Repatch (from linux) of OSX IRAF

333 files changed, 68170 insertions, 0 deletions

diff --git a/noao/twodspec/Revisions b/noao/twodspec/Revisions
new file mode 100644
index 00000000..c2a813cd
--- /dev/null
+++ b/noao/twodspec/Revisions
@@ -0,0 +1,81 @@
+.help revisions Jun88 noao.twodspec
+.nf
+twodspec$multispec/peaks.x
+twodspec$multispec/t_fitfunc.x
+    The 'rank' and 'samples' pointers were being used with Memr (5/4/13, MJF)
+
+twodspec$mkpkg
+    Commented out multispec package.
+    (2/14/92, Valdes)
+
+twodspec$twodspec.cl
+twodspec$twodspec.men
+    The SETDISP  task is now defunct.  (8/28/91, Valdes)
+
+twodspec$twodspec.cl
+twodspec$twodspec.men
+twodspec$twodspec.hd
+    Commented out multispec package.  Some day it may be resurrected.
+    (8/23/90, Valdes)
+
+====
+V2.9
+====
+
+twodspec$twodspec.cl
+twodspec$twodspec.men
+    Added SETAIRMASS and OBSERVATORY tasks. (6/2/89, Valdes)
+
+twodspec$twodspec.cl
+    Reference new ONEDSPEC executable for SETDISP.  (4/7/88 Valdes)
+
+====
+V2.5
+====
+    
+noao$twodspec/apextract/*
+    Valdes, September 16, 1986
+    1.  A new version of the package has been installed.  It is very
+	different from the old version.  The user parameter files must
+	be unlearned.
+
+twodspec:  Valdes, July 21, 1986:
+    1.  The older version of APEXTRACT has been removed.
+
+=============================================
+STScI pre-release and Version 2.3 SUN release
+=============================================
+
+twodspec:  Valdes, June 20, 1986:
+    1.  New APEXTRACT installed.  This version includes background
+	subtraction and new ICFIT.  The older version is still available.
+
+twodspec:  Valdes, March 27, 1986:
+    1.  Replaced SETIMHDR with SETDISP.  This task is now used in both
+	ONEDSPEC and TWODSPEC.
+
+twodspec:  Valdes, March 21, 1986:
+    1.  New aperture extraction package APEXTRACT.  This replaces EXTRACT
+	and TRACE.
+    2.  SETIMHDR moved from LONGSLIT to TWODSPEC.  It is my intention that
+	all tasks in this package (except background which is based on a
+	script in generic) use the header parameter DISPAXIS.  This means
+	both APEXTRACT and LONGSLIT.  MULTISPEC will probably not change since
+	it is an ancient package.
+
+===========
+Release 2.2
+===========
+From Valdes February 10, 1986:
+
+1.  The weighting options have been changed.  There are only two now;
+profile and variance.
+------
+From Valdes January 10, 1986:
+
+1.  New EXTRACT and TRACE tasks replace earlier EXTRACT.
+------
+From Valdes December 31, 1985:
+
+1.  The task EXTRACT has been made a part of the TWODSPEC package.
+.endhelp
diff --git a/noao/twodspec/apextract/Revisions b/noao/twodspec/apextract/Revisions
new file mode 100644
index 00000000..3ffe9058
--- /dev/null
+++ b/noao/twodspec/apextract/Revisions
@@ -0,0 +1,1558 @@
+.help revisions Jun88 noao.twodspec.apextract
+.nf
+
+approfile.x
+     When an aperture goes off the edge of an image there was an error
+     which allowed the imio data buffer from the image to go out of bounds.
+     (3/12/13, MJF)
+
+aptrace.x
+     The line1/line2 variables weren't being initialized to zero in the
+     ap_ctrace() procedure.  This woule lead to old values from a previous
+     run of the task being reused.  (2/6/13, MJF)
+
+=======
+V2.16.1
+=======
+
+approfile.x
+     Fixed a bug in the Marsh algorithm causing segfaults on 64-bit
+     platforms (Buglog 583)  (3/5/12, Valdes)
+
+apall.par
+     Changed the default for maxsep from 1000 to 100000.  This is because
+     the default is when the user doesn't want to skip apertures and it is
+     strange when the id jumps in the (rare) case that two apertures are
+     marked with a separation of more than 1000.  (2/17/09, Valdes)
+
+apedit.x
+    The 's' key now works on the current aperture rather than the nearest.
+    (10/7/08, Valdes)
+
+apcolon.x
+    The "all" mode was missing with :center.  (10/7/08, Valdes)
+
+apall1.par
+apfit1.par
+apnoise1.par
+apnorm1.par
+apscat1.par
+apparams.dat
+    When the apertures parameter was added in 1996 the :apertures and
+    :parameters commands were broken because of missing references in
+    the associated hidden psets.  (10/7/08, Valdes)
+
+=======
+V2.14.1
+=======
+
+========
+V2.12.2a
+========
+
+apextract.x
+    When using APFIT to output the difference the IMIO buffer which was
+    assumed to be static was invalidated because of I/O needed to create
+    the difference.  A special case was added to handle this case.
+    (7/7/04, Valdes)
+
+apcveval.x	+
+apedit.x
+apextract.x
+apfind.x
+apfindnew.x
+apfit.x
+apgmark.x
+apgscur.x
+apmask.x
+apnoise.x
+apprint.x
+approfile.x
+aprecenter.x
+apresize.x
+apskyeval.x
+apupdate.x
+apvalues.x
+apvariance.x
+apnearest.x
+apscatter.x
+aptrace.x
+mkpkg
+    Added an interface routine to CVEVAL to avoid calling it with
+    independent variables outside the range of the fit.  The fit range
+    may be short because of tracing problems.  So the profile shift
+    is now extended from the end points of the fitted range.
+    (5/21/04, Valdes)
+
+apupdate.x
+apdefault.x
+apfind.x
+aptrace.x
+apedit.x
+apcolon.x
+    Modified to check for inappropriate INDEF values in the "lower"
+    and "upper" aperture settings.  (3/26/04, Valdes)
+
+=======
+V2.12.2
+=======
+
+apextract.x
+    The edge weighting interpolation buffer space, interpbuf,  was
+    increased by one pixel.  This makes the data buffer wider so that
+    interpolation avoids using boundary extension except in cases where the
+    aperture actually approaches the image edge.  Note that this change
+    results in an improvement in the extracted spectra over the previous
+    release where wraparound boundary extension was used.  This also means
+    extractions will not be identical between the versions.
+    (1/23/04, Valdes)
+
+apextract.x
+    The new routine ap_asifit was not correct.  (1/22/04, Valdes)
+
+apextract.x
+approfile.x
+apvariance.x
+    A problem related to the change of 10/21/03 is when the trace goes
+    far outside the data buffer.  This could result in the number of points
+    specified for asifit being too small for the interpolation function.
+    An interface routine, ap_asifit, was added to do all the checks related
+    to using asifit for evaluating the edge pixels.  (12/10/03, Valdes)
+
+===========
+V2.12.2BETA
+===========
+
+apextract.x
+    The output name based on the input name for multiextension images
+    produces a multiextension output with the same extension description.
+    (12/3/03, Valdes)
+
+apgetim.x
+    1.	Restored ability to use image sections which was lost in the change
+	on 7/13/98 for V2.11.2.
+    2.	Support for multiextension data was added.  This consists of using
+	a standard name based on EXTNAME and EXTVER and without the
+	file type extension.  Note that this means that image names specified
+	by index will be converted to extension name and extension version.
+    (12/3/03, Valdes)
+
+apextract.x
+approfile.x
+apvariance.x
+    The call to asifit was specifying too many points to fit, a whole line
+    in the data buffer, because the data vector may be offset from the first
+    column of the data buffer.  This could cause a segmentation violation.
+    (10/21/03, Valdes)
+
+
+apwidth.cl
+    Script to compute aperture widths from database.  This was written
+    for a user and is saved here though it is not currently defined by
+    default.  (12/2/02, Valdes)
+
+apflat1.par
+    The indirect reference needs to be spelled out without abbreviation to
+    be "apflatten" instead of "apflat".  (11/18/02, Valdes)
+
+=======
+V2.12.1
+=======
+
+apextract.x
+approfile.x
+apvariance.x
+    Modified to handle edge pixels by interpolation.  (6/19/02, Valdes)
+
+=====
+V2.12
+=====
+
+apgraph.x
+apgmark.x
+    When there is just one aperture the background regions are marked
+    in apedit and in plotfile output.  (9/21/01, Valdes)
+
+doc/apall.hlp
+    The help page was indicating the extra information output was the
+    variance rather than the sigma.  (8/19/00, Valdes)
+
+apextract.x
+    The checking for the maximum number of apertures that fit in the allocated
+    memory (the "do j = i, napsex" loop) was incorrect because i was used
+    instead of the loop index j.  (3/20/00, Valdes)
+
+=========
+V2.11.3p1
+=========
+=======
+V2.11.3
+=======
+
+approfile.x
+    In the previous change to the weights in the Horne algorithm
+    the behavior when all data is rejected (say because the background
+    is set wrong and all data is below the background) the weights
+    would be set to MAX_REAL/10 which would cause CVFIT to fail.
+    (3/13/00, Valdes)
+
+apall1.par
+apdebug.par
+apfit1.par
+apnoise1.par
+apnorm1.par
+apparams.par
+    Reduced the polysep parameter.  (1/26/00, Valdes)
+
+apextractbak.x	-
+mkpkg
+    Removed this second old copy which was accidentally introduced into
+    mkpkg as well resulting in multiple copies of the same procedures
+    in the library in V2.11.3beta.  (12/9/99, Valdes)
+
+doc/apflatten.hlp
+    Removed extraneous parameters not actually in task parameter set.
+    (10/21/99, Valdes)
+
+mkpkg
+    Added missing dependencies.  (10/11/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+apextract.x
+    Added a keyword SUBAP when using echelle output with subapertures.
+    (3/26/99, Valdes)
+
+apflatten.par
+apflat1.par
+    Removed background subtraction as an option.  (12/11/98, Valdes)
+
+apskyeval.x
+    If the background sample region does not have explicit regions then
+    the xmin/xmax region is used for the background.  (12/11/98, Valdes)
+
+apfit.x
+    Added errchk for ic_fit and ic_gfit.  (12/8/98, Valdes)
+
+apflat1.par
+    Reduced the polysep because it can go wrong.  (12/8/98, Valdes)
+
+apextract.x
+    Added check to fix cases with the lower and upper aperture limits
+    are reversed.
+    (7/13/98, Valdes)
+
+apgetim.x
+    Changed to call xtools routine that strips extensions.
+    (7/13/98, Valdes)
+
+approfile.x
+    In the Horne algorithm the weights for rejected points were set to zero
+    to eliminate them from the fit.  But if large regions are rejected
+    this leaves the fit unconstrained and can lead to bad results.  A
+    change was made to set the weights for the rejected points to 1/10
+    of the minimum weight for the good data.
+    (2/6/98, Valdes)
+
+apextract.x
+    For "echelle" format with "extras" the header was not setup properly
+    resulting in WCSDIM=2 instead of 3.  (2/6/98, Valdes)
+
+apids.x
+    1.  Fix bug in IDS structure which pointed outside of allocated memory.
+    2.  Variables ra/dec in ap_gids were being used both as pointers and
+	double.  The ra/dec pointer usage was removed.
+    3.	The realloc step at the end of ap_gids had the wrong check so it
+	would never be done.
+    (1/13/98, Valdes)
+
+=======
+V2.11.1
+=======
+=====
+V2.11
+=====
+
+doc/apsum.hlp
+doc/apsum.hlp
+    Added missing task name in revisions section.  (4/22/97, Valdes)
+
+apextract.x
+    Removed calls to impl from inside amove in order to error check them.
+    (1/24/97, Valdes)
+
+t_apall.x
+    1.  Added errchk for ap_dbwrite.
+    2.  Made writing the aplast file optional.
+    3.  It is a warning if the plot file can't be written.
+    (1/24/97, Valdes)
+
+apextract.x
+    The step where the data is multplied by the gain was multiplying
+    outside the data if dispaxis=1.  If the there are enough apertures
+    and the aperture widths decrease then it is possible to get
+    mulitplications of gain**naps which can cause a floating overflow.
+    This was fixed.  (11/12/96, Valdes)
+
+apertures.h
+t_apall.x
+aptrace.x
+apresize.x
+apalloc.x
+apextract.x
+apselect.x
+aprecenter.x
+apall.par
+apall1.par
+apfit1.par
+apflat1.par
+apnorm1.par
+apparams.par
+apnoise1.par
+apdebug.par
+apfit.par
+apflatten.par
+apmask.par
+apnoise.par
+apnormalize.par
+apresize.par
+apscatter.par
+apsum.par
+aptrace.par
+apedit.par
+apfind.par
+aprecenter.par
+mkpkg
+doc/apextract.hlp
+doc/apextras.hlp
+doc/apedit.hlp
+doc/apall.hlp
+doc/apfind.hlp
+doc/apresize.hlp
+doc/apsum.hlp
+doc/aptrace.hlp
+doc/apfit.hlp
+doc/apflatten.hlp
+doc/apmask.hlp
+doc/apnoise.hlp
+doc/apnormalize.hlp
+doc/aprecenter.hlp
+doc/apscatter.hlp
+    Added a new parameter "apertures" to select a subset of the apertures
+    to resize, recenter, trace, extract, etc.  The parameter "apertures"
+    which applied to the recentering was changed to "aprecenter".
+    (9/5/96, Valdes)
+
+apedit.key
+    Alphabetized the summary command lists.  (9/3/96, Valdes)
+
+apextract.x
+    1. Onedspec output format is now allowed when nsubaps is greater than 1.
+    2. Echelle format outputs all orders for a each subapertures in
+       separate files.
+    (4/3/96, Valdes)
+
+apmw.x
+apextract.x
+    The WCS for strip extraction was wrong.  (1/31/96, Valdes)
+
+apmw.x
+    An error in computing the WCS transformation now prints a more informative
+    message indicating the final extracted spectrum will be in pixel units.
+    (1/4/96, Valdes)
+
+apids.x
+apedit.x
+    Changed the behavior of the 'i' and 'o' keys with regard to the beam
+    numbers.  These keys will now assign a beam number from the apid table
+    for the selected aperture as well as all other apertures.  Previously
+    the beam number was not changed which resulted in a new aperture
+    number with a beam number that did not agree with the apid table.
+    (10/27/95, Valdes)
+
+doc/apextras.hlp +
+apextract.men
+apextract.hd
+    Added a help topic on the "extras" information.  (9/5/95, Valdes)
+
+apimmap.x
+    If the image header dispersion axis is unreasonable a warning is
+    printed and the "dispaxis" parameter is used instead.  (8/2/95, Valdes)
+
+apids.x
+apmw.x
+doc/apall.hlp
+doc/apdefault.hlp
+doc/apedit.hlp
+doc/apfind.hlp
+    Modified to allow aperture ID table to be from an image header
+    under the keywords SLFIBnnn.  The extracted image will have
+    these keywords deleted.  (7/25/95, Valdes)
+
+=======
+V2.10.4
+=======
+
+apscatter.x
+    When not smoothing along the dispersion there was a bug that when
+    the number of points being fit across the disperision changed
+    ICFIT was not reset causing an error "Range descriptor undefined".
+    The routine now reset the "new" flag when the number of points
+    changes.  (5/3/95, Valdes)
+
+t_apall.x
+    Using the same input and output image name in APSCATTER was still
+    not right.  (2/24/95, Valdes)
+
+apscatter.x
+    Made the output image datatype be at least real.  (2/23/95, Valdes)
+
+apextract.x
+    For normalization the weights were not forced causing the gain to
+    default to 0.  The change of 12/31/94 also fixed this by setting the
+    gain to 1.  The file was touched but not changed.  (1/27/95, Valdes)
+
+apextract.x
+apskyeval.x
+    Made the query for the readnoise only occur if needed.  Previously
+    the query was made in the sky step even if the sky error estimate
+    was not needed.  (12/31/94, Valdes)
+
+apedit.x
+    Needed to set clobber and review options so they are queried during
+    interactive extraction.  (10/28/94, Valdes)
+
+apimmap.x
+apgetim.x
+apgetdata.x
+apextract.x
+apmw.x
+    1.	If a 3D image is given then a warning is printed and the first plane
+	is used and the other planes are ignored.
+    2.  Various fixes to allow image sections to be used.
+    (10/12/94, Valdes)
+
+aptrace.x
+    An uninitialized memory problem was fixed.  (9/19/94, Valdes/Zarate)
+
+apicset.x
+    Fixed type mismatch in min/max function calls.  (6/13/94, Valdes/Zarate)
+
+apextract.x
+    Changed BANDID name for raw spectrum to "raw".  (5/3/94, Valdes)
+
+apvariance.x
+doc/apvariance.hlp
+doc/apall.hlp
+doc/apsum.hlp
+    The correction to bring the weighted and unweighted total fluxes to the
+    same value (called the bias factor) can produce odd values in special
+    cases; such as slitlets where only part of the image contains real
+    spectrum.  This could result in variance spectra with flux scaling
+    errors to the extreme of a negative (inverted) spectrum.  The bias
+    factor is now logged.  If the two total fluxes differ by more than a
+    factor of 2 a warning (which always appears on the standard output) is
+    given with the fluxes and the bias factor.  If the bias factor is
+    negative a warning is given and the bias factor is ignored.
+    (5/1/94, Valdes)
+
+doc/aptrace.hlp
+    Fixed typo in description of Legendre basis functions.  (4/1/94, Valdes)
+
+apextract.x
+doc/apextract.hlp
+    Added output BANDID keywords to document the various output data.
+    (2/4/94, Valdes)
+
+apnoise.x	+
+apnoise1.par	+
+apnoise.par	+
+apnoise.key	+
+doc/apnoise.hlp	+
+apextract.x
+t_apall.x
+x_apextract.x
+apextract.hd
+apextract.men
+apextract.cl
+mkpkg
+    A new task for computing the noise sigma as a function of data value
+    was added.  This allows checking the noise model parameter and
+    can be used as a diagnostic of the profile modeling.  (8/28/93, Valdes)
+
+apfit.x
+apextract.x
+    There were some additional problems with gain parameter dependencies
+    in the difference, fit, and normalization output functions.
+    (8/27/93, Valdes)
+
+apgetdata.x
+aptrace.x
+apedit.par
+apfind.par
+apfit.par
+apflatten.par
+apmask.par
+apnormalize.par
+aprecenter.par
+apresize.par
+apscatter.par
+apsum.par
+aptrace.par
+apall.par
+apall.hlp
+apedit.hlp
+apfind.hlp
+apflatten.hlp
+apmask.hlp
+apfit.hlp
+apnormalize.hlp
+aprecenter.hlp
+apresize.hlp
+apscatter.hlp
+apsum.hlp
+aptrace.hlp
+    The nsum parameter may be negative to select a median rather than
+    a sum of lines/columns.  The parameter files had to be modified to
+    remove the minimum range limit and the help files modified to
+    document the new option.  (8/10/93, Valdes)
+
+===========
+V2.10.3beta
+===========
+
+doc/apall.hlp
+doc/apsum.hlp
+    The format parameter description was added.  (6/24/93, Valdes)
+
+apfind.x
+apfindnew.x
+    Removed the threshold in peak finding requiring peaks to be above zero.
+    This works with the change to center1d to allow finding of apertures
+    when the data is negative.  (5/5/93, Valdes)
+
+apfit.x
+    Added CCDMEAN=1. to output image in the normalization, flattening routines.
+    (4/16/93, Valdes)
+
+apextract.par
+*.par
+apgetim.x
+    Moved the "dispaxis" parameter to a package paraemter.
+    (3/8/93, Valdes)
+
+approfile.x
+    The profile was not cleared when saturated pixels are found.  This
+    could cause NaNs to get into the data with the result that
+    cvfit could produce garbage.
+    (3/4/93, Valdes)
+
+debug.par
+apparams.par
+apnorm1.par
+apflat1.par
+apfit1.par
+apall1.par
+    1.  Changed the default "fit2d" polynomial parameters to polyorder=10,
+	polysep=0.95.
+    2.  Changed the default "niterate" from 2 to 5.
+    (3/3/93, Valdes)
+
+approfile.x
+doc/approfiles.hlp
+    For the "fit1d" algorithm I doubled the order it uses to fit
+    parallel to the disperison.  The order is still computed based
+    on the tilt of the spectrum and the order used for the tracing
+    but now that number is doubled.  (2/26/93, Valdes)
+
+apscatter.x
+    Revised the algorithm to keep the cross-dispersion fits in memory
+    rather than writing them to disk as an image.  This speeds things
+    up in the case of slow I/O.  (2/23/93, Valdes)
+
+t_apall.x
+apscatter.x
+    1.  The temporary file name was not being passed to apscatter by
+	t_apall resulting in use of the name ".imh" which is hidden.
+    2.  Increased the column buffering size from 512*100 to 500000.
+    (2/5/93, Valdes)
+
+apextract.x
+    imaccf was being used as a boolean when it should be an int.
+    (12/13/92, Valdes)
+
+debug.par
+    A DPAR parameter file for use with debugging.  (1/12/92, Valdes)
+
+apmw.x
+apextract.x
+    Rewrote this to allow extractions of an arbitrary number of apertures.
+    Previously this was limited by MWCS.  The output format is now
+    EQUISPEC. (1/12/92, Valdes)
+
+aprecenter.x
+    This routine was incorrectly selecting the apertures to be used.
+    is_in_range (Memi[ranges], i) --> is_in_range (Memi[ranges], AP_ID(aps[i]))
+    (1/8/93, Valdes and Hill)
+
+doc/apbackground.hlp
+    In responding to a concern about the 'b' key showing a fit even though
+    the background type was "median" I added a paragraph explaining this.
+    (1/8/93, Valdes)
+
+t_apall.x
+    The dispersion smoothing was turned off in noninteractive mode regardless
+    of the task parameter.  This has been fixed.
+    (12/8/92, Valdes)
+
+t_apall.x
+    Added error check for ap_plot.
+    (10/14/92, Valdes)
+
+apextract.x
+    1. When the dispersion axis is 1 the data buffer may contain garbage
+       because of using a malloc and because not all of this buffer is
+       necessarily used.  Later the multiplication by the gain can cause
+       an arithmetic exception.  The mallocs were replaced by callocs.
+    2. Added errchks for the impl[123]r routines.
+    (9/10/92, Valdes)
+
+mkpkg
+apextract.x
+apmw.x		+
+    1. Separated out the MWCS routines into another file.
+    2. Added an apmw_saveim procedure to produce simple 1D format as is done
+       in the ONEDSPEC package.
+    (8/24/92, Valdes)
+
+apskyeval.x
+    When doing the fitted background variable roundoff among machines led
+    to using different background points and, hence, gave noticibly different
+    results.  The background points are now rounded to the nearest 1000th of
+    a pixel which will produce the same background points on all machines.
+    (8/19/92, Valdes)
+
+apnorm1.x
+    Added missing t_nlost parameter.  (8/10/92, Valdes)
+
+aptrace.x
+    There was an incorrect order in checking for failed traces which ends
+    up referencing uninitialized memory.  This bug has been there for a
+    long time (V2.8-V2.10) but only showed up during testing on the
+    SGI port.  (7/31/92, Valdes)
+
+The following set of changes concern the treatment of the background sample
+regions and min/max fitting limits.  There was also a change in ICFIT
+to check the min/max fitting limits and increase them if the sample region
+is extended beyond the initial fitting limits.
+
+--------
+
+apdefault.x
+	Now calls AP_ICSET with the image limits rather than the aperture
+	limits as required by the change to that routine.  (7/30/92, Valdes)
+
+apedit.x
+    1.  The default aperture is reset after a colon command just in case
+        one of the default aperture parameters has changed.  This is
+        slightly inefficient but the alternative is a more complex
+        AP_COLON to determine if a parameter relates to the default
+        aperture.
+    2.  Now calls AP_ICSET after fitting to apply the constraint that the
+        fitting limits pass under the aperture.  (7/30/92, Valdes)
+
+apicset.x
+    1.  The input background limits for a new aperture (called
+	by AP_DEFAULT) are now the maximum limits defined by the image size
+	rather than the minimum limits defined by the aperture.
+    2.  If a null default sample is given it is mapped to "*".
+    3.  A sample with "*" will map to the maximum limits.
+    4.  Allow the input and output pointers to be the same in order
+	for the constraint that the fitting region pass under the
+	aperture can be applied.  (7/30/92, Valdes)
+
+--------
+
+doc/apall.hlp doc/apsum.hlp doc/apbackground.hlp
+    The documentation of the "median" and "minimum" options for the
+    background parameter needed to be added.  (7/14/92, Valdes)
+
+apextract.x
+    The profile array needed to be corrected for the gain.  This makes a
+    difference for the output formats that use the fitted profile
+    (tasks APFLATTEN, APFIT: formats fit, ratio, diff, flat).
+    (7/9/92, Valdes)
+
+apfit1.par
+    Was missing t_nlost.  (7/9/92, Valdes)
+
+apparams.par
+apnorm1.par
+apflat1.par
+apfit1.par
+apall1.par
+    Replace prompt pfiT with pfit as it should be.  (7/9/92, Valdes)
+
+=======
+V2.10.2
+=======
+
+apextract.x
+    The WCS for the 3D images was changed to produce a WCSDIM of 3.
+    (6/30/92, Valdes)
+
+=======
+V2.10.1
+=======
+
+=======
+V2.10.0
+=======
+
+apextract.x
+    1. The axis array which was set by a data statement was actually
+       modified in the routine causing an improper WCS type to be
+       set.
+    2. If no coordinate label and/or units are found they are now set based
+       on DC-FLAG.  Before calibrated long slit spectra ended up with the
+       right wavelength coordinates but a label of Pixel and no units.
+       (5/20/92, Valdes)
+
+apall1.par
+apparams.par
+apfit1.par
+apflat1.par
+apnorm1.par
+    The e_profile prompt contained a new line.  This was removed.
+    (5/18/92, Valdes)
+
+doc/apexv210.ms +
+doc/revisions.v3.ms -
+    Revisions summary document.  (5/11/92, Valdes)
+
+apcolon.x
+apedit.key
+doc/apedit.hlp
+    Added t_nlost to the list of colon commands.  (5/11/92, Valdes)
+
+apgetim.x
+    Added the qp and pl extensions to those stripped.  (5/8/92, Valdes)
+
+apextract.x
+    Added error checking such that if there is a problem with reading the
+    input image WCS and warning is printed and pixel coordinates are set
+    in the output image.  (5/8/92, Valdes)
+
+=====
+V2.10
+=====
+
+apextract.x
+    For a single aperture using MULTISPEC WCS a dummy axis mapping was added
+    to make the image appear to be the first line of a parent 2D image.
+    (4/27/92, Valdes)
+
+approfile.x
+    Added a maximum order for the aphorne fitting function.  (4/24/92, Valdes)
+
+apextract.x
+    Added a error check trap to clean up and free memory in case of an
+    error.  (4/24/92, Valdes)
+
+t_apall.x
+apdb.x
+apedit.x
+apcolon.x
+apfind.x
+apfindnew.x
+apertures.h
+    Made the number of apertures dynamic.  There is no longer a maximum
+    number of apertures allowed.  (3/18/92, Valdes)
+
+t_apall.x
+    Length of format string declared as SZ_FNAME but used as SZ_LINE.
+    Change declaration to SZ_LINE.  (3/12/92, MJF)
+
+apextract.x
+    Now the output extension is added only if the output name is the
+    same as the input name.  Thus, if someone used <image>.ms as an
+    output name they won't get <image>.ms.ms.  (2/12/92, Valdes)
+
+apvariance.x
+apskyeval.x
+approfile.x
+apextract.x
+appars.x
+    Trapped errors from getting the read noise and gain from the image header
+    to produce a meaningful warning message.  (2/10/92, Valdes)
+
+apedit.x
+apfind.x
+t_apall.x
+apids.x
+    1. Added code to ignore negative beam numbers during extraction.
+    2. Negative beam numbers are only generated if an explicit assignment
+       is made in the aperture id table or with 'j'; i.e. beam numbers
+       generated by adding or subtracting will not have a negative beam.
+    (2/10/92, Valdes)
+
+apids.x
+apedit.x
+    Modified to not allow apertures numbers < 1.  (1/22/92, Valdes)
+
+t_apall.x
+x_apextract.x
+    Added new entry point, apslitproc, for the slit processing tasks.
+    (1/15/92, Valdes)
+
+apfind.x
+apall.par
+apfind.par
+    If nfind < 0 then the specified number of evenly spaced apertures are
+    defined.  (1/14/92, Valdes)
+
+apextract.x
+apsum.par
+apnormalize.par
+apflatten.par
+apfit.par
+apall.par
+apparams.par
+apnorm1.par
+apflat1.par
+apfit1.par
+apall1.par
+doc/apsum.hlp
+doc/approfiles.hlp
+doc/apnormalize.hlp
+doc/apflatten.hlp
+doc/apfit.hlp
+doc/apall.hlp
+    1.  Replaced the "maxtilt" criteria for choosing the profile fitting
+    algorithm with an explicit "pfit" parameter.
+    2.  The parameter files were modified to remove "maxtilt", add
+    "pfit", and change the default "polyorder" parameter for the
+    fit2d algorithm from 4 to 6.
+    3.  The "pfit" parameter is redirected from the hidden parameter files
+    to the user parameter files allowing the users to select the profile
+    fitting algorithm.
+    (1/8/92, Valdes)
+
+t_apall.x
+apdb.x
+    1.  Added special strings for the reference parameter.  If the reference
+    parameter is "OLD" then only input images with existing database
+    entries are processed.  If the reference is "NEW" then only input
+    images without existing databse entries are processed.
+    2.  Added a new procedure, ap_dbaccess, to simply check for the presence
+    of a database file.  This is used for the above change.
+    (1/2/92, Valdes)
+
+aptrace.x
+apall.par
+aptrace.par
+apparams.par
+apall1.par
+doc/apall.hlp
+doc/aptrace.hlp
+    A new parameter has been added to set the number of steps which may
+    be lost during tracing.  (9/5/91, Valdes)
+
+apextract.x
+    Changed ap_setdisp to ap_wcs.  This routine uses MWCS and sets the
+    WCS to multispec.  (8/29/91, Valdes)
+
+apextract.x
+    Modified so that profile image is used in place of input image for
+    determining the profile and eliminated the use of a disk profile file.
+    This is inefficient if the same profile image is used for many input
+    images but it is much easier for the user to understand.
+    (8/27/91, Valdes)
+
+apvariance.x
+    The subaperture extraction did not work because of a typo.
+    (8/27/91, Valdes)
+
+apextract.x
+    The profile image capability had several bugs which were fixed.
+    (8/27/91, Valdes)
+
+approfile.x
+    Fixed another division by zero problem in ap_horne.  (8/27/91, Valdes)
+
+approfile.x
+    Failed to clear profile in the case the spectrum was negative.
+    (5/30/91, Valdes)
+
+apertures.h
+    Increased the maximum number of aperture from 100 to 1000.
+    (4/29/91, Valdes)
+
+apdefault.x
+apicset.x
+    The default aperture was setting the background fitting range to
+    the full image range rather than range covered by the sample region.
+    This could cause singular solution errors in some cases.
+    (3/27/91, Valdes)
+
+apfind.x
+    Allowed still finding the specified number if some apertures (up to
+    2) fail for some reason such as too near the edge.  This is done by
+    setting the number of candidates to nfind+2. (3/26/91, Valdes)
+
+aprecenter.x
+doc/aprecenter.hlp
+    When using the shift option the shift is now the median (including
+    averaging of central 2 shifts for even number of peaks) instead of
+    the average.  (3/26/91, Valdes)
+
+appars.x
+apall1.par
+apfit1.par
+apflat1.par
+apnorm1.par
+apparams.par
+    In order to allow writing to redirected parameters rather than overwrite
+    the redirection string a kluge was added using the prompt string.
+    The apput procedures check the prompt string for the first character
+    ">" and if present write to the parameter given in the rest of the
+    string.  All the hidden parameter files with redirected parameters
+    had to be changes.  (3/26/91, Valdes)
+
+apextract.par
+apall.par apall1.par
+apsum.par apdefault.par apparams.par
+apfit.par apfit1.par
+apflatten.par apflatten1.par
+apnormalize.par apnorm1.par
+    1.  Moved format parameter from package parameters to
+	APALL and APSUM.
+    2.  Moved dispaxis parameter from package parameters to APDEFAULT.
+    3.  Added new background types.
+    (3/21/91, Valdes)
+
+t_apall.x
+    Allow scattered light correction to be run by APSCRIPT.
+    (3/21/91, Valdes)
+
+apscatter.x
+    Moved CLIO call for anssmooth out of loop to a single call using a
+    procedure variable.
+    (3/21/91, Valdes)
+
+apextract.x
+apskyeval.x
+    Aded new background functions median and minimum.
+    (3/21/91, Valdes)
+
+=================================
+V3 of APEXTRACT Installed 8/23/90
+=================================
+
+apextract$exsum.x
+    Added a test for the existence of output images before extractions and
+    a query to select whether to clobber spectra or not.  (8/9/89, Valdes)
+
+apextract$exmvsum.x
+apextract$exfit.x
+    1.  The moving average for profile images did not work correctly.  It
+	subtracted the line moving out of the moving average but failed to
+	add in the line moving into the average.  This caused the profile
+	to depart more and more from the data as the extraction procedes
+	through the image.
+    2.  The moving average for profile images actually used naverage + 1
+	instead of naverage becuase in this case the line being extract is
+	also included in the average.
+    3.  The fitting of the model to the data had a funny behavior when the
+	model had negative values and variance weight was used.  The
+	negative values are now excluded from the fitting calculation in
+	this case.  Note that the model is supposed to not contain negative
+	values.  Also note that if variance weighting is not used then the
+	negative values are used in straight least-squares fitting.
+	(8/8/89, Valdes)
+
+apextract$apicset.x
+apextract$apedit.x
+apextract$apupdate.x
+    The region over which the background fitting is defined has been extended
+    to require overlapping the aperture. (7/31/89, Valdes)
+
+apextract$apcolon.x
+    Added gdeactivate/greactivate calls when using EPARAM.  (6/14/89, Valdes)
+
+apextract$apextract.x
+    If reference apertures are used without change (no recenter, edit, or
+    retrace) then the apertures were not written to the database.  This has
+    been changed to write (or query if interactive) the apertures if
+    dbwrite=yes.  (5/19/89, Valdes)
+
+apextract$exio.h
+apextract$exio.x
+apextract$exsum.x
+    1.  The maximum number of simultaneous extractions was increased from
+	20 to 50.
+    2.  The amount of buffering used for column access (dispaxis=1) was
+	increased from 100K pixels to 1M chars.  (5/12/89, Valdes)
+
+apextract$doc/apsum.hlp
+    Added a sentence about the proper alignment of echelle spectra.
+    (5/8/89, Valdes)
+
+apextract$t_apscatter.x +
+apextract$apscatter.par +
+apextract$apscat1.par +
+apextract$apscat2.par +
+apextract$doc/apscatter.hlp +
+apextract$mkpkg
+apextract$x_apextract.x
+apextract$apextract.cl
+apextract$apextract.men
+apextract$apextract.hd
+imred$echelle/apscatter.par +
+imred$echelle/apscat1.par +
+imred$echelle/apscat2.par +
+imred$echelle/echelle.cl
+imred$echelle/echelle.men
+    Added a new task, APSCATTER, to fit and subtract scattered light.
+    It includes two hidden psets, APSCAT1 and APSCAT2.  (3/3/89, Valdes)
+
+apextract$apnormalize.par
+imred$echelle/apnormalize.par
+    Input image parameter name needed to be changed from "images" to "input".
+    (2/28/89, Valdes)
+
+apextract$exio.x
+    Added errchk for imgeti related to getting DISPAXIS keyword which
+    might be missing.  (2/28/89, Valdes)
+
+apextract$exsum.x
+    Changed usage of CRPIX keyword to real from integer.  (1/25/89, Valdes)
+
+apextract$apgmark.x
+    The size of the aperture labels now decreases with increasing number
+    of apertures.  (1/24/89, Valdes)
+
+apextract$t_apnorm.x
+apextract$apnormalize.par
+imred$echelle/apnormalize.par
+apextract$doc/apnormalize.hlp
+    Changed parameter names "lowreject" to "low_reject" and "highreject"
+    to "high_reject" to be consistent with other ICFIT tasks.
+    (1/24/89, Valdes)
+
+apextract$aprecenter.x
+    The progress information was not using the verbose parameter.
+    (1/23/89, Valdes)
+
+apextract$apedit.x
+    Fixed bug causing 'i' info to only be visibly momentarily.
+    (12/16/88 Valdes)
+
+apextract$t_apnorm.x
+    When fitting the normalization spectrum interactively any deleted
+    points would be remembered in the following apertures.  Deleted points
+    are now cleared after interactive fitting.  (12/15/88 Valdes)
+
+apextract$apedit.x
+    Fixed a minor bug in the 's' option (center + wx --> wx) (12/15/88 Valdes)
+
+apextract$*.x
+apextract$apio.par
+apextract$doc/apio.hlp
+    Removed the beep option. (12/8/88 Valdes)
+
+apextract$exgmodaps.x
+    The temporary apertures array and number of apertures were not being
+    initialized correctly causing a segmentation violation every time
+    the program was run. Added an n = 0 statement and initialized all the
+    pointers to NULL. (10/13/88 Davis)
+
+apextract$exmvsum.x
+    When cleaning and using a moving average the replacement of the bad pixel
+    in a data profile back in the moving average was in error leading to 
+    bad results and possible memory corruption.  (10/9/88 Valdes)
+
+apextract$exfit.x
+apextract$exmvsum.x
+    1.  The sigma clipping test now uses the variance relation for testing the
+	residuals.
+    2.  A bug was causing the length of the profile image to be incorrectly
+	referenced leading to an out of bounds error.
+
+apextract$apedit.x
+apextract$exapsum.x
+    1.  After doing a ":line" new apertures were defined with the old line
+	as the aperture center.  This made tracing fail.
+	Now after changing the line the default aperture is updated and
+	the apeture center is explicitly set every time.
+    2.  In a rare circumstance a divide by zero error occured for the fitted
+	background.  This is now checked.  (7/19/88 Valdes)
+
+noao$lib/scr/apedit.key
+apextract$apedit.x
+    1.  Deleted a reference to :nfind in the cursor help.
+    2.  After deleting a background defintion it was no longer possible
+	to define a new one.  Now an attempt to define backgrounds
+        after they have been deleted is initialized to the default again.
+        (7/1/88 Valdes)
+
+apextract$exsum.x
+    Fixed a bug in blocking overwriting of existing echelle format spectra.
+    Fixed a minor bug in writing the aperture info to the header of a 1D
+    format sky spectrum.  (6/16/88 Valdes)
+
+apextract$apgmark.x
+    Labels are not written outside of graph range.  (5/20/88 Valdes)
+
+apextract$apedit.x
+apextract$exgraph.x
+noao$lib/scr/apedit.key
+    Added 'I' interrupt.  (4/20/88 Valdes)
+
+apextract$exio.x
+    EX_UNMAP when using column access was free a buffer supplied by
+    IMIO causing a memory corruption error on VMS.  (3/30/88)
+
+apextract$exgmodaps.x
+    Model apertures where not being match up correctly resulting in a
+    warning message.  (3/22/88 Valdes)
+
+apextract$exsum.x
+apextract$exstrip.x
+apextract$exrecen.x
+    Added iferr statements for asifit.  Without this the task crashed
+    when an aperture went off the edge.  (3/10/88 Valdes)
+
+apextract$* Major changes:
+	o Use profile template image
+	o Don't interpolate data profile before cleaning
+	o New background option
+	o Integrate apertures
+	o Restructure code
+	o And much more
+    (3/1/88 Valdes)
+
+==============
+APEXTRACT V2.0
+==============
+
+apextract$excextract.x -
+apextract$exlextract.x -
+    Removed these unused procedures. (1/5/88 Valdes)
+
+apextract$excstrip.x
+apextract$exlstrip.x
+    Free curfit pointer if ic_fit returns an error. (1/5/88 Valdes)
+
+apextract$excsum.x
+apextract$exlsum.x
+    Set background to zero if ic_fit returns an error. (1/5/88 Valdes)
+
+    Original:
+	iferr (call ic_fit (AP_IC(aps[i]), cv, Memr[x],
+	    Memr[bufin], Memr[w], ncols, YES, YES, YES, YES))
+	    ;
+
+    New:
+	iferr {
+	    call ic_fit (AP_IC(aps[i]), cv, Memr[x],
+	        Memr[bufin], Memr[w], ncols, YES, YES, YES, YES)
+	    call ex_apbkg (cv, ncols, center, low, high,
+	        skyout[line,i])
+	} then
+	    skyout[line,i] = 0.
+
+apextract$exapsum.x
+    Added check for no data in sum. (1/5/88 Valdes)
+
+    In procedure ex_apsum:
+	a = max (0.5, center + lower)
+	b = min (npts + 0.5, center + upper)
+
+	if (a >= b) {			<-- ADD
+	    sum = 0.			<-- ADD
+	    return			<-- ADD
+	}
+
+    In procedure ex_apbkg:
+	a = max (0.5, center + lower)
+	b = min (npts + 0.5, center + upper)
+
+	if (a >= b) {			<-- ADD
+	    bkg = 0.			<-- ADD
+	    return			<-- ADD
+	}
+
+apextract$apnormalize.x
+    There was no error checking on ap_dbread which caused misleading errors
+    (apio package not found).  This was fixed by updating the logic to be the
+    same as in apextract.x.  A quick fix for outside sites is to add an
+    errchk for ap_dbread.  (12/18/87 Valdes)
+
+apextract$apedit.x
+apextract$apgscur.x
+    When first entering APEDIT with apertures defined the first attempt to
+    point the cursur at the first aperture uses an indefinite y value since
+    no cursor read has yet taken place.  The choices are to set it to some
+    arbitrary value, some percentage level on screen, or do nothing.  I
+    chose to do nothing.  Thus, the cursor will not point at the current
+    aperture in this case but it will leave the cursor position unchanged.
+    (12/17/87 Valdes)
+
+apextract$apio.par
+apextract$exsum.x
+apextract$exoutsum.x
+apextract$apedit.x
+    Added new parameter "format" to APIO pset.  Added new output formats for
+    echelle and multispectra data consisting of a single 2D image.  Added new
+    information in header.  Old format is called "onedspec".
+
+    Removed debugging print statement.  When it was put in I don't know.
+    (12/17/87 Valdes)
+
+apextract$apextract.x
+    An error was introduced with the change of 11/9/87 such that the error
+    when a database file does not exists was no longer being trapped.  This
+    was intended for reference images but was not intended for creating new
+    database files.  An iferr was added.
+
+apextract$t_apnormalize.x
+apextract$trtrace.x
+apextract$exstrip.x
+apextract$exsum.x
+    ERRCHK declarations for IMGETI were added to detect a missing DISPAXIS.
+    Failing to catch this error caused misleading error messages and
+    other fatal errors. (11/9/87 Valdes)
+
+apextract$apextract.x
+apextract$apdb.x
+    An error reading apertures for a specified reference image is now
+    printed instead of assuming there are no reference apertures.
+    (11/9/87 Valdes)
+
+apextract$exfit.x
+    Changed the variance formula from
+	V = v0 + v1 * abs (S + B)
+    to
+	V = v0 + v1 * max (0, S + B)		if v0 > 0
+	V = v1 * max (1, S + B)			if v0 = 0
+    (11/9/87 Valdes; see also 8/6/87)
+
+apextract$t_apnormalize.x
+    When normalizing more than 20 apertures some of the apertures
+    were being lost in the output image.  This was fixed to only
+    fill between the apertures on the first set of apertures.
+
+    Normalizing when DISPAXIS=1 did not work.  There were a number of
+    errors.  This task was never tested with data in this orientation.
+    (9/22/87 Valdes)
+
+apextract$exfit.x
+apextract$apsum.par
+apextract$apstrip.par
+apextract$doc/apsum.hlp
+apextract$doc/apstrip.hlp
+    When computing the variance for doing variance weighting the
+    intensity could be negative.  An absolute value was added to
+    correct this.
+
+    Make defaults for naverage=100 and nclean=2 because people have
+    been using inadequate number of lines for low signal-to-noise
+    data and because of interpolation even an 1 pixel cosmic ray
+    expands to two pixels.  (8/6/87 Valdes)
+
+====
+V2.5
+====
+
+apextract$apio.par
+apextract$apio.x
+apextract$t_apnormalize.x
+apextract$exsum.x
+apextract$exstrip.x
+apextract$apfindnew.x
+apextract$apfind.x
+apextract$apextract.x
+apextract$apedit.x
+apextract$trtrace.x
+apextract$trltrace.x
+apextract$trctrace.x
+apextract$exgraph.x
+apextract$doc/apio.hlp
+    Valdes, May 19, 1987
+    1.  Added the parameter "verbose" to the APIO pset to allow turning off
+	log information to the terminal.
+    2.  Made changes to minimize switching between text and graphics mode.
+	With verbose=no there should be essentially no mode switching.  This
+	was done for terminals in which such switches is either annoying
+	or slow.
+
+apextract$mkpkg
+apextract$apcvset.x
+apextract$t_apnormalize.x
+apextract$trtrace.x
+apextract$exsum.x
+apextract$exstrip.x
+apextract$apgetdata.x
+apextract$apimmap.x +
+    Valdes, April 24, 1987
+    1.  Protection against using an image which is not 2 dimensional was added.
+
+apextract$apedit.x
+apextract$apextract.x
+apextract$apsum.par
+apextract$exapsum.x
+apextract$excsum.x
+apextract$exgprofs.x
+apextract$exlsum.x
+apextract$exoutsum.x
+apextract$exsum.x
+apextract$doc/apsum.hlp
+    Valdes, April 11, 1987
+    1.  Added additional option to APSUM to output the subtracted sky
+	background spectra when doing background subtraction.
+
+apextract$apextract.hd
+apextract$apextract.men
+apextract$apextract.par
+apextract$apgetim.x
+apextract$apnormalize.par
+apextract$mkpkg
+apextract$t_apnormalize.x +
+apextract$x_apextract.x
+apextract$doc/apnormalize.hlp +
+    Valdes, April 3, 1987
+    1.  New task APNORMALIZE installed.
+
+apextract$*x
+    Valdes, February 17, 1987
+    1.  Required GIO changes.
+
+apextract$apio.h
+apextract$exgraph.x
+apextract$apio.x
+apextract$excextract.x
+apextract$apextract.tar
+apextract$trltrace.x
+apextract$trctrace.x
+apextract$exlextract.x
+apextract$applot.x
+apextract$apedit.x
+    Valdes, February 13, 1987
+    1.	I've made a number of modifications to the APEXTRACT package to
+	correct problems in the way graphics and text are mixed.  The
+	main change was to make the graphics open very local to the
+	procedure doing the graphics.  Previously the graphics device
+	was opened at the beginning of the logical task and remained
+	open until the end.  This was done since the integrated nature
+	of the package has many procedures which may do graphics.  This
+	has the bad side effects that for the first graphics open of
+	the process the terminal enters graphics mode (graphics screen
+	on SUN and clear screen on VT640) well before any graphics is
+	performed and text I/O is a problem.  Putting GOPEN and GCLOSE
+	immediately around the code that does graphics fixed almost all
+	the problems.  The only time that text output is now done when
+	the graphics terminal is open is for '?' and ':show' type of
+	commands.  The only remaining problem is the page wait problem
+	associated with '?' occuring before a cursor read rather than
+	immediately after the text output causing the last written
+	status line to become confused with the page wait prompt.
+
+apextract$apfind.par
+    Valdes, February 12, 1987
+    1.  The parameter apfind.nfind was changed back to hidden in order
+	for apsum to work in the background.  Note the PSET mechanism
+	would fix this by allowing nfind to be specified on the command
+	line.
+
+apextract$apio.par
+    Valdes, February 9, 1987
+    1.  New users rarely look at or know about the log files produced by
+	the package tasks.  These files (particularly graphics) take up
+	a lot of space.  Therefore the default is now not to log
+	text or graphics output.
+
+apextract$apedit.x
+apextract$apsort.x
+apextract$exapsum.x
+apextract$trltrace.x
+apextract$trctrace.x
+apextract$doc/apedit.hlp
+noao$lib/scr/apedit.key
+    Valdes, February 2, 1987
+    1.  Added a new edit option, 'o', to reorder the aperture id and beam
+	numbers sequentially.  This is useful after apertures have been
+	deleted and added interactively.
+    2.  If the aperture went completely off the image (ie there is no
+	overlap of even part of the aperture with the image) a random value
+	was given the aperture sum because the value was not intialize to
+	zero.  It is now initialize to zero.
+    3.  There is now a requirement that more than three points be traced
+	before a trace will be fit.
+
+apextract$trltrace.x
+apextract$trctrace.x
+apextract$apgetdata.x
+    Valdes, January 30, 1987
+    1.  The middle line (default) was not calculated correctly.  
+    2.  The tracing would sometimes run beyond the end of the image.  The
+	value of this traced point is suspect.  It was found because there
+	would be a point off the end of the ICFIT graph which was set to
+	be the size of the image.
+    3.  Just in case a traced point is right at the edge I made the default
+	window for fitting the trace extend half a step beyond the edges
+	of the image.
+
+apextract$exsum.x
+apextract$exstrip.x
+    Valdes, January 30, 1987
+    1.  Skip Schaller (Steward) reported a problem with running out of memory
+	with an input list of 20 images.  Also when the user deleted input
+	images after they were processed but before the list was finished
+	(to reduce memory) the memory was not actually freed until the process
+	actually finished.  I found that the input images
+	where not being closed! (Sorry about this really stupid error.)
+	This may not be all the problem but it is probable since IMIO
+	maintains large buffers.
+
+apextract$apcolon.x
+    Valdes, January 15, 1987
+    1.  Replaced dictionary string and numeric case by macros for readability.
+
+apextract$apfind.par
+    Valdes, December 19, 1986
+    1.  Change the default NFIND parameter in APFIND to auto mode.
+
+apextract$apnearest.x
+    Valdes, December 12, 1986
+    1.  It is possible for more than one aperture to be equidistant from
+	the cursor, particularly when more than one aperture is defined for
+	the same feature.  This is ambiguous for those commands which operate on
+	the nearest aperture.  The modification will query the user if it
+	is found that there is more than one aperture at the same distance
+	from the cursor.
+
+apextract$peaks.x
+    Valdes, October 10, 1986
+    1.  VMS adjustable array dimension error found.  Replaced declaration
+	dimension by ARB since the passed dimension value may be zero.
+
+apextract$*
+    Valdes, September 16, 1986
+    1.  A new version of the package has been installed.  It is very
+	different from the old version.  The user parameter files must
+	be unlearned.
+
+====================
+New Package Released
+====================
+
+apextract$: Valdes, July 19, 1986
+    1.  APEDIT and TRACE modified to include a detection threshold parameter
+	for profile centering.
+    2.  The help pages were updated.
+
+apextract$apedit.x, apvalue.x: Valdes, July 17, 1986
+    1.  A bug was found that appears if you edit the apertures of a
+	previously traced image.  The center moves with use of 'l' or
+	'u'.  This is due to an inconsistency between whether the aperture
+	center is before or after the traced shift is added.  Changes
+	to APVALUE.X and the calls to it in APEDIT.X fix this.
+
+apextract$: Valdes, July 15, 1986
+    1.  TRACE had a bug when trying to specify an explicit starting
+	line to edit and trace from.  This was fixed.
+    2.  EXCEXTRACT.X, EXLEXTRACT.X, and EXGPROFS.X were modified to
+	check for errors from background fitting.  This arose when
+	trying to get the background for a spectrum which has gone
+	off the edge of the image.
+
+apextract$apedit.x, apsort.x : Valdes, July 9, 1986
+    1.  When changing the aperture number the apertures are sorted and
+	then the wrong aperture could become the current aperture if
+	another aperture exists with the same aperture number.  This was
+	fixed so that the sorting returns the correct current aperture
+	after sorting.  Also apindex.x is no longer needed.
+
+apextract$apedit.x: Valdes, July 7, 1986
+    1.  The 'd' delete key now does nothing if no apertures are defined.
+	Previously it would cause a failure of the task.
+
+apextract$apedit.x:  Valdes, July 7, 1986
+    1.  Added redraw and window commands.
+    2.  Help page and '?' menu updated.
+
+apextract$apedit.x:  Valdes, July 3, 1986
+    1.  APEDIT modified to use new ICFIT package.
+
+apextract$apgetim.x:  Valdes, July 1, 1986
+    1.  New procedure to strip the image extension.  This is necessary
+	to create proper database files and to avoid having two legal
+	names for images in the database.
+
+apextract$exapstrip.x:  Valdes, July 1, 1986
+    1.  Simple strip extraction without profile modeling interpolated
+	the data so that the lower edge of the aperture was centered
+	on the first pixel.  This is inconsistent with the other extractions
+	which put the center of the aperture at the center of a pixel.
+	This has been fixed.
+
+apextract:  Valdes, June 30, 1986:
+    1.  TRACE was not correctly initializing the new ICFIT package.
+	In particular the task parameters "function" and "order" had no
+	effect and when multiple files were used the last set parameters
+	were not retained.  Changes to t_trace.x, trctrace.x, trltrace.x.
+
+=====================================
+STScI Pre-release and SUN 2.3 Release
+=====================================
+
+apextract:  Valdes, June 20, 1986:
+    1.  New APEXTRACT installed.  This version includes background
+	subtraction and new ICFIT.
+
+apextract:  Valdes, June 2, 1986
+    1.  Another round of name changes.  EDITAPS -> APEDIT,
+	EXTRACT1 -> SUMEXTRACT, EXTRACT2 -> STRIPEXTRACT.
+
+apextract:  Valdes, May 16, 1986
+    1.  Renamed APDEFINE to EDITAPS.
+    2.  Moved parameters used in editing the apertures from EXTRACT1 and
+	EXTRACT2.  These are now obtained from EDITAPS regardless of which
+	task calls apedit.
+    3.  Added parameters "cradius", "cwidth", "ctype", "lower", and "upper"
+	to EDITAPS.  The first parameters control profile centering and the
+	last parameters set the default aperture limits.
+    1.  Added new keys.  'c' center current aperture of profile near the cursor.
+	'm' mark and center aperture on profile near the cursor.  's' shift
+	the center of the current aperture to the cursor position.  The change
+	allows centering of profiles using CENTER1D.
+
+apextract$extract.x:  Valdes, May 13, 1986
+    1.  EXTRACT has been broken up into two tasks; EXTRACT1 and EXTRACT2.
+	EXTRACT1 extracts weighted summed 1D spectra.  EXTRACT2 extracts
+	2D apertures corrected for shifts across the dispersion.
+
+apextract:  Valdes, April 23, 1986
+    1.  Modified EXTRACT to only warn about an existing output image.
+	This allows adding a new aperture without needing to delete
+	old apertures or reextract previous extractions.
+
+apextract:  Valdes, April 21, 1986
+    1.  All procedures which pass the number of current apertures as an
+	argument and then dimension the array with this number
+	were modified by dimensioning the array as dimension
+	APS_MAXAPS or ARB.  This was done because the number of apertures
+	might be zero.  This is a fatal error on VMS/VAX though not on UNIX/VAX.
+
+apextract:  Valdes, March 27, 1986
+    1.  Modified EXTRACT (exsum.x and exwt.x) to update the dispersion image
+	header parameters.  In particular if the input dispersion axis is 2
+	then the header parameters must be reset to dispersion axis 1.
+
+===========
+Release 2.2
+===========
+.endhelp
diff --git a/noao/twodspec/apextract/apall.par b/noao/twodspec/apextract/apall.par
new file mode 100644
index 00000000..7c97a920
--- /dev/null
+++ b/noao/twodspec/apextract/apall.par
@@ -0,0 +1,96 @@
+# APALL
+
+input,s,a,,,,List of input images
+output,s,h,"",,,List of output spectra
+apertures,s,h,"",,,Apertures
+format,s,h,"multispec","onedspec|multispec|echelle|strip",,Extracted spectra format
+references,s,h,"",,,List of aperture reference images
+profiles,s,h,"",,,"List of aperture profile images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit the traced points interactively?
+extract,b,h,yes,,,Extract spectra?
+extras,b,h,yes,,,"Extract sky, sigma, etc.?"
+review,b,h,yes,,,"Review extractions?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,"Number of dispersion lines to sum or median
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,-5,,,Lower aperture limit relative to center
+upper,r,h,5,,,Upper aperture limit relative to center
+apidtable,s,h,"",,,"Aperture ID table (optional)
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,"chebyshev","chebyshev|legendre|spline1|spline3",,Background function
+b_order,i,h,1,1,,Background function order
+b_sample,s,h,"-10:-6,6:10",,,Background sample regions
+b_naverage,i,h,-3,,,Background average or median
+b_niterate,i,h,0,0,,Background rejection iterations
+b_low_reject,r,h,3.,0.,,Background lower rejection sigma
+b_high_reject,r,h,3.,0.,,Background upper rejection sigma
+b_grow,r,h,0.,0.,,"Background rejection growing radius
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,5.,0.,,Profile centering width
+radius,r,h,10.,,,Profile centering radius
+threshold,r,h,0.,0.,,"Detection threshold for profile centering
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,q,,,,Number of apertures to be found automatically
+minsep,r,h,5.,1.,,Minimum separation between spectra
+maxsep,r,h,100000.,1.,,Maximum separation between spectra
+order,s,h,"increasing","increasing|decreasing",,"Order of apertures
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,"",,,Apertures for recentering calculation
+npeaks,r,h,INDEF,0.,,Select brightest peaks
+shift,b,h,yes,,,"Use average shift instead of recentering?
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,INDEF,,,Lower aperture limit relative to center
+ulimit,r,h,INDEF,,,Upper aperture limit relative to center
+ylevel,r,h,0.1,,,Fraction of peak or intensity for automatic width
+peak,b,h,yes,,,Is ylevel a fraction of the peak?
+bkg,b,h,yes,,,"Subtract background in automatic width?"
+r_grow,r,h,0.,,,"Grow limits by this factor"
+avglimits,b,h,no,,,"Average limits over all apertures?
+
+# TRACING PARAMETERS
+"
+t_nsum,i,h,10,1,,Number of dispersion lines to sum
+t_step,i,h,10,1,,Tracing step
+t_nlost,i,h,3,1,,Number of consecutive times profile is lost before quitting
+t_function,s,h,"legendre","chebyshev|legendre|spline1|spline3",,Trace fitting function
+t_order,i,h,2,1,,Trace fitting function order
+t_sample,s,h,"*",,,Trace sample regions
+t_naverage,i,h,1,,,Trace average or median
+t_niterate,i,h,0,0,,Trace rejection iterations
+t_low_reject,r,h,3.,0.,,Trace lower rejection sigma
+t_high_reject,r,h,3.,0.,,Trace upper rejection sigma
+t_grow,r,h,0.,0.,,"Trace rejection growing radius
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,"none","none|average|median|minimum|fit",,Background to subtract
+skybox,i,h,1,1,,Box car smoothing length for sky
+weights,s,h,"none","none|variance",,Extraction weights (none|variance)
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting type (fit1d|fit2d)
+clean,b,h,no,,,Detect and replace bad pixels?
+saturation,r,h,INDEF,1.,,Saturation level
+readnoise,s,h,"0.",,,Read out noise sigma (photons)
+gain,s,h,"1.",,,Photon gain (photons/data number)
+lsigma,r,h,4,0,,Lower rejection threshold
+usigma,r,h,4,0,,Upper rejection threshold
+nsubaps,i,h,1,1,,Number of subapertures per aperture
diff --git a/noao/twodspec/apextract/apall1.par b/noao/twodspec/apextract/apall1.par
new file mode 100644
index 00000000..12a28b32
--- /dev/null
+++ b/noao/twodspec/apextract/apall1.par
@@ -0,0 +1,117 @@
+# OUTPUT PARAMETERS
+
+apertures,s,h,)apall.apertures,,,>apall.apertures
+format,s,h,)apall.format,,,>apall.format
+extras,b,h,)apall.extras,,,>apall.extras
+dbwrite,s,h,yes,,,Write to database?
+initialize,b,h,yes,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)apall.lower,,,>apall.lower
+upper,r,h,)apall.upper,,,>apall.upper
+apidtable,s,h,)apall.apidtable,,,">apall.apidtable
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)apall.b_function,,,>apall.b_function
+b_order,i,h,)apall.b_order,,,>apall.b_order
+b_sample,s,h,)apall.b_sample,,,>apall.b_sample
+b_naverage,i,h,)apall.b_naverage,,,>apall.b_naverage
+b_niterate,i,h,)apall.b_niterate,,,>apall.b_niterate
+b_low_reject,r,h,)apall.b_low_reject,,,>apall.b_low_reject
+b_high_reject,r,h,)apall.b_high_reject,,,>apall.b_high_reject
+b_grow,r,h,)apall.b_grow,,,">apall.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,)apall.width,,,>apall.width
+radius,r,h,)apall.radius,,,>apall.radius
+threshold,r,h,)apall.threshold,,,">apall.threshold
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,)apall.nfind,,,>apall.nfind
+minsep,r,h,)apall.minsep,,,>apall.minsep
+maxsep,r,h,)apall.maxsep,,,>apall.maxsep
+order,s,h,)apall.order,,,">apall.order
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,)apall.aprecenter,,,>apall.aprecenter
+npeaks,r,h,)apall.npeaks,,,>apall.npeaks
+shift,b,h,)apall.shift,,,">apall.shift
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,)apall.llimit,,,>apall.llimit
+ulimit,r,h,)apall.ulimit,,,>apall.ulimit
+ylevel,r,h,)apall.ylevel,,,>apall.ylevel
+peak,b,h,)apall.peak,,,>apall.peak
+bkg,b,h,)apall.bkg,,,>apall.bkg
+r_grow,r,h,)apall.r_grow,,,>apall.r_grow
+avglimits,b,h,)apall.avglimits,,,">apall.avglimits
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,Profile reference image
+
+# TRACING PARAMETERS
+t_nsum,i,h,)apall.t_nsum,,,>apall.t_nsum
+t_step,i,h,)apall.t_step,,,>apall.t_step
+t_nlost,i,h,)apall.t_nlost,,,>apall.t_nlost
+t_width,r,h,)apall.width,,,>apall.width
+t_function,s,h,)apall.t_function,,,>apall.t_function
+t_order,i,h,)apall.t_order,,,>apall.t_order
+t_sample,s,h,)apall.t_sample,,,>apall.t_sample
+t_naverage,i,h,)apall.t_naverage,,,>apall.t_naverage
+t_niterate,i,h,)apall.t_niterate,,,>apall.t_niterate
+t_low_reject,r,h,)apall.t_low_reject,,,>apall.t_low_reject
+t_high_reject,r,h,)apall.t_high_reject,,,>apall.t_high_reject
+t_grow,r,h,)apall.t_grow,,,">apall.t_grow
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,)apall.background,,,>apall.background
+skybox,i,h,)apall.skybox,,,>apall.skybox
+weights,s,h,)apall.weights,,,>apall.weights
+pfit,s,h,)apall.pfit,,,>apall.pfit
+clean,b,h,)apall.clean,,,>apall.clean
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,)apall.saturation,,,>apall.saturation
+readnoise,s,h,)apall.readnoise,,,>apall.readnoise
+gain,s,h,)apall.gain,,,>apall.gain
+lsigma,r,h,)apall.lsigma,,,>apall.lsigma
+usigma,r,h,)apall.usigma,,,>apall.usigma
+polysep,r,h,0.90,0.1,0.95,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,)apall.nsubaps,,,">apall.nsubaps
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"no",,," "
+ansclobber1,s,h,"no",,," "
+ansdbwrite,s,h,"yes",,," "
+ansdbwrite1,s,h,"yes",,," "
+ansedit,s,h,"yes",,," "
+ansextract,s,h,"yes",,," "
+ansfind,s,h,"yes",,," "
+ansfit,s,h,"yes",,," "
+ansfitscatter,s,h,"yes",,," "
+ansfitsmooth,s,h,"yes",,," "
+ansfitspec,s,h,"yes",,," "
+ansfitspec1,s,h,"yes",,," "
+ansfittrace,s,h,"yes",,," "
+ansfittrace1,s,h,"yes",,," "
+ansflat,s,h,"yes",,," "
+ansnorm,s,h,"yes",,," "
+ansrecenter,s,h,"yes",,," "
+ansresize,s,h,"yes",,," "
+ansreview,s,h,"yes",,," "
+ansreview1,s,h,"yes",,," "
+ansscat,s,h,"yes",,," "
+anssmooth,s,h,"yes",,," "
+anstrace,s,h,"yes",,," "
diff --git a/noao/twodspec/apextract/apalloc.x b/noao/twodspec/apextract/apalloc.x
new file mode 100644
index 00000000..086db650
--- /dev/null
+++ b/noao/twodspec/apextract/apalloc.x
@@ -0,0 +1,34 @@
+include	"apertures.h"
+
+# AP_ALLOC -- Allocate and initialize an aperture structure.
+
+procedure ap_alloc (ap)
+
+pointer	ap		# Aperture
+
+begin
+	call calloc (ap, AP_LEN, TY_STRUCT)
+	AP_TITLE(ap) = NULL
+	AP_CV(ap) = NULL
+	AP_IC(ap) = NULL
+	AP_SELECT(ap) = YES
+end
+
+
+# AP_FREE -- Free an aperture structure and related CURFIT structures.
+
+procedure ap_free (ap)
+
+pointer	ap		# Aperture
+
+begin
+	if (ap != NULL) {
+	    if (AP_TITLE(ap) != NULL)
+		call mfree (AP_TITLE(ap), TY_CHAR)
+	    if (AP_CV(ap) != NULL)
+	        call cvfree (AP_CV(ap))
+	    if (AP_IC(ap) != NULL)
+	        call ic_closer (AP_IC(ap))
+	    call mfree (ap, TY_STRUCT)
+	}
+end
diff --git a/noao/twodspec/apextract/apanswer.x b/noao/twodspec/apextract/apanswer.x
new file mode 100644
index 00000000..0077af4a
--- /dev/null
+++ b/noao/twodspec/apextract/apanswer.x
@@ -0,0 +1,121 @@
+define	ANSWERS	"|no|yes|NO|YES|"
+
+
+# AP_ANSWER -- Prompt the user (if needed) and return bool based
+# on 4-valued response
+
+bool procedure ap_answer (param, prompt)
+
+char	param[ARB]		# Parameter name
+char	prompt[ARB]		# Prompt to be issued
+
+char	word[3]
+int	i, apgwrd()
+pointer	pmode
+
+begin
+	i = apgwrd (param, word, 3, ANSWERS)
+	switch (i) {
+	case 3:
+	    return (false)
+	case 4:
+	    return (true)
+	default:
+	    call malloc (pmode, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[pmode], SZ_LINE, "%s.p_mode")
+		call pargstr (param)
+	    call appstr (Memc[pmode], "q")
+	    repeat {
+	        call eprintf (prompt)
+	        call flush (STDERR)
+		ifnoerr (i = apgwrd (param, word, 3, ANSWERS))
+		    break
+	    }
+	    call appstr (param, word)
+	    call appstr (Memc[pmode], "h")
+	    call mfree (pmode, TY_CHAR)
+	}
+
+	switch (i) {
+	case 1, 3:
+	    return (false)
+	case 2, 4:
+	    return (true)
+	}
+end
+
+
+# APGANSB -- Convert 4-valued parameter to bool
+
+bool procedure apgansb (param)
+
+char	param[ARB]		# Parameter name
+
+char	word[3]
+int	apgwrd()
+
+begin
+	switch (apgwrd (param, word, 3, ANSWERS)) {
+	case 1, 3:
+	    return (false)
+	default:
+	    return (true)
+	}
+end
+
+
+# APGANS -- Convert 4-value parameter to bool except "no" is true.
+
+bool procedure apgans (param)
+
+char	param[ARB]		# Parameter name
+
+char	word[3]
+pointer	pmode
+bool	streq()
+
+begin
+	call malloc (pmode, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[pmode], SZ_LINE, "%s.p_mode")
+	    call pargstr (param)
+	call apgstr (Memc[pmode], word, 3)
+	if (word[1] != 'h')
+	    call appstr (Memc[pmode], "h")
+	call mfree (pmode, TY_CHAR)
+	call apgstr (param, word, 3)
+	return (!streq (word, "NO"))
+end
+
+
+# APPANS -- Put 4-valued parameter based on interactive parameter.
+
+procedure appans (param, ival, nival)
+
+char	param[ARB]		# Parameter
+bool	ival			# Interactive value
+bool	nival			# Noninteractive value
+
+char	word[3]
+pointer	pmode
+bool	clgetb()
+
+begin
+	call malloc (pmode, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[pmode], SZ_LINE, "%s.p_mode")
+	    call pargstr (param)
+	call apgstr (Memc[pmode], word, 3)
+	if (word[1] != 'h')
+	    call appstr (Memc[pmode], "h")
+	call mfree (pmode, TY_CHAR)
+	if (clgetb ("interactive")) {
+	    if (ival)
+		call appstr (param, "yes")
+	    else
+		call appstr (param, "NO")
+	} else {
+	    if (nival)
+		call appstr (param, "YES")
+	    else
+		call appstr (param, "NO")
+	}
+end
diff --git a/noao/twodspec/apextract/apcenter.x b/noao/twodspec/apextract/apcenter.x
new file mode 100644
index 00000000..88f089d1
--- /dev/null
+++ b/noao/twodspec/apextract/apcenter.x
@@ -0,0 +1,26 @@
+include	<pkg/center1d.h>
+
+# AP_CENTER -- Locate the center of an emission profile.  This is done
+# using the CENTER1D algorithm.  The procedure gets the centering
+# parameters using CL queries.  If the center is not found because of the
+# RADIUS or THRESHOLD centering criteria then INDEF is returned.
+
+real procedure ap_center (x, data, npts)
+
+real	x		# Initial guess
+real	data[npts]	# Data
+int	npts		# Number of data points
+
+real	width		# Centering width
+real	radius		# Centering radius
+real	threshold	# Detection threshold
+
+real	apgetr(), center1d()
+
+begin
+	width = apgetr ("width")
+	radius = apgetr ("radius")
+	threshold = apgetr ("threshold")
+
+	return (center1d (x, data, npts, width, EMISSION, radius, threshold))
+end
diff --git a/noao/twodspec/apextract/apcolon.x b/noao/twodspec/apextract/apcolon.x
new file mode 100644
index 00000000..9e910a95
--- /dev/null
+++ b/noao/twodspec/apextract/apcolon.x
@@ -0,0 +1,384 @@
+include	<gset.h>
+include <imhdr.h>
+include	<error.h>
+include	"apertures.h"
+
+# List of colon commands.
+define	CMDS "|show|parameters|database|logfile|plotfile|read|write|image\
+	|line|nsum|center|lower|upper|title\
+	|extras,b|apidtable,s|b_function,s|b_order,i|b_sample,s\
+	|b_naverage,i|b_niterate,i|b_low_reject,r|b_high_reject,r|b_grow,r\
+	|minsep,r|maxsep,r|order,s|apertures,s|npeaks,r|shift,b|llimit,r\
+	|ulimit,r|ylevel,r|peak,b|bkg,b|r_grow,r|avglimits,b|width,r|radius,r\
+	|threshold,r|t_nsum,i|t_step,i|t_width,r|t_function,s|t_order,i\
+	|t_sample,s|t_naverage,i|t_niterate,i|t_low_reject,r|t_high_reject,r\
+	|t_grow,r|nsubaps,i|background,s|skybox,i|clean,b|saturation,r\
+	|weights,s|readnoise,s|gain,s|lsigma,r|usigma,r|t_nlost,i|"
+
+define	SHOW		1	# Show apertures
+define	PARAMS		2	# Show parameters
+define	DATABASE	3	# Database
+define	LOGFILE		4	# Logfile
+define	PLOTFILE	5	# Plotfile
+define	READ		6	# Read aperture database entry
+define	WRITE		7	# Write aperture database entry
+define	IMAGE		8	# Image being edited
+define	LINE		9	# Set image line to display
+define	NSUM		10	# Set number of image lines to sum for display
+define	CENTER		11	# Set aperture center
+define	LOWER		12	# Set aperture lower limit
+define	UPPER		13	# Set aperture upper limit
+define	APTITLE		14	# Set aperture title
+
+
+# AP_COLON -- Process colon commands.  The colon commands may be abbreviated.
+# Optional arguments determine either the output or the value of a parameter.
+# Changes are signaled to the calling task with the flags NEWGRAPH, NEWIM,
+# and NEWDATA.  This task does CLIO including CLCMDW commands.
+
+procedure ap_colon (cmd, im, gp, apdef, aps, naps, current, image, line,
+    nsum, all, newgraph, newim, newdata, statline)
+
+char	cmd[ARB]		# Colon command
+pointer	im			# IMIO pointer
+pointer	gp			# GIO pointer
+pointer	apdef			# Default aperture
+pointer	aps			# Aperture pointers
+int	naps			# Number of apertures
+int	current			# Current aperture
+char	image[SZ_FNAME]		# Image name
+int	line			# Dispersion line
+int	nsum			# Number of lines to sum
+int	all			# All switch
+int	newgraph		# New graph flag
+int	newim			# New image flag
+int	newdata			# New data flag
+int	statline		# Status line used?
+
+bool	bval
+int	i, j, ival, apid, apbeam
+real	center, low, high, rval
+pointer	sp, wrd, str
+
+bool	strne(), apgetb()
+real	apgetr()
+int	nscan(), strdic(), imaccess(), apgeti(), stridxs()
+errchk	ap_apertures, ap_show, ap_params, ap_dbread, ap_dbwrite, ap_openio
+
+define	done_	99
+
+begin
+	call smark (sp)
+	call salloc (wrd, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Scan the command string for the first word which may be abbreviated.
+	call sscan (cmd)
+	call gargwrd (Memc[wrd], SZ_LINE)
+	i = strdic (Memc[wrd], Memc[wrd], SZ_LINE, CMDS)
+	if (i == 0) {
+	    call printf ("Unrecognized or ambiguous command\007")
+	    statline = YES
+	    call sfree (sp)
+	    return
+	}
+	j = stridxs (",", Memc[wrd])
+
+	if (j == 0) {
+	    switch (i) {
+	    case SHOW:	# :show - Show aperture list
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1) {
+		    call gdeactivate (gp, AW_CLEAR)
+	            call ap_show ("STDOUT", Memi[aps], naps)
+		    call greactivate (gp, AW_PAUSE)
+	        } else {
+		    iferr (call ap_show (cmd, Memi[aps], naps)) {
+		        call erract (EA_WARN)
+			statline = YES
+		    }
+	        }
+	    case PARAMS: # :parameters - Show parameters
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1) {
+		    call mktemp ("junk", cmd, SZ_LINE) 
+	            iferr (call ap_params (cmd, image, line, nsum)) {
+		        call gdeactivate (gp, AW_CLEAR)
+	                call ap_params ("STDOUT", image, line, nsum)
+		        call greactivate (gp, AW_PAUSE)
+		    } else {
+		        call gpagefile (gp, cmd, ":parameters")
+		        call delete (cmd)
+		    }
+	        } else {
+		    iferr (call ap_params (cmd, image, line, nsum)) {
+		        call erract (EA_WARN)
+			statline = YES
+		    }
+	        }
+	    case DATABASE: # :database - Database name
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1) {
+		    call clgstr ("database", cmd, SZ_LINE)
+		    call printf ("database %s")
+		        call pargstr (cmd)
+		    statline = YES
+	        } else
+		    call clpstr ("database", cmd)
+	    case LOGFILE: # :logfile - Logfile name
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1) {
+		    call clgstr ("logfile", cmd, SZ_LINE)
+		    call printf ("logfile %s")
+		        call pargstr (cmd)
+		    statline = YES
+	        } else
+		    call clpstr ("logfile", cmd)
+	    case PLOTFILE: # :plotfile - Plotfile name
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1) {
+		    call clgstr ("plotfile", cmd, SZ_LINE)
+		    call printf ("plotfile %s")
+		        call pargstr (cmd)
+		    statline = YES
+	        } else
+		    call clpstr ("plotfile", cmd)
+	    case READ: # :read - Read database entry
+	        iferr {
+	            call gargwrd (cmd, SZ_LINE)
+	            if (nscan() == 1)
+		        call ap_dbread (image, aps, naps)
+	            else {
+		        call xt_stripwhite (cmd)
+		        if (cmd[1] == EOS)
+		            call ap_dbread (image, aps, naps)
+		        else {
+		            call ap_dbread (cmd, aps, naps)
+			    call appstr ("ansdbwrite1", "yes")
+		        }
+		    }
+	        } then {
+		    call erract (EA_WARN)
+		    statline = YES
+		}
+		current = min (1, naps)
+	        newgraph = YES
+	    case WRITE: # :write - Write database entry
+	        iferr {
+	            call gargwrd (cmd, SZ_LINE)
+	            if (nscan() == 1)
+		        call ap_dbwrite (image, aps, naps)
+	            else {
+		        call xt_stripwhite (cmd)
+		        if (cmd[1] == EOS)
+		            call ap_dbwrite (image, aps, naps)
+		        else {
+		            call ap_dbwrite (cmd, aps, naps)
+			    call appstr ("ansdbwrite1", "yes")
+		        }
+		    }
+	        } then {
+		    call erract (EA_WARN)
+		    statline = YES
+		}
+	    case IMAGE: # :image - Define a new image
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1) {
+		    call printf ("image %s")
+		        call pargstr (image)
+		    statline = YES
+	        } else {
+		    call xt_stripwhite (cmd)
+		    if ((cmd[1] != EOS) && (strne (cmd, image))) {
+		        if (imaccess (cmd, READ_ONLY) == YES)
+		            newim = YES
+		        else {
+			    call eprintf (
+			        "WARNING: Can't read image %s")
+			        call pargstr (cmd)
+			    statline = YES
+		        }
+		    }
+	        }
+	    case LINE: # :line - Image line or column
+	        call gargi (ival)
+	        if (nscan() < 2) {
+		    call printf ("line %d")
+		        call pargi (line)
+		    statline = YES
+	        } else if (ival != line) {
+		    call strcpy (image, cmd, SZ_LINE)
+		    line = ival
+		    newdata = YES
+	        }
+	    case NSUM: # :nsum - Number of image lines or columns to sum
+	        call gargi (ival)
+	        if (nscan() < 2) {
+		    call printf ("nsum %d")
+		        call pargi (nsum)
+		    statline = YES
+	        } else if (ival != nsum) {
+		    call strcpy (image, cmd, SZ_LINE)
+		    nsum = ival
+		    newdata = YES
+	        }
+	    case CENTER: # :center - Set aperture center
+	        if (current == 0)
+		    goto done_
+	        call gargr (rval)
+	        if (nscan() == 1) {
+	            call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    call printf ("center %g")
+		        call pargr (center)
+		    statline = YES
+	        } else if (all == NO) {
+	            call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    iferr (call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, rval, low, high)) {
+			call erract (EA_WARN)
+			statline = YES
+		    }
+	        } else {
+	            call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    rval = rval - center
+		    do i = 1, naps {
+			call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+			center = center + rval
+			iferr (call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center, low, high)) {
+			    call erract (EA_WARN)
+			    statline = YES
+			}
+		    }
+	        }
+	    case LOWER: # :lower - Set lower aperture limit
+	        if (current == 0)
+		    goto done_
+	        call gargr (rval)
+	        if (nscan() == 1) {
+	            call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    call printf ("low %g")
+		        call pargr (low)
+		    statline = YES
+	        } else if (all == NO) {
+		    call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    iferr (call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, center, rval, high)) {
+			call erract (EA_WARN)
+			statline = YES
+		    }
+	        } else {
+		    do i = 1, naps {
+		        call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+		        iferr (call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center, rval, high))
+			    call erract (EA_WARN) {
+			    statline = YES
+			}
+		    }
+	        }
+	    case UPPER: # :upper - Set upper aperture limit
+	        if (current == 0)
+		    goto done_
+	        call gargr (rval)
+	        if (nscan() == 1) {
+	            call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    call printf ("high %g")
+		        call pargr (high)
+		    statline = YES
+	        } else if (all == NO) {
+		    call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    iferr (call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, center, low, rval)) {
+			call erract (EA_WARN)
+			statline = YES
+		    }
+	        } else {
+		    do i = 1, naps {
+		        call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+		        iferr (call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center, low, rval)) {
+			    call erract (EA_WARN)
+			    statline = YES
+			}
+		    }
+	        }
+	    case APTITLE:
+	        if (current == 0)
+		    goto done_
+	        call gargwrd (Memc[wrd], SZ_LINE)
+	        if (nscan() == 1) {
+		    call printf ("title %s")
+		        if (AP_TITLE(Memi[aps+current-1]) != NULL)
+			    call pargstr (Memc[AP_TITLE(Memi[aps+current-1])])
+		        else
+			    call pargstr ("[NONE]")
+		    statline = YES
+	        } else {
+		    call reset_scan ()
+		    call gargwrd (Memc[str], SZ_LINE)
+		    call gargstr (Memc[str], SZ_LINE)
+		    if (AP_TITLE(Memi[aps+current-1]) == NULL)
+		        call malloc (AP_TITLE(Memi[aps+current-1]), SZ_APTITLE,
+			    TY_CHAR)
+		    call strcpy (Memc[str+1],
+			Memc[AP_TITLE(Memi[aps+current-1])], SZ_APTITLE)
+	        }
+	    }
+
+	} else {
+	    Memc[wrd+j-1] = EOS
+	    switch (Memc[wrd+j]) {
+	    case 'b':
+	        call gargb (bval)
+	        if (nscan() < 2) {
+		    call printf ("%s %b")
+			call pargstr (Memc[wrd])
+		        call pargb (apgetb (Memc[wrd]))
+		    statline = YES
+	        } else
+	            call apputb (Memc[wrd], bval)
+	    case 'i':
+	        call gargi (ival)
+	        if (nscan() < 2) {
+		    call printf ("%s %d")
+			call pargstr (Memc[wrd])
+		        call pargi (apgeti (Memc[wrd]))
+		    statline = YES
+	        } else
+	            call apputi (Memc[wrd], ival)
+	    case 'r':
+	        call gargr (rval)
+	        if (nscan() < 2) {
+		    call printf ("%s %g")
+			call pargstr (Memc[wrd])
+		        call pargr (apgetr (Memc[wrd]))
+		    statline = YES
+	        } else
+	            call apputr (Memc[wrd], rval)
+	    case 's':
+	        call gargwrd (Memc[str], SZ_LINE)
+	        if (nscan() < 2) {
+		    call apgstr (Memc[wrd], Memc[str], SZ_LINE)
+		    call printf ("%s %s")
+			call pargstr (Memc[wrd])
+		        call pargstr (Memc[str])
+		    statline = YES
+	        } else
+	            call appstr (Memc[wrd], Memc[str])
+	    }
+	}
+
+done_	call sfree (sp)
+
+end
diff --git a/noao/twodspec/apextract/apcopy.x b/noao/twodspec/apextract/apcopy.x
new file mode 100644
index 00000000..e697bf88
--- /dev/null
+++ b/noao/twodspec/apextract/apcopy.x
@@ -0,0 +1,28 @@
+include	"apertures.h"
+
+# AP_COPY -- Make a copy of an aperture.
+# The title is not copied.
+
+procedure ap_copy (apin, apout)
+
+pointer	apin		# Aperture to copy
+pointer	apout		# New copy
+
+int	i
+
+begin
+	# Allocate memory, transfer the aperture parameters, and call procedures
+	# which copy the offset curve and background parameters.
+	call ap_alloc (apout)
+	AP_ID(apout) = AP_ID(apin)
+	AP_BEAM(apout) = AP_BEAM(apin)
+	AP_AXIS(apout) = AP_AXIS(apin)
+	do i = 1, 2 {
+	    AP_CEN(apout, i) = AP_CEN(apin, i)
+	    AP_LOW(apout, i) = AP_LOW(apin, i)
+	    AP_HIGH(apout, i) = AP_HIGH(apin, i)
+	}
+	call ap_cvset (apin, apout)
+	call ic_open (AP_IC(apout))
+	call ic_copy (AP_IC(apin), AP_IC(apout))
+end
diff --git a/noao/twodspec/apextract/apcveval.x b/noao/twodspec/apextract/apcveval.x
new file mode 100644
index 00000000..09e5beb5
--- /dev/null
+++ b/noao/twodspec/apextract/apcveval.x
@@ -0,0 +1,19 @@
+include	<math/curfit.h>
+
+# AP_CVEVAL -- Interface to CVEVAL that avoids extrapolation.
+# This is necessary because if the tracing was truncated due to loss
+# of the profile the trace limits will be smaller than the image axis.
+# In the longer term the aperture limits along the dispersion should be
+# used to limit the extent of the spectrum.
+
+real procedure ap_cveval (cv, x)
+
+pointer	cv		#I CURFIT pointer
+real	x		#I Point to be evaluated.
+
+real	x1, cvstatr(), cveval()
+
+begin
+	x1 = min (max (x, cvstatr(cv,CVXMIN)), cvstatr(cv,CVXMAX))
+	return (cveval (cv, x1))
+end
diff --git a/noao/twodspec/apextract/apcvset.x b/noao/twodspec/apextract/apcvset.x
new file mode 100644
index 00000000..656187d5
--- /dev/null
+++ b/noao/twodspec/apextract/apcvset.x
@@ -0,0 +1,47 @@
+include	<math/curfit.h>
+include	"apertures.h"
+
+# AP_CVSET -- Set the trace curve.
+# If the input template aperture is NULL then the output trace curve
+# is set to a constant zero otherwise a copy from the input template
+# aperture is made.
+
+procedure ap_cvset (apin, apout)
+
+pointer	apin		# Input template aperture
+pointer	apout		# Output aperture
+
+int	apaxis, dispaxis, ncoeffs
+real	a, b, c[1]
+pointer	sp, coeffs
+
+int	cvstati()
+
+begin
+	if (AP_CV(apout) != NULL)
+	    call cvfree (AP_CV(apout))
+
+	if (apin == NULL) {
+	    # Determine the aperture and alternate axes.
+	    apaxis = AP_AXIS(apout)
+	    dispaxis = mod (apaxis, 2) + 1
+
+	    # Determine the limits over which the curve is defined.
+	    a = AP_CEN(apout, dispaxis) + AP_LOW(apout, dispaxis)
+	    b = AP_CEN(apout, dispaxis) + AP_HIGH(apout, dispaxis)
+	    if (a == b)
+		b = b + 1
+
+	    # Set the curve to a legendre polynomial of order 1 and value 0.
+	    c[1] = 0.
+	    call cvset (AP_CV(apout), LEGENDRE, a, b, c, 1)
+	} else {
+	    # Use a SAVE and RESTORE to copy the CURFIT data.
+	    call smark (sp)
+	    ncoeffs = cvstati (AP_CV(apin), CVNSAVE)
+	    call salloc (coeffs, ncoeffs, TY_REAL)
+	    call cvsave (AP_CV(apin), Memr[coeffs])
+	    call cvrestore (AP_CV(apout), Memr[coeffs])
+	    call sfree (sp)
+	}
+end
diff --git a/noao/twodspec/apextract/apdb.x b/noao/twodspec/apextract/apdb.x
new file mode 100644
index 00000000..8bfb5244
--- /dev/null
+++ b/noao/twodspec/apextract/apdb.x
@@ -0,0 +1,314 @@
+include	<math/curfit.h>
+include	<pkg/dttext.h>
+include	"apertures.h"
+
+# AP_DBWRITE -- Write aperture data to the database.  The database is obtained
+# with a CL query.
+
+procedure ap_dbwrite (image, aps, naps)
+
+char	image[ARB]		# Image
+pointer	aps			# Apertures
+int	naps
+
+int	i, j, ncoeffs
+pointer	sp, database, str, dt, coeffs, ap
+
+int	cvstati(), ic_geti()
+real	ic_getr()
+bool	strne()
+pointer	dtmap1()
+
+errchk	dtmap1
+
+begin
+	# Set the aperture database file name and map as a NEW_FILE.
+	# The file name is "ap" appended with the image name with the
+	# special image section characters replaced by '_'.
+	# The reason for making image sections separate database
+	# files rather than combining all database entries for an image
+	# in one file is that then previous entries can be deleted
+	# by using NEW_FILE mode which deletes any existing database
+	# file before writing out the new apertures.
+
+	call smark (sp)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	call clgstr ("database", Memc[database], SZ_FNAME)
+	if ((Memc[database] == EOS) || (image[1] == EOS)) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Map the database file name replacing special characters with '_'.
+	call sprintf (Memc[str], SZ_LINE, "ap%s")
+	    call pargstr (image)
+	for (i=str; Memc[i] != EOS; i = i + 1)
+	    switch (Memc[i]) {
+	    case '[', ':', ',',']','*',' ', '/':
+		Memc[i] = '_'
+	    }
+	dt = dtmap1 (Memc[database], Memc[str], NEW_FILE)
+
+	# Write aperture entries for all apertures.
+	for (j = 0; j < naps; j = j + 1) {
+	    ap = Memi[aps+j]
+
+	    call dtptime (dt)
+	    call dtput (dt, "begin\taperture %s %d %g %g\n")
+	        call pargstr (image)
+		call pargi (AP_ID(ap))
+	        call pargr (AP_CEN(ap, 1))
+	        call pargr (AP_CEN(ap, 2))
+	    if (AP_TITLE(ap) != NULL) {
+	        call dtput (dt, "\ttitle\t%s\n")
+		    call pargstr (Memc[AP_TITLE(ap)])
+	    }
+	    call dtput (dt, "\timage\t%s\n")
+	        call pargstr (image)
+	    call dtput (dt, "\taperture\t%d\n")
+	        call pargi (AP_ID(ap))
+	    call dtput (dt, "\tbeam\t%d\n")
+	        call pargi (AP_BEAM(ap))
+	    call dtput (dt, "\tcenter\t%g %g\n")
+	        call pargr (AP_CEN(ap, 1))
+	        call pargr (AP_CEN(ap, 2))
+	    call dtput (dt, "\tlow\t%g %g\n")
+	        call pargr (AP_LOW(ap, 1))
+	        call pargr (AP_LOW(ap, 2))
+	    call dtput (dt, "\thigh\t%g %g\n")
+	        call pargr (AP_HIGH(ap, 1))
+	        call pargr (AP_HIGH(ap, 2))
+	    if (AP_IC(ap) != NULL) {
+		call dtput (dt, "\tbackground\n")
+		call dtput (dt, "\t\txmin %g\n")
+		    call pargr (ic_getr (AP_IC(ap), "xmin"))
+		call dtput (dt, "\t\txmax %g\n")
+		    call pargr (ic_getr (AP_IC(ap), "xmax"))
+		call dtput (dt, "\t\tfunction %s\n")
+		    call ic_gstr (AP_IC(ap), "function", Memc[str], SZ_LINE)
+		    call pargstr (Memc[str])
+		call dtput (dt, "\t\torder %d\n")
+		    call pargi (ic_geti (AP_IC(ap), "order"))
+		call dtput (dt, "\t\tsample %s\n")
+		    call ic_gstr (AP_IC(ap), "sample", Memc[str], SZ_LINE)
+		    call pargstr (Memc[str])
+		call dtput (dt, "\t\tnaverage %d\n")
+		    call  pargi (ic_geti (AP_IC(ap), "naverage"))
+		call dtput (dt, "\t\tniterate %d\n")
+		    call  pargi (ic_geti (AP_IC(ap), "niterate"))
+		call dtput (dt, "\t\tlow_reject %g\n")
+		    call  pargr (ic_getr (AP_IC(ap), "low"))
+		call dtput (dt, "\t\thigh_reject %g\n")
+		    call  pargr (ic_getr (AP_IC(ap), "high"))
+		call dtput (dt, "\t\tgrow %g\n")
+		    call  pargr (ic_getr (AP_IC(ap), "grow"))
+	    }
+
+	    # Write out the curve.
+	    call dtput (dt, "\taxis\t%d\n")
+	        call pargi (AP_AXIS(ap))
+	    ncoeffs = cvstati (AP_CV(ap), CVNSAVE)
+	    call malloc (coeffs, ncoeffs, TY_REAL)
+	    call cvsave (AP_CV(ap), Memr[coeffs])
+	    call dtput (dt, "\tcurve\t%d\n")
+	        call pargi (ncoeffs)
+	    do i = 1, ncoeffs {
+	        call dtput (dt, "\t\t%g\n")
+		    call pargr (Memr[coeffs+i-1])
+	    }
+	    call mfree (coeffs, TY_REAL)
+
+	    call dtput (dt, "\n")
+	}
+	call dtunmap (dt)
+
+	# Log the write operation unless the output file is "last".
+	if (strne (image, "last")) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"DATABASE - %d apertures for %s written to %s")
+	        call pargi (naps)
+	        call pargstr (image)
+	        call pargstr (Memc[database])
+	    call ap_log (Memc[str], YES, YES, NO)
+	    call appstr ("ansdbwrite1", "no")
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_DBREAD - Get aperture information from the database.
+# If no apertures are found then the input apertures are unchanged.
+# The database is obtained with a CL query.
+
+procedure ap_dbread (image, aps, naps)
+
+char	image[ARB]		# Image
+pointer	aps			# Apertures
+int	naps			# Number of apertures
+
+int	i, j, n, ncoeffs
+pointer	sp, database, str, ap, dt, coeffs
+
+bool	strne()
+int	dtgeti()
+real	dtgetr()
+pointer	dtmap1()
+
+errchk	dtmap1
+
+begin
+	# Return if the database or image are undefined.
+	call smark (sp)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call clgstr ("database", Memc[database], SZ_FNAME)
+
+	if ((Memc[database] == EOS) || (image[1] == EOS)) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Set the aperture database file name and map it.
+	# The file name is "ap" appended with the image name with the
+	# special image section characters replaced by '_'.
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[str], SZ_LINE, "ap%s")
+	    call pargstr (image)
+	for (i=str; Memc[i] != EOS; i = i + 1)
+	    switch (Memc[i]) {
+	    case '[', ':', ',',']','*',' ', '/':
+		Memc[i] = '_'
+	    }
+
+	# If an error occurs return the error.
+	dt = dtmap1 (Memc[database], Memc[str], READ_ONLY)
+
+	# Read through the database finding records matching the input image.
+	n = naps
+	naps = 0
+	do i = 1, DT_NRECS(dt) {
+
+	    call dtgstr (dt, i, "image", Memc[str], SZ_LINE)
+	    if (strne (Memc[str], image))
+		next
+
+	    # If an aperture is found delete any input apertures.
+	    if (naps == 0)
+		for (j = 0; j < n; j = j + 1)
+		    call ap_free (Memi[aps+j])
+
+	    if (mod (naps, 100) == 0)
+		call realloc (aps, naps+100, TY_POINTER)
+
+	    call ap_alloc (ap)
+	    ifnoerr (call dtgstr (dt, i, "title", Memc[str], SZ_LINE)) {
+		call malloc (AP_TITLE(ap), SZ_APTITLE, TY_CHAR)
+		call strcpy (Memc[str], Memc[AP_TITLE(ap)], SZ_APTITLE)
+	    }
+	    AP_ID(ap) = dtgeti (dt, i, "aperture")
+	    iferr (AP_BEAM(ap) = dtgeti (dt, i, "beam"))
+		AP_BEAM(ap) = AP_ID(ap)
+	    call dtgstr (dt, i, "center", Memc[str], SZ_LINE)
+	    call sscan (Memc[str])
+	    call gargr (AP_CEN(ap, 1))
+	    call gargr (AP_CEN(ap, 2))
+	    call dtgstr (dt, i, "low", Memc[str], SZ_LINE)
+	    call sscan (Memc[str])
+	    call gargr (AP_LOW(ap, 1))
+	    call gargr (AP_LOW(ap, 2))
+	    call dtgstr (dt, i, "high", Memc[str], SZ_LINE)
+	    call sscan (Memc[str])
+	    call gargr (AP_HIGH(ap, 1))
+	    call gargr (AP_HIGH(ap, 2))
+	    ifnoerr (call dtgstr (dt, i, "background", Memc[str], SZ_LINE)) {
+		call ic_open (AP_IC(ap))
+		call ic_putr (AP_IC(ap), "xmin", dtgetr (dt, i, "xmin"))
+		call ic_putr (AP_IC(ap), "xmax", dtgetr (dt, i, "xmax"))
+		call dtgstr (dt, i, "function", Memc[str], SZ_LINE)
+		call ic_pstr (AP_IC(ap), "function", Memc[str])
+		call ic_puti (AP_IC(ap), "order", dtgeti (dt, i, "order"))
+		call dtgstr (dt, i, "sample", Memc[str], SZ_LINE)
+		call ic_pstr (AP_IC(ap), "sample", Memc[str])
+		call ic_puti (AP_IC(ap), "naverage", dtgeti (dt, i, "naverage"))
+		call ic_puti (AP_IC(ap), "niterate", dtgeti (dt, i, "niterate"))
+		call ic_putr (AP_IC(ap), "low", dtgetr (dt, i, "low_reject"))
+		call ic_putr (AP_IC(ap), "high", dtgetr (dt, i, "high_reject"))
+		call ic_putr (AP_IC(ap), "grow", dtgetr (dt, i, "grow"))
+	    }
+
+	    AP_AXIS(ap) = dtgeti (dt, i, "axis")
+	    ncoeffs = dtgeti (dt, i, "curve")
+	    call malloc (coeffs, ncoeffs, TY_REAL)
+	    call dtgar (dt, i, "curve", Memr[coeffs], ncoeffs, ncoeffs)
+	    call cvrestore (AP_CV(ap), Memr[coeffs])
+	    call mfree (coeffs, TY_REAL)
+
+	    Memi[aps+naps] = ap
+	    naps = naps + 1
+	}
+	call dtunmap (dt)
+
+	# Log the read operation.
+	call sprintf (Memc[str], SZ_LINE,
+	    "DATABASE  - %d apertures read for %s from %s")
+	    call pargi (naps)
+	    call pargstr (image)
+	    call pargstr (Memc[database])
+	call ap_log (Memc[str], YES, YES, NO)
+
+	# If no apertures were found then reset the number to the input value.
+	if (naps == 0)
+	    naps = n
+	else
+	    call appstr ("ansdbwrite1", "no")
+
+	call sfree (sp)
+end
+
+
+# AP_DBACCESS - Check if a database file can be accessed.
+# This does not check the contents of the file.
+# The database is obtained with a CL query.
+
+int procedure ap_dbaccess (image)
+
+char	image[ARB]		# Image
+int	access			# Database file access?
+
+int	i
+pointer	sp, database, str, dt
+pointer	dtmap1()
+errchk	dtmap1
+
+begin
+	call smark (sp)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call clgstr ("database", Memc[database], SZ_FNAME)
+
+	if ((Memc[database] != EOS) && (image[1] != EOS)) {
+	    # Set the aperture database file name and map it.
+	    # The file name is "ap" appended with the image name with the
+	    # special image section characters replaced by '_'.
+	    call salloc (str, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[str], SZ_LINE, "ap%s")
+		call pargstr (image)
+	    for (i=str; Memc[i] != EOS; i = i + 1)
+		switch (Memc[i]) {
+		case '[', ':', ',',']','*',' ', '/':
+		    Memc[i] = '_'
+		}
+
+	    iferr {
+		dt = dtmap1 (Memc[database], Memc[str], READ_ONLY)
+		call dtunmap (dt)
+		access = YES
+	    } then
+		access = NO
+	} else
+	    access = NO
+
+	call sfree (sp)
+	return (access)
+end
diff --git a/noao/twodspec/apextract/apdebug.par b/noao/twodspec/apextract/apdebug.par
new file mode 100644
index 00000000..6b9fc8f9
--- /dev/null
+++ b/noao/twodspec/apextract/apdebug.par
@@ -0,0 +1,156 @@
+dispaxis = 2
+database = "database"
+verbose = yes
+logfile = "logfile"
+plotfile = " "
+
+apall1.input = 
+apall1.nfind = 
+apall1.output = ""
+apall1.apertures = ""
+apall1.format = "multispec"
+apall1.references = ""
+apall1.profiles = ""
+apall1.interactive = yes
+apall1.find = yes
+apall1.recenter = no
+apall1.resize = no
+apall1.edit = yes
+apall1.trace = yes
+apall1.fittrace = no
+apall1.extract = yes
+apall1.extras = yes
+apall1.review = no
+apall1.line = INDEF
+apall1.nsum = 10
+apall1.lower = -5.
+apall1.upper = 5.
+apall1.apidtable = ""
+apall1.b_function = "chebyshev"
+apall1.b_order = 1
+apall1.b_sample = "-10:-6,6:10"
+apall1.b_naverage = -3
+apall1.b_niterate = 0
+apall1.b_low_reject = 3.
+apall1.b_high_reject = 3.
+apall1.b_grow = 0.
+apall1.width = 5.
+apall1.radius = 10.
+apall1.threshold = 0.
+apall1.minsep = 5.
+apall1.maxsep = 1000.
+apall1.order = "increasing"
+apall1.aprecenter = ""
+apall1.npeaks = INDEF
+apall1.shift = yes
+apall1.llimit = INDEF
+apall1.ulimit = INDEF
+apall1.ylevel = 0.1
+apall1.peak = yes
+apall1.bkg = yes
+apall1.r_grow = 0.
+apall1.avglimits = no
+apall1.t_nsum = 10
+apall1.t_step = 10
+apall1.t_width = 5.
+apall1.t_nlost = 3
+apall1.t_function = "legendre"
+apall1.t_order = 2
+apall1.t_sample = "*"
+apall1.t_naverage = 1
+apall1.t_niterate = 0
+apall1.t_low_reject = 3.
+apall1.t_high_reject = 3.
+apall1.t_grow = 0.
+apall1.background = "none"
+apall1.skybox = 1
+apall1.weights = "none"
+apall1.pfit = "fit1d"
+apall1.clean = no
+apall1.saturation = INDEF
+apall1.readnoise = "0."
+apall1.gain = "1."
+apall1.lsigma = 4.
+apall1.usigma = 4.
+apall1.nsubaps = 1
+
+apall1.e_output = 
+apall1.e_profiles = 
+apall1.dbwrite = "yes"
+apall1.initialize = yes
+apall1.nclean = 0.5
+apall1.niterate = 5
+apall1.polysep = 0.90
+apall1.polyorder = 10
+
+apall1.ansclobber = "no"
+apall1.ansclobber1 = "no"
+apall1.ansdbwrite = "yes"
+apall1.ansdbwrite1 = "yes"
+apall1.ansedit = "yes"
+apall1.ansextract = "yes"
+apall1.ansfind = "yes"
+apall1.ansfit = "yes"
+apall1.ansfitscatter = "yes"
+apall1.ansfitsmooth = "yes"
+apall1.ansfitspec = "yes"
+apall1.ansfitspec1 = "yes"
+apall1.ansfittrace = "yes"
+apall1.ansfittrace1 = "yes"
+apall1.ansflat = "yes"
+apall1.ansnorm = "yes"
+apall1.ansrecenter = "yes"
+apall1.ansresize = "yes"
+apall1.ansreview = "yes"
+apall1.ansreview1 = "yes"
+apall1.ansscat = "yes"
+apall1.anssmooth = "yes"
+apall1.anstrace = "yes"
+
+apall1.ansclobber.p_mode = "h"
+apall1.ansclobber1.p_mode = "h"
+apall1.ansdbwrite.p_mode = "h"
+apall1.ansdbwrite1.p_mode = "h"
+apall1.ansedit.p_mode = "h"
+apall1.ansextract.p_mode = "h"
+apall1.ansfind.p_mode = "h"
+apall1.ansfit.p_mode = "h"
+apall1.ansfitscatter.p_mode = "h"
+apall1.ansfitsmooth.p_mode = "h"
+apall1.ansfitspec.p_mode = "h"
+apall1.ansfitspec1.p_mode = "h"
+apall1.ansfittrace.p_mode = "h"
+apall1.ansfittrace1.p_mode = "h"
+apall1.ansflat.p_mode = "h"
+apall1.ansnorm.p_mode = "h"
+apall1.ansrecenter.p_mode = "h"
+apall1.ansresize.p_mode = "h"
+apall1.ansreview.p_mode = "h"
+apall1.ansreview1.p_mode = "h"
+apall1.ansscat.p_mode = "h"
+apall1.anssmooth.p_mode = "h"
+apall1.anstrace.p_mode = "h"
+
+apall1.ansclobber.p_prompt = "h"
+apall1.ansclobber1.p_prompt = "h"
+apall1.ansdbwrite.p_prompt = "h"
+apall1.ansdbwrite1.p_prompt = "h"
+apall1.ansedit.p_prompt = "h"
+apall1.ansextract.p_prompt = "h"
+apall1.ansfind.p_prompt = "h"
+apall1.ansfit.p_prompt = "h"
+apall1.ansfitscatter.p_prompt = "h"
+apall1.ansfitsmooth.p_prompt = "h"
+apall1.ansfitspec.p_prompt = "h"
+apall1.ansfitspec1.p_prompt = "h"
+apall1.ansfittrace.p_prompt = "h"
+apall1.ansfittrace1.p_prompt = "h"
+apall1.ansflat.p_prompt = "h"
+apall1.ansnorm.p_prompt = "h"
+apall1.ansrecenter.p_prompt = "h"
+apall1.ansresize.p_prompt = "h"
+apall1.ansreview.p_prompt = "h"
+apall1.ansreview1.p_prompt = "h"
+apall1.ansscat.p_prompt = "h"
+apall1.anssmooth.p_prompt = "h"
+apall1.anstrace.p_prompt = "h"
diff --git a/noao/twodspec/apextract/apdefault.par b/noao/twodspec/apextract/apdefault.par
new file mode 100644
index 00000000..7868197c
--- /dev/null
+++ b/noao/twodspec/apextract/apdefault.par
@@ -0,0 +1,14 @@
+# APDEFAULT
+
+lower,r,h,-5.,,,Lower aperture limit relative to center
+upper,r,h,5.,,,Upper aperture limit relative to center
+apidtable,s,h,"",,,"Aperture ID table
+"
+b_function,s,h,"chebyshev","chebyshev|legendre|spline1|spline3",,Background function
+b_order,i,h,1,1,,Background function order
+b_sample,s,h,"-10:-6,6:10",,,Background sample regions
+b_naverage,i,h,-3,,,Background average or median
+b_niterate,i,h,0,0,,Background rejection iterations
+b_low_reject,r,h,3.,0.,,Background lower rejection sigma
+b_high_reject,r,h,3.,0.,,Background upper rejection sigma
+b_grow,r,h,0.,0.,,Background rejection growing radius
diff --git a/noao/twodspec/apextract/apdefault.x b/noao/twodspec/apextract/apdefault.x
new file mode 100644
index 00000000..bea10f7c
--- /dev/null
+++ b/noao/twodspec/apextract/apdefault.x
@@ -0,0 +1,42 @@
+include	<imhdr.h>
+include	"apertures.h"
+
+# AP_DEFAULT -- Create a default aperture.
+# The aperture ID, beam, axis, and the aperture center in both dimensions
+# are specified.  The aperture limits along the dispersion axis are set to
+# the full size of the image while along the dispersion axis they are queried.
+# The default offset curve is a constant zero curve.
+
+procedure ap_default (im, apid, apbeam, apaxis, apcenter, dispcenter, ap)
+
+pointer	im		# IMIO pointer
+int	apid		# Aperture ID
+int	apbeam		# Aperture beam number
+int	apaxis		# Aperture axis
+real	apcenter	# Center along the aperture axis
+real	dispcenter	# Center along the dispersion axis	
+pointer	ap		# Aperture pointer
+
+int	dispaxis
+real	apgetr()
+
+begin
+	dispaxis = mod (apaxis, 2) + 1
+
+	call ap_alloc (ap)
+	AP_ID(ap) = apid
+	AP_BEAM(ap) = apbeam
+	AP_AXIS(ap) = apaxis
+	AP_CEN(ap, apaxis) = apcenter
+	AP_LOW(ap, apaxis) = apgetr ("lower") 
+	if (IS_INDEFR(AP_LOW(ap,apaxis)))
+	    call error (1, "INDEF not allowed (lower)")
+	AP_HIGH(ap, apaxis) = apgetr ("upper") 
+	if (IS_INDEFR(AP_HIGH(ap,apaxis)))
+	    call error (1, "INDEF not allowed (upper)")
+	AP_CEN(ap, dispaxis) = dispcenter
+	AP_LOW(ap, dispaxis) = 1 - AP_CEN(ap, dispaxis)
+	AP_HIGH(ap, dispaxis) = IM_LEN(im, dispaxis) - AP_CEN(ap, dispaxis)
+	call ap_cvset (NULL, ap)
+	call ap_icset (NULL, ap, IM_LEN(im, apaxis))
+end
diff --git a/noao/twodspec/apextract/apdelete.x b/noao/twodspec/apextract/apdelete.x
new file mode 100644
index 00000000..1956a331
--- /dev/null
+++ b/noao/twodspec/apextract/apdelete.x
@@ -0,0 +1,23 @@
+# AP_DELETE -- Delete the specified aperture and return a new current aperture.
+
+procedure ap_delete (current, aps, naps)
+
+int	current			# Return current aperture index
+pointer	aps[ARB]		# Aperture data
+int	naps			# Number of apertures
+
+int	i
+
+begin
+	if (current < 1)
+	    return
+
+	call ap_free (aps[current])
+	for (i = current; i < naps; i = i + 1)
+	    aps[i] = aps[i+1]
+
+	aps[naps] = NULL
+
+	naps = naps - 1
+	current = min (naps, current)
+end
diff --git a/noao/twodspec/apextract/apdemos/apdemo1.cl b/noao/twodspec/apextract/apdemos/apdemo1.cl
new file mode 100644
index 00000000..04704034
--- /dev/null
+++ b/noao/twodspec/apextract/apdemos/apdemo1.cl
@@ -0,0 +1,14 @@
+# Create demo data if needed.
+artdata
+mkexample ("multifiber", "apdemo", errors=no, verbose=yes, list=no)
+bye
+imdelete ("apdemo.ms.??h", verify=no)
+
+# Set parameters.
+verbose = yes
+logfile = ""
+plotfile = ""
+unlearn apall
+
+# Execute playback.
+stty (playback="apdemos$apdemo1.dat", verify=no, delay=500)
diff --git a/noao/twodspec/apextract/apdemos/apdemo1.dat b/noao/twodspec/apextract/apdemos/apdemo1.dat
new file mode 100644
index 00000000..c718b423
--- /dev/null
+++ b/noao/twodspec/apextract/apdemos/apdemo1.dat
@@ -0,0 +1,14 @@
+\O=NOAO/IRAF V2.10DEVELOP valdes@puppis Tue 13:26:44 31-Jul-90
+\T=gterm
+\G=gterm
+apall\n
+apdemo\n
+\n
+4\n
+\n
+no\n
+\n
+no\n
+no\n
+\n
+no\n
diff --git a/noao/twodspec/apextract/apdemos/apdemos.cl b/noao/twodspec/apextract/apdemos/apdemos.cl
new file mode 100644
index 00000000..3b040ef7
--- /dev/null
+++ b/noao/twodspec/apextract/apdemos/apdemos.cl
@@ -0,0 +1,17 @@
+procedure apdemos (demo)
+
+int	demo		{prompt="Demo number"}
+
+begin
+	int	demonum
+	file	demofile
+
+	if ($nargs == 0)
+	    type ("apdemos$apdemos.men")
+	demonum = demo
+	demofile = "apdemos$apdemo" // demonum // ".cl"
+	if (access (demofile))
+	    cl (< demofile)
+	else
+	    error (1, "Invalid demo number " // demonum)
+end
diff --git a/noao/twodspec/apextract/apdemos/apdemos.men b/noao/twodspec/apextract/apdemos/apdemos.men
new file mode 100644
index 00000000..4e0ca6e1
--- /dev/null
+++ b/noao/twodspec/apextract/apdemos/apdemos.men
@@ -0,0 +1,3 @@
+	MENU of APEXTRACT Demonstrations
+
+	1 - Simple demo of APALL
diff --git a/noao/twodspec/apextract/apdemos/apdemosdb/aplast b/noao/twodspec/apextract/apdemos/apdemosdb/aplast
new file mode 100644
index 00000000..93f85ea9
--- /dev/null
+++ b/noao/twodspec/apextract/apdemos/apdemosdb/aplast
@@ -0,0 +1,111 @@
+# Wed 11:02:05 22-Aug-90
+begin	aperture last 1 60.57419 256.
+	image	last
+	aperture	1
+	beam	1
+	center	60.57419 256.
+	low	-3.111816 -255.
+	high	2.949428 256.
+	background
+		xmin -100.
+		xmax 100.
+		function chebyshev
+		order 1
+		sample -10:-6,6:10
+		naverage -3
+		niterate 0
+		low_reject 3.
+		high_reject 3.
+		grow 0.
+	axis	1
+	curve	6
+		2.
+		2.
+		1.
+		512.
+		0.02659256
+		0.5026957
+
+# Wed 11:02:05 22-Aug-90
+begin	aperture last 2 70.70531 256.
+	image	last
+	aperture	2
+	beam	2
+	center	70.70531 256.
+	low	-2.926423 -255.
+	high	2.899426 256.
+	background
+		xmin -100.
+		xmax 100.
+		function chebyshev
+		order 1
+		sample -10:-6,6:10
+		naverage -3
+		niterate 0
+		low_reject 3.
+		high_reject 3.
+		grow 0.
+	axis	1
+	curve	6
+		2.
+		2.
+		1.
+		512.
+		-0.002646168
+		0.5073752
+
+# Wed 11:02:05 22-Aug-90
+begin	aperture last 3 80.78613 256.
+	image	last
+	aperture	3
+	beam	3
+	center	80.78613 256.
+	low	-2.953142 -255.
+	high	2.970872 256.
+	background
+		xmin -100.
+		xmax 100.
+		function chebyshev
+		order 1
+		sample -10:-6,6:10
+		naverage -3
+		niterate 0
+		low_reject 3.
+		high_reject 3.
+		grow 0.
+	axis	1
+	curve	6
+		2.
+		2.
+		1.
+		512.
+		0.01349655
+		0.5075101
+
+# Wed 11:02:05 22-Aug-90
+begin	aperture last 4 90.8806 256.
+	image	last
+	aperture	4
+	beam	4
+	center	90.8806 256.
+	low	-2.823333 -255.
+	high	2.915152 256.
+	background
+		xmin -100.
+		xmax 100.
+		function chebyshev
+		order 1
+		sample -10:-6,6:10
+		naverage -3
+		niterate 0
+		low_reject 3.
+		high_reject 3.
+		grow 0.
+	axis	1
+	curve	6
+		2.
+		2.
+		1.
+		512.
+		0.022075
+		0.5081324
diff --git a/noao/twodspec/apextract/apedit.key b/noao/twodspec/apextract/apedit.key
new file mode 100644
index 00000000..d28a8856
--- /dev/null
+++ b/noao/twodspec/apextract/apedit.key
@@ -0,0 +1,74 @@
+       		 APEXTRACT CURSOR KEY SUMMARY
+
+?  Print help             j  Set beam number        u  Set upper limit(s)
+a  Toggle all flag        l  Set lower limit(s)     w  Window graph
+b  Set background(s)      m  Mark aperture          y  Y level limit(s)
+c  Center aperture(s)     n  New uncentered ap.     z  Resize aperture(s)
+d  Delete aperture(s)     o  Order ap. numbers      I  Interrupt
+e  Extract spectra        q  Quit                   +  Next aperture
+f  Find apertures         r  Redraw graph           -  Previous aperture
+g  Recenter aperture(s)   s  Shift aperture(s)      .  Nearest aperture
+i  Set aperture ID        t  Trace aperture(s)      
+
+       		 APEXTRACT COLON COMMAND SUMMARY
+
+:apertures      :center         :npeaks         :show           :t_width
+:apidtable      :clean          :nsubaps        :skybox         :threshold
+:avglimits      :database       :nsum           :t_function     :title
+:b_function     :extras         :order          :t_grow         :ulimit
+:b_grow         :gain           :parameters     :t_high_reject  :upper
+:b_high_reject  :image          :peak           :t_low_reject   :usigma
+:b_low_reject   :line           :plotfile       :t_naverage     :weights
+:b_naverage     :llimit         :r_grow         :t_niterate     :width
+:b_niterate     :logfile        :radius         :t_nlost        :write
+:b_order        :lower          :read           :t_nsum         :ylevel
+:b_sample       :lsigma         :readnoise      :t_order        
+:background     :maxsep         :saturation     :t_sample       
+:bkg            :minsep         :shift          :t_step         
+
+		APEXTRACT CURSOR KEYS
+
+?    Print help
+a    Toggle the ALL flag
+b an Set background fitting parameters
+c an Center aperture(s)
+d an Delete aperture(s)
+e an Extract spectra (see APSUM)
+f    Find apertures up to the requested number (see APFIND)
+g an Recenter aperture(s) (see APRECENTER)
+i  n Set aperture ID
+j  n Set aperture beam number
+l ac Set lower limit of current aperture at cursor position
+m    Define and center a new aperture on the profile near the cursor
+n    Define a new aperture centered at the cursor
+o  n Enter desired aperture number for cursor selected aperture and remaining
+     apertures are reordered using apidtable and maxsep parameters
+     (see APFIND for ordering algorithm)
+q    Quit
+r    Redraw the graph
+s an Shift the center(s) of the current aperture to the cursor position
+t ac Trace aperture positions (see APTRACE)
+u ac Set upper limit of current aperture at cursor position
+w    Window the graph using the window cursor keys
+y an Set aperture limits to intercept the data at the cursor y position
+z an Resize aperture(s) (see APRESIZE)
+.  n Select the aperture nearest the cursor to be the current aperture
++  c Select the next aperture (in ID) to be the current aperture
+-  c Select the previous aperture (in ID) to be the current aperture
+I    Interrupt task immediately.  Database information is not saved.
+
+The letter a following the key indicates if all apertures are affected when
+the ALL flag is set.  The letter c indicates that the key affects the
+current aperture while the letter n indicates that the key affects the
+aperture whose center is nearest the cursor.
+
+			APEXTRACT COLON COMMANDS
+
+:show [file]	   Print a list of the apertures (default file is STDOUT)
+:parameters [file] Print current parameter values (default file is STDOUT)
+:read [name]       Read apertures from database (default to the current image)
+:write [name]      Write apertures to database (default to the current image)
+
+The remaining colon commands are task parameters and print the current
+value if no value is given or reset the current value to that specified.
+Use :parameters to see current parameter values.
diff --git a/noao/twodspec/apextract/apedit.par b/noao/twodspec/apextract/apedit.par
new file mode 100644
index 00000000..8e6c15f5
--- /dev/null
+++ b/noao/twodspec/apextract/apedit.par
@@ -0,0 +1,17 @@
+# APEDIT
+
+input,s,a,,,,List of input images to edit
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"Reference images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,no,,,Find apertures?
+recenter,b,h,no,,,Recenter apertures?
+resize,b,h,no,,,Resize apertures?
+edit,b,h,yes,,,"Edit apertures?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+width,r,h,5.,0.,,Profile centering width
+radius,r,h,10.,,,Profile centering radius
+threshold,r,h,0.,0.,,Detection threshold for profile centering
diff --git a/noao/twodspec/apextract/apedit.x b/noao/twodspec/apextract/apedit.x
new file mode 100644
index 00000000..e7170e92
--- /dev/null
+++ b/noao/twodspec/apextract/apedit.x
@@ -0,0 +1,604 @@
+include	<error.h>
+include	<gset.h>
+include	<imhdr.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+define	HELP	"noao$twodspec/apextract/apedit.key"
+define	PROMPT	"apextract options"
+
+# Sort flags
+define	ORDER	"|increasing|decreasing|"
+
+# AP_EDIT -- Define and edit apertures.  This is the main interactive
+# procedure for manipulating apertures.  The selected dispersion line
+# is graphed with possible summing of neighboring lines and then
+# cursor keys are used to define new apertures or edit existing apertures.
+# Note that the value of line may be changed.
+
+procedure ap_edit (image, line, nsum, aps, naps)
+
+char	image[SZ_FNAME]		# Image to be edited
+int	line			# Dispersion line
+int	nsum			# Number of dispersion lines to sum
+
+pointer	aps			# Aperture pointers
+int	naps			# Number of apertures
+
+char	cmd[SZ_LINE]
+int	i, npts, apaxis, dispaxis, statline
+int	current, newgraph, newim, newdata, all, wcs, key, apid, apbeam
+real	center, low, high, wx, wy
+bool	peak
+pointer	im, imdata, title
+pointer	sp, x, wts, apdef, gp, gt, ic_gt, cv, str, output, profiles, ids
+
+int	gt_gcur(), apgwrd(), scan(), nscan()
+real	ap_cveval(), ap_center()
+bool	ap_answer()
+pointer	gt_init()
+errchk	ap_getdata, ap_gopen, ap_default
+
+define	new_	10
+define	beep_	99
+
+begin
+	# Query user.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[str], SZ_LINE, "Edit apertures for %s?")
+    	    call pargstr (image)
+	if (!ap_answer ("ansedit", Memc[str])) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Set flags.
+	all = NO
+
+	# Get user aperture ID's
+	call ap_gids (ids)
+
+	# Map the image and get the image data.
+new_	call ap_getdata (image, line, nsum, im, imdata, npts, apaxis, title)
+	newdata = NO
+	newim = NO
+
+	# Allocate additional memory.
+	call salloc (x, npts, TY_REAL)
+	call salloc (wts, npts, TY_REAL)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (profiles, SZ_FNAME, TY_CHAR)
+
+	# Set the default aperture and delete apertures which do not have
+	# the correct aperture axis.
+	call ap_default (im, INDEFI, 1, apaxis, INDEFR, real (line), apdef)
+	dispaxis = mod (apaxis, 2) + 1
+	for (i = naps; i > 0; i = i - 1)
+	    if (AP_AXIS(Memi[aps+i-1]) != apaxis)
+	        call ap_delete (i, Memi[aps], naps)
+
+	# Set up the graphics.
+	call ap_gopen (gp)
+	gt = gt_init()
+	call gt_sets (gt, GTTITLE, "Define and Edit Apertures")
+	call gt_sets (gt, GTPARAMS, Memc[title])
+
+	# Enter cursor loop.
+	current = min (1, naps)
+	key = 'r'
+	wy = INDEF
+	repeat {
+	    statline = NO
+
+	    # For those keys affecting the nearest aperture set the current
+	    # aperture to be the aperture nearest the cursor.
+	    switch (key) {
+	    case '.','b','c','d','e','g','i','j','o','t','y','z':
+		# The current aperture is the one nearest the cursor.
+	        call ap_nearest (current, line, Memi[aps], naps, wx)
+	    }
+
+	    # Set the current aperture values.
+	    call ap_values (current, Memi[aps], line, apid,
+		apbeam, center, low, high)
+
+	    # Select the operation to be performed.
+	    switch (key) {
+	    case '?': # Print help text.
+		call gpagefile (gp, HELP, PROMPT)
+
+	    case ':': # Colon commands.
+		if (cmd[1] == '/')
+		    call gt_colon (cmd, gp, gt, newgraph)
+		else {
+		    call ap_colon (cmd, im, gp, apdef, aps, naps, current,
+			image, line, nsum, all, newgraph, newim, newdata,
+			statline)
+		    if (newim == YES)
+			break
+		    if (newdata == YES) {
+			call mfree (imdata, TY_REAL)
+			call mfree (title, TY_CHAR)
+			call imunmap (im)
+			call ap_getdata (image, line, nsum, im, imdata, npts,
+			    apaxis, title)
+			call gt_sets (gt, GTPARAMS, Memc[title])
+			newdata = NO
+			newgraph = YES
+		    }
+		    call ap_free (apdef)
+		    iferr (call ap_default (im, INDEFI, 1, apaxis, INDEFR,
+			real (line), apdef))
+			call erract (EA_WARN)
+		}
+
+	    case '.': # Select current aperture.  This has been done already.
+		;
+
+	    case '+': # Go to next aperture.
+		current = min (naps, current + 1)
+
+	    case '-': # Go to last aperture.
+		current = min (naps, max (1, current - 1))
+
+	    case 'a': # Toggle all flag
+		if (all == NO)
+		    all = YES
+		else
+		    all = NO
+
+	    case 'b': # Set background fitting parameters.
+		if (current == 0)
+		   goto beep_
+
+		do i = 1, npts {
+		    Memr[x+i-1] = i - center
+		    Memr[wts+i-1] = 1
+		}
+
+		if (ic_gt == NULL) {
+		    ic_gt = gt_init()
+		    call gt_sets (ic_gt, GTTYPE, "line")
+	    	    wx = max (10., high - low)
+	    	    call gt_setr (ic_gt, GTXMIN, low - 2 * wx)
+	    	    call gt_setr (ic_gt, GTXMAX, high + 2 * wx)
+		}
+
+		call sprintf (Memc[str], SZ_LINE,
+		    "Set Background Subtraction for Aperture %d")
+		    call pargi (apid)
+		call gt_sets (ic_gt, GTTITLE, Memc[str])
+
+		if (AP_IC(Memi[aps+current-1]) == NULL)
+		    call ap_icset (apdef, Memi[aps+current-1], npts)
+
+		call icg_fit (AP_IC(Memi[aps+current-1]), gp, "gcur",
+		    ic_gt, cv, Memr[x], Memr[imdata], Memr[wts], npts)
+		call cvfree (cv)
+
+		# Set background limits
+		call ap_icset (Memi[aps+current-1], Memi[aps+current-1], npts)
+
+		if ((naps > 1) && (all == YES))
+		   do i = 1, naps
+		       if (i != current)
+			   call ap_icset (Memi[aps+current-1],
+			       Memi[aps+i-1], npts)
+		newgraph = YES
+
+	    case 'c': # Center current aperture or all apertures.
+		if (current == 0)
+		    goto beep_
+
+		if ((naps == 1) || (all == NO)) {
+		    center = ap_center (center, Memr[imdata], npts)
+		    if (!IS_INDEF(center))
+			call ap_update (gp, Memi[aps+current-1], line, apid,
+			    apbeam, center, low, high)
+		} else {
+		    do i = 1, naps {
+		        call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+			center = ap_center (center, Memr[imdata], npts)
+			if (!IS_INDEF(center))
+			    call ap_update (gp, Memi[aps+i-1], line, apid,
+				apbeam, center, low, high)
+		    }
+		}
+
+	    case 'd': # Delete apertures
+		if (current == 0)
+		    goto beep_
+
+		call gseti (gp, G_PLTYPE, 0)
+		if ((naps == 1) || (all == NO)) {
+		    call ap_gmark (gp, line, Memi[aps+current-1], 1)
+		    call ap_delete (current, Memi[aps], naps)
+		    call ap_gscur (current, gp, line, Memi[aps], wy)
+	            call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		} else {
+		    do i = 1, naps {
+			call ap_gmark (gp, line, Memi[aps+i-1], 1)
+			call ap_free (Memi[aps+i-1])
+		    }
+		    naps = 0
+		    current = 0
+		}
+		call gseti (gp, G_PLTYPE, 1)
+
+	    case 'e': # Sum extraction
+		if (current == 0)
+		    goto beep_
+
+		call imunmap (im)
+		call apgstr ("e_output", Memc[output], SZ_FNAME)
+		call apgstr ("e_profiles", Memc[profiles], SZ_FNAME)
+	        call apgstr ("format", Memc[str], SZ_LINE)
+		call appstr ("ansreview", "yes")
+		call appstr ("ansreview1", "yes")
+		call appstr ("ansclobber", "yes")
+		call appstr ("ansclobber1", "yes")
+		if (all == NO)
+	            call ap_extract (image, Memc[output],
+			Memc[str], Memc[profiles], Memi[aps+current-1], 1)
+		else
+	            call ap_extract (image, Memc[output],
+			Memc[str], Memc[profiles], Memi[aps], naps)
+		call ap_getdata (image, line, nsum, im, imdata, npts, apaxis,
+		    title)
+		newgraph = YES
+
+	    case 'f': # Find apertures
+		if (current == 0)
+		    call ap_findnew (line, Memr[imdata], npts,
+			apdef, aps, naps)
+		else
+		    call ap_findnew (line, Memr[imdata], npts,
+			Memi[aps+current-1], aps, naps)
+		call ap_gmark (gp, line, Memi[aps], naps)
+		current = naps
+
+	    case 'g': # Apply recenter algorithm.
+		if (current == 0)
+		    goto beep_
+
+		call imunmap (im)
+		if (all == NO) {
+		    call gseti (gp, G_PLTYPE, 0)
+		    call ap_gmark (gp, line, Memi[aps+current-1], 1)
+		    call ap_recenter (image, line, nsum,
+			Memi[aps+current-1], 1, YES)
+		    call gseti (gp, G_PLTYPE, 1)
+		    call ap_gmark (gp, line, Memi[aps+current-1], 1)
+		    call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		} else {
+		    call gseti (gp, G_PLTYPE, 0)
+		    do i = 1, naps
+		        call ap_gmark (gp, line, Memi[aps+i-1], 1)
+		    call ap_recenter (image, line, nsum, Memi[aps], naps, YES)
+		    call gseti (gp, G_PLTYPE, 1)
+		    do i = 1, naps
+		        call ap_gmark (gp, line, Memi[aps+i-1], 1)
+		}
+		call ap_getdata (image, line, nsum, im, imdata, npts, apaxis,
+		    title)
+
+	    case 'i': # Set aperture ID
+		if (current == 0)
+		    goto beep_
+
+		repeat {
+		    call printf ("Aperture (%d) = ")
+		        call pargi (AP_ID(Memi[aps+current-1]))
+		    call flush (STDOUT)
+		    if (scan () != EOF) {
+		        call gargi (apid)
+		        if (nscan() == 1) {
+			    if (apid < 1) {
+				call printf (
+				"Aperture numbers < 1 are not allowed: ")
+			    } else {
+				for (i=1; i<=naps; i=i+1)
+				    if (i != current &&
+					apid == AP_ID(Memi[aps+i-1]))
+					break
+				if (i <= naps) {
+				    call printf ("Aperture %d already used: ")
+					call pargi (apid)
+				} else {
+				    AP_ID(Memi[aps+current-1]) = apid
+				    call ap_ids (Memi[aps+current-1], 1, ids)
+				    break
+				}
+			    }
+			} else
+			    break
+		    }
+		}
+
+	    case 'j': # Set beam number
+		if (current == 0)
+		    goto beep_
+
+		repeat {
+		    call printf ("Beam (%d) = ")
+			call pargi (AP_BEAM(Memi[aps+current-1]))
+		    call flush (STDOUT)
+		    if (scan () != EOF) {
+			call gargi (apbeam)
+			if (nscan() == 1) {
+#			    if (apbeam < 0) {
+#				call printf (
+#				    "Beam numbers < 0 are not allowed: ")
+#			    } else {
+				if (all == NO)
+				    AP_BEAM(Memi[aps+current-1]) = apbeam
+				else
+				    do i = 1, naps
+					AP_BEAM(Memi[aps+i-1]) = apbeam
+				break
+#			    }
+			} else
+			    break
+		    }
+		}
+
+	    case 'l': # Set the low limit.
+		if (current == 0)
+		    goto beep_
+
+		wx = wx - center
+		if ((naps == 1) || (all == NO))
+		    call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, center, wx, high)
+		else {
+		    do i = 1, naps {
+			call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+			call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center, wx, high)
+		    }
+		}
+
+	    case 'm', 'n': # Define a new aperture.
+		if (mod (naps, 100) == 0)
+		    call realloc (aps, naps+100, TY_POINTER)
+
+		if (key == 'm')
+		    wx = ap_center (wx, Memr[imdata], npts)
+
+		if (!IS_INDEF(wx)) {
+		    naps = naps + 1
+		    if (naps > 1)
+			call ap_copy (Memi[aps+current-1], Memi[aps+naps-1])
+		    else
+			call ap_copy (apdef, Memi[aps+naps-1])
+
+		    AP_ID(Memi[aps+naps-1]) = INDEFI
+		    AP_CEN(Memi[aps+naps-1], apaxis) = wx -
+		    	ap_cveval (AP_CV(Memi[aps+naps-1]), real (line))
+		    AP_CEN(Memi[aps+naps-1], dispaxis) = line
+		    AP_LOW(Memi[aps+naps-1], dispaxis) =
+			1 - AP_CEN(Memi[aps+naps-1], dispaxis)
+		    AP_HIGH(Memi[aps+naps-1], dispaxis) = IM_LEN(im, dispaxis) -
+			AP_CEN(Memi[aps+naps-1], dispaxis)
+
+		    call ap_icset (Memi[aps+naps-1], Memi[aps+naps-1], npts)
+
+		    current = naps
+		    i = apgwrd ("order", cmd, SZ_LINE, ORDER)
+		    call ap_sort (current, Memi[aps], naps, i)
+		    call ap_ids (Memi[aps], naps, ids)
+		    call ap_titles (Memi[aps+current-1], 1, ids)
+
+		    call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		    call ap_gmark (gp, line, Memi[aps+current-1], 1)
+		}
+
+	    case 'o': # Order the aperture and beam numbers
+		if (naps == 0)
+		    goto beep_
+
+		do i = 1, naps
+		    if (i != current)
+		        AP_ID(Memi[aps+i-1]) = INDEFI
+
+		call printf ("Aperture (%d) = ")
+		    call pargi (AP_ID(Memi[aps+current-1]))
+		call flush (STDOUT)
+		if (scan () != EOF) {
+		    call gargi (apid)
+		    if (nscan() == 1) {
+			AP_ID(Memi[aps+current-1]) = apid
+			AP_BEAM(Memi[aps+current-1]) = apid
+		    }
+		}
+
+		i = apgwrd ("order", cmd, SZ_LINE, ORDER)
+		call ap_sort (current, Memi[aps], naps, i)
+		call ap_ids (Memi[aps], naps, ids)
+
+		# Reset the titles
+		do i = 1, naps
+		    if (AP_TITLE(Memi[aps+i-1]) != NULL)
+			call mfree (AP_TITLE(Memi[aps+i-1]), TY_CHAR)
+		call ap_titles (Memi[aps], naps, ids)
+			
+		newgraph = YES
+
+	    case 'r': # Redraw the graph.
+		newgraph = YES
+
+	    case 's': # Shift apertures
+		if (current == 0)
+		    goto beep_
+
+		call printf ("Center aperture %d (no)? ")
+		    call pargi (AP_ID(Memi[aps+current-1]))
+		call flush (STDOUT)
+		if (scan () != EOF) {
+		    call gargb (peak)
+		    if (nscan() == 1 && peak) {
+		        wy = ap_center (wx, Memr[imdata], npts)
+		        if (!IS_INDEF(wy))
+			    wx = wy
+		    }
+		}
+
+		if ((naps == 1) || (all == NO))
+		    call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, wx, low, high)
+		else {
+		    wx = wx - center
+		    do i = 1, naps {
+		        call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+			call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center + wx, low, high)
+		    }
+		}
+
+	    case 't': # Trace.
+		if (current == 0)
+		    goto beep_
+
+		call imunmap (im)
+		call appstr ("ansfittrace1", "yes")
+		if (all == NO)
+		    call ap_trace (image, line, Memi[aps+current-1], 1, YES)
+		else
+		    call ap_trace (image, line, Memi[aps], naps, YES)
+		call ap_getdata (image, line, nsum, im, imdata, npts, apaxis,
+		    title)
+		newgraph = YES
+
+	    case 'u': # Set the upper limit.
+		if (current == 0)
+		    goto beep_
+
+		wx = wx - center
+		if ((naps == 1) || (all == NO))
+		    call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, center, low, wx)
+		else {
+		    do i = 1, naps {
+			call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+			call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center, low, wx)
+		    }
+		}
+
+	    case 'w': # Window the graph.
+		call gt_window (gt, gp, "gcur", newgraph)
+
+	    case 'y': # Set aperture limits at the y level.
+		if (current == 0)
+		    goto beep_
+
+		if ((naps == 1) || (all == NO)) {
+		    low = -npts
+		    high = npts
+		    call ap_ylevel (Memr[imdata], npts, wy, false, false, 0.,
+			center, low, high)
+		    call ap_update (gp, Memi[aps+current-1], line, apid,
+			apbeam, center, low, high)
+		} else {
+		    do i = 1, naps {
+		        call ap_values (i, Memi[aps], line, apid,
+			    apbeam, center, low, high)
+		        low = -npts
+		        high = npts
+			call ap_ylevel (Memr[imdata], npts, wy, false, false,
+			    0., center, low, high)
+			call ap_update (gp, Memi[aps+i-1], line, apid,
+			    apbeam, center, low, high)
+		    }
+		}
+
+	    case 'z': # Apply resize algorithm.
+		if (current == 0)
+		    goto beep_
+
+		call imunmap (im)
+		if (all == NO) {
+		    call gseti (gp, G_PLTYPE, 0)
+		    call ap_gmark (gp, line, Memi[aps+current-1], 1)
+		    call ap_resize (image, line, nsum,
+			Memi[aps+current-1], 1, YES)
+		    call gseti (gp, G_PLTYPE, 1)
+		    call ap_gmark (gp, line, Memi[aps+current-1], 1)
+		    call ap_values (current, Memi[aps], line, apid,
+			apbeam, center, low, high)
+		} else {
+		    call gseti (gp, G_PLTYPE, 0)
+		    do i = 1, naps
+		        call ap_gmark (gp, line, Memi[aps+i-1], 1)
+		    call ap_resize (image, line, nsum, Memi[aps], naps, YES)
+		    call gseti (gp, G_PLTYPE, 1)
+		    do i = 1, naps
+		        call ap_gmark (gp, line, Memi[aps+i-1], 1)
+		}
+		call ap_getdata (image, line, nsum, im, imdata, npts, apaxis,
+		    title)
+
+	    case 'I': # Interrupt
+		call fatal (0, "Interrupt")
+
+	    default: # Ring bell for unrecognized commands.
+beep_		call printf ("Invalid or unrecognized command\007")
+		statline = YES
+	    }
+
+	    # Update the graph if needed.
+	    if (newgraph == YES) {
+		call ap_graph (gp, gt, Memr[imdata], npts, line,
+		    Memi[aps], naps)
+	        newgraph = NO
+	    }
+
+	    # Set the cursor to the current aperture and print the current
+	    # aperture on the status line.
+	    call ap_gscur (current, gp, line, Memi[aps], wy)
+	    if (statline == NO)
+	        call ap_print (current, line, all, Memi[aps])
+
+	} until (gt_gcur ("gcur", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+
+	# Log the editing operation.
+	call sprintf (Memc[str], SZ_LINE, "EDIT - %d apertures edited for %s")
+       	    call pargi (naps)
+       	    call pargstr (image)
+	call ap_log (Memc[str], YES, NO, NO)
+
+	# Free memory.
+	call ap_fids (ids)
+	call mfree (imdata, TY_REAL)
+	call mfree (title, TY_CHAR)
+	call imunmap (im)
+	call gt_free (gt)
+	call gt_free (ic_gt)
+	call ap_free (apdef)
+
+	# If a new image is desired loop back.
+	if (newim == YES) {
+	    call clgstr ("database", Memc[output], SZ_LINE)
+	    call sprintf (Memc[str], SZ_LINE,
+	        "Write apertures for %s to %s")
+	        call pargstr (image)
+	        call pargstr (Memc[output])
+	    if (ap_answer ("ansdbwrite", Memc[str]))
+	        call ap_dbwrite (image, aps, naps)
+	    call strcpy (cmd, image, SZ_FNAME)
+	    call ap_dbread (image, aps, naps)
+	    goto new_
+	}
+
+	call appstr ("ansdbwrite1", "yes")
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apertures.h b/noao/twodspec/apextract/apertures.h
new file mode 100644
index 00000000..aeb4bd94
--- /dev/null
+++ b/noao/twodspec/apextract/apertures.h
@@ -0,0 +1,32 @@
+# Aperture Definition
+
+# Aperture structure --  The aperture structure consists of an integer
+# identification number, a title,  the center of the aperture, the lower
+# and upper limits of the aperture measured relative to the center, the
+# axis for a curve giving an offset relative to the center, the CURFIT
+# pointer describing the curve and an ICFIT pointer for background
+# subtraction.  The center and lower and upper limits are pairs of real
+# numbers in the order column value and line value.  The edges of the
+# aperture are given by:
+# 
+#	low column = center column + low column offset + curve (line)
+#	high column = center column + high column offset + curve (line)
+#	low line = center line + low line offset + curve (column)
+#	high line = center line + high line offset + curve (column)
+#
+# The curve is aplied to the column positions if the curve axis is 1 and
+# to the line positions if the curve axis is 2.
+
+define	AP_LEN		13			# Length of aperture structure
+define	SZ_APTITLE	60			# Length of aperture title
+
+define	AP_ID		Memi[$1]		# Aperture ID
+define	AP_TITLE	Memi[$1+1]		# Pointer to title
+define	AP_BEAM		Memi[$1+2]		# Aperture beam number
+define	AP_CEN		Memr[P2R($1+3+$2-1)]	# Aperture center
+define	AP_LOW		Memr[P2R($1+5+$2-1)]	# Aperture limit
+define	AP_HIGH		Memr[P2R($1+7+$2-1)]	# Aperture limit
+define	AP_AXIS		Memi[$1+9]		# Axis for curve
+define	AP_CV		Memi[$1+10]		# Aperture curve
+define	AP_IC		Memi[$1+11]		# ICFIT pointer
+define	AP_SELECT	Memi[$1+12]		# Aperture selected?
diff --git a/noao/twodspec/apextract/apextract.cl b/noao/twodspec/apextract/apextract.cl
new file mode 100644
index 00000000..035ce189
--- /dev/null
+++ b/noao/twodspec/apextract/apextract.cl
@@ -0,0 +1,33 @@
+#{ APEXTRACT -- Aperture extraction package
+
+package apextract
+
+task	apall,
+	apedit,
+	apfind,
+	apfit,
+	apflatten,
+	apmask,
+	apnormalize,
+	aprecenter,
+	apresize,
+	apscatter,
+	apnoise,
+	apsum,
+	aptrace		= "apextract$x_apextract.e"
+task	apparams	= "apextract$apparams.par"
+task	apall1		= "apextract$apall1.par"
+task	apfit1		= "apextract$apfit1.par"
+task	apflat1		= "apextract$apflat1.par"
+task	apnorm1		= "apextract$apnorm1.par"
+task	apnoise1	= "apextract$apnoise1.par"
+task	apdefault	= "apextract$apdefault.par"
+task	apscat1		= "apextract$apscat1.par"
+task	apscat2		= "apextract$apscat2.par"
+
+set	apdemos		= "apextract$apdemos/"
+task	apdemos.pkg	= "apdemos$apdemos.cl"
+ 
+hidetask apparams, apall1, apfit1, apflat1, apnorm1, apscat1, apscat2, apnoise1
+
+clbye
diff --git a/noao/twodspec/apextract/apextract.hd b/noao/twodspec/apextract/apextract.hd
new file mode 100644
index 00000000..ad17623d
--- /dev/null
+++ b/noao/twodspec/apextract/apextract.hd
@@ -0,0 +1,27 @@
+# Help directory for the APEXTRACT package.
+
+$doc		 = "./doc/"
+
+apall		hlp=doc$apall.hlp
+apdefault	hlp=doc$apdefault.hlp
+apdemos		hlp=doc$apdemos.hlp
+apedit		hlp=doc$apedit.hlp
+apfind		hlp=doc$apfind.hlp
+apfit		hlp=doc$apfit.hlp
+apflatten	hlp=doc$apflatten.hlp
+apmask		hlp=doc$apmask.hlp
+apnoise		hlp=doc$apnoise.hlp
+apnormalize	hlp=doc$apnormalize.hlp
+aprecenter	hlp=doc$aprecenter.hlp
+apresize	hlp=doc$apresize.hlp
+apscatter	hlp=doc$apscatter.hlp
+apsum		hlp=doc$apsum.hlp
+aptrace		hlp=doc$aptrace.hlp
+
+package		hlp=doc$apextract.hlp,		 sys=doc$apextractsys.hlp
+apbackground	hlp=doc$apbackground.hlp
+approfiles	hlp=doc$approfiles.hlp
+apvariance	hlp=doc$apvariance.hlp
+extras		hlp=doc$apextras.hlp
+
+revisions	sys=Revisions
diff --git a/noao/twodspec/apextract/apextract.men b/noao/twodspec/apextract/apextract.men
new file mode 100644
index 00000000..c0db0005
--- /dev/null
+++ b/noao/twodspec/apextract/apextract.men
@@ -0,0 +1,23 @@
+          apall - Extract 1D spectra (all parameters in one task)
+      apdefault - Set the default aperture parameters and apidtable
+        apdemos - Various tutorial demonstrations
+         apedit - Edit apertures interactively
+	 apfind - Automatically find spectra and define apertures
+	  apfit - Fit 2D spectra and output the fit, difference, or ratio
+      apflatten - Remove overall spectral and profile shapes from flat fields
+        apnoise - Compute and examine noise characteristics of spectra
+         apmask - Create and IRAF pixel list mask of the apertures
+    apnormalize - Normalize 2D apertures by 1D functions
+     aprecenter - Recenter apertures
+       apresize - Resize apertures
+      apscatter - Fit and subtract scattered light
+          apsum - Extract 1D spectra
+	aptrace - Trace positions of spectra
+
+		ADDITIONAL HELP TOPICS
+
+   apbackground - Background subtraction algorithms
+     approfiles - Profile determination algorithms
+     apvariance - Extractions, variance weighting, cleaning, and noise model
+	 extras - Information about the extra information in 3D images
+        package - Package parameters and general description of package
diff --git a/noao/twodspec/apextract/apextract.par b/noao/twodspec/apextract/apextract.par
new file mode 100644
index 00000000..8b153ec8
--- /dev/null
+++ b/noao/twodspec/apextract/apextract.par
@@ -0,0 +1,8 @@
+# APEXTRACT Package
+
+dispaxis,i,h,2,1,2,"Dispersion axis (1=along lines, 2=along columns)"
+database,f,h,"database",,,Database
+verbose,b,h,no,,,Verbose output?
+logfile,s,h,"",,,Text log file
+plotfile,s,h,"",,,Plot file
+version,s,h,"APEXTRACT V3.0: August 1990"
diff --git a/noao/twodspec/apextract/apextract.x b/noao/twodspec/apextract/apextract.x
new file mode 100644
index 00000000..176ab251
--- /dev/null
+++ b/noao/twodspec/apextract/apextract.x
@@ -0,0 +1,1834 @@
+include	<error.h>
+include	<imhdr.h>
+include	<mach.h>
+include	<math/iminterp.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+# Background fitting types
+define	BACKGROUND	"|none|average|median|minimum|fit|"
+define	B_NONE		1
+define	B_AVERAGE	2
+define	B_MEDIAN	3
+define	B_MINIMUM	4
+define	B_FIT		5
+
+# Weight types
+define	WEIGHTS		"|none|variance|"
+define	W_NONE		1
+define	W_VARIANCE	2
+
+# Profile fitting algorithms
+define	P_FIT		"|fit1d|fit2d|"
+define	P_FIT1D		1
+define	P_FIT2D		2
+
+# Output formats
+define	FORMATS		"|onedspec|multispec|echelle|strip|normalize|flatten\
+			|ratio|difference|fit|noise|"
+define	ONEDSPEC	1	# Individual 1D spectra
+define	MULTISPEC	2	# Multiple spectra
+define	ECHELLE		3	# Echelle spectra
+define	STRIP		4	# Strip spectra
+define	NORM		5	# Normalized spectra
+define	FLAT		6	# Flat spectra
+define	RATIO		7	# Ratio of data to model
+define	DIFF		8	# Difference of data and model
+define	FIT		9	# Model
+define	NOISE		10	# Noise calculation
+
+
+# AP_EXTRACT -- Extract spectra by a weighted sum across the apertures.
+# 
+# This routine does clobber checks on the output images, manages the I/O
+# from the input image in as big of pieces as possible, and loops through
+# each aperture calling routines to determine the sky, do any fitting and
+# extraction, and output the spectra.
+# The extraction may be either a simple, unweighted extraction
+# which is very fast or a weighted extraction using CCD noise
+# parameters.  The weights require dividing out the basic spectrum and
+# smoothing the 2D spectral profile.  The general approach of variance
+# weighting is described by K. Horne (PASP V98, P609, 1986).  The
+# smoothing has two algorithms, fitting columns or lines parallel to the
+# dispersion axis for nearly aligned spectra or fitting a 2D function
+# using a method given by T. Marsh (PASP V101, P1032, 1989).  The profile
+# may also be used to reject cosmic rays by iteration.
+#
+# The extractions require enough memory to get at least one aperture plus
+# background (if needed) into memory.  If possible the region containing
+# all the apertures is read into memory.  The target maximum amount of
+# memory is set by the maxmimum size returned by BEGMEM and the
+# appropriate working set size is requested.  The optimal size can be
+# tuned through BEGMEM, which references a machine dependent include
+# file, if needed.  The algorithm should work well (minimize I/O as well
+# as paging) in all cases but very large image formats with highly tilted
+# spectra (where aperture extraction along the image axes is not really
+# appropriate).  These memory requirements were chosen to minimize image
+# I/O and because the variance weighted algorithms need to make multiple
+# passes through the image.  In principle simple, unweighted extractions
+# with no sky smoothing can be done sequentially but this was not done in
+# order to use nearly the same code for both weighted and unweighted
+# cases.
+#
+# If using variance weighting and a profile image is given then it is used
+# to determine the profile which is then applied to the target image
+# during the final extraction.  If the same profile image is used multiple
+# times it would be more efficient to store the profile but then issues
+# of consistency arise.  For now this possible feature is not implemented.
+
+procedure ap_extract (input, output, format, profiles, aps, naps)
+
+char	input[SZ_FNAME]		# Input image
+char	output[SZ_FNAME]	# Output image (optional root name)
+char	format[SZ_LINE]		# Output format
+char	profiles[SZ_FNAME]	# Profile filename (optional)
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+
+# CL parameters
+int	fmt			# Output format
+int	bkg			# Background type
+int	weights			# Extraction weights
+int	pfit			# Profile fitting algorithm
+bool	clean			# Reject cosmic rays?
+real	gain			# Photon/DN gain
+real	rdnoise			# Read out noise
+int	nsubaps			# Number of subapertures
+int	interptype		# Edge interpolation type
+
+int	i, j, k, napsex, aaxis, baxis, namax, na, nb, na1, interpbuf
+int	amin, amax, bmin, bmax
+int	new_size, old_size, max_size, best_size
+real	cmin, cmax, xmin, xmax, shift
+pointer	sp, str, bkgstr, wtstr, cleanstr, apsex
+pointer	a, b, c, astart, spec, specsky, specsig, raw, profile
+pointer	a1, a2, b1, b2, c1, c2, im, pim, ap, cv, ic, dbuf, pbuf, sbuf, svar, ptr
+pointer	asi
+
+bool	clgetb(), apgetb(), strne()
+int	apgeti(), apgwrd(), begmem(), ap_check()
+real	apgimr(), ap_cveval(), ic_getr()
+pointer	ap_immap(), imgs2r(), imgl2r()
+errchk	salloc, malloc, ap_immap, imgs2r, imgl2r, asiinit
+errchk	ap_check, ap_skyeval, ap_profile, ap_variance, ap_output, apgimr
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	napsex = 0
+	do i = 1, naps
+	    if (AP_SELECT(aps[i]) == YES)
+		napsex = napsex + 1
+	if (napsex == 0) {
+	    call sprintf (Memc[str], SZ_LINE,
+	        "EXTRACT - No apertures defined for %s")
+		call pargstr (input)
+	    call ap_log (Memc[str], YES, NO, YES)
+	    call sfree (sp)
+	    return
+	}
+
+	call salloc (bkgstr, SZ_FNAME, TY_CHAR)
+	call salloc (wtstr, SZ_FNAME, TY_CHAR)
+	call salloc (cleanstr, SZ_FNAME, TY_CHAR)
+	call salloc (apsex, napsex, TY_POINTER)
+
+	# Select apertures to extract and fix possible limit error.
+	napsex = 0
+	do i = 1, naps {
+	    if (AP_LOW(aps[i],1) > AP_HIGH(aps[i],1)) {
+		xmax = AP_LOW(aps[i],1)
+		AP_LOW(aps[i],1) = AP_HIGH(aps[i],1)
+		AP_HIGH(aps[i],1) = xmax
+	    }
+	    if (AP_LOW(aps[i],2) > AP_HIGH(aps[i],2)) {
+		xmax = AP_LOW(aps[i],2)
+		AP_LOW(aps[i],2) = AP_HIGH(aps[i],2)
+		AP_HIGH(aps[i],2) = xmax
+	    }
+	    if (AP_SELECT(aps[i]) == NO)
+		next
+	    Memi[apsex+napsex] = aps[i]
+	    napsex = napsex + 1
+	}
+
+	# Get CL parameters
+	bkg = apgwrd ("background", Memc[bkgstr], SZ_FNAME, BACKGROUND)
+	pfit = apgwrd ("pfit", Memc[str], SZ_LINE, P_FIT)
+	clean = apgetb ("clean")
+	if (clean)
+	    call strcpy ("yes", Memc[cleanstr], SZ_FNAME)
+	else
+	    call strcpy ("no", Memc[cleanstr], SZ_FNAME)
+	nsubaps = apgeti ("nsubaps")
+	interptype = II_LINEAR
+
+	# Do clobber checking.  Return if output exists and not clobbering.
+	call apgstr ("ansclobber", Memc[str], SZ_LINE)
+	call appstr ("ansclobber1", Memc[str])
+	fmt = ap_check (input, output, format, Memi[apsex], napsex, nsubaps)
+	if (fmt == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Force weights depending on format or cleaning.
+	switch (fmt) {
+	case FLAT, RATIO, DIFF, FIT, NOISE:
+	    weights = W_VARIANCE
+	default:
+	    if (clean) {
+		call strcpy ("variance", Memc[wtstr], SZ_FNAME)
+		weights = W_VARIANCE
+	    } else
+	        weights = apgwrd ("weights", Memc[wtstr], SZ_FNAME, WEIGHTS)
+	}
+
+	if (clgetb ("verbose")) {
+	    call printf ("Extracting apertures ...\n")
+	    call flush (STDOUT)
+	}
+	    
+	# Open input image and profile image if given.  Set axis parameters
+	# where 'a' is the aperture axis across the dispersion and 'b' is
+	# along the dispersion.
+
+	im = ap_immap (input, aaxis, baxis)
+	namax = IM_LEN(im, aaxis)
+	nb = IM_LEN(im, baxis)
+
+	pim = NULL
+	if (strne(profiles,input) && weights==W_VARIANCE && profiles[1]!=EOS) {
+	    pim = ap_immap (profiles, i, j)
+	    if (i!=aaxis||j!=baxis||IM_LEN(pim,i)!=namax||IM_LEN(pim,j)!=nb) {
+		call imunmap (pim)
+		call imunmap (im)
+		call sfree (sp)
+		call error (1,
+		    "Input image and profile image are not compatible")
+	    }
+	    call sprintf (Memc[str], SZ_LINE,
+	        "EXTRACT - Using profile image %s for %s")
+		call pargstr (profiles)
+		call pargstr (input)
+	    call ap_log (Memc[str], YES, YES, NO)
+	}
+
+	# Determine limits of apertures for use in defining memory requirements
+	# and I/O.
+
+	call salloc (a, 2 * napsex, TY_INT)
+	call salloc (b, 2 * napsex, TY_INT)
+	call salloc (c, 2 * napsex, TY_REAL)
+	a1 = a - 1
+	a2 = a1 + napsex
+	b1 = b - 1
+	b2 = b1 + napsex
+	c1 = c - 1
+	c2 = c1 + napsex
+
+	# Initialize image interpolator for edge pixel weighting.
+	switch (interptype) {
+	case II_LINEAR:
+	    interpbuf = 2
+	case II_POLY3:
+	    interpbuf = 3
+	case II_SINC:
+	    interpbuf = 16
+	default:
+	    interpbuf = 0
+	}
+	if (interptype > 0)
+	    call asiinit (asi, interptype)
+	else
+	    asi = NULL
+
+	na1 = 0
+	do i = 1, napsex {
+	    ap = Memi[apsex+i-1]
+	    cv = AP_CV(ap)
+	    ic = AP_IC(ap)
+
+	    # Dispersion axis limits
+	    bmin = min (nb, max (1, nint (AP_CEN(ap,baxis)+AP_LOW(ap,baxis))))
+	    bmax = max (1, min (nb, nint (AP_CEN(ap,baxis)+AP_HIGH(ap,baxis))))
+
+	    # Aperture axis shifts
+	    if (cv != NULL) {
+		cmin = MAX_REAL
+	        cmax = -MAX_REAL
+	        do j = bmin, bmax {
+	           shift = ap_cveval (cv, real (j))
+	           cmin = min (cmin, shift)
+	           cmax = max (cmax, shift)
+	        }
+	    } else {
+		cmin = 0.
+		cmax = 0.
+	    }
+
+	    # Background region limits.
+	    xmin = AP_LOW(ap,aaxis)
+	    xmax = AP_HIGH(ap,aaxis)
+	    if (weights == W_VARIANCE) {
+		xmin = xmin - 2
+		xmax = xmax + 2
+	    }
+	    xmin = xmin - interpbuf
+	    xmax = xmax + interpbuf
+	    if (bkg != B_NONE && AP_IC(ap) != NULL) {
+		xmin = min (xmin, ic_getr (ic, "xmin"))
+		xmax = max (xmax, ic_getr (ic, "xmax"))
+	    }
+
+	    Memi[a1+i] = min (namax, max (1, nint (AP_CEN(ap,aaxis)+xmin+cmin)))
+	    Memi[a2+i] = max (1, min (namax, nint (AP_CEN(ap,aaxis)+xmax+cmax)))
+	    Memi[b1+i] = bmin
+	    Memi[b2+i] = bmax
+	    Memr[c1+i] = cmin
+	    Memr[c2+i] = cmax
+	}
+	call alimi (Memi[a], 2*napsex, amin, amax)
+	call alimi (Memi[b], 2*napsex, bmin, bmax)
+
+	# The maximum size of the image in memory is 80% of the maximum
+	# working set size returned by begmem or 40% if a profile image
+	# is used.  Later I/O may exceed this since at least one
+	# aperture + background is needed in memory.
+
+	new_size = begmem (0, old_size, max_size)
+	namax = (amax - amin + 1)
+	nb = (bmax - bmin + 1)
+	if (pim == NULL)
+	    namax = min (namax, int (0.8 * max_size / SZ_REAL / nb))
+	else
+	    namax = min (namax, int (0.8 * max_size / SZ_REAL / nb / 2))
+	best_size = 1.2 * namax * nb * SZ_REAL
+	new_size = begmem (best_size, old_size, max_size)
+
+	# Allocate auxilary memory.  Some memory is only dependent on the
+	# number of dispersion points and subapertures and is the same for
+	# all apertures.  Other memory, such as the sky and profile depend on
+	# the aperture widths and tilts which may vary.  The input data is
+	# expected to have the aperture axis along the first dimension.  If
+	# the image is in this orientation then the IMIO buffer is used.
+	# Otherwise sequential I/O is used and transposed into the allocated
+	# memory.
+
+	iferr {
+	    call salloc (astart, nb, TY_INT)
+	    call salloc (spec, nsubaps * nb, TY_REAL)
+	    if (weights == W_VARIANCE) {
+		call salloc (raw, nsubaps * nb, TY_REAL)
+		call salloc (specsig, nsubaps * nb, TY_REAL)
+	    } else {
+		raw = NULL
+		specsig = NULL
+	    }
+	    profile = NULL
+	    if (aaxis == 2) {
+		call calloc (dbuf, namax * nb, TY_REAL)
+		if (pim != NULL)
+		    call calloc (pbuf, namax * nb, TY_REAL)
+	    }
+
+	    # For variance weighting the computations are done in photon units.
+	    if (weights == W_VARIANCE) {
+		gain = apgimr ("gain", im)
+		rdnoise = apgimr ("readnoise", im)
+	    } else {
+		gain = 1
+		rdnoise = 0
+	    }
+
+	    # Loop through each aperture doing the extractions.
+	    amax = 0
+	    do i = 1, napsex {
+		ap = Memi[apsex+i-1]
+
+		# Check if a new input data buffer is needed.  As many apertures
+		# as possible are read at once within the given memory limits
+		# though at least one aperture must be read.  Do a transpose if
+		# needed.
+
+		if (Memi[a1+i] < amin || Memi[a2+i] > amax) {
+		    amin = Memi[a1+i]
+		    amax = Memi[a2+i]
+		    do j = i,  napsex {
+			amin = min (amin, Memi[a1+j]) 
+			amax = max (amax, Memi[a2+j]) 
+			na = amax - amin + 1
+			if (na > namax)
+			    break
+		    }
+
+		    if (aaxis == 1) {
+			if (fmt == DIFF) {
+			    call mfree (dbuf, TY_REAL)
+			    call malloc (dbuf, na*nb, TY_REAL)
+			    call amovr (Memr[imgs2r(im,amin,amax,bmin,bmax)],
+				Memr[dbuf], na*nb)
+			} else
+			    dbuf = imgs2r (im, amin, amax, bmin, bmax)
+		    } else {
+			if (na > namax) {
+			    call mfree (dbuf, TY_REAL)
+			    namax = na
+			    call calloc (dbuf, namax * nb, TY_REAL)
+			}
+			do j = amin, amax {
+			    sbuf = imgl2r (im, j)
+			    sbuf = sbuf + bmin - 1
+			    ptr = dbuf + j - amin
+			    do k = bmin, bmax {
+				Memr[ptr] = Memr[sbuf]
+				sbuf = sbuf + 1
+				ptr = ptr + na
+			    }
+			}
+		    }
+		    if (pim != NULL) {
+			if (aaxis == 1)
+			    pbuf = imgs2r (pim, amin, amax, bmin, bmax)
+			else {
+			    if (na > namax) {
+				call mfree (pbuf, TY_REAL)
+				namax = na
+				call calloc (pbuf, namax * nb, TY_REAL)
+			    }
+			    do j = amin, amax {
+				sbuf = imgl2r (pim, j)
+				sbuf = sbuf + bmin - 1
+				ptr = pbuf + j - amin
+				do k = bmin, bmax {
+				    Memr[ptr] = Memr[sbuf]
+				    sbuf = sbuf + 1
+				    ptr = ptr + na
+				}
+			    }
+			}
+		    }
+		    if (weights == W_VARIANCE && gain != 1.) {
+			j = na * nb
+			call amulkr (Memr[dbuf], gain, Memr[dbuf], j)
+			if (pim != NULL)
+			    call amulkr (Memr[pbuf], gain, Memr[pbuf], j)
+		    }
+		}
+
+		# To minimize memory a variable integer offset is used to
+		# accomodate the aperture tilts.  The offsets are stored in
+		# the astart array and the width of any one line determined.
+		# If a stored profile is used it is read and it is ASSUMED to
+		# be valid for the input aperture with the same ID.  If no
+		# stored profile is found the profile fitting algorithm
+		# parameter determines whether to fit 1D function along the
+		# image axes (in which case all the profile offsets are the
+		# same) or if the Marsh algorithm for tilted spectra is
+		# used.  In the latter the offsets can be adjusted to mimize
+		# memory and a buffer of two pixels around the aperture is
+		# required by the algorithm.
+
+		if (weights == W_NONE) {
+		    xmin = AP_CEN(ap,aaxis) + AP_LOW(ap,aaxis)
+		    xmax = AP_CEN(ap,aaxis) + AP_HIGH(ap,aaxis)
+		    xmin = xmin - interpbuf
+		    xmax = xmax + interpbuf
+		    na1 = nint (xmax) - nint (xmin) + 1
+		    cv = AP_CV(ap)
+		    do j = bmin, bmax {
+			shift = ap_cveval (cv, real (j))
+			Memi[astart+j-bmin] = nint (xmin + shift)
+		    }
+		} else {
+		    if (pfit == P_FIT1D) {
+			xmin = AP_CEN(ap,aaxis) + AP_LOW(ap,aaxis) + Memr[c1+i]
+			xmax = AP_CEN(ap,aaxis) + AP_HIGH(ap,aaxis) + Memr[c2+i]
+			xmin = xmin - interpbuf
+			xmax = xmax + interpbuf
+			na1 = nint (xmax) - nint (xmin) + 1
+			call amovki (nint (xmin), Memi[astart], nb)
+		    } else if (pfit == P_FIT2D) {
+			xmin = AP_CEN(ap,aaxis) + AP_LOW(ap,aaxis) - 2
+			xmax = AP_CEN(ap,aaxis) + AP_HIGH(ap,aaxis) + 2
+			xmin = xmin - interpbuf
+			xmax = xmax + interpbuf
+			na1 = nint (xmax) - nint (xmin) + 1
+			cv = AP_CV(ap)
+			do j = bmin, bmax {
+			    shift = ap_cveval (cv, real (j))
+			    Memi[astart+j-bmin] = nint (xmin + shift)
+			}
+		    }
+		}
+
+		# Do the sky or background determination if needed.  An array
+		# of the same size as the 2D aperture is returned as well as
+		# a single estimate of the variance in the sky value at each
+		# line based on the fit.  If a profile image is used then the
+		# sky is for the profile image and the object sky is
+		# determined later in order to reuse the sky buffers.
+
+		if (bkg != B_NONE && AP_IC(ap) != NULL) {
+		    call malloc (sbuf, na1 * nb, TY_REAL)
+		    call malloc (svar, nb, TY_REAL)
+		    call malloc (specsky, nsubaps * nb, TY_REAL)
+		    if (pim == NULL)
+			call ap_skyeval (im, ap, dbuf, na, nb, amin, 1,
+			    Memr[sbuf], Memr[svar], Memr[specsky], na1, nb,
+			    Memi[astart], 1, nsubaps, rdnoise)
+		    else
+			call ap_skyeval (pim, ap, pbuf, na, nb, amin, 1,
+			    Memr[sbuf], Memr[svar], Memr[specsky], na1, nb,
+			    Memi[astart], 1, nsubaps, rdnoise)
+		} else {
+		    sbuf = NULL
+		    svar = NULL
+		    specsky = NULL 
+		}
+
+		# Use a quick sum for unweighted extraction.  For weighed
+		# extractions we use either a previously determined profile
+		# or call the profile routine.  If desired the profile is
+		# stored for later use.  Then the variance weighted
+		# extraction routine is called.
+
+		if (weights == W_NONE)
+		    call ap_sum (ap, dbuf, na, nb, amin, 1, sbuf, na1, nb,
+			Memi[astart], 1, Memr[spec], nsubaps, asi)
+		else {
+		    call malloc (profile, na1 * nb, TY_REAL)
+		    if (pim == NULL)
+			call ap_profile (im, ap, dbuf, na, nb, amin, 1, sbuf,
+			    svar, Memr[profile], na1, nb, Memi[astart], 1,
+			    asi)
+		    else {
+			call ap_profile (pim, ap, pbuf, na, nb, amin, 1, sbuf,
+			    svar, Memr[profile], na1, nb, Memi[astart], 1,
+			    asi)
+			if (sbuf != NULL)
+			    call ap_skyeval (im, ap, dbuf, na, nb, amin, 1,
+				Memr[sbuf], Memr[svar], Memr[specsky], na1, nb,
+				Memi[astart], 1, nsubaps, rdnoise)
+		    }
+
+		    call ap_variance (im, ap, dbuf, na, nb, amin, 1, sbuf, svar,
+			Memr[profile], na1, nb, Memi[astart], 1, Memr[spec],
+			Memr[raw], Memr[specsig], nsubaps, asi)
+		}
+
+		# Output the extracted spectrum.  The extras of sky, sigma,
+		# and unweighted spectrum may also be stored.  If the extra
+		# information is not available the pointers will be NULL.
+
+		if (weights == W_VARIANCE && gain != 1.) {
+		    call adivkr (Memr[spec], gain, Memr[spec], nb)
+		    if (raw != NULL)
+			call adivkr (Memr[raw], gain, Memr[raw], nb)
+		    if (specsky != NULL)
+			call adivkr (Memr[specsky], gain, Memr[specsky], nb)
+		    if (specsig != NULL)
+			call adivkr (Memr[specsig], gain, Memr[specsig], nb)
+		    call amulkr (Memr[profile], gain, Memr[profile], nb*na1)
+		}
+
+		call ap_output (input, output, format, Memc[bkgstr],
+		    Memc[wtstr], Memc[cleanstr], gain, im, Memi[apsex], napsex,
+		    i, nsubaps, spec, raw, specsky, specsig, dbuf, na, nb, amin,
+		    1, sbuf, profile, na1, nb, Memi[astart], 1)
+
+		call mfree (profile, TY_REAL)
+		call mfree (sbuf, TY_REAL)
+		call mfree (svar, TY_REAL)
+		call mfree (specsky, TY_REAL)
+	    }
+
+	    # Finish up and restore the working set size.
+	    if (asi != NULL)
+		call asifree (asi)
+	    if (pim != NULL) {
+		if (aaxis == 2)
+		    call mfree (pbuf, TY_REAL)
+		call imunmap (pim)
+	    }
+	    if (aaxis == 2)
+		call mfree (dbuf, TY_REAL)
+	    call imunmap (im)
+	    call fixmem (old_size)
+	    call sfree (sp)
+
+	} then {
+	    call mfree (profile, TY_REAL)
+	    call mfree (sbuf, TY_REAL)
+	    call mfree (svar, TY_REAL)
+	    call mfree (specsky, TY_REAL)
+
+	    if (asi != NULL)
+		call asifree (asi)
+	    if (pim != NULL) {
+		if (aaxis == 2)
+		    call mfree (pbuf, TY_REAL)
+		call imunmap (pim)
+	    }
+	    if (aaxis == 2)
+		call mfree (dbuf, TY_REAL)
+	    call imunmap (im)
+	    call fixmem (old_size)
+	    call sfree (sp)
+
+	    call erract (EA_ERROR)
+	}
+end
+
+
+# AP_CHECK -- Check if output spectra exist.  If the user allows clobbering,
+# delete the spectra.  Return the format.
+
+int procedure ap_check (input, output, format, aps, naps, nsubaps)
+
+char	input[ARB]			# Input image name
+char	output[ARB]			# Output root name
+char	format[ARB]			# Output format
+pointer	aps[naps]			# Apertures
+int	naps				# Number of apertures
+int	nsubaps				# Number of subapertures
+
+int	i, j, fmt
+pointer	sp, name, name1, input1, ksection, ans
+
+int	strdic(), imaccess(), stridxs()
+bool	streq(), ap_answer()
+
+begin
+	call smark (sp)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (name1, SZ_LINE, TY_CHAR)
+	call salloc (input1, SZ_LINE, TY_CHAR)
+	call salloc (ksection, SZ_LINE, TY_CHAR)
+	call salloc (ans, SZ_LINE, TY_CHAR)
+
+	fmt = strdic (format, format, SZ_LINE, FORMATS)
+	call imgimage (input, Memc[input1], SZ_LINE)
+
+	switch (fmt) {
+	case MULTISPEC, NORM, FLAT, RATIO, DIFF, FIT:
+	    i = stridxs ("[", Memc[input1])
+	    if (i > 0) {
+		call strcpy (Memc[input1+i-1], Memc[ksection], SZ_LINE)
+		Memc[input1+i-1] = EOS
+	    } else
+		Memc[ksection] = EOS
+	    if (output[1] == EOS)
+	        call strcpy (Memc[input1], Memc[name], SZ_LINE)
+	    else
+	        call strcpy (output, Memc[name], SZ_LINE)
+
+	    switch (fmt) {
+	    case MULTISPEC:
+		if (streq (Memc[input1], Memc[name])) {
+	            call strcat (".ms", Memc[name], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name], SZ_LINE)
+		}
+	    case NORM:
+		if (streq (Memc[input1], Memc[name])) {
+	            call strcat (".norm", Memc[name], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name], SZ_LINE)
+		}
+	    case FLAT:
+		if (streq (Memc[input1], Memc[name])) {
+	            call strcat (".flat", Memc[name], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name], SZ_LINE)
+		}
+	    case RATIO:
+		if (streq (Memc[input1], Memc[name])) {
+	            call strcat (".ratio", Memc[name], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name], SZ_LINE)
+		}
+	    case DIFF:
+		if (streq (Memc[input1], Memc[name])) {
+	            call strcat (".diff", Memc[name], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name], SZ_LINE)
+		}
+	    case FIT:
+		if (streq (Memc[input1], Memc[name])) {
+	            call strcat (".fit", Memc[name], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name], SZ_LINE)
+		}
+	    }
+	    if (imaccess (Memc[name], 0) == YES) {
+		call sprintf (Memc[ans], SZ_LINE,
+		    "Clobber existing output image %s?")
+		    call pargstr (Memc[name])
+		if (ap_answer ("ansclobber1", Memc[ans]))
+		    call imdelete (Memc[name])
+		else {
+		    call sprintf (Memc[ans], SZ_LINE,
+			"EXTRACT - Output spectrum %s already exists")
+			call pargstr (Memc[name])
+		    call ap_log (Memc[ans], YES, NO, YES)
+		    fmt = 0
+		}
+	    }
+	case ECHELLE:
+	    if (output[1] == EOS)
+	        call strcpy (Memc[input1], Memc[name], SZ_LINE)
+	    else
+	        call strcpy (output, Memc[name], SZ_LINE)
+
+	    do i = 1, nsubaps {
+		if (nsubaps == 1)
+		    call strcpy (Memc[name], Memc[name1], SZ_LINE)
+		else {
+		    call sprintf (Memc[name1], SZ_LINE, "%s%0*d")
+			call pargstr (Memc[name])
+			call pargi (int(log10(real(nsubaps)))+1)
+			call pargi (i)
+		}
+		if (streq (Memc[input1], Memc[name])) {
+		    call strcat (".ec", Memc[name1], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name1], SZ_LINE)
+		}
+
+		if (imaccess (Memc[name1], 0) == YES) {
+		    call sprintf (Memc[ans], SZ_LINE,
+			"Clobber existing output image %s?")
+			call pargstr (Memc[name1])
+		    if (ap_answer ("ansclobber1", Memc[ans]))
+			call imdelete (Memc[name1])
+		    else {
+			call sprintf (Memc[ans], SZ_LINE,
+			    "EXTRACT - Output spectrum %s already exists")
+			    call pargstr (Memc[name1])
+			call ap_log (Memc[ans], YES, NO, YES)
+			fmt = 0
+		    }
+		}
+	    }
+	case ONEDSPEC, STRIP:
+	    do i = 1, naps {
+		do j = 1, nsubaps {
+		    call sprintf (Memc[name], SZ_LINE, "%s.%0*d")
+			if (output[1] == EOS)
+			    call pargstr (Memc[input1])
+			else
+			    call pargstr (output)
+			call pargi (int(log10(real(nsubaps)))+4)
+			call pargi (AP_ID(aps[i])+(j-1)*1000)
+		    if (imaccess (Memc[name], 0) == YES) {
+			call sprintf (Memc[ans], SZ_LINE,
+			    "Clobber existing output image %s?")
+			    call pargstr (Memc[name])
+			if (ap_answer ("ansclobber1", Memc[ans]))
+			    call imdelete (Memc[name])
+			else {
+			    call sprintf (Memc[ans], SZ_LINE,
+				"EXTRACT - Output spectrum %s already exists")
+				call pargstr (Memc[name])
+			    call ap_log (Memc[ans], YES, NO, YES)
+			    fmt = 0
+			}
+		    }
+		}
+	    }
+	case NOISE:
+	    ;
+	default:
+	    call sfree (sp)
+	    call error (1, "EXTRACT - Unknown output format")
+	}
+
+	call sfree (sp)
+	return (fmt)
+end
+
+
+# AP_OUTPUT -- Review the extracted spectra and write them to an image.
+# This routine determines the output format and whether to also output sky
+# unweighted, and sigma spectra.  The appropriate header keywords have
+# to be added.
+
+procedure ap_output (image, output, format, bkg, wt, clean, gain, in, aps,
+	naps, iap, nsubaps, spec, raw sky, sig, dbuf, nc, nl, c1, l1, sbuf,
+	profile, nx, ny, xs, ys)
+
+char	image[ARB]		# Input image name
+char	output[ARB]		# Output root name
+char	format[ARB]		# Output format
+char	bkg[ARB]		# Background type
+char	wt[ARB]			# Weight type
+char	clean[ARB]		# Clean?
+real	gain			# Gain
+pointer	in			# Input IMIO pointer
+pointer	aps[naps]		# Apertures
+int	naps			# Number of apertures
+int	iap			# Aperture
+int	nsubaps			# Number of subapertures
+pointer	spec			# Output spectrum
+pointer	raw			# Output raw spectrum
+pointer	sky			# Output sky
+pointer	sig			# Output sigma
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+pointer	sbuf			# Sky values (NULL if none)
+pointer	profile			# Profile (NULL if none)
+int	nx, ny			# Size of sky and profile array
+int	xs[ny], ys		# Origin of sky and profile array
+
+int	fmt			# Output format
+bool	extras			# Include raw spectrum, sky, and sigma
+
+real	low, high, step
+int	i, k, l, m, apid, apaxis, dispaxis
+pointer	sp, str, str1, name, name1, input, ksection
+pointer	ap, out, outsave, gt, apmw, buf
+pointer	sum2, sum4, nsum
+
+real	clgetr()
+int	scan(), strdic(), imaccf(), stridxs()
+bool	streq(), ap_answer(), apgetb()
+pointer	immap(), imgl2r(), impl2r(), impl3r()
+pointer	gt_init(), apmw_open()
+errchk	immap, impl2r, impl3r, imps2r, ap_strip, ap_pstrip, apmw_open
+errchk	ap_fitspec, ap_lnorm, ap_cnorm, ap_lflat, ap_cflat
+
+begin
+	# Allocate string and file name arrays.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (name1, SZ_LINE, TY_CHAR)
+	call salloc (input, SZ_LINE, TY_CHAR)
+	call salloc (ksection, SZ_LINE, TY_CHAR)
+
+	fmt = strdic (format, format, SZ_LINE, FORMATS)
+	extras = apgetb ("extras")
+
+	ap = aps[iap]
+	apaxis = AP_AXIS(ap)
+	dispaxis = mod (apaxis, 2) + 1
+
+	# Set output name.
+	call imgimage (image, Memc[input], SZ_LINE)
+	i = stridxs ("[", Memc[input])
+	if (i > 0) {
+	    call strcpy (Memc[input+i-1], Memc[ksection], SZ_LINE)
+	    Memc[input+i-1] = EOS
+	    i = stridxs ("]", Memc[ksection])
+	    call strcpy (",append]", Memc[ksection+i-1], SZ_LINE)
+	} else
+	    Memc[ksection] = EOS
+	if (output[1] == EOS)
+	    call strcpy (Memc[input], Memc[name], SZ_LINE)
+	else
+	    call strcpy (output, Memc[name], SZ_LINE)
+
+	switch (fmt) {
+	case ECHELLE:
+	    ;
+	case MULTISPEC:
+	    if (streq (Memc[input], Memc[name])) {
+		call strcat (".ms", Memc[name], SZ_LINE)
+		call strcat (Memc[ksection], Memc[name], SZ_LINE)
+	    }
+	case NORM:
+	    if (streq (Memc[input], Memc[name])) {
+	        call strcat (".norm", Memc[name], SZ_LINE)
+		call strcat (Memc[ksection], Memc[name], SZ_LINE)
+	    }
+	case FLAT:
+	    if (streq (Memc[input], Memc[name])) {
+	        call strcat (".flat", Memc[name], SZ_LINE)
+		call strcat (Memc[ksection], Memc[name], SZ_LINE)
+	    }
+	case RATIO:
+	    if (streq (Memc[input], Memc[name])) {
+	        call strcat (".ratio", Memc[name], SZ_LINE)
+		call strcat (Memc[ksection], Memc[name], SZ_LINE)
+	    }
+	case DIFF:
+	    if (streq (Memc[input], Memc[name])) {
+	        call strcat (".diff", Memc[name], SZ_LINE)
+		call strcat (Memc[ksection], Memc[name], SZ_LINE)
+	    }
+	case FIT:
+	    if (streq (Memc[input], Memc[name])) {
+	        call strcat (".fit", Memc[name], SZ_LINE)
+		call strcat (Memc[ksection], Memc[name], SZ_LINE)
+	    }
+	case NOISE:
+	    Memc[name] = EOS
+	}
+
+
+	# Set the review graph title.
+	call sprintf (Memc[str], SZ_LINE, "%s: %s - Aperture %s")
+	    call pargstr (image)
+	    call pargstr (IM_TITLE(in))
+	    call pargi (AP_ID(ap))
+
+	gt = gt_init ()
+	call gt_sets (gt, GTTITLE, Memc[str])
+
+	# Query the user whether to review the extraction.
+	call sprintf (Memc[str], SZ_LINE,
+	    "Review extracted spectrum for aperture %d from %s?")
+	    call pargi (AP_ID(ap))
+	    call pargstr (image)
+
+	# If reviewing graph the spectrum, do a cursor loop, and allow
+	# the user to skip the output or define a new output image.
+	if (ap_answer ("ansreview1", Memc[str])) {
+	    call ap_graph1 (gt, Memr[spec], ny, nsubaps)
+	    
+	    if (fmt == ONEDSPEC && nsubaps == 1) {
+	        call printf (
+		    "Output image name [use # to skip output] (%s): ")
+		    call pargstr (Memc[name])
+		call flush (STDOUT)
+	        if (scan() != EOF) {
+	            call gargwrd (Memc[str], SZ_LINE)
+	            if (Memc[str] == '#') {
+			call gt_free (gt)
+			call sfree (sp)
+		        return
+		    }
+	            if (Memc[str] != EOS)
+		        call strcpy (Memc[str], Memc[name], SZ_LINE)
+		}
+	    }
+	}
+
+	# Output the image.
+	switch (fmt) {
+	case MULTISPEC:
+	    if (iap == 1) {
+		out = immap (Memc[name], NEW_COPY, in)
+
+		IM_PIXTYPE(out) = TY_REAL
+		IM_NDIM(out) = 1
+		IM_LEN(out, 1) = ny
+		IM_LEN(out, 2) = nsubaps * naps
+		IM_LEN(out, 3) = 1
+		if (extras) {
+		    if (sky != NULL)
+		        IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		    if (raw != NULL)
+		        IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		    if (sig != NULL)
+		        IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		}
+		if (IM_LEN(out, 2) > 1)
+		    IM_NDIM(out) = 2
+		if (IM_LEN(out, 3) > 1)
+		    IM_NDIM(out) = 3
+
+		apmw = apmw_open (in, out, dispaxis, nsubaps*naps, ny)
+
+		# Write BAND IDs.
+		k = 1
+		call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+		    call pargi (k)
+		call sprintf (Memc[str], SZ_LINE,
+		    "spectrum - background %s, weights %s, clean %s")
+		    call pargstr (bkg)
+		    call pargstr (wt)
+		    call pargstr (clean)
+		call imastr (out, Memc[str1], Memc[str])
+		k = k + 1
+		if (extras) {
+		    if (raw != NULL) {
+			call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			call sprintf (Memc[str], SZ_LINE,
+			    "raw - background %s, weights none, clean no")
+			    call pargstr (bkg)
+			call imastr (out, Memc[str1], Memc[str])
+			k = k + 1
+		    }
+		    if (sky != NULL) {
+			call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			call sprintf (Memc[str], SZ_LINE,
+			    "background - background %s")
+			    call pargstr (bkg)
+			call imastr (out, Memc[str1], Memc[str])
+			k = k + 1
+		    }
+		    if (sig != NULL) {
+			call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			call sprintf (Memc[str], SZ_LINE,
+			    "sigma - background %s, weights %s, clean %s")
+			    call pargstr (bkg)
+			    call pargstr (wt)
+			    call pargstr (clean)
+			call imastr (out, Memc[str1], Memc[str])
+		    }
+		}
+
+		do k = 1, naps {
+		    low = AP_CEN(aps[k],apaxis) + AP_LOW(aps[k],apaxis)
+		    high = AP_CEN(aps[k],apaxis) + AP_HIGH(aps[k],apaxis)
+		    step = (high - low) / nsubaps
+		    low = low - step
+		    do l = 1, nsubaps {
+			apid = AP_ID(aps[k]) + (l - 1) * 1000
+			low = low + step
+			high = low + step
+			call apmw_setap (apmw, (k-1)*nsubaps+l,
+			    apid, AP_BEAM(aps[k]), low, high)
+		    }
+		}
+		do k = 1, naps {
+		    if (AP_TITLE(aps[k]) != NULL) {
+			do l = 1, nsubaps {
+			    call sprintf (Memc[str], SZ_LINE, "APID%d")
+				call pargi ((k-1)*nsubaps+l)
+		    	    call imastr (out, Memc[str],
+				Memc[AP_TITLE(aps[k])])
+			}
+		    }
+		}
+	    }
+	
+	    do l = 1, nsubaps {
+		k = (iap - 1) * nsubaps + l
+		buf = impl2r (out, k)
+	        call amovr (Memr[spec+(l-1)*ny], Memr[buf], ny)
+		if (extras) {
+		    m = 2
+		    if (raw != NULL) {
+			buf = impl3r (out, k, m)
+	                call amovr (Memr[raw+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		    if (sky != NULL) {
+			buf = impl3r (out, k, m)
+	                call amovr (Memr[sky+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		    if (sig != NULL) {
+			buf = impl3r (out, k, m)
+	                call amovr (Memr[sig+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		}
+	    }
+	    if (iap == naps) {
+		call apmw_saveim (apmw, out, fmt)
+		call apmw_close (apmw)
+	        call imunmap (out)
+	    }
+
+	    if (Memc[name] != EOS) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s")
+		    call pargi (AP_ID(ap))
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		call ap_log (Memc[str], YES, YES, NO)
+		call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+	    }
+
+	case ECHELLE:
+	    do l = 1, nsubaps {
+		if (nsubaps == 1)
+		    call strcpy (Memc[name], Memc[name1], SZ_LINE)
+		else {
+		    call sprintf (Memc[name1], SZ_LINE, "%s%0*d")
+			call pargstr (Memc[name])
+			call pargi (int(log10(real(nsubaps)))+1)
+			call pargi (l)
+		}
+		if (streq (Memc[input], Memc[name])) {
+		    call strcat (".ec", Memc[name1], SZ_LINE)
+		    call strcat (Memc[ksection], Memc[name1], SZ_LINE)
+		}
+
+		if (iap == 1) {
+		    out = immap (Memc[name1], NEW_COPY, in)
+
+		    IM_PIXTYPE(out) = TY_REAL
+		    IM_NDIM(out) = 1
+		    IM_LEN(out, 1) = ny
+		    IM_LEN(out, 2) = naps
+		    IM_LEN(out, 3) = 1
+		    if (extras) {
+			if (sky != NULL)
+			    IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+			if (raw != NULL)
+			    IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+			if (sig != NULL)
+			    IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		    }
+		    if (IM_LEN(out, 2) > 1)
+			IM_NDIM(out) = 2
+		    if (IM_LEN(out, 3) > 1)
+			IM_NDIM(out) = 3
+
+		    apmw = apmw_open (in, out, dispaxis, naps, ny)
+
+		    # Write BAND IDs.
+		    k = 1
+		    call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			call pargi (k)
+		    call sprintf (Memc[str], SZ_LINE,
+			"spectrum - background %s, weights %s, clean %s")
+			call pargstr (bkg)
+			call pargstr (wt)
+			call pargstr (clean)
+		    call imastr (out, Memc[str1], Memc[str])
+		    k = k + 1
+		    if (extras) {
+			if (raw != NULL) {
+			    call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+				call pargi (k)
+			    call sprintf (Memc[str], SZ_LINE,
+				"raw - background %s, weights none, clean no")
+				call pargstr (bkg)
+			    call imastr (out, Memc[str1], Memc[str])
+			    k = k + 1
+			}
+			if (sky != NULL) {
+			    call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+				call pargi (k)
+			    call sprintf (Memc[str], SZ_LINE,
+				"background - background %s")
+				call pargstr (bkg)
+			    call imastr (out, Memc[str1], Memc[str])
+			    k = k + 1
+			}
+			if (sig != NULL) {
+			    call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+				call pargi (k)
+			    call sprintf (Memc[str], SZ_LINE,
+				"sigma - background %s, weights %s, clean %s")
+				call pargstr (bkg)
+				call pargstr (wt)
+				call pargstr (clean)
+			    call imastr (out, Memc[str1], Memc[str])
+			}
+		    }
+
+		    # Write keyword to allow matching by subaperture.
+		    if (nsubaps > 1)
+			call imaddi (out, "SUBAP", l)
+
+		    do k = 1, naps {
+			low = AP_CEN(aps[k],apaxis) + AP_LOW(aps[k],apaxis)
+			high = AP_CEN(aps[k],apaxis) + AP_HIGH(aps[k],apaxis)
+			step = (high - low) / nsubaps
+			call apmw_setap (apmw, k, AP_ID(aps[k]),
+			    AP_BEAM(aps[k]), low+(l-1)*step, low+l*step)
+		    }
+		    do k = 1, naps {
+			if (AP_TITLE(aps[k]) != NULL) {
+			    call sprintf (Memc[str], SZ_LINE, "APID%d")
+				call pargi (k)
+			    call imastr (out, Memc[str],
+				Memc[AP_TITLE(aps[k])])
+			}
+		    }
+		} else {
+		    if (l == 1)
+			out = outsave
+		    else
+			out = immap (Memc[name1], READ_WRITE, 0)
+		}
+	    
+		k = iap
+		buf = impl2r (out, k)
+		call amovr (Memr[spec+(l-1)*ny], Memr[buf], ny)
+		if (extras) {
+		    m = 2
+		    if (raw != NULL) {
+			buf = impl3r (out, k, m)
+			call amovr (Memr[raw+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		    if (sky != NULL) {
+			buf = impl3r (out, k, m)
+			call amovr (Memr[sky+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		    if (sig != NULL) {
+			buf = impl3r (out, k, m)
+			call amovr (Memr[sig+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		}
+
+		if (iap == 1) {
+		    call apmw_saveim (apmw, out, fmt)
+		    call apmw_close (apmw)
+		}
+		if (l != 1 || iap == naps)
+		    call imunmap (out)
+		if (l == 1)
+		    outsave = out
+
+		if (nsubaps == 1) {
+		    call sprintf (Memc[str], SZ_LINE,
+			"EXTRACT - Aperture %d from %s --> %s")
+			call pargi (AP_ID(ap))
+			call pargstr (image)
+			call pargstr (Memc[name1])
+		} else {
+		    call sprintf (Memc[str], SZ_LINE,
+			"EXTRACT - Aperture %d-%d from %s --> %s")
+			call pargi (AP_ID(ap))
+			call pargi (l)
+			call pargstr (image)
+			call pargstr (Memc[name1])
+		}
+		call ap_log (Memc[str], YES, YES, NO)
+	    }
+
+	    call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+			
+	case ONEDSPEC:
+	    do l = 1, nsubaps {
+		apid = AP_ID(ap) + (l - 1) * 1000
+		low = AP_CEN(ap,apaxis) + AP_LOW(ap,apaxis)
+		high = AP_CEN(ap,apaxis) + AP_HIGH(ap,apaxis)
+		step = (high - low) / nsubaps
+		low = low + (l - 1) * step
+		high = low + step
+
+		call sprintf (Memc[str], SZ_LINE, "%s.%0*d")
+		    call pargstr (Memc[name])
+		    call pargi (int(log10(real(nsubaps)))+4)
+		    call pargi (apid)
+		out = immap (Memc[str], NEW_COPY, in)
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s.%0*d")
+		    call pargi (apid)
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		    call pargi (int(log10(real(nsubaps)))+4)
+		    call pargi (apid)
+		call ap_log (Memc[str], YES, YES, NO)
+
+		apmw = apmw_open (in, out, dispaxis, 1, ny)
+		call apmw_setap (apmw, 1, apid, AP_BEAM(ap), low, high)
+		if (AP_TITLE(ap) != NULL)
+		    call imastr (out, "APID1", Memc[AP_TITLE(ap)])
+
+		IM_PIXTYPE(out) = TY_REAL
+		IM_NDIM(out) = 1
+		IM_LEN(out, 1) = ny
+		IM_LEN(out, 2) = 1
+		IM_LEN(out, 3) = 1
+		if (extras) {
+		    if (sky != NULL)
+			IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		    if (raw != NULL)
+			IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		    if (sig != NULL)
+			IM_LEN(out, 3) = IM_LEN(out, 3) + 1
+		}
+		if (IM_LEN(out, 2) > 1)
+		    IM_NDIM(out) = 2
+		if (IM_LEN(out, 3) > 1)
+		    IM_NDIM(out) = 3
+
+		# Write BAND IDs.
+		k = 1
+		call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+		    call pargi (k)
+		call sprintf (Memc[str], SZ_LINE,
+		    "spectrum: background %s, weights %s, clean %s")
+		    call pargstr (bkg)
+		    call pargstr (wt)
+		    call pargstr (clean)
+		call imastr (out, Memc[str1], Memc[str])
+		k = k + 1
+		if (extras) {
+		    if (raw != NULL) {
+			call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			call sprintf (Memc[str], SZ_LINE,
+			    "spectrum: background %s, weights none, clean no")
+			    call pargstr (bkg)
+			call imastr (out, Memc[str1], Memc[str])
+			k = k + 1
+		    }
+		    if (sky != NULL) {
+			call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			call sprintf (Memc[str], SZ_LINE,
+			    "background: background %s")
+			    call pargstr (bkg)
+			call imastr (out, Memc[str1], Memc[str])
+			k = k + 1
+		    }
+		    if (sig != NULL) {
+			call sprintf (Memc[str1], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			call sprintf (Memc[str], SZ_LINE,
+			    "sigma - background %s, weights %s, clean %s")
+			    call pargstr (bkg)
+			    call pargstr (wt)
+			    call pargstr (clean)
+			call imastr (out, Memc[str1], Memc[str])
+		    }
+		}
+
+		buf = impl2r (out, 1)
+	        call amovr (Memr[spec+(l-1)*ny], Memr[buf], ny)
+		if (extras) {
+		    m = 2
+		    if (raw != NULL) {
+			buf = impl3r (out, 1, m)
+	                call amovr (Memr[raw+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		    if (sky != NULL) {
+			buf = impl3r (out, 1, m)
+	                call amovr (Memr[sky+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		    if (sig != NULL) {
+			buf = impl3r (out, 1, m)
+	                call amovr (Memr[sig+(l-1)*ny], Memr[buf], ny)
+			m = m + 1
+		    }
+		}
+
+		call apmw_saveim (apmw, out, fmt)
+		call apmw_close (apmw)
+		call imunmap (out)
+
+	    }
+
+	    call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+
+	case STRIP:
+	    do l = 1, nsubaps {
+		apid = AP_ID(ap) + (l - 1) * 1000
+		low = AP_CEN(ap,apaxis) + AP_LOW(ap,apaxis)
+		high = AP_CEN(ap,apaxis) + AP_HIGH(ap,apaxis)
+		step = (high - low) / nsubaps
+		low = low + (l - 1) * step
+		high = low + step
+
+		call sprintf (Memc[str], SZ_LINE, "%s.%0*d")
+		    call pargstr (Memc[name])
+		    call pargi (int(log10(real(nsubaps)))+4)
+		    call pargi (apid)
+		out = immap (Memc[str], NEW_COPY, in)
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s.%0*d")
+		    call pargi (apid)
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		    call pargi (int(log10(real(nsubaps)))+4)
+		    call pargi (apid)
+		call ap_log (Memc[str], YES, YES, NO)
+
+		apmw = apmw_open (in, out, dispaxis, 1, ny)
+		call apmw_setap (apmw, 1, apid, AP_BEAM(ap), low, high)
+		call sprintf (Memc[str], SZ_LINE, "%s - Aperture %d")
+		    call pargstr (IM_TITLE(out))
+		    call pargi (AP_ID(ap))
+		call strcpy (Memc[str], IM_TITLE(out), SZ_IMTITLE)
+		if (AP_TITLE(ap) != NULL)
+		    call imastr (out, "APID1", Memc[AP_TITLE(ap)])
+
+		IM_PIXTYPE(out) = TY_REAL
+		IM_NDIM(out) = 2
+		IM_LEN(out, 1) = ny
+		IM_LEN(out, 2) = high - low + 1
+
+		if (profile == NULL)
+		    call ap_strip (ap, low, high, out, dbuf, nc, nl, c1, l1,
+			sbuf, nx, ny, xs, ys)
+		else
+		    call ap_pstrip (ap, low, high, out, gain, Memr[spec],
+			Memr[profile], nx, ny, xs, ys)
+
+		call apmw_saveim (apmw, out, fmt)
+		call apmw_close (apmw)
+		call imunmap (out)
+	    }
+
+	    call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+
+	case NORM, FLAT:
+	    if (iap == 1) {
+	        out = immap (Memc[name], NEW_COPY, in)
+	        IM_PIXTYPE(out) = TY_REAL
+		if (imaccf (out, "CCDMEAN") == YES)
+		    call imdelf (out, "CCDMEAN")
+	        call ap_fitspec (ap, in, Memr[spec], ny)
+		k = YES
+	    } else {
+	        call ap_fitspec (ap, in, Memr[spec], ny)
+		k = NO
+	    }
+	    if (apaxis == 1) {
+		if (fmt == NORM)
+		    call ap_lnorm (ap, out, gain, dbuf, nc, nl, c1, l1,
+			Memr[spec], ny, ys, k)
+		else
+		    call ap_lflat (ap, out, dbuf, nc, nl, c1, l1, Memr[spec],
+		        sbuf, Memr[profile], nx, ny, xs, ys, k)
+	    } else {
+		if (fmt == NORM)
+		    call ap_cnorm (ap, out, gain, dbuf, nc, nl, c1, l1,
+			Memr[spec], ny, ys, k)
+		else
+		    call ap_cflat (ap, out, dbuf, nc, nl, c1, l1, Memr[spec],
+		        sbuf, Memr[profile], nx, ny, xs, ys, k)
+	    }
+	    if (iap == naps)
+	        call imunmap (out)
+
+	    if (Memc[name] != EOS) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s")
+		    call pargi (AP_ID(ap))
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		call ap_log (Memc[str], YES, YES, NO)
+		call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+	    }
+
+	case RATIO, FIT:
+	    if (iap == 1) {
+		out = immap (Memc[name], NEW_COPY, in)
+	        IM_PIXTYPE(out) = TY_REAL
+		k = YES
+	    } else
+		k = NO
+	    if (apaxis == 1) {
+		switch (fmt) {
+		case RATIO:
+		    call ap_lflat (ap, out, dbuf, nc, nl, c1, l1, Memr[spec],
+		        sbuf, Memr[profile], nx, ny, xs, ys, k)
+		case FIT:
+		    call ap_lfit (ap, out, gain, Memr[spec], Memr[profile],
+			nx, ny, xs, ys, k)
+		}
+	    } else {
+		switch (fmt) {
+		case RATIO:
+		    call ap_cflat (ap, out, dbuf, nc, nl, c1, l1, Memr[spec],
+		        sbuf, Memr[profile], nx, ny, xs, ys, k)
+		case FIT:
+		    call ap_cfit (ap, out, gain, Memr[spec], Memr[profile],
+			nx, ny, xs, ys, k)
+		}
+	    }
+	    if (iap == naps)
+	        call imunmap (out)
+
+	    if (Memc[name] != EOS) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s")
+		    call pargi (AP_ID(ap))
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		call ap_log (Memc[str], YES, YES, NO)
+		call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+	    }
+
+	case DIFF:
+	    if (iap == 1) {
+	        out = immap (Memc[name], NEW_COPY, in)
+	        IM_PIXTYPE(out) = TY_REAL
+		do k = 1, IM_LEN(in,2) {
+		    buf = impl2r (out, k)
+		    call amovr (Memr[imgl2r(in,k)], Memr[buf], IM_LEN(out,1))
+		}
+		k = NO
+	    } else
+		k = NO
+	    if (apaxis == 1)
+		call ap_ldiff (ap, out, gain, dbuf, nc, nl, c1, l1, Memr[spec],
+		    Memr[profile], nx, ny, xs, ys, k)
+	    else
+		call ap_cdiff (ap, out, gain, dbuf, nc, nl, c1, l1, Memr[spec],
+		    Memr[profile], nx, ny, xs, ys, k)
+	    if (iap == naps)
+	        call imunmap (out)
+
+	    if (Memc[name] != EOS) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s")
+		    call pargi (AP_ID(ap))
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		call ap_log (Memc[str], YES, YES, NO)
+		call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+	    }
+
+	case NOISE:
+	    if (iap == 1) {
+		low = clgetr ("dmin")
+		high = clgetr ("dmax")
+		l = clgetr ("nbins")
+		if (high < low) {
+		    step = low; low = high; high = step
+		}
+		step = (high - low) / l
+		call malloc (sum2, l, TY_REAL)
+		call malloc (sum4, l, TY_REAL)
+		call malloc (nsum, l, TY_INT)
+		call aclrr (Memr[sum2], l)
+		call aclrr (Memr[sum4], l)
+		call aclri (Memi[nsum], l)
+	    }
+	    call ap_noise (ap, gain, dbuf, nc, nl, c1, l1, sbuf, Memr[spec],
+		Memr[profile], nx, ny, xs, ys, Memr[sum2], Memr[sum4],
+		Memi[nsum], l, low, high)
+	    if (iap == naps) {
+		do k = 0, l-1 {
+		    m = Memi[nsum+k]
+		    if (m > 10) {
+			Memr[sum2+k] = sqrt (Memr[sum2+k] / (m - 1))
+			step = max (0., Memr[sum4+k] / m - Memr[sum2+k]**2)
+			Memr[sum4+k] = sqrt (sqrt (step / m))
+		    } else {
+			Memr[sum2+k] = 0.
+			Memr[sum4+k] = 0.
+		    }
+		}
+		call ap_nplot (image, in, Memr[sum2], Memr[sum4], l,
+		    low, high)
+		call mfree (sum2, TY_REAL)
+		call mfree (sum4, TY_REAL)
+		call mfree (nsum, TY_INT)
+	    }
+
+	    if (Memc[name] != EOS) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT - Aperture %d from %s --> %s")
+		    call pargi (AP_ID(ap))
+		    call pargstr (image)
+		    call pargstr (Memc[name])
+		call ap_log (Memc[str], YES, YES, NO)
+		call ap_plot1 (gt, Memr[spec], ny, nsubaps)
+	    }
+	}
+
+	call gt_free (gt)
+	call sfree (sp)
+end
+
+
+# AP_SUM -- Simple, unweighted aperture sum.
+
+procedure ap_sum (ap, dbuf, nc, nl, c1, l1, sbuf, nx, ny, xs, ys, spec,
+	nsubaps, asi)
+
+pointer	ap			# Aperture structure
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+pointer	sbuf			# Sky values (NULL if none)
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Origin of sky array
+real	spec[ny, nsubaps]	# Spectrum
+int	nsubaps			# Number of subapertures
+pointer	asi			# Interpolator for edge pixel weighting
+
+int	i, ix, iy, ix1, ix2
+real	low, high, step, x1, x2, wt1, wt2, s, sval, skyval
+real	ap_cveval()
+pointer	cv, data, sky
+errchk	asifit
+
+begin
+	i = AP_AXIS(ap)
+	low = AP_CEN(ap,i) + AP_LOW(ap,i)
+	high = AP_CEN(ap,i) + AP_HIGH(ap,i)
+	step = (high - low) / nsubaps
+	cv = AP_CV(ap)
+	do iy = 1, ny {
+	    s = ap_cveval (cv, real (iy + ys - 1)) - c1 + 1
+	    call ap_asifit (dbuf+(iy+ys-1-l1)*nc, nc, xs[iy]-c1+1,
+		low+s, high+s, data, asi)
+#	    data = dbuf + (iy + ys - 1 - l1) * nc + xs[iy] - c1 - 1
+#	    if (asi != NULL)
+#		call asifit (asi, Memr[data], nc-xs[iy]+c1)
+	    do i = 1, nsubaps {
+	        x1 = max (0.5, low + (i - 1) * step + s) + c1 - xs[iy]
+	        x2 = min (nc + 0.49, low + i * step + s) + c1 - xs[iy]
+	        if (x2 <= x1) {
+		    spec[iy,i] = 0.
+		    next
+	        }
+	        ix1 = nint (x1)
+	        ix2 = nint (x2)
+
+		# Compute end pixel weights.  Remember asi is offset by 1.
+		call ap_edge (asi, x1+1, x2+1, wt1, wt2)
+
+		# Sum pixels.
+		sval = wt1 * Memr[data+ix1] + wt2 * Memr[data+ix2]
+		do ix = ix1+1, ix2-1
+		    sval = sval + Memr[data+ix]
+
+		# Subtract sky if desired.
+	        if (sbuf != NULL) {
+		    sky = sbuf + (iy - 1) * nx - 1
+		    skyval = wt1 * Memr[sky+ix1] + wt2 * Memr[sky+ix2]
+	            do ix = ix1+1, ix2-1
+		        skyval = skyval + Memr[sky+ix]
+		    sval = sval - skyval
+	        }
+
+		# Save extracted pixel value.
+		spec[iy,i] = sval
+	    }
+	}
+end
+
+
+# AP_EDGE -- Compute edge weights.
+
+procedure ap_edge (asi, x1, x2, wt1, wt2)
+
+pointer	asi			#I Image interpolator pointer
+real	x1, x2			#I Aperture edges
+real	wt1, wt2		#I Weights
+
+int	ix1, ix2
+real	a, b
+real	asieval(), asigrl()
+
+begin
+	    # Edge pixel centers.
+	    ix1 = nint (x1)
+	    ix2 = nint (x2)
+
+	    # Default weights are fractions of pixel.
+	    if (ix1 == ix2) {
+		wt1 = (x2 - x1)
+		wt2 = 0
+	    } else {
+		wt1 = (ix1 - x1 + 0.5)
+		wt2 = (x2 - ix2 + 0.5)
+	    }
+
+	    # If there is an interpolator compute fraction of integral.
+	    # We require that data and integrals be positive.
+	    if (asi != NULL) {
+		if (asieval (asi, real(ix1)) > 0) {
+		    b = asigrl (asi, ix1-0.5, ix1+0.5)
+		    if (b > 0) {
+			if (ix1 == ix2)
+			    a = asigrl (asi, x1, x2)
+			else
+			    a = asigrl (asi, x1, ix1+0.5)
+			if (a > 0 && a < b)
+			    wt1 = a / b
+		    }
+		}
+		if (ix1 != ix2 && asieval (asi, real(ix2)) > 0) {
+		    b = asigrl (asi, ix2-0.5, ix2+0.5)
+		    if (b > 0) {
+			a = asigrl (asi, ix2-0.5, x2)
+			if (a > 0 && a < b)
+			    wt2 = a / b
+		    }
+		}
+	    }
+end
+
+
+# AP_STRIP -- Simple, unweighted aperture strip.
+# Interpolate so that the lower edge of the aperture is the first pixel.
+
+procedure ap_strip (ap, aplow, aphigh, out, dbuf, nc, nl, c1, l1, sbuf, nx, ny,
+	xs, ys)
+
+pointer	ap			# Aperture structure
+real	aplow, aphigh		# Aperture limits
+pointer	out			# Output IMIO pointer
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+pointer	sbuf			# Sky values (NULL if none)
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Origin of sky array
+
+int	i, na, iy, ix1, ix2, nasi
+real	low, high, s, x, ap_cveval(), asieval()
+pointer	obuf, cv, asi, data, sky, ptr, imps2r()
+
+begin
+	i = AP_AXIS(ap)
+	low = aplow - c1 + 1
+	high = aphigh - c1 + 1
+	cv = AP_CV(ap)
+	call asiinit (asi, II_LINEAR)
+
+	na = IM_LEN(out,2)
+	obuf = imps2r (out, 1, ny, 1, na)
+	call aclrr (Memr[obuf], na * ny)
+
+	do iy = 1, ny {
+	    i = iy + ys - 1
+	    s = ap_cveval (cv, real (i))
+	    ix1 = max (1, nint (low + s) - 1)
+	    ix2 = min (nc, nint (high + s) + 1)
+	    nasi = ix2 - ix1 + 1
+	    if (nasi < 3)
+		next
+	    data = dbuf + (i - l1) * nc + ix1 - 1
+	    iferr (call asifit (asi, Memr[data], nasi))
+		next
+	    
+	    x = low + s - ix1 + 1
+	    ptr = obuf + iy - 1
+	    if (sbuf == NULL) {
+	        do i = 1, na {
+		    if (x >= 1 && x <= nasi)
+		        Memr[ptr] = asieval (asi, x)
+		    x = x + 1.
+		    ptr = ptr + ny
+	        }
+	    } else {
+		sky = sbuf + (iy - 1) * nx + nint (low + s) - xs[iy] + c1 - 2
+	        do i = 1, na {
+		    if (x >= 1 && x <= nasi)
+		        Memr[ptr] = asieval (asi, x) - Memr[sky+i]
+		    x = x + 1.
+		    ptr = ptr + ny
+	        }
+	    }
+	}
+
+	call asifree (asi)
+end
+
+
+# AP_PSTRIP -- Profile based strip.
+# Interpolate the profile spectrum so that the lower aperture edge is the
+# first pixel.
+
+procedure ap_pstrip (ap, aplow, aphigh, out, gain, spec, profile, nx, ny,
+	xs, ys)
+
+pointer	ap			# Aperture structure
+real	aplow, aphigh		# Aperture limits
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+real	spec[ny]		# Spectrum
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Origin of profile array
+
+int	na, ix, iy
+real	low, high, s, x, ap_cveval(), asieval()
+pointer	sp, cv, asi, data, impl2r()
+
+begin
+	call smark (sp)
+	call salloc (data, nx, TY_REAL)
+
+	ix = AP_AXIS(ap)
+	low = aplow
+	high = aphigh
+	cv = AP_CV(ap)
+	na = IM_LEN(out,2)
+	call asiinit (asi, II_LINEAR)
+
+	do iy = 1, ny {
+	    s = spec[iy] / gain
+	    do ix = 1, nx
+		Memr[data+ix-1] = s * profile[iy,ix]
+	    call asifit (asi, Memr[data], nx)
+	    s = ap_cveval (cv, real (iy+ys-1)) - xs[iy] + 1
+	    x = low + s
+	    do ix = 1, na {
+		profile[iy,ix] = asieval (asi, x)
+		x = x + 1
+	    }
+	}
+
+	do ix = 1, na
+	    call amovr (profile[1,ix], Memr[impl2r(out,ix)], ny)
+
+	call asifree (asi)
+end
+
+
+# AP_ASIFIT -- Return interpolation pointer and data pointer.
+#
+# The main reason for this routine is to shift the origin of the data by
+# one pixel so that the interpolator may be called to evaluate across
+# the extent of the first and last pixels.  This means the calling program
+# will reference asi fit between 1.5 and N+1.5.  It also means the returned
+# data pointer may start before the first point but will never be
+# dereferenced outside of the data range.
+
+procedure ap_asifit (dbuf, nc, xs, low, high, data, asi)
+
+pointer	dbuf			#I Data buffer pointer
+int	nc			#I Size of data buffer
+int	xs			#I Start of aperture array (in dbuf coords)
+real	low			#I Low aperture edge (in dbuf coords)
+real	high			#I High aperture edge (in dbuf coords)
+pointer	data			#O Data pointer
+pointer	asi			#I ASI pointer
+
+int	i, ix1, ix2, n
+real	x1, x2
+pointer	fit
+
+begin
+	# Check for in bounds data.
+	x1 = max (0.5, low)
+	x2 = min (nc + 0.49, high)
+	if (x1 >= x2)
+	    return
+
+	# Set data pointer relative to the aperture start with an offset for
+	# one indexing; i.e. pixel i is referenced as Memr[data+i].  The
+	# aperture start may put this outside the data buffer but we expect
+	# routines using the pointer to never index outside of the buffer.
+
+	data = (dbuf + xs - 1) - 1
+
+	# If not using an interpolator we are done.
+
+	if (asi == NULL)
+	    return
+
+	# If the aperture, with one extra pixel on each end for integration
+	# across the end pixel, is within the data buffer then fit an
+	# interpolator directly.  Otherwise we need to use a temporary
+	# padded buffer.  The origin of the fitted buffer is relative
+	# to the data pointer.  Note that this means that evaluating the
+	# fit requires the aperture start coordinates to be incremented
+	# by 1.
+
+	ix1 = 0
+	ix2 = nint (x2) + 1 - (xs - 1)
+	n = ix2 + ix1 + 1
+	if (data + ix1 >= dbuf && data + ix2 <= dbuf + nc - 1) {
+	    call asifit (asi, Memr[data+ix1], n)
+	    return
+	}
+
+	# One or the other end point is out of bounds so to avoid potential
+	# NAN and segmentation errors use an internal array to pad.
+
+	call malloc (fit, n, TY_REAL)
+	do i = 0, n-1 {
+	    if (data + i < dbuf)
+		Memr[fit+i] = Memr[dbuf]
+	    else if (data + i > dbuf + nc - 1)
+		Memr[fit+i] = Memr[dbuf+nc-1]
+	    else
+		Memr[fit+i] = Memr[data+i]
+	}
+	call asifit (asi, Memr[fit], n)
+	call mfree (fit, TY_REAL)
+end
diff --git a/noao/twodspec/apextract/apfind.par b/noao/twodspec/apextract/apfind.par
new file mode 100644
index 00000000..f879a4a7
--- /dev/null
+++ b/noao/twodspec/apextract/apfind.par
@@ -0,0 +1,18 @@
+# APFIND
+
+input,s,a,,,,List of input images
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"Reference images
+"
+interactive,b,h,no,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,no,,,Recenter apertures?
+resize,b,h,no,,,Resize apertures?
+edit,b,h,yes,,,"Edit apertures?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,1,,,Number of dispersion lines to sum or median
+nfind,i,q,,,,Number of apertures to be found automatically
+minsep,r,h,5.,1.,,Minimum separation between spectra
+maxsep,r,h,1000.,1.,,Maximum separation between spectra
+order,s,h,"increasing","increasing|decreasing",,Order of apertures
diff --git a/noao/twodspec/apextract/apfind.x b/noao/twodspec/apextract/apfind.x
new file mode 100644
index 00000000..f58dd4f4
--- /dev/null
+++ b/noao/twodspec/apextract/apfind.x
@@ -0,0 +1,132 @@
+include	<imhdr.h>
+include	<mach.h>
+include	"apertures.h"
+
+# Sort flags
+define	ORDER	"|increasing|decreasing|"
+
+# AP_FIND -- Find and set apertures automatically.
+
+procedure ap_find (image, line, nsum, aps, naps)
+
+char	image[SZ_FNAME]		# Image name
+int	line			# Image dispersion line
+int	nsum			# Number of dispersion lines to sum
+pointer	aps			# Aperture pointers
+int	naps			# Number of apertures
+
+real	minsep, center
+int	i, j, npts, apaxis, nfind, nx
+pointer	im, imdata, title, sp, str, x, ids
+
+bool	clgetb(), ap_answer()
+int	apgeti(), apgwrd()
+real	apgetr(), ap_center(), ap_cveval()
+
+errchk	ap_getdata, ap_default
+
+begin
+	# Find apertures only if there are no other apertures defined.
+	if (naps != 0)
+	     return
+
+	# Query user.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[str], SZ_LINE, "Find apertures for %s?")
+            call pargstr (image)
+	if (!ap_answer ("ansfind", Memc[str])) {
+	    call sfree (sp)
+	    return
+	}
+
+	if (clgetb ("verbose"))
+	    call printf ("Finding apertures ...\n")
+
+	# Get CL parameters.
+	nfind = apgeti ("nfind")
+	if (nfind == 0)
+	    return
+	minsep = apgetr ("minsep")
+
+	# Map the image and get the image data.
+	call ap_getdata (image, line, nsum, im, imdata, npts, apaxis, title)
+
+	# If nfind > 0 find the peaks.  Otherwise divide the image evenly
+	# into apertures.
+
+	if (nfind > 0) {
+	    # Allocate working memory.
+	    call salloc (x, nfind+2, TY_REAL)
+
+	    # Find the peaks.
+	    nx = 0
+	    call find_peaks (Memr[imdata], npts, 0., 1, nfind+2, minsep,
+		-MAX_REAL, Memr[x], nx)
+	    #call find_peaks (Memr[imdata], npts, 0., 1, nfind+2, minsep,
+	    #	0, Memr[x], nx)
+	    #call asrtr (Memr[x], Memr[x], nx)
+
+	    # Center on the peaks.
+	    naps = 0
+	    for (i = 1; i <= nx && naps < nfind; i = i + 1) {
+		center = Memr[x+i-1]
+		center = ap_center (center, Memr[imdata], npts)
+
+		if (!IS_INDEF(center)) {
+		    if (mod (naps, 100) == 0)
+			call realloc (aps, naps+100, TY_POINTER)
+		    if (naps == 0)
+			call ap_default (im, INDEFI, 1, apaxis, INDEFR,
+			    real (line), Memi[aps+naps])
+		    else
+			call ap_copy (Memi[aps], Memi[aps+naps])
+
+		    AP_CEN(Memi[aps+naps], AP_AXIS(Memi[aps+naps])) = center -
+			ap_cveval (AP_CV(Memi[aps+naps]), real (line))
+		    naps = naps + 1
+		}
+	    }
+
+	} else {
+	    nfind = abs (nfind)
+	    minsep = real (npts) / nfind
+	    naps = 0
+	    do i = 1, nfind {
+		if (mod (naps, 100) == 0)
+		    call realloc (aps, naps+100, TY_POINTER)
+		center = (i - 0.5) * minsep
+		IF (naps == 0)
+		    call ap_default (im, INDEFI, 1, apaxis, INDEFR,
+			real (line), Memi[aps+naps])
+		else
+		    call ap_copy (Memi[aps], Memi[aps+naps])
+
+		AP_CEN(Memi[aps+naps], AP_AXIS(Memi[aps+naps])) = center -
+		    ap_cveval (AP_CV(Memi[aps+naps]), real (line))
+		naps = naps + 1
+	    }
+	}
+	    
+	# Set the aperture ID's
+	i = apgwrd ("order", Memc[str], SZ_LINE, ORDER)
+	call ap_sort (j, Memi[aps], naps, i)
+	call ap_gids (ids)
+	call ap_ids (Memi[aps], naps, ids)
+	call ap_titles (Memi[aps], naps, ids)
+	call ap_fids (ids)
+
+	# Log the apertures found and write them to the database.
+	call sprintf (Memc[str], SZ_LINE, "FIND - %d apertures found for %s")
+	    call pargi (naps)
+	    call pargstr (image)
+	call ap_log (Memc[str], YES, YES, NO)
+
+	call appstr ("ansdbwrite1", "yes")
+
+	# Free memory and unmap the image.
+	call mfree (imdata, TY_REAL)
+	call mfree (title, TY_CHAR)
+	call imunmap (im)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apfindnew.x b/noao/twodspec/apextract/apfindnew.x
new file mode 100644
index 00000000..66762f78
--- /dev/null
+++ b/noao/twodspec/apextract/apfindnew.x
@@ -0,0 +1,83 @@
+include	<mach.h>
+include	"apertures.h"
+
+# Sort flags
+define	ORDER	"|increasing|decreasing|"
+
+# AP_FINDNEW -- Find and set new apertures automatically.  This task is
+# called from the aperture editor so we don't want to read the image vector
+# again.  It also differs from AP_FIND in that existing apertures are
+# maintained and new apertures are added.
+
+procedure ap_findnew (line, data, npts, apdef, aps, naps)
+
+int	line			# Dispersion line of data
+real	data[npts]		# Image data in which to find features
+int	npts			# Number of pixels
+pointer	apdef			# Default aperture pointer
+pointer	aps			# Aperture pointers
+int	naps			# Number of apertures returned
+
+int	i, j, nx, nfind
+real	center, minsep
+pointer	sp, str, x, ids
+
+bool	clgetb()
+int	apgeti(), apgwrd()
+real	apgetr(), ap_center(), ap_cveval()
+
+begin
+	# Determine the maximum number of apertures to be found and return
+	# if that limit has been reached.
+	nfind = apgeti ("nfind")
+	if (nfind <= naps)
+	    return
+
+	if (clgetb ("verbose"))
+	    call printf ("Finding apertures ...\n")
+
+	# Set the positions of the currently defined apertures.
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call salloc (x, max (nfind, naps), TY_REAL)
+	nx = naps
+	for (i = 0; i < nx; i = i + 1)
+	    Memr[x+i] = AP_CEN (Memi[aps+i], AP_AXIS(Memi[aps+i])) +
+		ap_cveval (AP_CV(Memi[aps+i]), real (line))
+
+	# Find peaks not already identified.
+	minsep = apgetr ("minsep")
+	#call find_peaks (data, npts, 0., 1, nfind, minsep, 0., Memr[x], nx)
+	call find_peaks (data, npts, 0., 1, nfind, minsep, -MAX_REAL,
+	    Memr[x], nx)
+	call asrtr (Memr[x+naps], Memr[x+naps], nx - naps)
+
+	# Center on the new peaks and define new apertures.
+	for (i = naps + 1; i <= nx; i = i + 1) {
+	    center = Memr[x+i-1]
+	    center = ap_center (center, data, npts)
+
+	    if (!IS_INDEF(center)) {
+		if (mod (naps, 100) == 0)
+		    call realloc (aps, naps+100, TY_POINTER)
+
+		call ap_copy (apdef, Memi[aps+naps])
+
+		AP_ID(Memi[aps+naps]) = INDEFI
+		if (AP_TITLE(Memi[aps+naps]) != NULL)
+		    call mfree (AP_TITLE(Memi[aps+naps]), TY_CHAR)
+		AP_CEN(Memi[aps+naps], AP_AXIS(Memi[aps+naps])) = center -
+		    ap_cveval (AP_CV(Memi[aps+naps]), real (line))
+		naps = naps + 1
+	    }
+	}
+
+	# Set the aperture ID's
+	i = apgwrd ("order", Memc[str], SZ_LINE, ORDER)
+	call ap_sort (j, Memi[aps], naps, i)
+	call ap_gids (ids)
+	call ap_ids (Memi[aps], naps, ids)
+	call ap_titles (Memi[aps], naps, ids)
+	call ap_fids (ids)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apfit.par b/noao/twodspec/apextract/apfit.par
new file mode 100644
index 00000000..1d6da386
--- /dev/null
+++ b/noao/twodspec/apextract/apfit.par
@@ -0,0 +1,30 @@
+# APFIT
+
+input,s,a,,,,List of images to fit
+output,s,a,,,,List of output images
+apertures,s,h,"",,,Apertures
+fittype,s,a,"difference","fit|difference|ratio",,Type of output fit
+references,s,h,"",,,"List of reference images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit traced points interactively?
+fit,b,h,yes,,,"Fit apertures?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+threshold,r,h,10.,,,"Division threshold for ratio fit
+"
+background,s,h,"none","none|average|median|minimum|fit",,Background to subtract
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting type (fit1d|fit2d)
+clean,b,h,no,,,Detect and replace bad pixels?
+skybox,i,h,1,1,,Box car smoothing length for sky
+saturation,r,h,INDEF,,,Saturation level
+readnoise,s,h,"0.",,,Read out noise sigma (photons)
+gain,s,h,"1.",,,Photon gain (photons/data number)
+lsigma,r,h,4.,0.,,Lower rejection threshold
+usigma,r,h,4.,0.,,Upper rejection threshold
diff --git a/noao/twodspec/apextract/apfit.x b/noao/twodspec/apextract/apfit.x
new file mode 100644
index 00000000..67bf149d
--- /dev/null
+++ b/noao/twodspec/apextract/apfit.x
@@ -0,0 +1,737 @@
+include	<imhdr.h>
+include	<imset.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+
+# AP_FITSPEC -- Fit a spectrum by a smoothing function.
+
+procedure ap_fitspec (ap, in, spec, ny)
+
+pointer	ap			# Aperture (used for labels)
+pointer	in			# Input image (used for labels)
+real	spec[ny]		# spectrum
+int	ny			# Number of points in spectra
+
+int	i, fd, apaxis, clgeti()
+real	clgetr()
+pointer	sp, str, x, wts, cv, gp, gt, ic, ic1, gt_init()
+bool	ap_answer()
+data	ic1 /NULL/
+errchk	icg_fit, ic_fit
+
+common	/apn_com/ ic, gt
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, ny, TY_REAL)
+	call salloc (wts, ny, TY_REAL)
+
+	do i = 1, ny {
+	    Memr[x+i-1] = i
+	    Memr[wts+i-1] = 1
+	}
+
+	if (ic == NULL || ic1 == NULL) {
+	    call ic_open (ic)
+	    ic1 = ic
+	    call clgstr ("function", Memc[str], SZ_LINE)
+	    call ic_pstr (ic, "function", Memc[str])
+	    call ic_puti (ic, "order", clgeti ("order"))
+	    call clgstr ("sample", Memc[str], SZ_LINE)
+	    call ic_pstr (ic, "sample", Memc[str])
+	    call ic_puti (ic, "naverage", clgeti ("naverage"))
+	    call ic_puti (ic, "niterate", clgeti ("niterate"))
+	    call ic_putr (ic, "low", clgetr ("low_reject"))
+	    call ic_putr (ic, "high", clgetr ("high_reject"))
+	    call ic_putr (ic, "grow", clgetr ("grow"))
+	    call ic_pstr (ic, "ylabel", "")
+
+	    gt = gt_init()
+	}
+
+	call ic_putr (ic, "xmin", 1.)
+	call ic_putr (ic, "xmax", real (ny))
+	apaxis = AP_AXIS(ap)
+	switch (apaxis) {
+	case 1:
+	    call ic_pstr (ic, "xlabel", "Line")
+	case 2:
+	    call ic_pstr (ic, "xlabel", "Column")
+	}
+	call gt_sets (gt, GTTYPE, "line")
+
+	# Fit spectrum by a smoothing function.
+	call sprintf (Memc[str], SZ_LINE,
+	    "%s: %s - Aperture %s")
+	    call pargstr (IM_HDRFILE(in))
+	    call pargstr (IM_TITLE(in))
+	    call pargi (AP_ID(ap))
+	call gt_sets (gt, GTTITLE, Memc[str])
+
+	# Query the user to fit the spectrum interactively.
+	call sprintf (Memc[str], SZ_LINE,
+	    "Fit spectrum for aperture %d for %s interactively?")
+	    call pargi (AP_ID(ap))
+	    call pargstr (IM_HDRFILE(in))
+	if (ap_answer ("ansfitspec1", Memc[str])) {
+	    call ap_gopen (gp)
+	    call icg_fit (ic, gp, "gcur", gt, cv, Memr[x], spec,
+		Memr[wts], ny)
+	    call amovkr (1., Memr[wts], ny)
+	} else
+	    call ic_fit (ic, cv, Memr[x], spec, Memr[wts], ny,
+		YES, YES, YES, YES)
+
+	# Make a graph to the plot log.
+	call ap_popen (gp, fd, "fitspec")
+	if (gp != NULL) {
+	    call icg_graphr (ic, gp, gt, cv, Memr[x], spec, Memr[wts], ny)
+	    call ap_pclose (gp, fd)
+	}
+
+	call cvvector (cv, Memr[x], spec, ny)
+	call cvfree (cv)
+end
+
+
+procedure ap_fitfree ()
+
+pointer	ic, gt
+common	/apn_com/ ic, gt
+
+begin
+	call ic_closer (ic)
+	call gt_free (gt)
+end
+
+
+# AP_LNORM -- Normalize the input line apertures by the norm spectra.
+
+procedure ap_lnorm (ap, out, gain, dbuf, nc, nl, c1, l1, spec, ny, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Normalization spectrum
+int	ny			# Size of profile array
+int	ys			# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+bool	clgetb()		# Center normalize?
+real	threshold, clgetr()	# Division threshold
+
+int	i, ncols, nlines, ix1, ix2, iy, nsum
+real	cen, low, high, s, x1, x2, sum, ap_cveval(), asumr()
+pointer	cv, datain, dataout, imps2r(), impl2r()
+
+begin
+	threshold = clgetr ("threshold")
+
+	cen = AP_CEN(ap,1)
+	low = AP_CEN(ap,1) + AP_LOW(ap,1)
+	high = AP_CEN(ap,1) + AP_HIGH(ap,1)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	# Normalize by the aperture width and apply threshold.
+	call adivkr (spec, high - low, spec, ny)
+	if (clgetb ("cennorm")) {
+	    sum = 0.
+	    nsum = 0
+	    do i = 1, nlines {
+		iy = i - ys + 1
+		if (iy < 1 || iy > ny)
+		    next
+		s = cen + ap_cveval (cv, real (i))
+		ix1 = max (1, int (s))
+		ix2 = min (ncols, int (s + 1))
+		if (ix1 > ix2)
+		    next
+		datain = dbuf + (i - l1) * nc + ix1 - c1
+		if (ix1 == ix2)
+		    sum = sum + Memr[datain]
+		else
+		    sum = sum + (ix2-s)*Memr[datain] + (s-ix1)*Memr[datain+1]
+		nsum = nsum + 1
+	    }
+	    if (nsum > 0) {
+	        sum = (asumr (spec, ny) / ny) / (sum / nsum / gain)
+		call adivkr (spec, sum, spec, ny)
+	    }
+	}
+	if (!IS_INDEF (threshold))
+	    call arltr (spec, ny, threshold, threshold)
+
+	do i = 1, nlines {
+	    if (init == YES) {
+	        dataout = impl2r (out, i)
+	        call amovkr (1., Memr[dataout], ncols)
+	    }
+
+	    iy = i - ys + 1
+	    if (iy < 1 || iy > ny)
+		next
+	    s = ap_cveval (cv, real (i))
+	    x1 = max (0.5, low + s) 
+	    x2 = min (ncols + 0.49, high + s) 
+	    if (x1 > x2)
+		next
+
+	    ix1 = nint (x1)
+	    ix2 = nint (x2)
+
+	    datain = dbuf + (i - l1) * nc + ix1 - c1
+	    if (init == YES)
+		dataout = dataout + ix1 - 1
+	    else
+	        dataout = imps2r (out, ix1, ix2, i, i)
+	    call adivkr (Memr[datain], spec[iy] * gain, Memr[dataout],
+		ix2-ix1+1)
+	}
+
+	call imaddr (out, "CCDMEAN", 1.)
+end
+
+
+# AP_CNORM -- Normalize the input column apertures by the norm spectra.
+
+procedure ap_cnorm (ap, out, gain, dbuf, nc, nl, c1, l1, spec, ny, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Normalization spectrum
+int	ny			# Size of profile array
+int	ys			# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+bool	clgetb()		# Center normalize?
+real	threshold, clgetr()	# Division threshold
+
+int	ncols, nlines, ix, iy, ix1, ix2, iy1, iy2, nsum
+real	cen, low, high, s, sum, ap_cveval(), asumr()
+pointer	sp, y1, y2, cv, datain, dataout, buf, imps2r(), impl2r()
+
+begin
+	threshold = clgetr ("threshold")
+
+	call smark (sp)
+	call salloc (y1, 2 * ny, TY_INT)
+	y1 = y1 - ys
+	y2 = y1 + ny
+
+	cen = AP_CEN(ap,2)
+	low = AP_CEN(ap,2) + AP_LOW(ap,2)
+	high = AP_CEN(ap,2) + AP_HIGH(ap,2)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	# Normalize by the aperture width and apply threshold.
+	call adivkr (spec, high - low, spec, ny)
+	if (clgetb ("cennorm")) {
+	    sum = 0.
+	    nsum = 0
+	    do ix = ys, ys+ny-1 {
+		s = cen + ap_cveval (cv, real (ix))
+		iy1 = max (1, int (s))
+		iy2 = min (nlines, int (s + 1))
+		if (iy1 > iy2)
+		    next
+		datain = dbuf + (ix - l1) * nc + iy1 - c1
+		if (iy1 == iy2)
+		    sum = sum + Memr[datain]
+		else
+		    sum = sum + (iy2-s)*Memr[datain] + (s-iy1)*Memr[datain+1]
+		nsum = nsum + 1
+	    }
+	    if (nsum > 0) {
+	        sum = (asumr (spec, ny) / ny) / (sum / nsum / gain)
+		call adivkr (spec, sum, spec, ny)
+	    }
+	}
+	if (!IS_INDEF (threshold))
+	    call arltr (spec, ny, threshold, threshold)
+
+	do ix = ys, ys+ny-1 {
+	    s = ap_cveval (cv, real (ix))
+	    Memi[y1+ix] = nint (low + s) 
+	    Memi[y2+ix] = nint (high + s) 
+	}
+	call alimi (Memi[y1+ys], 2 * ny, iy1, iy2)
+
+	do iy = 1, nlines {
+	    if (init == YES) {
+	        buf = impl2r (out, iy)
+	        call amovkr (1., Memr[buf], ncols)
+	    }
+
+	    if (iy < iy1 || iy > iy2)
+		next
+
+	    for (ix1=ys; ix1<=ys+ny-1; ix1=ix1+1) {
+		if (iy < Memi[y1+ix1] || iy > Memi[y2+ix1])
+		    next
+		for (ix2=ix1+1; ix2<=ys+ny-1; ix2=ix2+1)
+		    if (iy < Memi[y1+ix2] || iy > Memi[y2+ix2])
+			break
+		ix2 = ix2 - 1
+
+	        datain = dbuf + (ix1 - l1) * nc + iy - c1
+	        if (init == YES)
+		    dataout = buf + ix1 - 1
+	        else
+	            dataout = imps2r (out, ix1, ix2, iy, iy)
+		do ix = ix1, ix2 {
+		    Memr[dataout] = Memr[datain] / spec[ix-ys+1] / gain
+		    datain = datain +  nc
+		    dataout = dataout + 1
+		}
+		ix1 = ix2
+	    }
+	}
+
+	call imaddr (out, "CCDMEAN", 1.)
+
+	call sfree (sp)
+end
+
+
+# AP_LFLAT -- Flatten the input line apertures by the norm spectra.
+
+procedure ap_lflat (ap, out, dbuf, nc, nl, c1, l1, spec, sbuf, profile, nx, ny,
+	xs, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Normalization spectrum
+pointer	sbuf			# Sky buffer
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+real	threshold, clgetr()	# Division threshold
+
+int	i, ncols, nlines, ix, iy, ix1, ix2
+real	low, high, s, x1, x2, ap_cveval()
+pointer	cv, datain, dataout, sky, imps2r(), impl2r()
+
+begin
+	threshold = clgetr ("threshold")
+	if (IS_INDEF(threshold))
+	    threshold = 0.
+	threshold = max (0., threshold)
+
+	low = AP_CEN(ap,1) + AP_LOW(ap,1)
+	high = AP_CEN(ap,1) + AP_HIGH(ap,1)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	do i = 1, nlines {
+	    if (init == YES) {
+	        dataout = impl2r (out, i)
+	        call amovkr (1., Memr[dataout], ncols)
+	    }
+
+	    iy = i - ys + 1
+	    if (iy < 1 || iy > ny)
+		next
+	    s = ap_cveval (cv, real (i))
+	    x1 = max (0.5, low + s) 
+	    x2 = min (ncols + 0.49, high + s) 
+	    if (x1 > x2)
+		next
+
+	    ix1 = nint (x1)
+	    ix2 = nint (x2)
+
+	    datain = dbuf + (i - l1) * nc + ix1 - c1
+	    if (init == YES)
+		dataout = dataout + ix1 - 1
+	    else
+	        dataout = imps2r (out, ix1, ix2, i, i)
+	    if (sbuf != NULL)
+		sky = sbuf + (iy - 1) * nx - xs[iy]
+	    do ix = ix1, ix2 {
+		s = spec[iy] * profile[iy, ix-xs[iy]+1]
+		if (sbuf != NULL)
+		    s = s + Memr[sky+ix]
+		if (s > threshold)
+		    Memr[dataout] = Memr[datain] / s
+		else
+		    Memr[dataout] = 1.
+		datain = datain + 1
+		dataout = dataout + 1
+	    }
+	}
+
+	call imaddr (out, "CCDMEAN", 1.)
+end
+
+
+# AP_CFLAT -- Flatten the input column apertures by the norm spectra.
+
+procedure ap_cflat (ap, out, dbuf, nc, nl, c1, l1, spec, sbuf, profile, nx, ny,
+    xs, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Normalization spectrum
+pointer	sbuf			# Sky buffer
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+real	threshold, clgetr()	# Division threshold
+
+int	ncols, nlines, ix, iy, ix1, ix2, iy1, iy2
+real	low, high, s, ap_cveval()
+pointer	sp, y1, y2, cv, datain, dataout, sky, buf, imps2r(), impl2r()
+
+begin
+	threshold = clgetr ("threshold")
+	if (IS_INDEF(threshold))
+	    threshold = 0.
+	threshold = max (0., threshold)
+
+	call smark (sp)
+	call salloc (y1, 2 * ny, TY_INT)
+	y1 = y1 - ys
+	y2 = y1 + ny
+
+	low = AP_CEN(ap,2) + AP_LOW(ap,2)
+	high = AP_CEN(ap,2) + AP_HIGH(ap,2)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	do ix = ys, ys+ny-1 {
+	    s = ap_cveval (cv, real (ix))
+	    Memi[y1+ix] = nint (low + s) 
+	    Memi[y2+ix] = nint (high + s) 
+	}
+	call alimi (Memi[y1+ys], 2 * ny, iy1, iy2)
+
+	do iy = 1, nlines {
+	    if (init == YES) {
+	        buf = impl2r (out, iy)
+	        call amovkr (1., Memr[buf], ncols)
+	    }
+
+	    if (iy < iy1 || iy > iy2)
+		next
+
+	    for (ix1=ys; ix1<=ys+ny-1; ix1=ix1+1) {
+		if (iy < Memi[y1+ix1] || iy > Memi[y2+ix1])
+		    next
+		for (ix2=ix1+1; ix2<=ys+ny-1; ix2=ix2+1)
+		    if (iy < Memi[y1+ix2] || iy > Memi[y2+ix2])
+			break
+		ix2 = ix2 - 1
+
+	        datain = dbuf + (ix1 - l1) * nc + iy - c1
+	        if (init == YES)
+		    dataout = buf + ix1 - 1
+	        else
+	            dataout = imps2r (out, ix1, ix2, iy, iy)
+	        if (sbuf != NULL)
+		    sky = sbuf - ys * nx + iy - xs[iy]
+	        do ix = ix1, ix2 {
+		    s = spec[ix-ys+1] * profile[ix-ys+1, iy-xs[ix-ys+1]+1]
+		    if (sbuf != NULL)
+			s = s + Memr[sky+ix*nx]
+		    if (s > threshold)
+		        Memr[dataout] = Memr[datain] / s
+		    else
+		        Memr[dataout] = 1.
+		    datain = datain + nc
+		    dataout = dataout + 1
+	        }
+		ix1 = ix2
+	    }
+	}
+
+	call imaddr (out, "CCDMEAN", 1.)
+
+	call sfree (sp)
+end
+
+
+# AP_LDIFF -- Model residuals.
+
+procedure ap_ldiff (ap, out, gain, dbuf, nc, nl, c1, l1, spec, profile, nx, ny,
+	xs, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Normalization spectrum
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+int	i, ncols, nlines, ix, iy, ix1, ix2
+real	low, high, s, x1, x2, ap_cveval()
+pointer	cv, datain, dataout, imps2r(), impl2r()
+
+begin
+	low = AP_CEN(ap,1) + AP_LOW(ap,1)
+	high = AP_CEN(ap,1) + AP_HIGH(ap,1)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	do i = 1, nlines {
+	    if (init == YES) {
+	        dataout = impl2r (out, i)
+	        call aclrr (Memr[dataout], ncols)
+	    }
+
+	    iy = i - ys + 1
+	    if (iy < 1 || iy > ny)
+		next
+	    s = ap_cveval (cv, real (i))
+	    x1 = max (0.5, low + s) 
+	    x2 = min (ncols + 0.49, high + s) 
+	    if (x1 > x2)
+		next
+
+	    ix1 = nint (x1)
+	    ix2 = nint (x2)
+
+	    datain = dbuf + (i - l1) * nc + ix1 - c1
+	    if (init == YES)
+		dataout = dataout + ix1 - 1
+	    else
+	        dataout = imps2r (out, ix1, ix2, i, i)
+	    do ix = ix1, ix2 {
+		s = spec[iy] * profile[iy, ix-xs[iy]+1]
+		Memr[dataout] = (Memr[datain] - s) / gain
+		datain = datain + 1
+		dataout = dataout + 1
+	    }
+	}
+end
+
+
+# AP_CDIFF -- Model residuals
+
+procedure ap_cdiff (ap, out, gain, dbuf, nc, nl, c1, l1, spec, profile, nx, ny,
+    xs, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Normalization spectrum
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+int	ncols, nlines, ix, iy, ix1, ix2, iy1, iy2
+real	low, high, s, ap_cveval()
+pointer	sp, y1, y2, cv, datain, dataout, buf, imps2r(), impl2r()
+
+begin
+	call smark (sp)
+	call salloc (y1, 2 * ny, TY_INT)
+	y1 = y1 - ys
+	y2 = y1 + ny
+
+	low = AP_CEN(ap,2) + AP_LOW(ap,2)
+	high = AP_CEN(ap,2) + AP_HIGH(ap,2)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	do ix = ys, ys+ny-1 {
+	    s = ap_cveval (cv, real (ix))
+	    Memi[y1+ix] = nint (low + s) 
+	    Memi[y2+ix] = nint (high + s) 
+	}
+	call alimi (Memi[y1+ys], 2 * ny, iy1, iy2)
+
+	do iy = 1, nlines {
+	    if (init == YES) {
+	        buf = impl2r (out, iy)
+	        call aclrr (Memr[buf], ncols)
+	    }
+
+	    if (iy < iy1 || iy > iy2)
+		next
+
+	    for (ix1=ys; ix1<=ys+ny-1; ix1=ix1+1) {
+		if (iy < Memi[y1+ix1] || iy > Memi[y2+ix1])
+		    next
+		for (ix2=ix1+1; ix2<=ys+ny-1; ix2=ix2+1)
+		    if (iy < Memi[y1+ix2] || iy > Memi[y2+ix2])
+			break
+		ix2 = ix2 - 1
+
+	        datain = dbuf + (ix1 - l1) * nc + iy - c1
+	        if (init == YES)
+		    dataout = buf + ix1 - 1
+	        else
+	            dataout = imps2r (out, ix1, ix2, iy, iy)
+	        do ix = ix1, ix2 {
+		    s = spec[ix-ys+1] * profile[ix-ys+1, iy-xs[ix-ys+1]+1]
+		    Memr[dataout] = (Memr[datain] - s) / gain
+		    datain = datain + nc
+		    dataout = dataout + 1
+	        }
+		ix1 = ix2
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_LFIT -- Model fit
+
+procedure ap_lfit (ap, out, gain, spec, profile, nx, ny, xs, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+real	spec[ny]		# Normalization spectrum
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+int	i, ncols, nlines, ix, iy, ix1, ix2
+real	low, high, s, x1, x2, ap_cveval()
+pointer	cv, dataout, imps2r(), impl2r()
+
+begin
+	low = AP_CEN(ap,1) + AP_LOW(ap,1)
+	high = AP_CEN(ap,1) + AP_HIGH(ap,1)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	do i = 1, nlines {
+	    if (init == YES) {
+	        dataout = impl2r (out, i)
+	        call aclrr (Memr[dataout], ncols)
+	    }
+
+	    iy = i - ys + 1
+	    if (iy < 1 || iy > ny)
+		next
+	    s = ap_cveval (cv, real (i))
+	    x1 = max (0.5, low + s) 
+	    x2 = min (ncols + 0.49, high + s) 
+	    if (x1 > x2)
+		next
+
+	    ix1 = nint (x1)
+	    ix2 = nint (x2)
+
+	    if (init == YES)
+		dataout = dataout + ix1 - 1
+	    else
+	        dataout = imps2r (out, ix1, ix2, i, i)
+	    do ix = ix1, ix2 {
+		s = spec[iy] * profile[iy, ix-xs[iy]+1]
+		Memr[dataout] = s / gain
+		dataout = dataout + 1
+	    }
+	}
+end
+
+
+# AP_CFIT -- Model fit
+
+procedure ap_cfit (ap, out, gain, spec, profile, nx, ny, xs, ys, init)
+
+pointer	ap			# Aperture structure
+pointer	out			# Output IMIO pointer
+real	gain			# Gain
+real	spec[ny]		# Normalization spectrum
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+int	init			# Fill between apertures with 1?
+
+int	ncols, nlines, ix, iy, ix1, ix2, iy1, iy2
+real	low, high, s, ap_cveval()
+pointer	sp, y1, y2, cv, dataout, buf, imps2r(), impl2r()
+
+begin
+	call smark (sp)
+	call salloc (y1, 2 * ny, TY_INT)
+	y1 = y1 - ys
+	y2 = y1 + ny
+
+	low = AP_CEN(ap,2) + AP_LOW(ap,2)
+	high = AP_CEN(ap,2) + AP_HIGH(ap,2)
+	cv = AP_CV(ap)
+	ncols = IM_LEN(out, 1)
+	nlines = IM_LEN(out, 2)
+
+	do ix = ys, ys+ny-1 {
+	    s = ap_cveval (cv, real (ix))
+	    Memi[y1+ix] = nint (low + s) 
+	    Memi[y2+ix] = nint (high + s) 
+	}
+	call alimi (Memi[y1+ys], 2 * ny, iy1, iy2)
+
+	do iy = 1, nlines {
+	    if (init == YES) {
+	        buf = impl2r (out, iy)
+	        call aclrr (Memr[buf], ncols)
+	    }
+
+	    if (iy < iy1 || iy > iy2)
+		next
+
+	    for (ix1=ys; ix1<=ys+ny-1; ix1=ix1+1) {
+		if (iy < Memi[y1+ix1] || iy > Memi[y2+ix1])
+		    next
+		for (ix2=ix1+1; ix2<=ys+ny-1; ix2=ix2+1)
+		    if (iy < Memi[y1+ix2] || iy > Memi[y2+ix2])
+			break
+		ix2 = ix2 - 1
+
+	        if (init == YES)
+		    dataout = buf + ix1 - 1
+	        else
+	            dataout = imps2r (out, ix1, ix2, iy, iy)
+	        do ix = ix1, ix2 {
+		    s = spec[ix-ys+1] * profile[ix-ys+1, iy-xs[ix-ys+1]+1]
+		    Memr[dataout] = s / gain
+		    dataout = dataout + 1
+	        }
+		ix1 = ix2
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apfit1.par b/noao/twodspec/apextract/apfit1.par
new file mode 100644
index 00000000..5420917d
--- /dev/null
+++ b/noao/twodspec/apextract/apfit1.par
@@ -0,0 +1,118 @@
+# OUTPUT PARAMETERS
+
+apertures,s,h,)apall.apertures,,,>apfit.apertures
+format,s,h,)apsum.format,,,>apsum.format
+extras,b,h,)apsum.extras,,,>apsum.extras
+dbwrite,s,h,yes,,,Write to database?
+initialize,b,h,yes,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)apdefault.lower,,,>apdefault.lower
+upper,r,h,)apdefault.upper,,,>apdefault.upper
+apidtable,s,h,)apdefault.apidtable,,,">apdefault.apidtable
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)apdefault.b_function,,,>apdefault.b_function
+b_order,i,h,)apdefault.b_order,,,>apdefault.b_order
+b_sample,s,h,)apdefault.b_sample,,,>apdefault.b_sample
+b_naverage,i,h,)apdefault.b_naverage,,,>apdefault.b_naverage
+b_niterate,i,h,)apdefault.b_niterate,,,>apdefault.b_niterate
+b_low_reject,r,h,)apdefault.b_low_reject,,,>apdefault.b_low_reject
+b_high_reject,r,h,)apdefault.b_high_reject,,,>apdefault.b_high_reject
+b_grow,r,h,)apdefault.b_grow,,,">apdefault.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,)apedit.width,,,>apedit.width
+radius,r,h,)apedit.radius,,,>apedit.radius
+threshold,r,h,)apedit.threshold,,,">apedit.threshold
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,)apfind.nfind,,,>apfind.nfind
+minsep,r,h,)apfind.minsep,,,>apfind.minsep
+maxsep,r,h,)apfind.maxsep,,,>apfind.maxsep
+order,s,h,)apfind.order,,,">apfind.order
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,)aprecenter.aprecenter,,,>aprecenter.aprecenter
+npeaks,r,h,)aprecenter.npeaks,,,>aprecenter.npeaks
+shift,b,h,)aprecenter.shift,,,">aprecenter.shift
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,)apresize.llimit,,,>apresize.llimit
+ulimit,r,h,)apresize.ulimit,,,>apresize.ulimit
+ylevel,r,h,)apresize.ylevel,,,>apresize.ylevel
+peak,b,h,)apresize.peak,,,>apresize.peak
+bkg,b,h,)apresize.bkg,,,>apresize.bkg
+r_grow,r,h,)apresize.r_grow,,,>apresize.r_grow
+avglimits,b,h,)apresize.avglimits,,,">apresize.avglimits
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,Profile reference image
+
+# TRACING PARAMETERS
+t_nsum,i,h,)aptrace.nsum,,,>aptrace.nsum
+t_step,i,h,)aptrace.step,,,>aptrace.step
+t_nlost,i,h,)aptrace.nlost,,,>aptrace.nlost
+t_width,r,h,)apedit.width,,,>apedit.width
+t_function,s,h,)aptrace.function,,,>aptrace.function
+t_order,i,h,)aptrace.order,,,>aptrace.order
+t_sample,s,h,)aptrace.sample,,,>aptrace.sample
+t_naverage,i,h,)aptrace.naverage,,,>aptrace.naverage
+t_niterate,i,h,)aptrace.niterate,,,>aptrace.niterate
+t_low_reject,r,h,)aptrace.low_reject,,,>aptrace.low_reject
+t_high_reject,r,h,)aptrace.high_reject,,,>aptrace.high_reject
+t_grow,r,h,)aptrace.grow,,,">aptrace.grow
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,)apfit.background,,,>apfit.background
+skybox,i,h,)apfit.skybox,,,>apfit.skybox
+weights,s,h,"none",,,Extraction weights (none|variance)
+pfit,s,h,)apfit.pfit,,,>apfit.pfit
+clean,b,h,)apfit.clean,,,>apfit.clean
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,)apfit.saturation,,,>apfit.saturation
+readnoise,s,h,)apfit.readnoise,,,>apfit.readnoise
+gain,s,h,)apfit.gain,,,>apfit.gain
+lsigma,r,h,)apfit.lsigma,,,>apfit.lsigma
+usigma,r,h,)apfit.usigma,,,>apfit.usigma
+polysep,r,h,0.90,0.1,0.95,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,1,,,"Number of subapertures per aperture
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"no",,," "
+ansclobber1,s,h,"no",,," "
+ansdbwrite,s,h,"yes",,," "
+ansdbwrite1,s,h,"yes",,," "
+ansedit,s,h,"yes",,," "
+ansextract,s,h,"yes",,," "
+ansfind,s,h,"yes",,," "
+ansfit,s,h,"yes",,," "
+ansfitscatter,s,h,"yes",,," "
+ansfitsmooth,s,h,"yes",,," "
+ansfitspec,s,h,"yes",,," "
+ansfitspec1,s,h,"yes",,," "
+ansfittrace,s,h,"yes",,," "
+ansfittrace1,s,h,"yes",,," "
+ansflat,s,h,"yes",,," "
+ansmask,s,h,"yes",,," "
+ansnorm,s,h,"yes",,," "
+ansrecenter,s,h,"yes",,," "
+ansresize,s,h,"yes",,," "
+ansreview,s,h,"yes",,," "
+ansreview1,s,h,"yes",,," "
+ansscat,s,h,"yes",,," "
+anssmooth,s,h,"yes",,," "
+anstrace,s,h,"yes",,," "
diff --git a/noao/twodspec/apextract/apflat1.par b/noao/twodspec/apextract/apflat1.par
new file mode 100644
index 00000000..0fac8391
--- /dev/null
+++ b/noao/twodspec/apextract/apflat1.par
@@ -0,0 +1,117 @@
+# OUTPUT PARAMETERS
+
+format,s,h,)apsum.format,,,>apsum.format
+extras,b,h,)apsum.extras,,,>apsum.extras
+dbwrite,s,h,yes,,,Write to database?
+initialize,b,h,yes,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)apdefault.lower,,,>apdefault.lower
+upper,r,h,)apdefault.upper,,,>apdefault.upper
+apidtable,s,h,)apdefault.apidtable,,,">apdefault.apidtable
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)apdefault.b_function,,,>apdefault.b_function
+b_order,i,h,)apdefault.b_order,,,>apdefault.b_order
+b_sample,s,h,)apdefault.b_sample,,,>apdefault.b_sample
+b_naverage,i,h,)apdefault.b_naverage,,,>apdefault.b_naverage
+b_niterate,i,h,)apdefault.b_niterate,,,>apdefault.b_niterate
+b_low_reject,r,h,)apdefault.b_low_reject,,,>apdefault.b_low_reject
+b_high_reject,r,h,)apdefault.b_high_reject,,,>apdefault.b_high_reject
+b_grow,r,h,)apdefault.b_grow,,,">apdefault.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,)apedit.width,,,>apedit.width
+radius,r,h,)apedit.radius,,,>apedit.radius
+threshold,r,h,)apedit.threshold,,,">apedit.threshold
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,)apfind.nfind,,,>apfind.nfind
+minsep,r,h,)apfind.minsep,,,>apfind.minsep
+maxsep,r,h,)apfind.maxsep,,,>apfind.maxsep
+order,s,h,)apfind.order,,,">apfind.order
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,)aprecenter.aprecenter,,,>aprecenter.aprecenter
+npeaks,r,h,)aprecenter.npeaks,,,>aprecenter.npeaks
+shift,b,h,)aprecenter.shift,,,">aprecenter.shift
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,)apresize.llimit,,,>apresize.llimit
+ulimit,r,h,)apresize.ulimit,,,>apresize.ulimit
+ylevel,r,h,)apresize.ylevel,,,>apresize.ylevel
+peak,b,h,)apresize.peak,,,>apresize.peak
+bkg,b,h,)apresize.bkg,,,>apresize.bkg
+r_grow,r,h,)apresize.r_grow,,,>apresize.r_grow
+avglimits,b,h,)apresize.avglimits,,,">apresize.avglimits
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,Profile reference image
+
+# TRACING PARAMETERS
+t_nsum,i,h,)aptrace.nsum,,,>aptrace.nsum
+t_step,i,h,)aptrace.step,,,>aptrace.step
+t_nlost,i,h,)aptrace.nlost,,,>aptrace.nlost
+t_width,r,h,)apedit.width,,,>apedit.width
+t_function,s,h,)aptrace.function,,,>aptrace.function
+t_order,i,h,)aptrace.order,,,>aptrace.order
+t_sample,s,h,)aptrace.sample,,,>aptrace.sample
+t_naverage,i,h,)aptrace.naverage,,,>aptrace.naverage
+t_niterate,i,h,)aptrace.niterate,,,>aptrace.niterate
+t_low_reject,r,h,)aptrace.low_reject,,,>aptrace.low_reject
+t_high_reject,r,h,)aptrace.high_reject,,,>aptrace.high_reject
+t_grow,r,h,)aptrace.grow,,,">aptrace.grow
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,"none",,,>apflatten.background
+skybox,i,h,1,,,>apflatten.skybox
+weights,s,h,"none",,,Extraction weights (none|variance)
+pfit,s,h,)apflatten.pfit,,,>apflatten.pfit
+clean,b,h,)apflatten.clean,,,>apflatten.clean
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,)apflatten.saturation,,,>apflatten.saturation
+readnoise,s,h,)apflatten.readnoise,,,>apflatten.readnoise
+gain,s,h,)apflatten.gain,,,>apflatten.gain
+lsigma,r,h,)apflatten.lsigma,,,>apflatten.lsigma
+usigma,r,h,)apflatten.usigma,,,>apflatten.usigma
+polysep,r,h,0.90,0.1,0.90,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,1,,,"Number of subapertures per aperture
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"no",,," "
+ansclobber1,s,h,"no",,," "
+ansdbwrite,s,h,"yes",,," "
+ansdbwrite1,s,h,"yes",,," "
+ansedit,s,h,"yes",,," "
+ansextract,s,h,"yes",,," "
+ansfind,s,h,"yes",,," "
+ansfit,s,h,"yes",,," "
+ansfitscatter,s,h,"yes",,," "
+ansfitsmooth,s,h,"yes",,," "
+ansfitspec,s,h,"yes",,," "
+ansfitspec1,s,h,"yes",,," "
+ansfittrace,s,h,"yes",,," "
+ansfittrace1,s,h,"yes",,," "
+ansflat,s,h,"yes",,," "
+ansmask,s,h,"yes",,," "
+ansnorm,s,h,"yes",,," "
+ansrecenter,s,h,"yes",,," "
+ansresize,s,h,"yes",,," "
+ansreview,s,h,"yes",,," "
+ansreview1,s,h,"yes",,," "
+ansscat,s,h,"yes",,," "
+anssmooth,s,h,"yes",,," "
+anstrace,s,h,"yes",,," "
diff --git a/noao/twodspec/apextract/apflatten.par b/noao/twodspec/apextract/apflatten.par
new file mode 100644
index 00000000..84e5906c
--- /dev/null
+++ b/noao/twodspec/apextract/apflatten.par
@@ -0,0 +1,37 @@
+# APFLATTEN
+
+input,s,a,,,,List of images to flatten
+output,s,a,,,,List of output flatten images
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"List of reference images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit traced points interactively?
+flatten,b,h,yes,,,Flatten spectra?
+fitspec,b,h,yes,,,"Fit normalization spectra interactively?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+threshold,r,h,10.,,,"Threshold for flattening spectra
+"
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting type (fit1d|fit2d)
+clean,b,h,no,,,Detect and replace bad pixels?
+saturation,r,h,INDEF,,,Saturation level
+readnoise,s,h,"0.",,,Read out noise sigma (photons)
+gain,s,h,"1.",,,Photon gain (photons/data number)
+lsigma,r,h,4.,0.,,Lower rejection threshold
+usigma,r,h,4.,0.,,"Upper rejection threshold
+"
+function,s,h,"legendre","chebyshev|legendre|spline1|spline3",,Fitting function for normalization spectra
+order,i,h,1,1,,Fitting function order
+sample,s,h,"*",,,Sample regions
+naverage,i,h,1,,,Average or median
+niterate,i,h,0,0,,Number of rejection iterations
+low_reject,r,h,3.,0.,,Lower rejection sigma
+high_reject,r,h,3.,0.,,High upper rejection sigma
+grow,r,h,0.,0.,,Rejection growing radius
diff --git a/noao/twodspec/apextract/apgetdata.x b/noao/twodspec/apextract/apgetdata.x
new file mode 100644
index 00000000..6645a6c3
--- /dev/null
+++ b/noao/twodspec/apextract/apgetdata.x
@@ -0,0 +1,99 @@
+include	<imhdr.h>
+
+# AP_GETDATA -- Get the summed dispersion line.
+# Return the IMIO pointer, pointer to image data, the aperture axis and title.
+# The pointers must be freed by the calling program.  Note that the value of
+# line may be changed.
+
+procedure ap_getdata (image, line, nsum, im, imdata, npts, apaxis, title)
+
+char	image[SZ_FNAME]		# Image name
+int	line			# Dispersion line to graph
+int	nsum			# Number of dispersion lines to sum
+pointer	im			# IMIO pointer
+pointer	imdata			# Pointer to image data
+int	npts			# Number of pixels 
+int	apaxis			# Aperture axis
+pointer	title			# Title for image data
+
+int	i, j, k, l, n, dispaxis
+pointer	buf, medbuf
+
+real	asumr(), amedr()
+pointer	ap_immap(), imgs2r()
+
+errchk	ap_immap, imgs2r
+
+begin
+	# Map the image
+	im = ap_immap (image, apaxis, dispaxis)
+
+	# Determine the dispersion and aperture axes.
+	if (IS_INDEFI (line))
+	    line = IM_LEN(im, dispaxis) / 2
+	else
+	    line = max (1, min (IM_LEN(im, dispaxis), line))
+
+	# Allocate memory for the image line and title.
+	npts = IM_LEN(im, apaxis)
+	call calloc (imdata, npts, TY_REAL)
+	call malloc (title, SZ_LINE, TY_CHAR)
+
+	# Sum the specified number of dispersion lines.
+	n = max (1, abs (nsum))
+	switch (apaxis) {
+	case 1:
+	    i = max (1, line - n / 2)
+	    j = min (IM_LEN(im, dispaxis), i + n - 1)
+	    i = max (1, j - n + 1)
+	    buf = imgs2r (im, 1, npts, i, j)
+	    j = j - i + 1
+	    if (j < 3 || nsum > 0) {
+		do k = 1, j
+		    call aaddr (Memr[buf+(k-1)*npts], Memr[imdata],
+			Memr[imdata], npts)
+		call sprintf (Memc[title], SZ_LINE,
+		    "Image=%s, Sum of lines %d-%d")
+		    call pargstr (image)
+		    call pargi (i)
+		    call pargi (i+j-1)
+	    } else {
+		call malloc (medbuf, j, TY_REAL)
+		do k = 0, npts-1 {
+		    do l = 0, j-1
+			Memr[medbuf+l] = Memr[buf+l*npts+k]
+		    Memr[imdata+k] = amedr (Memr[medbuf], j)
+		}
+		call mfree (medbuf, TY_REAL)
+		call sprintf (Memc[title], SZ_LINE,
+		    "Image=%s, Median of lines %d-%d")
+		    call pargstr (image)
+		    call pargi (i)
+		    call pargi (i+j-1)
+	    }
+
+	case 2:
+	    i = max (1, line - n / 2)
+	    j = min (IM_LEN(im, dispaxis), i + n - 1)
+	    i = max (1, j - n + 1)
+	    buf = imgs2r (im, i, j, 1, npts)
+	    j = j - i + 1
+	    if (j < 3 || nsum > 0) {
+		do k = 1, npts
+		    Memr[imdata+k-1] = asumr (Memr[buf+(k-1)*j], j)
+		call sprintf (Memc[title], SZ_LINE,
+		    "Image=%s, Sum of columns %d-%d")
+		    call pargstr (image)
+		    call pargi (i)
+		    call pargi (i+j-1)
+	    } else {
+		do k = 1, npts
+		    Memr[imdata+k-1] = amedr (Memr[buf+(k-1)*j], j)
+		call sprintf (Memc[title], SZ_LINE,
+		    "Image=%s, Median of columns %d-%d")
+		    call pargstr (image)
+		    call pargi (i)
+		    call pargi (i+j-1)
+	    }
+	}
+end
diff --git a/noao/twodspec/apextract/apgetim.x b/noao/twodspec/apextract/apgetim.x
new file mode 100644
index 00000000..c5bc96f8
--- /dev/null
+++ b/noao/twodspec/apextract/apgetim.x
@@ -0,0 +1,73 @@
+# AP_GETIM -- Standardize image name so that different ways of specifying
+# the images map to the same database and output rootnames.
+
+int procedure ap_getim (list, image, maxchar)
+
+int	list			#I Image list
+char	image[maxchar]		#O Image name
+int	maxchar			#I Maximum number of chars in image name
+
+char	ksection[SZ_FNAME]	#O Image name
+
+int	i, j, stat, cl_index, cl_size
+pointer	im
+pointer	sp, cluster, section
+
+int	imtgetim(), strlen(), stridxs(), ctoi()
+pointer	immap()
+
+begin
+	# Get next image name.
+	stat = imtgetim (list, image, maxchar)
+	if (stat == EOF)
+	    return (stat)
+
+	call smark (sp)
+	call salloc (cluster, SZ_FNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+
+	call imparse (image, Memc[cluster], SZ_FNAME, ksection, SZ_FNAME,
+	    Memc[section], SZ_FNAME, cl_index, cl_size)
+
+	# Strip the extension.
+	call xt_imroot (Memc[cluster], Memc[cluster], SZ_FNAME)
+
+	# Generate standard ksection.  Only map image if index used.
+	# Don't worry about cases with both an index and ksection.
+
+	if (cl_index < 0 && ksection[1] == EOS)
+	    ;
+	else if (cl_index == 0)
+	    ksection[1] = EOS
+	else {
+	    if (cl_index > 0) {
+		im = immap (image, READ_ONLY, 0)
+		ksection[1] = '['
+		call imgstr (im, "extname", ksection[2], SZ_FNAME-1)
+		i = strlen (ksection)
+		ifnoerr (call imgstr (im, "extver" ,
+		    ksection[i+2], SZ_FNAME-i-1)) {
+		    ksection[i+1] = ','
+		    i = strlen (ksection)
+		}
+		ksection[i+1] = ']'
+		ksection[i+2] = EOS
+		call imunmap (im)
+	    } else {
+		i = stridxs (",", ksection[2]) + 2
+		if (i > 2) {
+		    j = ctoi (ksection, i, j)
+		    ksection[i] = ']'
+		    ksection[i+1] = EOS
+		}
+	    }
+	}
+
+	call sprintf (image, maxchar, "%s%s%s")
+	    call pargstr (Memc[cluster])
+	    call pargstr (ksection)
+	    call pargstr (Memc[section])
+
+	call sfree (sp)
+	return (stat)
+end
diff --git a/noao/twodspec/apextract/apgmark.x b/noao/twodspec/apextract/apgmark.x
new file mode 100644
index 00000000..72ad6a68
--- /dev/null
+++ b/noao/twodspec/apextract/apgmark.x
@@ -0,0 +1,126 @@
+include	<pkg/rg.h>
+include	"apertures.h"
+
+# AP_GMARK -- Mark an aperture.
+
+define	SZ_TEXT	10	# Maximum size of aperture number string
+
+procedure ap_gmark (gp, imvec, aps, naps)
+
+pointer	gp			# GIO pointer
+int	imvec			# Image vector
+pointer	aps[ARB]		# Aperture data
+int	naps			# Number of apertures
+
+int	i, apaxis
+real	x1, x2, y1, y2, dy, xc, xl, xu
+pointer	sp, text, format, ap
+
+int	itoc()
+real	ap_cveval()
+
+begin
+	# The aperture is marked at the top of the graph.
+	call smark (sp)
+	call salloc (text, SZ_TEXT, TY_CHAR)
+
+	call ggwind (gp, xl, xu, y1, y2)
+	x1 = min (xl, xu)
+	x2 = max (xl, xu)
+	dy = 0.025 * (y2 - y1)
+	y1 = y2 - 4 * dy
+
+	if (naps > 20) {
+	    call salloc (format, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[format], SZ_LINE, "h=c,v=b,s=%4.2f")
+		call pargr (20. / naps)
+	}
+ 
+	for (i = 1; i <= naps; i = i + 1) {
+	    ap = aps[i]
+	    apaxis = AP_AXIS(ap)
+
+	    xc = AP_CEN(ap, apaxis) + ap_cveval (AP_CV(ap), real (imvec))
+	    xl = xc + AP_LOW(ap, apaxis)
+	    xu = xc + AP_HIGH(ap, apaxis)
+	    call gline (gp, xc, y1 - 2 * dy, xc, y1 + 2 * dy)
+	    call gline (gp, xl, y1 - dy, xl, y1 + dy)
+	    call gline (gp, xu, y1 - dy, xu, y1 + dy)
+	    call gline (gp, xl, y1, xu, y1)
+	    if ((xc > x1) && (xc < x2)) {
+	        if (itoc (AP_ID(ap), Memc[text], SZ_TEXT) > 0) {
+		    if (naps > 20)
+		        call gtext (gp, xc, y1 + 2.5 * dy, Memc[text],
+			    Memc[format])
+		    else
+		        call gtext (gp, xc, y1 + 2.5 * dy, Memc[text],
+			    "h=c,v=b")
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_GMARKB -- Mark backgrounds.
+
+procedure ap_gmarkb (gp, imvec, aps, naps)
+
+pointer	gp			# GIO pointer
+int	imvec			# Image vector
+pointer	aps[ARB]		# Aperture data
+int	naps			# Number of apertures
+
+int	i, j, nx, apaxis
+real	x1, x2, y1, y2, dy, xc, xl, xu
+pointer	sp, sample, x, ap, rg
+
+real	ap_cveval()
+pointer	rg_xrangesr()
+
+begin
+	call smark (sp)
+	call salloc (sample, SZ_LINE, TY_CHAR)
+
+	# The background is marked at the bottom of the graph.
+	call ggwind (gp, xl, xu, y1, y2)
+	x1 = min (xl, xu)
+	x2 = max (xl, xu)
+	dy = 0.005 * (y2 - y1)
+	y1 = y1 + 4 * dy
+
+	# Allocate x array.
+	nx = x2 - x1 + 2
+	call salloc (x, nx, TY_REAL)
+
+	for (i = 1; i <= naps; i = i + 1) {
+	    ap = aps[i]
+	    apaxis = AP_AXIS(ap)
+
+	    xc = AP_CEN(ap, apaxis) + ap_cveval (AP_CV(ap), real (imvec))
+
+	    if (AP_IC(ap) == NULL)
+		next
+	    call ic_gstr (AP_IC(ap), "sample", Memc[sample], SZ_LINE)
+
+	    do j = 0, nx-1
+		Memr[x+j] = x1 + j - xc
+	    rg = rg_xrangesr (Memc[sample], Memr[x], nx)
+
+	    do j = 1, RG_NRGS(rg) {
+		xl = Memr[x+RG_X1(rg,j)-1] + xc
+		xu = Memr[x+RG_X2(rg,j)-1] + xc
+		if (xl > x1 && xl < x2)
+		    call gline (gp, xl, y1-dy, xl, y1+dy)
+		if (xu > x1 && xu < x2)
+		    call gline (gp, xu, y1-dy, xu, y1+dy)
+		call gline (gp, xl, y1, xu, y1)
+
+	    }
+
+	    call rg_free (rg)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apgraph.x b/noao/twodspec/apextract/apgraph.x
new file mode 100644
index 00000000..47d71646
--- /dev/null
+++ b/noao/twodspec/apextract/apgraph.x
@@ -0,0 +1,145 @@
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+
+# AP_GRAPH -- Graph the image data and call ap_gmark to mark the apertures.
+
+procedure ap_graph (gp, gt, imdata, npts, imvec, aps, naps)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+real	imdata[npts]		# Image data
+int	npts			# Number points in image data
+int	imvec			# Image vector
+pointer	aps[ARB]		# Aperture pointers
+int	naps			# Number of apertures
+
+real	x1, x2
+
+begin
+	call gclear (gp)
+
+	x1 = 1.
+	x2 = npts
+	call gswind (gp, x1, x2, INDEF, INDEF)
+	call gascale (gp, imdata, npts, 2)
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+	call gvline (gp, imdata, npts, x1, x2)
+
+	call ap_gmark (gp, imvec, aps, naps)
+	if (naps == 1)
+	    call ap_gmarkb (gp, imvec, aps, naps)
+end
+
+
+# AP_PLOT -- Make a plot of the apertures if plot output is defined.
+
+procedure ap_plot (image, line, nsum, aps, naps)
+
+char	image[SZ_FNAME]		# Image to be edited
+int	line			# Dispersion line
+int	nsum			# Number of dispersion lines to sum
+
+pointer	aps[ARB]		# Aperture pointers
+int	naps			# Number of apertures
+
+int	npts, apaxis, fd
+pointer	im, imdata, title, gp, gt, gt_init()
+errchk	ap_getdata, ap_popen
+
+begin
+	call ap_popen (gp, fd, "aps")
+	if (gp == NULL)
+	    return
+
+	# Map the image and get the image data.
+	call ap_getdata (image, line, nsum, im, imdata, npts, apaxis, title)
+
+	gt = gt_init()
+	call gt_sets (gt, GTTITLE, Memc[title])
+	call gt_sets (gt, GTPARAMS, "")
+	call gt_setr (gt, GTXMIN, INDEF)
+	call gt_setr (gt, GTXMAX, INDEF)
+	call gt_setr (gt, GTYMIN, INDEF)
+	call gt_setr (gt, GTYMAX, INDEF)
+
+	call ap_graph (gp, gt, Memr[imdata], npts, line, aps, naps)
+
+	call mfree (imdata, TY_REAL)
+	call mfree (title, TY_CHAR)
+	call ap_pclose (gp, fd)
+	call gt_free (gt)
+	call imunmap (im)
+end
+
+
+# AP_GRAPH1 -- Make a graph of the extracted 1D spectrum.
+
+procedure ap_graph1 (gt, bufout, npts, nspec)
+
+pointer	gt			# GTOOLS pointer
+real	bufout[npts, nspec]	# Data
+int	npts			# Number of data points
+int	nspec			# Number of spectra
+
+real	wx, wy
+int	i, wcs, key, gt_gcur()
+pointer	sp, str, gp
+errchk	ap_gopen
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	call ap_gopen (gp)
+	call gclear (gp)
+	call gswind (gp, 1., real (npts), INDEF, INDEF)
+	call gascale (gp, bufout, npts * nspec, 2)
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+	do i = 1, nspec
+	    call gvline (gp, bufout[1,i], npts, 1., real (npts))
+	call gflush (gp)
+
+	while (gt_gcur ("gcur", wx, wy, wcs, key, Memc[str],
+	    SZ_LINE) != EOF) {
+	    switch (key) {
+	    case 'I':
+		call fatal (0, "Interrupt")
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_PLOT1 -- Make a plot of the extracted 1D spectrum.
+
+procedure ap_plot1 (gt, bufout, npts, nspec)
+
+pointer	gt			# GTOOLS pointer
+real	bufout[npts,nspec]	# Data
+int	npts			# Number of data points
+int	nspec			# Number of spectra
+
+int	i, fd
+pointer	gp
+errchk	ap_popen
+
+begin
+	call ap_popen (gp, fd, "spec")
+	if (gp == NULL)
+	    return
+
+	call gclear (gp)
+	call gswind (gp, 1., real (npts), INDEF, INDEF)
+	call gascale (gp, bufout, npts * nspec, 2)
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+	do i = 1, nspec
+	    call gvline (gp, bufout[1,i], npts, 1., real (npts))
+	call gflush (gp)
+
+	call ap_pclose (gp, fd)
+end
diff --git a/noao/twodspec/apextract/apgscur.x b/noao/twodspec/apextract/apgscur.x
new file mode 100644
index 00000000..5306ff9a
--- /dev/null
+++ b/noao/twodspec/apextract/apgscur.x
@@ -0,0 +1,28 @@
+include	"apertures.h"
+
+# AP_GSCUR -- Set the graphics cursor to the aperture given by the index.
+# It computes the position of the cursor for the specified dispersion line.
+
+procedure ap_gscur (index, gp, line, aps, y)
+
+int	index			# Index of aperture
+pointer	gp			# GIO pointer
+int	line			# Dispersion line
+pointer	aps[ARB]		# Apertures
+real	y			# Y cursor coordinate
+
+int	apaxis
+real	x
+pointer	ap
+
+real	ap_cveval()
+
+begin
+	if (index < 1 || IS_INDEF (y))
+	    return
+
+	ap = aps[index]
+	apaxis = AP_AXIS(ap)
+	x = AP_CEN(ap, apaxis) + ap_cveval (AP_CV(ap), real (line))
+	call gscur (gp, x, y)
+end
diff --git a/noao/twodspec/apextract/apicset.x b/noao/twodspec/apextract/apicset.x
new file mode 100644
index 00000000..b837a991
--- /dev/null
+++ b/noao/twodspec/apextract/apicset.x
@@ -0,0 +1,84 @@
+include	<imhdr.h>
+include	"apertures.h"
+
+# AP_ICSET -- Set the background fitting ICFIT structure for an aperture.
+# If the input template aperture is NULL then the output background fitting
+# ICFIT pointer is initialized otherwise a copy from the input template
+# aperture is made.
+
+procedure ap_icset (apin, apout, imlen)
+
+pointer	apin		# Input template aperture pointer
+pointer	apout		# Output aperture pointer
+int	imlen		# Image length along aperture axis
+
+int	i
+real	x, x1, x2
+pointer	ic, sp, str
+
+int	apgeti(), ctor()
+real	apgetr()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	if (AP_IC(apout) == NULL)
+	    call ic_open (AP_IC(apout))
+	ic = AP_IC(apout)
+
+	if (apin == NULL) {
+	    call apgstr ("b_function", Memc[str], SZ_LINE)
+	    call ic_pstr (ic, "function", Memc[str])
+	    call ic_puti (ic, "order", apgeti ("b_order"))
+	    call apgstr ("b_sample", Memc[str], SZ_LINE)
+	    for (i=str; Memc[i]==' '; i=i+1)
+		;
+	    if (Memc[i] == EOS)
+		call strcpy ("*", Memc[str], SZ_LINE)
+	    call ic_pstr (ic, "sample", Memc[str])
+	    call ic_puti (ic, "naverage", apgeti ("b_naverage"))
+	    call ic_puti (ic, "niterate", apgeti ("b_niterate"))
+	    call ic_putr (ic, "low", apgetr ("b_low_reject"))
+	    call ic_putr (ic, "high", apgetr ("b_high_reject"))
+	    call ic_putr (ic, "grow", apgetr ("b_grow"))
+	    if (AP_AXIS(apout) == 1)
+		    call ic_pstr (ic, "xlabel", "Column")
+		else
+		    call ic_pstr (ic, "xlabel", "Line")
+	} else {
+	    if (AP_IC(apin) == NULL) {
+		call ic_closer (AP_IC(apout))
+		AP_IC(apout) = NULL
+		ic = NULL
+	    } else if (AP_IC(apin) != ic)
+	        call ic_copy (AP_IC(apin), ic)
+	}
+
+	# Set the background limits
+	if (ic != NULL) {
+	    i = AP_AXIS(apout)
+	    x1 = AP_LOW(apout, i)
+	    x2 = AP_HIGH(apout, i)
+
+	    call ic_gstr (ic, "sample", Memc[str], SZ_LINE)
+	    for (i=str; Memc[i]!=EOS; i=i+1)
+		if (Memc[i] == ':')
+		    Memc[i] = ','
+	    for (i=1; Memc[str+i-1]!=EOS; i=i+1) {
+		if (Memc[str+i-1] == '*') {
+		    x1 = min (x1, real(-imlen))
+		    x2 = max (x2, real(imlen))
+		} else if (ctor (Memc[str], i, x) > 0) {
+		    x1 = min (x1, x)
+		    x2 = max (x2, x)
+		    i = i - 1
+	        }
+	    }
+
+	    call ic_putr (ic, "xmin", x1)
+	    call ic_putr (ic, "xmax", x2)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apids.x b/noao/twodspec/apextract/apids.x
new file mode 100644
index 00000000..572890a5
--- /dev/null
+++ b/noao/twodspec/apextract/apids.x
@@ -0,0 +1,401 @@
+include	<error.h>
+include	<mach.h>
+include	"apertures.h"
+
+# Data structure for user aperture id table.
+define	IDS_LEN		4		# Length of ID structure
+define	IDS_NIDS	Memi[$1]	# Number of aperture IDs
+define	IDS_APS		Memi[$1+1]	# Aperture numbers (pointer)
+define	IDS_BEAMS	Memi[$1+2]	# Beam numbers (pointer)
+define	IDS_TITLES	Memi[$1+3]	# Titles (pointer)
+
+# AP_GIDS -- Get user aperture ID's.
+
+procedure ap_gids (ids)
+
+pointer	ids		# ID structure
+
+int	nids, ap, beam, fd, nalloc
+double	ra, dec
+pointer	sp, key, str, aps, beams, titles, im, list
+
+int	nowhite(), open(), fscan(), nscan()
+pointer	immap(), imofnlu(), imgnfn()
+errchk	open
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	nids = 0
+	nalloc = 0
+
+	call apgstr ("apidtable", Memc[key], SZ_FNAME)
+	if (nowhite (Memc[key], Memc[key], SZ_FNAME) > 0) {
+	    iferr {
+		# Read aperture information from an image.
+		ifnoerr (im = immap (Memc[key], READ_ONLY, 0)) {
+		    list = imofnlu (im, "SLFIB[0-9]*")
+		    while (imgnfn (list, Memc[key], SZ_FNAME) != EOF) {
+			call imgstr (im, Memc[key], Memc[str], SZ_LINE)
+			call sscan (Memc[str])
+			call gargi (ap)
+			if (nscan() == 0)
+			    next
+			if (ap < 1) {
+			    call imcfnl (list)
+			    call imunmap (im)
+			    call error (1,
+				"Aperture numbers in apidtable must be > 0")
+			}
+			if (nalloc == 0) {
+			    nalloc = 50
+			    call malloc (aps, nalloc, TY_INT)
+			    call malloc (beams, nalloc, TY_INT)
+			    call malloc (titles, nalloc, TY_POINTER)
+			} else if (nids == nalloc) {
+			    nalloc = nalloc + 50
+			    call realloc (aps, nalloc, TY_INT)
+			    call realloc (beams, nalloc, TY_INT)
+			    call realloc (titles, nalloc, TY_POINTER)
+			}
+			Memi[aps+nids] = ap
+			call gargi (Memi[beams+nids])
+			call gargd (ra)
+			call gargd (dec)
+			if (nscan() != 4) {
+			    call reset_scan ()
+			    call gargi (ap)
+			    call gargi (beam)
+			    Memc[str] = EOS
+			    call gargstr (Memc[str], SZ_LINE)	
+			    call xt_stripwhite (Memc[str])
+			    if (Memc[str] == EOS)
+				Memi[titles+nids] = NULL
+			    else {
+				call malloc (Memi[titles+nids], SZ_APTITLE,
+				    TY_CHAR)
+				call strcpy (Memc[str], Memc[Memi[titles+nids]],
+				    SZ_APTITLE)
+			    }
+			} else {
+			    Memc[str] = EOS
+			    call gargstr (Memc[str], SZ_LINE)	
+			    call xt_stripwhite (Memc[str])
+			    call malloc (Memi[titles+nids], SZ_APTITLE, TY_CHAR)
+			    if (Memc[str] == EOS) {
+				call sprintf (Memc[Memi[titles+nids]],
+				    SZ_APTITLE, "(%.2h %.2h)")
+				    call pargd (ra)
+				    call pargd (dec)
+			    } else {
+				call sprintf (Memc[Memi[titles+nids]],
+				    SZ_APTITLE, "%s (%.2h %.2h)")
+				    call pargstr (Memc[str])
+				    call pargd (ra)
+				    call pargd (dec)
+			    }
+			}
+			nids = nids + 1
+		    }	
+		    call imcfnl (list)
+		    call imunmap (im)
+
+		# Read aperture information from a file.
+		} else {
+		    fd = open (Memc[key], READ_ONLY, TEXT_FILE)
+		    while (fscan (fd) != EOF) {
+			call gargi (ap)
+			if (nscan() == 0)
+			    next
+			if (ap < 1) {
+			    call close (fd)
+			    call error (1,
+				"Aperture numbers in apidtable must be > 0")
+			}
+			if (nalloc == 0) {
+			    nalloc = 50
+			    call malloc (aps, nalloc, TY_INT)
+			    call malloc (beams, nalloc, TY_INT)
+			    call malloc (titles, nalloc, TY_POINTER)
+			} else if (nids == nalloc) {
+			    nalloc = nalloc + 50
+			    call realloc (aps, nalloc, TY_INT)
+			    call realloc (beams, nalloc, TY_INT)
+			    call realloc (titles, nalloc, TY_POINTER)
+			}
+			Memi[aps+nids] = ap
+			Memi[beams+nids] = ap
+			Memc[str] = EOS
+			call gargi (beam)
+			if (nscan() == 2)
+			    Memi[beams+nids] = beam
+			call gargstr (Memc[str], SZ_LINE)	
+			call xt_stripwhite (Memc[str])
+			if (Memc[str] == EOS)
+			    Memi[titles+nids] = NULL
+			else {
+			    call malloc (Memi[titles+nids], SZ_APTITLE, TY_CHAR)
+			    call strcpy (Memc[str], Memc[Memi[titles+nids]],
+				SZ_APTITLE)
+			}
+			nids = nids + 1
+		    }	
+		    call close (fd)
+		}
+	    } then
+		call erract (EA_WARN)
+	}
+
+	if (nalloc > nids) {
+	    call realloc (aps, nids, TY_INT)
+	    call realloc (beams, nids, TY_INT)
+	    call realloc (titles, nids, TY_INT)
+	}
+
+	if (nids > 0) {
+	    call malloc (ids, IDS_LEN, TY_STRUCT)
+	    IDS_NIDS(ids) = nids
+	    IDS_APS(ids) = aps
+	    IDS_BEAMS(ids) = beams
+	    IDS_TITLES(ids) = titles
+	}
+
+	call sfree (sp)
+end
+
+
+procedure ap_fids (ids)
+
+pointer	ids		# ID structure
+int	i
+
+begin
+	if (ids != NULL) {
+	    do i = 1, IDS_NIDS(ids)
+		call mfree (Memi[IDS_TITLES(ids)+i-1], TY_CHAR)
+	    call mfree (IDS_APS(ids), TY_INT)
+	    call mfree (IDS_BEAMS(ids), TY_INT)
+	    call mfree (IDS_TITLES(ids), TY_POINTER)
+	    call mfree (ids, TY_STRUCT)
+	}
+end
+
+
+
+# AP_IDS -- Set aperture IDs
+# Do not allow negative or zero aperture numbers.
+
+procedure ap_ids (aps, naps, ids)
+
+pointer	aps[ARB]	# Aperture pointers
+int	naps		# Number of apertures
+int	ids		# ID structure
+
+int	i, j, k, l, m,  axis, nids, ap, beam, skip, nused
+real	maxsep, apgetr()
+pointer	sp, used, a, b
+
+begin
+	if (naps < 1)
+	    return
+
+	axis = AP_AXIS(aps[1])
+	maxsep = apgetr ("maxsep")
+
+	# Dereference ID structure pointers.
+	if (ids != NULL) {
+	    nids = IDS_NIDS(ids)
+	    a = IDS_APS(ids)
+	    b = IDS_BEAMS(ids)
+	} else
+	    nids = 0
+
+	# Make a list of used aperture numbers
+	call smark (sp)
+	call salloc (used, naps, TY_INT)
+	nused = 0
+	do i = 1, naps
+	    if (!IS_INDEFI(AP_ID(aps[i]))) {
+		Memi[used+nused] = AP_ID(aps[i])
+		nused = nused + 1
+	    }
+
+	# Find first aperture with a defined aperture number.
+	for (i=1; i<=naps && IS_INDEFI(AP_ID(aps[i])); i=i+1)
+	    ;
+
+	# If there are no defined aperture numbers start with 1 or first
+	# aperture in the ID table.
+
+	if (i > naps) {
+	    i = 1
+	    if (nids > 0) {
+		ap = Memi[a]
+		beam = Memi[b]
+	    } else {
+		ap = i
+		beam = ap
+	    }
+	    AP_ID(aps[i]) = ap
+	    AP_BEAM(aps[i]) = beam
+	    Memi[used+nused] = ap
+	    nused = nused + 1
+	} else {
+	    ap = AP_ID(aps[i])
+	    for (l = 1; l <= nids && ap != Memi[a+l-1]; l = l + 1)
+		;
+	    if (l <= nids)
+		AP_BEAM(aps[i]) = Memi[b+l-1]
+	    else
+		AP_BEAM(aps[i]) = ap
+	}
+
+	# Work backwards through the undefined apertures.
+	for (j = i - 1; j > 0; j = j - 1) {
+	    skip = abs (AP_CEN(aps[j],axis)-AP_CEN(aps[j+1],axis)) / maxsep
+	    if (ids != NULL) {
+	        ap = AP_ID(aps[j+1])
+		for (l = 1; l <= nids && ap != Memi[a+l-1]; l = l + 1)
+		    ;
+		if (nids <= naps)
+		    skip = 0
+		m = l - skip
+		if (l > nids) {
+		    l = 1
+		    for (k = 2; k <= nids; k = k + 1)
+		        if (abs (ap - Memi[a+k-1]) < abs (ap - Memi[a+l-1]))
+			    l = k
+		    m = l - skip + 1
+		}
+		repeat {
+		    m = m - 1
+		    if (m > 0) {
+			ap = Memi[a+m-1]
+			beam = Memi[b+m-1]
+		    } else {
+			ap = Memi[a+l-1] + m
+			beam = max (0, Memi[b+l-1] + m)
+		    }
+		    if (ap == 0)
+			next
+		    for (k = 0; k < nused && abs(ap) != Memi[used+k]; k = k + 1)
+			;
+		    if (k == nused)
+			break
+		 }
+	    } else {
+	        ap = AP_ID(aps[j+1]) - skip
+	        repeat {
+		    ap = ap - 1
+		    beam = abs (ap)
+		    if (ap == 0)
+			next
+		    for (k = 0; k < nused && abs(ap) != Memi[used+k]; k = k + 1)
+		        ;
+		    if (k == nused)
+		        break
+	        }
+	    }
+	    ap = abs (ap)
+	    AP_ID(aps[j]) = ap
+	    AP_BEAM(aps[j]) = beam
+	    Memi[used+nused] = ap
+	    nused = nused + 1
+	}
+
+	# Work forwards through the undefined apertures.
+	for (i = i + 1; i <= naps; i = i + 1) {
+	    if (IS_INDEFI(AP_ID(aps[i]))) {
+	        skip = abs (AP_CEN(aps[i],axis)-AP_CEN(aps[i-1],axis)) / maxsep
+	        if (nids > 0) {
+	            ap = AP_ID(aps[i-1])
+		    for (l = 1; l <= nids && ap != Memi[a+l-1]; l = l + 1)
+		        ;
+		    if (nids <= naps)
+		        skip = 0
+		    m = l + skip
+		    if (l > nids) {
+		        l = 1
+		        for (k = 2; k <= nids; k = k + 1)
+		            if (abs (ap-Memi[a+k-1]) < abs (ap-Memi[a+l-1]))
+			        l = k
+		        m = l + skip - 1
+		    }
+		    m = nids - m + 1
+		    repeat {
+		        m = m - 1
+		        if (m > 0) {
+			    ap = Memi[a+nids-m]
+			    beam = Memi[b+nids-m]
+			} else {
+			    ap = Memi[a+l-1] - m
+			    beam = max (0, Memi[b+l-1] - m)
+			}
+			if (ap == 0)
+			    next
+		        for (k=0; k<nused && abs(ap)!=Memi[used+k]; k=k+1)
+			    ;
+		        if (k == nused)
+			    break
+		     }
+	        } else {
+	            ap = AP_ID(aps[i-1]) + skip
+	            repeat {
+		        ap = ap + 1
+		        beam = abs (ap)
+			if (ap == 0)
+			    next
+		        for (k=0; k<nused && abs(ap)!=Memi[used+k]; k=k+1)
+		            ;
+		        if (k == nused)
+		            break
+	            }
+	        }
+		ap = abs(ap)
+	        AP_ID(aps[i]) = ap
+	        AP_BEAM(aps[i]) = beam
+	        Memi[used+nused] = ap
+	        nused = nused + 1
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+procedure ap_titles (aps, naps, ids)
+
+pointer	aps[ARB]	# Aperture pointers
+int	naps		# Number of apertures
+pointer	ids		# ID structure
+
+int	i, j, nids
+pointer	a, titles, title
+
+begin
+	if (ids == NULL)
+	    return
+
+	nids = IDS_NIDS(ids)
+	a = IDS_APS(ids)
+	titles = IDS_TITLES(ids)
+
+	do i = 1, naps {
+	    if (AP_TITLE(aps[i]) != NULL)
+		next
+	    do j = 1, nids {
+		if (AP_ID(aps[i]) == Memi[a+j-1]) {
+		    title = Memi[titles+j-1]
+	            if (title != NULL) {
+	                if (AP_TITLE(aps[i]) == NULL)
+		            call malloc (AP_TITLE(aps[i]), SZ_APTITLE, TY_CHAR)
+	                call strcpy (Memc[title], Memc[AP_TITLE(aps[i])],
+			    SZ_APTITLE)
+	            } else if (AP_TITLE(aps[i]) != NULL)
+	                call mfree (AP_TITLE(aps[i]), TY_CHAR)
+		}
+	    }
+	}
+end
diff --git a/noao/twodspec/apextract/apimmap.x b/noao/twodspec/apextract/apimmap.x
new file mode 100644
index 00000000..f001dc39
--- /dev/null
+++ b/noao/twodspec/apextract/apimmap.x
@@ -0,0 +1,48 @@
+include	<imhdr.h>
+
+# AP_IMMAP -- Map an input image for the APEXTRACT package.
+
+pointer procedure ap_immap (image, apaxis, dispaxis)
+
+char	image[ARB]	# Image to map
+int	apaxis		# Aperture axis
+int	dispaxis	# Dispersion axis
+
+pointer	im, immap()
+int	i, j, imgeti(), clgeti()
+errchk	immap
+
+data	i/0/, j/0/
+
+begin
+	im = immap (image, READ_ONLY, 0)
+	if (IM_NDIM(im) == 1) {
+	    call imunmap (im)
+	    call error (0, "Image must be two dimensional")
+	} else if (IM_NDIM(im) > 2) {
+	    if (i == 0)
+	    call eprintf (
+    "Warning: Image(s) are not two dimensional (ignoring higher dimensions)\n")
+	    i = i + 1
+	} else
+	    i = 0
+
+	iferr (dispaxis = imgeti (im, "dispaxis"))
+	    dispaxis = clgeti ("dispaxis")
+	if (dispaxis < 1 || dispaxis > 2) {
+	    apaxis = dispaxis
+	    dispaxis = max (1, min (2, clgeti ("dispaxis")))
+	    if (j == 0) {
+		call eprintf (
+		    "WARNING: Dispersion axis %d invalid; using axis %d\n")
+		    call pargi (apaxis)
+		    call pargi (dispaxis)
+	    }
+	    j = j + 1
+	} else
+	    j = 0
+
+	apaxis = mod (dispaxis, 2) + 1
+
+	return (im)
+end
diff --git a/noao/twodspec/apextract/apinfo.x b/noao/twodspec/apextract/apinfo.x
new file mode 100644
index 00000000..372860ae
--- /dev/null
+++ b/noao/twodspec/apextract/apinfo.x
@@ -0,0 +1,96 @@
+include	"apertures.h"
+
+# AP_INFO -- Print information about an aperture.
+
+procedure ap_info (ap)
+
+pointer	ap		# Aperture pointer
+
+int	n, ic_geti(), strlen()
+real	ic_getr()
+pointer	sp, str1, str2
+
+begin
+	call smark (sp)
+
+	if (AP_IC(ap) != NULL) {
+	    call salloc (str1, SZ_LINE, TY_CHAR)
+	    call salloc (str2, SZ_LINE, TY_CHAR)
+
+	    n = 0
+	    call ic_gstr (AP_IC(ap), "function", Memc[str1], SZ_LINE)
+	    call sprintf (Memc[str2], SZ_LINE, "background: func=%s ord=%d")
+		call pargstr (Memc[str1])
+		call pargi (ic_geti (AP_IC(ap), "order"))
+	    n = strlen (Memc[str2])
+	    call printf ("%s")
+		call pargstr (Memc[str2])
+
+	    call ic_gstr (AP_IC(ap), "sample", Memc[str1], SZ_LINE)
+	    if (Memc[str1] != '*') {
+	        call sprintf (Memc[str2], SZ_LINE, " sample=\"%s\"")
+		    call pargstr (Memc[str1])
+	        n = n + strlen (Memc[str2])
+		if (n > 80) {
+		    call printf ("\n\t")
+		    n = 8 + strlen (Memc[str2])
+		}
+		call printf ("%s")
+		    call pargstr (Memc[str2])
+	    }
+	    if (ic_geti (AP_IC(ap), "naverage") != 1) {
+		call sprintf (Memc[str2], SZ_LINE, " nav=%d")
+		    call pargi (ic_geti (AP_IC(ap), "naverage"))
+	        n = n + strlen (Memc[str2])
+		if (n > 80) {
+		    call printf ("\n\t")
+		    n = 8 + strlen (Memc[str2])
+		}
+		call printf ("%s")
+		    call pargstr (Memc[str2])
+	    }
+	    if (ic_geti (AP_IC(ap), "niterate") > 0) {
+		call sprintf (Memc[str2], SZ_LINE, " nit=%d")
+		    call pargi (ic_geti (AP_IC(ap), "niterate"))
+	        n = n + strlen (Memc[str2])
+		if (n > 80) {
+		    call printf ("\n\t")
+		    n = 8 + strlen (Memc[str2])
+		}
+		call printf ("%s")
+		    call pargstr (Memc[str2])
+		call sprintf (Memc[str2], SZ_LINE, " low=%3.1f")
+		    call pargr (ic_getr (AP_IC(ap), "low"))
+	        n = n + strlen (Memc[str2])
+		if (n > 80) {
+		    call printf ("\n\t")
+		    n = 8 + strlen (Memc[str2])
+		}
+		call printf ("%s")
+		    call pargstr (Memc[str2])
+		call sprintf (Memc[str2], SZ_LINE, " high=%3.1f")
+		    call pargr (ic_getr (AP_IC(ap), "high"))
+	        n = n + strlen (Memc[str2])
+		if (n > 80) {
+		    call printf ("\n\t")
+		    n = 8 + strlen (Memc[str2])
+		}
+		call printf ("%s")
+		    call pargstr (Memc[str2])
+	        if (ic_getr (AP_IC(ap), "grow") > 0) {
+		    call sprintf (Memc[str2], SZ_LINE, " grow=%d")
+		        call pargr (ic_getr (AP_IC(ap), "grow"))
+	            n = n + strlen (Memc[str2])
+		    if (n > 80) {
+		        call printf ("\n\t")
+		        n = 8 + strlen (Memc[str2])
+		    }
+		    call printf ("%s")
+		        call pargstr (Memc[str2])
+	        }
+	    }
+	    call printf ("\n")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apio.x b/noao/twodspec/apextract/apio.x
new file mode 100644
index 00000000..bfd2c6e6
--- /dev/null
+++ b/noao/twodspec/apextract/apio.x
@@ -0,0 +1,144 @@
+include	<time.h>
+
+# AP_LOG -- Verbose, log, and error output.
+
+procedure ap_log (str, log, verbose, err)
+
+char	str[ARB]	# String
+int	log		# Write to log if logfile defined?
+int	verbose		# Write to stdout if verbose?
+int	err		# Write to stdout?
+
+int	fd, open()
+long	clktime()
+bool	clgetb()
+pointer	sp, logfile, date
+errchk	open
+
+begin
+	call smark (sp)
+	call salloc (logfile, SZ_LINE, TY_CHAR)
+	call salloc (date, SZ_DATE, TY_CHAR)
+	call cnvdate (clktime(0), Memc[date], SZ_DATE)
+
+	if (err == YES || (verbose == YES && clgetb ("verbose"))) {
+	    call printf ("%s: %s\n")
+	        call pargstr (Memc[date])
+	        call pargstr (str)
+	    call flush (STDOUT)
+	}
+
+	if (log == YES) {
+	    call clgstr ("logfile", Memc[logfile], SZ_FNAME)
+	    if (Memc[logfile] != EOS) {
+	        fd = open (Memc[logfile], APPEND, TEXT_FILE)
+	        call fprintf (fd, "%s: %s\n")
+	            call pargstr (Memc[date])
+	            call pargstr (str)
+	        call flush (fd)
+	        call close (fd)
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_GOPEN/AP_GCLOSE -- Open and close the graphics device.
+# The device "stdgraph" is used.
+
+procedure ap_gopen (gp)
+
+pointer	gp		# GIO pointer
+pointer	gplast		# Last GIO pointer
+
+int	flag
+pointer	gopen()
+errchk	gopen
+
+data	flag/NO/
+common	/apgio/ gplast
+
+begin
+	if (flag == NO) {
+	    flag = YES
+	    call ap_gclose ()
+	}
+
+	if (gplast == NULL)
+	    gplast = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+
+	gp = gplast
+end
+
+procedure ap_gclose ()
+
+int	flag
+pointer	gplast
+
+data	flag/NO/
+common	/apgio/ gplast
+
+begin
+	if (flag == NO) {
+	    flag = YES
+	    gplast = NULL
+	}
+
+	if (gplast != NULL) {
+	    call gclose (gplast)
+	    gplast = NULL
+	}
+end
+
+
+# AP_POPEN -- Open the plot device or metacode file.  This includes CLIO
+# to get the plot device.
+
+procedure ap_popen (gp, fd, type)
+
+pointer	gp		# GIO pointer
+int	fd		# FIO channel for metacode file
+char	type[ARB]	# Plot type
+
+bool	streq(), strne()
+int	open(), nowhite(), strncmp()
+pointer	sp, str, gopen()
+errchk	gopen, open
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call clgstr ("plotfile", Memc[str], SZ_LINE)
+
+	gp = NULL
+	fd = NULL
+	if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) {
+	    if (strncmp ("debug", Memc[str], 5) == 0) {
+		if (streq (type, Memc[str+5]) || streq ("all", Memc[str+5])) {
+		    fd = open (Memc[str], APPEND, BINARY_FILE)
+		    gp = gopen ("stdvdm", APPEND, fd)
+		}
+	    } else if (strne ("fits", type)) {
+		fd = open (Memc[str], APPEND, BINARY_FILE)
+		gp = gopen ("stdvdm", APPEND, fd)
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_PCLOSE -- Close plot file.
+
+procedure ap_pclose (gp, fd)
+
+pointer	gp		# GIO pointer
+int	fd		# FIO channel for metacode file
+
+begin
+	if (gp != NULL)
+	    call gclose (gp)
+	if (fd != NULL)
+	    call close (fd)
+end
diff --git a/noao/twodspec/apextract/apmask.par b/noao/twodspec/apextract/apmask.par
new file mode 100644
index 00000000..7f8e114b
--- /dev/null
+++ b/noao/twodspec/apextract/apmask.par
@@ -0,0 +1,19 @@
+# APMASK
+
+input,s,a,,,,List of input images
+output,s,a,,,,List of output masks
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,List of reference images
+
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,no,,,Recenter apertures?
+resize,b,h,no,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit the traced points interactively?
+mask,b,h,yes,,,"Create mask images?
+"
+line,i,h,INDEF,1,,Starting dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+buffer,r,h,0.,,,Buffer distance from apertures
diff --git a/noao/twodspec/apextract/apmask.x b/noao/twodspec/apextract/apmask.x
new file mode 100644
index 00000000..4dc4da19
--- /dev/null
+++ b/noao/twodspec/apextract/apmask.x
@@ -0,0 +1,155 @@
+include	<imhdr.h>
+include	<pmset.h>
+include	"apertures.h"
+
+# AP_MASK -- Create an aperture mask.
+# The mask is boolean with pixels within the apertures having value 1 and
+# pixels outside the mask having values 0.  An additional  buffer distance 
+# may be specified.
+
+procedure ap_mask (image, output,  aps, naps)
+
+char	image[SZ_FNAME]		# Image name
+char	output[SZ_FNAME]	# Output mask name
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+
+real	buffer			# Buffer distance
+
+int	i, j, aaxis, baxis, nc, nl, na, nb, apmin, apmax, low, high
+real	aplow, aphigh, shift
+long	v[2]
+short	val
+pointer	im, pm, ap, cv, a1, b1
+pointer	sp, name, str, buf, a, b, amin, bmax
+
+real	clgetr(), ap_cveval()
+bool	ap_answer()
+pointer	ap_immap(), pm_newmask()
+errchk	ap_immap, pm_savef
+
+begin
+	# Query user.
+	call smark (sp)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[str], SZ_LINE, "Create aperture mask for %s?")
+	    call pargstr (image)
+	if (!ap_answer ("ansmask", Memc[str])) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Get buffer distance.
+	buffer = clgetr ("buffer")
+
+	# Make the image and initialize the mask.
+	im = ap_immap (image, aaxis, baxis)
+	pm = pm_newmask (im, 1)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	na = IM_LEN(im,aaxis)
+	nb = IM_LEN(im,baxis)
+
+	# Allocate memory.
+	call salloc (buf, nc, TY_SHORT)
+	call salloc (a, naps*nb, TY_SHORT)
+	call salloc (b, naps*nb, TY_SHORT)
+	call salloc (amin, naps, TY_SHORT)
+	call salloc (bmax, naps, TY_SHORT)
+	val = 1
+
+	# Go through and compute all the limits as well as the maximum
+	# range of each aperture.  This information must be computed for
+	# an aperture axis of 2 and it is also done for aperture axis
+	# of 1 just to keep the code the same.
+
+	do i = 1, naps {
+	    ap = aps[i]
+	    cv = AP_CV(ap)
+	    aplow = AP_CEN(ap,aaxis) + AP_LOW(ap,aaxis) - buffer
+	    aphigh = AP_CEN(ap,aaxis) + AP_HIGH(ap,aaxis) + buffer
+	    apmin = aplow
+	    apmax = aphigh
+	    a1 = a + (i - 1) * nb
+	    b1 = b + (i - 1) * nb
+	    do j = 1, nb {
+		shift = ap_cveval (cv, real (j))
+		low = nint (aplow + shift)
+		high = nint (aphigh + shift)
+		Mems[a1+j-1] = low
+		Mems[b1+j-1] = high
+		apmin = min (low, apmin)
+		apmax = max (high, apmax)
+	    }
+	    Mems[amin+i-1] = apmin
+	    Mems[bmax+i-1] = apmax
+	}
+
+	# For each line create a pixel array mask.  For aperture axis 1 this
+	# is simple while for aperture axis 2 we have to look through each
+	# line to see if any apertures intersect the line.
+
+	switch (aaxis) {
+	case 1:
+	    do j = 1, nl {
+	        v[2] = j
+		call aclrs (Mems[buf], nc)
+		a1 = a + j - 1
+		b1 = b + j - 1
+	        do i = 1, naps {
+		    low = Mems[a1]
+		    high = Mems[b1]
+		    low = max (1, low)
+		    high = min (na, high)
+		    if (low <= high)
+			call amovks (val, Mems[buf+low-1], high-low+1)
+		    a1 = a1 + nb
+		    b1 = b1 + nb
+	        }
+	        call pmplps (pm, v, Mems[buf], 1, nc, PIX_SRC)
+	    }
+	case 2:
+	    do j = 1, nl {
+		v[2] = j
+		call aclrs (Mems[buf], nc)
+		do i = 1, naps {
+		    if (j < Mems[amin+i-1] || j > Mems[bmax+i-1])
+			next
+
+		    a1 = a + (i - 1) * nb
+		    b1 = b + (i - 1) * nb
+		    for (low=0; low<nb; low=low+1) {
+			if (j < Mems[a1+low] || j > Mems[b1+low])
+			    next
+			for (high=low+1; high<nb; high=high+1)
+			    if (j < Mems[a1+high] || j > Mems[b1+high])
+				break
+			call amovks (val, Mems[buf+low], high-low)
+			low = high - 1
+		    }
+		}
+	        call pmplps (pm, v, Mems[buf], 1, nc, PIX_SRC)
+	    }
+	}
+	    
+	# Log the output and finish up.
+	if (output[1] == EOS) {
+	    call sprintf (Memc[name], SZ_LINE, "%s.pl")
+	        call pargstr (image)
+	} else
+	    call strcpy (output, Memc[name], SZ_LINE)
+	call sprintf (Memc[str], SZ_LINE, "Aperture mask for %s")
+	    call pargstr (image)
+
+	call pm_savef (pm, Memc[name], Memc[str], 0)
+	call pm_close (pm)
+	call imunmap (im)
+
+	call sprintf (Memc[str], SZ_LINE, "MASK - Aperture mask for %s --> %s")
+       	    call pargstr (image)
+	    call pargstr (Memc[name])
+	call ap_log (Memc[str], YES, YES, NO)
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apmw.x b/noao/twodspec/apextract/apmw.x
new file mode 100644
index 00000000..9fcd35d7
--- /dev/null
+++ b/noao/twodspec/apextract/apmw.x
@@ -0,0 +1,280 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mwset.h>
+
+
+# APMW_OPEN   -- Open APMW structure.
+# APMW_CLOSE  -- Close APMW structure.
+# APMW_SETAP  -- Set aperture values in APMW structure.
+# APMW_SAVEIM -- Set WCS in image header.
+# APMW_WCSFIX -- Fix up WCS
+
+# Output formats
+define	ONEDSPEC	1	# Individual 1D spectra
+define	MULTISPEC	2	# Multiple spectra
+define	ECHELLE		3	# Echelle spectra
+define	STRIP		4	# Strip spectra
+define	NORM		5	# Normalized spectra
+define	FLAT		6	# Flat spectra
+define	RATIO		7	# Ratio of data to model
+define	DIFF		8	# Difference of data and model
+define	FIT		9	# Model
+define	NOISE		10	# Noise calculation
+
+
+# Data structure for the apertures.  This version assumes the coordinates
+# are the same for all the apertures.
+
+define	APMW_LEN	(8 + $1 * 6)		# Structure length
+
+define	APMW_LABEL	Memi[$1]			# WCS label
+define	APMW_UNITS	Memi[$1+1]			# WCS units
+define	APMW_DTYPE	Memi[$1+2]			# Dispersion type
+define	APMW_NW		Memi[$1+3]			# Number of pixels
+define	APMW_W1		Memd[P2D($1+4)]			# Starting coordinate
+define	APMW_DW		Memd[P2D($1+6)]			# Coordinate per pixel
+define	APMW_AP		Memi[$1+6*($2-1)+8]		# Aperture
+define	APMW_BEAM	Memi[$1+6*($2-1)+9]		# Beam
+define	APMW_APLOW	Memd[P2D($1+6*($2-1)+10)]	# Aperture low
+define	APMW_APHIGH	Memd[P2D($1+6*($2-1)+12)]	# Aperture high
+
+
+# APMW_OPEN -- Open APMW structure.
+
+pointer procedure apmw_open (in, out, dispaxis, naps, nw)
+
+pointer	in		#I Input IMIO pointer
+pointer	out		#I Output IMIO pointer
+int	dispaxis	#I Input dispersion axis
+int	naps		#I Number of apertures
+int	nw		#I Number of dispersion pixels
+pointer	apmw		#O Returned APMW pointer
+
+int	imgeti()
+double	mw_c1trand()
+pointer	mw, ct, mw_openim(), mw_sctran()
+errchk	mw_openim, mw_sctran, mw_c1trand, apmw_wcsfix
+
+begin
+	# Allocate data structure.
+	call malloc (apmw, APMW_LEN(naps), TY_STRUCT)
+	call malloc (APMW_LABEL(apmw), SZ_LINE, TY_CHAR)
+	call malloc (APMW_UNITS(apmw), SZ_LINE, TY_CHAR)
+
+	# Set defaults.
+	call strcpy ("Pixel", Memc[APMW_LABEL(apmw)], SZ_LINE)
+	Memc[APMW_UNITS(apmw)] = EOS
+	APMW_DTYPE(apmw,i) = -1
+	APMW_NW(apmw,i) = nw
+	APMW_W1(apmw,i) = 1.
+	APMW_DW(apmw,i) = 1.
+
+	# Get WCS info from input image.
+	iferr {
+	    mw = mw_openim (in)
+	    iferr (APMW_DTYPE(apmw) = imgeti (in, "DC-FLAG"))
+		APMW_DTYPE(apmw) = -1
+	    iferr (call mw_gwattrs (mw, dispaxis, "label",
+		Memc[APMW_LABEL(apmw)], SZ_LINE)) {
+		if (APMW_DTYPE(apmw) == -1)
+		    call strcpy ("Pixel", Memc[APMW_LABEL(apmw)], SZ_LINE)
+		else
+		    call strcpy ("Wavelength", Memc[APMW_LABEL(apmw)], SZ_LINE)
+	    }
+	    iferr (call mw_gwattrs (mw, dispaxis, "units",
+		Memc[APMW_UNITS(apmw)], SZ_LINE)) {
+		if (APMW_DTYPE(apmw) == -1)
+		    Memc[APMW_UNITS(apmw)] = EOS
+		else
+		    call strcpy ("Angstroms", Memc[APMW_UNITS(apmw)], SZ_LINE)
+	    }
+
+	    call apmw_wcsfix (in, mw)
+	    iferr (ct = mw_sctran (mw, "logical", "world", dispaxis))
+		call error (1,
+	    "Coordinate system ignored (rotated?). Using pixel coordinates.")
+	    APMW_W1(apmw) = mw_c1trand (ct, 1D0)
+	    APMW_DW(apmw) = mw_c1trand (ct, double (nw))
+	    APMW_DW(apmw) = (APMW_DW(apmw)-APMW_W1(apmw))/(nw-1)
+	} then
+	    call erract (EA_WARN)
+
+	call mw_close (mw)
+
+	return (apmw)
+end
+
+
+# APMW_CLOSE -- Close APMW structure.
+
+procedure apmw_close (apmw)
+
+pointer	apmw		# APMW pointer
+
+begin
+	call mfree (APMW_LABEL(apmw), TY_CHAR)
+	call mfree (APMW_UNITS(apmw), TY_CHAR)
+	call mfree (apmw, TY_STRUCT)
+end
+
+
+# APMW_SETAP -- Set aperture values in APMW structure.
+
+procedure apmw_setap (apmw, line, ap, beam, aplow, aphigh)
+
+pointer	apmw		# APMW pointer
+int	line		# Image line
+int	ap		# Aperture
+int	beam		# Beam
+real	aplow		# Aperture lower limit
+real	aphigh		# Aperture upper limit
+
+begin
+	APMW_AP(apmw,line) = ap
+	APMW_BEAM(apmw,line) = beam
+	APMW_APLOW(apmw,line) = aplow
+	APMW_APHIGH(apmw,line) = aphigh
+end
+
+
+# APMW_SAVEIM -- Save WCS in image header.
+
+procedure apmw_saveim (apmw, im, fmt)
+
+pointer	apmw			#I APMW pointer
+pointer	im			#I IMIO pointer
+int	fmt			#I Output format
+
+int	i, naps, wcsdim, axes[3], imaccf()
+double	r[3], w[3], cd[9]
+bool	strne()
+pointer	sp, key, str, mw, list, mw_open(), imofnlu(), imgnfn()
+errchk	imdelf
+data	axes/1,2,3/
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	if (fmt == STRIP)
+	    naps = 1
+	else
+	    naps = IM_LEN(im, 2)
+
+	# Workaround for truncation of header during image header copy.
+	IM_HDRLEN(im) = IM_LENHDRMEM(im)
+
+	# Delete keywords.
+	list = imofnlu (im, "SLFIB[0-9]*")
+	while (imgnfn (list, Memc[key], SZ_FNAME) != EOF)
+	    call imdelf (im, Memc[key])
+	call imcfnl (list)
+
+	# Add aperture parameters to image header.
+	do i = 1, naps {
+	    call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
+		call pargi (i)
+	    call sprintf (Memc[str], SZ_LINE, "%d %d %.2f %.2f")
+		call pargi (APMW_AP(apmw,i))
+		call pargi (APMW_BEAM(apmw,i))
+		call pargd (APMW_APLOW(apmw,i))
+		call pargd (APMW_APHIGH(apmw,i))
+	    call imastr (im, Memc[key], Memc[str])
+	    if (naps == 1) {
+		call sprintf (Memc[key], SZ_FNAME, "APID%d")
+		    call pargi (i)
+		ifnoerr (call imgstr (im, Memc[key], Memc[str], SZ_LINE)) {
+		    if (strne (Memc[str], IM_TITLE(im))) {
+			call imastr (im, "MSTITLE", IM_TITLE(im))
+			call strcpy (Memc[str], IM_TITLE(im), SZ_IMTITLE)
+		    }
+		    call imdelf (im, Memc[key])
+		}
+	    }
+	}
+
+	# Add dispersion parameters to image header.
+	if (APMW_DTYPE(apmw) != -1)
+	    call imaddi (im, "DC-FLAG", APMW_DTYPE(apmw))
+	else if (imaccf (im, "DC-FLAG") == YES)
+	    call imdelf (im, "DC-FLAG")
+	if (APMW_NW(apmw) < IM_LEN(im,1))
+	    call imaddi (im, "NP2", APMW_NW(apmw))
+	else if (imaccf (im, "NP2") == YES)
+	    call imdelf (im, "NP2")
+	iferr (call imdelf (im, "dispaxis"))
+	    ;
+	if (fmt == STRIP)
+	    call imaddi (im, "dispaxis", 1)
+
+	# Set WCS in image header.
+	wcsdim = IM_NPHYSDIM(im)
+	mw = mw_open (NULL, wcsdim)
+	if (fmt == STRIP)
+	    call mw_newsystem (mw, "linear", wcsdim)
+	else
+	    call mw_newsystem (mw, "equispec", wcsdim)
+	call mw_swtype (mw, axes, wcsdim, "linear", "")
+	if (Memc[APMW_LABEL(apmw)] != EOS)
+	    call mw_swattrs (mw, 1, "label", Memc[APMW_LABEL(apmw)])
+	if (Memc[APMW_UNITS(apmw)] != EOS)
+	    call mw_swattrs (mw, 1, "units", Memc[APMW_UNITS(apmw)])
+
+	call aclrd (r, 3)
+	call aclrd (w, 3)
+	call aclrd (cd, 9)
+	r[1] = 1.
+	w[1] = APMW_W1(apmw)
+	cd[1] = APMW_DW(apmw)
+	if (wcsdim == 2)
+	    cd[4] = 1.
+	if (wcsdim == 3) {
+	    cd[5] = 1.
+	    cd[9] = 1.
+	}
+	call mw_swtermd (mw, r, w, cd, wcsdim)
+
+	call mw_saveim (mw, im)
+	call mw_close (mw)
+
+	call sfree (sp)
+end
+
+
+# APMW_WCSFIX -- Fix up WCS to avoid CDELT=0 which occurs if there are WCS
+# keywords in the header but no CDELT.
+
+procedure apmw_wcsfix (im, mw)
+
+pointer	im			# IMIO pointer
+pointer	mw			# MWCS pointer
+
+int	i, ndim, mw_stati()
+double	val
+pointer	sp, r, w, cd
+errchk	mw_gwtermd, mw_swtermd
+
+begin
+	call mw_seti (mw, MW_USEAXMAP, NO)
+	ndim = mw_stati (mw, MW_NDIM)
+
+	call smark (sp)
+	call salloc (r, ndim, TY_DOUBLE)
+	call salloc (w, ndim, TY_DOUBLE)
+	call salloc (cd, ndim*ndim, TY_DOUBLE)
+
+	# Check cd terms.  Assume no rotation.
+	call mw_gwtermd (mw, Memd[r], Memd[w], Memd[cd], ndim)
+	do i = 0, ndim-1 {
+	    val = Memd[cd+i*(ndim+1)]
+	    if (val == 0D0) {
+		Memd[w+i] = 1D0
+	        Memd[cd+i*(ndim+1)] = 1D0
+	    }
+	}
+	call mw_swtermd (mw, Memd[r], Memd[w], Memd[cd], ndim)
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apnearest.x b/noao/twodspec/apextract/apnearest.x
new file mode 100644
index 00000000..f3e027c5
--- /dev/null
+++ b/noao/twodspec/apextract/apnearest.x
@@ -0,0 +1,75 @@
+include	<mach.h>
+include	"apertures.h"
+
+# AP_NEAREST -- Find the index of the aperture nearest cursor position x.
+
+define	DELTA	0.01		# Tolerance for equidistant apertures
+
+procedure ap_nearest (index, line, aps, naps, x)
+
+int	index			# Index of aperture nearest x
+int	line			# Dispersion line
+pointer	aps[ARB]		# Aperture pointers
+int	naps			# Number of apertures
+real	x			# Point nearest aperture
+
+int	i, j, apaxis
+char	ch
+real	d, delta
+pointer	ap
+
+int	fscan(), nscan()
+real	ap_cveval()
+
+begin
+	if (naps == 0)
+	    return
+
+	index = 0
+	delta = MAX_REAL
+
+	for (i = 1; i <= naps; i = i + 1) {
+	    ap = aps[i]
+	    apaxis = AP_AXIS(ap)
+	    d = abs (AP_CEN(ap, apaxis)+ap_cveval(AP_CV(ap),real(line))-x)
+	    if (d < delta - DELTA) {
+		j = 1
+		index = i
+		delta = d
+	    } else if (d < delta + DELTA)
+		j = j + 1
+	}
+
+	# If there is more than one aperture equally near ask the user.
+	if (j > 1) {
+	    call printf ("Apertures")
+	    for (i = 1; i <= naps; i = i + 1) {
+	        ap = aps[i]
+	        apaxis = AP_AXIS(ap)
+	        d = abs (AP_CEN(ap, apaxis)+ap_cveval(AP_CV(ap),real(line))-x)
+	        if (d < delta + DELTA) {
+		    call printf (" %d")
+			call pargi (AP_ID (ap))
+		}
+	    }
+	    call printf (" are equally near the cursor.\n")
+10	    call printf ("Choose an aperture (%d): ")
+		call pargi (AP_ID (aps[index]))
+	    call flush (STDOUT)
+	    if (fscan (STDIN) != EOF) {
+		call scanc (ch)
+		if (ch == '\n')
+		    return
+
+		call reset_scan()
+		call gargi (j)
+		if (nscan() == 0)
+		    goto 10
+		for (i=1; (i<=naps)&&(AP_ID(aps[i])!=j); i=i+1)
+		    ;
+		if (i > naps)
+		    goto 10
+		index = i
+	    }
+	}
+end
diff --git a/noao/twodspec/apextract/apnoise.key b/noao/twodspec/apextract/apnoise.key
new file mode 100644
index 00000000..4920453a
--- /dev/null
+++ b/noao/twodspec/apextract/apnoise.key
@@ -0,0 +1,14 @@
+	APNOISE CURSOR COMMANDS
+
+
+?  Print command help
+q  Quit
+r  Redraw	
+w  Window the graph (see :/help)
+I  Interupt immediately
+
+:gain <value>		Check or set the gain model parameter
+:readnoise <value>	Check or set the read noise model parameter
+
+Also see the CURSOR MODE commads (:.help) and the windowing commands
+(:/help).
diff --git a/noao/twodspec/apextract/apnoise.par b/noao/twodspec/apextract/apnoise.par
new file mode 100644
index 00000000..365bc1c3
--- /dev/null
+++ b/noao/twodspec/apextract/apnoise.par
@@ -0,0 +1,30 @@
+# APSIGMA
+
+input,s,a,,,,List of images to evaluate
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"List of reference images
+"
+dmin,r,a,,,,Data minimum for sigma bins
+dmax,r,a,,,,Data maximum for sigma bins
+nbins,i,a,,1,,Number of sigma bins
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,"Fit traced points interactively?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+threshold,r,h,10.,,,"Division threshold for ratio fit
+"
+background,s,h,"none","none|average|median|minimum|fit",,Background to subtract
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting type (fit1d|fit2d)
+clean,b,h,no,,,Detect and replace bad pixels?
+skybox,i,h,1,1,,Box car smoothing length for sky
+saturation,r,h,INDEF,,,Saturation level
+readnoise,s,h,"0.",,,Read out noise sigma (photons)
+gain,s,h,"1.",,,Photon gain (photons/data number)
+lsigma,r,h,4.,0.,,Lower rejection threshold
+usigma,r,h,4.,0.,,Upper rejection threshold
diff --git a/noao/twodspec/apextract/apnoise.x b/noao/twodspec/apextract/apnoise.x
new file mode 100644
index 00000000..d22c09ae
--- /dev/null
+++ b/noao/twodspec/apextract/apnoise.x
@@ -0,0 +1,256 @@
+include	<gset.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+
+# AP_NOISE -- Model residuals.
+
+procedure ap_noise (ap, gain, dbuf, nc, nl, c1, l1, sbuf, spec, profile, nx, ny,
+	xs, ys, sum2, sum4, nsum, nbin, dmin, dmax)
+
+pointer	ap			# Aperture structure
+real	gain			# Gain
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+pointer	sbuf			# Sky buffer (NULL if no sky)
+real	spec[ny]		# Normalization spectrum
+real	profile[ny,nx]		# Profile
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Start of spectrum in image
+real	sum2[nbin]		# Sum of residuals squared in bin
+real	sum4[nbin]		# Sum of residuals squared in bin
+int	nsum[nbin]		# Number of values in bin
+int	nbin			# Number of bins
+real	dmin, dmax		# Data limits of bins
+
+int	i, ix, iy, ix1, ix2
+real	dstep, low, high, s, x1, x2, model, data, ap_cveval()
+pointer	cv, sptr, dptr
+
+begin
+	dstep = (dmax - dmin) / nbin
+
+	i = AP_AXIS(ap)
+	low = AP_CEN(ap,i) + AP_LOW(ap,i)
+	high = AP_CEN(ap,i) + AP_HIGH(ap,i)
+	cv = AP_CV(ap)
+
+	do iy = 1, ny {
+	    i = iy + ys - 1
+	    s = ap_cveval (cv, real (i))
+	    x1 = max (0.5, low + s) 
+	    x2 = min (c1 + nc - 0.49, high + s) 
+	    if (x1 > x2)
+		next
+
+	    ix1 = nint (x1) - xs[iy] + 1
+	    ix2 = nint (x2) - xs[iy] + 1
+
+	    s = spec[iy]
+	    if (sbuf != NULL)
+		sptr = sbuf + (iy - 1) * nx - 1
+	    dptr = dbuf + (i - l1) * nc + nint(x1) - c1
+	    do ix = ix1, ix2 {
+		if (sbuf != NULL) {
+		    model = (s * profile[iy,ix] + Memr[sptr]) / gain
+		    sptr = sptr + 1
+		} else
+		    model = (s * profile[iy,ix]) / gain
+		data = Memr[dptr] / gain
+		dptr = dptr + 1
+
+		if (model < dmin || model >= dmax)
+		    next
+		i = (model - dmin) / dstep + 1
+		sum2[i] = sum2[i] + (data - model) ** 2
+		sum4[i] = sum4[i] + (data - model) ** 4
+		nsum[i] = nsum[i] + 1
+	    }
+	}
+end
+
+
+define	HELP	"noao$twodspec/apextract/apnoise.key"
+define	PROMPT	"apextract options"
+
+# AP_NPLOT -- Plot and examine noise characteristics.
+
+procedure ap_nplot (image, im, sigma, sigerr, npts, dmin, dmax)
+
+char	image[SZ_FNAME]		# Image
+pointer	im			# Image pointer
+real	sigma[npts]		# Sigma values
+real	sigerr[npts]		# Sigma errors
+int	npts			# Number of sigma values
+real	dmin, dmax		# Data min and max
+
+real	rdnoise			# Read noise
+real	gain			# Gain
+
+int	i, newgraph, wcs, key
+real	wx, wy, x, x1, x2, dx, y, ymin, ymax
+pointer	sp, cmd, gp, gt
+
+int	gt_gcur()
+real	apgimr()
+#int	apgwrd()
+#bool	ap_answer()
+pointer	gt_init()
+errchk	ap_gopen
+
+begin
+	# Query user.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	#call sprintf (Memc[cmd], SZ_LINE, "Edit apertures for %s?")
+    	#    call pargstr (image)
+	#if (!ap_answer ("ansedit", Memc[cmd])) {
+	#    call sfree (sp)
+	#    return
+	#}
+
+	gain = apgimr ("gain", im)
+	rdnoise = apgimr ("readnoise", im)
+
+	dx = (dmax - dmin) / npts
+	x1 = dmin + dx / 2
+	x2 = dmax - dx / 2
+	ymin = sigma[1] - sigerr[1]
+	ymax = sigma[1] + sigerr[1]
+	do i = 2, npts {
+	    ymin = min (ymin, sigma[i] - sigerr[i])
+	    ymax = max (ymax, sigma[i] + sigerr[i])
+	}
+
+	# Set up the graphics.
+	call sprintf (Memc[cmd], SZ_LINE, "Noise characteristics of image %s")
+	    call pargstr (image)
+	call ap_gopen (gp)
+	gt = gt_init()
+	call gt_sets (gt, GTTITLE, Memc[cmd])
+	call gt_sets (gt, GTXLABEL, "Data value")
+	call gt_sets (gt, GTYLABEL, "Sigma")
+	call gt_sets (gt, GTTYPE, "mark")
+	call gt_sets (gt, GTMARK, "plus")
+
+	# Enter cursor loop.
+	key = 'r'
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call gpagefile (gp, HELP, PROMPT)
+
+	    case ':': # Colon commands.
+		if (Memc[cmd] == '/')
+		    call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call ap_ncolon (Memc[cmd], rdnoise, gain, newgraph)
+
+	    case 'q':
+		break
+
+	    case 'r': # Redraw the graph.
+		newgraph = YES
+
+	    case 'w': # Window graph
+		call gt_window (gt, gp, "gcur", newgraph)
+
+	    case 'I': # Interrupt
+		call fatal (0, "Interrupt")
+
+	    default: # Ring bell for unrecognized commands.
+		call printf ("\007")
+	    }
+
+	    # Update the graph if needed.
+	    if (newgraph == YES) {
+		call sprintf (Memc[cmd], SZ_LINE,
+		    "Read noise = %g e-, Gain = %g e-/DN")
+		    call pargr (rdnoise)
+		    call pargr (gain)
+		call gt_sets (gt, GTPARAMS, Memc[cmd])
+
+		call gclear (gp)
+		y = sqrt ((rdnoise/gain)**2 + dmax/gain)
+		call gswind (gp, dmin, dmax, ymin, max (ymax, y))
+		call gt_swind (gp, gt)
+		call gt_labax (gp, gt)
+		do i = 1, npts {
+		    if (sigma[i] > 0) {
+			x = x1 + (i-1) * dx
+			call gmark (gp, x, sigma[i], GM_VEBAR+GM_HLINE, -dx/2,
+			    -sigerr[i])
+		    }
+		}
+		do i = 1, npts {
+		    x = x1 + (i-1) * dx
+		    y = sqrt ((rdnoise/gain)**2 + x/gain)
+		    if (i == 1)
+			call gamove (gp, x, y)
+		    else
+			call gadraw (gp, x, y)
+		}
+	        newgraph = NO
+	    }
+
+	} until (gt_gcur ("gcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF)
+
+	# Free memory.
+	call gt_free (gt)
+	call sfree (sp)
+end
+
+
+# List of colon commands.
+define	CMDS		 "|readnoise|gain|"
+define	RDNOISE		1	# Read noise
+define	GAIN		2	# Gain
+
+# AP_NCOLON -- Respond to colon command from ap_nplot.
+
+procedure ap_ncolon (command, rdnoise, gain, newgraph)
+
+char	command[ARB]		# Colon command
+real	rdnoise			# Readout noise
+real	gain			# Gain
+int	newgraph		# New graph?
+
+real	rval
+int	ncmd, nscan(), strdic()
+pointer	sp, cmd
+
+begin
+	# Scan the command string and get the first word.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	call sscan (command)
+	call gargwrd (cmd, SZ_LINE)
+	ncmd = strdic (cmd, cmd, SZ_LINE, CMDS)
+
+	switch (ncmd) {
+	case RDNOISE:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		rdnoise = rval
+		newgraph = YES
+	    } else {
+		call printf ("rdnoise %g\n")
+		    call pargr (rdnoise)
+	    }
+	case GAIN:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		gain = rval
+		newgraph = YES
+	    } else {
+		call printf ("gain %g\n")
+		    call pargr (gain)
+	    }
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apnoise1.par b/noao/twodspec/apextract/apnoise1.par
new file mode 100644
index 00000000..3b5532a7
--- /dev/null
+++ b/noao/twodspec/apextract/apnoise1.par
@@ -0,0 +1,118 @@
+# OUTPUT PARAMETERS
+
+apertures,s,h,)apall.apertures,,,>apnoise.apertures
+format,s,h,)apsum.format,,,>apsum.format
+extras,b,h,)apsum.extras,,,>apsum.extras
+dbwrite,s,h,yes,,,Write to database?
+initialize,b,h,yes,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)apdefault.lower,,,>apdefault.lower
+upper,r,h,)apdefault.upper,,,>apdefault.upper
+apidtable,s,h,)apdefault.apidtable,,,">apdefault.apidtable
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)apdefault.b_function,,,>apdefault.b_function
+b_order,i,h,)apdefault.b_order,,,>apdefault.b_order
+b_sample,s,h,)apdefault.b_sample,,,>apdefault.b_sample
+b_naverage,i,h,)apdefault.b_naverage,,,>apdefault.b_naverage
+b_niterate,i,h,)apdefault.b_niterate,,,>apdefault.b_niterate
+b_low_reject,r,h,)apdefault.b_low_reject,,,>apdefault.b_low_reject
+b_high_reject,r,h,)apdefault.b_high_reject,,,>apdefault.b_high_reject
+b_grow,r,h,)apdefault.b_grow,,,">apdefault.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,)apedit.width,,,>apedit.width
+radius,r,h,)apedit.radius,,,>apedit.radius
+threshold,r,h,)apedit.threshold,,,">apedit.threshold
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,)apfind.nfind,,,>apfind.nfind
+minsep,r,h,)apfind.minsep,,,>apfind.minsep
+maxsep,r,h,)apfind.maxsep,,,>apfind.maxsep
+order,s,h,)apfind.order,,,">apfind.order
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,)aprecenter.aprecenter,,,>aprecenter.aprecenter
+npeaks,r,h,)aprecenter.npeaks,,,>aprecenter.npeaks
+shift,b,h,)aprecenter.shift,,,">aprecenter.shift
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,)apresize.llimit,,,>apresize.llimit
+ulimit,r,h,)apresize.ulimit,,,>apresize.ulimit
+ylevel,r,h,)apresize.ylevel,,,>apresize.ylevel
+peak,b,h,)apresize.peak,,,>apresize.peak
+bkg,b,h,)apresize.bkg,,,>apresize.bkg
+r_grow,r,h,)apresize.r_grow,,,>apresize.r_grow
+avglimits,b,h,)apresize.avglimits,,,">apresize.avglimits
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,Profile reference image
+
+# TRACING PARAMETERS
+t_nsum,i,h,)aptrace.nsum,,,>aptrace.nsum
+t_step,i,h,)aptrace.step,,,>aptrace.step
+t_nlost,i,h,)aptrace.nlost,,,>aptrace.nlost
+t_width,r,h,)apedit.width,,,>apedit.width
+t_function,s,h,)aptrace.function,,,>aptrace.function
+t_order,i,h,)aptrace.order,,,>aptrace.order
+t_sample,s,h,)aptrace.sample,,,>aptrace.sample
+t_naverage,i,h,)aptrace.naverage,,,>aptrace.naverage
+t_niterate,i,h,)aptrace.niterate,,,>aptrace.niterate
+t_low_reject,r,h,)aptrace.low_reject,,,>aptrace.low_reject
+t_high_reject,r,h,)aptrace.high_reject,,,>aptrace.high_reject
+t_grow,r,h,)aptrace.grow,,,">aptrace.grow
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,)apnoise.background,,,>apnoise.background
+skybox,i,h,)apnoise.skybox,,,>apnoise.skybox
+weights,s,h,"none",,,Extraction weights (none|variance)
+pfit,s,h,)apnoise.pfit,,,>apnoise.pfit
+clean,b,h,)apnoise.clean,,,>apnoise.clean
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,)apnoise.saturation,,,>apnoise.saturation
+readnoise,s,h,)apnoise.readnoise,,,>apnoise.readnoise
+gain,s,h,)apnoise.gain,,,>apnoise.gain
+lsigma,r,h,)apnoise.lsigma,,,>apnoise.lsigma
+usigma,r,h,)apnoise.usigma,,,>apnoise.usigma
+polysep,r,h,0.90,0.1,0.95,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,1,,,"Number of subapertures per aperture
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"no",,," "
+ansclobber1,s,h,"no",,," "
+ansdbwrite,s,h,"yes",,," "
+ansdbwrite1,s,h,"yes",,," "
+ansedit,s,h,"yes",,," "
+ansextract,s,h,"yes",,," "
+ansfind,s,h,"yes",,," "
+ansfit,s,h,"yes",,," "
+ansfitscatter,s,h,"yes",,," "
+ansfitsmooth,s,h,"yes",,," "
+ansfitspec,s,h,"yes",,," "
+ansfitspec1,s,h,"yes",,," "
+ansfittrace,s,h,"yes",,," "
+ansfittrace1,s,h,"yes",,," "
+ansflat,s,h,"yes",,," "
+ansmask,s,h,"yes",,," "
+ansnorm,s,h,"yes",,," "
+ansrecenter,s,h,"yes",,," "
+ansresize,s,h,"yes",,," "
+ansreview,s,h,"yes",,," "
+ansreview1,s,h,"yes",,," "
+ansscat,s,h,"yes",,," "
+anssmooth,s,h,"yes",,," "
+anstrace,s,h,"yes",,," "
diff --git a/noao/twodspec/apextract/apnorm1.par b/noao/twodspec/apextract/apnorm1.par
new file mode 100644
index 00000000..1a182dce
--- /dev/null
+++ b/noao/twodspec/apextract/apnorm1.par
@@ -0,0 +1,118 @@
+# OUTPUT PARAMETERS
+
+apertures,s,h,)apall.apertures,,,>apnorm.apertures
+format,s,h,)apsum.format,,,>apsum.format
+extras,b,h,)apsum.extras,,,>apsum.extras
+dbwrite,s,h,yes,,,Write to database?
+initialize,b,h,yes,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)apdefault.lower,,,>apdefault.lower
+upper,r,h,)apdefault.upper,,,>apdefault.upper
+apidtable,s,h,)apdefault.apidtable,,,">apdefault.apidtable
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)apdefault.b_function,,,>apdefault.b_function
+b_order,i,h,)apdefault.b_order,,,>apdefault.b_order
+b_sample,s,h,)apdefault.b_sample,,,>apdefault.b_sample
+b_naverage,i,h,)apdefault.b_naverage,,,>apdefault.b_naverage
+b_niterate,i,h,)apdefault.b_niterate,,,>apdefault.b_niterate
+b_low_reject,r,h,)apdefault.b_low_reject,,,>apdefault.b_low_reject
+b_high_reject,r,h,)apdefault.b_high_reject,,,>apdefault.b_high_reject
+b_grow,r,h,)apdefault.b_grow,,,">apdefault.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,)apedit.width,,,>apedit.width
+radius,r,h,)apedit.radius,,,>apedit.radius
+threshold,r,h,)apedit.threshold,,,">apedit.threshold
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,)apfind.nfind,,,>apfind.nfind
+minsep,r,h,)apfind.minsep,,,>apfind.minsep
+maxsep,r,h,)apfind.maxsep,,,>apfind.maxsep
+order,s,h,)apfind.order,,,">apfind.order
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,)aprecenter.aprecenter,,,>aprecenter.aprecenter
+npeaks,r,h,)aprecenter.npeaks,,,>aprecenter.npeaks
+shift,b,h,)aprecenter.shift,,,">aprecenter.shift
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,)apresize.llimit,,,>apresize.llimit
+ulimit,r,h,)apresize.ulimit,,,>apresize.ulimit
+ylevel,r,h,)apresize.ylevel,,,>apresize.ylevel
+peak,b,h,)apresize.peak,,,>apresize.peak
+bkg,b,h,)apresize.bkg,,,>apresize.bkg
+r_grow,r,h,)apresize.r_grow,,,>apresize.r_grow
+avglimits,b,h,)apresize.avglimits,,,">apresize.avglimits
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,Profile reference image
+
+# TRACING PARAMETERS
+t_nsum,i,h,)aptrace.nsum,,,>aptrace.nsum
+t_step,i,h,)aptrace.step,,,>aptrace.step
+t_nlost,i,h,)aptrace.nlost,,,>aptrace.nlost
+t_width,r,h,)apedit.width,,,>apedit.width
+t_function,s,h,)aptrace.function,,,>aptrace.function
+t_order,i,h,)aptrace.order,,,>aptrace.order
+t_sample,s,h,)aptrace.sample,,,>aptrace.sample
+t_naverage,i,h,)aptrace.naverage,,,>aptrace.naverage
+t_niterate,i,h,)aptrace.niterate,,,>aptrace.niterate
+t_low_reject,r,h,)aptrace.low_reject,,,>aptrace.low_reject
+t_high_reject,r,h,)aptrace.high_reject,,,>aptrace.high_reject
+t_grow,r,h,)aptrace.grow,,,">aptrace.grow
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,)apnorm.background,,,>apnorm.background
+skybox,i,h,)apnorm.skybox,,,>apnorm.skybox
+weights,s,h,)apnorm.weights,,,>apnorm.weights
+pfit,s,h,)apnorm.pfit,,,>apnorm.pfit
+clean,b,h,)apnorm.clean,,,>apnorm.clean
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,)apnorm.saturation,,,>apnorm.saturation
+readnoise,s,h,)apnorm.readnoise,,,>apnorm.readnoise
+gain,s,h,)apnorm.gain,,,>apnorm.gain
+lsigma,r,h,)apnorm.lsigma,,,>apnorm.lsigma
+usigma,r,h,)apnorm.usigma,,,>apnorm.usigma
+polysep,r,h,0.90,0.1,0.95,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,1,,,"Number of subapertures per aperture
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"no",,," "
+ansclobber1,s,h,"no",,," "
+ansdbwrite,s,h,"yes",,," "
+ansdbwrite1,s,h,"yes",,," "
+ansedit,s,h,"yes",,," "
+ansextract,s,h,"yes",,," "
+ansfind,s,h,"yes",,," "
+ansfit,s,h,"yes",,," "
+ansfitscatter,s,h,"yes",,," "
+ansfitsmooth,s,h,"yes",,," "
+ansfitspec,s,h,"yes",,," "
+ansfitspec1,s,h,"yes",,," "
+ansfittrace,s,h,"yes",,," "
+ansfittrace1,s,h,"yes",,," "
+ansflat,s,h,"yes",,," "
+ansmask,s,h,"yes",,," "
+ansnorm,s,h,"yes",,," "
+ansrecenter,s,h,"yes",,," "
+ansresize,s,h,"yes",,," "
+ansreview,s,h,"yes",,," "
+ansreview1,s,h,"yes",,," "
+ansscat,s,h,"yes",,," "
+anssmooth,s,h,"yes",,," "
+anstrace,s,h,"yes",,," "
diff --git a/noao/twodspec/apextract/apnormalize.par b/noao/twodspec/apextract/apnormalize.par
new file mode 100644
index 00000000..2fc64432
--- /dev/null
+++ b/noao/twodspec/apextract/apnormalize.par
@@ -0,0 +1,41 @@
+# APNORMALIZE
+
+input,s,a,,,,List of images to normalize
+output,s,a,,,,List of output normalized images
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"List of reference images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit traced points interactively?
+normalize,b,h,yes,,,Normalize spectra?
+fitspec,b,h,yes,,,"Fit normalization spectra interactively?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+cennorm,b,h,no,,,Normalize to the aperture center?
+threshold,r,h,10.,,,"Threshold for normalization spectra
+"
+background,s,h,"none","none|average|median|minimum|fit",,Background to subtract
+weights,s,h,"none","none|variance",,Extraction weights (none|variance)
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting type (fit1d|fit2d)
+clean,b,h,no,,,Detect and replace bad pixels?
+skybox,i,h,1,1,,Box car smoothing length for sky
+saturation,r,h,INDEF,,,Saturation level
+readnoise,s,h,"0.",,,Read out noise sigma (photons)
+gain,s,h,"1.",,,Photon gain (photons/data number)
+lsigma,r,h,4.,0.,,Lower rejection threshold
+usigma,r,h,4.,0.,,"Upper rejection threshold
+"
+function,s,h,"legendre","chebyshev|legendre|spline1|spline3",,Fitting function for normalization spectra
+order,i,h,1,1,,Fitting function order
+sample,s,h,"*",,,Sample regions
+naverage,i,h,1,,,Average or median
+niterate,i,h,0,0,,Number of rejection iterations
+low_reject,r,h,3.,0.,,Lower rejection sigma
+high_reject,r,h,3.,0.,,High upper rejection sigma
+grow,r,h,0.,0.,,Rejection growing radius
diff --git a/noao/twodspec/apextract/apparams.dat b/noao/twodspec/apextract/apparams.dat
new file mode 100644
index 00000000..897e4f2e
--- /dev/null
+++ b/noao/twodspec/apextract/apparams.dat
@@ -0,0 +1,68 @@
+"OUTPUT PARAMETERS"
+format		s	%s	26
+extras		b	%b	26
+dbwrite		s	%s	26
+
+"DEFAULT APERTURE PARAMETERS"
+lower		r	%g	26
+upper		r	%g	26
+apidtable	s	%s	26
+
+"DEFAULT BACKGROUND PARAMETERS"
+b_function	s	%s	26
+b_order		i	%d	26
+b_sample	s	%s	26
+b_naverage	i	%d	26
+b_niterate	i	%d	26
+b_low_reject	r	%g	26
+b_high_reject	r	%g	26
+b_grow		r	%g	26
+
+"APERTURE CENTERING PARAMETERS: FINDING, RECENTERING, MARKING"
+width		r	%g	26
+radius		r	%g	26
+threshold	r	%g	26
+
+"AUTOMATIC APERTURE FINDING AND ORDERING PARAMETERS"
+minsep		r	%g	26
+maxsep		r	%g	26
+order		s	%s	26
+
+"RECENTERING PARAMETERS"
+apertures	s	%s	26
+npeaks		r	%g	26
+shift		b	%b	26
+
+"RESIZING PARAMETERS"
+llimit		r	%g	26
+ulimit		r	%g	26
+ylevel		r	%g	26
+peak		b	%b	26
+bkg		b	%b	26
+r_grow		r	%g	26
+avglimits	b	%b	26
+
+"TRACING PARAMETERS"
+t_nsum		i	%d	26
+t_step		i	%d	26
+t_width		r	%g	26
+t_function	s	%s	26
+t_order		i	%d	26
+t_sample	s	%s	26
+t_naverage	i	%d	26
+t_niterate	i	%d	26
+t_low_reject	r	%g	26
+t_high_reject	r	%g	26
+t_grow		r	%g	26
+
+"EXTRACTION PARAMETERS"
+weights		s	%s	26
+background	s	%s	26
+clean		b	%b	26
+saturation	r	%g	26
+readnoise	r	%g	26
+gain		r	%g	26
+lsigma		r	%g	26
+usigma		r	%g	26
+skybox		i	%d	26
+nsubaps		i	%d	26
diff --git a/noao/twodspec/apextract/apparams.h b/noao/twodspec/apextract/apparams.h
new file mode 100644
index 00000000..ac3e37cb
--- /dev/null
+++ b/noao/twodspec/apextract/apparams.h
@@ -0,0 +1,92 @@
+# PP_TABLE -- This table assigns pset pointers for each parameter.
+
+define	PP_PP_LENTABLE	61
+
+# APDEFAULT
+
+define	PP_APIDTABLE		Memi[$1]
+define	PP_LOWER		Memi[$1+1]
+define	PP_UPPER		Memi[$1+2]
+define	PP_B_FUNCTION		Memi[$1+3]
+define	PP_B_ORDER		Memi[$1+4]
+define	PP_B_SAMPLE		Memi[$1+5]
+define	PP_B_NAVERAGE		Memi[$1+6]
+define	PP_B_NITERATE		Memi[$1+7]
+define	PP_B_LOW_REJECT		Memi[$1+8]
+define	PP_B_HIGH_REJECT	Memi[$1+9]
+define	PP_B_GROW		Memi[$1+10]
+
+#APFIND
+
+define	PP_NFIND		Memi[$1+11]
+define	PP_MINSEP		Memi[$1+12]
+define	PP_MAXSEP		Memi[$1+13]
+define	PP_ORDER		Memi[$1+14]
+
+# APRECENTER
+
+define	PP_APERTURES		Memi[$1+15]
+define	PP_NPEAKS		Memi[$1+16]
+define	PP_SHIFT		Memi[$1+17]
+
+# APRESIZE
+
+define	PP_LLIMIT		Memi[$1+18]
+define	PP_ULIMIT		Memi[$1+19]
+define	PP_YLEVEL		Memi[$1+20]
+define	PP_PEAK			Memi[$1+21]
+define	PP_BKG			Memi[$1+22]
+
+# APEDIT
+
+define	PP_WIDTH		Memi[$1+23]
+define	PP_RADIUS		Memi[$1+24]
+define	PP_THRESHOLD		Memi[$1+25]
+define	PP_E_OUTPUT		Memi[$1+26]
+define	PP_E_SKY		Memi[$1+27]
+define	PP_E_PROFILES		Memi[$1+28]
+
+# APTRACE
+
+define	PP_FITTRACE		Memi[$1+29]
+define	PP_T_NSUM		Memi[$1+30]
+define	PP_STEP			Memi[$1+31]
+define	PP_T_FUNCTION		Memi[$1+32]
+define	PP_T_ORDER		Memi[$1+33]
+define	PP_T_SAMPLE		Memi[$1+34]
+define	PP_T_NAVERAGE		Memi[$1+35]
+define	PP_T_NITERATE		Memi[$1+36]
+define	PP_T_LOW_REJECT		Memi[$1+37]
+define	PP_T_HIGH_REJECT	Memi[$1+38]
+define	PP_T_GROW		Memi[$1+39]
+
+# APSUM or APSTRIP
+
+define	PP_SKYEXTRACT		Memi[$1+40]
+define	PP_BACKGROUND		Memi[$1+41]
+define	PP_CLEAN		Memi[$1+42]
+define	PP_WEIGHTS		Memi[$1+43]
+define	PP_FIT(pp)		Memi[$1+61]
+define	PP_NAVERAGE		Memi[$1+44]
+define	PP_INTERPOLATOR		Memi[$1+45]
+define	PP_NCLEAN		Memi[$1+46]
+define	PP_LSIGMA		Memi[$1+47]
+define	PP_USIGMA		Memi[$1+48]
+define	PP_V0			Memi[$1+49]
+define	PP_V1			Memi[$1+50]
+
+# APNORMALIZE
+
+define	PP_N_THRESHOLD		Memi[$1+51]
+define	PP_N_FUNCTION		Memi[$1+52]
+define	PP_N_ORDER		Memi[$1+53]
+define	PP_N_SAMPLE		Memi[$1+54]
+define	PP_N_NAVERAGE		Memi[$1+55]
+define	PP_N_NITERATE		Memi[$1+56]
+define	PP_N_LOW_REJECT		Memi[$1+57]
+define	PP_N_HIGH_REJECT	Memi[$1+58]
+define	PP_N_GROW		Memi[$1+59]
+
+# APSCATTER
+
+define	PP_BUFFER		Memi[$1+60]
diff --git a/noao/twodspec/apextract/apparams.par b/noao/twodspec/apextract/apparams.par
new file mode 100644
index 00000000..61b2b2ce
--- /dev/null
+++ b/noao/twodspec/apextract/apparams.par
@@ -0,0 +1,117 @@
+# OUTPUT PARAMETERS
+
+format,s,h,)apsum.format,,,>apsum.format
+extras,b,h,)apsum.extras,,,>apsum.extras
+dbwrite,s,h,yes,,,Write to database?
+initialize,b,h,yes,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)apdefault.lower,,,>apdefault.lower
+upper,r,h,)apdefault.upper,,,>apdefault.upper
+apidtable,s,h,)apdefault.apidtable,,,">apdefault.apidtable
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)apdefault.b_function,,,>apdefault.b_function
+b_order,i,h,)apdefault.b_order,,,>apdefault.b_order
+b_sample,s,h,)apdefault.b_sample,,,>apdefault.b_sample
+b_naverage,i,h,)apdefault.b_naverage,,,>apdefault.b_naverage
+b_niterate,i,h,)apdefault.b_niterate,,,>apdefault.b_niterate
+b_low_reject,r,h,)apdefault.b_low_reject,,,>apdefault.b_low_reject
+b_high_reject,r,h,)apdefault.b_high_reject,,,>apdefault.b_high_reject
+b_grow,r,h,)apdefault.b_grow,,,">apdefault.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,)apedit.width,,,>apedit.width
+radius,r,h,)apedit.radius,,,>apedit.radius
+threshold,r,h,)apedit.threshold,,,">apedit.threshold
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,)apfind.nfind,,,>apfind.nfind
+minsep,r,h,)apfind.minsep,,,>apfind.minsep
+maxsep,r,h,)apfind.maxsep,,,>apfind.maxsep
+order,s,h,)apfind.order,,,">apfind.order
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,)aprecenter.aprecenter,,,>aprecenter.aprecenter
+npeaks,r,h,)aprecenter.npeaks,,,>aprecenter.npeaks
+shift,b,h,)aprecenter.shift,,,">aprecenter.shift
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,)apresize.llimit,,,>apresize.llimit
+ulimit,r,h,)apresize.ulimit,,,>apresize.ulimit
+ylevel,r,h,)apresize.ylevel,,,>apresize.ylevel
+peak,b,h,)apresize.peak,,,>apresize.peak
+bkg,b,h,)apresize.bkg,,,>apresize.bkg
+r_grow,r,h,)apresize.r_grow,,,>apresize.r_grow
+avglimits,b,h,)apresize.avglimits,,,">apresize.avglimits
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,Profile reference image
+
+# TRACING PARAMETERS
+t_nsum,i,h,)aptrace.nsum,,,>aptrace.nsum
+t_step,i,h,)aptrace.step,,,>aptrace.step
+t_nlost,i,h,)aptrace.nlost,,,>aptrace.nlost
+t_width,r,h,)apedit.width,,,>apedit.width
+t_function,s,h,)aptrace.function,,,>aptrace.function
+t_order,i,h,)aptrace.order,,,>aptrace.order
+t_sample,s,h,)aptrace.sample,,,>aptrace.sample
+t_naverage,i,h,)aptrace.naverage,,,>aptrace.naverage
+t_niterate,i,h,)aptrace.niterate,,,>aptrace.niterate
+t_low_reject,r,h,)aptrace.low_reject,,,>aptrace.low_reject
+t_high_reject,r,h,)aptrace.high_reject,,,>aptrace.high_reject
+t_grow,r,h,)aptrace.grow,,,">aptrace.grow
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,)apsum.background,,,>apsum.background
+skybox,i,h,)apsum.skybox,,,>apsum.skybox
+weights,s,h,)apsum.weights,,,>apsum.weights
+pfit,s,h,)apsum.pfit,,,>apsum.pfit
+clean,b,h,)apsum.clean,,,>apsum.clean
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,)apsum.saturation,,,>apsum.saturation
+readnoise,s,h,)apsum.readnoise,,,>apsum.readnoise
+gain,s,h,)apsum.gain,,,>apsum.gain
+lsigma,r,h,)apsum.lsigma,,,>apsum.lsigma
+usigma,r,h,)apsum.usigma,,,>apsum.usigma
+polysep,r,h,0.90,0.1,0.95,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,)apsum.nsubaps,,,">apsum.nsubaps
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"no",,," "
+ansclobber1,s,h,"no",,," "
+ansdbwrite,s,h,"yes",,," "
+ansdbwrite1,s,h,"yes",,," "
+ansedit,s,h,"yes",,," "
+ansextract,s,h,"yes",,," "
+ansfind,s,h,"yes",,," "
+ansfit,s,h,"yes",,," "
+ansfitscatter,s,h,"yes",,," "
+ansfitsmooth,s,h,"yes",,," "
+ansfitspec,s,h,"yes",,," "
+ansfitspec1,s,h,"yes",,," "
+ansfittrace,s,h,"yes",,," "
+ansfittrace1,s,h,"yes",,," "
+ansflat,s,h,"yes",,," "
+ansmask,s,h,"yes",,," "
+ansnorm,s,h,"yes",,," "
+ansrecenter,s,h,"yes",,," "
+ansresize,s,h,"yes",,," "
+ansreview,s,h,"yes",,," "
+ansreview1,s,h,"yes",,," "
+ansscat,s,h,"yes",,," "
+anssmooth,s,h,"yes",,," "
+anstrace,s,h,"yes",,," "
diff --git a/noao/twodspec/apextract/apparams.x b/noao/twodspec/apextract/apparams.x
new file mode 100644
index 00000000..526b4bcd
--- /dev/null
+++ b/noao/twodspec/apextract/apparams.x
@@ -0,0 +1,95 @@
+define	PARAMS		"apextract$apparams.dat"
+define	LEN_LINE	80
+
+# AP_PARAMS -- Show the parameters.
+
+procedure ap_params (file, image, line, nsum)
+
+char	file[ARB]		# Aperture file
+char	image[ARB]		# Image name
+int	line			# Image line
+int	nsum			# Number of lines to sum
+
+int	in, out, len, nchar
+pointer	sp, param, type, format, instr, outstr, str
+bool	apgetb()
+int	apgeti(), open(), fscan(), nscan(), strlen()
+real	apgetr()
+errchk	open
+
+begin
+	# Open input parameter file and output stream.
+	in = open (PARAMS, READ_ONLY, TEXT_FILE)
+	out = open (file, APPEND, TEXT_FILE)
+
+	call smark (sp)
+	call salloc (param, SZ_LINE, TY_CHAR)
+	call salloc (type, 10, TY_CHAR)
+	call salloc (format, 10, TY_CHAR)
+	call salloc (instr, SZ_LINE, TY_CHAR)
+	call salloc (outstr, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	Memc[outstr] = EOS
+
+	call fprintf (out, "%32tAPEXTRACT PARAMETERS\n")
+	call fprintf (out, "image=%s%27tline=%d%53tnsum=%d\n")
+	    call pargstr (image)
+	    call pargi (line)
+	    call pargi (nsum)
+	call fprintf (out, "database=%s%27tlogfile=%s%53tplotfile=%s\n\n")
+	    call clgstr ("database", Memc[str], SZ_LINE)
+	    call pargstr (Memc[str])
+	    call clgstr ("logfile", Memc[str], SZ_LINE)
+	    call pargstr (Memc[str])
+	    call clgstr ("plotfile", Memc[str], SZ_LINE)
+	    call pargstr (Memc[str])
+
+	len = 0
+	while (fscan (in) != EOF) {
+	    call gargwrd (Memc[param], SZ_LINE)
+	    call gargwrd (Memc[type], 10)
+	    call gargwrd (Memc[format], 10)
+	    call gargi (nchar)
+	    if (nscan() < 4)
+		nchar = LEN_LINE
+
+	    if (len + nchar > LEN_LINE) {
+		call strcat ("\n", Memc[outstr], SZ_LINE)
+		call fprintf (out, Memc[outstr])
+		Memc[outstr] = EOS
+		len = 0
+	    }
+
+	    if (nscan() == 1) {
+		call sprintf (Memc[outstr], SZ_LINE, "%%%dt%s")
+		    call pargi ((LEN_LINE - strlen (Memc[param])) / 2)
+		    call pargstr (Memc[param])
+	    } else if (nscan() == 4) {
+	        call sprintf (Memc[str], SZ_LINE, "%%%dt%s=")
+		    call pargi (len+1)
+		    call pargstr (Memc[param])
+	        call strcat (Memc[str], Memc[outstr], SZ_LINE)
+
+	        call sprintf (Memc[str], SZ_LINE, Memc[format])
+	        switch (Memc[type]) {
+	        case 'b':
+		    call pargb (apgetb (Memc[param]))
+	        case 'i':
+		    call pargi (apgeti (Memc[param]))
+	        case 'r':
+		    call pargr (apgetr (Memc[param]))
+	        case 's':
+		    call apgstr (Memc[param], Memc[instr], SZ_LINE)
+		    call pargstr (Memc[instr])
+	        }
+	        call strcat (Memc[str], Memc[outstr], SZ_LINE)
+	    }
+	    len = len + nchar
+	}
+	call strcat ("\n", Memc[outstr], SZ_LINE)
+	call fprintf (out, Memc[outstr])
+
+	call close (in)
+	call close (out)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/appars.x b/noao/twodspec/apextract/appars.x
new file mode 100644
index 00000000..8f68c0c9
--- /dev/null
+++ b/noao/twodspec/apextract/appars.x
@@ -0,0 +1,261 @@
+include <math/iminterp.h>
+
+procedure apopset (pset)
+
+char	pset[ARB]		# Pset name
+pointer	pp, clopset ()
+common	/apparam/ pp
+
+begin
+	pp = clopset (pset)
+end
+
+
+procedure apcpset ()
+
+pointer	pp
+common	/apparam/ pp
+
+begin
+	call clcpset (pp)
+end
+
+
+procedure apgstr (param, str, maxchar)
+
+char	param[ARB]		# Parameter name
+char	str[ARB]		# String to return
+int	maxchar			# Maximum length of string
+
+pointer	pp
+common	/apparam/ pp
+
+begin
+	call clgpset (pp, param, str, maxchar)
+end
+
+
+bool procedure apgetb (param)
+
+char	param[ARB]		# Parameter name
+bool	clgpsetb()
+pointer	pp
+common	/apparam/ pp
+
+begin
+	return (clgpsetb (pp, param))
+end
+
+
+int procedure apgeti (param)
+
+char	param[ARB]		# Parameter name
+int	clgpseti()
+pointer	pp
+common	/apparam/ pp
+
+begin
+	return (clgpseti (pp, param))
+end
+
+
+real procedure apgetr (param)
+
+char	param[ARB]		# Parameter name
+real	clgpsetr()
+pointer	pp
+common	/apparam/ pp
+
+begin
+	return (clgpsetr (pp, param))
+end
+
+
+real procedure apgimr (param, im)
+
+char	param[ARB]		# Parameter name
+pointer	im			# IMIO pointer
+int	i, ctor()
+pointer	pp, sp, str
+real	rval, imgetr()
+common	/apparam/ pp
+errchk	imgetr
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call clgpset (pp, param, Memc[str], SZ_FNAME)
+	i = 1
+	if (ctor (Mems[str], i, rval) == 0)
+	    rval = imgetr (im, Memc[str])
+	call sfree (sp)
+	return (rval)
+end
+
+
+int procedure apgwrd (param, keyword, maxchar, dictionary)
+
+char	param[ARB]		# CL parameter string
+char	keyword[ARB]		# String matched in dictionary
+int	maxchar			# Maximum size of str
+char	dictionary[ARB]		# Dictionary string
+
+int	i, strdic()
+pointer	pp
+common	/apparam/ pp
+
+begin
+	call clgpset (pp, param, keyword, maxchar)
+	i = strdic (keyword, keyword, maxchar, dictionary)
+	if (i <= 0)
+	    call error (1, "Ambiguous or unknown parameter value")
+	return (i)
+end
+
+
+# APGINTERP -- Select an interpolator from a CL input string.  The procedure
+# is coded to be protected from changes in the values of the interpolator
+# types in interpdef.h.
+
+int procedure apginterp (param)
+
+char	param[ARB]		# CL parameter prompt string
+int	index, iicodes[5]
+pointer	sp, word
+int	apgwrd()
+errchk	apgwrd
+data	iicodes /II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, II_SPLINE3/
+
+pointer	pp
+common	/apparam/ pp
+
+begin
+	call smark (sp)
+	call salloc (word, SZ_FNAME, TY_CHAR)
+
+	index = max (1, min (5, apgwrd (param, Memc[word], SZ_FNAME,
+	    "|nearest|linear|poly3|poly5|spline3|")))
+
+	call sfree (sp)
+	return (iicodes[index])
+end
+
+
+procedure appstr (param, str)
+
+char	param[ARB]		# Parameter name
+char	str[ARB]		# String to be put
+pointer	pp, sp, str1, str2
+common	/apparam/ pp
+
+int	i, strmatch(), stridxs()
+
+begin
+	if (strmatch (param, "p_") == 0) {
+	    call smark (sp)
+	    call salloc (str1, SZ_FNAME, TY_CHAR)
+	    call salloc (str2, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[str1], SZ_FNAME, "%s.p_prompt")
+		call pargstr (param)
+	    call clgpset (pp, Memc[str1], Memc[str2], SZ_LINE)
+	    if (Memc[str2] == '>') {
+		i = stridxs (" \\\t\n", Memc[str2])
+		if (i > 0)
+		    Memc[str2+i-1] = EOS
+		call clpstr (Memc[str2+1], str)
+	    } else
+		call clppset (pp, param, str)
+	    call sfree (sp)
+	} else
+	    call clppset (pp, param, str)
+end
+
+
+procedure apputb (param, bval)
+
+char	param[ARB]		# Parameter name
+bool	bval			# Value to be put
+pointer	pp, sp, str1, str2
+common	/apparam/ pp
+
+int	i, strmatch(), stridxs()
+
+begin
+	if (strmatch (param, "p_") == 0) {
+	    call smark (sp)
+	    call salloc (str1, SZ_FNAME, TY_CHAR)
+	    call salloc (str2, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[str1], SZ_FNAME, "%s.p_prompt")
+		call pargstr (param)
+	    call clgpset (pp, Memc[str1], Memc[str2], SZ_LINE)
+	    if (Memc[str2] == '>') {
+		i = stridxs (" \\\t\n", Memc[str2])
+		if (i > 0)
+		    Memc[str2+i-1] = EOS
+		call clputb (Memc[str2+1], bval)
+	    } else
+		call clppsetb (pp, param, bval)
+	    call sfree (sp)
+	} else
+	    call clppsetb (pp, param, bval)
+end
+
+
+procedure apputi (param, ival)
+
+char	param[ARB]		# Parameter name
+int	ival			# Value to be put
+pointer	pp, sp, str1, str2
+common	/apparam/ pp
+
+int	i, strmatch(), stridxs()
+
+begin
+	if (strmatch (param, "p_") == 0) {
+	    call smark (sp)
+	    call salloc (str1, SZ_FNAME, TY_CHAR)
+	    call salloc (str2, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[str1], SZ_FNAME, "%s.p_prompt")
+		call pargstr (param)
+	    call clgpset (pp, Memc[str1], Memc[str2], SZ_LINE)
+	    if (Memc[str2] == '>') {
+		i = stridxs (" \\\t\n", Memc[str2])
+		if (i > 0)
+		    Memc[str2+i-1] = EOS
+		call clputi (Memc[str2+1], ival)
+	    } else
+		call clppseti (pp, param, ival)
+	    call sfree (sp)
+	} else
+	    call clppseti (pp, param, ival)
+end
+
+
+procedure apputr (param, rval)
+
+char	param[ARB]		# Parameter name
+real	rval			# Value to be put
+pointer	pp, sp, str1, str2
+common	/apparam/ pp
+
+int	i, strmatch(), stridxs()
+
+begin
+	if (strmatch (param, "p_") == 0) {
+	    call smark (sp)
+	    call salloc (str1, SZ_FNAME, TY_CHAR)
+	    call salloc (str2, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[str1], SZ_FNAME, "%s.p_prompt")
+		call pargstr (param)
+	    call clgpset (pp, Memc[str1], Memc[str2], SZ_LINE)
+	    if (Memc[str2] == '>') {
+		i = stridxs (" \\\t\n", Memc[str2])
+		if (i > 0)
+		    Memc[str2+i-1] = EOS
+		call clputr (Memc[str2+1], rval)
+	    } else
+		call clppsetr (pp, param, rval)
+	    call sfree (sp)
+	} else
+	    call clppsetr (pp, param, rval)
+end
diff --git a/noao/twodspec/apextract/apprint.x b/noao/twodspec/apextract/apprint.x
new file mode 100644
index 00000000..b2bf17f0
--- /dev/null
+++ b/noao/twodspec/apextract/apprint.x
@@ -0,0 +1,34 @@
+include	"apertures.h"
+
+# AP_PRINT -- Print the parameters of the indexed aperture.
+
+procedure ap_print (index, line, all, aps)
+
+int	index			# Index of aperture
+int	line			# Dispersion line
+int	all			# All flag
+pointer	aps[ARB]		# Apertures
+
+int	apaxis
+pointer	ap
+real	ap_cveval()
+
+begin
+	if (index < 1)
+	    return
+
+	if (all == YES)
+	    call printf ("ALL: ")
+	else
+	    call printf ("     ")
+
+	ap = aps[index]
+	apaxis = AP_AXIS(ap)
+	call printf (
+"aperture = %d  beam = %d  center = %.2f  low = %.2f  upper = %.2f\n")
+	    call pargi (AP_ID(ap))
+	    call pargi (AP_BEAM(ap))
+	    call pargr (AP_CEN(ap, apaxis)+ap_cveval (AP_CV(ap), real (line)))
+	    call pargr (AP_LOW(ap, apaxis))
+	    call pargr (AP_HIGH(ap, apaxis))
+end
diff --git a/noao/twodspec/apextract/approfile.x b/noao/twodspec/apextract/approfile.x
new file mode 100644
index 00000000..eeb31a6d
--- /dev/null
+++ b/noao/twodspec/apextract/approfile.x
@@ -0,0 +1,765 @@
+include	<mach.h>
+include	<gset.h>
+include	<math/curfit.h>
+include	"apertures.h"
+
+
+# AP_PROFILE -- Determine spectrum profile with pixel rejection.
+#
+# The profile is determined by dividing each dispersion point by an estimate
+# of the spectrum and then smoothing and normalizing to unit integral.
+# This routine has two algorithms (procedures) for smoothing, one for nearly
+# aligned spectra and one for tilted spectra.  The selection is determined
+# by the calling program and signaled by whether there is a variation in
+# the profile offsets.  For both smoothing algorithms the same iterative
+# rejection algorithm may be used to eliminate deviant points from affecting
+# the profile.  This rejection is selected by the "clean" parameter.
+# A plot of the final profile along the dispersion may be made for the
+# special plotfile "debugfits" or "debugall".
+#
+# Dispersion points with saturated pixels are ignored as well a when the
+# total sky subtracted flux is negative.
+
+procedure ap_profile (im, ap, dbuf, nc, nl, c1, l1, sbuf, svar, profile, nx, ny,
+	xs, ys, asi)
+
+pointer	im		# IMIO pointer
+pointer	ap		# Aperture structure
+pointer	dbuf		# Data buffer
+int	nc, nl		# Size of data buffer
+int	c1, l1		# Origin of data buffer
+pointer	sbuf		# Sky values (NULL if none)
+pointer	svar		# Sky variances
+real	profile[ny,nx]	# Profile (returned)
+int	nx, ny		# Size of profile array
+int	xs[ny], ys	# Origin of profile array
+pointer	asi		# Image interpolator for edge pixel weighting
+
+real	gain		# Gain
+real	rdnoise		# Readout noise
+real	saturation	# Maximum value for an unsaturated pixel
+bool	clean		# Clean cosmic rays?
+real	lsigma, usigma	# Rejection sigmas.
+
+int	fd, ix, iy, ix1, ix2, xs1, xs2, nsum
+int	i, niterate, ixrej, iyrej, nrej, nreject
+real	p, s, chisq, tfac, rrej, predict, var0, var, vmin, resid, wt1, wt2, dat
+pointer	sp, str, spec, x1, x2, y, reject, xreject, data, sky, cv, gp
+
+int	apgeti()
+real	apgetr(), ap_cveval(), apgimr()
+bool	apgetb()
+errchk	salloc, ap_horne, ap_marsh, apgimr, ap_asifit
+
+begin
+	# Allocate memory. Adjust pointers to be one indexed.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (spec, ny, TY_REAL)
+	call salloc (x1, ny, TY_REAL)
+	call salloc (x2, ny, TY_REAL)
+	call salloc (y, ny, TY_REAL)
+	call salloc (reject, nx*ny, TY_BOOL)
+	if (sbuf == NULL) {
+	    call salloc (sky, nx, TY_REAL)
+	    sky = sky - 1
+	}
+	spec=spec-1; x1=x1-1; x2=x2-1; y=y-1
+
+	# Get task parameters.
+	gain = apgimr ("gain", im)
+	rdnoise = apgimr ("readnoise", im) ** 2
+	saturation = apgetr ("saturation")
+	if (!IS_INDEF(saturation))
+	    saturation = saturation * gain
+	lsigma = apgetr ("lsigma")
+	usigma = apgetr ("usigma")
+	clean = apgetb ("clean")
+	if (clean)
+	    niterate = apgeti ("niterate")
+	else
+	    niterate = 0
+
+	# Initialize.
+	if (rdnoise == 0.)
+	    vmin = 1.
+	else
+	    vmin = rdnoise
+	if (sbuf == NULL) {
+	    call aclrr (Memr[sky+1], nx)
+	    var0 = rdnoise
+	}
+	cv = AP_CV(ap)
+
+	# Set aperture limits and initialize rejection flags.
+	call alimi (xs, ny, xs1, xs2)
+	i = AP_AXIS(ap)
+	p = AP_CEN(ap,i) + AP_LOW(ap,i)
+	s = AP_CEN(ap,i) + AP_HIGH(ap,i)
+	xreject = reject
+	do iy = 1, ny {
+	    dat = ap_cveval (cv, real (iy + ys - 1)) - c1 + 1
+	    Memr[x1+iy] = p + dat
+	    Memr[x2+iy] = s + dat
+	    Memr[x1+iy] = max (0.5, Memr[x1+iy]) + c1 - xs[iy]
+	    Memr[x2+iy] = min (nc + 0.49, Memr[x2+iy]) + c1 - xs[iy]
+	    ix1 = nint (Memr[x1+iy])
+	    ix2 = nint (Memr[x2+iy])
+	    Memr[y+iy] = iy
+	    do ix = 1, nx {
+		if (ix < ix1 || ix > ix2)
+		    Memb[xreject] = false
+		else
+		    Memb[xreject] = true
+		xreject = xreject + 1
+	    }
+	}
+
+	# Estimate spectrum by summing across the aperture with partial
+	# pixel estimates at the aperture edges.  The initial profile
+	# estimates are obtained by normalizing by the spectrum estimate.
+	# Profiles where the spectrum is below sky are set to zero.
+
+	call aclrr (profile, nx * ny)
+	nrej = 0
+	do iy = 1, ny {
+	    if (Memr[x1+iy] >= Memr[x2+iy]) {
+		Memr[spec+iy] = 0.
+	        do ix = 1, nx
+		    profile[iy,ix] = 0.
+		next
+	    }
+
+	    call ap_asifit (dbuf+(iy+ys-1-l1)*nc, nc, xs[iy]-c1+1,
+		Memr[x1+iy]-c1+xs[iy], Memr[x2+iy]-c1+xs[iy], data, asi)
+	    if (sbuf != NULL)
+		sky = sbuf + (iy - 1) * nx - 1
+	    call ap_edge (asi, Memr[x1+iy]+1, Memr[x2+iy]+1, wt1, wt2)
+	    ix1 = nint (Memr[x1+iy])
+	    ix2 = nint (Memr[x2+iy])
+	    s = 0.
+	    do ix = ix1, ix2 {
+		if (!IS_INDEF(saturation))
+		    if (Memr[data+ix] > saturation) {
+			s = 0.
+			nrej = nrej + 1
+			break;
+		    }
+		dat = Memr[data+ix] - Memr[sky+ix]
+		if (ix1 == ix2)
+		    dat = wt1 * dat
+		else if (ix == ix1)
+		    dat = wt1 * dat
+		else if (ix == ix2)
+		    dat = wt2 * dat
+		s = s + dat
+	    }
+
+	    if (s > 0.) {
+	        do ix = ix1, ix2
+		    profile[iy,ix] = max (0., (Memr[data+ix]-Memr[sky+ix])/s)
+	    } else {
+	        do ix = ix1, ix2
+		    profile[iy,ix] = 0.
+	    }
+	    Memr[spec+iy] = s
+	}
+
+	if (nrej == ny)
+	    call error (1, "All profiles contain saturated pixels")
+	else if (nrej > 0) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"EXTRACT: %d profiles with saturated pixels in aperture %d")
+		call pargi (nrej)
+		call pargi (AP_ID(ap))
+	    if (nrej < ny / 3)
+	        call ap_log (Memc[str], YES, NO, NO)
+	    else
+	        call ap_log (Memc[str], YES, NO, YES)
+	}
+
+	# Smooth the profile and possibly reject deviant pixels.
+	nreject = 0
+	tfac = 2.
+	do i = 0, niterate {
+
+	    # Estimate profile.
+	    if (xs1 == xs2)
+	        call ap_horne (im, cv, dbuf, nc, nl, c1, l1, Memr[spec+1], sbuf,
+		    svar, Memb[reject], profile, nx, ny, xs, ys,
+		    Memr[x1+1], Memr[x2+1])
+	    else
+	        call ap_marsh (im, dbuf, nc, nl, c1, l1, Memr[spec+1], sbuf,
+		    svar, Memb[reject], profile, nx, ny, xs, ys,
+		    Memr[x1+1], Memr[x2+1])
+
+	    if (i == niterate)
+		break
+
+	    # Reject pixels.  The rejection threshold is based on the overall
+	    # chi square.  Pixels are rejected on the basis of the current
+	    # chi square and the largest residual not rejected is compared
+	    # against the final chi square to possibly trigger another round
+	    # of rejections.
+
+	    chisq = 0.; nsum = 0; ixrej = 0; iyrej = 0; rrej = 0.; nrej = 0
+	    do iy = 1, ny {
+	        s = Memr[spec+iy]
+		if (s <= 0.)
+		    next
+		call ap_asifit (dbuf+(iy+ys-1-l1)*nc, nc, xs[iy]-c1+1,
+		    Memr[x1+iy]-c1+xs[iy], Memr[x2+iy]-c1+xs[iy], data, asi)
+		if (sbuf != NULL) {
+		    sky = sbuf + (iy - 1) * nx - 1
+		    var0 = rdnoise + Memr[svar+iy-1]
+		}
+		call ap_edge (asi, Memr[x1+iy]+1, Memr[x2+iy]+1, wt1, wt2)
+		xreject = reject + (iy - 1) * nx - 1
+	        ix1 = nint (Memr[x1+iy])
+	        ix2 = nint (Memr[x2+iy])
+	        do ix = ix1, ix2 {
+	            if (Memb[xreject+ix]) {
+	                nsum = nsum + 1
+	                predict = max (0., s * profile[iy,ix] + Memr[sky+ix])
+	                var = max (vmin, var0 + predict)
+	                resid = (Memr[data+ix] - predict) / sqrt (var)
+	                chisq = chisq + resid**2
+		        if (resid < -tfac*lsigma || resid > tfac*usigma) {
+		            if (ix < ix1 || ix > ix2)
+			        p = 0.
+			    else if (ix1 == ix2)
+		                p = wt1
+		            else if (ix == ix1)
+		                p = wt1
+		            else if (ix == ix2)
+		                p = wt2
+		            else 
+			        p = 1
+		            Memr[spec+iy] = Memr[spec+iy] -
+				p * (Memr[data+ix] - predict)
+	                    nrej = nrej + 1
+			    Memb[xreject+ix] = false
+		        } else if (abs (resid) > abs (rrej)) {
+		            rrej = resid
+		            if (ix < ix1 || ix > ix2)
+			        p = 0.
+			    else if (ix1 == ix2)
+		                p = wt1
+		            else if (ix == ix1)
+			        p = wt1
+		            else if (ix == ix2)
+			        p = wt2
+		            else 
+			        p = 1
+		            dat = p * (Memr[data+ix] - predict)
+		            ixrej = ix
+		            iyrej = iy
+			}
+	            }
+	        }
+	    }
+
+	    if (nsum == 0)
+		call error (1, "All pixels rejected")
+	    tfac = sqrt (chisq / nsum)
+	    if (rrej < -tfac * lsigma || rrej > tfac * usigma) {
+	        Memr[spec+iyrej] = Memr[spec+iyrej] - dat
+		xreject = reject + (iyrej - 1) * nx - 1
+	        Memb[xreject+ixrej] = false
+	        nrej = nrej + 1
+	    }
+
+	    nreject = nreject + nrej
+	    if (nrej == 0)
+		break
+	}
+
+	# These plots are too big for production work but can be turned on
+	# for debugging.
+
+	call ap_popen (gp, fd, "fits")
+	if (gp != NULL) {
+	    ix1 = xs1
+	    ix2 = xs2 + nx - 1
+	    if (xs1 != xs2) {
+		ix1 = ix1 + 1
+		ix2 = ix2 - 1
+	    }
+	    do ix = ix1, ix2 {
+		nrej = 0
+		do iy = 1, ny {
+		    i = ix - xs[iy] + 1
+		    if (i < 1 || i > nx)
+			next
+		    if (Memr[spec+iy] <= 0.)
+			next
+		    data = dbuf + (iy + ys - 1 - l1) * nc + ix - c1 - 1
+		    if (sbuf != NULL)
+		        s = Memr[sbuf+(iy-1)*nx+i-1]
+		    else
+			s = Memr[sky+i]
+		    nrej = nrej + 1
+		    Memr[y+nrej] = iy + ys - 1
+		    Memr[x1+nrej] = max (-.1, min (1.1,
+			(Memr[data+1] - s) / Memr[spec+iy]))
+		    Memr[x2+nrej] = profile[iy,i]
+		}
+		call gclear (gp)
+		call gascale (gp, Memr[x1+1], nrej, 2)
+		call grscale (gp, Memr[x2+1], nrej, 2)
+		call gswind (gp, Memr[y+1], Memr[y+nrej], INDEF, INDEF)
+		if (AP_AXIS(ap) == 1) {
+		    call sprintf (Memc[str], SZ_LINE, "Column %d")
+			call pargi (ix)
+		    call glabax (gp, Memc[str], "Line", "Profile")
+		} else {
+		    call sprintf (Memc[str], SZ_LINE, "Line %d")
+			call pargi (ix)
+		    call glabax (gp, Memc[str], "Column", "Profile")
+		}
+		call gpmark (gp, Memr[y+1], Memr[x1+1], nrej, GM_POINT, 1., 1.)
+		call gpline (gp, Memr[y+1], Memr[x2+1], nrej)
+	    }
+	}
+	call ap_pclose (gp, fd)
+
+	# Log the number of rejected pixels.
+	if (clean) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"EXTRACT: %d pixels rejected for profile from aperture %d")
+		call pargi (nreject)
+		call pargi (AP_ID(ap))
+	    call ap_log (Memc[str], YES, NO, NO)
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_HORNE -- Determine profile by fitting a low order function parallel to
+# dispersion along image lines or columns after dividing by a spectrum
+# estimate.  An initial profile estimate and a rejection array are
+# required for setting the weights.  This is a straightforward algorithm
+# similar to images.fit1d except that it is noninteractive.  The fitting
+# function is fixed at a cubic spline and the number of pieces is set by
+# the amount of tilt such that there is one cubic spline piece per
+# passage across the tilted spectrum plus an amount based on the order
+# of the tracing function.  It is named after Keith Horne
+# since this is what is outlined in his paper.  The profile array is used
+# cleverly to minimize memory requirements.  The storage order of the
+# profile array, which is transposed relative to the data, is determined
+# by this procedure.
+
+procedure ap_horne (im, cvtrace, dbuf, nc, nl, c1, l1, spec, sbuf, svar, reject,
+	profile, nx, ny, xs, ys, x1, x2)
+
+pointer	im			# IMIO pointer
+pointer	cvtrace			# Trace pointer
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Spectrum estimate
+pointer	sbuf			# Sky values (NULL if none)
+pointer	svar			# Sky variances
+bool	reject[nx,ny]		# Rejection flags
+real	profile[ny,nx]		# Initial profile in, improved profile out
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Origin of profile array
+real	x1[ny], x2[ny]		# Aperture limits in profile array
+
+int	cvtype			# Curfit type
+int	order			# Order of curfit function.
+real	rdnoise			# Readout noise in RMS data numbers.
+
+int	ix, iy, ierr
+real	p, s, sk, var, vmin, var0, wmin
+pointer	sp, y, w, cv, dbuf1, data, sky
+
+#int	apgeti()
+int	cvstati()
+real	apgimr()
+errchk	salloc, apgimr
+
+begin
+	call smark (sp)
+	call salloc (y, ny, TY_REAL)
+	call salloc (w, ny, TY_REAL)
+
+	# Get CL parameters
+	#cvtype = apgeti ("e_function")
+	#order = apgeti ("e_order")
+	rdnoise = apgimr ("readnoise", im) ** 2
+
+	# Initialize.
+	call alimr (x1, ny, p, s)
+	cvtype = SPLINE3
+	order = int (s - p + 1) + max (0, cvstati (cvtrace, CVNCOEFF) - 2)
+	#order = min (20, order)
+	order = 2 * order
+	call cvinit (cv, cvtype, order, 1., real (ny))
+	do iy = 1, ny
+	    Memr[y+iy-1] = iy
+	if (rdnoise == 0.)
+	    vmin = 1.
+	else
+	    vmin = rdnoise
+	dbuf1 = dbuf + (ys - l1 - 1) * nc - c1 - 1
+	if (sbuf == NULL) {
+	    sk = 0.
+	    var0 = rdnoise
+	}
+
+	# For each line parallel to the dispersion divide by a spectrum
+	# estimate and then fit the smoothing function.  Use the input
+	# profile and rejection array to set the weights.
+
+	do ix = 1, nx { 
+	    data = dbuf1 + ix
+	    if (sbuf != NULL)
+		sky = sbuf - nx - 1 + ix
+	    wmin = MAX_REAL
+	    do iy = 1, ny {
+	        s = spec[iy]
+	        if (s > 0. && reject[ix,iy]) {
+		    if (sbuf != NULL) {
+			sk = Memr[sky+iy*nx]
+			var0 = rdnoise + Memr[svar+iy-1]
+		    }
+		    p = profile[iy,ix]
+		    var = max (vmin, var0 + max (0., s * p + sk))
+		    var = (s ** 2) / var
+		    wmin = min (wmin, var)
+		    Memr[w+iy-1] = var
+		    profile[iy,ix] = (Memr[data+iy*nc+xs[iy]] - sk) / s
+		} else
+		    Memr[w+iy-1] = 0.
+	    }
+	    if (wmin == MAX_REAL)
+		call amovkr (1., Memr[w], ny)
+	    else
+		call amaxkr (Memr[w], wmin / 10., Memr[w], ny)
+	    call cvfit (cv, Memr[y], profile[1,ix], Memr[w], ny, WTS_USER, ierr)
+	    call cvvector (cv, Memr[y], profile[1,ix], ny)
+	    call amaxkr (profile[1,ix], 0., profile[1,ix], ny)
+	}
+
+	call cvfree (cv)
+	call sfree (sp)
+end
+
+
+# AP_MARSH -- Determine profile by Marsh algorithm (PASP V101, P1032, 1989).
+# This algorithm fits low order polynomials to weighted points sampled
+# at uniform intervals parallel to the aperture trace.  The polynomials
+# are coupled through the weights and so requires a 2D matrix inversion.
+# This is a relatively slow algorithm but does provide low order smoothing
+# for arbitrary profile shapes in highly tilted spectra.  An estimate
+# of the profile, a rejection array, sky and sky variance, and aperture
+# limit arrays are required.
+
+procedure ap_marsh (im, dbuf, nc, nl, c1, l1, spec, sbuf, svar, reject,
+	profile, nx, ny, xs, ys, x1, x2)
+
+pointer	im			# IMIO pointer
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+real	spec[ny]		# Spectrum estimate
+pointer	sbuf			# Sky values (NULL if none)
+pointer	svar			# Sky variances
+bool	reject[nx,ny]		# Rejection flags
+real	profile[ny,nx]		# Initial profile in, improved profile out
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Origin of profile array
+real	x1[ny], x2[ny]		# Aperture limits in profile array
+
+real	spix			# Polynomial pixel separation
+int	npols			# Number of polynomials
+int	order			# Order of function.
+real	rdnoise			# Readout noise in RMS data numbers.
+
+int	il, jl, kl, ll, ix, iy, ix1, ix2, nside, nadd
+int	ip, ip1, ip2, index1, index2, index3
+real	p, s, s2, dat, sk, var, vmin, var0
+real	dx0, dx1, dx2, dx3, dx4, xj, xk, xt, xz, qj, qk, xadd
+double	sum1, sum2
+pointer	sp, work, work1, work2, work3, work4, ysum, data, sky
+
+int	apgeti()
+real	apgetr(), apgimr()
+errchk	salloc, apgimr
+
+begin
+	# Get CL parameters
+	#npols = apgeti ("npols")
+	spix = apgetr ("polysep")
+	order = apgeti ("polyorder")
+	rdnoise = apgimr ("readnoise", im) ** 2
+
+	# Set dimensions.
+	npols = (x2[1] - x1[1] + 2) / spix
+	spix = (x2[1] - x1[1] + 2) / real (npols)
+	nside = npols * order
+	nadd = nside * nside
+	if (spix > 1.)
+	    call error (4, "Polynomial separation too large")
+
+	# Allocate memory.  One index pointers.
+	call smark (sp)
+	call salloc (work, nadd+3*nside, TY_REAL)
+	call salloc (work4, nside, TY_INT)
+	call salloc (ysum, ny, TY_REAL)
+	work = work - 1
+	work1 = work + nadd
+	work2 = work1 + nside
+	work3 = work2 + nside
+	work4 = work4 - 1
+	ysum=ysum-1
+	if (sbuf == NULL) {
+	    call salloc (sky, nx, TY_REAL)
+	    sky = sky - 1
+	}
+
+	# Initialize.
+	call aclrr (Memr[work+1], nadd+3*nside)
+	call aclri (Memi[work4+1], nside)
+	if (rdnoise == 0.)
+	    vmin = 1.
+	else
+	    vmin = rdnoise
+	if (sbuf == NULL) {
+	    call aclrr (Memr[sky+1], nx)
+	    var0 = rdnoise
+	}
+
+	# Factors for weights.
+	dx0 = 0.5 - spix
+	dx1 = abs (dx0)
+	dx2 = 1. - (dx0 / spix) ** 2
+	dx3 = 0.5 + spix
+	dx4 = sqrt (2.) * spix
+
+	# Accumulate least terms for least squares matrix equation AX = B.
+
+	# First accumulate B.
+	do jl = 0, npols-1 {
+ 	    do iy = 1, ny {
+	        if (spec[iy] <= 0.)
+		    next
+
+		xj = x1[iy] - 1 + spix * (real (jl) + 0.5)
+		ix1 = nint (xj - spix)
+		ix2 = nint (xj + spix)
+		if (ix1 < 1 || ix2 > nx) {
+		    Memr[ysum+iy] = 0.
+		    next
+		}
+
+		data = dbuf + (iy + ys - 1 - l1) * nc + xs[iy] - c1 - 1
+		if (sbuf != NULL) {
+		    sky = sbuf + (iy - 1) * nx - 1
+		    var0 = rdnoise + Memr[svar+iy-1]
+		}
+
+		# Evaluate qj, the contribution of polynomial number jl+1
+		# for the pixel ix1,jj.  Four cases are considered.  The
+		# first two account for the triangular interpolation
+		# function partially overlapping a pixel, on one side
+		# only.  The third is for the function wholly inside a
+		# pixel, and finally for the pixel wholly covered by the
+		# interpolation function.
+
+	        s = spec[iy]
+	        sum1 = 0.
+	        do ix = ix1, ix2 {
+		    if (!reject[ix,iy])
+			next
+	            p = profile[iy,ix]
+		    sk = Memr[sky+ix]
+                    dat = Memr[data+ix] - sk
+		    var = max (vmin, var0 + max (0., s * p + sk))
+
+                    xz = xj - real (ix)
+                    xt = abs (xz)
+                    if (xt >= dx1) {
+                        if (xt >= 0.5)
+                            qj = ((xt - dx3) / dx4) ** 2
+                        else
+                            qj = 1.- ((xt - dx0) / dx4) ** 2
+                        
+                    } else if (xt <= dx0)
+                        qj = 1.
+                    else
+                        qj = dx2 - (xz / spix) ** 2
+                    sum1 = sum1 + qj * s * dat / var
+                }
+	        Memr[ysum+iy] = sum1
+	    }
+
+	    index1 = order * jl
+	    do il = 1, order {
+	        sum1 = 0.
+	        ip = il - 1
+	        do iy = 1, ny
+	            if (spec[iy] > 0.)
+			sum1 = sum1 + Memr[ysum+iy] * ((real (iy) / ny) ** ip)
+	        Memr[work1+index1+il] = sum1
+	    }
+	}
+
+	# Now accumulate matrix A.  Since it is symmetric we only need to
+	# evaluate half of it.  Since it is banded we only need to evaluate
+	# contribution if two polynomial terms can be affected by the same
+	# pixel.
+
+	ip1 = nside - 1
+	ip2 = order * ip1
+	do jl = 0, npols-1 {
+	    do kl = 0, jl {
+		if (spix * (jl - kl - 2) > 0.)
+		    next
+		do iy = 1, ny {
+		    if (spec[iy] <= 0.)
+			next
+		    if (sbuf != NULL) {
+			sky = sbuf + (iy - 1) * nx - 1
+			var0 = rdnoise + Memr[svar+iy-1]
+		    }
+
+		    # Compute left and right limits of polynomials jl+1
+		    # and kl+1 for this value of y Evaluate sum over row
+		    # of qj[jl+1] times qj[kl+1] where qj[i] is fraction
+		    # of polynomial i which contributes to to pixel ix,jj.
+
+		    xj = x1[iy] - 1 + spix * (real (jl) + 0.5)
+		    xk = x1[iy] - 1 + spix * (real (kl) + 0.5)
+		    ix1 = nint (xj - spix)
+		    ix2 = nint (xk + spix)
+
+                    if (ix2 < ix1 || ix1 < 1 || ix2 > nx) {
+			Memr[ysum+iy] = 0.
+			next
+		    }
+
+                    s  = spec[iy]
+                    s2 = s * s
+                    sum1 = 0.
+                    do ix = ix1, ix2 {
+                        if (reject[ix,iy]) {
+                            p = profile[iy,ix]
+			    sk = Memr[sky+ix]
+			    var = max (vmin, var0 + max (0., s * p + sk))
+
+                            xz = xj - real (ix)
+                            xt = abs (xz)
+                            if (xt >= dx1) {
+                                if (xt >= 0.5)
+                                    qj = ((xt-dx3)/dx4)**2
+                                else
+                                    qj = 1.- ((xt-dx0)/dx4)**2
+                            } else if (xt <= dx0)
+                                qj = 1.
+                            else
+                                qj = dx2 - (xz / spix) ** 2
+                            if (kl != jl) {
+                                xz = xk - real (ix)
+                                xt = abs (xz)
+                                if (xt >= dx1) {
+                                    if (xt >= 0.5)
+                                        qk = ((xt-dx3)/dx4)**2
+                                    else
+                                        qk = 1.-((xt-dx0)/dx4)**2
+                                } else if (xt <= dx0)
+                                    qk = 1.
+                                else
+                                    qk = dx2 - (xz / spix) ** 2
+                            } else
+                                qk = qj
+                            sum1 = sum1 + qj * qk * s2 / var
+                        }
+                    }
+                    Memr[ysum+iy] = sum1
+		}
+
+	        do il = 1, order {
+	            do ll = 1, il {
+	                sum1 = 0.
+	                ip = il + ll - 2
+	                do iy = 1, ny
+	                    if (spec[iy] > 0.)
+	                        sum1 = sum1 +
+				    Memr[ysum+iy] * ((real (iy) / ny)**ip)
+	                index1 = nside * (order*jl+il-1) + order * kl + ll
+	                Memr[work+index1] = sum1
+	                if (ll != il) {
+	                    ip = ip1 * (ll - il)
+	                    index2 = index1 + ip
+	                    Memr[work+index2] = sum1
+	                } else
+	                    index2 = index1 
+	                if (kl != jl) {
+	                    index3 = index2 + ip2 * (kl - jl)
+	                    Memr[work+index3] = sum1
+	                    if (ll != il)
+	                        Memr[work+index3-ip] = sum1
+	                }
+	            }
+	        }
+	    }
+	}
+
+	# Solve matrix equation AX = B for X.  A is a real symmetric,
+	# positive definite matrix, dimension (order*npols)**2.  X is 
+	# the vector representing the coefficients fitted to the 
+	# normalized profile.  Coefficients are reordered for later speed.
+
+	call hfti (Memr[work+1], nside, nside, nside, Memr[work1+1], 1, 1,
+	    0.01, ip, p, Memr[work2+1], Memr[work3+1], Memi[work4+1])
+
+	do jl = 1, order {
+	    do il = 1, npols {
+	        index1 = order * (il - 1) + jl
+	        index2 = npols * (jl - 1) + il
+	        Memr[work+index2] = Memr[work1+index1]
+	    }
+	}
+
+	# Evaluate fit and make profile positive only.
+	do iy = 1, ny {
+	    ix1 = nint (x1[iy])
+	    ix2 = nint (x2[iy])
+	    xadd = x1[iy] - 1
+	    s = 0.
+	    do ix = 1, nx {
+	        xj = real (ix) - xadd - 0.5
+	        xk = real (ix) - xadd + 0.5
+	        ip1 = int (xj / spix + 0.5)
+	        ip2 = int (xk / spix + 1.5)
+	        ip1 = max (1, min (ip1, npols))
+	        ip2 = max (1, min (ip2, npols))
+	        sum1 = 0.
+	        do jl = 0, order-1 {
+	            index1 = npols * jl
+	            sum2 = 0.
+	            do il = ip1, ip2 {
+	                xz = xadd + spix * (real (il-1) + 0.5) - real (ix)
+	                xt = abs (xz)
+	                if (xt >= dx1) {
+	                    if (xt >= 0.5)
+	                        qj = ((xt - dx3) / dx4) ** 2
+	                    else
+	                        qj = 1. - ((xt - dx0) / dx4) ** 2
+	                } else if (xt <= dx0)
+	                    qj = 1.
+	                else
+	                    qj = dx2 - (xz / spix) ** 2
+	                sum2 = sum2 + qj * Memr[work+index1+il]
+	            }
+	            sum1 = sum1 + sum2 * ((real (iy)/ ny) ** jl)
+	        }
+	        profile[iy,ix] = max (0.d0, sum1)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/aprecenter.par b/noao/twodspec/apextract/aprecenter.par
new file mode 100644
index 00000000..a76b4c76
--- /dev/null
+++ b/noao/twodspec/apextract/aprecenter.par
@@ -0,0 +1,17 @@
+# APRECENTER
+
+input,s,a,,,,List of input images
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"Reference images
+"
+interactive,b,h,no,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,no,,,Resize apertures?
+edit,b,h,yes,,,"Edit apertures?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,1,,,Number of dispersion lines to sum or median
+aprecenter,s,h,"",,,Apertures for recentering calculation
+npeaks,r,h,INDEF,0.,,Select brightest peaks
+shift,b,h,yes,,,Use average shift instead of recentering?
diff --git a/noao/twodspec/apextract/aprecenter.x b/noao/twodspec/apextract/aprecenter.x
new file mode 100644
index 00000000..fb3b9a86
--- /dev/null
+++ b/noao/twodspec/apextract/aprecenter.x
@@ -0,0 +1,166 @@
+include	"apertures.h"
+
+define	NRANGES	50
+
+# AP_RECENTER -- Recenter apertures.
+
+procedure ap_recenter (image, line, nsum, aps, naps, apedit)
+
+char	image[SZ_FNAME]		# Image name
+int	line			# Image dispersion line
+int	nsum			# Number of dispersion lines to sum
+pointer	aps[ARB]		# Aperture pointers
+int	naps			# Number of apertures
+int	apedit			# Called by apedit?
+
+pointer	ranges			# Apertures to select
+int	npeaks			# Number of bright peaks to select 
+bool	shift			# Shift instead of center?
+
+real	center, delta
+int	i, j, k, na, npts, apaxis
+pointer	sp, str, im, imdata, title, index, peaks, deltas
+
+int	decode_ranges()
+real	apgetr(), ap_center(), ap_cveval(), asokr()
+bool	clgetb(), ap_answer(), apgetb(), is_in_range()
+errchk	ap_getdata
+
+begin
+	# Check if apertures are defined.
+	na = 0
+	do i = 1, naps
+	    if (AP_SELECT(aps[i]) == YES)
+		na = na + 1
+	if (na < 1)
+	    return
+
+	# Query user.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	if (apedit == NO) {
+	    call sprintf (Memc[str], SZ_LINE, "Recenter apertures for %s?")
+	        call pargstr (image)
+	    if (!ap_answer ("ansrecenter", Memc[str])) {
+	        call sfree (sp)
+	        return
+	    }
+
+	    if (clgetb ("verbose"))
+	        call printf ("Recentering apertures ...\n")
+	}
+
+	# Get parameters
+	delta = apgetr ("npeaks")
+	shift = apgetb ("shift")
+	if (IS_INDEFR (delta))
+	    npeaks = naps
+	else if (delta < 1.)
+	    npeaks = max (1., delta * naps)
+	else
+	    npeaks = delta
+
+	# Map the image and get the image data.
+	call ap_getdata (image, line, nsum, im, imdata, npts, apaxis, title)
+
+	if (npeaks == naps && !shift) {
+	    na = 0
+	    do i = 1, naps {
+		if (AP_SELECT(aps[i]) == NO)
+		    next
+	        center = AP_CEN(aps[i], apaxis) +
+		    ap_cveval (AP_CV(aps[i]), real (line))
+	        center = ap_center (center, Memr[imdata], npts)
+	        if (!IS_INDEF(center)) {
+		    AP_CEN(aps[i], apaxis) = center -
+		        ap_cveval (AP_CV(aps[i]), real (line))
+		    na = na + 1
+		}
+	    }
+	} else {
+	    call salloc (ranges, 3*NRANGES, TY_INT)
+	    call salloc (index, naps, TY_REAL)
+	    call salloc (peaks, naps, TY_REAL)
+	    call salloc (deltas, naps, TY_REAL)
+
+	    call apgstr ("aprecenter", Memc[str], SZ_LINE)
+	    if (decode_ranges (Memc[str], Memi[ranges], NRANGES, i) == ERR)
+		call error (0, "Bad aperture list")
+
+	    j = 0
+	    do i = 1, naps {
+	        if (!is_in_range (Memi[ranges], AP_ID(aps[i])))
+		    next
+	        center = AP_CEN(aps[i], apaxis) +
+		    ap_cveval (AP_CV(aps[i]), real (line))
+	        delta = ap_center (center, Memr[imdata], npts)
+	        if (!IS_INDEF(delta)) {
+		    k = max (1, min (npts, int (delta+0.5)))
+		    Memr[index+j] = i
+		    Memr[peaks+j] = -Memr[imdata+k-1]
+		    Memr[deltas+j] = delta - center
+		    j = j + 1
+	        }
+	    }
+
+	    if (j > 0 && npeaks > 0) {
+	        if (npeaks < j) {
+	            call xt_sort3 (Memr[peaks], Memr[deltas], Memr[index], j)
+		    j = npeaks
+	        }
+
+	        if (shift) {
+		    if (mod (j, 2) == 0)
+			delta = (asokr (Memr[deltas], j, j/2) +
+				asokr (Memr[deltas], j, 1+j/2)) / 2
+		    else
+			delta = asokr (Memr[deltas], j, 1+j/2)
+		    na = 0
+		    do i = 1, naps {
+			if (AP_SELECT(aps[i]) == NO)
+			    next
+		        center = AP_CEN(aps[i], apaxis) + delta
+		        AP_CEN(aps[i], apaxis) = center
+			na = na + 1
+		    }
+	        } else {
+		    na = 0
+		    do k = 1, j {
+		        delta = Memr[deltas+k-1]
+		        i = Memr[index+k-1]
+			if (AP_SELECT(aps[i]) == NO)
+			    next
+			center = AP_CEN(aps[i], apaxis) + delta
+			AP_CEN(aps[i], apaxis) = center
+			na = na + 1
+		    }
+		}
+	    }
+	}
+		    
+	# Log the operation, write the apertures to the database,
+	# unmap the image and free memory.
+	if (shift) {
+	    call sprintf (Memc[str], SZ_LINE,
+	        "RECENTER  - %d apertures shifted by %.2f for %s.")
+	        call pargi (na)
+		call pargr (delta)
+	        call pargstr (image)
+	} else {
+	    call sprintf (Memc[str], SZ_LINE,
+	        "RECENTER - %d apertures recentered for %s")
+	        call pargi (na)
+	        call pargstr (image)
+	}
+	if (apedit == NO)
+	    call ap_log (Memc[str], YES, YES, NO)
+	else
+	    call ap_log (Memc[str], YES, NO, NO)
+
+	call appstr ("ansdbwrite1", "yes")
+
+	call mfree (imdata, TY_REAL)
+	call mfree (title, TY_CHAR)
+	call imunmap (im)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apresize.par b/noao/twodspec/apextract/apresize.par
new file mode 100644
index 00000000..4cbcf4b7
--- /dev/null
+++ b/noao/twodspec/apextract/apresize.par
@@ -0,0 +1,21 @@
+# APRESIZE
+
+input,s,a,,,,List of input images
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,"Reference images
+"
+interactive,b,h,no,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,no,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,"Edit apertures?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,1,,,Number of dispersion lines to sum or median
+llimit,r,h,INDEF,,,Lower aperture limit relative to center
+ulimit,r,h,INDEF,,,Upper aperture limit relative to center
+ylevel,r,h,0.1,,,Fraction of peak or intensity for automatic width
+peak,b,h,yes,,,Is ylevel a fraction of the peak?
+bkg,b,h,yes,,,Subtract background in automatic width?
+r_grow,r,h,0.,,,"Grow limits by this factor"
+avglimits,b,h,no,,,Average limits over all apertures?
diff --git a/noao/twodspec/apextract/apresize.x b/noao/twodspec/apextract/apresize.x
new file mode 100644
index 00000000..8443223a
--- /dev/null
+++ b/noao/twodspec/apextract/apresize.x
@@ -0,0 +1,142 @@
+include	"apertures.h"
+
+# AP_RESIZE -- Resize apertures.
+
+procedure ap_resize (image, line, nsum, aps, naps, apedit)
+
+char	image[SZ_FNAME]		# Image name
+int	line			# Image dispersion line
+int	nsum			# Number of dispersion lines to sum
+int	apedit			# Called from apedit?
+
+pointer	aps[ARB]		# Aperture pointers
+int	naps			# Number of apertures
+
+real	llimit, ulimit		# Maximum aperture limits
+real	ylevel			# Fraction of intensity for resize
+bool	peak			# Is ylevel a fraction of the peak?
+bool	bkg			# Subtract background?
+real	grow			# Expand limits by this factor
+bool	avglimits		# Average limits?
+
+real	center, low, high
+int	i, na, npts, apaxis
+pointer	sp, str, im, imdata, title
+
+bool	clgetb(), ap_answer(), apgetb()
+real	apgetr(), ap_cveval()
+errchk	ap_getdata
+
+begin
+	# Check if apertures are defined.
+	na = 0
+	do i = 1, naps
+	    if (AP_SELECT(aps[i]) == YES)
+		na = na + 1
+	if (na == 0)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	if (apedit == NO) {
+	    call sprintf (Memc[str], SZ_LINE, "Resize apertures for %s?")
+	        call pargstr (image)
+	    if (!ap_answer ("ansresize", Memc[str])) {
+	        call sfree (sp)
+	        return
+	    }
+
+	    if (clgetb ("verbose"))
+	        call printf ("Resizing apertures ...\n")
+	}
+
+	# Map the image and get the image data.
+	call ap_getdata (image, line, nsum, im, imdata, npts, apaxis, title)
+
+	# Resize the apertures.
+	llimit = apgetr ("llimit")
+	ulimit = apgetr ("ulimit")
+	ylevel = apgetr ("ylevel")
+	bkg = apgetb ("bkg")
+	peak = apgetb ("peak")
+	grow = apgetr ("r_grow")
+	avglimits = apgetb ("avglimits")
+
+	if (IS_INDEF(llimit))
+	    llimit = -npts
+	if (IS_INDEF(ulimit))
+	    ulimit = npts
+	
+	high = max (llimit, ulimit)
+	llimit = min (llimit, ulimit)
+	ulimit = high
+
+	if (IS_INDEF (ylevel)) {
+	    do i = 1, naps {
+		if (AP_SELECT(aps[i]) == YES) {
+		    AP_LOW(aps[i], apaxis) = llimit
+		    AP_HIGH(aps[i], apaxis) = ulimit
+		}
+	    }
+	    avglimits = true
+	} else {
+	    do i = 1, naps {
+		if (AP_SELECT(aps[i]) == YES) {
+		    low = llimit
+		    high = ulimit
+		    center = AP_CEN(aps[i], apaxis) +
+			ap_cveval (AP_CV(aps[i]), real (line))
+		    call ap_ylevel (Memr[imdata], npts, ylevel, peak, bkg, grow,
+			center, low, high)
+		    AP_LOW(aps[i], apaxis) = min (low, high)
+		    AP_HIGH(aps[i], apaxis) = max (low, high)
+		}
+	    }
+
+	    if (avglimits) {
+		low = 0.
+		high = 0.
+		do i = 1, naps {
+		    if (AP_SELECT(aps[i]) == YES) {
+			low = low + AP_LOW(aps[i], apaxis)
+			high = high + AP_HIGH(aps[i], apaxis)
+		    }
+		}
+		low = low / na
+		high = high / na
+		do i = 1, naps {
+		    if (AP_SELECT(aps[i]) == YES) {
+			AP_LOW(aps[i], apaxis) = low
+			AP_HIGH(aps[i], apaxis) = high
+		    }
+		}
+	    }
+	}
+
+	# Log the operation, write the apertures to the database,
+	# unmap the image and free memory.
+	if (na == 1 || avglimits) {
+	    call sprintf (Memc[str], SZ_LINE,
+        	"APRESIZE  - %d apertures resized for %s (%.2f, %.2f)")
+	        call pargi (na)
+	        call pargstr (image)
+		call pargr (AP_LOW(aps[1], apaxis))
+		call pargr (AP_HIGH(aps[1], apaxis))
+	} else {
+	    call sprintf (Memc[str], SZ_LINE,
+	        "RESIZE - %d apertures resized for %s")
+	        call pargi (na)
+	        call pargstr (image)
+	}
+	if (apedit == NO)
+	    call ap_log (Memc[str], YES, YES, NO)
+	else
+	    call ap_log (Memc[str], YES, NO, NO)
+
+	call appstr ("ansdbwrite1", "yes")
+
+	call mfree (imdata, TY_REAL)
+	call mfree (title, TY_CHAR)
+	call imunmap (im)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apscat1.par b/noao/twodspec/apextract/apscat1.par
new file mode 100644
index 00000000..8cb5cf7b
--- /dev/null
+++ b/noao/twodspec/apextract/apscat1.par
@@ -0,0 +1,11 @@
+# APSCAT1
+
+apertures,s,h,)apscatter.apertures,,,>apall.apertures
+function,s,h,"spline3","spline3|legendre|chebyshev|spline1",,Fitting function
+order,i,h,1,1,,Order of fitting function
+sample,s,h,"*",,,Sample points to use in fit
+naverage,i,h,1,,,Number of points in sample averaging
+low_reject,r,h,5.,0.,,Low rejection in sigma of fit
+high_reject,r,h,2.,0.,,High rejection in sigma of fit
+niterate,i,h,5,0,,Number of rejection iterations
+grow,r,h,0.,0.,,Rejection growing radius in pixels
diff --git a/noao/twodspec/apextract/apscat2.par b/noao/twodspec/apextract/apscat2.par
new file mode 100644
index 00000000..2463f110
--- /dev/null
+++ b/noao/twodspec/apextract/apscat2.par
@@ -0,0 +1,10 @@
+# APSCAT2
+
+function,s,h,"spline3","spline3|legendre|chebyshev|spline1",,Fitting function
+order,i,h,1,1,,Order of fitting function
+sample,s,h,"*",,,Sample points to use in fit
+naverage,i,h,1,,,Number of points in sample averaging
+low_reject,r,h,3.,0.,,Low rejection in sigma of fit
+high_reject,r,h,3.,0.,,High rejection in sigma of fit
+niterate,i,h,0,0,,Number of rejection iterations
+grow,r,h,0.,0.,,Rejection growing radius in pixels
diff --git a/noao/twodspec/apextract/apscatter.par b/noao/twodspec/apextract/apscatter.par
new file mode 100644
index 00000000..b7f45991
--- /dev/null
+++ b/noao/twodspec/apextract/apscatter.par
@@ -0,0 +1,25 @@
+# APSCATTER
+
+input,s,a,,,,List of input images to subtract scattered light
+output,s,a,,,,List of output corrected images
+apertures,s,h,"",,,Apertures
+scatter,s,h,"",,,List of scattered light images (optional)
+references,s,h,"",,,"List of aperture reference images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit the traced points interactively?
+subtract,b,h,yes,,,Subtract scattered light?
+smooth,b,h,yes,,,Smooth scattered light along the dispersion?
+fitscatter,b,h,yes,,,Fit scattered light interactively?
+fitsmooth,b,h,yes,,,"Smooth the scattered light interactively?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum or median
+buffer,r,h,1.,0.,,Buffer distance from apertures
+apscat1,pset,h,"",,,Fitting parameters across the dispersion
+apscat2,pset,h,"",,,Fitting parameters along the dispersion
diff --git a/noao/twodspec/apextract/apscatter.x b/noao/twodspec/apextract/apscatter.x
new file mode 100644
index 00000000..44f56a72
--- /dev/null
+++ b/noao/twodspec/apextract/apscatter.x
@@ -0,0 +1,662 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+ 
+define	MAXBUF	500000		# Buffer size (number of reals) for col access
+ 
+ 
+# AP_SCATTER -- Fit and subtract the scattered light from between the apertures.
+#
+# Each line of the input image across the dispersion is read.  The points to
+# be fit are selected from between the apertures (which includes a buffer
+# distance).  The fitting is done using the ICFIT package.  If not smoothing
+# along the dispersion write the scattered light subtracted output directly
+# thus minimizing I/O.  If smoothing save the fits in memory.  During the
+# smoothing process the fits are evaluated at each point along the dispersion
+# and then fit to the create the scattered light subtracted output image.  A
+# scattered light image is only created after the output image by subtracting
+# the input from the output.
+
+procedure ap_scatter (input, output, scatter, aps, naps, line)
+ 
+char	input[SZ_FNAME]		# Input image
+char	output[SZ_FNAME]	# Output image
+char	scatter[SZ_FNAME]	# Scattered light image
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+int	line			# Line to be edited
+ 
+bool	smooth
+int	i, aaxis, daxis, npts, nlines, nscatter, nscatter1, new
+pointer	sp, str, in, out, scat, cv, cvs, gp, indata, outdata, col, x, y, w 
+pointer	ic1, ic2, ic3, gt1, gt2
+data	ic3/NULL/
+
+real	clgetr()
+int	clgeti(), ap_gline(), ap_gdata()
+bool	clgetb(), ap_answer(), apgansb()
+pointer	gt_init(), immap(), ap_immap(), imgl2r(), impl2r()
+
+common	/aps_com/ ic1, ic2, gt1, gt2
+ 
+begin
+	if (naps < 1)
+	    return
+ 
+	# Query the user.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[str], SZ_LINE, "Subtract scattered light in %s?")
+	        call pargstr (input)
+	if (!ap_answer ("ansscat", Memc[str])) {
+	    call sfree (sp)
+	    return
+	}
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "Fit scattered light for %s interactively?")
+	    call pargstr (input)
+	if (ap_answer ("ansfitscatter", Memc[str]))
+	    ;
+
+	call sprintf (Memc[str], SZ_LINE, "Smooth the scattered light in %s?")
+	    call pargstr (input)
+	if (ap_answer ("anssmooth", Memc[str])) {
+	    call sprintf (Memc[str], SZ_LINE,
+	        "Smooth the scattered light for %s interactively?")
+	        call pargstr (input)
+	    if (ap_answer ("ansfitsmooth", Memc[str]))
+		;
+	}
+	smooth = apgansb ("anssmooth")
+
+	# Initialize the ICFIT pointers.
+	if (ic1 == NULL || ic3 == NULL) {
+	    call ic_open (ic1)
+	    call clgstr ("apscat1.function", Memc[str], SZ_LINE)
+	    call ic_pstr (ic1, "function", Memc[str])
+	    call ic_puti (ic1, "order", clgeti ("apscat1.order"))
+	    call clgstr ("apscat1.sample", Memc[str], SZ_LINE)
+	    call ic_pstr (ic1, "sample", Memc[str])
+	    call ic_puti (ic1, "naverage", clgeti ("apscat1.naverage"))
+	    call ic_puti (ic1, "niterate", clgeti ("apscat1.niterate"))
+	    call ic_putr (ic1, "low", clgetr ("apscat1.low_reject"))
+	    call ic_putr (ic1, "high", clgetr ("apscat1.high_reject"))
+	    call ic_putr (ic1, "grow", clgetr ("apscat1.grow"))
+	    call ic_pstr (ic1, "ylabel", "")
+	    gt1 = gt_init()
+	    call gt_sets (gt1, GTTYPE, "line")
+ 
+	    call ic_open (ic2)
+	    call clgstr ("apscat2.function", Memc[str], SZ_LINE)
+	    call ic_pstr (ic2, "function", Memc[str])
+	    call ic_puti (ic2, "order", clgeti ("apscat2.order"))
+	    call clgstr ("apscat2.sample", Memc[str], SZ_LINE)
+	    call ic_pstr (ic2, "sample", Memc[str])
+	    call ic_puti (ic2, "naverage", clgeti ("apscat2.naverage"))
+	    call ic_puti (ic2, "niterate", clgeti ("apscat2.niterate"))
+	    call ic_putr (ic2, "low", clgetr ("apscat2.low_reject"))
+	    call ic_putr (ic2, "high", clgetr ("apscat2.high_reject"))
+	    call ic_putr (ic2, "grow", clgetr ("apscat2.grow"))
+	    call ic_pstr (ic2, "ylabel", "")
+	    gt2 = gt_init()
+	    call gt_sets (gt2, GTTYPE, "line")
+
+	    ic3 = ic1
+	}
+ 
+	# Map the input and output images.  Warn and return on an error.
+	iferr (in = ap_immap (input, aaxis, daxis)) {
+	    call sfree (sp)
+	    call erract (EA_WARN)
+	    return
+	}
+	iferr (out = immap (output, NEW_COPY, in)) {
+	    call imunmap (in)
+	    call sfree (sp)
+	    call erract (EA_WARN)
+	    return
+	}
+	if (IM_PIXTYPE(out) != TY_DOUBLE)
+	    IM_PIXTYPE(out) = TY_REAL
+ 
+	# Allocate memory for curve fitting.
+	call ap_sort (i, aps, naps, 1)
+	npts = IM_LEN (in, aaxis)
+	nlines = IM_LEN (in, daxis)
+	call salloc (col, npts, TY_REAL)
+	call salloc (x, npts, TY_REAL)
+	call salloc (y, npts, TY_REAL)
+	call salloc (w, npts, TY_REAL)
+ 
+	do i = 1, npts
+	    Memr[col+i-1] = i
+	call ic_putr (ic1, "xmin", Memr[col])
+	call ic_putr (ic1, "xmax", Memr[col+npts-1])
+ 
+	# If the interactive flag is set then use icg_fit to set the
+	# fitting parameters.  AP_GLINE returns EOF when the user
+	# is done.
+ 
+	if (apgansb ("ansfitscatter")) {
+	    call ap_gopen (gp)
+ 
+	    if (IS_INDEFI (line))
+		i = nlines / 2
+	    else
+		i = line
+	    indata = NULL
+	    while (ap_gline (ic1, gt1, NULL, in, aaxis, aaxis, i, indata) !=
+		EOF) {
+	        call ap_gscatter1 (aps, naps, i, Memr[indata], npts,
+		    Memr[x], Memr[y], Memr[w], nscatter)
+	        call icg_fit (ic1, gp, "gcur", gt1, cv, Memr[x], Memr[y],
+		    Memr[w], nscatter)
+	    }
+	    call cvfree (cv)
+	}
+ 
+	# Loop through the input image and create an output image.
+	# To minimize I/O if not smoothing write the final image
+	# directly otherwise save the fit.  AP_SMOOTH will then
+	# smooth along the dispersion and compute the scattered
+	# light subtracted image.
+ 
+	if (clgetb ("verbose")) {
+	    call printf (
+		"Fitting the scattered light across the dispersion ...\n")
+	    call flush (STDOUT)
+	}
+ 
+	if (!smooth) {
+	    nscatter = 0
+	    i = 0
+	    while (ap_gdata (in, out, NULL, aaxis, MAXBUF, i,
+		indata, outdata) != EOF) {
+		call ap_gscatter1 (aps, naps, i, Memr[indata], npts, Memr[x],
+		    Memr[y], Memr[w], nscatter1)
+		if (nscatter != nscatter1)
+		    new = YES
+		else
+		    new = NO
+		nscatter = nscatter1
+		call ic_fit (ic1, cv, Memr[x], Memr[y], Memr[w], nscatter,
+		    new, YES, new, new)
+		call cvvector (cv, Memr[col], Memr[outdata], npts)
+		call asubr (Memr[indata], Memr[outdata], Memr[outdata], npts)
+	    }
+	    call cvfree (cv)
+	} else {
+	    call salloc (cvs, nlines, TY_POINTER)
+	    call amovki (NULL, Memi[cvs], nlines)
+
+	    new = YES
+	    i = 0
+	    while (ap_gdata (in, NULL, NULL, aaxis, MAXBUF, i,
+		indata, outdata) != EOF) {
+		call ap_gscatter1 (aps, naps, i, Memr[indata], npts, Memr[x],
+		    Memr[y], Memr[w], nscatter)
+		call ic_fit (ic1, Memi[cvs+i-1], Memr[x], Memr[y], Memr[w],
+		    nscatter, new, YES, new, new)
+	    }
+     
+	    # Smooth and subtract along the dispersion.
+	    call ap_smooth (in, out, aaxis, daxis, aps, naps, ic2, gt2, cvs)
+	    do i = 1, nlines
+		call cvfree (Memi[cvs+i-1])
+	}
+
+	call imastr (out, "apscatter", "Scattered light subtracted")
+	call imunmap (out)
+	call imunmap (in)
+ 
+	# If a scattered light image is desired compute it from the difference
+	# of the input and output images.
+ 
+	if (scatter[1] != EOS) {
+	    in = immap (input, READ_ONLY, 0)
+	    out = immap (output, READ_ONLY, 0)
+	    ifnoerr (scat = immap (scatter, NEW_COPY, in)) {
+		if (IM_PIXTYPE(scat) != TY_DOUBLE)
+		    IM_PIXTYPE(scat) = TY_REAL
+		npts = IM_LEN(in,1)
+		nlines = IM_LEN(in,2)
+		do i = 1, nlines
+		    call asubr (Memr[imgl2r(in,i)], Memr[imgl2r(out,i)],
+			Memr[impl2r(scat,i)], npts)
+		call imunmap (scat)
+	    } else
+		call erract (EA_WARN)
+	    call imunmap (in)
+	    call imunmap (out)
+	}
+ 
+	# Make a log.
+	call sprintf (Memc[str], SZ_LINE,
+	    "SCATTER - Scattered light subtracted from %s")
+	    call pargstr (input)
+	call ap_log (Memc[str], YES, YES, NO)
+ 
+	call sfree (sp)
+end
+
+
+# SCAT_FREE -- Free scattered light memory.
+
+procedure scat_free ()
+
+pointer	ic1, ic2, gt1, gt2
+pointer	sp, str
+
+int	ic_geti()
+real	ic_getr()
+
+common	/aps_com/ ic1, ic2, gt1, gt2
+
+begin
+	if (ic1 != NULL) {
+	    call smark (sp)
+	    call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	    call ic_gstr (ic1, "function", Memc[str], SZ_LINE)
+	    call clpstr ("apscat1.function", Memc[str])
+	    call ic_gstr (ic1, "sample", Memc[str], SZ_LINE)
+	    call clpstr ("apscat1.sample", Memc[str])
+	    call clputi ("apscat1.order", ic_geti (ic1, "order"))
+	    call clputi ("apscat1.naverage", ic_geti (ic1, "naverage"))
+	    call clputi ("apscat1.niterate", ic_geti (ic1, "niterate"))
+	    call clputr ("apscat1.low", ic_getr (ic1, "low"))
+	    call clputr ("apscat1.high", ic_getr (ic1, "high"))
+	    call clputr ("apscat1.grow", ic_getr (ic1, "grow"))
+ 
+	    call ic_gstr (ic2, "function", Memc[str], SZ_LINE)
+	    call clpstr ("apscat2.function", Memc[str])
+	    call ic_gstr (ic2, "sample", Memc[str], SZ_LINE)
+	    call clpstr ("apscat2.sample", Memc[str])
+	    call clputi ("apscat2.order", ic_geti (ic2, "order"))
+	    call clputi ("apscat2.naverage", ic_geti (ic2, "naverage"))
+	    call clputi ("apscat2.niterate", ic_geti (ic2, "niterate"))
+	    call clputr ("apscat2.low", ic_getr (ic2, "low"))
+	    call clputr ("apscat2.high", ic_getr (ic2, "high"))
+	    call clputr ("apscat2.grow", ic_getr (ic2, "grow"))
+ 
+	    call ic_closer (ic1)
+	    call gt_free (gt1)
+	    call ic_closer (ic2)
+	    call gt_free (gt2)
+	    call sfree (sp)
+	}
+end
+ 
+ 
+# AP_SMOOTH -- Smooth the scattered light by fitting one dimensional functions.
+#
+# The output image consists of smooth one dimensional fits across the
+# dispersion.  This routine reads each line along the dispersion and fits
+# a function to smooth the fits made across the dispersion.  The output
+# image is used both as input of the cross dispersion fits and as output
+# of the scattered light subtracted image.
+ 
+procedure ap_smooth (in, out, aaxis, daxis, aps, naps, ic, gt, cvs)
+ 
+pointer	in			# Input IMIO pointer
+pointer	out			# Output IMIO pointer
+int	aaxis, daxis		# Aperture and dispersion axes
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+pointer	ic			# ICFIT pointer
+pointer	gt			# GTOOLS pointer
+pointer	cvs			# CURFIT pointers
+ 
+int	i, npts, nlines, new
+pointer	cv, gp, indata, outdata, x, w 
+
+int	ap_gline(), ap_gdata()
+bool	clgetb(), apgansb()
+ 
+begin
+	if (!apgansb ("anssmooth"))
+	    return
+ 
+	# Allocate memory for curve fitting.
+	npts = IM_LEN (in, daxis)
+	nlines = IM_LEN (in, aaxis)
+	call salloc (x, npts, TY_REAL)
+	call salloc (w, npts, TY_REAL)
+ 
+	do i = 1, npts
+	    Memr[x+i-1] = i
+	call amovkr (1., Memr[w], npts)
+	call ic_putr (ic, "xmin", Memr[x])
+	call ic_putr (ic, "xmax", Memr[x+npts-1])
+ 
+	# If the interactive flag is set then use icg_fit to set the
+	# fitting parameters.  AP_GLINE returns EOF when the user
+	# is done.
+ 
+	if (apgansb ("ansfitsmooth")) {
+	    call ap_gopen (gp)
+ 
+	    i = nlines / 2
+	    outdata = NULL
+	    while (ap_gline (ic, gt, cvs, out, daxis, aaxis, i, outdata) !=
+		EOF) {
+	        call icg_fit (ic, gp, "gcur", gt, cv, Memr[x],
+		    Memr[outdata], Memr[w], npts)
+		call amovkr (1., Memr[w], npts)
+	    }
+	    call mfree (outdata, TY_REAL)
+	}
+ 
+	# Loop through the input image and create an output image.
+	if (clgetb ("verbose")) {
+	    call printf ("Smoothing scattered light along the dispersion ...\n")
+	    call flush (STDOUT)
+	}
+ 
+	# Use the new flag to optimize the fitting.
+	new = YES
+	i = 0
+	while (ap_gdata (in, out, cvs, daxis, MAXBUF, i,
+	    indata, outdata) != EOF) {
+	    call ic_fit (ic, cv, Memr[x], Memr[outdata], Memr[w], npts,
+		new, YES, new, new)
+	    call cvvector (cv, Memr[x], Memr[outdata], npts)
+	    call asubr (Memr[indata], Memr[outdata], Memr[outdata], npts)
+	    new = NO
+	}
+	call cvfree (cv)
+end
+ 
+ 
+# AP_GSCATTER -- Get scattered light pixels.
+#
+# The pixels outside the apertures extended by the specified buffer
+# distance are selected.  The x and weight arrays are also set.
+# The apertures must be sorted by position.
+ 
+procedure ap_gscatter1 (aps, naps, line, data, npts, x, y, w, nscatter)
+ 
+pointer	aps[naps]		# Apertures
+int	naps			# Number of apertures
+int	line			# Line
+real	data[npts]		# Image data
+int	npts			# Number of points
+real	x[npts]			# Scattered light positions
+real	y[npts]			# Image data
+real	w[npts]			# Weights
+int	nscatter		# Number of scattered light pixels
+ 
+real	buf			# Aperture buffer
+ 
+int	i, j, axis
+int	low, high
+real	center, ap_cveval(), clgetr()
+ 
+begin
+	buf = clgetr ("buffer") + 0.5
+	call aclrr (x, npts)
+ 
+	axis = AP_AXIS(aps[1])
+	do i = 1, naps {
+	    center = AP_CEN(aps[i],axis) + ap_cveval (AP_CV(aps[i]), real(line))
+	    low = max (1, int (center + AP_LOW(aps[i],axis) - buf))
+	    high = min (npts, int (center + AP_HIGH(aps[i],axis) + buf))
+	    do j = low, high
+		x[j] = 1
+	}
+
+	nscatter = 0
+	do i = 1, npts {
+	    if (x[i] == 0.) {
+		nscatter = nscatter + 1
+		x[nscatter] = i
+		y[nscatter] = data[i]
+		w[nscatter] = 1.
+	    }
+	}
+end
+ 
+ 
+# AP_GDATA -- Get the next line of image data.  Return EOF at end.
+# This task optimizes column access if needed.  It assumes sequential access.
+ 
+int procedure ap_gdata (in, out, cvs, axis, maxbuf, index, indata, outdata)
+ 
+pointer	in			# Input IMIO pointer
+pointer	out			# Output IMIO pointer (NULL if no output)
+pointer	cvs			# CURFIT pointers
+int	axis			# Image axis
+int	maxbuf			# Maximum buffer size chars for column axis
+int	index			# Last line (input), current line (returned)
+pointer	indata			# Input data pointer
+pointer	outdata			# Output data pointer
+ 
+real	val, ap_cveval()
+int	i, last_index, col1, col2, nc, nd, ncols, nlines, ncols_block
+pointer	inbuf, outbuf, ptr, imgl2r(), impl2r(), imgs2r(), imps2r()
+ 
+begin
+	# Increment to the next image vector.
+	index = index + 1
+ 
+	# Initialize for the first vector.
+	if (index == 1) {
+	    ncols = IM_LEN (in, 1)
+	    if (IM_NDIM (in) == 1)
+		nlines = 1
+	    else
+		nlines = IM_LEN (in, 2)
+ 
+	    switch (axis) {
+	    case 1:
+		nd = ncols
+		last_index = nlines
+	    case 2:
+		nd = nlines
+		last_index = ncols
+	        ncols_block =
+		    max (1, min (ncols, maxbuf / nlines))
+		col2 = 0
+ 
+	        call malloc (indata, nlines, TY_REAL)
+		if (out != NULL)
+		    call malloc (outdata, nlines, TY_REAL)
+	    }
+	}
+ 
+	# Finish up if the last vector has been done.
+	if (index > last_index) {
+	    if (axis == 2) {
+	        call mfree (indata, TY_REAL)
+		if (out != NULL) {
+		    ptr = outbuf + index - 1 - col1
+		    do i = 1, nlines {
+			Memr[ptr] = Memr[outdata+i-1]
+			ptr = ptr + nc
+		    }
+		    call mfree (outdata, TY_REAL)
+		}
+	    }
+	    index = 0
+	    return (EOF)
+	}
+ 
+	# Get the next image vector.
+	switch (axis) {
+	case 1:
+	    indata = imgl2r (in, index)
+	    if (out != NULL)
+		outdata = impl2r (out, index)
+	case 2:
+	    if (out != NULL)
+		if (index > 1) {
+		    ptr = outbuf + index - 1 - col1
+		    do i = 1, nlines {
+			Memr[ptr] = Memr[outdata+i-1]
+			ptr = ptr + nc
+		    }
+		}
+ 
+	    if (index > col2) {
+		col1 = col2 + 1
+		col2 = min (ncols, col1 + ncols_block - 1)
+		nc = col2 - col1 + 1
+		inbuf = imgs2r (in, col1, col2, 1, nlines)
+		if (out != NULL)
+		    outbuf = imps2r (out, col1, col2, 1, nlines)
+	    }
+ 
+	    ptr = inbuf + index - col1
+	    do i = 1, nlines {
+		Memr[indata+i-1] = Memr[ptr]
+		ptr = ptr + nc
+	    }
+	}
+	if (cvs != NULL) {
+	    val = index
+	    do i = 1, nd
+		Memr[outdata+i-1] = ap_cveval (Memi[cvs+i-1], val)
+	}
+ 
+	return (index)
+end
+ 
+ 
+define	CMDS	"|quit|line|column|buffer|"
+define	QUIT	1		# Quit
+define	LINE	2		# Line to examine
+define	COLUMN	3		# Column to examine
+define	BUFFER	4		# Buffer distance
+ 
+# AP_GLINE -- Get image data to be fit interactively.  Return EOF
+# when the user enters EOF or CR.  The out of bounds
+# requests are silently limited to the nearest edge.
+ 
+int procedure ap_gline (ic, gt, cvs, im, axis, aaxis, line, data)
+ 
+pointer	ic			# ICFIT pointer
+pointer	gt			# GTOOLS pointer
+pointer	cvs			# CURFIT pointers
+pointer	im			# IMIO pointer
+int	axis			# Image axis
+int	aaxis			# Aperture axis
+int	line			# Line to get
+pointer	data			# Image data
+ 
+real	rval, clgetr(), ap_cveval()
+int	i, stat, cmd, ival, strdic(), scan(), nscan()
+pointer	sp, name, str, imgl2r(), imgs2r()
+ 
+begin
+	call smark (sp)
+	call salloc (name, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	stat = OK
+	if (data != NULL) {
+	    cmd = 0
+	    repeat {
+	        switch (cmd) {
+	        case QUIT:
+		    stat = EOF
+		    break
+	        case LINE:
+		    call gargi (ival)
+		    if (axis == 2 || nscan() == 1) {
+		        call printf ("line %d - ")
+		        call pargi (line)
+		    } else {
+		        line = max (1, min (IM_LEN(im,2), ival))
+		        break
+		    }
+	        case COLUMN:
+		    call gargi (ival)
+		    if (axis == 1 || nscan() == 1) {
+		        call printf ("column %d - ")
+		        call pargi (line)
+		    } else {
+		        line = max (1, min (IM_LEN(im,1), ival))
+		        break
+		    }
+	        case BUFFER:
+		    if (axis == aaxis) {
+			call gargr (rval)
+			if (nscan() == 1) {
+			    call printf ("buffer %g - ")
+				call pargr (clgetr ("buffer"))
+			} else {
+			    call clputr ("buffer", rval)
+			    break
+			}
+		    }
+	        }
+ 
+		if (axis == aaxis) {
+		    if (axis == 1)
+			call printf (
+			    "Command (quit, buffer <value>, line <value>): ")
+		    else
+			call printf (
+			    "Command (quit, buffer <value>, column <value>): ")
+		} else {
+		    if (axis == 1)
+			call printf (
+			    "Command (quit, line <value>): ")
+		    else
+			call printf (
+			    "Command (quit, column <value>): ")
+		}
+		call flush (STDOUT)
+		stat = scan ()
+		if (stat == EOF)
+		    break
+		call gargwrd (Memc[str], SZ_LINE)
+		cmd = strdic (Memc[str], Memc[str], SZ_LINE, CMDS)
+	    }
+
+	}
+
+	if (stat != EOF) {
+	    call imstats (im, IM_IMAGENAME, Memc[name], SZ_FNAME)
+	    switch (axis) {
+	    case 1:
+		call sprintf (Memc[str], SZ_LINE, "%s: Fit line %d\n%s")
+		    call pargstr (Memc[name])
+		    call pargi (line)
+		    call pargstr (IM_TITLE(im))
+		call gt_sets (gt, GTTITLE, Memc[str])
+		call ic_pstr (ic, "xlabel", "Column")
+		if (axis == aaxis)
+		    data = imgl2r (im, line)
+		else {
+		    if (data == NULL)
+			call malloc (data, IM_LEN(im,1), TY_REAL)
+		    rval = line
+		    do i = 1, IM_LEN(im,1)
+			Memr[data+i-1] = ap_cveval (Memi[cvs+i-1], rval)
+		}
+	    case 2:
+		call sprintf (Memc[str], SZ_LINE, "%s: Fit column %d\n%s")
+		    call pargstr (Memc[name])
+		    call pargi (line)
+		    call pargstr (IM_TITLE(im))
+		call gt_sets (gt, GTTITLE, Memc[str])
+		call ic_pstr (ic, "xlabel", "Line")
+		if (axis == aaxis)
+		    data = imgs2r (im, line, line, 1, IM_LEN(im,2))
+		else {
+		    if (data == NULL)
+			call malloc (data, IM_LEN(im,2), TY_REAL)
+		    rval = line
+		    do i = 1, IM_LEN(im,2)
+			Memr[data+i-1] = ap_cveval (Memi[cvs+i-1], rval)
+		}
+	    }
+	}
+ 
+	call sfree (sp)
+	return (stat)
+end
diff --git a/noao/twodspec/apextract/apselect.x b/noao/twodspec/apextract/apselect.x
new file mode 100644
index 00000000..47730f47
--- /dev/null
+++ b/noao/twodspec/apextract/apselect.x
@@ -0,0 +1,40 @@
+include	"apertures.h"
+
+define	NRANGES	100
+
+
+# AP_SELECT -- Select apertures.
+# The AP_SELECT field of the aperture structure is set.
+
+procedure ap_select (apertures, aps, naps)
+
+char	apertures[ARB]		#I Aperture selection string
+pointer	aps[ARB]		#U Aperture pointers
+int	naps			#I Number of apertures
+
+pointer	sp, ranges
+int	i, decode_ranges()
+bool	is_in_range()
+
+begin
+	# Check if apertures are defined.
+	if (naps < 1)
+	    return
+
+	call smark (sp)
+	call salloc (ranges, 3*NRANGES, TY_INT)
+
+	# Decode aperture string.
+	if (decode_ranges (apertures, Memi[ranges], NRANGES, i) == ERR)
+	    call error (0, "Bad aperture list")
+
+	# Select apertures.
+	do i = 1, naps {
+	    if (is_in_range (Memi[ranges], AP_ID(aps[i])))
+		AP_SELECT(aps[i]) = YES
+	    else
+		AP_SELECT(aps[i]) = NO
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apshow.x b/noao/twodspec/apextract/apshow.x
new file mode 100644
index 00000000..16f4d504
--- /dev/null
+++ b/noao/twodspec/apextract/apshow.x
@@ -0,0 +1,46 @@
+include	"apertures.h"
+
+# AP_SHOW -- List the apertures to a text file.
+
+procedure ap_show (file, aps, naps)
+
+char	file[ARB]		# Aperture file
+pointer	aps[ARB]		# Aperture pointers
+int	naps			# Number of apertures
+
+pointer	ap
+int	i, apaxis, fd, open()
+errchk	open
+
+begin
+	if (naps == 0)
+	    return
+
+	# Open the output file.  Return if an error occurs.
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call fprintf (fd, "# APERTURES\n\n%4s %4s %7s %7s %7s %s\n")
+	    call pargstr ("##ID")
+	    call pargstr ("BEAM")
+	    call pargstr ("CENTER")
+	    call pargstr ("LOW")
+	    call pargstr ("HIGH")
+	    call pargstr ("TITLE")
+	for (i = 1; i <= naps; i = i + 1) {
+	    ap = aps[i]
+	    apaxis = AP_AXIS(ap)
+	    call fprintf (fd, "%4d %4d %7.2f %7.2f %7.2f")
+		call pargi (AP_ID(ap))
+		call pargi (AP_BEAM(ap))
+		call pargr (AP_CEN(ap, apaxis))
+		call pargr (AP_LOW(ap, apaxis))
+		call pargr (AP_HIGH(ap, apaxis))
+	    if (AP_TITLE(ap) != NULL) {
+		call fprintf (fd, " %s")
+		    call pargstr (Memc[AP_TITLE(ap)])
+	    }
+	    call fprintf (fd, "\n")
+	}
+
+	call close (fd)
+end
diff --git a/noao/twodspec/apextract/apskyeval.x b/noao/twodspec/apextract/apskyeval.x
new file mode 100644
index 00000000..05f47f14
--- /dev/null
+++ b/noao/twodspec/apextract/apskyeval.x
@@ -0,0 +1,368 @@
+include	<math/iminterp.h>
+include <mach.h>
+include	"apertures.h"
+
+# Background fitting types
+define	BACKGROUND	"|none|average|median|minimum|fit|"
+define	B_NONE		1
+define	B_AVERAGE	2
+define	B_MEDIAN	3
+define	B_MINIMUM	4
+define	B_FIT		5
+
+define	NSAMPLE		20	# Maximum number of background sample regions
+
+
+# AP_SKYEVAL -- Evaluate sky within aperture.
+#
+# The sky pixels specified by the background sample string are used to
+# determine a sky function at each line which is then evaluated for each
+# pixel in the aperture as given by the SBUF array with starting offsets
+# given by XS.  The fitting consists of either a straight average or a
+# function fit using ICFIT.  The sky regions are specified relative to the
+# aperture center.  To avoid systematics due to shifting of the aperture
+# relative to the integer pixel positions the sky regions are linearly
+# interpolated.  The average uses the integral of the interpolation
+# function within the sample region endpoints.  The fit samples the
+# interpolation on a pixel grid with the aperture exactly centered on
+# a pixel.  A crude sky variance is computed for each line based solely
+# on the variance model and the square root of the number of "pixels"
+# used for the fit.  This variance is used to boost the variance of
+# the sky subtracted spectrum during variance weighting.  Because sky
+# noise may be significant in short slits a box car smoothing may be
+# used giving a lower variance per pixel but bad errors near sky lines.
+# An unweighted aperture sum of the sky is returned in case the user
+# wants to save the subtracted 1D sky spectrum.
+
+procedure ap_skyeval (im, ap, dbuf, nc, nl, c1, l1, sbuf, svar, sky, nx, ny,
+	xs, ys, nsubaps, rdnoise)
+
+pointer	im		# IMIO pointer
+pointer	ap		# Aperture structure
+pointer	dbuf		# Data buffer
+int	nc, nl		# Size of data buffer
+int	c1, l1		# Origin of data buffer
+real	sbuf[nx,ny]	# Sky values
+real	svar[ny]	# Sky variances
+real	sky[ny,nsubaps]	# Extracted sky (out)
+int	nx, ny		# Size of profile array
+int	xs[ny], ys	# Origin of profile array
+int	nsubaps		# Number of subapertures
+real	rdnoise		# Readout noise in RMS data numbers.
+
+int	bkg		# Background type
+int	skybox		# Sky box car smoothing
+
+int	i, j, ix1, ix2, nsample, nsky, nfit, ix, iy
+real	center, xmin, xmax, a, b, c, s, avg
+pointer	ic, cv, cv1, asi, sp, str, data, as, bs, x, y, w
+
+int	apgwrd(), apgeti(), ctor()
+real	ic_getr(), ap_cveval(), asieval(), asigrl(), amedr()
+errchk	salloc, ic_fit
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Get CL parameters and set shift and fitting function pointers.
+	bkg = apgwrd ("background", Memc[str], SZ_LINE, BACKGROUND)
+	skybox = apgeti ("skybox")
+
+	cv = AP_CV(ap)
+	ic = AP_IC(ap)
+
+	# Set center and maximum limits relative to data buffer.
+	# The limits are required to overlap the aperture and include
+	# an extra point at each end for interpolation.  Shifts
+	# and boundary limits will be enforced later.
+
+	i = AP_AXIS(ap)
+	center = AP_CEN(ap,i)
+	xmin = center + min (AP_LOW(ap,i), ic_getr (ic, "xmin"))
+	xmax = center + max (AP_HIGH(ap,i), ic_getr (ic, "xmax"))
+	ix1 = nint (xmin) - 1
+	ix2 = nint (xmax) + 1
+	nfit = ix2 - ix1 + 1
+
+	# Allocate memory and parse sample string.
+	# The colons in the sample string must be changed to avoid
+	# sexigesimal interpretation.
+
+	call salloc (as, NSAMPLE, TY_REAL)
+	call salloc (bs, NSAMPLE, TY_REAL)
+
+	call ic_gstr (ic, "sample", Memc[str], SZ_LINE)
+	for (i=str; Memc[i]!=EOS; i=i+1)
+	    if (Memc[i] == ':')
+		Memc[i] = '$'
+
+	nsample = 0
+	for (i=1; Memc[str+i-1]!=EOS; i=i+1) {
+	    if (ctor (Memc[str], i, a) > 0) {
+		i = i - 1
+		if (Memc[str+i] == '$') {
+		    i = i + 2
+		    if (ctor (Memc[str], i, b) > 0) {
+			i = i - 1
+			Memr[as+nsample] = center + min (a, b)
+			Memr[bs+nsample] = center + max (a, b)
+			nsample = nsample + 1
+			if (nsample == NSAMPLE)
+			    break
+		    }
+	        }
+	    }
+	}
+
+	if (nsample == 0) {
+	    Memr[as] = xmin
+	    Memr[bs] = xmax
+	    nsample = 1
+	}
+
+	if (bkg == B_MEDIAN)
+	    call salloc (y, nfit, TY_REAL)
+	else if (bkg == B_FIT) {
+	    call salloc (x, nfit, TY_REAL)
+	    call salloc (y, nfit, TY_REAL)
+	    call salloc (w, nfit, TY_REAL)
+	}
+
+	# Initialize the image interpolator.
+	call asiinit (asi, II_LINEAR)
+
+	# Determine sky at each dispersion point.
+	call aclrr (svar, ny)
+	do iy = 1, ny {
+
+	    # Fit image interpolation function including extra points
+	    # and apply image boundary limits.
+
+	    i = iy + ys - 1
+	    s = ap_cveval (cv, real (i))
+	    ix1 = max (c1, nint (xmin + s) - 1)
+	    ix2 = min (c1+nc-1, nint (xmax + s) + 1)
+	    nfit = ix2 - ix1 + 1
+	    if (nfit < 3) {
+		call aclrr (sbuf[1,iy], nx)
+		svar[iy] = 0.
+		next
+	    }
+	    data = dbuf + (i - l1) * nc + ix1 - c1
+	    if (bkg == B_AVERAGE || bkg == B_FIT) {
+		iferr (call asifit (asi, Memr[data], nfit)) {
+		    call aclrr (sbuf[1,iy], nx)
+		    svar[iy] = 0.
+		    next
+		}
+	    }
+
+	    # Determine background
+	    switch (bkg) {
+	    case B_AVERAGE:
+		# The background is computed by integrating the interpolator 
+	        avg = 0.
+		nsky = 0
+	        c = 0.
+		for (i=0; i < nsample; i=i+1) {
+		    a = max (real (ix1), Memr[as+i] + s) - ix1 + 1
+		    b = min (real (ix2), Memr[bs+i] + s) - ix1 + 1
+		    if (b - a > 0.) {
+			avg = avg + asigrl (asi, a, b)
+			c = c + b - a
+			nsky = nsky + nint (b) - nint(a) + 1
+		    }
+	        }
+	        if (c > 0.)
+	            avg = avg / c
+		call amovkr (avg, sbuf[1,iy], nx) 
+		if (nsky > 1)
+		    svar[iy] = max (0., (rdnoise + avg) / (nsky - 1))
+	    case B_MEDIAN:
+		# The background is computed by the median pixel
+	        avg = 0.
+		nsky = 0
+		for (i=0; i < nsample; i=i+1) {
+		    a = max (real (ix1), Memr[as+i] + s) - ix1 + 1
+		    b = min (real (ix2), Memr[bs+i] + s) - ix1 + 1
+		    do j = nint (a), nint (b) {
+			Memr[y+nsky] = Memr[data+j-1]
+			nsky = nsky + 1
+		    }
+	        }
+		if (nsky > 0)
+		    avg = amedr (Memr[y], nsky)
+		call amovkr (avg, sbuf[1,iy], nx) 
+		if (nsky > 1)
+		    svar[iy] = max (0., (rdnoise + avg) / (nsky - 1))
+	    case B_MINIMUM:
+		# The background is computed by the minimum pixel
+	        avg = MAX_REAL
+		nsky = 0
+		for (i=0; i < nsample; i=i+1) {
+		    a = max (real (ix1), Memr[as+i] + s) - ix1 + 1
+		    b = min (real (ix2), Memr[bs+i] + s) - ix1 + 1
+		    do j = nint (a), nint (b) {
+			avg = min (avg, Memr[data+j-1])
+			nsky = nsky + 1
+		    }
+	        }
+		if (nsky == 0)
+		    avg = 0
+		call amovkr (avg, sbuf[1,iy], nx) 
+		if (nsky > 1)
+		    svar[iy] = max (0., (rdnoise + avg) / (nsky - 1))
+	    case B_FIT:
+		# The fitting is done in a coordinate system relative to
+		# aperture center.
+
+		c = center + s
+	        a = ix1 + c - int (c)
+	        do i = 1, nfit-1 {
+	            Memr[x+i-1] = nint (1000. * (a - c)) / 1000.
+		    Memr[y+i-1] = asieval (asi, a-ix1+1)
+		    Memr[w+i-1] = 1.
+		    a = a + 1.
+	        }
+
+	        iferr {
+	            call ic_fit (ic, cv1, Memr[x], Memr[y], Memr[w], nfit-1,
+	                YES, YES, YES, YES)
+
+		    avg = 0.
+	            do i = 1, nx {
+		        a = xs[iy] + i - 1
+			b = ap_cveval (cv1, a - c)
+			avg = avg + b
+			sbuf[i,iy] = b
+	            }
+		    avg = avg / nx
+	        } then {
+		    avg = 0.
+		    call aclrr (sbuf[1,iy], nx)
+		}
+
+		nsky = 0.
+		for (i=0; i < nsample; i=i+1) {
+		    a = max (real (ix1), Memr[as+i] + s) - ix1 + 1
+		    b = min (real (ix2), Memr[bs+i] + s) - ix1 + 1
+		    nsky = nsky + nint (b) - nint (a) + 1
+		}
+		if (nsky > 1)
+		    svar[iy] = max (0., (rdnoise + avg) / (nsky - 1))
+	    }
+	}
+
+	# Do box car smoothing if desired.
+	if (skybox > 1) {
+	    ix2 = skybox ** 2
+	    avg = 0.
+	    a = 0.
+	    iy = 1
+	    for (i=1; i<=skybox; i=i+1) {
+		avg = avg + sbuf[1,i]
+		a = a + svar[i]
+	    }
+	    for (; i<=ny; i=i+1) {
+		b = sbuf[1,iy]
+		c = svar[iy]
+		sbuf[1,iy] = avg / skybox
+		svar[iy] = a / ix2
+		avg = avg + sbuf[1,i] - b
+		a = a + svar[i] - c
+		iy = iy + 1
+	    }
+	    sbuf[1,iy] = avg / skybox
+	    svar[iy] = a / ix2
+	    i = ny - skybox + 1
+	    for (iy=ny; iy > ny-skybox/2; iy=iy-1)
+		svar[iy] = svar[i]
+	    for (; i > 1; i=i-1) {
+		svar[iy] = svar[i]
+		iy = iy - 1
+	    }
+	    for (; iy > 1; iy=iy-1)
+		svar[iy] = svar[1]
+
+	    switch (bkg) {
+	    case B_AVERAGE, B_MEDIAN, B_MINIMUM:
+		i = ny - skybox + 1
+	        for (iy=ny; iy > ny-skybox/2; iy=iy-1)
+		    call amovkr (sbuf[1,i], sbuf[1,iy], nx)
+	        for (; i > 1; i=i-1) {
+		    call amovkr (sbuf[1,i], sbuf[1,iy], nx)
+		    iy = iy - 1
+	        }
+	        for (; iy > 1; iy=iy-1)
+		    call amovkr (sbuf[1,1], sbuf[1,iy], nx)
+	    case B_FIT:
+	        i = ny - skybox + 1
+	        for (iy=ny; iy > ny-skybox/2; iy=iy-1)
+		    sbuf[1,iy] = sbuf[1,i]
+	        for (; i > 1; i=i-1) {
+		    sbuf[1,iy] = sbuf[1,i]
+		    iy = iy - 1
+	        }
+	        for (; iy > 1; iy=iy-1)
+		    sbuf[1,iy] = sbuf[1,1]
+		do ix1 = 2, nx {
+		    avg = 0.
+		    iy = 1
+		    for (i=1; i<=skybox; i=i+1)
+			avg = avg + sbuf[ix1,i]
+		    for (; i<=ny; i=i+1) {
+			b = sbuf[ix1,iy]
+			sbuf[ix1,iy] = avg / skybox
+			avg = avg + sbuf[ix1,i] - b
+			iy = iy + 1
+		    }
+		    sbuf[ix1,iy] = avg / skybox
+		    i = ny - skybox + 1
+		    for (iy=ny; iy > ny-skybox/2; iy=iy-1)
+			sbuf[ix1,iy] = sbuf[ix1,i]
+		    for (; i > 1; i=i-1) {
+			sbuf[ix1,iy] = sbuf[ix1,i]
+			iy = iy - 1
+		    }
+		    for (; iy > 1; iy=iy-1)
+			sbuf[ix1,iy] = sbuf[ix1,1]
+		}
+	    }
+	}
+
+	# Compute the unweighted aperture sky spectrum.
+	i = AP_AXIS(ap)
+	a = AP_CEN(ap,i) + AP_LOW(ap,i)
+	b = AP_CEN(ap,i) + AP_HIGH(ap,i)
+	c = (b - a) / nsubaps
+
+	do iy = 1, ny {
+	    data = dbuf + (iy + ys - 1 - l1) * nc + xs[iy] - c1 - 1
+	    s = ap_cveval (cv, real (iy + ys - 1)) - c1 + 1
+	    do i = 1, nsubaps {
+		xmin = max (0.5, a + (i - 1) * c + s) + c1 - xs[iy]
+		xmax = min (nc + 0.49, a + i * c + s) + c1 - xs[iy]
+		if (xmin >= xmax) {
+		    sky[iy,i] = 0.
+		    next
+		}
+		ix1 = nint (xmin)
+		ix2 = nint (xmax)
+
+		if (ix1 == ix2)
+		    sky[iy,i] = (xmax - xmin) * sbuf[ix1,iy]
+		else {
+		    sky[iy,i] = (ix1 - xmin + 0.5) * sbuf[ix1,iy]
+		    sky[iy,i] = sky[iy,i] + (xmax - ix2 + 0.5) * sbuf[ix2,iy]
+		}
+		do ix = ix1+1, ix2-1
+		    sky[iy,i] = sky[iy,i] + sbuf[ix,iy]
+	    }
+	}
+
+	if (bkg == B_FIT)
+	    call cvfree (cv1)
+	call asifree (asi)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apsort.x b/noao/twodspec/apextract/apsort.x
new file mode 100644
index 00000000..85b21cc5
--- /dev/null
+++ b/noao/twodspec/apextract/apsort.x
@@ -0,0 +1,55 @@
+include	"apertures.h"
+
+# Sort flags:
+define	INC	1	# Sort by aperture position in increasing order
+define	DEC	2	# Sort by position in decreasing order
+
+# AP_SORT -- Sort the apertures.
+
+procedure ap_sort (current, aps, naps, flag)
+
+int	current			# Current aperture
+pointer	aps[ARB]		# Aperture data
+int	naps			# Number of apertures
+int	flag			# Sort flag
+
+int	i, j, apaxis
+pointer	ap
+
+begin
+	if (naps < 1)
+	    return
+
+	switch (flag) {
+	case INC:
+	    apaxis = AP_AXIS (aps[1])
+	    for (i = 1; i <= naps - 1; i = i + 1) {
+	        for (j = i + 1; j <= naps; j = j + 1) {
+		    if (AP_CEN(aps[i], apaxis) > AP_CEN(aps[j], apaxis)) {
+		        ap = aps[i]
+		        aps[i] = aps[j]
+		        aps[j] = ap
+		        if (current == i)
+			    current = j
+		        else if (current == j)
+			    current = i
+		    }
+	        }
+	    }
+	case DEC:
+	    apaxis = AP_AXIS (aps[1])
+	    for (i = 1; i <= naps - 1; i = i + 1) {
+	        for (j = i + 1; j <= naps; j = j + 1) {
+		    if (AP_CEN(aps[i], apaxis) < AP_CEN(aps[j], apaxis)) {
+		        ap = aps[i]
+		        aps[i] = aps[j]
+		        aps[j] = ap
+		        if (current == i)
+			    current = j
+		        else if (current == j)
+			    current = i
+		    }
+	        }
+	    }
+	}
+end
diff --git a/noao/twodspec/apextract/apsum.par b/noao/twodspec/apextract/apsum.par
new file mode 100644
index 00000000..b5b58013
--- /dev/null
+++ b/noao/twodspec/apextract/apsum.par
@@ -0,0 +1,34 @@
+# APSUM
+
+input,s,a,,,,List of input images
+output,s,h,"",,,List of output spectra
+apertures,s,h,"",,,Apertures
+format,s,h,"multispec","onedspec|multispec|echelle|strip",,Extracted spectra format
+references,s,h,"",,,List of aperture reference images
+profiles,s,h,"",,,"List of aperture profile images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,no,,,Recenter apertures?
+resize,b,h,no,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit the traced points interactively?
+extract,b,h,yes,,,Extract apertures?
+extras,b,h,no,,,"Extract sky, sigma, etc.?"
+review,b,h,yes,,,"Review extractions?
+"
+line,i,h,INDEF,1,,Dispersion line
+nsum,i,h,10,,,"Number of dispersion lines to sum or median
+"
+background,s,h,"none",,,Background to subtract (none|average|fit)
+weights,s,h,"none","none|variance",,Extraction weights (none|variance)
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting type (fit1d|fit2d)
+clean,b,h,no,,,Detect and replace bad pixels?
+skybox,i,h,1,1,,Box car smoothing length for sky
+saturation,r,h,INDEF,,,Saturation level
+readnoise,s,h,"0.",,,Read out noise sigma (photons)
+gain,s,h,"1.",,,Photon gain (photons/data number)
+lsigma,r,h,4.,0.,,Lower rejection threshold
+usigma,r,h,4.,0.,,Upper rejection threshold
+nsubaps,i,h,1,1,,Number of subapertures per aperture
diff --git a/noao/twodspec/apextract/aptrace.par b/noao/twodspec/apextract/aptrace.par
new file mode 100644
index 00000000..9134a012
--- /dev/null
+++ b/noao/twodspec/apextract/aptrace.par
@@ -0,0 +1,27 @@
+# APTRACE
+
+input,s,a,,,,List of input images to trace
+apertures,s,h,"",,,Apertures
+references,s,h,"",,,List of reference images
+
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,no,,,Recenter apertures?
+resize,b,h,no,,,Resize apertures?
+edit,b,h,no,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,"Fit the traced points interactively?
+"
+line,i,h,INDEF,1,,Starting dispersion line
+nsum,i,h,10,,,Number of dispersion lines to sum
+step,i,h,10,1,,Tracing step
+nlost,i,h,3,1,,"Number of consecutive times profile is lost before quitting
+"
+function,s,h,"legendre","chebyshev|legendre|spline1|spline3",,Trace fitting function
+order,i,h,2,1,,Trace fitting function order
+sample,s,h,"*",,,Trace sample regions
+naverage,i,h,1,,,Trace average or median
+niterate,i,h,0,0,,Trace rejection iterations
+low_reject,r,h,3.,0.,,Trace lower rejection sigma
+high_reject,r,h,3.,0.,,Trace upper rejection sigma
+grow,r,h,0.,0.,,Trace rejection growing radius
diff --git a/noao/twodspec/apextract/aptrace.x b/noao/twodspec/apextract/aptrace.x
new file mode 100644
index 00000000..c38af01c
--- /dev/null
+++ b/noao/twodspec/apextract/aptrace.x
@@ -0,0 +1,669 @@
+include	<imhdr.h>
+include	<math/curfit.h>
+include	<pkg/center1d.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+define	MAXBUF	100000		# Column buffer size
+
+
+# AP_TRACE -- Trace features in a two dimensional image.
+#
+# Given an image pointer, the starting dispersion position, and a set
+# of apertures defining the centers of features, trace the feature
+# centers to other dispersion positions and fit a curve to the positions.
+# The user specifies the dispersion step size, the number of dispersion
+# lines to sum, and parameters for the feature centering function
+# fitting.
+
+procedure ap_trace (image, line, aps, naps, apedit)
+
+char	image[SZ_FNAME]		# Image name
+int	line			# Starting dispersion position
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+int	apedit			# Called from APEDIT?
+
+int	step			# Tracing step
+int	nsum			# Number of dispersion lines to sum
+int	nlost			# Number of steps lost before quitting
+real	cradius			# Centering radius
+real	cwidth			# Centering width
+real	cthreshold		# Detection threshold for centering
+
+int	i, na, dispaxis, apaxis
+real	center
+pointer	im, ic, ic1, sp, str
+data	ic1 /NULL/
+
+int	apgeti()
+real	apgetr()
+bool	clgetb(), ap_answer()
+pointer	ap_immap()
+
+errchk	ap_immap, ic_open, ap_ltrace, ap_ctrace, ap_default
+
+common	/apt_com/ ic
+
+begin
+	na = 0
+	do i = 1, naps
+	    if (AP_SELECT(aps[i]) == YES)
+		na = na + 1
+	if (naps > 0 && na == 0)
+	    return
+
+	# Query user.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	if (apedit == NO) {
+	    call sprintf (Memc[str], SZ_LINE, "Trace apertures for %s?")
+	        call pargstr (image)
+	    if (!ap_answer ("anstrace", Memc[str])) {
+	        call sfree (sp)
+	        return
+	    }
+
+	    call sprintf (Memc[str], SZ_LINE,
+	        "Fit traced positions for %s interactively?")
+	        call pargstr (image)
+	    if (ap_answer ("ansfittrace", Memc[str])) {
+	        call apgstr ("ansfittrace", Memc[str], SZ_LINE)
+	        call appstr ("ansfittrace1", Memc[str])
+	    } else
+	        call appstr ("ansfittrace1", "NO")
+
+	    if (clgetb ("verbose"))
+	        call printf ("Tracing apertures ...\n")
+	}
+
+	# Tracing parameters
+	step = apgeti ("t_step")
+	nsum = max (1, abs (apgeti ("t_nsum")))
+	nlost = apgeti ("t_nlost")
+	if (ic == NULL || ic1 == NULL) {
+	    call ic_open (ic)
+	    ic1 = ic
+	    call apgstr ("t_function", Memc[str], SZ_LINE)
+	    call ic_pstr (ic, "function", Memc[str])
+	    call ic_puti (ic, "order", apgeti ("t_order"))
+	    call apgstr ("t_sample", Memc[str], SZ_LINE)
+	    call ic_pstr (ic, "sample", Memc[str])
+	    call ic_puti (ic, "naverage", apgeti ("t_naverage"))
+	    call ic_puti (ic, "niterate", apgeti ("t_niterate"))
+	    call ic_putr (ic, "low", apgetr ("t_low_reject"))
+	    call ic_putr (ic, "high", apgetr ("t_high_reject"))
+	    call ic_putr (ic, "grow", apgetr ("t_grow"))
+	}
+
+	im = ap_immap (image, apaxis, dispaxis)
+
+	# If no apertures are defined default to the center of the image.
+	if (naps == 0) {
+	    naps = 1
+	    center = IM_LEN (im, apaxis) / 2.
+	    call ap_default (im, 1, 1, apaxis, center, real (line),
+		aps[naps])
+	    call sprintf (Memc[str], SZ_LINE,
+	       "TRACE - Default aperture defined centered on %s")
+	       call pargstr (image)
+	    call ap_log (Memc[str], YES, NO, YES)
+	}
+
+	# Centering parameters
+	cwidth = apgetr ("t_width")
+	cradius = apgetr ("radius")
+	cthreshold = apgetr ("threshold")
+
+	switch (dispaxis) {
+	case 1:
+	    call ap_ctrace (image, im, ic, line, step, nsum, nlost, cradius,
+		cwidth, cthreshold, aps, naps)
+	case 2:
+	    call ap_ltrace (image, im, ic, line, step, nsum, nlost, cradius,
+		cwidth, cthreshold, aps, naps)
+	}
+
+	# Log the tracing and write the traced apertures to the database.
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "TRACE - %d apertures traced in %s.")
+       	    call pargi (na)
+       	    call pargstr (image)
+	if (apedit == NO)
+	    call ap_log (Memc[str], YES, YES, NO)
+	else
+	    call ap_log (Memc[str], YES, NO, NO)
+
+	call appstr ("ansdbwrite1", "yes")
+
+	call imunmap (im)
+	call sfree (sp)
+end
+
+
+procedure ap_trfree ()
+
+pointer	ic
+common	/apt_com/ ic
+
+begin
+	call ic_closer (ic)
+end
+
+
+# AP_CTRACE -- Trace feature positions for aperture axis 2.
+
+procedure ap_ctrace (image, im, ic, start, step, nsum, nlost, cradius, cwidth,
+    threshold, aps, naps)
+
+char	image[ARB]		# Image to be traced.
+pointer	im			# IMIO pointer
+pointer	ic			# ICFIT pointer
+int	start			# Starting column
+int	step			# Tracing step size
+int	nsum			# Number of lines or columns to sum
+int	nlost			# Number of steps lost before quiting
+real	cradius			# Centering radius
+real	cwidth			# Centering width
+real	threshold		# Detection threshold for centering
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+
+int	nlines, col, col1, col2, line1, line2
+int	i, j, n, nx, ny, ntrace, istart, lost, fd
+real	yc, yc1
+pointer	co, data, sp, str, x, y, wts, gp, gt
+
+real	center1d(), ap_cveval()
+bool	ap_answer()
+pointer comap(), gt_init()
+
+errchk	ap_cveval, xt_csum, xt_csumb, center1d, icg_fit, ic_fit
+errchk	ap_gopen, ap_popen
+
+begin
+	# Set up column access buffering.
+
+	co = comap (im, MAXBUF)
+
+	# Determine the number of lines to be traced and allocate memory.
+
+	nx = IM_LEN(im, 1)
+	ny = IM_LEN(im, 2)
+	if (IS_INDEFI (start))
+	    start = nx / 2
+	nlines = 5 * cwidth
+	istart = (start - 1) / step + 1
+	ntrace = istart + (nx - start) / step
+
+	# Allocate memory for the traced positions and the weights for fitting.
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, ntrace, TY_REAL)
+	call salloc (y, ntrace, TY_REAL)
+	call salloc (wts, ntrace, TY_REAL)
+	call aclrr (Memr[y], ntrace)
+	data = NULL
+
+	# Initialize the ICFIT limits and the GTOOLS parameters.
+	# Set initial interactive flag.
+
+	call ic_putr (ic, "xmin", 1.)
+	call ic_putr (ic, "xmax", real (nx))
+	call ic_pstr (ic, "xlabel", "Column")
+	call ic_pstr (ic, "ylabel", "Line")
+
+	gt = gt_init()
+	call gt_setr (gt, GTXMIN, 1. - step / 2)
+	call gt_setr (gt, GTXMAX, real (nx + step / 2))
+
+	# Trace each feature.
+
+	line1 = 0
+	line2 = 0
+	do j = 1, naps {
+	    if (AP_SELECT(aps[j]) == NO)
+		next
+
+	    # Trace from the starting column to the last column while the
+	    # position is not INDEF.
+
+	    lost = 0
+	    yc = AP_CEN(aps[j], 2) + ap_cveval (AP_CV(aps[j]), real (start))
+	    do i = istart, ntrace {
+		Memr[y+i-1] = INDEF
+		if (lost < nlost) {
+		    # Update the scrolling buffer if the feature center is less
+		    # than cwidth from the edge of the buffer.
+		    if (((yc-line1) < cwidth) || ((line2-yc) < cwidth)) {
+		        line1 = max (1, int (yc + .5 - nlines / 2))
+		        line2 = min (ny, line1 + nlines - 1)
+		        line1 = max (1, line2 - nlines + 1)
+		    }
+
+		    # Sum columns to form the 1D vector for centering.
+
+	            col = start + (i - istart) * step
+		    col1 = max (1, col - nsum / 2)
+		    col2 = min (nx, col1 + nsum - 1)
+		    col1 = max (1, col2 - nsum + 1)
+
+		    # If columns in the sum overlap then use buffering.
+
+		    if (step < nsum)
+		        call xt_csumb (co, col1, col2, line1, line2, data)
+		    else
+		        call xt_csum (co, col1, col2, line1, line2, data)
+
+		    # Center the feature for the new column using the previous
+		    # center as the starting point.  Convert to position
+		    # relative to the start of the data buffer for centering
+		    # and then convert back to position relative to the
+		    # edge of the image.
+
+		    yc1 = center1d (yc-line1+1, Memr[data], line2-line1+1,
+			cwidth, EMISSION, cradius, threshold)
+
+		    if (!IS_INDEF (yc1)) {
+			lost = 0
+		        yc = yc1 + line1 - 1
+			Memr[y+i-1] = yc
+			if (IS_INDEF (Memr[y+i-2])) {
+	    		    call sprintf (Memc[str], SZ_LINE,
+		   "TRACE - Trace of aperture %d in %s recovered at column %d.")
+			        call pargi (AP_ID(aps[j]))
+			        call pargstr (image)
+			        call pargi (col)
+			    call ap_log (Memc[str], YES, NO, YES)
+			}
+		    } else {
+			lost = lost + 1
+	    		call sprintf (Memc[str], SZ_LINE,
+		    "TRACE - Trace of aperture %d in %s lost at column %d.")
+			    call pargi (AP_ID(aps[j]))
+			    call pargstr (image)
+			    call pargi (col)
+			call ap_log (Memc[str], YES, NO, YES)
+		    }
+		}
+	    }
+
+	    # Trace from the starting column to the first column while the
+	    # position is not INDEF.
+
+	    lost = 0
+	    yc = AP_CEN(aps[j], 2) + ap_cveval (AP_CV(aps[j]), real (start))
+	    do i = istart - 1, 1, -1 {
+		Memr[y+i-1] = INDEF
+		if (lost < nlost) {
+		    # Update the scrolling buffer if the feature center is less
+		    # than cwidth from the edge of the buffer.
+
+		    if (((yc-line1) < cwidth) || ((line2-yc) < cwidth)) {
+		        line1 = max (1, int (yc + .5 - nlines / 2))
+		        line2 = min (ny, line1 + nlines - 1)
+		        line1 = max (1, line2 - nlines + 1)
+		    }
+
+		    # Sum columns to form the 1D vector for centering.
+
+	            col = start + (i - istart) * step
+		    col1 = max (1, col - nsum / 2)
+		    col2 = min (nx, col1 + nsum - 1)
+		    col1 = max (1, col2 - nsum + 1)
+
+		    # If columns in the sum overlap then use buffering.
+
+		    if (step < nsum)
+		        call xt_csumb (co, col1, col2, line1, line2, data)
+		    else
+		        call xt_csum (co, col1, col2, line1, line2, data)
+
+		    # Center the feature for the new column using the previous
+		    # center as the starting point.  Convert to position
+		    # relative to the start of the data buffer for centering
+		    # and then convert back to position relative to the
+		    # edge of the image.
+
+		    yc1 = center1d (yc-line1+1, Memr[data], line2-line1+1,
+			cwidth, EMISSION, cradius, threshold)
+
+		    if (!IS_INDEF (yc1)) {
+			lost = 0
+		        yc = yc1 + line1 - 1
+			Memr[y+i-1] = yc
+			if (IS_INDEF (Memr[y+i])) {
+	    		    call sprintf (Memc[str], SZ_LINE,
+		   "TRACE - Trace of aperture %d in %s recovered at column %d.")
+			        call pargi (AP_ID(aps[j]))
+			        call pargstr (image)
+			        call pargi ((i - 1) * step + 1)
+			    call ap_log (Memc[str], YES, NO, YES)
+			}
+		    } else {
+			lost = lost + 1
+	    		call sprintf (Memc[str], SZ_LINE,
+		    "TRACE - Trace of aperture %d in %s lost at column %d.")
+			    call pargi (AP_ID(aps[j]))
+			    call pargstr (image)
+			    call pargi ((i - 1) * step + 1)
+			call ap_log (Memc[str], YES, NO, YES)
+		    }
+		}
+	    }
+
+	    # Order the traced points and exclude INDEF positions.
+
+	    n = 0
+	    do i = 1, ntrace {
+		if (IS_INDEF (Memr[y+i-1]))
+		    next
+		n = n + 1
+		Memr[x+n-1] = start + (i - istart) * step
+		Memr[y+n-1] = Memr[y+i-1]
+		Memr[wts+n-1] = 1.
+	    }
+
+	    # If all positions are INDEF print a message and go on to the next
+	    # aperture.
+
+	    if (n < 2) {
+		call eprintf (
+		    "Not enough points traced for aperture %d of %s\n")
+		    call pargi (AP_ID(aps[j]))
+		    call pargstr (image)
+		next
+	    }
+		    
+	    # Fit a curve to the traced positions and graph the result.
+
+	    call sprintf (Memc[str], SZ_LINE, "Aperture %d of %s")
+	        call pargi (AP_ID(aps[j]))
+		call pargstr (image)
+	    call gt_sets (gt, GTTITLE, Memc[str])
+
+	    call sprintf (Memc[str], SZ_LINE,
+		"Fit curve to aperture %d of %s interactively")
+		call pargi (AP_ID(aps[j]))
+		call pargstr (image)
+	    if (ap_answer ("ansfittrace1", Memc[str])) {
+		call ap_gopen (gp)
+	        call icg_fit (ic, gp, "gcur", gt,
+		    AP_CV(aps[j]), Memr[x], Memr[y], Memr[wts], n)
+	    } else
+	        call ic_fit (ic, AP_CV(aps[j]), Memr[x], Memr[y], Memr[wts], n,
+		    YES, YES, YES, YES)
+
+	    call ap_popen (gp, fd, "trace")
+	    if (gp != NULL) {
+		call icg_graphr (ic, gp, gt, AP_CV(aps[j]),
+		    Memr[x], Memr[y], Memr[wts], n)
+		call ap_pclose (gp, fd)
+	    }
+
+	    call asubkr (Memr[y], AP_CEN(aps[j], 2), Memr[y], n)
+	    call ic_fit (ic, AP_CV(aps[j]), Memr[x], Memr[y], Memr[wts], n,
+		YES, YES, YES, YES)
+	}
+
+	# Free allocated memory.
+
+	call gt_free (gt)
+	call mfree (data, TY_REAL)
+	call counmap (co)
+	call sfree (sp)
+end
+
+
+# AP_LTRACE -- Trace feature positions for aperture axis 1.
+
+procedure ap_ltrace (image, im, ic, start, step, nsum, nlost, cradius, cwidth,
+    threshold, aps, naps)
+
+char	image[ARB]		# Image to be traced
+pointer	im			# IMIO pointer
+pointer	ic			# ICFIT pointer
+int	start			# Starting line
+int	step			# Tracing step size
+int	nsum			# Number of lines or columns to sum
+int	nlost			# Number of steps lost before quiting
+real	cradius			# Centering radius
+real	cwidth			# Centering width
+real	threshold		# Detection threshold for centering
+pointer	aps[ARB]		# Apertures
+int	naps			# Number of apertures
+
+real	xc1
+int	i, j, n, nx, ny, ntrace, istart, line, line1, line2, fd
+pointer	data, sp, str, x, y, wts, xc, lost, x1, x2, gp, gt
+
+real	center1d(), ap_cveval()
+bool	ap_answer()
+pointer	gt_init()
+
+errchk	ap_cveval, xt_lsum, xt_lsumb, center1d, icg_fit, ic_fit
+errchk	ap_gopen, ap_popen
+
+begin
+	# Determine the number of lines to be traced and allocate memory.
+
+	nx = IM_LEN(im, 1)
+	ny = IM_LEN(im, 2)
+	if (IS_INDEFI (start))
+	    start = ny / 2
+
+	istart = (start - 1) / step + 1
+	ntrace = istart + (ny - start) / step
+
+	# Allocate memory for the traced positions and the weights for fitting.
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, ntrace * naps, TY_REAL)
+	call salloc (y, ntrace, TY_REAL)
+	call salloc (wts, ntrace, TY_REAL)
+	call salloc (xc, naps, TY_REAL)
+	call salloc (lost, naps, TY_INT)
+	call aclrr ( Memr[x], ntrace * naps)
+	data = NULL
+
+	# Set the dispersion lines to be traced.
+
+	do i = 1, ntrace
+	    Memr[y+i-1] = start + (i - istart) * step
+
+	# Trace from the starting line to the last line.
+
+	x1 = x + istart - 1
+	do i = 1, naps {
+	    if (AP_SELECT(aps[i]) == NO)
+		next
+	    Memr[xc+i-1] = AP_CEN(aps[i], 1) +
+		ap_cveval (AP_CV(aps[i]), real (start))
+	    Memi[lost+i-1] =  0
+	}
+
+	do i = istart, ntrace {
+	    line = Memr[y+i-1]
+	    line1 = max (1, line - nsum / 2)
+	    line2 = min (ny, line1 + nsum - 1)
+	    line1 = max (1, line2 - nsum + 1)
+
+	    # If the sums overlap use buffering.
+
+	    if (step < nsum)
+	        call xt_lsumb (im, 1, nx, line1, line2, data)
+	    else
+	        call xt_lsum (im, 1, nx, line1, line2, data)
+
+	    do j = 1, naps {
+		if (AP_SELECT(aps[j]) == NO)
+		    next
+		x2 = x1 + (j - 1) * ntrace
+		Memr[x2] = INDEF
+		if (Memi[lost+j-1] < nlost) {
+		    xc1 = center1d (Memr[xc+j-1], Memr[data], nx,
+			cwidth, EMISSION, cradius, threshold)
+		    if (IS_INDEF(xc1)) {
+			Memi[lost+j-1] = Memi[lost+j-1] + 1
+			call sprintf (Memc[str], SZ_LINE,
+			"TRACE - Trace of aperture %d in %s lost at line %d.")
+			    call pargi (AP_ID(aps[j]))
+			    call pargstr (image)
+			    call pargi (line)
+			call ap_log (Memc[str], YES, NO, YES)
+		    } else {
+			Memi[lost+j-1] = 0
+			Memr[xc+j-1] = xc1
+			Memr[x2] = xc1
+			if (IS_INDEF (Memr[x2-1])) {
+			    call sprintf (Memc[str], SZ_LINE,
+		    "TRACE - Trace of aperture %d in %s recovered at line %d.")
+				call pargi (AP_ID(aps[j]))
+				call pargstr (image)
+				call pargi (line)
+			    call ap_log (Memc[str], YES, NO, YES)
+			}
+		    }
+		}
+	    }
+	    x1 = x1 + 1
+	}
+
+	# Trace from the starting line to the first line.
+
+	x1 = x + istart - 2
+	do i = 1, naps {
+	    if (AP_SELECT(aps[i]) == NO)
+		next
+	    Memr[xc+i-1] = AP_CEN(aps[i], 1) +
+		ap_cveval (AP_CV(aps[i]), real (start))
+	    Memi[lost+i-1] = 0
+	}
+
+	do i = istart - 1, 1, -1 {
+	    line = Memr[y+i-1]
+	    line1 = max (1, line - nsum / 2)
+	    line2 = min (ny, line1 + nsum - 1)
+	    line1 = max (1, line2 - nsum + 1)
+
+	    # If the sums overlap use buffering.
+
+	    if (step < nsum)
+	        call xt_lsumb (im, 1, nx, line1, line2, data)
+	    else
+	        call xt_lsum (im, 1, nx, line1, line2, data)
+
+	    do j = 1, naps {
+		if (AP_SELECT(aps[j]) == NO)
+		    next
+		x2 = x1 + (j - 1) * ntrace
+		Memr[x2] = INDEF
+		if (Memi[lost+j-1] < nlost) {
+		    xc1 = center1d (Memr[xc+j-1], Memr[data], nx,
+			cwidth, EMISSION, cradius, threshold)
+		    if (IS_INDEF(xc1)) {
+			Memi[lost+j-1] = Memi[lost+j-1] + 1
+			call sprintf (Memc[str], SZ_LINE,
+			    "TRACE - Trace of aperture %d in %s lost at line %d.")
+			    call pargi (AP_ID(aps[j]))
+			    call pargstr (image)
+			    call pargi (line)
+			call ap_log (Memc[str], YES, NO, YES)
+		    } else {
+			Memi[lost+j-1] = 0
+			Memr[xc+j-1] = xc1
+			Memr[x2] = xc1
+			if (IS_INDEF (Memr[x2+1])) {
+			    call sprintf (Memc[str], SZ_LINE,
+		    "TRACE - Trace of aperture %d in %s recovered at line %d.")
+				call pargi (AP_ID(aps[j]))
+				call pargstr (image)
+				call pargi (line)
+			    call ap_log (Memc[str], YES, NO, YES)
+			}
+		    }
+		}
+	    }
+	    x1 = x1 - 1
+	}
+
+	# Initialize the the GTOOLS parameters.
+	call ic_putr (ic, "xmin", 1.)
+	call ic_putr (ic, "xmax", real (ny))
+	call ic_pstr (ic, "xlabel", "Line")
+	call ic_pstr (ic, "ylabel", "Column")
+
+	gt = gt_init()
+	call gt_setr (gt, GTXMIN, 1. - step / 2)
+	call gt_setr (gt, GTXMAX, real (ny + step / 2))
+
+	do j = 1, naps {
+	    if (AP_SELECT(aps[j]) == NO)
+		next
+
+	    # Order the traced points and exclude INDEF positions.
+
+	    x1 = x + (j - 1) * ntrace
+	    n = 0
+
+	    do i = 1, ntrace {
+		if (IS_INDEF (Memr[x1+i-1]))
+		    next
+		n = n + 1
+		Memr[x1+n-1] = Memr[x1+i-1]
+		Memr[y+n-1] = start + (i - istart) * step
+		Memr[wts+n-1] = 1.
+	    }
+
+	    # If all positions are INDEF print a message and go on to the next
+	    # aperture.
+
+	    if (n < 2) {
+		call eprintf (
+		    "Not enough points traced for aperture %d of %s\n")
+		    call pargi (AP_ID(aps[j]))
+		    call pargstr (image)
+		next
+	    }
+
+	    # Fit a curve to the traced positions and graph the result.
+
+	    call sprintf (Memc[str], SZ_LINE, "Aperture %d of %s")
+	        call pargi (AP_ID(aps[j]))
+		call pargstr (image)
+	    call gt_sets (gt, GTTITLE, Memc[str])
+
+	    call sprintf (Memc[str], SZ_LINE,
+		"Fit curve to aperture %d of %s interactively")
+		call pargi (AP_ID(aps[j]))
+		call pargstr (image)
+	    if (ap_answer ("ansfittrace1", Memc[str])) {
+		call ap_gopen (gp)
+	        call icg_fit (ic, gp, "gcur", gt,
+		    AP_CV(aps[j]), Memr[y], Memr[x1], Memr[wts], n)
+	    } else
+	        call ic_fit (ic, AP_CV(aps[j]), Memr[y], Memr[x1], Memr[wts], n,
+		    YES, YES, YES, YES)
+
+	    call ap_popen (gp, fd, "trace")
+	    if (gp != NULL) {
+		call icg_graphr (ic, gp, gt, AP_CV(aps[j]),
+		    Memr[y], Memr[x1], Memr[wts], n)
+		call ap_pclose (gp, fd)
+	    }
+
+	    # Subtract the aperture center and refit offset curve.
+	    call asubkr (Memr[x1], AP_CEN(aps[j], 1), Memr[x1], n)
+	    call ic_fit (ic, AP_CV(aps[j]), Memr[y], Memr[x1], Memr[wts], n,
+		YES, YES, YES, YES)
+	}
+
+	# Free allocated memory.
+
+	call gt_free (gt)
+	call mfree (data, TY_REAL)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apupdate.x b/noao/twodspec/apextract/apupdate.x
new file mode 100644
index 00000000..d3344b5f
--- /dev/null
+++ b/noao/twodspec/apextract/apupdate.x
@@ -0,0 +1,44 @@
+include <gset.h>
+include	"apertures.h"
+
+# AP_UPDATE -- Update an aperture.
+
+procedure ap_update (gp, ap, line, apid, apbeam, center, low, high)
+
+pointer	gp		# GIO pointer
+pointer	ap		# Aperture pointer
+int	line		# Dispersion line
+int	apid		# New aperture ID
+int	apbeam		# New aperture beam
+real	center		# New center at dispersion line
+real	low		# New lower limit
+real	high		# New upper limit
+
+real	ap_cveval(), ic_getr()
+
+begin
+	# Check for bad values.
+	if (IS_INDEFR(center) || IS_INDEFR(low) || IS_INDEFR(high))
+	    call error (1, "INDEF not allowed")
+
+	# Erase the current aperture.
+	call gseti (gp, G_PLTYPE, 0)
+	call ap_gmark (gp, line, ap, 1)
+
+	# Update the aperture.
+	AP_ID(ap) = apid
+	AP_BEAM(ap) = apbeam
+	AP_CEN(ap, AP_AXIS(ap)) = center - ap_cveval (AP_CV(ap), real (line))
+        AP_LOW(ap, AP_AXIS(ap)) = min (low, high)
+        AP_HIGH(ap, AP_AXIS(ap)) = max (low, high)
+	if (AP_IC(ap) != NULL) {
+	    call ic_putr (AP_IC(ap), "xmin",
+		min (low, high, ic_getr (AP_IC(ap), "xmin")))
+	    call ic_putr (AP_IC(ap), "xmax",
+		max (low, high, ic_getr (AP_IC(ap), "xmax")))
+	}
+
+	# Mark the new aperture.
+	call gseti (gp, G_PLTYPE, 1)
+	call ap_gmark (gp, line, ap, 1)
+end
diff --git a/noao/twodspec/apextract/apvalues.x b/noao/twodspec/apextract/apvalues.x
new file mode 100644
index 00000000..2072907e
--- /dev/null
+++ b/noao/twodspec/apextract/apvalues.x
@@ -0,0 +1,32 @@
+include	"apertures.h"
+
+# AP_VALUES -- Return the values for an aperture
+
+procedure ap_values (current, aps, line, apid, apbeam, center, low, high)
+
+int	current			# Index to current aperture
+pointer	aps[ARB]		# Apertures
+int	line			# Line
+int	apid			# Aperture ID
+int	apbeam			# Aperture beam
+real	center			# Aperture center
+real	low			# Lower limit of aperture
+real	high			# Upper limit of aperture
+
+int	apaxis
+pointer	ap
+
+real	ap_cveval()
+
+begin
+	if (current > 0) {
+	    ap = aps[current]
+	    apaxis = AP_AXIS(ap)
+
+	    apid = AP_ID(ap)
+	    apbeam = AP_BEAM(ap)
+	    center = AP_CEN(ap, apaxis) + ap_cveval (AP_CV(ap), real (line))
+	    low = AP_LOW(ap, apaxis)
+	    high = AP_HIGH(ap, apaxis)
+	}
+end
diff --git a/noao/twodspec/apextract/apvariance.x b/noao/twodspec/apextract/apvariance.x
new file mode 100644
index 00000000..015eed74
--- /dev/null
+++ b/noao/twodspec/apextract/apvariance.x
@@ -0,0 +1,420 @@
+include	<gset.h>
+include	"apertures.h"
+
+
+# AP_VARIANCE -- Variance weighted extraction based on profile and CCD noise.
+# If desired reject deviant pixels.  In addition to the variance weighted
+# spectrum, the unweighted and uncleaned "raw" spectrum is extracted and
+# a sigma spectrum is returned.  Wavelengths with saturated pixels are
+# flagged with 0 value and negative sigma if cleaning.
+
+procedure ap_variance (im, ap, dbuf, nc, nl, c1, l1, sbuf, svar, profile,
+	nx, ny, xs, ys, spec, raw, specsig, nsubaps, asi)
+
+pointer	im			# IMIO pointer
+pointer	ap			# Aperture structure
+pointer	dbuf			# Data buffer
+int	nc, nl			# Size of data buffer
+int	c1, l1			# Origin of data buffer
+pointer	sbuf			# Sky values (NULL if none)
+pointer	svar			# Sky variance
+real	profile[ny,nx]		# Profile (returned)
+int	nx, ny			# Size of profile array
+int	xs[ny], ys		# Origin of profile array
+real	spec[ny,nsubaps]	# Spectrum
+real	raw[ny,nsubaps]		# Raw spectrum
+real	specsig[ny,nsubaps]	# Sky variance in, spectrum sigma out
+int	nsubaps			# Number of subapertures
+pointer	asi			# Image interpolator for edge pixel weighting
+
+real	rdnoise			# Readout noise in RMS data numbers.
+real	gain			# Gain in photons per data number.
+real	saturation		# Maximum value for an unsaturated pixel.
+bool	clean			# Clean cosmic rays?
+real	nclean			# Number of pixels to clean
+real	lsigma, usigma		# Rejection sigmas.
+
+bool	sat
+int	fd, iterate, niterate, nrej, irej, nreject
+int	i, ix, iy, ix1, ix2
+real	low, high, step, shift, x1, x2, wt1, wt2, s, w, dat, sk, var, var0
+real	sum, wsum, wvsum, sum1, sum2, total1, total2
+real	vmin, resid, rrej
+pointer	cv, gp
+pointer	sp, str, work, wt, xplot, yplot, eplot, fplot, data, sky, data1
+
+real	apgetr(), apgimr(), ap_cveval()
+bool	apgetb()
+errchk	apgimr, ap_asifit
+
+begin
+	# Get task parameters.
+	gain = apgimr ("gain", im)
+	rdnoise = apgimr ("readnoise", im) ** 2
+	saturation = apgetr ("saturation")
+	if (!IS_INDEF(saturation))
+	    saturation = saturation * gain
+	clean = apgetb ("clean")
+	lsigma = apgetr ("lsigma")
+	usigma = apgetr ("usigma")
+	call ap_popen (gp, fd, "clean")
+
+	# Allocate memory and one index.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (work, 6*nx, TY_REAL)
+	wt = work - 1
+	xplot = wt + nx
+	yplot = xplot + nx
+	eplot = yplot + nx
+	fplot = eplot + nx
+	data1 = fplot + nx
+	if (sbuf == NULL) {
+	    call salloc (sky, nx, TY_REAL)
+	    call aclrr (Memr[sky], nx)
+	    sky = sky - 1
+	    var0 = rdnoise
+	}
+
+	# Initialize
+	if (rdnoise == 0.)
+	    vmin = 1.
+	else
+	    vmin = rdnoise
+	if (clean) {
+	    nclean = apgetr ("nclean")
+	    if (nclean < 1.)
+	        niterate = max (1., nclean * nx)
+	    else
+		niterate = max (1., min (real (nx), nclean))
+	} else
+	    niterate = 0
+
+	call aclrr (spec, ny * nsubaps)
+	call aclrr (raw, ny * nsubaps)
+	call amovkr (-1., specsig, ny * nsubaps)
+
+	i = AP_AXIS(ap)
+	low = AP_CEN(ap,i) + AP_LOW(ap,i)
+	high = AP_CEN(ap,i) + AP_HIGH(ap,i)
+	step = (high - low) / nsubaps
+	cv = AP_CV(ap)
+
+	# For each line compute the weighted spectrum and then iterate
+	# to reject deviant pixels.  Rejected pixels are flagged by negative
+	# variance.
+
+	nreject = 0
+	total1 = 0.
+	total2 = 0.
+	do iy = 1, ny {
+	    shift = ap_cveval (cv, real (iy + ys - 1)) - c1 + 1
+	    x1 = max (0.5, low + shift) + c1 - xs[iy]
+	    x2 = min (nc + 0.49, high + shift) + c1 - xs[iy]
+	    if (x1 >= x2)
+		next
+	    ix1 = nint (x1)
+	    ix2 = nint (x2)
+
+	    call ap_asifit (dbuf+(iy+ys-1-l1)*nc, nc, xs[iy]-c1+1,
+		low+shift, high+shift, data, asi)
+#	    data = dbuf + (iy + ys - 1 - l1) * nc + xs[iy] - c1 - 1
+	    if (sbuf != NULL) {
+		sky = sbuf + (iy - 1) * nx - 1
+		var0 = rdnoise + Memr[svar+iy-1]
+	    }
+
+	    # Set pixel weights for summing.
+#	    if (asi != NULL)
+#		call asifit (asi, Memr[data], nc-xs[iy]+c1)
+	    call ap_edge (asi, x1+1, x2+1, wt1, wt2)
+
+	    # First estimate spectrum by summing across the aperture.
+	    # Accumulate the raw spectrum and set up various arrays for
+	    # plotting and later access.
+
+	    sat = false
+	    sum = 0.
+	    wsum = 0.
+	    wvsum = 0.
+	    do ix = ix1, ix2 {
+		if (ix1 == ix2)
+		    w = wt1
+		else if (ix == ix1)
+		    w = wt1
+		else if (ix == ix2)
+		    w = wt2
+		else
+		    w = 1.
+		dat = Memr[data+ix]
+		if (!IS_INDEF(saturation))
+		    if (dat > saturation)
+			sat = true
+		sk = Memr[sky+ix]
+		raw[iy,1] = raw[iy,1] + w * (dat - sk)
+
+	        Memr[xplot+ix] = ix + xs[iy] - 1
+	        Memr[yplot+ix] = dat - sk
+		Memr[data1+ix] = dat - sk
+		Memr[wt+ix] = w
+		var = max (vmin, var0 + max (0., dat))
+		w = profile[iy,ix] / var
+		var = sqrt (var)
+		Memr[eplot+ix] = var
+		sum = sum + w * (dat - sk)
+		wsum = wsum + w * profile[iy,ix]
+		wvsum = wvsum + (w * var) ** 2
+	    }
+	    if (wsum > 0.) {
+	        spec[iy,1] = sum / wsum
+	        specsig[iy,1] = sqrt (wvsum) / abs (wsum)
+	    } else {
+	        spec[iy,1] = 0.
+	        specsig[iy,1] = -1.
+	    }
+
+	    sum = 0.
+	    wsum = 0.
+	    wvsum = 0.
+	    sum1 = 0.
+	    sum2 = 0.
+	    do ix = ix1, ix2 {
+		sum1 = sum1 + Memr[wt+ix] * Memr[data1+ix]
+		if (Memr[eplot+ix] <= 0.)
+		    next
+		sk = Memr[sky+ix]
+	        s = max (0., spec[iy,1]) * profile[iy,ix]
+	        var = max (vmin, var0 + (s + sk))
+	        w = profile[iy,ix] / var
+		var = sqrt (var)
+	        Memr[eplot+ix] = var
+	        Memr[fplot+ix] = s
+	        sum = sum + w * Memr[data1+ix]
+	        wsum = wsum + w * profile[iy,ix]
+	        wvsum = wvsum + (w * var) ** 2
+	    }
+	    if (wsum > 0.) {
+	        spec[iy,1] = sum / wsum
+	        specsig[iy,1] = sqrt (wvsum) / abs (wsum)
+		sum2 = sum2 + spec[iy,1]
+	    } else {
+	         spec[iy,1] = 0.
+	         specsig[iy,1] = -1.
+		 sum1 = 0.
+		 sum2 = 0.
+	    }
+
+	    # Reject cosmic rays one at a time.
+	    nrej = 0
+	    do iterate = 1, niterate {
+	        irej = 0
+	        rrej = 0.
+
+		# Compute revised variance estimate using profile model 
+		# skip rejected pixels, find worst pixel.
+
+	        do ix = ix1, ix2 {
+	            if (Memr[eplot+ix] <= 0.)
+			next
+	            s = max (0., spec[iy,1]) * profile[iy,ix]
+		    sk = Memr[sky+ix]
+	            var = sqrt (max (vmin, var0 + max (0., s + sk)))
+	            Memr[fplot+ix] = s
+	            Memr[eplot+ix] = var
+
+		    resid = (Memr[data1+ix] - Memr[fplot+ix]) / var
+		    if (abs (resid) > abs (rrej)) {
+			rrej = resid
+			irej = ix
+	            }
+	        }
+
+		# Reject worst outlier.
+
+	        if (rrej <= -lsigma || rrej >= usigma) {
+	            Memr[eplot+irej] = -Memr[eplot+irej]
+		    Memr[data1+irej] = Memr[fplot+irej]
+	            nrej = nrej + 1
+	        } else
+		    break
+
+		# Update spectrum estimate excluding rejected pixels.
+	        sum = 0.
+	        wsum = 0.
+	        wvsum = 0.
+		sum1 = 0.
+		sum2 = 0.
+	        do ix = ix1, ix2 {
+		    sum1 = sum1 + Memr[wt+ix] * Memr[data1+ix]
+	            if (Memr[eplot+ix] <= 0.)
+			next
+	            w = profile[iy,ix] / Memr[eplot+ix]**2
+	            sum = sum + w * Memr[data1+ix]
+	            wsum = wsum + w * profile[iy,ix]
+	            wvsum = wvsum + (w * Memr[eplot+ix]) ** 2
+	        }
+
+	        if (wsum > 0.) {
+	            spec[iy,1] = sum / wsum
+	            specsig[iy,1] = sqrt (wvsum) / abs (wsum)
+		    sum2 = sum2 + spec[iy,1]
+	        } else {
+	            spec[iy,1] = 0.
+	            specsig[iy,1] = -1.
+		    sum1 = 0.
+		    sum2 = 0.
+	        }
+	    }
+
+	    nreject = nreject + nrej
+	    total1 = total1 + sum1
+	    total2 = total2 + sum2
+
+	    # Calculate subapertures if desired.
+	    if (nsubaps > 1) {
+		do i = 1, nsubaps {
+		    x1 = max (0.5, low + (i - 1) * step + shift) + c1 - xs[iy]
+		    x2 = min (nc + 0.49, low + i * step + shift) + c1 - xs[iy]
+		    if (x1 >= x2) {
+			spec[iy,i] = 0.
+			raw[iy,i] = 0.
+			specsig[iy,i] = -1.
+			next
+		    }
+		    ix1 = nint (x1)
+		    ix2 = nint (x2)
+		    call ap_edge (asi, x1+1, x2+1, wt1, wt2)
+
+	            sum = 0.
+	            wvsum = 0.
+		    raw[iy,i] = 0.
+	            do ix = ix1, ix2 {
+			if (ix1 == ix2)
+			    w = wt1
+			else if (ix == ix1)
+			    w = wt1
+			else if (ix == ix2)
+			    w = wt2
+			else
+			    w = 1.
+			raw[iy,i] = raw[iy,i] + w * Memr[yplot+ix]
+	                if (Memr[eplot+ix] <= 0.)
+			    next
+	                w = profile[iy,ix] / Memr[eplot+ix]**2
+	                sum = sum + w * Memr[data1+ix]
+	                wvsum = wvsum + (w * Memr[eplot+ix]) ** 2
+	            }
+
+	            if (wsum > 0.) {
+	                spec[iy,i] = sum / wsum
+	                specsig[iy,i] = sqrt (wvsum) / abs (wsum)
+	            } else {
+	                spec[iy,i] = 0.
+	                specsig[iy,i] = -1.
+	            }
+		}
+	    }
+
+	    # Flag points with saturated pixels.
+	    if (sat)
+	        do i = 1, nsubaps
+		    specsig[iy,i] = -specsig[iy,i]
+
+	    # Plot profile with cosmic rays if desired.
+	    if (gp != NULL && nrej > 0 && spec[iy,1] > 0.) {
+		call sprintf (Memc[str], SZ_LINE, "Profile %4d")
+		    call pargi (iy)
+		s = Memr[yplot+ix1] - abs (Memr[eplot+ix1])
+		w = Memr[yplot+ix1] + abs (Memr[eplot+ix1])
+		do ix = ix1+1, ix2 {
+		    s = min (s, Memr[yplot+ix] - abs (Memr[eplot+ix]))
+		    w = max (w, Memr[yplot+ix] + abs (Memr[eplot+ix]))
+		}
+		sum = w - s
+		x1 = ix1 + xs[iy] - 2
+		x2 = ix2 + xs[iy]
+		s = s - 0.1 * sum
+		w = w + 0.1 * sum
+		call gclear (gp)
+		call gswind (gp, x1, x2, s, w)
+		call glabax (gp, Memc[str], "", "")
+
+	        do ix = ix1, ix2 {
+	            if (Memr[eplot+ix] > 0.) {
+			call gmark (gp, Memr[xplot+ix], Memr[yplot+ix],
+			    GM_PLUS, 2., 2.)
+			call gmark (gp, Memr[xplot+ix], Memr[yplot+ix],
+			    GM_VEBAR, 2., -6.*Memr[eplot+ix])
+	            } else {
+			call gmark (gp, Memr[xplot+ix], Memr[yplot+ix],
+			    GM_CROSS, 2., 2.)
+			call gmark (gp, Memr[xplot+ix], Memr[yplot+ix],
+			    GM_VEBAR, 1., 6.*Memr[eplot+ix])
+	            }
+	        }
+		call gpline (gp, Memr[xplot+ix1], Memr[fplot+ix1], ix2-ix1+1)
+	    }
+	}
+
+	# To avoid any bias, scale weighted extraction to same total flux
+	# as raw spectrum (with rejected pixels replaced by fit).
+
+	if (total1 * total2 <= 0.) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"EXTRACT: WARNING - Aperture %d:")
+		call pargi (AP_ID(ap))
+	    call ap_log (Memc[str], YES, NO, YES)
+	    call sprintf (Memc[str], SZ_LINE,
+		"   Total variance weighted spectrum flux is %g")
+		call pargr (total2)
+	    call ap_log (Memc[str], YES, NO, YES)
+	    call sprintf (Memc[str], SZ_LINE,
+		"   Total unweighted spectrum flux is %g")
+		call pargr (total1)
+	    call ap_log (Memc[str], YES, NO, YES)
+	    call sprintf (Memc[str], SZ_LINE,
+		"   Variance spectrum bias factor ignored")
+	    call ap_log (Memc[str], YES, NO, YES)
+	} else {
+	    sum = total1 / total2
+	    call amulkr (spec, sum, spec, ny * nsubaps)
+	    call amulkr (specsig, sum, specsig, ny * nsubaps)
+	    if (sum < .5 || sum > 2) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT: WARNING - Aperture %d:")
+		    call pargi (AP_ID(ap))
+		call ap_log (Memc[str], YES, NO, YES)
+		call sprintf (Memc[str], SZ_LINE,
+		    "   Total variance weighted spectrum flux is %g")
+		    call pargr (total2)
+		call ap_log (Memc[str], YES, NO, YES)
+		call sprintf (Memc[str], SZ_LINE,
+		    "   Total unweighted spectrum flux is %g")
+		    call pargr (total1)
+		call ap_log (Memc[str], YES, NO, YES)
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT: Aperture %d variance spectrum bias factor is %g")
+		    call pargi (AP_ID(ap))
+		    call pargr (total1 / total2)
+		call ap_log (Memc[str], YES, NO, YES)
+	    } else {
+		call sprintf (Memc[str], SZ_LINE,
+		    "EXTRACT: Aperture %d variance spectrum bias factor is %g")
+		    call pargi (AP_ID(ap))
+		    call pargr (total1 / total2)
+		call ap_log (Memc[str], YES, NO, NO)
+	    }
+	}
+
+	# Log the number of rejected pixels.
+	if (clean) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"EXTRACT: %d pixels rejected from aperture %d")
+		call pargi (nreject)
+		call pargi (AP_ID(ap))
+	    call ap_log (Memc[str], YES, NO, NO)
+	}
+
+	call ap_pclose (gp, fd)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/apwidth.cl b/noao/twodspec/apextract/apwidth.cl
new file mode 100644
index 00000000..94a247d7
--- /dev/null
+++ b/noao/twodspec/apextract/apwidth.cl
@@ -0,0 +1,59 @@
+# APWIDTH -- Script to report widths from APALL database files.
+# The input is the image name and database directory.
+# The output is image name, aperture number, x center, y center, and width.
+#
+# To install this script copy it to a directory, such as your IRAF login
+# directory "home$" in this example.  Define the task in your loginuser.cl
+# or login.cl with
+#
+#    task apwidth = home$apwidth.cl
+#
+# Note that you can substitute some other path to the script if desired.
+
+procedure apwidth (image)
+
+file	image			{prompt="Image name"}
+file	database = "database"	{prompt="Database"}
+
+begin
+	file	dbfile
+	string	im
+	int	ap, axis
+	real	xc, yc, aplow1, aphigh1, aplow2, aphigh2, width
+
+	# Form database name from the database and image names.
+	dbfile = database // "/ap" // image
+
+	# Check that the database file actually exists.
+	if (!access(dbfile))
+	    error (1, "Databse file not found (" // dbfile // ")")
+
+	# Loop through each line of the database file.  Extract information
+	# and print the output line when the axis keyword is found.  This
+	# assumes the aperture limits are read before the axis.
+
+	axis = INDEF
+	list = dbfile
+	while (fscan (list, line) != EOF) {
+	    if (fscan (line, s1) < 1)
+		next
+	    if (s1 == "begin")
+		i = fscan (line, s1, s1, im, ap, xc, yc)
+	    else if (s1 == "low")
+		i = fscan (line, s1, aplow1, aplow2)
+	    else if (s1 == "high")
+		i = fscan (line, s1, aphigh1, aphigh2)
+	    else if (s1 == "axis")
+		i = fscan (line, s1, axis)
+
+	    if (axis != INDEF) {
+		if (axis == 1)
+		    width = aphigh1 - aplow1
+		else
+		    width = aphigh2 - aplow2
+		printf ("%s %2d %8.4g %8.4g %8.4g\n", im, ap, xc, yc, width)
+		axis = INDEF
+	    }
+	}
+	list = ""
+end
diff --git a/noao/twodspec/apextract/apylevel.x b/noao/twodspec/apextract/apylevel.x
new file mode 100644
index 00000000..aa208453
--- /dev/null
+++ b/noao/twodspec/apextract/apylevel.x
@@ -0,0 +1,103 @@
+# AP_YLEVEL -- Set the aperture to intercept the specified y level.
+
+procedure ap_ylevel (imdata, npts, ylevel, peak, bkg, grow, center, low, high)
+
+real	imdata[npts]		# Image data
+int	npts			# Number of image points
+real	ylevel			# Y value
+bool	peak			# Is y a fraction of peak?
+bool	bkg			# Subtract a background?
+real	grow			# Grow factor
+real	center			# Center of aperture
+real	low, high		# Equal flux points
+
+int	i1, i2, j1, j2, k1, k2
+real	y, y1, y2, a, b, ycut, x
+
+begin
+	if ((center < 1.) || (center >= npts) || IS_INDEF (ylevel))
+	    return
+
+	if (bkg) {
+	    i1 = nint (center) 
+	    i2 = max (1, nint (center + low))
+	    for (k1=i1; k1 > i2 && imdata[k1] <= imdata[k1-1]; k1=k1-1)
+		;
+	    for (; k1 > i2 && imdata[k1] >= imdata[k1-1]; k1=k1-1)
+		;
+	   
+	    i2 = min (npts, nint (center + high))
+	    for (k2=i1; k2 < i2 && imdata[k2] <= imdata[k2+1]; k2=k2+1)
+		;
+	    for (; k2 < i2 && imdata[k2] >= imdata[k2+1]; k2=k2+1)
+		;
+	   
+	    a = imdata[k1]
+	    b = (imdata[k2] - imdata[k1]) / (k2 - k1)
+	} else {
+	    k1 = center
+	    a = 0.
+	    b = 0.
+	}
+	    
+	i1 = center
+	i2 = i1 + 1
+	y1 = imdata[i1] - a - b * (i1 - k1)
+	y2 = imdata[i2] - a - b * (i2 - k1)
+	y = y1 * (i2 - center) + y2 * (center - i1)
+
+	if (peak)
+	    ycut = ylevel * y
+	else
+	    ycut = ylevel
+
+	if (y > ycut) {
+	    for (j1 = i1; j1 >= 1; j1 = j1 - 1) {
+		y1 = imdata[j1] - a - b * (j1 - k1)
+		if (y1 <= ycut)
+		    break
+	    }
+	    if (j1 >= 1) {
+	        j2 = j1 + 1
+		y2 = imdata[j2] - a - b * (j2 - k1)
+	        x = (ycut + y2 * j1 - y1 * j2) / (y2 - y1) - center
+	        low = max (low, (1.+grow)*x)
+	    }
+
+	    for (j2 = i2; j2 <= npts; j2 = j2 + 1) {
+		y2 = imdata[j2] - a - b * (j2 - k1)
+		if (y2 <= ycut)
+		    break
+	    }
+	    if (j2 <= npts) {
+	        j1 = j2 - 1
+		y1 = imdata[j1] - a - b * (j1 - k1)
+	        x = (ycut + y2*j1 - y1*j2) / (y2 - y1) - center
+	        high = min (high, (1.+grow)*x)
+	    }
+	} else {
+	    for (j1 = i1; j1 >= 1; j1 = j1 - 1) {
+		y1 = imdata[j1] - a - b * (j1 - k1)
+		if (y1 >= ycut)
+		    break
+	    }
+	    if (j1 >= 1) {
+	        j2 = j1 + 1
+		y2 = imdata[j2] - a - b * (j2 - k1)
+	        x = (ycut + y2 * j1 - y1 * j2) / (y2 - y1) - center
+	        low = max (low, (1.+grow)*x)
+	    }
+
+	    for (j2 = i2; j2 <= npts; j2 = j2 + 1) {
+		y2 = imdata[j2] - a - b * (j2 - k1)
+		if (y2 >= ycut)
+		    break
+	    }
+	    if (j2 <= npts) {
+	        j1 = j2 - 1
+		y1 = imdata[j1] - a - b * (j1 - k1)
+	        x = (ycut + y2*j1 - y1*j2) / (y2 - y1) - center
+	        high = min (high, (1.+grow)*x)
+	    }
+	}
+end
diff --git a/noao/twodspec/apextract/doc/apall.hlp b/noao/twodspec/apextract/doc/apall.hlp
new file mode 100644
index 00000000..c4e50072
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apall.hlp
@@ -0,0 +1,557 @@
+.help apall Sep96 noao.twodspec.apextract
+.ih
+NAME
+apall -- Extract one dimensional sums across the apertures
+.ih
+USAGE
+apall input
+.ih
+PARAMETERS
+.ls input
+List of input images.
+.le
+.ls output = ""
+List of output root names for extracted spectra.  If the null
+string is given or the end of the output list is reached before the end
+of the input list then the input image name is used as the output root name.
+This will not conflict with the input image since an aperture number
+extension is added for onedspec format, the extension ".ms" for multispec
+format, or the extension ".ec" for echelle format.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls format = "multispec" (onedspec|multispec|echelle|strip)
+Format for output extracted spectra.  "Onedspec" format extracts each
+aperture to a separate image while "multispec" and "echelle" extract
+multiple apertures for the same image to a single output image.
+The "multispec" and "echelle" format selections differ only in the
+extension added.  The "strip" format produces a separate 2D image in
+which each column or line along the dispersion axis is shifted to
+exactly align the aperture based on the trace information.
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+Input images without/with a database entry are skipped silently.
+.le
+.ls profiles = ""
+List of profile images for variance weighting or cleanning.   If variance
+weighting or cleanning a profile of each aperture is computed from the
+input image unless a profile image is specified, in which case the
+profile is computed from the profile image.  The profile image must
+have the same dimensions and dispersion and it is assumed that the
+spectra have the same position and profile shape as in the object
+spectra.  Use of a profile image is generally not required even for
+faint input spectra but the option is available for those who wish
+to use it.
+.le
+
+.ce
+PROCESSING PARAMETERS
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing, trace
+fitting, and extraction review are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+.ls extract = yes
+Extract the one dimensional aperture sums?
+.le
+.ls extras = yes
+Extract the raw spectrum (if variance weighting is used), the sky spectrum
+(if background subtraction is used), and sigma spectrum (if variance
+weighting is used)?  This information is extracted to the third dimension
+of the output image.
+.le
+.ls review = yes
+Review the extracted spectra?  The \fIinteractive\fR parameter must also be
+yes.
+.le
+
+.ls line = INDEF, nsum = 10
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  A line of INDEF selects the middle of the
+image along the dispersion axis.  A positive nsum selects a sum of
+lines and a negative selects a median of lines.
+.le
+
+.ce
+DEFAULT APERTURE PARAMETERS
+.ls lower = -5., upper = 5.
+Default lower and upper aperture limits relative to the aperture center.
+These limits are used for apertures found with \fBapfind\fR and when
+defining the first aperture in \fBapedit\fR.
+.le
+.ls apidtable = ""
+Aperture identification table.  This may be either a text file or an
+image.  A text file consisting of lines with an aperture number, beam
+number, and aperture title or identification.  An image will contain the
+keywords SLFIBnnn with string value consisting of aperture number, beam
+number, optional right ascension and declination, and aperture title.  This
+information is used to assign aperture information automatically in
+\fBapfind\fR and \fBapedit\fR.
+.le
+
+.ce
+DEFAULT BACKGROUND PARAMETERS
+.ls b_function = "chebyshev"
+Default background fitting function.  The fitting function types are
+"chebyshev" polynomial, "legendre" polynomial, "spline1" linear spline, and
+"spline3" cubic spline.
+.le
+.ls b_order = 1
+Default background function order.  The order refers to the number of
+terms in the polynomial functions or the number of spline pieces in the spline
+functions.
+.le
+.ls b_sample = "-10:-6,6:10"
+Default background sample.  The sample is given by a set of colon separated
+ranges each separated by either whitespace or commas.  The string "*" refers
+to all points.  Note that the background coordinates are relative to the
+aperture center and not image pixel coordinates so the endpoints need not
+be integer.
+.le
+.ls b_naverage = -3
+Default number of points to average or median.  Positive numbers
+average that number of sequential points to form a fitting point.
+Negative numbers median that number, in absolute value, of sequential
+points.  A value of 1 does no averaging and each data point is used in the
+fit.
+.le
+.ls b_niterate = 0
+Default number of rejection iterations.  If greater than zero the fit is
+used to detect deviant fitting points and reject them before repeating the
+fit.  The number of iterations of this process is given by this parameter.
+.le
+.ls b_low_reject = 3., b_high_reject = 3.
+Default background lower and upper rejection sigmas.  If greater than zero
+points deviating from the fit below and above the fit by more than this
+number of times the sigma of the residuals are rejected before refitting.
+.le
+.ls b_grow = 0.
+Default reject growing radius.  Points within a distance given by this
+parameter of any rejected point are also rejected.
+.le
+
+.ce
+APERTURE CENTERING PARAMETERS
+.ls width = 5.
+Width of spectrum profiles.  This parameter is used for the profile
+centering algorithm in this and other tasks.
+.le
+.ls radius = 10.
+The profile centering error radius for the centering algorithm.
+.le
+.ls threshold = 0.
+Centering threshold for the centering algorithm.  The range of pixel intensities
+near the initial centering position must exceed this threshold.
+.le
+
+.ce
+AUTOMATIC FINDING AND ORDERING PARAMETERS
+.ls nfind
+Maximum number of apertures to be defined.  This is a query parameter
+so the user is queried for a value except when given explicitly on
+the command line.
+.le
+.ls minsep = 5.
+Minimum separation between spectra.  Weaker spectra or noise within this
+distance of a stronger spectrum are rejected.
+.le
+.ls maxsep = 1000.
+Maximum separation between adjacent spectra.  This parameter
+is used to identify missing spectra in uniformly spaced spectra produced
+by fiber spectrographs.  If two adjacent spectra exceed this separation
+then it is assumed that a spectrum is missing and the aperture identification
+assignments will be adjusted accordingly.
+.le
+.ls order = "increasing"
+When assigning aperture identifications order the spectra "increasing"
+or "decreasing" with increasing pixel position (left-to-right or
+right-to-left in a cross-section plot of the image).
+.le
+
+.ce
+RECENTERING PARAMETERS
+.ls aprecenter = ""
+List of apertures to be used in shift calculation.
+.le
+.ls npeaks = INDEF
+Select the specified number of apertures with the highest peak values
+to be recentered.  If the number is INDEF all apertures will be selected.
+If the value is less than 1 then the value is interpreted as a fraction
+of total number of apertures.
+.le
+.ls shift = yes
+Use the average shift from recentering the apertures selected by the
+\fIaprecenter\fR parameter to apply to the apertures selected by the
+\fIapertures\fR parameter.  The recentering is then a constant shift for
+all apertures.
+.le
+
+.ce
+RESIZING PARAMETERS
+.ls llimit = INDEF, ulimit = INDEF
+Lower and upper aperture size limits.  If the parameter \fIylevel\fR is
+INDEF then these limits are assigned to all apertures.  Otherwise
+these parameters are used as limits to the resizing operation.
+A value of INDEF places the aperture limits at the image edge (for the
+dispersion line used).
+.le
+.ls ylevel = 0.1
+Data level at which to set aperture limits.  If it is INDEF then the
+aperture limits are set at the values given by the parameters
+\fIllimit\fR and \fIulimit\fR.  If it is not INDEF then it is a
+fraction of the peak or an actual data level depending on the parameter
+\fIpeak\fR.  It may be relative to a local background or to zero
+depending on the parameter \fIbkg\fR.
+.le
+.ls peak = yes
+Is the data level specified by \fIylevel\fR a fraction of the peak?
+.le
+.ls bkg = yes
+Subtract a simple background when interpreting the \fBylevel\fR parameter.
+The background is a slope connecting the first inflection points
+away from the aperture center.
+.le
+.ls r_grow = 0.
+Change the lower and upper aperture limits by this fractional amount.
+The factor is multiplied by each limit and the result added to limit.
+.le
+.ls avglimits = no
+Apply the average lower and upper aperture limits to all apertures.
+.le
+
+.ce
+TRACING PARAMETERS
+.ls t_nsum = 10
+Number of dispersion lines to be summed at each step along the dispersion.
+.le
+.ls t_step = 10
+Step along the dispersion axis between determination of the spectrum
+positions.
+.le
+.ls t_nlost = 3
+Number of consecutive steps in which the profile is lost before quitting
+the tracing in one direction.  To force tracing to continue through
+regions of very low signal this parameter can be made large.  Note,
+however, that noise may drag the trace away before it recovers.
+.le
+.ls t_function = "legendre"
+Default trace fitting function.  The fitting function types are
+"chebyshev" polynomial, "legendre" polynomial, "spline1" linear spline, and
+"spline3" cubic spline.
+.le
+.ls t_order = 2
+Default trace function order.  The order refers to the number of
+terms in the polynomial functions or the number of spline pieces in the spline
+functions.
+.le
+.ls t_sample = "*"
+Default fitting sample.  The sample is given by a set of colon separated
+ranges each separated by either whitespace or commas.  The string "*" refers
+to all points.
+.le
+.ls t_naverage = 1
+Default number of points to average or median.  Positive numbers
+average that number of sequential points to form a fitting point.
+Negative numbers median that number, in absolute value, of sequential
+points.  A value of 1 does no averaging and each data point is used in the
+.le
+.ls t_niterate = 0
+Default number of rejection iterations.  If greater than zero the fit is
+used to detect deviant traced positions and reject them before repeating the
+fit.  The number of iterations of this process is given by this parameter.
+.le
+.ls t_low_reject = 3., t_high_reject = 3.
+Default lower and upper rejection sigma.  If greater than zero traced
+points deviating from the fit below and above the fit by more than this
+number of times the sigma of the residuals are rejected before refitting.
+.le
+.ls t_grow = 0.
+Default reject growing radius.  Traced points within a distance given by this
+parameter of any rejected point are also rejected.
+.le
+
+.ce
+EXTRACTION PARAMETERS
+.ls background = "none" (none|average|median|minimum|fit)
+Type of background subtraction.  The choices are "none" for no background
+subtraction, "average" to average the background within the background
+regions, "median" to use the median in the background regions, "minimum" to
+use the minimum in the background regions, or "fit" to fit across the
+dispersion using the background within the background regions.  Note that
+the "average" option does not do any medianing or bad pixel checking,
+something which is recommended.  The fitting option is slower than the
+other options and requires additional fitting parameter.
+.le
+.ls skybox = 1
+Box car smoothing length for sky background when using background
+subtraction.  Since the background noise is often the limiting factor
+for good extraction one may box car smooth the sky to improve the
+statistics in smooth background regions at the expense of distorting
+the subtraction near spectral features.  This is most appropriate when
+the sky regions are limited due to a small slit length.
+.le
+.ls weights = "none" (none|variance)
+Type of extraction weighting.  Note that if the \fIclean\fR parameter is
+set then the weights used are "variance" regardless of the weights
+specified by this parameter.  The choices are:
+.ls "none"
+The pixels are summed without weights except for partial pixels at the
+ends.
+.le
+.ls "variance"
+The extraction is weighted by the variance based on the data values
+and a poisson/ccd model using the \fIgain\fR and \fIreadnoise\fR
+parameters.
+.le
+.le
+.ls pfit = "fit1d" (fit1d|fit2d)
+Profile fitting algorithm to use with variance weighting or cleaning.
+When determining a profile the two dimensional spectrum is divided by
+an estimate of the one dimensional spectrum to form a normalized two
+dimensional spectrum profile.  This profile is then smoothed by fitting
+one dimensional functions, "fit1d", along the lines or columns most closely
+corresponding to the dispersion axis or a special two dimensional
+function, "fit2d", described by Marsh (see \fBapprofile\fR).
+.le
+.ls clean = no
+Detect and replace deviant pixels?
+.le
+.ls saturation = INDEF
+Saturation or nonlinearity level in data units.  During variance weighted
+extractions wavelength points having any pixels above this value are
+excluded from the profile determination and the sigma spectrum extraction
+output, if selected by the \fIextras\fR parameter, flags wavelengths with
+saturated pixels with a negative sigma.
+.le
+.ls readnoise = 0.
+Read out noise in photons.  This parameter defines the minimum noise
+sigma.  It is defined in terms of photons (or electrons) and scales
+to the data values through the gain parameter.  A image header keyword
+(case insensitive) may be specified to get the value from the image.
+.le
+.ls gain = 1
+Detector gain or conversion factor between photons/electrons and
+data values.  It is specified as the number of photons per data value.
+A image header keyword (case insensitive) may be specified to get the value
+from the image.
+.le
+.ls lsigma = 4., usigma = 4.
+Lower and upper rejection thresholds, given as a number of times the
+estimated sigma of a pixel, for cleaning.
+.le
+.ls nsubaps = 1
+During extraction it is possible to equally divide the apertures into
+this number of subapertures.  For multispec format all subapertures will
+be in the same file with aperture numbers of 1000*(subap-1)+ap where
+subap is the subaperture (1 to nsubaps) and ap is the main aperture
+number.  For echelle format there will be a separate echelle format
+image containing the same subaperture from each order.  The name
+will have the subaperture number appended.  For onedspec format
+each subaperture will be in a separate file with extensions and
+aperture numbers as in the multispec format.
+.le
+.ih
+ADDITIONAL PARAMETERS
+Dispersion axis and I/O parameters are taken from the package parameters.
+.ih
+DESCRIPTION
+This task provides functions for defining, modifying, tracing, and
+extracting apertures from two dimensional spectra.  The functions
+desired are selected using switch parameters.  When the task is
+run interactively queries are made at each step allowing additional
+control of the operations performed on each input image.
+
+The functions, in the order in which they are generally performed, are
+summarized below.
+.ls o
+Automatically find a specified number of spectra and assign default
+apertures.  Apertures may also be inherited from another image or
+defined using an interactive graphical interface called the \fIaperture
+editor\fR.
+.le
+.ls o
+Recenter selected reference apertures on the image spectrum profiles.
+.le
+.ls o
+Resize the selected reference apertures based on spectrum profile width.
+.le
+.ls o
+Interactively define or adjust aperture definitions using a graphical
+interface called the \fIaperture editor\fR.  All function may also
+be performed from this editor and, so, provides an alternative
+method of processing and extracting spectra.
+.le
+.ls o
+Trace the positions of the selected spectra profiles from a starting image line
+or column to other image lines or columns and fit a smooth function.
+The trace function is used to shift the center of the apertures
+at each dispersion point in the image.
+.le
+.ls o
+Extract the flux in the selected apertures into one dimensional spectra in
+various formats.  This includes possible background subtraction, variance
+weighting, and bad pixel rejection.
+.le
+
+Each of these functions has different options and parameters.  In
+addition to selecting any of these functions in this task, they may
+also be selected using the aperture editor and as individual
+commands (which themselves allow selection of other functions).  When
+broken down into individual tasks the parameters are also sorted by
+their function though there are then some mutual parameter
+interdependencies.  This functional decomposition is what was available
+prior to the addition of the \fBapall\fR task.  It is recommended that
+this task be used because it collects all the parameters in one
+place eliminating confusion over where a particular parameter
+is defined.  However, documenting the various functions
+is better organized in terms of the separate descriptions given for
+each of the functions; namely under the help topics
+\fBapdefault, apfind, aprecenter, apresize, apedit,
+aptrace\fR, and \fBapsum\fR.
+.ih
+EXAMPLES
+1.  This example may be executed if desired.  First we create an artificial
+spectrum with four spectra and a background.  After it is created you
+can display or plot it.  Next we define the dispersion axis and set the
+verbose flag to better illustrate what is happening.  The task APALL
+is run with the default parameters except for background fitting and
+subtracting added.  The text beginning with # are comments of things to
+try and do.
+
+.nf
+  ap> artdata
+  ar> unlearn artdata
+  ar> mk1dspec apdemo1d nl=50
+  ar> mk2dspec apdemo2d model=STDIN
+  apdemo1d 1. gauss 3 0 20 .01
+  apdemo1d .8 gauss 3 0 40 .01
+  apdemo1d .6 gauss 3 0 60 .01
+  apdemo1d .4 gauss 3 0 80 .01
+  [EOF=Control D or Control Z]
+  ar> mknoise apdemo2d background=100. rdnoise=3. poisson+
+  ar> bye
+  # Display or plot the spectrum
+  ap> dispaxis=2; verbose=yes
+  ap> unlearn apall
+  ap> apall apdemo2d back=fit
+  Searching aperture database ...
+  Find apertures for apdemo2d?  (yes): 
+  Finding apertures ...
+  Number of apertures to be found automatically (1): 4
+  Jul 31 16:55: FIND - 4 apertures found for apdemo2d.
+  Resize apertures for apdemo2d?  (yes): 
+  Resizing apertures ...
+  Jul 31 16:55: RESIZE - 4 apertures resized for apdemo2d.
+  Edit apertures for apdemo2d?  (yes):
+  # Get a list of commands with '?'
+  # See all the parameters settings with :par
+  # Try deleting and marking a spectrum with 'd' and 'm'
+  # Look at the background fitting parameters with 'b' (exit with 'q')
+  # Exit with 'q'
+  Trace apertures for apdemo2d?  (yes): 
+  Fit traced positions for apdemo2d interactively?  (yes):
+  Tracing apertures ...
+  Fit curve to aperture 1 of apdemo2d interactively  (yes):
+  # You can use ICFIT commands to adjust the fit.
+  Fit curve to aperture 2 of apdemo2d interactively  (yes): n 
+  Fit curve to aperture 3 of apdemo2d interactively  (no): 
+  Fit curve to aperture 4 of apdemo2d interactively  (no): y 
+  Jul 31 16:56: TRACE - 4 apertures traced in apdemo2d.
+  Write apertures for apdemo2d to apdemosdb  (yes): 
+  Jul 31 16:56: DATABASE - 4 apertures for apdemo2d written to database.
+  Extract aperture spectra for apdemo2d?  (yes): 
+  Review extracted spectra from apdemo2d?  (yes):
+  Extracting apertures ...
+  Review extracted spectrum for aperture 1 from apdemo2d?  (yes):
+  # Type 'q' to quit
+  Jul 31 16:56: EXTRACT - Aperture 1 from apdemo2d --> apdemo2d.ms
+  Review extracted spectrum for aperture 2 from apdemo2d?  (yes): N
+  Jul 31 16:56: EXTRACT - Aperture 2 from apdemo2d --> apdemo2d.ms
+  Jul 31 16:56: EXTRACT - Aperture 3 from apdemo2d --> apdemo2d.ms
+  Jul 31 16:57: EXTRACT - Aperture 4 from apdemo2d --> apdemo2d.ms
+.fi
+
+2. To extract a series of similar spectra noninteractively using a
+reference for the aperture definitions, then recentering and resizing
+but not retracing:
+
+.nf
+  ap> apall fib*.imh ref=flat inter- trace-
+.fi
+
+Note that the interactive flag automatically turns off the edit, fittrace,
+and review options and the reference image eliminates the find
+(find only occurs if there are no initial apertures).
+.ih
+REVISIONS
+.ls APALL V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+
+The aperture ID table information may now be contained in the
+image header under the keywords SLFIBnnn.
+
+The "nsubaps" parameter now allows onedspec and echelle output formats.
+The echelle format is appropriate for treating each subaperture as
+a full echelle extraction.
+.le
+.ls APALL V2.10.3
+The dispersion axis parameter was moved to purely a package parameter.
+
+As a final step when computing a weighted/cleaned spectrum the total
+fluxes from the weighted spectrum and the simple unweighted spectrum
+(excluding any deviant and saturated pixels) are computed and a
+"bias" factor of the ratio of the two fluxes is multiplied into
+the weighted spectrum and the sigma estimate.  This makes the total
+fluxes the same.  In this version the bias factor is recorded in the logfile
+if one is kept.  Also a check is made for unusual bias factors.
+If the two fluxes disagree by more than a factor of two a warning
+is given on the standard output and the logfile with the individual
+total fluxes as well as the bias factor.  If the bias factor is
+negative a warning is also given and no bias factor is applied.
+In the previous version a negative (inverted) spectrum would result.
+.le
+.ih
+SEE ALSO
+apdefault, apfind, aprecenter, apresize, apedit, aptrace, apsum
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apbackground.hlp b/noao/twodspec/apextract/doc/apbackground.hlp
new file mode 100644
index 00000000..93a49e42
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apbackground.hlp
@@ -0,0 +1,79 @@
+.help apbackground Aug90 noao.twodspec.apextract
+
+.ce
+Background Determination
+
+
+Data from slit spectra allow the determination and subtraction
+of the background sky using information from regions near the object
+of interest.  Background subtraction may also apply to cases of
+scattered light though other techniques for scattered light removal
+may be more appropriate.  The APEXTRACT package provides for determining
+the background level at each wavelength (line or column along the dispersion
+axis) from a set of regions and extrapolating and subtracting the
+background at each pixel extracted from the object profile.  The
+type of background used during extraction is specified by the parameter
+\fIbackground\fR.  If the value "none" is used then no background is
+subtracted and any background parameters defined for an aperture are
+ignored.  If the value is "average", "median", "minimum" or "fit" then a
+background is determined, including a variance estimate when using variance
+weighted extraction (see \fIapvariance\fR), and the subtracted background
+spectrum may be output if the \fIextras\fR parameter is set.
+
+The basic aperture definition structure used in the APEXTRACT package
+includes associated background regions and fitting parameters.  The
+background regions are specified by a list of colon delimited ranges
+defined relative to the center of the aperture.  There are generally
+two ranges, one on each side of the object, though one sided or more
+complex sets may be used to avoid contaminated or missing parts
+of the slit.  The default ranges are defined by the parameter
+\fIb_sample\fR.  Often the ranges are better set graphically using a
+cursor by invoking the 'b' option of the aperture editor.
+
+If the background type is "average", "median", or "minimum" then pixels
+occupying these regions are averaged, medianed, or the minimum found to
+produce a single background level for all object pixels at each wavelength.  
+Note that the "average" choice does not exclude any pixels which may
+yield a background contaminated by cosmic rays.  The "median" or "minimum"
+is recommended instead.
+
+If the background type is "fit" then a function is fit to the pixels in the
+background regions using the ICFIT options (see \fBicfit\fR).  The
+parameter \fIb_naverage\fR may be used to compute averages or medians of
+groups or all of the points within each sample region.  The fit is defined
+by a function type \fIb_function\fR; one of legendre polynomial, chebyshev
+polynomial, linear spline, or cubic spline, and function order
+\fIb_order\fR (number of polynomial terms or spline pieces).  An
+interactive rejection of grossly deviant points from the fit may also be
+used.  The fitted function can define a constant, sloped, or higher order
+background for the object pixels.
+
+Note that the background setting function, the 'b' key in \fBapedit\fR,
+may be used to set the background regions for all the background options
+but it will always show the result of a fit regardless of the background
+type.
+
+After determining a background by averaging, medianing, minimizing, or
+fitting, a box car smoothing step may be applied.  The box car size is
+given by the parameter \fIskybox\fR.  When the number of available
+background pixels is small, due to a small slit for instance, the noise
+introduced to the extracted object spectrum may be unsatisfactorily large.
+By smoothing the background one can reduce the noise when the background
+consists of a smooth continuum.  The trade-off, however, is that near sharp
+features the smoothing will smear the features out and give a poorer
+subtraction of these features.  One could extract both the object and
+background separately and apply a background smoothing separately using
+other image processing tools.  However, this is not possible for variance
+weighted extraction because of the intimate connection between the
+background levels, the profile determination, and the variance estimates
+based on both.  Thus, this smoothing feature is included.
+
+The background determined by the methods outlined above is actually
+subtracted as a separate step during extraction.  The background
+is also used during profile fitting when cleaning or using variance
+weighted extraction.  See \fBapvariance\fR and \fBapprofile\fR for
+further discussion.
+.ih
+SEE ALSO
+approfile apvariance apdefault icfit apall apsum
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apdefault.hlp b/noao/twodspec/apextract/doc/apdefault.hlp
new file mode 100644
index 00000000..e17fe50d
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apdefault.hlp
@@ -0,0 +1,95 @@
+.help apdefault Jul95 noao.twodspec.apextract
+.ih
+NAME
+apdefault -- Set default aperture parameters for the package
+.ih
+USAGE
+apdefault
+.ih
+PARAMETERS
+.ls lower = -5., upper = 5.
+Default lower and upper aperture limits relative to the aperture center.
+These limits are used for apertures found with \fBapfind\fR and when
+defining the first aperture in \fBapedit\fR.
+.le
+.ls apidtable = ""
+Aperture identification table.  This may be either a text file or an
+image.  A text file consisting of lines with an aperture number, beam
+number, and aperture title or identification.  An image will contain the
+keywords SLFIBnnn with string value consisting of aperture number, beam
+number, optional right ascension and declination, and aperture title.  This
+information is used to assign aperture information automatically in
+\fBapfind\fR and \fBapedit\fR.
+.le
+
+.ce
+Default Background Subtraction Parameters
+.ls b_function = "chebyshev"
+Default background fitting function.  The fitting function types are
+"chebyshev" polynomial, "legendre" polynomial, "spline1" linear spline, and
+"spline3" cubic spline.
+.le
+.ls b_order = 1
+Default background function order.  The order refers to the number of
+terms in the polynomial functions or the number of spline pieces in the spline
+functions.
+.le
+.ls b_sample = "-10:-6,6:10"
+Default background sample.  The sample is given by a set of colon separated
+ranges each separated by either whitespace or commas.  The string "*" refers
+to all points.  Note that the background coordinates are relative to the
+aperture center and not image pixel coordinates so the endpoints need not
+be integer.
+.le
+.ls b_naverage = -3
+Default number of points to average or median.  Positive numbers
+average that number of sequential points to form a fitting point.
+Negative numbers median that number, in absolute value, of sequential
+points.  A value of 1 does no averaging and each data point is used in the
+fit.
+.le
+.ls b_niterate = 0
+Default number of rejection iterations.  If greater than zero the fit is
+used to detect deviant fitting points and reject them before repeating the
+fit.  The number of iterations of this process is given by this parameter.
+.le
+.ls b_low_reject = 3., b_high_reject = 3.
+Default background lower and upper rejection sigmas.  If greater than zero
+points deviating from the fit below and above the fit by more than this
+number of times the sigma of the residuals are rejected before refitting.
+.le
+.ls b_grow = 0.
+Default reject growing radius.  Points within a distance given by this
+parameter of any rejected point are also rejected.
+.le
+.ih
+DESCRIPTION
+This task sets the values of the default aperture parameters for the
+tasks \fBapedit\fR and \fBapfind\fR which define new apertures.  For a
+description of the components of an aperture see the paper \fBThe
+APEXTRACT Package\fR.  In \fBapedit\fR the default aperture limits and
+background parameters are only used if there are no other
+apertures defined.  The aperture identification table is used when
+reordering the apertures with the 'o' key.  When run the parameters are
+displayed and modified using the \fBeparam\fR task.
+
+The aperture limits and background fitting sample regions are defined
+relative to the center of the aperture.  The background fitting parameters
+are those used by the ICFIT package.  They may be modified interactively
+with the 'b' key in the task \fBapedit\fR.  For more on background fitting
+and subtracting see \fBapbackground\fR.
+.ih
+EXAMPLES
+To review and modify the default aperture parameters:
+
+	cl> apdefault
+.ih
+.ih
+REVISIONS
+.ls APDEFAULT V2.11
+The aperture ID table information may now be contained in the
+image header under the keywords SLFIBnnn.
+.le
+SEE ALSO
+apbackground, apedit, apfind, icfit
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apedit.hlp b/noao/twodspec/apextract/doc/apedit.hlp
new file mode 100644
index 00000000..324f6e5d
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apedit.hlp
@@ -0,0 +1,374 @@
+.help apedit Sep96 noao.twodspec.apextract
+.ih
+NAME
+apedit -- Edit apertures
+.ih
+USAGE
+apedit input
+.ih
+PARAMETERS
+.ls input
+List of input images for which apertures are to be edited.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+If the reference image list is shorter than the input image list the
+last reference image is used for the remaining input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = no
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing is
+disabled.
+.le
+.ls find = no
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = no
+Recenter the apertures?
+.le
+.ls resize = no
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+
+.ls line = INDEF
+The dispersion line (line or column perpendicular to the dispersion axis) to
+be graphed.  A value of INDEF uses the middle of the image.
+.le
+.ls nsum = 10
+Number of dispersion lines to be summed or medianed.  The lines are taken
+around the specified dispersion line.  A positive nsum selects a sum of
+lines and a negative selects a median of lines.
+.le
+.ls width = 5.
+Width of spectrum profiles.  This parameter is used for the profile
+centering algorithm in this and other tasks.
+.le
+.ls radius = 5.
+The profile centering error radius for the centering algorithm.
+.le
+.ls threshold = 0.
+Centering threshold for the centering algorithm.  The range of pixel intensities
+near the initial centering position must exceed this threshold.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters are taken from the
+task \fBapdefault\fR.  Parameters for the various functions of finding,
+recentering, and resizing are taken from the parameters for the
+appropriate task.
+
+When this operation is performed from the task \fBapall\fR all parameters
+except the package parameters are included in that task.
+.ih
+CURSOR KEYS
+When editing the apertures interactively the following cursor keys are
+available.
+
+.nf
+?    Print help
+a    Toggle the ALL flag
+b an Set background fitting parameters
+c an Center aperture(s)
+d an Delete aperture(s)
+e an Extract spectra (see APSUM)
+f    Find apertures up to the requested number (see APFIND)
+g an Recenter aperture(s) (see APRECENTER)
+i  n Set aperture ID
+j  n Set aperture beam number
+l ac Set lower limit of current aperture at cursor position
+m    Define and center a new aperture on the profile near the cursor
+n    Define a new aperture centered at the cursor
+o  n Enter desired aperture number for cursor selected aperture and
+     remaining apertures are reordered using apidtable and maxsep
+     parameters (see APFIND for ordering algorithm)
+q    Quit
+r    Redraw the graph
+s an Shift the center(s) of the current aperture to the cursor
+     position
+t ac Trace aperture positions (see APTRACE)
+u ac Set upper limit of current aperture at cursor position
+w    Window the graph using the window cursor keys
+y an Set aperture limits to intercept the data at the cursor y
+     position
+z an Resize aperture(s) (see APRESIZE)
+.  n Select the aperture nearest the cursor for current aperture
++  c Select the next aperture (in ID) to be the current aperture
+-  c Select the previous aperture (in ID) to be the current aperture
+I    Interrupt task immediately.  Database information is not saved.
+.fi
+
+The letter a following the key indicates if all apertures are affected when
+the ALL flag is set.  The letter c indicates that the key affects the
+current aperture while the letter n indicates that the key affects the
+aperture whose center is nearest the cursor.
+.ih
+COLON COMMANDS
+
+.nf
+:show [file]	   Print a list of the apertures (default STDOUT)
+:parameters [file] Print current parameter values (default STDOUT)
+:read [name]       Read from database (default current image)
+:write [name]      Write to database (default current image)
+.fi
+
+The remaining colon commands are task parameters and print the current
+value if no value is given or reset the current value to that specified.
+Use :parameters to see current parameter values.
+
+.nf
+:apertures      :apidtable      :avglimits      :b_function
+:b_grow         :b_high_reject  :b_low_reject   :b_naverage
+:b_niterate     :b_order        :b_sample       :background
+:bkg            :center         :clean          :database
+:extras         :gain           :image          :line
+:llimit         :logfile        :lower          :lsigma
+:maxsep         :minsep         :npeaks         :nsubaps
+:nsum           :order          :parameters     :peak
+:plotfile       :r_grow         :radius         :read
+:readnoise      :saturation     :shift          :show
+:skybox         :t_function     :t_grow         :t_high_reject
+:t_low_reject   :t_naverage     :t_niterate     :t_nsum
+:t_order        :t_sample       :t_step         :t_width
+:threshold      :title          :ulimit         :upper
+:usigma         :weights        :width          :write
+:ylevel		:t_nlost
+.fi
+.ih
+DESCRIPTION
+For each image in the input image list, apertures are defined and edited
+interactively.  The aperture editor is invoked when the parameters
+\fIinteractive\fR and \fIedit\fR are both yes.  When this is the case
+the task will query whether to edit each image.  The responses are
+"yes", "no", "YES", and "NO", where the upper case responses suppress
+queries for all following images.
+
+When the aperture editor is entered a graph of the image lines or
+columns specified by the parameters \fIline\fR and \fInsum\fR is
+drawn.  In the \fBapextract\fR package a dispersion line is either a
+line or column in the image at one point along the dispersion axis.
+The dispersion axis may be defined in the image header under the
+keyword DISPAXIS or by the package parameter \fIdispaxis\fR.  The
+parameter \fBnsum\fR determines how many dispersion lines surrounding
+the specified dispersion line are summed or medianed.  This improves the
+signal in the profiles of weaker spectra.  Once the graph is drawn an
+interactive cursor loop is entered.  The set of cursor keys and colon
+commands is given above and may be printed when the task is running using
+the '?' key.  The CURSOR MODE keys and graph formatting options are also
+available (see \fBcursor\fR and \fBgtools\fR).
+
+A status line, usually at the bottom of the graphics terminal,
+indicates the current aperture and shows the ALL flag, 'a' key, if set.  The
+concept of the current aperture is used by several of the aperture
+editing commands.  Other commands operate on the aperture whose center
+is nearest the cursor.  It is important to know which commands operate
+on the current aperture and which operate on the nearest aperture to
+the cursor.
+
+The cursor keys and colon commands are used to define new apertures,
+delete existing apertures, modify the aperture number, beam number,
+title, center, and limits, set background fitting parameters, trace the
+positions of the spectra in the apertures, and extract aperture
+spectra.  When creating new apertures default parameters are supplied
+in two ways; if no apertures are defined then the default parameters
+are taken from the task \fBapdefault\fR while if there is a current
+aperture then a copy of its parameters are made.
+
+The keys for creating a new aperture are 'm' and 'n' and 'f'.  The key
+'m' marks a new aperture and centers the aperture on the profile
+nearest the cursor.  The centering algorithm is described under the
+help topic \fBcenter1d\fR and the parameters controlling the centering are
+\fIwidth\fR, \fIradius\fR, and \fIthreshold\fR.  The key 'n' defines a
+new aperture at the position of the cursor without centering.  This is
+used if there is no spectrum profile such as when defining sky apertures
+or when defining apertures in extended profiles.  The 'f' key finds new
+apertures using the algorithm described in the task \fBapfind\fR.  The
+number of apertures found in this way is limited by the parameter
+\fBnfind\fR and the number includes any previously defined
+apertures.  The new aperture number, beam number, and title are assigned using
+the aperture assignment algorithm described in \fBapfind\fR.
+
+The aperture number for the aperture \fInearest\fR the cursor is changed
+with the 'j' key and the beam number is changed with the 'k' key.  The
+user is prompted for a new aperture number or beam number.  The
+aperture title may be set or changed with the :title colon command.
+
+The 'o' key may be used to reorder or correct the aperture
+identifications and beam numbers.  This is useful if the aperture
+numbers become disordered due to deletions and additions or if the
+first spectrum is missing when using the automatic identification
+algorithm.  An aperture number is requested for the aperture pointed to
+by the cursor.  The remaining apertures are reordered relative to this
+aperture number.  There is a aperture number, beam number, and title
+assignment algorithm which uses information about the maximum
+separation between consecutive apertures, the direction of increasing
+aperture numbers, and an optional aperture identification table.  See
+\fBapfind\fR for a description of the algorithm.
+
+After defining a new aperture it becomes the current aperture.  The
+current aperture is indicated on the status line and the '.', '+', and
+'-' keys are used to select a new current aperture.
+
+Apertures are deleted with 'd' key.  The aperture \fInearest\fR the
+cursor is deleted.
+
+The aperture center may be changed with the 'c', 's', and 'g' keys and the
+":center value" colon command.  The 'c' key applies the centering algorithm
+to the aperture \fInearest\fR the colon.  The 's' key shifts the center
+of the \fIcurrent\fR aperture to the position of the cursor.  The 'g'
+applies the \fBaprecenter\fR algorithm.  The :center command sets the
+center of the \fIcurrent\fR aperture to the value specified.  Except
+for the last option these commands may be applied to all apertures
+if the ALL flag is set.
+
+The aperture limits are defined relative to the aperture center.  The
+limits may be changed with the 'l', 'u', 'y', and 'z' keys and with the
+":lower value" and ":upper value" commands.  The 'l' and 'u' keys set
+the lower and upper limits of the \fIcurrent\fR aperture at the position
+of the cursor.  The colon commands allow setting the limits explicitly.
+The 'y' key defines both limits for the \fInearest\fR aperture as
+points at which the y cursor position intercepts the data profile.
+This requires that the aperture include a spectrum profile and that
+the y cursor value lie below the peak of the profile.  The 'z'
+key applies the \fBapresize\fR algorithm.  Except for the colon
+commands these commands may be applied to all apertures if the ALL
+flag is set.
+
+The key 'b' modifies the background fitting parameters for the aperture
+\fInearest\fR the cursor.  The default background parameters are
+specified by the task \fBapdefault\fR.  Note that even though
+background parameters are defined, background subtraction is not
+performed during extraction unless specified.
+When the 'b' key is used the \fBicfit\fR graphical interface is entered
+showing the background regions and function fit for the current image
+line.  Note that the background regions are specified relative to
+the aperture center and follows changes in the aperture position.
+
+The two types of
+extraction which may be specified are to average all points within
+a set of background regions or fit a function to the points in
+the background regions.  In the first case only the background sample
+parameter is used.  In the latter case the other parameters are
+also used in conjunction with the \fBicfit\fR function fitting commands.
+See \fBapbackground\fR for more on the background parameters.
+
+Each aperture may have different background
+fitting parameters but newly defined apertures inherit the background
+fitting parameters of the last current aperture.  This will usually be
+satisfactory since the background regions are defined relative to the
+aperture center rather than in absolute coordinates.  If the ALL flag
+is set then all apertures will be given the same background
+parameters.
+
+The algorithms used in the tasks \fBapfind, aprecenter, apresize, aptrace\fR,
+and \fBapsum\fR are available from the editor with the keys 'f', 'g', 'z',
+'t', and 'e'
+respectively.  Excluding finding, if the ALL flag is not set then the
+nearest aperture
+to the cursor is used.  This allows selective recentering, resizing,
+tracing and extracting.
+If the ALL flag is set then all apertures are traced or extracted.
+When extracting the output, rootname and profile name are queried.
+
+Some general purpose keys window the graph 'w' using the \fBgtools\fR
+commands, redraw the graph 'r', and quit 'q'.
+
+The final cursor key is the 'a' key.  The cursor keys which modify the
+apertures were defined as operating on either the aperture nearest the
+cursor or the current aperture.  The 'a' key allows these keys to
+affect all the apertures simultaneously.  The 'a' key sets a flag which
+is shown on the status line when it is set.  When set, the operation on
+one aperture is duplicated on the remaining apertures.  The operations
+which apply to all apertures are set background 'b', center 'c', delete
+'d', extract 'e', recenter 'g', set lower limit 'l', shift 's', trace
+'t', set upper limit 'u', set limits at the y cursor 'y', and resize
+'z'.  The 'b', 'l', 's', and 'u' keys first set the background,
+aperture limits, or shift for the appropriate aperture and then are
+applied to the other apertures relative to their centers.
+
+All the parameters used in any of the operations may be examined or
+changed through colon commands.  The :parameters command lists all
+parameter values and :show lists the apertures.  The :read and :write
+are used to force an update or save the current apertures and to read
+apertures for the current image or from some other image.  The commands
+all have optional arguments.  For the commands which show information
+the argument specifies a file to which the information is to be
+written.  The default is the standard output.  The database read and
+write and the change image commands take an image name.  If an image
+name is not given for the read and write commands the
+current image name is used.  The change image command default is to
+print the current image name.  The remaining commands take a value.  If
+a value is not given then the current value is printed.
+
+The aperture editor may be selected from nearly every task using the
+\fBedit\fR parameter.
+.ih
+EXAMPLES
+The aperture editor is a very flexible and interactive tool
+for which it is impossible illustrate all likely uses.  The following
+give some simple examples.
+
+1.  To define and edit apertures for image "n1.001":
+
+	cl> apedit n1.001
+
+2.  To define apertures for one image and then apply them to several other
+images:
+
+.nf
+	cl> apedit n1.* ref=n1.001
+	Edit apertures for n1.001? (yes)
+	Edit apertures for n1.002? (yes) NO
+.fi
+
+Answer "yes" to the first query for editing n1.001.  To
+the next query (for n1.002) respond with "NO".  The remaining
+images then will not be edited interactively.  Note that after
+defining the apertures for n1.001 they are recorded in the database
+and subsequent images will be able to use them as reference apertures.
+
+3.  Using the ":image name" and ":read image" colon commands and the
+'f', 'g', 'z', 't' and 'e' keys the user can perform all the functions
+available in the package without ever leaving the editor.  The 'a' key
+to set the ALL flag is very useful when dealing with many spectra in a
+single image.
+.ih
+.ih
+REVISIONS
+.ls APEDIT V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+
+The aperture ID table information may now be contained in the
+image header under the keywords SLFIBnnn.
+.le
+SEE ALSO
+.nf
+apdefault, apfind, aprecenter, apresize, aptrace, apsum, apall
+center1d, cursor, gtools, icfit
+.fi
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apextract.hlp b/noao/twodspec/apextract/doc/apextract.hlp
new file mode 100644
index 00000000..401d93e7
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apextract.hlp
@@ -0,0 +1,365 @@
+.help package Feb94 noao.twodspec.apextract
+.ih
+NAME
+apextract -- Identify, manipulate, and extract spectra in 2D images
+.ih
+USAGE
+apextract
+.ih
+PARAMETERS
+.ls dispaxis = 2
+Image axis along which the spectra dispersion run.  The dispersion axis
+is 1 when the dispersion is along lines so that spectra are horizontal
+when displayed normally.  The dispersion axis is 2 when the dispersion
+is along columns so that spectra are vertical when displayed normally.
+This parameter is superseded when the dispersion axis is defined in
+the image header by the parameter DISPAXIS.
+.le
+.ls database = "database"
+Database for storing aperture definitions.  Currently the database is
+a subdirectory of text files with prefix "ap" followed by the entry name,
+usually the image name.
+.le
+.ls verbose = no
+Print detailed processing and log information?  The output is to the
+standard output stream which is the user's terminal unless redirected.
+.le
+.ls logfile = ""
+Text logfile of operations performed.  If a file name is specified
+log and history information produced by all the tasks in the package
+is appended to the file.
+.le
+.ls plotfile = ""
+Binary plot metacode file of aperture locations, traces, rejected points,
+etc.  If a file name is given metacode plots are appended.  The contents
+of the file may be manipulated with the tasks in the \fBplot\fR package.
+The most common is \fBgkimosaic\fR.  Special plotfile names may be used
+to select only particular plots or plots not normally output.  These are
+debugall, debugfitspec, debugaps, debugspec, debugfits, debugtrace,
+and debugclean which plot everything, the fitted spectrum, the apertures,
+the extracted spectrum, profile fit plots, the trace, and the rejected
+points during cleaned extraction.
+.le
+.ls version = "APEXTRACT V3.0: August 1990"
+Version of the package.  This is the third major version of the package.
+.le
+.ih
+DESCRIPTION
+The primary function of the \fBapextract\fR package is the extraction of
+spectra from two dimensional formats to one dimensional formats.  In
+other words, the pixels at each wavelength are summed, possibly
+subtracting a background or sky from other pixels at that wavelength,
+to produce a vector of spectral fluxes as a function of wavelength.
+It has become common to have many spectra in one two dimensional
+image produced by instruments using echelles, fibers, and aperture
+masks.  Thus, the package provides many features for the efficient
+extractions of multiple spectra as well as single spectra.  There are
+also some additional, special purpose tasks for modeling spectra
+and using the aperture definitions, described below,
+to create masks and modified flat field images.
+
+The package assumes that one of the image axes is the dispersion axis,
+specified by the \fIdispaxis\fR package parameter or image header
+parameter of the same name, and the other is the spatial axes.
+This means that all pixels at the same column or line (the
+orientation may be in either direction) are considered to be at the
+same wavelength.  Even if this is not exactly
+true the resolution loss is generally quite small and the simplicity and
+absence of interpolation problems justify this approach.  The
+alternatives are to rotate the image with \fBrotate\fR or use the more
+complex \fBlongslit\fR package.  Though extraction is strictly along
+lines and columns the position of the spectrum along the spatial axis
+is allowed to shift smoothly with wavelength.  This accounts for small
+misalignments and distortions.
+
+The two dimensional regions occupied by the spectra are defined by
+digital apertures having a fixed width but with spatial position smoothly
+varying with wavelength.  The apertures have a number of attributes.
+The aperture definitions are created and modified by the tasks in this
+package and stored in a database specified by the parameter \fIdatabase\fR.
+The database is currently a directory containing simple text files
+in a human readable format.  The elements of an aperture definition
+are as follows.
+
+
+.ce
+Elements of an Aperture Definition
+.ls aperture
+An integer aperture identification number.  The aperture number
+must be unique within a set of apertures.  The aperture number is
+the primary means of referencing an aperture and the resulting
+extracted spectra.  The aperture numbers are part of the extracted
+spectra image headers.  The numbers may be any integer and in any order
+but the most typical case is to have sequential numbers beginning
+with 1.
+.le
+.ls beam
+An integer beam number.  The beam number need not be unique; i.e.
+several apertures may have the same beam number.  The beam numbers are
+recorded in the image headers of the extracted spectra.  The beam
+number is often used to identify types of spectra such as object,
+sky, arc, etc.
+.le
+.ls center
+A pair of numbers specifying the center of the aperture along the spatial
+and dispersion axes in the two dimensional image.  The center along
+the dispersion is usually defined as the middle of the image.  The
+rest of the aperture parameters are defined relative to the aperture
+center making it easy to move apertures.
+.le
+.ls low, high
+Pairs of numbers specifying the lower and upper limits of the
+aperture relative to the center along the spatial and dispersion axes.
+The lower limits are usually negative and the upper limits positive
+but there is no actual restriction; i.e. the aperture can actually
+be offset from the center position.  Currently the dispersion
+aperture limits are such that the entire length of the image along the
+dispersion axis is used.  In the future this definition can be
+easily used for objective prism spectra.
+.le
+.ls curve, axis
+An IRAF "curfit" function specifying a shift to be added to the center
+position along the spatial axis, given by the axis parameter which is
+the complement of the dispersion axis parameter \fIdispaxis\fR, as a
+function of the dispersion coordinate.  This trace function is one of
+the standard IRAF \fBicfit\fR types; a legendre polynomial, a chebyshev
+polynomial, a linear spline, or a cubic spline.
+.le
+.ls background
+Background definition parameters.  For the "average" background subtraction
+option only the set of background sample regions (defined relative to
+the aperture center) are used.  For the "fit" option the parameters
+are those used by the \fBicfit\fR package for fitting a function to
+the points in the background sample regions.
+.le
+
+This information as well as the image (or database entry) name are stored
+in a text file, with name given by the prefix "ap" followed by the entry
+name, in the database directory.  An example with the special entry  name
+"last", stored in the file "database$aplast", is given below. The "begin"
+line marks the beginning of an aperture definition.
+
+
+.ce
+Sample Aperture Database Entry
+
+.nf
+# Fri 17:43:41 03-Aug-90
+begin	aperture last 1 70.74564 256.
+	image	last
+	aperture	1
+	beam	1
+	center	70.74564 256.
+	low	-5. -255.
+	high	5. 256.
+	background
+		xmin -100.
+		xmax 100.
+		function chebyshev
+		order 1
+		sample -10:-6,6:10
+		naverage -3
+		niterate 0
+		low_reject 3.
+		high_reject 3.
+		grow 0.
+	axis	1
+	curve	5
+		2.
+		1.
+		1.
+		512.
+		0.
+.fi
+
+There are a number of logical functions which may be performed to
+create, modify, and use the aperture definitions.  These functions
+are:
+.ls o
+Automatically find a specified number of spectra and assign default
+apertures.  Apertures may also be inherited from another image or
+defined using an interactive graphical interface called the \fIaperture
+editor\fR.
+.le
+.ls o
+Recenter apertures on the image spectrum profiles.
+.le
+.ls o
+Resize apertures based on spectrum profile width.
+.le
+.ls o
+Interactively define or adjust aperture definitions using a graphical
+interface called the \fIaperture editor\fR.  All function may also
+be performed from this editor and, so, provides an alternative
+method of processing and extracting spectra.
+.le
+.ls o
+Trace the positions of spectra profiles from a starting image line
+or column to other image lines or columns and fit a smooth function.
+The trace function is used to shift the center of the apertures
+at each dispersion point in the image.
+.le
+.ls o
+Extract the flux in the apertures into one dimensional spectra in various
+formats.  This includes possible background subtraction, variance
+weighting, and bad pixel rejection.
+.le
+
+The package is logically organized around these functions.  Each
+function has a task devoted to it.  The description of the parameters
+and algorithms for each function are organized according to these
+tasks; namely under the help topics \fBapdefault, apfind, aprecenter,
+apresize, apedit, aptrace\fR, and \fBapsum\fR.  However, each task has
+parameters to allow selecting some or all of the other functions, hence
+it is not necessary to use the individual tasks and often it is more
+convenient to use just the extraction task for all operations.  It is
+also possible to perform all the functions from within a graphical
+interface called the aperture editor.  This is usually only used to
+define and modify aperture definitions but it also has the capability
+to trace spectra and extract them.
+
+Each of the functions has many different options and parameters.  When
+broken down into individual tasks the parameters are also sorted by
+their function though there are then some mutual interdependencies.
+This parameter decomposition was what was available prior to the
+addition of the task \fBapall\fR.  This is the central task of the
+package which performs any and all of the functions required for the
+extraction of spectra and also collects all the parameters into one
+parameter set.  It is recommended that \fBapall\fR be used because it
+collects all the parameters in one place eliminating confusion over
+where a particular parameter is defined.
+
+In summary, the package consists of a number of logical functions which
+are documented by the individual tasks named for that function, but the
+functions are also integrated into each task and the aperture editor to
+providing many different ways for the user to choose to perform the
+functions.
+
+The package menu and help summary is shown below.
+
+
+.ce
+The APEXTRACT Package Tasks
+
+.nf
+     apall        apedit       apflatten    aprecenter   apsum
+     apdefault    apfind       apmask       apresize     aptrace
+     apdemos      apfit        apnormalize  apscatter
+
+          apall - Extract 1D spectra (all parameters in one task)
+      apdefault - Set the default aperture parameters and apidtable
+        apdemos - Various tutorial demonstrations
+         apedit - Edit apertures interactively
+	 apfind - Automatically find spectra and define apertures
+	  apfit - Fit 2D spectra and output the fit, difference,
+		  or ratio
+      apflatten - Remove overall spectral and profile shapes from
+		  flat fields
+         apmask - Create and IRAF pixel list mask of the apertures
+    apnormalize - Normalize 2D apertures by 1D functions
+     aprecenter - Recenter apertures
+       apresize - Resize apertures
+      apscatter - Fit and subtract scattered light
+          apsum - Extract 1D spectra
+	aptrace - Trace positions of spectra
+
+		Additional topics
+
+   apbackground - Background subtraction algorithms
+      apextract - Package parameters and general description of
+		  package
+     approfiles - Profile determination algorithms
+     apvariance - Extractions, variance weighting, cleaning, and
+		  noise model
+.fi
+
+The extracted spectra are recorded in one, two, or three dimensional
+images depending on the \fIformat\fR and \fIextras\fR parameters.  If
+the \fIextras\fR parameter is set to yes the formats are three
+dimensional with each plane in the third dimension containing
+associated information for the spectra in the first plane.  See
+\fBapsum\fR for further details.  When \fIextras\fR=no only the
+extracted spectra are output.
+
+If the format parameter is "onedspec" the output extractions are one
+dimensional images with names formed from an output rootname and an
+aperture number extension; i.e. root.0001 for aperture 1.  There will
+be as many output images as there are apertures for each input image,
+all with the same output rootname but with different aperture
+extensions.  This format is provided to be compatible with the original
+format used by the \fBonedspec\fR package.
+
+If the format parameter is "echelle" or "multispec" the output aperture
+extractions are put into a two dimensional image with a name formed from
+the output rootname and the extension ".ec" or ".ms".  Each line in
+the output image corresponds to one aperture.  Thus in this format
+there is one output image for each input image.  These are the preferred
+output formats for reasons of compactness, ease of handling, and efficiency.
+These formats are compatible with the \fBonedspec\fR, \fBechelle\fR, and
+\fBmsred\fR packages.  The format is a standard IRAF image with
+specialized image header keywords.  Below is an example of the keywords.
+
+
+.ce
+MULTISPEC/ECHELLE Format Image Header Keywords
+
+.nf
+    ap> imhead test.ms
+    test.ms[512,2,4][real]: Title
+	BANDID1 = 'spectrum - background fit, weights variance, clean yes'
+	BANDID2 = 'spectrum - background fit, weights none, clean no'
+	BANDID3 = 'background - background fit'
+	BANDID4 = 'sigma - background fit, weights variance, clean yes'
+	APNUM1  = '1 1 87.11 94.79'
+	APNUM2  = '2 1 107.11 114.79'
+	APID1   = 'Galaxy center'
+	APID2   = 'Galaxy edge'
+	WCSDIM  =                    3
+	CTYPE1  = 'PIXEL   '
+	CTYPE2  = 'LINEAR  '
+	CTYPE3  = 'LINEAR  '
+	CRVAL1  =                   1.
+	CRPIX1  =                   1.
+	CD1_1   =                   1.
+	CD2_2   =                   1.
+	CD3_3   =                   1.
+	LTM1_1  =                   1.
+	LTM2_2  =                   1.
+	LTM3_3  =                   1.
+	WAT0_001= 'system=equispec
+	WAT1_001= 'wtype=linear label=Pixel
+	WAT2_001= 'wtype=linear
+	WAT3_001= 'wtype=linear
+.fi
+
+The BANDIDn keywords describe the various elements of the 3rd dimension.
+Except for the first one the other bands only occur when \fIextras\fR is
+yes and when sky subtraction and/or variance and cleaning are done.  The
+relation between the line and the aperture numbers is given by the header
+parameters APNUMn where n is the line and the value gives extraction and
+coordinate information about the spectrum.  The first field is the aperture
+number and the second is the beam number.  After dispersion calibration of
+echelle format spectra the beam number becomes the order number.  The other
+two numbers are the aperture limits at the line or column at which the
+aperture was defined.
+The APID keywords provide an optional title for each extracted spectrum
+in addition to the overall image title.
+
+The rest of the keywords are part of the IRAF World Coordinate System
+(WCS).  If the image being extracted has been previously calibrated
+(say with \fBlongslit.transform\fR) then the dispersion coordinates
+will be carried in CRVAL1 and CD1_1.
+
+There is one other value for the format parameter, "strip".  This produces
+two dimensional extractions rather than one dimensional extractions.
+Each aperture is output to a two dimensional image with a width set by the
+nearest integer which includes the aperture.  The output names are
+generated in the same way as for "onedspec" format.  The aperture is
+shifted by interpolation so that it is exactly aligned with the image
+columns.  If not variance weighting the actual image data is output
+with appropriate shifting while for variance weighting and/or cleaning
+the profile model is output (similar to \fBapfit\fR except for being
+aligned).  This format is that provided in the previous version of
+the package by the \fBapstrip\fR task.  It is now relegated to a
+special case.
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apextractsys.hlp b/noao/twodspec/apextract/doc/apextractsys.hlp
new file mode 100644
index 00000000..a93d9f56
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apextractsys.hlp
@@ -0,0 +1,415 @@
+.help apextract Aug90 noao.twodspec.apextract
+
+.ce
+APEXTRACT System Notes
+
+
+\fBIntroduction\fR
+
+The \fBapextract\fR package is a complex package with a simple
+purpose, the extraction of one dimensional spectra from two dimensional
+images.  The complexity arises from the many algorithms and parameters
+involved.  To manage the complexity of the algorithms, features, parameters,
+functionality, and documentation the package has been organized in terms
+of logical functions which may be invoked in a number of ways.  The
+logical functions are:
+.ls o
+Automatically find a specified number of spectra and assign default
+apertures.  Apertures may also be inherited from another image or
+defined using an interactive graphical interface called the \fIaperture
+editor\fR.
+.le
+.ls o
+Recenter apertures on the image spectrum profiles.
+.le
+.ls o
+Resize apertures based on spectrum profile width.
+.le
+.ls o
+Interactively define or adjust aperture definitions using a graphical
+interface called the \fIaperture editor\fR.  All function may also
+be performed from this editor and, so, provides an alternative
+method of processing and extracting spectra.
+.le
+.ls o
+Trace the positions of spectra profiles from a starting image line
+or column to other image lines or columns and fit a smooth function.
+The trace function is used to shift the center of the apertures
+at each dispersion point in the image.
+.le
+.ls o
+Extract the flux in the apertures into one dimensional spectra in various
+formats.  This includes possible background subtraction, variance
+weighting, and bad pixel rejection.
+.le
+
+The package is logically organized around these functions.  Each
+function has a task devoted to it.  The description of the parameters
+and algorithms for each function are organized according to these
+tasks; namely under the help topics \fBapdefault, apfind, aprecenter,
+apresize, apedit, aptrace\fR, and \fBapsum\fR.  However, each task has
+parameters to allow selecting some or all of the other functions, hence
+it is not necessary to use the individual tasks and often it is more
+convenient to use just the extraction task for all operations.  It is
+also possible to perform all the functions from within a graphical
+interface called the aperture editor.  This is usually only used to
+define and modify aperture definitions but it also has the capability
+to trace spectra and extract them.
+
+Each of the functions has many different options and parameters.  When
+broken down into individual tasks the parameters are also sorted by
+their function though there are then some mutual interdependencies.
+This parameter decomposition was what was available prior to the
+addition of the task \fBapall\fR.  This is the central task of the
+package which performs any and all of the functions required for the
+extraction of spectra and also collects all the parameters into one
+parameter set.  It is recommended that \fBapall\fR be used because it
+collects all the parameters in one place eliminating confusion over
+where a particular parameter is defined.
+
+In summary, the package consists of a number of logical functions which
+are documented by the individual tasks named for that function, but the
+functions are also integrated into each task and the aperture editor to
+providing many different ways for the user to choose to perform the
+functions.
+
+This document describes some of the implementation details and features
+which are hidden from the normal user.
+
+
+\fBParameters\fR
+
+The tasks actually use hidden parameter sets for almost all parameters.
+To see all the parameter sets type
+
+.nf
+	ap> ?_ apextract
+.fi
+
+The relation between the tasks and the hidden parameter sets is given below.
+
+.nf
+	PSET	   TASK
+	apparams - apdefault, apfind, aprecenter, apresize,
+		   apedit, aptrace, apsum, apmask, apscatter
+	apall1   - apall
+	apfit1   - apfit
+	apflat1  - apflatten
+	apnorm1  - apnormalize
+.fi
+
+The hidden parameter sets may be viewed in any of the normal ways
+\fBeparam\fR, \fBlparam\fR, or just by typing their name, except
+their names may not be abbreviated.  Their purpose is to redirect
+parameters to visible parameter sets, to hide some parameters which
+are not meant to be changed by the user, and to include parameters
+used for queries.
+
+Most of the redirected parameters go to a single visible parameter set
+or to package parameters.
+The interesting exception is \fBapparams\fR which provides the
+parameter linkage between the various functional tasks like
+\fBapfind\fR, \fBaptrace\fR, \fBapsum\fR, etc.  Below is a reproduction
+of this parameter set.
+
+.ce
+APPARAMS Hidden Parameter Set
+
+.nf
+				   I R A F  
+                    Image Reduction and Analysis Facility
+PACKAGE = apextract
+   TASK = apparams
+    
+(format =            )_.format) Extracted spectra format
+(extras =        )apsum.extras) Extract sky, sigma, etc.?
+(dbwrite=                  yes) Write to database?
+(initial=                  yes) Initialize answers?
+(verbose=           )_.verbose) Verbose output?
+                                
+                                # DEFAULT APERTURE PARAMETERS
+
+(upper  =     )apdefault.upper) Upper aperture limit relative to center
+(apidtab= )apdefault.apidtable) Aperture ID table (optional)
+                                
+                                # DEFAULT BACKGROUND PARAMETERS
+
+(b_funct= )apdefault.b_function) Background function
+(b_order=   )apdefault.b_order) Background function order
+(b_sampl=  )apdefault.b_sample) Background sample regions
+(b_naver= )apdefault.b_naverage) Background average or median
+(b_niter= )apdefault.b_niterate) Background rejection iterations
+(b_low_r= )apdefault.b_low_reject) Background lower rejection sigma
+(b_high_= )apdefault.b_high_reject) Background upper rejection sigma
+(b_grow =    )apdefault.b_grow) Background rejection growing radius
+                                
+                                # APERTURE CENTERING PARAMETERS
+
+(width  =        )apedit.width) Profile centering width
+(radius =       )apedit.radius) Profile centering radius
+(thresho=    )apedit.threshold) Detection threshold for profile centering
+                                
+                                # AUTOMATIC FINDING AND ORDERING PARAMETERS
+
+(nfind  =        )apfind.nfind) Number of apertures to be found automatically
+(minsep =       )apfind.minsep) Minimum separation between spectra
+(maxsep =       )apfind.maxsep) Maximum separation between spectra
+(order  =        )apfind.order) Order of apertures
+                                
+                                # RECENTERING PARAMETERS
+
+(apertur= )aprecenter.apertures) Select apertures
+(npeaks =   )aprecenter.npeaks) Select brightest peaks
+(shift  =    )aprecenter.shift) Use average shift instead of recentering?
+                                
+                                # RESIZING PARAMETERS
+
+(llimit =     )apresize.llimit) Lower aperture limit relative to center
+(ulimit =     )apresize.ulimit) Upper aperture limit relative to center
+(ylevel =     )apresize.ylevel) Fraction of peak or intensity for automatic widt(peak   =       )apresize.peak) Is ylevel a fraction of the peak?
+(bkg    =        )apresize.bkg) Subtract background in automatic width?
+(r_grow =     )apresize.r_grow) Grow limits by this factor
+(avglimi=  )apresize.avglimits) Average limits over all apertures?
+                                
+                                # EDITING PARAMETERS
+
+e_output=                       Output spectra rootname
+e_profil=                       Profile reference image
+(t_nsum =        )aptrace.nsum) Number of dispersion lines to sum
+(t_step =        )aptrace.step) Tracing step
+(t_width=        )apedit.width) Centering width for tracing
+(t_funct=    )aptrace.function) Trace fitting function
+(t_order=       )aptrace.order) Trace fitting function order
+(t_sampl=      )aptrace.sample) Trace sample regions
+(t_naver=    )aptrace.naverage) Trace average or median
+(t_niter=    )aptrace.niterate) Trace rejection iterations
+(t_low_r=  )aptrace.low_reject) Trace lower rejection sigma
+(t_high_= )aptrace.high_reject) Trace upper rejection sigma
+(t_grow =        )aptrace.grow) Trace rejection growing radius
+                                
+                                # EXTRACTION PARAMETERS
+
+(backgro=    )apsum.background) Background to subtract (none|average|fit)
+(skybox =        )apsum.skybox) Box car smoothing length for sky
+(weights=       )apsum.weights) Extraction weights (none|variance)
+(clean  =         )apsum.clean) Detect and replace bad pixels?
+(niterat=                    2) Number of profile fitting iterations
+(saturat=    )apsum.saturation) Saturation level
+(readnoi=     )apsum.readnoise) Read out noise sigma (photons)
+(gain   =          )apsum.gain) Photon gain (photons/data number)
+(lsigma =        )apsum.lsigma) Lower rejection threshold
+(usigma =        )apsum.usigma) Upper rejection threshold
+(maxtilt=                    3) Maximum excursion for line/column fitting
+(polysep=                 0.95) Marsh algorithm polynomial spacing
+(polyord=                   10) Marsh algorithm polynomial order
+(nsubaps=       )apsum.nsubaps) Number of subapertures per aperture
+                                
+                                # ANSWER PARAMETERS
+
+(ansclob=                   no)  
+(ansclob=                   no)  
+(ansdbwr=                  yes)  
+(ansdbwr=                  yes)  
+(ansedit=                  yes)  
+(ansextr=                  yes)
+(ansfind=                  yes)  
+(ansfit =                  yes)  
+(ansfits=                  yes)  
+(ansfits=                  yes)  
+(ansfits=                  yes)  
+(ansfits=                  yes)  
+(ansfitt=                  yes)  
+(ansfitt=                  yes)  
+(ansflat=                  yes)  
+(ansmask=                  yes)  
+(ansnorm=                  yes)  
+(ansrece=                  yes)  
+(ansresi=                  yes)  
+(ansrevi=                  yes)  
+(ansrevi=                  yes)  
+(ansscat=                  yes)  
+(anssmoo=                  yes)  
+(anstrac=                   no)  
+(mode   =                    q)
+.fi
+
+Note how the parameters are redirected to a variety of tasks.
+
+
+\fBInvisible Parameters\fR
+
+The following algorithm parameters are not visible to the normal user
+and are described only here.
+.ls dbwrite = yes
+Write to database?  Writing to the database is a function just like
+find, edit, extract, etc.  When the task is interactive a query is
+made whether to write to the database which may be answered with the
+usual four values.  When noninteractive the database writing is automatic.
+This parameter provides the possibility of turning off database writing.
+.le
+.ls initialize = yes
+Initialize default queries?  Normally each invocation of a task results
+in new queries independent of the last responses in a prior invocation
+and based only on the functions selected; NO for those not selected and
+yes for those selected.  By setting this to no either the prior values
+may be used or the response values may be set independently of the
+function flags.  This is used in scripts to tie together different
+invocations of the task and to finely control the queries.
+.le
+.ls e_output, e_profile
+These are query parameters used when extraction is invoked from the
+aperture editor.
+.le
+ 
+The following parameters are part of the variance weighted and cleaning
+extractions.  They are described further in \fBapprofiles\fR.
+.ls niterate = 2
+Number of rejection iterations in the profile determination when cleaning.
+Iteration of the profile is slow and the low order fitting function
+is not very sensitive to deviant points.
+.le
+.ls maxtilt = 3
+Maximum excursion separating the two profile fitting algorithms.
+.le
+.ls polysep = 0.95
+Marsh algorithm polynomial spacing.
+.le
+.ls polyorder = 10
+Marsh algorithm polynomial order.
+.le
+
+
+\fBQuery Mechanism and Invisible Query Parameters\fR
+
+The querying mechanism of the \fBapextract\fR package is a nice feature
+but has some complexities in implementation.  At the bottom of the
+mechanism are CL checks of the parameters described below.  The parameter
+is accessed first as a hidden parameter.  If the value is YES or NO
+then the appropriate function is performed or not.  If the value is
+lower case then the task supplies a prompt string, which varies by
+including the image and/or aperture involved, the mode of the
+parameter is changed to query, and the parameter is requested again
+leading to a CL query of the user with the current default value.
+Finally, the parameter is returned to hidden mode.
+
+If the \fIinitialize\fR parameter is no then the initial default
+query values are those set before the task is invoked.  This provides
+very fine control of the query mechanism and linking different
+invocations of the tasks to previous user responses.   It is intended
+only for complex scripts such as those in the spectroscopic \fBimred\fR
+packages.  Normally the initial values of the parameters are set
+during task startup  based on the function flags.  If a flag is no
+then the related query parameter is NO.  If the function flag is yes
+then when the task is interactive the initial value is yes otherwise
+it is YES.  The solely interactive functions, such as editing, are
+set to NO when the task is noninteractive regardless of the function
+selection.
+.ls ansclobber, ansclobber1
+Used to define the action to be taken if an output image would be clobbered.
+Normally the action is to query if interactive and not clobber if
+noninteractive.  The first parameter acts as the function switch and
+the second as the actual query.
+.le
+.ls ansdbwrite, ansdbwrite1
+The second parameter is used by the task to mark whether any changes have
+been made that might require a database update.  The first parameter is
+the actual query parameter for the \fIdbwrite\fR function flag.
+.le
+.ls ansedit
+Query parameter for the interactive editing function.
+.le
+.ls ansextract
+Query parameter for the extraction function.
+.le
+.ls ansfind
+Query parameter for the find function.
+.le
+.ls ansfit
+Query parameter for the fit function of \fBapfit\fR.
+.le
+.ls ansfitscatter
+Query parameter for the interactive fitscatter function of \fBapscatter\fR.
+.le
+.ls ansfitsmooth
+Query parameter for the interactive fitsmooth function of \fBapscatter\fR.
+.le
+.ls ansfitspec
+Query parameter for the interactive fitspec function of \fBapflatten\fR
+and \fBapnormalize\fR.  This applies to each image.
+.le
+.ls ansfitspec1
+Query parameter for the interactive fitspec function of \fBapflatten\fR
+and \fBapnormalize\fR.  This applies to each aperture in an image.
+.le
+.ls ansfittrace
+Query parameter for the interactive fittrace function.
+This applies to each image.
+.le
+.ls ansfittrace1
+Query parameter for the interactive fittrace function.
+This applies to each aperture in an image.
+.le
+.ls ansflat
+Query parameter for the flatten function of \fBapflatten\fR.
+.le
+.ls ansmask
+Query parameter for the mask function of \fBapmask\fR.
+.le
+.ls ansnorm
+Query parameter for the normalize function of \fBapnormalize\fR.
+.le
+.ls ansrecenter
+Query parameter for the recenter function.
+.le
+.ls ansresize
+Query parameter for the resize function.
+.le
+.ls ansreview
+Query parameter for the interactive extraction review function.
+This applies to each image.
+.le
+.ls ansreview1
+Query parameter for the interactive extraction review function.
+This applies to each aperture in an image.
+.le
+.ls ansscat
+Query parameter for the subtract function of \fBapscatter\fR.
+.le
+.ls anssmooth
+Query parameter for the smooth function of \fBapscatter\fR.
+.le
+.ls anstrace
+Query parameter for the trace function.
+.le
+
+
+\fBTask Entry Points\fR
+
+Logical tasks in IRAF are organized as multiple procedures in one physical
+task selected by the IRAF main.  The \fBapextract\fR package extends
+this concept to a lower level.  All of the package tasks go through
+one procedure, \fBapall\fR.  This procedure handles all of the
+startup details and breaks the logical task down into selected
+functions which are implemented as other procedures.  There are
+a couple of interesting and unusual features of this organization.
+
+IRAF physical tasks may map multiple logical task names to the same
+procedure.  However, the procedure will not know under what name it
+was called.  In this package we want to know the logical task name
+in order to select the appropriate hidden parameter set and to
+make minor adjustments in what the tasks do while maintaining the
+same basic logical flow and source code.  To do this dummy entry
+points are used whose only function is to call \fBapall\fR and
+pass an indication of the task name.
+
+Based on the task name a named parameter set is opened with \fBclopset\fR
+and then all CLIO calls use the returned pointer and can be blind to the
+actual parameter set used.
+
+In addition to the tasks defined in the package and their associated
+parameter sets there is one more task entry point called \fBapscript\fR
+with parameter set \fBapscript\fR.  It is intended for use in scripts
+as it's name implies.  For this reason it does not need an intermediate
+hidden parameter set.  For examples of it's use see the \fBimred\fR
+packages such as \fBnessie\fR.
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apextras.hlp b/noao/twodspec/apextract/doc/apextras.hlp
new file mode 100644
index 00000000..36a51b26
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apextras.hlp
@@ -0,0 +1,61 @@
+.help extras Sep95 noao.twodspec.apextract
+.ih
+NAME
+extras -- Information about the extra bands in 3D output
+.ih
+DESCRIPTION
+When one dimensional spectra are extracted by the tasks in the
+\fBapextract\fR package the user may specify that additional
+extra associated information be extracted at the same time.  This
+information is produced when the \fIextras\fR parameter is "yes".
+
+The associated information is recorded as additional "bands" (the IRAF term
+for the third dimension of a three dimensional image) of the output
+extracted spectral image.  Extracted spectra are currently stored as IRAF
+images with dispersion information given in the image header.  The
+image axes for such images are:
+
+.nf
+    1 (columns) - dispersion axis
+    2 (lines)   - spectrum axis (each line is a separate spectrum)
+    3 (bands)   - extras axis (each band is associated data)
+.fi
+
+The lengths of the second and third axes, that is the number of
+lines and bands, may be one or more.  If there is only one band
+the image will be two dimensional and if there is only one line
+and one band the image will be one dimensional.  Note that the
+\fIformat\fR parameter controls whether multiple apertures are
+written to separate images or to a single image.  Thus, if
+the format is "onedspec" this means that the second dimension
+will always be of length one and, if the \fIextras\fR parameter
+is no, the output images will be one dimensional.
+
+The associated data in the image bands depends on which extraction
+options are performed.  The various types of data are:
+
+.nf
+    The primary spectrum flux values.
+    Simple aperture sum if variance weighting or cleaning was done.
+    Background spectrum if background subtraction was done.
+    Sigma spectrum if variance weighting or cleaning was done.
+.fi
+
+The primary spectrum is always the first band and will be the cleaned
+and/or variance weighted and/or background subtracted spectrum.  The
+simple aperture sum spectrum allows comparing against the results of the
+variance weighting or pixel rejection options.  When background
+subtraction is performed the subtracted background is recorded in
+one of the bands.  When variance weighting or pixel rejection is
+performed the software generates an estimate of the uncertainty
+in the extracted flux as a sigma.
+
+The identity of the various bands is given by the image header
+keywords BANDIDn (where n is the band number).  This also serves
+to document which extraction options were used.
+
+For more information get help under the topic "apextract.package".
+.ih
+SEE ALSO
+apextract.package
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apfind.hlp b/noao/twodspec/apextract/doc/apfind.hlp
new file mode 100644
index 00000000..65260394
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apfind.hlp
@@ -0,0 +1,180 @@
+.help apfind Sep96 noao.twodspec.apextract
+.ih
+NAME
+apfind -- Find spectra and define apertures automatically
+.ih
+USAGE
+apfind input
+.ih
+PARAMETERS
+.ls input
+List of input images in which spectra are to be identified and
+apertures defined automatically.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = no
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing is
+disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database and the
+parameter \fInfind\fR must be greater than zero.
+.le
+.ls recenter = no
+Recenter the apertures?
+.le
+.ls resize = no
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+
+.ls line = INDEF
+The dispersion line (line or column perpendicular to the dispersion axis) to
+be used in finding the spectra.  A value of INDEF selects the middle of the
+image.
+.le
+.ls nsum = 1
+Number of dispersion lines to be summed or medianed.  The lines are taken
+around the specified dispersion line.  A positive value sums lines and
+a negative value medians lines.
+.le
+.ls nfind = 1
+Maximum number of apertures to be defined.  This is a query parameter
+so the user is queried for a value except when given explicitly on
+the command line.
+.le
+.ls minsep = 5.
+Minimum separation between spectra.  Weaker spectra or noise within this
+distance of a stronger spectrum are rejected.
+.le
+.ls maxsep = 1000.
+Maximum separation between adjacent spectra.  This parameter
+is used to identify missing spectra in uniformly spaced spectra produced
+by fiber spectrographs.  If two adjacent spectra exceed this separation
+then it is assumed that a spectrum is missing and the aperture identification
+assignments will be adjusted accordingly.
+.le
+.ls order = "increasing"
+When assigning aperture identifications order the spectra "increasing"
+or "decreasing" with increasing pixel position (left-to-right or
+right-to-left in a cross-section plot of the image).
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters are taken from the
+task \fBapdefault\fR, and parameters used for centering and editing the
+apertures are taken from \fBapedit\fR.
+
+When this operation is performed from the task \fBapall\fR all parameters
+except the package parameters are included in that task.
+.ih
+DESCRIPTION
+For each image in the input image list spectra are identified and
+default apertures defined.  The automatic aperture finding is performed
+only if 1) there are no apertures defined for the reference image, 2)
+there are no apertures defined for the input image, 3) the parameter
+\fIfind\fR is yes, and 4) the parameter \fInfind\fR is greater than
+zero.
+
+The automatic finding algorithm uses the following steps.  First, all local
+maxima are found.  The maxima are sorted by peak value and the weaker
+of the peaks separated by less than the value given by the parameter
+\fIminsep\fR are rejected.  Finally, at most the \fInfind\fR strongests
+peaks are kept.  \fBNfind\fR is a query parameter, so if it is not
+specified explicitly on the command line, the desired number of spectra
+to be found is requested.  After the peaks have been found the
+\fBcenter1d\fR algorithm is used to refine the centers of the
+profiles.  Apertures having the default parameters set with the task
+\fBapdefault\fR are defined at each center.  This algorithm is also
+available with the 'f' key in the task \fBapedit\fR with the change that
+existing apertures are kept and count toward the maximum number
+specified by \fBnfind\fR.
+
+The automatic assignment of aperture numbers, beam numbers, and titles
+has several options.  The simplest is when no aperture identification
+table, parameter \fIapidtable\fR, is specified and the maximum separation
+parameter, \fImaxsep\fR, is very large.  In this case the aperture and
+beam numbers are sequential starting from one and numbered either from
+left-to-right or right-to-left depending on the \fIorder\fR parameter.
+There are no aperture titles in this case.  If two adjacent spectra are
+separated by more than the specified maximum then the aperture numbers
+jump by the integer part of the ratio of the separation to the
+specified maximum separation.  This is used when the image is expected
+to have evenly spaced spectra, such as in multifiber spectrographs, in
+which some may be missing due to broken fibers.  Finally, the
+aperture identification table (either a text file or an image
+having a set of SLFIBnnn keyowrds) may contain lines with aperture number,
+beam number, and (optional) title.  The sequential numbers are then
+indices into this table.  Note that the skipping of missing spectra and
+the ordering applies to entries in this table as well.
+
+The ways in which the automatic method can fail for evenly spaced
+spectra with missing members are when the first spectrum is missing on
+the side from which the ordering begins and when the expected rather
+the actual number of spectra is used.  In the first case one can use
+the interactive 'o' key of the aperture editing facility to specify the
+identity of any aperture and then all other apertures will be
+appropriately reidentified.  If more spectra are sought than actually
+exist then noise spikes may be mistakenly found.  This problem can be
+eliminated by specifying the actual number of spectra or minimized by
+using the threshold centering parameter.
+
+The \fIrecenter\fR parameter allows recentering apertures if defined by
+a reference image.  Since the purpose of this task is to find new
+apertures it is usually the case that there are no reference images and
+recentering is not done.  The default apertures are of fixed width.
+The \fIresize\fR parameter may be used to adjust the widths in a
+variety of ways.  The aperture positions and any other parameters may
+also be edited with the aperture editing function if selected by the
+\fIapedit\fR parameter and the task is run interactively.
+
+If the task is interactive the user is queried whether to perform
+various steps on each image.  The queries may be answered with one of
+the four values "yes", "no", "YES" and "NO", where an upper case
+response suppresses all further queries to this question.
+
+The aperture finding algorithm may be selected from nearly every task
+in the package.
+.ih
+EXAMPLES
+	cl> apfind image nfind=10
+.ih
+.ih
+REVISIONS
+.ls APFIND V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+
+The aperture ID table information may now be contained in the
+image header under the keywords SLFIBnnn.
+.le
+SEE ALSO
+center1d, apdefault, aprecenter, apresize, apedit, apall
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apfit.hlp b/noao/twodspec/apextract/doc/apfit.hlp
new file mode 100644
index 00000000..60dd9b4c
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apfit.hlp
@@ -0,0 +1,263 @@
+.help apfit Sep96 noao.twodspec.apextract
+.ih
+NAME
+apfit -- Fit 2D spectra using APEXTRACT profile algorithms
+.ih
+USAGE
+apfit input output fittype
+.ih
+PARAMETERS
+.ls input
+List of input images to be fit.
+.le
+.ls output = ""
+List of output images to be created with the  fitting results.  If the null
+string is given or the end of the output list is reached before the end
+of the input list then the input image name is used and an extension
+of ".fit", ".diff", or ".ratio" is added based on the type of fit.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and fit.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls fittype = "difference"
+Type of fitted output.  The choices are:
+.ls "fit"
+The fitted spectra are output.
+.le
+.ls "difference"
+The difference (or residuals) of the data and the fit (data - fit).
+.le
+.ls "ratio"
+The ratio of the data to the fit.  If a fitted pixel goes below a specified
+threshold the ratio is set to 1.
+.le
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing and trace
+fitting are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+.ls fit = yes
+Fit the spectra and produce a fitted output image?
+.le
+
+The following two parameters are used in the finding, recentering, resizing,
+editing, and tracing operations.
+.ls line = INDEF
+The starting dispersion line (line or column perpendicular to the dispersion
+axis) for the tracing.  A value of INDEF starts at the middle of the image.
+.le
+.ls nsum = 1
+Number of dispersion lines to be summed or medianed at each step along
+the dispersion.  For tracing only summing is done and the sign is
+ignored.
+.le
+
+.ls threshold = 10.
+Division threshold for ratio fit type.  If a pixel in the fitted spectrum
+is less than this value then a ratio of 1 is output.
+.le
+
+The following parameters control the profile and spectrum fitting.
+.ls background = "none"
+Type of background subtraction.  The choices are "none" for no
+background subtraction, "average" to average the background within the
+background regions, or "fit" to fit across the dispersion using the
+background within the background regions.  Note that the "average"
+option does not do any medianing or bad pixel checking; it is faster
+than fitting however.  Background subtraction also requires that the
+background fitting parameters are properly defined.  For the "average"
+option only the background sample regions parameter is used.
+.le
+.ls pfit = "fit1d" (fit1d|fit2d)
+Profile fitting algorithm to use with variance weighting or cleaning.
+When determining a profile the two dimensional spectrum is divided by
+an estimate of the one dimensional spectrum to form a normalized two
+dimensional spectrum profile.  This profile is then smoothed by fitting
+one dimensional functions, "fit1d", along the lines or columns most closely
+corresponding to the dispersion axis or a special two dimensional
+function, "fit2d", described by Marsh (see \fBapprofile\fR).
+.le
+.ls clean = no
+Detect and replace deviant pixels?
+.le
+.ls skybox = 1
+Box car smoothing length for sky background when using background
+subtraction.  Since the background noise is often the limiting factor
+for good extraction one may box car smooth the sky to improve the
+statistics in smooth background regions at the expense of distorting
+the subtraction near spectral features.  This is most appropriate when
+the sky regions are limited due to a small slit length.
+.le
+.ls saturation = INDEF
+Saturation or nonlinearity level.  During variance weighted extractions
+wavelength points having any pixels above this value are excluded from the
+profile determination.
+.le
+.ls readnoise = 0.
+Read out noise in photons.  This parameter defines the minimum noise
+sigma.  It is defined in terms of photons (or electrons) and scales
+to the data values through the gain parameter.  A image header keyword
+(case insensitive) may be specified to get the value from the image.
+.le
+.ls gain = 1
+Detector gain or conversion factor between photons/electrons and
+data values.  It is specified as the number of photons per data value.
+A image header keyword (case insensitive) may be specified to get the value
+from the image.
+.le
+.ls lsigma = 3., usigma = 3.
+Lower and upper rejection thresholds, given as a number of times the
+estimated sigma of a pixel, for cleaning.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+.ih
+DESCRIPTION
+The two dimensional spectra within the defined apertures of the input
+images are fit by a model and new output images are created with either
+the model spectra, the difference between the input and model spectra,
+or the ratio of input and model spectra.  The type of output is
+selected by the parameter \fIfittype\fR which may have one of the
+values "fit", "difference", or "ratio".
+
+Aperture definitions may be inherited from those of other images by
+specifying a reference image with the \fBreferences\fR parameter.
+Images in the reference list are matched with those in the
+input list in order.  If the reference image list is shorter than the
+number of input images, the last reference image is used for all
+remaining input images.  Thus, a single reference image may be given
+for all the input images or different reference images may be given for
+each input image.  The special reference name "last" may be used to
+select the last set apertures used in any of the \fBapextract\fR tasks.
+
+If an aperture reference image is not specified or no apertures are
+found for the specified reference image, previously defined apertures
+for the input image are sought in the aperture database.  Note that
+reference apertures supersede apertures for the input image.  If no
+apertures are defined they may be created automatically, the \fIfind\fR
+option, or interactively in the aperture editor, if the
+\fIinteractive\fR and \fIedit\fR options are set.
+
+The functions performed by the task are selected by a set of flag
+parameters.  The functions are an automatic spectrum finding and
+aperture defining algorithm (see \fBapfind\fR) which is ignored if
+apertures are already defined, automatic recentering and resizing
+algorithms (see \fBaprecenter\fR and \fBapresize\fR), an interactive
+aperture editing function (see \fBapedit\fR), a spectrum position tracing
+and trace function fit (see \fBaptrace\fR), and the main function of
+this task, two dimensional model fitting.
+
+Each function selection will produce a query for each input spectrum if
+the \fIinteractive\fR parameter is set.  The queries are answered by
+"yes", "no", "YES", or "NO", where the upper case responses suppress
+the query for following images.  There are other queries associated
+with tracing which first ask whether the operation is to be done
+interactively and, if yes, lead to queries for each aperture.  If the
+\fIinteractive\fR parameter is not set then aperture editing and
+interactive trace fitting are ignored.
+
+The two dimensional spectrum model consists of a smooth two dimensional
+normalized profile multiplied by the variance weighted one dimensional
+spectrum.  The profile is computed by dividing the data within the aperture
+by the one dimensional spectrum, smoothing with either low order function
+fits parallel to the dispersion axis or a special two dimensional function
+as selected by the \fIpfit\fR parameter.  The smooth profile is then used
+to improve the spectrum estimate using variance weighting and to eliminate
+deviant or cosmic ray pixels by sigma tests.  The profile algorithm is
+described in detail in \fBapprofiles\fR and the variance weighted spectrum
+is described in \fBapvariance\fR.
+
+The process of determining the profile and variance weighted spectrum,
+and hence the two dimensional spectrum model, is identical to that used
+for variance weighted extraction of the one dimensional spectra in the
+tasks \fBapall\fR or \fBapsum\fR.  Most of the parameters of in this
+task are the same as those in the extraction tasks and so further
+information about them may be found in the descriptions of those tasks.
+
+Because of the connection with variance weighted extraction and cleaning
+of one dimensional spectra, this task is useful as a diagnostic tool for
+understanding and evaluating the variance weighting algorithm.
+For example the "difference" image provides the residuals in a
+two dimensional visual form.
+
+The "fit" output image does not include any background determination;
+i.e the fit is background subtracted.  Pixels outside the modeled
+spectra are set to zero.
+
+The "difference" output image is simply the difference between the
+background subtracted "fit" and the data.  Thus the difference within
+the apertures should approximate the background and outside the
+apertures the difference will be identical with the input image.
+
+The "ratio" output image does include any background in the model
+before taking the ratio of the data and model.  If a model pixel
+is less than the given \fIthreshold\fR parameter the output ratio
+is set to one.  This is used to avoid division by zero and set a
+limit to noise in ratio image.  Outside of the apertures the ratio
+output pixels are set to one.
+.ih
+EXAMPLES
+1.  To compute the residuals of a model fit where the image already has
+aperture defined:
+
+	cl> apfit ls1 inter- rec- res- trace- read=3 gain=1 back=fit
+
+.ih
+REVISIONS
+.ls APFIND V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+apbackground, approfile, apvariance,
+apdefault, apfind, aprecenter, apresize, apedit, aptrace, apsum, apall
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apflatten.hlp b/noao/twodspec/apextract/doc/apflatten.hlp
new file mode 100644
index 00000000..f7e1b8c0
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apflatten.hlp
@@ -0,0 +1,304 @@
+.help apflatten Sep96 noao.twodspec.apextract
+.ih
+NAME
+apflatten -- Create flat fields for fiber or narrow aperture spectra
+.ih
+USAGE
+apflatten input output
+.ih
+PARAMETERS
+.ls input
+List of input flat field observations.
+.le
+.ls output = ""
+List of output flat field images.  If no output name is given then the
+input name is used as a root with the extension ".flat".
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and flatten.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing and trace
+fitting are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+.ls flatten = yes
+Remove the profile shape and flat field spectrum leaving only
+sensitivity variations?
+.le
+.ls fitspec = yes
+Fit normalization spectrum interactively?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+
+.ls line = INDEF, nsum = 1
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  For tracing this is the starting line and
+the same number of lines are summed at each tracing point.  A line of
+INDEF selects the middle of the image along the dispersion axis.
+A positive nsum sums the lines and a negative value takes the median.
+However, for tracing only sums are allowed and the absolute value
+is used.
+.le
+.ls threshold = 10.
+Division threshold.  If a pixel in the two dimensional normalization spectrum
+is less than this value then a flat field value of 1 is output.
+.le
+
+The following parameters control the profile and spectrum fitting.
+.ls pfit = "fit1d" (fit1d|fit2d)
+Profile fitting algorithm to use with variance weighting or cleaning.
+When determining a profile the two dimensional spectrum is divided by
+an estimate of the one dimensional spectrum to form a normalized two
+dimensional spectrum profile.  This profile is then smoothed by fitting
+one dimensional functions, "fit1d", along the lines or columns most closely
+corresponding to the dispersion axis or a special two dimensional
+function, "fit2d", described by Marsh (see \fBapprofile\fR).
+.le
+.ls clean = no
+Detect and replace deviant pixels?
+.le
+.ls saturation = INDEF
+Saturation or nonlinearity level.  During variance weighted extractions
+wavelength points having any pixels above this value are excluded from the
+profile determination.
+.le
+.ls readnoise = 0.
+Read out noise in photons.  This parameter defines the minimum noise
+sigma.  It is defined in terms of photons (or electrons) and scales
+to the data values through the gain parameter.  A image header keyword
+(case insensitive) may be specified to get the value from the image.
+.le
+.ls gain = 1
+Detector gain or conversion factor between photons/electrons and
+data values.  It is specified as the number of photons per data value.
+A image header keyword (case insensitive) may be specified to get the value
+from the image.
+.le
+.ls lsigma = 3., usigma = 3.
+Lower and upper rejection thresholds, given as a number of times the
+estimated sigma of a pixel, for cleaning.
+.le
+
+The following parameters are used to fit the normalization spectrum using
+the ICFIT routine.
+.ls function = "legendre"
+Fitting function for the normalization spectra.  The choices are "legendre"
+polynomial, "chebyshev" polynomial, linear spline ("spline1"), and
+cubic spline ("spline3").
+.le
+.ls order = 1
+Number of polynomial terms or number of spline pieces for the fitting function.
+.le
+.ls sample = "*"
+Sample regions for fitting points.  Intervals are separated by "," and an
+interval may be one point or a range separated by ":".
+.le
+.ls naverage = 1
+Number of points within a sample interval to be subaveraged or submedianed to
+form fitting points.  Positive values are for averages and negative points
+for medians.
+.le
+.ls niterate = 0
+Number of sigma clipping rejection iterations.
+.le
+.ls low_reject = 3. , high_reject = 3.
+Lower and upper sigma clipping rejection threshold in units of sigma determined
+from the RMS sigma of the data to the fit.
+.le
+.ls grow = 0.
+Growing radius for rejected points (in pixels).  That is, any rejected point
+also rejects other points within this distance of the rejected point.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+.ih
+DESCRIPTION
+It is sometimes the case that it is undesirable to simply divide
+two dimensional format spectra taken through fibers, aperture masks
+with small apertures such as holes and slitlets, or small slits in
+echelle formats by a flat field observation of a lamp.  This is due
+to the sharp dropoff of the flat field and object profiles and
+absence of signal outside of the profile.  Slight shifts or changes
+in profile shape introduce bad edge effects, unsightly "grass" is
+produced where there is no signal (which may also confuse extraction
+programs), and the division will also remove the characteristic
+profile of the object which might be needed for tracking the
+statistical significance, variance weighted extraction, and more.
+A straight flat field division also has the problem of changing the
+shape of the spectrum in wavelength, again compromising the
+poisson statistics and artificially boosting low signal regions.
+
+There are three approaches to consider.  First, the
+flat field correction can be done after extraction to one dimension.
+This is valid provided the flat field and object profiles don't shift
+much.  However, for extractions that depend on a smooth profile,
+such as the variance weighting algorithms of this package, the sensitivity
+corrections must remain small; i.e. no large fringes or other
+small scale variations that greatly perturb the true photon profile.
+The second approach is to divide out the overall spectral shape of
+the flat field spectrum, fill regions outside of the signal with
+one and leave the profile shape intact.  This will still cause profile
+division problems described earlier but is mentioned here since it
+implemented in a related task called \fBapnormalize\fR.  The last
+approach is to model both the profile and overall spectrum shape and
+remove it from the flat field leaving only the sensitivity variations.
+This is what the task \fBapflatten\fR does.
+
+The two dimensional flat field spectra within the defined apertures of
+the input images are fit by a model having the profile of the data and
+a smooth spectral shape.  This model is then divided into the flat
+field image within the aperture, replacing points of low signal, set
+with the \fIthreshold\fR parameter, within the aperture and all points
+outside the aperture by one to produce an output sensitivity variation
+only flat field image.
+
+A two dimensional normalized profile is computed by dividing the data
+within the aperture by the one dimensional spectrum and smoothing with
+low order function fits parallel to the dispersion axis if the aperture
+is well aligned with the axis or parallel to the traced aperture center
+if the trace is tilted relative to the dispersion axis.  The smooth
+profile is then used to improve the spectrum estimate using variance
+weighting and to eliminate deviant or cosmic ray pixels by sigma
+tests.  The profile algorithm is described in detail in
+\fBapprofiles\fR and the variance weighted spectrum is described in
+\fBapvariance\fR.
+
+The process of determining the profile and variance weighted spectrum,
+and hence the two dimensional spectrum model, is identical to that used
+for variance weighted extraction of the one dimensional spectra in the
+tasks \fBapall\fR or \fBapsum\fR and in making a two dimensional
+spectrum model in the task \fBapfit\fR.  Most of the parameters in
+this task are the same in those tasks and so further information about
+them may be found in their descriptions.  In fact, up to this point the
+task is the same as \fBapfit\fR and, if the flat field were normalized
+by this model it would produce the "ratio" output of that task.
+
+This task deviates from \fBapfit\fR in that the final variance weighted
+one dimensional spectrum of the flat field is subjected to a smoothing
+operation.  This is done by fitting a function to the spectrum using
+the \fBicfit\fR routine.  This may be done interactively or
+noninteractively depending on the \fBinteractive\fR parameter.  The
+default fitting parameters are part of this task.  The goal of the
+fitting is to follow the general spectral shape of the flat field light
+(usually a lamp) but not the small bumps and wiggles which are the one
+dimensional projection of sensitivity variations.  When the fitted
+function is multiplied into the normalize profile and then the two
+dimensional model divided into the data the sensitivity variations not
+part of the fitted spectrum are what is left in the final output flat
+field.
+
+The remainder of this description covers the basic steps defining the
+apertures to be used.  These steps and parameter are much the same as
+in any of the other \fBapextract\fR tasks.
+
+Aperture definitions may be inherited from those of other images by
+specifying a reference image with the \fBreferences\fR parameter.
+Images in the reference list are matched with those in the input list
+in order.  If the reference image list is shorter than the number of
+input images, the last reference image is used for all remaining input
+images.  Thus, a single reference image may be given for all the input
+images or different reference images may be given for each input
+image.  The special reference name "last" may be used to select the
+last set apertures used in any of the \fBapextract\fR tasks.
+
+If an aperture reference image is not specified or no apertures are
+found for the specified reference image, previously defined apertures
+for the input image are sought in the aperture database.  Note that
+reference apertures supersede apertures for the input image.  If no
+apertures are defined they may be created automatically, the \fIfind\fR
+option, or interactively in the aperture editor, if the
+\fIinteractive\fR and \fIedit\fR options are set.
+
+The functions performed by the task are selected by a set of flag
+parameters.  The functions are an automatic spectrum finding and
+aperture defining algorithm (see \fBapfind\fR) which is ignored if
+apertures are already defined, automatic recentering and resizing
+algorithms (see \fBaprecenter\fR and \fBapresize\fR), an interactive
+aperture editing function (see \fBapedit\fR), a spectrum position tracing
+and trace function fit (see \fBaptrace\fR), and the main function of
+this task, the flat field profile and spectral shape modeling and removal.
+
+Each function selection will produce a query for each input spectrum if
+the \fIinteractive\fR parameter is set.  The queries are answered by
+"yes", "no", "YES", or "NO", where the upper case responses suppress
+the query for following images.  There are other queries associated
+with tracing which first ask whether the operation is to be done
+interactively and, if yes, lead to queries for each aperture.  If the
+\fIinteractive\fR parameter is not set then aperture editing
+interactive trace fitting, and interactive spectrum shape fitting are ignored.
+.ih
+REVISIONS
+.ls APFLATTEN V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+EXAMPLES
+1.  To make a two dimensional flat field from a lamp observation:
+
+.nf
+	cl> apflatten fiber1 flat read=3 gain=1 back=fit
+	Yes find
+	No resize
+	No edit
+	Yes trace
+	Yes trace interactively
+	NO
+	Yes flatten
+	Yes fit interactively
+.fi
+.ih
+SEE ALSO
+apbackground, approfile, apvariance, apfit, icfit,
+apdefault, apfind, aprecenter, apresize, apedit, aptrace, apsum
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apmask.hlp b/noao/twodspec/apextract/doc/apmask.hlp
new file mode 100644
index 00000000..78d775f9
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apmask.hlp
@@ -0,0 +1,123 @@
+.help apmask Sep96 noao.twodspec.apextract
+.ih
+NAME
+apmask -- Make pixel mask from apertures definitions
+.ih
+USAGE
+apfind input
+.ih
+PARAMETERS
+.ls input
+List of input images with aperture definitions.
+.le
+.ls output
+List of output mask names.  As a convention the extension ".pl" (pixel
+list) should be used.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and create a mask.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = no
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing is
+disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database and the
+parameter \fInfind\fR must be greater than zero.
+.le
+.ls recenter = no
+Recenter the apertures?
+.le
+.ls resize = no
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace apertures?
+.le
+.ls fittrace = yes
+Fit the traced points interactively?  The \fIinteractive\fR parameter
+must also be yes.
+.le
+.ls mask = yes
+Create mask images?
+.le
+
+.ls line = INDEF
+The dispersion line (line or column perpendicular to the dispersion axis) to
+be used in finding, recentering, resizing, editing, and starting to
+trace spectra.  A value of INDEF selects the middle of the image.
+.le
+.ls nsum = 1
+Number of dispersion lines to be summed or medianed.  The lines are taken
+around the specified dispersion line.  A positive value takes the
+sum and a negative value selects a median.
+.le
+.ls buffer = 0.
+Buffer to add to aperture limits.  One use for this is to increase
+the width of the apertures when a mask is used to fit data between
+the apertures.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+.ih
+DESCRIPTION
+Pixel list masks are created from the aperture definitions in the input
+images.  Pixel list masks are a compact way to define arbitrary
+regions of an image.  The masks may be used directly as an image with values
+of 1 (in an aperture) and 0 (outside an aperture).  Alternatively,
+some tasks may use a mask to define regions to be operated upon.
+When this task was written there were no such tasks though eventually
+some tasks will be converted to use this general format.  The intent
+of making an aperture mask is to someday allow using it with the task
+\fBimsurfit\fR to fit a background or scattered light surface.
+(See \fBapscatter\fR for an alternative method).
+.ih
+EXAMPLES
+1. To replace all data outside the apertures by zero:
+
+.nf
+	cl> apmask image image.pl nfind=10
+	cl> imarith image * image.pl image1
+.fi
+.ih
+REVISIONS
+.ls APMASK V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+apdefault, aprecenter, apresize, apedit, aptrace, apall
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apnoise.hlp b/noao/twodspec/apextract/doc/apnoise.hlp
new file mode 100644
index 00000000..a4f69f83
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apnoise.hlp
@@ -0,0 +1,231 @@
+.help apnoise Sep96 noao.twodspec.apextract
+.ih
+NAME
+apnoise -- Compute and examine noise characteristics of spectra
+.ih
+USAGE
+apnoise input dmin dmax nbins
+.ih
+PARAMETERS
+.ls input
+List of input spectra to examine.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls dmin, dmax, nbins
+The noise sigma is computed in a set of bins over the specified
+range of image data numbers.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing and trace
+fitting are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+
+.ls line = INDEF, nsum = 1
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  For tracing this is the starting line and
+the same number of lines are summed at each tracing point.  A line of
+INDEF selects the middle of the image along the dispersion axis.
+A positive nsum sums the lines and a negative value takes the median.
+However, for tracing only sums are allowed and the absolute value
+is used.
+.le
+.ls threshold = 10.
+Division threshold.  If a pixel in the two dimensional normalization spectrum
+is less than this value then a flat field value of 1 is output.
+.le
+
+The following parameters control the profile and spectrum fitting.
+.ls background = "none"
+Type of background subtraction.  The choices are "none" for no
+background subtraction, "average" to average the background within the
+background regions, or "fit" to fit across the dispersion using the
+background within the background regions.  Note that the "average"
+option does not do any medianing or bad pixel checking; it is faster
+than fitting however.  Background subtraction also requires that the
+background fitting parameters are properly defined.  For the "average"
+option only the background sample regions parameter is used.
+.le
+.ls pfit = "fit1d" (fit1d|fit2d)
+Profile fitting algorithm to use with variance weighting or cleaning.
+When determining a profile the two dimensional spectrum is divided by
+an estimate of the one dimensional spectrum to form a normalized two
+dimensional spectrum profile.  This profile is then smoothed by fitting
+one dimensional functions, "fit1d", along the lines or columns most closely
+corresponding to the dispersion axis or a special two dimensional
+function, "fit2d", described by Marsh (see \fBapprofile\fR).
+.le
+.ls clean = no
+Detect and replace deviant pixels?
+.le
+.ls skybox = 1
+Box car smoothing length for sky background when using background
+subtraction.  Since the background noise is often the limiting factor
+for good extraction one may box car smooth the sky to improve the
+statistics in smooth background regions at the expense of distorting
+the subtraction near spectral features.  This is most appropriate when
+the sky regions are limited due to a small slit length.
+.le
+.ls saturation = INDEF
+Saturation or nonlinearity level.  During variance weighted extractions
+wavelength points having any pixels above this value are excluded from the
+profile determination.
+.le
+.ls readnoise = "0."
+Read out noise in photons.  This parameter defines the minimum noise
+sigma.  It is defined in terms of photons (or electrons) and scales
+to the data values through the gain parameter.  A image header keyword
+(case insensitive) may be specified to get the value from the image.
+.le
+.ls gain = "1."
+Detector gain or conversion factor between photons/electrons and
+data values.  It is specified as the number of photons per data value.
+A image header keyword (case insensitive) may be specified to get the value
+from the image.
+.le
+.ls lsigma = 3., usigma = 3.
+Lower and upper rejection thresholds, given as a number of times the
+estimated sigma of a pixel, for cleaning.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+.ih
+CURSOR COMMANDS
+The following cursor keys and colon commands are available during the
+display of the noise sigmas and noise model.  See \fBapedit\fR for
+the commands for that mode.
+
+.nf
+?  Print command help
+q  Quit
+r  Redraw	
+w  Window the graph (see :/help)
+I  Interupt immediately
+
+:gain <value>		Check or set the gain model parameter
+:readnoise <value>	Check or set the read noise model parameter
+
+Also see the CURSOR MODE commands (:.help) and the windowing commands
+(:/help).
+.fi
+.ih
+DESCRIPTION
+\fBApnoise\fR computes the noise sigma as a function of data value
+using the same profile model used for weighted extraction and
+cosmic ray cleanning.  In particular, the residuals used in computing the
+noise sigma are the same as those during cleanning.  By looking
+at the noise sigma as a function of data value as compared to that
+predicted by the noise model based on the read out noise and gain
+parameters one can then better refine these values for proper
+rejection of cosmic rays without rejection of valid data.
+So this task can be used to check or deduce these values and also
+to adjust them to include additional sources of error such as
+flat field noise and, especially, an additional source of noise due
+to the accuracy of the profile modeling.
+
+The first part of this task follows the standard model of allowing
+one to define apertures by finding, recentering, editing, and
+tracing.  If one has previously defined apertures then these
+steps can be skipped.  Once the apertures are defined the apertures
+are internally extracted using the profile modeling (see \fBapprofile\fR)
+with the optional background subtraction, cleanning, and choices of
+profile fitting algorithm, "fit1d" or "fit2d".  But rather than
+outputing the extracted spectrum as in \fBapsum\fR or \fBapall\fR
+or various functions of the data and profile model as in \fBapfit\fR,
+\fBapnormalize\fR, or \fBapflatten\fR, the task computes the
+residuals for all points in all apertures (essentially the same
+as the difference output of \fBapfit\fR) and determines the
+sigma (population corrected RMS) as a function of model data value
+in the specified bins.  The bins are defined by a minimum and
+maximum data value (found using \fBminmax\fR, \fBimplot\fR, or
+\fBimexamine\fR) and the number of bins.
+
+The noise sigma values, with their estimated uncertainties, are then
+plotted as a function of data numer.  A curve representing the specified
+read out noise and gain is also plotted.  The user then has the
+option of varying these two parameters with colon commands.  The
+aim of this is to find a noise model which either represents the
+measure noise sigmas or at least exceeds them so that only valid
+outliers such as cosmic rays will be rejected during cleanning.
+The interactive graphical mode only has this function.  The other
+keys and colon commands are the standard ones for redrawing, windowing,
+and quitting.
+.ih
+EXAMPLES
+1.  To check that the read noise and gain parameters are reasonable for
+cleaning \fBapnoise\fR is run.  In this case it is assumed that the
+apertures have already been defined and traced.
+
+.nf
+	cl> minmax lsobj
+	    lsobj  -2.058870315551758  490.3247375488282
+	cl> apnoise lsobj 0 500 50 rece- resi- edit- trace-
+	    A graph of the noise sigma for data between 0 and 500
+	    data numbers is given with a line showing the
+	    expected value for the current read noise and gain.
+	    The read noise and gain may be varied if desired.
+	    Exit with 'q'
+.fi
+.ih
+REVISIONS
+.ls APNOISE V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+apbackground, approfile, apvariance, apfit, icfit, minmax,
+apdefault, apfind, aprecenter, apresize, apedit, aptrace, apsum
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apnormalize.hlp b/noao/twodspec/apextract/doc/apnormalize.hlp
new file mode 100644
index 00000000..fda3fd31
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apnormalize.hlp
@@ -0,0 +1,324 @@
+.help apnormalize Sep96 noao.twodspec.apextract
+.ih
+NAME
+apnormalize -- Normalize 2D apertures by 1D functions
+.ih
+USAGE
+apnormalize input output
+.ih
+PARAMETERS
+.ls input
+List of input images to be normalized.
+.le
+.ls output
+List of output image names for the normalized input images.  If no output
+name is given then the input name is used as a root with the extension
+".norm" added.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and normalize.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing and trace
+fitting are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+.ls normalize = yes
+Normalize the aperture spectra by a one dimensional function?
+.le
+.ls fitspec = yes
+Fit normalization spectrum interactively?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+
+.ls line = INDEF, nsum = 1
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  For tracing this is the starting line and
+the same number of lines are summed at each tracing point.  A line of
+INDEF selects the middle of the image along the dispersion axis.
+A negative nsum selects a median rather than a sum except that
+tracing always uses a sum.
+.le
+.ls cennorm = no
+Normalize to the aperture center rather than the mean?
+.le
+.ls threshold = 10.
+All pixels in the normalization spectrum less than this value are replaced
+by this value.
+.le
+
+The following parameters control the normalization spectrum extraction.
+.ls background = "none"
+Type of background subtraction.  The choices are "none" for no
+background subtraction, "average" to average the background within the
+background regions, or "fit" to fit across the dispersion using the
+background within the background regions.  Note that the "average"
+option does not do any medianing or bad pixel checking; it is faster
+than fitting however.  Background subtraction also requires that the
+background fitting parameters are properly defined.  For the "average"
+option only the background sample regions parameter is used.
+.le
+.ls weights = "none"
+Type of extraction weighting.  Note that if the \fIclean\fR parameter is
+set then the weights used are "variance" regardless of the weights
+specified by this parameter.  The choices are:
+.ls "none"
+The pixels are summed without weights except for partial pixels at the
+ends.
+.le
+.ls "variance"
+The extraction is weighted by estimated variances of the pixels using
+a poisson noise model.
+.le
+.le
+.ls pfit = "fit1d" (fit1d|fit2d)
+Profile fitting algorithm to use with variance weighting or cleaning.
+When determining a profile the two dimensional spectrum is divided by
+an estimate of the one dimensional spectrum to form a normalized two
+dimensional spectrum profile.  This profile is then smoothed by fitting
+one dimensional functions, "fit1d", along the lines or columns most closely
+corresponding to the dispersion axis or a special two dimensional
+function, "fit2d", described by Marsh (see \fBapprofile\fR).
+.le
+.ls clean = no
+Detect and replace deviant pixels?
+.le
+.ls skybox = 1
+Box car smoothing length for sky background when using background
+subtraction.  Since the background noise is often the limiting factor
+for good extraction one may box car smooth the sky to improve the
+statistics in smooth background regions at the expense of distorting
+the subtraction near spectral features.  This is most appropriate when
+the sky regions are limited due to a small slit length.
+.le
+.ls saturation = INDEF
+Saturation or nonlinearity level.  During variance weighted extractions
+wavelength points having any pixels above this value are excluded from the
+profile determination.
+.le
+.ls readnoise = 0.
+Read out noise in photons.  This parameter defines the minimum noise
+sigma.  It is defined in terms of photons (or electrons) and scales
+to the data values through the gain parameter.  A image header keyword
+(case insensitive) may be specified to get the value from the image.
+.le
+.ls gain = 1
+Detector gain or conversion factor between photons/electrons and
+data values.  It is specified as the number of photons per data value.
+A image header keyword (case insensitive) may be specified to get the value
+from the image.
+.le
+.ls lsigma = 3., usigma = 3.
+Lower and upper rejection thresholds, given as a number of times the
+estimated sigma of a pixel, for cleaning.
+.le
+
+The following parameters are used to fit the normalization spectrum using
+the ICFIT routine.
+.ls function = "legendre"
+Fitting function for the normalization spectra.  The choices are "legendre"
+polynomial, "chebyshev" polynomial, linear spline ("spline1"), and
+cubic spline ("spline3").
+.le
+.ls order = 1
+Number of polynomial terms or number of spline pieces for the fitting function.
+.le
+.ls sample = "*"
+Sample regions for fitting points.  Intervals are separated by "," and an
+interval may be one point or a range separated by ":".
+.le
+.ls naverage = 1
+Number of points within a sample interval to be subaveraged or submedianed to
+form fitting points.  Positive values are for averages and negative points
+for medians.
+.le
+.ls niterate = 0
+Number of sigma clipping rejection iterations.
+.le
+.ls low_reject = 3. , high_reject = 3.
+Lower and upper sigma clipping rejection threshold in units of sigma determined
+from the RMS sigma of the data to the fit.
+.le
+.ls grow = 0.
+Growing radius for rejected points (in pixels).  That is, any rejected point
+also rejects other points within this distance of the rejected point.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+.ih
+DESCRIPTION
+For each image in the input image list the two dimensional spectra
+defined by a set of apertures are normalized by a one dimensional
+normalization function derived by extracting and smoothing the spectrum
+by fitting a function with the \fBicfit\fR procedure.  The value of the
+fitting function at each point along the dispersion, divided by the
+aperture width to form a mean or scaled to the same mean as the center
+pixel of the aperture depending on the \fIcennorm\fR parameter, is
+divided into the two dimensional input aperture.  All points outside
+the apertures are set to unity.
+
+The purpose of this task is to remove a general shape from the aperture
+spectra.  If low order (order = 1 for instance) functions are used then
+only the amplitudes of the spectra are affected, shifting each aperture
+to approximately unit intensity per pixel.  If high order functions are
+used only the small spatial scale variations are preserved.  This
+is useful for making flat field images with the spectral signature of the
+continuum source removed or for producing two dimensional normalized
+spectra similar to the task \fBonedspec.continuum\fR.  For flat fields
+this algorithm retains the profile shape which may be useful for
+removing the profile response in short slit data.  However, often
+one does not want the profile of the flat fielded observation to be
+modified in which case the task \fBapflatten\fR should be used.
+
+The normalization spectrum is first extracted in the same way as is
+the one dimensional extraction in \fBapsum\fR or \fBapall\fR.  In
+particular the same parameters for selecting weighting and cleaning
+are available.  After extraction the spectrum is fit using the
+\fBicfit\fR routine.  This may be done interactively or noninteractively
+depending on the \fIinteractive\fR parameter.  The default fitting
+parameters are part of this task.  The goal of the fitting depends
+on the application.  One may be trying to simply continuum normalize,
+in which case one wants to iteratively reject and grow the rejected
+points to exclude the lines and fit the continuum with a
+moderate order function (see \fBcontinuum\fR for more discussion).  
+If one wants to simply normalize all spectra to a common flux, say to
+remove a blaze function in echelle data, then an order of 1 will
+normalize by a constant.  For flat field and profile correction of
+small slits one wants to fit the large scale shape of the
+spectrum but not fit the small bumps and wiggles due to sensitivity
+variations and fringing.
+
+The smoothed extracted spectrum represents the total flux within the
+aperture.  There are two choices for scaling to a normalization per
+pixel.  One is to divide by the aperture width, thus computing an average
+flux normalization.  In this case the peak of the spectrum will be
+greater than unity.  This is done when \fIcennorm\fR = no.  When this
+parameter has the value yes then the mean of the normalization spectrum
+is scaled to the mean of the aperture center, computed by linearly
+interpolating the two pixels about the traced center.  This will give
+values near one for the pixels at the center of the aperture in the
+final output image.
+
+Before division of each pixel by the appropriate dispersion point in
+the normalization spectrum, all pixels below the value specified by the
+\fIthreshold\fR parameter in the normalization spectrum are replaced by
+the threshold value.  This suppresses division by very small numbers.
+Finally, the pixels within the aperture are divided by the normalization
+function and the pixels outside the apertures are set to 1.
+
+The remainder of this description covers the basic steps defining the
+apertures to be used.  These steps and parameter are much the same as
+in any of the other \fBapextract\fR tasks.
+
+Aperture definitions may be inherited from those of other images by
+specifying a reference image with the \fBreferences\fR parameter.
+Images in the reference list are matched with those in the input list
+in order.  If the reference image list is shorter than the number of
+input images, the last reference image is used for all remaining input
+images.  Thus, a single reference image may be given for all the input
+images or different reference images may be given for each input
+image.  The special reference name "last" may be used to select the
+last set apertures used in any of the \fBapextract\fR tasks.
+
+If an aperture reference image is not specified or no apertures are
+found for the specified reference image, previously defined apertures
+for the input image are sought in the aperture database.  Note that
+reference apertures supersede apertures for the input image.  If no
+apertures are defined they may be created automatically, the \fIfind\fR
+option, or interactively in the aperture editor, if the
+\fIinteractive\fR and \fIedit\fR options are set.
+
+The functions performed by the task are selected by a set of flag
+parameters.  The functions are an automatic spectrum finding and
+aperture defining algorithm (see \fBapfind\fR) which is ignored if
+apertures are already defined, automatic recentering and resizing
+algorithms (see \fBaprecenter\fR and \fBapresize\fR), an interactive
+aperture editing function (see \fBapedit\fR), a spectrum position tracing
+and trace function fit (see \fBaptrace\fR), and the main function of
+this task, the one dimensional normalization of the aperture
+profiles.
+
+Each function selection will produce a query for each input spectrum if
+the \fIinteractive\fR parameter is set.  The queries are answered by
+"yes", "no", "YES", or "NO", where the upper case responses suppress
+the query for following images.  There are other queries associated
+with tracing which first ask whether the operation is to be done
+interactively and, if yes, lead to queries for each aperture.  If the
+\fIinteractive\fR parameter is not set then aperture editing,
+interactive trace fitting, and interactive spectrum shape fitting are ignored.
+.ih
+EXAMPLES
+To make a flat field image which leaves the total counts of the object
+images approximately unchanged from a quartz echelle or slitlet image:
+
+.nf
+	cl> apnormalize qtz001,qtz002 flat001,flat002
+	Yes find
+	No resize
+	No edit
+	Yes trace
+	Yes trace interactively
+	NO
+	Yes flatten
+	Yes fit interactively
+.fi
+.ih
+REVISIONS
+.ls APNORMALIZE V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+apbackground, approfile, apvariance, apfit, icfit,
+apdefault, apfind, aprecenter, apresize, apedit, aptrace, apsum
+.endhelp
diff --git a/noao/twodspec/apextract/doc/approfiles.hlp b/noao/twodspec/apextract/doc/approfiles.hlp
new file mode 100644
index 00000000..43ae774a
--- /dev/null
+++ b/noao/twodspec/apextract/doc/approfiles.hlp
@@ -0,0 +1,131 @@
+.help approfiles Feb93 noao.twodspec.apextract
+
+.ce
+Spectrum Profile Determinations
+
+
+The foundation of variance weighted or optimal extraction, cosmic ray
+detection and removal, two dimensional flat field normalization, and
+spectrum fitting and modeling is the accurate determination of the
+spectrum profile across the dispersion as a function of wavelength.
+The previous version of the APEXTRACT package accomplished this by
+averaging a specified number of profiles in the vicinity of each
+wavelength after correcting for shifts in the center of the profile.
+This technique was sensitive to perturbations from cosmic rays
+and the exact choice of averaging parameters.  The current version of
+the package uses two different algorithm which are much more stable.
+
+The basic idea is to normalize each profile along the dispersion to
+unit flux and then fit a low order function to sets of unsaturated
+points at nearly the same point in the profile parallel to the
+dispersion.  The important point here is that points at the same
+distance from the profile center should have the nearly the same values
+once the continuum shape and spectral features have been divided out.
+Any variations are due to slow changes in the shape of the profile with
+wavelength, differences in the exact point on the profile, pixel
+binning or sampling, and noise.  Except for the noise, the variations
+should be slow and a low order function smoothing over many points will
+minimize the noise and be relatively insensitive to bad pixels such as
+cosmic rays.  Effects from bad pixels may be further eliminated by
+chi-squared iteration and clipping.  Since there will be many points
+per degree of freedom in the fitting function the clipping may even be
+quite aggressive without significantly affecting the profile
+estimates.  Effects from saturated pixels are minimized by excluding
+from the profile determination any profiles containing one or more
+saturated pixels as defined by the \fIsaturation\fR parameter.
+
+The normalization is, in fact, the one dimensional spectrum.  Initially
+this is the simple sum across the aperture which is then updated by the
+variance weighted sum with deviant pixels possibly removed.  This updated
+one dimensional spectrum is what is meant by the profile normalization
+factor in the discussion below.  The two dimensional spectrum model or
+estimate is the product of the normalization factor and the profile.  This
+model is used for estimating the pixel intensities and, thence, the
+variances.
+
+There are two important requirements that must be met by the profile fitting
+algorithm.  First it is essential that the image data not be
+interpolated.  Any interpolation introduces correlated errors and
+broadens cosmic rays to an extent that they may be confused with the
+spectrum profile, particularly when the profile is narrow.  This was
+one of the problems limiting the shift and average method used
+previously.  The second requirement is that data fit by the smoothing
+function vary slowly with wavelength.  This is what precludes, for
+instance, fitting profile functions across the dispersion since narrow,
+marginally sampled profiles require a high order function using only a
+very few points.  One exception to this, which is sometimes useful but
+of less generality, is methods which assume a model for the profile
+shape such as a gaussian.  In the methods used here there is no
+assumption made about the underlying profile other than it vary
+smoothly with wavelength.
+
+These requirements lead to two fitting algorithms which the user
+selects with the \fIpfit\fR parameter.  The primary method, "fit1d",
+fits low order, one dimensional functions to the lines or columns
+most nearly parallel to the dispersion.  While this is intended for
+spectra which are well aligned with the image axes, even fairly large
+excursions or tilts can be adequately fit in this
+way.  When the spectra become strongly tilted then single lines or
+columns may cross the actual profile relatively quickly causing the
+requirement of a slow variation to be violated.  One thought is to use
+interpolation to fit points always at the same distance from the
+profile.  This is ruled out by the problems introduced by
+image interpolation.  However, there is a clever method which, in
+effect, fits low order polynomials parallel to the direction defined by
+tracing the spectrum but which does not interpolate the image data.
+Instead it weights and couples polynomial coefficients.  This
+method was developed by Tom Marsh and is described in detail in the
+paper, "The Extraction of Highly Distorted Spectra", PASP 101, 1032,
+Nov. 1989.  Here we refer to this method as the Marsh or "fit2d"
+algorithm and do not attempt to explain it further.
+
+The choice of when to use the one dimensional or the two dimensional
+fitting is left to the user.  The "fit1d" algorithm is preferable since it
+is faster, easier to understand, and has proved to be very robust.  The
+"fit2d" algorithm usually works just as well but is slower and has been
+seen to fail on some data.  The user may simply try both to achieve the
+best results.
+
+What follows are some implementation details of the preceding ideas in the
+APEXTRACT package.  For column/line fitting, the fitting function is a
+cubic spline.  A base number of spline pieces is set by rounding up the
+maximum trace excursion; an excursion of 1.2 pixels would use a spline of 2
+pieces.  To this base number is added the number of coefficients in the
+trace function in excess of two; i.e. the number of terms in excess of a
+linear function.  This is done because if the trace wiggles a large amount
+then a higher order function will be needed to fit a line or column as the
+profile shifts under it.  Finally the number of pieces is doubled
+because experience shows that for low tilts it doesn't matter but for
+large tilts this improves the results dramatically.
+
+For the Marsh algorithm there are two parameters to be set, the
+polynomial order parallel to the dispersion and the spacing between
+parallel, coupled polynomials.  The algorithm requires that the spacing
+be less than a pixel to provide sufficient sampling.  The spacing is
+arbitrarily set at 0.95 pixels.  Because the method always fits
+polynomials to points at the same position of the profile the order
+should be 1 except for variations in the profile shape with
+wavelength.  To allow for this the profile order is set at 10; i.e. a
+9th order function.  A final parameter in the algorithm is the number
+of polynomials across the profile but this is obviously  determined
+from the polynomial spacing and the width of the aperture including an
+extra pixel on either side.
+
+Both fitting algorithms weight the pixels by their variance as computed
+from the background and background variance if background subtraction
+is specified, the spectrum estimate from the profile and the spectrum
+normalization, and the detector noise parameters.  A poisson
+plus constant gaussian readout noise model is used.  The noise model is
+described further in \fBapvariance\fR.
+
+As mentioned earlier, the profile fitting can be iterated to remove
+deviant pixels.  This is done by rejecting pixels greater than a
+specified number of sigmas above or below the expected value based
+on the profile, the normalization factor, the background, the
+detector noise parameters, and the overall chi square of the residuals.
+Rejected points are removed from the profile normalization and
+from the fits.
+.ih
+SEE ALSO
+apbackground apvariance apall apsum apfit apflatten
+.endhelp
diff --git a/noao/twodspec/apextract/doc/aprecenter.hlp b/noao/twodspec/apextract/doc/aprecenter.hlp
new file mode 100644
index 00000000..5a05cb36
--- /dev/null
+++ b/noao/twodspec/apextract/doc/aprecenter.hlp
@@ -0,0 +1,148 @@
+.help aprecenter Sep96 noao.twodspec.apextract
+.ih
+NAME
+aprecenter -- Recenter apertures automatically
+.ih
+USAGE
+aprecenter input
+.ih
+PARAMETERS
+.ls input
+List of input images in which apertures are to be recentered.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+.ls interactive = no
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing is
+disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = no
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+
+.ls line = INDEF
+The dispersion line (line or column perpendicular to the dispersion axis) to
+be used in recentering the spectra.  A value of INDEF selects the middle of the
+image.
+.le
+.ls nsum = 1
+Number of dispersion lines to be summed or medianed.  The lines are taken
+around the specified dispersion line.  A positive value takes a sum
+and a negative values selects a median.
+.le
+.ls aprecenter = ""
+List of apertures to be used in shift calculation.
+.le
+.ls npeaks = INDEF
+Select the specified number of apertures with the highest peak values
+to be recentered.  If the number is INDEF all apertures will be selected.
+If the value is less than 1 then the value is interpreted as a fraction
+of total number of apertures.
+.le
+.ls shift = yes
+Use the median shift from recentering the selected apertures to apply to
+all apertures.  The recentering is then a constant shift for all apertures.
+The median is the average of the two central values for an even number
+of apertures.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters are taken from the
+task \fBapdefault\fR, automatic aperture finding parameters are taken
+from \fBapfind\fR, and parameters used for centering and editing the
+apertures are taken from \fBapedit\fR.
+
+When this operation is performed from the task \fBapall\fR all parameters
+except the package parameters are included in that task.
+.ih
+DESCRIPTION
+For each image in the input image list, the aperture center positions
+are redefined by centering at the specified dispersion line using the
+\fBcenter1d\fR algorithm with centering parameters from \fBapedit\fR.
+Normally this is done when inheriting apertures from an aperture
+reference image.  The recentering does not change the "trace" of the
+aperture but simple adds a shift across the dispersion axis.
+
+There are a several recentering options.  Each selected aperture may be
+recentered independently.  However, if some or all of the spectra are
+relatively weak this may actually be worse than using the reference
+apertures defined by strong spectra or flat fields in the case of
+fibers or aperture masks.  One may select a subset of apertures to be
+used in calculating shift.  This is done with a the \fIaprecenter\fR
+list of aperture numbers (see
+\fBranges\fR for the syntax) and/or by selecting a specific number or
+fraction of the apertures with the strongest peak values.  The list
+selection is done first and the strongest remaining apertures are used
+to satisfy the \fBnpeaks\fR value.  Though some or all of the apertures
+may be recentered independently the most common case of recentering
+reference apertures is to account for detector shifts.  In this case
+one expects that any shift should be common to all apertures.  The
+\fIshift\fR parameter allows using the new centers for all selected
+apertures to compute a median shift to be added to ALL apertures.  Using
+a median shift for all apertures is the default.
+
+The \fIfind\fR parameter allows automatically finding apertures if none
+are defined for the image or by a reference image.  Since the purpose
+of this task is to recenter reference apertures it is usually the case
+that reference images are used and apertures are not defined by this
+task.  One case in which the apertures from the image itself might be
+recentered is if one wants to use a different dispersion line.  The
+\fIresize\fR parameter may be used to adjust the widths in a variety
+of ways based on the spectra profiles specific to each image.  The
+aperture positions and any other parameters may also be edited with the
+aperture editing function if selected by the \fIapedit\fR parameter and
+the task is run interactively.  The recentering algorithm may be run
+from the aperture editor using the 'g' keystroke.
+
+If the task is interactive the user is queried whether to perform
+various steps on each image.  The queries may be answered with one of
+the four values "yes", "no", "YES" and "NO", where an upper case
+response suppresses all further queries to this question.
+
+The aperture recentering algorithm may be selected from nearly every task
+in the package.
+.ih
+EXAMPLES
+	cl> aprecenter newimage reference=flat
+.ih
+REVISIONS
+.ls APRECENTER V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+center1d, ranges, apfind, apresize, apedit, apall
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apresize.hlp b/noao/twodspec/apextract/doc/apresize.hlp
new file mode 100644
index 00000000..d8ab4774
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apresize.hlp
@@ -0,0 +1,201 @@
+.help apresize Sep96 noao.twodspec.apextract
+.ih
+NAME
+apresize -- Resize apertures automatically
+.ih
+USAGE
+apresize input
+.ih
+PARAMETERS
+.ls input
+List of input images in which apertures are to be resized.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = no
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing is
+disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = no
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+
+.ls line = INDEF
+The dispersion line (line or column perpendicular to the dispersion axis) to
+be used in resizing the spectra.  A value of INDEF selects the middle of the
+image.
+.le
+.ls nsum = 1
+Number of dispersion lines to be summed or medianed.  The lines are taken
+around the specified dispersion line.  A positive value takes a
+sum and a negative value selects a median.
+.le
+.ls llimit = INDEF, ulimit = INDEF
+Lower and upper aperture size limits.  If the parameter \fIylevel\fR is
+INDEF then these limits are assigned to all apertures.  Otherwise
+these parameters are used as limits to the resizing operation.
+A value of INDEF places the aperture limits at the image edge (for the
+dispersion line used).
+.le
+.ls ylevel = 0.1
+Data level at which to set aperture limits.  If it is INDEF then the
+aperture limits are set at the values given by the parameters
+\fIllimit\fR and \fIulimit\fR.  If it is not INDEF then it is a
+fraction of the peak or an actual data level depending on the parameter
+\fIpeak\fR.  It may be relative to a local background or to zero
+depending on the parameter \fIbkg\fR.
+.le
+.ls peak = yes
+Is the data level specified by \fIylevel\fR a fraction of the peak?
+.le
+.ls bkg = yes
+Subtract a simple background when interpreting the \fBylevel\fR parameter.
+The background is a slope connecting the first minima
+away from the aperture center.
+.le
+.ls r_grow = 0.
+Change the lower and upper aperture limits by this fractional amount.
+The factor is multiplied by each limit and the result added to limit.
+.le
+.ls avglimits = no
+Apply the average lower and upper aperture limits to all apertures.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters are taken from the
+task \fBapdefault\fR, automatic aperture finding parameters are taken
+from \fBapfind\fR, and parameters used for centering and editing the
+apertures are taken from \fBapedit\fR.
+
+When this operation is performed from the task \fBapall\fR all parameters
+except the package parameters are included in that task.
+.ih
+DESCRIPTION
+For each image in the input image list, the aperture limits are
+redefined to be either specified values or by finding the points at
+which the spectrum profile, linearly interpolated, first crosses a
+specified value moving away from the aperture center at the specified
+dispersion line.  In the latter case the limits may then be increased
+or decreased by a specified percentage, a maximum lower and upper limit,
+may be imposed, and the independent limits may be averaged and the
+single values applied to all the apertures.
+
+The simplest resizing choice is to reset all the aperture limits to
+the values specified by \fIllimit\fR and \fIulimit\fR.  This option
+is selected if the parameter \fIylevel\fR is INDEF.
+
+There are several options for specifying a data level at which an
+aperture is sized.  The most common method (the default) is to specify
+a fraction of the peak value since this is data independent and physically
+reasonable.  This is done by setting the fraction with the parameter
+\fIylevel\fR and the parameter \fIpeak\fR to yes.  If the peak parameter
+is no then the level is a data value.
+
+The levels may be relative to zero, as might be used with fibers or
+high dispersion / high signal-to-noise data, or relative to a local
+linear background, as would be appropriate for slit data having a
+significant background.  A background is found and used if the
+parameter \fIbkg\fR is set.  The background determination is very
+simple.  Starting at the peak two background points are found, one in
+each direction, which are inflection points; i.e. the first pixels
+which are less than their two neighbors.  A linear slope is fit and
+subtracted for the purposes of measuring the peak and setting the
+aperture limits.  Note that if the slope is significant the actual
+limits may not correspond to the intercepts of a line at constant data
+value.
+
+Once aperture limits, a distance relative to the center, are determined
+they are increased or decreased by a percentage, expressed as a fraction,
+given by the parameter \fIr_grow\fR.  To illustrate the operation,
+if xlow is the initial lower limit then the final lower limit will be:
+
+	xlow final = xlow * (1 + r_grow)
+
+A value of zero leaves the aperture limits unchanged.
+
+After the aperture limits are found, based on the above steps, a fixed lower
+limit, given by the parameter \fIllimit\fR, is applied to the lower
+aperture points and, similarly, a fixed upper limit is applied to the
+upper aperture points.  This feature protects against absurdly wide apertures.
+
+Finally, if the parameter \fIavglimits\fR is set the individual aperture
+limits are averaged to form an average aperture.  This average aperture
+is then assigned to all apertures.  This option allows keeping common
+aperture sizes but allowing variation due to seeing changes.
+
+The resizing algorithm is available in the interactive aperture editor.
+Here one may select individual apertures or all apertures using the
+'a' switch.  The resizing algorithm described above is selected using
+the 'z' key.  An simple alternative is the 'y' key which resizes
+apertures to the y level marked by the cursor.
+
+If the task is interactive the user is queried whether to perform
+various steps on each image.  The queries may be answered with one of
+the four values "yes", "no", "YES" and "NO", where an upper case
+response suppresses all further queries to this question.
+
+The aperture resizing algorithm may be selected from nearly every task
+in the package with the \fIresize\fR parameter.
+.ih
+EXAMPLES
+1.  To resize all apertures to the range -4 to 4:
+
+	cl> apresize image llimit=-4 ulimit=4 ylevel=INDEF
+
+2.  To resize all aperture to a point which is 5% of the peak relative
+to a local background:
+
+	cl> apresize image ylevel=.05 peak+ bkg+
+
+3.  To resize all apertures to the point where the data exceeds 100
+data units:
+
+	cl> apresize image ylevel=100 peak- bkg-
+
+4.  To resize all apertures to default values of the task except
+averaging all the results at the end:
+
+	cl> apresize image avg+
+.ih
+REVISIONS
+.ls APRESIZE V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+center1d, ranges, apfind, aprecenter, apedit, apall
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apscatter.hlp b/noao/twodspec/apextract/doc/apscatter.hlp
new file mode 100644
index 00000000..902c57a8
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apscatter.hlp
@@ -0,0 +1,253 @@
+.help apscatter Sep96 noao.twodspec.apextract
+.ih
+NAME
+apscatter -- Fit and subtract scattered light
+.ih
+USAGE
+apscatter input output
+.ih
+PARAMETERS
+.ls input
+List of input images in which to determine and subtract scattered light.
+.le
+.ls output
+List of output scattered light subtracted images.  If no output images
+are specified or the end of the output list is reached before the end 
+of the input list then the output image will overwrite the input image.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  All apertures are
+used to define the scattered light region.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls scatter = ""
+List of scattered light images.  This is the scattered light subtracted
+from the input image.  If no list is given or the end of the list is
+reached before the end of the input list then no scattered light image
+is created.
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing, trace
+fitting, and interactive scattered light fitting are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = yes
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+.ls subtract = yes
+Subtract the scattered light from the input images?
+.le
+.ls smooth = yes
+Smooth the cross-dispersion fits along the dispersion?
+.le
+.ls fitscatter = yes
+Fit the scattered light across the dispersion interactively?
+The \fIinteractive\fR parameter must also be yes.
+.le
+.ls fitsmooth = yes
+Smooth the cross-dispersion fits along the dispersion?
+The \fIinteractive\fR parameter must also be yes.
+.le
+
+.ls line = INDEF, nsum = 1
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  For tracing this is the starting line and
+the same number of lines are summed at each tracing point.  This is
+also the initial line for interactive fitting of the scattered light.
+A line of INDEF selects the middle of the image along the dispersion
+axis.  A positive nsum takes a sum and a negative value selects a
+median except that tracing always uses a sum.
+.le
+
+.ls buffer = 1.
+Buffer distance from the aperture edges to be excluded in selecting the
+scattered light pixels to be used.
+.le
+.ls apscat1 = ""
+Fitting parameters across the dispersion.  This references an additional
+set of parameters for the ICFIT package.  The default is the "apscat1"
+parameter set.  See below for additional information.
+.le
+.ls apscat2 = ""
+Fitting parameters along the dispersion.  This references an additional
+set of parameters for the ICFIT package.  The default is the "apscat2"
+parameter set.  See below for additional information.
+.le
+.ih
+ICFIT PARAMETERS FOR FITTING THE SCATTERED LIGHT
+There are two additional parameter sets which define the parameters used
+for fitting the scattered light across the dispersion and along the
+dispersion.  The default parameter sets are \fBapscat1\fR and \fBapscat2\fR.
+The parameters may be examined and edited by either typing their names
+or by typing ":e" when editing the main parameter set with \fBeparam\fR
+and with the cursor pointing at the appropriate parameter set name.
+These parameters are used by the ICFIT package and a further
+description may be found there.
+
+.ls function = "spline3" (apscat1 and apscat2)
+Fitting function for the scattered light across and along the dispersion.
+The choices are "legendre" polynomial, "chebyshev" polynomial,
+linear spline ("spline1"), and cubic spline ("spline3").
+.le
+.ls order = 1 (apscat1 and apscat2)
+Number of polynomial terms or number of spline pieces for the fitting function.
+.le
+.ls sample = "*" (apscat1 and apscat2)
+Sample regions for fitting points.  Intervals are separated by "," and an
+interval may be one point or a range separated by ":".
+.le
+.ls naverage = 1 (apscat1 and apscat2)
+Number of points within a sample interval to be subaveraged or submedianed to
+form fitting points.  Positive values are for averages and negative points
+for medians.
+.le
+.ls niterate = 5 (apscat1), niterate = 0 (apscat2)
+Number of sigma clipping rejection iterations.
+.le
+.ls low_reject = 5. (apscat1) , low_reject = 3. (apscat2)
+Lower sigma clipping rejection threshold in units of sigma determined
+from the RMS sigma of the data to the fit.
+.le
+.ls high_reject = 2. (apscat1) , high_reject = 3. (apscat2)
+High sigma clipping rejection threshold in units of sigma determined
+from the RMS sigma of the data to the fit.
+.le
+.ls grow = 0. (apscat1 and apscat2)
+Growing radius for rejected points (in pixels).  That is, any rejected point
+also rejects other points within this distance of the rejected point.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+.ih
+DESCRIPTION
+The scattered light outside the apertures defining the two dimensional
+spectra is extracted, smoothed, and subtracted from each input image.  The
+approach is to first select the pixels outside the defined apertures
+and outside a buffer distance from the edge of any aperture at each
+point along the dispersion independently.  A one dimensional function
+is fit using the \fBicfit\fR package.  This fitting uses an iterative
+algorithm to further reject high values and thus fit the minima between
+the spectra.  (This even works reasonably well if no apertures are
+defined).  Because each fit is done independently the scattered light
+thus determined will not be smooth along the dispersion.  If desired
+each line along the dispersion in the scattered light surface may then
+be smoothed by again fitting a one dimensional function using the
+\fBicfit\fR package.  The final scattered light surface is then
+subtracted from the input image to form the output image.  The
+scattered light surface may be output if desired.
+
+The reason for using two one dimensional fits as opposed to a surface fit
+is that the actual shape of the scattered light is often not easily modeled
+by a simple two dimensional function.  Also the one dimensional function
+fitting offers more flexibility in defining functions and options as
+provided by the \fBicfit\fR package.
+
+The organization of the task is like the other tasks in the package
+which has options for defining apertures using a reference image,
+defining apertures through an automatic finding algorithm (see
+\fBapfind\fR), automatically recentering or resizing the apertures (see
+\fBaprecenter\fR and \fBapresize\fR), interactively editing the
+apertures (see \fBapedit\fR), and tracing the positions of the spectra
+as a function of dispersion position (see \fBaptrace\fR).  Though
+unlikely, the actual scattered light subtraction operation may be
+suppressed when the parameter \fIsubtract\fR is no.  If the scattered
+light determination and fitting is done interactively (the
+\fIinteractive\fR parameter set to yes) then the user is queried
+whether or not to do the fitting and subtraction for each image.  The
+responses are "yes", "no", "YES", or "NO", where the upper case
+queries suppress this query for the following images.  When the task is
+interactive there are further queries for each step of the operation
+which may also be answered both individually or collectively for all
+other input images using the four responses.
+
+When the scattered light operation is done interactively the user may
+set the fitting parameters for the scattered light functions both
+across and along the dispersion interactively.  Initially the central
+line or column is used but after exiting (with 'q') a prompt is given
+for selecting additional lines or columns and for changing the buffer
+distance.  Note that the point of the interactive stage is to set the
+fitting parameters.  When the entire image is finally fit the last set
+of fitting parameters are used for all lines or columns.
+
+The default fitting parameters are organized as separate parameter sets
+called \fBapscat1\fR for the first fits across the dispersion and
+\fBapscat2\fR for the second smoothing fits along the dispersion.
+Changes to these parameters made interactively during execution of
+this task are updated in the parameter sets.  The general idea for
+these parameters is that when fitting the pixels from between the
+apertures the iteration and rejection thresholds are set to eliminate
+high values while for smoothing along the dispersion a simple smooth
+function is all that is required.
+.ih
+EXAMPLES
+1.  To subtract the scattered light from a set of images to form a
+new set of images:
+
+	cl> apscatter raw* %raw%new%*
+
+This example uses a substitution in the names from raw to new.
+By default this would be done interactively
+
+2.  To subtract the scattered light in place and save the scattered light
+images:
+
+	cl> apscatter im* "" scatter="s//im*" ref=im1 interact-
+
+The prefix s is added to the original names for the scattered light.
+This operation is done noninteractively using a reference spectrum
+to define the apertures.
+.ih
+REVISIONS
+.ls APSCATTER V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+apfind, aprecenter, apresize,  apedit, aptrace, apsum, apmask, icfit
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apsum.hlp b/noao/twodspec/apextract/doc/apsum.hlp
new file mode 100644
index 00000000..6fa7ad0e
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apsum.hlp
@@ -0,0 +1,402 @@
+.help apsum Sep96 noao.twodspec.apextract
+.ih
+NAME
+apsum -- Extract one dimensional sums across the apertures
+.ih
+USAGE
+apsum input
+.ih
+PARAMETERS
+.ls input
+List of input images containing apertures to be extracted.
+.le
+.ls output = ""
+List of output rootnames for the extracted spectra.  If the null
+string is given or the end of the output list is reached before the end
+of the input list then the input image name is used as the output rootname.
+This will not conflict with the input image since an aperture number
+extension is added for onedspec format, the extension ".ms" for multispec
+format, or the extension ".ec" for echelle format.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls format = "multispec" (onedspec|multispec|echelle|strip)
+Format for output extracted spectra.  "Onedspec" format extracts each
+aperture to a separate image while "multispec" and "echelle" extract
+multiple apertures for the same image to a single output image.
+The "multispec" and "echelle" format selections differ only in the
+extension added.  The "strip" format produces a separate 2D image in
+which each column or line along the dispersion axis is shifted to
+exactly align the aperture based on the trace information.
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+.ls profiles = ""
+List of profile images for variance weighting or cleanning.   If variance
+weighting or cleanning a profile of each aperture is computed from the
+input image unless a profile image is specified, in which case the
+profile is computed from the profile image.  The profile image must
+have the same dimensions and dispersion and it is assumed that the
+spectra have the same position and profile shape as in the object
+spectra.  Use of a profile image is generally not required even for
+faint input spectra but the option is available for those who wish
+to use it.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing, trace
+fitting, and extraction review are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = no
+Recenter the apertures?
+.le
+.ls resize = no
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+.ls extract = yes
+Extract the one dimensional aperture sums?
+.le
+.ls extras = no
+Extract the raw spectrum (if variance weighting is used), the sky spectrum
+(if background subtraction is used), and variance spectrum (if variance
+weighting is used)?  This information is extracted to the third dimension
+of the output image.
+.le
+.ls review = yes
+Review the extracted spectra?  The \fIinteractive\fR parameter must also be
+yes.
+.le
+
+.ls line = INDEF, nsum = 10
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  For tracing this is the starting line and
+the same number of lines are summed at each tracing point.  A line of
+INDEF selects the middle of the image along the dispersion axis.
+A positive nsum takes a sum while a negative value selects a median
+except that tracing always uses a sum.
+.le
+
+.ls background = "none" (none|average|median|minimum|fit)
+Type of background subtraction.  The choices are "none" for no background
+subtraction, "average" to average the background within the background
+regions, "median" to use the median in the background regions, "minimum" to
+use the minimum in the background regions, or "fit" to fit across the
+dispersion using the background within the background regions.  Note that
+the "average" option does not do any medianing or bad pixel checking,
+something which is recommended.  The fitting option is slower than the
+other options and requires additional fitting parameter.
+.le
+.ls weights = "none"
+Type of extraction weighting.  Note that if the \fIclean\fR parameter is
+set then the weights used are "variance" regardless of the weights
+specified by this parameter.  The choices are:
+.ls "none"
+The pixels are summed without weights except for partial pixels at the
+ends.
+.le
+.ls "variance"
+The extraction is weighted by the variance based on the data values
+and a poisson/ccd model using the \fIgain\fR and \fIreadnoise\fR
+parameters.
+.le
+.le
+.ls pfit = "fit1d" (fit1d|fit2d)
+Profile fitting algorithm to use with variance weighting or cleaning.
+When determining a profile the two dimensional spectrum is divided by
+an estimate of the one dimensional spectrum to form a normalized two
+dimensional spectrum profile.  This profile is then smoothed by fitting
+one dimensional functions, "fit1d", along the lines or columns most closely
+corresponding to the dispersion axis or a special two dimensional
+function, "fit2d", described by Marsh (see \fBapprofile\fR).
+.le
+.ls clean = no
+Detect and replace deviant pixels?
+.le
+.ls skybox = 1
+Box car smoothing length for sky background when using background
+subtraction.  Since the background noise is often the limiting factor
+for good extraction one may box car smooth the sky to improve the
+statistics in smooth background regions at the expense of distorting
+the subtraction near spectral features.  This is most appropriate when
+the sky regions are limited due to a small slit length.
+.le
+.ls saturation = INDEF
+Saturation or nonlinearity level in data units.  During variance weighted
+extractions wavelength points having any pixels above this value are
+excluded from the profile determination and the sigma spectrum extraction
+output, if selected by the \fIextras\fR parameter, flags wavelengths with
+saturated pixels with a negative sigma.
+.le
+.ls readnoise = 0.
+Read out noise in photons.  This parameter defines the minimum noise
+sigma.  It is defined in terms of photons (or electrons) and scales
+to the data values through the gain parameter.  A image header keyword
+(case insensitive) may be specified to get the value from the image.
+.le
+.ls gain = 1
+Detector gain or conversion factor between photons/electrons and
+data values.  It is specified as the number of photons per data value.
+A image header keyword (case insensitive) may be specified to get the value
+from the image.
+.le
+.ls lsigma = 4., usigma = 4.
+Lower and upper rejection thresholds, given as a number of times the
+estimated sigma of a pixel, for cleaning.
+.le
+.ls nsubaps = 1
+During extraction it is possible to equally divide the apertures into
+this number of subapertures.  For multispec format all subapertures will
+be in the same file with aperture numbers of 1000*(subap-1)+ap where
+subap is the subaperture (1 to nsubaps) and ap is the main aperture
+number.  For echelle format there will be a separate echelle format
+image containing the same subaperture from each order.  The name
+will have the subaperture number appended.  For onedspec format
+each subaperture will be in a separate file with extensions and
+aperture numbers as in the multispec format.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, parameters used for centering and
+editing the apertures from \fBapedit\fR, and tracing parameters from
+\fBaptrace\fR.
+
+When this operation is performed from the task \fBapall\fR all
+parameters except the package parameters are included in that task.
+.ih
+DESCRIPTION
+For each image in the input image list, the two dimensional spectra are
+extracted to one dimensional spectra by summing the pixels across the
+dispersion axis at each wavelength along the dispersion axis within a
+set of defined apertures.  The extraction apertures consist of an
+aperture number, a beam number, a title, a center, limits relative to
+the center, a curve describing shifts of the aperture center across the
+dispersion axis as a function of the wavelength, and parameters for
+background fitting and subtraction.  See \fBapextract\fR for a more
+detailed discussion of the aperture structures.
+
+The extracted spectra are recorded in one, two, or three dimensional
+images depending on the \fIformat\fR and \fIextras\fR parameters.  The
+output image rootnames are specified by the \fIoutput\fR list. If the
+list is empty or shorter than the input list the missing names are
+taken to be the same as the input image names.  Because the rootnames
+have extensions added it is common to default to the input names in
+order to preserve a naming relation between the input two dimensional
+spectra and the extracted spectra.
+
+When the parameter \fIextras\fR=no only the extracted spectra are
+output.  If the format parameter \fIformat\fR="onedspec" the output
+aperture extractions are one dimensional images with names formed from
+the output rootname and a numeric extension given by the aperture
+number; i.e. root.0001 for aperture 1.  Note that there will be as many
+output images as there are apertures for each input image, all with the
+same output rootname but with different aperture extensions.  The
+aperture beam number associated with each aperture is recorded in the
+output image under the keyword BEAM-NUM.  The output image name format
+and the BEAM-NUM entry in the image are chosen to be compatible with
+the \fBonedspec\fR package.
+
+If the format parameter is "echelle" or "multispec" the output aperture
+extractions are put into a two dimensional image with a name formed from
+the output rootname and the extension ".ech" or ".ms".  Each line in
+the output image corresponds to one aperture.  Thus in this format
+there is one output image for each input image.  These are the preferred
+output formats for reasons of compactness and ease of handling.  These
+formats are compatible with the \fBonedspec\fR, \fBechelle\fR, and
+\fBmsred\fR packages.  The relation between the line and the aperture
+numbers is given by the header parameter APNUMn where n is the line and
+the value is the aperture number and other numeric information.
+
+If the \fIextras\fR parameter is set to yes then the above formats
+become three dimensional.  Each plane in the third dimension contains
+associated information for the spectra in the first plane.  If variance
+weighted extractions are done the unweighted spectra are recorded.  If
+background subtraction is done the background spectra are recorded.  If
+variance weighted extractions are done the sigma spectrum (the
+estimated sigma of each spectrum pixel based on the individual
+variances of the pixels summed) is recorded.  The order of the
+additional information is as given above.  For example, an unweighted
+extraction with background subtraction will have one additional plane
+containing the sky spectra while a variance weighted extraction with
+background subtractions will have the variance weighted spectra, the
+unweighted spectra, the background spectra, and the sigma spectra in
+consecutive planes.
+
+Aperture definitions may be inherited from those of other images by
+specifying a reference image with the \fBreferences\fR parameter.
+Images in the reference list are matched with those in the
+input list in order.  If the reference image list is shorter than the
+number of input images, the last reference image is used for all
+remaining input images.  Thus, a single reference image may be given
+for all the input images or different reference images may be given for
+each input image.  The special reference name "last" may be used to
+select the last set apertures used in any of the \fBapextract\fR tasks.
+
+If an aperture reference image is not specified or no apertures are
+found for the specified reference image, previously defined apertures
+for the input image are sought in the aperture database.  Note that
+reference apertures supersede apertures for the input image.  If no
+apertures are defined they may be created automatically, the \fIfind\fR
+option, or interactively in the aperture editor, if the
+\fIinteractive\fR and \fIedit\fR options are set.
+
+The functions performed by the task are selected by a set of flag
+parameters.  The functions are an automatic spectrum finding and
+aperture defining algorithm (see \fBapfind\fR) which is ignored if
+apertures are already defined, automatic recentering and resizing
+algorithms (see \fBaprecenter\fR and \fBapresize\fR), an interactive
+aperture editing function (see \fBapedit\fR), a spectrum position tracing
+and trace function fit (see \fBaptrace\fR), and the main function of
+this task, one dimensional spectrum extraction.
+
+Each function selection will produce a query for each input spectrum if
+the \fIinteractive\fR parameter is set.  The queries are answered by
+"yes", "no", "YES", or "NO", where the upper case responses suppress
+the query for following images.  There are other queries associated
+with tracing and extracted spectrum review which first ask whether the
+operation is to be done interactively and, if yes, lead to queries for
+each aperture.  The cursor keys available during spectrum review are
+minimal, only the CURSOR MODE keys for expanding and adjusting the
+graph are available and the quit key 'q'.  If the \fIinteractive\fR
+parameter is not set then aperture editing, interactive trace fitting,
+and spectrum review are ignored.
+
+Background sky subtraction is done during the extraction based on
+background regions and parameters defined by the default parameters or
+changed during the interactive setting of the apertures.  The background
+subtraction options are to do no background subtraction, subtract the
+average, median, or minimum of the pixels in the background regions, or to
+fit a function and subtract the function from under the extracted object
+pixels.  The background regions are specified in pixels from
+the aperture center and follow changes in center of the spectrum along the
+dispersion.  The syntax is colon separated ranges with multiple ranges
+separated by a comma or space.  The background fitting uses the \fBicfit\fR
+routines which include medians, iterative rejection of deviant points, and
+a choice of function types and orders.  Note that it is important to use a
+method which rejects cosmic rays such as using either medians over all the
+background regions (\fIbackground\fR = "median") or median samples during
+fitting (\fIb_naverage\fR < -1).  The background subtraction algorithm and
+options are described in greater detail in \fBapsum\fR and
+\fBapbackground\fR.
+
+Since the background noise is often the limiting factor for good
+extraction one may box car smooth the sky to improve the statistics in
+smooth background regions at the expense of distorting the subtraction
+near spectra features.  This is most appropriate when the sky region is
+limited due to small slit length.  The smoothing length is specified by
+the parameter \fIskybox\fR.
+
+For a more extended discussion about the background determination see
+\fBapbackground\fR.
+
+The aperture extractions consists of summing all the background
+subtracted pixel values at a given wavelength within the aperture
+limits.  The aperture limits form a fixed width aperture but the center
+varies smoothly to follow changes in the position of the spectrum
+across the dispersion axis.  At the ends of the aperture partial pixels
+are used.
+
+The pixels in the sum may be weighted as specified by the \fIweights\fR
+parameter.  If the weights parameter is "none" and the \fIclean\fR
+parameter is no then the simple sum of the pixels (with fractional
+endpoints) is extracted.  If the weights parameter is "variance" or if
+the \fBclean\fR parameter is yes the pixels are weighted by their
+estimated variance derived from a noise model based on the \fIgain\fR
+and \fIreadnoise\fR parameters and a smooth profile function.  Normally
+the profile function is determined from the data being extracted.
+However, one may substitute a "profile" image as specified by the
+\fIprofiles\fR parameter for computing the profile.  This requires that
+the profile image have spectra of identical position and profile as
+the image being extracted.  For example, this would likely be the case
+with fiber spectra and an off-telescope spectrograph and a strong flat
+field or object spectrum could be used for weak spectra.  Note that
+experience has shown that even for very weak spectra there is little
+improvement with using a separate profile image but the user is free
+to experiment.
+
+When the \fIclean\fR parameter is set pixels deviating by more than a
+specified number of sigma from the profile function are excluded from the
+variance weighted sum.  Note that the \fIclean\fR parameter always selects
+variance weights.  For a more complete discussion of the extraction sums,
+variance weighting, cleaning, the noise model, and profile function
+determination see \fBapvariance\fR and \fBapprofiles\fR.
+.ih
+EXAMPLES
+1.  To simply extract the spectra from a multislit observation:
+
+	cl> apsum multislit1
+
+The positions of the slits are defined using either automatic finding
+or with the aperture editor.  The positions of the slits are traced if
+necessary and then the apertures are extracted to the image
+"multslit1.ms".  The steps of defining the slit positions and tracing
+can be done as part of this command or previously using the other tasks
+in the \fBapextract\fR package.
+.ih
+REVISIONS
+.ls APSUM V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+
+The "nsubaps" parameter now allows onedspec and echelle output formats.
+The echelle format is appropriate for treating each subaperture as
+a full echelle extraction.
+
+The dispersion axis parameter was moved to purely a package parameter.
+
+As a final step when computing a weighted/cleaned spectrum the total
+fluxes from the weighted spectrum and the simple unweighted spectrum
+(excluding any deviant and saturated pixels) are computed and a
+"bias" factor of the ratio of the two fluxes is multiplied into
+the weighted spectrum and the sigma estimate.  This makes the total
+fluxes the same.  In this version the bias factor is recorded in the logfile
+if one is kept.  Also a check is made for unusual bias factors.
+If the two fluxes disagree by more than a factor of two a warning
+is given on the standard output and the logfile with the individual
+total fluxes as well as the bias factor.  If the bias factor is
+negative a warning is also given and no bias factor is applied.
+In the previous version a negative (inverted) spectrum would result.
+.le
+.ih
+SEE ALSO
+apbackground, apvariance, approfile,
+apdefault, apfind, aprecenter, apresize, apedit, aptrace, apall
+.endhelp
diff --git a/noao/twodspec/apextract/doc/aptrace.hlp b/noao/twodspec/apextract/doc/aptrace.hlp
new file mode 100644
index 00000000..3b9ddd38
--- /dev/null
+++ b/noao/twodspec/apextract/doc/aptrace.hlp
@@ -0,0 +1,354 @@
+.help aptrace Sep96 noao.twodspec.apextract
+.ih
+NAME
+aptrace -- Trace spectra for aperture extraction
+.ih
+USAGE
+.nf
+aptrace images
+.fi
+.ih
+PARAMETERS
+.ls input
+List of input images to be traced.
+.le
+.ls apertures = ""
+Apertures to recenter, resize, trace, and extract.  This only applies
+to apertures read from the input or reference database.  Any new
+apertures defined with the automatic finding algorithm or interactively
+are always selected.  The syntax is a list comma separated ranges
+where a range can be a single aperture number, a hyphen separated
+range of aperture numbers, or a range with a step specified by "x<step>";
+for example, "1,3-5,9-12x2".
+.le
+.ls references = ""
+List of reference images to be used to define apertures for the input
+images.  When a reference image is given it supersedes apertures
+previously defined for the input image. The list may be null, "", or
+any number of images less than or equal to the list of input images.
+There are three special words which may be used in place of an image
+name.  The word "last" refers to the last set of apertures written to
+the database.  The word "OLD" requires that an entry exist
+and the word "NEW" requires that the entry not exist for each input image.
+.le
+
+.ls interactive = yes
+Run this task interactively?  If the task is not run interactively then
+all user queries are suppressed and interactive aperture editing and trace
+fitting are disabled.
+.le
+.ls find = yes
+Find the spectra and define apertures automatically?  In order for
+spectra to be found automatically there must be no apertures for the
+input image or reference image defined in the database.
+.le
+.ls recenter = no
+Recenter the apertures?
+.le
+.ls resize = yes
+Resize the apertures?
+.le
+.ls edit = yes
+Edit the apertures?  The \fIinteractive\fR parameter must also be yes.
+.le
+.ls trace = yes
+Trace the apertures?
+.le
+.ls fittrace = yes
+Interactively fit the traced positions by a function?  The \fIinteractive\fR
+parameter must also be yes.
+.le
+
+.ls line = INDEF, nsum = 1
+The dispersion line (line or column perpendicular to the dispersion
+axis) and number of adjacent lines (half before and half after unless
+at the end of the image) used in finding, recentering, resizing,
+and editing operations.  For tracing this is the starting line and
+the same number of lines are summed at each tracing point.  A line of
+INDEF selects the middle of the image along the dispersion axis.
+A positive nsum selects the number of lines to sum while a negative
+value selects a median.  Tracing always uses a sum.
+.le
+.ls step = 10
+Step along the dispersion axis between determination of the spectrum
+positions.
+.le
+.ls nlost = 3
+Number of consecutive steps in which the profile is lost before quitting
+the tracing in one direction.  To force tracing to continue through
+regions of very low signal this parameter can be made large.  Note,
+however, that noise may drag the trace away before it recovers.
+.le
+
+The following parameters are the defaults used to fit the traced positions
+by a function of the dispersion line.  These parameters are those used by
+the ICFIT package.
+.ls function = "legendre"
+Default trace fitting function.  The fitting function types are
+"chebyshev" polynomial, "legendre" polynomial, "spline1" linear spline, and
+"spline3" cubic spline.
+.le
+.ls order = 2
+Default trace function order.  The order refers to the number of
+terms in the polynomial functions or the number of spline pieces in the spline
+functions.
+.le
+.ls sample = "*"
+Default fitting sample.  The sample is given by a set of colon separated
+ranges each separated by either whitespace or commas.  The string "*" refers
+to all points.
+.le
+.ls naverage = 1
+Default number of points to average or median.  Positive numbers
+average that number of sequential points to form a fitting point.
+Negative numbers median that number, in absolute value, of sequential
+points.  A value of 1 does no averaging and each data point is used in the
+.le
+.ls niterate = 0
+Default number of rejection iterations.  If greater than zero the fit is
+used to detect deviant traced positions and reject them before repeating the
+fit.  The number of iterations of this process is given by this parameter.
+.le
+.ls low_reject = 3., high_reject = 3.
+Default lower and upper rejection sigma.  If greater than zero traced
+points deviating from the fit below and above the fit by more than this
+number of times the sigma of the residuals are rejected before refitting.
+.le
+.ls grow = 0.
+Default reject growing radius.  Traced points within a distance given by this
+parameter of any rejected point are also rejected.
+.le
+.ih
+ADDITIONAL PARAMETERS
+I/O parameters and the default dispersion axis are taken from the
+package parameters, the default aperture parameters from
+\fBapdefault\fR, automatic aperture finding parameters from
+\fBapfind\fR, recentering parameters from \fBaprecenter\fR, resizing
+parameters from \fBapresize\fR, and parameters used for centering and
+editing the apertures from \fBapedit\fR.
+
+When this operation is performed from the task \fBapall\fR all parameters
+except the package parameters are included in that task.
+.ih
+DESCRIPTION
+For each image in the input image list the position of the spectrum
+within each aperture are determined at a number of points along the
+dispersion axis and a smooth function is fit to these positions.  The
+fitted curve defines a shift to be added to the aperture center at each
+wavelength.  Other options allow defining apertures using a reference
+image, defining apertures through an automatic finding algorithm (see
+\fBapfind\fR), automatically recentering apertures (see
+\fBaprecenter\fR), automatically resizing apertures (see
+\fBapresize\fR), and interactively editing the apertures prior to
+tracing (see \fBapedit\fR).  Tracing is selected with the parameter
+\fItrace\fR.  If the tracing is done interactively (the
+\fIinteractive\fR parameter set to yes) then the user is queried
+whether or not to trace each image.  The responses are "yes", "no",
+"YES", or "NO", where the upper case queries suppress this query
+for the following images.
+
+The tracing begins with the specified dispersion line.  A dispersion
+line is a line or column of the image perpendicular to the dispersion
+axis.  The dispersion axis is defined in the image header or by the
+package parameter \fIdispaxis\fR.  If the starting dispersion line is
+INDEF then the middle dispersion line of the image is used.  The
+positions of the spectra are determined using the \fBcenter1d\fR
+algorithm and the centering parameters from the \fBapedit\fR task.
+(See help under \fBcenter1d\fR for a description of the one dimensional
+position measuring algorithm.) The positions are redetermined at other
+points along the dispersion axis by stepping from the starting line in
+steps specified by the user.  A number of dispersion lines around each
+dispersion line to be measured may be summed to improve the position
+determinations, particularly for weak profiles.  This number usually is
+set equal to the tracing step.
+
+It is important to understand how to set the step size and the
+relationship between the step size and the centering error radius.
+Larger steps reduce the computational time, which is an important
+consideration.  However, if the step is too large then the tracing may
+fail to follow the systematic changes in the positions of the
+spectrum.  The centering error radius, \fIradius\fR, is used to limit
+the maximum position change between two successive steps.  If the
+positions of a spectrum changes by more than the specified amount or
+the data contrast falls below the \fIthreshold\fR parameter then
+the position is marked as lost.
+
+The centering radius should be large enough to follow changes in the
+spectrum positions from point to point but small enough to detect an error
+in the tracing by a sudden abrupt change in position, such as caused by
+crowding with other spectra or by the disappearance of the spectrum.  The
+\fInlost\fR parameter determines how many consecutive steps the position
+may fail to be found before tracing in that direction is stopped.  If this
+parameter is small the trace will stop quickly upon loss of the profile
+while if it is very large it will continue to try and recover the profile.
+
+The parameter \fIthreshold\fR checks for the vanishing of a spectrum by
+requiring a minimum range in the data used for centering.  If the
+tracing fails when the spectra are strong and well defined the problem
+is usually that the step size is too large and/or the centering error
+radius is too small.
+
+The traced positions of a spectrum include some measurement variation
+from point to point.  Since the actual position of the spectrum in the
+image should be a smooth curve, a function of the dispersion line is fit
+to the measured points.  The fitted function is stored as part of the
+aperture description.  It is an offset to be added to the aperture's
+center as a function of the dispersion line.  Even if the fitting is not
+done interactively plots of the trace and the fit are recorded in the
+plot file or device specified by the parameter \fIplotfile\fR.
+
+Fitting the traced spectrum positions with a smooth function may be
+performed interactively when parameters \fIfittrace\fR and
+\fIinteractive\fR are yes.  This allows changing the default fitting
+parameters.  The function fitting is done with the interactive curve
+fitting tools described under the help topic \fBicfit\fR.  There are
+two levels of queries when fitting the spectrum positions
+interactively; prompts for each image and prompts for each aperture in
+an image.  These prompts may be answered individually with the lower
+case responses "yes" or "no" or answered for all further prompts with
+the responses "YES" or "NO".  Responding with "yes" or "YES" to the
+image prompt allows interactive fitting of the traced positions for the
+spectra.  Prompts are then given for each aperture in the image.  When
+an spectrum is not fit interactively the last set of fitting parameters
+are used (initially the default function and order given by the task
+parameters).  Note that answering "YES" or "NO" to a aperture prompt
+applies to all further aperture in the current image only.  Responding
+with "no" or "NO" to the image prompt fits the spectrum positions for
+all apertures in all images with the last set of fitting parameters.
+
+The tracing may also be done from the interactive aperture editor with
+the 't' key.  The aperture tracing algorithm may be selected from many
+of the tasks in the package with the \fItrace\fR parameter.
+.ih
+APTRACE DATABASE COEFFICIENTS
+The path of an aperture is described by a function that gives an additive
+offset relative to the aperture center as stored under the database keyword
+center.  The function is saved in the database as a series of
+coefficients.  The section containing the coefficients starts with the
+keyword "curve" and the number of coefficients.
+
+The first four coefficients define the type of function, the order
+or number of spline pieces, and the range of the independent variable
+(the line or column coordinate along the dispersion).  The first
+coefficient is the function type code with values:
+
+.nf
+	Code	Type
+	   1	Chebyshev polynomial
+	   2	Legendre polynomial
+	   3	Cubic spline
+	   4	Linear spline
+.fi
+
+The second coefficient is the order (actually the number of terms) of
+the polynomial or the number of pieces in the spline.
+
+The next two coefficients are the range of the independent variable over
+which the function is defined.  These values are used to normalize the
+input variable to the range -1 to 1 in the polynomial functions.  If the
+independent variable is x and the normalized variable is n, then
+
+.nf
+	n = (2 * x - (xmax + xmin)) / (xmax - xmin)
+.fi
+
+where xmin and xmax are the two coefficients.
+
+The spline functions divide the range into the specified number of
+pieces.  A spline coordinate s and the nearest integer below s,
+denoted as j, are defined by
+
+.nf
+	s = (x - xmin) / (xmax - xmin) * npieces
+	j = integer part of s
+.fi
+
+where npieces are the number of pieces.
+
+The remaining coefficients are those for the appropriate function.
+The number of coefficients is either the same as the function order
+for the polynomials, npieces+1 for the linear spline, or npieces + 3
+for the cubic spline.
+
+1. Chebyshev Polynomial
+
+The polynomial can be expressed as the sum
+
+.nf
+	y = sum from i=1 to order {c_i * z_i}
+.fi
+
+where the c_i are the coefficients and the z_i are defined
+interactively as:
+
+.nf
+	z_1 = 1
+	z_2 = n
+	z_i = 2 * n * z_{i-1} - z_{i-2}
+.fi
+
+2. Legendre Polynomial
+
+The polynomial can be expressed as the sum
+
+.nf
+	y = sum from i=1 to order {c_i * z_i}
+.fi
+
+where the c_i are the coefficients and the z_i are defined
+interactively as:
+
+.nf
+	z_1 = 1
+	z_2 = n
+	z_i = ((2*i-3) * n * z_{i-1} - (i-2) * z_{i-2}) / (i - 1)
+.fi
+
+3. Linear Spline
+
+The linear spline is evaluated as
+
+.nf
+	y = c_j * a + c_{j+1} * b
+.fi
+
+where j is as defined earlier and a and b are fractional difference
+between s and the nearest integers above and below
+
+.nf
+	a = (j + 1) - s
+	b = s - j
+.fi
+
+4.  Cubic Spline
+
+The cubic spline is evaluated as
+
+.nf
+	y = sum from i=0 to 3 {c_{i+j} * z_i}
+.fi
+
+where j is as defined earlier.  The term z_i are computed from
+a and b, as defined earlier, as follows
+
+.nf
+	z_0 = a**3
+	z_1 = 1 + 3 * a * (1 + a * b)
+	z_2 = 1 + 3 * b * (1 + a * b)
+	z_3 = b**3
+.fi
+.ih
+EXAMPLES
+.ih
+REVISIONS
+.ls APTRACE V2.11
+The "apertures" parameter can be used to select apertures for resizing,
+recentering, tracing, and extraction.  This parameter name was previously
+used for selecting apertures in the recentering algorithm.  The new
+parameter name for this is now "aprecenter".
+.le
+.ih
+SEE ALSO
+apdefault, apfind, aprecenter, apresize, apedit, apall,
+center1d, icfit, gtools
+.endhelp
diff --git a/noao/twodspec/apextract/doc/apvariance.hlp b/noao/twodspec/apextract/doc/apvariance.hlp
new file mode 100644
index 00000000..6ff1e073
--- /dev/null
+++ b/noao/twodspec/apextract/doc/apvariance.hlp
@@ -0,0 +1,159 @@
+.help apvariance Aug90 noao.twodspec.apextract
+
+.ce
+Variance Weighted and Cleaned Extractions
+
+
+There are two types of aperture extraction (estimating the background
+subtracted flux across a fixed width aperture at each image line or
+column) in the APEXTRACT package.  One is a simple sum of pixel values
+across an aperture.  It is selected by specifying "none" for the
+\fIweights\fR parameter.  The second type weights each pixel in the sum
+by it's estimated variance based on a spectrum model and detector noise
+parameters.  This type of extraction is selected by specifying
+"variance" for the weighting parameter.  These two extractions are
+defined by the following equations.
+
+.nf
+	none:	S = sum { I - B }
+    variance:	S = sum { (P**2 / V) (I - B) / P } / sum { P**2 / V }
+.fi
+
+S is the one dimensional spectrum flux at a particular wavelength (line
+or column along the dispersion axis).  The sum is over all pixels at
+that wavelength within the aperture limits.  If the aperture endpoints
+occupy only a fraction of a pixel then the pixel value above the
+background is multiplied by the fraction.  I is the pixel value and B
+is the estimated background at that pixel (see \fBapbackground\fR), P
+is estimated normalized profile value for that pixel (see
+\fBapprofile\fR), and V is the estimated variance of the pixel based on
+the noise model described below.  Note that the quantity (I-B)/P is an
+independent estimate of the total flux from one pixel since the
+integral of P is one and it is these estimates that are variance
+weighted.
+
+Variance weighting is often called "optimal" extraction since it
+produces the best unbiased signal-to-noise estimate of the flux in the
+two dimensional profile.  The theory and application of this type of
+weighting has been described in several papers.  The ones which were
+closely examined and used as a model for the algorithms in this
+software are "An Optimal Extraction Algorithm for CCD Spectroscopy",
+PASP 98, 609, 1986, by Keith Horne and "The Extraction of Highly
+Distorted Spectra", PASP 100, 1032, 1989, by Tom Marsh.
+
+The noise model for the image data used in the variance weighting,
+cleaning, and profile fitting consists of a constant gaussian noise and
+a photon count dependent poisson noise.  The signal is related to the
+number of photons detected in a pixel by a \fRgain\fR parameter given
+as the number of photons per data number.  The gaussian noise is given
+by a \fIreadnoise\fR parameter which is a defined as a sigma in
+photons.  The poisson noise is approximated as gaussian with sigma
+given by the number of photons.
+
+Some additional effects which should be considered in principle, and
+which are possibly important in practice, are that the variance
+estimate should be based on the actual number of photons detected before
+correction for pixel sensitivity; i.e. before flat field correction.
+Furthermore the uncertainty in the flat field should also be included
+in the weighting.  However, the profile must be determined free of
+sensitivity effects including rapid larger scale variations such as
+fringing.  Thus, ideally one should input the unflat-fielded
+observation and the flat field data and carry out the extractions with
+the above points in mind.  However, due to the complexity often
+involved in basic CCD reductions and special steps required for
+producing spectroscopic flat fields this level of sophistication is not
+provided by the current package.  The package does provide, however,
+for propagation of an approximate uncertainty in the background
+estimate when using background subtraction.
+
+The noise model is described by the following equations.
+
+.nf
+    (1) V = max (VMIN, (R**2 + I + VB) / G**2)
+	    max (VMIN, (R**2 + S * P + B + VB) / G**2)
+
+    (2) VB = 0.                 if (B = 0)
+	   = B / (N - 1)        if (B > 0)
+
+    (3) VMIN = 1 / G**2         if (R = 0)
+	       R**2 / G**2      if (R > 0)
+.fi
+
+V is the desired variance of a pixel to use for variance weighting.  R
+is the photon read out noise specified by the parameter \fIreadnoise\fR
+and G is the photon per data value gain specified by the parameter
+\fIgain\fR.  There are two forms to (1).  The first is used in the
+initial pass of estimating the spectrum flux S and the actual pixel
+value I (which includes any background) is used for the poisson term.
+The other form is used in a second pass (and further passes if
+cleaning) using the estimated data value based on the normalized
+profile P scaled to the estimated total flux plus the estimated
+background B; i.e. I estimated = S * P + B.
+
+The background variance VB is computed using the poisson noise model
+based on the estimated background counts.  If no background subtraction
+is done then both B and VB are set to zero.  If a background is
+determined the background is either an average or function fit to
+pixels in defined background regions.  If a fit is used B need not be a
+constant.   Because the background estimate is based on a finite number of
+pixels, the poisson variance estimate is divided by the number N (minus
+one) of pixels used in determining the background.  The number of
+pixels used includes any box car smoothing.  Thus, the larger the
+number of background pixels the smaller the background noise
+contribution to the variance weighting.  This method is only
+approximate since no correction is made for the number of degrees of
+freedom and correlations when using the fitting method of background
+estimation.
+
+VMIN is a minimum variance need to avoid generating zero or negative
+variances from the data.  The definition of VMIN is such that if a zero
+read out noise is specified (which is certainly possible such as with
+photon counting detectors) then a minimum of 1 photon is imposed.
+Otherwise the minimum is set by the read out noise even if the poisson
+count part is (unphysically) negative.
+
+One deviation from the linear photon response mode which is considered
+is saturation.   A data level specified by the parameter
+\fIsaturation\fR is used to exclude data from the profile fitting.
+During extraction the saturated pixels are not treated any differently
+than unsaturated pixels except that dispersion points with saturated
+pixels are flagged by reversing the sign of the final estimated sigma;
+the sigma output is enabled with the \fIextras\fR parameter.  Exclusion
+of saturated pixels from the extraction, as is done with deviant
+pixels, was tried but this resulted in higher noise in the spectrum.
+
+If removal of cosmic rays and other deviant pixels is desired, called
+cleaning and selected with a \fIclean\fR parameter, they are
+iteratively rejected based on the estimated variance and excluded from
+the weighted sum.  Note that a cleaned extraction is always variance
+weighted regardless of the value of the \fIweights\fR parameter.  This
+makes sense since the detector noise parameters must be specified and
+the spectrum profile computed, so all of the computational effort must
+be done anyway, and the variance weighting is as good or superior to a
+simple unweighted extraction.
+
+The detection and removal of deviant pixels is straightforward.  Based
+on the noise model described earlier, pixels deviating by more than a
+specified number of sigma (square root of the variance) above or below
+the model are removed from the weighted sum.  A new spectrum estimate
+is made and the rejection is repeated.  The rejections are made one at
+a time starting with the most deviant and up to half the pixels in the
+aperture may be rejected.  The total number of rejected pixels in the
+spectrum is recorded in the logfile and a profile plot of data and
+model profile is recorded in the plotfile.
+
+As a final step when computing a weighted/cleaned spectrum the total
+fluxes from the weighted spectrum and the simple unweighted spectrum
+(excluding any deviant and saturated pixels) are computed and a
+"bias" factor of the ratio of the two fluxes is multiplied into
+the weighted spectrum and the sigma estimate.  This makes the total
+fluxes the same.  The bias factor is recorded in the logfile
+if one is kept.  Also a check is made for unusual bias factors.
+If the two fluxes disagree by more than a factor of two a warning
+is given on the standard output and the logfile with the individual
+total fluxes as well as the bias factor.  If the bias factor is
+negative a warning is also given and no bias factor is applied.
+.ih
+SEE ALSO
+apbackground approfiles apall apsum
+.endhelp
diff --git a/noao/twodspec/apextract/doc/dictionary b/noao/twodspec/apextract/doc/dictionary
new file mode 100644
index 00000000..1046499c
--- /dev/null
+++ b/noao/twodspec/apextract/doc/dictionary
@@ -0,0 +1,282 @@
+ADU
+APALL
+APAXIS
+APEDIT
+APEXTRACT
+APFIND
+APFIT
+APFLATTEN
+APFORMAT
+APID
+APID2
+APIO
+APMASK
+APNORMALIZE
+APNUM2
+APNUMn
+APPARAMS
+APRECENTER
+APRESIZE
+APSCATTER
+APSTRIP
+APSUM
+APTRACE
+CCD
+CL
+DISPAXIS
+ECHELLE
+EOF
+EPARAM
+FIT1D
+FLAT1D
+Fri
+Horne
+Horne's
+ICFIT
+IMARITH
+IMREPLACE
+IMSURFIT
+INDEF
+IRAF
+Jul
+Jul90
+Nfind
+P.O
+PASP
+PSET
+RMS
+SETDISP
+SN
+STDIN
+STDOUT
+Slitlet
+VB
+VMIN
+Valdes
+ansclob
+ansclobber
+ansclobber1
+ansdbwr
+ansdbwrite
+ansdbwrite1
+ansedit
+ansextr
+ansextract
+ansfind
+ansfit
+ansfits
+ansfitscatter
+ansfitsmooth
+ansfitspec
+ansfitspec1
+ansfitt
+ansfittrace
+ansfittrace1
+ansflat
+ansmask
+ansnorm
+ansrece
+ansrecenter
+ansresi
+ansresize
+ansrevi
+ansreview
+ansreview1
+ansscat
+anssmoo
+anssmooth
+anstrac
+anstrace
+ap
+apall
+apall1
+apbackground
+apdefault
+apdefault.apidtable
+apdefault.b
+apdefault.lower
+apdefault.upper
+apdemo1d
+apdemo2d
+apdemo2d.ms
+apdemos
+apdemosdb
+apedit
+apedit.radius
+apedit.threshold
+apedit.width
+apertur
+apextract
+apextractsys
+apfind
+apfind.maxsep
+apfind.minsep
+apfind.nfind
+apfind.order
+apfit
+apfit1
+apflat1
+apflatten
+apidtab
+apidtable
+apio
+aplast
+apmask
+apnorm1
+apnormalize
+apparams
+approfile
+approfiles
+aprecenter
+aprecenter.apertures
+aprecenter.npeaks
+aprecenter.shift
+apresize
+apresize.avglimits
+apresize.bkg
+apresize.llimit
+apresize.peak
+apresize.r
+apresize.ulimit
+apresize.ylevel
+apscat1
+apscat2
+apscatter
+apscript
+apstrip
+apsum
+apsum.background
+apsum.clean
+apsum.extras
+apsum.gain
+apsum.lsigma
+apsum.nsubaps
+apsum.readnoise
+apsum.saturation
+apsum.skybox
+apsum.usigma
+apsum.weights
+aptrace
+aptrace.function
+aptrace.grow
+aptrace.high
+aptrace.low
+aptrace.naverage
+aptrace.niterate
+aptrace.nsum
+aptrace.order
+aptrace.sample
+aptrace.step
+apvariance
+artdata
+avg
+avglimi
+avglimits
+backgro
+bkg
+ccd
+cennorm
+center1d
+chebyshev
+cl
+clopset
+computerese
+curfit
+dbwrite
+dispaxi
+dispaxis
+dropoff
+ech
+ech001
+echelle
+echelles
+elp
+eparam
+fiber1
+fitscatter
+fitsmooth
+fitspec
+fittrace
+fittype
+flat001,flat002
+funct
+gaussian
+gkimosaic
+gtools
+icfit
+im
+im1
+image.pl
+image1
+imarith
+imh
+imred
+imred.generic.flat1d
+imsurfit
+keystroke
+legendre
+llimit
+logfile
+longslit
+lparam
+ls1
+lsigma
+maxsep
+maxtilt
+minsep
+mk1dspec
+mk2dspec
+mknoise
+msred
+multislit1
+multspec.ms
+naverage
+ndhelp
+nessie
+newimage
+nfind
+niter
+niterat
+niterate
+nl
+noao.twodspec.apextract
+npeaks
+nsubaps
+nsum
+onedspec
+onedspec.continuum
+pl
+plotfile
+poisson
+polyord
+polysep
+pset
+psets
+qtz001,qtz002
+rdnoise
+readnoi
+readnoise
+rec
+ref
+res
+root.0001
+rootname
+rootnames
+sampl
+saturat
+setdisp
+skybox
+slitlet
+slitlets
+spline1
+spline3
+thresho
+twodspec
+ulimit
+usigma
+whitespace
+widt
+xlow
+xmax
+xmin
+ylevel
diff --git a/noao/twodspec/apextract/doc/old/Tutorial.hlp b/noao/twodspec/apextract/doc/old/Tutorial.hlp
new file mode 100644
index 00000000..fd0ff8e8
--- /dev/null
+++ b/noao/twodspec/apextract/doc/old/Tutorial.hlp
@@ -0,0 +1,278 @@
+.help Tutorial Sep86 "Apextract Tutorial"
+.ih
+TOPICS
+The APEXTRACT tutorial consists of a number of topics.  The topics are brief
+and describe the simplest operations.  More sophisticated discussions are
+available for the tasks in the printed documentation and through the on-line
+\fBhelp\fR facility; i.e. "help taskname".  To obtain information
+on a particular topic type "tutor topic" where the topic is one of the
+following:
+
+.nf
+			TOPICS
+
+         topics - List of topics
+       overview - An overview of the \fBapextract\fR tasks
+   organization - How the package is organized
+      apertures - Definition of apertures
+       defining - How to define apertures
+     references - Using reference images to define apertures
+        queries - Description of interactive queries
+	 cosmic - Problems with cosmic ray removal
+	    all - Print all of this tutorial
+.fi
+.ih
+OVERVIEW
+The \fBapextract\fR tasks extract spectra from two dimensional images.
+One image axis is the dispersion axis and the other image axis is the
+aperture axis.  The user defines apertures whose position along the
+aperture axis is a function of position along the dispersion axis and
+whose width is fixed.  There are two types of aperture extractions.
+\fIStrip\fR extraction produces two dimensional images in which the
+center of the aperture is exactly centered along one of the lines or
+columns of the image and the edges of the image just include the
+edges of the aperture.  \fISum\fR extraction sums the pixels across
+the aperture at each point along the dispersion to produce a one
+dimensional spectrum.  The extraction algorithms include
+fitting and subtracting a background, modeling the profiles across the
+dispersion, detecting and removing deviant pixels which do not fit the
+model profiles, and weighting the pixels in the sum extraction according
+to the signal-to-noise.
+
+To extract spectra one must define the dispersion axis by placing the
+parameter DISPAXIS in the image headers using the task \fBsetdisp\fR.
+Then apertures are defined either automatically, interactively, or by
+reference to an image in which apertures have been previously defined.
+Initially the apertures are aligned parallel to the dispersion axis
+but if the spectra are not aligned with the dispersion axis and have
+profiles which can be traced then the position of the aperture along
+the aperture axis can be made a function of position along the dispersion
+axis.  Finally, the extraction operation is performed for each aperture.
+.ih
+ORGANIZATION
+The tasks in the \fBapextract\fR package are highly integrated.  This
+means that tasks call each other.  For example, the aperture
+editing task may be called from the finding, tracing, or extraction
+tasks.  Also from within the aperture editor the finding, tracing, and
+extraction tasks may be run on selected apertures.  This organization
+provides the flexibility to process images either step-by-step,
+image-by-image, or very interactively from the aperture editor.  For
+example, one may defined apertures for all the images, trace all the
+images, and then extract all the images or, alternatively, define,
+trace, and extract each image individually.
+
+This organization also implies that parameters from many tasks are used
+during the execution of a single task.  For example, the editing
+parameters are used in any of the tasks which may enter the interactive
+editing task.  Two tasks, \fBapio\fR and \fBapdefault\fR, only set
+parameters but these parameters are package parameters which affect all
+the other tasks.  There are two effects of this parameter
+organization.  First, only parameters from the task being executed may
+be specified on the command line or with menu mode.  However, the
+parameters are logically organized and the parameter list for any
+particular task is not excessively long or complex.  For example, the
+number of parameters potentially used by the task \fBapsum\fR is 57
+parameters instead of just the parameters logically related to the
+extraction itself.
+
+Another feature of the package organization is the ability to
+control the flow and interactivity of the tasks.  The parameter
+\fIinteractive\fR selects whether the user will be queried about various
+operations and if the aperture editor, trace fitting, and extraction
+review will be performed.  The parameters \fBdbwrite,
+find, recenter, edit, trace, fittrace, sum, review\fR, and
+\fBstrip\fR select which operations may be performed by a particular
+task.  When a task is run interactively the user is queried about
+whether to perform each operation on each image.  A query may be answered
+individually or as a group.  In the latter case the query will not be
+repeated for other images but will always take the specified action.
+This allows the user to begin interactively and then reduce
+the interactivity as the images are processed and parameters are refined.
+For additional discussion of these parameters see the topic QUERIES.
+
+Finally, the package has attempted to provide good logging facilities.
+There are log files for both time stamped text output and plots.
+The text log is still minimal but the plot logging is complete
+and allows later browsing and hardcopy review of batch processing.
+See \fBapio\fR for further discussion.
+
+This package organization is somewhat experimental.  Let us know what
+you think.
+.ih
+APERTURES
+An aperture consists of the following elements:
+
+.ls id    
+An integer aperture identification number.  The identification number
+must be unique.  The aperture number is used as the default extension
+of the extracted spectra.
+.le
+.ls beam    
+An integer beam number.  The beam number need not be unique; i.e.
+several apertures may have the same beam number.  The beam number will
+be recorded in the image header of the extracted spectrum.  Note that
+the \fBonedspec\fR package restricts the beam numbers to the range 0 to
+49.
+.le
+.ls cslit, cdisp
+The center of the aperture along the slit and dispersion axes in the two
+dimensional image.
+.le
+.ls lslit, ldisp
+The lower limits of the aperture, relative to the aperture center,
+along the slit and dispersion axes.  The lower limits need not be less
+than the center.
+.le
+.ls uslit, udisp
+The upper limits of the aperture, relative to the aperture center,
+along the slit and dispersion axes.  The upper limits need not be greater
+than the center.
+.le
+.ls curve
+An shift to be added to the center position for the slit axis which is
+a function of position along the dispersion axis.  The function is one
+of the standard IRAF \fBicfit\fR types; a legendre polynomial, a chebyshev
+polynomial, a linear spline, or a cubic spline.
+.le
+.ls background
+Background fitting parameters used by the \fBicfit\fR package for background
+subtraction.  Background parameters need not be used if background
+subtraction is not needed.  The background sample regions are specified
+relative to aperture center.
+.le
+
+The aperture center is the only absolute coordinate relative to the
+image or image section.  The size and shape of the aperture are
+specified relative to the aperture center.  The center and aperture
+limits in image coordinates along the slit axis are functions of the
+dispersion coordinate, lambda, given by
+
+.nf
+	center(lambda) = cslit + curve(lambda)
+	 lower(lambda) = center(lambda) + lslit
+	 upper(lambda) = center(lambda) + uslit
+.fi
+
+Note that both the lower and upper constants are added to the center
+defined by the aperture center and the curve offset.  The aperture limits
+along the dispersion axis are constant,
+
+.nf
+	        center(s) = cdisp
+	         lower(s) = center(s) + ldisp
+	         upper(s) = center(s) + udisp
+.fi
+
+Usually the aperture size along the dispersion is equal to the entire image.
+.ih
+DEFINING APERTURES
+If a reference image is specified the \fBapextract\fR tasks first search
+the database for it's apertures.  Note that this supercedes any apertures
+previously defined for the input image.  If no reference apertures are
+found then the apertures for the input image are sought.
+If no apertures are defined at this point then apertures
+may be defined automatically, interactively, or, by default, in the center
+of the image.  The automatic method, \fBapfind\fR, locates spectra as peaks
+across the dispersion and then defines default apertures given by the
+parameters from \fBapdefault\fR.  The algorithm is controlled
+by specifying the number of apertures and a minimum separation between
+spectra.  Only the strongest peaks are selected.
+
+The interactive method, \fBapedit\fR, allows the user to mark the positions
+of apertures and to adjust the aperture parameters such as the limits.
+The aperture editor may be used edit apertures defined by any of the
+other methods.
+
+If no apertures are defined when tracing or extraction is begun, that is
+following the optional editing, then a default aperture is defined
+centered along the aperture axis of the image.  This ultimate default
+may be useful for spectra defined by image sections; i.e. the image
+section is a type of aperture.  Image sections are sometimes used with
+multislit spectra.
+.ih
+REFERENCE IMAGES
+The \fBapextract\fR tasks define apertures for an input image by
+first searching the database for apertures recorded under the name
+of the reference image.  Use of a reference image implies
+superceding the input image apertures.  Reference images are specified
+by an image list which is paired with
+the input image list.  If the number of reference images
+is less than the number of input images then the last reference image
+is used for all following images.  Generally, the reference image list
+consists of the null string if reference images are not to be used,
+a single image which is applied to all input images, or a list
+which exactly matches the input list.  The special reference image
+name "last" may be used to refer to the last apertures written to
+the database; usually the previous input image.
+
+The task parameter \fIrecenter\fR specifies whether the
+reference apertures are to be recentered on the spectra in the input
+image.  If recentering is desired the \fBcenter1d\fR centering algorithm
+is used with centering parameters taken from the task \fBapedit\fR.
+The spectra in the image must all have well defined profiles for the
+centering.  It does not make sense to center an aperture defined for
+a region of sky or background or for an arc spectrum.
+
+Recentering is used when the only change between two spectra is
+a shift along the aperture axis.  This can reduce the number of
+images which must be traced if tracing is required by using a
+traced reference image and just recentering on the next spectra.
+Recentering of a traced reference image is also useful when
+the spectra are too weak to be traced reliably.  Recentering would be
+most commonly used with echelle or multiaperture spectra.
+
+Recentering is not used when extracting sky or arc calibration spectra
+from long slit or multislit images.  This is because it is desirable
+to extract from the same part of the detector as the object spectra and
+because recentering does not make sense when there is no profile across
+the aperture.  Centering or recentering is also not used when dealing
+with apertures covering parts of extended objects in long slit spectra.
+.ih
+QUERIES
+When the interactive parameter is specified as yes in a task then the user
+is queried at each step of the task.  The queries refer to either a
+particular image or a particular aperture in an image.  The acceptable
+responses to the queries are the strings "yes", "no", "YES", and "NO".
+The lower case answers refer only to the specific query.  The upper
+case answers apply to all repetitions of query for other images and
+apertures.  The upper case reponses then suppress the query and take
+the specified action every time.  This allows tasks to be highly interactive
+by querying at each step and for each image or to skip or perform
+each step for all images without queries.
+
+The two steps of fitting a function to traced positions and reviewing
+one dimensional extracted spectra, selected with the parameters
+\fIaptrace.fittrace\fR and \fIapsum.review\fR have two levels of queries.
+First a query is made for the image being traced or extracted.  If
+the answer is "yes" or "YES" then a query is made for each aperture.
+A response of "YES" or "NO" applies only to the remaining apertures
+and not to apertures of a later image.
+.ih
+COSMIC RAYS
+The cleaning and modeling features available during aperture extraction
+are fairly good.  They are described in the documentation for the
+tasks.  It can only go so far towards discriminating cosmic rays
+because of problems described below.  Further work on the algorithm may
+improve the performance but it is best, when feasible, to first
+eliminate at least the strongest cosmic rays from the data before
+extracting.  One recommended method is to use \fBlineclean\fR with a
+high rejection threshold and a high order.
+
+There are two difficult problems encountered in using the
+\fBapextract\fR tasks for cosmic ray detection.  First, the spectral
+profiles are first interpolated to a common center before comparison
+with the average profile model.  The interpolation often splits single
+strong spikes into two high points of half the intensity, as is
+intuitively obvious.  Furthermore, for very strong spikes there is
+ringing in the interpolator which makes the interpolated profile depart
+significantly from the original profile.  The fact that the
+interpolated profile now has two or more deviant points makes it much
+harder to decide which points are in the profile.  This leads to the
+second problem.  The average profile model is scaled to fit the
+spectrum profile.  When there are several high points it is very
+difficult to discriminate between a higher scale factor and bad
+points.  The algorithm has been enhanced to initially exclude the point which
+most pulls the scale factor to higher values.  If there are two high
+points due to the interpolator splitting a strong spike then this helps
+but does not eliminate errors in the extracted spectra.
+.endhelp
diff --git a/noao/twodspec/apextract/doc/old/apextract.ms b/noao/twodspec/apextract/doc/old/apextract.ms
new file mode 100644
index 00000000..3e71890b
--- /dev/null
+++ b/noao/twodspec/apextract/doc/old/apextract.ms
@@ -0,0 +1,725 @@
+.EQ
+delim $$
+define sl '{s lambda}'
+.EN
+.RP
+.TL
+The IRAF APEXTRACT Package
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+.AB
+The IRAF \fBapextract\fR package provides tools for the extraction of
+one and two dimensional spectra from two dimensional images
+such as echelle, long slit, multi-fiber, and multi-slit spectra.
+Apertures of fixed width along the spatial define the regions of
+the two dimensional images to be extracted at each point along the
+dispersion axis.  Apertures may follow changes in the positions of
+the spectra as a function of position along the dispersion axis.
+The spatial and dispersion axes may be oriented along either image axis.
+Extraction to one dimensional spectra consists of a weighted sum of the pixels
+within the apertures at each point along the dispersion axis.  The
+weighting options provide the simple sum of the pixel values and a
+weighting by the expected uncertainty of each pixel.  Two dimensional
+extractions interpolate the spectra in the spatial axis to produce
+image strips with the position of the  spectra exactly aligned with one
+of the image dimensions.  The extractions also include optional
+background subtraction, modeling, and bad pixel detection and replacement.
+The tasks are flexible in their ability to define and edit apertures,
+operate on lists of images, use apertures defined for reference
+images, and operate both very interactively or noninteractively.
+The extraction tasks are efficient and require only one pass through
+the data.  This paper describes the tasks, the algorithms, the data
+structures, as well as some examples and possible future developments.
+.AE
+.NH
+Introduction
+.PP
+The IRAF \fBapextract\fR package provides tools for the extraction of
+one and two dimensional aperture spectra from two dimensional format
+images such as those produced by echelle, long slit, multi-fiber, and
+multi-slit spectrographs.  This type of data is becoming increasingly
+popular because of the efficiency of data collection and recent
+technological improvements such as fibers and digital detectors.
+The trend is also to greater and greater numbers of spectra per
+image.  Extraction is one of the fundamental operations performed
+on these types of two dimensional spectral images, so a great deal of effort
+has gone into the design and development of this package.  
+.PP
+The tasks are flexible and have many options.  To make the best use of
+them it is important to understand how they work.  This paper provides
+a general description of the tasks, the algorithms, the data structures,
+as well as some examples of usage.  Specific descriptions of parameters
+and usage may be found in the IRAF help pages for the tasks included
+as appendices to this paper.  The image reduction "cookbooks" also
+provide complete examples of usage for specific instruments or types
+of instruments.
+.PP
+The tasks  in the \fBapextract\fR pacakge are summarized below.
+
+.ce
+The \fBApextract\fR Package
+.TS
+center;
+n.
+apdefault \&- Set the default aperture parameters
+apedit \&- Edit apertures interactively
+apfind \&- Automatically find spectra and define apertures
+apio \&- Set the I/O parameters for the APEXTRACT tasks
+apnormalize \&- Normalize 2D apertures by 1D functions
+apstrip \&- Extract two dimensional aperture strips
+apsum \&- Extract one dimensional aperture sums
+aptrace \&- Trace positions of spectra
+.TE
+
+The tasks are highly integrated so that one task may call another tasks
+or use its parameters.  Thus, these tasks reflect the logical organization
+of the package rather than a set of disparate tools.  One reason for
+this organization is group the parameters by function into easy to manage
+\fIparameter sets (psets)\fR.  The tasks \fBapdefault\fR and \fBapio\fR
+are just psets for specifying the default aperture parameters and the
+I/O parameters of the package; in other words, they do nothing but
+provide a grouping of parameters.  Executing these tasks is a shorthand
+for the command "eparam apdefault" or "eparam apio".  The other tasks
+provide both a logical grouping of parameters and function.  For
+example the task \fBaptrace\fR traces the positions of the spectra
+in the images and has the parameters related to tracing.  The task
+\fBapsum\fR, however, may trace the spectra as part of the overall
+extraction process and it uses the functionality and parameters of
+the \fBaptrace\fR task without requiring all the tracing parameters
+be included as part of its parameter set.  As we examine each task
+in detail it will become more apparent how this integration of function
+and parameters works.
+.PP
+The \fBapextract\fR package identifies the image axes with the spatial
+and dispersion axes.  Thus, during extraction pixels of constant
+wavelength are those along a line or column.  In this paper the terms
+\fIslit\fR or \fIspatial\fR axis and \fIdispersion\fR or \fIwavelength\fR
+axis are used to refer to the image axes corresponding to the spatial
+and dispersion axes.  Often a small degree of misalignment between the
+image axes and the true dispersion and spatial axes is not important.
+The main effect of misalignment is a broadening of the spectral
+features due to the difference in wavelength on opposite sides of the
+extraction aperture.  If the misalignment is significant, however, the
+image may be rotated with the task \fBrotate\fR in the \fBimages\fR
+package or remapped with the \fBlongslit\fR package tasks for
+coordinate rectification.
+.PP
+It does not matter which image axis is the dispersion axis since the
+tasks work equally well in either orientation.  However, the dispersion
+axis must be defined, with the \fBtwodspec\fR task \fBsetdisp\fR,
+before these tasks may be used.  This task is a simple script which
+adds the parameter DISPAXIS to the image headers.  The \fBapextract\fR
+tasks, like the \fBlongslit\fR tasks, look in the header to determine
+the dispersion axis.
+.NH
+Apertures
+.PP
+Apertures are the basic data structures used in the package; hence the
+package name.  An aperture defines a region of the two dimensional image
+to be extracted.  The aperture definitions are stored in a database.
+An aperture consists of the following components.
+
+.IP ID
+.br
+An integer identification number.  The identification number must be
+unique.  It is used as the default extension during extraction of
+the spectra.  Typically the IDs are consecutive positive integers
+ordered by increasing or decreasing slit position.
+.IP BEAM
+.br
+An integer beam number.  The beam number need not be
+unique; i.e. several apertures may have the same beam number.
+The beam number will be recorded in the image header of the
+the extracted spectrum.  By default the beam number is the same as
+the ID.
+.IP APAXIS
+.IP CENTER[2]
+.br
+The center of the aperture along the slit and dispersion axes in the two
+dimensional image.
+.IP LOWER[2]
+.br
+The lower limits of the aperture, relative to the aperture center,
+along the slit and dispersion axes.  The lower limits need not be less
+than the center.
+.IP UPPER[2]
+.br
+The upper limits of the aperture, relative to the aperture center,
+along the slit and dispersion axes.  The upper limits need not be greater
+than the center.
+.IP CURVE
+.br
+An offset to be added to the center position for the \fIslit\fR axis which is
+a function of the wavelength.  The function is one of the standard IRAF
+types; a legendre polynomial, a chebyshev polynomial, a linear spline,
+or a cubic spline.
+.IP background
+.br
+Parameters for background subtraction based on the interactive
+curve fitting (\fBicfit\fR) tools.
+
+.PP
+The aperture center is the only absolute coordinate (relative to the
+image or image section).  The other aperture parameters and the
+background fitting regions are defined relative to the center.  Thus,
+an aperture may be repositioned easily by changing the center
+coordinates.  Also a constant aperture size, shape (curve), and
+background regions may be maintained for many apertures.  The center
+and aperture limits, in image coordinates, along the slit axis are
+given by:
+
+.EQ I
+  ~roman center ( lambda )~mark = roman cslit + roman curve ( lambda )
+.EN
+.EQ I
+roman lower ( lambda )~lineup = roman center ( lambda ) + roman lslit
+.EN
+.EQ I
+roman upper ( lambda )~lineup = roman center ( lambda ) + roman uslit
+.EN
+
+where $lambda$ is the wavelength coordinate.  Note that both the lower and
+upper constants are added to the center defined by the aperture center and
+the offset curve.  The aperture limits along the dispersion axis are
+constant since there is no offset curve:
+
+.EQ I
+roman center (s)~lineup = roman cdisp
+.EN
+.EQ I
+roman lower (s)~lineup = roman center (s) + roman ldisp
+.EN
+.EQ I
+roman upper (s)~lineup = roman center (s) + roman udisp
+.EN
+
+.PP
+Apertures for a particular image may be defined in several ways.  
+These methods are arranged in a hierarchy.
+
+.IP (1)
+The database is first searched for previously defined apertures.
+.IP (2)
+If no apertures are found and a reference image is specified then the
+database is searched for apertures defined for the reference image.
+.IP (3)
+The user may then edit the apertures interactively with graphics
+commands if the \fIapedit\fR parameter is set.  This includes creating
+new apertures and deleting or modifying existing apertures.  This
+interactive editing procedure may be entered from any of the \fBapextract\fR
+tasks.
+.IP (4)
+For the tasks \fBtrace\fR, \fBsumextract\fR, and \fBstripextract\fR
+if no apertures are defined at this point a default aperture
+is created consisting of the entire image with center at the center of
+the image.  Note that if an image section is used then the aperture
+spans the image section only.
+.IP (5)
+Any apertures created, modified, or adopted from a reference image are recorded
+in the database for the image.
+
+.PP
+There are several important points to appreciate in the above logic.
+First, any of the tasks may be used without prior use of the others.
+For example one may use extract with the \fIapedit\fR switch set and
+define the apertures to be extracted (except for tracing).
+Alternatively the apertures may be defined with \fBapedit\fR
+interactively and then traced and extracted noninteractively.  Second,
+image sections may be used to define apertures (step 4).  For example
+a list of image sections (such as are used in multislit spectra) may be
+extracted directly and noninteractively.  Third, multiple images may
+use a reference image to define the same apertures.  There are several
+more options which are illustrated in the examples section.
+.PP
+Another subtlety is the way in which reference images may be
+specified.  The tasks in the package all accept list of images
+(including image sections).  Reference images may also be given as a
+list of images.  The lists, however, need not be of the same length.
+The reference images in the reference image list are paired in order
+with the input images.  If the reference list ends before the image
+list then the last reference image is used for the remaining images.
+The most common situations are when there is no reference image, when
+only one reference image is given for a set of input images, and when a
+matching list of reference images is given.  In the second case the
+reference image refers to all the input images while in the last case
+each input image has a reference image.
+.PP
+There is a trick which may be played with the reference images.  If a list
+of input images is given and the reference image is the same as the first
+input image then only the first image need be done interactively.
+This is because after the apertures for the first image have been defined
+they are recorded in the database.  Then when the database is searched
+for apertures for the second image, the apertures of the reference image
+will be available.
+.NH
+.PP
+\fBApedit\fR is a generally interactive task which graphs a line of
+an image along the slit axis and allows the user to define and edit
+apertures with the graphics cursor.  The defined apertures are recorded
+in a database.  The task \fBtrace\fR traces the positions of the
+spectrum profiles from one wavelength to other wavelengths in the image
+and fits a smooth curve to the positions.  This allows apertures
+to follow shifts in the spectrum along the slit axis.  The tasks
+\fBsumextract\fR and \fBstripextract\fR perform the actual aperture
+extraction to one and two dimensional spectra.  They have options for
+performing background subtraction, detecting and replacing bad pixels,
+modeling the spectrum profile, and weighting the pixels in the aperture
+when summing across the dispersion.
+.NH
+Tracing
+.PP
+The spectra to be extracted are not always aligned exactly with the
+image columns or lines (the extraction axes).
+For consistent extraction it is important that the same
+part of the spectrum profile be extracted at each wavelength point.
+Thus, the extraction apertures allow for shifts along the spatial axis
+at each dispersion point.  The shifts are defined by a curve which is a
+function of the wavelength.  The curve is determined by tracing the
+positions of the spectrum profile at a number of wavelengths and
+fitting a function to these positions.
+.PP
+The task \fBtrace\fR performs the tracing and curve fitting and records
+the curve in the database.  The starting point along the
+dispersion axis (a line or column) for the tracing is specified by the
+user.  The position of the profile is then determined using the
+\fBcenter1d\fR algorithm described elsewhere (see the help page for
+\fBcenter1d\fR or the paper \fIThe Long Slit Reduction Package\fR).
+The user specifies a step along the dispersion axis.  At each step the
+positions of the profiles are redetermined using the preceding
+position as the initial guess.  In order to enhance and trace weak
+spectra the user may specify a number of neighboring profiles to be
+summed before determining the profile positions.
+.PP
+Once the
+positions have been traced from the starting point to the ends of the
+aperture, or until the positions become indeterminate, a curve of a
+specified type and order is fit to the positions as a function of
+wavelength.  The function fitting is performed with the \fBicfit\fR
+tools (see the IRAF help page).  The curve fitting may be performed
+interactively or noninteractively.  Note that when the curve is fit
+interactively the actually positions measured are graphed.  However, the
+curve is stored in the aperture definition as an offset relative to the
+aperture center.
+.PP
+The tracing requires that the spectrum profile have a shape from which
+\fBcenter1d\fR can determine a position.  This pretty much means
+gaussian type profiles.  To extract a part of a long slit spectrum
+which does not have such a profile the user must trace a profile from
+another part of the image or a different image and then shift the
+center of the aperture without changing the shape.  For example the
+center of a extended galaxy spectrum can be traced and the aperture
+shifted to other parts of the galaxy.
+.NH
+Extraction
+.PP
+There are two types of extraction; strip extraction and sum
+extraction.  Strip extraction produces two dimensional images with
+pixels corresponding to the center of an aperture aligned along the
+lines or columns.  Sum extraction consists of the weighted sum of the
+pixels within an aperture along the image axis nearest the spatial axis
+at each point along the dispersion direction.  It is important to
+understand that the extraction is along image lines or columns while
+the actual dispersion/spatial coordinates may not be aligned exactly
+with the image axes.  If this misalignment is important then for simple
+rotations the task \fBrotate\fR in the \fBimages\fR package may be used
+while for more complex coordinate rectifications the tasks in the
+\fBlongslit\fR package may be used.
+.NH 2
+Sum Extraction
+.PP
+Denote the image axis nearest the spatial axis by the index $s$ and
+the other image axis corresponding to the dispersion axis by $lambda$.
+The extraction is defined by the equation
+
+.EQ I (1)
+f sub lambda~=~sum from s (W sub sl (I sub sl - B sub sl ) / P sub sl ) /
+sum from s W sub sl
+.EN
+
+where the sums are over all pixels along the spatial axis within some
+aperture.  The $W$ are weights, the $I$ are pixel intensities,
+the $B$ are background intensities, and the $P$ are a normalized
+profile model.
+.PP
+There are many possible choices for the extraction weights.  The extraction
+task currently provides two:
+
+.EQ I (2a)
+W sub sl~mark =~P sub sl
+.EN
+.EQ I (2b)
+W sub sl~lineup =~P sub sl sup 2 / V sub sl
+.EN
+
+where $V sub sl$ is the variance of the pixel intensities given by the
+model
+
+.EQ I
+	V sub sl~=~v sub 0 + v sub 1~max (0,~I sub sl )~~~~if v sub 0~>~0
+.EN
+.EQ I
+	V sub sl~=~v sub 1~max (1,~I sub sl )~~~~~~~~~if v sub 0~=~0
+.EN
+
+Substituting these weights in equation (1) yields the extraction equations
+
+.EQ I (3a)
+f sub lambda~mark =~sum from s (I sub sl - B sub sl )
+.EN
+.EQ I (3b)
+f sub lambda~lineup =~sum from s (P sub sl (I sub sl - B sub sl ) / V sub sl ) /
+sum from s (P sub sl sup 2 / V sub sl )
+.EN
+
+.PP
+The first type of weighting (2a), called \fIprofile\fR weighting, weights
+by the profile.  Since the weights cancel this gives the simple extraction (3a)
+consisting of the direct summation of the pixels within the aperture.
+It has the virtue of being simple and computationally fast (since the
+profile model does not have to be determined).
+.PP
+The second type of weighting (2b), called \fIvariance\fR weighting,
+uses a model for the variance of the pixel intensities.
+The model is based on Poisson statistics for a linear quantum detector.
+The first term is commanly call the \fIreadout\fR noise and the second term
+is the Poisson noise.  The actual value of $v sub 1$ is the reciprical of
+the number of photons per digital intensity unit (ADU).  A simple variant of
+this type of weighting is to let $v sub 1$ equal zero.  Since the actual
+scale of the variance cancels we can then set $v sub 0$ to unity to obtain
+
+.EQ I (4)
+f sub lambda~=~sum from s (P sub sl (I sub sl - B sub sl )) /
+sum from s P sub sl sup 2 .
+.EN
+
+The interpretation of this extraction is that the variance of the intensities
+is constant.  It gives greater weight to the stronger parts of the spectrum
+profile than does the profile weighting (3a) since the weights are
+$P sub sl sup 2$.  Equation (4) has the virtue that one need not know the
+readout noise or the ADU to photon number conversion.
+.NH 3
+Optimal Extraction
+.PP
+Variance weighted extraction is sometimes called optimal extraction because
+it is optimal in a statistical sense.  Specifically,
+the relative contribution of a pixel to the sum is related to the uncertainty
+of its intensity.  The uncertainty is measured by the expected variance of
+a pixel with that intensity.  The degree of optimality depends on how well
+the relative variances of the pixels are known.
+.PP
+A discussion of the concepts behind optimal extraction is given in the paper
+\fIAn Optimal Extraction Algorithm for CCD Spectroscopy\fR by Keith Horne
+(\fBPASP\fR, June 1986).  The weighting described in Horne's paper is the
+same as the variance weighting described in this paper.  The differences
+in the algorithms are primarily in how the model profiles $P sub sl$ are
+determined.
+.NH 3
+Profile Determination
+.PP
+The profiles of the spectra along the spatial axis are determined when
+either the detection and replacement of bad pixels or variance
+weighting are specified.  The requirements on the profiles are that
+they have the same shape as the image profiles at a each dispersion
+point and that they be as noise free and uncontaminated as possible.
+The algorithm used to create these profiles is to average a specified
+number of consecutive background subtracted image profiles immediately
+preceding the wavelength to which a profile refers.  When there are an
+insufficient number of image profiles preceding the wavelength being
+extracted then the following image profiles are also used to make up
+the desired number.  The image profiles are interpolated to a common
+center before averaging using the curve given in the aperture
+definition.  The averaging reduces the noise in the image data while
+the centering eliminates shifts in the spectrum as a function of
+wavelength which would broaden the profile relative to the profile of a
+single image line or column.  It is assumed that the spectrum profile
+changes slowly with wavelength so that by using profiles near a given
+wavelength the average profile shape will correctly reflect the profile
+of the spectrum at that wavelength.
+.PP
+The average profiles are determined in parallel with the extraction,
+which proceeds sequentially through the image.  Initially the first set
+of spectrum profiles is read from the image and interpolated to a common
+center.  The profiles are averaged excluding the first profile to be
+extracted; the image profiles in the average never include the image
+profile to be extracted.  Subsequently the average profile is updated
+by adding the last extracted image profile and subtracting the image
+profile which no longer belongs in the average.  This allows each image
+profile to be accessed and interpolated only once and makes the
+averaging computationally efficient.  This scheme also allows excluding
+bad pixels from the average profile.  The average profile is used to
+locate and replace bad pixels in the image profile being extracted as
+discussed in the following sections.  Then when this profile is added
+into the average for the next image profile the detected bad pixels are
+no longer in the profile.
+.PP
+In summary this algorithm for determining the spectrum profile
+has the following advantages:
+
+.IP (1)
+No model dependent smoothing is done.
+.IP (2)
+There is no assumption required about the shape of the profile.
+The only requirement is that the profile shape change slowly.
+.IP (3)
+Only one pass through the image is required and each image profile
+is accessed only once.
+.IP (4)
+The buffered moving average is very efficient computationally.
+.IP (5)
+Bad pixels are detected and removed from the profile average as the
+extraction proceeds.
+
+.NH 3
+Detection and Elimination of Bad Pixels
+.PP
+One of the important features of the aperture extraction package is the
+detection and elimination of bad pixels.  The average profile described
+in the previous section is used to find pixels which deviate from this
+profile.  The algorithm is straightforward.  A model spectrum of the
+image profile is obtained by scaling the normalized profile to the
+image profile.  The scale factor is determined using chi squared fitting:
+
+.EQ I (6)
+M sub sl~=~P sub sl~left { sum from s ((I sub sl - B sub sl ) P sub sl /
+V sub sl)~/~ sum from s (P sub sl sup 2 / V sub sl ) right } .
+.EN
+
+The RMS of this fit is determined and pixels deviating by more than a
+user specified factor times this RMS are rejected.  The fit is then
+repeated excluding the rejected points.  These steps are repeated until
+the user specified number of points have been rejected or no further deviant
+points are detected.  The rejected points in the image profile are then
+replaced by their model values.
+.PP
+This algorithm is based only on the assumption that the spatial profile
+of the spectrum (no matter what it is) changes slowly with wavelength.
+It is very sensitive at detecting departures from the expected profile.
+Its main defect is that in the first pass at the fit all of the image profile
+is used.  If there is a very badly deviant point and the rest of the profile
+is weak then the scale factor may favor the bad pixel more than the
+rest of the profile resulting in rejecting good profile points and not
+the bad pixel.
+.NH 3
+Relation of Optimal Extraction to Model Extraction
+.PP
+Equation (1) defines the extraction process in terms of a weighted sum
+of the pixel intensities.  However, the actual extraction operations
+performed by the task \fBsumextract\fR are 
+
+.EQ I (7a)
+f sub lambda~mark =~sum from s (I sub sl - B sub sl )
+.EN
+.EQ I (7b)
+f sub lambda~lineup =~sum from s M sub sl
+.EN
+
+where $M sub sl$ is the model spectrum fit to the background subtracted
+image spectrum $(I sub sl - B sub sl )$
+defined in the previous section (equation 6).  It is not obvious at first that
+(7b) is equivalent to (3b).  However, if one sums (6) and uses the fact
+that the sum of the normalized profile is unity one is left with equation (3b).
+.PP
+Equations (6) and (7b) provide an alternate way to think about the
+extracted one dimensional spectra.  Sum extraction of the model spectrum
+is used instead of the weighted sum for variance weighted extraction
+because the model spectrum is a product of the profile determination
+and the bad pixel cleaning process.  It is then more convenient
+and efficient to use the simple equations (7).
+.NH 2
+Strip Extraction
+.PP
+The task \fBstripextract\fR uses one dimensional image interpolation
+to shift the pixels along the spatial axes so that in the resultant
+output image the center of the aperture is exactly aligned with the
+image lines or columns.  The cleaning of bad pixels is an option
+in this extraction using the methods described above.  In addition
+the model spectrum described above may be extracted as a two
+dimensional image.  In fact, the only difference between strip extraction
+and sum extraction is whether the final step of summing the pixels
+in the aperture along the spatial axis is performed.
+.PP
+The primary use of \fBstripextract\fR is as a diagnostic tool.  It
+allows the user to see the background subtracted, cleaned and/or model
+spectrum as an image before it is summed to a one dimensional spectrum.
+In addition the two dimensional format allows use of other IRAF tools such as
+smoothing operators.  When appropriate
+it is a much simpler method of removing detector distortions and alignment
+errors than the full two dimensional mapping and image transformation
+available with the \fBlongslit\fR package.
+.NH
+Examples
+.de CS
+.nf
+.ft L
+..
+.de CE
+.fi
+.ft R
+..
+.PP
+This section is included because the flexibility and many options of
+the tasks allows a wide range of applications.  The examples illustrate
+the use of the task parameters for manipulating input images, output
+images, and reference images, and setting apertures interactively and
+noninteractively.  They do not illustrate the different possibilities
+in extraction or the interactive aperture definition and editing
+features.  These examples are meant to be relevant to actual data
+reduction and analysis problems.  For the purpose of these examples we
+will assume the dispersion axis is along the second image axis; i.e.
+DISPAXIS = 2.
+.PP
+The simplest problem is the extraction of an object spectrum which
+is centered on column 200.  To extract the spectrum with an aperture
+width of 20 pixels an image section can be used.
+
+.CS
+cl> sumextract image[190:209,*] obj1d
+cl> stripextract image[190:209,*] obj2d
+.CE
+
+To set the aperture center and limits interactively the edit option can be
+used with or without the image section.  This also allows fractional pixel
+centering and limits.
+.PP
+If the object slit position changes the spectrum profile can be traced first
+and then extracted.
+
+.CS
+cl> trace image[190:209,*]
+cl> sumextract image[190:209,*] obj1d
+cl> stripextract image[190:209,*] obj2d
+.CE
+
+By default the apertures are defined and/or edited interactively in
+\fBtrace\fR and editing is not the default in \fBsumextract\fR or
+\fBstripextract\fR.
+.PP
+A more typical example involves many images.  In this case a list of images
+is used though, of course, each image could be done separately as
+in the previous examples.  There are three common forms of lists, a
+pattern matching template, a comma separated list, and an "@" file.
+In addition the template editing metacharacter, "%", may be used
+to create new output image names based on input image names.
+If the object positions are different in each image then we can select
+apertures with image sections or using the editing option.  Some examples
+are
+
+.CS
+cl> sumextract image1[10:29,*],image2[32:51] obj1,obj2
+cl> sumextract image* e//image* edit+
+cl> sumextract image* image%%ex%* edit+
+cl> sumextract @images @images edit+
+.CE
+
+The "@" files can be created from the other two types of lists using the
+\fBsections\fR task in the \fBimages\fR package.  An important feature
+of the image templates is the use of the concatenation operator.  Note,
+however, this a feature of image templates and not file templates.
+Also the output root name may be the same as the input
+name because an extension is added provided there are no image
+sections in the input images.
+.PP
+If the object positions are the same then the apertures can be defined once
+and the remaining objects can be extracted using a reference image.
+
+.CS
+cl> apedit image1
+cl> sumextract image* image* ref=image1
+.CE
+
+Rather than using \fBapedit\fR one can use \fBsumextract\fR alone with
+the edit switch set.  The command is
+
+.CS
+cl> sumextract image* image* ref=image1 edit+
+.CE
+
+The task queries whether to edit the apertures for each image.
+For the first image respond with "yes" and set the apertures interactively.
+For the second task respond with "NO".  Since the aperture for "image1"
+was recorded when the first image was extracted it then acts as the reference
+for the remaining images.  The emphatic response "NO" turns off the edit switch
+for all the other images.  One difference between this example and the
+previous one is that the task cannot be run as a background batch task.
+.PP
+The extension to using traced apertures in the preceding examples is
+very similar.
+
+.CS
+cl> apedit image1
+cl> trace image* ref=image1 edit-
+cl> sumextract image* image*
+cl> stripextract image* image*
+.CE
+
+.PP
+Another common type of data has multiple spectra on each image.  Some examples
+are echelle and multislit spectra.  Echelle extractions usually are done
+interactively with tracing.  Thus, the commands are
+
+.CS
+cl> trace ech*
+cl> sumextract ech* ech*
+.CE
+
+For multislit spectra the slitlets are usually referenced by creating
+an "@" file containing the image sections.  The usage for extraction
+is then
+
+.CS
+cl> sumextract @slits @slitsout
+.CE
+
+.PP
+The aperture definitions can be transfered from a reference image to
+other images using \fBapedit\fR.  There is no particular reason to
+do this except that reference images would not be needed in 
+\fBtrace\fR, \fBsumextract\fR or \fBstripextract\fR.  The transfer
+is accomplished with the following command
+
+.CS
+cl> apedit image1
+cl> apedit image* ref=image1 edit-
+.CE
+
+The above can also be combined into one step by editing the first image
+and then responding with "NO" to the second image query.
+.NH
+Future Developments
+.PP
+The IRAF extraction package \fBapextract\fR is going to continue to
+evolve because 1) the extraction of one and two dimensional spectra
+from two dimensional images is an important part of reducing echelle,
+longslit, multislit, and multiaperture spectra, 2) the final strategy
+for handling multislit and multiaperture spectra produced by aperture
+masks or fiber optic mapping has not yet been determined, and 3) the
+extraction package and the algorithms have not received sufficient user
+testing and evaluation.  Changes may include some of the following.
+
+.IP (1)
+Determine the actual variance from the data rather than using the Poisson
+CCD model.
+.IP (2)
+Another task, possibly called \fBapfind\fR, is needed to automatically find
+profile positions in multiaperture, multislit, and echelle spectra.
+.IP (3)
+The bad pixel detection and removal algorithm does not handle well the case
+of a very strong cosmic ray event on top of a very weak spectrum profile.
+A heuristic method to make the first fitting pass of the average
+profile to the image data less prone to errors due to strong cosmic rays
+is needed.
+.IP (4)
+The aperture definition structure is general enough to allow the aperture
+limits along the dispersion dimension to be variable.  Eventually aperture
+definition and editing will be available using an image display.  Then
+both graphics and image display editing switches will be available.
+An image display interface will make extraction of objective prism
+spectra more convenient than it is now.
+.IP (5)
+Other types of extraction weighting may be added.
+.IP (6)
+Allow the extraction to be locally perpendicular to the traced curve.
diff --git a/noao/twodspec/apextract/doc/old/apextract1.ms b/noao/twodspec/apextract/doc/old/apextract1.ms
new file mode 100644
index 00000000..b586daad
--- /dev/null
+++ b/noao/twodspec/apextract/doc/old/apextract1.ms
@@ -0,0 +1,811 @@
+.EQ
+delim $$
+define sl '{s lambda}'
+.EN
+.RP
+.TL
+The IRAF APEXTRACT Package
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+.AB
+The IRAF \fBapextract\fR package provides tools for the extraction of
+one and two dimensional spectra from two dimensional images
+such as echelle, long slit, multifiber, and multislit spectra.
+Apertures of fixed spatial width define the regions of
+the two dimensional images to be extracted at each point along the
+dispersion axis.  Apertures may follow changes in the positions of
+the spectra as a function of position along the dispersion axis.
+The spatial and dispersion axes may be oriented along either image axis.
+Extraction to one dimensional spectra consists of a weighted sum of the pixels
+within the apertures at each point along the dispersion axis.  The
+weighting options provide the simple sum of the pixel values and a
+weighting by the expected uncertainty of each pixel.  Two dimensional
+extractions interpolate the spectra in the spatial axis to produce
+image strips with the position of the  spectra exactly aligned with one
+of the image dimensions.  The extractions also include optional
+background subtraction, modeling, and bad pixel detection and replacement.
+The tasks are flexible in their ability to define and edit apertures,
+operate on lists of images, use apertures defined for reference
+images, and operate both very interactively or noninteractively.
+The extraction tasks are efficient and require only one pass through
+the data.  This paper describes the package organization, the tasks,
+the algorithms, and the data structures.
+.AE
+.NH
+Introduction
+.PP
+The IRAF \fBapextract\fR package provides tools for the extraction of
+one and two dimensional aperture spectra from two dimensional format
+images such as those produced by echelle, long slit, multifiber, and
+multislit spectrographs.  This type of data is becoming increasingly
+common because of the efficiency of data collection and technological
+improvements in spectrographs and detectors.  The trend is to greater
+and greater numbers of spectra per image.  Extraction is one of the
+fundamental operations performed on these types of two dimensional
+spectral images, so a great deal of effort has gone into the design and
+development of this package and to making it easy to use.
+.PP
+The tasks are flexible and have many options.  To make the best use of
+them it is important to understand how they work.  This paper provides
+a general description of the package organization, the tasks, the algorithms,
+and the data structures.  Specific descriptions of parameters
+and usage may be found in the IRAF help pages for the tasks which
+are included as appendices to this paper.  The image reduction "cookbooks"
+also provide examples of usage for specific instruments or types
+of instruments.
+.PP
+Extraction of spectra consists of three logical steps.  First, locating
+the spectra in the two dimensional image.  This includes defining the
+dispersion direction, the positions of the spectra at some point
+along the dispersion direction, the spatial extent or aperture to be
+used for extraction, and possible information about where the background
+for each spectrum is to be determined.  This information is maintained
+in the package as structures called \fIapertures\fR.  The second step is
+to measure the positions of the spectra at other points along the dispersion.
+This process is called tracing.  Tracing is optional if the spectra
+are exactly aligned with the dispersion direction.  The final step is
+to extract the spectra into one or two dimensional images.
+.PP
+The \fBapextract\fR package identifies the image axes with the spatial
+and dispersion axes.  Thus, during extraction, pixels of constant
+wavelength are assumed to be along a line or column.  In this paper the
+terms \fIslit\fR or \fIspatial\fR axis and \fIdispersion\fR or
+\fIwavelength\fR axis are used to refer to the image axes corresponding
+to the spatial and dispersion axes.  To simplify the presentation a
+cut across the dispersion axis will be called a line even though it
+could also be a column.
+.PP
+Often a small degree of
+misalignment between the image axes and the true dispersion and spatial
+axes is not important.  The main effect of misalignment is a broadening
+of the spectral features due to the difference in wavelength on
+opposite sides of the extraction aperture.  If the misalignment is
+significant, however, the image may be rotated with the task
+\fBrotate\fR in the \fBimages\fR package or remapped with the
+\fBlongslit\fR package tasks for coordinate rectification.
+.PP
+It does not matter which image axis is the dispersion axis since the
+tasks work equally well in either orientation.  However, the dispersion
+axis must be defined, with the \fBtwodspec\fR task \fBsetdisp\fR,
+before these tasks may be used.  This task is a simple script which
+adds the parameter DISPAXIS to the image headers.  The \fBapextract\fR
+tasks, like the \fBlongslit\fR tasks, look in the header to determine
+the dispersion axis.
+.NH
+The APEXTRACT Package
+.PP
+In this section the organization of the \fBapextract\fR package and the
+functions and parameters of the tasks are briefly described.  More detailed
+descriptions are given in the help pages for the tasks.  The tasks in the
+package are:
+
+.ce
+.ft B
+The APEXTRACT Tasks
+
+.ft L
+.nf
+	  apdefault - Set the default aperture parameters
+	     apedit - Edit apertures interactively
+	     apfind - Automatically find spectra and define apertures
+	       apio - Set the I/O parameters for the APEXTRACT tasks
+	apnormalize - Normalize 2D apertures by 1D functions
+	    apstrip - Extract two dimensional aperture strips
+	      apsum - Extract one dimensional aperture sums
+	    aptrace - Trace positions of spectra
+.fi
+.ft R
+
+.PP
+The tasks are highly integrated so that each task includes some or all of
+the functions and parameters of the other tasks.  Thus, these tasks
+reflect the logical organization of the extraction process rather than
+a set of disparate tools.  One reason for this organization is to group
+the parameters by function into easy to manage \fIparameter sets
+(psets)\fR.  The tasks \fBapdefault\fR and \fBapio\fR are just psets
+for specifying the default aperture parameters and the I/O parameters
+of the package; in other words, they do nothing but provide a grouping
+of parameters.  Executing these tasks is a shorthand for the command
+"eparam apdefault" or "eparam apio".
+.PP
+The input/output parameters in \fBapio\fR specify the aperture database,
+an optional log file for brief, time stamped log information, an optional
+metacode plot file for saving plots of the apertures, the traces, and the
+quick look extracted spectra, and the graphics input and output devices
+(almost always the user's terminal).  One point about the plot file is
+that the plots are recorded even if the user chooses not to view these
+graphs as the task is run interactively or noninteractively.  This allows
+reviewing the traces and spectra with a tool like \fBgkimosaic\fR.
+.PP
+The default aperture parameters specify the aperture limits (basically
+the width of the aperture and position relative to the center of the
+spectrum) and the background fitting parameters.  The background
+parameters are the standard parameters used by the \fBicfit\fR package
+with which the user is assumed to be familiar.  For more on this see
+the help information for \fBicfit\fR.
+.PP
+The other tasks are both psets and executable tasks.  There are a
+number features which are common to all these tasks.  First, they
+follow the same steps in defining apertures for the input images.
+These steps are:
+.IP (1)
+If a reference image is specified then the database is searched for
+apertures previously defined for this image.
+.IP (2)
+If apertures are found for the reference image they may be recentered
+on the spectra in the input image at a specified line.  This does not
+change the shape of the apertures but only adds a shift in the center
+coordinate of the apertures along the spatial axis.
+.IP (3)
+If a reference image is not specified or if no reference apertures are found
+then the database is searched for previous apertures for the input image.
+.IP (4)
+If there are no apertures defined either from a reference image or previous
+apertures for the input image then an automatic algorithm may be used to find
+a specified number of spectra (based on peak values) and assign them default
+apertures.
+.IP (5)
+Finally, a sophisticated graphical aperture editor may be used to examine,
+define, and modify apertures.
+.IP (6)
+When tracing, extracting, or normalizing flat field spectra,
+if no apertures have been defined by the steps above then a single default
+aperture, centered in the image, is defined.
+
+Any apertures created, modified, or adopted from a reference image
+may be recorded in the database for the input image.
+.PP
+The operations listed above are selected by parameters common to each of the
+tasks.  For example the parameter \fIedit\fR selects whether to enter
+the aperture editor and is present in each of the executable tasks.
+On the other hand the parameters specific to the aperture editor,
+while accessed by any of the tasks, reside only in the parameter set of
+the task \fBapedit\fR.  In this way parameters are distributed
+by logical function rather than including them in each task.
+.PP
+In addition to the aperture editing and finding functions available in
+every task, some of the tasks include functions for tracing, extracting,
+or normalizing the spectra.  The tasks \fBapsum\fR and \fBapstrip\fR,
+which extract one and two dimensional spectra, are at the top of the
+hierarchy and include all the logical functions provided by the package.
+Thus, in most cases the user need only use the task \fBapsum\fR to define
+apertures, trace the spectra, and extract them.
+.PP
+Another feature common to the tasks is their interactive and noninteractive
+modes.  When the parameter \fIinteractive\fR is set to \fIno\fR then the
+aperture editing, interactive trace fitting, and review of the extracted
+one dimensional spectra functions of the package are bypassed.  Note that
+this means you do not have to explicitly set the parameter \fIedit\fR,
+or those for other purely interactive functions,
+to \fIno\fR when extracting spectra noninteractively.  In the noninteractive
+mode there are also no queries.
+.PP
+The interactive mode includes the interactive graphical functions of
+aperture editing, trace fitting, and extraction review.  In addition
+the user is queried at each step.  For example the user will be queried
+whether to edit the apertures for a particular image if the task
+parameter for editing is set.  The queries have four responses: \fIyes,
+no, YES,\fR and \fINO\fR.  The lower case responses apply only to the
+particular query.  The upper case responses apply to any further
+queries of the same type and suppress the query from appearing again.
+This is particularly useful when dealing with many images or many
+apertures.  For example, when fitting the traced points interactively
+the user may examine the first few and then say \fINO\fR to skip the
+remaining apertures using the last defined fitting parameters.  Note
+that if a plot file is specified the graphs showing the traced points
+and the fits are recorded even if they are not viewed interactively.
+.NH
+Algorithms
+.PP
+The \fBapextract\fR package consists of a number of logical functions or,
+in computerese, algorithms.  These algorithms manipulate the aperture
+structure data and create output data in the form of images.  In
+this section the various algorithms are described.  In addition to the
+algorithms specific to the package, there are some general algorithms
+and tools used which appear in other IRAF tasks.  Specifically there are the
+interactive curve fitting tools called \fBicfit\fR and the one
+dimensional centering algorithm called \fBcenter1d\fR.  These are
+mentioned below and described in detail elsewhere in the help documentation.
+.NH 2
+Finding Spectra
+.PP
+When dealing with images containing large numbers of spectra it may be
+desirable to locate the spectra and define apertures automatically.  The
+\fBapfind\fR algorithm provides this ability from any of the executable
+tasks and from the aperture editor using the 'f' key.  It takes a cut
+across the dispersion axis by summing one or more image lines.
+All the local maxima are identified and ranked by intensity.  Starting
+with the highest maxima any other peaks within a specified minimum
+separation are eliminated.  The weakest remaining peaks exceeding the
+specified number are eliminated next.  The positions of the
+spectra based on peak positions are refined by centering using the
+\fBcenter1d\fR algorithm.  Finally identical apertures are assigned
+for each spectrum found.
+.PP
+When the algorithm is invoked by a task, with the parameter \fIfind\fR,
+there must be no previous or reference apertures in the database.
+The apertures assigned to the spectra have the parameters
+specified in the \fBapdefault\fR pset.  When the algorithm is invoked
+from the aperture editor with the 'f' key then new apertures are
+added to any existing apertures up to the total number of apertures,
+existing plus new, given by the \fInfind\fR parameter.  If there
+is a current aperture then copies of it are used to define the
+apertures for the new spectra.  Thus, one method for defining many
+apertures is to use the editor to define one aperture, set its
+limits and background parameters, and then find the remaining apertures
+automatically.
+.NH 2
+Centering and Recentering
+.PP
+When new apertures are defined (except for a special key to mark apertures
+without centering) or when apertures are recentered, either with the
+centering key in the editor or with the task parameter \fIrecenter\fR,
+the center is determined using the \fBcenter1d\fR algorithm.
+This is described in the help documentation under the name \fBcenter1d\fR.
+Briefly, the data line is convolved with an asymmetric function of specified
+width.  The convolution integral is evaluated using image interpolation.
+The sign of the convolution acts as a gradient to move from the starting
+position to the final position where the convolution is zero.  This algorithm
+is good to about 5% of a pixel.  It has two important parameters; the
+width of the convolution and the error distance between the starting
+and final positions.  The width of the convolution determines the scale
+of features to which the centering is sensitive.  The error distance is
+the greatest change allowed in the initial positions.  If this error
+distance is exceeded then the centering fails and either a new aperture
+is not defined or the position of an existing aperture is not changed.
+.NH 2
+The Aperture Editor
+.PP
+The aperture editor is a sophisticated tool for defining and modifying
+apertures.  It may also be used to selectively trace and extract
+spectra.  Thus, the aperture editor may be used alone to perform all
+the functions for extracting spectra.  The aperture editor uses a
+graphical presentation.  A line or sum of lines is displayed.  The
+apertures are marked above the line and identified with the aperture
+number.  Information about the current aperture is shown on the status
+line.  The cursor is used to mark new apertures, shift the center or
+aperture limits, and perform a variety of functions.  Because there may
+be many apertures which the user wants to modify in the same way there
+is a mode switch to apply commands to all the apertures.  The switch is
+toggled with the 'a' key and the mode is indicated on the status line.
+.PP
+There are also a number of colon commands.  These allow resetting parameters
+explicitly rather than by cursor and interacting with the aperture
+database and the image data.  The background fitting parameters such as
+the background regions and function order are set by switching to the
+interactive curve fitting package \fBicfit\fR.  The line being edited is
+used to set the parameters.  No background is actually extracted at this
+stage.  The ALL mode applies to the background parameters as well.
+.PP
+The aperture editor has many commands.  For a description of the
+commands see the help information for the task \fBapedit\fR.  In
+summary the aperture editor is used to interactively define apertures,
+both centered on spectra and at arbitrary positions, adjust the limits
+and background parameters, and possibly select apertures to be traced
+and extracted.  These functions may be applied independently on each
+aperture for maximum flexibility or applied to all apertures for ease
+of use with many apertures.
+.NH 2
+Tracing
+.PP
+The spectra to be extracted are not always aligned exactly with the
+image columns or lines.  For consistent
+extraction it is important that the same part of the spectrum profile
+be extracted at each wavelength point.  Thus, the extraction apertures
+allow for shifts along the spatial axis at each wavelength.  The
+shifts are defined by a curve which is a function of the wavelength.
+The curve is determined by tracing the positions of the spectrum
+profile at a number of wavelengths and fitting a function to these
+positions.
+.PP
+The \fIaptrace\fR algorithm performs the tracing and curve fitting.
+The starting point along the dispersion axis (a line or column) for
+the tracing is specified by the user.  The positions of the spectrum
+profiles are determined using the \fBcenter1d\fR algorithm
+(see the previous section on centering and  the help page for \fBcenter1d\fR).
+The user specifies a step along the dispersion axis.  At each step the
+positions of the profiles are redetermined using the preceding
+positions as the initial guesses.  If the positions are lost at one step
+an attempt is made to recover the spectrum in the next step.  If this
+also fails then tracing of that spectrum in that direction is finished.
+In order to enhance and trace weak spectra the user may specify a number
+of neighboring profiles to be summed before determining the profile positions.
+In addition to the other centering parameters, there is also a
+\fIthreshold\fR parameter to define a minimum contrast between the spectrum
+and the background.
+.PP
+Once the positions have been traced from the starting point to the ends of the
+aperture, or until the positions become indeterminate, a curve of a
+specified type and order is fit to the positions as a function of
+wavelength.  The function fitting is performed with the \fBicfit\fR
+tools (see the help documentation for \fBicfit\fR).  The curve fitting
+may be performed interactively or noninteractively.  Note that when the
+curve is fit interactively the actual positions measured are graphed.
+However, the curve is stored in the aperture definition as an offset
+relative to the aperture center.
+.PP
+The tracing requires that the spectrum profile be continuous and have
+some kind of maxima.  This means that arc calibration spectra or
+arbitrary regions of an extended object in a long slit spectrum cannot
+be traced.  Flat topped spectra such as quartz lamp images taken through
+slits can be measured provided the width of the centering function is
+somewhat wider than the profile (to avoid centering on little peaks
+within the slit).  For images which cannot be traced, reference apertures
+from images that can be traced are used.  This is how apertures for
+arc spectra are defined and extracted.  For sky apertures or the
+wings of extended objects the reference apertures can be shifted
+by the aperture editor without altering the shape of the aperture.
+.NH 2
+Sum Extraction
+.PP
+Sum extraction consists of the weighted sum of the pixels along the spatial axis
+within the aperture limits at each point along the dispersion axis.
+A background at each point along the dispersion may be determined by fitting a
+function to data in the vicinity of the spectrum and subtracting the
+function values estimated at each point within the aperture.  The estimated
+background may be output as a one dimensional spectrum.  Other options
+include the detection and replacement of deviant points such as due to
+cosmic rays.
+.PP
+Denote the image axis nearest the spatial axis by the index $s$ and
+the other image axis corresponding to the dispersion axis by $lambda$.
+The weighted extraction is defined by the equation
+
+.EQ I (1)
+f sub lambda~=~sum from s (W sub sl (I sub sl - B sub sl ) / P sub sl ) /
+sum from s W sub sl
+.EN
+
+where the sums are over all pixels along the spatial axis within some
+aperture.  The $W$ are weights, the $I$ are pixel intensities,
+the $B$ are background intensities, and the $P$ are a normalized
+profile model.
+.PP
+There are many possible choices for the extraction weights.  The extraction
+task \fBapsum\fR currently provides two:
+
+.EQ I (2a)
+W sub sl~mark =~P sub sl
+.EN
+.EQ I (2b)
+W sub sl~lineup =~P sub sl sup 2 / V sub sl
+.EN
+
+where $V sub sl$ is the variance of the pixel intensities given by the
+model
+
+.EQ I
+	V sub sl~=~v sub 0 + v sub 1~max (0,~I sub sl )~~~~if v sub 0~>~0
+.EN
+.EQ I
+	V sub sl~=~v sub 1~max (1,~I sub sl )~~~~~~~~~if v sub 0~=~0
+.EN
+
+Substituting these weights in equation (1) yields the extraction equations
+
+.EQ I (3a)
+f sub lambda~mark =~sum from s (I sub sl - B sub sl )
+.EN
+.EQ I (3b)
+f sub lambda~lineup =~sum from s (P sub sl (I sub sl - B sub sl ) / V sub sl ) /
+sum from s (P sub sl sup 2 / V sub sl )
+.EN
+
+.PP
+The first type of weighting (2a), called \fIprofile\fR weighting, weights
+by the profile.  Since the weights cancel this gives the simple extraction (3a)
+consisting of the direct summation of the pixels within the aperture.
+It has the virtue of being simple and computationally fast (since the
+profile model does not have to be determined).
+.PP
+The second type of weighting (2b), called \fIvariance\fR weighting,
+uses a model for the variance of the pixel intensities.
+The model is based on Poisson statistics for a linear quantum detector.
+The first term is commonly call the \fIreadout\fR noise and the second term
+is the Poisson noise.  The actual value of $v sub 1$ is the reciprocal of
+the number of photons per digital intensity unit (ADU).  A simple variant of
+this type of weighting is to let $v sub 1$ equal zero.  Since the actual
+scale of the variance cancels we can then set $v sub 0$ to unity to obtain
+
+.EQ I (4)
+f sub lambda~=~sum from s (P sub sl (I sub sl - B sub sl )) /
+sum from s P sub sl sup 2 .
+.EN
+
+The interpretation of this extraction is that the variance of the intensities
+is constant.  It gives greater weight to the stronger parts of the spectrum
+profile than does the profile weighting (3a) since the weights are
+$P sub sl sup 2$.  Equation (4) has the virtue that one need not know the
+readout noise or the ADU to photon number conversion.
+.NH 3
+Optimal Extraction
+.PP
+Variance weighted extraction is sometimes called optimal extraction because
+it is optimal in a statistical sense.  Specifically,
+the relative contribution of a pixel to the sum is related to the uncertainty
+of its intensity.  The uncertainty is measured by the expected variance of
+a pixel with that intensity.  The degree of optimality depends on how well
+the relative variances of the pixels are known.
+.PP
+A discussion of the concepts behind optimal extraction is given in the paper
+\fIAn Optimal Extraction Algorithm for CCD Spectroscopy\fR by Keith Horne
+(\fBPASP\fR, June 1986).  The weighting described in Horne's paper is the
+same as the variance weighting described in this paper.  The differences
+in the algorithms are primarily in how the model profiles $P sub sl$ are
+determined.
+.NH 3
+Profile Determination
+.PP
+The profiles of the spectra along the spatial axis are determined when
+either the detection and replacement of bad pixels or variance
+weighting are specified.  The requirements on the profiles are that
+they have the same shape as the image profiles at a each dispersion
+point and that they be as noise free and uncontaminated as possible.
+The algorithm used to create these profiles is to average a specified
+number of consecutive background subtracted image profiles immediately
+preceding the wavelength to which a profile refers.  When there are an
+insufficient number of image profiles preceding the wavelength being
+extracted then the following image profiles are also used to make up
+the desired number.  The image profiles are interpolated to a common
+center before averaging using the curve given in the aperture
+definition.  The averaging reduces the noise in the image data while
+the centering eliminates shifts in the spectrum as a function of
+wavelength which would broaden the profile relative to the profile of a
+single image line or column.  It is assumed that the spectrum profile
+changes slowly with wavelength so that by using profiles near a given
+wavelength the average profile shape will correctly reflect the profile
+of the spectrum at that wavelength.
+.PP
+The average profiles are determined in parallel with the extraction,
+which proceeds sequentially through the image.  Initially the first set
+of spectrum profiles is read from the image and interpolated to a common
+center.  The profiles are averaged excluding the first profile to be
+extracted; the image profiles in the average never include the image
+profile to be extracted.  Subsequently the average profile is updated
+by adding the last extracted image profile and subtracting the image
+profile which no longer belongs in the average.  This allows each image
+profile to be accessed and interpolated only once and makes the
+averaging computationally efficient.  This scheme also allows excluding
+bad pixels from the average profile.  The average profile is used to
+locate and replace bad pixels in the image profile being extracted as
+discussed in the following sections.  Then when this profile is added
+into the average for the next image profile the detected bad pixels are
+no longer in the profile.
+.PP
+In summary this algorithm for determining the spectrum profile
+has the following advantages:
+
+.IP (1)
+No model dependent smoothing is done.
+.IP (2)
+There is no assumption required about the shape of the profile.
+The only requirement is that the profile shape change slowly.
+.IP (3)
+Only one pass through the image is required and each image profile
+is accessed only once.
+.IP (4)
+The buffered moving average is very efficient computationally.
+.IP (5)
+Bad pixels are detected and removed from the profile average as the
+extraction proceeds.
+
+.NH 3
+Detection and Elimination of Bad Pixels
+.PP
+One of the important features of the aperture extraction package is the
+detection and elimination of bad pixels.  The average profile described
+in the previous section is used to find pixels which deviate from this
+profile.  The algorithm is straightforward.  A model spectrum of the
+image profile is obtained by scaling the normalized profile to the
+image profile.  The scale factor is determined using chi-squared fitting:
+
+.EQ I (6)
+M sub sl~=~P sub sl~left { sum from s ((I sub sl - B sub sl ) P sub sl /
+V sub sl )~/~ sum from s (P sub sl sup 2 / V sub sl ) right } .
+.EN
+
+The RMS of this fit is determined and pixels deviating by more than a
+user specified factor times this RMS are rejected.  The fit is then
+repeated excluding the rejected points.  These steps are repeated until
+the user specified number of points have been rejected or no further deviant
+points are detected.  The rejected points in the image profile are then
+replaced by their model values.
+.PP
+This algorithm is based only on the assumption that the spatial profile
+of the spectrum (no matter what it is) changes slowly with wavelength.
+It is very sensitive at detecting departures from the expected
+profile.  It has two problems currently.  Because the input line is
+first interpolated to the same center as the profile, single bad pixels
+are generally broadened to two bad pixels, making it harder to find the
+bad data.  Also, in the first pass at the fit all of the image profile
+is used so if there is a very badly deviant point and the rest of the
+profile is weak then the scale factor may favor the bad pixel more than
+the rest of the profile.  This may result in rejecting good profile
+points and not the bad pixel.
+.NH 3
+Relation of Optimal Extraction to Model Extraction
+.PP
+Equation (1) defines the extraction process in terms of a weighted sum
+of the pixel intensities.  However, the actual extraction operations
+performed by the task \fBapsum\fR are 
+
+.EQ I (7a)
+f sub lambda~mark =~sum from s (I sub sl - B sub sl )
+.EN
+.EQ I (7b)
+f sub lambda~lineup =~sum from s M sub sl
+.EN
+
+where $M sub sl$ is the model spectrum fit to the background subtracted
+image spectrum $(I sub sl - B sub sl )$
+defined in the previous section (equation 6).  It is not obvious at first that
+(7b) is equivalent to (3b).  However, if one sums (6) and uses the fact
+that the sum of the normalized profile is unity one is left with equation (3b).
+.PP
+Equations (6) and (7b) provide an alternate way to think about the
+extracted one dimensional spectra.  Sum extraction of the model spectrum
+is used instead of the weighted sum for variance weighted extraction
+because the model spectrum is a product of the profile determination
+and the bad pixel cleaning process.  It is then more convenient
+and efficient to use the simple equations (7).
+.NH 2
+Strip Extraction
+.PP
+The task \fBapstrip\fR uses one dimensional image interpolation
+to shift the pixels along the spatial axis so that in the resultant
+output image the center of the aperture is exactly aligned with the
+image lines or columns.  The cleaning of bad pixels is an option
+in this extraction using the methods described above.  In addition
+the model spectrum, described above, may be extracted as a two
+dimensional image.  In fact, the only difference between strip extraction
+and sum extraction is whether the final step of summing the pixels
+in the aperture along the spatial axis is performed.
+.PP
+The primary use of \fBapstrip\fR is as a diagnostic tool.  It
+allows the user to see the background subtracted, cleaned, and/or model
+spectrum as an image before it is summed to a one dimensional spectrum.
+In addition the two dimensional format allows use of other IRAF tools such as
+smoothing operators.  When appropriate
+it is a much simpler method of removing detector distortions and alignment
+errors than the full two dimensional mapping and image transformation
+available with the \fBlongslit\fR package.
+.NH 2
+Aperture Normalization
+.PP
+The special algorithm/task \fBapnormalize\fR normalizes the two dimensional
+image data within an aperture by a smooth function of the dispersion
+coordinate.  Unlike the extraction tasks the output of this algorithm is
+a two dimensional image of the same format as the input image.  This function
+is used primarily for creating flat field images in which the large
+scale shape of the quartz spectra and the variations in level between the
+spectra are removed and the regions between the spectra, where there is no
+signal, are set to unity.  It may also be used to normalize two dimensional
+spectra to a unit continuum at some point in the spectrum, such as the center.
+.PP
+The algorithm is to extract a one dimensional spectrum for each aperture,
+fit a smooth function to the spectrum, and then divide this spectrum
+back into the two dimensional image.  Points outside the apertures are
+set to 1.  This is the same algorithm used in the \fBlongslit\fR package
+by the task \fBresponse\fR except that it applies to arbitrary apertures
+rather than to image sections.
+.PP
+Apertures are defined in the same way as for extraction.  The normalization
+spectrum may be obtained from a different aperture than the aperture to be
+normalized.  Generally the normalization apertures are either the same or
+narrower than the apertures to be normalized.  The continuum fitting also
+uses the \fBicfit\fR package.  Sample regions and iterative sigma clipping
+are used to remove spectral lines from the continuum fits.
+.PP
+There are two commonly used approaches to fitting the extracted spectra
+in flat field images.  First, a constant function is fit.  This has the
+effect of simply normalizing the apertures to near unity without affecting
+the shape of spectra in any way.  This removes response effects at all scales,
+from spectra flatten with this flat field.  However, it does not
+preserve total counts, it introduces the shape of the quartz spectrum,
+and it removes the blaze function.  The second approach is to fit the
+large scale shape of the quartz spectra.  This removes smaller scale
+response effects such a fringing and individual pixel responses while
+preserving the total counts by leaving the blaze function alone.  There are
+cases where each of these approaches is applicable.
+.NH
+Apertures
+.PP
+Apertures are the basic data structures used in the package; hence the
+package name.  An aperture defines a region of the two dimensional image
+to be extracted.  The aperture definitions are stored in a database.
+An aperture consists of the following components:
+
+.IP ID
+.br
+An integer identification number.  The identification number must be
+unique.  It is used as the default extension during extraction of
+the spectra.  Typically the IDs are consecutive positive integers
+ordered by increasing or decreasing slit position.
+.IP BEAM
+.br
+An integer beam number.  The beam number need not be
+unique; i.e. several apertures may have the same beam number.
+The beam number will be recorded in the image header of the
+the extracted spectrum.  By default the beam number is the same as
+the ID.
+.IP CENTER[2]
+.br
+The center of the aperture along the slit and dispersion axes in the two
+dimensional image.
+.IP LOWER[2]
+.br
+The lower limits of the aperture, relative to the aperture center,
+along the slit and dispersion axes.  The lower limits need not be less
+than the center.
+.IP UPPER[2]
+.br
+The upper limits of the aperture, relative to the aperture center,
+along the slit and dispersion axes.  The upper limits need not be greater
+than the center.
+.IP APAXIS
+.br
+The aperture or spatial axis.
+.IP CURVE
+.br
+An offset to be added to the center position for the aperture axis as
+a function of the wavelength.  The function is one of the standard IRAF
+types; a legendre polynomial, a chebyshev polynomial, a linear spline,
+or a cubic spline.
+.IP BACKGROUND
+.br
+Parameters for background subtraction along the aperture axis based on
+the interactive curve fitting (\fBicfit\fR) tools.
+
+.PP
+The aperture center is the only absolute coordinate (relative to the
+image or image section).  The other aperture parameters and the
+background fitting regions are defined relative to the center.  Thus,
+an aperture may be repositioned easily by changing the center
+coordinates.  Also constant aperture size, shape (curve), and
+background regions may be maintained for many apertures.
+.PP
+The edges of the aperture along the spatial axis at each point along the
+dispersion axis are given by evaluating the offset curve at that dispersion
+coordinate and adding the aperture center and the lower or upper limits
+for the aperture axis.  The edges of the aperture along the dispersion axis
+do not have an offset curve and are currently fixed to define the entire
+length of the image.  In the future this may not be the case such as
+in applications with objective prism spectra.
+.PP
+Apertures for a particular image may be defined in several ways.  They
+may be defined and modified graphically with an aperture editor.  Default
+apertures may be defined automatically with parameters from the
+\fBapdefault\fR pset using an aperture finding algorithm.  Another
+method is to specify that the apertures for one image use the aperture
+definitions from another "reference" image.  In the rare cases where
+apertures are not defined at the stage of tracing or extracting then
+a single default aperture centered in the image is created.
+.NH 2
+The Database
+.PP
+The aperture information is stored in a database.  The structure and type of
+database is expected to change in the future and as far as the package and
+user need be concerned it is just a black box with some name specified in
+the database name parameter.  However, accepting that the database structure may
+change it may be of use to the user to understand the nature of the current
+text file / directory format database.  The database is a directory containing
+text files.  It is automatically created if necessary.  The aperture data
+for all the apertures from a single image are stored in a text file
+with the name given by the image name (with special characters replaced
+with '_') prefixed with "ap".  Updates of the aperture data are performed
+by overwriting the database file.
+.PP
+The content of a file consists of a comment (beginning with a #) giving
+the date created/updated, a record identification (there is one record
+per aperture) with the image name, aperture number and aperture
+coordinate in the aperture and dispersion axes.  The following lines
+give information about the aperture.  The position and shape of an
+aperture is given by a center coordinate along the aperture axis (given
+by the axis keyword) and the dispersion axis.  There are lower and
+upper limits for the aperture relative to this center, again along both
+axis.  Currently the limits along the dispersion axis are the image
+boundaries.  The background keyword introduces the background
+subtraction parameters.  Finally there is an offset or trace function
+which is added to the center at each point along the dispersion axis.
+function.  The offset is generally zero at the dispersion point
+corresponding to the aperture center.
+.PP
+This offset or trace function is described by a \fBcurfit\fR array under
+the keyword curve.  The first value is the number of elements in this
+array.  The first element is a magic number specifying the function
+type.  The next number is the order or number of spline pieces.  The
+next two elements give the range over which the curve is defined.  In
+the \fBapextract\fR case it is the edges of the image along the dispersion.
+The remaining elements are the function coefficients.  The form of the
+the function is specific to the IRAF \fBcurfit\fR math routines.  Note that
+the coefficients apply to an independent variable which is -1 at the
+beginning of the defined range (element 3) and 1 at the end of the range
+(element 4).  For further details consult the IRAF group.
+.PP
+An example database file for one aperture from an image "ech001" is given
+below.
+
+.ft L
+.nf
+	# Fri 14:33:35 08-May-87
+	begin	aperture ech001 1 22.75604 100.
+		image	ech001
+		aperture	1
+		beam	1
+		center	22.75604 100.
+		low	-2.680193 -99.
+		high	3.910698 100.
+		background
+			xmin -262.
+			xmax 262.
+			function chebyshev
+			order 1
+			sample -10:-6,6:10
+			naverage -3
+			niterate 0
+			low_reject 3.
+			high_reject 3.
+			grow 0.
+		axis	1
+		curve	6
+			2.
+			2.
+			1.
+			200.
+			-0.009295368
+			-0.3061974
+.fi
+.ft R
+.NH
+Future Developments
+.PP
+The IRAF extraction package \fBapextract\fR is going to continue to
+evolve because the extraction of one and two dimensional spectra
+from two dimensional images is an important part of reducing echelle,
+longslit, multislit, and multiaperture spectra.  Changes may include
+some of the following:
+
+.IP (1)
+Determine the actual variance from the data rather than using the Poisson
+CCD model.  Also output the variance vector if desired.
+.IP (2)
+The bad pixel detection and removal algorithm does not handle well the case
+of a very strong cosmic ray event on top of a very weak spectrum profile.
+A heuristic method to make the first fitting pass of the average
+profile to the image data less prone to errors due to strong cosmic rays
+is needed.  Also the detection should be done by interpolating the profile
+to the original image data rather than the other way around, in order to
+avoid broadening cosmic rays by interpolation.
+.IP (3)
+The aperture definition structure is general enough to allow the aperture
+limits along the dispersion dimension to be variable.  Eventually aperture
+definition and editing will be available using an image display.  Then
+both graphics and image display editing switches will be available.
+An image display interface will make extraction of objective prism
+spectra more convenient than it is now.
+.IP (4)
+Other types of extraction weighting may be added.
diff --git a/noao/twodspec/apextract/doc/old/apextract2.ms b/noao/twodspec/apextract/doc/old/apextract2.ms
new file mode 100644
index 00000000..35b42390
--- /dev/null
+++ b/noao/twodspec/apextract/doc/old/apextract2.ms
@@ -0,0 +1,14 @@
+.RP
+.TL
+Cleaning and Optimal Extraction with the IRAF APEXTACT Package
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+.AB
+.AE
+.NH
+Introduction
+.PP
diff --git a/noao/twodspec/apextract/doc/revisions.v3.ms b/noao/twodspec/apextract/doc/revisions.v3.ms
new file mode 100644
index 00000000..f78362a5
--- /dev/null
+++ b/noao/twodspec/apextract/doc/revisions.v3.ms
@@ -0,0 +1,522 @@
+.nr PS 9
+.nr VS 11
+.RP
+.ND
+.TL
+APEXTRACT Package Revisions Summary: IRAF Version 2.10
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+September 1990
+.AB
+This paper summarizes the changes in Version 3 of the IRAF \fBapextract\fR
+package which is part of IRAF Version 2.10.  The major new features and
+changes are:
+
+.IP \(bu
+New techniques for cleaning and variance weighting extracted spectra
+.IP \(bu
+A new task, \fBapall\fR, which integrates all the parameters used for
+one dimensional extraction of spectra
+.IP \(bu
+A new extended output format for recording both weighted and unweighted
+extractions, subtracted background, and variance information.
+.IP \(bu
+Special featurers for automatically numbering and identifying large
+numbers of apertures.
+.IP \(bu
+New tasks and algorithms, \fBaprecenter\fR and \fBapresize\fR,
+for automatically recentering and resizing aperture definitions
+.IP \(bu
+A new task, \fBapflatten\fR, for creating flat fields from
+fiber and slitlet spectra
+.IP \(bu
+A new task, \fBapfit\fR, providing various types of fitting for
+two dimensional multiobject spectra. 
+.IP \(bu
+A new task, \fBapmask\fR, for creating mask images from aperture definitions.
+.AE
+.NH
+Introduction
+.PP
+A new version of the IRAF \fBapextract\fR package has been completed.
+It is Version 3 and is part of IRAF Version 2.10.  The package will
+be made available as an external package prior to the release of V2.10.
+This paper describes the changes and new features of the package.  It
+does not describe them in detail.  Full details of the algorithms,
+functions, and parameters are found in the task descriptions.
+Reference is made to the previous version so familiarity with that
+version is useful though not necessary.  There were three goals for the
+new package: new and improved cleaning and variance weighting (optimal
+extraction) algorithms, the addition of recommended or desirable new
+tasks and algorithms (particularly to support large numbers of spectra
+from fiber and aperture mask instruments), and special support for the
+new image reduction scripts.  Features relating to the last point are
+not discussed here.
+.PP
+Table 1 summarizes the major new features and changes in the package.
+
+.ce
+Table 1:  Summary of Major New Features and Changes
+
+.IP \(bu
+New techniques for cleaning and variance weighting extracted spectra
+.IP \(bu
+A new task, \fBapall\fR, which integrates all the parameters used for
+one dimensional extraction of spectra
+.IP \(bu
+A new extended output format for recording both weighted and unweighted
+extractions, subtracted background, and variance information.
+.IP \(bu
+Special featurers for automatically numbering and identifying large
+numbers of apertures.
+.IP \(bu
+New tasks and algorithms, \fBaprecenter\fR and \fBapresize\fR, for
+automatically recentering and resizing aperture definitions
+.IP \(bu
+A new task, \fBapflatten\fR, for creating flat fields from fiber and slitlet
+spectra
+.IP \(bu
+A new task, \fBapfit\fR, providing various types of fitting for two dimensional
+multiobject spectra.
+.IP \(bu
+A new task, \fBapmask\fR, for creating mask images from aperture definitions.
+.NH
+Cleaned and Variance Weighted Extractions: apsum and apall
+.PP
+There are two types of aperture extraction (estimating the background
+subtracted flux across a fixed width aperture at each image line or
+column) just as in the previous version.  One is a simple sum of pixel
+values across an aperture.  In the previous version this was called
+"profile" weighting while in this version it is simply called
+unweighted or "none".  The second type weights each pixel in the sum by
+its estimated variance based on a spectrum model and detector noise
+parameters.  As before this type of extraction is selected by
+specifying "variance" for the weighting parameter.
+.PP
+Variance weighting is often called "optimal" extraction since it
+produces the best unbiased signal-to-noise estimate of the flux in the
+two dimensional profile.  It also has the advantage that wider
+apertures may be used without penalty of added noise.  The theory and
+application of this type of weighting has been described in several
+papers.  The ones which were closely examined and used as a model for
+the algorithms in this software are \fIAn Optimal Extraction Algorithm
+for CCD Spectroscopy\fR, \fBPASP 98\fR, 609, 1986, by Keith Horne and
+\fIThe Extraction of Highly Distorted Spectra\fR, \fBPASP 100\fR, 1032,
+1989, by Tom Marsh.
+.PP
+The noise model for the image data used in the variance weighting,
+cleaning, and profile fitting consists of a constant gaussian noise and
+a photon count dependent poisson noise.  The signal is related to the
+number of photons detected in a pixel by a gain parameter given
+as the number of photons per data number.  The gaussian noise is given
+by a readout noise parameter which is a defined as a sigma in
+photons.  The poisson noise is approximated as gaussian with sigma
+given by the number of photons.  The method of specifying this noise
+model differs from the previous version in that the more common CCD
+detector parameters of readout noise and gain are used rather than the
+linear variance parameters "v0" and "v1".
+.PP
+Some additional effects which should be considered in principle, and
+which are possibly important in practice, are that the variance
+estimate should be based on the actual number of photons detected before
+correction for pixel sensitivity; i.e. before flat field correction.
+Furthermore the uncertainty in the flat field should also be included
+in the weighting.  However, the profile must be determined free of
+sensitivity effects including rapid larger scale variations such as
+fringing.  Thus, ideally one should input the unflat-fielded
+observation and the flat field data and carry out the extractions with
+the above points in mind.  However, due to the complexity often
+involved in basic CCD reductions and special steps required for
+producing spectroscopic flat fields this level of sophistication is not
+provided by the current package.
+.PP
+The package does provide, however, for propagation of an approximate
+uncertainty in the background estimate when using background subtraction.
+If background subtraction is done, a background variance is computed
+using the poisson noise model based on the estimated background counts.
+Because the background estimate is based on a finite number of
+pixels, the poisson variance estimate is divided by the number (minus
+one) of pixels used in determining the background.  The number of
+pixels used includes any box car smoothing.  Thus, the larger the
+number of background pixels the smaller the background noise
+contribution to the variance weighting.  This method is only
+approximate since no correction is made for the number of degrees of
+freedom and correlations when using the fitting method of background
+estimation.
+.PP
+If removal of cosmic rays and other deviant pixels is desired (called
+cleaning) they are iteratively rejected based on the estimated variance
+and excluded from the weighted sum.  Unlike the previous version, a
+cleaned extraction is always variance weighted.  This makes sense since
+the detector noise parameters must be specified and the spectrum
+profile computed, so all of the computational effort must be done
+anyway, and the variance weighting is as good or superior to a simple
+unweighted extraction.
+.PP
+The detection and removal of deviant pixels is straightforward.  Based
+on the noise model, pixels deviating by more than a
+specified number of sigma (square root of the variance) above or below
+the model are removed from the weighted sum.  A new spectrum estimate
+is made and the rejection is repeated.  The rejections are made one at
+a time starting with the most deviant and up to half the pixels in the
+aperture may be rejected.
+.NH
+Spectrum Profile Determination: apsum, apall, apflatten, apfit
+.PP
+The foundation of variance weighted or optimal extraction, cosmic ray
+detection and removal, two dimensional flat field normalization, and
+spectrum fitting and modeling is the accurate determination of the
+spectrum profile across the dispersion as a function of wavelength.
+The previous version of the \fBapextract\fR package accomplished this by
+averaging a specified number of profiles in the vicinity of each
+wavelength after correcting for shifts in the center of the profile.
+This technique was sensitive to perturbations from cosmic rays
+and the exact choice of averaging parameters.  The current version of
+the package uses a different algorithm, actually a combination of
+two algorithms, which is much more stable.
+.PP
+The basic idea is to normalize each profile along the dispersion to
+unit flux and then fit a low order function to sets of unsaturated
+points at nearly the same point in the profile parallel to the
+dispersion.  The important point here is that points at the same
+distance from the profile center should have the nearly the same values
+once the continuum shape and spectral features have been divided out.
+Any variations are due to slow changes in the shape of the profile with
+wavelength, differences in the exact point on the profile, pixel
+binning or sampling, and noise.  Except for the noise, the variations
+should be slow and a low order function smoothing over many points will
+minimize the noise and be relatively insensitive to bad pixels such as
+cosmic rays.  Effects from bad pixels may be further eliminated by
+chi-squared iteration and clipping.  Since there will be many points
+per degree of freedom in the fitting function the clipping may even be
+quite aggressive without significantly affecting the profile
+estimates.  Effects from saturated pixels are minimized by excluding
+from the profile determination any profiles containing one or more
+saturated pixels.
+.PP
+The normalization is, in fact, the one dimensional spectrum.  Initially
+this is the simple sum across the aperture which is then updated
+by the variance weighted sum with deviant pixels possibly removed.
+This updated one dimensional spectrum is what is meant by the
+profile normalization factor in the discussion below.  The two dimensional
+spectrum model or estimate is the product of the normalization factor
+and the profile.  This model is used for estimating
+the pixel intensities and, thence, the variances.
+.PP
+There are two important requirements that must be met by the profile fitting
+algorithm.  First it is essential that the image data not be
+interpolated.  Any interpolation introduces correlated errors and
+broadens cosmic rays to an extent that they may be confused with the
+spectrum profile, particularly when the profile is narrow.  This was
+one of the problems limiting the shift and average method used
+previously.  The second requirement is that data fit by the smoothing
+function vary slowly with wavelength.  This is what precludes, for
+instance, fitting profile functions across the dispersion since narrow,
+marginally sampled profiles require a high order function using only a
+very few points.  One exception to this, which is sometimes useful but
+of less generality, is methods which assume a model for the profile
+shape such as a gaussian.  In the methods used here there is no
+assumption made about the underlying profile other than it vary
+smoothly with wavelength.
+.PP
+These requirements lead to two fitting algorithms based on how well the
+dispersion axis is aligned with the image columns or lines.  When the
+spectra are well aligned with the image axes one dimensional functions
+are fit to the image columns or lines.  Small excursions of a few
+pixels over the length of the spectrum can be adequately fit in this
+way.  When the spectra become strongly tilted then single lines or
+columns may cross the actual profile relatively quickly causing the
+requirement of a slow variation to be violated.  One thought is to use
+interpolation to fit points always at the same distance from the
+profile.  This is ruled out by the problems introduced by image
+interpolation.  However, there is a clever method which, in effect,
+fits low order polynomials parallel to the direction defined by tracing
+the spectrum but which does not interpolate the image data.  Instead it
+weights and couples polynomial coefficients.  This method was developed
+by Tom Marsh and is described in detail in the paper, \fIThe Extraction
+of Highly Distorted Spectra\fR, \fBPASP 101\fR, 1032, Nov. 1989.  Here
+we refer to this method as the Marsh algorithm and do not attempt to
+explain it further.
+.PP
+Both fitting algorithms weight the pixels by their variance as computed
+from the background and background variance if background subtraction
+is specified, the spectrum estimate from the profile and the spectrum
+normalization, and the detector noise parameters.  The noise model is
+that described earlier.
+.PP
+The profile fitting can be iterated to remove deviant pixels.  This is
+done by rejecting pixels greater than a specified number of sigmas
+above or below the expected value based on the profile, the
+normalization factor, the background, the detector noise parameters,
+and the overall chi square of the residuals.  Rejected points are
+removed from the profile normalization and from the fits.
+.NH
+New Extraction Task: apall
+.PP
+All of the functions of the \fBapextract\fR package are actually part
+of one master program.  The organization of the package into tasks by
+function with parameters to allow selection of some of the other
+functions, for example the aperture editor may be entered from
+virtually every task, was done to highlight the logic and organize the
+parameters into small sets.  However, there was often confusion about
+which parameters were being used and the need to set parameters in one
+task, say \fBaptrace\fR, in order to use the trace option in another
+task, say \fBapsum\fR.  In practice, for the most common function of
+extraction of two dimensional spectra to one dimension most users end up
+using \fBapsum\fR for all the functions.
+.PP
+In the new version, the old organization is retained (with the addition
+of new functions and some changes in parameters) but a new task,
+\fBapall\fR, is also available.  This task contains all of the
+parameters needed for extraction with a parameter organization which is
+nicely formated for use with \fBeparam\fR.  The parameters in
+\fBapall\fR are independent of the those in the other tasks.  It is
+expected that many, if not most users will opt to use this task for
+spectrum extraction in preference to the individual functions.
+.PP
+The organization by function is still used in the documentation.  This
+is still the best way to organize the descriptions of the various
+algorithms and parameters.  As an example, the profile tracing algorithm
+is described in most detail under the topic \fBaptrace\fR.
+.NH
+Extraction Output Formats: apsum and apall
+.PP
+The extracted spectra are recorded in one, two, or three dimensional
+images depending on the \fIformat\fR and \fIextras\fR parameters.  If
+the \fIextras\fR parameter is selected the formats are three
+dimensional with each plane in the third dimension containing
+associated information for the spectra in the first plane.  This
+information includes the unweighted spectrum and a sigma spectrum
+(estimated from the variances and weights of the pixels extracted) when
+using variance weighting, and the background spectrum when background
+subtraction is used.  When \fIextras\fR is not selected only the
+extracted spectra are output.
+.PP
+The formats are basically the same as in the previous version;
+onedspec, multispec, and echelle.  In addition, the function of the
+task \fBapstrip\fR in the previous version has been transferred to the
+extraction tasks by simply specifying "strip" for the format.
+.PP
+There are some additions to the header parameters in multispec and
+echelle format.  Two additional fields have been added to the
+aperture number parameter giving the aperture limits (at the reference
+dispersion point).  Besides being informative it may be used for
+interpolating dispersion solutions spatially.  A second, optional keyword per
+spectrum has been added to contain a title.  This is useful for
+multiobject spectra.
+.NH
+Easier and Extended Aperture Identifications: apfind and apedit
+.PP
+When dealing with a large number of apertures, such as occur with
+multifiber and multiaperture data, the burden of making and maintaining
+useful aperture identifications becomes large.  Several very useful
+improvements were made in this area.  These improvements generally
+apply equally to aperture identifications made by the automated
+\fBapfind\fR algorithm and those made interactively using
+\fBapedit\fR.  In the simplest usage of defining apertures
+interactively or with the aperture finding algorithm, aperture numbers
+are assigned sequentially beginning with 1.  In the new version the
+parameter "order" allows the direction of increasing aperture numbers
+with respect to the direction of increasing pixel coordinate (either
+column or line) to be set.  An "increasing" order parameter value
+numbers the apertures from left to right (the direction naturally
+plotted) in the same sense as the pixel coordinates.  A "decreasing"
+order reverses this sense.
+.PP
+Some instruments, particularly multifiber instruments, produce nearly
+equally spaced spectra for which one wants to maintain a consistent
+numbering sequence.  However, at times some spectra may be missing
+due to broken or unassigned fibers and one would like to skip an
+aperture identification number to maintain the same fiber assignments.
+To do this automatically, a new parameter called \fImaxsep\fR has been
+added.  This parameter defines the maximum separation between two
+apertures beyond which a jump in the aperture sequence is made.  In
+other words the sequence increment is given by rounding down the
+separation divided by this parameter.  How accurately this value has
+to be specified depends on how large the gaps may be and the natural
+variability in the aperture positions.  In conjunction with the
+minimum separation parameter this algorithm works quite well in
+accounting for missing spectra.
+.PP
+One flaw in this scheme is when the first spectrum is missing causing
+the identifications will be off.  In this case the modified interactive
+aperture editing command 'o' asks for the aperture identification
+number of the aperture pointed at by the cursor and then automatically
+renumbers the other apertures relative to that aperture.  The other
+possible flaw is identification of noise as a spetrum but this is
+controlled by the \fIthreshold\fR parameter and, provided the actual
+number of spectra is known, say by counting off a graph, then the
+\fInfind\fR parameter generally limits this type of problem.
+.PP
+A new attribute of an aperture is a title.  If present this title
+is propagated through the extraction into the image headers.  The title
+may be set interactively but normally the titles are supplied in
+another new feature, an "aperture identification" file specified by
+the parameter \fIapidtable\fR.  This file provides
+the most flexibility in making aperture identification assignments.
+The file consists of lines with three fields, a unique aperture number,
+a beam or aperture type number which may be repeated, and the
+aperture title.  The aperture identification lines from the file are
+assigned sequentially in the same order as would be done if using
+the default indexing including skipping of missing spectra based on
+the maximum separation.
+.PP
+By default the beam number is the same as the aperture number.  When
+using an aperture identification file the beam number can be used
+to assign spectrum types which other software may use.  For example,
+some of the specialized fiber reduction packages use the beam number
+to identify sky fibers and embedded arc fibers.
+.NH
+New Aperture Recentering Task: aprecenter
+.PP
+An automated recentering algorithm has been added.  It may be called
+through the new \fBaprecenter\fR command, from any of the tasks containing
+the \fIrecenter\fR parameter, or from the aperture editor.  The purpose of
+this new feature is to allow automatically adjusting the aperture
+centers to follow small changes in the positions of spectra expected to be at
+essentially the same position, such as with fiber fed spectrographs.
+This does not change the shape of the trace but simply adds a shift
+across the dispersion axis.
+.PP
+Typically, one uses a strong image to define reference apertures and
+then for subsequent objects uses the reference positions with a
+recentering to correct for flexure effects.  However, it may be
+inappropriate to base a new center on weak spectra or to have multiple
+spectra recentered independently.  The recentering options provide for
+selecting specific apertures to be recentered, selecting only a
+fraction of the strongest (highest peak data level) spectra and
+averaging the shifts determined (possible from only a subset of the
+spectra) and applying the average shift to all the apertures.
+Note that one may still specify the dispersion line and number of 
+dispersion lines to sum in order to improve the signal for centering.
+.NH
+New Aperture Resizing Task: apresize
+.PP
+An automated resizing algorithm has been added.  It may be called
+through the new \fBapresize\fR command, from any of the tasks
+containing the \fIresize\fR parameter, or from the aperture editor with
+the new key 'z' (the y cursor level command is still available with the
+'y' key).  The purpose of this new feature is to allow automatically
+adjusting the aperture widths to follow changes in seeing and to
+provide a greater variety of global aperture sizing methods.
+.PP
+In all the methods the aperture limits are set at the pixel positions
+relative to the center which intersect the linearly interpolated data
+at some data value.  The methods differ in how the data level is
+determined.  The methods are:
+
+.IP \(bu
+Set size at a specified absolute data level
+.IP \(bu
+Set size at a specified data level above a background
+.IP \(bu
+Set size at a specified fraction of the peak pixel value
+.IP \(bu
+Set size at a specified fraction of the peak pixel value above a background
+.LP
+The automatic background is quite simple; a line connecting the first
+local minima from the aperture center.
+.PP
+The limits determined by one of the above methods may be further
+adjusted.  The limits may be increased or decreased by a specified
+fraction.  This allows setting wider limits based on more accurately
+determined limits from the stronger part of the profile; for example
+doubling the limits obtained from the half intensity point.  A maximum
+extent may be imposed.  Finally, if there is more than one aperture and one
+wants to maintain the same aperture size, the apertures sizes
+determined individually may be averaged and substituted for all the
+apertures.
+.NH
+New Aperture Mask Output: apmask
+.PP
+A new task, \fBapmask\fR, has been added to produce a mask file/image
+of 1's and 0's defined by the aperture definitions.  This is based on
+the new IRAF mask facilities.  The output is a compact binary file
+which may be used directly as an image in most applications.  In
+particular the mask file can be used with tasks such as \fBimarith\fR,
+\fBimreplace\fR, and \fBdisplay\fR.  Because the mask facility is new,
+there is little that can be done with masks other than using it as an
+image.  However, eventually many tasks will be able to use mask
+images.  The aperture mask will be particularly well suited to work
+with \fBimsurfit\fR for fitting a surface to the data outside the apertures.
+This would be an alternative for scattered light modeling to the
+\fBapscatter\fR tasks.
+.NH
+Aperture Flat Fields and Normalization: apflatten and apnormalize
+.PP
+Slitlet, echelle, and fiber spectra have the characteristic that the
+signal falls off to near zero values outside regions of the image
+containing spectra.  Also fiber profiles are usually undersampled
+causing problems with gradients across the pixels.  Directly dividing
+by a flat field produces high noise (if not division by zero) where the
+signal is low, introduces the spectrum of the flat field light, and
+changes the profile shape.
+.PP
+One method for modifying the flat field to avoid these problems is
+provided by the task \fBimred.generic.flat1d\fR.  However, this task
+does not use any knowledge of where the spectra are.  There are two
+tasks in the \fBapextract\fR package which can be used to modify flat
+field images.  \fBapnormalize\fR is not new.  It divides the spectra
+within specified apertures by a one dimensional spectrum, either a
+constant for simple throughput normalization or some smoothed version
+of the spectrum in the aperture to remove the spectral shape.  Pixels
+outside specified apertures are set to unity to avoid division
+effects.  This task has the effect of preserving the profile shape in
+the flat field which may be desired for attempts to remove slit
+profiles.
+.PP
+Retaining the profile shape of the flat field can give very bad edge
+effects, however, if there is image flexure.  A new task similar to
+\fBflat1d\fR but which uses aperture information is \fBapflatten\fR.
+It uses the spectrum profile model described earlier.  For nearly image
+axes aligned spectra this amounts very nearly to the line or column
+fitting of \fBflat1d\fR.  As with \fBapnormalize\fR there is an option
+to fit the one dimensional spectrum to remove the large scale shape of
+the spectrum while preserving small scale sensitivity variations.  The
+smoothed spectrum is multiplied by the normalized profile and divided
+into the data in each aperture.  Pixels outside the aperture are set to
+1.  Pixels with model values below a threshold are also set to 1.  This
+produces output images which have the small scale sensitivity
+variations, a normalized mean, and the spectrum profile removed.
+.NH
+Two Dimensional Spectrum Fitting: apfit
+.PP
+The profile and spectrum fitting used for cleaning and variance
+weighted extraction may be used and output in the new task
+\fBapfit\fR.  The task \fBapfit\fR is similar in structure to
+\fBfit1d\fR.  One may output the fit, difference, or ratio.  The fit
+may be used to examine the spectrum model used for the cleaning and
+variance weighted extraction.  The difference and ratio may used to
+display small variations and any deviant pixels.  While specific uses
+are not given this task will probably be used in interesting ways not
+anticipated by the author.
+.NH
+I/O and Dispersion Axis Parameters: apextract and apio
+.PP
+The general parameters, primarily concerning input and output devices
+and files, were previously in the parameter set \fBapio\fR.  This "pset"
+task has been removed and those parameters are now found as part of
+the package parameters, i.e. \fBapextract\fR.  There is one new parameter
+in the \fBapextract\fR package parameters, dispaxis.  In the previous
+version of the package one needed to run the task \fBsetdisp\fR to insert
+information in the image header identifying the dispersion direction
+of the spectra in the image.  Often people would forget this step
+and receive an error message to that effect.  The new parameter
+allows skipping this step.  If the DISPAXIS image header parameter
+is missing the package parameter value is inserted into the image
+header as part of the processing.  Note that if the parameter is
+present in the image header either because \fBsetdisp\fR was used or the
+image creation process inserted it (a future ideal case) then that
+value is used in preference to the package parameter.
+.NH
+Strip Extraction: apstrip
+.PP
+The task \fBapstrip\fR from the previous version has been removed.
+However, it is possible to obtain two dimensional strips aligned with
+the image axes by specifying a format of "strip" when using \fBapsum\fR
+or \fBapall\fR.  While the author doesn't anticipate a good scientific
+use for this feature others may find it useful.
diff --git a/noao/twodspec/apextract/mkpkg b/noao/twodspec/apextract/mkpkg
new file mode 100644
index 00000000..bcc342c4
--- /dev/null
+++ b/noao/twodspec/apextract/mkpkg
@@ -0,0 +1,76 @@
+# APEXTRACT
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$call	apextract
+	;
+
+install:
+	$move	xx_apextract.e noaobin$x_apextract.e
+	;
+
+apextract:
+	$omake	x_apextract.x
+	$link	x_apextract.o libpkg.a -lxtools\
+		-lcurfit -liminterp -lllsq -o xx_apextract.e
+	;
+
+libpkg.a:
+	apalloc.x	apertures.h
+	apanswer.x	
+	apcenter.x	<pkg/center1d.h>
+	apcolon.x	apertures.h <error.h> <gset.h> <imhdr.h>
+	apcopy.x	apertures.h
+	apcveval.x	<math/curfit.h>
+	apcvset.x	apertures.h <math/curfit.h>
+	apdb.x		apertures.h <math/curfit.h> <pkg/dttext.h>
+	apdefault.x	apertures.h <imhdr.h>
+	apdelete.x	
+	apedit.x	apertures.h <gset.h> <imhdr.h> <mach.h> <pkg/gtools.h>
+	apextract.x	apertures.h <error.h> <imhdr.h> <mach.h>\
+			<math/iminterp.h> <pkg/gtools.h>
+	apfind.x	apertures.h <imhdr.h> <mach.h>
+	apfindnew.x	apertures.h <mach.h>
+	apfit.x		apertures.h <imhdr.h> <imset.h> <pkg/gtools.h>
+	apgetdata.x	<imhdr.h>
+	apgetim.x	
+	apgmark.x	apertures.h <pkg/rg.h>
+	apgraph.x	apertures.h <pkg/gtools.h>
+	apgscur.x	apertures.h
+	apicset.x	apertures.h <imhdr.h>
+	apids.x		apertures.h <error.h> <mach.h>
+	apimmap.x	<imhdr.h>
+	apinfo.x	apertures.h
+	apio.x		<time.h>
+	apmask.x	apertures.h <imhdr.h> <pmset.h>
+	apmw.x		<error.h> <imhdr.h> <imio.h> <mwset.h>
+	apnearest.x	apertures.h <mach.h>
+	apnoise.x	apertures.h <gset.h> <pkg/gtools.h>
+	apparams.x	
+	appars.x	<math/iminterp.h>
+	apprint.x	apertures.h
+	approfile.x	apertures.h <gset.h> <mach.h> <math/curfit.h>
+	aprecenter.x	apertures.h
+	apresize.x	apertures.h
+	apscatter.x	apertures.h <error.h> <imhdr.h> <imset.h> <pkg/gtools.h>
+	apselect.x	apertures.h
+	apshow.x	apertures.h
+	apskyeval.x	apertures.h <math/iminterp.h> <mach.h>
+	apsort.x	apertures.h
+	aptrace.x	apertures.h <imhdr.h> <math/curfit.h> <pkg/center1d.h>\
+			<pkg/gtools.h>
+	apupdate.x	apertures.h <gset.h>
+	apvalues.x	apertures.h
+	apvariance.x	apertures.h <gset.h>
+	apylevel.x	
+	peaks.x	
+	t_apall.x	apertures.h <error.h> <imhdr.h> <pkg/gtools.h>
+	;
diff --git a/noao/twodspec/apextract/peaks.x b/noao/twodspec/apextract/peaks.x
new file mode 100644
index 00000000..fe525f88
--- /dev/null
+++ b/noao/twodspec/apextract/peaks.x
@@ -0,0 +1,313 @@
+# PEAKS -- The following procedures are general numerical functions
+# dealing with finding peaks in a data array.
+#
+# FIND_PEAKS		Find additional peaks in the data array.
+# FIND_LOCAL_MAXIMA	Find the local maxima in the data array.
+# IS_LOCAL_MAX		Test a point to determine if it is a local maximum.
+# FIND_CONTRAST		Find the peaks satisfying the contrast constraint.
+# FIND_ISOLATED		Flag peaks which are within separation of a peak
+#			with a higher peak value.
+# FIND_NMAX		Select up to the nmax highest ranked peaks.
+# COMPARE		Compare procedure for sort used in FIND_PEAKS.
+
+# FIND_PEAKS -- Find the peaks in the data array.
+#
+# The peaks are found using the following algorithm:
+#
+# 1.  Find the local maxima which are not near the edge of existing peaks.
+# 2.  Reject those below the absolute threshold.
+# 3.  Reject those below the contrast threshold.
+# 4.  Determine the ranks of the remaining peaks.
+# 5.  Flag weaker peaks within separation of a stronger peak.
+# 6.  Add strongest peaks to the peaks array.
+#
+# Indefinite data points are ignored.
+
+procedure find_peaks (data, npts, contrast, edge, nmax, separation, threshold,
+    peaks, npeaks)
+
+real	data[npts]		# Input data array
+int	npts			# Number of data points
+
+real	contrast		# Maximum contrast between strongest and weakest
+int	edge			# Minimum distance from the edge
+int	nmax			# Maximum number of peaks to be returned
+real	separation		# Minimum separation between peaks
+real	threshold		# Minimum threshold level for peaks
+
+real	peaks[nmax]		# Positons of input peaks / output peaks
+int	npeaks			# Number of input peaks / number of output peaks
+
+int	i, nx
+pointer	sp, x, y, rank
+
+int	compare()
+extern	compare()
+
+common	/sort/ y
+
+begin
+	if (npeaks >= nmax)
+	    return
+
+	call smark (sp)
+	call salloc (x, npts, TY_INT)
+	call salloc (y, npts, TY_REAL)
+
+	# Find the positions of the local maxima.
+	call find_local_maxima (data, npts, peaks, npeaks, edge, separation,
+	    threshold, Memi[x], Memr[y], nx)
+
+	# Eliminate points not satisfying the contrast constraint.
+	call find_contrast (data, Memi[x], Memr[y], nx, contrast)
+
+	# Rank the peaks by peak value.
+	call salloc (rank, nx, TY_INT)
+	for (i = 1; i <= nx; i = i + 1)
+	    Memi[rank + i - 1] = i
+	call qsort (Memi[rank], nx, compare)
+
+	# Reject weaker peaks within a specified separation of a stronger peak.
+	call find_isolated (Memi[x], Memi[rank], nx, separation)
+
+	# Add the strongest peaks.
+	call find_nmax (Memi[x], Memi[rank], nx, nmax, peaks, npeaks)
+
+	call sfree (sp)
+end
+
+
+# FIND_LOCAL_MAXIMA -- Find the local maxima in the data array.
+
+procedure find_local_maxima (data, npts, peaks, npeaks, edge, separation,
+    threshold, x, y, nx)
+
+real	data[npts]		# Input data array
+int	npts			# Number of input points
+real	peaks[ARB]		# Positions of peaks
+int	npeaks			# Number of peaks
+int	edge			# Edge buffer distance
+real	separation		# Minimum separation from peaks
+real	threshold		# Data threshold
+int	x[npts]			# Output positions
+real	y[npts]			# Output data values
+int	nx			# Number of maxima
+
+int	i, j
+
+bool	is_local_max()
+
+begin
+	# Find the local maxima above the threshold and not near the edge.
+	nx = 0
+	for (i = edge + 1; i <= npts - edge; i = i + 1) {
+	    if ((data[i] >= threshold) && (is_local_max (i, data, npts))) {
+	        nx = nx + 1
+	        x[nx] = i
+	    }
+	}
+
+	# Flag maxima within separation of previous peaks.
+	for (j = 1; j <= npeaks; j = j + 1) {
+	    for (i = 1; i <= nx; i = i + 1) {
+		if (IS_INDEFI (x[i]))
+		    next
+		if (x[i] < peaks[j] - separation)
+		    next
+		if (x[i] > peaks[j] + separation)
+		    break
+		x[i] = INDEFI
+	    }
+	}
+
+	# Eliminate flagged maxima and set y values.
+	j = 0
+	for (i = 1; i <= nx; i = i + 1) {
+	    if (!IS_INDEFI (x[i])) {
+		j = j + 1
+		x[j] = x[i]
+		y[j] = data[x[j]]
+	    }
+	}
+
+	nx = j
+end
+
+
+# IS_LOCAL_MAX -- Test a point to determine if it is a local maximum.
+#
+# Indefinite points are ignored.
+
+bool procedure is_local_max (index, data, npts)
+
+# Procedure parameters:
+int	index			# Index to test for local maximum
+real	data[npts]		# Data values
+int	npts			# Number of points in the data vector
+
+int	i, j, nright, nleft
+
+begin
+	# INDEFR points cannot be local maxima.
+	if (IS_INDEFR (data[index]))
+	    return (false)
+
+	# Find the left and right indices where data values change and the
+	# number of points with the same value.  Ignore INDEFR points.
+	nleft = 0
+	for (i = index - 1; i >= 1; i = i - 1) {
+	    if (!IS_INDEFR (data[i])) {
+		if (data[i] != data[index])
+		    break
+		nleft = nleft + 1
+	    }
+	}
+	nright = 0
+	for (j = index + 1; i <= npts; j = j + 1) {
+	    if (!IS_INDEFR (data[j])) {
+		if (data[j] != data[index])
+		    break
+		nright = nright + 1
+	    }
+	}
+
+	# Test for failure to be a local maxima
+	if ((i == 0) && (j == npts)) {
+	    return (FALSE)		# Data is constant
+	} else if (i == 0) {
+	    if (data[j] > data[index])
+	        return (FALSE)		# Data increases to right
+	} else if (j == npts) {
+	    if (data[i] > data[index])	# Data increase to left
+		return (FALSE)
+	} else if ((data[i] > data[index]) || (data[j] > data[index])) {
+	    return (FALSE)		# Not a local maximum
+	} else if (!((nleft - nright == 0) || (nleft - nright == 1))) {
+	    return (FALSE)		# Not center of plateau
+	}
+
+	# Point is a local maxima
+	return (TRUE)
+end
+
+
+
+# FIND_CONTRAST -- Find the peaks with positions satisfying contrast constraint.
+
+procedure find_contrast (data, x, y, nx, contrast)
+
+real	data[ARB]		# Input data values
+int	x[ARB]			# Input/Output peak positions
+real	y[ARB]			# Output peak data values
+int	nx			# Number of peaks input
+real	contrast		# Contrast constraint
+
+int	i, j
+real	minval, maxval, threshold
+
+begin
+	if ((nx == 0.) || (contrast <= 0.))
+	    return
+
+	call alimr (y, nx, minval, maxval)
+	threshold = contrast * maxval
+
+	j = 0
+	do i = 1, nx {
+	    if (y[i] < threshold) {
+		j = j + 1
+		x[j] = x[i]
+		y[j] = y[i]
+	    }
+	}
+
+	nx = j
+end
+
+# FIND_ISOLATED -- Flag peaks which are within separation of a peak
+# with a higher peak value.
+#
+# The peak positions, x, and their ranks, rank, are input.
+# The rank array contains the indices of the peak positions in order from
+# the highest peak value to the lowest peak value.  Starting with
+# highest rank (rank[1]) all peaks of lower rank within separation
+# are marked by setting their positions to INDEFI.
+
+procedure find_isolated (x, rank, nx, separation)
+
+int	x[ARB]			# Positions of points
+int	rank[ARB]		# Rank of peaks
+int	nx			# Number of peaks
+real	separation		# Minimum allowed separation
+
+int	i, j
+
+begin
+	if ((nx == 0) || (separation <= 0.))
+	    return
+
+	# Eliminate close neighbors.  The eliminated
+	# peaks are marked by setting their positions to INDEFI.
+
+	for (i = 1; i < nx; i = i + 1) {
+	    if (IS_INDEFI (x[rank[i]]))
+		next
+	    for (j = i + 1; j <= nx; j = j + 1) {
+		if (IS_INDEFI (x[rank[j]]))
+		    next
+		if (abs (x[rank[i]] - x[rank[j]]) < separation)
+		    x[rank[j]] = INDEFI
+	    }
+	}
+end
+
+
+# FIND_NMAX -- Select up to the nmax highest ranked peaks.
+
+procedure find_nmax (x, rank, nx, nmax, peaks, npeaks)
+
+int	x[ARB]			# Peak positions
+int	rank[ARB]		# Ranks of peaks
+int	nx			# Number of input / output peaks
+int	nmax			# Max number of peaks to be selected
+real	peaks[nmax]		# Output peak position array
+int	npeaks			# Output number of peaks
+
+int	i
+
+begin
+	for (i = 1; (i <= nx) && (npeaks < nmax); i = i + 1) {
+	    if (IS_INDEFI (x[rank[i]]))
+		next
+	    npeaks = npeaks + 1
+	    peaks[npeaks] = x[rank[i]]
+	}
+end
+
+
+# COMPARE -- Compare procedure for sort used in FIND_PEAKS.
+# Larger values are indexed first.  INDEFR values are indexed last.
+
+int procedure compare (index1, index2)
+
+# Procedure parameters:
+int	index1				# Comparison index
+int	index2				# Comparison index
+
+pointer	y
+
+common	/sort/ y
+
+begin
+	# INDEFR points are considered to be smallest possible values.
+	if (IS_INDEFR (Memr[y - 1 + index1]))
+	    return (1)
+	else if (IS_INDEFR (Memr[y - 1 + index2]))
+	    return (-1)
+	else if (Memr[y - 1 + index1] < Memr[y - 1 + index2])
+	    return (1)
+	else if (Memr[y - 1 + index1] > Memr[y - 1 + index2])
+	    return (-1)
+	else
+	    return (0)
+end
diff --git a/noao/twodspec/apextract/t_apall.x b/noao/twodspec/apextract/t_apall.x
new file mode 100644
index 00000000..415066ba
--- /dev/null
+++ b/noao/twodspec/apextract/t_apall.x
@@ -0,0 +1,576 @@
+include	<imhdr.h>
+include	<error.h>
+include	<pkg/gtools.h>
+include	"apertures.h"
+
+define	APFIND		1
+define	APRECENTER	2
+define	APRESIZE	3
+define	APEDIT		4
+define	APTRACE		5
+define	APSUM		6
+define	APNORM		7
+define	APSCAT		8
+define	APALL		9
+define	APFIT		10
+define	APFLAT		11
+define	APMASK		12
+define	APSCRIPT	13
+define	APSLITPROC	14
+define	APNOISE		15
+
+
+# APEXTRACT TASK ENTRY POINTS
+#
+# The entry point for each task selects the operations to be performed
+# and initializes the pset to be used for the algorithm parameters.
+
+procedure t_apfind ()
+begin
+	call apall (APFIND)
+end
+
+procedure t_aprecenter ()
+begin
+	call apall (APRECENTER)
+end
+
+procedure t_apresize ()
+begin
+	call apall (APRESIZE)
+end
+
+procedure t_apedit ()
+begin
+	call apall (APEDIT)
+end
+
+procedure t_aptrace ()
+begin
+	call apall (APTRACE)
+end
+
+procedure t_apsum ()
+begin
+	call apall (APSUM)
+end
+
+procedure t_apnorm ()
+begin
+	call apall (APNORM)
+end
+
+procedure t_apscatter ()
+begin
+	call apall (APSCAT)
+end
+
+procedure t_apall ()
+begin
+	call apall (APALL)
+end
+
+procedure t_apflat ()
+begin
+	call apall (APFLAT)
+end
+
+procedure t_apfit ()
+begin
+	call apall (APFIT)
+end
+
+procedure t_apmask ()
+begin
+	call apall (APMASK)
+end
+
+procedure t_apscript ()
+begin
+	call apall (APSCRIPT)
+end
+
+procedure t_apslitproc ()
+begin
+	call apall (APSLITPROC)
+end
+
+procedure t_apnoise ()
+begin
+	call apall (APNOISE)
+end
+
+
+# APALL -- Master aperture definition and extraction procedure.
+
+procedure apall (ltask)
+
+int	ltask			# Logical task
+
+bool	find			# Find apertures?
+bool	recenter		# Recenter apertures?
+bool	resize			# Resize apertures?
+bool	edit			# Edit apertures?
+bool	trace			# Trace apertures?
+bool	extract			# Extract apertures?
+bool	fit			# Extract fit?
+bool	norm			# Normalize spectra?
+bool	flat			# Flatten spectra?
+bool	scat			# Subtract scattered light?
+bool	mask			# Aperture mask?
+bool	noise			# Noise calculation?
+
+int	input			# List of input spectra
+int	refs			# List of reference spectra
+int	out			# List of output spectra
+pointer	format			# Output format or fit type
+int	scatout			# List of scattered light images
+int	profs			# List of profile spectra
+int	line			# Dispersion line
+int	nsum			# Lines to sum
+
+pointer	aps			# Pointer to array of aperture pointers
+int	naps			# Number of apertures
+
+char	nullstr[1]
+int	i
+pointer	sp, image, output, reference, profiles, str, str1
+
+bool	clgetb(), apgetb(), streq(), ap_answer(), apgans(), apgansb()
+int	imtopenp(), clgeti(), ap_getim(), ap_dbaccess(), strncmp()
+
+errchk	ap_dbacess, ap_dbread, ap_find, ap_recenter, ap_resize, ap_edit
+errchk	ap_trace, ap_plot, ap_extract, ap_scatter, ap_mask, ap_dbwrite
+
+data	nullstr /0,0/
+
+begin
+	# Allocate memory for the apertures, filenames, and strings.
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (reference, SZ_FNAME, TY_CHAR)
+	call salloc (format, SZ_LINE, TY_CHAR)
+	call salloc (profiles, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+
+	switch (ltask) {
+	case APALL:
+	    call apopset ("apall1")
+	case APFIT:
+	    call apopset ("apfit1")
+	case APFLAT:
+	    call apopset ("apflat1")
+	case APNORM:
+	    call apopset ("apnorm1")
+	case APSCRIPT:
+	    call apopset ("apscript")
+	case APSLITPROC:
+	    call apopset ("apslitproc")
+	case APNOISE:
+	    call apopset ("apnoise1")
+	default:
+	    call apopset ("apparams")
+	}
+
+	input = imtopenp ("input")
+	refs = imtopenp ("references")
+	line = clgeti ("line")
+	nsum = clgeti ("nsum")
+	out = NULL
+	profs = NULL
+	scatout = NULL
+
+	switch (ltask) {
+	case APSUM, APALL, APFIT, APNORM, APFLAT, APSCAT,
+	    APMASK, APSCRIPT, APSLITPROC:
+	    out = imtopenp ("output")
+	}
+
+	switch (ltask) {
+	case APSUM, APALL:
+	    profs = imtopenp ("profiles")
+	    call apgstr ("format", Memc[format], SZ_LINE)
+	case APFIT:
+	    call clgstr ("fittype", Memc[format], SZ_LINE)
+	case APNORM:
+	    call strcpy ("normalize", Memc[format], SZ_LINE)
+	case APFLAT:
+	    call strcpy ("flatten", Memc[format], SZ_LINE)
+	case APSCAT:
+	    scatout = imtopenp ("scatter")
+	case APSCRIPT, APSLITPROC:
+	    scatout = imtopenp ("scatter")
+	    profs = imtopenp ("profiles")
+	    call apgstr ("format", Memc[format], SZ_LINE)
+	case APNOISE:
+	    call strcpy ("noise", Memc[format], SZ_LINE)
+	}
+
+	trace = false
+	extract = false
+	fit = false
+	norm = false
+	flat = false
+	scat = false
+	mask = false
+	noise = false
+
+	if (apgetb ("initialize")) {
+	    find = clgetb ("find")
+	    recenter = clgetb ("recenter")
+	    resize = clgetb ("resize")
+	    edit = clgetb ("edit")
+
+	    switch (ltask) {
+	    case APTRACE, APSUM, APALL, APFIT, APNORM,
+		APFLAT, APSCAT, APMASK, APSCRIPT, APSLITPROC, APNOISE:
+	        trace = clgetb ("trace")
+	    }
+
+	    switch (ltask) {
+	    case APSUM, APALL:
+	        extract = clgetb ("extract")
+	    case APFIT:
+	        fit = clgetb ("fit")
+	    case APNORM:
+	        norm = clgetb ("normalize")
+	    case APFLAT:
+	        flat = clgetb ("flatten")
+	    case APSCAT:
+	        scat = clgetb ("subtract")
+	    case APMASK:
+	        mask = clgetb ("mask")
+	    case APSCRIPT, APSLITPROC:
+	        extract = clgetb ("extract")
+	        scat = clgetb ("subtract")
+		if (extract && scat)
+		    call error (1,
+		    "APSCRIPT: Can't combine scattered light and extraction")
+	    case APNOISE:
+		noise = true
+	    }
+
+	    call ap_init (find, recenter, resize, edit, trace, extract, fit,
+	        norm, flat, scat, mask, noise)
+	} else {
+	    find = apgans ("ansfind")
+	    recenter = apgans ("ansrecenter")
+	    resize = apgans ("ansresize")
+	    edit = apgans ("ansedit")
+
+	    switch (ltask) {
+	    case APTRACE, APSUM, APALL, APFIT, APNORM,
+		APFLAT, APSCAT, APMASK, APSCRIPT, APSLITPROC, APNOISE:
+	        trace = apgans ("anstrace")
+	    }
+
+	    switch (ltask) {
+	    case APSUM, APALL:
+	        extract = apgans ("ansextract")
+	    case APFIT:
+	        fit = apgans ("ansfit")
+	    case APNORM:
+	        norm = apgans ("ansnorm")
+	    case APFLAT:
+	        flat = apgans ("ansflat")
+	    case APSCAT:
+	        scat = apgans ("ansscat")
+	    case APMASK:
+	        mask = apgans ("ansmask")
+	    case APSCRIPT, APSLITPROC:
+	        extract = apgans ("ansextract")
+	        scat = apgans ("ansscat")
+		if (extract && scat)
+		    call error (1,
+		    "APSCRIPT: Can't combine scattered light and extraction")
+	    }
+	}
+
+	# Initialize the apertures.
+	naps = 0
+	Memc[reference] = EOS
+	Memc[profiles] = EOS
+	call malloc (aps, 100, TY_POINTER)
+
+	# Process the apertures from each input image.
+	while (ap_getim (input, Memc[image], SZ_FNAME) != EOF) {
+	    if (ap_getim (refs, Memc[str], SZ_LINE) != EOF)
+		call strcpy (Memc[str], Memc[reference], SZ_FNAME)
+	    if (extract || fit || flat || norm || scat || mask)
+		if (ap_getim (out, Memc[output], SZ_FNAME) == EOF)
+		    Memc[output] = EOS
+
+	    # Get apertures.
+	    call appstr ("ansdbwrite1", "no")
+	    if (streq (Memc[reference], nullstr) ||
+		streq (Memc[reference], Memc[image])) {
+		if (clgetb ("verbose"))
+		    call printf ("Searching aperture database ...\n")
+		iferr (call ap_dbread (Memc[image], aps, naps))
+		    ;
+	    } else if (streq (Memc[reference], "OLD")) {
+		iferr (call ap_dbread (Memc[image], aps, naps))
+		    next
+	    } else {
+		if (strncmp (Memc[reference], "NEW", 3) == 0) {
+		    if (ap_dbaccess (Memc[image]) == YES)
+			next
+		    call strcpy (Memc[reference+3], Memc[reference], SZ_FNAME)
+		}
+		if (clgetb ("verbose"))
+		    call printf ("Searching aperture database ...\n")
+		iferr (call ap_dbread (Memc[reference], aps, naps)) {
+		    call eprintf (
+			"WARNING: Reference image (%s) apertures not found\n")
+			call pargstr (Memc[reference])
+		    next
+		}
+		if (naps > 0)
+		    call appstr ("ansdbwrite1", "yes")
+	    }
+	    call clgstr ("apertures", Memc[str], SZ_LINE)
+	    call ap_select (Memc[str], Memi[aps], naps)
+
+	    iferr {
+		# Find apertures.
+		if (find && naps == 0)
+		    call ap_find (Memc[image], line, nsum, aps, naps)
+
+		# Recenter apertures.
+		else if (recenter)
+		    call ap_recenter (Memc[image], line, nsum, Memi[aps], naps,
+			NO)
+
+		# Resize apertures.
+		if (resize)
+		    call ap_resize (Memc[image], line, nsum, Memi[aps], naps,
+			NO)
+
+		# Edit apertures.
+		if (edit)
+		    call ap_edit (Memc[image], line, nsum, aps, naps)
+
+		# Trace apertures.
+		if (trace)
+		    call ap_trace (Memc[image], line, Memi[aps], naps, NO)
+
+		# Write database and make aperture plot.
+		if (apgansb ("ansdbwrite1")) {
+		    call clgstr ("database", Memc[str1], SZ_LINE)
+	            call sprintf (Memc[str], SZ_LINE,
+		        "Write apertures for %s to %s")
+	                call pargstr (Memc[image])
+	                call pargstr (Memc[str1])
+	            if (ap_answer ("ansdbwrite", Memc[str]))
+		        call ap_dbwrite (Memc[image], aps, naps)
+		}
+	        iferr (call ap_dbwrite ("last", aps, naps))
+		    ;
+		iferr (call ap_plot (Memc[image], line, nsum, Memi[aps], naps))
+		    call erract (EA_WARN)
+
+		# Extract 1D spectra but do not extract negative beams
+		if (extract) {
+		    do i = 1, naps {
+			if (AP_BEAM(Memi[aps+i-1]) < 0)
+			    AP_SELECT(Memi[aps+i-1]) = NO
+		    }
+
+	    	    if (ap_getim (profs, Memc[str1], SZ_LINE) != EOF)
+			call strcpy (Memc[str1], Memc[profiles], SZ_FNAME)
+		    call sprintf (Memc[str], SZ_LINE,
+		        "Extract aperture spectra for %s?")
+	                call pargstr (Memc[image])
+		    if (ap_answer ("ansextract", Memc[str])) {
+			call sprintf (Memc[str], SZ_LINE,
+			    "Review extracted spectra from %s?")
+			    call pargstr (Memc[image])
+			if (ap_answer ("ansreview", Memc[str])) {
+			    call apgstr ("ansreview", Memc[str], SZ_LINE)
+			    call appstr ("ansreview1", Memc[str])
+			} else
+			    call appstr ("ansreview1", "NO")
+	                call ap_extract (Memc[image], Memc[output],
+			    Memc[format], Memc[profiles], Memi[aps], naps)
+		    }
+		}
+
+		# Fit apertures.
+		if (fit) {
+		    call sprintf (Memc[str], SZ_LINE,
+			"Fit apertures in %s?")
+	                call pargstr (Memc[image])
+		    if (ap_answer ("ansfit", Memc[str])) {
+	                call ap_extract (Memc[image], Memc[output],
+			    Memc[format], nullstr, Memi[aps], naps)
+		    }
+		}
+
+		# Normalize apertures.
+		if (norm) {
+		    call sprintf (Memc[str], SZ_LINE,
+			"Normalize apertures in %s?")
+	                call pargstr (Memc[image])
+		    if (ap_answer ("ansnorm", Memc[str])) {
+			call sprintf (Memc[str], SZ_LINE,
+			    "Fit spectra from %s interactively?")
+			    call pargstr (Memc[image])
+			if (ap_answer ("ansfitspec", Memc[str])) {
+			    call apgstr ("ansfitspec", Memc[str], SZ_LINE)
+			    call appstr ("ansfitspec1", Memc[str])
+			} else
+			    call appstr ("ansfitspec1", "NO")
+	                call ap_extract (Memc[image], Memc[output],
+			    Memc[format], nullstr, Memi[aps], naps)
+		    }
+		}
+
+		# Flatten apertures.
+		if (flat) {
+		    call sprintf (Memc[str], SZ_LINE,
+			"Flatten apertures in %s?")
+	                call pargstr (Memc[image])
+		    if (ap_answer ("ansflat", Memc[str])) {
+			call sprintf (Memc[str], SZ_LINE,
+			    "Fit spectra from %s interactively?")
+			    call pargstr (Memc[image])
+			if (ap_answer ("ansfitspec", Memc[str])) {
+			    call apgstr ("ansfitspec", Memc[str], SZ_LINE)
+			    call appstr ("ansfitspec1", Memc[str])
+			} else
+			    call appstr ("ansfitspec1", "NO")
+	                call ap_extract (Memc[image], Memc[output],
+			    Memc[format], nullstr, Memi[aps], naps)
+		    }
+		}
+ 
+		# Substract scattered light.
+		if (scat) {
+		    if (ap_getim (scatout, Memc[str1], SZ_LINE) == EOF)
+		        Memc[str1] = EOS
+		    if (Memc[output] == EOS ||
+			streq (Memc[image], Memc[output])) {
+		        call mktemp ("tmp", Memc[str], SZ_LINE)
+	                call ap_scatter (Memc[image], Memc[str],
+			    Memc[str1], Memi[aps], naps, line)
+		        call imdelete (Memc[image])
+		        call imrename (Memc[str], Memc[image])
+		    } else
+	                call ap_scatter (Memc[image], Memc[output],
+			    Memc[str1], Memi[aps], naps, line)
+		}
+
+		# Make a aperture mask.
+		if (mask)
+		    call ap_mask (Memc[image], Memc[output], Memi[aps], naps)
+
+		# Fit noise.
+		if (noise)
+		    call ap_extract (Memc[image], nullstr,
+			Memc[format], nullstr, Memi[aps], naps)
+
+	    } then
+		call erract (EA_WARN)
+
+	    # Free memory.
+	    for (i = 1; i <= naps; i = i + 1)
+		call ap_free (Memi[aps+i-1])
+	    naps = 0
+	}
+
+	# Free memory and finish up.
+	call imtclose (input)
+	call imtclose (refs)
+	if (out != NULL)
+	    call imtclose (out)
+	if (profs != NULL)
+	    call imtclose (profs)
+	if (norm || flat)
+	    call ap_fitfree ()
+	if (scat) {
+	    if (scatout != NULL)
+	        call imtclose (scatout)
+	    call scat_free ()
+	}
+	call ap_gclose ()
+	call ap_trfree ()
+	call apcpset ()
+	call sfree (sp)
+end
+
+
+procedure ap_init (find, recenter, resize, edit, trace, extract, fit,
+	norm, flat, scat, mask, noise)
+
+bool	find, recenter, resize, edit, trace
+bool	extract, fit, norm, flat, scat, mask, noise
+
+pointer	sp, str
+bool	clgetb()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	if (find)
+	    call appans ("ansfind", find, find)
+	if (recenter)
+	    call appans ("ansrecenter", recenter, recenter)
+	if (resize)
+	    call appans ("ansresize", resize, resize)
+	if (edit)
+	    call appans ("ansedit", edit, false)
+	if (trace) {
+	    call appans ("anstrace", trace, trace)
+	    call appans ("ansfittrace", clgetb ("fittrace"), false)
+	}
+	if (extract) {
+	    call appans ("ansextract", extract, extract)
+            call appans ("ansreview", clgetb ("review"), false)
+	}
+	if (fit) {
+	    call appans ("ansfit", fit, fit)
+            call appstr ("ansreview1", "NO")
+	}
+	if (norm) {
+	    call appans ("ansnorm", norm, norm)
+	    call appans ("ansfitspec", clgetb ("fitspec"), false)
+            call appstr ("ansreview1", "NO")
+	}
+	if (flat) {
+	    call appans ("ansflat", flat, flat)
+	    call appans ("ansfitspec", clgetb ("fitspec"), false)
+            call appstr ("ansreview1", "NO")
+	}
+	if (scat) {
+	    call appans ("ansscat", scat, scat)
+            call appans ("anssmooth", clgetb ("smooth"), clgetb ("smooth"))
+            call appans ("ansfitscatter", clgetb ("fitscatter"), false)
+            call appans ("ansfitsmooth", clgetb ("fitsmooth"), false)
+	}
+	if (mask)
+	    call appans ("ansmask", mask, mask)
+	if (noise)
+            call appstr ("ansreview1", "NO")
+
+	if (extract || fit || norm || flat) {
+	    if (clgetb ("interactive"))
+	        call appstr ("ansclobber", "no")
+            else
+	        call appstr ("ansclobber", "NO")
+	}
+
+	call apgstr ("dbwrite", Memc[str], SZ_LINE)
+	if (clgetb ("interactive"))
+	    call appstr ("ansdbwrite", Memc[str])
+	else {
+	    if (Memc[str] == 'y' || Memc[str] == 'Y')
+	        call appstr ("ansdbwrite", "YES")
+	    else
+	        call appstr ("ansdbwrite", "NO")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/apextract/x_apextract.x b/noao/twodspec/apextract/x_apextract.x
new file mode 100644
index 00000000..47a5fc1a
--- /dev/null
+++ b/noao/twodspec/apextract/x_apextract.x
@@ -0,0 +1,15 @@
+task	apall		= t_apall,
+	apedit		= t_apedit,
+	apfind		= t_apfind,
+	apfit		= t_apfit,
+	apflatten	= t_apflat,
+	apmask		= t_apmask,
+	apnormalize	= t_apnorm,
+	aprecenter	= t_aprecenter,
+	apresize	= t_apresize,
+	apscatter	= t_apscatter,
+	apscript	= t_apscript,
+	apslitproc	= t_apslitproc,
+	apnoise		= t_apnoise,
+	apsum		= t_apsum,
+	aptrace		= t_aptrace
diff --git a/noao/twodspec/longslit/Revisions b/noao/twodspec/longslit/Revisions
new file mode 100644
index 00000000..e90bbb37
--- /dev/null
+++ b/noao/twodspec/longslit/Revisions
@@ -0,0 +1,1003 @@
+.help revisions Jun88 noao.twodspec.longslit
+.nf
+
+transform/trsetup.x
+transform/igsfit/igscolon.x
+fitcoords.par
+    1. The fitcoords fitting orders can not be set to less than 2.
+    2. There is an attempt to avoid divide by zero in trsetup.x.
+    (2/1/11, Valdes)
+
+=====
+v2.15
+=====
+
+transform/t_transform.x
+lscombine/t_lscombine.x
+    Replaced xt_mappm to yt_mappm thus supporting world coordinate pixel mask
+    matching.  (1/16/08, Valdes)
+
+=====
+V2.14
+=====
+
+=====
+V2.13
+=====
+
+transform/trsetup.x
+    Conversion between natural and log coordinates had precision problems.
+    The conversions are now done in double precision.  Added limits to
+    insure the interpolation coordinates for msivector remain in the
+    image.  (8/7/07, Valdes)
+
+transform/fcgetcoords.x
+    The previous change failed to reset the axis mapping which causes the
+    transformation from physical to logical to fail when the trace axis
+    is 2.  (6/14/06, Valdes)
+
+getdaxis.x
+    Put an error check to avoid an error when the WCS is 3D.  (9/22/05, Valdes)
+
+transform/igsfit/igsfit.x
+    The computation of the rms was not handling deleted points.
+    (7/14/05, Valdes)
+
+standard.par
+    The file needed to be updated for the changes in the task for supporting
+    IR reductions.  (9/10/04, Valdes)
+
+doc/fitcoords.hlp
+    Fixed wording.  (8/25/04, Cooke & Valdes)
+
+transform/fcgetcoords.x
+transform/icgsfit/igssolve.x
+    It is now possible to do a solution using a single column or line of
+    fiduciary points.  (8/25/04, Cooke & Valdes)
+
+========
+V2.12.2a
+========
+
+transform/t_transform.x
+    Fixed a typo nxin -> nyin.  (7/8/04, Valdes)
+
+lscombine/			+
+lscombine.par			+
+mkpkg
+x_longslit.x
+longslit.hd
+longslit.men
+longslit.cl
+doc/lscombine.hlp		+
+    1.  Added the new task LSCOMBINE to register and combine longslit data.
+    	This is a combination of the functions in TRANSFORM for resampling
+	and IMCOMBINE for combining.
+
+transform/trsetup.x		+
+transform/t_transform.x
+transform/transform.com
+transform/mkpkg
+transform.par
+doc/transform.hlp
+    1.  Added the parameters "minput" and "moutput".  This allows masks
+    	to be transformed using the same transformation as the data.  The
+	transformation procedures were modified to allow doing this
+	efficiently; i.e. doing it in parallel with the data transformation
+	using the same internal coordinate lookup maps.
+    2.  Added the parameter "blank" to allow setting the value for output
+    	pixels interpolated from outside the input image.  The value
+	INDEF produces the old behavior or extrapolating from the nearest
+	edge pixel in the input image.
+    3.  If no "fitnames" are specified the tasks now uses the WCS for
+    	defining the transformation.  This allows resampling dispersion
+	calibrated longslit data.
+    4.  The routines were restructured to allow calling the setup and
+    	resampling from another task such as LSCOMBINE.
+    (6/18/04, Valdes)
+
+=======
+V2.12.2
+=======
+
+longslit$transform/t_fceval.x	+
+longslit$transform/fceval.par	+
+longslit$doc/fceval.hlp		+
+longslit$transform/mkpkg
+longslit$x_longslit.x
+longslit$longslit.cl
+longslit$longslit.hd
+    New task to evaluate FITCOORDS solutions added.  (8/27/03, Valdes)
+
+longslit$transform/fcgetcoord.x
+    Features in the IDENTIFY database with zero weight are now ignored.
+    (7/22/02, Valdes)
+
+=======
+V2.12.1
+=======
+=====
+V2.12
+=====
+
+longslit$response.x
+    Fixed argument errors in calls to ic_g* routines.  (1/7/02, Valdes)
+
+longslit$transform/mkpkg
+    Added missing <mach.h> dependency for fcdlist.x  (12/13/01, MJF)
+
+longslit$response.x
+longslit$doc/response.hlp
+    Modified to update the fitting parameters to the parameter set.
+    (9/20/01, Valdes)
+
+longslit$doc/fitcoords.hlp
+    Added that 'p' works as unzoom.  (8/15/01, Valdes)
+
+longslit$transform/fcdlist.x
+    The check between a deleted point and the values read from the IDENTIFY
+    database are no tolerance checked.  See bug 485.  (8/15/01, Valdes)
+
+longslit$transform/t_transform.x
+    1.  Instead of using 50 sample points across the image for the sampled
+    inversion points the algorithm now sets a step near 10.  In the
+    former method the sampling would become too crude with larger
+    images.
+    2.  Formerly the inversion would quit after one or two iterations if
+    the point falls off the edge.  This can lead to bad interpolation at
+    the edges if the distortion and requested output samples outside the
+    input image.  The edge check has been removed.
+    (7/5/01, Valdes)
+
+longslit$doc/fitcoords.hlp
+    Added a description of the FITCOORDS database.  (4/24/00, Valdes)
+
+igsfit.x
+igsparams.x
+igscolon.x
+igsfit.com
+mkpkg
+    Added an RMS to the graph title and the :show command.
+    (3/9/00, Valdes)
+
+=========
+V2.11.3p1
+=========
+=========
+V2.11.3
+=========
+
+longslit$transform/mkpkg
+    Added missing dependency.  (10/11/99, Valdes)
+
+longslit$transform/t_transform.x
+    The REFSPEC keywords are now deleted if present.  (9/7/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+longslit$transform/
+longslit$transform/fcgetcoords.x
+    Added an error check for there only being one line or column measured.
+    (7/21/99, Valdes)
+
+longslit$transform/igsfit/igsfit.x
+    Added an error check for an error in the fitting.  (7/21/99, Valdes)
+
+transform/t_transform.x
+    Updated for new interpolation types.  (1/4/99, Valdes)
+
+=======
+V2.11.1
+=======
+
+transform/fcgetcoords.x
+    Add an errchk on immap.  Without this the task would give a segmentation
+    violation if for some reason it could not open the image section given
+    in the identify database.  For example if the image was not present.
+    (11/20/98, Valdes)
+
+longslit.cl
+    aidpars was incorrectly defined to be aidpars.cl instead of aidpars.par.
+    (11/18/97, Valdes)
+
+=====
+V2.11
+=====
+
+response.x
+    The previous change had a typo in line 264 where the index should be
+    j and not i.  (7/10/97, Valdes)
+
+=========
+V2.11Beta
+=========
+
+response.x
+doc/response.hlp
+    Change the behavior of the task with respect to the threshold parameter
+    to agree with the help page.  Previously it replaced values below
+    the threshold by the threshold value in both the normalization and
+    the data prior to dividing.  The result would not be a unit response
+    unless both the data and normalization were below the threshold.
+    The new behavior gives a unit response if either the normalization
+    or data are below the threshold.  The help page was slightly
+    modified to make the behavior even clearer.  (5/15/97, Valdes)
+
+doc/response.help
+    Fixed formating typo.  (5/15/97, Valdes)
+
+reidentify.par
+    Change default threshold value to 0. (4/22/97, Valdes)
+
+doc/fluxcalib.hlp
+    Fixed missing task name in revisions section.  (4/22/97, Valdes)
+
+demos$mktest.cl
+demos$mktestt.cl
+    Made the ARTDATA package parameters explicit.  (4/15/97, Valdes)
+
+transform/fitcoords.x
+transform/fcfitcoords.x
+transform/fcgetcoords.x
+transform/mkpkg
+    Added error checking for missing database, missing database file,
+    no coordinates, all INDEF coordinates.  (2/21/96, Valdes)
+
+doc/illumination.hlp
+    Fixed a formating error (font change).  (10/15/96, Valdes)
+
+transform/fcgetcoords.x
+    A rotated WCS is ignored in the same way as IDENTIFY.
+    (1/4/96, Valdes)
+
+=======
+V2.10.4
+=======
+
+doc/response.hlp
+doc/illumination.hlp
+doc/extinction.hlp
+doc/fluxcalib.hlp
+    Added note that DISPAXIS refers to the original dispersion axis in
+    transposed images.  (7/31/95, Valdes)
+
+longslit.cl
+longslit.men
+    Added the new SFLIP task to the package.  (7/18/94, Valdes)
+
+transform/t_transform.x
+    The last interval of the inversion surface could be distorted by the
+    limitation of the inversion coordinats to be within the input image.
+    This limit was removed (with the out of bounds checking taking place
+    later).  (9/19/93, Valdes)
+
+============
+V2.10.3 beta
+============
+
+transform/fcgetcoords.x
+transform/t_transform.x
+    Modified to allow transposed axes.  (5/14/93, Valdes)
+
+getdaxis.x	+
+response.x
+illumination.x
+extinction.x
+fluxcalib.x
+transform/t_transform.x
+    Access to the dispersion axis is now through the routine get_daxis.  This
+    routine checks for transposed images.  (5/14/93, Valdes)
+
+longslit.men
+longslit.par
+longslit.cl
+standard.par +
+sensfunc.par +
+calibrate.par +
+identify.par -
+reidentify.par
+demos$test.cl
+demos$xgtest.dat +
+demos$gtest.dat -
+demos$xtest.dat -
+    1.  Added commonly used tasks from the ONEDSPEC package.
+    2.  Added additional package paraemters required by the ONEDSPEC tasks.
+    3.  Modified the test playback for the new package and XGTERM.
+    4.  Removed playbacks for XTERM and GTERM.
+    (2/12/93, Valdes)
+
+transform/fcgetcoords.x
+    If the combine option is used and the images do not all have the same
+    fit axis then a segmentation error would occur because of a mistake
+    in where the MWCS and IMIO pointers are closed.  This was fixed
+    and a warning message added.  (12/7/92, Valdes)
+
+transform/fcgetcoords.x
+    Features with INDEF user values are now excluded.
+    (11/11/92, Valdes)
+
+transform/t_transform.x
+    Added DCLOG1 keyword.  This goes along with the changes in DISPCOR
+    to allow multiple dispersion corrections.  (10/19/92, Valdes)
+
+fluxcalib.x
+    Loosened the wavelength limit checks so that an warning is only given
+    if the image wavelengths extend outside the calibration wavelengths
+    by more than a half pixel.  (9/10/92, Valdes)
+
+demos/* +
+longslit.cl
+longslit.men
+    Added a demos task with a test playback.  (7/24/92, Valdes)
+
+=======
+V2.10.2
+=======
+
+=======
+V2.10.1
+=======
+
+=======
+V2.10.0
+=======
+
+transform/t_transform.x
+    It was possible to end up with too few lines for MSIFIT.  A minimum
+    buffer size is now enforced.  (6/18/92, Valdes)
+
+transform/t_transform.x
+    Modified to use MWCS.  (5/20/92, Valdes)
+
+=====
+V2.10
+=====
+
+longslit$fluxcalib.x
+longslit$doc/fluxcalib.hlp
+    The output pixel type is now of type real.  If the input image is
+    to be modified the calibration is done on a temporary image and
+    renamed to the input image upon completion rather than being done
+    in place.  Previously, flux calibrating a type short image would
+    produce an image of all zeros.  (3/19/92, Valdes)
+
+longslit$longslit.par
+    Added observatory to package parameters.
+    (2/6/92, Valdes)
+
+longslit$transform/fcgetcoords.x
+    In V2.10 IDENTIFY/REIDENTIFY measure feature positions in physical
+    coordinates while FITCOORDS and TRANSFORM require logical coordinates.
+    Therefore, the IDENTIFY database coordinates are transformed to
+    logical coordinates when they are read.  (12/20/91, Valdes)
+
+longslit$transform/igsfit/igsfit.x
+    Removed the print statement about fitting because this caused the graphics
+    to be overplotted on the previous graph for some unknown reason.
+    (12/12/91, Valdes)
+
+longslit$doc/extinction.hlp
+longslit$doc/fluxcalib.hlp
+longslit$doc/illumination.hlp
+longslit$doc/response.hlp
+    Added discussion and example about the DISPAXIS keyword.  (12/6/91, Valdes)
+
+longslit$t_transform.x
+    Fixed datatype declaration error for array tmp.  This was a harmless
+    error.  (11/21/91, Valdes)
+
+longslit$longslit.par
+longslit$response.x
+longslit$illumination.x
+longslit$fluxcalib.x
+longslit$extinction.x
+longslit$transform/t_transform.x
+    1.  Added dispaxis parameter to package parameters.
+    2.  Modified all routines to use package dispaxis if not found in image
+	all also write it to header.  (8/28/91, Valdes)
+
+longslit$transform/t_transform.x
+    Removed W0 and WPC from output image.  (8/28/91, Valdes)
+
+longslit$transform/igsfit/igssolve.x
+    The case of a single trace along x handled by igs_solve3 was using the
+    yorder instead of the xorder in one place.  (7/11/91, Valdes)
+
+longslit$transform/t_transform.x
+    The interative inversion was made more stable by using a fudge factor.
+    This was needed to make the LONGSLIT test procedure work on HPUX.
+    (9/17/90, Valdes)
+
+longslit$identify.par
+longslit$reidentify.par
+    Updated parameter files for the new version.  (8/23/90, Valdes)
+
+longslit$transform/t_transform.x
+    Changed the computation of the output grid from a cumulative addition of
+    the pixel increment to a direct calculation to avoid cumulative
+    round off errors in high resolution data. (7/19/90, Valdes)
+
+longslit$doc/lslit.ms +
+    Added copy of the SPIE paper on the LONGSLIT package.  It is in MS TROFF
+    format.  Postscript copies may be obtained from the FTP archive.
+    (7/4/90, Valdes)
+
+====
+V2.9
+====
+
+longslit$transform/igsfit
+longslit$transform/t_transform.x
+longslit$fluxcalib.x
+longslit$extinction.x
+    Added use of CD keywords in addition to CDELT.  (3/8/90, Valdes)
+
+longslit$transform/igsfit/igsfit.x
+    1.  Changed incorrect usage of abscissa/ordinate.
+    2.  Cleared prompts after input.
+    (3/6/90, Valdes)
+
+longslit$transform/fcgetcoords.x
+    Fixed problem in which database files where opened within a loop but
+    only closed once outside a loop.  (5/6/89, Valdes - reported by Schaller)
+
+longslit$illumination.x
+    1.  Added error checking to handle missing DISPAXIS keyword.
+    2.  Changed to dynamically allocated strings.
+    (2/28/89, Valdes)
+ 
+longslit$ilsetbins.x
+    1.  The "bins" string is now checked for null after stripping any
+	leading whitespace with xt_stripwhite.
+    2.  The ":bins" command with no argument will not clear the bins now.
+    3.  An error message is printed if two many sky bins are defined
+	using the cursor.
+    (1/26/89, Valdes)
+ 
+longslit$fluxcalib.x
+    1.  Changed CRPIXn keyword and variable to type real.
+    2.  Added the ONEDSPEC flag for flux calibration.
+    (1/26/89, Valdes)
+ 
+longslit$response.x
+longslit$illumination.x
+    Added header keywords CCDMEAN and MKILLUM for compatibility with CCDRED.
+    (12/14/88 Valdes)
+
+longslit$transform/t_transform.x
+    Changed the computation of x1, x2 and y1, y2 to natural units if logx and
+    logy were set to yes. These numbers were being erroneously computed in
+    log units leading to an erroneous transformation if the user specified the
+    coordinate limits with x1,nx,dx and y1,ny,dy. (10/26/88 Davis)
+
+longslit$t_longslit.x
+    Changed the units of w0 to be log (w0) if log=yes. (9/21/88 Davis)
+
+longslit$ilsetbins.x
+longslit$transform/igsfit/igsfit.x
+noao$lib/scr/ilsetbins.key
+noao$lib/scr/igsfit.key
+    Added 'I' interrupt key.  (4/20/88 Valdes)
+
+longslit$mkpkg
+longslit$longslit.cl
+longslit$x_longslit.x
+longslit$transform/mkpkg
+longslit$transform/igsfit/mkpkg
+longslit$transform/x_transform.x -
+longslit$transform/libpkg.a -
+longslit$transform/fitcoords.par -> longslit$fitcoords.par
+longslit$transform/transform.par -> longslit$transform.par
+    Merged tranform executable with the longslit executable.  (4/7/88 Valdes)
+
+longslit$transform/extinction.x
+    Was incorrectly doing in place correction.  (3/24/88 Valdes)
+
+longslit$ilsetbins.x
+    Increased bin string from SZ_LINE to 2048 chars.  Some users have attempted
+    to define a large number of bins which fails when the string limit is
+    reached. (1/4/88 Valdes)
+
+longslit$transform/fluxcalib.x
+    Was incorrectly doing in place correction.  (11/5/87 Valdes)
+
+longslit$transform/transform.x -
+longslit$transform/trtransform.x -
+longslit$transform/trgetsurface.x -
+longslit$transform/trsftomsi.x -
+longslit$transform/trsetoutput.x -
+longslit$transform/t_transform.x +
+longslit$doc/transform.hlp
+    The task TRANSFORM in  the  LONGSLIT  package  is  used  to
+    interpolate images  onto a user defined coordinate system given as
+    surface functions U(X,Y)  and  V(X,Y)  where  (X,Y)  are  the
+    untransformed  image  pixel coordinates  and  (U,V) are the user
+    coordinates.  The surface functions are derived from a set of measured
+    points  using  the  task  FITCOORDS.  With  Version  2.6  of  IRAF
+    the  algorithm  used  to  invert  the user coordinate surfaces, U(X,Y)
+    and V(X,Y) --> X(U,V) and Y(U,V),  has  been changed.   Previously,
+    surfaces  function  of  comparable  order to the original surfaces were
+    fit to a grid of points,  i.e.  (U(X,Y),  V(X,Y), X)  and (U(X,Y),
+    V(X,Y), Y), with the same surface fitting routines used in FITCOORDS to
+    obtain the input user coordinate surfaces.  This  method of  inversion
+    worked  well in all cases in which reasonable distortions and
+    dispersions were used.  It was selected because  it  was  relatively
+    fast.   However,  it  cannot  be  proved  to  work  in all cases; in
+    one instance in  which  an  invalid  surface  was  used  the
+    inversion  was actually  much poorer than expected.  Therefore, a more
+    direct iterative inversion algorithm is  now  used.   This  is
+    guaranteed  to  give  the correct  inversion  to  within a set error
+    (0.05 of a pixel in X and Y).  It is slightly slower than the previous
+    algorithm but it  is  still  not as major a factor as the image
+    interpolation itself.
+
+    The  event  which  triggered  this  change was when a user
+    misidentified some arc lines.  The dispersion function which was
+    forced  to  fit  the misidentified   lines   required  curvatures  of
+    a  couple  of  hundred angstroms over 100 pixels at a dispersion of
+    10  angstroms  per  pixel.  It  was  possible  to do this to the user's
+    satisifaction with a surface function of xorder=6 and yorder=7.
+    TRANSFORM inverts  this  surface  by fitting  a  function  with the
+    same orders (it uses a minimum of order 6 and the order of the  input
+    surface  function).   The  transformed  arc image  was  then examined
+    and found to have residual wavelength errors 5 times larger expected
+    from the residuals  in  the  dispersion  solution.  With  such  a
+    large  curvature  in  the  dispersion surface function it turned out
+    that to  maintain  errors  at  the  same  level  the  fitting function
+    required  orders of 12.  (To determine this required a special version
+    of TRANSFORM  and  the  new  double  precision  surface  fitting
+    routines).   When  the  lines  were  correctly identified the
+    dispersion function had much lower curvatures and required lower orders
+    in the  fit and  gave a good transformation of the arc image.  The
+    conclusions drawn from this event are:
+
+    1. An incorrect dispersion solution can appear  to  be  correct  if
+    the misidentified lines are at the end and a high enough order is
+    used.
+
+    2.   This  requires  high  order  surface  functions  in  FITCOORDS
+    and TRANSFORM.
+
+    3.  The algorithm used in TRANSFORM  in  V2.5  and  earlier,  while
+    not failing,  does  give  unexpectly  large  residuals in the
+    linearized arc spectrum in this case.  A cautious user should transform
+    arc images  and examine them.
+
+    4.   In  the  future  a more direct inversion algorithm is guaranteed
+    to give residuals in the transform consistent with  the  residuals  in
+    the dispersion solution even when the dispersion function is not
+    realistic.
+    (9/14/87 Valdes)
+
+longslit$transform/trgetsurface.x
+longslit$transform/fcfitcoords.x
+longslit$transform/fcdbio.x
+longslit$transform/trsftomsi.x
+longslit$transform/trsetoutput.x
+longslit$transform/igsfit/igsfit.x
+longslit$transform/igsfit/igscolon.x
+longslit$transform/igsfit/igssolve.x
+longslit$transform/igsfit/igsget.x
+longslit$transform/igsfit/xgs.x +
+    Modified routines using the GSURFIT routines to call an interface routine
+    which allows calling the double precision versions of these procedures
+    without changing the single precision data arrays (a double precision
+    copy is made within the interface).  Thus, FITCOORDS and TRANSFORM now
+    use double precision arithmetic when doing surface fitting and evaluating.
+    This removes the problems experienced with high order surfaces.
+    (8/14/87 Valdes)
+
+longslit$transform/igsfit/igsfit.x
+longslit$transform/igsfit/igsget.x
+longslit$transform/igsfit/igscolon.x
+longslit$doc/fitcoords.hlp
+noao$lib/scr/igsfit.key
+    Added a listing of the fitted surface values at the corners of the
+    image.  This allows evaluating the fit. (8/8/87 Valdes)
+
+longslit$transform/fitcoords.x
+    Added check against using blanks in fitname prefix instead of null
+    file. (7/3/87 Valdes)
+
+====
+V2.5
+====
+
+longslit$extinction.x
+longslit$extinction.par
+longslit$doc/extinction.hlp
+    Valdes, May 26, 1987
+    1.  EXTINCTION now uses the same extinction files used by the ONEDSPEC
+	package.
+    2.  The parameter name for the extinction file has been changed from
+	"table" to "extinction" to be consistent with the ONEDSPEC parameter.
+    3.  The help page was updated.
+
+longslit$longslit.cl
+longslit$identify.par +
+longslit$reidentify.par +
+    Valdes, April 16, 1986
+    1.  Parameters for IDENTIFY and REIDENTIFY are now separate for the
+	LONGSLIT package.
+
+longslit$fluxcalib.x
+    Valdes, March 16, 1987
+    1.  A reference off the end of the sensitivity image due to an error
+	in a do loop index was fixed.
+
+longslit$transform/trtransform.x
+    Valdes, February 26, 1987
+    1.  Add a warning if the header parameter DISPAXIS is not found.  This
+	affects whether coordinate information for ONEDSPEC is produced.
+
+longslit$*.x
+    Valdes, February 17, 1987
+    1.  Required GIO changes.
+
+longslit$transform/igsfit/igsdelete.x
+longslit$transform/igsfit/igsundelete.x
+    Valdes, October 16, 1986
+    1.  Real line type specified in gseti call changed to integer.
+	This caused a crash on AOS/IRAF.
+
+longslit$doc/fluxcalib.hlp
+    Valdes, October 8, 1986
+    1.  Added a short paragraph discussing calibration of logarithmicly
+	binned spectra.
+
+longslit$response.x
+longslit$response.par
+longslit$doc/response.hlp
+    Valdes, August 18, 1986
+    1.  RESPONSE was modified to allow separately specifying the image
+	section to be used to determine the response (the numerator)
+	and the image section used to derive the normalization spectrum
+	(the denominator).  The help page was also modified.
+
+====================================
+Version 2.3 Release, August 18, 1986
+====================================
+
+longslit$doc:  Valdes, July 9, 1986
+    1.  Help page and menu file (noao$lib/scr/ilsetbins.key) for ILLUMINATION
+	were updated since they mention colon commands which do not exist.
+    2.  Help page for EXTINCTION updated to reflect new name for extinction
+	file.
+    3.  Date of help page for FITCOORDS updated to because of new window
+	command.
+
+longslit$fitcoords.x:  Valdes, July 7, 1986
+    1.  Keys 'a' and 'e' replaced with the general 'w' window package.
+    2.  Help page updated.
+
+longslit$response.x, illumination.x:  Valdes, July 3, 1986
+    1.  RESPONSE and ILLUMINATION modified to use new ICFIT package.
+
+transform/fitcoords.x,fcgetcoords.x,fcgetim.x: Valdes, July 1, 1986
+    1.  Added routine to remove image extensions.  This was necessary
+	to prevent having two legal image names and to avoid creating
+	database files with the image extensions.
+
+=====================================
+STScI Pre-release and SUN 2.3 Release
+=====================================
+
+longslit$illumination.x:  Valdes, June 17, 1986:
+    1.  It was possible to request a higher order image interpolator
+	than the number of bins being interpolated causing an error.
+	A check was added to use a lower order interpolator if the
+	number of bins is too small.
+
+longslit$*.ext; Valdes June 2, 1986
+    1.  Moved the extinction data files to "noao$lib/onedstds/".
+	Modified the parameter file for EXTINCTION appropriately.
+
+longslit$fluxcalib.x:  Valdes, May 13, 1986
+    1.  Modified FLUXCALIB to allow any combination of log or linear wavelength
+	coordinates for the input image and the sensitivity image.
+
+longslit$fluxcalib.x:  Valdes, May 1, 1986
+    1.  Modified FLUXCALIB to use image templates instead of file templates.
+
+longslit$tranform/transform.par: Valdes, May 1, 1986
+    1.  Changed default value of parameter database to "database" from
+	"identify.db"
+    2.  Changed help page to reflect change in default parameter.
+
+longslit$tranform/transform.x: Valdes, April 21, 1986
+    1.  Task TRANSFORM crashed when flux conservation was turned off.  This
+	was caused at the end by attempting to free memory allocated for
+	flux conservation.  The transformed image is still ok.  This
+	bug has been fixed.
+    2.  Help page for TRANSFORM updated to include timing information.
+
+longslit$ilsetbins.x: Valdes, April 7, 1986
+    1.  Fixed use of STRIDX with a character constant to STRIDXS.
+
+longslit: Valdes, Mar 24, 1986
+    1.  RESPONSE, ILLUMINATION, EXTINCTION, and FLUXCALIB modified to
+	fix history writing bug.
+
+longslit: Valdes, Mar 21, 1986
+    1.  APDEFINE, APEXTRACT, and SETIMHDR removed from this package.
+    2.  APDEFINE, APEXTRACT, and SETIMHDR help pages removed.
+    3.  LONGSLIT menu revised.
+
+longslit$response.x: Valdes, Mar 20, 1986
+    1.  There was a bug in RESPONSE which turned the interactive fitting
+	off if the answer was only "no" instead of "NO".  This has been
+	fixed.
+    
+longslit$illumination.x:  Valdes, Mar 11, 1986
+    1.  ILLUMINATION has a new parameter for the interpolation type.
+    2.  The help page for ILLUMINATION has been updated
+
+===========
+Release 2.2
+===========
+From Valdes Feb 11, 1986:
+
+1.  APEXTRACT sets the BEAM_NUM beam number to zero for all extractions.
+The aperture numbers are used to generate the record extensions.
+------
+From Valdes Feb 7, 1986:
+
+1.  Images package loaded with longslit.
+------
+From Valdes Feb 3, 1986:
+
+1.  Fixed bug in setting the aperture number in APDEFINE.  It was interpreting
+the input value as a real number and storing it in an integer variable.
+------
+From Valdes Jan 23, 1986:
+
+1.  Buffering limits removed in TRANSFORM.
+
+2.  Bug fixed in coordinate setting in TRANSFORM.
+
+3.  Bug fixed in undeleting points in FITCOORDS.
+------
+From Valdes Jan 3, 1986:
+
+1.  FITCOORDS has been modified.  The 'z' zoom option now queries for
+the type of zoom.  The types are feature, constant x, constant y, and
+constant z.  This allows examining dispersion solutions at different
+columns or lines.
+------
+From Valdes Nov 20, 1985:
+
+1.  TRANSFORM now exits with an error if a database record is not found
+rather than giving a warning and continuing on.
+------
+From Valdes Nov 15, 1985:
+
+1.  FITCOORDS and TRANSFORM modified to use directory/text databases
+rather than single text databases.  This new database structure is what
+is now created by IDENTIFY and REIDENTIFY.
+------
+From Valdes Nov 7, 1985:
+
+1.  The task MKSCRIPT has been made a basic system task.  It is no longer
+loaded in the LONGSLIT package but is always available.
+------
+From Valdes Nov 1, 1985:
+
+1.  New task MKSCRIPT has been added.  It is loaded out of the IMRED.GENERIC
+package.  See the help page for the task and the revisions for GENERIC.
+
+2.  Task FITCOORDS has been modified in several ways:
+	a.  The images in a list of images can be fit separately or
+	    combined into a single fit based on the value of the parameter
+	    COMBINE.
+	b.  Points delete interactively are recorded in a deletion list
+	    and may be used in subsequent fits.
+	c.  The last interactive plot or a default non-interactive plot
+	    is recorded in a plotfile (if specified).  The plots in the
+	    plot file can be spool or examined after the fact.
+
+See the new help for this task.
+------
+From Valdes Oct 22, 1985:
+
+1.  New parameter "exposure" in FLUXCALIB.  This parameter specifies the
+image header keyword corresponding to the exposure time to be used in
+calibrating the images.
+
+2.  FLUXCALIB and EXTINCTION have been changed to take a list of input
+images and a list of output images.  The output images may be the same
+as the input images.
+------
+From Valdes Oct 4, 1985:
+
+1.  Response and illumination modified to include the parameters for
+low and high rejection and rejection iteration.
+------
+From Valdes Oct 1, 1985:
+
+1.  The package has been reorganized.  Task extract has been moved to
+a new package twodspec.echelle.  The source code for identify and reidentify,
+which are actually one dimensional tools, have been moved to the onedspec
+package though they are still loaded with the twodspec package.
+
+2.  New task fluxcalib flux calibrates long slit images using the flux
+calibration file produced by onedspec.sensfunc.
+
+3.  Illumination can now handle using a single illumination bin.
+
+4.  Task revisions renamed to revs.  Note that this is a temporary task.
+------
+From Valdes September 25, 1985:
+
+1.  New task setimages added.  This task sets parameters in the image headers
+defining the dispersion axis and, optionally, strings for the coordinate
+types and coordinate units.  This strings, if defined, are used in other
+tasks for identifying and labeling graphs.
+
+2.  Because the dispersion axis is now defined in the header the axis
+parameter in tasks response and illumination have been removed.
+
+3.  Task transform now adds coordinate information to the image headers.
+
+4.  New task extinction corrects images for extinction.
+
+------
+From Valdes September 23, 1985:
+
+1.  Reidentify has been significantly speeded up when tracing a 2D image
+by eliminating most database accesses.
+------
+From Valdes August 6, 1985:
+
+1.  A bug in the absorption feature centering was fixed.
+2.  Numerous cosmetic changes in the graphics are being made.  These will
+be documented later.
+------
+From Valdes August 1, 1985:
+
+1.  The icfit package has been modified to allow resetting the x and
+y fitting points with keys 'x' and 'y'.  This is useful in identify
+to reset the user coordinates directly in the fitting package.
+
+2.  The :features command in identify now takes an (optional) file name
+directing the feature information to the specified file.  Without a
+file the terminal is cleared and the information written to the terminal
+with a pause at the end.  With a file name the information is appended to
+the specified file.
+
+3.  A couple of small bugs in the handling of INDEF user coordinates in
+identify have been fixed.
+
+4.  The default pixel range in the icfit package when called from identify
+is now the full image range rather than the range of points to be fit.
+
+5.  The image section in identify is now used with :image just as it is
+used for images given as arguments to the task.  Explicit image sections
+must be given, however, in database :read and :write because the optional
+names to these commands need not be image names.
+------
+From Valdes July 30, 1985:
+
+1.  The tasks lsmap, lstrans, and reidentify have been changed so that
+the user may specify a list of log files instead of just one logfile.
+Now it is possible to have log output be written to the terminal
+as well as a disk file.  This is now the default.
+------
+From Valdes July 27, 1985:
+
+1.  The default user coordinate when marking a feature in identify
+is the pixel coordinate if there is no coordinate function.
+
+2.  When entering a user coordinate in identify after a (m)ark or
+(u)ser key the coordinate typed by the user is matched against the
+line list and the line list value substituted if a match is found.
+Thus, for wavelengths the user only needs to enter the wavelength to
+the nearest Angstrom and the decimal part will be found from the 
+coordinate list.
+
+3.  Response and illumination have been modified to work along either
+image axis.  A new parameter "axis" has been added to select the
+axis.  For response the axis should be along the dispersion (default
+is along the columns) and in illumination the axis is that slit position
+axis (the default is along the lines).  These changes in conjunction
+with the new flat1d, fit1d, and background make the orientation of the
+longslit images arbitrary!
+
+4.  The values in the default parameter files for response, illumination,
+identify, reidentify, lsmap, and lstrans have been changed.  This will
+cause user parameter files to be out of date.  Sorry about that.
+------
+From Valdes July 26, 1985:
+
+1.  Background has been modified to use new fit1d task.  It now does
+column backgrounds without transposes and allows image sections.
+------
+From Valdes July 23, 1985:
+
+1.  Task lsrevisions has been renamed to revisions.  The intent is that
+each package will have a revisions task.  Note that this means there may
+be multiple tasks named revisions loaded at one time.  Typing revisions
+alone will give the revisions for the current package.  To get the system
+revisions type system.revisions.
+
+2.  Background now does both line and column backgrounds.
+______
+July 18, 1985:
+
+1.  Help page for extract is available.
+2.  Help page for lsrevisions is available.
+______
+July 17, 1985:
+
+1.  Extract has been modified to allow interactively setting the
+extraction limits for each trace.  If this is not needed then answer
+NO to the query.  Any changes made in lower and upper remain
+in effect to subsequent traces.  The lower and upper limits are written
+to the database.  Older database tracings are still useable as before.
+______
+July 16, 1985:
+
+1. A new task, lsrevisions, has been added to record revisions to the
+beta test version of the package.
+
+2. A help page for identify is now available!
+
+3. A default one dimensional image section is available in the tasks
+identify, reidentify, and extract.  This allows use of two dimensional
+images (without an image section) to be used without bothering with
+the image section.  It is also a little more general than regular image
+sections in that a special format in terms of lines or columns can be given.
+The default section is the "middle line".
+
+4. Extract has been changed to allow:
+
+	a. Recording the traced curves.
+	b. Using the traced curves from one image to extract from another image.
+    
+This is done by having three query parameters giving the name of the
+image to be traced or which was previously traced, a list of input
+images from which to extract, and a list of output rootnames
+one for each input image.
+
+
+.:
+total 4520
+-rw-r--r--    1 valdes   iraf         1423 Sep 24  1985 airmass.x
+-rw-r--r--    1 valdes   iraf          245 Oct 22  1985 fluxcalib.par
+-rw-r--r--    1 valdes   iraf          659 Nov 18  1985 fitcoords.par
+-rw-r--r--    1 valdes   iraf          879 Mar 13  1986 illumination.par
+-rw-r--r--    1 valdes   iraf         3108 Jun  2  1986 lstools.x
+-rw-r--r--    1 valdes   iraf          800 Aug 18  1986 response.par
+-rw-r--r--    1 valdes   iraf          183 May 26  1987 extinction.par
+-rw-r--r--    1 valdes   iraf         5297 Feb  3  1989 ilsetbins.x
+-rw-r--r--    1 valdes   iraf          493 Feb 12  1993 calibrate.par
+-rw-r--r--    1 valdes   iraf          950 Feb 12  1993 sensfunc.par
+-rw-r--r--    1 valdes   iraf          758 Feb 12  1993 standard.par
+-rw-r--r--    1 valdes   iraf          496 Feb 12  1993 longslit.par
+-rw-r--r--    1 valdes   iraf         8574 May 14  1993 fluxcalib.x
+-rw-r--r--    1 valdes   iraf          690 May 14  1993 getdaxis.x
+-rw-r--r--    1 valdes   iraf        10216 May 14  1993 illumination.x
+-rw-r--r--    1 valdes   iraf         5996 May 14  1993 extinction.x
+-rw-r--r--    1 valdes   iraf         1567 Jul 21  1997 reidentify.par
+drwxr-xr-x    2 valdes   iraf         4096 Aug 12  1999 demos
+-rw-r--r--    1 valdes   iraf         9206 Jan  7  2002 response.x
+-rw-r--r--    1 valdes   iraf          171 Aug 27  2003 fceval.par
+-rw-r--r--    1 valdes   iraf        30895 Aug 27  2003 Revisions
+-rw-r--r--    1 valdes   iraf          212 Jun 10 14:38 x_longslit.x
+-rw-r--r--    1 valdes   iraf        12252 Jun 10 14:38 x_longslit.o
+-rw-rw-r--    1 valdes   iraf        17479 Jun 15 16:16 xtpmmap.x
+-rw-rw-r--    1 valdes   iraf         3240 Jun 16 11:30 xtmaskname.x
+-rw-r--r--    1 valdes   iraf        13080 Jun 16 11:43 xtmaskname.o
+-rw-r--r--    1 valdes   iraf        46608 Jun 16 11:43 xtpmmap.o
+-rw-r--r--    1 valdes   iraf          841 Jun 16 11:49 transform.par
+-rw-r--r--    1 valdes   iraf          804 Jun 16 17:12 mkpkg
+drwxr-xr-x    3 valdes   iraf         4096 Jun 16 17:53 transform
+-rw-r--r--    1 valdes   iraf      1613602 Jun 16 18:06 libpkg.a
+-rwxr-xr-x    1 valdes   iraf      2714998 Jun 16 18:06 xx_longslit.e
+drwxrwxr-x    3 valdes   iraf         4096 Jun 18 16:07 lscombine
+-rw-r--r--    1 valdes   iraf         2331 Jun 18 16:25 lscombine.par
+drwxr-xr-x    2 valdes   iraf         4096 Jun 18 16:50 doc
+-rw-r--r--    1 valdes   iraf          376 Jun 18 16:50 longslit.hd
+-rw-r--r--    1 valdes   iraf         1499 Jun 18 16:51 longslit.men
+-rw-r--r--    1 valdes   iraf          776 Jun 18 16:52 longslit.cl
diff --git a/noao/twodspec/longslit/airmass.x b/noao/twodspec/longslit/airmass.x
new file mode 100644
index 00000000..d47fab2d
--- /dev/null
+++ b/noao/twodspec/longslit/airmass.x
@@ -0,0 +1,60 @@
+include	<math.h>
+
+# IMG_AIRMASS -- Get or compute the image airmass from the image header.
+# If the airmass cannot be determined from header then INDEF is returned.
+#
+# Airmass formulation from Allen "Astrophysical Quantities" 1973 p.125,133
+# and John Ball's book on Algorithms for the HP-45.
+
+real procedure img_airmass (im)
+
+pointer	im			# IMIO pointer
+
+real	airmass, zd, ha, ra, dec, st, latitude, coszd, scale, x
+
+int	imaccf()
+real	imgetr()
+errchk	imgetr()
+
+data	scale/750.0/		# Atmospheric scale height approx
+
+begin
+	# If the airmass is in the header return its value.
+
+	if (imaccf (im, "airmass") == YES)
+	    return (imgetr (im, "airmass"))
+
+	# Compute zenith distance if not defined.
+
+	iferr (zd = imgetr (im, "zd")) {
+	    
+	    # Compute hour angle if not defined.
+
+	    iferr (ha = imgetr (im, "ha")) {
+		st = imgetr (im, "st")
+		ra = imgetr (im, "ra")
+		ha = st - ra
+		call imaddr (im, "ha", ha)
+	    }
+	
+	    dec = imgetr (im, "dec")
+	    latitude = imgetr (im, "latitude")
+
+	    ha = DEGTORAD (ha) * 15
+	    dec = DEGTORAD (dec)
+	    latitude = DEGTORAD (latitude)
+	    coszd = sin (latitude) * sin (dec) +
+		cos (latitude) * cos (dec) * cos (ha)
+	    zd = RADTODEG (acos (coszd))
+	    call imaddr (im, "zd", zd)
+	}
+
+	# Compute airmass from zenith distance.
+
+	zd = DEGTORAD (zd)
+	x = scale * cos (zd)
+	airmass = sqrt (x ** 2 + 2 * scale + 1) - x
+	call imaddr (im, "airmass", airmass)
+
+	return (airmass)
+end
diff --git a/noao/twodspec/longslit/calibrate.par b/noao/twodspec/longslit/calibrate.par
new file mode 100644
index 00000000..4cf9f810
--- /dev/null
+++ b/noao/twodspec/longslit/calibrate.par
@@ -0,0 +1,11 @@
+# CALIBRATE parameter file
+
+input,s,a,,,,Input spectra to calibrate
+output,s,a,,,,Output calibrated spectra
+extinct,b,h,yes,,,Apply extinction correction?
+flux,b,h,yes,,,Apply flux calibration?
+extinction,s,h,"onedstds$kpnoextinct.dat",,,Extinction file
+observatory,s,h,)_.observatory,,,Observatory of observation
+ignoreaps,b,h,yes,,,Ignore aperture numbers in flux calibration?
+sensitivity,s,h,"sens",,,Image root name for sensitivity spectra
+fnu,b,h,no,,,Create spectra having units of FNU?
diff --git a/noao/twodspec/longslit/demos/demoarc1.dat b/noao/twodspec/longslit/demos/demoarc1.dat
new file mode 100644
index 00000000..fa0a179d
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demoarc1.dat
@@ -0,0 +1,38 @@
+    OBJECT  = 'First comp        '  /  object name
+    OBSERVAT= 'KPNO              '  /  observatory
+    OBSERVER= 'Massey            '  /  observers
+    COMMENTS= 'Final New Ice     '  /  comments
+    EXPTIME =                  60.  /  actual integration time
+    DARKTIME=                  60.  /  total elapsed time
+    IMAGETYP= 'comp              '  /  object, dark, bias, etc.
+    DATE-OBS= '26/11/91          '  /  date (dd/mm/yy) of obs.
+    UT      = '12:11:30.00       '  /  universal time
+    ST      = '09:04:54.00       '  /  sidereal time
+    RA      = '06:37:02.00       '  /  right ascension
+    DEC     = '06:09:03.00       '  /  declination
+    EPOCH   =               1991.9  /  epoch of ra and dec
+    ZD      = '48.760            '  /  zenith distance
+    AIRMASS =                   0.  /  airmass
+    TELESCOP= 'kpcdf             '  /  telescope name
+    DETECTOR= 'te1k              '  /  detector
+    PREFLASH=                    0  /  preflash time, seconds
+    GAIN    =                  5.4  /  gain, electrons per adu
+    DWELL   =                    5  /  sample integration time
+    RDNOISE =                  3.5  /  read noise, electrons per adu
+    DELAY0  =                    0  /  time delay after each pixel
+    DELAY1  =                    0  /  time delay after each row
+    CAMTEMP =                 -111  /  camera temperature
+    DEWTEMP =                 -183  /  dewar temperature
+    CCDSEC  = '[97:134,2:1023]'     /  orientation to full frame
+    ORIGSEC = '[1:1024,1:1024]   '  /  original size  full frame
+    CCDSUM  = '1 1               '  /  on chip summation
+    INSTRUME= 'test              '  /  instrument
+    APERTURE= '250micron slit    '  /  aperture
+    TVFILT  = '4-96              '  /  tv filter
+    DISPAXIS= '2                 '  /  dispersion axis
+    GRATPOS =               4624.3  /  grating position
+    TRIM    = 'Nov 26  5:44 Trim data section is [23:60,2:1023]'
+    OVERSCAN= 'Nov 26  5:44 Overscan section is [103:133,2:1023] with mean=611.1
+    ZEROCOR = 'Nov 26  5:44 Zero level correction image is Zerof'
+    CCDMEAN =              179.398
+    CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/twodspec/longslit/demos/demoarc2.dat b/noao/twodspec/longslit/demos/demoarc2.dat
new file mode 100644
index 00000000..4cd9975d
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demoarc2.dat
@@ -0,0 +1,38 @@
+    OBJECT  = 'Last comp         '  /  object name
+    OBSERVAT= 'KPNO              '  /  observatory
+    OBSERVER= 'Massey            '  /  observers
+    COMMENTS= 'Final New Ice     '  /  comments
+    EXPTIME =                  60.  /  actual integration time
+    DARKTIME=                  60.  /  total elapsed time
+    IMAGETYP= 'comp              '  /  object, dark, bias, etc.
+    DATE-OBS= '26/11/91          '  /  date (dd/mm/yy) of obs.
+    UT      = '12:41:30.00       '  /  universal time
+    ST      = '09:34:54.00       '  /  sidereal time
+    RA      = '06:37:02.00       '  /  right ascension
+    DEC     = '06:09:03.00       '  /  declination
+    EPOCH   =               1991.9  /  epoch of ra and dec
+    ZD      = '48.760            '  /  zenith distance
+    AIRMASS =                   0.  /  airmass
+    TELESCOP= 'kpcdf             '  /  telescope name
+    DETECTOR= 'te1k              '  /  detector
+    PREFLASH=                    0  /  preflash time, seconds
+    GAIN    =                  5.4  /  gain, electrons per adu
+    DWELL   =                    5  /  sample integration time
+    RDNOISE =                  3.5  /  read noise, electrons per adu
+    DELAY0  =                    0  /  time delay after each pixel
+    DELAY1  =                    0  /  time delay after each row
+    CAMTEMP =                 -111  /  camera temperature
+    DEWTEMP =                 -183  /  dewar temperature
+    CCDSEC  = '[97:134,2:1023]'     /  orientation to full frame
+    ORIGSEC = '[1:1024,1:1024]   '  /  original size  full frame
+    CCDSUM  = '1 1               '  /  on chip summation
+    INSTRUME= 'test              '  /  instrument
+    APERTURE= '250micron slit    '  /  aperture
+    TVFILT  = '4-96              '  /  tv filter
+    DISPAXIS= '2                 '  /  dispersion axis
+    GRATPOS =               4624.3  /  grating position
+    TRIM    = 'Nov 26  5:44 Trim data section is [23:60,2:1023]'
+    OVERSCAN= 'Nov 26  5:44 Overscan section is [103:133,2:1023] with mean=611.1
+    ZEROCOR = 'Nov 26  5:44 Zero level correction image is Zerof'
+    CCDMEAN =              179.398
+    CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/twodspec/longslit/demos/demoflat.dat b/noao/twodspec/longslit/demos/demoflat.dat
new file mode 100644
index 00000000..f4651c52
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demoflat.dat
@@ -0,0 +1,37 @@
+    OBJECT  = 'Flat	         '  /  object name
+    OBSERVAT= 'KPNO              '  /  observatory
+    OBSERVER= 'Massey            '  /  observers
+    COMMENTS= 'Final New Ice     '  /  comments
+    EXPTIME =                1200.  /  actual integration time
+    DARKTIME=                1200.  /  total elapsed time
+    IMAGETYP= 'flat              '  /  object, dark, bias, etc.
+    DATE-OBS= '26/11/91          '  /  date (dd/mm/yy) of obs.
+    UT      = '12:19:55.00       '  /  universal time
+    ST      = '09:13:15.00       '  /  sidereal time
+    RA      = '06:37:02.00       '  /  right ascension
+    DEC     = '06:08:52.00       '  /  declination
+    EPOCH   =               1991.9  /  epoch of ra and dec
+    ZD      = '44.580            '  /  zenith distance
+    AIRMASS =                   0.  /  airmass
+    TELESCOP= 'kpcdf             '  /  telescope name
+    DETECTOR= 'te1k              '  /  detector
+    PREFLASH=                    0  /  preflash time, seconds
+    GAIN    =                  5.4  /  gain, electrons per adu
+    DWELL   =                    5  /  sample integration time
+    RDNOISE =                  3.5  /  read noise, electrons per adu
+    DELAY0  =                    0  /  time delay after each pixel
+    DELAY1  =                    0  /  time delay after each row
+    CAMTEMP =                 -111  /  camera temperature
+    DEWTEMP =                 -183  /  dewar temperature
+    CCDSEC  = '[97:134,2:1023]'     /  orientation to full frame
+    ORIGSEC = '[1:1024,1:1024]   '  /  original size  full frame
+    CCDSUM  = '1 1               '  /  on chip summation
+    INSTRUME= 'test              '  /  instrument
+    APERTURE= '250micron slit    '  /  aperture
+    TVFILT  = '4-96              '  /  tv filter
+    DISPAXIS= '2                 '  /  dispersion axis
+    GRATPOS =               4624.3  /  grating position
+    TRIM    = 'Nov 26  5:44 Trim data section is [23:60,2:1023]'
+    OVERSCAN= 'Nov 26  5:44 Overscan section is [103:133,2:1023] with mean=611.1
+    ZEROCOR = 'Nov 26  5:44 Zero level correction image is Zerof'
+    CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/twodspec/longslit/demos/demoobj.dat b/noao/twodspec/longslit/demos/demoobj.dat
new file mode 100644
index 00000000..78f3b9ad
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demoobj.dat
@@ -0,0 +1,37 @@
+    OBJECT  = 'V640Mon 4500      '  /  object name
+    OBSERVAT= 'KPNO              '  /  observatory
+    OBSERVER= 'Massey            '  /  observers
+    COMMENTS= 'Final New Ice     '  /  comments
+    EXPTIME =                1200.  /  actual integration time
+    DARKTIME=                1200.  /  total elapsed time
+    IMAGETYP= 'object            '  /  object, dark, bias, etc.
+    DATE-OBS= '26/11/91          '  /  date (dd/mm/yy) of obs.
+    UT      = '12:19:55.00       '  /  universal time
+    ST      = '09:13:15.00       '  /  sidereal time
+    RA      = '06:37:02.00       '  /  right ascension
+    DEC     = '06:08:52.00       '  /  declination
+    EPOCH   =               1991.9  /  epoch of ra and dec
+    ZD      = '44.580            '  /  zenith distance
+    AIRMASS =                   0.  /  airmass
+    TELESCOP= 'kpcdf             '  /  telescope name
+    DETECTOR= 'te1k              '  /  detector
+    PREFLASH=                    0  /  preflash time, seconds
+    GAIN    =                  5.4  /  gain, electrons per adu
+    DWELL   =                    5  /  sample integration time
+    RDNOISE =                  3.5  /  read noise, electrons per adu
+    DELAY0  =                    0  /  time delay after each pixel
+    DELAY1  =                    0  /  time delay after each row
+    CAMTEMP =                 -111  /  camera temperature
+    DEWTEMP =                 -183  /  dewar temperature
+    CCDSEC  = '[97:134,2:1023]'     /  orientation to full frame
+    ORIGSEC = '[1:1024,1:1024]   '  /  original size  full frame
+    CCDSUM  = '1 1               '  /  on chip summation
+    INSTRUME= 'test              '  /  instrument
+    APERTURE= '250micron slit    '  /  aperture
+    TVFILT  = '4-96              '  /  tv filter
+    DISPAXIS= '2                 '  /  dispersion axis
+    GRATPOS =               4624.3  /  grating position
+    TRIM    = 'Nov 26  5:44 Trim data section is [23:60,2:1023]'
+    OVERSCAN= 'Nov 26  5:44 Overscan section is [103:133,2:1023] with mean=611.1
+    ZEROCOR = 'Nov 26  5:44 Zero level correction image is Zerof'
+    CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/twodspec/longslit/demos/demos.cl b/noao/twodspec/longslit/demos/demos.cl
new file mode 100644
index 00000000..5b065c51
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demos.cl
@@ -0,0 +1,18 @@
+# DEMOS -- Run specified demo provided a demo file exists.
+
+procedure demos (demoname)
+
+file	demoname	{prompt="Demo name"}
+
+begin
+	file	demo, demofile
+
+	if ($nargs == 0 && mode != "h")
+	    type ("demos$demos.men")
+	demo = demoname
+	demofile = "demos$" // demo // ".cl"
+	if (access (demofile))
+	    cl (< demofile)
+	else
+	    error (1, "Unknown demo " // demo)
+end
diff --git a/noao/twodspec/longslit/demos/demos.men b/noao/twodspec/longslit/demos/demos.men
new file mode 100644
index 00000000..559bc1ae
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demos.men
@@ -0,0 +1,4 @@
+	MENU of LONGSLIT Demonstrations
+
+         test - Test of LONGSLIT package (no comments, no delays)
+	testt - Test of LONGSLIT package with transposed data
diff --git a/noao/twodspec/longslit/demos/demos.par b/noao/twodspec/longslit/demos/demos.par
new file mode 100644
index 00000000..4181ed59
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demos.par
@@ -0,0 +1,2 @@
+demoname,f,a,"",,,"Demo name"
+mode,s,h,"ql",,,
diff --git a/noao/twodspec/longslit/demos/demostd.dat b/noao/twodspec/longslit/demos/demostd.dat
new file mode 100644
index 00000000..78f3b9ad
--- /dev/null
+++ b/noao/twodspec/longslit/demos/demostd.dat
@@ -0,0 +1,37 @@
+    OBJECT  = 'V640Mon 4500      '  /  object name
+    OBSERVAT= 'KPNO              '  /  observatory
+    OBSERVER= 'Massey            '  /  observers
+    COMMENTS= 'Final New Ice     '  /  comments
+    EXPTIME =                1200.  /  actual integration time
+    DARKTIME=                1200.  /  total elapsed time
+    IMAGETYP= 'object            '  /  object, dark, bias, etc.
+    DATE-OBS= '26/11/91          '  /  date (dd/mm/yy) of obs.
+    UT      = '12:19:55.00       '  /  universal time
+    ST      = '09:13:15.00       '  /  sidereal time
+    RA      = '06:37:02.00       '  /  right ascension
+    DEC     = '06:08:52.00       '  /  declination
+    EPOCH   =               1991.9  /  epoch of ra and dec
+    ZD      = '44.580            '  /  zenith distance
+    AIRMASS =                   0.  /  airmass
+    TELESCOP= 'kpcdf             '  /  telescope name
+    DETECTOR= 'te1k              '  /  detector
+    PREFLASH=                    0  /  preflash time, seconds
+    GAIN    =                  5.4  /  gain, electrons per adu
+    DWELL   =                    5  /  sample integration time
+    RDNOISE =                  3.5  /  read noise, electrons per adu
+    DELAY0  =                    0  /  time delay after each pixel
+    DELAY1  =                    0  /  time delay after each row
+    CAMTEMP =                 -111  /  camera temperature
+    DEWTEMP =                 -183  /  dewar temperature
+    CCDSEC  = '[97:134,2:1023]'     /  orientation to full frame
+    ORIGSEC = '[1:1024,1:1024]   '  /  original size  full frame
+    CCDSUM  = '1 1               '  /  on chip summation
+    INSTRUME= 'test              '  /  instrument
+    APERTURE= '250micron slit    '  /  aperture
+    TVFILT  = '4-96              '  /  tv filter
+    DISPAXIS= '2                 '  /  dispersion axis
+    GRATPOS =               4624.3  /  grating position
+    TRIM    = 'Nov 26  5:44 Trim data section is [23:60,2:1023]'
+    OVERSCAN= 'Nov 26  5:44 Overscan section is [103:133,2:1023] with mean=611.1
+    ZEROCOR = 'Nov 26  5:44 Zero level correction image is Zerof'
+    CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/twodspec/longslit/demos/mktest.cl b/noao/twodspec/longslit/demos/mktest.cl
new file mode 100644
index 00000000..e1c5f069
--- /dev/null
+++ b/noao/twodspec/longslit/demos/mktest.cl
@@ -0,0 +1,31 @@
+# Create demo data if needed.
+
+artdata
+artdata.nxc = 5
+artdata.nyc = 5
+artdata.nxsub = 10
+artdata.nysub = 10
+artdata.nxgsub = 5
+artdata.nygsub = 5
+artdata.dynrange = 100000.
+artdata.psfrange = 10.
+artdata.ranbuf = 0
+
+mkexample ("longslit", "Demoflat", oseed=4,  nseed=3,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoflat", "demos$demoflat.dat", append=no, verbose=no)
+mkexample ("longslit", "Demoarc1", oseed=5,  nseed=1,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoarc1", "demos$demoarc1.dat", append=no, verbose=no)
+mkexample ("longslit", "Demoobj", oseed=1,  nseed=1,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoobj", "demos$demoobj.dat", append=no, verbose=no)
+mkexample ("longslit", "Demostd", oseed=2, nseed=2,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demostd", "demos$demostd.dat", append=no, verbose=no)
+mkexample ("longslit", "Demoarc2", oseed=5,  nseed=2,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoarc2", "demos$demoarc2.dat", append=no, verbose=no)
+imcopy ("Demoflat,Demoarc1,Demoobj,Demostd,Demoarc2",
+	"demoflat,demoarc1,demoobj,demostd,demoarc2",
+	verbose=yes)
diff --git a/noao/twodspec/longslit/demos/mktestt.cl b/noao/twodspec/longslit/demos/mktestt.cl
new file mode 100644
index 00000000..a60d8ad7
--- /dev/null
+++ b/noao/twodspec/longslit/demos/mktestt.cl
@@ -0,0 +1,38 @@
+# Create demo data if needed.
+
+artdata
+artdata.nxc = 5
+artdata.nyc = 5
+artdata.nxsub = 10
+artdata.nysub = 10
+artdata.nxgsub = 5
+artdata.nygsub = 5
+artdata.dynrange = 100000.
+artdata.psfrange = 10.
+artdata.ranbuf = 0
+
+mkexample ("longslit", "Demoflat", oseed=4,  nseed=3,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoflat", "demos$demoflat.dat", append=no, verbose=no)
+mkexample ("longslit", "Demoarc1", oseed=5,  nseed=1,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoarc1", "demos$demoarc1.dat", append=no, verbose=no)
+mkexample ("longslit", "Demoobj", oseed=1,  nseed=1,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoobj", "demos$demoobj.dat", append=no, verbose=no)
+mkexample ("longslit", "Demostd", oseed=2, nseed=2,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demostd", "demos$demostd.dat", append=no, verbose=no)
+mkexample ("longslit", "Demoarc2", oseed=5,  nseed=2,
+    errors=no, verbose=yes, list=no)
+mkheader ("Demoarc2", "demos$demoarc2.dat", append=no, verbose=no)
+
+print ("Transposing images...")
+imtranspose ("Demoflat,Demoarc1,Demoobj,Demostd,Demoarc2",
+	"demoflat,demoarc1,demoobj,demostd,demoarc2")
+wcsreset ("demoflat,demoarc1,demoobj,demostd,demoarc2", wcs="physical",
+	verbose=no)
+hedit ("demoflat,demoarc1,demoobj,demostd,demoarc2", "dispaxis", 1,
+	update=yes, verify=no, show=no)
+imtranspose ("demoflat,demoarc1,demoobj,demostd,demoarc2",
+	"demoflat,demoarc1,demoobj,demostd,demoarc2")
diff --git a/noao/twodspec/longslit/demos/test.cl b/noao/twodspec/longslit/demos/test.cl
new file mode 100644
index 00000000..99dbeb77
--- /dev/null
+++ b/noao/twodspec/longslit/demos/test.cl
@@ -0,0 +1,21 @@
+# Create demo data if needed.
+
+unlearn background calibrate identify illumination reidentify response
+unlearn sensfunc setairmass setjd splot standard fitcoords transform
+imdel demo*.imh
+cl (< "demos$mktest.cl")
+delete demolist,demodelfile,demologfile,demoplotfile,demostdfile v- >& dev$null
+if (access ("database"))
+    delete database/* v- >& dev$null
+;
+reidentify.logfile="demologfile"
+fitcoords.deletions="demodelfile"
+fitcoords.logfiles="STDOUT,demologfile"
+fitcoords.plotfile="demoplotfile"
+transform.logfiles="STDOUT,demologfile"
+
+# Execute playback.
+if (substr (envget("stdgraph"), 1, 6) == "xgterm")
+    stty (playback="demos$xgtest.dat", nlines=24, verify=no, delay=0)
+else
+    error (1, "Playback for current terminal type not available")
diff --git a/noao/twodspec/longslit/demos/testt.cl b/noao/twodspec/longslit/demos/testt.cl
new file mode 100644
index 00000000..94dcf0e0
--- /dev/null
+++ b/noao/twodspec/longslit/demos/testt.cl
@@ -0,0 +1,21 @@
+# Create demo data if needed.
+
+unlearn background calibrate identify illumination reidentify response
+unlearn sensfunc setairmass setjd splot standard fitcoords transform
+imdel demo*.imh
+cl (< "demos$mktestt.cl")
+delete demolist,demodelfile,demologfile,demoplotfile,demostdfile v- >& dev$null
+if (access ("database"))
+    delete database/* v- >& dev$null
+;
+reidentify.logfile="demologfile"
+fitcoords.deletions="demodelfile"
+fitcoords.logfiles="STDOUT,demologfile"
+fitcoords.plotfile="demoplotfile"
+transform.logfiles="STDOUT,demologfile"
+
+# Execute playback.
+if (substr (envget("stdgraph"), 1, 6) == "xgterm")
+    stty (playback="demos$xgtest.dat", nlines=24, verify=no, delay=0)
+else
+    error (1, "Playback for current terminal type not available")
diff --git a/noao/twodspec/longslit/demos/xgtest.dat b/noao/twodspec/longslit/demos/xgtest.dat
new file mode 100644
index 00000000..c521337d
--- /dev/null
+++ b/noao/twodspec/longslit/demos/xgtest.dat
@@ -0,0 +1,96 @@
+\O=NOAO/IRAF V2.10EXPORT valdes@puppis Thu 09:50:51 04-Feb-93
+\T=xgtermc
+\G=xgtermc
+imred\n
+bias\n
+sections\sdemoobj,demostd,demoarc1,demoarc2\s>\sdemolist\n
+colbias\sdemoflat,@demolist\sdemoflat,@demolist\sbias=[100,*]\strim=[20:80,*]\n
+\n
+:/<-5\s\s\s\s/=(.\s=\r f\scheb\r
+f/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+N\n
+bye\n
+bye\n
+response\sdemoflat\sdemoflat[20:40,*]\sdemoflat\n
+\n
+k/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+imarith\s@demolist\s/\sdemoflat\s@demolist\n
+illum\sdemostd\sdemoillum\sbins=1\n
+\n
+q/<-5\s\s\s\s/=(.\s=\r
+\n
+:/<-5\s\s\s\s/=(.\s=\r sample\s5:24,36:55\r
+:/<-5\s\s\s\s/=(.\s=\r f\scheb\r
+:/<-5\s\s\s\s/=(.\s=\r o\s3\r
+f/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+imarith\s@demolist\s/\sdemoillum\s@demolist\n
+iden\sdemoarc1\ssec="mid\scol"\n
+i/<-5\s\s\s\s/=(.\s=\r
+m*),'\s\s\s\s*)&/=2\r 5015\r
+m;$,9\s\s\s\s;%+/%*\r 7281\r
+l/<-5\s\s\s\s/=(.\s=\r
+f/<-5\s\s\s\s/=(.\s=\r
+d%"5!\s\s\s\s%!;$**\r
+d:7'5\s\s\s\s:845=(\r
+f/<-5\s\s\s\s/=(.\s=\r
+l/<-5\s\s\s\s/=(.\s=\r
+d/0%>\s\s\s\s/008&"\r
+f/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+\n
+reid\sdemoarc1\sdemoarc1,demoarc2\ssec="mid\scol"\snlost=5\sv+\n
+iden\sdemostd\ssec="mid\sline"\n
+m/<-;\s\s\s\s/=(-94\r 50\r
+q/<-5\s\s\s\s/=(.\s=\r
+\n
+reid\sdemostd\sdemostd\ssec="mid\sline"\snlost=5\sv+\n
+fitcoords\scombine+\sfitname=demoarcfit\n
+demoarc1,demoarc2\n
+\n
+y/<-5\s\s\s\s/=(.\s=\r
+x/<-5\s\s\s\s/=(.\s=\r
+r/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+\n
+fitcoords\n
+demostd\n
+\n
+y/<-5\s\s\s\s/=(.\s=\r
+x/<-5\s\s\s\s/=(.\s=\r
+r/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+\n
+transform\slogfiles=STDOUT,demologfile\n
+demoobj,demostd\n
+demoobj,demostd\n
+demoarcfit,demostd\n
+background\sdemoobj,demostd\sdemoobj,demostd\n
+256\r
+:/<-5\s\s\s\s/=(.\s=\r sample\s5:24,36:55\r
+:/<-5\s\s\s\s/=(.\s=\r nav\s-20\r
+f/<-5\s\s\s\s/=(.\s=\r
+q/<-5\s\s\s\s/=(.\s=\r
+\r
+256\r
+q/<-5\s\s\s\s/=(.\s=\r
+\r
+nsum=7\n
+setairmass\sdemoobj,demostd\n
+standard\sdemostd\sdemostdfile\sap=31\n
+hz14\n
+n\n
+sensfunc\sdemostdfile\sdemosens\slogfile=demologfile\n
+\n
+q/<-5\s\s\s\s/=(.\s=\r
+calibrate\sdemoobj,demostd\sdemoobj,demostd\ssens=demosens\n
+splot\sdemostd,demoobj\n
+31\n
+y/<-5\s\s\s\s/=(.\s=\r hz14\r
+q/<-5\s\s\s\s/=(.\s=\r
+o/<-5\s\s\s\s/=(.\s=\r
+#/<-5\s\s\s\s/=(.\s=\r 1\r
+q/<-5\s\s\s\s/=(.\s=\r
diff --git a/noao/twodspec/longslit/demos/xgtestold.dat b/noao/twodspec/longslit/demos/xgtestold.dat
new file mode 100644
index 00000000..071fa083
--- /dev/null
+++ b/noao/twodspec/longslit/demos/xgtestold.dat
@@ -0,0 +1,93 @@
+\O=NOAO/IRAF V2.10EXPORT valdes@puppis Thu 09:50:51 04-Feb-93
+\T=xgtermc
+\G=xgtermc
+imred\n
+bias\n
+sections\sdemoobj,demostd,demoarc1,demoarc2\s>\sdemolist\n
+colbias\sdemoflat,@demolist\sdemoflat,@demolist\sbias=[100,*]\strim=[20:80,*]\n
+\n
+:*'3,\r f\scheb\r
+f*'3,\r
+q*'3,\r
+N\n
+bye\n
+bye\n
+response\sdemoflat\sdemoflat[20:40,*]\sdemoflat\n
+\n
+k*'3,\r
+q*'3,\r
+imarith\s@demolist\s/\sdemoflat\s@demolist\n
+illum\sdemostd\sdemoillum\sbins=1\n
+\n
+q*'3,\r
+\n
+:*'3,\r sample\s5:24,36:55\r
+:*'3,\r f\scheb\r
+:*'3,\r o\s3\r
+f*'3,\r
+q*'3,\r
+imarith\s@demolist\s/\sdemoillum\s@demolist\n
+iden\sdemoarc1\ssec="mid\scol"\n
+m*)4)\r 5015\r
+m;$4)\r 7281\r
+l*'3,\r
+f*'3,\r
+d$<5!\r
+d/9&5\r
+f*'3,\r
+l*'3,\r
+q*'3,\r
+q*'3,\r
+\n
+reid\sdemoarc1\sdemoarc1,demoarc2\ssec="mid\scol"\sv+\n
+iden\sdemostd\ssec="mid\sline"\n
+m0\s4"\r 50\r
+q0\s4"\r
+\n
+reid\sdemostd\sdemostd\ssec="mid\sline"\sv+\n
+fitcoords\scombine+\sfitname=demoarcfit\n
+demoarc1,demoarc2\n
+\n
+y*'3,\r
+x*'3,\r
+r*'3,\r
+q*'3,\r
+\n
+fitcoords\n
+demostd\n
+\n
+y*'3,\r
+x*'3,\r
+r*'3,\r
+q*'3,\r
+\n
+transform\slogfiles=STDOUT,demologfile\n
+demoobj,demostd\n
+demoobj,demostd\n
+demoarcfit,demostd\n
+background\sdemoobj,demostd\sdemoobj,demostd\n
+256\r
+:*'3,\r sample\s5:24,36:55\r
+:*'3,\r nav\s-20\r
+f*'3,\r
+q*'3,\r
+\r
+256\r
+q*'3,\r
+\r
+nsum=7\n
+setairmass\sdemoobj,demostd\n
+standard\sdemostd\sdemostdfile\sap=31\n
+hz14\n
+n\n
+sensfunc\sdemostdfile\sdemosens\slogfile=demologfile\n
+\n
+q*'3,\r
+calibrate\sdemoobj,demostd\sdemoobj,demostd\ssens=demosens\n
+splot\sdemostd,demoobj\n
+31\n
+y*'3,\r hz14\r
+q*'3,\r
+o*'3,\r
+#*'3,\r 1\r
+q*'3,\r
diff --git a/noao/twodspec/longslit/doc/extinction.hlp b/noao/twodspec/longslit/doc/extinction.hlp
new file mode 100644
index 00000000..39579a07
--- /dev/null
+++ b/noao/twodspec/longslit/doc/extinction.hlp
@@ -0,0 +1,87 @@
+.help extinction May87 noao.twodspec.longslit
+.ih
+NAME
+extinction -- Apply atmospheric extinction corrections
+.ih
+USAGE
+extinction images
+.ih
+PARAMETERS
+.ls input
+List of input images to be extinction corrected.
+.le
+.ls output
+List of output extinction corrected images.  Output images may be the
+same as the input images.
+.le
+.ls extinction = "onedstds$kpnoextinct.dat"
+Extinction file to be used.  The standard extinction files:
+
+.nf
+	onedstds$kpnoextinct.dat - KPNO standard extinction
+	onedstds$ctioextinct.dat - CTIO standard extinction
+.fi
+.le
+.ih
+DESCRIPTION
+The specified images are corrected for atmospheric extinction according
+to the formula
+
+    correction factor = 10 ** (0.4 * airmass * extinction)
+
+where the extinction is a tabulated function of the wavelength.  The
+extinction file contains lines of wavelength and extinction at that
+wavelength.  The units of the wavelength must be the same as those of
+the dispersion corrected images; i.e. Angstroms.   If the image is
+dispersion corrected in logarithmic wavelength intervals (DC-FLAG = 1)
+the task will convert to wavelength and so the extinction file must
+still be wavelength.  The table values are interpolated
+to the wavelengths of the image pixels and the correction applied to
+the pixel values.  Note that the image pixel values are modifed.
+
+The airmass is sought in the image header under the name AIRMASS.  If the
+airmass is not found then it is computed from the zenith distance (ZD in hours)
+using the approximation formula from Allen's "Astrophysical Quantities", 1973,
+page125 and page 133
+
+	AIRMASS = sqrt (cos (ZD) ** 2 + 2 * scale + 1)
+
+where the atmospheric scale height is set to be 750.  If the parameter ZD
+is not found then it must be computed from the hour angle (HA in hours),
+the declination (DEC in degrees), and the observation latitude (LATITUDE
+in degress).   The hour angle may be computed from the right ascension
+(RA in hours) and siderial time (ST in hours).  Computed quantities are
+recorded in the image header.  Flags indicating extinction correction are
+also set in the image header.
+
+The image header keyword DISPAXIS must be present with a value of 1 for
+dispersion parallel to the lines (varying with the column coordinate) or 2
+for dispersion parallel to the columns (varying with line coordinate).
+This parameter may be added using \fBhedit\fR.  Note that if the image has
+been transposed (\fBimtranspose\fR) the dispersion axis should still refer
+to the original dispersion axis unless the physical world coordinate system
+is first reset (see \fBwcsreset\R).  This is done in order to allow images
+which have DISPAXIS defined prior to transposing to still work correctly
+without requiring this keyword to be changed.
+.ih
+EXAMPLES
+1. A set of dispersion corrected images is extinction corrected in-place as
+follows:
+
+.nf
+	cl> extinction img* img*
+.fi
+
+2. To keep the uncorrected image:
+
+.nf
+	cl> extinction nite1.004 nite1ext.004
+.fi
+
+3.  If the DISPAXIS keyword is missing and the dispersion is running
+vertically (varying with the image lines):
+
+.nf
+	cl> hedit *.imh dispaxis 2 add+
+.fi
+.endhelp
diff --git a/noao/twodspec/longslit/doc/fccoeffs b/noao/twodspec/longslit/doc/fccoeffs
new file mode 100644
index 00000000..ab8de92f
--- /dev/null
+++ b/noao/twodspec/longslit/doc/fccoeffs
@@ -0,0 +1,210 @@
+From davis Tue May 18 15:09:59 1993
+Received: by tucana.tuc.noao.edu (4.1/SAG.tucana.12)
+        id AA26431; Tue, 18 May 93 15:09:56 MST; for sites
+Date: Tue, 18 May 93 15:09:56 MST
+From: davis (Lindsey Davis)
+Message-Id: <9305182209.AA26431@tucana.tuc.noao.edu>
+To: belkine@mesiob.obspm.circe.fr
+Subject: RE: geomap
+Cc: sites
+
+
+
+Igor,
+
+    The following is a copy of a mail message I sent to another user who made
+the same request regarding geomap. I hope this is of use to you.
+
+
+                                           Lindsey Davis
+
+###############################################################################
+
+
+    Jeannette forwarded your request for a detailed description of the
+geomap output format to me. This format was originally intended to be
+for the internal use of geomap only, but the following should help you
+decode it.
+
+    1. For simple linear geometric transformations you will see the
+following two entries in the fit record. Surface1 describes the linear
+portion of the fit; surface2 describes the residual distortion map
+which is always 0 for linear fits.
+
+        surface1        11
+            surface(xfit) surface(yfit)    (surface type 1=cheb, 2=leg, 3=poly)
+            xxorder(xfit) yxorder(yfit)    (always 2)
+            xyorder(xfit) yyorder(yfit)    (always 2)
+            xxterms(xfit) yxterms(yfit)    (always 0)
+            xmin(xfit)   xmin(yfit)        (geomap input or data)
+            xmax(xfit)   xmax(yfit)        (geomap input or data)
+            ymin(xfit)   ymin(yfit)        (geomap input or data)
+            ymax(xfit)   ymax(yfit)        (geomap input or data)
+            a            d
+            b            e
+            c            f
+        surface2        0
+
+This above describes the following linear surfaces.
+
+        xfit = a + b * x + c * y  (polynomial)
+        yfit = d + e * x + f * y
+
+        xfit = a + b * xnorm + c * ynorm  (chebyshev)
+        yfit = d + e * xnorm + f * ynorm
+
+        xfit = a + b * xnorm + c * ynorm  (legendre)
+        yfit = d + e * xnorm + f * ynorm
+
+        xnorm = (2 * x - (xmax + xmin)) / (xmax - xmin)
+        ynorm = (2 * y - (ymax + ymin)) / (ymax - ymin)
+
+Xnorm and ynorm are the input x and y values normalized between -1.0
+and 1.0.
+
+
+
+
+      2. For a higher order fit, say xorder=4 yorder=4 and xterms=yes,
+the format is more complicated.  The second surface is computed by fitting
+the higher order surface to the residuals of the first fit. The geomap
+output will look something like the following.
+
+        surface1        11
+            surface(xfit) surface(yfit)    (surface type 1=cheb, 2=leg, 3=poly)
+            xxorder(xfit) yxorder(yfit)    (always 2)
+            xyorder(xfit) yyorder(yfit)    (always 2)
+            xxterms(xfit) yxterms(yfit)    (always 0)
+            xmin(xfit)   xmin(yfit)        (geomap input or data)
+            xmax(xfit)   xmax(yfit)        (geomap input or data)
+            ymin(xfit)   ymin(yfit)        (geomap input or data)
+            ymax(xfit)   ymax(yfit)        (geomap input or data)
+            a            d
+            b            e
+            c            f
+        surface2        24
+            surface(xfit) surface(yfit)    (surface type 1=cheb, 2=leg, 3=poly)
+            xxorder(xfit) yxorder(yfit)    (4)
+            xyorder(xfit) yyorder(yfit)    (4)
+            xxterms(xfit) yxterms(yfit)    (1 in this case)
+            xmin(xfit)   xmin(yfit)        (geomap input or data)
+            xmax(xfit)   xmax(yfit)        (geomap input or data)
+            ymin(xfit)   ymin(yfit)        (geomap input or data)
+            ymax(xfit)   ymax(yfit)        (geomap input or data)
+            C00(xfit)    C00(yfit)
+            C10(xfit)    C10(yfit)
+            C20(xfit)    C20(yfit)
+            C30(xfit)    C30(yfit)
+            C01(xfit)    C01(yfit)
+            C11(xfit)    C11(yfit)
+            C21(xfit)    C21(yfit)
+            C31(xfit)    C31(yfit)
+            C02(xfit)    C02(yfit)
+            C12(xfit)    C12(yfit)
+            C22(xfit)    C22(yfit)
+            C32(xfit)    C32(yfit)
+            C03(xfit)    C03(yfit)
+            C13(xfit)    C13(yfit)
+            C23(xfit)    C23(yfit)
+            C33(xfit)    C33(yfit)
+
+
+where the Cmn are the coefficients of the polynomials Pmn, and the Pmn
+are defined as follows
+
+            Pmn = x ** m * y ** n    (polynomial)
+
+            Pmn = Pm(xnorm) * Pn(ynorm)     (chebyshev)
+
+                P0(xnorm) = 1.0
+                P1(xnorm) = xnorm
+                Pm+1(xnorm) = 2.0 * xnorm * Pm(xnorm) - Pm-1(xnorm)
+                xnorm = (2 * x - (xmax + xmin)) / (xmax - xmin)
+
+                P0(ynorm) = 1.0
+                P1(ynorm) = ynorm
+                Pn+1(ynorm) = 2.0 * ynorm * Pn(ynorm) - Pn-1(ynorm)
+                ynorm = (2 * y - (ymax + ymin)) / (ymax - ymin)
+
+            Pmn = Pm(xnorm) * Pn(ynorm)     (legendgre)
+
+                P0(xnorm) = 1.0
+                P1(xnorm) = xnorm
+                Pm+1(xnorm) = ((2m + 1) * xnorm * Pm(xnorm) - m * Pm-1(xnorm))/
+                              (m + 1)
+                xnorm = (2 * x - (xmax + xmin)) / (xmax - xmin)
+
+                P0(ynorm) = 1.0
+                P1(ynorm) = ynorm
+                Pn+1(ynorm) = ((2n + 1) * ynorm * Pn(ynorm) - n * Pn-1(ynorm))/
+                              (n + 1)
+                ynorm = (2 * y - (ymax + ymin)) / (ymax - ymin)
+
+
+Hopefully I have copied this all down correctly. The main points to remember
+is that the mangitudes of the coefficients reflect both the function type
+(polynomial, chebyshev, or legendre) and the normalization (xmin, xmax,
+ymin, ymax).
+
+    Hope this helps you out and write back if you have more questions.
+
+                                             Lindsey Davis
+
+=======================================
+
+# <Date>
+begin	<name>
+	task fitcoords
+	axis	1	# Axis of fitted value
+	surface	24	# The number of following parameters/coefficients
+            surface	# surface type 1=chebyshev, 2=legendre
+            xorder	# X order
+            yorder	# Y order
+            xterms	# Cross terms?  0=no, 1=yes (always 1 for fitcoords)
+            xmin	# Minimum x value in fit - usually 1
+            xmax	# Maximum x value in fit - usually image dimension
+            ymin	# Minimum y value in fit - usually 1
+            ymax	# Maximum y value in fit - usually image dimension
+            C00		# Coefficients (shown for xorder=4 and yorder=4)
+            C10
+            C20
+            C30
+            C01
+            C11
+            C21
+            C31
+            C02
+            C12
+            C22
+            C32
+            C03
+            C13
+            C23
+            C33
+
+
+The fit is a sum of the form:
+
+	fit = sum(m=0 to xorder-1) sum(n=0 to yorder-1) {Cmn*Pm(x')*Pn(y')}
+
+where the cross-terms may or may not be included depending on the xterms
+parameter.  Cross-terms are always used in FITCOORDS.
+
+The coefficients are defined in terms of normalized independent variables
+in the range -1 to 1.  If x and y are actual values then the normalized
+variables, x' and y', are defined using the data range parameters as:
+
+	x' = (2 * x - (xmax + xmin)) / (xmax - xmin)
+	y' = (2 * y - (ymax + ymin)) / (ymax - ymin)
+
+The Pi(z), where z is either x' or y', are defined iteratively as follows:
+
+	# Chebyshev
+	P0(z) = 1.0
+	P1(z) = z
+	Pi+1(z) = 2.0 * z * Pi(z) - Pi-1(z)
+
+	# Legendre
+	P0(z) = 1.0
+	P1(z) = z
+	Pi+1(z) = ((2i + 1) * z * Pi(z) - i * Pi-1(z)) / (i + 1)
diff --git a/noao/twodspec/longslit/doc/fceval.hlp b/noao/twodspec/longslit/doc/fceval.hlp
new file mode 100644
index 00000000..87d258c0
--- /dev/null
+++ b/noao/twodspec/longslit/doc/fceval.hlp
@@ -0,0 +1,87 @@
+.help fceval Aug03 noao.twodspec.longslit
+.ih
+NAME
+fceval -- Evaluate coordinates using the FITCOORDS solutions
+.ih
+USAGE
+fceval input output fitnames
+.ih
+PARAMETERS
+.ls input
+Input text file of pixel coordinates.  This may be "STDIN" to read
+coordinates from the terminal or pipe.
+.le
+.ls output
+Output text file of pixel coordinates and fitted coordinates.  This may
+be "STDOUT" to write coordinates to the terminal or pipe.
+.le
+.ls fitnames  
+Names of the user coordinate maps to evaluate.
+.le
+.ls database = "database"
+Database containing the coordinate maps.
+.le
+.ih
+DESCRIPTION
+This task transforms pixel coordinates to the world coordinates fit with
+FITCOORDS.  When there is no map for an axis the identify transform is
+used.  If there are more the one map for an axis the average of the mapped
+coordinates is output.  This is the same behavior as TRANSFORM.
+
+The input file consists of two columns giving the x and y pixel values
+in the frame of the untransformed image data.  The output is a file
+with four columns giving the input x any y pixel values and the
+user coordinates fit by FITCOORDS.
+
+Two typical uses for this task are to look up world coordinates for
+points in the untransformed data and to generate transformations using
+GEOMAP and GEOTRAN.
+.ih
+EXAMPLES
+1. Evaluate a wavelength and slit position fit where the input pixel coordinates
+are entered interactively and the output is written to the terminal.
+
+.nf
+    cl> fceval STDIN STDOUT arcfit,std
+    1 1
+    1. 1. 20.60425149463117 4202.47202514205
+    60 1
+    60. 1. 79.60425149463118 4203.316616448186
+    1 512
+    1. 512. 19.15606081299484 7356.089801036373
+    60 512
+    60. 512. 78.15606081299485 7355.042495319318
+.fi
+
+In this case the first axis corresponds to the spatial dimension and
+the second to the dispersion dimension.  The arcfit was created using
+Angstroms and so the units of the last column is Angstroms.
+
+2. One use of this task is to generate the inverse transformation from
+that produced by TRANSFORM.  The steps are: 1) produce a grid of
+coordinates using LISTPIX and FCEVAL, 2) convert the user coordinates to
+pixel coordinates in the transformed data using WCSCTRAN, 3) fit a
+transformation using GEOMAP, and 4) transform the data with GEOTRAN.
+
+.nf
+    cl> listpix orig[*:5,*:5] wcs=physical verb- |
+    >>> fceval STDIN STDOUT arcfit,std |
+    >>> wcsctran STDIN coords trans world logical columns="3 4"
+    cl> geomap coords geomap.db 1 61 1 512
+    cl> geotran trans origNEW geomap.db coords flux+
+.fi
+
+This example uses pipes to eliminate intermediate files.  But these
+files can be useful for understanding the process.  LIXTPIX is used to
+generate a grid of points with some subsampling.  Be sure to use "physical"
+for the coordinate system otherwise the grid of x and y values will be
+for the subsection.  The order of the columns will be appropriate for
+GEOMAP to compute the inverse transformation.  By reversing the order
+of the columns one could generate a transformation similar to that
+produced by TRANSFORM in order to use features in GEOTRAN not provided
+by TRANSFORM.  However, the world coordinate system information will
+not be automatically set.
+.ih
+SEE ALSO
+fitcoords, transform, geomap, geotran
+.endhelp
diff --git a/noao/twodspec/longslit/doc/fitcoords.hlp b/noao/twodspec/longslit/doc/fitcoords.hlp
new file mode 100644
index 00000000..a376ee74
--- /dev/null
+++ b/noao/twodspec/longslit/doc/fitcoords.hlp
@@ -0,0 +1,287 @@
+.help fitcoords Apr00 noao.twodspec.longslit
+.ih
+NAME
+fitcoords -- Fit user coordinates to the image coordinates
+.ih
+USAGE
+fitcoords images fitname
+.ih
+PARAMETERS
+.ls images
+List of images containing the feature coordinates to be fit.  If the
+parameter \fIcombine\fR is yes then feature coordinates from all the images
+are combined and fit by a single function.  Otherwise the feature coordinates
+from each image are fit separately.
+.le
+.ls fitname = "" 
+If the input images are combined and fit by a single function then the fit
+is stored under this name.  If the images are not combined then the
+fit for each image is stored under the name formed by appending the image
+name to this name.  A null prefix is acceptable when not combining but it
+is an error if combining a list of images.
+.le
+.ls interactive = yes
+Determine coordinate fits interactively?
+.le
+.ls combine = no
+Combine the coordinates from all the input images and fit them by a single
+function?  If 'no' then fit the coordinates from each image separately.
+.le
+.ls database = "database"
+Database containing the feature coordinate information used in fitting the
+coordinates and in which the coordinate fit is recorded.
+.le
+.ls deletions = "deletions.db"
+Deletion list file.  If not null then points whose coordinates match those in
+this file (if it exists) are initially deleted from the fit.
+If the fitting is done interactively then the coordinates of
+any deleted points (after exiting from the interactive fitting) are recorded
+in this file.
+.le
+.ls function = "chebyshev"
+Type of two dimensional function to use in fitting the user coordinates.
+The choices are "chebyshev" polynomial and "legendre" polynomial.
+The function may be abbreviated.  If the task is interactive then
+the user may change the function later.
+.le
+.ls xorder = 6
+Order of the mapping function along the first image axis.
+The order is the number of polynomial terms.  If the task is interactive
+then the user may change the order later.
+.le
+.ls yorder = 6
+Order of the mapping function along the second image axis.
+The order is the number of polynomial terms.  If the task is interactive
+then the user may change the order later.
+.le
+.ls logfiles = "STDOUT,logfile"
+List of files in which to keep logs containing information about
+the coordinate fit.  If null then no log is kept.
+.le
+.ls plotfile = "plotfile"
+Name of file to contain metacode for log plots.  If null then no log plots
+are kept.  When the fitting is interactive the last graph is recorded in
+the plot file and when not interactive a default plot is recorded.
+.le
+.ls graphics = "stdgraph"
+Graphics output device.
+.le
+.ls cursor = ""
+Graphics cursor input.  If null the standard graphics cursor is used.
+.le
+.bp
+.ih
+CURSOR COMMANDS
+
+.nf
+?  List commands
+c  Print data values for point nearest the cursor
+d  Delete the point or set of points with constant x, y, or z
+	nearest the cursor (p, x, y, z,)
+f  Fit surface
+l  Graph the last set of points (in zoom mode)
+n  Graph the next set of points (in zoom mode)
+p  Graph all features
+q  Quit
+r  Redraw a graph
+u  Undelete the point or set of points with constant x, y, or z
+	nearest the cursor (p, x, y, z,)
+w  Window the graph.  Type '?' to the "window:" prompt for more help.
+x  Select data for the x axis (x, y, z, s, r)
+y  Select data for the y axis (x, y, z, s, r)
+z  Zoom on the set of points with constant x, y, or z (x, y, z)
+   Unzoom with p
+
+:corners	Show the fitted values for the corners of the image
+:function type	Set the function for the fitted surface
+		(chebyshev, legendre)
+:show		Show the fitting parameters
+:xorder value	Set the x order  for the fitted surface
+:yorder value	Set the y order  for the fitted surface
+.fi
+.ih
+DESCRIPTION
+A two dimensional function of the image coordinates is fitted to the user
+coordinates from the specified images;
+
+.nf
+	user coordinate = function (column, line)
+
+			or
+
+		      z = s (x, y)
+.fi
+
+The coordinates from all the input images may be combined in a single fit or
+the coordinates from each image may be fit separately.  If the
+coordinates from the input images are combined then the fitted function
+is recorded in the database under the specified name.  If
+the coordinates are fit separately the fitted function is recorded under
+a name formed by appending the image name to the specified root name.
+
+When the task is interactive the user is first queried whether to perform
+the fitting interactively.  The user may answer "yes", "no", "YES", or "NO"
+to the query.  The lowercase responses apply only to the current fit
+and the uppercase responses apply to all remaining fits.  When the
+fitting is done interactively the user may change the fitted function and
+orders iteratively, delete individual coordinates or entire features,
+and graph the fit and residuals in a number ways.
+The CURSOR COMMANDS section describes the graphics cursor keystrokes
+which are available.  When selecting data for the graph axes the
+follow definitions apply:
+
+.nf
+	x	Input image column positions
+	y	Input image line positions
+	z	Input user coordinates
+	s	Fitted user coordinates
+	r	Residuals (s - z)
+.fi
+
+A very useful feature is zooming, deleting, or undeleting a subset of data
+points.  The subsets
+are defined as points with the same x, y, or z value as the point indicated
+by the cursor when typing (z)oom, (d)elete, or (u)ndelete.
+
+When a satisfactory coordinate fit has been determined exit with the (q)uit
+key.  The user is asked if the fit is to be recorded in the database.
+
+If a deletion list file is specified then the coordinates of any
+points deleted interactively are recorded in this file.  This file then can
+be read by subsequent fits to initially delete points with matching
+coordinates.  This is generally used when fitting a series of images
+non-interactively.
+
+Information about the fitted function may be recorded.  Textual information
+is written to the specified log files (which may include the standard
+output STDOUT).  The last interactive plot or a default non-interactive
+plot is written the specified plot file which may be examined and spooled
+at a later time.
+
+
+FITCOORDS DATABASE
+
+The FITCOORDS fits are stored in text files in the subdirectory given by
+the "database" parameter.  The name of the file is fc<fitname> where
+<fitname> is the specified fit name.  The database text file contains
+blocks of lines beginning with a time stamp followed by line with the
+"begin" keyword.  The value following "begin" is the fit name, which is
+often the name of the image used for the fit.  If there is more than one
+block with the same fit name then the last one is used.
+
+The "task" keyword will has the value "fitcoords" and the "axis" keyword
+identifies the axis to which the surface fit applies.  An axis of 1 refers
+to the first or x axis (the first dimension of the image) and 2 refers to
+the second or y axis.
+
+The "surface" keyword specifies the number of coefficients for the surface
+fit given in the following lines .  The surface fit is produced by an IRAF
+math package called "gsurfit".  The coefficients recorded in the database
+are intented to be internal to that package.  However the following
+describes how to interpret the coefficients.
+
+The first 8 lines specify:
+
+.nf
+   function - Function type (1=chebyshev, 2=legendre)
+     xorder - X "order" (highest power of x)
+     yorder - Y "order" (highest power of y)
+     xterms - Cross-term type (always 1 for FITCOORDS)
+       xmin - Minimum x over which the fit is defined
+       xmax - Maximum x over which the fit is defined
+       ymin - Minimum y over which the fit is defined
+       ymax - Maximum y over which the fit is defined
+.fi
+
+The polynomial coefficients follow in array order with the x index
+varying fastest:
+
+.nf
+	C00
+	C10
+	C20
+	...
+	C<xorder-1>0
+	C01
+	C11
+	C21
+	...
+	C<xorder-1>1
+	...
+	C<xorder-1><yorder-1>
+.fi
+
+The surface fitting functions have the form
+
+.nf
+	fit(x,y) = Cmn * Pmn
+.fi
+
+where the Cmn are the coefficients of the polynomials terms Pmn, and the Pmn
+are defined as follows:
+
+.nf
+Chebyshev: Pmn = Pm(xnorm) * Pn(ynorm)
+
+	   xnorm = (2 * x - (xmax + xmin)) / (xmax - xmin)
+	   ynorm = (2 * y - (ymax + ymin)) / (ymax - ymin)
+
+	   P0(xnorm) = 1.0
+	   P1(xnorm) = xnorm
+	   Pm+1(xnorm) = 2.0 * xnorm * Pm(xnorm) - Pm-1(xnorm) 
+
+	   P0(ynorm) = 1.0
+	   P1(ynorm) = ynorm
+	   Pn+1(ynorm) = 2.0 * ynorm * Pn(ynorm) - Pn-1(ynorm) 
+
+Legendre:  Pmn = Pm(xnorm) * Pn(ynorm)
+
+	   xnorm = (2 * x - (xmax + xmin)) / (xmax - xmin)
+	   ynorm = (2 * y - (ymax + ymin)) / (ymax - ymin)
+
+	   P0(xnorm) = 1.0
+	   P1(xnorm) = xnorm
+	   Pm+1(xnorm) = ((2m+1)*xnorm*Pm(xnorm)-m*Pm-1(xnorm))/(m+1)   
+
+	   P0(ynorm) = 1.0
+	   P1(ynorm) = ynorm
+	   Pn+1(ynorm) = ((2n+1)*ynorm*Pn(ynorm)-n*Pn-1(ynorm))/(n+1)   
+.fi
+
+Notice that the x and y values are first normalized to the interval -1 to 1
+over the range of the surface as given by the xmin, xmax, ymin, and ymax
+elements of the database description.
+.ih
+EXAMPLES
+A number of strong arc lines are identified along one column of an arc
+calibration image "arc001".  The arc lines are then reidentified at every
+20th column.  A two dimensional dispersion solution is determined as follows:
+
+	cl> fitcoords arc001 fit.
+
+The fitting is done interactively and deleted points are recorded.
+The fit is recorded under the name fit.arc001.  A set of similar arc
+calibrations are fit non-interactively, with the same points deleted,
+as follows:
+
+	cl> fitcoords arc* interactive=no
+
+Several stellar spectra are identified at different positions along the slit
+and traced to other lines.  A fit to the geometric distortion is determined
+with the command:
+
+	cl> fitcoords star001,star003,star005 fitname=distortion combine=yes
+
+In this case the coordinates from all the tracings are combined in a single
+fit called distortion.
+
+The plots in the plot file are spooled to the standard plotting device as
+follows:
+
+	cl> gkimosaic plotfile
+
+\fBGkimosaic\fR is in the \fBplot\fR package.
+.ih
+SEE ALSO
+transform
+.endhelp
diff --git a/noao/twodspec/longslit/doc/fluxcalib.hlp b/noao/twodspec/longslit/doc/fluxcalib.hlp
new file mode 100644
index 00000000..ee38cee5
--- /dev/null
+++ b/noao/twodspec/longslit/doc/fluxcalib.hlp
@@ -0,0 +1,106 @@
+.help fluxcalib Oct86 noao.twodspec.longslit
+.ih
+NAME
+fluxcalib -- Apply flux calibration
+.ih
+USAGE
+fluxcalib images fluxfile
+.ih
+PARAMETERS
+.ls input
+List of input images to be flux calibrated.
+.le
+.ls output
+List of output flux calibrated images.  The output images may be the same
+as the input images.  The output image will be of type real regardless
+of the input pixel type.
+.le
+.ls fluxfile
+Flux calibration file from \fBonedspec.sensfunc\fR.
+.le
+.ls fnu = no
+Convert the flux calibration to flux per unit frequency (F-nu)?
+.le
+.ls exposure = "otime"
+Exposure time keyword in image headers.
+.le
+.ih
+DESCRIPTION
+The specified images are flux calibrated using a flux calibration image
+file derived from the \fBonedspec\fR package using standard stars.
+The flux calibration pixel values are in magnitudes and the pixel coordinates
+are in wavelength.  The multiplicative calibration factor is given by the
+formula
+
+    factor = 10 ** (-0.4 * calibration) / exposure / dispersion.
+
+Since the calibration data has units of (instrumental intensity) /
+(ergs/cm**2), the exposure time for the image must be in seconds and the
+pixel dispersion in wavelength/pixel to yield units of
+ergs/cm**2/sec/wavelength.
+
+The calibration wavelengths are interpolated to the wavelengths
+of the image pixels and the correction applied to the pixel values.
+Note that the image pixel values are modified.
+
+If flux per unit frequency is requested then the flux values are multiplied
+by
+
+	wavelength ** 2 / velocity of light (in Angstroms/sec)
+
+to yield units of ergs/cm**2/Hz/sec/(wavelength/Angstrom).  Note that normally
+the wavelength units should be Angstroms.
+
+It is possible to flux calibrate images which are binned in logarithmic
+wavelength intervals.  The point to note is that the units of the flux
+calibrated image will be the same.  Therefore, rebinning to linear
+wavelength coordinates requires only interpolation and not flux conservation.
+When extracting standard stars from logarithmicaly bin spectra for determination
+of a flux calibration it is necessary to rebin the extracted one dimensional
+spectra to linear wavelength (required by \fBonedspec\fR) conserving
+flux so that the instrumental counts are preserved.
+
+The image header keyword DISPAXIS must be present with a value of 1 for
+dispersion parallel to the lines (varying with the column coordinate) or 2
+for dispersion parallel to the columns (varying with line coordinate).
+This parameter may be added using \fBhedit\fR.  Note that if the image has
+been transposed (\fBimtranspose\fR) the dispersion axis should still refer
+to the original dispersion axis unless the physical world coordinate system
+is first reset (see \fBwcsreset\R).  This is done in order to allow images
+which have DISPAXIS defined prior to transposing to still work correctly
+without requiring this keyword to be changed.
+.ih
+EXAMPLES
+Standard stars were observed and extracted to one dimensional spectra.
+The standard stars are then used to determine a flux calibration using
+the \fBonedspec\fR package.  A set of dispersion and extinction corrected
+images is flux calibrated in-place with the command
+
+.nf
+	cl> fluxcalib img* img* sens.0000
+.fi
+
+where "sens.0000" is the calibration file produced by the task
+\fBonedspec.sensfunc\fR.
+
+To keep the uncalibrated image:
+
+.nf
+	cl> fluxcalib n1ext.004 n1extf.004 sens.0000
+.fi
+
+3.  If the DISPAXIS keyword is missing and the dispersion is running
+vertically (varying with the image lines):
+
+.nf
+	cl> hedit *.imh dispaxis 2 add+
+.fi
+.ih
+REVISIONS
+.ls FLUXCALIB V2.10
+The output pixel type is now forced to be real.
+.le
+.ih
+SEE ALSO
+onedspec.standard onedspec.sensfunc
+.endhelp
diff --git a/noao/twodspec/longslit/doc/illumination.hlp b/noao/twodspec/longslit/doc/illumination.hlp
new file mode 100644
index 00000000..5697bfad
--- /dev/null
+++ b/noao/twodspec/longslit/doc/illumination.hlp
@@ -0,0 +1,220 @@
+.help iillumination Jul86 noao.twodspec.longslit
+.ih
+NAME
+iillumination -- Determine iillumination calibrations
+.ih
+USAGE
+iillumination images iilluminations
+.ih
+PARAMETERS
+.ls images
+Images to use in determining iillumination calibrations.  These are
+generally sky spectra.  An image section may be used to select only a
+portion of the image.
+.le
+.ls iilluminations
+Iillumination calibration images to be created.  Each iillumination image is
+paired with a calibration image.  If the image exists then it will be modified
+otherwise it is created.
+.le
+.ls interactive = yes
+Graph the average spectrum and select the dispersion bins
+and graph and fit the slit profile for each dispersion bin interactively?
+.le
+.ls bins = ""
+Range string defining the dispersions bins within which the slit profiles
+are determined.  If the range string is null then the dispersion
+bins are determined by the parameter \fInbins\fR.
+.le
+.ls nbins = 5
+If the dispersion bins are not specified explicitly by the parameter
+\fIbins\fR then the dispersion range is divided into this number of
+nearly equal bins.
+.le
+.ls sample = "*"
+Sample of points to use in fitting each slit profile.
+The sample is selected with a range string.
+.le
+.ls naverage = 1
+Number of sample points to average or median before fitting a function.
+If the number is positive the average of each set of naverage sample
+points is formed while if the number is negative then the median of each set
+of points (in absolute value) is formed.  This subsample of points is
+used in fitting the slit profile.
+.le
+.ls function = "spline3"
+Function to fit to each dispersion bin to form the iillumination function.
+The options are "spline1", "spline3", "legendre", and "chebyshev".
+.le
+.ls order = 1
+Order of the fitting function or the number of spline pieces.
+.le
+.ls low_reject = 0., high_reject = 0.
+Rejection limits below and above the fit in units of the residual sigma.
+.le
+.ls niterate = 1
+Number of rejection iterations.
+.le
+.ls grow = 0
+Reject additional points within this distance of points exceeding the
+rejection threshold.
+.le
+.ls interpolator = "poly3"
+Interpolation type.  One of "nearest", "linear", "poly3", "poly5", or
+"spline3".
+.le
+.ls graphics = "stdgraph"
+Graphics output device.  May be one of the standard devices "stdgraph",
+"stdplot", or "stdvdm" or an explicit device.
+.le
+.ls cursor = ""
+Graphics input device.  May be either null for the standard graphics cursor
+or a file containing cursor commands.
+.le
+.ih
+CURSOR KEYS
+The interactive curve fitting package \fBicfit\fR is used to fit a function
+to the average calibration spectrum.  Additional help on using this package
+and the cursor keys is available under the name "icfit".
+
+When the dispersion bins are set graphically the following cursor keys are
+defined.
+
+.ls ?
+Clear the screen and print a menu of the cursor options.
+.le
+.ls i
+Initialize the sample ranges.
+.le
+.ls q
+Exit interactive dispersion bin selection.
+.le
+.ls s
+Set a bin with the cursor.  This may be repeated any number of times.
+Two keystrokes are required to mark the two ends of the bin.
+.le
+
+The parameters are listed or set with the following commands which may be
+abbreviated.  To list the value of a parameter type the command alone.
+
+.nf
+:bins value		Iillumination bins
+:show			Show the values of all the parameters
+.fi
+.ih
+DESCRIPTION
+An iillumination calibration, in the form of an image, is created for each
+longslit calibration image, normally a sky spectrum.  The iillumination
+calibration is determined by fitting functions across the slit (the slit
+profiles) at a number of points along the dispersion, normalizing each fitted
+function to unity at the center of the slit, and interpolating the iillumination
+between the dispersion points.  The fitted data is formed by dividing the
+dispersion points into a set of bins and averaging the slit profiles within
+each bin.  The interpolation type is a user parameter.
+
+The image header keyword DISPAXIS must be present with a value of 1 for
+dispersion parallel to the lines (varying with the column coordinate) or 2
+for dispersion parallel to the columns (varying with line coordinate).
+This parameter may be added using \fBhedit\fR.  Note that if the image has
+been transposed (\fBimtranspose\fR) the dispersion axis should still refer
+to the original dispersion axis unless the physical world coordinate system
+is first reset (see \fBwcsreset\fR).  This is done in order to allow images
+which have DISPAXIS defined prior to transposing to still work correctly
+without requiring this keyword to be changed.
+
+If the output image does not exist it is first created with unit iillumination
+everywhere.  Subsequently the iillumination is only modified in those regions
+occupied by the input image.  Thus, an image section in the input image may
+be used to select the data to be used and for which an iillumination calibration
+will be determined.  This ability is particularly userful when dealing with
+multiple slits or to exclude regions outside the slit.
+
+The dispersion bins may be selected by a range string (\fIbins\fR) or,
+if no range string is given, by the number of bins into which the dispersion
+range is to be divided (\fInbins\fR).  When the interactive parameter
+is set (\fIinteractive\fR) then the average spectrum is graphed and the
+bins may be set using the cursor or with a colon command.  Once the bins
+have been selected exit with (q)uit to continue to the slit profile fitting.
+
+Fitting of the slit profiles is done using the interactive curve fitting
+package (\fBicfit\fR).  The parameters determining the fit are the
+sample points, the averaging bin size, the fitting function,
+the order of the function, the rejection sigmas, the number of
+rejection iterations, and the rejection width.
+The sample points for the average slit profile are selected by a range string.  
+Points in the slit profile not in the sample are not used in determining
+the fitted function.  The selected sample points may be binned into a
+set of averages or medians which are used in the function fit instead of the
+sample points with the averaging bin size parameter
+\fInaverage\fR.  This parameter selects the number of sample points to be
+averaged if its value is positive or the number of points to be medianed
+if its value is negative (naturally, the absolute value is used for the
+number of points).  A value of one uses all sample points without binning.
+The fitted function may be used to reject points from the fit using the
+parameters \fIlow_reject, high_reject, niterate\fR and \fIgrow\fR.  If
+one or both of the rejection limits are greater than zero then the sigma
+of the residuals is computed and points with residuals less than
+\fI-low_reject\fR times the sigma and greater than \fIhigh_reject\fR times
+the sigma are removed and the function fitted again.  In addition points
+within a distance given by the parameter \fIgrow\fR of the a rejected point
+are also rejected.  A value of zero for this parameter rejects only the
+points exceeding the rejection threshold.  Finally, the rejection procedure
+may be iterated the number of times given by the parameter \fIniterate\fR.
+
+The fitted functions may be examined and modified interactively when the
+parameter \fIinteractive\fR is set.  The user is asked before each dispersion
+bin whether to perform the fit interactively.  The possible response are
+"no", "yes", "NO", and "YES".  The lower case responses only affect the
+specified dispersion bin while the upper case responses affect all following
+dispersion bins for the current image.  Thus, if the response is "NO" then
+no further prompts or interactive curve fitting need be performed while if
+the response is "YES" there are no further prompts but the slit profile
+for each dispersion bin must be graphed and exited with (q)uit.
+Changes to the fitting parameters remain in effect until they are next
+changed.  This allows the fitting parameters to be selected from only the first
+dispersion bin without requiring each dispersion bin to be graphed and
+confirmed.
+
+When a dispersion bin is to be fitted interactively the average slit profile
+and the fitted function or the residuals of the fit are graphed.
+Deleted points are marked with an x and rejected points by a diamond.
+The sample regions are indicated along the bottom of the graph.
+The cursor keys and colon commands are used to change the values
+of the fitting parameters, delete points, and window and expand the
+graph.  When the fitted function is satisfactory exit with
+with a carriage return or 'q'.  The prompt for the next dispersion bin will
+then be given until the last dispersion bin has been fit.  The iillumination
+calibration image is then created.
+.ih
+EXAMPLES
+1. To create an iillumination image non-interactively:
+
+.nf
+	cl> iillumination sky illum nbins=8 order=20 interactive=no
+.fi
+
+2. To determine independent iilluminations for a multislit image determine the
+image sections defining each slit.  Then the iillumination functions are
+computed as follows:
+
+.nf
+	cl> iillumination sky[10:20,*],sky[35:45,*] illum,illum
+.fi
+
+3. Generally the slit image sections are prepared in a file which is then
+used to define the lists of input images and iilluminations.
+
+.nf
+	cl> iillumination @slits @illums
+.fi
+
+3.  If the DISPAXIS keyword is missing and the dispersion is running
+vertically (varying with the image lines):
+
+.nf
+	cl> hedit *.imh dispaxis 2 add+
+.fi
+.ih
+SEE ALSO
+icfit, response
+.endhelp
diff --git a/noao/twodspec/longslit/doc/lscombine.hlp b/noao/twodspec/longslit/doc/lscombine.hlp
new file mode 100644
index 00000000..764c3b1b
--- /dev/null
+++ b/noao/twodspec/longslit/doc/lscombine.hlp
@@ -0,0 +1,296 @@
+.help lscombine Jun04 noao.twodspec.longslit
+.ih
+NAME
+lscombine -- Combine longslit images
+.ih
+USAGE
+lscombine input output
+.ih
+PARAMETERS
+.ls input
+List of input two-dimensional images to combine.  This task is typically
+used with dispersion calibrated longslit images though it will work with
+any 2D images.
+.le
+.ls output
+Output combined image.
+.le
+.ls headers = "" (optional)
+Optional output multiextension FITS file where each extension is a dataless
+headers from each input image.
+.le
+.ls bpmasks = "" (optional)
+Optional output bad pixel mask with good values of 0 and bad values of 1.
+Output pixels are marked as bad when no input pixels contributed to the
+output pixel.  The file name is also added to the output image header under
+the keyword BPM.
+.le
+.ls rejmask = "" (optional)
+Optional output mask file identifying rejected or excluded pixels.  The
+pixel mask is the size of the output image but there is one extra dimension
+with length equal to the number of input images.  Each element of the
+highest dimension is a mask corresponding to an input image with values of
+1 for rejected or excluded pixels and values of 0 for pixels which were
+used.  The order of the masks is the order of the input images and image
+header keywords, indexed by the pixel coordinate of the highest dimension
+identify the input images.  Note that the pixel positions are in the output
+pixel coordinate system.
+.le
+.ls nrejmasks = "" (optional)
+Optional output pixel mask giving the number of input pixels rejected or
+excluded from the input images.
+.le
+.ls expmasks = "" (optional)
+Optional output exposure mask giving the sum of the exposure values of
+the input images with non-zero weights that contributed to that pixel.
+Since masks are integer, the exposure values may be scaled to preserve
+dynamic range and fractional significance.  The scaling values are given in
+the header under the keywords MASKSCAL and MASKZERO.  Exposure values are
+computed from the mask values by scale * value + zero where scale is the
+value of the MASKSCAL keyword and zero is the value of the MASKZERO
+keyword.
+.le
+.ls sigma = "" (optional)
+Optional output sigma image.  The sigma is the standard deviation,
+corrected for a finite population, of the input pixel values (excluding
+rejected pixels) about the output combined pixel values.
+.le
+
+.ls logfile = "STDOUT" (optional)
+Optional output log file.  If no file is specified then no log information is
+produced.  The special filename "STDOUT" prints log information to the
+terminal.
+.le
+
+.ls interptype = "spline3"
+Image interpolation type for any resampling prior to combining.
+The allowed types are "nearest" (nearest neighbor), "linear" (bilinear),
+"poly3" (bicubic polynomial), "poly5" (biquintic polynomial), and "spline3"
+(bicubic polynomial).
+.le
+.ls x1 = INDEF, y1 = INDEF
+User coordinates of the first output column and line.  If INDEF then it
+is based on the smallest value over all the images.
+.le
+.ls x2 = INDEF, y2 = INDEF
+User coordinates of the last output column and line.  If INDEF then it
+is based on the largest value over all the images.
+.le
+.ls dx = INDEF, dy = INDEF
+User coordinate pixel interval of the output.  If INDEF then the it
+is based on smallest interval (i.e. highest dispersion) over all the images.
+.le
+.ls nx = INDEF, ny = INDEF
+Number of output pixels.  If INDEF then it is based on the values of the
+other coordinate parameters.
+.le
+
+.ls combine = "average" (average|median|sum)
+Type of combining operation performed on the final set of pixels (after
+offsetting, masking, thresholding, and rejection).  The choices are
+"average", "median", or "sum".  The median uses the average of the two central
+values when the number of pixels is even.  For the average and sum, the
+pixel values are multiplied by the weights (1 if no weighting is used)
+and summed.  The average is computed by dividing by the sum of the weights.
+If the sum of the weights is zero then the unweighted average is used.
+.le
+.ls reject = "none" (none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip)
+Type of rejection operation performed on the pixels remaining after offsetting,
+masking and thresholding.  The algorithms are described in the
+DESCRIPTION section.  The rejection choices are:
+
+.nf
+      none - No rejection
+    minmax - Reject the nlow and nhigh pixels
+   ccdclip - Reject pixels using CCD noise parameters
+  crreject - Reject only positive pixels using CCD noise parameters
+   sigclip - Reject pixels using a sigma clipping algorithm
+ avsigclip - Reject pixels using an averaged sigma clipping algorithm
+     pclip - Reject pixels using sigma based on percentiles
+.fi
+
+.le
+.ls outtype = "real" (none|short|ushort|integer|long|real|double)
+Output image pixel datatype.  The pixel datatypes are "double", "real",
+"long", "integer", unsigned short "ushort", and "short" with highest
+precedence first.  If "none" is specified then the highest precedence
+datatype of the input images is used.  When there is a mixture of
+short and unsigned short images the highest precedence become integer.
+The datatypes may be abbreviated to a single character.
+.le
+.ls outlimits = ""
+Output region limits in pixels specified as pairs of whitespace separated
+values.  The first two numbers are the limits along the first output image
+dimension, the next two numbers are the limits along the second dimension,
+and so on.  If the higher dimension limits are not specified they default
+to the full range.  Therefore, if no limits are specified then the full
+output is created.  Note that the output size is computed from all the
+input images including offsets if specified and the coordinates are
+relative to that size.
+.le
+.ls masktype = "none" (none|goodvalue)
+Type of pixel masking to use.  If "none" then no pixel masking is done
+even if an image has an associated  pixel mask.  Otherwise the
+value "goodvalue" will use any mask specified for the image under
+the BPM keyword.  The values of the mask will be interpreted as
+zero for good pixels and non-zero for bad pixels.  The mask pixels
+are assumed to be registered with the image pixels.
+.le
+.ls blank = 0.
+Output value to be used when there are no pixels.
+.le
+
+.ls scale = "none" (none|mode|median|mean|exposure|@<file>|!<keyword>)
+Multiplicative image scaling to be applied.  The choices are none, multiply
+by the reciprocal of the mode, median, or mean of the specified statistics
+section, multiply by the reciprocal of the exposure time in the image header,
+multiply by the values in a specified file, or multiply by a specified
+image header keyword.  When specified in a file the scales must be one per
+line in the order of the input images.
+.le
+.ls zero = "none" (none|mode|median|mean|@<file>|!<keyword>)
+Additive zero level image shifts to be applied.  The choices are none, add
+the negative of the mode, median, or mean of the specified statistics
+section, add the values given in a file, or add the values given by an
+image header keyword.  When specified in a file the zero values must be one
+per line in the order of the input images.  File or keyword zero offset
+values do not allow a correction to the weights.
+.le
+.ls weight = "none" (none|mode|median|mean|exposure|@<file>|!<keyword>)
+Weights to be applied during the final averaging.  The choices are none,
+the mode, median, or mean of the specified statistics section, the exposure
+time, values given in a file, or values given by an image header keyword.
+When specified in a file the weights must be one per line in the order of
+the input images and the only adjustment made by the task is for the number of
+images previously combined.   In this case the weights should be those
+appropriate for the scaled images which would normally be the inverse
+of the variance in the scaled image.
+.le
+.ls statsec = ""
+Section of images to use in computing image statistics for scaling and
+weighting.  If no section is given then the entire region of the input is
+sampled (for efficiency the images are sampled if they are big enough).
+When the images are offset relative to each other one can precede the image
+section with one of the modifiers "input", "output", "overlap".  The first
+interprets the section relative to the input image (which is equivalent to
+not specifying a modifier), the second interprets the section relative to
+the output image, and the last selects the common overlap and any following
+section is ignored.
+.le
+.ls  expname = ""
+Image header keyword to be used with the exposure scaling and weighting
+options.  Also if an exposure keyword is specified that keyword will be
+added to the output image using a weighted average of the input exposure
+values.
+.le
+
+.ce
+Algorithm Parameters
+.ls lthreshold = INDEF, hthreshold = INDEF
+Low and high thresholds to be applied to the input pixels.  This is done
+before any scaling, rejection, and combining.  If INDEF the thresholds
+are not used.
+.le
+.ls nlow = 1,  nhigh = 1 (minmax)
+The number of low and high pixels to be rejected by the "minmax" algorithm.
+These numbers are converted to fractions of the total number of input images
+so that if no rejections have taken place the specified number of pixels
+are rejected while if pixels have been rejected by masking, thresholding,
+or nonoverlap, then the fraction of the remaining pixels, truncated
+to an integer, is used.
+.le
+.ls nkeep = 1
+The minimum number of pixels to retain or the maximum number to reject
+when using the clipping algorithms (ccdclip, crreject, sigclip,
+avsigclip, or pclip).  When given as a positive value this is the minimum
+number to keep.  When given as a negative value the absolute value is
+the maximum number to reject.  The latter is in addition to pixels
+missing due to non-overlapping offsets, bad pixel masks, or thresholds.
+.le
+.ls mclip = yes (ccdclip, crreject, sigclip, avsigcliip)
+Use the median as the estimate for the true intensity rather than the
+average with high and low values excluded in the "ccdclip", "crreject",
+"sigclip", and "avsigclip" algorithms?  The median is a better estimator
+in the presence of data which one wants to reject than the average.
+However, computing the median is slower than the average.
+.le
+.ls lsigma = 3., hsigma = 3. (ccdclip, crreject, sigclip, avsigclip, pclip)
+Low and high sigma clipping factors for the "ccdclip", "crreject", "sigclip",
+"avsigclip", and "pclip" algorithms.  They multiply a "sigma" factor
+produced by the algorithm to select a point below and above the average or
+median value for rejecting pixels.  The lower sigma is ignored for the
+"crreject" algorithm.
+.le
+.ls rdnoise = "0.", gain = "1.", snoise = "0." (ccdclip, crreject)
+CCD readout noise in electrons, gain in electrons/DN, and sensitivity noise
+as a fraction.  These parameters are used with the "ccdclip" and "crreject"
+algorithms.  The values may be either numeric or an image header keyword
+which contains the value.  The noise model for a pixel is:
+
+.nf
+    variance in DN = (rdnoise/gain)^2 + DN/gain + (snoise*DN)^2
+    variance in e- = (rdnoise)^2 + (gain*DN) + (snoise*(gain*DN))^2
+		   = rdnoise^2 + Ne + (snoise * Ne)^2
+.fi
+
+where DN is the data number and Ne is the number of electrons.  Sensitivity
+noise typically comes from noise introduced during flat fielding.
+.le
+.ls sigscale = 0.1 (ccdclip, crreject, sigclip, avsigclip)
+This parameter determines when poisson corrections are made to the
+computation of a sigma for images with different scale factors.  If all
+relative scales are within this value of unity and all relative zero level
+offsets are within this fraction of the mean then no correction is made.
+The idea is that if the images are all similarly though not identically
+scaled, the extra computations involved in making poisson corrections for
+variations in the sigmas can be skipped.  A value of zero will apply the
+corrections except in the case of equal images and a large value can be
+used if the sigmas of pixels in the images are independent of scale and
+zero level.
+.le
+.ls pclip = -0.5 (pclip)
+Percentile clipping algorithm parameter.  If greater than
+one in absolute value then it specifies a number of pixels above or
+below the median to use for computing the clipping sigma.  If less
+than one in absolute value then it specifies the fraction of the pixels
+above or below the median to use.  A positive value selects a point
+above the median and a negative value selects a point below the median.
+The default of -0.5 selects approximately the quartile point.
+.le
+.ls grow = 0.
+Radius in pixels for additional pixel to be rejected in an image with a
+rejected pixel from one of the rejection algorithms.  This applies only to
+pixels rejected by one of the rejection algorithms and not the masked or
+threshold rejected pixels.
+.le
+.ih
+DESCRIPTION
+\fBLSCOMBINE\fR combines two-dimensional longslit images by first
+resampling them to a common world coordinate system, if not already on
+the same system, and then combining the matching pixels.  The final world
+coordinate system is specified by parameters or by looking at the maximum
+ranges and minimum intervals over the input data.
+
+Algorithmically it is a combination of the tasks \fBTRANSFORM\fR (using
+the WCS) and \fBIMCOMBINE\fR.  When executing it will generate temporary
+images ("lsc*") and masks ("mlsc*") if the images are not already on a
+common world coordinate system.  The user only need be aware of this
+in case of an unexpected abort leaving these files behind.
+
+Rather than repeat the details the user should consult the descriptions
+for \fBTRANSFORM\fR and \fBIMCOMBINE\fR ignoring parameters which are
+not part of this task.
+.ih
+EXAMPLES
+.nf
+    cl> lscombine obj* lscomb
+.fi
+.ih
+NOTES
+.ls LSCOMBINE: V2.12.3
+This is a new task in this relese.
+.le
+.ih
+SEE ALSO
+transform, imcombine. odcombine 
+.endhelp
diff --git a/noao/twodspec/longslit/doc/lslit.ms b/noao/twodspec/longslit/doc/lslit.ms
new file mode 100644
index 00000000..de35424f
--- /dev/null
+++ b/noao/twodspec/longslit/doc/lslit.ms
@@ -0,0 +1,712 @@
+.nr PS 9
+.nr VS 10
+.ps 9
+.vs 10
+.po 0.50i
+.nr PO 0.50i
+.ll 7.0i
+.nr LL 7.0i
+.nr PD 1v
+.EQ
+delim	$$
+.EN
+.TL
+Reduction of long slit spectra with IRAF
+.AU
+Francisco Valdes
+.AI
+IRAF Group, Central Computer Services, National Optical Astronomy Observatories
+P.O. Box 26732, Tucson, Arizona, 85726
+March 1986
+.AB
+Tools for the reduction of long slit spectra within the Interactive
+Data Reduction and Analysis Facility (IRAF) at the National Optical
+Astronomy Observatory (NOAO) are described.  The user interface
+(commands and special features) and the algorithms are discussed.
+Application of the reduction package to multi-slit images is briefly
+outlined.  The author developed and supports the package at NOAO.
+.AE
+.LP
+
+.ce
+\fB1. Introduction\fR
+.PP
+This paper describes the tools currently available within the Interactive Data
+Reduction and Analysis Facility (IRAF) at the National Optical
+Astronomy Observatories (NOAO) for the reduction of long slit spectra.
+The reduction tools, called tasks, are organized as an IRAF package
+called \fBlongslit\fR.  The tasks in the package are summarized below.
+
+.TS
+center;
+n n.
+apdefine \&- Define apertures for 1D aperture extraction	identify \&- Identify features
+apextract \&- Extract 1D aperture spectra	illumination \&- Determine illumination calibration
+background \&- Fit and subtract a line or column background	reidentify \&- Reidentify features
+extinction \&- Apply atmospheric extinction corrections to images	response \&- Determine response calibration
+fitcoords \&- Fit user coordinates to image coordinates	setimhdr \&- Set longslit image header parameters
+fluxcalib \&- Apply flux calibration to images	transform \&- Transform longslit images to user coordinates
+.TE
+
+.PP
+Since there are many types of long slit spectra, detectors, and
+astronomical goals we do not describe a reduction procedure or path.
+Reduction manuals giving cookbook instructions for the reduction of
+certain types of data at NOAO are available from the Central Computer
+Services Division.  Instead, each task is discussed separately.  The
+primary emphasis is on the algorithms.
+.PP
+The following terminology is used in this paper.  A \fIlong slit
+spectrum\fR is a two dimensional image.  The two image axes are
+called \fIaxis 1\fR and \fIaxis 2\fR and the pixel coordinates are
+given in terms of \fIcolumns\fR and \fIlines\fR.  The long slit
+axes are called the \fIdispersion axis\fR and the \fIslit
+axis\fR.  The reduction tasks do not require a particular orientation
+of the dispersion and slit axes, however, these axes should be
+fairly closely aligned with the image axes.  \fBIn the remainder of
+this paper the slit axis will correspond to image axis 1 and
+the dispersion axis with image axis 2\fR.
+.PP
+There are five types of operations performed by the tasks in the
+\fBlongslit\fR package: (1) detector response calibration, (2) geometric
+distortion and coordinate rectification, (3) background sky subtraction,
+(4) flux calibration, and (5) aperture extraction of one dimensional spectra.
+These are listed in the order in which they are usually performed and in
+which they are discussed in this paper.  There is also an initialization
+task, \fBsetimhdr\fR, and a general routine, \fBicfit\fR, used in may of the
+long slit tasks.  These are described first.
+.SH
+SETIMHDR - Set long slit image header parameters
+.PP
+The tasks in the \fBlongslit\fR package use information contained in the IRAF
+image header.  The task \fBsetimhdr\fR sets a required parameter in the image
+header advising the long slit tasks which image axis corresponds to the
+dispersion axis; the tasks work equally well with the dispersion axis
+aligned with the image lines or the image columns.  This is generally
+the first task executed when reducing long slit spectra.
+.SH
+ICFIT - The IRAF Interactive Curve Fitting routine
+.PP
+Many of the tasks in the IRAF which fit a one dimensional function
+utilize the same powerful interactive curve fitting routine called
+\fBicfit\fR.  This routine allows the user to perform sophisticated
+function fitting interactively and graphically or to specify the
+function fitting parameters in advance and run the task
+non-interactively.  That this routine is used in many tasks also has
+the advantage that the user need not learn a new set of commands and
+features for each task requiring function fitting.
+.PP
+The features of the this curve fitting tool include:
+.IP (1)
+A choice of four fitting functions; Chebyshev polynomial, Legendre polynomial,
+a linear spline, and a cubic spline.
+.nr PD 0v
+.IP (2)
+A choice of the polynomial order or the number of spline pieces.
+.IP (3)
+Deletion of individual points from the fit.
+.IP (4)
+Selection of a sample or subset of points to be fit (excluding the rest).
+.IP (5)
+Iterative deletion of points with large residuals from the fitted function.
+.IP (6)
+Binning sets of neighboring points into averages or medians which are then
+fit instead of the individual points.
+.nr PD 1v
+.LP
+In addition to the above features the interactive graphics mode allows
+the user to:
+.IP (1)
+Iterate any number of times on the fitting parameters.
+.nr PD 0v
+.IP (2)
+Display the fit in several different ways; residuals, ratios, and the fit
+overplotted on the data points.
+.IP (3)
+Manipulate the graphs using a large set of commands for formating and
+expanding any part of a graph for detailed examination.
+.IP (4)
+Produce copies of the graphs with a snap-shot command.
+.nr PD 1v
+.PP
+For the applications described in this paper the most important features
+are the ability to adjust the function order, exclude bad points, and
+select subsets of points to be fit.  Other useful features are taking the
+median or average of a set of points before fitting and iteratively
+rejecting deviant points.  When used non-interactively the user
+selects the function and the order.  The \fBlongslit\fR tasks using the
+interactive curve fitting routine are \fBbackground\fR, \fBidentify\fR,
+\fBillumination\fR, and \fBresponse\fR.
+
+
+.ce
+\fB2. Detector Response Calibrations\fR
+.PP
+The relative response of the pixels in the detector and the transmission
+of the spectrograph along the slit are generally not uniform.  Outside
+of the \fBlongslit\fR package are IRAF tasks for creating \fIflat fields\fR
+from quartz lamp calibration images which correct for small scale response
+variations.  Flat fields, however, do not correct for spectrograph
+transmission variations or any large scale response patterns.  The tasks
+\fBresponse\fR and \fBillumination\fR are specially designed for long slit
+spectra to correct both the small scale variations as well as
+larger scale response patterns and slit illumination and transmission effects.
+.PP
+These algorithms make the assumption that the wavelength and slit axis
+are very nearly aligned with the image lines and columns.  If this is
+not true then the images must be aligned first or alternate response
+calibration methods used.
+.SH
+RESPONSE - Determine response calibration
+.PP
+The task \fBresponse\fR is used with calibration images which (1)
+do not have any intrinsic structure along the slit dimension and (2)
+have a smooth spectrum without emission or absorption features.
+Typically the calibration images consist of quartz lamp exposures.
+The idea is to determine a response correction that turns an observed
+calibration image into one which is identical at all points along the
+slit.
+.PP
+From (1) a one dimensional spectrum is obtained by averaging along the
+slit; i.e. averaging the columns.  Based on (2) a smoothing function is
+fit to the one dimensional spectrum to reduce noise and eliminate
+response effects which are coherent in wavelength such as fringing.
+The response correction for each pixel is then obtained by dividing
+each point along the slit (the columns) by the smoothed one dimensional
+spectrum.
+.PP
+The purpose of fitting a function to the one dimensional spectrum is to
+reduce noise and to remove coherent response effects which are not part
+of the true quartz spectrum.  Examples of coherent response effects are
+fringing and regions of low or high response running along the slit
+dimension which are, therefore, not averaged out in the one dimensional
+spectrum.  The choice of smoothing function is dictated by the behavior
+of the particular detector.  Difficult cases are treated with the
+interactive graphical function fitting routine \fBicfit\fR.  For the
+automated case the user specifies the smoothing function and order.
+.PP
+This calibration algorithm has the advantage of removing spatial
+frequencies at almost all scales; in particular, there is no modeling
+of the response pattern along the slit dimension.  The only modeling is
+the fit to the \fBaverage\fR spectrum of the calibration source.  In
+tests at NOAO this algorithm was able to reduce the response variations
+to less 0.2%, to correct for a broad diagonal region of low response in
+one of the CCD detectors (the CRYOCAM), and to remove strong fringing
+in spectra taken in the red portion of the spectrum where the detector
+is particularly subject to fringing.
+.PP
+One feature common to \fBresponse\fR and \fBillumination\fR is that
+the algorithm can be restricted to a section of the calibration image.
+The response corrections are then determined only within that section.
+If a response image does not exist initially then the response values outside
+the section are set to unity.  If the response image does exist then
+the points outside the section are not changed.  This feature is used
+with data containing several slits on one image such as produced by
+the multi-slit masks at Kitt Peak National Observatory.
+.PP
+When there are many calibration images this algorithm may be applied to
+each image separately or to an average of the images.  If applied
+separately the response images may be averaged or applied to the
+appropriate long slit spectra; typically the one nearest the object
+exposure in time or telescope position.  The task allows a list of
+calibration images from which a set of response corrections is
+determined.
+.PP
+Figure 1 shows a portion of an average quartz spectrum ratioed with the
+smooth fit to the spectrum.  It is one of the graphs which can be
+produced with the \fBicfit\fR routine and, with the other figures in
+this paper, illustrates the formating,
+zooming, and snap-shot capabilities in IRAF.  The figure shows considerable
+structure of periodic high response lines and fringing which, because
+they are primarily aligned with the image lines, are still present in
+the average quartz spectrum.  Note that this is not the response
+since it is the average of all the columns; an actual response column
+would have much larger variations including pixel-to-pixel response
+differences as well as large scale response patterns such as the diagonal
+structure mentioned previously.
+.SH
+ILLUMINATION - Determine illumination calibration
+.PP
+The task \fBillumination\fR corrects for large scale variations along
+the slit and dispersion dimensions due to illumination or spectrograph
+transmission variations (often called the \fIslit profile\fR).  When
+the detector response function is determined from quartz calibration
+images, using \fBresponse\fR, an illumination error may be introduced
+due to differences in the way the spectrograph is illuminated by the
+quartz lamp compared to that of an astronomical exposure.  This
+violates the the assumption that the calibration spectrum has no
+intrinsic structure along the slit.  \fBIllumination\fR is also used
+when only the small scale response variations have been removed using a
+flat field correction.
+.PP
+The approach to determining the response correction is similar to that
+described for \fBresponse\fR.  Namely, the response correction is the
+ratio of a calibration image to the expected calibration image.  Again,
+the expected calibration image is that which has no structure along the
+slit.  Calibration images may be quartz lamp exposures, assuming there
+is no illumination problem, and blank sky exposures.  In the worst
+case, object exposures also may be used if the extent of the object in
+the slit is small.
+.PP
+There are several important differences between this algorithm and that
+of \fBresponse\fR:
+.IP (1)
+The spectra are not required to be smooth in wavelength and may contain
+strong emission and absorption lines.
+.nr PD 0v
+.IP (2)
+The response correction is a smooth, large scale function only.
+.IP (3)
+Since the signal-to-noise of spectra from blank sky and object images is
+lower than quartz calibration images, steps must be taken to minimize noise.
+.IP (4)
+Care must be taken that the spectral features do not affect the
+response determination.
+.nr PD 1v
+.PP
+The algorithm which satisfies these requirements is as follows.  First the
+calibration spectrum is binned in wavelength.  This addresses the
+signal-to-noise consideration (3) and is permitted because only large
+scale response variations are being determined (2).  Next a smoothing
+function is fit along the slit dimension in each bin; i.e. each
+wavelength bin is smoothed to reduce noise and determine the large
+scale slit profile.  Then each bin is normalized to the central point
+in the slit to remove the spectral signature of the calibration image.
+Finally, the binned response is interpolated back to the
+original image size.
+.PP
+The normalization to the central point in the slit is an assumption
+which limits the ability of the illumination algorithm to correct
+for all wavelength dependent response effects.  There is a wavelength
+dependence, however, in that the slit profile is a function of the
+wavelength though normalized to unity at the central point of the
+slit.
+.PP
+The wavelength bins and bin widths need not be constant.  The bins are
+chosen to sample the large scale variations in the slit profile as a
+function of wavelength, to obtain good signal statistics, and to avoid
+effects due to variations in the positions and widths of strong
+emission lines.  This last point means that bin boundaries should not
+intersect strong emission lines though the bin itself may and should
+contain strong lines.  Another way to put this criterion is that
+changes in the data in the wavelength bins should be small when the
+bin boundaries are changed slightly.
+.PP
+The bins may be set interactively using a graph of the average
+spectrum or automatically by dividing the dispersion axis into a
+specified number of equal width bins.  When the number of bins is small
+(and the number of wavelength points in each bin is large) bin
+boundary effects are likely to be insignificant.
+A single bin consisting of all wavelengths, i.e. the sum of all the image
+lines, may be used if no wavelength dependence is expected in the
+response.  Illumination effects introduced with \fBresponse\fR,
+however, appear as wavelength dependent variations in the slit
+profile.
+.PP
+Smoothing of each bin along the slit dimension is done with the
+interactive curve fitting routine.  The curve fitting may be done
+graphically and interactively on any set of bins or automatically by
+specifying the function and order initially.  The fitting should be
+done interactively (at least on the first bin) in order to exclude
+objects when the sky is not truly blank and contains faint objects or
+when object exposures must be used to determine the slit profile.
+.PP
+As with \fBresponse\fR, several blank sky images may be available
+(though this is less often true in practice).  An illumination
+correction may be determined for each calibration image or one
+illumination correction may be computed from the average of the
+calibration images.  Also the illumination response correction may be
+determined for only a section of the calibration image so as to be
+applicable to multi-slit data.
+.PP
+Figure 2 shows the fit to one of the wavelength bins; lines 1 to 150 have been
+summed and the sum is plotted as a function of slit position (column).
+The data is from a response image produced by \fBresponse\fR.  This
+figure illustrates a number of things.  \fBIllumination\fR may be run
+on a response image to remove the large scale illumination and slit
+transmission effects.  This creates a flat field in a manner different than
+normal surface fitting.  The figure shows that response effects occur
+at all scales (keeping in mind that the pixel-to-pixel response has
+been largely averaged out by summing 150 columns).  It also illustrates
+how the illumination algorithm works for a typical slit profile.  In
+this example about half the large scale variation in the slit profile
+is due to illumination effects and half is real slit transmission
+variations.  For a blank sky or object image the main differences
+would be larger data values (hundreds to thousands) and possibly
+objects present in the slit to be excluded from the fit.
+
+
+.ce
+\fB3. Distortion Corrections and Coordinate Transformations\fR
+.PP
+The removal of geometric distortions and the application of coordinate
+transformations are closely related.  Both involve applying a
+transformation to the observed image to form the desired final image.
+Generally, both steps are combined into a single image transformation
+producing distortion corrected images with linear wavelength
+coordinates (though the pixel interval may be logarithmic).
+This differs from other systems (for example, the Kitt Peak IPPS) which
+perform distortion corrections on each axis independently and then
+apply a dispersion correction on the distortion corrected image.
+While this approach is modular it requires several transformations of
+the images and does not couple the distortions in each dimension into
+a single two dimensional distortion.
+.PP
+To transform long slit images requires (1) identifying spectral
+features and measuring their positions in arc lamp or sky
+exposures at a number of points in the image, (2) determining the
+distortions in the slit positions at a number of points along the
+dispersion axis using either calibration images taken with special
+masks or narrow objects such as stars,
+(3) determining a transformation function between the image
+coordinates and the user coordinates for the measured wavelength and
+slit positions, (4) and interpolating the images to a uniform grid in
+the user coordinates according to the transformation function.  The
+coordinate feature information and the transformation functions are
+stored in a database.  If needed, the database may be examined and
+edited.
+.PP
+An important part of this task is the feature center determination.  This
+algorithm is described in a separate section below.
+.SH
+IDENTIFY - Identify features
+.PP
+The tasks \fBidentify\fR and \fBreidentify\fR are general tools used
+for one dimensional, multi-aperture, multi-slit, echelle, and long slit
+spectra.  The tasks are also general in the sense that they are used to
+identify features in any one dimensional vector.  For long slit
+reductions they are used to identify and trace objects in the slit and
+to identify, trace, and determine wavelength solutions for spectral
+features from arc calibration images and from sky and object
+exposures.
+.PP
+\fBIdentify\fR is used to identify emission or absorption features in a
+one dimensional projection of an image.  This projection consists of an
+image line or column or the
+average of many lines or columns.  Averaging is used to increase the
+signal in weak features and provide better accuracy in determining the
+one dimensional positions of the features.  The identified features are
+assigned user coordinates.  The user coordinates will ultimately define
+the final coordinates of the rectified images.
+.PP
+For determining the distortions along the slit, the positions of object
+profiles or profiles obtained with multi-aperture masks in the slit
+are measured at a reference line.  The user coordinates are then taken to be
+the positions at this reference line.  The
+coordinate rectification will then correct for the distortion to bring the
+object positions at the other lines to the same position.
+(Note that it is feasible to make an actual coordinate transformation of
+the spatial axis to arc seconds or some other units).
+.PP
+For wavelength features arc calibration images are generally used,
+though sky and object exposures can also be used if necessary.  After
+marking a number of spectral features and assigning them wavelength
+coordinates a \fIdispersion solution\fR can be computed relating the
+image coordinate to the wavelength; $lambda~=~f(l)$, where $lambda$ is
+wavelength and $l$ is the image line.  The dispersion
+solution is determined using the \fBicfit\fR routines described
+earlier.  This dispersion solution is used in the long slit package
+only as an aid in finding misidentified lines and to automatically add
+new features from a wavelength list.  The dispersion solution actually
+used in transforming the images is a two dimensional function
+determined with the task \fBfitcoords\fR.
+.PP
+Figure 3 shows a graph from \fBidentify\fR used on a Helium-Neon-Argon
+arc calibration image.  Only three lines were identified interactively
+and the reminder were added automatically from a standard line list.
+Note that the abscissa is in wavelength units and the ordinate is
+displayed logarithmically.  The latter again illustrates the flexibility
+the user has to modify the graph formats.  Each marked feature is
+stored in a database and is automatically reidentified at other columns
+in the image with \fBreidentify\fR.
+.SH
+REIDENTIFY - Reidentify features
+.PP
+The task \fBreidentify\fR automatically reidentifies the spectral and
+object features and measures their positions at a number of other
+columns and lines starting from those identified interactively with
+\fBidentify\fR.  The algorithms and the feature information produced is
+the same as that of \fBidentify\fR including averaging a number of
+lines or columns to enhance weak features.  The automatic tracing can
+be set to stop or continue when a feature fails to be found in a new
+column or line; failure is defined by the position either becoming
+indeterminate or shifting by more than a specified amount
+(\fIcradius\fR defined in the next section).
+.SH
+CENTER1D - One dimensional feature centering
+.PP
+The one dimensional position of a feature is determined by solving the equation
+
+.EQ
+define I0 'I sub 0'
+define XC 'X sub c'
+.EN
+.EQ (1)
+int ( I - I0 ) f( X - XC ) dX~=~0
+.EN
+
+where $I$ is the intensity at position $X$, $I0$ is the continuum
+intensity, $X$ is the vector coordinate, and $XC$ is the desired
+feature position.  The convolution function $f(X- XC )$ is a
+sawtooth as shown in figure 4.  For absorption features the negative of this
+function is used.  The figure defines the parameter \fIfwidth\fR which
+is set to be approximately the width of the feature.  If it is too
+large the centering may be affected by neighboring features and if it
+is too small the accuracy is worse.
+.PP
+For emission features the continuum, $I0$, is assumed to be zero.
+For absorption features the continuum
+is the maximum value in the region around the initial guess
+for $XC$.  The size of the region on each side of the initial guess is
+the sum of \fIfwidth\fR/2, to allow for the feature itself, \fIcradius\fR,
+to allow for the uncertainty in the feature position, and \fIfwidth\fR, for a
+buffer.  Admittedly this is
+not the best continuum but it contains the fewest assumptions and is
+tolerant of nearby contaminating features.
+.PP
+Equation (1) is solved iteratively starting with the initial position.
+When successive positions agree within 0.1% of a pixel the position is
+returned.  If the position wanders further than the user defined
+distance \fIcradius\fR from the initial guess or outside of the data
+vector then the position is considered to be indefinite.
+.SH
+FITCOORDS - Fit user coordinates to image coordinates
+.PP
+Let us denote the image coordinates of a point in the two dimensional
+image as $(c,~l)$ where $c$ is the column coordinate
+and $l$ is the line coordinate.  Similarly, denote the
+long slit coordinates as $(s,~lambda )$ where $s$ is
+the slit position and $lambda$ is the wavelength.
+The results of \fBidentify\fR and \fBreidentify\fR is a set of points
+$(c,~l,~s)$ and $(c,~l,~lambda )$ recorded in the database.
+.PP
+Two dimensional functions of the image coordinates are fit to the user
+coordinates for each set of slit and wavelength features,
+$s~=~t sub s (c, l)$ and $lambda~=~t sub lambda (c, l)$, which are
+stored in the database.
+Note that the second function is a two dimensional dispersion solution.
+It is this function which is used to transform the long slit images to
+linear wavelength coordinates.  Many images may be used to create a
+single transformation or each calibration images may be used separately
+to create a set of transformations.
+.PP
+This task has both an interactive and non-interactive mode.  For the
+non-interactive mode the user specifies the transformation function,
+either a two dimensional Chebyshev or Legendre polynomial, and separate
+orders for the column and line axes.  When run interactively the
+user can try different functions and orders, delete bad points, and
+examine the data and the transformation in a variety of graphical formats.
+The interactive option is quite useful in initially setting the
+transformation function parameters and deleting bad points.
+The two dimensional function fitting routine is similar in spirit to the
+\fBicfit\fR one dimensional function fitting routine.  It is possible
+that this routine may find uses in other IRAF tasks.
+.PP
+Figure 5 shows a graph from \fBfitcoords\fR.  The feature image coordinates
+of four objects in the slit (the first of which is very weak)
+from \fBidentify\fR and \fBreidentify\fR are plotted.  This information
+is used to measure the distortion of the spectrograph in the slit axis.
+This example shows particularly gross distortions; often the distortions
+would not be visible in such a graph, though expanding it would make
+the distortion visible.  The transformation surface fit to this data
+removes this distortion almost entirely as seen in the residual plot
+of figure 6.  Figure 7 shows the equivalent residual plot for the
+wavelength coordinates; a two dimensional dispersion solution.
+.SH
+TRANSFORM - Transform long slit images to user coordinates
+.PP
+The coordinate transformations determined with the task \fBfitcoords\fR are
+read from the database.  The transformations are evaluated on a grid of
+columns and lines, $s sub i~=~t sub s (c sub i , l sub i )$ and
+$lambda sub i~=~t sub lambda (c sub i , l sub i )$.
+If no transformation is defined for a particular dimension then a unit
+transformation is used.  If more than one transformation for a dimension
+is given then a set of points is computed for each transformation.
+The inverse transformations are obtained by fitting transformation
+functions of the same type and orders to the set of slit position and
+wavelength points.  Note how this allows combining separate
+transformations into one inverse transformation.
+.PP
+The inverse transformations, $c~=~t sub c (s, lambda )$ and
+$l~=~t sub l (s, lambda )$, are used to rectify a set of input images.
+The user specifies a linear grid for the transformed images by defining some
+subset of the starting and ending coordinates, the pixel interval, and the
+number of points.  In addition the pixel interval can be specified to be
+logarithmic; used primarily on the wavelength axis for radial
+velocity studies.  The inverse transformations define the image column
+and line to be interpolated in the input image.  The user has the choice
+of several types of image interpolation; bilinear, bicubic, and biquintic
+polynomials and bicubic spline.  In addition the interpolation
+can be specified to conserve flux by multiplying the interpolated value
+by the Jacobian of the transformation.
+.PP
+The wavelength of the first pixel and the pixel wavelength interval are
+recorded in image headers for later use in making plots and in the
+\fBonedspec\fR package.  In addition a flag is set in the header indicating
+that the image has been dispersion corrected.
+
+
+.ce
+\fB4. Background Subtraction\fR
+.SH
+BACKGROUND - Fit and subtract a line or column background
+.PP
+If required, the background sky at each wavelength is subtracted from
+the objects using regions of the slit not occupied by the object.
+This must be done on coordinate rectified images since the lines or
+columns of the image must correspond exactly to the same wavelength.
+A set of points along the slit dimension, which are representative of the
+background, are chosen interactively.  Generally this will consist of two
+strips on either side of the object spectrum.
+At each wavelength a low order function is fit to the sky points and then
+subtracted from the entire line or column.
+.PP
+Ideally the response corrections and coordinate rectification will make
+the background sky constant at all points on the slit at each
+wavelength and the subtracted background is just a constant.  However, if
+desired a higher order function may be used to correct for
+deficiencies in the data.  A possible problem is focus variations which
+cause the width of the sky emission lines to vary along the slit.  One
+may partially compensate for the focus variations by using a higher
+order background fitting function.
+.PP
+The background fitting uses the
+interactive curve fitting routine \fBicfit\fR described earlier.
+Figure 8 shows a graph from \fBbackground\fR illustrating how the user
+sets two sample regions defining the sky (indicated a the bottom of
+the graph).
+
+
+.ce
+\fB5. Flux Calibration\fR
+.SH
+EXTINCTION - Apply atmospheric extinction corrections to images
+.PP
+A set of coordinate rectified images is corrected for atmospheric
+extinction with the task \fBextinction\fR.  The extinction correction
+is given by the formula
+
+.EQ
+    roman {correction~factor}~=~10 sup {0.4~E sub lambda~A}
+.EN
+
+where $E sub lambda$ are tabulated extinctions values and $A$ is the air
+mass of the observation (determined from information in the image
+header).  The tabulated extinctions are interpolated to the wavelength of
+each pixel and the correction applied to the input pixel value to form
+the output pixel value.  The user may supply the extinction table but
+generally a standard extinction table is used.
+.PP
+The air mass is sought in the image header under the keyword AIRMASS.
+If the air mass is not found then it is computed from the zenith
+distance, ZD, using the approximation formula from Allen's
+"Astrophysical Quantities", 1973, pages 125 and 133
+
+.EQ
+	A = ( cos ( roman ZD ) sup 2~+~2 s~+~1) sup half
+.EN
+
+where $s$, the atmospheric scale height, is set to be 750.  If the
+zenith distance is not found then it must be computed from the
+hour angle, the declination, and the observation latitude.   The
+hour angle may be computed from the right ascension and the siderial time.
+Computed quantities are recorded in the image header.
+Flags indicating extinction correction are also set in the image
+header.
+.SH
+FLUXCALIB - Apply flux calibration to images
+.PP
+The specified images are flux calibrated using a flux calibration file
+derived with the \fBonedspec\fR package using standard stars.  The
+standard stars are extracted from response corrected, coordinate
+rectified, and background subtracted long slit images using the tasks
+\fBapdefine\fR and \fBapextract\fR.  The standard stars must not be
+extinction corrected because this is done by the \fBonedspec\fR flux
+calibration algorithms.  The user may specify flux per unit wavelength,
+$roman F sub lambda$, or flux per unit frequency, $roman F sub nu$.
+The flux is computed using the exposure time and dispersion from the
+image headers and a flux calibration flag is set.
+
+
+.ce
+\fB6. Extraction of One Dimensional Spectra\fR
+.PP
+The user may wish to extract one dimensional spectra at various points
+along the slit.  As mentioned earlier, this is necessary if observations
+of standard stars are to be used to calibrate the fluxes.  The flux
+calibration values are determined from one dimensional spectra of standard
+stars using the \fBonedspec\fR package.  The tools to extract
+one dimensional aperture spectra from long slit spectra are \fBapdefine\fR and
+\fBapextract\fR.
+.SH
+APDEFINE - Define apertures for 1D aperture extraction
+.PP
+Extraction apertures are defined as a list consisting of an
+aperture number and lower and upper limits for the aperture.  The aperture
+limits are specified as column or line positions which need not be
+integers.  The user may create a file containing these
+aperture definitions with an editor or use the interactive
+graphics task \fBapdefine\fR.
+.PP
+\fBApdefine\fR graphs the sum of a number of lines or columns (depending
+on the dispersion axis) and allows the user to interactively define and
+adjust apertures either with the cursor or using explicit commands.
+If an aperture definition file exists the apertures are indicated on
+the graph initially.  When the user is done a new aperture definition
+file is written.
+.SH
+APEXTRACT - Extract 1D aperture spectra
+.PP
+One dimensional aperture spectra are extracted from a list of
+long slit images using an aperture definition file.  The extraction
+consists of the sum of the pixels, including partial pixels, at
+each column or line along the dispersion axis between the aperture limits.
+.PP
+More sophisticated algorithms than simple strip extraction are available
+in IRAF and will soon be incorporated in the long slit package.  The
+other extraction tasks trace the positions of features, i.e. the aperture
+is not fixed at certain columns or lines, and allow weighted extractions
+and detecting and removing bad pixels such as cosmic rays.  The
+weighted extractions can be chosen to be optimal in a statistical sense.
+
+
+.ce
+\fBConclusion\fR
+.PP
+The IRAF long slit reduction tasks have been used at NOAO for about six
+months and have yielded good results.  The package does not contain specific
+analysis tasks.  Some analysis task will be added in time.  The package
+is part of the software distributed with release of the IRAF.  The
+author of this paper wrote and supports the tasks described here.
+Any comments are welcome.
+.sp5
+.ll 4.2i
+.nr LL 4.2i
+.LP
+\fBCaptions for Figures:\fP
+.sp 1
+Figure 1.  Ratio of average quartz spectrum to fit of a 20 piece cubic spline
+for determination of response correction using \fBresponse\fR.
+
+Figure 2.  Fit of 4 piece cubic spline to the slit profile from the average
+of the first 150 lines in a response image using \fBillumination\fR.
+
+Figure 3.  Identification of emission lines from the central column of a
+Helium-Neon-Argon spectrum using task \fBidentify\fR.
+
+Figure 4.  Sawtooth convolution function of width \fIfwidth\fR used in the
+profile centering algorithm.
+
+Figure 5.  Graph of stellar object positions identified with \fBidentify\fR,
+traced with \fBreidentify\fR, and graphed by \fBfitcoords\fR showing the
+spectrograph distortions.
+
+Figure 6.  Residuals of the fit of a two dimensional 6th order Chebyshev
+polynomial to the data of figure 5 using \fBfitcoords\fR.
+
+Figure 7.  Residuals of the fit of a two dimensional 6th order Chebyshev
+polynomial to the image positions of wavelength features using \fBfitcoords\fR.
+
+Figure 8.  Constant background fit to a line of an object spectrum using
+\fBbackground\fR.  The marks at the bottom of the graph indicate the
+set of points used in the fit.
diff --git a/noao/twodspec/longslit/doc/response.hlp b/noao/twodspec/longslit/doc/response.hlp
new file mode 100644
index 00000000..61a7b34a
--- /dev/null
+++ b/noao/twodspec/longslit/doc/response.hlp
@@ -0,0 +1,178 @@
+.help response Aug86 noao.twodspec.longslit
+.ih
+NAME
+response -- Determine response calibrations
+.ih
+USAGE
+response calibration normalization response
+.ih
+PARAMETERS
+.ls calibration
+Images to use in determining response calibrations.  These are
+generally quartz continuum spectra.  An image section may be used to select
+only a portion of the image.
+.le
+.ls normalization
+Images to use determining the normalization spectrum.  In almost all cases
+the normalization images are the same as the calibration images or a
+subsection of the calibration images.
+.le
+.ls responses
+Response calibration images to be created.  Each response image is paired
+with a calibration image.  If the image exists then it will be modified
+otherwise it is created.
+.le
+.ls interactive = yes
+Graph the average calibration spectrum and fit the normalization spectrum
+interactively?
+.le
+.ls threshold = INDEF
+Set the response to 1 when the normalization spectrum or input image data
+fall below this value.  If INDEF then no threshold is applied.
+.le
+.ls sample = "*"
+Sample of points to use in fitting the average calibration spectrum.
+The sample is selected with a range string.
+.le
+.ls naverage = 1
+Number of sample points to average or median before fitting the function.
+If the number is positive the average of each set of naverage sample
+points is formed while if the number is negative then the median of each set
+of points (in absolute value) is formed.  This subsample of points is
+used in fitting the normalization spectrum.
+.le
+.ls function = "spline3"
+Function to fit to the average image spectrum to form the normalization
+spectrum.  The options are "spline1", "spline3", "legendre", and "chebyshev".
+.le
+.ls order = 1
+Order of the fitting function or the number of spline pieces.
+.le
+.ls low_reject = 0., high_reject = 0.
+Rejection limits below and above the fit in units of the residual sigma.
+.le
+.ls niterate = 1
+Number of rejection iterations.
+.le
+.ls grow = 0
+Reject additional points within this distance of points exceeding the
+rejection threshold.
+.le
+.ih
+CURSOR KEYS
+The interactive curve fitting package \fBicfit\fR is used to fit a function
+to the average calibration spectrum.  Help for this package is found
+under the name "icfit".
+.ih
+DESCRIPTION
+A response calibration, in the form of an image, is created for each input
+image, normally a quartz spectrum.  The response calibration is formed by
+dividing the calibration image by a normalization spectrum which is the
+same at all points along the spatial axis.  The normalization spectrum is
+obtained by averaging the normalization image across the dispersion to form
+a one dimensional spectrum and smoothing the spectrum by fitting a
+function.  The threshold value does not apply to creating or fitting of
+the normalization spectrum but only the final creation of the response
+values.  When normalizing (that is dividing the data values by the
+fit to the normalization spectrum) only pixels in which both the fitted
+normalization value and the data value are above the threshold are
+computed.  If either the normalization value or the data value is below
+the threshold the output response value is one.
+
+The image header keyword DISPAXIS must be present with a value of 1 for
+dispersion parallel to the lines (varying with the column coordinate) or 2
+for dispersion parallel to the columns (varying with line coordinate).
+This parameter may be added using \fBhedit\fR.  Note that if the image has
+been transposed (\fBimtranspose\fR) the dispersion axis should still refer
+to the original dispersion axis unless the physical world coordinate system
+is first reset (see \fBwcsreset\fR).  This is done in order to allow images
+which have DISPAXIS defined prior to transposing to still work correctly
+without requiring this keyword to be changed.
+
+If the output image does not exist it is first created with unit response
+everywhere.  Subsequently the response is only modified in those regions
+occupied by the input calibration image.  Thus, image sections may be used
+to select regions in which the response is desired.  This ability is
+particularly useful when dealing with multiple slits within an image or to
+exclude regions outside the slit.
+
+Normally the normalization images are the same as the calibration images.
+In other words the calibration image is normalized by the average spectrum
+of the calibration image itself.  Sometimes, however, the normalization
+image may be a smaller image section of the calibration image to avoid
+contaminating the normalization spectrum by effects at the edge of the
+slit.  Again, this may be quite useful in multi-slit images.
+
+The normalization spectrum is smoothed by fitting a function
+using the interactive curve fitting package (\fBicfit\fR).  The
+parameters determining the fitted normalization spectrum are the sample
+points, the averaging bin size, the fitting function, the order of the
+function, the rejection sigmas, the number of rejection iterations, and
+the rejection width.  The sample points for the average spectrum are
+selected by a range string.  Points in the normalization spectrum not in the
+sample are not used in determining the fitted function.  The selected
+sample points may be binned into a set of averages or medians which are
+used in the function fit instead of the sample points with the
+averaging bin size parameter \fInaverage\fR.  This parameter selects
+the number of sample points to be averaged if its value is positive or
+the number of points to be medianed if its value is negative
+(naturally, the absolute value is used for the number of points).  A
+value of one uses all sample points without binning.  The fitted
+function may be used to reject points from the fit using the parameters
+\fIlow_reject, high_reject, niterate\fR and \fIgrow\fR.  If one or both
+of the rejection limits are greater than zero then the sigma of the
+residuals is computed and points with residuals less than
+\fI-low_reject\fR times the sigma and greater than \fIhigh_reject\fR
+times the sigma are removed and the function fitted again.  In addition
+points within a distance given by the parameter \fIgrow\fR of the a
+rejected point are also rejected.  A value of zero for this parameter
+rejects only the points exceeding the rejection threshold.  Finally,
+the rejection procedure may be iterated the number of times given by
+the parameter \fIniterate\fR.
+
+The fitted function may be examined and modified interactively when the
+parameter \fIinteractive\fR is set.  In this case the normalization spectrum
+and the fitted function or the residuals of the fit are graphed.
+Deleted points are marked with an x and rejected points by a diamond.
+The sample regions are indicated along the bottom of the graph.
+The cursor keys and colon commands are used to change the values
+of the fitting parameters, delete points, and window and expand the
+graph.  When the fitted function is satisfactory exit with a carriage
+return or 'q' and the calibration image will be created.  Changes in
+the fitted parameters are remembered from image to image within the
+task but not outside the task.
+
+When the task finishes creating a response image the fitting parameters
+are updated in the parameter file.
+.ih
+EXAMPLES
+1. To create a response image non-interactively:
+
+	cl> response quartz quartz response order=20 interactive=no
+
+2. To determine independent responses for a multislit image determine the
+image sections defining each slit.  Then the responses are computed as
+follows:
+
+.nf
+	cl> response quartz[10:20,*],quartz[35:45,*] \
+	>>> quartz[12:18,*],quartz[12:18,*] resp,resp
+.fi
+
+Generally the slit image sections are prepared in a file which is then
+used to define the lists of input images and response.
+
+.nf
+	cl> response @slits @slits @responses
+.fi
+
+3.  If the DISPAXIS keyword is missing and the dispersion is running
+vertically (varying with the image lines):
+
+.nf
+	cl> hedit *.imh dispaxis 2 add+
+.fi
+.ih
+SEE ALSO
+icfit, iillumination
+.endhelp
diff --git a/noao/twodspec/longslit/doc/transform.hlp b/noao/twodspec/longslit/doc/transform.hlp
new file mode 100644
index 00000000..6955b51e
--- /dev/null
+++ b/noao/twodspec/longslit/doc/transform.hlp
@@ -0,0 +1,240 @@
+.help transform Sep87 noao.twodspec.longslit
+.ih
+NAME
+transform -- Transform longslit images to user coordinates
+.ih
+USAGE
+transform input output fitnames
+.ih
+PARAMETERS
+.ls input
+List of input images to be transformed.
+.le
+.ls output
+List of output images.  The number of output images in the list must
+match the number of input images.
+.le
+.ls minput = ""
+List of input masks or references.  This mask is used to create an output
+mask and is currently not used in the calculation of the output pixel
+values.  The list may be empty, a single element to apply to all input
+images, or a list that matches the input list.  A element in the list
+may be "BPM" to use the mask referenced by the standard bad pixel mask
+keyword "BPM", "!<keyword>" to use another header keyword pointing to a
+mask, or a mask filename.  The mask file is typically a pixel list file
+but it may also be an image.  The mask values are interpreted as zero and
+greater than zero with the actual values ignored.  The mask is assumed to
+be registered with the input and no coordinate system matching is used.
+The mask maybe smaller or larger than the input image with non-overlapping
+pixels ignored and missing pixels assumed to be zero valued.  The mask
+.le
+.ls moutput = ""
+List of output masks to be created.  The list may be empty or must match
+the input list.  Output masks may be specified even if no input mask is
+specified, in which case the output mask will identify pixels which map
+to regions outside the input images (also see the \fIblank\fR parameter).
+If an explicit extension is not specified a FITS mask is extension is
+created unless the environment variable "masktype" is set to "pl".
+.le
+.ls fitnames  
+Names of the user coordinate maps in the database to be used in the transform.
+If no names are specified, using the null string "", the world coordinate
+system (WCS) of the image is used.  This latter case may be used to
+resample previously WCS calibrated images to a different linear range
+or sampling.
+.le
+.ls database = "database"
+Database containing the coordinate map to be used in transforming the images.
+.le
+.ls interptype = "spline3"
+Image interpolation type.  The allowed types are "nearest" (nearest neighbor),
+"linear" (bilinear), "poly3" (bicubic polynomial), "poly5" (biquintic
+polynomial), and "spline3" (bicubic polynomial).
+.le
+.ls flux = yes
+Conserve flux per pixel?  If "no" then each output pixel is simply interpolated
+from the input image.  If "yes" the interpolated output pixel value is
+multiplied by the Jacobean of the transformation (essentially the ratio of
+pixel areas between the output and input images).
+.le
+.ls x1 = INDEF, y1 = INDEF
+User coordinates of the first output column and line.  If INDEF then the
+smallest value corresponding to a pixel from the image used to create the
+coordinate map is used.  These values are in user units regardless of whether
+logarithmic intervals are specified or not.
+.le
+.ls x2 = INDEF, y2 = INDEF
+User coordinates of the last output column and line.  If INDEF then the
+largest value corresponding to a pixel from the image used to create the
+coordinate map is used.  These values are in user units regardless of whether
+logarithmic intervals are specified or not.
+.le
+.ls dx = INDEF, dy = INDEF
+Output pixel intervals.  If INDEF then the interval is set to yield the
+specified number of pixels.  Note that for logarithmic intervals the
+interval must be specified as a base 10 logarithm (base 10) and not in
+user units.
+.le
+.ls nx = INDEF, ny = INDEF
+Number of output pixels.  If INDEF and if the pixel interval is also INDEF then
+the number of output pixels is equal to the number of input pixels.
+.le
+.ls xlog = no, ylog = no
+Convert to logarithmic intervals?  If "yes" the output pixel intervals
+are logarithmic.
+.le
+.ls blank = INDEF
+Value to put in the output transformed image when it transforms to regions
+outside the input image.  The special value INDEF will use the nearest
+input pixel which is the behavior before the addition of this parameter.
+Using special blank values allows other software to identify such out
+of input pixels.  See also the \fImoutput\fR parameter to identify
+out of input pixels in pixel masks.
+.le
+.ls logfiles = "STDOUT,logfile"
+List of files in which to keep a log.  If null, "", then no log is kept.
+.le
+.ih
+DESCRIPTION
+The coordinate maps U(X,Y) and V(X,Y), created by the task \fBfitcoords\fR,
+are read from the specified database coordinate fits or from the
+world coordinate system (WCS) of the image.  X and Y are the original
+untransformed pixel coordinates and U and V are the desired output user or
+world coordinates (i.e. slit position and wavelength).  If a coordinate map
+for only one of the user coordinates is given then a one-to-one mapping
+is assumed for the other such that U=X or V=Y.  The coordinate maps are
+inverted to obtain X(U,V) and Y(U,V) on an even subsampled grid of U and
+V over the desired output image coordinates.  The X and Y at each output
+U and V used to interpolate from the input image are found by linear
+interpolation over this grid.  X(U,V) and Y(U,V) are not determined at
+every output point because this is quite slow and is not necessary since
+the coordinate surfaces are relatively slowly varying over the subsampling
+(every 10th output point).
+
+The type of image interpolation is
+selected by the user.  Note that the more accurate the interpolator the
+longer the transformation time required.  The parameter \fIflux\fR selects
+between direct image interpolation and a flux conserving interpolation.
+Flux conservation consists of multiplying the interpolated pixel value by
+the Jacobean of the transformation at that point.  This is essentially
+the ratio of the pixel areas between the output and input images.  Note
+that this is not exact since it is not an integral over the output pixel.
+However, it will be very close except when the output pixel size is much
+greater than the input pixel size.  A log describing the image transformations
+may be kept or printed on the standard output.
+
+The output coordinate grid may be defined by the user or allowed to
+default to an image of the same size as the input image spanning the
+full range of user coordinates in the coordinate transformation maps.
+When the coordinate maps are created by the task \fBfitcoords\fR the
+user coordinates at the corners of the image are recorded in the
+database.  By default these values are used to set the limits of the
+output grid.  If a pixel interval is not specified then an interval
+yielding the specified number of pixels is used.  The default number of
+pixels is that of the input image.  Note that if a pixel interval is
+specified then it takes precedence over the number of pixels.
+
+The pixel intervals may also be logarithmic if the parameter \fIxlog\fR or
+\fIylog\fR is "yes".  Generally, the number of output pixels is specified
+in this case .  However, if the interval is specified it must be a base
+10 logarithmic interval and not in units of the x and y limits which are
+specified in user units.
+
+The transformation from the desired output pixel to the input image may
+fall outside of the input image.  In this case the output pixel may be
+set to the nearest pixel value in the input image or to a particular value
+using the \fIblank\fR parameter.  Also if an output mask is created this
+pixels will have a value of one in the mask.
+
+The parameters \fIminput\fR and \fImoutput\fR provide for input and output
+pixel masks.  An input mask is not used in calculating the transformed
+pixel value but is used to identify the output pixels in the output mask
+which make a significant contribution to the interpolated value.  The
+significance is determined as follows.  The input mask values above zero
+are converted to one hundred.  The mask is then interpolated in the same
+way as the input image.  Any interpolated value of ten or greater is then
+given the value one in the output mask.  This means if all the input pixels
+had mask values of zero a result of zero means no bad pixels were used.
+If all the input pixels had values of 100 then the result will be 100 and
+the output mask will flag this as a bad pixel.  Other values are produced
+by a mixture of good and bad pixels weighted by the interpolation kernel.
+The choice of 10% is purely empirical and gives an approximate identification
+of significant affected pixels.
+zero and
+is created with values of 100
+
+.ih
+EXAMPLES
+Arc calibration images were used to determine a two dimensional dispersion
+map called dispmap.  Stellar spectra were used to determine a two dimensional
+distortion map call distort.  These maps where made using the task
+\fBfitcoords\fR. To transform a set of input images into linear wavelength
+between 3800 and 6400 Angstroms (the user coordinate units) with a dispersion
+of 3 Angstroms per pixel:
+
+.nf
+	cl> transform obj001,obj002 out001,out002 dispmap,distort \
+	>>> y1=3800 y2=6400 dy=3
+.fi
+
+To use logarithmic intervals in the wavelength to yield the same number of
+pixels in the output images as in the input images:
+
+.nf
+	cl> transform obj001,obj002 out001,out002 dispmap,distort \
+	>>> y1=3800 y2=6400 ylog=yes
+.fi
+.ih
+TIMINGS
+The following timings were obtained for transforming a 511x512 real
+image to another 511x512 real image using two Chebyshev transformation
+surface functions (one for the dispersion axis, "henear", and one in
+spatial axis, "object") of order 6 in both dimensions created with the
+task \fBfitcoords\fR.  The times are for a UNIX/VAX 11/750.
+
+.nf
+cl> $transform input output henear,object interp=linear
+TIME (transform)  173.73  5:13  55%
+cl> $transform input output henear,object interp=poly3
+TIME (transform)  266.63  9:17  42%
+cl> $transform input output henear,object interp=spline3
+TIME (transform)  309.05  6:11  83%
+cl> $transform input output henear,object interp=spline3
+TIME (transform)  444.13  9:44  76%
+cl> $transform input output henear interp=linear
+TIME (transform)  171.32  7:24  38%
+cl> $transform input output henear interp=spline3
+TIME (transform)  303.40  12:17  41%
+cl> $transform input output henear,object interp=spline3 flux=no
+TIME (transform)  262.42  10:42  40%
+.fi
+
+The majority of the time is due to the image interpolation and not evaluating
+the transformation functions as indicated by the last three examples.
+.ih
+NOTES
+.ls TRANSFORM: V2.12.2
+The use of bad pixel masks, a specified "blank" value, and use of a WCS
+to resample a WCS calibrated image was added.
+.le
+.ls TRANSFORM: V2.6
+With Version 2.6 of IRAF the algorithm used to invert the user
+coordinate surfaces, U(X,Y) and V(X,Y) to X(U,V) and Y(U,V), has been
+changed.  Previously surfaces of comparable order to the original
+surfaces were fit to a grid of points, i.e. (U(X,Y), V(X,Y), X) and
+(U(X,Y), V(X,Y), Y), with the same surface fitting routines used in
+\fBfitcoords\fR to obtain the input user coordinate surfaces.  This
+method of inversion worked well in all cases in which reasonable
+distortions and dispersions were used.  It was selected because it was
+relatively fast.  However, it cannot be proved to work in all cases; in
+one instance in which an invalid surface was used the inversion was
+actually much poorer than expected.  Therefore a more direct iterative
+inversion algorithm is now used.  This is guaranteed to give the
+correct inversion to within a set error (0.05 of a pixel in X and Y).
+It is slightly slower than the previous algorithm but it is still not
+as major a factor as the image interpolation itself.
+.le
+.ih
+SEE ALSO
+fitcoords
+.endhelp
diff --git a/noao/twodspec/longslit/extinction.par b/noao/twodspec/longslit/extinction.par
new file mode 100644
index 00000000..544802a8
--- /dev/null
+++ b/noao/twodspec/longslit/extinction.par
@@ -0,0 +1,5 @@
+# Parameter file for task extinct.
+
+input,s,a,,,,Images to be extinction corrected
+output,s,a,,,,Extinction corrected images
+extinction,f,h,onedstds$kpnoextinct.dat,,,Extinction file
diff --git a/noao/twodspec/longslit/extinction.x b/noao/twodspec/longslit/extinction.x
new file mode 100644
index 00000000..b3358303
--- /dev/null
+++ b/noao/twodspec/longslit/extinction.x
@@ -0,0 +1,226 @@
+include	<imhdr.h>
+include	<error.h>
+
+
+# T_EXTINCTION -- CL task for applying extinction corrections to images.
+#
+# The image headers must contain the parameters DISPAXIS, CRVALn,
+# CRPIXn, and CDELTn to define the wavelength coordinates and
+# either AIRMASS, ZD, or information needed to compute the zenith
+# distance (HA, LATITUDE, RA, DEC, ST).
+#
+# The extinction table contains wavelengths and extinctions in
+# magnitudes such that the multiplicative extinction correction
+# is given by:
+#
+#	correction = 10 ** (0.4 * airmass * extinction value)
+#
+# The extinction table need not be sorted.
+
+
+procedure t_extinction()
+
+int	list1			# List of images to be corrected
+int	list2			# List of extinction corrected images
+char	table[SZ_FNAME]		# Extinction table filename
+
+bool	extcor
+char	image1[SZ_FNAME], image2[SZ_FNAME]
+int	fd, nalloc, len_table
+real	wavelen, ext
+pointer	im1, im2, w, e
+
+int	clpopnu(), fscan(), nscan(), open(), clgfil()
+bool	imgetb(), streq()
+pointer	immap()
+
+errchk	ext_cor()
+
+begin
+	# Get the list of images and the extinction table.
+
+	list1 = clpopnu ("input")
+	list2 = clpopnu ("output")
+	call clgstr ("extinction", table, SZ_FNAME)
+
+	# Read the extinction table.  Dynamically allocate memory for the
+	# table.
+
+	fd = open (table, READ_ONLY, TEXT_FILE)
+	nalloc = 100
+	call malloc (w, nalloc, TY_REAL)
+	call malloc (e, nalloc, TY_REAL)
+
+	len_table = 0
+	while (fscan (fd) != EOF) {
+	    call gargr (wavelen)
+	    call gargr (ext)
+	    if (nscan() < 2)
+		next
+
+	    if (len_table == nalloc) {
+		nalloc = nalloc + 100
+		call realloc (w, nalloc, TY_REAL)
+		call realloc (e, nalloc, TY_REAL)
+	     }
+
+	     Memr[w + len_table] = wavelen
+	     Memr[e + len_table] = ext
+	     len_table = len_table + 1
+	}
+	call close (fd)
+
+	# If there are no extinction values in the table then return an error.
+	# Sort the extinction values by wavelength.
+
+	if (len_table > 0) {
+	    call realloc (w, len_table, TY_REAL)
+	    call realloc (e, len_table, TY_REAL)
+	    call xt_sort2 (Memr[w], Memr[e], len_table)
+	} else {
+	    call mfree (w, TY_REAL)
+	    call mfree (e, TY_REAL)
+	    call error (0, "No extinction values extinction table")
+	}
+
+	# Loop through each pair of input and output images.  Check if
+	# the input image has been corrected previously.  If TRUE then
+	# print message and go on to the next input image.  If FALSE
+	# print message and apply extinction corrections.
+	# Missing information in the image header will return an error
+	# which will warn the user and go on to the next image.
+
+	while (clgfil (list1, image1, SZ_FNAME) != EOF) {
+
+	    if (clgfil (list2, image2, SZ_FNAME) == EOF) {
+		call eprintf ("No output image for %s.\n")
+		    call pargstr (image1)
+		next
+	    }
+
+	    if (streq (image1, image2)) {
+	        im1 = immap (image1, READ_WRITE, 0)
+	        im2 = im1
+	    } else {
+	        im1 = immap (image1, READ_ONLY, 0)
+	        im2 = immap (image2, NEW_COPY, im1)
+	    }
+
+	    iferr (extcor = imgetb (im1, "extcor"))
+		extcor = false
+
+	    if (extcor) {
+		call printf ("Image %s is extinction corrected.\n")
+		    call pargstr (image1)
+	    } else {
+	        call printf ("Extinction correction: %s -> %s.\n")
+		    call pargstr (image1)
+		    call pargstr (image2)
+	        call flush (STDOUT)
+	        iferr (call do_extinct(im1, im2, Memr[w], Memr[e], len_table)) {
+		    call printf ("!!No extinction correction for %s!!\n")
+		        call pargstr (image1)
+		    call flush (STDOUT)
+		    call erract (EA_WARN)
+	        }
+	    }
+
+	    if (im2 != im1)
+	        call imunmap (im2)
+	    call imunmap (im1)
+	}
+
+	# Finish up.
+
+	call mfree (w, TY_REAL)
+	call mfree (e, TY_REAL)
+	call clpcls (list1)
+	call clpcls (list2)
+end
+
+
+# DO_EXTINCT -- Apply extinction correction.
+
+define	SZ_FIELD	8	# Size of field string
+
+procedure do_extinct (im1, im2, w, e, len_table)
+
+pointer	im1			# Input IMIO pointer
+pointer	im2			# Output IMIO pointer
+real	w[len_table]		# Wavelengths
+real	e[len_table]		# Extinction values
+int	len_table		# Length of extinction table
+
+char	field[SZ_FIELD]
+int	laxis, paxis, npix, i, flag, dcflag
+real	crval, cdelt, crpix, airmass, wavelen, extval
+long	v1[IM_MAXDIM], v2[IM_MAXDIM]
+pointer	sp, ext, pix1, pix2
+
+int	imgeti(), imgnlr(), impnlr()
+real	imgetr(), img_airmass()
+errchk	get_daxis, imgeti, imgetr, img_airmass
+
+begin
+	# Determine the dispersion axis and linear coordinates.
+	call get_daxis (im1, laxis, paxis)
+
+	call sprintf (field, SZ_FIELD, "crval%d")
+	    call pargi (laxis)
+	crval = imgetr (im1, field)
+	call sprintf (field, SZ_FIELD, "crpix%d")
+	    call pargi (laxis)
+	crpix = imgetr (im1, field)
+	call sprintf (field, SZ_FIELD, "cdelt%d")
+	    call pargi (laxis)
+	iferr (cdelt = imgetr (im1, field)) {
+	    call sprintf (field, SZ_FIELD, "cd%d_%d")
+	        call pargi (laxis)
+	        call pargi (laxis)
+	    cdelt = imgetr (im1, field)
+	}
+	dcflag = imgeti (im1, "dc-flag")
+
+	# Determine the airmass.
+
+	airmass = img_airmass (im1)
+
+	# Determine the extinction values at each pixel.
+
+	npix = IM_LEN (im1, laxis)
+	call smark (sp)
+	call salloc (ext, npix, TY_REAL)
+
+	do i = 1, npix {
+	    wavelen = crval + (i - crpix) * cdelt
+	    if (dcflag == 1)
+		wavelen = 10. ** wavelen
+	    call intrp (1, w, e, len_table, wavelen, extval, flag)
+	    Memr[ext+i-1] = 10. ** (0.4 * airmass * extval)
+	}
+
+	# Loop through the image applying the extinction correction to each
+	# pixel.
+
+	call amovkl (long (1), v1, IM_MAXDIM)
+	call amovkl (long (1), v2, IM_MAXDIM)
+	while ((imgnlr(im1, pix1, v1) != EOF) &&
+	    (impnlr(im2, pix2, v2) != EOF)) {
+	    switch (laxis) {
+	    case 1:
+		call amulr (Memr[pix1], Memr[ext], Memr[pix2], IM_LEN (im1, 1))
+	    default:
+		extval = Memr[ext+v1[laxis]-2]
+		call amulkr (Memr[pix1], extval, Memr[pix2], IM_LEN (im1, 1))
+	    }
+	}
+
+	call sfree (sp)
+
+	# Add the extinction correction flag, history, and return.
+	# The parameter ex-flag is added for compatibility with onedspec.
+
+	call imaddb (im2, "extcor", true)
+	call imaddi (im2, "ex-flag", 0)
+	call xt_phistory (im2, "Extinction correction applied.")
+end
diff --git a/noao/twodspec/longslit/fceval.par b/noao/twodspec/longslit/fceval.par
new file mode 100644
index 00000000..0d9d8240
--- /dev/null
+++ b/noao/twodspec/longslit/fceval.par
@@ -0,0 +1,4 @@
+input,f,a,,,,Input coordinate file
+output,f,a,,,,Output coordinate file
+fitnames,s,a,,,,Names of coordinate fits in the database
+database,f,h,database,,,Identify database
diff --git a/noao/twodspec/longslit/fitcoords.par b/noao/twodspec/longslit/fitcoords.par
new file mode 100644
index 00000000..ae203339
--- /dev/null
+++ b/noao/twodspec/longslit/fitcoords.par
@@ -0,0 +1,13 @@
+images,s,a,,,,Images whose coordinates are to be fit
+fitname,s,h,"",,,Name for coordinate fit in the database
+interactive,b,h,yes,,,Fit coordinates interactively?
+combine,b,h,no,,,Combine input coordinates for a single fit?
+database,f,h,database,,,Database
+deletions,s,h,"deletions.db",,,Deletion list file (not used if null)
+function,s,h,"chebyshev","chebyshev|legendre",,Type of fitting function
+xorder,i,h,6,2,,X order of fitting function
+yorder,i,h,6,2,,Y order of fitting function
+logfiles,f,h,"STDOUT,logfile",,,Log files
+plotfile,f,h,"plotfile",,,Plot log file
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/twodspec/longslit/fluxcalib.par b/noao/twodspec/longslit/fluxcalib.par
new file mode 100644
index 00000000..b0612a6a
--- /dev/null
+++ b/noao/twodspec/longslit/fluxcalib.par
@@ -0,0 +1,7 @@
+# Parameter file for FLUXCALIB
+
+input,s,a,,,,Images to be flux calibrated
+output,s,a,,,,Flux calibrated images
+fluxfile,f,a,,,,Flux calibration file
+fnu,b,h,no,,,Flux in units of F-nu?
+exposure,s,h,otime,,,Exposure time keyword in image headers
diff --git a/noao/twodspec/longslit/fluxcalib.x b/noao/twodspec/longslit/fluxcalib.x
new file mode 100644
index 00000000..042e7b89
--- /dev/null
+++ b/noao/twodspec/longslit/fluxcalib.x
@@ -0,0 +1,302 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math/iminterp.h>
+
+# T_FLUXCALIB -- CL task for applying flux calibration to longslit images.
+#
+# The image headers must contain the parameters DISPAXIS, W0, and WPC
+# to define the wavelength coordinates in Angstroms and an exposure time
+# in seconds.  
+#
+# The flux file is an image containing sensitivity corrections in magnitudes:
+#
+#	2.5 log10 ((counts/sec/Ang) / (ergs/cm2/sec/Ang))
+#
+# The flux file wavelengths need not be the same as the image but must
+# span the entire range of the input image.  If interpolation is required
+# the interpolator is a cubic spline.
+
+procedure t_fluxcalib()
+
+int	list1			# List of images to be calibrated
+int	list2			# List of calibrated images
+char	fluxfile[SZ_FNAME]	# Name of flux file
+bool	fnu			# Convert to fnu?
+
+char	image1[SZ_FNAME], image2[SZ_FNAME], history[SZ_LINE]
+bool	fluxcor
+pointer	im1, im2, ff, fluxdata
+
+int	imtopen(), imtgetim()
+bool	clgetb(), imgetb(), streq()
+pointer	immap()
+errchk	get_fluxdata(), do_fluxcalib()
+
+data	fluxdata/NULL/
+
+begin
+	# Get task parameters.
+
+	call clgstr ("input", history, SZ_LINE)
+	list1 = imtopen (history)
+	call clgstr ("output", history, SZ_LINE)
+	list2 = imtopen (history)
+	call clgstr ("fluxfile", fluxfile, SZ_FNAME)
+	fnu = clgetb ("fnu")
+	ff = immap (fluxfile, READ_ONLY, 0)
+
+	# Loop through each pair of input and output images.  Check if the
+	# input image has been corrected previously.  If TRUE then print
+	# message and go on to the next input image.  If FALSE print message
+	# and apply flux corrections.  Missing information in the image header
+	# will return an error which will warn the user and go on to the next
+	# image.
+
+	while ((imtgetim (list1, image1, SZ_FNAME) != EOF) &&
+	    (imtgetim (list2, image2, SZ_FNAME) != EOF)) {
+
+	    # Open image to be calibrated.
+	    iferr (im1 = immap (image1, READ_WRITE, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Check if the image has already been flux calibrated.
+	    iferr (fluxcor = imgetb (im1, "fluxcor"))
+		fluxcor = false
+	    if (fluxcor) {
+		call printf ("Image %s is flux calibrated.\n")
+		    call pargstr (image1)
+		call imunmap (im1)
+		next
+	    }
+
+	    # Open output image
+	    if (streq (image1, image2))
+	        im2 = immap ("fluxcalibtemp", NEW_COPY, im1)
+	    else
+	        im2 = immap (image2, NEW_COPY, im1)
+	    IM_PIXTYPE(im2) = TY_REAL
+
+	    # Apply flux calibration.  If error delete output image.
+	    iferr {
+	        call printf ("Flux calibration: %s --> %s.\n")
+		    call pargstr (image1)
+		    call pargstr (image2)
+	        call flush (STDOUT)
+		call get_fluxdata (im1, ff, fnu, fluxdata)
+		call do_fluxcalib (im1, im2, Memr[fluxdata])
+		call sprintf (history, SZ_LINE,
+		    "Flux calibration %s applied with fnu=%b.")
+		    call pargstr (fluxfile)
+		    call pargb (fnu)
+		call xt_phistory (im2, history)
+		call imunmap (im2)
+	        call imunmap (im1)
+		if (streq (image1, image2)) {
+		    call imdelete (image1)
+		    call imrename ("fluxcalibtemp", image1)
+		}
+	    } then {
+		call imunmap (im2)
+	        call imunmap (im1)
+		call imdelete (image2)
+		call printf ("!!No flux calibration for %s!!\n")
+		    call pargstr (image1)
+		call flush (STDOUT)
+		call erract (EA_WARN)
+	    }
+	}
+
+	call mfree (fluxdata, TY_REAL)
+	call imunmap (ff)
+	call imtclose (list1)
+	call imtclose (list2)
+end
+
+
+# GET_FLUXDATA -- Get the flux calibration data for the mapped image.
+# For efficiency read the data from the flux file only once and interpolate
+# to the wavelengths of the image only if they differ from those of the
+# flux file.  Correct for the dispersion and exposure time of the image
+# and convert to fnu if needed.
+
+procedure get_fluxdata (im, ff, fnu, fluxdata)
+
+pointer	im		# IMIO pointer for image to be calibrated
+pointer	ff		# IMIO pointer for the flux file
+bool	fnu		# Convert to fnu?
+pointer	fluxdata	# Pointer to flux data
+
+int	i, laxis, paxis, nw, ff_nw, ff_dcflag, dcflag
+char	exposure[SZ_LINE]
+real	w, dw, w0, wpc, crpix, exptime, ff_w0, ff_wpc
+pointer	ff_data, wavelens, asi
+
+int	imgeti()
+real	imgetr()
+pointer	imgl1r()
+errchk	imgeti, imgetr
+
+define	VLIGHT	2.997925e18		# Speed of light in Angstroms/sec
+
+begin
+	# If the fluxdata pointer is NULL then initialize.
+
+	if (fluxdata == NULL) {
+	    # Determine the dispersion.
+
+	    ff_dcflag = imgeti (ff, "dc-flag")
+	    ff_w0 = imgetr (ff, "crval1")
+	    iferr (ff_wpc = imgetr (ff, "cdelt1"))
+	        ff_wpc = imgetr (ff, "cd1_1")
+	    crpix = imgetr (ff, "crpix1")
+	    ff_w0 = ff_w0 + (1 - crpix) * ff_wpc
+	    ff_nw = IM_LEN (ff, 1)
+
+	    # Read the flux file and convert to multiplicative correction.
+
+	    ff_data = imgl1r (ff)
+	    do i = ff_data, ff_data + ff_nw - 1
+	        Memr[i] = 10.0 ** (-0.4 * Memr[i])
+	}
+
+	# Determine dispersion and exposure time for the image.
+	call get_daxis (im, laxis, paxis)
+	dcflag = imgeti (im, "dc-flag")
+	if (laxis == 1) {
+	    w0 = imgetr (im, "crval1")
+	    iferr (wpc = imgetr (im, "cdelt1"))
+	        wpc = imgetr (im, "cd1_1")
+	    crpix = imgetr (im, "crpix1")
+	} else {
+	    w0 = imgetr (im, "crval2")
+	    iferr (wpc = imgetr (im, "cdelt2"))
+	        wpc = imgetr (im, "cd2_2")
+	    crpix = imgetr (im, "crpix2")
+	}
+	w0 = w0 + (1 - crpix) * wpc
+	nw = IM_LEN (im, laxis)
+	call clgstr ("exposure", exposure, SZ_LINE)
+	exptime = imgetr (im, exposure)
+	if (exptime <= 0.)
+	    call error (0, "Bad integration time in image header")
+
+	# Allocate memory for the flux calibration data.
+
+	call mfree (fluxdata, TY_REAL)
+	call malloc (fluxdata, nw, TY_REAL)
+
+	# Check if the data from the flux file needs to be interpolated.
+
+	if ((w0 != ff_w0) || (wpc != ff_wpc) || (nw != ff_nw)) {
+	    # Compute the interpolation wavelengths.
+
+	    call malloc (wavelens, nw, TY_REAL)
+	    if ((ff_dcflag == 1) && (dcflag == 0))
+	        do i = 1, nw
+		    Memr[wavelens+i-1] = (log10 (w0+(i-1)*wpc) - ff_w0) /
+			ff_wpc + 1
+	    else if ((ff_dcflag == 0) && (dcflag == 1))
+	        do i = 1, nw
+		    Memr[wavelens+i-1] = (10. ** (w0+(i-1)*wpc) - ff_w0) /
+			ff_wpc + 1
+	    else
+	        do i = 1, nw
+		    Memr[wavelens+i-1] = ((w0+(i-1)*wpc) - ff_w0) / ff_wpc + 1
+
+	    if ((Memr[wavelens] < 1.) || (Memr[wavelens+nw-1] > ff_nw)) {
+		if ((Memr[wavelens]<0.5) || (Memr[wavelens+nw-1]>ff_nw+0.5))
+		    call eprintf (
+		    "Warning: Wavelengths extend beyond flux calibration\n.")
+		call arltr (Memr[wavelens], nw, 1., 1.)
+		call argtr (Memr[wavelens], nw, real(ff_nw), real(ff_nw))
+	    }
+
+	    # Fit an interpolation cubic spline and evaluate.
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[ff_data], ff_nw)
+	    call asivector (asi, Memr[wavelens], Memr[fluxdata], nw)
+	    call asifree (asi)
+	    call mfree (wavelens, TY_REAL)
+	} else
+	    call amovr (Memr[ff_data], Memr[fluxdata], nw)
+
+	# Convert to flux
+
+	if (fnu) {
+	    if (dcflag == 0) {
+	        do i = 1, nw {
+		    w = w0 + (i - 1) * wpc
+		    dw = wpc
+		    Memr[fluxdata+i-1] = Memr[fluxdata+i-1] / exptime / dw *
+			w**2 / VLIGHT
+	        }
+	    } else {
+	        do i = 1, nw {
+		    w = 10. ** (w0 + (i - 1) * wpc)
+		    dw = 2.30259 * wpc * w
+		    Memr[fluxdata+i-1] = Memr[fluxdata+i-1] / exptime / dw *
+		        w**2 / VLIGHT
+	        }
+	    }
+	} else {
+	    if (dcflag == 0) {
+		dw = wpc
+	        call amulkr (Memr[fluxdata], 1./dw/exptime, Memr[fluxdata], nw)
+	    } else {
+	        do i = 1, nw {
+		    dw = 2.30259 * wpc * (10. ** (w0 + (i - 1) * wpc))
+		    Memr[fluxdata+i-1] = Memr[fluxdata+i-1] / exptime / dw
+	        }
+	    }
+	}
+end
+
+
+# DO_FLUXCALIB -- Apply the flux calibration to a mapped image.
+# This procedure works for images of any dimension.
+
+procedure do_fluxcalib (im1, im2, fluxdata)
+
+pointer	im1			# IMIO pointer for image to be calibrated
+pointer	im2			# IMIO pointer for calibrated image
+real	fluxdata[ARB]		# Flux calibration data
+
+int	laxis, paxis, nw, npts
+long	v1[IM_MAXDIM], v2[IM_MAXDIM]
+pointer	in, out
+
+int	imgnlr(), impnlr()
+errchk	get_daxis
+
+begin
+	# Determine the dispersion axis of the image.
+
+	call get_daxis (im1, laxis, paxis)
+	nw = IM_LEN (im1, laxis)
+
+	# Calibrate the image.
+
+	npts = IM_LEN (im1, 1)
+	call amovkl (long (1), v1, IM_MAXDIM)
+	call amovkl (long (1), v2, IM_MAXDIM)
+
+	if (laxis == 1) {
+	    while ((imgnlr(im1, in, v1) != EOF) &&
+		(impnlr(im2, out, v2) != EOF))
+		call amulr (Memr[in], fluxdata, Memr[out], npts)
+
+	} else {
+	    while ((imgnlr(im1, in, v1) != EOF) &&
+		(impnlr(im2, out, v2) != EOF))
+		call amulkr (Memr[in], fluxdata[v1[laxis]-1], Memr[out],
+		    npts)
+	}
+
+	# Add the flux correction flag and return.
+
+	call imaddb (im2, "fluxcor", true)
+	call imaddi (im2, "ca-flag", 0)
+end
diff --git a/noao/twodspec/longslit/getdaxis.x b/noao/twodspec/longslit/getdaxis.x
new file mode 100644
index 00000000..06be22c7
--- /dev/null
+++ b/noao/twodspec/longslit/getdaxis.x
@@ -0,0 +1,36 @@
+include	<mwset.h>
+
+
+# GET_DAXIS -- Get logical dispersion axis.
+
+procedure get_daxis (im, laxis, paxis)
+
+pointer	im			#I IMIO pointer
+int	laxis			#O Logical dispersion axis
+int	paxis			#O Physical dispersion axis
+
+real	ltm[2,2], ltv[2]
+pointer	mw, tmp, mw_openim()
+int	imgeti(), clgeti()
+errchk	imaddi, mw_openim, mw_gltermr
+
+begin
+	# Get the dispersion axis from the header or package parameter.
+	iferr (paxis = imgeti (im, "dispaxis")) {
+	    paxis = clgeti ("dispaxis")
+	    call imaddi (im, "dispaxis", paxis)
+	}
+	laxis = paxis
+
+	# Check for a transposed image.
+	iferr {
+	    mw= NULL
+	    tmp = mw_openim (im); mw = tmp
+	    call mw_gltermr (mw, ltm, ltv, 2)
+	    if (ltm[1,1] == 0. && ltm[2,2] == 0)
+		laxis = mod (paxis, 2) + 1
+	} then
+	    ;
+	if (mw != NULL)
+	    call mw_close (mw)
+end
diff --git a/noao/twodspec/longslit/illumination.par b/noao/twodspec/longslit/illumination.par
new file mode 100644
index 00000000..6c5792b1
--- /dev/null
+++ b/noao/twodspec/longslit/illumination.par
@@ -0,0 +1,18 @@
+# ILLUMINATION -- Determine illumination calibrations
+
+images,s,a,,,,Longslit calibration images
+illuminations,s,a,,,,Illumination function images
+interactive,b,h,yes,,,Interactive illumination fitting?
+bins,s,h,"",,,Dispersion bins
+nbins,i,h,5,1,,Number of dispersion bins when bins = ""
+sample,s,h,"*",,,Sample of points to use in fit
+naverage,i,h,1,,,Number of points in sample averaging
+function,s,h,"spline3","spline3|legendre|chebyshev|spline1",,Fitting function
+order,i,h,1,1,,Order of fitting function
+low_reject,r,h,0.,0.,,Low rejection in sigma of fit
+high_reject,r,h,0.,0.,,High rejection in sigma of fit
+niterate,i,h,1,0,,Number of rejection iterations
+grow,r,h,0.,0.,,Rejection growing radius
+interpolator,s,h,"poly3","nearest|linear|poly3|poly5|spline3",,Interpolation type
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/twodspec/longslit/illumination.x b/noao/twodspec/longslit/illumination.x
new file mode 100644
index 00000000..c291d6f4
--- /dev/null
+++ b/noao/twodspec/longslit/illumination.x
@@ -0,0 +1,414 @@
+include	<imhdr.h>
+include	<error.h>
+include	<math/iminterp.h>
+include	<pkg/gtools.h>
+include	<pkg/rg.h>
+include	<pkg/xtanswer.h>
+
+# T_ILLUMINATION -- Determine the illumination function for longslit spectra.
+#
+# The calibration image is binned in wavelength.  Each wavelength  bin is
+# then smoothed by curve fitting and normalized to the middle point.
+# Finally the binned image is interpolated back to the original image
+# dimension.  The binning and curve fitting may be performed interactively.
+# A illumination function is determined for each input images.  Image
+# sections in the input image allow only parts of the illumination function
+# to be created.  Thus, multiple slits in the same image may have
+# independent illumination functions on the same illumination image.
+
+# CL callable procedure.
+#
+# The input and output images are given by image templates.  The
+# number of output images must match the number of input images.
+# Input image sections are allowed.
+
+procedure t_illumination ()
+
+pointer	image1
+pointer	image2
+int	list1				# Calibration image list
+int	list2				# Illumination image list
+int	interactive			# Interactive?
+int	naverage			# Sample averaging size
+int	order				# Order of curve fitting function
+real	low_reject, high_reject		# Rejection thresholds
+int	niterate			# Number of rejection iterations
+real	grow				# Rejection growing radius
+
+int	answer
+char	history[SZ_LINE]
+pointer	in, out, ic, gt, sp, str
+
+int	clgeti(), imtopen(), imtgetim(), imtlen(), gt_init()
+bool	clgetb()
+real	clgetr()
+errchk	il_make
+
+begin
+	call smark (sp)
+	call salloc (image1, SZ_LINE, TY_CHAR)
+	call salloc (image2, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Get calibration and illumination image template lists.
+
+	call clgstr ("images", Memc[image1], SZ_LINE)
+	call clgstr ("illuminations", Memc[image2], SZ_LINE)
+
+	# Check that the number of illumination calibration images are the same.
+
+	list1 = imtopen (Memc[image1])
+	list2 = imtopen (Memc[image2])
+	if (imtlen (list1) != imtlen (list2)) {
+	    call imtclose (list1)
+	    call imtclose (list2)
+	    call error (0,
+		"The number of input and output images are not the same.")
+	}
+
+	# Get other parameters and initialize the curve fitting package.
+
+	if (clgetb ("interactive"))
+	    interactive = YES
+	else
+	    interactive = ALWAYSNO
+
+	call clgstr ("sample", Memc[image1], SZ_LINE)
+	naverage = clgeti ("naverage")
+	call clgstr ("function", Memc[str], SZ_LINE)
+	order = clgeti ("order")
+	low_reject = clgetr ("low_reject")
+	high_reject = clgetr ("high_reject")
+	niterate = clgeti ("niterate")
+	grow = clgetr ("grow")
+
+	# Set the ICFIT pointer structure.
+	call ic_open (ic)
+	call ic_pstr (ic, "sample", Memc[image1])
+	call ic_puti (ic, "naverage", naverage)
+	call ic_pstr (ic, "function", Memc[str])
+	call ic_puti (ic, "order", order)
+	call ic_putr (ic, "low", low_reject)
+	call ic_putr (ic, "high", high_reject)
+	call ic_puti (ic, "niterate", niterate)
+	call ic_putr (ic, "grow", grow)
+	call ic_pstr (ic, "ylabel", "")
+
+	gt = gt_init()
+	call gt_sets (gt, GTTYPE, "line")
+
+	# Create an illumination image for each calibration image
+	while ((imtgetim (list1, Memc[image1], SZ_LINE) != EOF) &&
+	    (imtgetim (list2, Memc[image2], SZ_LINE) != EOF)) {
+
+	    call ls_immap (Memc[image1], Memc[image2], in, out)
+
+	    call sprintf (Memc[str], SZ_LINE,
+		"Determine illumination interactively for %s")
+	        call pargstr (Memc[image1])
+	    call xt_answer (Memc[str], interactive)
+	    answer = interactive
+
+	    iferr {
+		call il_make (in, out, ic, gt, Memc[str], answer)
+ 
+	        call imaddr (out, "ccdmean", 1.)
+	        call sprintf (history, SZ_LINE,
+		    "Illumination correction determined from %s.")
+		    call pargstr (Memc[image1])
+	        call imastr (out, "mkillum", history)
+	        call imunmap (in)
+	        call imunmap (out)
+	    } then {
+		call erract (EA_WARN)
+	        call imunmap (in)
+	        call imunmap (out)
+		call imdelete (Memc[image2])
+	    }
+	}
+
+	call ic_closer (ic)
+	call gt_free (gt)
+	call imtclose (list1)
+	call imtclose (list2)
+	call sfree (sp)
+end
+
+
+# IL_MAKE -- Given the calibration and illumination image descriptors
+# make the illumination function.
+
+procedure il_make (in, out, ic, gt, title, interactive)
+
+pointer	in			# Calibration IMIO pointer
+pointer	out			# Illumination IMIO pointer
+pointer	ic			# ICFIT pointer
+pointer	gt			# GTOOLS pointer
+char	title[ARB]		# Title
+int	interactive		# Interactive?
+
+char	graphics[SZ_FNAME]	# Graphics output device
+int	i, laxis, paxis, axis, npts, nbins, len_title
+pointer	bins, cv, gp, sp, x, y, z, z1, wts
+
+pointer	gopen()
+int	strlen()
+errchk	get_daxis
+
+begin
+	# Determine the slit axis and set the axis labels.
+	call get_daxis (in, laxis, paxis)
+	if (laxis == 1)
+	    axis = 2
+	else
+	    axis = 1
+
+	switch (axis) {
+	case 1:
+	    call ic_pstr (ic, "xlabel", "Column")
+	case 2:
+	    call ic_pstr (ic, "xlabel", "Line")
+	}
+
+	# Set the bins and bin the calibration image.
+
+	switch (axis) {
+	case 1:
+	    call il_setbins (in, 2, interactive, bins)
+	case 2:
+	    call il_setbins (in, 1, interactive, bins)
+	}
+
+	call il_binimage (in, axis, bins, x, y, z, npts, nbins)
+	call rg_free (bins)
+
+	# Allocate memory for the fit.
+
+	call smark (sp)
+	call salloc (wts, npts, TY_REAL)
+	call amovkr (1., Memr[wts], npts)
+
+	# Smooth each bin.
+		
+	call ic_putr (ic, "xmin", Memr[x])
+	call ic_putr (ic, "xmax", Memr[x+npts-1])
+
+	len_title = strlen (title)
+	z1 = z
+
+	do i = 1, nbins {
+	    title[len_title + 1] = EOS
+	    call sprintf (title, SZ_LINE, "%s at bin %d")
+		call pargstr (title)
+		call pargi (i)
+	    call xt_answer (title, interactive)
+
+	    if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	        call sprintf (title, SZ_LINE, "%s\n%s")
+	            call pargstr (title)
+	            call pargstr (IM_TITLE(in))
+	        call gt_sets (gt, GTTITLE, title)
+
+		call clgstr ("graphics", graphics, SZ_FNAME)
+	        gp = gopen (graphics, NEW_FILE, STDGRAPH)
+	        call icg_fit (ic, gp, "cursor", gt, cv, Memr[x], Memr[z1],
+		    Memr[wts], npts)
+		call amovkr (1., Memr[wts], npts)
+	        call gclose (gp)
+	    } else {
+	        call ic_fit (ic, cv, Memr[x], Memr[z1], Memr[wts], npts,
+		    YES, YES, YES, YES)
+	    }
+
+	    call cvvector (cv, Memr[x], Memr[z1], npts)
+	    z1 = z1 + npts
+	}
+	call cvfree (cv)
+
+	# Compute the illumination image by linear interpolation.
+
+	call il_expand (out, axis, Memr[x], Memr[y], Memr[z], npts, nbins)
+
+	# Free allocated memory.
+
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+	call mfree (z, TY_REAL)
+	call sfree (sp)
+end
+
+
+# IL_BINIMAGE -- Read the calibration image and bin it.
+
+procedure il_binimage (im, axis, bins, x, y, z, npts, nbins)
+
+pointer im			# Calibration IMIO pointer
+int	axis			# Slit axis
+pointer	bins			# Bins
+pointer	x			# Slit positions
+pointer	y			# Dispersion positions of bins
+pointer	z			# Binned image
+int	npts			# Number of points per bin
+int	nbins			# Number of bins
+
+int	i, y1, y2
+pointer	z1
+
+begin
+	# Allocate memory.
+
+	npts = IM_LEN (im, axis)
+	nbins = RG_NRGS (bins)
+	call malloc (y, nbins, TY_REAL)
+	call malloc (z, npts * nbins, TY_REAL)
+
+	# Bin the image data.
+
+	x = NULL
+	do i = 1, nbins {
+	    y1 = RG_X1 (bins, i)
+	    y2 = RG_X2 (bins, i)
+	    Memr[y+i-1] = (y1 + y2) / 2
+
+	    call mfree (x, TY_REAL)
+	    switch (axis) {
+	    case 1:
+	        call ls_aimavg (im, axis, 1, IM_LEN(im, 1), y1, y2, x, z1, npts)
+	    case 2:
+	        call ls_aimavg (im, axis, y1, y2, 1, IM_LEN(im, 2), x, z1, npts)
+	    }
+	    call amovr (Memr[z1], Memr[z+(i-1)*npts], npts)
+	    call mfree (z1, TY_REAL)
+	}
+end
+
+
+# IL_EXPAND -- Expand the reduced illumination back to the original size.
+# This procedure request the interpolation type.
+
+procedure il_expand (im, axis, x, y, z, nx, ny)
+
+pointer	im			# Illumination image pointer
+int	axis			# Slit axis
+real	x[nx]			# Slit coordinates
+real	y[ny]			# Dispersion coordinates
+real	z[nx, ny]		# Slit profile
+int	nx			# Number of points per slit profile
+int	ny			# Number of slit profiles
+
+char	dummy[7]
+int	nyout, ncols, nlines
+int	i, j, y1, y2
+real	dy
+pointer	msi, sp, out, yout
+
+int	clgwrd()
+pointer	impl2r()
+
+int	msitypes[5]
+data	msitypes/II_BINEAREST,II_BILINEAR,II_BIPOLY3,II_BIPOLY5,II_BISPLINE3/
+string	msinames "|nearest|linear|poly3|poly5|spline3|"
+
+begin
+	ncols = IM_LEN (im, 1)
+	nlines = IM_LEN (im, 2)
+
+	# Normalize illumination to the center of each slit.
+
+	i = nx / 2 - 1
+	do j = 1, ny {
+	    dy = z[i, j]
+	    call adivkr (z[1, j], dy, z[1, j], nx)
+	}
+
+	# If there is only one slit profile then copy the profile to each
+	# image line or column.
+
+	if (ny == 1) {
+	    switch (axis) {
+	    case 1:
+	        do i = 1, nlines
+	            call amovr (z, Memr[impl2r (im, i)], ncols)
+	    case 2:
+	        do i = 1, nlines
+		    call amovkr (z[i, 1], Memr[impl2r (im, i)], ncols)
+	    }
+
+	    return
+	}
+
+	# If there is more than one slit profile fit a 2D interpolator.
+
+	i = clgwrd ("interpolator", dummy, 7, msinames)
+	if (i == 0)
+	    i = II_BILINEAR
+	else
+	    i = msitypes[i]
+
+	switch (i) {
+	case II_POLY3, II_SPLINE3:
+	    if (ny < 4)
+		i = II_BILINEAR
+	case II_POLY5:
+	    if (ny < 6) {
+		if (ny < 4)
+		   i = II_BILINEAR
+		else
+		   i = II_POLY3
+	    }
+	}
+
+	call msiinit (msi, i)
+	call msifit (msi, z, nx, ny, nx)
+
+	# Set the output grid in terms of the interpolation surface.
+
+	switch (axis) {
+	case 1:
+	    nyout = IM_LEN (im, 2)
+	case 2:
+	    nyout = IM_LEN (im, 1)
+	}
+
+	call smark (sp)
+	call salloc (yout, nyout, TY_REAL)
+
+	y1 = 1
+	y2 = y[1]
+	do i = y1, y2
+	    Memr[yout+i-1] = 1
+	do j = 2, ny {
+	    y1 = y2 + 1
+	    y2 = y[j]
+	    dy = 1. / (y2 - y1)
+	    do i = y1, y2
+		Memr[yout+i-1] = j - 1 + (i - y1) * dy
+	    }
+	y1 = y2 + 1
+	y2 = nyout
+	do i = y1, y2
+	    Memr[yout+i-1] = ny
+
+	# Evaluate the interpolation surface on the output grid.
+
+	ncols = IM_LEN (im, 1)
+	nlines = IM_LEN (im, 2)
+	call salloc (out, ncols, TY_REAL)
+
+	switch (axis) {
+	case 1:
+	    do i = 1, nlines {
+	        call amovkr (Memr[yout+i-1], Memr[out], ncols)
+	        call msivector (msi, x, Memr[out], Memr[impl2r (im, i)],
+		    ncols)
+	    }
+	case 2:
+	    do i = 1, nlines {
+	        call amovkr (x[i], Memr[out], ncols)
+	        call msivector (msi, Memr[out], Memr[yout], Memr[impl2r(im, i)],
+		    ncols)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/ilsetbins.x b/noao/twodspec/longslit/ilsetbins.x
new file mode 100644
index 00000000..5d71a03a
--- /dev/null
+++ b/noao/twodspec/longslit/ilsetbins.x
@@ -0,0 +1,232 @@
+include	<imhdr.h>
+include	<gset.h>
+include	<pkg/rg.h>
+include	<pkg/gtools.h>
+include	<pkg/xtanswer.h>
+
+define	HELP		"noao$lib/scr/ilsetbins.key"
+define	PROMPT		"illumination options"
+define	SZ_BINS		2048	# Length of bin string
+
+# IL_SETBINS -- Set the dispersion bins.
+
+procedure il_setbins (im, axis, interactive, rg)
+
+pointer	im			# IMIO pointer for calibration image
+int	axis			# Slit axis
+int	interactive		# Set bins interactively?
+pointer	rg			# Range pointer for bins
+
+char	bins[SZ_BINS], str[SZ_LINE]
+int	i, npts, nbins
+real	dx
+pointer x
+
+int	clgeti()
+pointer	rg_ranges()
+
+begin
+	# Get the bins.  If the bin string is null then divide the dispersion
+	# range into a number of equal bins.
+
+	call clgstr ("bins", bins, SZ_BINS)
+	call xt_stripwhite (bins)
+
+	npts = IM_LEN (im, axis)
+
+	if (bins[1] == EOS) {
+	    call malloc (x, npts, TY_INT)
+	    do i = 1, npts
+		Memi[x+i-1] = i
+	    nbins = clgeti ("nbins")
+	    dx = npts / nbins
+	    do i = 1, nbins {
+		call sprintf (str, SZ_LINE, "%d:%d ")
+		    call pargi (Memi[x + int ((i - 1) * dx)])
+		    call pargi (Memi[x + int (i * dx - 1)])
+		call strcat (str, bins, SZ_BINS)
+	    }
+	    call mfree (x, TY_INT)
+	}
+
+	rg = rg_ranges (bins, 1, npts)
+	if (rg == NULL)
+	    call error (0, "Bad range string for parameter bins")
+
+	# Set the bins interactively.
+
+	if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	    call sprintf (str, SZ_LINE, "Set illumination bins\n%s")
+		call pargstr (IM_TITLE(im))
+	    call il_gsetbins (im, axis, str, bins, SZ_BINS, rg)
+	}
+
+	call rg_order (rg)
+end
+
+
+# IL_GSETBINS -- Set dispersion bins graphically.
+
+procedure il_gsetbins (im, axis, title, bins, sz_bins, rg)
+
+pointer	im			# IMIO pointer
+int	axis			# Slit axis
+char	title[ARB]		# Title
+char	bins[sz_bins]		# Bin string
+int	sz_bins			# Size of bin string
+pointer	rg			# Range pointer for the bins
+
+int	npts, newbins, newgraph
+real	x1, x2
+char	oldbins[SZ_BINS]
+pointer	gp, gt, x, y
+
+real	wx, wy
+int	wcs, key
+char	cmd[SZ_BINS]
+
+int	gt_gcur(), stridxs(), strlen()
+pointer	gopen(), gt_init(), rg_xrangesr()
+
+begin
+	# Get the average spectrum.
+
+	call ls_aimavg (im, axis, 1, IM_LEN(im,1), 1, IM_LEN(im,2), x, y, npts)
+
+	# Graph the spectrum and mark the bins.
+
+	call clgstr ("graphics", oldbins, SZ_BINS)
+	gp = gopen (oldbins, NEW_FILE, STDGRAPH)
+	gt = gt_init()
+	call il_gbins (gp, gt, axis, Memr[x], Memr[y], npts, bins, title)
+
+	while (gt_gcur ("cursor", wx, wy, wcs, key, cmd, SZ_BINS) != EOF) {
+	    switch (key) {
+	    case '?': # Print help text
+		call gpagefile (gp, HELP, PROMPT)
+
+	    case ':': # Colon commands
+		call strcpy (bins, oldbins, SZ_BINS)
+		if (cmd[1] == '/')
+		    call gt_colon (cmd, gp, gt, newgraph)
+		else
+		    call il_colon (cmd, bins, sz_bins, newbins)
+		if (newgraph == YES) {
+		    call il_gbins (gp, gt, axis, Memr[x], Memr[y], npts, bins,
+			title)
+		} else if (newbins == YES) {
+		    call rg_gxmarkr (gp, oldbins, Memr[x], npts, 0)
+		    call rg_gxmarkr (gp, bins, Memr[x], npts, 1)
+		}
+
+	    case 'i': # Initialize range string
+		call rg_gxmarkr (gp, bins, Memr[x], npts, 0)
+		call sprintf (bins, sz_bins, "*")
+
+	    case 's': # Set sample ranges with the cursor.
+		if (stridxs ("*", bins) > 0)
+		    bins[1] = EOS
+
+		x1 = wx
+		call printf ("again:\n")
+		if (gt_gcur ("cursor", wx, wy, wcs, key, cmd, SZ_BINS) == EOF)
+		    break
+
+		x2 = wx
+		call sprintf (cmd, SZ_BINS, "%d:%d ")
+		    call pargr (x1)
+		    call pargr (x2)
+		if (strlen (cmd) + strlen (bins) > sz_bins)
+		    call eprintf (
+			"Warning: Too many bins.  New bin ignored.\n")
+		else {
+		    call strcat (cmd, bins, sz_bins)
+		    call rg_gxmarkr (gp, bins, Memr[x], npts, 1)
+		}
+
+	    case 'I':
+		call fatal (0, "Interrupt")
+
+	    default: # Ring bell for unrecognized commands.
+		call printf ("\7\n")
+	    }
+	}
+
+	rg = rg_xrangesr (bins, Memr[x], npts)
+
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+	call gclose (gp)
+	call gt_free (gt)
+end
+
+
+define	COMMANDS "|show|bins|"
+define	SHOW		1	# Show bins
+define	BINS		2	# Set bins
+
+# IL_COLON -- Processes colon commands.
+
+procedure il_colon (cmdstr, bins, sz_bins, newbins)
+
+char	cmdstr[ARB]			# Colon command
+char	bins[sz_bins]			# Bins string
+int	sz_bins				# Size of bins string
+int	newbins				# New bins?
+
+char	cmd[SZ_BINS]
+int	ncmd
+
+int	strdic()
+
+begin
+	newbins = NO
+
+	call sscan (cmdstr)
+	call gargwrd (cmd, SZ_BINS)
+	ncmd = strdic (cmd, cmd, SZ_BINS, COMMANDS)
+
+	switch (ncmd) {
+	case SHOW:
+	    call printf ("bins = %s\n")
+		call pargstr (bins)
+	case BINS:
+	    call gargstr (cmd, SZ_BINS)
+	    call xt_stripwhite (cmd)
+	    if (cmd[1] == EOS) {
+		call printf ("bins = %s\n")
+		    call pargstr (bins)
+	    } else {
+		call strcpy (cmd, bins, sz_bins)
+		newbins = YES
+	    }
+	}
+end
+
+
+# IL_GBINS -- Graph data
+
+procedure il_gbins (gp, gt, axis, x, y, npts, bins, title)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+int	axis			# Slit axis
+real	x[npts], y[npts]	# Data to graph
+int	npts			# Number of data points
+char	bins[ARB]		# Bins to graph
+char	title[ARB] 		# Graph labels
+
+begin
+	call gclear (gp)
+	call gascale (gp, x, npts, 1)
+	call gascale (gp, y, npts, 2)
+	call gt_swind (gp, gt)
+	switch (axis) {
+	case 1:
+	    call glabax (gp, title, "Line", "")
+	case 2:
+	    call glabax (gp, title, "Column", "")
+	}
+	call gpline (gp, x, y, npts)
+	call rg_gxmarkr (gp, bins, x, npts, 1)
+end
diff --git a/noao/twodspec/longslit/longslit.cl b/noao/twodspec/longslit/longslit.cl
new file mode 100644
index 00000000..4ba17770
--- /dev/null
+++ b/noao/twodspec/longslit/longslit.cl
@@ -0,0 +1,54 @@
+#{ LONGSLIT -- Longslit Package
+
+# Load dependent packages
+
+images		# Used in setimhdr
+
+package longslit
+
+set	generic		= "noao$imred/generic/"
+set	demos		= "longslit$demos/"
+
+# Tasks.
+
+task	extinction,
+	fceval,
+	fitcoords,
+	fluxcalib,
+	illumination,
+	lscombine,
+	response,
+	transform	= longslit$x_longslit.e
+
+task	calibrate,
+	reidentify,
+	sensfunc,
+	standard	= longslit$x_onedspec.e
+
+task	autoidentify,
+	deredden,
+	dopcor,
+	identify,
+	lcalib,
+	sarith,
+	sflip,
+	slist,
+	specplot,
+	specshift,
+	splot		 = onedspec$x_onedspec.e
+
+task	aidpars		= onedspec$aidpars.par
+task	bplot		= onedspec$bplot.cl
+task	scopy		= onedspec$scopy.cl
+
+task	background	= generic$background.cl
+
+task	setairmass,
+	setjd		= astutil$x_astutil.e
+
+# Demos
+task	demos		= demos$demos.cl
+
+hidetask slist
+
+clbye
diff --git a/noao/twodspec/longslit/longslit.hd b/noao/twodspec/longslit/longslit.hd
new file mode 100644
index 00000000..6f52233b
--- /dev/null
+++ b/noao/twodspec/longslit/longslit.hd
@@ -0,0 +1,14 @@
+# Help directory for the LONGSLIT package.
+
+$doc		= "./doc/"
+$identify	= "noao$onedspec/doc/"
+
+extinction	hlp=doc$extinction.hlp
+fceval		hlp=doc$fceval.hlp
+fitcoords	hlp=doc$fitcoords.hlp
+fluxcalib	hlp=doc$fluxcalib.hlp
+illumination	hlp=doc$illumination.hlp
+lscombine	hlp=doc$lscombine.hlp
+response	hlp=doc$response.hlp
+revisions	sys=Revisions
+transform	hlp=doc$transform.hlp
diff --git a/noao/twodspec/longslit/longslit.men b/noao/twodspec/longslit/longslit.men
new file mode 100644
index 00000000..27dbb175
--- /dev/null
+++ b/noao/twodspec/longslit/longslit.men
@@ -0,0 +1,29 @@
+     background - Fit and subtract a line or column background
+          bplot - Batch plots of spectra
+      calibrate - Apply extinction and flux calibrations to spectra
+       deredden - Apply interstellar extinction correction
+         dopcor - Apply doppler corrections
+	 fceval - Evaluate coordinates using the FITSCOORDS solutions
+      fitcoords - Fit user coordinates to image coordinates
+       identify - Identify features
+   illumination - Determine illumination calibration
+         lcalib - List calibration file data
+      lscombine - Combine longslit images
+     reidentify - Reidentify features
+       response - Determine response calibration
+         sarith - Spectrum arithmetic
+          scopy - Sum and extract spectra from long slit to 1D format
+       sensfunc - Create sensitivity function
+     setairmass - Compute effective airmass and middle UT for an exposure
+          setjd - Compute and set Julian dates in images
+	  sflip - Flip data and/or dispersion coordinates in spectra
+       specplot - Stack and plot multiple spectra
+      specshift - Shift spectral dispersion coordinate systems
+          splot - Preliminary spectral plot/analysis
+       standard - Identify standard stars to be used in sensitivity calc
+      transform - Transform longslit images to user coordinates
+
+     extinction - Apply atmospheric extinction corrections to images (obsolete)
+      fluxcalib - Apply flux calibration to images (obsolete)
+
+	  demos - Demonstration and test playbacks
diff --git a/noao/twodspec/longslit/longslit.par b/noao/twodspec/longslit/longslit.par
new file mode 100644
index 00000000..c028f508
--- /dev/null
+++ b/noao/twodspec/longslit/longslit.par
@@ -0,0 +1,10 @@
+# LONGSLIT package parameter file.
+
+dispaxis,i,q,1,1,3,"Dispersion axis (1=along lines, 2=along columns, 3=along z)"
+nsum,s,h,"1",,,"Number of lines/columns to sum "
+observatory,s,h,"observatory",,,Observatory of data
+extinction,s,h,onedstds$kpnoextinct.dat,,,Extinction file
+caldir,s,h,onedstds$spec50cal/,,,Standard star calibration directory
+interp,s,h,"poly5","nearest|linear|poly3|poly5|spline3|sinc",,Interpolation type
+records,s,h,"",,,Record number extensions
+version,s,h,"February 1993"
diff --git a/noao/twodspec/longslit/lscombine.par b/noao/twodspec/longslit/lscombine.par
new file mode 100644
index 00000000..d93e2387
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine.par
@@ -0,0 +1,53 @@
+# LSCOMBINE -- Long slit combine parameters
+
+input,s,a,,,,List of images to combine
+output,s,a,,,,Output image
+headers,s,h,"",,,Output header file (optional)
+bpmasks,s,h,"",,,Output bad pixel mask (optional)
+rejmasks,s,h,"",,,Output rejection mask (optional)
+nrejmasks,s,h,"",,,Output number rejected mask (optional)
+expmasks,s,h,"",,,Output exposure mask (optional)
+sigmas,s,h,"",,,Output sigma image (optional)
+logfile,s,h,"STDOUT",,,"Log file
+"
+interptype,s,h,spline3,"nearest|linear|poly3|poly5|spline3",,Interpolation type
+x1,r,h,INDEF,,,Output starting x coordinate
+x2,r,h,INDEF,,,Output ending x coordinate
+dx,r,h,INDEF,,,Output X pixel interval
+nx,r,h,INDEF,,,Number of output x pixels
+y1,r,h,INDEF,,,Output starting y coordinate
+y2,r,h,INDEF,,,Output ending y coordinate
+dy,r,h,INDEF,,,Output Y pixel interval
+ny,r,h,INDEF,,,"Number of output y pixels
+"
+combine,s,h,"average","average|median|sum",,Type of combine operation
+reject,s,h,"none","none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip",,Type of rejection
+project,b,h,no,,,Project highest dimension of input images?
+outtype,s,h,"real","none|short|ushort|integer|long|real|double",,Output image pixel datatype
+outlimits,s,h,"",,,Output limits (x1 x2 y1 y2 ...)
+masktype,s,h,"none","none|goodvalue",,Mask type
+blank,r,h,0.,,,"Value if there are no pixels
+"
+scale,s,h,"none",,,Image scaling
+zero,s,h,"none",,,Image zero point offset
+weight,s,h,"none",,,Image weights
+statsec,s,h,"",,,Image section for computing statistics
+expname,s,h,"",,,"Image header exposure time keyword
+"
+lthreshold,r,h,INDEF,,,Lower threshold
+hthreshold,r,h,INDEF,,,Upper threshold
+nlow,i,h,1,0,,minmax: Number of low pixels to reject
+nhigh,i,h,1,0,,minmax: Number of high pixels to reject
+nkeep,i,h,1,,,Minimum to keep (pos) or maximum to reject (neg)
+mclip,b,h,yes,,,Use median in sigma clipping algorithms?
+lsigma,r,h,3.,0.,,Lower sigma clipping factor
+hsigma,r,h,3.,0.,,Upper sigma clipping factor
+rdnoise,s,h,"0.",,,ccdclip: CCD readout noise (electrons)
+gain,s,h,"1.",,,ccdclip: CCD gain (electrons/DN)
+snoise,s,h,"0.",,,ccdclip: Sensitivity noise (fraction)
+sigscale,r,h,0.1,0.,,Tolerance for sigma clipping scaling corrections
+pclip,r,h,-0.5,,,pclip: Percentile clipping parameter
+grow,r,h,0.,0.,,"Radius (pixels) for neighbor rejection
+"
+offsets,f,h,"none","none"
+maskvalue,r,h,0,0
diff --git a/noao/twodspec/longslit/lscombine/mkpkg b/noao/twodspec/longslit/lscombine/mkpkg
new file mode 100644
index 00000000..c8d60229
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/mkpkg
@@ -0,0 +1,14 @@
+# Make the LSCOMBINE Task.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	@src
+
+	t_lscombine.x	<error.h> <imhdr.h> <mach.h> <math/iminterp.h>\
+			src/icombine.com src/icombine.h\
+			../transform/transform.com
+	;
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icaclip.x b/noao/twodspec/longslit/lscombine/src/generic/icaclip.x
new file mode 100644
index 00000000..97c12346
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icaclip.x
@@ -0,0 +1,2206 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		3	# Minimum number of images for this algorithm
+
+
+# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_aavsigclips (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, s1, r, one
+data	one /1.0/
+pointer	sp, sums, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (sums, npts, TY_REAL)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Since the unweighted average is computed here possibly skip combining
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Compute the unweighted average with the high and low rejected and
+	# the poisson scaled average sigma.  There must be at least three
+	# pixels at each point to define the average and contributions to
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	nin = n[1]
+	s = 0.
+	n2 = 0
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3)
+		next
+
+	    # Unweighted average with the high and low rejected
+	    low = Mems[d[1]+k]
+	    high = Mems[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Mems[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    dp1 = d[j] + k
+		    mp1 = m[j] + k
+
+		    d1 = Mems[dp1]
+		    l = Memi[mp1]
+		    s1 = max (one, (a + zeros[l]) /  scales[l])
+		    s = s + (d1 - a) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, a)
+		do j = 1, n1
+		    s = s + (Mems[d[j]+k] - a) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the average and sum for later.
+	    average[i] = a
+	    Memr[sums+k] = sum
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+
+	# Reject pixels and compute the final average (if needed).
+	# There must be at least three pixels at each point for rejection.
+	# Iteratively scale the mean sigma and reject pixels
+	# Compact the data and keep track of the image IDs if needed.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (2, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Mems[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Mems[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    a = average[i]
+	    sum = Memr[sums+k]
+
+	    repeat {
+		n2 = n1
+		if (s > 0.) {
+		    if (doscale1) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+
+			    d1 = Mems[dp1]
+			    l = Memi[mp1]
+			    s1 = s * sqrt (max (one, (a+zeros[l]) /  scales[l]))
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    mp2 = m[n1] + k
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			s1 = s * sqrt (max (one, a))
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Mems[dp1]
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mems[dp1]
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Mems[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mems[dp1]
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Mems[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_mavsigclips (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+pointer	sp, resid, mp1, mp2
+real	med, low, high, r, s, s1, one
+data	one /1.0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute the poisson scaled average sigma about the median.
+	# There must be at least three pixels at each point to define
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	s = 0.
+	n2 = 0
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3) {
+		if (n1 == 0)
+		    median[i] = blank
+		else if (n1 == 1)
+		    median[i] = Mems[d[1]+k]
+		else {
+		    low = Mems[d[1]+k]
+		    high = Mems[d[2]+k]
+		    median[i] = (low + high) / 2.
+		}
+		next
+	    }
+
+	    # Median
+	    n3 = 1 + n1 / 2
+	    if (mod (n1, 2) == 0) {
+		low = Mems[d[n3-1]+k]
+		high = Mems[d[n3]+k]
+		med = (low + high) / 2.
+	    } else
+		med = Mems[d[n3]+k]
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    l = Memi[m[j]+k]
+		    s1 = max (one, (med + zeros[l]) /  scales[l])
+		    s = s + (Mems[d[j]+k] - med) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, med)
+		do j = 1, n1
+		    s = s + (Mems[d[j]+k] - med) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the median for later.
+	    median[i] = med
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+	else {
+	    call sfree (sp)
+	    return
+	}
+
+	# Compute individual sigmas and iteratively clip.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 < max (3, maxkeep+1))
+		next
+	    nl = 1
+	    nh = n1
+	    med = median[i]
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (med - Mems[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (Mems[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			s1 = s * sqrt (max (one, med))
+			for (; nl <= n2; nl = nl + 1) {
+			    r = (med - Mems[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    r = (Mems[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+
+		    # Recompute median
+		    if (n1 < n2) {
+			if (n1 > 0) {
+			    n3 = nl + n1 / 2
+			    if (mod (n1, 2) == 0) {
+				low = Mems[d[n3-1]+k]
+				high = Mems[d[n3]+k]
+				med = (low + high) / 2.
+			    } else
+				med = Mems[d[n3]+k]
+			} else
+			    med = blank
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+
+		# Recompute median
+		if (n1 < n2) {
+		    if (n1 > 0) {
+			n3 = nl + n1 / 2
+			if (mod (n1, 2) == 0) {
+			    low = Mems[d[n3-1]+k]
+			    high = Mems[d[n3]+k]
+			    med = (low + high) / 2.
+			} else
+			    med = Mems[d[n3]+k]
+		    } else
+			med = blank
+		}
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mems[d[l]+k] = Mems[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mems[d[l]+k] = Mems[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_aavsigclipi (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, s1, r, one
+data	one /1.0/
+pointer	sp, sums, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (sums, npts, TY_REAL)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Since the unweighted average is computed here possibly skip combining
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Compute the unweighted average with the high and low rejected and
+	# the poisson scaled average sigma.  There must be at least three
+	# pixels at each point to define the average and contributions to
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	nin = n[1]
+	s = 0.
+	n2 = 0
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3)
+		next
+
+	    # Unweighted average with the high and low rejected
+	    low = Memi[d[1]+k]
+	    high = Memi[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Memi[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    dp1 = d[j] + k
+		    mp1 = m[j] + k
+
+		    d1 = Memi[dp1]
+		    l = Memi[mp1]
+		    s1 = max (one, (a + zeros[l]) /  scales[l])
+		    s = s + (d1 - a) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, a)
+		do j = 1, n1
+		    s = s + (Memi[d[j]+k] - a) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the average and sum for later.
+	    average[i] = a
+	    Memr[sums+k] = sum
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+
+	# Reject pixels and compute the final average (if needed).
+	# There must be at least three pixels at each point for rejection.
+	# Iteratively scale the mean sigma and reject pixels
+	# Compact the data and keep track of the image IDs if needed.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (2, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memi[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memi[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    a = average[i]
+	    sum = Memr[sums+k]
+
+	    repeat {
+		n2 = n1
+		if (s > 0.) {
+		    if (doscale1) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+
+			    d1 = Memi[dp1]
+			    l = Memi[mp1]
+			    s1 = s * sqrt (max (one, (a+zeros[l]) /  scales[l]))
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    mp2 = m[n1] + k
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			s1 = s * sqrt (max (one, a))
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Memi[dp1]
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memi[dp1]
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memi[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memi[dp1]
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memi[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_mavsigclipi (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+pointer	sp, resid, mp1, mp2
+real	med, low, high, r, s, s1, one
+data	one /1.0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute the poisson scaled average sigma about the median.
+	# There must be at least three pixels at each point to define
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	s = 0.
+	n2 = 0
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3) {
+		if (n1 == 0)
+		    median[i] = blank
+		else if (n1 == 1)
+		    median[i] = Memi[d[1]+k]
+		else {
+		    low = Memi[d[1]+k]
+		    high = Memi[d[2]+k]
+		    median[i] = (low + high) / 2.
+		}
+		next
+	    }
+
+	    # Median
+	    n3 = 1 + n1 / 2
+	    if (mod (n1, 2) == 0) {
+		low = Memi[d[n3-1]+k]
+		high = Memi[d[n3]+k]
+		med = (low + high) / 2.
+	    } else
+		med = Memi[d[n3]+k]
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    l = Memi[m[j]+k]
+		    s1 = max (one, (med + zeros[l]) /  scales[l])
+		    s = s + (Memi[d[j]+k] - med) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, med)
+		do j = 1, n1
+		    s = s + (Memi[d[j]+k] - med) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the median for later.
+	    median[i] = med
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+	else {
+	    call sfree (sp)
+	    return
+	}
+
+	# Compute individual sigmas and iteratively clip.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 < max (3, maxkeep+1))
+		next
+	    nl = 1
+	    nh = n1
+	    med = median[i]
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (med - Memi[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (Memi[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			s1 = s * sqrt (max (one, med))
+			for (; nl <= n2; nl = nl + 1) {
+			    r = (med - Memi[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    r = (Memi[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+
+		    # Recompute median
+		    if (n1 < n2) {
+			if (n1 > 0) {
+			    n3 = nl + n1 / 2
+			    if (mod (n1, 2) == 0) {
+				low = Memi[d[n3-1]+k]
+				high = Memi[d[n3]+k]
+				med = (low + high) / 2.
+			    } else
+				med = Memi[d[n3]+k]
+			} else
+			    med = blank
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+
+		# Recompute median
+		if (n1 < n2) {
+		    if (n1 > 0) {
+			n3 = nl + n1 / 2
+			if (mod (n1, 2) == 0) {
+			    low = Memi[d[n3-1]+k]
+			    high = Memi[d[n3]+k]
+			    med = (low + high) / 2.
+			} else
+			    med = Memi[d[n3]+k]
+		    } else
+			med = blank
+		}
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memi[d[l]+k] = Memi[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memi[d[l]+k] = Memi[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_aavsigclipr (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, s1, r, one
+data	one /1.0/
+pointer	sp, sums, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (sums, npts, TY_REAL)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Since the unweighted average is computed here possibly skip combining
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Compute the unweighted average with the high and low rejected and
+	# the poisson scaled average sigma.  There must be at least three
+	# pixels at each point to define the average and contributions to
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	nin = n[1]
+	s = 0.
+	n2 = 0
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3)
+		next
+
+	    # Unweighted average with the high and low rejected
+	    low = Memr[d[1]+k]
+	    high = Memr[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Memr[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    dp1 = d[j] + k
+		    mp1 = m[j] + k
+
+		    d1 = Memr[dp1]
+		    l = Memi[mp1]
+		    s1 = max (one, (a + zeros[l]) /  scales[l])
+		    s = s + (d1 - a) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, a)
+		do j = 1, n1
+		    s = s + (Memr[d[j]+k] - a) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the average and sum for later.
+	    average[i] = a
+	    Memr[sums+k] = sum
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+
+	# Reject pixels and compute the final average (if needed).
+	# There must be at least three pixels at each point for rejection.
+	# Iteratively scale the mean sigma and reject pixels
+	# Compact the data and keep track of the image IDs if needed.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (2, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memr[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memr[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    a = average[i]
+	    sum = Memr[sums+k]
+
+	    repeat {
+		n2 = n1
+		if (s > 0.) {
+		    if (doscale1) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+
+			    d1 = Memr[dp1]
+			    l = Memi[mp1]
+			    s1 = s * sqrt (max (one, (a+zeros[l]) /  scales[l]))
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    mp2 = m[n1] + k
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			s1 = s * sqrt (max (one, a))
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Memr[dp1]
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memr[dp1]
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memr[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memr[dp1]
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memr[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_mavsigclipr (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+pointer	sp, resid, mp1, mp2
+real	med, low, high, r, s, s1, one
+data	one /1.0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute the poisson scaled average sigma about the median.
+	# There must be at least three pixels at each point to define
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	s = 0.
+	n2 = 0
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3) {
+		if (n1 == 0)
+		    median[i] = blank
+		else if (n1 == 1)
+		    median[i] = Memr[d[1]+k]
+		else {
+		    low = Memr[d[1]+k]
+		    high = Memr[d[2]+k]
+		    median[i] = (low + high) / 2.
+		}
+		next
+	    }
+
+	    # Median
+	    n3 = 1 + n1 / 2
+	    if (mod (n1, 2) == 0) {
+		low = Memr[d[n3-1]+k]
+		high = Memr[d[n3]+k]
+		med = (low + high) / 2.
+	    } else
+		med = Memr[d[n3]+k]
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    l = Memi[m[j]+k]
+		    s1 = max (one, (med + zeros[l]) /  scales[l])
+		    s = s + (Memr[d[j]+k] - med) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, med)
+		do j = 1, n1
+		    s = s + (Memr[d[j]+k] - med) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the median for later.
+	    median[i] = med
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+	else {
+	    call sfree (sp)
+	    return
+	}
+
+	# Compute individual sigmas and iteratively clip.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 < max (3, maxkeep+1))
+		next
+	    nl = 1
+	    nh = n1
+	    med = median[i]
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (med - Memr[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (Memr[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			s1 = s * sqrt (max (one, med))
+			for (; nl <= n2; nl = nl + 1) {
+			    r = (med - Memr[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    r = (Memr[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+
+		    # Recompute median
+		    if (n1 < n2) {
+			if (n1 > 0) {
+			    n3 = nl + n1 / 2
+			    if (mod (n1, 2) == 0) {
+				low = Memr[d[n3-1]+k]
+				high = Memr[d[n3]+k]
+				med = (low + high) / 2.
+			    } else
+				med = Memr[d[n3]+k]
+			} else
+			    med = blank
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+
+		# Recompute median
+		if (n1 < n2) {
+		    if (n1 > 0) {
+			n3 = nl + n1 / 2
+			if (mod (n1, 2) == 0) {
+			    low = Memr[d[n3-1]+k]
+			    high = Memr[d[n3]+k]
+			    med = (low + high) / 2.
+			} else
+			    med = Memr[d[n3]+k]
+		    } else
+			med = blank
+		}
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_aavsigclipd (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+double	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+double	d1, low, high, sum, a, s, s1, r, one
+data	one /1.0D0/
+pointer	sp, sums, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (sums, npts, TY_REAL)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Since the unweighted average is computed here possibly skip combining
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Compute the unweighted average with the high and low rejected and
+	# the poisson scaled average sigma.  There must be at least three
+	# pixels at each point to define the average and contributions to
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	nin = n[1]
+	s = 0.
+	n2 = 0
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3)
+		next
+
+	    # Unweighted average with the high and low rejected
+	    low = Memd[d[1]+k]
+	    high = Memd[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Memd[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    dp1 = d[j] + k
+		    mp1 = m[j] + k
+
+		    d1 = Memd[dp1]
+		    l = Memi[mp1]
+		    s1 = max (one, (a + zeros[l]) /  scales[l])
+		    s = s + (d1 - a) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, a)
+		do j = 1, n1
+		    s = s + (Memd[d[j]+k] - a) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the average and sum for later.
+	    average[i] = a
+	    Memr[sums+k] = sum
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+
+	# Reject pixels and compute the final average (if needed).
+	# There must be at least three pixels at each point for rejection.
+	# Iteratively scale the mean sigma and reject pixels
+	# Compact the data and keep track of the image IDs if needed.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (2, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memd[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memd[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    a = average[i]
+	    sum = Memr[sums+k]
+
+	    repeat {
+		n2 = n1
+		if (s > 0.) {
+		    if (doscale1) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+
+			    d1 = Memd[dp1]
+			    l = Memi[mp1]
+			    s1 = s * sqrt (max (one, (a+zeros[l]) /  scales[l]))
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    mp2 = m[n1] + k
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			s1 = s * sqrt (max (one, a))
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Memd[dp1]
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memd[dp1]
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memd[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memd[dp1]
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memd[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_mavsigclipd (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+double	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+pointer	sp, resid, mp1, mp2
+double	med, low, high, r, s, s1, one
+data	one /1.0D0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute the poisson scaled average sigma about the median.
+	# There must be at least three pixels at each point to define
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	s = 0.
+	n2 = 0
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3) {
+		if (n1 == 0)
+		    median[i] = blank
+		else if (n1 == 1)
+		    median[i] = Memd[d[1]+k]
+		else {
+		    low = Memd[d[1]+k]
+		    high = Memd[d[2]+k]
+		    median[i] = (low + high) / 2.
+		}
+		next
+	    }
+
+	    # Median
+	    n3 = 1 + n1 / 2
+	    if (mod (n1, 2) == 0) {
+		low = Memd[d[n3-1]+k]
+		high = Memd[d[n3]+k]
+		med = (low + high) / 2.
+	    } else
+		med = Memd[d[n3]+k]
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    l = Memi[m[j]+k]
+		    s1 = max (one, (med + zeros[l]) /  scales[l])
+		    s = s + (Memd[d[j]+k] - med) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, med)
+		do j = 1, n1
+		    s = s + (Memd[d[j]+k] - med) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the median for later.
+	    median[i] = med
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+	else {
+	    call sfree (sp)
+	    return
+	}
+
+	# Compute individual sigmas and iteratively clip.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 < max (3, maxkeep+1))
+		next
+	    nl = 1
+	    nh = n1
+	    med = median[i]
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (med - Memd[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (Memd[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			s1 = s * sqrt (max (one, med))
+			for (; nl <= n2; nl = nl + 1) {
+			    r = (med - Memd[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    r = (Memd[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+
+		    # Recompute median
+		    if (n1 < n2) {
+			if (n1 > 0) {
+			    n3 = nl + n1 / 2
+			    if (mod (n1, 2) == 0) {
+				low = Memd[d[n3-1]+k]
+				high = Memd[d[n3]+k]
+				med = (low + high) / 2.
+			    } else
+				med = Memd[d[n3]+k]
+			} else
+			    med = blank
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+
+		# Recompute median
+		if (n1 < n2) {
+		    if (n1 > 0) {
+			n3 = nl + n1 / 2
+			if (mod (n1, 2) == 0) {
+			    low = Memd[d[n3-1]+k]
+			    high = Memd[d[n3]+k]
+			    med = (low + high) / 2.
+			} else
+			    med = Memd[d[n3]+k]
+		    } else
+			med = blank
+		}
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memd[d[l]+k] = Memd[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memd[d[l]+k] = Memd[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icaverage.x b/noao/twodspec/longslit/lscombine/src/generic/icaverage.x
new file mode 100644
index 00000000..fc9f16da
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icaverage.x
@@ -0,0 +1,406 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+
+# IC_AVERAGE -- Compute the average (or summed) image line.
+# Options include a weighted average/sum.
+
+procedure ic_averages (d, m, n, wts, npts, doblank, doaverage, average)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+int	doaverage		# Do average?
+real	average[npts]		# Average (returned)
+
+int	i, j, k
+real	sumwt, wt
+real	sum
+
+include	"../icombine.com"
+
+begin
+	# If no data has been excluded do the average/sum without checking
+	# the number of points and using the fact that the weights are
+	# normalized.  If all the data has been excluded set the average/sum
+	# to the blank value if requested.
+
+	if (dflag == D_ALL) {
+	    if (dowts) {
+		do i = 1, npts {
+		    k = i - 1
+		    wt = wts[Memi[m[1]+k]]
+		    sum = Mems[d[1]+k] * wt
+		    do j = 2, n[i] {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + Mems[d[j]+k] * wt
+		    }
+		    average[i] = sum
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    sum = Mems[d[1]+k]
+		    do j = 2, n[i]
+			sum = sum + Mems[d[j]+k]
+		    if (doaverage == YES)
+			average[i] = sum / n[i]
+		    else
+			average[i] = sum
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    average[i] = blank
+	    }
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			wt = wts[Memi[m[1]+k]]
+			sum = Mems[d[1]+k] * wt
+			sumwt = wt
+			do j = 2, n[i] {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + Mems[d[j]+k] * wt
+			    sumwt = sumwt + wt
+			}
+			if (doaverage == YES) {
+			    if (sumwt > 0)
+				average[i] = sum / sumwt
+			    else {
+				sum = Mems[d[1]+k]
+				do j = 2, n[i]
+				    sum = sum + Mems[d[j]+k]
+				average[i] = sum / n[i]
+			    }
+			} else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			sum = Mems[d[1]+k]
+			do j = 2, n[i]
+			    sum = sum + Mems[d[j]+k]
+			if (doaverage == YES)
+			    average[i] = sum / n[i]
+			else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    }
+	}
+end
+
+# IC_AVERAGE -- Compute the average (or summed) image line.
+# Options include a weighted average/sum.
+
+procedure ic_averagei (d, m, n, wts, npts, doblank, doaverage, average)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+int	doaverage		# Do average?
+real	average[npts]		# Average (returned)
+
+int	i, j, k
+real	sumwt, wt
+real	sum
+
+include	"../icombine.com"
+
+begin
+	# If no data has been excluded do the average/sum without checking
+	# the number of points and using the fact that the weights are
+	# normalized.  If all the data has been excluded set the average/sum
+	# to the blank value if requested.
+
+	if (dflag == D_ALL) {
+	    if (dowts) {
+		do i = 1, npts {
+		    k = i - 1
+		    wt = wts[Memi[m[1]+k]]
+		    sum = Memi[d[1]+k] * wt
+		    do j = 2, n[i] {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + Memi[d[j]+k] * wt
+		    }
+		    average[i] = sum
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    sum = Memi[d[1]+k]
+		    do j = 2, n[i]
+			sum = sum + Memi[d[j]+k]
+		    if (doaverage == YES)
+			average[i] = sum / n[i]
+		    else
+			average[i] = sum
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    average[i] = blank
+	    }
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			wt = wts[Memi[m[1]+k]]
+			sum = Memi[d[1]+k] * wt
+			sumwt = wt
+			do j = 2, n[i] {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + Memi[d[j]+k] * wt
+			    sumwt = sumwt + wt
+			}
+			if (doaverage == YES) {
+			    if (sumwt > 0)
+				average[i] = sum / sumwt
+			    else {
+				sum = Memi[d[1]+k]
+				do j = 2, n[i]
+				    sum = sum + Memi[d[j]+k]
+				average[i] = sum / n[i]
+			    }
+			} else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			sum = Memi[d[1]+k]
+			do j = 2, n[i]
+			    sum = sum + Memi[d[j]+k]
+			if (doaverage == YES)
+			    average[i] = sum / n[i]
+			else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    }
+	}
+end
+
+# IC_AVERAGE -- Compute the average (or summed) image line.
+# Options include a weighted average/sum.
+
+procedure ic_averager (d, m, n, wts, npts, doblank, doaverage, average)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+int	doaverage		# Do average?
+real	average[npts]		# Average (returned)
+
+int	i, j, k
+real	sumwt, wt
+real	sum
+
+include	"../icombine.com"
+
+begin
+	# If no data has been excluded do the average/sum without checking
+	# the number of points and using the fact that the weights are
+	# normalized.  If all the data has been excluded set the average/sum
+	# to the blank value if requested.
+
+	if (dflag == D_ALL) {
+	    if (dowts) {
+		do i = 1, npts {
+		    k = i - 1
+		    wt = wts[Memi[m[1]+k]]
+		    sum = Memr[d[1]+k] * wt
+		    do j = 2, n[i] {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + Memr[d[j]+k] * wt
+		    }
+		    average[i] = sum
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    sum = Memr[d[1]+k]
+		    do j = 2, n[i]
+			sum = sum + Memr[d[j]+k]
+		    if (doaverage == YES)
+			average[i] = sum / n[i]
+		    else
+			average[i] = sum
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    average[i] = blank
+	    }
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			wt = wts[Memi[m[1]+k]]
+			sum = Memr[d[1]+k] * wt
+			sumwt = wt
+			do j = 2, n[i] {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + Memr[d[j]+k] * wt
+			    sumwt = sumwt + wt
+			}
+			if (doaverage == YES) {
+			    if (sumwt > 0)
+				average[i] = sum / sumwt
+			    else {
+				sum = Memr[d[1]+k]
+				do j = 2, n[i]
+				    sum = sum + Memr[d[j]+k]
+				average[i] = sum / n[i]
+			    }
+			} else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			sum = Memr[d[1]+k]
+			do j = 2, n[i]
+			    sum = sum + Memr[d[j]+k]
+			if (doaverage == YES)
+			    average[i] = sum / n[i]
+			else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    }
+	}
+end
+
+# IC_AVERAGE -- Compute the average (or summed) image line.
+# Options include a weighted average/sum.
+
+procedure ic_averaged (d, m, n, wts, npts, doblank, doaverage, average)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+int	doaverage		# Do average?
+double	average[npts]		# Average (returned)
+
+int	i, j, k
+real	sumwt, wt
+double	sum
+
+include	"../icombine.com"
+
+begin
+	# If no data has been excluded do the average/sum without checking
+	# the number of points and using the fact that the weights are
+	# normalized.  If all the data has been excluded set the average/sum
+	# to the blank value if requested.
+
+	if (dflag == D_ALL) {
+	    if (dowts) {
+		do i = 1, npts {
+		    k = i - 1
+		    wt = wts[Memi[m[1]+k]]
+		    sum = Memd[d[1]+k] * wt
+		    do j = 2, n[i] {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + Memd[d[j]+k] * wt
+		    }
+		    average[i] = sum
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    sum = Memd[d[1]+k]
+		    do j = 2, n[i]
+			sum = sum + Memd[d[j]+k]
+		    if (doaverage == YES)
+			average[i] = sum / n[i]
+		    else
+			average[i] = sum
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    average[i] = blank
+	    }
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			wt = wts[Memi[m[1]+k]]
+			sum = Memd[d[1]+k] * wt
+			sumwt = wt
+			do j = 2, n[i] {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + Memd[d[j]+k] * wt
+			    sumwt = sumwt + wt
+			}
+			if (doaverage == YES) {
+			    if (sumwt > 0)
+				average[i] = sum / sumwt
+			    else {
+				sum = Memd[d[1]+k]
+				do j = 2, n[i]
+				    sum = sum + Memd[d[j]+k]
+				average[i] = sum / n[i]
+			    }
+			} else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			sum = Memd[d[1]+k]
+			do j = 2, n[i]
+			    sum = sum + Memd[d[j]+k]
+			if (doaverage == YES)
+			    average[i] = sum / n[i]
+			else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    }
+	}
+end
+
diff --git a/noao/twodspec/longslit/lscombine/src/generic/iccclip.x b/noao/twodspec/longslit/lscombine/src/generic/iccclip.x
new file mode 100644
index 00000000..bf655477
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/iccclip.x
@@ -0,0 +1,1790 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		2	# Mininum number of images for algorithm
+
+
+# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average
+
+procedure ic_accdclips (d, m, n, scales, zeros, nm, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model parameters
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, r, zero
+data	zero /0.0/
+pointer	sp, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are no pixels go on to the combining.  Since the unweighted
+	# average is computed here possibly skip the combining later.
+
+	# There must be at least max (1, nkeep) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} else if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# There must be at least two pixels for rejection.  The initial
+	# average is the low/high rejected average except in the case of
+	# just two pixels.  The rejections are iterated and the average
+	# is recomputed.  Corrections for scaling may be performed.
+	# Depending on other flags the image IDs may also need to be adjusted.
+
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (MINCLIP-1, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Mems[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Mems[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    repeat {
+		if (n1 == 2) {
+		    sum = Mems[d[1]+k]
+		    sum = sum + Mems[d[2]+k]
+		    a = sum / 2
+		} else {
+		    low = Mems[d[1]+k]
+		    high = Mems[d[2]+k]
+		    if (low > high) {
+			d1 = low
+			low = high
+			high = d1
+		    }
+		    sum = 0.
+		    do j = 3, n1 {
+		       d1 = Mems[d[j]+k]
+		       if (d1 < low) {
+			   sum = sum + low
+			   low = d1
+			} else if (d1 > high) {
+			    sum = sum + high
+			    high = d1
+			} else
+			    sum = sum + d1
+		    }
+		    a = sum / (n1 - 2)
+		    sum = sum + low + high
+		}
+		n2 = n1
+		if (doscale1) {
+		    for (j=1; j<=n1; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+
+			l = Memi[mp1]
+			s = scales[l]
+			d1 = max (zero, s * (a + zeros[l]))
+			s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s
+
+			d1 = Mems[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Mems[dp1] = Mems[dp2]
+				Mems[dp2] = d1
+				mp2 = m[n1] + k
+				Memi[mp1] = Memi[mp2]
+				Memi[mp2] = l
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		} else {
+		    if (!keepids) {
+			s = max (zero, a)
+			s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+		    }
+		    for (j=1; j<=n1; j=j+1) {
+			if (keepids) {
+			    l = Memi[m[j]+k]
+			    s = max (zero, a)
+			    s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			}
+			dp1 = d[j] + k
+			d1 = Mems[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Mems[dp1] = Mems[dp2]
+				Mems[dp2] = d1
+				if (keepids) {
+				    mp1 = m[j] + k
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				}
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mems[dp1]
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Mems[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mems[dp1]
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Mems[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+	    }
+
+	    n[i] = n1
+	    if (!docombine)
+		if (n1 > 0)
+		    average[i] = sum / n1
+		else
+		    average[i] = blank
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median
+
+procedure ic_mccdclips (d, m, n, scales, zeros, nm, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, mp1, mp2
+real	med, zero
+data	zero /0.0/
+
+include	"../icombine.com"
+
+begin
+	# There must be at least max (MINCLIP, nkeep+1) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0) {
+		    med = Mems[d[n3-1]+k]
+		    med = (med + Mems[d[n3]+k]) / 2.
+		} else
+		    med = Mems[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (med - Mems[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (Mems[d[nh]+k] - med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			if (!keepids) {
+			    s = max (zero, med)
+			    s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+			}
+			for (; nl <= n2; nl = nl + 1) {
+			    if (keepids) {
+				l = Memi[m[nl]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (med - Mems[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    if (keepids) {
+				l = Memi[m[nh]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (Mems[d[nh]+k] -  med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mems[d[l]+k] = Mems[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mems[d[l]+k] = Mems[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average
+
+procedure ic_accdclipi (d, m, n, scales, zeros, nm, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model parameters
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, r, zero
+data	zero /0.0/
+pointer	sp, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are no pixels go on to the combining.  Since the unweighted
+	# average is computed here possibly skip the combining later.
+
+	# There must be at least max (1, nkeep) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} else if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# There must be at least two pixels for rejection.  The initial
+	# average is the low/high rejected average except in the case of
+	# just two pixels.  The rejections are iterated and the average
+	# is recomputed.  Corrections for scaling may be performed.
+	# Depending on other flags the image IDs may also need to be adjusted.
+
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (MINCLIP-1, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memi[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memi[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    repeat {
+		if (n1 == 2) {
+		    sum = Memi[d[1]+k]
+		    sum = sum + Memi[d[2]+k]
+		    a = sum / 2
+		} else {
+		    low = Memi[d[1]+k]
+		    high = Memi[d[2]+k]
+		    if (low > high) {
+			d1 = low
+			low = high
+			high = d1
+		    }
+		    sum = 0.
+		    do j = 3, n1 {
+		       d1 = Memi[d[j]+k]
+		       if (d1 < low) {
+			   sum = sum + low
+			   low = d1
+			} else if (d1 > high) {
+			    sum = sum + high
+			    high = d1
+			} else
+			    sum = sum + d1
+		    }
+		    a = sum / (n1 - 2)
+		    sum = sum + low + high
+		}
+		n2 = n1
+		if (doscale1) {
+		    for (j=1; j<=n1; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+
+			l = Memi[mp1]
+			s = scales[l]
+			d1 = max (zero, s * (a + zeros[l]))
+			s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s
+
+			d1 = Memi[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Memi[dp1] = Memi[dp2]
+				Memi[dp2] = d1
+				mp2 = m[n1] + k
+				Memi[mp1] = Memi[mp2]
+				Memi[mp2] = l
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		} else {
+		    if (!keepids) {
+			s = max (zero, a)
+			s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+		    }
+		    for (j=1; j<=n1; j=j+1) {
+			if (keepids) {
+			    l = Memi[m[j]+k]
+			    s = max (zero, a)
+			    s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			}
+			dp1 = d[j] + k
+			d1 = Memi[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Memi[dp1] = Memi[dp2]
+				Memi[dp2] = d1
+				if (keepids) {
+				    mp1 = m[j] + k
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				}
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memi[dp1]
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memi[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memi[dp1]
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memi[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+	    }
+
+	    n[i] = n1
+	    if (!docombine)
+		if (n1 > 0)
+		    average[i] = sum / n1
+		else
+		    average[i] = blank
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median
+
+procedure ic_mccdclipi (d, m, n, scales, zeros, nm, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, mp1, mp2
+real	med, zero
+data	zero /0.0/
+
+include	"../icombine.com"
+
+begin
+	# There must be at least max (MINCLIP, nkeep+1) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0) {
+		    med = Memi[d[n3-1]+k]
+		    med = (med + Memi[d[n3]+k]) / 2.
+		} else
+		    med = Memi[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (med - Memi[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (Memi[d[nh]+k] - med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			if (!keepids) {
+			    s = max (zero, med)
+			    s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+			}
+			for (; nl <= n2; nl = nl + 1) {
+			    if (keepids) {
+				l = Memi[m[nl]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (med - Memi[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    if (keepids) {
+				l = Memi[m[nh]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (Memi[d[nh]+k] -  med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memi[d[l]+k] = Memi[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memi[d[l]+k] = Memi[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average
+
+procedure ic_accdclipr (d, m, n, scales, zeros, nm, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model parameters
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, r, zero
+data	zero /0.0/
+pointer	sp, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are no pixels go on to the combining.  Since the unweighted
+	# average is computed here possibly skip the combining later.
+
+	# There must be at least max (1, nkeep) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} else if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# There must be at least two pixels for rejection.  The initial
+	# average is the low/high rejected average except in the case of
+	# just two pixels.  The rejections are iterated and the average
+	# is recomputed.  Corrections for scaling may be performed.
+	# Depending on other flags the image IDs may also need to be adjusted.
+
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (MINCLIP-1, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memr[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memr[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    repeat {
+		if (n1 == 2) {
+		    sum = Memr[d[1]+k]
+		    sum = sum + Memr[d[2]+k]
+		    a = sum / 2
+		} else {
+		    low = Memr[d[1]+k]
+		    high = Memr[d[2]+k]
+		    if (low > high) {
+			d1 = low
+			low = high
+			high = d1
+		    }
+		    sum = 0.
+		    do j = 3, n1 {
+		       d1 = Memr[d[j]+k]
+		       if (d1 < low) {
+			   sum = sum + low
+			   low = d1
+			} else if (d1 > high) {
+			    sum = sum + high
+			    high = d1
+			} else
+			    sum = sum + d1
+		    }
+		    a = sum / (n1 - 2)
+		    sum = sum + low + high
+		}
+		n2 = n1
+		if (doscale1) {
+		    for (j=1; j<=n1; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+
+			l = Memi[mp1]
+			s = scales[l]
+			d1 = max (zero, s * (a + zeros[l]))
+			s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s
+
+			d1 = Memr[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Memr[dp1] = Memr[dp2]
+				Memr[dp2] = d1
+				mp2 = m[n1] + k
+				Memi[mp1] = Memi[mp2]
+				Memi[mp2] = l
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		} else {
+		    if (!keepids) {
+			s = max (zero, a)
+			s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+		    }
+		    for (j=1; j<=n1; j=j+1) {
+			if (keepids) {
+			    l = Memi[m[j]+k]
+			    s = max (zero, a)
+			    s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			}
+			dp1 = d[j] + k
+			d1 = Memr[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Memr[dp1] = Memr[dp2]
+				Memr[dp2] = d1
+				if (keepids) {
+				    mp1 = m[j] + k
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				}
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memr[dp1]
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memr[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memr[dp1]
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memr[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+	    }
+
+	    n[i] = n1
+	    if (!docombine)
+		if (n1 > 0)
+		    average[i] = sum / n1
+		else
+		    average[i] = blank
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median
+
+procedure ic_mccdclipr (d, m, n, scales, zeros, nm, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, mp1, mp2
+real	med, zero
+data	zero /0.0/
+
+include	"../icombine.com"
+
+begin
+	# There must be at least max (MINCLIP, nkeep+1) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0) {
+		    med = Memr[d[n3-1]+k]
+		    med = (med + Memr[d[n3]+k]) / 2.
+		} else
+		    med = Memr[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (med - Memr[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (Memr[d[nh]+k] - med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			if (!keepids) {
+			    s = max (zero, med)
+			    s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+			}
+			for (; nl <= n2; nl = nl + 1) {
+			    if (keepids) {
+				l = Memi[m[nl]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (med - Memr[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    if (keepids) {
+				l = Memi[m[nh]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (Memr[d[nh]+k] -  med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average
+
+procedure ic_accdclipd (d, m, n, scales, zeros, nm, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model parameters
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+double	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+double	d1, low, high, sum, a, s, r, zero
+data	zero /0.0D0/
+pointer	sp, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are no pixels go on to the combining.  Since the unweighted
+	# average is computed here possibly skip the combining later.
+
+	# There must be at least max (1, nkeep) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} else if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# There must be at least two pixels for rejection.  The initial
+	# average is the low/high rejected average except in the case of
+	# just two pixels.  The rejections are iterated and the average
+	# is recomputed.  Corrections for scaling may be performed.
+	# Depending on other flags the image IDs may also need to be adjusted.
+
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (MINCLIP-1, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memd[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memd[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    repeat {
+		if (n1 == 2) {
+		    sum = Memd[d[1]+k]
+		    sum = sum + Memd[d[2]+k]
+		    a = sum / 2
+		} else {
+		    low = Memd[d[1]+k]
+		    high = Memd[d[2]+k]
+		    if (low > high) {
+			d1 = low
+			low = high
+			high = d1
+		    }
+		    sum = 0.
+		    do j = 3, n1 {
+		       d1 = Memd[d[j]+k]
+		       if (d1 < low) {
+			   sum = sum + low
+			   low = d1
+			} else if (d1 > high) {
+			    sum = sum + high
+			    high = d1
+			} else
+			    sum = sum + d1
+		    }
+		    a = sum / (n1 - 2)
+		    sum = sum + low + high
+		}
+		n2 = n1
+		if (doscale1) {
+		    for (j=1; j<=n1; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+
+			l = Memi[mp1]
+			s = scales[l]
+			d1 = max (zero, s * (a + zeros[l]))
+			s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s
+
+			d1 = Memd[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Memd[dp1] = Memd[dp2]
+				Memd[dp2] = d1
+				mp2 = m[n1] + k
+				Memi[mp1] = Memi[mp2]
+				Memi[mp2] = l
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		} else {
+		    if (!keepids) {
+			s = max (zero, a)
+			s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+		    }
+		    for (j=1; j<=n1; j=j+1) {
+			if (keepids) {
+			    l = Memi[m[j]+k]
+			    s = max (zero, a)
+			    s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			}
+			dp1 = d[j] + k
+			d1 = Memd[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Memd[dp1] = Memd[dp2]
+				Memd[dp2] = d1
+				if (keepids) {
+				    mp1 = m[j] + k
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				}
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memd[dp1]
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memd[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memd[dp1]
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memd[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+	    }
+
+	    n[i] = n1
+	    if (!docombine)
+		if (n1 > 0)
+		    average[i] = sum / n1
+		else
+		    average[i] = blank
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median
+
+procedure ic_mccdclipd (d, m, n, scales, zeros, nm, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+double	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, mp1, mp2
+double	med, zero
+data	zero /0.0D0/
+
+include	"../icombine.com"
+
+begin
+	# There must be at least max (MINCLIP, nkeep+1) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0) {
+		    med = Memd[d[n3-1]+k]
+		    med = (med + Memd[d[n3]+k]) / 2.
+		} else
+		    med = Memd[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (med - Memd[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (Memd[d[nh]+k] - med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			if (!keepids) {
+			    s = max (zero, med)
+			    s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+			}
+			for (; nl <= n2; nl = nl + 1) {
+			    if (keepids) {
+				l = Memi[m[nl]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (med - Memd[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    if (keepids) {
+				l = Memi[m[nh]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (Memd[d[nh]+k] -  med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memd[d[l]+k] = Memd[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memd[d[l]+k] = Memd[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icgdata.x b/noao/twodspec/longslit/lscombine/src/generic/icgdata.x
new file mode 100644
index 00000000..5cefcf5a
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icgdata.x
@@ -0,0 +1,1207 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<mach.h>
+include	"../icombine.h"
+
+
+# IC_GDATA -- Get line of image and mask data and apply threshold and scaling.
+# Entirely empty lines are excluded.  The data are compacted within the
+# input data buffers.  If it is required, the connection to the original
+# image index is kept in the returned m data pointers.
+
+procedure ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets, scales,
+	zeros, nimages, npts, v1, v2)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+pointer	dbuf[nimages]		# Data buffers
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Empty mask flags
+int	offsets[nimages,ARB]	# Image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+int	nimages			# Number of input images
+int	npts			# NUmber of output points per line
+long	v1[ARB], v2[ARB]	# Line vectors
+
+int	i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnls()
+real	a, b
+pointer	buf, dp, ip, mp
+errchk	xt_cpix, xt_imgnls
+
+include	"../icombine.com"
+
+begin
+	# Get masks and return if there is no data
+	call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages)
+	if (dflag == D_NONE) {
+	    call aclri (n, npts)
+	    return
+	}
+
+	# Close images which are not needed.
+	nout = IM_LEN(out[1],1)
+	ndim = IM_NDIM(out[1])
+	if (!project) {
+	    do i = 1, nimages {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1)
+		    call xt_cpix (i)
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+	    }
+	}
+
+	# Get data and fill data buffers.  Correct for offsets if needed.
+	do i = 1, nimages {
+	    if (lflag[i] == D_NONE)
+		next
+	    if (dbuf[i] == NULL) {
+		call amovl (v1, v2, IM_MAXDIM)
+		if (project)
+		    v2[ndim+1] = i
+		j = xt_imgnls (in[i], i, d[i], v2, v1[2])
+	    } else {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1) {
+		    lflag[i] = D_NONE
+		    next
+		}
+		k = 1 + j - offsets[i,1]
+		v2[1] = k
+		do l = 2, ndim {
+		    v2[l] = v1[l] - offsets[i,l]
+		    if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) {
+			lflag[i] = D_NONE
+			break
+		    }
+		}
+		if (lflag[i] == D_NONE)
+		    next
+		if (project)
+		    v2[ndim+1] = i
+		l = xt_imgnls (in[i], i, buf, v2, v1[2])
+		call amovs (Mems[buf+k-1], Mems[dbuf[i]+j], npix)
+		d[i] = dbuf[i]
+	    }
+	}
+
+	# Apply threshold if needed
+	if (dothresh) {
+	    do i = 1, nimages {
+		if (lflag[i] == D_ALL) {
+		    dp = d[i]
+		    do j = 1, npts {
+			a = Mems[dp]
+			if (a < lthresh || a > hthresh) {
+			    Memi[m[i]+j-1] = 1
+			    lflag[i] = D_MIX
+			    dflag = D_MIX
+			}
+			dp = dp + 1
+		    }
+
+		    # Check for completely empty lines
+		    if (lflag[i] == D_MIX) {
+			lflag[i] = D_NONE
+			mp = m[i]
+			do j = 1, npts {
+			    if (Memi[mp] == 0) {
+				lflag[i] = D_MIX
+				break
+			    }
+			    mp = mp + 1
+			}
+		    }
+		} else if (lflag[i] == D_MIX) {
+		    nin = IM_LEN(in[i],1)
+		    j = max (0, offsets[i,1])
+		    k = min (nout, nin + offsets[i,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    a = Mems[dp]
+			    if (a < lthresh || a > hthresh) {
+				Memi[m[i]+j-1] = 1
+				dflag = D_MIX
+			    }
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+
+		    # Check for completely empty lines
+		    lflag[i] = D_NONE
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    lflag[i] = D_MIX
+			    break
+			}
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Apply scaling (avoiding masked pixels which might overflow?)
+	if (doscale) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = d[i]
+		    a = scales[i]
+		    b = -zeros[i]
+		    do j = 1, npts {
+			Mems[dp] = Mems[dp] / a + b
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    a = scales[i]
+		    b = -zeros[i]
+		    if (lflag[i] == D_ALL) {
+			dp = d[i]
+			do j = 1, npts {
+			    Mems[dp] = Mems[dp] / a + b
+			    dp = dp + 1
+			}
+		    } else if (lflag[i] == D_MIX) {
+			nin = IM_LEN(in[i],1)
+			j = max (0, offsets[i,1])
+			k = min (nout, nin + offsets[i,1])
+			npix = k - j
+			n1 = 1 + j
+			n2 = n1 + npix - 1
+			dp = d[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0)
+				Mems[dp] = Mems[dp] / a + b
+			    dp = dp + 1
+			    mp = mp + 1
+			}
+		    }
+		}
+	    }
+	}
+
+	# Sort pointers to exclude unused images.
+	# Use the lflag array to keep track of the image index.
+
+	if (dflag == D_ALL)
+	    nused = nimages
+	else {
+	    nused = 0
+	    do i = 1, nimages
+		if (lflag[i] != D_NONE) {
+		    nused = nused + 1
+		    d[nused] = d[i]
+		    m[nused] = m[i]
+		    lflag[nused] = i
+		}
+	    if (nused == 0)
+		dflag = D_NONE
+	}
+
+	# Compact data to remove bad pixels
+	# Keep track of the image indices if needed
+	# If growing mark the end of the included image indices with zero
+
+	if (dflag == D_ALL) {
+	    call amovki (nused, n, npts)
+	    if (keepids)
+		do i = 1, nimages
+		    call amovki (i, Memi[id[i]], npts)
+	} else if (dflag == D_NONE)
+	    call aclri (n, npts)
+	else {
+	    call aclri (n, npts)
+	    if (keepids) {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    ip = id[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i) {
+				Mems[d[k]+j-1] = Mems[dp]
+				Memi[id[k]+j-1] = l
+			    } else
+				Memi[ip] = l
+			}
+			dp = dp + 1
+			ip = ip + 1
+			mp = mp + 1
+		    }
+		}
+		if (grow >= 1.) {
+		    do j = 1, npts {
+			do i = n[j]+1, nimages
+			    Memi[id[i]+j-1] = 0
+		    }
+		}
+	    } else {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i)
+				Mems[d[k]+j-1] = Mems[dp]
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Sort the pixels and IDs if needed
+	if (mclip) {
+	    call malloc (dp, nimages, TY_SHORT)
+	    if (keepids) {
+		call malloc (ip, nimages, TY_INT)
+		call ic_2sorts (d, Mems[dp], id, Memi[ip], n, npts)
+		call mfree (ip, TY_INT)
+	    } else
+		call ic_sorts (d, Mems[dp], n, npts)
+	    call mfree (dp, TY_SHORT)
+	}
+end
+
+# IC_GDATA -- Get line of image and mask data and apply threshold and scaling.
+# Entirely empty lines are excluded.  The data are compacted within the
+# input data buffers.  If it is required, the connection to the original
+# image index is kept in the returned m data pointers.
+
+procedure ic_gdatai (in, out, dbuf, d, id, n, m, lflag, offsets, scales,
+	zeros, nimages, npts, v1, v2)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+pointer	dbuf[nimages]		# Data buffers
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Empty mask flags
+int	offsets[nimages,ARB]	# Image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+int	nimages			# Number of input images
+int	npts			# NUmber of output points per line
+long	v1[ARB], v2[ARB]	# Line vectors
+
+int	i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnli()
+real	a, b
+pointer	buf, dp, ip, mp
+errchk	xt_cpix, xt_imgnli
+
+include	"../icombine.com"
+
+begin
+	# Get masks and return if there is no data
+	call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages)
+	if (dflag == D_NONE) {
+	    call aclri (n, npts)
+	    return
+	}
+
+	# Close images which are not needed.
+	nout = IM_LEN(out[1],1)
+	ndim = IM_NDIM(out[1])
+	if (!project) {
+	    do i = 1, nimages {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1)
+		    call xt_cpix (i)
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+	    }
+	}
+
+	# Get data and fill data buffers.  Correct for offsets if needed.
+	do i = 1, nimages {
+	    if (lflag[i] == D_NONE)
+		next
+	    if (dbuf[i] == NULL) {
+		call amovl (v1, v2, IM_MAXDIM)
+		if (project)
+		    v2[ndim+1] = i
+		j = xt_imgnli (in[i], i, d[i], v2, v1[2])
+	    } else {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1) {
+		    lflag[i] = D_NONE
+		    next
+		}
+		k = 1 + j - offsets[i,1]
+		v2[1] = k
+		do l = 2, ndim {
+		    v2[l] = v1[l] - offsets[i,l]
+		    if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) {
+			lflag[i] = D_NONE
+			break
+		    }
+		}
+		if (lflag[i] == D_NONE)
+		    next
+		if (project)
+		    v2[ndim+1] = i
+		l = xt_imgnli (in[i], i, buf, v2, v1[2])
+		call amovi (Memi[buf+k-1], Memi[dbuf[i]+j], npix)
+		d[i] = dbuf[i]
+	    }
+	}
+
+	# Apply threshold if needed
+	if (dothresh) {
+	    do i = 1, nimages {
+		if (lflag[i] == D_ALL) {
+		    dp = d[i]
+		    do j = 1, npts {
+			a = Memi[dp]
+			if (a < lthresh || a > hthresh) {
+			    Memi[m[i]+j-1] = 1
+			    lflag[i] = D_MIX
+			    dflag = D_MIX
+			}
+			dp = dp + 1
+		    }
+
+		    # Check for completely empty lines
+		    if (lflag[i] == D_MIX) {
+			lflag[i] = D_NONE
+			mp = m[i]
+			do j = 1, npts {
+			    if (Memi[mp] == 0) {
+				lflag[i] = D_MIX
+				break
+			    }
+			    mp = mp + 1
+			}
+		    }
+		} else if (lflag[i] == D_MIX) {
+		    nin = IM_LEN(in[i],1)
+		    j = max (0, offsets[i,1])
+		    k = min (nout, nin + offsets[i,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    a = Memi[dp]
+			    if (a < lthresh || a > hthresh) {
+				Memi[m[i]+j-1] = 1
+				dflag = D_MIX
+			    }
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+
+		    # Check for completely empty lines
+		    lflag[i] = D_NONE
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    lflag[i] = D_MIX
+			    break
+			}
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Apply scaling (avoiding masked pixels which might overflow?)
+	if (doscale) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = d[i]
+		    a = scales[i]
+		    b = -zeros[i]
+		    do j = 1, npts {
+			Memi[dp] = Memi[dp] / a + b
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    a = scales[i]
+		    b = -zeros[i]
+		    if (lflag[i] == D_ALL) {
+			dp = d[i]
+			do j = 1, npts {
+			    Memi[dp] = Memi[dp] / a + b
+			    dp = dp + 1
+			}
+		    } else if (lflag[i] == D_MIX) {
+			nin = IM_LEN(in[i],1)
+			j = max (0, offsets[i,1])
+			k = min (nout, nin + offsets[i,1])
+			npix = k - j
+			n1 = 1 + j
+			n2 = n1 + npix - 1
+			dp = d[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0)
+				Memi[dp] = Memi[dp] / a + b
+			    dp = dp + 1
+			    mp = mp + 1
+			}
+		    }
+		}
+	    }
+	}
+
+	# Sort pointers to exclude unused images.
+	# Use the lflag array to keep track of the image index.
+
+	if (dflag == D_ALL)
+	    nused = nimages
+	else {
+	    nused = 0
+	    do i = 1, nimages
+		if (lflag[i] != D_NONE) {
+		    nused = nused + 1
+		    d[nused] = d[i]
+		    m[nused] = m[i]
+		    lflag[nused] = i
+		}
+	    if (nused == 0)
+		dflag = D_NONE
+	}
+
+	# Compact data to remove bad pixels
+	# Keep track of the image indices if needed
+	# If growing mark the end of the included image indices with zero
+
+	if (dflag == D_ALL) {
+	    call amovki (nused, n, npts)
+	    if (keepids)
+		do i = 1, nimages
+		    call amovki (i, Memi[id[i]], npts)
+	} else if (dflag == D_NONE)
+	    call aclri (n, npts)
+	else {
+	    call aclri (n, npts)
+	    if (keepids) {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    ip = id[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i) {
+				Memi[d[k]+j-1] = Memi[dp]
+				Memi[id[k]+j-1] = l
+			    } else
+				Memi[ip] = l
+			}
+			dp = dp + 1
+			ip = ip + 1
+			mp = mp + 1
+		    }
+		}
+		if (grow >= 1.) {
+		    do j = 1, npts {
+			do i = n[j]+1, nimages
+			    Memi[id[i]+j-1] = 0
+		    }
+		}
+	    } else {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i)
+				Memi[d[k]+j-1] = Memi[dp]
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Sort the pixels and IDs if needed
+	if (mclip) {
+	    call malloc (dp, nimages, TY_INT)
+	    if (keepids) {
+		call malloc (ip, nimages, TY_INT)
+		call ic_2sorti (d, Memi[dp], id, Memi[ip], n, npts)
+		call mfree (ip, TY_INT)
+	    } else
+		call ic_sorti (d, Memi[dp], n, npts)
+	    call mfree (dp, TY_INT)
+	}
+end
+
+# IC_GDATA -- Get line of image and mask data and apply threshold and scaling.
+# Entirely empty lines are excluded.  The data are compacted within the
+# input data buffers.  If it is required, the connection to the original
+# image index is kept in the returned m data pointers.
+
+procedure ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets, scales,
+	zeros, nimages, npts, v1, v2)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+pointer	dbuf[nimages]		# Data buffers
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Empty mask flags
+int	offsets[nimages,ARB]	# Image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+int	nimages			# Number of input images
+int	npts			# NUmber of output points per line
+long	v1[ARB], v2[ARB]	# Line vectors
+
+int	i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnlr()
+real	a, b
+pointer	buf, dp, ip, mp
+errchk	xt_cpix, xt_imgnlr
+
+include	"../icombine.com"
+
+begin
+	# Get masks and return if there is no data
+	call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages)
+	if (dflag == D_NONE) {
+	    call aclri (n, npts)
+	    return
+	}
+
+	# Close images which are not needed.
+	nout = IM_LEN(out[1],1)
+	ndim = IM_NDIM(out[1])
+	if (!project) {
+	    do i = 1, nimages {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1)
+		    call xt_cpix (i)
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+	    }
+	}
+
+	# Get data and fill data buffers.  Correct for offsets if needed.
+	do i = 1, nimages {
+	    if (lflag[i] == D_NONE)
+		next
+	    if (dbuf[i] == NULL) {
+		call amovl (v1, v2, IM_MAXDIM)
+		if (project)
+		    v2[ndim+1] = i
+		j = xt_imgnlr (in[i], i, d[i], v2, v1[2])
+	    } else {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1) {
+		    lflag[i] = D_NONE
+		    next
+		}
+		k = 1 + j - offsets[i,1]
+		v2[1] = k
+		do l = 2, ndim {
+		    v2[l] = v1[l] - offsets[i,l]
+		    if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) {
+			lflag[i] = D_NONE
+			break
+		    }
+		}
+		if (lflag[i] == D_NONE)
+		    next
+		if (project)
+		    v2[ndim+1] = i
+		l = xt_imgnlr (in[i], i, buf, v2, v1[2])
+		call amovr (Memr[buf+k-1], Memr[dbuf[i]+j], npix)
+		d[i] = dbuf[i]
+	    }
+	}
+
+	# Apply threshold if needed
+	if (dothresh) {
+	    do i = 1, nimages {
+		if (lflag[i] == D_ALL) {
+		    dp = d[i]
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a < lthresh || a > hthresh) {
+			    Memi[m[i]+j-1] = 1
+			    lflag[i] = D_MIX
+			    dflag = D_MIX
+			}
+			dp = dp + 1
+		    }
+
+		    # Check for completely empty lines
+		    if (lflag[i] == D_MIX) {
+			lflag[i] = D_NONE
+			mp = m[i]
+			do j = 1, npts {
+			    if (Memi[mp] == 0) {
+				lflag[i] = D_MIX
+				break
+			    }
+			    mp = mp + 1
+			}
+		    }
+		} else if (lflag[i] == D_MIX) {
+		    nin = IM_LEN(in[i],1)
+		    j = max (0, offsets[i,1])
+		    k = min (nout, nin + offsets[i,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    a = Memr[dp]
+			    if (a < lthresh || a > hthresh) {
+				Memi[m[i]+j-1] = 1
+				dflag = D_MIX
+			    }
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+
+		    # Check for completely empty lines
+		    lflag[i] = D_NONE
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    lflag[i] = D_MIX
+			    break
+			}
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Apply scaling (avoiding masked pixels which might overflow?)
+	if (doscale) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = d[i]
+		    a = scales[i]
+		    b = -zeros[i]
+		    do j = 1, npts {
+			Memr[dp] = Memr[dp] / a + b
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    a = scales[i]
+		    b = -zeros[i]
+		    if (lflag[i] == D_ALL) {
+			dp = d[i]
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a + b
+			    dp = dp + 1
+			}
+		    } else if (lflag[i] == D_MIX) {
+			nin = IM_LEN(in[i],1)
+			j = max (0, offsets[i,1])
+			k = min (nout, nin + offsets[i,1])
+			npix = k - j
+			n1 = 1 + j
+			n2 = n1 + npix - 1
+			dp = d[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0)
+				Memr[dp] = Memr[dp] / a + b
+			    dp = dp + 1
+			    mp = mp + 1
+			}
+		    }
+		}
+	    }
+	}
+
+	# Sort pointers to exclude unused images.
+	# Use the lflag array to keep track of the image index.
+
+	if (dflag == D_ALL)
+	    nused = nimages
+	else {
+	    nused = 0
+	    do i = 1, nimages
+		if (lflag[i] != D_NONE) {
+		    nused = nused + 1
+		    d[nused] = d[i]
+		    m[nused] = m[i]
+		    lflag[nused] = i
+		}
+	    if (nused == 0)
+		dflag = D_NONE
+	}
+
+	# Compact data to remove bad pixels
+	# Keep track of the image indices if needed
+	# If growing mark the end of the included image indices with zero
+
+	if (dflag == D_ALL) {
+	    call amovki (nused, n, npts)
+	    if (keepids)
+		do i = 1, nimages
+		    call amovki (i, Memi[id[i]], npts)
+	} else if (dflag == D_NONE)
+	    call aclri (n, npts)
+	else {
+	    call aclri (n, npts)
+	    if (keepids) {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    ip = id[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i) {
+				Memr[d[k]+j-1] = Memr[dp]
+				Memi[id[k]+j-1] = l
+			    } else
+				Memi[ip] = l
+			}
+			dp = dp + 1
+			ip = ip + 1
+			mp = mp + 1
+		    }
+		}
+		if (grow >= 1.) {
+		    do j = 1, npts {
+			do i = n[j]+1, nimages
+			    Memi[id[i]+j-1] = 0
+		    }
+		}
+	    } else {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i)
+				Memr[d[k]+j-1] = Memr[dp]
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Sort the pixels and IDs if needed
+	if (mclip) {
+	    call malloc (dp, nimages, TY_REAL)
+	    if (keepids) {
+		call malloc (ip, nimages, TY_INT)
+		call ic_2sortr (d, Memr[dp], id, Memi[ip], n, npts)
+		call mfree (ip, TY_INT)
+	    } else
+		call ic_sortr (d, Memr[dp], n, npts)
+	    call mfree (dp, TY_REAL)
+	}
+end
+
+# IC_GDATA -- Get line of image and mask data and apply threshold and scaling.
+# Entirely empty lines are excluded.  The data are compacted within the
+# input data buffers.  If it is required, the connection to the original
+# image index is kept in the returned m data pointers.
+
+procedure ic_gdatad (in, out, dbuf, d, id, n, m, lflag, offsets, scales,
+	zeros, nimages, npts, v1, v2)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+pointer	dbuf[nimages]		# Data buffers
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Empty mask flags
+int	offsets[nimages,ARB]	# Image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+int	nimages			# Number of input images
+int	npts			# NUmber of output points per line
+long	v1[ARB], v2[ARB]	# Line vectors
+
+int	i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnld()
+real	a, b
+pointer	buf, dp, ip, mp
+errchk	xt_cpix, xt_imgnld
+
+include	"../icombine.com"
+
+begin
+	# Get masks and return if there is no data
+	call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages)
+	if (dflag == D_NONE) {
+	    call aclri (n, npts)
+	    return
+	}
+
+	# Close images which are not needed.
+	nout = IM_LEN(out[1],1)
+	ndim = IM_NDIM(out[1])
+	if (!project) {
+	    do i = 1, nimages {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1)
+		    call xt_cpix (i)
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+	    }
+	}
+
+	# Get data and fill data buffers.  Correct for offsets if needed.
+	do i = 1, nimages {
+	    if (lflag[i] == D_NONE)
+		next
+	    if (dbuf[i] == NULL) {
+		call amovl (v1, v2, IM_MAXDIM)
+		if (project)
+		    v2[ndim+1] = i
+		j = xt_imgnld (in[i], i, d[i], v2, v1[2])
+	    } else {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1) {
+		    lflag[i] = D_NONE
+		    next
+		}
+		k = 1 + j - offsets[i,1]
+		v2[1] = k
+		do l = 2, ndim {
+		    v2[l] = v1[l] - offsets[i,l]
+		    if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) {
+			lflag[i] = D_NONE
+			break
+		    }
+		}
+		if (lflag[i] == D_NONE)
+		    next
+		if (project)
+		    v2[ndim+1] = i
+		l = xt_imgnld (in[i], i, buf, v2, v1[2])
+		call amovd (Memd[buf+k-1], Memd[dbuf[i]+j], npix)
+		d[i] = dbuf[i]
+	    }
+	}
+
+	# Apply threshold if needed
+	if (dothresh) {
+	    do i = 1, nimages {
+		if (lflag[i] == D_ALL) {
+		    dp = d[i]
+		    do j = 1, npts {
+			a = Memd[dp]
+			if (a < lthresh || a > hthresh) {
+			    Memi[m[i]+j-1] = 1
+			    lflag[i] = D_MIX
+			    dflag = D_MIX
+			}
+			dp = dp + 1
+		    }
+
+		    # Check for completely empty lines
+		    if (lflag[i] == D_MIX) {
+			lflag[i] = D_NONE
+			mp = m[i]
+			do j = 1, npts {
+			    if (Memi[mp] == 0) {
+				lflag[i] = D_MIX
+				break
+			    }
+			    mp = mp + 1
+			}
+		    }
+		} else if (lflag[i] == D_MIX) {
+		    nin = IM_LEN(in[i],1)
+		    j = max (0, offsets[i,1])
+		    k = min (nout, nin + offsets[i,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    a = Memd[dp]
+			    if (a < lthresh || a > hthresh) {
+				Memi[m[i]+j-1] = 1
+				dflag = D_MIX
+			    }
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+
+		    # Check for completely empty lines
+		    lflag[i] = D_NONE
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    lflag[i] = D_MIX
+			    break
+			}
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Apply scaling (avoiding masked pixels which might overflow?)
+	if (doscale) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = d[i]
+		    a = scales[i]
+		    b = -zeros[i]
+		    do j = 1, npts {
+			Memd[dp] = Memd[dp] / a + b
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    a = scales[i]
+		    b = -zeros[i]
+		    if (lflag[i] == D_ALL) {
+			dp = d[i]
+			do j = 1, npts {
+			    Memd[dp] = Memd[dp] / a + b
+			    dp = dp + 1
+			}
+		    } else if (lflag[i] == D_MIX) {
+			nin = IM_LEN(in[i],1)
+			j = max (0, offsets[i,1])
+			k = min (nout, nin + offsets[i,1])
+			npix = k - j
+			n1 = 1 + j
+			n2 = n1 + npix - 1
+			dp = d[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0)
+				Memd[dp] = Memd[dp] / a + b
+			    dp = dp + 1
+			    mp = mp + 1
+			}
+		    }
+		}
+	    }
+	}
+
+	# Sort pointers to exclude unused images.
+	# Use the lflag array to keep track of the image index.
+
+	if (dflag == D_ALL)
+	    nused = nimages
+	else {
+	    nused = 0
+	    do i = 1, nimages
+		if (lflag[i] != D_NONE) {
+		    nused = nused + 1
+		    d[nused] = d[i]
+		    m[nused] = m[i]
+		    lflag[nused] = i
+		}
+	    if (nused == 0)
+		dflag = D_NONE
+	}
+
+	# Compact data to remove bad pixels
+	# Keep track of the image indices if needed
+	# If growing mark the end of the included image indices with zero
+
+	if (dflag == D_ALL) {
+	    call amovki (nused, n, npts)
+	    if (keepids)
+		do i = 1, nimages
+		    call amovki (i, Memi[id[i]], npts)
+	} else if (dflag == D_NONE)
+	    call aclri (n, npts)
+	else {
+	    call aclri (n, npts)
+	    if (keepids) {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    ip = id[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i) {
+				Memd[d[k]+j-1] = Memd[dp]
+				Memi[id[k]+j-1] = l
+			    } else
+				Memi[ip] = l
+			}
+			dp = dp + 1
+			ip = ip + 1
+			mp = mp + 1
+		    }
+		}
+		if (grow >= 1.) {
+		    do j = 1, npts {
+			do i = n[j]+1, nimages
+			    Memi[id[i]+j-1] = 0
+		    }
+		}
+	    } else {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i)
+				Memd[d[k]+j-1] = Memd[dp]
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Sort the pixels and IDs if needed
+	if (mclip) {
+	    call malloc (dp, nimages, TY_DOUBLE)
+	    if (keepids) {
+		call malloc (ip, nimages, TY_INT)
+		call ic_2sortd (d, Memd[dp], id, Memi[ip], n, npts)
+		call mfree (ip, TY_INT)
+	    } else
+		call ic_sortd (d, Memd[dp], n, npts)
+	    call mfree (dp, TY_DOUBLE)
+	}
+end
+
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icgrow.x b/noao/twodspec/longslit/lscombine/src/generic/icgrow.x
new file mode 100644
index 00000000..1ccb7885
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icgrow.x
@@ -0,0 +1,263 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	"../icombine.h"
+
+# IC_GROW --  Mark neigbors of rejected pixels.
+# The rejected pixels (original plus grown) are saved in pixel masks.
+
+procedure ic_grow (out, v, m, n, buf, nimages, npts, pms)
+
+pointer	out			# Output image pointer
+long	v[ARB]			# Output vector
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[npts,nimages]	# Working buffer
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k, l, line, nl, rop, igrow, nset, ncompress, or()
+real	grow2, i2
+pointer	mp, pm, pm_newmask()
+errchk	pm_newmask()
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE || grow == 0.)
+	    return
+
+	line = v[2]
+	nl = IM_LEN(out,2)
+	rop = or (PIX_SRC, PIX_DST)
+
+	igrow = grow
+	grow2 = grow**2
+	do l = 0, igrow {
+	    i2 = grow2 - l * l
+	    call aclri (buf, npts*nimages)
+	    nset = 0
+	    do j = 1, npts {
+		do k = n[j]+1, nimages {
+		    mp = Memi[m[k]+j-1]
+		    if (mp == 0)
+			next
+		    do i = 0, igrow {
+			if (i**2 > i2)
+			    next
+			if (j > i)
+			    buf[j-i,mp] = 1
+			if (j+i <= npts)
+			    buf[j+i,mp] = 1
+			nset = nset + 1
+		    }
+		}
+	    }
+	    if (nset == 0)
+		return
+
+	    if (pms == NULL) {
+		call malloc (pms, nimages, TY_POINTER)
+		do i = 1, nimages
+		    Memi[pms+i-1] = pm_newmask (out, 1)
+		ncompress = 0
+	    }
+	    do i = 1, nimages {
+		pm = Memi[pms+i-1]
+		v[2] = line - l
+		if (v[2] > 0)
+		    call pmplpi (pm, v, buf[1,i], 1, npts, rop)
+		if (l > 0) {
+		    v[2] = line + l
+		    if (v[2] <= nl)
+			call pmplpi (pm, v, buf[1,i], 1, npts, rop)
+		}
+	    }
+	}
+	v[2] = line
+
+	if (ncompress > 10) {
+	    do i = 1, nimages {
+		pm = Memi[pms+i-1]
+		call pm_compress (pm)
+	    }
+	    ncompress = 0
+	} else
+	    ncompress = ncompress + 1
+end
+
+
+
+# IC_GROW$T --  Reject pixels.
+
+procedure ic_grows (v, d, m, n, buf, nimages, npts, pms)
+
+long	v[ARB]			# Output vector
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[ARB]		# Buffer of npts
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k
+pointer	pm
+bool	pl_linenotempty()
+
+include	"../icombine.com"
+
+begin
+	do k = 1, nimages {
+	    pm = Memi[pms+k-1]
+	    if (!pl_linenotempty (pm, v))
+		next
+	    call pmglpi (pm, v, buf, 1, npts, PIX_SRC)
+	    do i = 1, npts {
+		if (buf[i] == 0)
+		    next
+		for (j = 1; j <= n[i]; j = j + 1) {
+		    if (Memi[m[j]+i-1] == k) {
+			if (j < n[i]) {
+			    Mems[d[j]+i-1] = Mems[d[n[i]]+i-1]
+			    Memi[m[j]+i-1] = Memi[m[n[i]]+i-1]
+			}
+			n[i] = n[i] - 1
+			dflag = D_MIX
+			break
+		    }
+		}
+	    }
+	}
+end
+
+# IC_GROW$T --  Reject pixels.
+
+procedure ic_growi (v, d, m, n, buf, nimages, npts, pms)
+
+long	v[ARB]			# Output vector
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[ARB]		# Buffer of npts
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k
+pointer	pm
+bool	pl_linenotempty()
+
+include	"../icombine.com"
+
+begin
+	do k = 1, nimages {
+	    pm = Memi[pms+k-1]
+	    if (!pl_linenotempty (pm, v))
+		next
+	    call pmglpi (pm, v, buf, 1, npts, PIX_SRC)
+	    do i = 1, npts {
+		if (buf[i] == 0)
+		    next
+		for (j = 1; j <= n[i]; j = j + 1) {
+		    if (Memi[m[j]+i-1] == k) {
+			if (j < n[i]) {
+			    Memi[d[j]+i-1] = Memi[d[n[i]]+i-1]
+			    Memi[m[j]+i-1] = Memi[m[n[i]]+i-1]
+			}
+			n[i] = n[i] - 1
+			dflag = D_MIX
+			break
+		    }
+		}
+	    }
+	}
+end
+
+# IC_GROW$T --  Reject pixels.
+
+procedure ic_growr (v, d, m, n, buf, nimages, npts, pms)
+
+long	v[ARB]			# Output vector
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[ARB]		# Buffer of npts
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k
+pointer	pm
+bool	pl_linenotempty()
+
+include	"../icombine.com"
+
+begin
+	do k = 1, nimages {
+	    pm = Memi[pms+k-1]
+	    if (!pl_linenotempty (pm, v))
+		next
+	    call pmglpi (pm, v, buf, 1, npts, PIX_SRC)
+	    do i = 1, npts {
+		if (buf[i] == 0)
+		    next
+		for (j = 1; j <= n[i]; j = j + 1) {
+		    if (Memi[m[j]+i-1] == k) {
+			if (j < n[i]) {
+			    Memr[d[j]+i-1] = Memr[d[n[i]]+i-1]
+			    Memi[m[j]+i-1] = Memi[m[n[i]]+i-1]
+			}
+			n[i] = n[i] - 1
+			dflag = D_MIX
+			break
+		    }
+		}
+	    }
+	}
+end
+
+# IC_GROW$T --  Reject pixels.
+
+procedure ic_growd (v, d, m, n, buf, nimages, npts, pms)
+
+long	v[ARB]			# Output vector
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[ARB]		# Buffer of npts
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k
+pointer	pm
+bool	pl_linenotempty()
+
+include	"../icombine.com"
+
+begin
+	do k = 1, nimages {
+	    pm = Memi[pms+k-1]
+	    if (!pl_linenotempty (pm, v))
+		next
+	    call pmglpi (pm, v, buf, 1, npts, PIX_SRC)
+	    do i = 1, npts {
+		if (buf[i] == 0)
+		    next
+		for (j = 1; j <= n[i]; j = j + 1) {
+		    if (Memi[m[j]+i-1] == k) {
+			if (j < n[i]) {
+			    Memd[d[j]+i-1] = Memd[d[n[i]]+i-1]
+			    Memi[m[j]+i-1] = Memi[m[n[i]]+i-1]
+			}
+			n[i] = n[i] - 1
+			dflag = D_MIX
+			break
+		    }
+		}
+	    }
+	}
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icmedian.x b/noao/twodspec/longslit/lscombine/src/generic/icmedian.x
new file mode 100644
index 00000000..1a2ed72d
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icmedian.x
@@ -0,0 +1,692 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+
+# IC_MEDIAN -- Median of lines
+
+procedure ic_medians (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+real	median[npts]		# Median
+
+int	i, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+real	val1, val2, val3
+short	temp, wtemp
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Mems[d[j1]+k]
+			val2 = Mems[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Mems[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Mems[d[j1]+k]
+			    val2 = Mems[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Mems[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Mems[d[j]+k];  lo1 = lo;  up1 = up
+
+		    repeat {
+			while (Mems[d[lo1]+k] < temp)
+			    lo1 = lo1 + 1
+			while (temp < Mems[d[up1]+k])
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Mems[d[lo1]+k]
+			    Mems[d[lo1]+k] = Mems[d[up1]+k]
+			    Mems[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Mems[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Mems[d[j]+k];  lo1 = lo;  up1 = up
+
+			repeat {
+			    while (Mems[d[lo1]+k] < temp)
+				lo1 = lo1 + 1
+			    while (temp < Mems[d[up1]+k])
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Mems[d[lo1]+k]
+				Mems[d[lo1]+k] = Mems[d[up1]+k]
+				Mems[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Mems[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else if (n1 == 3) {
+	        val1 = Mems[d[1]+k]
+	        val2 = Mems[d[2]+k]
+	        val3 = Mems[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Mems[d[1]+k]
+		val2 = Mems[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Mems[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+
+# IC_MEDIAN -- Median of lines
+
+procedure ic_mediani (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+real	median[npts]		# Median
+
+int	i, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+real	val1, val2, val3
+int	temp, wtemp
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Memi[d[j1]+k]
+			val2 = Memi[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Memi[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Memi[d[j1]+k]
+			    val2 = Memi[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Memi[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Memi[d[j]+k];  lo1 = lo;  up1 = up
+
+		    repeat {
+			while (Memi[d[lo1]+k] < temp)
+			    lo1 = lo1 + 1
+			while (temp < Memi[d[up1]+k])
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Memi[d[lo1]+k]
+			    Memi[d[lo1]+k] = Memi[d[up1]+k]
+			    Memi[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Memi[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Memi[d[j]+k];  lo1 = lo;  up1 = up
+
+			repeat {
+			    while (Memi[d[lo1]+k] < temp)
+				lo1 = lo1 + 1
+			    while (temp < Memi[d[up1]+k])
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Memi[d[lo1]+k]
+				Memi[d[lo1]+k] = Memi[d[up1]+k]
+				Memi[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Memi[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else if (n1 == 3) {
+	        val1 = Memi[d[1]+k]
+	        val2 = Memi[d[2]+k]
+	        val3 = Memi[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Memi[d[1]+k]
+		val2 = Memi[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Memi[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+
+# IC_MEDIAN -- Median of lines
+
+procedure ic_medianr (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+real	median[npts]		# Median
+
+int	i, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+real	val1, val2, val3
+real	temp, wtemp
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Memr[d[j1]+k]
+			val2 = Memr[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Memr[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Memr[d[j1]+k]
+			    val2 = Memr[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Memr[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Memr[d[j]+k];  lo1 = lo;  up1 = up
+
+		    repeat {
+			while (Memr[d[lo1]+k] < temp)
+			    lo1 = lo1 + 1
+			while (temp < Memr[d[up1]+k])
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Memr[d[lo1]+k]
+			    Memr[d[lo1]+k] = Memr[d[up1]+k]
+			    Memr[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Memr[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Memr[d[j]+k];  lo1 = lo;  up1 = up
+
+			repeat {
+			    while (Memr[d[lo1]+k] < temp)
+				lo1 = lo1 + 1
+			    while (temp < Memr[d[up1]+k])
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Memr[d[lo1]+k]
+				Memr[d[lo1]+k] = Memr[d[up1]+k]
+				Memr[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Memr[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else if (n1 == 3) {
+	        val1 = Memr[d[1]+k]
+	        val2 = Memr[d[2]+k]
+	        val3 = Memr[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Memr[d[1]+k]
+		val2 = Memr[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Memr[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+
+# IC_MEDIAN -- Median of lines
+
+procedure ic_mediand (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+double	median[npts]		# Median
+
+int	i, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+double	val1, val2, val3
+double	temp, wtemp
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Memd[d[j1]+k]
+			val2 = Memd[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Memd[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Memd[d[j1]+k]
+			    val2 = Memd[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Memd[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Memd[d[j]+k];  lo1 = lo;  up1 = up
+
+		    repeat {
+			while (Memd[d[lo1]+k] < temp)
+			    lo1 = lo1 + 1
+			while (temp < Memd[d[up1]+k])
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Memd[d[lo1]+k]
+			    Memd[d[lo1]+k] = Memd[d[up1]+k]
+			    Memd[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Memd[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Memd[d[j]+k];  lo1 = lo;  up1 = up
+
+			repeat {
+			    while (Memd[d[lo1]+k] < temp)
+				lo1 = lo1 + 1
+			    while (temp < Memd[d[up1]+k])
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Memd[d[lo1]+k]
+				Memd[d[lo1]+k] = Memd[d[up1]+k]
+				Memd[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Memd[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else if (n1 == 3) {
+	        val1 = Memd[d[1]+k]
+	        val2 = Memd[d[2]+k]
+	        val3 = Memd[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Memd[d[1]+k]
+		val2 = Memd[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Memd[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icmm.x b/noao/twodspec/longslit/lscombine/src/generic/icmm.x
new file mode 100644
index 00000000..5b2b13bf
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icmm.x
@@ -0,0 +1,644 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+
+# IC_MM --  Reject a specified number of high and low pixels
+
+procedure ic_mms (d, m, n, npts)
+
+pointer	d[ARB]		# Data pointers
+pointer	m[ARB]		# Image ID pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+
+int	n1, ncombine, npairs, nlow, nhigh, np
+int	i, i1, j, jmax, jmin
+pointer	k, kmax, kmin
+short	d1, d2, dmin, dmax
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE)
+	    return
+
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    nlow = flow * n1 + 0.001
+	    nhigh = fhigh * n1 + 0.001
+	    ncombine = n1 - nlow -  nhigh
+	    npairs = min (nlow, nhigh)
+	    nlow = nlow - npairs
+	    nhigh = nhigh - npairs
+	}
+
+	do i = 1, npts {
+	    i1 = i - 1
+	    n1 = n[i]
+	    if (dflag == D_MIX) {
+		nlow = flow * n1 + 0.001
+		nhigh = fhigh * n1 + 0.001
+		ncombine = max (ncombine, n1 - nlow - nhigh)
+		npairs = min (nlow, nhigh)
+		nlow = nlow - npairs
+		nhigh = nhigh - npairs
+	    }
+
+	    # Reject the npairs low and high points.
+	    do np = 1, npairs {
+		k = d[1] + i1
+		d1 = Mems[k]
+		dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k
+		do j = 2, n1 {
+		    d2 = d1
+		    k = d[j] + i1
+		    d1 = Mems[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    } else if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		j = n1 - 1
+		if (keepids) {
+		    if (jmax < j) {
+			if (jmin != j) {
+			    Mems[kmax] = d2
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			} else {
+			    Mems[kmax] = d1
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			}
+		    }
+		    if (jmin < j) {
+			if (jmax != n1) {
+			    Mems[kmin] = d1
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			} else {
+			    Mems[kmin] = d2
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			}
+		    }
+		} else {
+		    if (jmax < j) {
+			if (jmin != j)
+			    Mems[kmax] = d2
+			else
+			    Mems[kmax] = d1
+		    }
+		    if (jmin < j) {
+			if (jmax != n1)
+			    Mems[kmin] = d1
+			else
+			    Mems[kmin] = d2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    # Reject the excess low points.
+	    do np = 1, nlow {
+		k = d[1] + i1
+		d1 = Mems[k]
+		dmin = d1; jmin = 1; kmin = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Mems[k]
+		    if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		if (keepids) {
+		    if (jmin < n1) {
+			Mems[kmin] = d1
+			k = Memi[m[jmin]+i1]
+			Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmin < n1)
+			Mems[kmin] = d1
+		}
+		n1 = n1 - 1 
+	    }
+
+	    # Reject the excess high points.
+	    do np = 1, nhigh {
+		k = d[1] + i1
+		d1 = Mems[k]
+		dmax = d1; jmax = 1; kmax = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Mems[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    }
+		}
+		if (keepids) {
+		    if (jmax < n1) {
+			Mems[kmax] = d1
+			k = Memi[m[jmax]+i1]
+			Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmax < n1)
+			Mems[kmax] = d1
+		}
+		n1 = n1 - 1 
+	    }
+	    n[i] = n1
+	}
+
+	if (dflag == D_ALL && npairs + nlow + nhigh > 0)
+		dflag = D_MIX
+end
+
+# IC_MM --  Reject a specified number of high and low pixels
+
+procedure ic_mmi (d, m, n, npts)
+
+pointer	d[ARB]		# Data pointers
+pointer	m[ARB]		# Image ID pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+
+int	n1, ncombine, npairs, nlow, nhigh, np
+int	i, i1, j, jmax, jmin
+pointer	k, kmax, kmin
+int	d1, d2, dmin, dmax
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE)
+	    return
+
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    nlow = flow * n1 + 0.001
+	    nhigh = fhigh * n1 + 0.001
+	    ncombine = n1 - nlow -  nhigh
+	    npairs = min (nlow, nhigh)
+	    nlow = nlow - npairs
+	    nhigh = nhigh - npairs
+	}
+
+	do i = 1, npts {
+	    i1 = i - 1
+	    n1 = n[i]
+	    if (dflag == D_MIX) {
+		nlow = flow * n1 + 0.001
+		nhigh = fhigh * n1 + 0.001
+		ncombine = max (ncombine, n1 - nlow - nhigh)
+		npairs = min (nlow, nhigh)
+		nlow = nlow - npairs
+		nhigh = nhigh - npairs
+	    }
+
+	    # Reject the npairs low and high points.
+	    do np = 1, npairs {
+		k = d[1] + i1
+		d1 = Memi[k]
+		dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k
+		do j = 2, n1 {
+		    d2 = d1
+		    k = d[j] + i1
+		    d1 = Memi[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    } else if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		j = n1 - 1
+		if (keepids) {
+		    if (jmax < j) {
+			if (jmin != j) {
+			    Memi[kmax] = d2
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			} else {
+			    Memi[kmax] = d1
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			}
+		    }
+		    if (jmin < j) {
+			if (jmax != n1) {
+			    Memi[kmin] = d1
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			} else {
+			    Memi[kmin] = d2
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			}
+		    }
+		} else {
+		    if (jmax < j) {
+			if (jmin != j)
+			    Memi[kmax] = d2
+			else
+			    Memi[kmax] = d1
+		    }
+		    if (jmin < j) {
+			if (jmax != n1)
+			    Memi[kmin] = d1
+			else
+			    Memi[kmin] = d2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    # Reject the excess low points.
+	    do np = 1, nlow {
+		k = d[1] + i1
+		d1 = Memi[k]
+		dmin = d1; jmin = 1; kmin = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Memi[k]
+		    if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		if (keepids) {
+		    if (jmin < n1) {
+			Memi[kmin] = d1
+			k = Memi[m[jmin]+i1]
+			Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmin < n1)
+			Memi[kmin] = d1
+		}
+		n1 = n1 - 1 
+	    }
+
+	    # Reject the excess high points.
+	    do np = 1, nhigh {
+		k = d[1] + i1
+		d1 = Memi[k]
+		dmax = d1; jmax = 1; kmax = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Memi[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    }
+		}
+		if (keepids) {
+		    if (jmax < n1) {
+			Memi[kmax] = d1
+			k = Memi[m[jmax]+i1]
+			Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmax < n1)
+			Memi[kmax] = d1
+		}
+		n1 = n1 - 1 
+	    }
+	    n[i] = n1
+	}
+
+	if (dflag == D_ALL && npairs + nlow + nhigh > 0)
+		dflag = D_MIX
+end
+
+# IC_MM --  Reject a specified number of high and low pixels
+
+procedure ic_mmr (d, m, n, npts)
+
+pointer	d[ARB]		# Data pointers
+pointer	m[ARB]		# Image ID pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+
+int	n1, ncombine, npairs, nlow, nhigh, np
+int	i, i1, j, jmax, jmin
+pointer	k, kmax, kmin
+real	d1, d2, dmin, dmax
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE)
+	    return
+
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    nlow = flow * n1 + 0.001
+	    nhigh = fhigh * n1 + 0.001
+	    ncombine = n1 - nlow -  nhigh
+	    npairs = min (nlow, nhigh)
+	    nlow = nlow - npairs
+	    nhigh = nhigh - npairs
+	}
+
+	do i = 1, npts {
+	    i1 = i - 1
+	    n1 = n[i]
+	    if (dflag == D_MIX) {
+		nlow = flow * n1 + 0.001
+		nhigh = fhigh * n1 + 0.001
+		ncombine = max (ncombine, n1 - nlow - nhigh)
+		npairs = min (nlow, nhigh)
+		nlow = nlow - npairs
+		nhigh = nhigh - npairs
+	    }
+
+	    # Reject the npairs low and high points.
+	    do np = 1, npairs {
+		k = d[1] + i1
+		d1 = Memr[k]
+		dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k
+		do j = 2, n1 {
+		    d2 = d1
+		    k = d[j] + i1
+		    d1 = Memr[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    } else if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		j = n1 - 1
+		if (keepids) {
+		    if (jmax < j) {
+			if (jmin != j) {
+			    Memr[kmax] = d2
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			} else {
+			    Memr[kmax] = d1
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			}
+		    }
+		    if (jmin < j) {
+			if (jmax != n1) {
+			    Memr[kmin] = d1
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			} else {
+			    Memr[kmin] = d2
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			}
+		    }
+		} else {
+		    if (jmax < j) {
+			if (jmin != j)
+			    Memr[kmax] = d2
+			else
+			    Memr[kmax] = d1
+		    }
+		    if (jmin < j) {
+			if (jmax != n1)
+			    Memr[kmin] = d1
+			else
+			    Memr[kmin] = d2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    # Reject the excess low points.
+	    do np = 1, nlow {
+		k = d[1] + i1
+		d1 = Memr[k]
+		dmin = d1; jmin = 1; kmin = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Memr[k]
+		    if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		if (keepids) {
+		    if (jmin < n1) {
+			Memr[kmin] = d1
+			k = Memi[m[jmin]+i1]
+			Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmin < n1)
+			Memr[kmin] = d1
+		}
+		n1 = n1 - 1 
+	    }
+
+	    # Reject the excess high points.
+	    do np = 1, nhigh {
+		k = d[1] + i1
+		d1 = Memr[k]
+		dmax = d1; jmax = 1; kmax = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Memr[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    }
+		}
+		if (keepids) {
+		    if (jmax < n1) {
+			Memr[kmax] = d1
+			k = Memi[m[jmax]+i1]
+			Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmax < n1)
+			Memr[kmax] = d1
+		}
+		n1 = n1 - 1 
+	    }
+	    n[i] = n1
+	}
+
+	if (dflag == D_ALL && npairs + nlow + nhigh > 0)
+		dflag = D_MIX
+end
+
+# IC_MM --  Reject a specified number of high and low pixels
+
+procedure ic_mmd (d, m, n, npts)
+
+pointer	d[ARB]		# Data pointers
+pointer	m[ARB]		# Image ID pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+
+int	n1, ncombine, npairs, nlow, nhigh, np
+int	i, i1, j, jmax, jmin
+pointer	k, kmax, kmin
+double	d1, d2, dmin, dmax
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE)
+	    return
+
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    nlow = flow * n1 + 0.001
+	    nhigh = fhigh * n1 + 0.001
+	    ncombine = n1 - nlow -  nhigh
+	    npairs = min (nlow, nhigh)
+	    nlow = nlow - npairs
+	    nhigh = nhigh - npairs
+	}
+
+	do i = 1, npts {
+	    i1 = i - 1
+	    n1 = n[i]
+	    if (dflag == D_MIX) {
+		nlow = flow * n1 + 0.001
+		nhigh = fhigh * n1 + 0.001
+		ncombine = max (ncombine, n1 - nlow - nhigh)
+		npairs = min (nlow, nhigh)
+		nlow = nlow - npairs
+		nhigh = nhigh - npairs
+	    }
+
+	    # Reject the npairs low and high points.
+	    do np = 1, npairs {
+		k = d[1] + i1
+		d1 = Memd[k]
+		dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k
+		do j = 2, n1 {
+		    d2 = d1
+		    k = d[j] + i1
+		    d1 = Memd[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    } else if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		j = n1 - 1
+		if (keepids) {
+		    if (jmax < j) {
+			if (jmin != j) {
+			    Memd[kmax] = d2
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			} else {
+			    Memd[kmax] = d1
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			}
+		    }
+		    if (jmin < j) {
+			if (jmax != n1) {
+			    Memd[kmin] = d1
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			} else {
+			    Memd[kmin] = d2
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			}
+		    }
+		} else {
+		    if (jmax < j) {
+			if (jmin != j)
+			    Memd[kmax] = d2
+			else
+			    Memd[kmax] = d1
+		    }
+		    if (jmin < j) {
+			if (jmax != n1)
+			    Memd[kmin] = d1
+			else
+			    Memd[kmin] = d2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    # Reject the excess low points.
+	    do np = 1, nlow {
+		k = d[1] + i1
+		d1 = Memd[k]
+		dmin = d1; jmin = 1; kmin = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Memd[k]
+		    if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		if (keepids) {
+		    if (jmin < n1) {
+			Memd[kmin] = d1
+			k = Memi[m[jmin]+i1]
+			Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmin < n1)
+			Memd[kmin] = d1
+		}
+		n1 = n1 - 1 
+	    }
+
+	    # Reject the excess high points.
+	    do np = 1, nhigh {
+		k = d[1] + i1
+		d1 = Memd[k]
+		dmax = d1; jmax = 1; kmax = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    d1 = Memd[k]
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    }
+		}
+		if (keepids) {
+		    if (jmax < n1) {
+			Memd[kmax] = d1
+			k = Memi[m[jmax]+i1]
+			Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmax < n1)
+			Memd[kmax] = d1
+		}
+		n1 = n1 - 1 
+	    }
+	    n[i] = n1
+	}
+
+	if (dflag == D_ALL && npairs + nlow + nhigh > 0)
+		dflag = D_MIX
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icomb.x b/noao/twodspec/longslit/lscombine/src/generic/icomb.x
new file mode 100644
index 00000000..96138646
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icomb.x
@@ -0,0 +1,1917 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	<error.h>
+include	<syserr.h>
+include	<mach.h>
+include	"../icombine.h"
+
+# The following is for compiling under V2.11.
+define	IM_BUFFRAC	IM_BUFSIZE
+include	<imset.h>
+
+
+# ICOMBINE -- Combine images
+#
+# The memory and open file descriptor limits are checked and an attempt
+# to recover is made either by setting the image pixel files to be
+# closed after I/O or by notifying the calling program that memory
+# ran out and the IMIO buffer size should be reduced.  After the checks
+# a procedure for the selected combine option is called.
+# Because there may be several failure modes when reaching the file
+# limits we first assume an error is due to the file limit, except for
+# out of memory, and close some pixel files.  If the error then repeats
+# on accessing the pixels the error is passed back.
+
+
+procedure icombines (in, out, scales, zeros, wts, offsets, nimages, bufsize)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	wts[nimages]		# Weights
+int	offsets[nimages,ARB]	# Input image offsets
+int	nimages			# Number of input images
+int	bufsize			# IMIO buffer size
+
+char	str[1]
+int	i, j, k, npts, fd, stropen(), xt_imgnls()
+pointer	sp, d, id, n, m, lflag, v, dbuf
+pointer	im, buf, xt_opix(), impl1i()
+errchk	stropen, xt_cpix, xt_opix, xt_imgnls, impl1i, ic_combines
+pointer	impl1r()
+errchk	impl1r
+
+include	"../icombine.com"
+
+begin
+	npts = IM_LEN(out[1],1)
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (dbuf, nimages, TY_POINTER)
+	call salloc (d, nimages, TY_POINTER)
+	call salloc (id, nimages, TY_POINTER)
+	call salloc (n, npts, TY_INT)
+	call salloc (m, nimages, TY_POINTER)
+	call salloc (lflag, nimages, TY_INT)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call amovki (D_ALL, Memi[lflag], nimages)
+	call amovkl (1, Meml[v], IM_MAXDIM)
+
+	# If not aligned or growing create data buffers of output length
+	# otherwise use the IMIO buffers.
+
+	if (!aligned || grow >= 1.) {
+	    do i = 1, nimages
+		call salloc (Memi[dbuf+i-1], npts, TY_SHORT)
+	} else {
+	    do i = 1, nimages {
+		im = xt_opix (in[i], i, 1)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_SHORT)
+	    }
+	    call amovki (NULL, Memi[dbuf], nimages)
+	}
+
+	if (project) {
+	    call imseti (in[1], IM_NBUFS, nimages)
+	    call imseti (in[1], IM_BUFFRAC, 0)
+	    call imseti (in[1], IM_BUFSIZE, bufsize)
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	} else {
+	    # Reserve FD for string operations.
+	    fd = stropen (str, 1, NEW_FILE)
+
+	    # Do I/O to the images.
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	    buf = impl1r (out[1])
+	    call aclrr (Memr[buf], npts)
+	    if (out[3] != NULL) {
+		buf = impl1r (out[3])
+		call aclrr (Memr[buf], npts)
+	    }
+	    if (out[2] != NULL) {
+		buf = impl1i (out[2])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[4] != NULL) {
+		buf = impl1i (out[4])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[5] != NULL) {
+		buf = impl1i (out[5])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[6] != NULL) {
+		buf = impl1i (out[6])
+		call aclri (Memi[buf], npts)
+	    }
+
+	    # Do I/O for first input image line.
+	    if (!project) {
+		do i = 1, nimages {
+		    call xt_imseti (i, "bufsize", bufsize)
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			call xt_cpix (i)
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+
+		do i = 1, nimages {
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			next
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			next
+		    iferr {
+			Meml[v+1] = j
+			j = xt_imgnls (in[i], i, buf, Meml[v], 1)
+		    } then {
+			call imseti (im, IM_PIXFD, NULL)
+			call sfree (sp)
+			call strclose (fd)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	    call strclose (fd)
+	}
+
+	call ic_combines (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n],
+	    Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combines (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, nimages, npts)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output image
+pointer	dbuf[nimages]		# Data buffers for nonaligned images
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# Image index ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Line flags
+int	offsets[nimages,ARB]	# Input image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+real	wts[nimages]		# Combining weights
+int	nimages			# Number of input images
+int	npts			# Number of points per output line
+
+int	i, ext, ctor(), errcode()
+real	r, imgetr()
+pointer	sp, fname, imname, v1, v2, v3, work
+pointer	outdata, buf, nm, pms
+pointer	immap(), impnli()
+pointer	impnlr(), imgnlr()
+errchk	immap, ic_scale, imgetr, ic_grow, ic_grows, ic_rmasks, ic_gdatas
+
+include	"../icombine.com"
+data	ext/0/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (v3, IM_MAXDIM, TY_LONG)
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	call amovkl (long(1), Meml[v3], IM_MAXDIM)
+
+	call ic_scale (in, out, offsets, scales, zeros, wts, nimages)
+
+	# Set combine parameters
+	switch (combine) {
+	case AVERAGE:
+	    if (dowts)
+		keepids = true
+	    else
+		keepids = false
+	case MEDIAN:
+	    dowts = false
+	    keepids = false
+	}
+	docombine = true
+
+	# Set rejection algorithm specific parameters
+	switch (reject) {
+	case CCDCLIP, CRREJECT:
+	    call salloc (nm, 3*nimages, TY_REAL)
+	    i = 1
+	    if (ctor (Memc[rdnoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = r
+	    } else {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise])
+	    }
+	    i = 1
+	    if (ctor (Memc[gain], i, r) > 0) {
+		do i = 1, nimages {
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[gain])
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    }
+	    i = 1
+	    if (ctor (Memc[snoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)+2] = r
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[snoise])
+		    Memr[nm+3*(i-1)+2] = r
+		}
+	    }
+	    if (!keepids) {
+		if (doscale1)
+		    keepids = true
+		else {
+		    do i = 2, nimages {
+			if (Memr[nm+3*(i-1)] != Memr[nm] ||
+			    Memr[nm+3*(i-1)+1] != Memr[nm+1] ||
+			    Memr[nm+3*(i-1)+2] != Memr[nm+2]) {
+			    keepids = true
+			    break
+			}
+		    }
+		}
+	    }
+	    if (reject == CRREJECT)
+		lsigma = MAX_REAL
+	case MINMAX:
+	    mclip = false
+	case PCLIP:
+	    mclip = true
+	case AVSIGCLIP, SIGCLIP:
+	    if (doscale1)
+		keepids = true
+	case NONE:
+	    mclip = false
+	}
+
+	if (out[4] != NULL)
+	    keepids = true
+
+	if (out[6] != NULL) {
+	    keepids = true
+	    call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1)
+	}
+
+	if (grow >= 1.) {
+	    keepids = true
+	    call salloc (work, npts * nimages, TY_INT)
+	}
+	pms = NULL
+
+	if (keepids) {
+	    do i = 1, nimages
+		call salloc (id[i], npts, TY_INT)
+	}
+
+	while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+	    call ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets,
+		scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+	    switch (reject) {
+	    case CCDCLIP, CRREJECT:
+		if (mclip)
+		    call ic_mccdclips (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+		else
+		    call ic_accdclips (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+	    case MINMAX:
+		call ic_mms (d, id, n, npts)
+	    case PCLIP:
+		call ic_pclips (d, id, n, nimages, npts, Memr[outdata])
+	    case SIGCLIP:
+		if (mclip)
+		    call ic_msigclips (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+		else
+		    call ic_asigclips (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+	    case AVSIGCLIP:
+		if (mclip)
+		    call ic_mavsigclips (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+		else
+		    call ic_aavsigclips (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+	    }
+
+	    if (pms == NULL || nkeep > 0) {
+		if (docombine) {
+		    switch (combine) {
+		    case AVERAGE:
+			call ic_averages (d, id, n, wts, npts, YES, YES,
+			    Memr[outdata])
+		    case MEDIAN:
+			call ic_medians (d, n, npts, YES, Memr[outdata])
+		    case SUM:
+			call ic_averages (d, id, n, wts, npts, YES, NO,
+			    Memr[outdata])
+		    }
+		}
+	    }
+
+	    if (grow >= 1.)
+		call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts,
+		    pms)
+
+	    if (pms == NULL) {
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigmas (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+	    }
+
+	    call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	}
+
+	if (pms != NULL) {
+	    if (nkeep > 0) {
+		call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME)
+		call imunmap (out[1])
+		iferr (buf = immap (Memc[fname], READ_WRITE, 0)) {
+		    switch (errcode()) {
+		    case SYS_FXFOPNOEXTNV:
+			call imgcluster (Memc[fname], Memc[fname], SZ_FNAME)
+			ext = ext + 1
+			call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+			    call pargstr (Memc[fname])
+			    call pargi (ext)
+			iferr (buf = immap (Memc[imname], READ_WRITE, 0)) {
+			    buf = NULL
+			    ext = 0
+			}
+			repeat {
+			    call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+				call pargstr (Memc[fname])
+				call pargi (ext+1)
+			    iferr (outdata = immap (Memc[imname],READ_WRITE,0)) 
+				break
+			    if (buf != NULL)
+				call imunmap (buf)
+			    buf = outdata
+			    ext = ext + 1
+			}
+		    default:
+			call erract (EA_ERROR)
+		    }
+		}
+		out[1] = buf
+	    }
+
+	    call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v3], IM_MAXDIM)
+	    while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+		call ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets,
+		    scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+		call ic_grows (Meml[v2], d, id, n, Memi[work], nimages, npts,
+		    pms)
+
+		if (nkeep > 0) {
+		    do i = 1, npts {
+			if (n[i] < nkeep) {
+			    Meml[v1+1] = Meml[v1+1] - 1
+			    if (imgnlr (out[1], buf, Meml[v1]) == EOF)
+				;
+			    call amovr (Memr[buf], Memr[outdata], npts)
+			    break
+			}
+		    }
+		}
+
+		switch (combine) {
+		case AVERAGE:
+		    call ic_averages (d, id, n, wts, npts, NO, YES,
+			Memr[outdata])
+		case MEDIAN:
+		    call ic_medians (d, n, npts, NO, Memr[outdata])
+		case SUM:
+		    call ic_averages (d, id, n, wts, npts, NO, NO,
+			Memr[outdata])
+		}
+
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+			
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigmas (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+
+		call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	    }
+
+	    do i = 1, nimages
+		call pm_close (Memi[pms+i-1])
+	    call mfree (pms, TY_POINTER)
+	}
+
+	call sfree (sp)
+end
+
+procedure icombinei (in, out, scales, zeros, wts, offsets, nimages, bufsize)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	wts[nimages]		# Weights
+int	offsets[nimages,ARB]	# Input image offsets
+int	nimages			# Number of input images
+int	bufsize			# IMIO buffer size
+
+char	str[1]
+int	i, j, k, npts, fd, stropen(), xt_imgnli()
+pointer	sp, d, id, n, m, lflag, v, dbuf
+pointer	im, buf, xt_opix(), impl1i()
+errchk	stropen, xt_cpix, xt_opix, xt_imgnli, impl1i, ic_combinei
+pointer	impl1r()
+errchk	impl1r
+
+include	"../icombine.com"
+
+begin
+	npts = IM_LEN(out[1],1)
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (dbuf, nimages, TY_POINTER)
+	call salloc (d, nimages, TY_POINTER)
+	call salloc (id, nimages, TY_POINTER)
+	call salloc (n, npts, TY_INT)
+	call salloc (m, nimages, TY_POINTER)
+	call salloc (lflag, nimages, TY_INT)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call amovki (D_ALL, Memi[lflag], nimages)
+	call amovkl (1, Meml[v], IM_MAXDIM)
+
+	# If not aligned or growing create data buffers of output length
+	# otherwise use the IMIO buffers.
+
+	if (!aligned || grow >= 1.) {
+	    do i = 1, nimages
+		call salloc (Memi[dbuf+i-1], npts, TY_INT)
+	} else {
+	    do i = 1, nimages {
+		im = xt_opix (in[i], i, 1)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_INT)
+	    }
+	    call amovki (NULL, Memi[dbuf], nimages)
+	}
+
+	if (project) {
+	    call imseti (in[1], IM_NBUFS, nimages)
+	    call imseti (in[1], IM_BUFFRAC, 0)
+	    call imseti (in[1], IM_BUFSIZE, bufsize)
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	} else {
+	    # Reserve FD for string operations.
+	    fd = stropen (str, 1, NEW_FILE)
+
+	    # Do I/O to the images.
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	    buf = impl1r (out[1])
+	    call aclrr (Memr[buf], npts)
+	    if (out[3] != NULL) {
+		buf = impl1r (out[3])
+		call aclrr (Memr[buf], npts)
+	    }
+	    if (out[2] != NULL) {
+		buf = impl1i (out[2])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[4] != NULL) {
+		buf = impl1i (out[4])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[5] != NULL) {
+		buf = impl1i (out[5])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[6] != NULL) {
+		buf = impl1i (out[6])
+		call aclri (Memi[buf], npts)
+	    }
+
+	    # Do I/O for first input image line.
+	    if (!project) {
+		do i = 1, nimages {
+		    call xt_imseti (i, "bufsize", bufsize)
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			call xt_cpix (i)
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+
+		do i = 1, nimages {
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			next
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			next
+		    iferr {
+			Meml[v+1] = j
+			j = xt_imgnli (in[i], i, buf, Meml[v], 1)
+		    } then {
+			call imseti (im, IM_PIXFD, NULL)
+			call sfree (sp)
+			call strclose (fd)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	    call strclose (fd)
+	}
+
+	call ic_combinei (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n],
+	    Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combinei (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, nimages, npts)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output image
+pointer	dbuf[nimages]		# Data buffers for nonaligned images
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# Image index ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Line flags
+int	offsets[nimages,ARB]	# Input image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+real	wts[nimages]		# Combining weights
+int	nimages			# Number of input images
+int	npts			# Number of points per output line
+
+int	i, ext, ctor(), errcode()
+real	r, imgetr()
+pointer	sp, fname, imname, v1, v2, v3, work
+pointer	outdata, buf, nm, pms
+pointer	immap(), impnli()
+pointer	impnlr(), imgnlr()
+errchk	immap, ic_scale, imgetr, ic_grow, ic_growi, ic_rmasks, ic_gdatai
+
+include	"../icombine.com"
+data	ext/0/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (v3, IM_MAXDIM, TY_LONG)
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	call amovkl (long(1), Meml[v3], IM_MAXDIM)
+
+	call ic_scale (in, out, offsets, scales, zeros, wts, nimages)
+
+	# Set combine parameters
+	switch (combine) {
+	case AVERAGE:
+	    if (dowts)
+		keepids = true
+	    else
+		keepids = false
+	case MEDIAN:
+	    dowts = false
+	    keepids = false
+	}
+	docombine = true
+
+	# Set rejection algorithm specific parameters
+	switch (reject) {
+	case CCDCLIP, CRREJECT:
+	    call salloc (nm, 3*nimages, TY_REAL)
+	    i = 1
+	    if (ctor (Memc[rdnoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = r
+	    } else {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise])
+	    }
+	    i = 1
+	    if (ctor (Memc[gain], i, r) > 0) {
+		do i = 1, nimages {
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[gain])
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    }
+	    i = 1
+	    if (ctor (Memc[snoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)+2] = r
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[snoise])
+		    Memr[nm+3*(i-1)+2] = r
+		}
+	    }
+	    if (!keepids) {
+		if (doscale1)
+		    keepids = true
+		else {
+		    do i = 2, nimages {
+			if (Memr[nm+3*(i-1)] != Memr[nm] ||
+			    Memr[nm+3*(i-1)+1] != Memr[nm+1] ||
+			    Memr[nm+3*(i-1)+2] != Memr[nm+2]) {
+			    keepids = true
+			    break
+			}
+		    }
+		}
+	    }
+	    if (reject == CRREJECT)
+		lsigma = MAX_REAL
+	case MINMAX:
+	    mclip = false
+	case PCLIP:
+	    mclip = true
+	case AVSIGCLIP, SIGCLIP:
+	    if (doscale1)
+		keepids = true
+	case NONE:
+	    mclip = false
+	}
+
+	if (out[4] != NULL)
+	    keepids = true
+
+	if (out[6] != NULL) {
+	    keepids = true
+	    call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1)
+	}
+
+	if (grow >= 1.) {
+	    keepids = true
+	    call salloc (work, npts * nimages, TY_INT)
+	}
+	pms = NULL
+
+	if (keepids) {
+	    do i = 1, nimages
+		call salloc (id[i], npts, TY_INT)
+	}
+
+	while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+	    call ic_gdatai (in, out, dbuf, d, id, n, m, lflag, offsets,
+		scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+	    switch (reject) {
+	    case CCDCLIP, CRREJECT:
+		if (mclip)
+		    call ic_mccdclipi (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+		else
+		    call ic_accdclipi (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+	    case MINMAX:
+		call ic_mmi (d, id, n, npts)
+	    case PCLIP:
+		call ic_pclipi (d, id, n, nimages, npts, Memr[outdata])
+	    case SIGCLIP:
+		if (mclip)
+		    call ic_msigclipi (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+		else
+		    call ic_asigclipi (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+	    case AVSIGCLIP:
+		if (mclip)
+		    call ic_mavsigclipi (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+		else
+		    call ic_aavsigclipi (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+	    }
+
+	    if (pms == NULL || nkeep > 0) {
+		if (docombine) {
+		    switch (combine) {
+		    case AVERAGE:
+			call ic_averagei (d, id, n, wts, npts, YES, YES,
+			    Memr[outdata])
+		    case MEDIAN:
+			call ic_mediani (d, n, npts, YES, Memr[outdata])
+		    case SUM:
+			call ic_averagei (d, id, n, wts, npts, YES, NO,
+			    Memr[outdata])
+		    }
+		}
+	    }
+
+	    if (grow >= 1.)
+		call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts,
+		    pms)
+
+	    if (pms == NULL) {
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigmai (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+	    }
+
+	    call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	}
+
+	if (pms != NULL) {
+	    if (nkeep > 0) {
+		call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME)
+		call imunmap (out[1])
+		iferr (buf = immap (Memc[fname], READ_WRITE, 0)) {
+		    switch (errcode()) {
+		    case SYS_FXFOPNOEXTNV:
+			call imgcluster (Memc[fname], Memc[fname], SZ_FNAME)
+			ext = ext + 1
+			call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+			    call pargstr (Memc[fname])
+			    call pargi (ext)
+			iferr (buf = immap (Memc[imname], READ_WRITE, 0)) {
+			    buf = NULL
+			    ext = 0
+			}
+			repeat {
+			    call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+				call pargstr (Memc[fname])
+				call pargi (ext+1)
+			    iferr (outdata = immap (Memc[imname],READ_WRITE,0)) 
+				break
+			    if (buf != NULL)
+				call imunmap (buf)
+			    buf = outdata
+			    ext = ext + 1
+			}
+		    default:
+			call erract (EA_ERROR)
+		    }
+		}
+		out[1] = buf
+	    }
+
+	    call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v3], IM_MAXDIM)
+	    while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+		call ic_gdatai (in, out, dbuf, d, id, n, m, lflag, offsets,
+		    scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+		call ic_growi (Meml[v2], d, id, n, Memi[work], nimages, npts,
+		    pms)
+
+		if (nkeep > 0) {
+		    do i = 1, npts {
+			if (n[i] < nkeep) {
+			    Meml[v1+1] = Meml[v1+1] - 1
+			    if (imgnlr (out[1], buf, Meml[v1]) == EOF)
+				;
+			    call amovr (Memr[buf], Memr[outdata], npts)
+			    break
+			}
+		    }
+		}
+
+		switch (combine) {
+		case AVERAGE:
+		    call ic_averagei (d, id, n, wts, npts, NO, YES,
+			Memr[outdata])
+		case MEDIAN:
+		    call ic_mediani (d, n, npts, NO, Memr[outdata])
+		case SUM:
+		    call ic_averagei (d, id, n, wts, npts, NO, NO,
+			Memr[outdata])
+		}
+
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+			
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigmai (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+
+		call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	    }
+
+	    do i = 1, nimages
+		call pm_close (Memi[pms+i-1])
+	    call mfree (pms, TY_POINTER)
+	}
+
+	call sfree (sp)
+end
+
+procedure icombiner (in, out, scales, zeros, wts, offsets, nimages, bufsize)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	wts[nimages]		# Weights
+int	offsets[nimages,ARB]	# Input image offsets
+int	nimages			# Number of input images
+int	bufsize			# IMIO buffer size
+
+char	str[1]
+int	i, j, k, npts, fd, stropen(), xt_imgnlr()
+pointer	sp, d, id, n, m, lflag, v, dbuf
+pointer	im, buf, xt_opix(), impl1i()
+errchk	stropen, xt_cpix, xt_opix, xt_imgnlr, impl1i, ic_combiner
+pointer	impl1r()
+errchk	impl1r
+
+include	"../icombine.com"
+
+begin
+	npts = IM_LEN(out[1],1)
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (dbuf, nimages, TY_POINTER)
+	call salloc (d, nimages, TY_POINTER)
+	call salloc (id, nimages, TY_POINTER)
+	call salloc (n, npts, TY_INT)
+	call salloc (m, nimages, TY_POINTER)
+	call salloc (lflag, nimages, TY_INT)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call amovki (D_ALL, Memi[lflag], nimages)
+	call amovkl (1, Meml[v], IM_MAXDIM)
+
+	# If not aligned or growing create data buffers of output length
+	# otherwise use the IMIO buffers.
+
+	if (!aligned || grow >= 1.) {
+	    do i = 1, nimages
+		call salloc (Memi[dbuf+i-1], npts, TY_REAL)
+	} else {
+	    do i = 1, nimages {
+		im = xt_opix (in[i], i, 1)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_REAL)
+	    }
+	    call amovki (NULL, Memi[dbuf], nimages)
+	}
+
+	if (project) {
+	    call imseti (in[1], IM_NBUFS, nimages)
+	    call imseti (in[1], IM_BUFFRAC, 0)
+	    call imseti (in[1], IM_BUFSIZE, bufsize)
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	} else {
+	    # Reserve FD for string operations.
+	    fd = stropen (str, 1, NEW_FILE)
+
+	    # Do I/O to the images.
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	    buf = impl1r (out[1])
+	    call aclrr (Memr[buf], npts)
+	    if (out[3] != NULL) {
+		buf = impl1r (out[3])
+		call aclrr (Memr[buf], npts)
+	    }
+	    if (out[2] != NULL) {
+		buf = impl1i (out[2])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[4] != NULL) {
+		buf = impl1i (out[4])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[5] != NULL) {
+		buf = impl1i (out[5])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[6] != NULL) {
+		buf = impl1i (out[6])
+		call aclri (Memi[buf], npts)
+	    }
+
+	    # Do I/O for first input image line.
+	    if (!project) {
+		do i = 1, nimages {
+		    call xt_imseti (i, "bufsize", bufsize)
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			call xt_cpix (i)
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+
+		do i = 1, nimages {
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			next
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			next
+		    iferr {
+			Meml[v+1] = j
+			j = xt_imgnlr (in[i], i, buf, Meml[v], 1)
+		    } then {
+			call imseti (im, IM_PIXFD, NULL)
+			call sfree (sp)
+			call strclose (fd)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	    call strclose (fd)
+	}
+
+	call ic_combiner (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n],
+	    Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combiner (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, nimages, npts)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output image
+pointer	dbuf[nimages]		# Data buffers for nonaligned images
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# Image index ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Line flags
+int	offsets[nimages,ARB]	# Input image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+real	wts[nimages]		# Combining weights
+int	nimages			# Number of input images
+int	npts			# Number of points per output line
+
+int	i, ext, ctor(), errcode()
+real	r, imgetr()
+pointer	sp, fname, imname, v1, v2, v3, work
+pointer	outdata, buf, nm, pms
+pointer	immap(), impnli()
+pointer	impnlr(), imgnlr
+errchk	immap, ic_scale, imgetr, ic_grow, ic_growr, ic_rmasks, ic_gdatar
+
+include	"../icombine.com"
+data	ext/0/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (v3, IM_MAXDIM, TY_LONG)
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	call amovkl (long(1), Meml[v3], IM_MAXDIM)
+
+	call ic_scale (in, out, offsets, scales, zeros, wts, nimages)
+
+	# Set combine parameters
+	switch (combine) {
+	case AVERAGE:
+	    if (dowts)
+		keepids = true
+	    else
+		keepids = false
+	case MEDIAN:
+	    dowts = false
+	    keepids = false
+	}
+	docombine = true
+
+	# Set rejection algorithm specific parameters
+	switch (reject) {
+	case CCDCLIP, CRREJECT:
+	    call salloc (nm, 3*nimages, TY_REAL)
+	    i = 1
+	    if (ctor (Memc[rdnoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = r
+	    } else {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise])
+	    }
+	    i = 1
+	    if (ctor (Memc[gain], i, r) > 0) {
+		do i = 1, nimages {
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[gain])
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    }
+	    i = 1
+	    if (ctor (Memc[snoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)+2] = r
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[snoise])
+		    Memr[nm+3*(i-1)+2] = r
+		}
+	    }
+	    if (!keepids) {
+		if (doscale1)
+		    keepids = true
+		else {
+		    do i = 2, nimages {
+			if (Memr[nm+3*(i-1)] != Memr[nm] ||
+			    Memr[nm+3*(i-1)+1] != Memr[nm+1] ||
+			    Memr[nm+3*(i-1)+2] != Memr[nm+2]) {
+			    keepids = true
+			    break
+			}
+		    }
+		}
+	    }
+	    if (reject == CRREJECT)
+		lsigma = MAX_REAL
+	case MINMAX:
+	    mclip = false
+	case PCLIP:
+	    mclip = true
+	case AVSIGCLIP, SIGCLIP:
+	    if (doscale1)
+		keepids = true
+	case NONE:
+	    mclip = false
+	}
+
+	if (out[4] != NULL)
+	    keepids = true
+
+	if (out[6] != NULL) {
+	    keepids = true
+	    call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1)
+	}
+
+	if (grow >= 1.) {
+	    keepids = true
+	    call salloc (work, npts * nimages, TY_INT)
+	}
+	pms = NULL
+
+	if (keepids) {
+	    do i = 1, nimages
+		call salloc (id[i], npts, TY_INT)
+	}
+
+	while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+	    call ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets,
+		scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+	    switch (reject) {
+	    case CCDCLIP, CRREJECT:
+		if (mclip)
+		    call ic_mccdclipr (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+		else
+		    call ic_accdclipr (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+	    case MINMAX:
+		call ic_mmr (d, id, n, npts)
+	    case PCLIP:
+		call ic_pclipr (d, id, n, nimages, npts, Memr[outdata])
+	    case SIGCLIP:
+		if (mclip)
+		    call ic_msigclipr (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+		else
+		    call ic_asigclipr (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+	    case AVSIGCLIP:
+		if (mclip)
+		    call ic_mavsigclipr (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+		else
+		    call ic_aavsigclipr (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+	    }
+
+	    if (pms == NULL || nkeep > 0) {
+		if (docombine) {
+		    switch (combine) {
+		    case AVERAGE:
+			call ic_averager (d, id, n, wts, npts, YES, YES,
+			    Memr[outdata])
+		    case MEDIAN:
+			call ic_medianr (d, n, npts, YES, Memr[outdata])
+		    case SUM:
+			call ic_averager (d, id, n, wts, npts, YES, NO,
+			    Memr[outdata])
+		    }
+		}
+	    }
+
+	    if (grow >= 1.)
+		call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts,
+		    pms)
+
+	    if (pms == NULL) {
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+			buf = buf + 1
+		    }
+		}
+
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigmar (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+	    }
+
+	    call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	}
+
+	if (pms != NULL) {
+	    if (nkeep > 0) {
+		call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME)
+		call imunmap (out[1])
+		iferr (buf = immap (Memc[fname], READ_WRITE, 0)) {
+		    switch (errcode()) {
+		    case SYS_FXFOPNOEXTNV:
+			call imgcluster (Memc[fname], Memc[fname], SZ_FNAME)
+			ext = ext + 1
+			call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+			    call pargstr (Memc[fname])
+			    call pargi (ext)
+			iferr (buf = immap (Memc[imname], READ_WRITE, 0)) {
+			    buf = NULL
+			    ext = 0
+			}
+			repeat {
+			    call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+				call pargstr (Memc[fname])
+				call pargi (ext+1)
+			    iferr (outdata = immap (Memc[imname],READ_WRITE,0)) 
+				break
+			    if (buf != NULL)
+				call imunmap (buf)
+			    buf = outdata
+			    ext = ext + 1
+			}
+		    default:
+			call erract (EA_ERROR)
+		    }
+		}
+		out[1] = buf
+	    }
+
+	    call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v3], IM_MAXDIM)
+	    while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+		call ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets,
+		    scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+		call ic_growr (Meml[v2], d, id, n, Memi[work], nimages, npts,
+		    pms)
+
+		if (nkeep > 0) {
+		    do i = 1, npts {
+			if (n[i] < nkeep) {
+			    Meml[v1+1] = Meml[v1+1] - 1
+			    if (imgnlr (out[1], buf, Meml[v1]) == EOF)
+				;
+			    call amovr (Memr[buf], Memr[outdata], npts)
+			    break
+			}
+		    }
+		}
+
+		switch (combine) {
+		case AVERAGE:
+		    call ic_averager (d, id, n, wts, npts, NO, YES,
+			Memr[outdata])
+		case MEDIAN:
+		    call ic_medianr (d, n, npts, NO, Memr[outdata])
+		case SUM:
+		    call ic_averager (d, id, n, wts, npts, NO, NO,
+			Memr[outdata])
+		}
+
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+			
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigmar (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+
+		call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	    }
+
+	    do i = 1, nimages
+		call pm_close (Memi[pms+i-1])
+	    call mfree (pms, TY_POINTER)
+	}
+
+	call sfree (sp)
+end
+
+procedure icombined (in, out, scales, zeros, wts, offsets, nimages, bufsize)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	wts[nimages]		# Weights
+int	offsets[nimages,ARB]	# Input image offsets
+int	nimages			# Number of input images
+int	bufsize			# IMIO buffer size
+
+char	str[1]
+int	i, j, k, npts, fd, stropen(), xt_imgnld()
+pointer	sp, d, id, n, m, lflag, v, dbuf
+pointer	im, buf, xt_opix(), impl1i()
+errchk	stropen, xt_cpix, xt_opix, xt_imgnld, impl1i, ic_combined
+pointer	impl1d()
+errchk	impl1d
+
+include	"../icombine.com"
+
+begin
+	npts = IM_LEN(out[1],1)
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (dbuf, nimages, TY_POINTER)
+	call salloc (d, nimages, TY_POINTER)
+	call salloc (id, nimages, TY_POINTER)
+	call salloc (n, npts, TY_INT)
+	call salloc (m, nimages, TY_POINTER)
+	call salloc (lflag, nimages, TY_INT)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call amovki (D_ALL, Memi[lflag], nimages)
+	call amovkl (1, Meml[v], IM_MAXDIM)
+
+	# If not aligned or growing create data buffers of output length
+	# otherwise use the IMIO buffers.
+
+	if (!aligned || grow >= 1.) {
+	    do i = 1, nimages
+		call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE)
+	} else {
+	    do i = 1, nimages {
+		im = xt_opix (in[i], i, 1)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE)
+	    }
+	    call amovki (NULL, Memi[dbuf], nimages)
+	}
+
+	if (project) {
+	    call imseti (in[1], IM_NBUFS, nimages)
+	    call imseti (in[1], IM_BUFFRAC, 0)
+	    call imseti (in[1], IM_BUFSIZE, bufsize)
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	} else {
+	    # Reserve FD for string operations.
+	    fd = stropen (str, 1, NEW_FILE)
+
+	    # Do I/O to the images.
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	    buf = impl1d (out[1])
+	    call aclrd (Memd[buf], npts)
+	    if (out[3] != NULL) {
+		buf = impl1d (out[3])
+		call aclrd (Memd[buf], npts)
+	    }
+	    if (out[2] != NULL) {
+		buf = impl1i (out[2])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[4] != NULL) {
+		buf = impl1i (out[4])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[5] != NULL) {
+		buf = impl1i (out[5])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[6] != NULL) {
+		buf = impl1i (out[6])
+		call aclri (Memi[buf], npts)
+	    }
+
+	    # Do I/O for first input image line.
+	    if (!project) {
+		do i = 1, nimages {
+		    call xt_imseti (i, "bufsize", bufsize)
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			call xt_cpix (i)
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+
+		do i = 1, nimages {
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			next
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			next
+		    iferr {
+			Meml[v+1] = j
+			j = xt_imgnld (in[i], i, buf, Meml[v], 1)
+		    } then {
+			call imseti (im, IM_PIXFD, NULL)
+			call sfree (sp)
+			call strclose (fd)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	    call strclose (fd)
+	}
+
+	call ic_combined (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n],
+	    Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combined (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, nimages, npts)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output image
+pointer	dbuf[nimages]		# Data buffers for nonaligned images
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# Image index ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Line flags
+int	offsets[nimages,ARB]	# Input image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+real	wts[nimages]		# Combining weights
+int	nimages			# Number of input images
+int	npts			# Number of points per output line
+
+int	i, ext, ctor(), errcode()
+real	r, imgetr()
+pointer	sp, fname, imname, v1, v2, v3, work
+pointer	outdata, buf, nm, pms
+pointer	immap(), impnli()
+pointer	impnld(), imgnld
+errchk	immap, ic_scale, imgetr, ic_grow, ic_growd, ic_rmasks, ic_gdatad
+
+include	"../icombine.com"
+data	ext/0/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (v3, IM_MAXDIM, TY_LONG)
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	call amovkl (long(1), Meml[v3], IM_MAXDIM)
+
+	call ic_scale (in, out, offsets, scales, zeros, wts, nimages)
+
+	# Set combine parameters
+	switch (combine) {
+	case AVERAGE:
+	    if (dowts)
+		keepids = true
+	    else
+		keepids = false
+	case MEDIAN:
+	    dowts = false
+	    keepids = false
+	}
+	docombine = true
+
+	# Set rejection algorithm specific parameters
+	switch (reject) {
+	case CCDCLIP, CRREJECT:
+	    call salloc (nm, 3*nimages, TY_REAL)
+	    i = 1
+	    if (ctor (Memc[rdnoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = r
+	    } else {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise])
+	    }
+	    i = 1
+	    if (ctor (Memc[gain], i, r) > 0) {
+		do i = 1, nimages {
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[gain])
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    }
+	    i = 1
+	    if (ctor (Memc[snoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)+2] = r
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[snoise])
+		    Memr[nm+3*(i-1)+2] = r
+		}
+	    }
+	    if (!keepids) {
+		if (doscale1)
+		    keepids = true
+		else {
+		    do i = 2, nimages {
+			if (Memr[nm+3*(i-1)] != Memr[nm] ||
+			    Memr[nm+3*(i-1)+1] != Memr[nm+1] ||
+			    Memr[nm+3*(i-1)+2] != Memr[nm+2]) {
+			    keepids = true
+			    break
+			}
+		    }
+		}
+	    }
+	    if (reject == CRREJECT)
+		lsigma = MAX_REAL
+	case MINMAX:
+	    mclip = false
+	case PCLIP:
+	    mclip = true
+	case AVSIGCLIP, SIGCLIP:
+	    if (doscale1)
+		keepids = true
+	case NONE:
+	    mclip = false
+	}
+
+	if (out[4] != NULL)
+	    keepids = true
+
+	if (out[6] != NULL) {
+	    keepids = true
+	    call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1)
+	}
+
+	if (grow >= 1.) {
+	    keepids = true
+	    call salloc (work, npts * nimages, TY_INT)
+	}
+	pms = NULL
+
+	if (keepids) {
+	    do i = 1, nimages
+		call salloc (id[i], npts, TY_INT)
+	}
+
+	while (impnld (out[1], outdata, Meml[v1]) != EOF) {
+	    call ic_gdatad (in, out, dbuf, d, id, n, m, lflag, offsets,
+		scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+	    switch (reject) {
+	    case CCDCLIP, CRREJECT:
+		if (mclip)
+		    call ic_mccdclipd (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memd[outdata])
+		else
+		    call ic_accdclipd (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memd[outdata])
+	    case MINMAX:
+		call ic_mmd (d, id, n, npts)
+	    case PCLIP:
+		call ic_pclipd (d, id, n, nimages, npts, Memd[outdata])
+	    case SIGCLIP:
+		if (mclip)
+		    call ic_msigclipd (d, id, n, scales, zeros, nimages, npts,
+			Memd[outdata])
+		else
+		    call ic_asigclipd (d, id, n, scales, zeros, nimages, npts,
+			Memd[outdata])
+	    case AVSIGCLIP:
+		if (mclip)
+		    call ic_mavsigclipd (d, id, n, scales, zeros, nimages,
+			npts, Memd[outdata])
+		else
+		    call ic_aavsigclipd (d, id, n, scales, zeros, nimages,
+			npts, Memd[outdata])
+	    }
+
+	    if (pms == NULL || nkeep > 0) {
+		if (docombine) {
+		    switch (combine) {
+		    case AVERAGE:
+			call ic_averaged (d, id, n, wts, npts, YES, YES,
+			    Memd[outdata])
+		    case MEDIAN:
+			call ic_mediand (d, n, npts, YES, Memd[outdata])
+		    case SUM:
+			call ic_averaged (d, id, n, wts, npts, YES, NO,
+			    Memd[outdata])
+		    }
+		}
+	    }
+
+	    if (grow >= 1.)
+		call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts,
+		    pms)
+
+	    if (pms == NULL) {
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+			buf = buf + 1
+		    }
+		}
+
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnld (out[3], buf, Meml[v1])
+		    call ic_sigmad (d, id, n, wts, npts, Memd[outdata],
+			Memd[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+	    }
+
+	    call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	}
+
+	if (pms != NULL) {
+	    if (nkeep > 0) {
+		call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME)
+		call imunmap (out[1])
+		iferr (buf = immap (Memc[fname], READ_WRITE, 0)) {
+		    switch (errcode()) {
+		    case SYS_FXFOPNOEXTNV:
+			call imgcluster (Memc[fname], Memc[fname], SZ_FNAME)
+			ext = ext + 1
+			call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+			    call pargstr (Memc[fname])
+			    call pargi (ext)
+			iferr (buf = immap (Memc[imname], READ_WRITE, 0)) {
+			    buf = NULL
+			    ext = 0
+			}
+			repeat {
+			    call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+				call pargstr (Memc[fname])
+				call pargi (ext+1)
+			    iferr (outdata = immap (Memc[imname],READ_WRITE,0)) 
+				break
+			    if (buf != NULL)
+				call imunmap (buf)
+			    buf = outdata
+			    ext = ext + 1
+			}
+		    default:
+			call erract (EA_ERROR)
+		    }
+		}
+		out[1] = buf
+	    }
+
+	    call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v3], IM_MAXDIM)
+	    while (impnld (out[1], outdata, Meml[v1]) != EOF) {
+		call ic_gdatad (in, out, dbuf, d, id, n, m, lflag, offsets,
+		    scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+		call ic_growd (Meml[v2], d, id, n, Memi[work], nimages, npts,
+		    pms)
+
+		if (nkeep > 0) {
+		    do i = 1, npts {
+			if (n[i] < nkeep) {
+			    Meml[v1+1] = Meml[v1+1] - 1
+			    if (imgnld (out[1], buf, Meml[v1]) == EOF)
+				;
+			    call amovd (Memd[buf], Memd[outdata], npts)
+			    break
+			}
+		    }
+		}
+
+		switch (combine) {
+		case AVERAGE:
+		    call ic_averaged (d, id, n, wts, npts, NO, YES,
+			Memd[outdata])
+		case MEDIAN:
+		    call ic_mediand (d, n, npts, NO, Memd[outdata])
+		case SUM:
+		    call ic_averaged (d, id, n, wts, npts, NO, NO,
+			Memd[outdata])
+		}
+
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+			
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnld (out[3], buf, Meml[v1])
+		    call ic_sigmad (d, id, n, wts, npts, Memd[outdata],
+			Memd[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+
+		call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	    }
+
+	    do i = 1, nimages
+		call pm_close (Memi[pms+i-1])
+	    call mfree (pms, TY_POINTER)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icpclip.x b/noao/twodspec/longslit/lscombine/src/generic/icpclip.x
new file mode 100644
index 00000000..237d9686
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icpclip.x
@@ -0,0 +1,878 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		3	# Minimum number for clipping
+
+
+# IC_PCLIP -- Percentile clip
+#
+# 1) Find the median
+# 2) Find the pixel which is the specified order index away
+# 3) Use the data value difference as a sigma and apply clipping
+# 4) Since the median is known return it so it does not have to be recomputed
+
+procedure ic_pclips (d, m, n, nimages, npts, median)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[npts]			# Number of good pixels
+int	nimages			# Number of input images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep
+bool	even, fp_equalr()
+real	sigma, r, s, t
+pointer	sp, resid, mp1, mp2
+real	med
+
+include	"../icombine.com"
+
+begin
+	# There must be at least MINCLIP and more than nkeep pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Set sign of pclip parameter
+	if (pclip < 0)
+	    t = -1.
+	else
+	    t = 1.
+
+	# If there are no rejected pixels compute certain parameters once.
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    n2 = 1 + n1 / 2
+	    even = (mod (n1, 2) == 0)
+	    if (pclip < 0.) {
+		if (even)
+		    n3 = max (1, nint (n2 - 1 + pclip))
+		else
+		    n3 = max (1, nint (n2 + pclip))
+	    } else
+		n3 = min (n1, nint (n2 + pclip))
+	    nin = n1
+	}
+
+	# Now apply clipping.
+	do i = 1, npts {
+	    # Compute median.
+	    if (dflag == D_MIX) {
+		n1 = n[i]
+		if (nkeep < 0)
+		    maxkeep = max (0, n1 + nkeep)
+		else
+		    maxkeep = min (n1, nkeep)
+		if (n1 == 0) {
+		    if (combine == MEDIAN)
+			median[i] = blank
+		    next
+		}
+		n2 = 1 + n1 / 2
+		even = (mod (n1, 2) == 0)
+		if (pclip < 0) {
+		    if (even)
+			n3 = max (1, nint (n2 - 1 + pclip))
+		    else
+			n3 = max (1, nint (n2 + pclip))
+		} else
+		    n3 = min (n1, nint (n2 + pclip))
+	    }
+
+	    j = i - 1 
+	    if (even) {
+		med = Mems[d[n2-1]+j]
+		med = (med + Mems[d[n2]+j]) / 2.
+	    } else
+		med = Mems[d[n2]+j]
+
+	    if (n1 < max (MINCLIP, maxkeep+1)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Define sigma for clipping
+	    sigma = t * (Mems[d[n3]+j] - med)
+	    if (fp_equalr (sigma, 0.)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Reject pixels and save residuals.
+	    # Check if any pixels are clipped.
+	    # If so recompute the median and reset the number of good pixels.
+	    # Only reorder if needed.
+
+	    for (nl=1; nl<=n1; nl=nl+1) {
+		r = (med - Mems[d[nl]+j]) / sigma
+		if (r < lsigma)
+		    break
+		Memr[resid+nl] = r
+	    }
+	    for (nh=n1; nh>=1; nh=nh-1) {
+		r = (Mems[d[nh]+j] -  med) / sigma
+		if (r < hsigma)
+		    break
+		Memr[resid+nh] = r
+	    }
+	    n4 = nh - nl + 1
+
+	    # If too many pixels are rejected add some back in.
+	    # All pixels with the same residual are added.
+	    while (n4 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n4 = nh - nl + 1
+	    }
+
+	    # If any pixels are rejected recompute the median.
+	    if (nl > 1 || nh < n1) {
+		n5 = nl + n4 / 2
+		if (mod (n4, 2) == 0) {
+		    med = Mems[d[n5-1]+j]
+		    med = (med + Mems[d[n5]+j]) / 2.
+		} else
+		    med = Mems[d[n5]+j]
+		n[i] = n4
+	    }
+	    if (combine == MEDIAN)
+		median[i] = med
+
+	    # Reorder if pixels only if necessary.
+	    if (nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		k = max (nl, n4 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mems[d[l]+j] = Mems[d[k]+j]
+			if (grow >= 1.) {
+			    mp1 = m[l] + j
+			    mp2 = m[k] + j
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+j] = Memi[m[k]+j]
+			k = k + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mems[d[l]+j] = Mems[d[k]+j]
+			k = k + 1
+		    }
+		}
+	    }
+	}
+
+	# Check if data flag needs to be reset for rejected pixels.
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag whether the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_PCLIP -- Percentile clip
+#
+# 1) Find the median
+# 2) Find the pixel which is the specified order index away
+# 3) Use the data value difference as a sigma and apply clipping
+# 4) Since the median is known return it so it does not have to be recomputed
+
+procedure ic_pclipi (d, m, n, nimages, npts, median)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[npts]			# Number of good pixels
+int	nimages			# Number of input images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep
+bool	even, fp_equalr()
+real	sigma, r, s, t
+pointer	sp, resid, mp1, mp2
+real	med
+
+include	"../icombine.com"
+
+begin
+	# There must be at least MINCLIP and more than nkeep pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Set sign of pclip parameter
+	if (pclip < 0)
+	    t = -1.
+	else
+	    t = 1.
+
+	# If there are no rejected pixels compute certain parameters once.
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    n2 = 1 + n1 / 2
+	    even = (mod (n1, 2) == 0)
+	    if (pclip < 0.) {
+		if (even)
+		    n3 = max (1, nint (n2 - 1 + pclip))
+		else
+		    n3 = max (1, nint (n2 + pclip))
+	    } else
+		n3 = min (n1, nint (n2 + pclip))
+	    nin = n1
+	}
+
+	# Now apply clipping.
+	do i = 1, npts {
+	    # Compute median.
+	    if (dflag == D_MIX) {
+		n1 = n[i]
+		if (nkeep < 0)
+		    maxkeep = max (0, n1 + nkeep)
+		else
+		    maxkeep = min (n1, nkeep)
+		if (n1 == 0) {
+		    if (combine == MEDIAN)
+			median[i] = blank
+		    next
+		}
+		n2 = 1 + n1 / 2
+		even = (mod (n1, 2) == 0)
+		if (pclip < 0) {
+		    if (even)
+			n3 = max (1, nint (n2 - 1 + pclip))
+		    else
+			n3 = max (1, nint (n2 + pclip))
+		} else
+		    n3 = min (n1, nint (n2 + pclip))
+	    }
+
+	    j = i - 1 
+	    if (even) {
+		med = Memi[d[n2-1]+j]
+		med = (med + Memi[d[n2]+j]) / 2.
+	    } else
+		med = Memi[d[n2]+j]
+
+	    if (n1 < max (MINCLIP, maxkeep+1)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Define sigma for clipping
+	    sigma = t * (Memi[d[n3]+j] - med)
+	    if (fp_equalr (sigma, 0.)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Reject pixels and save residuals.
+	    # Check if any pixels are clipped.
+	    # If so recompute the median and reset the number of good pixels.
+	    # Only reorder if needed.
+
+	    for (nl=1; nl<=n1; nl=nl+1) {
+		r = (med - Memi[d[nl]+j]) / sigma
+		if (r < lsigma)
+		    break
+		Memr[resid+nl] = r
+	    }
+	    for (nh=n1; nh>=1; nh=nh-1) {
+		r = (Memi[d[nh]+j] -  med) / sigma
+		if (r < hsigma)
+		    break
+		Memr[resid+nh] = r
+	    }
+	    n4 = nh - nl + 1
+
+	    # If too many pixels are rejected add some back in.
+	    # All pixels with the same residual are added.
+	    while (n4 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n4 = nh - nl + 1
+	    }
+
+	    # If any pixels are rejected recompute the median.
+	    if (nl > 1 || nh < n1) {
+		n5 = nl + n4 / 2
+		if (mod (n4, 2) == 0) {
+		    med = Memi[d[n5-1]+j]
+		    med = (med + Memi[d[n5]+j]) / 2.
+		} else
+		    med = Memi[d[n5]+j]
+		n[i] = n4
+	    }
+	    if (combine == MEDIAN)
+		median[i] = med
+
+	    # Reorder if pixels only if necessary.
+	    if (nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		k = max (nl, n4 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memi[d[l]+j] = Memi[d[k]+j]
+			if (grow >= 1.) {
+			    mp1 = m[l] + j
+			    mp2 = m[k] + j
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+j] = Memi[m[k]+j]
+			k = k + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memi[d[l]+j] = Memi[d[k]+j]
+			k = k + 1
+		    }
+		}
+	    }
+	}
+
+	# Check if data flag needs to be reset for rejected pixels.
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag whether the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_PCLIP -- Percentile clip
+#
+# 1) Find the median
+# 2) Find the pixel which is the specified order index away
+# 3) Use the data value difference as a sigma and apply clipping
+# 4) Since the median is known return it so it does not have to be recomputed
+
+procedure ic_pclipr (d, m, n, nimages, npts, median)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[npts]			# Number of good pixels
+int	nimages			# Number of input images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep
+bool	even, fp_equalr()
+real	sigma, r, s, t
+pointer	sp, resid, mp1, mp2
+real	med
+
+include	"../icombine.com"
+
+begin
+	# There must be at least MINCLIP and more than nkeep pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Set sign of pclip parameter
+	if (pclip < 0)
+	    t = -1.
+	else
+	    t = 1.
+
+	# If there are no rejected pixels compute certain parameters once.
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    n2 = 1 + n1 / 2
+	    even = (mod (n1, 2) == 0)
+	    if (pclip < 0.) {
+		if (even)
+		    n3 = max (1, nint (n2 - 1 + pclip))
+		else
+		    n3 = max (1, nint (n2 + pclip))
+	    } else
+		n3 = min (n1, nint (n2 + pclip))
+	    nin = n1
+	}
+
+	# Now apply clipping.
+	do i = 1, npts {
+	    # Compute median.
+	    if (dflag == D_MIX) {
+		n1 = n[i]
+		if (nkeep < 0)
+		    maxkeep = max (0, n1 + nkeep)
+		else
+		    maxkeep = min (n1, nkeep)
+		if (n1 == 0) {
+		    if (combine == MEDIAN)
+			median[i] = blank
+		    next
+		}
+		n2 = 1 + n1 / 2
+		even = (mod (n1, 2) == 0)
+		if (pclip < 0) {
+		    if (even)
+			n3 = max (1, nint (n2 - 1 + pclip))
+		    else
+			n3 = max (1, nint (n2 + pclip))
+		} else
+		    n3 = min (n1, nint (n2 + pclip))
+	    }
+
+	    j = i - 1 
+	    if (even) {
+		med = Memr[d[n2-1]+j]
+		med = (med + Memr[d[n2]+j]) / 2.
+	    } else
+		med = Memr[d[n2]+j]
+
+	    if (n1 < max (MINCLIP, maxkeep+1)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Define sigma for clipping
+	    sigma = t * (Memr[d[n3]+j] - med)
+	    if (fp_equalr (sigma, 0.)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Reject pixels and save residuals.
+	    # Check if any pixels are clipped.
+	    # If so recompute the median and reset the number of good pixels.
+	    # Only reorder if needed.
+
+	    for (nl=1; nl<=n1; nl=nl+1) {
+		r = (med - Memr[d[nl]+j]) / sigma
+		if (r < lsigma)
+		    break
+		Memr[resid+nl] = r
+	    }
+	    for (nh=n1; nh>=1; nh=nh-1) {
+		r = (Memr[d[nh]+j] -  med) / sigma
+		if (r < hsigma)
+		    break
+		Memr[resid+nh] = r
+	    }
+	    n4 = nh - nl + 1
+
+	    # If too many pixels are rejected add some back in.
+	    # All pixels with the same residual are added.
+	    while (n4 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n4 = nh - nl + 1
+	    }
+
+	    # If any pixels are rejected recompute the median.
+	    if (nl > 1 || nh < n1) {
+		n5 = nl + n4 / 2
+		if (mod (n4, 2) == 0) {
+		    med = Memr[d[n5-1]+j]
+		    med = (med + Memr[d[n5]+j]) / 2.
+		} else
+		    med = Memr[d[n5]+j]
+		n[i] = n4
+	    }
+	    if (combine == MEDIAN)
+		median[i] = med
+
+	    # Reorder if pixels only if necessary.
+	    if (nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		k = max (nl, n4 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+j] = Memr[d[k]+j]
+			if (grow >= 1.) {
+			    mp1 = m[l] + j
+			    mp2 = m[k] + j
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+j] = Memi[m[k]+j]
+			k = k + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memr[d[l]+j] = Memr[d[k]+j]
+			k = k + 1
+		    }
+		}
+	    }
+	}
+
+	# Check if data flag needs to be reset for rejected pixels.
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag whether the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_PCLIP -- Percentile clip
+#
+# 1) Find the median
+# 2) Find the pixel which is the specified order index away
+# 3) Use the data value difference as a sigma and apply clipping
+# 4) Since the median is known return it so it does not have to be recomputed
+
+procedure ic_pclipd (d, m, n, nimages, npts, median)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[npts]			# Number of good pixels
+int	nimages			# Number of input images
+int	npts			# Number of output points per line
+double	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep
+bool	even, fp_equalr()
+real	sigma, r, s, t
+pointer	sp, resid, mp1, mp2
+double	med
+
+include	"../icombine.com"
+
+begin
+	# There must be at least MINCLIP and more than nkeep pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Set sign of pclip parameter
+	if (pclip < 0)
+	    t = -1.
+	else
+	    t = 1.
+
+	# If there are no rejected pixels compute certain parameters once.
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    n2 = 1 + n1 / 2
+	    even = (mod (n1, 2) == 0)
+	    if (pclip < 0.) {
+		if (even)
+		    n3 = max (1, nint (n2 - 1 + pclip))
+		else
+		    n3 = max (1, nint (n2 + pclip))
+	    } else
+		n3 = min (n1, nint (n2 + pclip))
+	    nin = n1
+	}
+
+	# Now apply clipping.
+	do i = 1, npts {
+	    # Compute median.
+	    if (dflag == D_MIX) {
+		n1 = n[i]
+		if (nkeep < 0)
+		    maxkeep = max (0, n1 + nkeep)
+		else
+		    maxkeep = min (n1, nkeep)
+		if (n1 == 0) {
+		    if (combine == MEDIAN)
+			median[i] = blank
+		    next
+		}
+		n2 = 1 + n1 / 2
+		even = (mod (n1, 2) == 0)
+		if (pclip < 0) {
+		    if (even)
+			n3 = max (1, nint (n2 - 1 + pclip))
+		    else
+			n3 = max (1, nint (n2 + pclip))
+		} else
+		    n3 = min (n1, nint (n2 + pclip))
+	    }
+
+	    j = i - 1 
+	    if (even) {
+		med = Memd[d[n2-1]+j]
+		med = (med + Memd[d[n2]+j]) / 2.
+	    } else
+		med = Memd[d[n2]+j]
+
+	    if (n1 < max (MINCLIP, maxkeep+1)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Define sigma for clipping
+	    sigma = t * (Memd[d[n3]+j] - med)
+	    if (fp_equalr (sigma, 0.)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Reject pixels and save residuals.
+	    # Check if any pixels are clipped.
+	    # If so recompute the median and reset the number of good pixels.
+	    # Only reorder if needed.
+
+	    for (nl=1; nl<=n1; nl=nl+1) {
+		r = (med - Memd[d[nl]+j]) / sigma
+		if (r < lsigma)
+		    break
+		Memr[resid+nl] = r
+	    }
+	    for (nh=n1; nh>=1; nh=nh-1) {
+		r = (Memd[d[nh]+j] -  med) / sigma
+		if (r < hsigma)
+		    break
+		Memr[resid+nh] = r
+	    }
+	    n4 = nh - nl + 1
+
+	    # If too many pixels are rejected add some back in.
+	    # All pixels with the same residual are added.
+	    while (n4 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n4 = nh - nl + 1
+	    }
+
+	    # If any pixels are rejected recompute the median.
+	    if (nl > 1 || nh < n1) {
+		n5 = nl + n4 / 2
+		if (mod (n4, 2) == 0) {
+		    med = Memd[d[n5-1]+j]
+		    med = (med + Memd[d[n5]+j]) / 2.
+		} else
+		    med = Memd[d[n5]+j]
+		n[i] = n4
+	    }
+	    if (combine == MEDIAN)
+		median[i] = med
+
+	    # Reorder if pixels only if necessary.
+	    if (nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		k = max (nl, n4 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memd[d[l]+j] = Memd[d[k]+j]
+			if (grow >= 1.) {
+			    mp1 = m[l] + j
+			    mp2 = m[k] + j
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+j] = Memi[m[k]+j]
+			k = k + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memd[d[l]+j] = Memd[d[k]+j]
+			k = k + 1
+		    }
+		}
+	    }
+	}
+
+	# Check if data flag needs to be reset for rejected pixels.
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag whether the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icsclip.x b/noao/twodspec/longslit/lscombine/src/generic/icsclip.x
new file mode 100644
index 00000000..a0188d72
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icsclip.x
@@ -0,0 +1,1922 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		3	# Mininum number of images for algorithm
+
+
+# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average
+# The initial average rejects the high and low pixels.  A correction for
+# different scalings of the images may be made.  Weights are not used.
+
+procedure ic_asigclips (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, r, one
+data	one /1.0/
+pointer	sp, resid, w, wp, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} 
+	
+	# Flag whether returned average needs to be recomputed.
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Save the residuals and the sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Do sigma clipping.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+
+	    # If there are not enough pixels simply compute the average.
+	    if (n1 < max (3, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Mems[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Mems[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    # Compute average with the high and low rejected.
+	    low = Mems[d[1]+k]
+	    high = Mems[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Mems[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Iteratively reject pixels and compute the final average if needed.
+	    # Compact the data and keep track of the image IDs if needed.
+
+	    repeat {
+		n2 = n1
+		if (doscale1) {
+		    # Compute sigma corrected for scaling.
+		    s = 0.
+		    wp = w - 1
+		    do j = 1, n1 {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			wp = wp + 1
+
+			d1 = Mems[dp1]
+			l = Memi[mp1]
+			r = sqrt (max (one, (a + zeros[l]) / scales[l]))
+			s = s + ((d1 - a) / r) ** 2
+			Memr[wp] = r
+		    }
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    wp = w - 1
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+			    wp = wp + 1
+
+			    d1 = Mems[dp1]
+			    r = (d1 - a) / (s * Memr[wp])
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    Memr[wp] = Memr[w+n1-1]
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		} else {
+		    # Compute the sigma without scale correction.
+		    s = 0.
+		    do j = 1, n1
+			s = s + (Mems[d[j]+k] - a) ** 2
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Mems[dp1]
+			    r = (d1 - a) / s
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mems[dp1]
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Mems[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mems[dp1]
+				    Mems[dp1] = Mems[dp2]
+				    Mems[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Mems[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median
+
+procedure ic_msigclips (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, w, mp1, mp2
+real	med, one
+data	one /1.0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	# Save the residuals and sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0)
+		    med = (Mems[d[n3-1]+k] + Mems[d[n3]+k]) / 2.
+		else
+		    med = Mems[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			# Compute the sigma with scaling correction.
+			s = 0.
+			do j = nl, nh {
+			    l = Memi[m[j]+k]
+			    r = sqrt (max (one, (med + zeros[l]) / scales[l]))
+			    s = s + ((Mems[d[j]+k] - med) / r) ** 2
+			    Memr[w+j-1] = r
+			}
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Mems[d[nl]+k]) / (s * Memr[w+nl-1])
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Mems[d[nh]+k] - med) / (s * Memr[w+nh-1])
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			# Compute the sigma without scaling correction.
+			s = 0.
+			do j = nl, nh
+			    s = s + (Mems[d[j]+k] - med) ** 2
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Mems[d[nl]+k]) / s
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Mems[d[nh]+k] -  med) / s
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mems[d[l]+k] = Mems[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mems[d[l]+k] = Mems[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average
+# The initial average rejects the high and low pixels.  A correction for
+# different scalings of the images may be made.  Weights are not used.
+
+procedure ic_asigclipi (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, r, one
+data	one /1.0/
+pointer	sp, resid, w, wp, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} 
+	
+	# Flag whether returned average needs to be recomputed.
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Save the residuals and the sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Do sigma clipping.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+
+	    # If there are not enough pixels simply compute the average.
+	    if (n1 < max (3, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memi[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memi[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    # Compute average with the high and low rejected.
+	    low = Memi[d[1]+k]
+	    high = Memi[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Memi[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Iteratively reject pixels and compute the final average if needed.
+	    # Compact the data and keep track of the image IDs if needed.
+
+	    repeat {
+		n2 = n1
+		if (doscale1) {
+		    # Compute sigma corrected for scaling.
+		    s = 0.
+		    wp = w - 1
+		    do j = 1, n1 {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			wp = wp + 1
+
+			d1 = Memi[dp1]
+			l = Memi[mp1]
+			r = sqrt (max (one, (a + zeros[l]) / scales[l]))
+			s = s + ((d1 - a) / r) ** 2
+			Memr[wp] = r
+		    }
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    wp = w - 1
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+			    wp = wp + 1
+
+			    d1 = Memi[dp1]
+			    r = (d1 - a) / (s * Memr[wp])
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    Memr[wp] = Memr[w+n1-1]
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		} else {
+		    # Compute the sigma without scale correction.
+		    s = 0.
+		    do j = 1, n1
+			s = s + (Memi[d[j]+k] - a) ** 2
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Memi[dp1]
+			    r = (d1 - a) / s
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memi[dp1]
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memi[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memi[dp1]
+				    Memi[dp1] = Memi[dp2]
+				    Memi[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memi[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median
+
+procedure ic_msigclipi (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, w, mp1, mp2
+real	med, one
+data	one /1.0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	# Save the residuals and sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0)
+		    med = (Memi[d[n3-1]+k] + Memi[d[n3]+k]) / 2.
+		else
+		    med = Memi[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			# Compute the sigma with scaling correction.
+			s = 0.
+			do j = nl, nh {
+			    l = Memi[m[j]+k]
+			    r = sqrt (max (one, (med + zeros[l]) / scales[l]))
+			    s = s + ((Memi[d[j]+k] - med) / r) ** 2
+			    Memr[w+j-1] = r
+			}
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Memi[d[nl]+k]) / (s * Memr[w+nl-1])
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Memi[d[nh]+k] - med) / (s * Memr[w+nh-1])
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			# Compute the sigma without scaling correction.
+			s = 0.
+			do j = nl, nh
+			    s = s + (Memi[d[j]+k] - med) ** 2
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Memi[d[nl]+k]) / s
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Memi[d[nh]+k] -  med) / s
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memi[d[l]+k] = Memi[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memi[d[l]+k] = Memi[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average
+# The initial average rejects the high and low pixels.  A correction for
+# different scalings of the images may be made.  Weights are not used.
+
+procedure ic_asigclipr (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+real	d1, low, high, sum, a, s, r, one
+data	one /1.0/
+pointer	sp, resid, w, wp, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} 
+	
+	# Flag whether returned average needs to be recomputed.
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Save the residuals and the sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Do sigma clipping.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+
+	    # If there are not enough pixels simply compute the average.
+	    if (n1 < max (3, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memr[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memr[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    # Compute average with the high and low rejected.
+	    low = Memr[d[1]+k]
+	    high = Memr[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Memr[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Iteratively reject pixels and compute the final average if needed.
+	    # Compact the data and keep track of the image IDs if needed.
+
+	    repeat {
+		n2 = n1
+		if (doscale1) {
+		    # Compute sigma corrected for scaling.
+		    s = 0.
+		    wp = w - 1
+		    do j = 1, n1 {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			wp = wp + 1
+
+			d1 = Memr[dp1]
+			l = Memi[mp1]
+			r = sqrt (max (one, (a + zeros[l]) / scales[l]))
+			s = s + ((d1 - a) / r) ** 2
+			Memr[wp] = r
+		    }
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    wp = w - 1
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+			    wp = wp + 1
+
+			    d1 = Memr[dp1]
+			    r = (d1 - a) / (s * Memr[wp])
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    Memr[wp] = Memr[w+n1-1]
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		} else {
+		    # Compute the sigma without scale correction.
+		    s = 0.
+		    do j = 1, n1
+			s = s + (Memr[d[j]+k] - a) ** 2
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Memr[dp1]
+			    r = (d1 - a) / s
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memr[dp1]
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memr[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memr[dp1]
+				    Memr[dp1] = Memr[dp2]
+				    Memr[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memr[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median
+
+procedure ic_msigclipr (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, w, mp1, mp2
+real	med, one
+data	one /1.0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	# Save the residuals and sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0)
+		    med = (Memr[d[n3-1]+k] + Memr[d[n3]+k]) / 2.
+		else
+		    med = Memr[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			# Compute the sigma with scaling correction.
+			s = 0.
+			do j = nl, nh {
+			    l = Memi[m[j]+k]
+			    r = sqrt (max (one, (med + zeros[l]) / scales[l]))
+			    s = s + ((Memr[d[j]+k] - med) / r) ** 2
+			    Memr[w+j-1] = r
+			}
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Memr[d[nl]+k]) / (s * Memr[w+nl-1])
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Memr[d[nh]+k] - med) / (s * Memr[w+nh-1])
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			# Compute the sigma without scaling correction.
+			s = 0.
+			do j = nl, nh
+			    s = s + (Memr[d[j]+k] - med) ** 2
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Memr[d[nl]+k]) / s
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Memr[d[nh]+k] -  med) / s
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+
+# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average
+# The initial average rejects the high and low pixels.  A correction for
+# different scalings of the images may be made.  Weights are not used.
+
+procedure ic_asigclipd (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+double	average[npts]		# Average
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+double	d1, low, high, sum, a, s, r, one
+data	one /1.0D0/
+pointer	sp, resid, w, wp, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} 
+	
+	# Flag whether returned average needs to be recomputed.
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Save the residuals and the sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Do sigma clipping.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+
+	    # If there are not enough pixels simply compute the average.
+	    if (n1 < max (3, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Memd[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Memd[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    # Compute average with the high and low rejected.
+	    low = Memd[d[1]+k]
+	    high = Memd[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Memd[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Iteratively reject pixels and compute the final average if needed.
+	    # Compact the data and keep track of the image IDs if needed.
+
+	    repeat {
+		n2 = n1
+		if (doscale1) {
+		    # Compute sigma corrected for scaling.
+		    s = 0.
+		    wp = w - 1
+		    do j = 1, n1 {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			wp = wp + 1
+
+			d1 = Memd[dp1]
+			l = Memi[mp1]
+			r = sqrt (max (one, (a + zeros[l]) / scales[l]))
+			s = s + ((d1 - a) / r) ** 2
+			Memr[wp] = r
+		    }
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    wp = w - 1
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+			    wp = wp + 1
+
+			    d1 = Memd[dp1]
+			    r = (d1 - a) / (s * Memr[wp])
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    Memr[wp] = Memr[w+n1-1]
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		} else {
+		    # Compute the sigma without scale correction.
+		    s = 0.
+		    do j = 1, n1
+			s = s + (Memd[d[j]+k] - a) ** 2
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Memd[dp1]
+			    r = (d1 - a) / s
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memd[dp1]
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Memd[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Memd[dp1]
+				    Memd[dp1] = Memd[dp2]
+				    Memd[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Memd[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median
+
+procedure ic_msigclipd (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+double	median[npts]		# Median
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, w, mp1, mp2
+double	med, one
+data	one /1.0D0/
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	# Save the residuals and sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0)
+		    med = (Memd[d[n3-1]+k] + Memd[d[n3]+k]) / 2.
+		else
+		    med = Memd[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			# Compute the sigma with scaling correction.
+			s = 0.
+			do j = nl, nh {
+			    l = Memi[m[j]+k]
+			    r = sqrt (max (one, (med + zeros[l]) / scales[l]))
+			    s = s + ((Memd[d[j]+k] - med) / r) ** 2
+			    Memr[w+j-1] = r
+			}
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Memd[d[nl]+k]) / (s * Memr[w+nl-1])
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Memd[d[nh]+k] - med) / (s * Memr[w+nh-1])
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			# Compute the sigma without scaling correction.
+			s = 0.
+			do j = nl, nh
+			    s = s + (Memd[d[j]+k] - med) ** 2
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Memd[d[nl]+k]) / s
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Memd[d[nh]+k] -  med) / s
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memd[d[l]+k] = Memd[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Memd[d[l]+k] = Memd[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icsigma.x b/noao/twodspec/longslit/lscombine/src/generic/icsigma.x
new file mode 100644
index 00000000..b9c9a781
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icsigma.x
@@ -0,0 +1,434 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+
+# IC_SIGMA -- Compute the sigma image line.
+# The estimated sigma includes a correction for the finite population.
+# Weights are used if desired.
+
+procedure ic_sigmas (d, m, n, wts, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+real	sigma[npts]		# Sigma line (returned)
+
+int	i, j, k, n1
+real	wt, sigcor, sumwt
+real	a, sum
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (dowts) {
+		if (n1 > 1)
+		    sigcor = real (n1) / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    wt = wts[Memi[m[1]+k]]
+		    sum = (Mems[d[1]+k] - a) ** 2 * wt
+		    do j = 2, n1 {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + (Mems[d[j]+k] - a) ** 2 * wt
+		    }
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    } else {
+		if (n1 > 1)
+		    sigcor = 1. / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    sum = (Mems[d[1]+k] - a) ** 2
+		    do j = 2, n1
+			sum = sum + (Mems[d[j]+k] - a) ** 2
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    do i = 1, npts
+		sigma[i] = blank
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = real (n1) / real (n1 -1)
+			else
+			    sigcor = 1
+			a = average[i]
+			wt = wts[Memi[m[1]+k]]
+			sum = (Mems[d[1]+k] - a) ** 2 * wt
+			sumwt = wt
+			do j = 2, n1 {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + (Mems[d[j]+k] - a) ** 2 * wt
+			    sumwt = sumwt + wt
+			}
+			if (sumwt > 0)
+			    sigma[i] = sqrt (sum / sumwt * sigcor)
+			else {
+			    sum = (Mems[d[1]+k] - a) ** 2
+			    do j = 2, n1
+				sum = sum + (Mems[d[j]+k] - a) ** 2
+			    sigma[i] = sqrt (sum / n1 * sigcor)
+			}
+		    } else
+			sigma[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = 1. / real (n1 - 1)
+			else
+			    sigcor = 1.
+			a = average[i]
+			sum = (Mems[d[1]+k] - a) ** 2
+			do j = 2, n1
+			    sum = sum + (Mems[d[j]+k] - a) ** 2
+			sigma[i] = sqrt (sum * sigcor)
+		    } else
+			sigma[i] = blank
+		}
+	    }
+	}
+end
+
+# IC_SIGMA -- Compute the sigma image line.
+# The estimated sigma includes a correction for the finite population.
+# Weights are used if desired.
+
+procedure ic_sigmai (d, m, n, wts, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+real	sigma[npts]		# Sigma line (returned)
+
+int	i, j, k, n1
+real	wt, sigcor, sumwt
+real	a, sum
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (dowts) {
+		if (n1 > 1)
+		    sigcor = real (n1) / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    wt = wts[Memi[m[1]+k]]
+		    sum = (Memi[d[1]+k] - a) ** 2 * wt
+		    do j = 2, n1 {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + (Memi[d[j]+k] - a) ** 2 * wt
+		    }
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    } else {
+		if (n1 > 1)
+		    sigcor = 1. / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    sum = (Memi[d[1]+k] - a) ** 2
+		    do j = 2, n1
+			sum = sum + (Memi[d[j]+k] - a) ** 2
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    do i = 1, npts
+		sigma[i] = blank
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = real (n1) / real (n1 -1)
+			else
+			    sigcor = 1
+			a = average[i]
+			wt = wts[Memi[m[1]+k]]
+			sum = (Memi[d[1]+k] - a) ** 2 * wt
+			sumwt = wt
+			do j = 2, n1 {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + (Memi[d[j]+k] - a) ** 2 * wt
+			    sumwt = sumwt + wt
+			}
+			if (sumwt > 0)
+			    sigma[i] = sqrt (sum / sumwt * sigcor)
+			else {
+			    sum = (Memi[d[1]+k] - a) ** 2
+			    do j = 2, n1
+				sum = sum + (Memi[d[j]+k] - a) ** 2
+			    sigma[i] = sqrt (sum / n1 * sigcor)
+			}
+		    } else
+			sigma[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = 1. / real (n1 - 1)
+			else
+			    sigcor = 1.
+			a = average[i]
+			sum = (Memi[d[1]+k] - a) ** 2
+			do j = 2, n1
+			    sum = sum + (Memi[d[j]+k] - a) ** 2
+			sigma[i] = sqrt (sum * sigcor)
+		    } else
+			sigma[i] = blank
+		}
+	    }
+	}
+end
+
+# IC_SIGMA -- Compute the sigma image line.
+# The estimated sigma includes a correction for the finite population.
+# Weights are used if desired.
+
+procedure ic_sigmar (d, m, n, wts, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+real	sigma[npts]		# Sigma line (returned)
+
+int	i, j, k, n1
+real	wt, sigcor, sumwt
+real	a, sum
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (dowts) {
+		if (n1 > 1)
+		    sigcor = real (n1) / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    wt = wts[Memi[m[1]+k]]
+		    sum = (Memr[d[1]+k] - a) ** 2 * wt
+		    do j = 2, n1 {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + (Memr[d[j]+k] - a) ** 2 * wt
+		    }
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    } else {
+		if (n1 > 1)
+		    sigcor = 1. / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    sum = (Memr[d[1]+k] - a) ** 2
+		    do j = 2, n1
+			sum = sum + (Memr[d[j]+k] - a) ** 2
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    do i = 1, npts
+		sigma[i] = blank
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = real (n1) / real (n1 -1)
+			else
+			    sigcor = 1
+			a = average[i]
+			wt = wts[Memi[m[1]+k]]
+			sum = (Memr[d[1]+k] - a) ** 2 * wt
+			sumwt = wt
+			do j = 2, n1 {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + (Memr[d[j]+k] - a) ** 2 * wt
+			    sumwt = sumwt + wt
+			}
+			if (sumwt > 0)
+			    sigma[i] = sqrt (sum / sumwt * sigcor)
+			else {
+			    sum = (Memr[d[1]+k] - a) ** 2
+			    do j = 2, n1
+				sum = sum + (Memr[d[j]+k] - a) ** 2
+			    sigma[i] = sqrt (sum / n1 * sigcor)
+			}
+		    } else
+			sigma[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = 1. / real (n1 - 1)
+			else
+			    sigcor = 1.
+			a = average[i]
+			sum = (Memr[d[1]+k] - a) ** 2
+			do j = 2, n1
+			    sum = sum + (Memr[d[j]+k] - a) ** 2
+			sigma[i] = sqrt (sum * sigcor)
+		    } else
+			sigma[i] = blank
+		}
+	    }
+	}
+end
+
+# IC_SIGMA -- Compute the sigma image line.
+# The estimated sigma includes a correction for the finite population.
+# Weights are used if desired.
+
+procedure ic_sigmad (d, m, n, wts, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+double	average[npts]		# Average
+double	sigma[npts]		# Sigma line (returned)
+
+int	i, j, k, n1
+real	wt, sigcor, sumwt
+double	a, sum
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (dowts) {
+		if (n1 > 1)
+		    sigcor = real (n1) / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    wt = wts[Memi[m[1]+k]]
+		    sum = (Memd[d[1]+k] - a) ** 2 * wt
+		    do j = 2, n1 {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + (Memd[d[j]+k] - a) ** 2 * wt
+		    }
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    } else {
+		if (n1 > 1)
+		    sigcor = 1. / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    sum = (Memd[d[1]+k] - a) ** 2
+		    do j = 2, n1
+			sum = sum + (Memd[d[j]+k] - a) ** 2
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    do i = 1, npts
+		sigma[i] = blank
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = real (n1) / real (n1 -1)
+			else
+			    sigcor = 1
+			a = average[i]
+			wt = wts[Memi[m[1]+k]]
+			sum = (Memd[d[1]+k] - a) ** 2 * wt
+			sumwt = wt
+			do j = 2, n1 {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + (Memd[d[j]+k] - a) ** 2 * wt
+			    sumwt = sumwt + wt
+			}
+			if (sumwt > 0)
+			    sigma[i] = sqrt (sum / sumwt * sigcor)
+			else {
+			    sum = (Memd[d[1]+k] - a) ** 2
+			    do j = 2, n1
+				sum = sum + (Memd[d[j]+k] - a) ** 2
+			    sigma[i] = sqrt (sum / n1 * sigcor)
+			}
+		    } else
+			sigma[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = 1. / real (n1 - 1)
+			else
+			    sigcor = 1.
+			a = average[i]
+			sum = (Memd[d[1]+k] - a) ** 2
+			do j = 2, n1
+			    sum = sum + (Memd[d[j]+k] - a) ** 2
+			sigma[i] = sqrt (sum * sigcor)
+		    } else
+			sigma[i] = blank
+		}
+	    }
+	}
+end
+
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icsort.x b/noao/twodspec/longslit/lscombine/src/generic/icsort.x
new file mode 100644
index 00000000..3ec1d27e
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icsort.x
@@ -0,0 +1,1096 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+
+# IC_SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.
+
+procedure ic_sorts (a, b, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+short	b[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+short	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix
+		b[i] = Mems[a[i]+l]
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3)			# bac
+				b[2] = pivot
+			    else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3)			# acb
+			    b[2] = temp3
+			else {					# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    do i = 1, npix
+		b[i] = Mems[a[i]+l]
+
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j)		   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_
+	    do i = 1, npix
+		Mems[a[i]+l] = b[i]
+	}
+end
+
+
+# IC_2SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.  A second integer set of
+# vectors is sorted.
+
+procedure ic_2sorts (a, b, c, d, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+short	b[ARB]			# work array
+pointer	c[ARB]			# pointer to associated integer vectors
+int	d[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+short	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp
+define	swap {temp=$1;$1=$2;$2=temp}
+define	iswap {itemp=$1;$1=$2;$2=itemp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix {
+		b[i] = Mems[a[i]+l]
+		d[i] = Memi[c[i]+l]
+	    }
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+			iswap (d[1], d[2])
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3) {		# bac
+				b[2] = pivot
+				iswap (d[1], d[2])
+			    } else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+				itemp = d[2]
+				d[2] = d[3]
+				d[3] = d[1]
+				d[1] = itemp
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			    iswap (d[1], d[3])
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3) {			# acb
+			    b[2] = temp3
+			    iswap (d[2], d[3])
+			} else {				# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			    itemp = d[2]
+			    d[2] = d[1]
+			    d[1] = d[3]
+			    d[3] = itemp
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k]); swap (d[j], d[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j) {	   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+				swap (d[i], d[j])
+			    }
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+			swap (d[i], d[j])
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_	   
+	    do i = 1, npix {
+		Mems[a[i]+l] = b[i]
+		Memi[c[i]+l] = d[i]
+	    }
+	}
+end
+
+# IC_SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.
+
+procedure ic_sorti (a, b, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+int	b[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+int	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix
+		b[i] = Memi[a[i]+l]
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3)			# bac
+				b[2] = pivot
+			    else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3)			# acb
+			    b[2] = temp3
+			else {					# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    do i = 1, npix
+		b[i] = Memi[a[i]+l]
+
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j)		   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_
+	    do i = 1, npix
+		Memi[a[i]+l] = b[i]
+	}
+end
+
+
+# IC_2SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.  A second integer set of
+# vectors is sorted.
+
+procedure ic_2sorti (a, b, c, d, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+int	b[ARB]			# work array
+pointer	c[ARB]			# pointer to associated integer vectors
+int	d[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+int	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp
+define	swap {temp=$1;$1=$2;$2=temp}
+define	iswap {itemp=$1;$1=$2;$2=itemp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix {
+		b[i] = Memi[a[i]+l]
+		d[i] = Memi[c[i]+l]
+	    }
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+			iswap (d[1], d[2])
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3) {		# bac
+				b[2] = pivot
+				iswap (d[1], d[2])
+			    } else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+				itemp = d[2]
+				d[2] = d[3]
+				d[3] = d[1]
+				d[1] = itemp
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			    iswap (d[1], d[3])
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3) {			# acb
+			    b[2] = temp3
+			    iswap (d[2], d[3])
+			} else {				# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			    itemp = d[2]
+			    d[2] = d[1]
+			    d[1] = d[3]
+			    d[3] = itemp
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k]); swap (d[j], d[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j) {	   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+				swap (d[i], d[j])
+			    }
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+			swap (d[i], d[j])
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_	   
+	    do i = 1, npix {
+		Memi[a[i]+l] = b[i]
+		Memi[c[i]+l] = d[i]
+	    }
+	}
+end
+
+# IC_SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.
+
+procedure ic_sortr (a, b, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+real	b[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+real	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix
+		b[i] = Memr[a[i]+l]
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3)			# bac
+				b[2] = pivot
+			    else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3)			# acb
+			    b[2] = temp3
+			else {					# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    do i = 1, npix
+		b[i] = Memr[a[i]+l]
+
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j)		   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_
+	    do i = 1, npix
+		Memr[a[i]+l] = b[i]
+	}
+end
+
+
+# IC_2SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.  A second integer set of
+# vectors is sorted.
+
+procedure ic_2sortr (a, b, c, d, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+real	b[ARB]			# work array
+pointer	c[ARB]			# pointer to associated integer vectors
+int	d[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+real	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp
+define	swap {temp=$1;$1=$2;$2=temp}
+define	iswap {itemp=$1;$1=$2;$2=itemp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix {
+		b[i] = Memr[a[i]+l]
+		d[i] = Memi[c[i]+l]
+	    }
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+			iswap (d[1], d[2])
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3) {		# bac
+				b[2] = pivot
+				iswap (d[1], d[2])
+			    } else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+				itemp = d[2]
+				d[2] = d[3]
+				d[3] = d[1]
+				d[1] = itemp
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			    iswap (d[1], d[3])
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3) {			# acb
+			    b[2] = temp3
+			    iswap (d[2], d[3])
+			} else {				# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			    itemp = d[2]
+			    d[2] = d[1]
+			    d[1] = d[3]
+			    d[3] = itemp
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k]); swap (d[j], d[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j) {	   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+				swap (d[i], d[j])
+			    }
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+			swap (d[i], d[j])
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_	   
+	    do i = 1, npix {
+		Memr[a[i]+l] = b[i]
+		Memi[c[i]+l] = d[i]
+	    }
+	}
+end
+
+# IC_SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.
+
+procedure ic_sortd (a, b, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+double	b[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+double	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix
+		b[i] = Memd[a[i]+l]
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3)			# bac
+				b[2] = pivot
+			    else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3)			# acb
+			    b[2] = temp3
+			else {					# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    do i = 1, npix
+		b[i] = Memd[a[i]+l]
+
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j)		   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_
+	    do i = 1, npix
+		Memd[a[i]+l] = b[i]
+	}
+end
+
+
+# IC_2SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.  A second integer set of
+# vectors is sorted.
+
+procedure ic_2sortd (a, b, c, d, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+double	b[ARB]			# work array
+pointer	c[ARB]			# pointer to associated integer vectors
+int	d[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+double	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp
+define	swap {temp=$1;$1=$2;$2=temp}
+define	iswap {itemp=$1;$1=$2;$2=itemp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix {
+		b[i] = Memd[a[i]+l]
+		d[i] = Memi[c[i]+l]
+	    }
+
+	    # Special cases
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+			iswap (d[1], d[2])
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3) {		# bac
+				b[2] = pivot
+				iswap (d[1], d[2])
+			    } else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+				itemp = d[2]
+				d[2] = d[3]
+				d[3] = d[1]
+				d[1] = itemp
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			    iswap (d[1], d[3])
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3) {			# acb
+			    b[2] = temp3
+			    iswap (d[2], d[3])
+			} else {				# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			    itemp = d[2]
+			    d[2] = d[1]
+			    d[1] = d[3]
+			    d[3] = itemp
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+
+	    # General case
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k]); swap (d[j], d[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+				if (b[j] <= pivot)
+				    break
+			    if (i < j) {	   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+				swap (d[i], d[j])
+			    }
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+			swap (d[i], d[j])
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_	   
+	    do i = 1, npix {
+		Memd[a[i]+l] = b[i]
+		Memi[c[i]+l] = d[i]
+	    }
+	}
+end
diff --git a/noao/twodspec/longslit/lscombine/src/generic/icstat.x b/noao/twodspec/longslit/lscombine/src/generic/icstat.x
new file mode 100644
index 00000000..3a0ed49c
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/icstat.x
@@ -0,0 +1,892 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+define	NMAX	100000	# Maximum number of pixels to sample
+
+
+# IC_STAT -- Compute image statistics within specified section.
+# The image section is relative to a reference image which may be
+# different than the input image and may have an offset.  Only a
+# subsample of pixels is used.  Masked and thresholded pixels are
+# ignored.  Only the desired statistics are computed to increase
+# efficiency.
+
+procedure ic_stats (im, imref, section, offsets, image, nimages,
+	domode, domedian, domean, mode, median, mean)
+
+pointer	im			 # Data image
+pointer	imref			 # Reference image for image section
+char	section[ARB]		 # Image section
+int	offsets[nimages,ARB]	 # Image section offset from data to reference
+int	image			 # Image index (for mask I/O)
+int	nimages			 # Number of images in  offsets.
+bool	domode, domedian, domean # Statistics to compute
+real	mode, median, mean	 # Statistics
+
+int	i, j, ndim, n, nv
+real	a
+pointer	sp, v1, v2, dv, va, vb
+pointer	data, mask, dp, lp, mp, imgnls()
+
+real	asums()
+short	ic_modes()
+
+include	"../icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (dv, IM_MAXDIM, TY_LONG)
+	call salloc (va, IM_MAXDIM, TY_LONG)
+	call salloc (vb, IM_MAXDIM, TY_LONG)
+
+	# Determine the image section parameters.  This must be in terms of
+	# the data image pixel coordinates though the section may be specified
+	# in terms of the reference image coordinates.  Limit the number of
+	# pixels in each dimension to a maximum.
+
+	ndim = IM_NDIM(im)
+	if (project)
+	    ndim = ndim - 1
+	call amovki (1, Memi[v1], IM_MAXDIM)
+	call amovki (1, Memi[va], IM_MAXDIM)
+	call amovki (1, Memi[dv], IM_MAXDIM)
+	call amovi (IM_LEN(imref,1), Memi[vb], ndim)
+	call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim)
+	if (im != imref)
+	    do i = 1, ndim {
+		Memi[va+i-1] = Memi[va+i-1] - offsets[image,i]
+		Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i]
+	    }
+
+	do j = 1, 10 {
+	    n = 1
+	    do i = 0, ndim-1 {
+		Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i]))
+		Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i]))
+		Memi[dv+i] = j
+		nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1)
+		Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i]
+		n = n * nv
+	    }
+	    if (n < NMAX)
+		break
+	}
+
+	call amovl (Memi[v1], Memi[va], IM_MAXDIM)
+	Memi[va] = 1
+	if (project)
+	   Memi[va+ndim] = image
+	call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+
+	# Accumulate the pixel values within the section.  Masked pixels and
+	# thresholded pixels are ignored.
+
+	call salloc (data, n, TY_SHORT)
+	dp = data
+	while (imgnls (im, lp, Memi[vb]) != EOF) {
+	    call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask)
+	    lp = lp + Memi[v1] - 1
+	    if (dflag == D_ALL) {
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			a = Mems[lp]
+			if (a >= lthresh && a <= hthresh) {
+			    Mems[dp] = a
+			    dp = dp + 1
+			}
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			Mems[dp] = Mems[lp]
+			dp = dp + 1
+			lp = lp + Memi[dv]
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		mp = mask + Memi[v1] - 1
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    a = Mems[lp]
+			    if (a >= lthresh && a <= hthresh) {
+				Mems[dp] = a
+				dp = dp + 1
+			    }
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    Mems[dp] = Mems[lp]
+			    dp = dp + 1
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		}
+	    }
+	    for (i=2; i<=ndim; i=i+1) {
+		Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1]
+		if (Memi[va+i-1] <= Memi[v2+i-1])
+		    break
+		Memi[va+i-1] = Memi[v1+i-1]
+	    }
+	    if (i > ndim)
+		break
+	    call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+	}
+
+	# Close mask until it is needed again.
+	call ic_mclose1 (image, nimages)
+
+	n = dp - data
+	if (n < 1) {
+	    call sfree (sp)
+	    call error (1, "Image section contains no pixels")
+	}
+
+	# Compute only statistics needed.
+	if (domode || domedian) {
+	    call asrts (Mems[data], Mems[data], n)
+	    mode = ic_modes (Mems[data], n)
+	    median = Mems[data+n/2-1]
+	}
+	if (domean)
+	    mean = asums (Mems[data], n) / n
+
+	call sfree (sp)
+end
+
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZRANGE	0.7	# Fraction of pixels about median to use
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+# IC_MODE -- Compute mode of an array.  The mode is found by binning
+# with a bin size based on the data range over a fraction of the
+# pixels about the median and a bin step which may be smaller than the
+# bin size.  If there are too few points the median is returned.
+# The input array must be sorted.
+
+short procedure ic_modes (a, n)
+
+short	a[n]			# Data array
+int	n			# Number of points
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+short	mode
+bool	fp_equalr()
+
+begin
+	if (n < NMIN)
+	    return (a[n/2])
+
+	# Compute the mode.  The array must be sorted.  Consider a
+	# range of values about the median point.  Use a bin size which
+	# is ZBIN of the range.  Step the bin limits in ZSTEP fraction of
+	# the bin size.
+
+	i = 1 + n * (1. - ZRANGE) / 2.
+	j = 1 + n * (1. + ZRANGE) / 2.
+	z1 = a[i]
+	z2 = a[j]
+	if (fp_equalr (z1, z2)) {
+	    mode = z1
+	    return (mode)
+	}
+
+	zstep = ZSTEP * (z2 - z1)
+	zbin = ZBIN * (z2 - z1)
+	zstep = max (1., zstep)
+	zbin = max (1., zbin)
+
+	z1 = z1 - zstep
+	k = i
+	nmax = 0
+	repeat {
+	    z1 = z1 + zstep
+	    z2 = z1 + zbin
+	    for (; i < j && a[i] < z1; i=i+1)
+		;
+	    for (; k < j && a[k] < z2; k=k+1)
+		;
+	    if (k - i > nmax) {
+	        nmax = k - i
+	        mode = a[(i+k)/2]
+	    }
+	} until (k >= j)
+
+	return (mode)
+end
+
+# IC_STAT -- Compute image statistics within specified section.
+# The image section is relative to a reference image which may be
+# different than the input image and may have an offset.  Only a
+# subsample of pixels is used.  Masked and thresholded pixels are
+# ignored.  Only the desired statistics are computed to increase
+# efficiency.
+
+procedure ic_stati (im, imref, section, offsets, image, nimages,
+	domode, domedian, domean, mode, median, mean)
+
+pointer	im			 # Data image
+pointer	imref			 # Reference image for image section
+char	section[ARB]		 # Image section
+int	offsets[nimages,ARB]	 # Image section offset from data to reference
+int	image			 # Image index (for mask I/O)
+int	nimages			 # Number of images in  offsets.
+bool	domode, domedian, domean # Statistics to compute
+real	mode, median, mean	 # Statistics
+
+int	i, j, ndim, n, nv
+real	a
+pointer	sp, v1, v2, dv, va, vb
+pointer	data, mask, dp, lp, mp, imgnli()
+
+real	asumi()
+int	ic_modei()
+
+include	"../icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (dv, IM_MAXDIM, TY_LONG)
+	call salloc (va, IM_MAXDIM, TY_LONG)
+	call salloc (vb, IM_MAXDIM, TY_LONG)
+
+	# Determine the image section parameters.  This must be in terms of
+	# the data image pixel coordinates though the section may be specified
+	# in terms of the reference image coordinates.  Limit the number of
+	# pixels in each dimension to a maximum.
+
+	ndim = IM_NDIM(im)
+	if (project)
+	    ndim = ndim - 1
+	call amovki (1, Memi[v1], IM_MAXDIM)
+	call amovki (1, Memi[va], IM_MAXDIM)
+	call amovki (1, Memi[dv], IM_MAXDIM)
+	call amovi (IM_LEN(imref,1), Memi[vb], ndim)
+	call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim)
+	if (im != imref)
+	    do i = 1, ndim {
+		Memi[va+i-1] = Memi[va+i-1] - offsets[image,i]
+		Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i]
+	    }
+
+	do j = 1, 10 {
+	    n = 1
+	    do i = 0, ndim-1 {
+		Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i]))
+		Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i]))
+		Memi[dv+i] = j
+		nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1)
+		Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i]
+		n = n * nv
+	    }
+	    if (n < NMAX)
+		break
+	}
+
+	call amovl (Memi[v1], Memi[va], IM_MAXDIM)
+	Memi[va] = 1
+	if (project)
+	   Memi[va+ndim] = image
+	call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+
+	# Accumulate the pixel values within the section.  Masked pixels and
+	# thresholded pixels are ignored.
+
+	call salloc (data, n, TY_INT)
+	dp = data
+	while (imgnli (im, lp, Memi[vb]) != EOF) {
+	    call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask)
+	    lp = lp + Memi[v1] - 1
+	    if (dflag == D_ALL) {
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			a = Memi[lp]
+			if (a >= lthresh && a <= hthresh) {
+			    Memi[dp] = a
+			    dp = dp + 1
+			}
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			Memi[dp] = Memi[lp]
+			dp = dp + 1
+			lp = lp + Memi[dv]
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		mp = mask + Memi[v1] - 1
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    a = Memi[lp]
+			    if (a >= lthresh && a <= hthresh) {
+				Memi[dp] = a
+				dp = dp + 1
+			    }
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    Memi[dp] = Memi[lp]
+			    dp = dp + 1
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		}
+	    }
+	    for (i=2; i<=ndim; i=i+1) {
+		Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1]
+		if (Memi[va+i-1] <= Memi[v2+i-1])
+		    break
+		Memi[va+i-1] = Memi[v1+i-1]
+	    }
+	    if (i > ndim)
+		break
+	    call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+	}
+
+	# Close mask until it is needed again.
+	call ic_mclose1 (image, nimages)
+
+	n = dp - data
+	if (n < 1) {
+	    call sfree (sp)
+	    call error (1, "Image section contains no pixels")
+	}
+
+	# Compute only statistics needed.
+	if (domode || domedian) {
+	    call asrti (Memi[data], Memi[data], n)
+	    mode = ic_modei (Memi[data], n)
+	    median = Memi[data+n/2-1]
+	}
+	if (domean)
+	    mean = asumi (Memi[data], n) / n
+
+	call sfree (sp)
+end
+
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZRANGE	0.7	# Fraction of pixels about median to use
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+# IC_MODE -- Compute mode of an array.  The mode is found by binning
+# with a bin size based on the data range over a fraction of the
+# pixels about the median and a bin step which may be smaller than the
+# bin size.  If there are too few points the median is returned.
+# The input array must be sorted.
+
+int procedure ic_modei (a, n)
+
+int	a[n]			# Data array
+int	n			# Number of points
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+int	mode
+bool	fp_equalr()
+
+begin
+	if (n < NMIN)
+	    return (a[n/2])
+
+	# Compute the mode.  The array must be sorted.  Consider a
+	# range of values about the median point.  Use a bin size which
+	# is ZBIN of the range.  Step the bin limits in ZSTEP fraction of
+	# the bin size.
+
+	i = 1 + n * (1. - ZRANGE) / 2.
+	j = 1 + n * (1. + ZRANGE) / 2.
+	z1 = a[i]
+	z2 = a[j]
+	if (fp_equalr (z1, z2)) {
+	    mode = z1
+	    return (mode)
+	}
+
+	zstep = ZSTEP * (z2 - z1)
+	zbin = ZBIN * (z2 - z1)
+	zstep = max (1., zstep)
+	zbin = max (1., zbin)
+
+	z1 = z1 - zstep
+	k = i
+	nmax = 0
+	repeat {
+	    z1 = z1 + zstep
+	    z2 = z1 + zbin
+	    for (; i < j && a[i] < z1; i=i+1)
+		;
+	    for (; k < j && a[k] < z2; k=k+1)
+		;
+	    if (k - i > nmax) {
+	        nmax = k - i
+	        mode = a[(i+k)/2]
+	    }
+	} until (k >= j)
+
+	return (mode)
+end
+
+# IC_STAT -- Compute image statistics within specified section.
+# The image section is relative to a reference image which may be
+# different than the input image and may have an offset.  Only a
+# subsample of pixels is used.  Masked and thresholded pixels are
+# ignored.  Only the desired statistics are computed to increase
+# efficiency.
+
+procedure ic_statr (im, imref, section, offsets, image, nimages,
+	domode, domedian, domean, mode, median, mean)
+
+pointer	im			 # Data image
+pointer	imref			 # Reference image for image section
+char	section[ARB]		 # Image section
+int	offsets[nimages,ARB]	 # Image section offset from data to reference
+int	image			 # Image index (for mask I/O)
+int	nimages			 # Number of images in  offsets.
+bool	domode, domedian, domean # Statistics to compute
+real	mode, median, mean	 # Statistics
+
+int	i, j, ndim, n, nv
+real	a
+pointer	sp, v1, v2, dv, va, vb
+pointer	data, mask, dp, lp, mp, imgnlr()
+
+real	asumr()
+real	ic_moder()
+
+include	"../icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (dv, IM_MAXDIM, TY_LONG)
+	call salloc (va, IM_MAXDIM, TY_LONG)
+	call salloc (vb, IM_MAXDIM, TY_LONG)
+
+	# Determine the image section parameters.  This must be in terms of
+	# the data image pixel coordinates though the section may be specified
+	# in terms of the reference image coordinates.  Limit the number of
+	# pixels in each dimension to a maximum.
+
+	ndim = IM_NDIM(im)
+	if (project)
+	    ndim = ndim - 1
+	call amovki (1, Memi[v1], IM_MAXDIM)
+	call amovki (1, Memi[va], IM_MAXDIM)
+	call amovki (1, Memi[dv], IM_MAXDIM)
+	call amovi (IM_LEN(imref,1), Memi[vb], ndim)
+	call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim)
+	if (im != imref)
+	    do i = 1, ndim {
+		Memi[va+i-1] = Memi[va+i-1] - offsets[image,i]
+		Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i]
+	    }
+
+	do j = 1, 10 {
+	    n = 1
+	    do i = 0, ndim-1 {
+		Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i]))
+		Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i]))
+		Memi[dv+i] = j
+		nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1)
+		Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i]
+		n = n * nv
+	    }
+	    if (n < NMAX)
+		break
+	}
+
+	call amovl (Memi[v1], Memi[va], IM_MAXDIM)
+	Memi[va] = 1
+	if (project)
+	   Memi[va+ndim] = image
+	call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+
+	# Accumulate the pixel values within the section.  Masked pixels and
+	# thresholded pixels are ignored.
+
+	call salloc (data, n, TY_REAL)
+	dp = data
+	while (imgnlr (im, lp, Memi[vb]) != EOF) {
+	    call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask)
+	    lp = lp + Memi[v1] - 1
+	    if (dflag == D_ALL) {
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			a = Memr[lp]
+			if (a >= lthresh && a <= hthresh) {
+			    Memr[dp] = a
+			    dp = dp + 1
+			}
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			Memr[dp] = Memr[lp]
+			dp = dp + 1
+			lp = lp + Memi[dv]
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		mp = mask + Memi[v1] - 1
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    a = Memr[lp]
+			    if (a >= lthresh && a <= hthresh) {
+				Memr[dp] = a
+				dp = dp + 1
+			    }
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    Memr[dp] = Memr[lp]
+			    dp = dp + 1
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		}
+	    }
+	    for (i=2; i<=ndim; i=i+1) {
+		Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1]
+		if (Memi[va+i-1] <= Memi[v2+i-1])
+		    break
+		Memi[va+i-1] = Memi[v1+i-1]
+	    }
+	    if (i > ndim)
+		break
+	    call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+	}
+
+	# Close mask until it is needed again.
+	call ic_mclose1 (image, nimages)
+
+	n = dp - data
+	if (n < 1) {
+	    call sfree (sp)
+	    call error (1, "Image section contains no pixels")
+	}
+
+	# Compute only statistics needed.
+	if (domode || domedian) {
+	    call asrtr (Memr[data], Memr[data], n)
+	    mode = ic_moder (Memr[data], n)
+	    median = Memr[data+n/2-1]
+	}
+	if (domean)
+	    mean = asumr (Memr[data], n) / n
+
+	call sfree (sp)
+end
+
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZRANGE	0.7	# Fraction of pixels about median to use
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+# IC_MODE -- Compute mode of an array.  The mode is found by binning
+# with a bin size based on the data range over a fraction of the
+# pixels about the median and a bin step which may be smaller than the
+# bin size.  If there are too few points the median is returned.
+# The input array must be sorted.
+
+real procedure ic_moder (a, n)
+
+real	a[n]			# Data array
+int	n			# Number of points
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+real	mode
+bool	fp_equalr()
+
+begin
+	if (n < NMIN)
+	    return (a[n/2])
+
+	# Compute the mode.  The array must be sorted.  Consider a
+	# range of values about the median point.  Use a bin size which
+	# is ZBIN of the range.  Step the bin limits in ZSTEP fraction of
+	# the bin size.
+
+	i = 1 + n * (1. - ZRANGE) / 2.
+	j = 1 + n * (1. + ZRANGE) / 2.
+	z1 = a[i]
+	z2 = a[j]
+	if (fp_equalr (z1, z2)) {
+	    mode = z1
+	    return (mode)
+	}
+
+	zstep = ZSTEP * (z2 - z1)
+	zbin = ZBIN * (z2 - z1)
+
+	z1 = z1 - zstep
+	k = i
+	nmax = 0
+	repeat {
+	    z1 = z1 + zstep
+	    z2 = z1 + zbin
+	    for (; i < j && a[i] < z1; i=i+1)
+		;
+	    for (; k < j && a[k] < z2; k=k+1)
+		;
+	    if (k - i > nmax) {
+	        nmax = k - i
+	        mode = a[(i+k)/2]
+	    }
+	} until (k >= j)
+
+	return (mode)
+end
+
+# IC_STAT -- Compute image statistics within specified section.
+# The image section is relative to a reference image which may be
+# different than the input image and may have an offset.  Only a
+# subsample of pixels is used.  Masked and thresholded pixels are
+# ignored.  Only the desired statistics are computed to increase
+# efficiency.
+
+procedure ic_statd (im, imref, section, offsets, image, nimages,
+	domode, domedian, domean, mode, median, mean)
+
+pointer	im			 # Data image
+pointer	imref			 # Reference image for image section
+char	section[ARB]		 # Image section
+int	offsets[nimages,ARB]	 # Image section offset from data to reference
+int	image			 # Image index (for mask I/O)
+int	nimages			 # Number of images in  offsets.
+bool	domode, domedian, domean # Statistics to compute
+real	mode, median, mean	 # Statistics
+
+int	i, j, ndim, n, nv
+real	a
+pointer	sp, v1, v2, dv, va, vb
+pointer	data, mask, dp, lp, mp, imgnld()
+
+double	asumd()
+double	ic_moded()
+
+include	"../icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (dv, IM_MAXDIM, TY_LONG)
+	call salloc (va, IM_MAXDIM, TY_LONG)
+	call salloc (vb, IM_MAXDIM, TY_LONG)
+
+	# Determine the image section parameters.  This must be in terms of
+	# the data image pixel coordinates though the section may be specified
+	# in terms of the reference image coordinates.  Limit the number of
+	# pixels in each dimension to a maximum.
+
+	ndim = IM_NDIM(im)
+	if (project)
+	    ndim = ndim - 1
+	call amovki (1, Memi[v1], IM_MAXDIM)
+	call amovki (1, Memi[va], IM_MAXDIM)
+	call amovki (1, Memi[dv], IM_MAXDIM)
+	call amovi (IM_LEN(imref,1), Memi[vb], ndim)
+	call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim)
+	if (im != imref)
+	    do i = 1, ndim {
+		Memi[va+i-1] = Memi[va+i-1] - offsets[image,i]
+		Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i]
+	    }
+
+	do j = 1, 10 {
+	    n = 1
+	    do i = 0, ndim-1 {
+		Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i]))
+		Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i]))
+		Memi[dv+i] = j
+		nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1)
+		Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i]
+		n = n * nv
+	    }
+	    if (n < NMAX)
+		break
+	}
+
+	call amovl (Memi[v1], Memi[va], IM_MAXDIM)
+	Memi[va] = 1
+	if (project)
+	   Memi[va+ndim] = image
+	call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+
+	# Accumulate the pixel values within the section.  Masked pixels and
+	# thresholded pixels are ignored.
+
+	call salloc (data, n, TY_DOUBLE)
+	dp = data
+	while (imgnld (im, lp, Memi[vb]) != EOF) {
+	    call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask)
+	    lp = lp + Memi[v1] - 1
+	    if (dflag == D_ALL) {
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			a = Memd[lp]
+			if (a >= lthresh && a <= hthresh) {
+			    Memd[dp] = a
+			    dp = dp + 1
+			}
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			Memd[dp] = Memd[lp]
+			dp = dp + 1
+			lp = lp + Memi[dv]
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		mp = mask + Memi[v1] - 1
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    a = Memd[lp]
+			    if (a >= lthresh && a <= hthresh) {
+				Memd[dp] = a
+				dp = dp + 1
+			    }
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    Memd[dp] = Memd[lp]
+			    dp = dp + 1
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		}
+	    }
+	    for (i=2; i<=ndim; i=i+1) {
+		Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1]
+		if (Memi[va+i-1] <= Memi[v2+i-1])
+		    break
+		Memi[va+i-1] = Memi[v1+i-1]
+	    }
+	    if (i > ndim)
+		break
+	    call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+	}
+
+	# Close mask until it is needed again.
+	call ic_mclose1 (image, nimages)
+
+	n = dp - data
+	if (n < 1) {
+	    call sfree (sp)
+	    call error (1, "Image section contains no pixels")
+	}
+
+	# Compute only statistics needed.
+	if (domode || domedian) {
+	    call asrtd (Memd[data], Memd[data], n)
+	    mode = ic_moded (Memd[data], n)
+	    median = Memd[data+n/2-1]
+	}
+	if (domean)
+	    mean = asumd (Memd[data], n) / n
+
+	call sfree (sp)
+end
+
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZRANGE	0.7	# Fraction of pixels about median to use
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+# IC_MODE -- Compute mode of an array.  The mode is found by binning
+# with a bin size based on the data range over a fraction of the
+# pixels about the median and a bin step which may be smaller than the
+# bin size.  If there are too few points the median is returned.
+# The input array must be sorted.
+
+double procedure ic_moded (a, n)
+
+double	a[n]			# Data array
+int	n			# Number of points
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+double	mode
+bool	fp_equalr()
+
+begin
+	if (n < NMIN)
+	    return (a[n/2])
+
+	# Compute the mode.  The array must be sorted.  Consider a
+	# range of values about the median point.  Use a bin size which
+	# is ZBIN of the range.  Step the bin limits in ZSTEP fraction of
+	# the bin size.
+
+	i = 1 + n * (1. - ZRANGE) / 2.
+	j = 1 + n * (1. + ZRANGE) / 2.
+	z1 = a[i]
+	z2 = a[j]
+	if (fp_equalr (z1, z2)) {
+	    mode = z1
+	    return (mode)
+	}
+
+	zstep = ZSTEP * (z2 - z1)
+	zbin = ZBIN * (z2 - z1)
+
+	z1 = z1 - zstep
+	k = i
+	nmax = 0
+	repeat {
+	    z1 = z1 + zstep
+	    z2 = z1 + zbin
+	    for (; i < j && a[i] < z1; i=i+1)
+		;
+	    for (; k < j && a[k] < z2; k=k+1)
+		;
+	    if (k - i > nmax) {
+	        nmax = k - i
+	        mode = a[(i+k)/2]
+	    }
+	} until (k >= j)
+
+	return (mode)
+end
+
diff --git a/noao/twodspec/longslit/lscombine/src/generic/mkpkg b/noao/twodspec/longslit/lscombine/src/generic/mkpkg
new file mode 100644
index 00000000..b05b48a6
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/mkpkg
@@ -0,0 +1,25 @@
+# Make IMCOMBINE.
+
+$checkout libpkg.a ../../../../
+$update   libpkg.a
+$checkin  libpkg.a ../../../../
+$exit
+
+libpkg.a:
+	icaclip.x	../icombine.com ../icombine.h
+	icaverage.x	../icombine.com ../icombine.h <imhdr.h>
+	iccclip.x	../icombine.com ../icombine.h
+	icgdata.x	../icombine.com ../icombine.h <imhdr.h> <mach.h>
+	icgrow.x	../icombine.com ../icombine.h <imhdr.h> <pmset.h>
+	icmedian.x	../icombine.com ../icombine.h
+	icmm.x		../icombine.com ../icombine.h
+	icomb.x		../icombine.com ../icombine.h <error.h> <imhdr.h>\
+			<imset.h> <mach.h> <pmset.h> <syserr.h>
+	icpclip.x	../icombine.com ../icombine.h
+	icsclip.x	../icombine.com ../icombine.h
+	icsigma.x	../icombine.com ../icombine.h <imhdr.h>
+	icsort.x	
+	icstat.x	../icombine.com ../icombine.h <imhdr.h>
+
+	xtimmap.x	../xtimmap.com <config.h> <error.h> <imhdr.h> <imset.h>
+	;
diff --git a/noao/twodspec/longslit/lscombine/src/generic/xtimmap.x b/noao/twodspec/longslit/lscombine/src/generic/xtimmap.x
new file mode 100644
index 00000000..9e86e44d
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/generic/xtimmap.x
@@ -0,0 +1,1080 @@
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<config.h>
+
+# The following is for compiling under V2.11.
+define	IM_BUFFRAC	IM_BUFSIZE
+include	<imset.h>
+
+# These routines maintain an arbitrary number of indexed "open" images which
+# must be READ_ONLY.  The calling program may use the returned pointer for
+# header accesses but must call xt_opix before I/O.  Subsequent calls to
+# xt_opix may invalidate the pointer.  The xt_imunmap call will free memory.
+
+define	MAX_OPENIM	(LAST_FD-16)		# Maximum images kept open
+define	MAX_OPENPIX	45			# Maximum pixel files kept open
+
+define	XT_SZIMNAME	299			# Size of IMNAME string
+define	XT_LEN		179			# Structure length
+define	XT_IMNAME	Memc[P2C($1)]		# Image name
+define	XT_ARG		Memi[$1+150]		# IMMAP header argument
+define	XT_IM		Memi[$1+151]		# IMIO pointer
+define	XT_HDR		Memi[$1+152]		# Copy of IMIO pointer
+define	XT_CLOSEFD	Memi[$1+153]		# Close FD?
+define	XT_FLAG		Memi[$1+154]		# Flag
+define	XT_BUFSIZE	Memi[$1+155]		# Buffer size
+define	XT_BUF		Memi[$1+156]		# Data buffer
+define	XT_BTYPE	Memi[$1+157]		# Data buffer type
+define	XT_VS		Memi[$1+157+$2]		# Start vector (10)
+define	XT_VE		Memi[$1+167+$2]		# End vector (10)
+
+# Options
+define	XT_MAPUNMAP	1	# Map and unmap images.
+
+# XT_IMMAP -- Map an image and save it as an indexed open image.
+# The returned pointer may be used for header access but not I/O.
+# The indexed image is closed by xt_imunmap.
+
+pointer procedure xt_immap (imname, acmode, hdr_arg, index)
+
+char	imname[ARB]		#I Image name
+int	acmode			#I Access mode
+int	hdr_arg			#I Header argument
+int	index			#I Save index
+pointer	im			#O Image pointer (returned)
+
+int	i, envgeti()
+pointer	xt, xt_opix()
+errchk	xt_opix
+
+int	first_time
+data	first_time /YES/
+
+include	"../xtimmap.com"
+
+begin
+	if (acmode != READ_ONLY)
+	    call error (1, "XT_IMMAP: Only READ_ONLY allowed")
+
+	# Initialize once per process.
+	if (first_time == YES) {
+	    iferr (option = envgeti ("imcombine_option"))
+		option = 1
+	    min_open = 1
+	    nopen = 0
+	    nopenpix = 0
+	    nalloc = MAX_OPENIM
+	    call calloc (ims, nalloc, TY_POINTER)
+	    first_time = NO
+	}
+
+	# Free image if needed.
+	call xt_imunmap (NULL, index)
+
+	# Allocate structure.
+	if (index > nalloc) {
+	    i = nalloc
+	    nalloc = index + MAX_OPENIM
+	    call realloc (ims, nalloc, TY_STRUCT)
+	    call amovki (NULL, Memi[ims+i], nalloc-i)
+	}
+	call calloc (xt, XT_LEN, TY_STRUCT)
+	Memi[ims+index-1] = xt
+
+	# Initialize.
+	call strcpy (imname, XT_IMNAME(xt), XT_SZIMNAME)
+	XT_ARG(xt) = hdr_arg
+	XT_IM(xt) = NULL
+	XT_HDR(xt) = NULL
+
+	# Open image.
+	last_flag = 0
+	im = xt_opix (NULL, index, 0)
+
+	# Make copy of IMIO pointer for header keyword access.
+	call malloc (XT_HDR(xt), LEN_IMDES+IM_HDRLEN(im)+1, TY_STRUCT)
+	call amovi (Memi[im], Memi[XT_HDR(xt)], LEN_IMDES)
+	call amovi (IM_MAGIC(im), IM_MAGIC(XT_HDR(xt)), IM_HDRLEN(im)+1)
+
+	return (XT_HDR(xt))
+end
+
+
+# XT_OPIX -- Open the image for I/O.
+# If the image has not been mapped return the default pointer.
+
+pointer	procedure xt_opix (imdef, index, flag)
+
+int	index			#I index
+pointer	imdef			#I Default pointer
+int	flag			#I Flag
+
+int	i, open(), imstati()
+pointer	im, xt, xt1, immap()
+errchk	open, immap, imunmap
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imdef)
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Return pointer for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (im)
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || flag == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			im = XT_IM(xt1)
+			if (im == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	if (!IS_INDEFI(XT_BUFSIZE(xt)))
+	    call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	else
+	    XT_BUFSIZE(xt) = imstati (im, IM_BUFSIZE)
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (im)
+end
+
+
+# XT_CPIX -- Close image.
+
+procedure xt_cpix (index)
+
+int	index			#I index
+
+pointer	xt
+errchk	imunmap
+
+include	"../xtimmap.com"
+
+begin
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	if (xt == NULL)
+	    return
+
+	if (XT_IM(xt) != NULL) {
+	    call imunmap (XT_IM(xt))
+	    nopen = nopen - 1
+	    if (XT_CLOSEFD(xt) == NO)
+		nopenpix = nopenpix - 1
+	}
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+end
+
+
+# XT_IMSETI -- Set IMIO value.
+
+procedure xt_imseti (index, param, value)
+
+int	index			#I index
+int	param			#I IMSET parameter
+int	value			#I Value
+
+pointer	xt
+bool	streq()
+
+include	"../xtimmap.com"
+
+begin
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	if (xt == NULL) {
+	    if (streq (param, "option"))
+		option = value
+	} else {
+	    if (streq (param, "bufsize")) {
+		XT_BUFSIZE(xt) = value
+		if (XT_IM(xt) != NULL) {
+		    call imseti (XT_IM(xt), IM_BUFFRAC, 0)
+		    call imseti (XT_IM(xt), IM_BUFSIZE, value)
+		}
+	    }
+	}
+end
+
+
+# XT_IMUNMAP -- Unmap indexed open image.
+# The header pointer is set to NULL to indicate the image has been closed.
+
+procedure xt_imunmap (im, index)
+
+int	im			#U IMIO header pointer
+int	index			#I index
+
+pointer	xt
+errchk	imunmap
+
+include	"../xtimmap.com"
+
+begin
+	# Check for an indexed image.  If it is not unmap the pointer
+	# as a regular IMIO pointer.
+
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+	if (xt == NULL) {
+	    if (im != NULL)
+		call imunmap (im)
+	    return
+	}
+
+	# Close indexed image.
+	if (XT_IM(xt) != NULL) {
+	    iferr (call imunmap (XT_IM(xt))) {
+		XT_IM(xt) = NULL
+		call erract (EA_WARN)
+	    }
+	    nopen = nopen - 1
+	    if (XT_CLOSEFD(xt) == NO)
+		nopenpix = nopenpix - 1
+	    if (index == min_open)
+		min_open = 1
+	}
+
+	# Free any buffered memory.
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+
+	# Free header pointer.  Note that if the supplied pointer is not
+	# header pointer then it is not set to NULL.
+	if (XT_HDR(xt) == im)
+	    im = NULL
+	call mfree (XT_HDR(xt), TY_STRUCT)
+
+	# Free save structure.
+	call mfree (Memi[ims+index-1], TY_STRUCT)
+	Memi[ims+index-1] = NULL
+end
+
+
+# XT_REINDEX -- Reindex open images.
+# This is used when some images are closed by xt_imunmap.  It is up to
+# the calling program to reindex the header pointers and to subsequently
+# use the new index values.
+
+procedure xt_reindex ()
+
+int	old, new
+
+include	"../xtimmap.com"
+
+begin
+	new = 0
+	do old = 0, nalloc-1 {
+	    if (Memi[ims+old] == NULL)
+		next
+	    Memi[ims+new] = Memi[ims+old]
+	    new = new + 1
+	}
+	do old = new, nalloc-1
+	    Memi[ims+old] = NULL
+end
+
+
+
+# XT_IMGNL -- Return the next line for the indexed image.
+# Possibly unmap another image if too many files are open.
+# Buffer data when an image is unmmaped to minimize the mapping of images.
+# If the requested index has not been mapped use the default pointer.
+
+int procedure xt_imgnls (imdef, index, buf, v, flag)
+
+pointer	imdef			#I Default pointer
+int	index			#I index
+pointer	buf			#O Data buffer
+long	v[ARB]			#I Line vector
+int	flag			#I Flag (=output line)
+
+int	i, j, nc, nl, open(), imgnls(), sizeof(), imloop()
+pointer	im, xt, xt1, ptr, immap(), imggss()
+errchk	open, immap, imgnls, imggss, imunmap
+
+long	unit_v[IM_MAXDIM]
+data	unit_v /IM_MAXDIM * 1/
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imgnls (imdef, buf, v))
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Use IMIO for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (imgnls (im, buf, v))
+	}
+
+	# If the image is not currently mapped use the stored header.
+	im = XT_HDR(xt)
+
+	# Check for EOF.
+	i = IM_NDIM(im)
+	if (v[i] > IM_LEN(im,i))
+	    return (EOF)
+
+	# Check for buffered data.
+	if (XT_BUF(xt) != NULL) {
+	    if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) {
+		if (XT_BTYPE(xt) != TY_SHORT)
+		    call error (1, "Cannot mix data types")
+		nc = IM_LEN(im,1)
+		buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1)
+		XT_FLAG(xt) = flag
+		if (i == 1)
+		    v[1] = nc + 1
+		else
+		    j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i)
+		return (nc)
+	    }
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || v[2] == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+
+		    # Buffer some number of lines.
+		    nl = XT_BUFSIZE(xt1) / sizeof (TY_SHORT) / IM_LEN(im,1)
+		    if (nl > 1) {
+			nc = IM_LEN(im,1)
+			call amovl (v, XT_VS(xt1,1), IM_MAXDIM)
+			call amovl (v, XT_VE(xt1,1), IM_MAXDIM)
+			XT_VS(xt1,1) = 1
+			XT_VE(xt1,1) = nc
+			XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2))
+			nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1
+			XT_BTYPE(xt1) = TY_SHORT
+			call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1))
+			ptr = imggss (im, XT_VS(xt1,1), XT_VE(xt1,1),
+			   IM_NDIM(im))
+			call amovs (Mems[ptr], Mems[XT_BUF(xt1)], nl*nc)
+		    }
+
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			if (XT_IM(xt1) == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (imgnls (im, buf, v))
+end
+
+# XT_IMGNL -- Return the next line for the indexed image.
+# Possibly unmap another image if too many files are open.
+# Buffer data when an image is unmmaped to minimize the mapping of images.
+# If the requested index has not been mapped use the default pointer.
+
+int procedure xt_imgnli (imdef, index, buf, v, flag)
+
+pointer	imdef			#I Default pointer
+int	index			#I index
+pointer	buf			#O Data buffer
+long	v[ARB]			#I Line vector
+int	flag			#I Flag (=output line)
+
+int	i, j, nc, nl, open(), imgnli(), sizeof(), imloop()
+pointer	im, xt, xt1, ptr, immap(), imggsi()
+errchk	open, immap, imgnli, imggsi, imunmap
+
+long	unit_v[IM_MAXDIM]
+data	unit_v /IM_MAXDIM * 1/
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imgnli (imdef, buf, v))
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Use IMIO for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (imgnli (im, buf, v))
+	}
+
+	# If the image is not currently mapped use the stored header.
+	im = XT_HDR(xt)
+
+	# Check for EOF.
+	i = IM_NDIM(im)
+	if (v[i] > IM_LEN(im,i))
+	    return (EOF)
+
+	# Check for buffered data.
+	if (XT_BUF(xt) != NULL) {
+	    if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) {
+		if (XT_BTYPE(xt) != TY_INT)
+		    call error (1, "Cannot mix data types")
+		nc = IM_LEN(im,1)
+		buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1)
+		XT_FLAG(xt) = flag
+		if (i == 1)
+		    v[1] = nc + 1
+		else
+		    j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i)
+		return (nc)
+	    }
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || v[2] == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+
+		    # Buffer some number of lines.
+		    nl = XT_BUFSIZE(xt1) / sizeof (TY_INT) / IM_LEN(im,1)
+		    if (nl > 1) {
+			nc = IM_LEN(im,1)
+			call amovl (v, XT_VS(xt1,1), IM_MAXDIM)
+			call amovl (v, XT_VE(xt1,1), IM_MAXDIM)
+			XT_VS(xt1,1) = 1
+			XT_VE(xt1,1) = nc
+			XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2))
+			nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1
+			XT_BTYPE(xt1) = TY_INT
+			call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1))
+			ptr = imggsi (im, XT_VS(xt1,1), XT_VE(xt1,1),
+			   IM_NDIM(im))
+			call amovi (Memi[ptr], Memi[XT_BUF(xt1)], nl*nc)
+		    }
+
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			if (XT_IM(xt1) == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (imgnli (im, buf, v))
+end
+
+# XT_IMGNL -- Return the next line for the indexed image.
+# Possibly unmap another image if too many files are open.
+# Buffer data when an image is unmmaped to minimize the mapping of images.
+# If the requested index has not been mapped use the default pointer.
+
+int procedure xt_imgnlr (imdef, index, buf, v, flag)
+
+pointer	imdef			#I Default pointer
+int	index			#I index
+pointer	buf			#O Data buffer
+long	v[ARB]			#I Line vector
+int	flag			#I Flag (=output line)
+
+int	i, j, nc, nl, open(), imgnlr(), sizeof(), imloop()
+pointer	im, xt, xt1, ptr, immap(), imggsr()
+errchk	open, immap, imgnlr, imggsr, imunmap
+
+long	unit_v[IM_MAXDIM]
+data	unit_v /IM_MAXDIM * 1/
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imgnlr (imdef, buf, v))
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Use IMIO for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (imgnlr (im, buf, v))
+	}
+
+	# If the image is not currently mapped use the stored header.
+	im = XT_HDR(xt)
+
+	# Check for EOF.
+	i = IM_NDIM(im)
+	if (v[i] > IM_LEN(im,i))
+	    return (EOF)
+
+	# Check for buffered data.
+	if (XT_BUF(xt) != NULL) {
+	    if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) {
+		if (XT_BTYPE(xt) != TY_REAL)
+		    call error (1, "Cannot mix data types")
+		nc = IM_LEN(im,1)
+		buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1)
+		XT_FLAG(xt) = flag
+		if (i == 1)
+		    v[1] = nc + 1
+		else
+		    j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i)
+		return (nc)
+	    }
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || v[2] == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+
+		    # Buffer some number of lines.
+		    nl = XT_BUFSIZE(xt1) / sizeof (TY_REAL) / IM_LEN(im,1)
+		    if (nl > 1) {
+			nc = IM_LEN(im,1)
+			call amovl (v, XT_VS(xt1,1), IM_MAXDIM)
+			call amovl (v, XT_VE(xt1,1), IM_MAXDIM)
+			XT_VS(xt1,1) = 1
+			XT_VE(xt1,1) = nc
+			XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2))
+			nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1
+			XT_BTYPE(xt1) = TY_REAL
+			call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1))
+			ptr = imggsr (im, XT_VS(xt1,1), XT_VE(xt1,1),
+			   IM_NDIM(im))
+			call amovr (Memr[ptr], Memr[XT_BUF(xt1)], nl*nc)
+		    }
+
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			if (XT_IM(xt1) == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (imgnlr (im, buf, v))
+end
+
+# XT_IMGNL -- Return the next line for the indexed image.
+# Possibly unmap another image if too many files are open.
+# Buffer data when an image is unmmaped to minimize the mapping of images.
+# If the requested index has not been mapped use the default pointer.
+
+int procedure xt_imgnld (imdef, index, buf, v, flag)
+
+pointer	imdef			#I Default pointer
+int	index			#I index
+pointer	buf			#O Data buffer
+long	v[ARB]			#I Line vector
+int	flag			#I Flag (=output line)
+
+int	i, j, nc, nl, open(), imgnld(), sizeof(), imloop()
+pointer	im, xt, xt1, ptr, immap(), imggsd()
+errchk	open, immap, imgnld, imggsd, imunmap
+
+long	unit_v[IM_MAXDIM]
+data	unit_v /IM_MAXDIM * 1/
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imgnld (imdef, buf, v))
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Use IMIO for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (imgnld (im, buf, v))
+	}
+
+	# If the image is not currently mapped use the stored header.
+	im = XT_HDR(xt)
+
+	# Check for EOF.
+	i = IM_NDIM(im)
+	if (v[i] > IM_LEN(im,i))
+	    return (EOF)
+
+	# Check for buffered data.
+	if (XT_BUF(xt) != NULL) {
+	    if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) {
+		if (XT_BTYPE(xt) != TY_DOUBLE)
+		    call error (1, "Cannot mix data types")
+		nc = IM_LEN(im,1)
+		buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1)
+		XT_FLAG(xt) = flag
+		if (i == 1)
+		    v[1] = nc + 1
+		else
+		    j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i)
+		return (nc)
+	    }
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || v[2] == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+
+		    # Buffer some number of lines.
+		    nl = XT_BUFSIZE(xt1) / sizeof (TY_DOUBLE) / IM_LEN(im,1)
+		    if (nl > 1) {
+			nc = IM_LEN(im,1)
+			call amovl (v, XT_VS(xt1,1), IM_MAXDIM)
+			call amovl (v, XT_VE(xt1,1), IM_MAXDIM)
+			XT_VS(xt1,1) = 1
+			XT_VE(xt1,1) = nc
+			XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2))
+			nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1
+			XT_BTYPE(xt1) = TY_DOUBLE
+			call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1))
+			ptr = imggsd (im, XT_VS(xt1,1), XT_VE(xt1,1),
+			   IM_NDIM(im))
+			call amovd (Memd[ptr], Memd[XT_BUF(xt1)], nl*nc)
+		    }
+
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			if (XT_IM(xt1) == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (imgnld (im, buf, v))
+end
+
diff --git a/noao/twodspec/longslit/lscombine/src/icaclip.gx b/noao/twodspec/longslit/lscombine/src/icaclip.gx
new file mode 100644
index 00000000..696402b2
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icaclip.gx
@@ -0,0 +1,575 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		3	# Minimum number of images for this algorithm
+
+$for (sird)
+# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_aavsigclip$t (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	average[npts]		# Average
+$else
+PIXEL	average[npts]		# Average
+$endif
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+$if (datatype == sil)
+real	d1, low, high, sum, a, s, s1, r, one
+data	one /1.0/
+$else
+PIXEL	d1, low, high, sum, a, s, s1, r, one
+data	one /1$f/
+$endif
+pointer	sp, sums, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (sums, npts, TY_REAL)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Since the unweighted average is computed here possibly skip combining
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Compute the unweighted average with the high and low rejected and
+	# the poisson scaled average sigma.  There must be at least three
+	# pixels at each point to define the average and contributions to
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	nin = n[1]
+	s = 0.
+	n2 = 0
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3)
+		next
+
+	    # Unweighted average with the high and low rejected
+	    low = Mem$t[d[1]+k]
+	    high = Mem$t[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Mem$t[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    dp1 = d[j] + k
+		    mp1 = m[j] + k
+
+		    d1 = Mem$t[dp1]
+		    l = Memi[mp1]
+		    s1 = max (one, (a + zeros[l]) /  scales[l])
+		    s = s + (d1 - a) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, a)
+		do j = 1, n1
+		    s = s + (Mem$t[d[j]+k] - a) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the average and sum for later.
+	    average[i] = a
+	    Memr[sums+k] = sum
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+
+	# Reject pixels and compute the final average (if needed).
+	# There must be at least three pixels at each point for rejection.
+	# Iteratively scale the mean sigma and reject pixels
+	# Compact the data and keep track of the image IDs if needed.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (2, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Mem$t[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Mem$t[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    a = average[i]
+	    sum = Memr[sums+k]
+
+	    repeat {
+		n2 = n1
+		if (s > 0.) {
+		    if (doscale1) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+
+			    d1 = Mem$t[dp1]
+			    l = Memi[mp1]
+			    s1 = s * sqrt (max (one, (a+zeros[l]) /  scales[l]))
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    mp2 = m[n1] + k
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			s1 = s * sqrt (max (one, a))
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Mem$t[dp1]
+			    r = (d1 - a) / s1
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs(r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mem$t[dp1]
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Mem$t[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mem$t[dp1]
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Mem$t[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median
+# The average sigma is normalized by the expected poisson sigma.
+
+procedure ic_mavsigclip$t (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+pointer	sp, resid, mp1, mp2
+$if (datatype == sil)
+real	med, low, high, r, s, s1, one
+data	one /1.0/
+$else
+PIXEL	med, low, high, r, s, s1, one
+data	one /1$f/
+$endif
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute the poisson scaled average sigma about the median.
+	# There must be at least three pixels at each point to define
+	# the mean sigma.  Corrections for differences in the image
+	# scale factors are selected by the doscale1 flag.
+
+	s = 0.
+	n2 = 0
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (n1 < 3) {
+		if (n1 == 0)
+		    median[i] = blank
+		else if (n1 == 1)
+		    median[i] = Mem$t[d[1]+k]
+		else {
+		    low = Mem$t[d[1]+k]
+		    high = Mem$t[d[2]+k]
+		    median[i] = (low + high) / 2.
+		}
+		next
+	    }
+
+	    # Median
+	    n3 = 1 + n1 / 2
+	    if (mod (n1, 2) == 0) {
+		low = Mem$t[d[n3-1]+k]
+		high = Mem$t[d[n3]+k]
+		med = (low + high) / 2.
+	    } else
+		med = Mem$t[d[n3]+k]
+
+	    # Poisson scaled sigma accumulation
+	    if (doscale1) {
+		do j = 1, n1 {
+		    l = Memi[m[j]+k]
+		    s1 = max (one, (med + zeros[l]) /  scales[l])
+		    s = s + (Mem$t[d[j]+k] - med) ** 2 / s1
+		}
+	    } else {
+		s1 = max (one, med)
+		do j = 1, n1
+		    s = s + (Mem$t[d[j]+k] - med) ** 2 / s1
+	    }
+	    n2 = n2 + n1
+
+	    # Save the median for later.
+	    median[i] = med
+	}
+
+	# Here is the final sigma.
+	if (n2 > 1)
+	    s = sqrt (s / (n2 - 1))
+	else {
+	    call sfree (sp)
+	    return
+	}
+
+	# Compute individual sigmas and iteratively clip.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 < max (3, maxkeep+1))
+		next
+	    nl = 1
+	    nh = n1
+	    med = median[i]
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (med - Mem$t[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s1 = s * sqrt (max (one, (med+zeros[l])/scales[l]))
+			    r = (Mem$t[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			s1 = s * sqrt (max (one, med))
+			for (; nl <= n2; nl = nl + 1) {
+			    r = (med - Mem$t[d[nl]+k]) / s1
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    r = (Mem$t[d[nh]+k] - med) / s1
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+
+		    # Recompute median
+		    if (n1 < n2) {
+			if (n1 > 0) {
+			    n3 = nl + n1 / 2
+			    if (mod (n1, 2) == 0) {
+				low = Mem$t[d[n3-1]+k]
+				high = Mem$t[d[n3]+k]
+				med = (low + high) / 2.
+			    } else
+				med = Mem$t[d[n3]+k]
+			} else
+			    med = blank
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many are rejected add some back in.
+	    # Pixels with equal residuals are added together.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+
+		# Recompute median
+		if (n1 < n2) {
+		    if (n1 > 0) {
+			n3 = nl + n1 / 2
+			if (mod (n1, 2) == 0) {
+			    low = Mem$t[d[n3-1]+k]
+			    high = Mem$t[d[n3]+k]
+			    med = (low + high) / 2.
+			} else
+			    med = Mem$t[d[n3]+k]
+		    } else
+			med = blank
+		}
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mem$t[d[l]+k] = Mem$t[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mem$t[d[l]+k] = Mem$t[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icaverage.gx b/noao/twodspec/longslit/lscombine/src/icaverage.gx
new file mode 100644
index 00000000..a95b7673
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icaverage.gx
@@ -0,0 +1,114 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+$for (sird)
+# IC_AVERAGE -- Compute the average (or summed) image line.
+# Options include a weighted average/sum.
+
+procedure ic_average$t (d, m, n, wts, npts, doblank, doaverage, average)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+int	doaverage		# Do average?
+$if (datatype == sil)
+real	average[npts]		# Average (returned)
+$else
+PIXEL	average[npts]		# Average (returned)
+$endif
+
+int	i, j, k
+real	sumwt, wt
+$if (datatype == sil)
+real	sum
+$else
+PIXEL	sum
+$endif
+
+include	"../icombine.com"
+
+begin
+	# If no data has been excluded do the average/sum without checking
+	# the number of points and using the fact that the weights are
+	# normalized.  If all the data has been excluded set the average/sum
+	# to the blank value if requested.
+
+	if (dflag == D_ALL) {
+	    if (dowts) {
+		do i = 1, npts {
+		    k = i - 1
+		    wt = wts[Memi[m[1]+k]]
+		    sum = Mem$t[d[1]+k] * wt
+		    do j = 2, n[i] {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + Mem$t[d[j]+k] * wt
+		    }
+		    average[i] = sum
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    sum = Mem$t[d[1]+k]
+		    do j = 2, n[i]
+			sum = sum + Mem$t[d[j]+k]
+		    if (doaverage == YES)
+			average[i] = sum / n[i]
+		    else
+			average[i] = sum
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    average[i] = blank
+	    }
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			wt = wts[Memi[m[1]+k]]
+			sum = Mem$t[d[1]+k] * wt
+			sumwt = wt
+			do j = 2, n[i] {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + Mem$t[d[j]+k] * wt
+			    sumwt = sumwt + wt
+			}
+			if (doaverage == YES) {
+			    if (sumwt > 0)
+				average[i] = sum / sumwt
+			    else {
+				sum = Mem$t[d[1]+k]
+				do j = 2, n[i]
+				    sum = sum + Mem$t[d[j]+k]
+				average[i] = sum / n[i]
+			    }
+			} else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    if (n[i] > 0) {
+			k = i - 1
+			sum = Mem$t[d[1]+k]
+			do j = 2, n[i]
+			    sum = sum + Mem$t[d[j]+k]
+			if (doaverage == YES)
+			    average[i] = sum / n[i]
+			else
+			    average[i] = sum
+		    } else if (doblank == YES)
+			average[i] = blank
+		}
+	    }
+	}
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/iccclip.gx b/noao/twodspec/longslit/lscombine/src/iccclip.gx
new file mode 100644
index 00000000..609b3448
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/iccclip.gx
@@ -0,0 +1,471 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		2	# Mininum number of images for algorithm
+
+$for (sird)
+# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average
+
+procedure ic_accdclip$t (d, m, n, scales, zeros, nm, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model parameters
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	average[npts]		# Average
+$else
+PIXEL	average[npts]		# Average
+$endif
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+$if (datatype == sil)
+real	d1, low, high, sum, a, s, r, zero
+data	zero /0.0/
+$else
+PIXEL	d1, low, high, sum, a, s, r, zero
+data	zero /0$f/
+$endif
+pointer	sp, resid, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are no pixels go on to the combining.  Since the unweighted
+	# average is computed here possibly skip the combining later.
+
+	# There must be at least max (1, nkeep) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} else if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# There must be at least two pixels for rejection.  The initial
+	# average is the low/high rejected average except in the case of
+	# just two pixels.  The rejections are iterated and the average
+	# is recomputed.  Corrections for scaling may be performed.
+	# Depending on other flags the image IDs may also need to be adjusted.
+
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    if (n1 <= max (MINCLIP-1, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Mem$t[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Mem$t[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    repeat {
+		if (n1 == 2) {
+		    sum = Mem$t[d[1]+k]
+		    sum = sum + Mem$t[d[2]+k]
+		    a = sum / 2
+		} else {
+		    low = Mem$t[d[1]+k]
+		    high = Mem$t[d[2]+k]
+		    if (low > high) {
+			d1 = low
+			low = high
+			high = d1
+		    }
+		    sum = 0.
+		    do j = 3, n1 {
+		       d1 = Mem$t[d[j]+k]
+		       if (d1 < low) {
+			   sum = sum + low
+			   low = d1
+			} else if (d1 > high) {
+			    sum = sum + high
+			    high = d1
+			} else
+			    sum = sum + d1
+		    }
+		    a = sum / (n1 - 2)
+		    sum = sum + low + high
+		}
+		n2 = n1
+		if (doscale1) {
+		    for (j=1; j<=n1; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+
+			l = Memi[mp1]
+			s = scales[l]
+			d1 = max (zero, s * (a + zeros[l]))
+			s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s
+
+			d1 = Mem$t[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Mem$t[dp1] = Mem$t[dp2]
+				Mem$t[dp2] = d1
+				mp2 = m[n1] + k
+				Memi[mp1] = Memi[mp2]
+				Memi[mp2] = l
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		} else {
+		    if (!keepids) {
+			s = max (zero, a)
+			s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+		    }
+		    for (j=1; j<=n1; j=j+1) {
+			if (keepids) {
+			    l = Memi[m[j]+k]
+			    s = max (zero, a)
+			    s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			}
+			dp1 = d[j] + k
+			d1 = Mem$t[dp1]
+			r = (d1 - a) / s
+			if (r < -lsigma || r > hsigma) {
+			    Memr[resid+n1] = abs(r)
+			    if (j < n1) {
+				dp2 = d[n1] + k
+				Mem$t[dp1] = Mem$t[dp2]
+				Mem$t[dp2] = d1
+				if (keepids) {
+				    mp1 = m[j] + k
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				}
+				j = j - 1
+			    }
+			    sum = sum - d1
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mem$t[dp1]
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Mem$t[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mem$t[dp1]
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Mem$t[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+	    }
+
+	    n[i] = n1
+	    if (!docombine)
+		if (n1 > 0)
+		    average[i] = sum / n1
+		else
+		    average[i] = blank
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median
+
+procedure ic_mccdclip$t (d, m, n, scales, zeros, nm, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	nm[3,nimages]		# Noise model
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, mp1, mp2
+$if (datatype == sil)
+real	med, zero
+data	zero /0.0/
+$else
+PIXEL	med, zero
+data	zero /0$f/
+$endif
+
+include	"../icombine.com"
+
+begin
+	# There must be at least max (MINCLIP, nkeep+1) pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0) {
+		    med = Mem$t[d[n3-1]+k]
+		    med = (med + Mem$t[d[n3]+k]) / 2.
+		} else
+		    med = Mem$t[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			for (; nl <= n2; nl = nl + 1) {
+			    l = Memi[m[nl]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (med - Mem$t[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    l = Memi[m[nh]+k]
+			    s = scales[l]
+			    r = max (zero, s * (med + zeros[l]))
+			    s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s
+			    r = (Mem$t[d[nh]+k] - med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    } else {
+			if (!keepids) {
+			    s = max (zero, med)
+			    s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2)
+			}
+			for (; nl <= n2; nl = nl + 1) {
+			    if (keepids) {
+				l = Memi[m[nl]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (med - Mem$t[d[nl]+k]) / s
+			    if (r <= lsigma)
+				break
+			    Memr[resid+nl] = r
+			    n1 = n1 - 1
+			}
+			for (; nh >= nl; nh = nh - 1) {
+			    if (keepids) {
+				l = Memi[m[nh]+k]
+				s = max (zero, med)
+				s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2)
+			    }
+			    r = (Mem$t[d[nh]+k] -  med) / s
+			    if (r <= hsigma)
+				break
+			    Memr[resid+nh] = r
+			    n1 = n1 - 1
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mem$t[d[l]+k] = Mem$t[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mem$t[d[l]+k] = Mem$t[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median is computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icemask.x b/noao/twodspec/longslit/lscombine/src/icemask.x
new file mode 100644
index 00000000..e60b8ab7
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icemask.x
@@ -0,0 +1,114 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<mach.h>
+
+
+# IC_EMASK --  Create exposure mask.
+
+procedure ic_emask (pm, v, id, nimages, n, wts, npts)
+
+pointer	pm			#I Pixel mask
+long	v[ARB]			#I Output vector
+pointer	id[nimages]		#I Image id pointers
+int	nimages			#I Number of images
+int	n[npts]			#I Number of good pixels
+real	wts[npts]		#I Weights
+int	npts			#I Number of output pixels per line
+
+int	i, j, k, impnli()
+real	exp
+pointer	buf
+
+pointer	exps			# Exposure times
+pointer	ev			# IMIO coordinate vector
+real	ezero			# Integer to real zero
+real	escale			# Integer to real scale
+int	einit			# Initialization flag
+common	/emask/ exps, ev, ezero, escale, einit
+
+begin
+	# Write scaling factors to the header.
+	if (einit == NO) {
+	    if (ezero != 0. || escale != 1.) {
+		call imaddr (pm, "MASKZERO", ezero)
+		call imaddr (pm, "MASKSCAL", escale)
+	    }
+	    einit = YES
+	}
+
+	call amovl (v, Meml[ev], IM_MAXDIM)
+	i = impnli (pm, buf, Meml[ev])
+	call aclri (Memi[buf], npts)
+	do i = 1, npts {
+	    exp = 0.
+	    do j = 1, n[i] {
+		k = Memi[id[j]+i-1]
+		if (wts[k] > 0.)
+		    exp = exp + Memr[exps+k-1]
+	    }
+	    Memi[buf] = nint((exp-ezero)/escale)
+	    buf = buf + 1
+	}
+end
+
+
+# IC_EINIT --  Initialize exposure mask.
+
+procedure ic_einit (in, nimages, key, default, maxval)
+
+int	in[nimages]		#I Image pointers
+int	nimages			#I Number of images
+char	key[ARB]		#I Exposure time keyword
+real	default			#I Default exposure time
+int	maxval			#I Maximum mask value
+
+int	i
+real	exp, emin, emax, efrac, imgetr()
+
+pointer	exps			# Exposure times
+pointer	ev			# IMIO coordinate vector
+real	ezero			# Integer to real zero
+real	escale			# Integer to real scale
+int	einit			# Initialization flag
+common	/emask/ exps, ev, ezero, escale, einit
+
+begin
+	call malloc (ev, IM_MAXDIM, TY_LONG)
+	call malloc (exps, nimages, TY_REAL)
+
+	emax = 0.
+	emin = MAX_REAL
+	efrac = 0
+	do i = 1, nimages {
+	    iferr (exp = imgetr (in[i], key))
+		exp = default
+	    exp = max (0., exp)
+	    emax = emax + exp
+	    if (exp > 0.)
+		emin = min (exp, emin)
+	    efrac = max (abs(exp-nint(exp)), efrac)
+	    Memr[exps+i-1] = exp
+	}
+
+	# Set scaling.
+	ezero = 0.
+	escale = 1.
+	if (emin < 1.) {
+	    escale = emin
+	    emin = emin / escale
+	    emax = emax / escale
+	} else if (emin == MAX_REAL)
+	    emin = 0.
+	if (efrac > 0.001 && emax-emin < 1000.) {
+	    escale = escale / 1000.
+	    emin = emin * 1000.
+	    emax = emax * 1000.
+	}
+	while (emax > maxval) {
+	    escale = escale * 10.
+	    emin = emin / 10.
+	    emax = emax / 10.
+	}
+	einit = NO
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icgdata.gx b/noao/twodspec/longslit/lscombine/src/icgdata.gx
new file mode 100644
index 00000000..27f51ec5
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icgdata.gx
@@ -0,0 +1,307 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<mach.h>
+include	"../icombine.h"
+
+$for (sird)
+# IC_GDATA -- Get line of image and mask data and apply threshold and scaling.
+# Entirely empty lines are excluded.  The data are compacted within the
+# input data buffers.  If it is required, the connection to the original
+# image index is kept in the returned m data pointers.
+
+procedure ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, scales,
+	zeros, nimages, npts, v1, v2)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+pointer	dbuf[nimages]		# Data buffers
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Empty mask flags
+int	offsets[nimages,ARB]	# Image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+int	nimages			# Number of input images
+int	npts			# NUmber of output points per line
+long	v1[ARB], v2[ARB]	# Line vectors
+
+int	i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnl$t()
+real	a, b
+pointer	buf, dp, ip, mp
+errchk	xt_cpix, xt_imgnl$t
+
+include	"../icombine.com"
+
+begin
+	# Get masks and return if there is no data
+	call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages)
+	if (dflag == D_NONE) {
+	    call aclri (n, npts)
+	    return
+	}
+
+	# Close images which are not needed.
+	nout = IM_LEN(out[1],1)
+	ndim = IM_NDIM(out[1])
+	if (!project) {
+	    do i = 1, nimages {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1)
+		    call xt_cpix (i)
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+	    }
+	}
+
+	# Get data and fill data buffers.  Correct for offsets if needed.
+	do i = 1, nimages {
+	    if (lflag[i] == D_NONE)
+		next
+	    if (dbuf[i] == NULL) {
+		call amovl (v1, v2, IM_MAXDIM)
+		if (project)
+		    v2[ndim+1] = i
+		j = xt_imgnl$t (in[i], i, d[i], v2, v1[2])
+	    } else {
+		nin = IM_LEN(in[i],1)
+		j = max (0, offsets[i,1])
+		k = min (nout, nin + offsets[i,1])
+		npix = k - j
+		if (npix < 1) {
+		    lflag[i] = D_NONE
+		    next
+		}
+		k = 1 + j - offsets[i,1]
+		v2[1] = k
+		do l = 2, ndim {
+		    v2[l] = v1[l] - offsets[i,l]
+		    if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) {
+			lflag[i] = D_NONE
+			break
+		    }
+		}
+		if (lflag[i] == D_NONE)
+		    next
+		if (project)
+		    v2[ndim+1] = i
+		l = xt_imgnl$t (in[i], i, buf, v2, v1[2])
+		call amov$t (Mem$t[buf+k-1], Mem$t[dbuf[i]+j], npix)
+		d[i] = dbuf[i]
+	    }
+	}
+
+	# Apply threshold if needed
+	if (dothresh) {
+	    do i = 1, nimages {
+		if (lflag[i] == D_ALL) {
+		    dp = d[i]
+		    do j = 1, npts {
+			a = Mem$t[dp]
+			if (a < lthresh || a > hthresh) {
+			    Memi[m[i]+j-1] = 1
+			    lflag[i] = D_MIX
+			    dflag = D_MIX
+			}
+			dp = dp + 1
+		    }
+
+		    # Check for completely empty lines
+		    if (lflag[i] == D_MIX) {
+			lflag[i] = D_NONE
+			mp = m[i]
+			do j = 1, npts {
+			    if (Memi[mp] == 0) {
+				lflag[i] = D_MIX
+				break
+			    }
+			    mp = mp + 1
+			}
+		    }
+		} else if (lflag[i] == D_MIX) {
+		    nin = IM_LEN(in[i],1)
+		    j = max (0, offsets[i,1])
+		    k = min (nout, nin + offsets[i,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    a = Mem$t[dp]
+			    if (a < lthresh || a > hthresh) {
+				Memi[m[i]+j-1] = 1
+				dflag = D_MIX
+			    }
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+
+		    # Check for completely empty lines
+		    lflag[i] = D_NONE
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    lflag[i] = D_MIX
+			    break
+			}
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Apply scaling (avoiding masked pixels which might overflow?)
+	if (doscale) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = d[i]
+		    a = scales[i]
+		    b = -zeros[i]
+		    do j = 1, npts {
+			Mem$t[dp] = Mem$t[dp] / a + b
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    a = scales[i]
+		    b = -zeros[i]
+		    if (lflag[i] == D_ALL) {
+			dp = d[i]
+			do j = 1, npts {
+			    Mem$t[dp] = Mem$t[dp] / a + b
+			    dp = dp + 1
+			}
+		    } else if (lflag[i] == D_MIX) {
+			nin = IM_LEN(in[i],1)
+			j = max (0, offsets[i,1])
+			k = min (nout, nin + offsets[i,1])
+			npix = k - j
+			n1 = 1 + j
+			n2 = n1 + npix - 1
+			dp = d[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0)
+				Mem$t[dp] = Mem$t[dp] / a + b
+			    dp = dp + 1
+			    mp = mp + 1
+			}
+		    }
+		}
+	    }
+	}
+
+	# Sort pointers to exclude unused images.
+	# Use the lflag array to keep track of the image index.
+
+	if (dflag == D_ALL)
+	    nused = nimages
+	else {
+	    nused = 0
+	    do i = 1, nimages
+		if (lflag[i] != D_NONE) {
+		    nused = nused + 1
+		    d[nused] = d[i]
+		    m[nused] = m[i]
+		    lflag[nused] = i
+		}
+	    if (nused == 0)
+		dflag = D_NONE
+	}
+
+	# Compact data to remove bad pixels
+	# Keep track of the image indices if needed
+	# If growing mark the end of the included image indices with zero
+
+	if (dflag == D_ALL) {
+	    call amovki (nused, n, npts)
+	    if (keepids)
+		do i = 1, nimages
+		    call amovki (i, Memi[id[i]], npts)
+	} else if (dflag == D_NONE)
+	    call aclri (n, npts)
+	else {
+	    call aclri (n, npts)
+	    if (keepids) {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    ip = id[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i) {
+				Mem$t[d[k]+j-1] = Mem$t[dp]
+				Memi[id[k]+j-1] = l
+			    } else
+				Memi[ip] = l
+			}
+			dp = dp + 1
+			ip = ip + 1
+			mp = mp + 1
+		    }
+		}
+		if (grow >= 1.) {
+		    do j = 1, npts {
+			do i = n[j]+1, nimages
+			    Memi[id[i]+j-1] = 0
+		    }
+		}
+	    } else {
+		do i = 1, nused {
+		    l = lflag[i]
+		    nin = IM_LEN(in[l],1)
+		    j = max (0, offsets[l,1])
+		    k = min (nout, nin + offsets[l,1])
+		    npix = k - j
+		    n1 = 1 + j
+		    n2 = n1 + npix - 1
+		    dp = d[i] + n1 - 1
+		    mp = m[i] + n1 - 1
+		    do j = n1, n2 {
+			if (Memi[mp] == 0) {
+			    n[j] = n[j] + 1
+			    k = n[j]
+			    if (k < i)
+				Mem$t[d[k]+j-1] = Mem$t[dp]
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+		}
+	    }
+	}
+
+	# Sort the pixels and IDs if needed
+	if (mclip) {
+	    call malloc (dp, nimages, TY_PIXEL)
+	    if (keepids) {
+		call malloc (ip, nimages, TY_INT)
+		call ic_2sort$t (d, Mem$t[dp], id, Memi[ip], n, npts)
+		call mfree (ip, TY_INT)
+	    } else
+		call ic_sort$t (d, Mem$t[dp], n, npts)
+	    call mfree (dp, TY_PIXEL)
+	}
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icgrow.gx b/noao/twodspec/longslit/lscombine/src/icgrow.gx
new file mode 100644
index 00000000..caf7dd29
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icgrow.gx
@@ -0,0 +1,135 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	"../icombine.h"
+
+# IC_GROW --  Mark neigbors of rejected pixels.
+# The rejected pixels (original plus grown) are saved in pixel masks.
+
+procedure ic_grow (out, v, m, n, buf, nimages, npts, pms)
+
+pointer	out			# Output image pointer
+long	v[ARB]			# Output vector
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[npts,nimages]	# Working buffer
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k, l, line, nl, rop, igrow, nset, ncompress, or()
+real	grow2, i2
+pointer	mp, pm, pm_newmask()
+errchk	pm_newmask()
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE || grow == 0.)
+	    return
+
+	line = v[2]
+	nl = IM_LEN(out,2)
+	rop = or (PIX_SRC, PIX_DST)
+
+	igrow = grow
+	grow2 = grow**2
+	do l = 0, igrow {
+	    i2 = grow2 - l * l
+	    call aclri (buf, npts*nimages)
+	    nset = 0
+	    do j = 1, npts {
+		do k = n[j]+1, nimages {
+		    mp = Memi[m[k]+j-1]
+		    if (mp == 0)
+			next
+		    do i = 0, igrow {
+			if (i**2 > i2)
+			    next
+			if (j > i)
+			    buf[j-i,mp] = 1
+			if (j+i <= npts)
+			    buf[j+i,mp] = 1
+			nset = nset + 1
+		    }
+		}
+	    }
+	    if (nset == 0)
+		return
+
+	    if (pms == NULL) {
+		call malloc (pms, nimages, TY_POINTER)
+		do i = 1, nimages
+		    Memi[pms+i-1] = pm_newmask (out, 1)
+		ncompress = 0
+	    }
+	    do i = 1, nimages {
+		pm = Memi[pms+i-1]
+		v[2] = line - l
+		if (v[2] > 0)
+		    call pmplpi (pm, v, buf[1,i], 1, npts, rop)
+		if (l > 0) {
+		    v[2] = line + l
+		    if (v[2] <= nl)
+			call pmplpi (pm, v, buf[1,i], 1, npts, rop)
+		}
+	    }
+	}
+	v[2] = line
+
+	if (ncompress > 10) {
+	    do i = 1, nimages {
+		pm = Memi[pms+i-1]
+		call pm_compress (pm)
+	    }
+	    ncompress = 0
+	} else
+	    ncompress = ncompress + 1
+end
+
+
+$for (sird)
+# IC_GROW$T --  Reject pixels.
+
+procedure ic_grow$t (v, d, m, n, buf, nimages, npts, pms)
+
+long	v[ARB]			# Output vector
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[ARB]			# Number of good pixels
+int	buf[ARB]		# Buffer of npts
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+pointer	pms			# Pointer to array of pixel masks
+
+int	i, j, k
+pointer	pm
+bool	pl_linenotempty()
+
+include	"../icombine.com"
+
+begin
+	do k = 1, nimages {
+	    pm = Memi[pms+k-1]
+	    if (!pl_linenotempty (pm, v))
+		next
+	    call pmglpi (pm, v, buf, 1, npts, PIX_SRC)
+	    do i = 1, npts {
+		if (buf[i] == 0)
+		    next
+		for (j = 1; j <= n[i]; j = j + 1) {
+		    if (Memi[m[j]+i-1] == k) {
+			if (j < n[i]) {
+			    Mem$t[d[j]+i-1] = Mem$t[d[n[i]]+i-1]
+			    Memi[m[j]+i-1] = Memi[m[n[i]]+i-1]
+			}
+			n[i] = n[i] - 1
+			dflag = D_MIX
+			break
+		    }
+		}
+	    }
+	}
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icgscale.x b/noao/twodspec/longslit/lscombine/src/icgscale.x
new file mode 100644
index 00000000..570697ad
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icgscale.x
@@ -0,0 +1,88 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icombine.h"
+
+
+# IC_GSCALE -- Get scale values as directed by CL parameter.
+# Only those values which are INDEF are changed.
+# The values can be one of those in the dictionary, from a file specified
+# with a @ prefix, or from an image header keyword specified by a ! prefix.
+
+int procedure ic_gscale (param, name, dic, in, exptime, values, nimages)
+
+char	param[ARB]		#I CL parameter name
+char	name[SZ_FNAME]		#O Parameter value
+char	dic[ARB]		#I Dictionary string
+pointer	in[nimages]		#I IMIO pointers
+real	exptime[nimages]	#I Exposure times
+real	values[nimages]		#O Values
+int	nimages			#I Number of images
+
+int	type			#O Type of value
+
+int	fd, i, nowhite(), open(), fscan(), nscan(), strdic()
+real	rval, imgetr()
+pointer	errstr
+errchk	open, imgetr
+
+include	"icombine.com"
+
+begin
+	call clgstr (param, name, SZ_FNAME)
+	if (nowhite (name, name, SZ_FNAME) == 0)
+	    type = S_NONE
+	else if (name[1] == '@') {
+	    type = S_FILE
+	    do i = 1, nimages
+		if (IS_INDEFR(values[i]))
+		    break
+	    if (i <= nimages) {
+		fd = open (name[2], READ_ONLY, TEXT_FILE)
+		i = 0
+		while (fscan (fd) != EOF) {
+		    call gargr (rval)
+		    if (nscan() != 1)
+			next
+		    if (i == nimages) {
+		       call eprintf (
+			   "Warning: Ignoring additional %s values in %s\n")
+			   call pargstr (param)
+			   call pargstr (name[2])
+		       break
+		    }
+		    i = i + 1
+		    if (IS_INDEFR(values[i]))
+			values[i] = rval
+		}
+		call close (fd)
+		if (i < nimages) {
+		    call salloc (errstr, SZ_LINE, TY_CHAR)
+		    call sprintf (errstr, SZ_FNAME,
+			"Insufficient %s values in %s")
+			call pargstr (param)
+			call pargstr (name[2])
+		    call error (1, errstr)
+		}
+	    }
+	} else if (name[1] == '!') {
+	    type = S_KEYWORD
+	    do i = 1, nimages {
+		if (IS_INDEFR(values[i]))
+		    values[i] = imgetr (in[i], name[2])
+		if (project) {
+		    call amovkr (values, values, nimages)
+		    break
+		}
+	    }
+	} else {
+	    type = strdic (name, name, SZ_FNAME, dic)
+	    if (type == 0)
+		call error (1, "Unknown scale, zero, or weight type")
+	    if (type==S_EXPOSURE)
+		do i = 1, nimages
+		    if (IS_INDEFR(values[i]))
+			values[i] = max (0.001, exptime[i])
+	}
+
+	return (type)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/ichdr.x b/noao/twodspec/longslit/lscombine/src/ichdr.x
new file mode 100644
index 00000000..2d19c5bd
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/ichdr.x
@@ -0,0 +1,55 @@
+include	<imset.h>
+
+
+# IC_HDR -- Set output header.
+
+procedure ic_hdr (in, out, nimages)
+
+pointer	in[nimages]		#I Input images
+pointer	out[ARB]		#I Output images
+int	nimages			#I Number of images
+
+int	i, imgnfn()
+pointer	sp, key, str, list, imofnlu()
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	# Set new PROCID.
+	call xt_procid (out)
+
+	# Set input PROCIDs.
+	if (nimages < 100) {
+	    list = imofnlu (out, "PROCID[0-9][0-9]")
+	    while (imgnfn (list, Memc[key], SZ_LINE) != EOF)
+		call imdelf (out, Memc[key])
+	    call imcfnl (list)
+	    do i = 1, nimages {
+		call sprintf (Memc[key], 8, "PROCID%02d")
+		    call pargi (i)
+		iferr (call imgstr (in[i], "PROCID", Memc[str], SZ_LINE)) {
+		    iferr (call imgstr (in[i], "OBSID", Memc[str], SZ_LINE))
+			Memc[str] = EOS
+		}
+		if (Memc[str] != EOS)
+		    call imastr (out, Memc[key], Memc[str])
+	    }
+
+	    # Set input image names.
+	    list = imofnlu (out, "IMCMB[0-9][0-9][0-9]")
+	    while (imgnfn (list, Memc[key], SZ_LINE) != EOF)
+		call imdelf (out, Memc[key])
+	    call imcfnl (list)
+	    do i = 1, nimages {
+		iferr (call imgstr (in[i], "ICFNAME", Memc[str], SZ_LINE))
+		    call imstats (in[i], IM_IMAGENAME, Memc[str], SZ_LINE)
+		call sprintf (Memc[key], SZ_LINE, "IMCMB%03d")
+		    call pargi (i)
+		call imastr (out, Memc[key], Memc[str])
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icimstack.x b/noao/twodspec/longslit/lscombine/src/icimstack.x
new file mode 100644
index 00000000..d5628694
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icimstack.x
@@ -0,0 +1,186 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+
+
+# IC_IMSTACK -- Stack images into a single image of higher dimension.
+
+procedure ic_imstack (list, output, mask)
+
+int	list		#I List of images
+char	output[ARB]	#I Name of output image
+char	mask[ARB]	#I Name of output mask
+
+int	i, j, npix
+long	line_in[IM_MAXDIM], line_out[IM_MAXDIM], line_outbpm[IM_MAXDIM]
+pointer	sp, input, bpmname, key, in, out, inbpm, outbpm, buf_in, buf_out, ptr
+
+int	imtgetim(), imtlen(), errget()
+int	imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx()
+int	impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx()
+pointer	immap(), pm_newmask()
+errchk	immap
+errchk	imgnls, imgnli, imgnll, imgnlr, imgnld, imgnlx
+errchk	impnls, impnli, impnll, impnlr, impnld, impnlx
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (bpmname, SZ_FNAME, TY_CHAR)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	iferr {
+	    # Add each input image to the output image.
+	    out = NULL; outbpm = NULL
+	    i = 0
+	    while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) {
+
+		i = i + 1
+		in = NULL; inbpm = NULL
+		ptr = immap (Memc[input], READ_ONLY, 0)
+		in = ptr
+
+		# For the first input image map the output image as a copy
+		# and increment the dimension.  Set the output line counter.
+
+		if (i == 1) {
+		    ptr = immap (output, NEW_COPY, in)
+		    out = ptr
+		    IM_NDIM(out) = IM_NDIM(out) + 1
+		    IM_LEN(out, IM_NDIM(out)) = imtlen (list)
+		    npix = IM_LEN(out, 1)
+		    call amovkl (long(1), line_out, IM_MAXDIM)
+
+		    if (mask[1] != EOS) {
+			ptr = immap (mask, NEW_COPY, in)
+			outbpm = ptr
+			IM_NDIM(outbpm) = IM_NDIM(outbpm) + 1
+			IM_LEN(outbpm, IM_NDIM(outbpm)) = imtlen (list)
+			call amovkl (long(1), line_outbpm, IM_MAXDIM)
+		    }
+		}
+
+		# Check next input image for consistency with the output image.
+		if (IM_NDIM(in) != IM_NDIM(out) - 1)
+		    call error (0, "Input images not consistent")
+		do j = 1, IM_NDIM(in) {
+		    if (IM_LEN(in, j) != IM_LEN(out, j))
+			call error (0, "Input images not consistent")
+		}
+
+		call sprintf (Memc[key], SZ_FNAME, "stck%04d")
+		    call pargi (i)
+		call imastr (out, Memc[key], Memc[input])
+
+		# Copy the input lines from the image to the next lines of
+		# the output image.  Switch on the output data type to optimize
+		# IMIO.
+
+		call amovkl (long(1), line_in, IM_MAXDIM)
+		switch (IM_PIXTYPE (out)) {
+		case TY_SHORT:
+		    while (imgnls (in, buf_in, line_in) != EOF) {
+			if (impnls (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovs (Mems[buf_in], Mems[buf_out], npix)
+		    }
+		case TY_INT:
+		    while (imgnli (in, buf_in, line_in) != EOF) {
+			if (impnli (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovi (Memi[buf_in], Memi[buf_out], npix)
+		    }
+		case TY_USHORT, TY_LONG:
+		    while (imgnll (in, buf_in, line_in) != EOF) {
+			if (impnll (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovl (Meml[buf_in], Meml[buf_out], npix)
+		    }
+		case TY_REAL:
+		    while (imgnlr (in, buf_in, line_in) != EOF) {
+			if (impnlr (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovr (Memr[buf_in], Memr[buf_out], npix)
+		    }
+		case TY_DOUBLE:
+		    while (imgnld (in, buf_in, line_in) != EOF) {
+			if (impnld (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovd (Memd[buf_in], Memd[buf_out], npix)
+		    }
+		case TY_COMPLEX:
+		    while (imgnlx (in, buf_in, line_in) != EOF) {
+			if (impnlx (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovx (Memx[buf_in], Memx[buf_out], npix)
+		    }
+		default:
+		    while (imgnlr (in, buf_in, line_in) != EOF) {
+			if (impnlr (out, buf_out, line_out) == EOF)
+			    call error (0, "Error writing output image")
+			call amovr (Memr[buf_in], Memr[buf_out], npix)
+		    }
+		}
+
+		# Copy mask.
+		if (mask[1] != EOS) {
+		    iferr (call imgstr (in, "bpm", Memc[bpmname], SZ_FNAME)) {
+			Memc[bpmname] = EOS
+			ptr = pm_newmask (in, 27)
+		    } else
+			ptr = immap (Memc[bpmname], READ_ONLY, 0)
+		    inbpm = ptr
+
+		    if (IM_NDIM(inbpm) != IM_NDIM(outbpm) - 1)
+			call error (0, "Input images not consistent")
+		    do j = 1, IM_NDIM(inbpm) {
+			if (IM_LEN(inbpm, j) != IM_LEN(outbpm, j))
+			    call error (0, "Masks not consistent")
+		    }
+
+		    call amovkl (long(1), line_in, IM_MAXDIM)
+		    while (imgnli (inbpm, buf_in, line_in) != EOF) {
+			if (impnli (outbpm, buf_out, line_outbpm) == EOF)
+			    call error (0, "Error writing output mask")
+			call amovi (Memi[buf_in], Memi[buf_out], npix)
+		    }
+
+		    call sprintf (Memc[key], SZ_FNAME, "bpm%04d")
+			call pargi (i)
+		    call imastr (out, Memc[key], Memc[bpmname])
+
+		    call imunmap (inbpm)
+		}
+
+		call imunmap (in)
+	    }
+	} then {
+	    i = errget (Memc[key], SZ_FNAME)
+	    call erract (EA_WARN)
+	    if (outbpm != NULL) {
+		call imunmap (outbpm)
+		iferr (call imdelete (mask))
+		    ;
+	    }
+	    if (out != NULL) {
+		call imunmap (out)
+		iferr (call imdelete (output))
+		    ;
+	    }
+	    if (inbpm != NULL)
+		call imunmap (inbpm)
+	    if (in != NULL)
+		call imunmap (in)
+	    call sfree (sp)
+	    call error (i, "Can't make temporary stack images")
+	}
+
+	# Finish up.
+	if (outbpm != NULL) {
+	    call imunmap (outbpm)
+	    call imastr (out, "bpm", mask)
+	}
+	call imunmap (out)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/iclog.x b/noao/twodspec/longslit/lscombine/src/iclog.x
new file mode 100644
index 00000000..43ab37ab
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/iclog.x
@@ -0,0 +1,422 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<mach.h>
+include	"icombine.h"
+include	"icmask.h"
+
+# IC_LOG -- Output log information is a log file has been specfied.
+
+procedure ic_log (in, out, ncombine, exptime, sname, zname, wname,
+	mode, median, mean, scales, zeros, wts, offsets, nimages,
+	dozero, nout)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+int	ncombine[nimages]	# Number of previous combined images
+real	exptime[nimages]	# Exposure times
+char	sname[ARB]		# Scale name
+char	zname[ARB]		# Zero name
+char	wname[ARB]		# Weight name
+real	mode[nimages]		# Modes
+real	median[nimages]		# Medians
+real	mean[nimages]		# Means
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero or sky levels
+real	wts[nimages]		# Weights
+int	offsets[nimages,ARB]	# Image offsets
+int	nimages			# Number of images
+bool	dozero			# Zero flag
+int	nout			# Number of images combined in output
+
+int	i, j, stack, ctor()
+real	rval, imgetr()
+long	clktime()
+bool	prncombine, prexptime, prmode, prmedian, prmean, prmask
+bool	prrdn, prgain, prsn
+pointer	sp, fname, bpname, key
+errchk	imgetr
+
+include	"icombine.com"
+
+begin
+	if (logfd == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (fname, SZ_LINE, TY_CHAR)
+	call salloc (bpname, SZ_LINE, TY_CHAR)
+
+	stack = NO
+	if (project) {
+	    ifnoerr (call imgstr (in[1], "stck0001", Memc[fname], SZ_LINE))
+	        stack = YES
+	}
+	if (stack == YES)
+	    call salloc (key, SZ_FNAME, TY_CHAR)
+
+	# Time stamp the log and print parameter information.
+
+	call cnvdate (clktime(0), Memc[fname], SZ_LINE)
+	call fprintf (logfd, "\n%s: %s\n")
+	    call pargstr (Memc[fname])
+	    if (ictask != NULL)
+		call pargstr (Memc[ictask])
+	    else
+	        call pargstr ("IMCOMBINE")
+	switch (combine) {
+	case  AVERAGE:
+	    call fprintf (logfd, "  combine = average, ")
+	case  MEDIAN:
+	    call fprintf (logfd, "  combine = median, ")
+	case  SUM:
+	    call fprintf (logfd, "  combine = sum, ")
+	}
+	call fprintf (logfd, "scale = %s, zero = %s, weight = %s\n")
+	    call pargstr (sname)
+	    call pargstr (zname)
+	    call pargstr (wname)
+
+	switch (reject) {
+	case MINMAX:
+	    call fprintf (logfd, "  reject = minmax, nlow = %d, nhigh = %d\n")
+		call pargi (nint (flow * nimages))
+		call pargi (nint (fhigh * nimages))
+	case CCDCLIP:
+	    call fprintf (logfd, "  reject = ccdclip, mclip = %b, nkeep = %d\n")
+		call pargb (mclip)
+		call pargi (nkeep)
+	    call fprintf (logfd,
+	    "  rdnoise = %s, gain = %s, snoise = %s, sigma = %g, hsigma = %g\n")
+		call pargstr (Memc[rdnoise])
+		call pargstr (Memc[gain])
+		call pargstr (Memc[snoise])
+		call pargr (lsigma)
+		call pargr (hsigma)
+	case CRREJECT:
+	    call fprintf (logfd,
+		"  reject = crreject, mclip = %b, nkeep = %d\n")
+		call pargb (mclip)
+		call pargi (nkeep)
+	    call fprintf (logfd,
+		"  rdnoise = %s, gain = %s, snoise = %s, hsigma = %g\n")
+		call pargstr (Memc[rdnoise])
+		call pargstr (Memc[gain])
+		call pargstr (Memc[snoise])
+		call pargr (hsigma)
+	case PCLIP:
+	    call fprintf (logfd, "  reject = pclip, nkeep = %d\n")
+		call pargi (nkeep)
+	    call fprintf (logfd, "  pclip = %g, lsigma = %g, hsigma = %g\n")
+		call pargr (pclip)
+		call pargr (lsigma)
+		call pargr (hsigma)
+	case SIGCLIP:
+	    call fprintf (logfd, "  reject = sigclip, mclip = %b, nkeep = %d\n")
+		call pargb (mclip)
+		call pargi (nkeep)
+	    call fprintf (logfd, "  lsigma = %g, hsigma = %g\n")
+		call pargr (lsigma)
+		call pargr (hsigma)
+	case AVSIGCLIP:
+	    call fprintf (logfd,
+		"  reject = avsigclip, mclip = %b, nkeep = %d\n")
+		call pargb (mclip)
+		call pargi (nkeep)
+	    call fprintf (logfd, "  lsigma = %g, hsigma = %g\n")
+		call pargr (lsigma)
+		call pargr (hsigma)
+	}
+	if (reject != NONE && grow >= 1.) {
+	    call fprintf (logfd, "  grow = %g\n")
+		call pargr (grow)
+	}
+	if (dothresh) {
+	    if (lthresh > -MAX_REAL && hthresh < MAX_REAL) {
+		call fprintf (logfd, "  lthreshold = %g, hthreshold = %g\n")
+		    call pargr (lthresh)
+		    call pargr (hthresh)
+	    } else if (lthresh > -MAX_REAL) {
+		call fprintf (logfd, "  lthreshold = %g\n")
+		    call pargr (lthresh)
+	    } else {
+		call fprintf (logfd, "  hthreshold = %g\n")
+		    call pargr (hthresh)
+	    }
+	}
+	call fprintf (logfd, "  blank = %g\n")
+	    call pargr (blank)
+	if (Memc[statsec] != EOS) {
+	    call fprintf (logfd, "  statsec = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	if (ICM_TYPE(icm) != M_NONE) {
+	    switch (ICM_TYPE(icm)) {
+	    case M_BOOLEAN, M_GOODVAL:
+		call fprintf (logfd, "  masktype = goodval, maskval = %d\n")
+		    call pargi (ICM_VALUE(icm))
+	    case M_BADVAL:
+		call fprintf (logfd, "  masktype = badval, maskval = %d\n")
+		    call pargi (ICM_VALUE(icm))
+	    case M_GOODBITS:
+		call fprintf (logfd, "  masktype = goodbits, maskval = %d\n")
+		    call pargi (ICM_VALUE(icm))
+	    case M_BADBITS:
+		call fprintf (logfd, "  masktype = badbits, maskval = %d\n")
+		    call pargi (ICM_VALUE(icm))
+	    }
+	}
+
+	# Print information pertaining to individual images as a set of
+	# columns with the image name being the first column.  Determine
+	# what information is relevant and print the appropriate header.
+
+	prncombine = false
+	prexptime = false
+	prmode = false
+	prmedian = false
+	prmean = false
+	prmask = false
+	prrdn = false
+	prgain = false
+	prsn = false
+	do i = 1, nimages {
+	    if (ncombine[i] != ncombine[1])
+		prncombine = true
+	    if (exptime[i] != exptime[1])
+		prexptime = true
+	    if (mode[i] != mode[1])
+		prmode = true
+	    if (median[i] != median[1])
+		prmedian = true
+	    if (mean[i] != mean[1])
+		prmean = true
+	    if (ICM_TYPE(icm) != M_NONE) {
+		if (project)
+		    bpname = Memi[ICM_LOGNAMES(icm)]
+		else
+		    bpname = Memi[ICM_LOGNAMES(icm)+i-1]
+		if (Memc[bpname] != EOS)
+		    prmask = true
+	    }
+	    if (reject == CCDCLIP || reject == CRREJECT) {
+		j = 1
+		if (ctor (Memc[rdnoise], j, rval) == 0)
+		    prrdn = true
+		j = 1
+		if (ctor (Memc[gain], j, rval) == 0)
+		    prgain = true
+		j = 1
+		if (ctor (Memc[snoise], j, rval) == 0)
+		    prsn = true
+	    }
+	}
+
+	call fprintf (logfd, "  %20s ")
+	    call pargstr ("Images")
+	if (prncombine) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("N")
+	}
+	if (prexptime) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Exp")
+	}
+	if (prmode) {
+	    call fprintf (logfd, " %7s")
+		call pargstr ("Mode")
+	}
+	if (prmedian) {
+	    call fprintf (logfd, " %7s")
+		call pargstr ("Median")
+	}
+	if (prmean) {
+	    call fprintf (logfd, " %7s")
+		call pargstr ("Mean")
+	}
+	if (prrdn) {
+	    call fprintf (logfd, " %7s")
+		call pargstr ("Rdnoise")
+	}
+	if (prgain) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Gain")
+	}
+	if (prsn) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Snoise")
+	}
+	if (doscale) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Scale")
+	}
+	if (dozero) {
+	    call fprintf (logfd, " %7s")
+		call pargstr ("Zero")
+	}
+	if (dowts) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Weight")
+	}
+	if (!aligned) {
+	    call fprintf (logfd, " %9s")
+		call pargstr ("Offsets")
+	}
+	if (prmask) {
+	    call fprintf (logfd, " %s")
+		call pargstr ("Maskfile")
+	}
+	call fprintf (logfd, "\n")
+
+	do i = 1, nimages {
+	    if (stack == YES) {
+		call sprintf (Memc[key], SZ_FNAME, "stck%04d")
+		    call pargi (i)
+		ifnoerr (call imgstr (in[i], Memc[key], Memc[fname], SZ_LINE)) {
+		    call fprintf (logfd, "  %21s")
+			call pargstr (Memc[fname])
+		} else {
+		    call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE)
+		    call fprintf (logfd, "  %16s[%3d]")
+			call pargstr (Memc[fname])
+			call pargi (i)
+		}
+	    } else if (project) {
+		call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE)
+		call fprintf (logfd, "  %16s[%3d]")
+		    call pargstr (Memc[fname])
+		    call pargi (i)
+	    } else ifnoerr (call imgstr (in[i],"ICFNAME",Memc[fname],SZ_LINE)) {
+	        call fprintf (logfd, " %21s")
+		    call pargstr (Memc[fname])
+	    } else  {
+		call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE)
+		call fprintf (logfd, "  %21s")
+		    call pargstr (Memc[fname])
+	    }
+	    if (prncombine) {
+		call fprintf (logfd, " %6d")
+		    call pargi (ncombine[i])
+	    }
+	    if (prexptime) {
+		call fprintf (logfd, " %6.1f")
+		    call pargr (exptime[i])
+	    }
+	    if (prmode) {
+		call fprintf (logfd, " %7.5g")
+		    call pargr (mode[i])
+	    }
+	    if (prmedian) {
+		call fprintf (logfd, " %7.5g")
+		    call pargr (median[i])
+	    }
+	    if (prmean) {
+		call fprintf (logfd, " %7.5g")
+		    call pargr (mean[i])
+	    }
+	    if (prrdn) {
+		rval = imgetr (in[i], Memc[rdnoise])
+		call fprintf (logfd, " %7g")
+		    call pargr (rval)
+	    }
+	    if (prgain) {
+		rval = imgetr (in[i], Memc[gain])
+		call fprintf (logfd, " %6g")
+		    call pargr (rval)
+	    }
+	    if (prsn) {
+		rval = imgetr (in[i], Memc[snoise])
+		call fprintf (logfd, " %6g")
+		    call pargr (rval)
+	    }
+	    if (doscale) {
+		call fprintf (logfd, " %6.3f")
+		    call pargr (1./scales[i])
+	    }
+	    if (dozero) {
+		call fprintf (logfd, " %7.5g")
+		    call pargr (-zeros[i])
+	    }
+	    if (dowts) {
+		call fprintf (logfd, " %6.3f")
+		    call pargr (wts[i])
+	    }
+	    if (!aligned) {
+		if (IM_NDIM(out[1]) == 1) {
+		    call fprintf (logfd, " %9d")
+			call pargi (offsets[i,1])
+		} else {
+		    do  j = 1, IM_NDIM(out[1]) {
+			call fprintf (logfd, " %4d")
+			    call pargi (offsets[i,j])
+		    }
+		}
+	    }
+	    if (prmask) {
+		if (stack == YES) {
+		    call sprintf (Memc[key], SZ_FNAME, "bpm%04d")
+			call pargi (i)
+		    ifnoerr (call imgstr (in[i], Memc[key], Memc[fname],
+		        SZ_LINE)) {
+			call fprintf (logfd, " %s")
+			    call pargstr (Memc[fname])
+		    } else {
+			call fprintf (logfd, " %s")
+			    call pargstr (Memc[bpname])
+		    }
+		} else if (ICM_TYPE(icm) != M_NONE) {
+		    if (project)
+			bpname = Memi[ICM_LOGNAMES(icm)]
+		    else
+			bpname = Memi[ICM_LOGNAMES(icm)+i-1]
+		    if (Memc[bpname] != EOS) {
+			call fprintf (logfd, " %s")
+			    call pargstr (Memc[bpname])
+		    }
+		}
+	    }
+	    call fprintf (logfd, "\n")
+	}
+
+	# Log information about the output images.
+	call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_LINE)
+	call fprintf (logfd, "\n  Output image = %s, ncombine = %d")
+	    call pargstr (Memc[fname])
+	    call pargi (nout)
+	call fprintf (logfd, "\n")
+
+	if (out[2] != NULL) {
+	    call imstats (out[2], IM_IMAGENAME, Memc[fname], SZ_LINE)
+	    call fprintf (logfd, "  Bad pixel mask = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	if (out[4] != NULL) {
+	    call imstats (out[4], IM_IMAGENAME, Memc[fname], SZ_LINE)
+	    call fprintf (logfd, "  Rejection mask = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	if (out[5] != NULL) {
+	    call imstats (out[5], IM_IMAGENAME, Memc[fname], SZ_LINE)
+	    call fprintf (logfd, "  Number rejected mask = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	if (out[6] != NULL) {
+	    call imstats (out[6], IM_IMAGENAME, Memc[fname], SZ_LINE)
+	    call fprintf (logfd, "  Exposure mask = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	if (out[3] != NULL) {
+	    call imstats (out[3], IM_IMAGENAME, Memc[fname], SZ_LINE)
+	    call fprintf (logfd, "  Sigma image = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	call flush (logfd)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icmask.com b/noao/twodspec/longslit/lscombine/src/icmask.com
new file mode 100644
index 00000000..baba6f6a
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icmask.com
@@ -0,0 +1,8 @@
+# IMCMASK -- Common for IMCOMBINE mask interface.
+
+int	mtype		# Mask type
+int	mvalue		# Mask value
+pointer	bufs		# Pointer to data line buffers
+pointer	pms		# Pointer to array of PMIO pointers
+
+common	/imcmask/ mtype, mvalue, bufs, pms
diff --git a/noao/twodspec/longslit/lscombine/src/icmask.h b/noao/twodspec/longslit/lscombine/src/icmask.h
new file mode 100644
index 00000000..533c601d
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icmask.h
@@ -0,0 +1,9 @@
+# ICMASK -- Data structure for IMCOMBINE mask interface.
+
+define	ICM_LEN		6		# Structure length
+define	ICM_TYPE	Memi[$1]	# Mask type
+define	ICM_VALUE	Memi[$1+1]	# Mask value
+define	ICM_BUFS	Memi[$1+2]	# Pointer to data line buffers
+define	ICM_PMS		Memi[$1+3]	# Pointer to array of PMIO pointers
+define	ICM_NAMES	Memi[$1+4]	# Pointer to array of mask names
+define	ICM_LOGNAMES	Memi[$1+5]	# Pointer to array of mask log names
diff --git a/noao/twodspec/longslit/lscombine/src/icmask.x b/noao/twodspec/longslit/lscombine/src/icmask.x
new file mode 100644
index 00000000..9242405d
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icmask.x
@@ -0,0 +1,499 @@
+include	<imhdr.h>
+include	<pmset.h>
+include	"icombine.h"
+include	"icmask.h"
+
+# IC_MASK   -- ICOMBINE mask interface
+#
+# IC_MOPEN  -- Initialize mask interface
+# IC_MCLOSE -- Close the mask interface
+# IC_MGET   -- Get lines of mask pixels for all the images
+# IC_MGET1  -- Get a line of mask pixels for the specified image
+# IC_MCLOSE1-- Close a mask for the specified image index
+
+
+# IC_MOPEN -- Initialize mask interface.
+
+procedure ic_mopen (in, out, nimages, offsets)
+
+pointer	in[nimages]		#I Input images
+pointer	out[ARB]		#I Output images
+int	nimages			#I Number of images
+int	offsets[nimages,ARB]	#I Offsets to  output image
+
+int	mtype			# Mask type
+int	mvalue			# Mask value
+pointer	bufs			# Pointer to data line buffers
+pointer	pms			# Pointer to array of PMIO pointers
+pointer	names			# Pointer to array of string pointers
+pointer	lognames		# Pointer to array of string pointers
+
+int	i, j, k, nin, nout, npix, npms, nowhite(), strdic()
+int	clgeti()
+pointer	sp, key, fname, logname, title, pm, pm_open()
+bool	invert, pm_empty()
+errchk	calloc, pm_open, pm_loadf, pm_loadim
+
+include "icombine.com"
+
+begin
+	icm = NULL
+	if (IM_NDIM(out[1]) == 0)
+	    return
+
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (title, SZ_FNAME, TY_CHAR)
+
+	# Determine the mask parameters and allocate memory.
+	# The mask buffers are initialize to all excluded so that
+	# output points outside the input data are always excluded
+	# and don't need to be set on a line-by-line basis.
+
+	mtype = M_NONE
+	call clgstr ("masktype", Memc[key], SZ_FNAME)
+	if (nowhite (Memc[key], Memc[key], SZ_FNAME) > 0) {
+	    if (Memc[key] == '!') {
+		mtype = M_GOODVAL
+		call strcpy (Memc[key+1], Memc[key], SZ_FNAME)
+	    } else {
+		mtype = strdic (Memc[key], Memc[title], SZ_FNAME, MASKTYPES)
+		if (mtype == 0) {
+		    call sprintf (Memc[title], SZ_FNAME,
+			"Invalid or ambiguous masktype (%s)")
+			call pargstr (Memc[key])
+		    call error (1, Memc[title])
+		}
+		call strcpy ("BPM", Memc[key], SZ_FNAME)
+	    }
+	}
+	mvalue = clgeti ("maskvalue")
+	npix = IM_LEN(out[1],1)
+	call calloc (pms, nimages, TY_POINTER)
+	call calloc (bufs, nimages, TY_POINTER)
+	call calloc (names, nimages, TY_POINTER)
+	call calloc (lognames, nimages, TY_POINTER)
+	do i = 1, nimages {
+	    call malloc (Memi[bufs+i-1], npix, TY_INT)
+	    call amovki (1, Memi[Memi[bufs+i-1]], npix)
+	}
+
+	# Check for special cases.  The BOOLEAN type is used when only
+	# zero and nonzero are significant; i.e. the actual mask values are
+	# not important.  The invert flag is used to indicate that
+	# empty masks are all bad rather the all good.
+
+	if (mtype == 0)
+	    mtype = M_NONE
+	if (mtype == M_BADBITS && mvalue == 0) 
+	    mtype = M_NONE
+	if (mvalue == 0 && (mtype == M_GOODVAL || mtype == M_GOODBITS))
+	    mtype = M_BOOLEAN
+	if ((mtype == M_BADVAL && mvalue == 0) ||
+	    (mtype == M_GOODVAL && mvalue != 0) ||
+	    (mtype == M_GOODBITS && mvalue == 0))
+	    invert = true 
+	else
+	    invert = false 
+
+	# If mask images are to be used, get the mask name from the image
+	# header and open it saving the descriptor in the pms array.
+	# Empty masks (all good) are treated as if there was no mask image.
+
+	nout = IM_LEN(out[1],1)
+	npms = 0
+	do i = 1, nimages {
+	    if (mtype != M_NONE) {
+		call malloc (Memi[names+i-1], SZ_FNAME, TY_CHAR)
+		call malloc (Memi[lognames+i-1], SZ_FNAME, TY_CHAR)
+		fname = Memi[names+i-1]
+		logname = Memi[lognames+i-1]
+		ifnoerr (call imgstr (in[i],Memc[key],Memc[fname],SZ_FNAME)) {
+		    nin = IM_LEN(in[i],1)
+		    j = max (0, offsets[i,1])
+		    k = min (nout, nin + offsets[i,1])
+		    npix = k - j
+		    if (npix < 1)
+			Memc[fname] = EOS
+		    else {
+			pm = pm_open (NULL)
+			iferr (call pm_loadf (pm, Memc[fname], Memc[title],
+			    SZ_FNAME))
+			    call pm_loadim (pm, Memc[fname], Memc[title],
+				SZ_FNAME)
+			call pm_seti (pm, P_REFIM, in[i])
+			if (pm_empty (pm) && !invert)
+			    Memc[fname] = EOS
+			else {
+			    if (project)
+				npms = nimages
+			    else
+				npms = npms + 1
+			}
+			call pm_close (pm)
+
+			ifnoerr (call imgstr (in[i], "ICBPM", Memc[title],
+			    SZ_FNAME))
+			    call strcpy (Memc[title], Memc[logname], SZ_FNAME)
+			else
+			    call strcpy (Memc[fname], Memc[logname], SZ_FNAME)
+		    }
+		    if (project)
+			break
+		} else {
+		    Memc[fname] = EOS
+		    Memc[logname] = EOS
+		}
+	    }
+	}
+
+	# If no mask images are found and the mask parameters imply that
+	# good values are 0 then use the special case of no masks.
+
+	if (npms == 0) {
+	    if (!invert)
+		mtype = M_NONE
+	}
+
+	# Set up mask structure.
+	call calloc (icm, ICM_LEN, TY_STRUCT)
+	ICM_TYPE(icm) = mtype
+	ICM_VALUE(icm) = mvalue
+	ICM_BUFS(icm) = bufs
+	ICM_PMS(icm) = pms
+	ICM_NAMES(icm) = names
+	ICM_LOGNAMES(icm) = lognames
+
+	call sfree (sp)
+end
+
+
+# IC_MCLOSE -- Close the mask interface.
+
+procedure ic_mclose (nimages)
+
+int	nimages			# Number of images
+
+int	i
+include	"icombine.com"
+
+begin
+	if (icm == NULL)
+	    return
+
+	do i = 1, nimages {
+	    call mfree (Memi[ICM_NAMES(icm)+i-1], TY_CHAR)
+	    call mfree (Memi[ICM_BUFS(icm)+i-1], TY_INT)
+	}
+	do i = 1, nimages {
+	    if (Memi[ICM_PMS(icm)+i-1] != NULL)
+		call pm_close (Memi[ICM_PMS(icm)+i-1])
+	    if (project)
+		break
+	}
+	call mfree (ICM_NAMES(icm), TY_POINTER)
+	call mfree (ICM_BUFS(icm), TY_POINTER)
+	call mfree (ICM_PMS(icm), TY_POINTER)
+	call mfree (icm, TY_STRUCT)
+end
+
+
+# IC_MGET -- Get lines of mask pixels in the output coordinate system.
+# This converts the mask format to an array where zero is good and nonzero
+# is bad.  This has special cases for optimization.
+
+procedure ic_mget (in, out, offsets, v1, v2, m, lflag, nimages)
+
+pointer	in[nimages]		# Input image pointers
+pointer	out[ARB]		# Output image pointer
+int	offsets[nimages,ARB]	# Offsets to  output image
+long	v1[IM_MAXDIM]		# Data vector desired in output image
+long	v2[IM_MAXDIM]		# Data vector in input image
+pointer	m[nimages]		# Pointer to mask pointers
+int	lflag[nimages]		# Line flags
+int	nimages			# Number of images
+
+int	mtype			# Mask type
+int	mvalue			# Mask value
+pointer	bufs			# Pointer to data line buffers
+pointer	pms			# Pointer to array of PMIO pointers
+
+char	title[1]
+int	i, j, k, ndim, nin, nout, npix
+pointer	buf, pm, names, fname, pm_open()
+bool	pm_linenotempty()
+errchk	pm_glpi, pm_open, pm_loadf, pm_loadim
+
+include	"icombine.com"
+
+begin
+	# Determine if masks are needed at all.  Note that the threshold
+	# is applied by simulating mask values so the mask pointers have to
+	# be set.
+
+	dflag = D_ALL
+	if (icm == NULL)
+	    return
+	if (ICM_TYPE(icm) == M_NONE && aligned && !dothresh)
+	    return
+
+	mtype = ICM_TYPE(icm)
+	mvalue = ICM_VALUE(icm)
+	bufs = ICM_BUFS(icm)
+	pms = ICM_PMS(icm)
+	names = ICM_NAMES(icm)
+
+	# Set the mask pointers and line flags and apply offsets if needed.
+
+	ndim = IM_NDIM(out[1])
+	nout = IM_LEN(out[1],1)
+	do i = 1, nimages {
+	    nin = IM_LEN(in[i],1)
+	    j = max (0, offsets[i,1])
+	    k = min (nout, nin + offsets[i,1])
+	    npix = k - j
+
+	    m[i] = Memi[bufs+i-1]
+	    buf = Memi[bufs+i-1] + j
+	    if (project) {
+		pm =  Memi[pms]
+		fname = Memi[names]
+	    } else {
+		pm =  Memi[pms+i-1]
+		fname = Memi[names+i-1]
+	    }
+
+	    if (npix < 1)
+	        lflag[i] = D_NONE
+	    else if (npix == nout)
+	        lflag[i] = D_ALL
+	    else
+	        lflag[i] = D_MIX
+
+	    if (lflag[i] != D_NONE) {
+		v2[1] = 1 + j - offsets[i,1]
+		do j = 2, ndim {
+		    v2[j] = v1[j] - offsets[i,j]
+		    if (v2[j] < 1 || v2[j] > IM_LEN(in[i],j)) {
+			lflag[i] = D_NONE
+			break
+		    }
+		}
+	    }
+	    if (project)
+		v2[ndim+1] = i
+
+	    if (lflag[i] == D_NONE) {
+		if (pm != NULL && !project) {
+		    call pm_close (pm)
+		    Memi[pms+i-1] = NULL
+		}
+		next
+	    }
+
+	    if (fname == NULL) {
+		call aclri (Memi[buf], npix)
+		next
+	    } else if (Memc[fname] == EOS) {
+		call aclri (Memi[buf], npix)
+		next
+	    }
+
+	    # Do mask I/O and convert to appropriate values in order of
+	    # expected usage.
+
+	    if (pm == NULL) {
+		pm = pm_open (NULL)
+		iferr (call pm_loadf (pm, Memc[fname], title, 1))
+		    call pm_loadim (pm, Memc[fname], title, 1)
+		call pm_seti (pm, P_REFIM, in[i])
+		if (project)
+		    Memi[pms] = pm
+		else
+		    Memi[pms+i-1] = pm
+	    }
+
+	    if (pm_linenotempty (pm, v2)) {
+		call pm_glpi (pm, v2, Memi[buf], 32, npix, 0)
+
+		if (mtype == M_BOOLEAN)
+		    ;
+		else if (mtype == M_BADBITS)
+		    call aandki (Memi[buf], mvalue, Memi[buf], npix)
+		else if (mtype == M_BADVAL)
+		    call abeqki (Memi[buf], mvalue, Memi[buf], npix)
+		else if (mtype == M_GOODBITS) {
+		    call aandki (Memi[buf], mvalue, Memi[buf], npix)
+		    call abeqki (Memi[buf], 0, Memi[buf], npix)
+		} else if (mtype == M_GOODVAL)
+		    call abneki (Memi[buf], mvalue, Memi[buf], npix)
+
+		lflag[i] = D_NONE
+		do j = 1, npix
+		    if (Memi[buf+j-1] == 0) {
+			lflag[i] = D_MIX
+			break
+		    }
+	    } else {
+		if (mtype == M_BOOLEAN || mtype == M_BADBITS) {
+		    call aclri (Memi[buf], npix)
+		} else if ((mtype == M_BADVAL && mvalue != 0) ||
+		    (mtype == M_GOODVAL && mvalue == 0)) {
+		    call aclri (Memi[buf], npix)
+		} else {
+		    call amovki (1, Memi[buf], npix)
+		    lflag[i] = D_NONE
+		}
+	    }
+	}
+
+	# Set overall data flag
+	dflag = lflag[1]
+	do i = 2, nimages  {
+	    if (lflag[i] != dflag) {
+		dflag = D_MIX
+		break
+	    }
+	}
+end
+
+
+# IC_MGET1 -- Get line of mask pixels from a specified image.
+# This is used by the IC_STAT procedure. This procedure  converts the
+# stored mask format to an array where zero is good and nonzero is bad.
+# The data vector and returned mask array are in the input image pixel system.
+
+procedure ic_mget1 (in, image, nimages, offset, v, m)
+
+pointer	in			# Input image pointer
+int	image			# Image index
+int	nimages			# Number of images
+int	offset			# Column offset
+long	v[IM_MAXDIM]		# Data vector desired
+pointer	m			# Pointer to mask
+
+int	mtype			# Mask type
+int	mvalue			# Mask value
+pointer	bufs			# Pointer to data line buffers
+pointer	pms			# Pointer to array of PMIO pointers
+
+char	title[1]
+int	i, npix
+pointer	buf, pm, names, fname, pm_open()
+bool	pm_linenotempty()
+errchk	pm_glpi, pm_open, pm_loadf, pm_loadim
+
+include	"icombine.com"
+
+begin
+	dflag = D_ALL
+	if (icm == NULL)
+	    return
+	if (ICM_TYPE(icm) == M_NONE)
+	    return
+
+	mtype = ICM_TYPE(icm)
+	mvalue = ICM_VALUE(icm)
+	bufs = ICM_BUFS(icm)
+	pms = ICM_PMS(icm)
+	names = ICM_NAMES(icm)
+
+	npix = IM_LEN(in,1)
+	m = Memi[bufs+image-1] + offset
+	if (project) {
+	    pm =  Memi[pms]
+	    fname = Memi[names]
+	} else {
+	    pm =  Memi[pms+image-1]
+	    fname = Memi[names+image-1]
+	}
+
+	if (fname == NULL)
+	    return
+	if (Memc[fname] == EOS)
+	    return
+
+	if (pm == NULL) {
+	    pm = pm_open (NULL)
+	    iferr (call pm_loadf (pm, Memc[fname], title, 1))
+		call pm_loadim (pm, Memc[fname], title, 1)
+	    call pm_seti (pm, P_REFIM, in)
+	    if (project)
+		Memi[pms] = pm
+	    else
+		Memi[pms+image-1] = pm
+	}
+
+	# Do mask I/O and convert to appropriate values in order of
+	# expected usage.
+
+	buf = m
+	if (pm_linenotempty (pm, v)) {
+	    call pm_glpi (pm, v, Memi[buf], 32, npix, 0)
+
+	    if (mtype == M_BOOLEAN)
+		;
+	    else if (mtype == M_BADBITS)
+		call aandki (Memi[buf], mvalue, Memi[buf], npix)
+	    else if (mtype == M_BADVAL)
+		call abeqki (Memi[buf], mvalue, Memi[buf], npix)
+	    else if (mtype == M_GOODBITS) {
+		call aandki (Memi[buf], mvalue, Memi[buf], npix)
+		call abeqki (Memi[buf], 0, Memi[buf], npix)
+	    } else if (mtype == M_GOODVAL)
+		call abneki (Memi[buf], mvalue, Memi[buf], npix)
+
+	    dflag = D_NONE
+	    do i = 1, npix
+		if (Memi[buf+i-1] == 0) {
+		    dflag = D_MIX
+		    break
+		}
+	} else {
+	    if (mtype == M_BOOLEAN || mtype == M_BADBITS) {
+		;
+	    } else if ((mtype == M_BADVAL && mvalue != 0) ||
+		(mtype == M_GOODVAL && mvalue == 0)) {
+		;
+	    } else
+		dflag = D_NONE
+	}
+end
+
+
+# IC_MCLOSE1 -- Close mask by index.
+
+procedure ic_mclose1 (image, nimages)
+
+int	image			# Image index
+int	nimages			# Number of images
+
+pointer	pms, names, pm, fname
+include	"icombine.com"
+
+begin
+	if (icm == NULL)
+	    return
+
+	pms = ICM_PMS(icm)
+	names = ICM_NAMES(icm)
+
+	if (project) {
+	    pm =  Memi[pms]
+	    fname = Memi[names]
+	} else {
+	    pm =  Memi[pms+image-1]
+	    fname = Memi[names+image-1]
+	}
+
+	if (fname == NULL || pm == NULL)
+	    return
+	if (Memc[fname] == EOS || pm == NULL)
+	    return
+
+	call pm_close (pm)
+	if (project)
+	    Memi[pms] = NULL
+	else
+	    Memi[pms+image-1] = NULL
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icmedian.gx b/noao/twodspec/longslit/lscombine/src/icmedian.gx
new file mode 100644
index 00000000..4ac51ae6
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icmedian.gx
@@ -0,0 +1,231 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+$for (sird)
+# IC_MEDIAN -- Median of lines
+
+procedure ic_median$t (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+$if (datatype == silx)
+real	val1, val2, val3
+$else
+PIXEL	val1, val2, val3
+$endif
+PIXEL	temp, wtemp
+$if (datatype == x)
+real	abs_temp
+$endif
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Mem$t[d[j1]+k]
+			val2 = Mem$t[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Mem$t[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Mem$t[d[j1]+k]
+			    val2 = Mem$t[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Mem$t[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Mem$t[d[j]+k];  lo1 = lo;  up1 = up
+		    $if (datatype == x)
+		    abs_temp = abs (temp)
+		    $endif
+
+		    repeat {
+			$if (datatype == x)
+			while (abs (Mem$t[d[lo1]+k]) < abs_temp)
+			$else
+			while (Mem$t[d[lo1]+k] < temp)
+			$endif
+			    lo1 = lo1 + 1
+			$if (datatype == x)
+			while (abs_temp < abs (Mem$t[d[up1]+k]))
+			$else
+			while (temp < Mem$t[d[up1]+k])
+			$endif
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Mem$t[d[lo1]+k]
+			    Mem$t[d[lo1]+k] = Mem$t[d[up1]+k]
+			    Mem$t[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Mem$t[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Mem$t[d[j]+k];  lo1 = lo;  up1 = up
+			$if (datatype == x)
+			abs_temp = abs (temp)
+			$endif
+
+			repeat {
+			    $if (datatype == x)
+			    while (abs (Mem$t[d[lo1]+k]) < abs_temp)
+			    $else
+			    while (Mem$t[d[lo1]+k] < temp)
+			    $endif
+				lo1 = lo1 + 1
+			    $if (datatype == x)
+			    while (abs_temp < abs (Mem$t[d[up1]+k]))
+			    $else
+			    while (temp < Mem$t[d[up1]+k])
+			    $endif
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Mem$t[d[lo1]+k]
+				Mem$t[d[lo1]+k] = Mem$t[d[up1]+k]
+				Mem$t[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Mem$t[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else if (n1 == 3) {
+		$if (datatype == x)
+	        val1 = abs (Mem$t[d[1]+k])
+	        val2 = abs (Mem$t[d[2]+k])
+	        val3 = abs (Mem$t[d[3]+k])
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = Mem$t[d[2]+k]
+		    else if (val1 < val3)	# acb
+		        median[i] = Mem$t[d[3]+k]
+		    else			# cab
+		        median[i] = Mem$t[d[1]+k]
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = Mem$t[d[2]+k]
+		    else if (val1 > val3)	# bca
+		        median[i] = Mem$t[d[3]+k]
+		    else			# bac
+		        median[i] = Mem$t[d[1]+k]
+	        }
+		$else
+	        val1 = Mem$t[d[1]+k]
+	        val2 = Mem$t[d[2]+k]
+	        val3 = Mem$t[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+		$endif
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Mem$t[d[1]+k]
+		val2 = Mem$t[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Mem$t[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icmm.gx b/noao/twodspec/longslit/lscombine/src/icmm.gx
new file mode 100644
index 00000000..16505588
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icmm.gx
@@ -0,0 +1,189 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+$for (sird)
+# IC_MM --  Reject a specified number of high and low pixels
+
+procedure ic_mm$t (d, m, n, npts)
+
+pointer	d[ARB]		# Data pointers
+pointer	m[ARB]		# Image ID pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+
+int	n1, ncombine, npairs, nlow, nhigh, np
+int	i, i1, j, jmax, jmin
+pointer	k, kmax, kmin
+PIXEL	d1, d2, dmin, dmax
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE)
+	    return
+
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    nlow = flow * n1 + 0.001
+	    nhigh = fhigh * n1 + 0.001
+	    ncombine = n1 - nlow -  nhigh
+	    npairs = min (nlow, nhigh)
+	    nlow = nlow - npairs
+	    nhigh = nhigh - npairs
+	}
+
+	do i = 1, npts {
+	    i1 = i - 1
+	    n1 = n[i]
+	    if (dflag == D_MIX) {
+		nlow = flow * n1 + 0.001
+		nhigh = fhigh * n1 + 0.001
+		ncombine = max (ncombine, n1 - nlow - nhigh)
+		npairs = min (nlow, nhigh)
+		nlow = nlow - npairs
+		nhigh = nhigh - npairs
+	    }
+
+	    # Reject the npairs low and high points.
+	    do np = 1, npairs {
+		k = d[1] + i1
+		$if (datatype == x)
+		d1 = abs (Mem$t[k])
+		$else
+		d1 = Mem$t[k]
+		$endif
+		dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k
+		do j = 2, n1 {
+		    d2 = d1
+		    k = d[j] + i1
+		    $if (datatype == x)
+		    d1 = abs (Mem$t[k])
+		    $else
+		    d1 = Mem$t[k]
+		    $endif
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    } else if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		j = n1 - 1
+		if (keepids) {
+		    if (jmax < j) {
+			if (jmin != j) {
+			    Mem$t[kmax] = d2
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			} else {
+			    Mem$t[kmax] = d1
+			    k = Memi[m[jmax]+i1]
+			    Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			}
+		    }
+		    if (jmin < j) {
+			if (jmax != n1) {
+			    Mem$t[kmin] = d1
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			    Memi[m[n1]+i1] = k
+			} else {
+			    Mem$t[kmin] = d2
+			    k = Memi[m[jmin]+i1]
+			    Memi[m[jmin]+i1] = Memi[m[j]+i1]
+			    Memi[m[j]+i1] = k
+			}
+		    }
+		} else {
+		    if (jmax < j) {
+			if (jmin != j)
+			    Mem$t[kmax] = d2
+			else
+			    Mem$t[kmax] = d1
+		    }
+		    if (jmin < j) {
+			if (jmax != n1)
+			    Mem$t[kmin] = d1
+			else
+			    Mem$t[kmin] = d2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    # Reject the excess low points.
+	    do np = 1, nlow {
+		k = d[1] + i1
+		$if (datatype == x)
+		d1 = abs (Mem$t[k])
+		$else
+		d1 = Mem$t[k]
+		$endif
+		dmin = d1; jmin = 1; kmin = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    $if (datatype == x)
+		    d1 = abs (Mem$t[k])
+		    $else
+		    d1 = Mem$t[k]
+		    $endif
+		    if (d1 < dmin) {
+			dmin = d1; jmin = j; kmin = k
+		    }
+		}
+		if (keepids) {
+		    if (jmin < n1) {
+			Mem$t[kmin] = d1
+			k = Memi[m[jmin]+i1]
+			Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmin < n1)
+			Mem$t[kmin] = d1
+		}
+		n1 = n1 - 1 
+	    }
+
+	    # Reject the excess high points.
+	    do np = 1, nhigh {
+		k = d[1] + i1
+		$if (datatype == x)
+		d1 = abs (Mem$t[k])
+		$else
+		d1 = Mem$t[k]
+		$endif
+		dmax = d1; jmax = 1; kmax = k
+		do j = 2, n1 {
+		    k = d[j] + i1
+		    $if (datatype == x)
+		    d1 = abs (Mem$t[k])
+		    $else
+		    d1 = Mem$t[k]
+		    $endif
+		    if (d1 > dmax) {
+			dmax = d1; jmax = j; kmax = k
+		    }
+		}
+		if (keepids) {
+		    if (jmax < n1) {
+			Mem$t[kmax] = d1
+			k = Memi[m[jmax]+i1]
+			Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			Memi[m[n1]+i1] = k
+		    }
+		} else {
+		    if (jmax < n1)
+			Mem$t[kmax] = d1
+		}
+		n1 = n1 - 1 
+	    }
+	    n[i] = n1
+	}
+
+	if (dflag == D_ALL && npairs + nlow + nhigh > 0)
+		dflag = D_MIX
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icomb.gx b/noao/twodspec/longslit/lscombine/src/icomb.gx
new file mode 100644
index 00000000..6c6e56c9
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icomb.gx
@@ -0,0 +1,674 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	<error.h>
+include	<syserr.h>
+include	<mach.h>
+include	"../icombine.h"
+
+# The following is for compiling under V2.11.
+define	IM_BUFFRAC	IM_BUFSIZE
+include	<imset.h>
+
+
+# ICOMBINE -- Combine images
+#
+# The memory and open file descriptor limits are checked and an attempt
+# to recover is made either by setting the image pixel files to be
+# closed after I/O or by notifying the calling program that memory
+# ran out and the IMIO buffer size should be reduced.  After the checks
+# a procedure for the selected combine option is called.
+# Because there may be several failure modes when reaching the file
+# limits we first assume an error is due to the file limit, except for
+# out of memory, and close some pixel files.  If the error then repeats
+# on accessing the pixels the error is passed back.
+
+$for (sird)
+procedure icombine$t (in, out, scales, zeros, wts, offsets, nimages, bufsize)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+real	wts[nimages]		# Weights
+int	offsets[nimages,ARB]	# Input image offsets
+int	nimages			# Number of input images
+int	bufsize			# IMIO buffer size
+
+char	str[1]
+int	i, j, k, npts, fd, stropen(), xt_imgnl$t()
+pointer	sp, d, id, n, m, lflag, v, dbuf
+pointer	im, buf, xt_opix(), impl1i()
+errchk	stropen, xt_cpix, xt_opix, xt_imgnl$t, impl1i, ic_combine$t
+$if (datatype == sil)
+pointer	impl1r()
+errchk	impl1r
+$else
+pointer	impl1$t()
+errchk	impl1$t
+$endif
+
+include	"../icombine.com"
+
+begin
+	npts = IM_LEN(out[1],1)
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (dbuf, nimages, TY_POINTER)
+	call salloc (d, nimages, TY_POINTER)
+	call salloc (id, nimages, TY_POINTER)
+	call salloc (n, npts, TY_INT)
+	call salloc (m, nimages, TY_POINTER)
+	call salloc (lflag, nimages, TY_INT)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call amovki (D_ALL, Memi[lflag], nimages)
+	call amovkl (1, Meml[v], IM_MAXDIM)
+
+	# If not aligned or growing create data buffers of output length
+	# otherwise use the IMIO buffers.
+
+	if (!aligned || grow >= 1.) {
+	    do i = 1, nimages
+		call salloc (Memi[dbuf+i-1], npts, TY_PIXEL)
+	} else {
+	    do i = 1, nimages {
+		im = xt_opix (in[i], i, 1)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_PIXEL)
+	    }
+	    call amovki (NULL, Memi[dbuf], nimages)
+	}
+
+	if (project) {
+	    call imseti (in[1], IM_NBUFS, nimages)
+	    call imseti (in[1], IM_BUFFRAC, 0)
+	    call imseti (in[1], IM_BUFSIZE, bufsize)
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	} else {
+	    # Reserve FD for string operations.
+	    fd = stropen (str, 1, NEW_FILE)
+
+	    # Do I/O to the images.
+	    do i = 1, 6 {
+		if (out[i] != NULL) {
+		    call imseti (out[i], IM_BUFFRAC, 0)
+		    call imseti (out[i], IM_BUFSIZE, bufsize)
+		}
+	    }
+	    $if (datatype == sil)
+	    buf = impl1r (out[1])
+	    call aclrr (Memr[buf], npts)
+	    if (out[3] != NULL) {
+		buf = impl1r (out[3])
+		call aclrr (Memr[buf], npts)
+	    }
+	    $else
+	    buf = impl1$t (out[1])
+	    call aclr$t (Mem$t[buf], npts)
+	    if (out[3] != NULL) {
+		buf = impl1$t (out[3])
+		call aclr$t (Mem$t[buf], npts)
+	    }
+	    $endif
+	    if (out[2] != NULL) {
+		buf = impl1i (out[2])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[4] != NULL) {
+		buf = impl1i (out[4])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[5] != NULL) {
+		buf = impl1i (out[5])
+		call aclri (Memi[buf], npts)
+	    }
+	    if (out[6] != NULL) {
+		buf = impl1i (out[6])
+		call aclri (Memi[buf], npts)
+	    }
+
+	    # Do I/O for first input image line.
+	    if (!project) {
+		do i = 1, nimages {
+		    call xt_imseti (i, "bufsize", bufsize)
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			call xt_cpix (i)
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			call xt_cpix (i)
+		}
+
+		do i = 1, nimages {
+		    j = max (0, offsets[i,1])
+		    k = min (npts, IM_LEN(in[i],1) + offsets[i,1])
+		    if (k - j < 1)
+			next
+		    j = 1 - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2))
+			next
+		    iferr {
+			Meml[v+1] = j
+			j = xt_imgnl$t (in[i], i, buf, Meml[v], 1)
+		    } then {
+			call imseti (im, IM_PIXFD, NULL)
+			call sfree (sp)
+			call strclose (fd)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	    call strclose (fd)
+	}
+
+	call ic_combine$t (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n],
+	    Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combine$t (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, nimages, npts)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output image
+pointer	dbuf[nimages]		# Data buffers for nonaligned images
+pointer	d[nimages]		# Data pointers
+pointer	id[nimages]		# Image index ID pointers
+int	n[npts]			# Number of good pixels
+pointer	m[nimages]		# Mask pointers
+int	lflag[nimages]		# Line flags
+int	offsets[nimages,ARB]	# Input image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+real	wts[nimages]		# Combining weights
+int	nimages			# Number of input images
+int	npts			# Number of points per output line
+
+int	i, ext, ctor(), errcode()
+real	r, imgetr()
+pointer	sp, fname, imname, v1, v2, v3, work
+pointer	outdata, buf, nm, pms
+pointer	immap(), impnli()
+$if (datatype == sil)
+pointer	impnlr(), imgnlr()
+$else
+pointer	impnl$t(), imgnl$t
+$endif
+errchk	immap, ic_scale, imgetr, ic_grow, ic_grow$t, ic_rmasks, ic_gdata$t
+
+include	"../icombine.com"
+data	ext/0/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (v3, IM_MAXDIM, TY_LONG)
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	call amovkl (long(1), Meml[v3], IM_MAXDIM)
+
+	call ic_scale (in, out, offsets, scales, zeros, wts, nimages)
+
+	# Set combine parameters
+	switch (combine) {
+	case AVERAGE:
+	    if (dowts)
+		keepids = true
+	    else
+		keepids = false
+	case MEDIAN:
+	    dowts = false
+	    keepids = false
+	}
+	docombine = true
+
+	# Set rejection algorithm specific parameters
+	switch (reject) {
+	case CCDCLIP, CRREJECT:
+	    call salloc (nm, 3*nimages, TY_REAL)
+	    i = 1
+	    if (ctor (Memc[rdnoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = r
+	    } else {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise])
+	    }
+	    i = 1
+	    if (ctor (Memc[gain], i, r) > 0) {
+		do i = 1, nimages {
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[gain])
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] =
+			max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL)
+		}
+	    }
+	    i = 1
+	    if (ctor (Memc[snoise], i, r) > 0) {
+		do i = 1, nimages
+		    Memr[nm+3*(i-1)+2] = r
+	    } else {
+		do i = 1, nimages {
+		    r = imgetr (in[i], Memc[snoise])
+		    Memr[nm+3*(i-1)+2] = r
+		}
+	    }
+	    if (!keepids) {
+		if (doscale1)
+		    keepids = true
+		else {
+		    do i = 2, nimages {
+			if (Memr[nm+3*(i-1)] != Memr[nm] ||
+			    Memr[nm+3*(i-1)+1] != Memr[nm+1] ||
+			    Memr[nm+3*(i-1)+2] != Memr[nm+2]) {
+			    keepids = true
+			    break
+			}
+		    }
+		}
+	    }
+	    if (reject == CRREJECT)
+		lsigma = MAX_REAL
+	case MINMAX:
+	    mclip = false
+	case PCLIP:
+	    mclip = true
+	case AVSIGCLIP, SIGCLIP:
+	    if (doscale1)
+		keepids = true
+	case NONE:
+	    mclip = false
+	}
+
+	if (out[4] != NULL)
+	    keepids = true
+
+	if (out[6] != NULL) {
+	    keepids = true
+	    call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1)
+	}
+
+	if (grow >= 1.) {
+	    keepids = true
+	    call salloc (work, npts * nimages, TY_INT)
+	}
+	pms = NULL
+
+	if (keepids) {
+	    do i = 1, nimages
+		call salloc (id[i], npts, TY_INT)
+	}
+
+	$if (datatype == sil)
+	while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+	    call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets,
+		scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+	    switch (reject) {
+	    case CCDCLIP, CRREJECT:
+		if (mclip)
+		    call ic_mccdclip$t (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+		else
+		    call ic_accdclip$t (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Memr[outdata])
+	    case MINMAX:
+		call ic_mm$t (d, id, n, npts)
+	    case PCLIP:
+		call ic_pclip$t (d, id, n, nimages, npts, Memr[outdata])
+	    case SIGCLIP:
+		if (mclip)
+		    call ic_msigclip$t (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+		else
+		    call ic_asigclip$t (d, id, n, scales, zeros, nimages, npts,
+			Memr[outdata])
+	    case AVSIGCLIP:
+		if (mclip)
+		    call ic_mavsigclip$t (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+		else
+		    call ic_aavsigclip$t (d, id, n, scales, zeros, nimages,
+			npts, Memr[outdata])
+	    }
+
+	    if (pms == NULL || nkeep > 0) {
+		if (docombine) {
+		    switch (combine) {
+		    case AVERAGE:
+			call ic_average$t (d, id, n, wts, npts, YES, YES,
+			    Memr[outdata])
+		    case MEDIAN:
+			call ic_median$t (d, n, npts, YES, Memr[outdata])
+		    case SUM:
+			call ic_average$t (d, id, n, wts, npts, YES, NO,
+			    Memr[outdata])
+		    }
+		}
+	    }
+
+	    if (grow >= 1.)
+		call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts,
+		    pms)
+
+	    if (pms == NULL) {
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigma$t (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+	    }
+
+	    call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	}
+	$else
+	while (impnl$t (out[1], outdata, Meml[v1]) != EOF) {
+	    call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets,
+		scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+	    switch (reject) {
+	    case CCDCLIP, CRREJECT:
+		if (mclip)
+		    call ic_mccdclip$t (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Mem$t[outdata])
+		else
+		    call ic_accdclip$t (d, id, n, scales, zeros, Memr[nm],
+			nimages, npts, Mem$t[outdata])
+	    case MINMAX:
+		call ic_mm$t (d, id, n, npts)
+	    case PCLIP:
+		call ic_pclip$t (d, id, n, nimages, npts, Mem$t[outdata])
+	    case SIGCLIP:
+		if (mclip)
+		    call ic_msigclip$t (d, id, n, scales, zeros, nimages, npts,
+			Mem$t[outdata])
+		else
+		    call ic_asigclip$t (d, id, n, scales, zeros, nimages, npts,
+			Mem$t[outdata])
+	    case AVSIGCLIP:
+		if (mclip)
+		    call ic_mavsigclip$t (d, id, n, scales, zeros, nimages,
+			npts, Mem$t[outdata])
+		else
+		    call ic_aavsigclip$t (d, id, n, scales, zeros, nimages,
+			npts, Mem$t[outdata])
+	    }
+
+	    if (pms == NULL || nkeep > 0) {
+		if (docombine) {
+		    switch (combine) {
+		    case AVERAGE:
+			call ic_average$t (d, id, n, wts, npts, YES, YES,
+			    Mem$t[outdata])
+		    case MEDIAN:
+			call ic_median$t (d, n, npts, YES, Mem$t[outdata])
+		    case SUM:
+			call ic_average$t (d, id, n, wts, npts, YES, NO,
+			    Mem$t[outdata])
+		    }
+		}
+	    }
+
+	    if (grow >= 1.)
+		call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts,
+		    pms)
+
+	    if (pms == NULL) {
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+			buf = buf + 1
+		    }
+		}
+
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnl$t (out[3], buf, Meml[v1])
+		    call ic_sigma$t (d, id, n, wts, npts, Mem$t[outdata],
+			Mem$t[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+	    }
+
+	    call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	}
+	$endif
+
+	if (pms != NULL) {
+	    if (nkeep > 0) {
+		call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME)
+		call imunmap (out[1])
+		iferr (buf = immap (Memc[fname], READ_WRITE, 0)) {
+		    switch (errcode()) {
+		    case SYS_FXFOPNOEXTNV:
+			call imgcluster (Memc[fname], Memc[fname], SZ_FNAME)
+			ext = ext + 1
+			call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+			    call pargstr (Memc[fname])
+			    call pargi (ext)
+			iferr (buf = immap (Memc[imname], READ_WRITE, 0)) {
+			    buf = NULL
+			    ext = 0
+			}
+			repeat {
+			    call sprintf (Memc[imname], SZ_FNAME, "%s[%d]")
+				call pargstr (Memc[fname])
+				call pargi (ext+1)
+			    iferr (outdata = immap (Memc[imname],READ_WRITE,0)) 
+				break
+			    if (buf != NULL)
+				call imunmap (buf)
+			    buf = outdata
+			    ext = ext + 1
+			}
+		    default:
+			call erract (EA_ERROR)
+		    }
+		}
+		out[1] = buf
+	    }
+
+	    call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v3], IM_MAXDIM)
+	    $if (datatype == sil)
+	    while (impnlr (out[1], outdata, Meml[v1]) != EOF) {
+		call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets,
+		    scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+		call ic_grow$t (Meml[v2], d, id, n, Memi[work], nimages, npts,
+		    pms)
+
+		if (nkeep > 0) {
+		    do i = 1, npts {
+			if (n[i] < nkeep) {
+			    Meml[v1+1] = Meml[v1+1] - 1
+			    if (imgnlr (out[1], buf, Meml[v1]) == EOF)
+				;
+			    call amovr (Memr[buf], Memr[outdata], npts)
+			    break
+			}
+		    }
+		}
+
+		switch (combine) {
+		case AVERAGE:
+		    call ic_average$t (d, id, n, wts, npts, NO, YES,
+			Memr[outdata])
+		case MEDIAN:
+		    call ic_median$t (d, n, npts, NO, Memr[outdata])
+		case SUM:
+		    call ic_average$t (d, id, n, wts, npts, NO, NO,
+			Memr[outdata])
+		}
+
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+			
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnlr (out[3], buf, Meml[v1])
+		    call ic_sigma$t (d, id, n, wts, npts, Memr[outdata],
+			Memr[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+
+		call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	    }
+	    $else
+	    while (impnl$t (out[1], outdata, Meml[v1]) != EOF) {
+		call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets,
+		    scales, zeros, nimages, npts, Meml[v2], Meml[v3])
+
+		call ic_grow$t (Meml[v2], d, id, n, Memi[work], nimages, npts,
+		    pms)
+
+		if (nkeep > 0) {
+		    do i = 1, npts {
+			if (n[i] < nkeep) {
+			    Meml[v1+1] = Meml[v1+1] - 1
+			    if (imgnl$t (out[1], buf, Meml[v1]) == EOF)
+				;
+			    call amov$t (Mem$t[buf], Mem$t[outdata], npts)
+			    break
+			}
+		    }
+		}
+
+		switch (combine) {
+		case AVERAGE:
+		    call ic_average$t (d, id, n, wts, npts, NO, YES,
+			Mem$t[outdata])
+		case MEDIAN:
+		    call ic_median$t (d, n, npts, NO, Mem$t[outdata])
+		case SUM:
+		    call ic_average$t (d, id, n, wts, npts, NO, NO,
+			Mem$t[outdata])
+		}
+
+		if (out[2] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[2], buf, Meml[v1])
+		    do i = 1, npts {
+			if (n[i] == 0)
+			    Memi[buf] = 1
+			else
+			    Memi[buf] = 0
+		    }
+		}
+			
+		if (out[3] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnl$t (out[3], buf, Meml[v1])
+		    call ic_sigma$t (d, id, n, wts, npts, Mem$t[outdata],
+			Mem$t[buf])
+		}
+
+		if (out[4] != NULL)
+		    call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts)
+
+		if (out[5] != NULL) {
+		    call amovl (Meml[v2], Meml[v1], IM_MAXDIM)
+		    i = impnli (out[5], buf, Meml[v1])
+		    call amovki (nimages, Memi[buf], npts)
+		    call asubi (Memi[buf], n, Memi[buf], npts)
+		}
+
+		if (out[6] != NULL)
+		    call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts)
+
+		call amovl (Meml[v1], Meml[v2], IM_MAXDIM)
+	    }
+	    $endif
+
+	    do i = 1, nimages
+		call pm_close (Memi[pms+i-1])
+	    call mfree (pms, TY_POINTER)
+	}
+
+	call sfree (sp)
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icombine.com b/noao/twodspec/longslit/lscombine/src/icombine.com
new file mode 100644
index 00000000..7fa34287
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icombine.com
@@ -0,0 +1,45 @@
+# ICOMBINE Common
+
+int	combine			# Combine algorithm
+int	reject			# Rejection algorithm
+bool	project			# Combine across the highest dimension?
+real	blank			# Blank value
+pointer	ictask			# Task name for log
+pointer	expkeyword		# Exposure time keyword
+pointer	statsec			# Statistics section
+pointer	rdnoise			# CCD read noise
+pointer	gain			# CCD gain
+pointer	snoise			# CCD sensitivity noise
+real	lthresh			# Low threshold
+real	hthresh			# High threshold
+int	nkeep			# Minimum to keep
+real	lsigma			# Low sigma cutoff
+real	hsigma			# High sigma cutoff
+real	pclip			# Number or fraction of pixels from median
+real	flow			# Fraction of low pixels to reject
+real	fhigh			# Fraction of high pixels to reject
+real	grow			# Grow radius
+bool	mclip			# Use median in sigma clipping?
+real	sigscale		# Sigma scaling tolerance
+int	logfd			# Log file descriptor
+
+# These flags allow special conditions to be optimized.
+
+int	dflag			# Data flag (D_ALL, D_NONE, D_MIX)
+bool	aligned			# Are the images aligned?
+bool	doscale			# Do the images have to be scaled?
+bool	doscale1		# Do the sigma calculations have to be scaled?
+bool	dothresh		# Check pixels outside specified thresholds?
+bool	dowts			# Does the final average have to be weighted?
+bool	keepids			# Keep track of the image indices?
+bool	docombine		# Call the combine procedure?
+bool	sort			# Sort data?
+bool	verbose			# Verbose?
+
+pointer	icm			# Mask data structure
+
+common	/imccom/ combine, reject, blank, ictask, expkeyword, statsec, rdnoise,
+		 gain, snoise, lsigma, hsigma, lthresh, hthresh, nkeep,
+		 pclip, flow, fhigh, grow, logfd, dflag, sigscale, project,
+		 mclip, aligned, doscale, doscale1, dothresh, dowts,
+		 keepids, docombine, sort, verbose, icm
diff --git a/noao/twodspec/longslit/lscombine/src/icombine.h b/noao/twodspec/longslit/lscombine/src/icombine.h
new file mode 100644
index 00000000..016172de
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icombine.h
@@ -0,0 +1,53 @@
+# ICOMBINE Definitions
+
+# Memory management parameters;
+define	MAXMEMORY		250000000	# maximum memory
+define	FUDGE			0.8		# fudge factor
+
+# Rejection options:
+define	REJECT	"|none|ccdclip|crreject|minmax|pclip|sigclip|avsigclip|"
+define	NONE		1	# No rejection algorithm
+define	CCDCLIP		2	# CCD noise function clipping
+define	CRREJECT	3	# CCD noise function clipping
+define	MINMAX		4	# Minmax rejection
+define	PCLIP		5	# Percentile clip
+define	SIGCLIP		6	# Sigma clip
+define	AVSIGCLIP	7	# Sigma clip with average poisson sigma
+
+# Combine options:
+define	COMBINE	"|average|median|sum|"
+define	AVERAGE		1
+define	MEDIAN		2
+define	SUM		3
+
+# Scaling options:
+define	STYPES		"|none|mode|median|mean|exposure|"
+define	ZTYPES		"|none|mode|median|mean|"
+define	WTYPES		"|none|mode|median|mean|exposure|"
+define	S_NONE		1
+define	S_MODE		2
+define	S_MEDIAN	3
+define	S_MEAN		4
+define	S_EXPOSURE	5
+define	S_FILE		6
+define	S_KEYWORD	7
+define	S_SECTION	"|input|output|overlap|"
+define	S_INPUT		1
+define	S_OUTPUT	2
+define	S_OVERLAP	3
+
+# Mask options
+define	MASKTYPES	"|none|goodvalue|badvalue|goodbits|badbits|"
+define	M_NONE		1	# Don't use mask images
+define	M_GOODVAL	2	# Value selecting good pixels
+define	M_BADVAL	3	# Value selecting bad pixels
+define	M_GOODBITS	4	# Bits selecting good pixels
+define	M_BADBITS	5	# Bits selecting bad pixels
+define	M_BOOLEAN	-1	# Ignore mask values
+
+# Data flag
+define	D_ALL		0	# All pixels are good
+define	D_NONE		1	# All pixels are bad or rejected
+define	D_MIX		2	# Mixture of good and bad pixels
+
+define	TOL		0.001	# Tolerance for equal residuals
diff --git a/noao/twodspec/longslit/lscombine/src/icombine.x b/noao/twodspec/longslit/lscombine/src/icombine.x
new file mode 100644
index 00000000..d7b1d1e7
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icombine.x
@@ -0,0 +1,476 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<error.h>
+include	<syserr.h>
+include	"icombine.h"
+
+
+# ICOMBINE -- Combine input list or image.
+# This procedure maps the images, sets the output dimensions and datatype,
+# opens the logfile, and sets IMIO parameters.  It attempts to adjust
+# buffer sizes and memory requirements for maximum efficiency.
+
+procedure icombine (list, output, headers, bmask, rmask, nrmask, emask,
+	sigma, logfile, scales, zeros, wts, stack, delete)
+
+int	list				#I List of input images
+char	output[ARB]			#I Output image
+char	headers[ARB]			#I Output header rootname
+char	bmask[ARB]			#I Bad pixel mask
+char	rmask[ARB]			#I Rejection mask
+char	nrmask[ARB]			#I Nreject mask
+char	emask[ARB]			#I Exposure mask
+char	sigma[ARB]			#I Sigma image (optional)
+char	logfile[ARB]			#I Logfile (optional)
+real	scales[ARB]			#I Scale factors
+real	zeros[ARB]			#I Offset factors
+real	wts[ARB]			#I Weights
+int	stack				#I Stack input images?
+int	delete				#I Delete input images?
+
+bool	proj
+char	input[SZ_FNAME], errstr[SZ_LINE]
+int	i, j, nimages, intype, bufsize, maxsize, memory, oldsize, stack1, err
+pointer	sp, im, in1, in, out[6], offsets, key, tmp, bpmstack 
+
+char	clgetc()
+int	clgwrd(), imtlen(), imtgetim(), imtrgetim(), getdatatype()
+int	begmem(), errget(), open(), ty_max(), sizeof(), strmatch()
+pointer	immap(), xt_immap(), ic_pmmap()
+errchk	ic_imstack, immap, imunmap, xt_immap, ic_pmmap, ic_setout
+
+include	"icombine.com"
+
+define	retry_	98
+define	err_	99
+
+begin
+	nimages = imtlen (list)
+	if (nimages == 0)
+	    call error (1, "No images to combine")
+
+	if (project) {
+	    if (imtgetim (list, input, SZ_FNAME) == EOF)
+		call error (1, "No image to project")
+	}
+
+	bufsize = 0
+#	if (nimages > LAST_FD - 15)
+#	    stack1 = YES
+#	else
+	    stack1 = stack
+
+retry_
+	iferr {
+	    call smark (sp)
+	    call salloc (in, 1, TY_POINTER)
+
+	    nimages = 0
+	    in1 = NULL; Memi[in] = NULL; logfd = NULL
+	    out[1] = NULL; out[2] = NULL; out[3] = NULL
+	    out[4] = NULL; out[5] = NULL; out[6] = NULL
+
+	    # Stack the input images.
+	    if (stack1 == YES) {
+		proj = project
+		project = true
+		call salloc (bpmstack, SZ_FNAME, TY_CHAR)
+		i = clgwrd ("masktype", Memc[bpmstack], SZ_FNAME, MASKTYPES)
+		if (i == M_NONE)
+		    Memc[bpmstack] = EOS
+		else {
+		    call mktemp ("tmp", Memc[bpmstack], SZ_FNAME)
+		    call strcat (".pl", Memc[bpmstack], SZ_FNAME)
+		}
+		call mktemp ("tmp", input, SZ_FNAME)
+		call imtrew (list)
+		call ic_imstack (list, input, Memc[bpmstack])
+	    }
+
+	    # Open the input image(s).
+	    if (project) {
+		tmp = immap (input, READ_ONLY, 0); out[1] = tmp
+		if (IM_NDIM(out[1]) == 1)
+		    call error (1, "Can't project one dimensional images")
+		nimages = IM_LEN(out[1],IM_NDIM(out[1]))
+		call salloc (in, nimages, TY_POINTER)
+		call amovki (out[1], Memi[in], nimages)
+	    } else {
+		call salloc (in, imtlen(list), TY_POINTER)
+		call amovki (NULL, Memi[in], imtlen(list))
+		call imtrew (list)
+		while (imtgetim (list, input, SZ_FNAME)!=EOF) {
+		    nimages = nimages + 1
+		    tmp = xt_immap (input, READ_ONLY, 0, nimages)
+		    Memi[in+nimages-1] = tmp
+		}
+
+		# Check sizes and set I/O option.
+		intype = 0
+		tmp = Memi[in]
+		do i = 2, nimages {
+		    do j = 1, IM_NDIM(tmp) {
+			if (IM_LEN(tmp,j) != IM_LEN(Memi[in+i-1],j))
+			    intype = 1
+		    }
+		    if (intype == 1)
+			break
+		}
+		if (intype == 1)
+		    call xt_imseti (0, "option", intype)
+	    }
+
+	    # Check if there are no images.
+	    if (nimages == 0)
+		call error (1, "No images to combine")
+
+	    # Convert the pclip parameter to a number of pixels rather than
+	    # a fraction.  This number stays constant even if pixels are
+	    # rejected.  The number of low and high pixel rejected, however,
+	    # are converted to a fraction of the valid pixels.
+
+	    if (reject == PCLIP) {
+		i = nimages / 2.
+		if (abs (pclip) < 1.)
+		    pclip = pclip * i
+		if (pclip < 0.)
+		    pclip = min (-1, max (-i, int (pclip)))
+		else
+		    pclip = max (1, min (i, int (pclip)))
+	    }
+
+	    if (reject == MINMAX) {
+		if (flow >= 1)
+		    flow = flow / nimages
+		if (fhigh >= 1)
+		    fhigh = fhigh / nimages
+		i = flow * nimages
+		j = fhigh * nimages
+		if (i + j == 0)
+		    reject = NONE
+		else if (i + j >= nimages)
+		    call error (1, "Bad minmax rejection parameters")
+	    }
+
+	    # Map the output image and set dimensions and offsets.
+	    if (stack1 == YES) {
+		call imtrew (list)
+		i = imtgetim (list, errstr, SZ_LINE)
+		in1 = immap (errstr, READ_ONLY, 0)
+		tmp = immap (output, NEW_COPY, in1); out[1] = tmp
+		call salloc (key, SZ_FNAME, TY_CHAR)
+		do i = 1, nimages {
+		    call sprintf (Memc[key], SZ_FNAME, "stck%04d")
+			call pargi (i)
+		    iferr (call imdelf (out[1], Memc[key]))
+			;
+		    if (Memc[bpmstack] != EOS) {
+			call sprintf (Memc[key], SZ_FNAME, "bpm%04d")
+			    call pargi (i)
+			iferr (call imdelf (out[1], Memc[key]))
+			    ;
+		    }
+		}
+	    } else {
+		tmp = immap (output, NEW_COPY, Memi[in]); out[1] = tmp
+		if (project) {
+		    IM_LEN(out[1],IM_NDIM(out[1])) = 1
+		    IM_NDIM(out[1]) = IM_NDIM(out[1]) - 1
+		}
+	    }
+	    call salloc (offsets, nimages*IM_NDIM(out[1]), TY_INT)
+	    iferr (call ic_setout (Memi[in], out, Memi[offsets], nimages)) {
+		call erract (EA_WARN)
+		call error (1, "Can't set output geometry")
+	    }
+	    call ic_hdr (Memi[in], out, nimages)
+	    iferr (call imdelf (out, "BPM"))
+		;
+	    iferr (call imdelf (out, "ICFNAME"))
+		;
+
+	    # Determine the highest precedence datatype and set output datatype.
+	    intype = IM_PIXTYPE(Memi[in])
+	    do i = 2, nimages
+		intype = ty_max (intype, IM_PIXTYPE(Memi[in+i-1]))
+	    IM_PIXTYPE(out[1]) = getdatatype (clgetc ("outtype"))
+	    if (IM_PIXTYPE(out[1]) == ERR)
+		IM_PIXTYPE(out[1]) = intype
+
+	    # Open rejection masks
+	    if (rmask[1] != EOS) {
+		tmp = ic_pmmap (rmask, NEW_COPY, out[1]); out[4] = tmp
+		IM_NDIM(out[4]) = IM_NDIM(out[4]) + 1
+		IM_LEN(out[4],IM_NDIM(out[4])) = nimages
+		if (!project) {
+		    if (key == NULL)
+			call salloc (key, SZ_FNAME, TY_CHAR)
+		    do i = 100, nimages {
+			j = imtrgetim (list, i, input, SZ_FNAME)
+			if (i < 999)
+			    call sprintf (Memc[key], SZ_FNAME, "imcmb%d")
+			else if (i < 9999)
+			    call sprintf (Memc[key], SZ_FNAME, "imcm%d")
+			else
+			    call sprintf (Memc[key], SZ_FNAME, "imc%d")
+			    call pargi (i)
+			call imastr (out[4], Memc[key], input)
+		    }
+		}
+	    } else
+		out[4] = NULL
+
+	    # Open bad pixel pixel list file if given.
+	    if (bmask[1] != EOS) {
+		tmp = ic_pmmap (bmask, NEW_COPY, out[1]); out[2] = tmp
+	    } else
+		out[2] = NULL
+
+	    # Open nreject pixel list file if given.
+	    if (nrmask[1] != EOS) {
+		tmp = ic_pmmap (nrmask, NEW_COPY, out[1]); out[5] = tmp
+	    } else
+		out[5] = NULL
+
+	    # Open exposure mask if given.
+	    if (emask[1] != EOS) {
+		tmp = ic_pmmap (emask, NEW_COPY, out[1]); out[6] = tmp
+	    } else
+		out[6] = NULL
+
+	    # Open the sigma image if given.
+	    if (sigma[1] != EOS) {
+		tmp = immap (sigma, NEW_COPY, out[1]); out[3] = tmp
+		IM_PIXTYPE(out[3]) = ty_max (TY_REAL, IM_PIXTYPE(out[1]))
+		call sprintf (IM_TITLE(out[3]), SZ_IMTITLE,
+		    "Combine sigma images for %s")
+		    call pargstr (output)
+	    } else
+		out[3] = NULL
+
+	    # Open masks.
+	    call ic_mopen (Memi[in], out, nimages, Memi[offsets])
+
+	    # Open the log file.
+	    logfd = NULL
+	    if (logfile[1] != EOS) {
+		iferr (logfd = open (logfile, APPEND, TEXT_FILE)) {
+		    logfd = NULL
+		    call erract (EA_WARN)
+		}
+	    }
+
+	    if (bufsize == 0) {
+		# Set initial IMIO buffer size based on the number of images
+		# and maximum amount of working memory available.  The buffer
+		# size may be adjusted later if the task runs out of memory.
+		# The FUDGE factor is used to allow for the size of the
+		# program, memory allocator inefficiencies, and any other
+		# memory requirements besides IMIO.
+
+		memory = begmem (0, oldsize, maxsize)
+		memory = min (memory, maxsize, MAXMEMORY)
+		bufsize = FUDGE * memory / (nimages + 1) / sizeof (intype)
+	    }
+
+	    # Combine the images.  If an out of memory error occurs close all
+	    # images and files, divide the IMIO buffer size in half and try
+	    # again. 
+
+	    switch (ty_max (intype, IM_PIXTYPE(out[1]))) {
+	    case TY_SHORT:
+		call icombines (Memi[in], out, scales, zeros,
+		    wts, Memi[offsets], nimages, bufsize)
+	    case TY_USHORT, TY_INT, TY_LONG:
+		call icombinei (Memi[in], out, scales, zeros,
+		    wts, Memi[offsets], nimages, bufsize)
+	    case TY_DOUBLE:
+		call icombined (Memi[in], out, scales, zeros,
+		    wts, Memi[offsets], nimages, bufsize)
+	    case TY_COMPLEX:
+		call error (1, "Complex images not allowed")
+	    default:
+		call icombiner (Memi[in], out, scales, zeros,
+		    wts, Memi[offsets], nimages, bufsize)
+	    }
+	} then {
+	    err = errget (errstr, SZ_LINE)
+	    if (err == SYS_IKIOPIX && nimages < 250)
+		err = SYS_MFULL
+	    call ic_mclose (nimages)
+	    if (!project) {
+		do j = 2, nimages {
+		    if (Memi[in+j-1] != NULL)
+			call xt_imunmap (Memi[in+j-1], j)
+		}
+	    }
+	    if (out[2] != NULL) {
+		call imunmap (out[2])
+		iferr (call imdelete (bmask))
+		    ;
+	    }
+	    if (out[3] != NULL) {
+		call imunmap (out[3])
+		iferr (call imdelete (sigma))
+		    ;
+	    }
+	    if (out[4] != NULL) {
+		call imunmap (out[4])
+		iferr (call imdelete (rmask))
+		    ;
+	    }
+	    if (out[5] != NULL) {
+		call imunmap (out[5])
+		iferr (call imdelete (nrmask))
+		    ;
+	    }
+	    if (out[6] != NULL) {
+		call imunmap (out[6])
+		iferr (call imdelete (emask))
+		    ;
+	    }
+	    if (out[1] != NULL) {
+		call imunmap (out[1])
+		iferr (call imdelete (output))
+		    ;
+	    }
+	    if (Memi[in] != NULL)
+		call xt_imunmap (Memi[in], 1)
+	    if (in1 != NULL)
+		call imunmap (in1)
+	    if (logfd != NULL)
+		call close (logfd)
+
+	    switch (err) {
+	    case SYS_MFULL:
+		if (project)
+		    goto err_
+
+		if (bufsize < 10000) {
+		    call strcat ("- Maybe min_lenuserarea is too large",
+			errstr, SZ_LINE)
+		    goto err_
+		}
+
+		bufsize = bufsize / 2
+		call sfree (sp)
+		goto retry_
+	    case SYS_FTOOMANYFILES, SYS_IKIOPEN, SYS_IKIOPIX, SYS_FOPEN, SYS_FWTNOACC:
+		if (project)
+		    goto err_
+		stack1 = YES
+		call sfree (sp)
+		goto retry_
+	    default:
+err_
+		if (stack1 == YES) {
+		    iferr (call imdelete (input))
+			;
+		    if (Memc[bpmstack] != EOS) {
+			iferr (call imdelete (Memc[bpmstack]))
+			    ;
+		    }
+		}
+		call fixmem (oldsize)
+		while (imtgetim (list, input, SZ_FNAME)!=EOF)
+		    ;
+		call sfree (sp)
+		call error (err, errstr)
+	    }
+	}
+
+	# Unmap all the images, close the log file, and restore memory.
+	if (out[2] != NULL)
+	    iferr (call imunmap (out[2]))
+		call erract (EA_WARN)
+	if (out[3] != NULL)
+	    iferr (call imunmap (out[3]))
+		call erract (EA_WARN)
+	if (out[4] != NULL) {
+	    # Close the output first so that there is no confusion with
+	    # inheriting the output header.  Then update the WCS for the
+	    # extra dimension.  Note that this may not be correct with
+	    # axis reduced WCS.
+	    iferr {
+		call imunmap (out[4])
+		out[4] = immap (rmask, READ_WRITE, 0)
+		i = IM_NDIM(out[4])
+		call imaddi (out[4], "WCSDIM", i)
+		call sprintf (errstr, SZ_LINE, "LTM%d_%d")
+		    call pargi (i)
+		    call pargi (i)
+		call imaddr (out[4], errstr, 1.)
+		call sprintf (errstr, SZ_LINE, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (i)
+		call imaddr (out[4], errstr, 1.)
+		call imunmap (out[4])
+	    } then
+		call erract (EA_WARN)
+	}
+	if (out[5] != NULL)
+	    iferr (call imunmap (out[5]))
+		call erract (EA_WARN)
+	if (out[6] != NULL)
+	    iferr (call imunmap (out[6]))
+		call erract (EA_WARN)
+	if (out[1] != NULL) {
+	    call imunmap (out[1])
+	    if (headers[1] != EOS) {
+		# Write input headers to a multiextension file if desired.
+		# This might be the same as the output image.
+		iferr {
+		    do i = 1, nimages {
+			im = Memi[in+i-1]
+			call imstats (im, IM_IMAGENAME, input, SZ_FNAME)
+			if (strmatch (headers, ".fits$") == 0) {
+			    call sprintf (errstr, SZ_LINE, "%s.fits[append]")
+				call pargstr (headers)
+			} else {
+			    call sprintf (errstr, SZ_LINE, "%s[append]")
+				call pargstr (headers)
+			}
+			tmp = immap (errstr, NEW_COPY, im)
+			IM_NDIM(tmp) = 0
+			do j = 1, IM_NDIM(im) {
+			    call sprintf (errstr, SZ_LINE, "AXLEN%d")
+				call pargi (j)
+			    call imaddi (tmp, errstr, IM_LEN(im,j))
+			}
+			call imastr (tmp, "INIMAGE", input)
+			call imastr (tmp, "OUTIMAGE", output)
+			call imastr (tmp, "EXTNAME", input)
+			call imunmap (tmp)
+		    }
+		    if (logfd != NULL) {
+			call eprintf ("  Headers = %s\n")
+			    call pargstr (headers)
+		    }
+		} then
+		    call erract (EA_WARN)
+	    }
+	}
+	if (!project) {
+	    do i = 2, nimages {
+		if (Memi[in+i-1] != NULL)
+		    call xt_imunmap (Memi[in+i-1], i)
+	    }
+	}
+	if (Memi[in] != NULL)
+	    call xt_imunmap (Memi[in], 1)
+	if (in1 != NULL)
+	    call imunmap (in1)
+	if (stack1 == YES) {
+	    call imdelete (input)
+	    if (Memc[bpmstack] != EOS)
+		call imdelete (Memc[bpmstack])
+	    project = proj
+	}
+	if (logfd != NULL)
+	    call close (logfd)
+	call ic_mclose (nimages)
+	call fixmem (oldsize)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icpclip.gx b/noao/twodspec/longslit/lscombine/src/icpclip.gx
new file mode 100644
index 00000000..f0c76369
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icpclip.gx
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		3	# Minimum number for clipping
+
+$for (sird)
+# IC_PCLIP -- Percentile clip
+#
+# 1) Find the median
+# 2) Find the pixel which is the specified order index away
+# 3) Use the data value difference as a sigma and apply clipping
+# 4) Since the median is known return it so it does not have to be recomputed
+
+procedure ic_pclip$t (d, m, n, nimages, npts, median)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[npts]			# Number of good pixels
+int	nimages			# Number of input images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep
+bool	even, fp_equalr()
+real	sigma, r, s, t
+pointer	sp, resid, mp1, mp2
+$if (datatype == sil)
+real	med
+$else
+PIXEL	med
+$endif
+
+include	"../icombine.com"
+
+begin
+	# There must be at least MINCLIP and more than nkeep pixels.
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+
+	# Set sign of pclip parameter
+	if (pclip < 0)
+	    t = -1.
+	else
+	    t = 1.
+
+	# If there are no rejected pixels compute certain parameters once.
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    n2 = 1 + n1 / 2
+	    even = (mod (n1, 2) == 0)
+	    if (pclip < 0.) {
+		if (even)
+		    n3 = max (1, nint (n2 - 1 + pclip))
+		else
+		    n3 = max (1, nint (n2 + pclip))
+	    } else
+		n3 = min (n1, nint (n2 + pclip))
+	    nin = n1
+	}
+
+	# Now apply clipping.
+	do i = 1, npts {
+	    # Compute median.
+	    if (dflag == D_MIX) {
+		n1 = n[i]
+		if (nkeep < 0)
+		    maxkeep = max (0, n1 + nkeep)
+		else
+		    maxkeep = min (n1, nkeep)
+		if (n1 == 0) {
+		    if (combine == MEDIAN)
+			median[i] = blank
+		    next
+		}
+		n2 = 1 + n1 / 2
+		even = (mod (n1, 2) == 0)
+		if (pclip < 0) {
+		    if (even)
+			n3 = max (1, nint (n2 - 1 + pclip))
+		    else
+			n3 = max (1, nint (n2 + pclip))
+		} else
+		    n3 = min (n1, nint (n2 + pclip))
+	    }
+
+	    j = i - 1 
+	    if (even) {
+		med = Mem$t[d[n2-1]+j]
+		med = (med + Mem$t[d[n2]+j]) / 2.
+	    } else
+		med = Mem$t[d[n2]+j]
+
+	    if (n1 < max (MINCLIP, maxkeep+1)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Define sigma for clipping
+	    sigma = t * (Mem$t[d[n3]+j] - med)
+	    if (fp_equalr (sigma, 0.)) {
+		if (combine == MEDIAN)
+		    median[i] = med
+		next
+	    }
+
+	    # Reject pixels and save residuals.
+	    # Check if any pixels are clipped.
+	    # If so recompute the median and reset the number of good pixels.
+	    # Only reorder if needed.
+
+	    for (nl=1; nl<=n1; nl=nl+1) {
+		r = (med - Mem$t[d[nl]+j]) / sigma
+		if (r < lsigma)
+		    break
+		Memr[resid+nl] = r
+	    }
+	    for (nh=n1; nh>=1; nh=nh-1) {
+		r = (Mem$t[d[nh]+j] -  med) / sigma
+		if (r < hsigma)
+		    break
+		Memr[resid+nh] = r
+	    }
+	    n4 = nh - nl + 1
+
+	    # If too many pixels are rejected add some back in.
+	    # All pixels with the same residual are added.
+	    while (n4 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n4 = nh - nl + 1
+	    }
+
+	    # If any pixels are rejected recompute the median.
+	    if (nl > 1 || nh < n1) {
+		n5 = nl + n4 / 2
+		if (mod (n4, 2) == 0) {
+		    med = Mem$t[d[n5-1]+j]
+		    med = (med + Mem$t[d[n5]+j]) / 2.
+		} else
+		    med = Mem$t[d[n5]+j]
+		n[i] = n4
+	    }
+	    if (combine == MEDIAN)
+		median[i] = med
+
+	    # Reorder if pixels only if necessary.
+	    if (nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		k = max (nl, n4 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mem$t[d[l]+j] = Mem$t[d[k]+j]
+			if (grow >= 1.) {
+			    mp1 = m[l] + j
+			    mp2 = m[k] + j
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+j] = Memi[m[k]+j]
+			k = k + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mem$t[d[l]+j] = Mem$t[d[k]+j]
+			k = k + 1
+		    }
+		}
+	    }
+	}
+
+	# Check if data flag needs to be reset for rejected pixels.
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag whether the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icpmmap.x b/noao/twodspec/longslit/lscombine/src/icpmmap.x
new file mode 100644
index 00000000..1afeedd7
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icpmmap.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+
+
+# IC_PMMAP -- Map pixel mask.
+
+pointer procedure ic_pmmap (fname, mode, refim)
+
+char	fname[ARB]		# Mask name
+int	mode			# Image mode
+pointer	refim			# Reference image
+pointer	pm			# IMIO pointer (returned)
+
+int	i, fnextn()
+pointer	sp, extn, immap()
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	i = fnextn (fname, Memc[extn], SZ_FNAME)
+	if (streq (Memc[extn], "pl"))
+	    pm = immap (fname, mode, refim)
+	else {
+	    call strcpy (fname, Memc[extn], SZ_FNAME)
+	    call strcat (".pl", Memc[extn], SZ_FNAME)
+	    pm = immap (Memc[extn], mode, refim)
+	}
+
+	call sfree (sp)
+	return (pm)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icrmasks.x b/noao/twodspec/longslit/lscombine/src/icrmasks.x
new file mode 100644
index 00000000..8b9a0c3d
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icrmasks.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+
+# IC_RMASKS --  Set pixels for rejection mask.
+
+procedure ic_rmasks (pm, v, id, nimages, n, npts)
+
+pointer	pm			#I Pixel mask
+long	v[ARB]			#I Output vector (input)
+pointer	id[nimages]		#I Image id pointers
+int	nimages			#I Number of images
+int	n[npts]			#I Number of good pixels
+int	npts			#I Number of output points per line
+
+int	i, j, k, ndim, impnls()
+long	v1[IM_MAXDIM]
+pointer	buf
+
+begin
+	ndim = IM_NDIM(pm)
+	do k = 1, nimages {
+	    call amovl (v, v1, ndim-1)
+	    v1[ndim] = k
+	    i = impnls (pm, buf, v1)
+	    do j = 1, npts {
+		if (n[j] == nimages)
+		    Mems[buf+j-1] = 0
+		else {
+		    Mems[buf+j-1] = 1
+		    do i = 1, n[j] {
+			if (Memi[id[i]+j-1] == k) {
+			    Mems[buf+j-1] = 0
+			    break
+			}
+		    }
+		}
+	    }
+	}
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icscale.x b/noao/twodspec/longslit/lscombine/src/icscale.x
new file mode 100644
index 00000000..42d62f8d
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icscale.x
@@ -0,0 +1,351 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	"icombine.h"
+
+
+# IC_SCALE -- Get and set the scaling factors.
+#
+# If the scaling parameters have been set earlier then this routine
+# just normalizes the factors and writes the log output.
+# When dealing with individual images using image statistics for scaling
+# factors this routine determines the image statistics rather than being
+# done earlier since the input images have all been mapped at this stage.
+
+procedure ic_scale (in, out, offsets, scales, zeros, wts, nimages)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+int	offsets[nimages,ARB]	# Image offsets
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero or sky levels
+real	wts[nimages]		# Weights
+int	nimages			# Number of images
+
+int	stype, ztype, wtype
+int	i, j, k, l, nout
+real	mode, median, mean, sumwts
+pointer	sp, ncombine, exptime, modes, medians, means
+pointer	section, str, sname, zname, wname, im, imref
+bool	domode, domedian, domean, dozero, dos, doz, dow, snorm, znorm, wflag
+
+int	imgeti(), strdic(), ic_gscale()
+real	imgetr(), asumr(), asumi()
+pointer	xt_opix()
+errchk	ic_gscale, xt_opix, ic_statr
+
+include	"icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (ncombine, nimages, TY_INT)
+	call salloc (exptime, nimages, TY_REAL)
+	call salloc (modes, nimages, TY_REAL)
+	call salloc (medians, nimages, TY_REAL)
+	call salloc (means, nimages, TY_REAL)
+	call salloc (section, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (sname, SZ_FNAME, TY_CHAR)
+	call salloc (zname, SZ_FNAME, TY_CHAR)
+	call salloc (wname, SZ_FNAME, TY_CHAR)
+
+	# Get the number of images previously combined and the exposure times.
+	# The default combine number is 1 and the default exposure is 0.
+
+	do i = 1, nimages {
+	    iferr (Memi[ncombine+i-1] = imgeti (in[i], "ncombine"))
+		Memi[ncombine+i-1] = 1
+	    if (Memc[expkeyword] != EOS) {
+	        iferr (Memr[exptime+i-1] = imgetr (in[i], Memc[expkeyword]))
+		    Memr[exptime+i-1] = 0.
+	    } else
+		Memr[exptime+i-1] = 0.
+	    if (project) {
+		call amovki (Memi[ncombine], Memi[ncombine], nimages)
+		call amovkr (Memr[exptime], Memr[exptime], nimages)
+		break
+	    }
+	}
+
+	# Set scaling type and factors.
+	stype = ic_gscale ("scale", Memc[sname], STYPES, in, Memr[exptime],
+	    scales, nimages)
+	ztype = ic_gscale ("zero", Memc[zname], ZTYPES, in, Memr[exptime],
+	    zeros, nimages)
+	wtype = ic_gscale ("weight", Memc[wname], WTYPES, in, Memr[exptime],
+	    wts, nimages)
+
+	# Get image statistics if needed.
+	dos = ((stype==S_MODE)||(stype==S_MEDIAN)||(stype==S_MEAN))
+	doz = ((ztype==S_MODE)||(ztype==S_MEDIAN)||(ztype==S_MEAN))
+	dow = ((wtype==S_MODE)||(wtype==S_MEDIAN)||(wtype==S_MEAN))
+	if (dos) {
+	    dos = false
+	    do i = 1, nimages
+		if (IS_INDEFR(scales[i])) {
+		    dos = true
+		    break
+		}
+	}
+	if (doz) {
+	    doz = false
+	    do i = 1, nimages
+		if (IS_INDEFR(zeros[i])) {
+		    doz = true
+		    break
+		}
+	}
+	if (dow) {
+	    dow = false
+	    do i = 1, nimages
+		if (IS_INDEFR(wts[i])) {
+		    dow = true
+		    break
+		}
+	}
+
+	if (dos || doz || dow) {
+	    domode = ((stype==S_MODE)||(ztype==S_MODE)||(wtype==S_MODE))
+	    domedian = ((stype==S_MEDIAN)||(ztype==S_MEDIAN)||(wtype==S_MEDIAN))
+	    domean = ((stype==S_MEAN)||(ztype==S_MEAN)||(wtype==S_MEAN))
+
+	    Memc[section] = EOS
+	    Memc[str] = EOS
+	    call sscan (Memc[statsec])
+	    call gargwrd (Memc[section], SZ_FNAME)
+	    call  gargwrd (Memc[str], SZ_LINE)
+
+	    i = strdic (Memc[section], Memc[section], SZ_FNAME, S_SECTION)
+	    switch (i) {
+	    case S_INPUT:
+		call strcpy (Memc[str], Memc[section], SZ_FNAME)
+		imref = NULL
+	    case S_OUTPUT:
+		call strcpy (Memc[str], Memc[section], SZ_FNAME)
+		imref = out[1]
+	    case S_OVERLAP:
+		call strcpy ("[", Memc[section], SZ_FNAME)
+		do i = 1, IM_NDIM(out[1]) {
+		    k = offsets[1,i] + 1
+		    l = offsets[1,i] + IM_LEN(in[1],i)
+		    do j = 2, nimages {
+			k = max (k, offsets[j,i]+1)
+			l = min (l, offsets[j,i]+IM_LEN(in[j],i))
+		    }
+		    if (i < IM_NDIM(out[1]))
+			call sprintf (Memc[str], SZ_LINE, "%d:%d,")
+		    else
+			call sprintf (Memc[str], SZ_LINE, "%d:%d]")
+			    call pargi (k)
+			    call pargi (l)
+		    call strcat (Memc[str], Memc[section], SZ_FNAME)
+		}
+		imref = out[1]
+	    default:
+		imref = NULL
+	    }
+
+	    do i = 1, nimages {
+		im = xt_opix (in[i], i, 0)
+		if (imref != out[1])
+		    imref = im
+		if ((dos && IS_INDEFR(scales[i])) ||
+		    (doz && IS_INDEFR(zeros[i])) ||
+		    (dow && IS_INDEFR(wts[i]))) {
+		    call ic_statr (im, imref, Memc[section], offsets, i,
+			nimages, domode, domedian, domean, mode, median, mean)
+		    if (domode) {
+			if (stype == S_MODE && IS_INDEFR(scales[i]))
+			    scales[i] = mode
+			if (ztype == S_MODE && IS_INDEFR(zeros[i]))
+			    zeros[i] = mode
+			if (wtype == S_MODE && IS_INDEFR(wts[i]))
+			    wts[i] = mode
+		    }
+		    if (domedian) {
+			if (stype == S_MEDIAN && IS_INDEFR(scales[i]))
+			    scales[i] = median
+			if (ztype == S_MEDIAN && IS_INDEFR(zeros[i]))
+			    zeros[i] = median
+			if (wtype == S_MEDIAN && IS_INDEFR(wts[i]))
+			    wts[i] = median
+		    }
+		    if (domean) {
+			if (stype == S_MEAN && IS_INDEFR(scales[i]))
+			    scales[i] = mean
+			if (ztype == S_MEAN && IS_INDEFR(zeros[i]))
+			    zeros[i] = mean
+			if (wtype == S_MEAN && IS_INDEFR(wts[i]))
+			    wts[i] = mean
+		    }
+		}
+	    }
+	}
+
+	# Save the image statistics if computed.
+	call amovkr (INDEFR, Memr[modes], nimages)
+	call amovkr (INDEFR, Memr[medians], nimages)
+	call amovkr (INDEFR, Memr[means], nimages)
+	if (stype == S_MODE)
+	    call amovr (scales, Memr[modes], nimages)
+	if (stype == S_MEDIAN)
+	    call amovr (scales, Memr[medians], nimages)
+	if (stype == S_MEAN)
+	    call amovr (scales, Memr[means], nimages)
+	if (ztype == S_MODE)
+	    call amovr (zeros, Memr[modes], nimages)
+	if (ztype == S_MEDIAN)
+	    call amovr (zeros, Memr[medians], nimages)
+	if (ztype == S_MEAN)
+	    call amovr (zeros, Memr[means], nimages)
+	if (wtype == S_MODE)
+	    call amovr (wts, Memr[modes], nimages)
+	if (wtype == S_MEDIAN)
+	    call amovr (wts, Memr[medians], nimages)
+	if (wtype == S_MEAN)
+	    call amovr (wts, Memr[means], nimages)
+
+	# If nothing else has set the scaling factors set them to defaults.
+	do i = 1, nimages {
+	    if (IS_INDEFR(scales[i]))
+		scales[i] = 1.
+	    if (IS_INDEFR(zeros[i]))
+		zeros[i] = 0.
+	    if (IS_INDEFR(wts[i]))
+		wts[i] = 1.
+	}
+
+	do i = 1, nimages
+	    if (scales[i] <= 0.) {
+		call eprintf ("WARNING: Negative scale factors")
+		call eprintf (" -- ignoring scaling\n")
+		call amovkr (1., scales, nimages)
+		break
+	    }
+
+	# Convert to factors relative to the first image.
+	snorm = (stype == S_FILE || stype == S_KEYWORD)
+	znorm = (ztype == S_FILE || ztype == S_KEYWORD)
+	wflag = (wtype == S_FILE || wtype == S_KEYWORD)
+	if (snorm)
+	    call arcpr (1., scales, scales, nimages)
+	mean = scales[1]
+	call adivkr (scales, mean, scales, nimages)
+	call adivr (zeros, scales, zeros, nimages)
+
+	if (wtype != S_NONE) {
+	    do i = 1, nimages {
+		if (wts[i] < 0.) {
+		    call eprintf ("WARNING: Negative weights")
+		    call eprintf (" -- using only NCOMBINE weights\n")
+		    do j = 1, nimages
+			wts[j] = Memi[ncombine+j-1]
+		    break
+		}
+		if (ztype == S_NONE || znorm || wflag)
+	            wts[i] = Memi[ncombine+i-1] * wts[i]
+		else {
+		    if (zeros[i] <= 0.) {
+			call eprintf ("WARNING: Negative zero offsets")
+			call eprintf (" -- ignoring zero weight adjustments\n")
+			do j = 1, nimages
+			    wts[j] = Memi[ncombine+j-1] * wts[j]
+			break
+		    }
+		    wts[i] = Memi[ncombine+i-1] * wts[i] * zeros[1] / zeros[i]
+		}
+	    }
+	}
+
+	if (znorm)
+	    call anegr (zeros, zeros, nimages)
+	else {
+	    # Because of finite arithmetic it is possible for the zero offsets
+	    # to be nonzero even when they are all equal.  Just for the sake of
+	    # a nice log set the zero offsets in this case.
+
+	    mean = zeros[1]
+	    call asubkr (zeros, mean, zeros, nimages)
+	    for (i=2; (i<=nimages)&&(zeros[i]==zeros[1]); i=i+1)
+		;
+	    if (i > nimages)
+		call aclrr (zeros, nimages)
+	}
+	mean = asumr (wts, nimages)
+	if (mean > 0.)
+	    call adivkr (wts, mean, wts, nimages)
+	else {
+	    call eprintf ("WARNING: Mean weight is zero -- using no weights\n")
+	    call amovkr (1., wts, nimages)
+	    mean = 1.
+	}
+
+	# Set flags for scaling, zero offsets, sigma scaling, weights.
+	# Sigma scaling may be suppressed if the scales or zeros are
+	# different by a specified tolerance.
+
+	doscale = false
+	dozero = false
+	doscale1 = false
+	dowts = false
+	do i = 2, nimages {
+	    if (snorm || scales[i] != scales[1])
+		doscale = true
+	    if (znorm || zeros[i] != zeros[1])
+		dozero = true
+	    if (wts[i] != wts[1])
+		dowts = true
+	}
+	if (doscale && sigscale != 0.) {
+	    do i = 1, nimages {
+		if (abs (scales[i] - 1) > sigscale) {
+		    doscale1 = true
+		    break
+		}
+	    }
+	}
+		    
+	# Set the output header parameters.
+	nout = asumi (Memi[ncombine], nimages)
+	call imaddi (out[1], "ncombine", nout)
+	mean = 0.
+	sumwts = 0.
+	do i = 1, nimages {
+	    ifnoerr (mode = imgetr (in[i], "ccdmean")) {
+		mean = mean + wts[i] * mode / scales[i]
+		sumwts = sumwts + wts[i]
+	    }
+	}
+	if (sumwts > 0.) {
+	    mean = mean / sumwts
+	    ifnoerr (mode = imgetr (out[1], "ccdmean")) {
+		call imaddr (out[1], "ccdmean", mean)
+		iferr (call imdelf (out[1], "ccdmeant"))
+		    ;
+	    }
+	}
+	if (out[2] != NULL) {
+	    call imstats (out[2], IM_IMAGENAME, Memc[str], SZ_FNAME)
+	    call imastr (out[1], "BPM", Memc[str])
+	}
+
+	# Start the log here since much of the info is only available here.
+	if (verbose) {
+	    i = logfd
+	    logfd = STDOUT
+	    call ic_log (in, out, Memi[ncombine], Memr[exptime], Memc[sname],
+		Memc[zname], Memc[wname], Memr[modes], Memr[medians],
+		Memr[means], scales, zeros, wts, offsets, nimages, dozero,
+		nout)
+
+	    logfd = i
+	}
+	call ic_log (in, out, Memi[ncombine], Memr[exptime], Memc[sname],
+	    Memc[zname], Memc[wname], Memr[modes], Memr[medians], Memr[means],
+	    scales, zeros, wts, offsets, nimages, dozero, nout)
+
+	doscale = (doscale || dozero)
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icsclip.gx b/noao/twodspec/longslit/lscombine/src/icsclip.gx
new file mode 100644
index 00000000..1b1c5de9
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icsclip.gx
@@ -0,0 +1,504 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+define	MINCLIP		3	# Mininum number of images for algorithm
+
+$for (sird)
+# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average
+# The initial average rejects the high and low pixels.  A correction for
+# different scalings of the images may be made.  Weights are not used.
+
+procedure ic_asigclip$t (d, m, n, scales, zeros, nimages, npts, average)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	average[npts]		# Average
+$else
+PIXEL	average[npts]		# Average
+$endif
+
+int	i, j, k, l, jj, n1, n2, nin, nk, maxkeep
+$if (datatype == sil)
+real	d1, low, high, sum, a, s, r, one
+data	one /1.0/
+$else
+PIXEL	d1, low, high, sum, a, s, r, one
+data	one /1$f/
+$endif
+pointer	sp, resid, w, wp, dp1, dp2, mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	} 
+	
+	# Flag whether returned average needs to be recomputed.
+	if (dowts || combine != AVERAGE)
+	    docombine = true
+	else
+	    docombine = false
+
+	# Save the residuals and the sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Do sigma clipping.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+
+	    # If there are not enough pixels simply compute the average.
+	    if (n1 < max (3, maxkeep)) {
+		if (!docombine) {
+		    if (n1 == 0)
+			average[i] = blank
+		    else {
+			sum = Mem$t[d[1]+k]
+			do j = 2, n1
+			    sum = sum + Mem$t[d[j]+k]
+			average[i] = sum / n1
+		    }
+		}
+		next
+	    }
+
+	    # Compute average with the high and low rejected.
+	    low = Mem$t[d[1]+k]
+	    high = Mem$t[d[2]+k]
+	    if (low > high) {
+		d1 = low
+		low = high
+		high = d1
+	    }
+	    sum = 0.
+	    do j = 3, n1 {
+	       d1 = Mem$t[d[j]+k]
+	       if (d1 < low) {
+		   sum = sum + low
+		   low = d1
+		} else if (d1 > high) {
+		    sum = sum + high
+		    high = d1
+		} else
+		    sum = sum + d1
+	    }
+	    a = sum / (n1 - 2)
+	    sum = sum + low + high
+
+	    # Iteratively reject pixels and compute the final average if needed.
+	    # Compact the data and keep track of the image IDs if needed.
+
+	    repeat {
+		n2 = n1
+		if (doscale1) {
+		    # Compute sigma corrected for scaling.
+		    s = 0.
+		    wp = w - 1
+		    do j = 1, n1 {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			wp = wp + 1
+
+			d1 = Mem$t[dp1]
+			l = Memi[mp1]
+			r = sqrt (max (one, (a + zeros[l]) / scales[l]))
+			s = s + ((d1 - a) / r) ** 2
+			Memr[wp] = r
+		    }
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    wp = w - 1
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    mp1 = m[j] + k
+			    wp = wp + 1
+
+			    d1 = Mem$t[dp1]
+			    r = (d1 - a) / (s * Memr[wp])
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    Memr[wp] = Memr[w+n1-1]
+				    mp2 = m[n1] + k
+				    l = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = l
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		} else {
+		    # Compute the sigma without scale correction.
+		    s = 0.
+		    do j = 1, n1
+			s = s + (Mem$t[d[j]+k] - a) ** 2
+		    s = sqrt (s / (n1 - 1))
+
+		    # Reject pixels.  Save the residuals and data values.
+		    if (s > 0.) {
+			for (j=1; j<=n1; j=j+1) {
+			    dp1 = d[j] + k
+			    d1 = Mem$t[dp1]
+			    r = (d1 - a) / s
+			    if (r < -lsigma || r > hsigma) {
+				Memr[resid+n1] = abs (r)
+				if (j < n1) {
+				    dp2 = d[n1] + k
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[n1] + k
+					l = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = l
+				    }
+				    j = j - 1
+				}
+				sum = sum - d1
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    } until (n1 == n2 || n1 <= max (2, maxkeep))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    if (n1 < maxkeep) {
+		nk = maxkeep
+		if (doscale1) {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			mp1 = m[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mem$t[dp1]
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    mp2 = m[l] + k
+				    s = Memi[mp1]
+				    Memi[mp1] = Memi[mp2]
+				    Memi[mp2] = s
+				}
+			    }
+			}
+			sum = sum + Mem$t[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		} else {
+		    for (j=n1+1; j<=nk; j=j+1) {
+			dp1 = d[j] + k
+			r = Memr[resid+j]
+			jj = 0
+			do l = j+1, n2 {
+			    s = Memr[resid+l]
+			    if (s < r + TOL) {
+				if (s > r - TOL)
+				    jj = jj + 1
+				else {
+				    jj = 0
+				    Memr[resid+l] = r
+				    r = s
+				    dp2 = d[l] + k
+				    d1 = Mem$t[dp1]
+				    Mem$t[dp1] = Mem$t[dp2]
+				    Mem$t[dp2] = d1
+				    if (keepids) {
+					mp1 = m[j] + k
+					mp2 = m[l] + k
+					s = Memi[mp1]
+					Memi[mp1] = Memi[mp2]
+					Memi[mp2] = s
+				    }
+				}
+			    }
+			}
+			sum = sum + Mem$t[dp1]
+			n1 = n1 + 1
+			nk = max (nk, j+jj)
+		    }
+		}
+
+		# Recompute the average.
+		if (n1 > 1)
+		    a = sum / n1
+	    }
+
+	    # Save the average if needed.
+	    n[i] = n1
+	    if (!docombine) {
+		if (n1 > 0)
+		    average[i] = a
+		else
+		    average[i] = blank
+	    }
+	}
+
+	# Check if the data flag has to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median
+
+procedure ic_msigclip$t (d, m, n, scales, zeros, nimages, npts, median)
+
+pointer	d[nimages]		# Data pointers
+pointer	m[nimages]		# Image id pointers
+int	n[npts]			# Number of good pixels
+real	scales[nimages]		# Scales
+real	zeros[nimages]		# Zeros
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep
+real	r, s
+pointer	sp, resid, w, mp1, mp2
+$if (datatype == sil)
+real	med, one
+data	one /1.0/
+$else
+PIXEL	med, one
+data	one /1$f/
+$endif
+
+include	"../icombine.com"
+
+begin
+	# If there are insufficient pixels go on to the combining
+	if (nkeep < 0)
+	    maxkeep = max (0, nimages + nkeep)
+	else
+	    maxkeep = min (nimages, nkeep)
+	if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) {
+	    docombine = true
+	    return
+	}
+
+	# Save the residuals and sigma scaling corrections if needed.
+	call smark (sp)
+	call salloc (resid, nimages+1, TY_REAL)
+	if (doscale1)
+	    call salloc (w, nimages, TY_REAL)
+
+	# Compute median and sigma and iteratively clip.
+	nin = n[1]
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    if (nkeep < 0)
+		maxkeep = max (0, n1 + nkeep)
+	    else
+		maxkeep = min (n1, nkeep)
+	    nl = 1
+	    nh = n1
+
+	    repeat {
+		n2 = n1
+		n3 = nl + n1 / 2
+
+		if (n1 == 0)
+		    med = blank
+		else if (mod (n1, 2) == 0)
+		    med = (Mem$t[d[n3-1]+k] + Mem$t[d[n3]+k]) / 2.
+		else
+		    med = Mem$t[d[n3]+k]
+
+		if (n1 >= max (MINCLIP, maxkeep+1)) {
+		    if (doscale1) {
+			# Compute the sigma with scaling correction.
+			s = 0.
+			do j = nl, nh {
+			    l = Memi[m[j]+k]
+			    r = sqrt (max (one, (med + zeros[l]) / scales[l]))
+			    s = s + ((Mem$t[d[j]+k] - med) / r) ** 2
+			    Memr[w+j-1] = r
+			}
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Mem$t[d[nl]+k]) / (s * Memr[w+nl-1])
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Mem$t[d[nh]+k] - med) / (s * Memr[w+nh-1])
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    } else {
+			# Compute the sigma without scaling correction.
+			s = 0.
+			do j = nl, nh
+			    s = s + (Mem$t[d[j]+k] - med) ** 2
+			s = sqrt (s / (n1 - 1))
+
+			# Reject pixels and save the residuals.
+			if (s > 0.) {
+			    for (; nl <= n2; nl = nl + 1) {
+				r = (med - Mem$t[d[nl]+k]) / s
+				if (r <= lsigma)
+				    break
+				Memr[resid+nl] = r
+				n1 = n1 - 1
+			    }
+			    for (; nh >= nl; nh = nh - 1) {
+				r = (Mem$t[d[nh]+k] -  med) / s
+				if (r <= hsigma)
+				    break
+				Memr[resid+nh] = r
+				n1 = n1 - 1
+			    }
+			}
+		    }
+		}
+	    } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1))
+
+	    # If too many pixels are rejected add some back.
+	    # All pixels with equal residuals are added back.
+	    while (n1 < maxkeep) {
+		if (nl == 1)
+		    nh = nh + 1
+		else if (nh == n[i])
+		    nl = nl - 1
+		else {
+		    r = Memr[resid+nl-1]
+		    s = Memr[resid+nh+1]
+		    if (r < s) {
+			nl = nl - 1
+			r = r + TOL
+			if (s <= r)
+			    nh = nh + 1
+			if (nl > 1) {
+			    if (Memr[resid+nl-1] <= r)
+				nl = nl - 1
+			}
+		    } else {
+			nh = nh + 1
+			s = s + TOL
+			if (r <= s)
+			    nl = nl - 1
+			if (nh < n2) {
+			    if (Memr[resid+nh+1] <= s)
+				nh = nh + 1
+			}
+		    }
+		}
+		n1 = nh - nl + 1
+	    }
+
+	    # Only set median and reorder if needed
+	    n[i] = n1
+	    if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Mem$t[d[l]+k] = Mem$t[d[j]+k]
+			if (grow >= 1.) {
+			    mp1 = m[l] + k
+			    mp2 = m[j] + k
+			    id = Memi[mp1]
+			    Memi[mp1] = Memi[mp2]
+			    Memi[mp2] = id
+			} else
+			    Memi[m[l]+k] = Memi[m[j]+k]
+			j = j + 1
+		    }
+		} else {
+		    do l = 1, min (n1, nl - 1) {
+			Mem$t[d[l]+k] = Mem$t[d[j]+k]
+			j = j + 1
+		    }
+		}
+	    }
+
+	    if (combine == MEDIAN)
+		median[i] = med
+	}
+
+	# Check if data flag needs to be reset for rejected pixels
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		if (n[i] != nin) {
+		    dflag = D_MIX
+		    break
+		}
+	    }
+	}
+
+	# Flag that the median has been computed.
+	if (combine == MEDIAN)
+	    docombine = false
+	else
+	    docombine = true
+
+	call sfree (sp)
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icsection.x b/noao/twodspec/longslit/lscombine/src/icsection.x
new file mode 100644
index 00000000..746c1f51
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icsection.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# IC_SECTION -- Parse an image section into its elements.
+# 1. The default values must be set by the caller.
+# 2. A null image section is OK.
+# 3. The first nonwhitespace character must be '['.
+# 4. The last interpreted character must be ']'.
+#
+# This procedure should be replaced with an IMIO procedure at some
+# point.
+
+procedure ic_section (section, x1, x2, xs, ndim)
+
+char	section[ARB]		# Image section
+int	x1[ndim]		# Starting pixel
+int	x2[ndim]		# Ending pixel
+int	xs[ndim]		# Step
+int	ndim			# Number of dimensions
+
+int	i, ip, a, b, c, temp, ctoi()
+define	error_	99
+
+begin
+	# Decode the section string.
+	ip = 1
+	while (IS_WHITE(section[ip]))
+	    ip = ip + 1
+	if (section[ip] == '[')
+	    ip = ip + 1
+	else if (section[ip] == EOS)
+	    return
+	else
+	    goto error_
+
+	do i = 1, ndim {
+	    while (IS_WHITE(section[ip]))
+	        ip = ip + 1
+	    if (section[ip] == ']')
+		break
+
+	    # Default values
+	    a = x1[i]
+	    b = x2[i]
+	    c = xs[i]
+
+	    # Get a:b:c.  Allow notation such as "-*:c"
+	    # (or even "-:c") where the step is obviously negative.
+
+	    if (ctoi (section, ip, temp) > 0) {			# a
+		a = temp
+	        if (section[ip] == ':') {	
+		    ip = ip + 1
+		    if (ctoi (section, ip, b) == 0)		# a:b
+		        goto error_
+	        } else
+		    b = a
+	    } else if (section[ip] == '-') {			# -*
+		temp = a
+		a = b
+		b = temp
+	        ip = ip + 1
+	        if (section[ip] == '*')
+		    ip = ip + 1
+	    } else if (section[ip] == '*')			# *
+	        ip = ip + 1
+	    if (section[ip] == ':') {				# ..:step
+	        ip = ip + 1
+	        if (ctoi (section, ip, c) == 0)
+		    goto error_
+	        else if (c == 0)
+		    goto error_
+	    }
+	    if (a > b && c > 0)
+	        c = -c
+
+	    x1[i] = a
+	    x2[i] = b
+	    xs[i] = c
+
+	    while (IS_WHITE(section[ip]))
+	        ip = ip + 1
+	    if (section[ip] == ',')
+		ip = ip + 1
+	}
+
+	if (section[ip] != ']')
+	    goto error_
+
+	return
+error_
+	call error (0, "Error in image section specification")
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icsetout.x b/noao/twodspec/longslit/lscombine/src/icsetout.x
new file mode 100644
index 00000000..51e1fe90
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icsetout.x
@@ -0,0 +1,322 @@
+include	<imhdr.h>
+include	<imset.h>
+include <mwset.h>
+
+define	OFFTYPES	"|none|wcs|world|physical|grid|"
+define	FILE		0
+define	NONE		1
+define	WCS		2
+define	WORLD		3
+define	PHYSICAL	4
+define	GRID		5
+
+# IC_SETOUT -- Set output image size and offsets of input images.
+
+procedure ic_setout (in, out, offsets, nimages)
+
+pointer	in[nimages]		# Input images
+pointer	out[ARB]		# Output images
+int	offsets[nimages,ARB]	# Offsets
+int	nimages			# Number of images
+
+int	i, j, indim, outdim, mwdim, a, b, amin, bmax, fd, offtype
+real	val
+bool	proj, reloff, flip, streq(), fp_equald()
+pointer	sp, str, fname
+pointer	ltv, lref, wref, cd, ltm, coord, shift, axno, axval, section
+pointer	mw, ct, mw_openim(), mw_sctran(), xt_immap()
+int	open(), fscan(), nscan(), mw_stati(), strlen(), strdic()
+errchk	mw_openim, mw_gwtermd, mw_gltermd, mw_gaxmap
+errchk	mw_sctran, mw_ctrand, open, xt_immap
+
+include	"icombine.com"
+define	newscan_ 10
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (ltv, IM_MAXDIM, TY_DOUBLE)
+	call salloc (ltm, IM_MAXDIM*IM_MAXDIM, TY_DOUBLE)
+	call salloc (lref, IM_MAXDIM, TY_DOUBLE)
+	call salloc (wref, IM_MAXDIM, TY_DOUBLE)
+	call salloc (cd, IM_MAXDIM*IM_MAXDIM, TY_DOUBLE)
+	call salloc (coord, IM_MAXDIM, TY_DOUBLE)
+	call salloc (shift, IM_MAXDIM, TY_REAL)
+	call salloc (axno, IM_MAXDIM, TY_INT)
+	call salloc (axval, IM_MAXDIM, TY_INT)
+
+	# Check and set the image dimensionality.
+	indim = IM_NDIM(in[1])
+	outdim = IM_NDIM(out[1])
+	proj = (indim != outdim)
+	if (!proj) {
+	    do i = 1, nimages
+		if (IM_NDIM(in[i]) != outdim) {
+		    call sfree (sp)
+		    call error (1, "Image dimensions are not the same")
+		}
+	}
+
+	# Set the reference point to that of the first image.
+	mw = mw_openim (in[1])
+	call mw_seti (mw, MW_USEAXMAP, NO)
+	mwdim = mw_stati (mw, MW_NPHYSDIM)
+	call mw_gwtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim)
+	ct = mw_sctran (mw, "world", "logical", 0)
+	call mw_ctrand (ct, Memd[wref], Memd[lref], mwdim)
+	call mw_ctfree (ct)
+	if (proj)
+	    Memd[lref+outdim] = 1
+
+	# Parse the user offset string.  If "none" then there are no offsets.
+	# If "world" or "wcs" then set the offsets based on the world WCS.
+	# If "physical" then set the offsets based on the physical WCS.
+	# If "grid" then set the offsets based on the input grid parameters.
+	# If a file scan it.
+
+	call clgstr ("offsets", Memc[fname], SZ_FNAME)
+	call sscan (Memc[fname])
+	call gargwrd (Memc[fname], SZ_FNAME)
+	if (nscan() == 0)
+	    offtype = NONE
+	else {
+	    offtype = strdic (Memc[fname], Memc[str], SZ_FNAME, OFFTYPES)
+	    if (offtype > 0 && !streq (Memc[fname], Memc[str]))
+		offtype = 0
+	}
+	if (offtype == 0)
+	    offtype = FILE
+
+	switch (offtype) {
+	case NONE:
+	    call aclri (offsets, outdim*nimages)
+	    reloff = true
+	case WORLD, WCS:
+	    do j = 1, outdim
+		offsets[1,j] = 0
+	    if (proj) {
+		ct = mw_sctran (mw, "world", "logical", 0)
+		do i = 2, nimages {
+		    Memd[wref+outdim] = i
+		    call mw_ctrand (ct, Memd[wref], Memd[coord], indim)
+		    do j = 1, outdim
+			offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1])
+		}
+		call mw_ctfree (ct)
+		call mw_close (mw)
+	    } else {
+		ct = mw_sctran (mw, "world", "logical", 0)
+		call mw_ctrand (ct, Memd[wref], Memd[lref], indim)
+		do i = 2, nimages {
+		    call mw_close (mw)
+		    mw = mw_openim (in[i])
+		    ct = mw_sctran (mw, "world", "logical", 0)
+		    call mw_ctrand (ct, Memd[wref], Memd[coord], indim)
+		    do j = 1, outdim
+			offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1])
+		    call mw_ctfree (ct)
+		}
+	    }
+	    reloff = true
+	case PHYSICAL:
+	    call salloc (section, SZ_FNAME, TY_CHAR)
+
+	    call mw_gltermd (mw, Memd[ltm], Memd[coord], indim)
+	    do i = 2, nimages {
+		call mw_close (mw)
+		mw = mw_openim (in[i])
+		call mw_gltermd (mw, Memd[cd], Memd[coord], indim)
+		call strcpy ("[", Memc[section], SZ_FNAME)
+		flip = false
+		do j = 0, indim*indim-1, indim+1 {
+		    if (Memd[ltm+j] * Memd[cd+j] >= 0.)
+			call strcat ("*,", Memc[section], SZ_FNAME)
+		    else {
+			call strcat ("-*,", Memc[section], SZ_FNAME)
+			flip = true
+		    }
+		}
+		Memc[section+strlen(Memc[section])-1] = ']'
+		if (flip) {
+		    call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_FNAME)
+		    call strcat (Memc[section], Memc[fname], SZ_FNAME)
+		    call xt_imunmap (in[i], i)
+		    in[i] = xt_immap (Memc[fname], READ_ONLY, TY_CHAR, i) 
+		    call mw_close (mw)
+		    mw = mw_openim (in[i])
+		    call mw_gltermd (mw, Memd[cd], Memd[coord], indim)
+		    do j = 0, indim*indim-1
+			if (!fp_equald (Memd[ltm+j], Memd[cd+j]))
+			    call error (1,
+				"Cannot match physical coordinates")
+		}
+	    }
+
+	    call mw_close (mw)
+	    mw = mw_openim (in[1])
+	    ct = mw_sctran (mw, "logical", "physical", 0)
+	    call mw_ctrand (ct, Memd[lref], Memd[ltv], indim)
+	    call mw_ctfree (ct)
+	    do j = 1, outdim
+		offsets[1,j] = 0
+	    if (proj) {
+		ct = mw_sctran (mw, "physical", "logical", 0)
+		do i = 2, nimages {
+		    Memd[ltv+outdim] = i
+		    call mw_ctrand (ct, Memd[ltv], Memd[coord], indim)
+		    do j = 1, outdim
+			offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1])
+		}
+		call mw_ctfree (ct)
+		call mw_close (mw)
+	    } else {
+		do i = 2, nimages {
+		    call mw_close (mw)
+		    mw = mw_openim (in[i])
+		    ct = mw_sctran (mw, "physical", "logical", 0)
+		    call mw_ctrand (ct, Memd[ltv], Memd[coord], indim)
+		    do j = 1, outdim
+			offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1])
+		    call mw_ctfree (ct)
+		}
+	    }
+	    reloff = true
+	case GRID:
+	    amin = 1
+	    do j = 1, outdim {
+		call gargi (a)
+		call gargi (b)
+		if (nscan() < 1+2*j) {
+		    a = 1
+		    b = 0
+		}
+		do i = 1, nimages
+		    offsets[i,j] = mod ((i-1)/amin, a) * b 
+		amin = amin * a
+	    }
+	    reloff = true
+	case FILE:
+	    reloff = true
+	    fd = open (Memc[fname], READ_ONLY, TEXT_FILE)
+	    do i = 1, nimages {
+newscan_	if (fscan (fd) == EOF)
+		    call error (1, "IMCOMBINE: Offset list too short")
+		call gargwrd (Memc[fname], SZ_FNAME)
+		if (Memc[fname] == '#') {
+		    call gargwrd (Memc[fname], SZ_FNAME)
+		    call strlwr (Memc[fname])
+		    if (streq (Memc[fname], "absolute"))
+			reloff = false
+		    else if (streq (Memc[fname], "relative"))
+			reloff = true
+		    goto newscan_
+		}
+		call reset_scan ()
+		do j = 1, outdim {
+		    call gargr (val)
+		    offsets[i,j] = nint (val)
+		}
+		if (nscan() < outdim)
+		    call error (1, "IMCOMBINE: Error in offset list")
+	    }
+	    call close (fd)
+	}
+
+	# Set the output image size and the aligned flag 
+	aligned = true
+	do j = 1, outdim {
+	    a = offsets[1,j]
+	    b = IM_LEN(in[1],j) + a
+	    amin = a
+	    bmax = b
+	    do i = 2, nimages {
+		a = offsets[i,j]
+		b = IM_LEN(in[i],j) + a
+		if (a != amin || b != bmax || !reloff)
+		    aligned = false
+		amin = min (a, amin)
+		bmax = max (b, bmax)
+	    }
+	    IM_LEN(out[1],j) = bmax
+	    if (reloff || amin < 0) {
+		do i = 1, nimages
+		    offsets[i,j] = offsets[i,j] - amin
+		IM_LEN(out[1],j) = IM_LEN(out[1],j) - amin
+	    }
+	}
+
+	# Get the output limits.
+	call clgstr ("outlimits", Memc[fname], SZ_FNAME)
+	call sscan (Memc[fname])
+	do j = 1, outdim {
+	    call gargi (a)
+	    call gargi (b)
+	    if (nscan() < 2*j)
+		break
+	    if (!IS_INDEFI(a)) {
+		do i = 1, nimages {
+		    offsets[i,j] = offsets[i,j] - a + 1
+		    if (offsets[i,j] != 0)
+			aligned = false
+		}
+		IM_LEN(out[1],j) = IM_LEN(out[1],j) - a + 1
+	    }
+	    if (!IS_INDEFI(a) && !IS_INDEFI(b))
+		IM_LEN(out[1],j) = min (IM_LEN(out[1],j), b - a + 1)
+	}
+
+	# Update the WCS.
+	if (proj || !aligned || !reloff) {
+	    call mw_close (mw)
+	    mw = mw_openim (out[1])
+	    mwdim = mw_stati (mw, MW_NPHYSDIM)
+	    call mw_gaxmap (mw, Memi[axno], Memi[axval], mwdim)
+	    if (!aligned || !reloff) {
+		call mw_gltermd (mw, Memd[cd], Memd[lref], mwdim)
+		do i = 1, mwdim {
+		    j = Memi[axno+i-1]
+		    if (j > 0 && j <= indim)
+			Memd[lref+i-1] = Memd[lref+i-1] + offsets[1,j]
+		}
+		if (proj)
+		    Memd[lref+mwdim-1] = 0.
+		call mw_sltermd (mw, Memd[cd], Memd[lref], mwdim)
+	    }
+	    if (proj) {
+		# Apply dimensional reduction.
+		do i = 1, mwdim {
+		    j = Memi[axno+i-1]
+		    if (j <= outdim)
+			next
+		    else if (j > outdim+1)
+			Memi[axno+i-1] = j - 1
+		    else {
+			Memi[axno+i-1] = 0
+			Memi[axval+i-1] = 0
+		    }
+		}
+		call mw_saxmap (mw, Memi[axno], Memi[axval], mwdim)
+	    }
+
+	    # Reset physical coordinates.
+	    if (offtype == WCS || offtype == WORLD) {
+		call mw_gltermd (mw, Memd[ltm], Memd[ltv], mwdim)
+		call mw_gwtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim)
+		call mwvmuld (Memd[ltm], Memd[lref], Memd[lref], mwdim)
+		call aaddd (Memd[lref], Memd[ltv], Memd[lref], mwdim)
+		call mwinvertd (Memd[ltm], Memd[ltm], mwdim)
+		call mwmmuld (Memd[cd], Memd[ltm], Memd[cd], mwdim)
+		call mw_swtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim)
+		call aclrd (Memd[ltv], mwdim)
+		call aclrd (Memd[ltm], mwdim*mwdim)
+		do i = 1, mwdim
+		    Memd[ltm+(i-1)*(mwdim+1)] = 1.
+		call mw_sltermd (mw, Memd[ltm], Memd[ltv], mwdim)
+	    }
+	    call mw_saveim (mw, out)
+	}
+	call mw_close (mw)
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/icsigma.gx b/noao/twodspec/longslit/lscombine/src/icsigma.gx
new file mode 100644
index 00000000..1304d940
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icsigma.gx
@@ -0,0 +1,122 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+$for (sird)
+# IC_SIGMA -- Compute the sigma image line.
+# The estimated sigma includes a correction for the finite population.
+# Weights are used if desired.
+
+procedure ic_sigma$t (d, m, n, wts, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+int	npts			# Number of output points per line
+$if (datatype == sil)
+real	average[npts]		# Average
+real	sigma[npts]		# Sigma line (returned)
+$else
+PIXEL	average[npts]		# Average
+PIXEL	sigma[npts]		# Sigma line (returned)
+$endif
+
+int	i, j, k, n1
+real	wt, sigcor, sumwt
+$if (datatype == sil)
+real	a, sum
+$else
+PIXEL	a, sum
+$endif
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_ALL) {
+	    n1 = n[1]
+	    if (dowts) {
+		if (n1 > 1)
+		    sigcor = real (n1) / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    wt = wts[Memi[m[1]+k]]
+		    sum = (Mem$t[d[1]+k] - a) ** 2 * wt
+		    do j = 2, n1 {
+			wt = wts[Memi[m[j]+k]]
+			sum = sum + (Mem$t[d[j]+k] - a) ** 2 * wt
+		    }
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    } else {
+		if (n1 > 1)
+		    sigcor = 1. / real (n1 - 1)
+		else
+		    sigcor = 1.
+		do i = 1, npts {
+		    k = i - 1
+		    a = average[i]
+		    sum = (Mem$t[d[1]+k] - a) ** 2
+		    do j = 2, n1
+			sum = sum + (Mem$t[d[j]+k] - a) ** 2
+		    sigma[i] = sqrt (sum * sigcor)
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    do i = 1, npts
+		sigma[i] = blank
+	} else {
+	    if (dowts) {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = real (n1) / real (n1 -1)
+			else
+			    sigcor = 1
+			a = average[i]
+			wt = wts[Memi[m[1]+k]]
+			sum = (Mem$t[d[1]+k] - a) ** 2 * wt
+			sumwt = wt
+			do j = 2, n1 {
+			    wt = wts[Memi[m[j]+k]]
+			    sum = sum + (Mem$t[d[j]+k] - a) ** 2 * wt
+			    sumwt = sumwt + wt
+			}
+			if (sumwt > 0)
+			    sigma[i] = sqrt (sum / sumwt * sigcor)
+			else {
+			    sum = (Mem$t[d[1]+k] - a) ** 2
+			    do j = 2, n1
+				sum = sum + (Mem$t[d[j]+k] - a) ** 2
+			    sigma[i] = sqrt (sum / n1 * sigcor)
+			}
+		    } else
+			sigma[i] = blank
+		}
+	    } else {
+		do i = 1, npts {
+		    n1 = n[i]
+		    if (n1 > 0) {
+			k = i - 1
+			if (n1 > 1)
+			    sigcor = 1. / real (n1 - 1)
+			else
+			    sigcor = 1.
+			a = average[i]
+			sum = (Mem$t[d[1]+k] - a) ** 2
+			do j = 2, n1
+			    sum = sum + (Mem$t[d[j]+k] - a) ** 2
+			sigma[i] = sqrt (sum * sigcor)
+		    } else
+			sigma[i] = blank
+		}
+	    }
+	}
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icsort.gx b/noao/twodspec/longslit/lscombine/src/icsort.gx
new file mode 100644
index 00000000..e124da15
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icsort.gx
@@ -0,0 +1,386 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+$for (sird)
+# IC_SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.
+
+procedure ic_sort$t (a, b, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+PIXEL	b[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+PIXEL	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix
+		b[i] = Mem$t[a[i]+l]
+
+	    # Special cases
+	    $if (datatype == x)
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (abs (temp) < abs (pivot)) {
+			b[1] = temp
+			b[2] = pivot
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (abs (temp) < abs (pivot)) {		# bac|bca|cba
+			if (abs (temp) < abs (temp3)) {		# bac|bca
+			    b[1] = temp
+			    if (abs (pivot) < abs (temp3))	# bac
+				b[2] = pivot
+			    else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			}
+		    } else if (abs (temp3) < abs (temp)) {	# acb|cab
+			b[3] = temp
+			if (abs (pivot) < abs (temp3))		# acb
+			    b[2] = temp3
+			else {					# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+	    $else
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3)			# bac
+				b[2] = pivot
+			    else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3)			# acb
+			    b[2] = temp3
+			else {					# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+	    $endif
+
+	    # General case
+	    do i = 1, npix
+		b[i] = Mem$t[a[i]+l]
+
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			$if (datatype == x)
+			    for (i=i+1;  abs(b[i]) < abs(pivot);  i=i+1)
+			$else
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+			$endif
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+			$if (datatype == x)
+				if (abs(b[j]) <= abs(pivot))
+			$else
+				if (b[j] <= pivot)
+			$endif
+				    break
+			    if (i < j)		   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_
+	    do i = 1, npix
+		Mem$t[a[i]+l] = b[i]
+	}
+end
+
+
+# IC_2SORT -- Quicksort.  This is based on the VOPS asrt except that
+# the input is an array of pointers to image lines and the sort is done
+# across the image lines at each point along the lines.  The number of
+# valid pixels at each point is allowed to vary.  The cases of 1, 2, and 3
+# pixels per point are treated specially.  A second integer set of
+# vectors is sorted.
+
+procedure ic_2sort$t (a, b, c, d, nvecs, npts)
+
+pointer	a[ARB]			# pointer to input vectors
+PIXEL	b[ARB]			# work array
+pointer	c[ARB]			# pointer to associated integer vectors
+int	d[ARB]			# work array
+int	nvecs[npts]		# number of vectors
+int	npts			# number of points in vectors
+
+PIXEL	pivot, temp, temp3
+int	i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp
+define	swap {temp=$1;$1=$2;$2=temp}
+define	iswap {itemp=$1;$1=$2;$2=itemp}
+define	copy_	10
+
+begin
+	do l = 0, npts-1 {
+	    npix = nvecs[l+1]
+	    if (npix <= 1)
+		next
+
+	    do i = 1, npix {
+		b[i] = Mem$t[a[i]+l]
+		d[i] = Memi[c[i]+l]
+	    }
+
+	    # Special cases
+	    $if (datatype == x)
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (abs (temp) < abs (pivot)) {
+			b[1] = temp
+			b[2] = pivot
+			iswap (d[1], d[2])
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (abs (temp) < abs (pivot)) {		# bac|bca|cba
+			if (abs (temp) < abs (temp3)) {		# bac|bca
+			    b[1] = temp
+			    if (abs (pivot) < abs (temp3)) {	# bac
+				b[2] = pivot
+				iswap (d[1], d[2])
+			    } else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+				itemp = d[2]
+				d[2] = d[3]
+				d[3] = d[1]
+				d[1] = itemp
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			    iswap (d[1], d[3])
+			}
+		    } else if (abs (temp3) < abs (temp)) {	# acb|cab
+			b[3] = temp
+			if (abs (pivot) < abs (temp3)) {	# acb
+			    b[2] = temp3
+			    iswap (d[2], d[3])
+			} else {				# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			    itemp = d[2]
+			    d[2] = d[1]
+			    d[1] = d[3]
+			    d[3] = itemp
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+	    $else
+	    if (npix <= 3) {
+		pivot = b[1]
+		temp = b[2]
+		if (npix == 2) {
+		    if (temp < pivot) {
+			b[1] = temp
+			b[2] = pivot
+			iswap (d[1], d[2])
+		    } else
+			next
+		} else {
+		    temp3 = b[3]
+		    if (temp < pivot) {				# bac|bca|cba
+			if (temp < temp3) {			# bac|bca
+			    b[1] = temp
+			    if (pivot < temp3) {		# bac
+				b[2] = pivot
+				iswap (d[1], d[2])
+			    } else {				# bca
+				b[2] = temp3
+				b[3] = pivot
+				itemp = d[2]
+				d[2] = d[3]
+				d[3] = d[1]
+				d[1] = itemp
+			    }
+			} else {				# cba
+			    b[1] = temp3
+			    b[3] = pivot
+			    iswap (d[1], d[3])
+			}
+		    } else if (temp3 < temp) {			# acb|cab
+			b[3] = temp
+			if (pivot < temp3) {			# acb
+			    b[2] = temp3
+			    iswap (d[2], d[3])
+			} else {				# cab
+			    b[1] = temp3
+			    b[2] = pivot
+			    itemp = d[2]
+			    d[2] = d[1]
+			    d[1] = d[3]
+			    d[3] = itemp
+			}
+		    } else
+			next
+		}
+		goto copy_
+	    }
+	    $endif
+
+	    # General case
+	    lv[1] = 1
+	    uv[1] = npix
+	    p = 1
+
+	    while (p > 0) {
+		if (lv[p] >= uv[p])		# only one elem in this subset
+		    p = p - 1			# pop stack
+		else {
+		    # Dummy do loop to trigger the Fortran optimizer.
+		    do p = p, ARB {
+			i = lv[p] - 1
+			j = uv[p]
+
+			# Select as the pivot the element at the center of the
+			# array, to avoid quadratic behavior on an already
+			# sorted array.
+
+			k = (lv[p] + uv[p]) / 2
+			swap (b[j], b[k]); swap (d[j], d[k])
+			pivot = b[j]		   # pivot line
+
+			while (i < j) {
+			$if (datatype == x)
+			    for (i=i+1;  abs(b[i]) < abs(pivot);  i=i+1)
+			$else
+			    for (i=i+1;  b[i] < pivot;  i=i+1)
+			$endif
+				;
+			    for (j=j-1;  j > i;  j=j-1)
+			$if (datatype == x)
+				if (abs(b[j]) <= abs(pivot))
+			$else
+				if (b[j] <= pivot)
+			$endif
+				    break
+			    if (i < j) {	   # out of order pair
+				swap (b[i], b[j])  # interchange elements
+				swap (d[i], d[j])
+			    }
+			}
+
+			j = uv[p]		   # move pivot to position i
+			swap (b[i], b[j])	   # interchange elements
+			swap (d[i], d[j])
+
+			if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+			    lv[p+1] = lv[p]
+			    uv[p+1] = i - 1
+			    lv[p] = i + 1
+			} else {
+			    lv[p+1] = i + 1
+			    uv[p+1] = uv[p]
+			    uv[p] = i - 1
+			}
+
+			break
+		    }
+		    p = p + 1			   # push onto stack
+		}
+	    }
+
+copy_	   
+	    do i = 1, npix {
+		Mem$t[a[i]+l] = b[i]
+		Memi[c[i]+l] = d[i]
+	    }
+	}
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/icstat.gx b/noao/twodspec/longslit/lscombine/src/icstat.gx
new file mode 100644
index 00000000..c594182b
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/icstat.gx
@@ -0,0 +1,238 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+define	NMAX	100000	# Maximum number of pixels to sample
+
+$for (sird)
+# IC_STAT -- Compute image statistics within specified section.
+# The image section is relative to a reference image which may be
+# different than the input image and may have an offset.  Only a
+# subsample of pixels is used.  Masked and thresholded pixels are
+# ignored.  Only the desired statistics are computed to increase
+# efficiency.
+
+procedure ic_stat$t (im, imref, section, offsets, image, nimages,
+	domode, domedian, domean, mode, median, mean)
+
+pointer	im			 # Data image
+pointer	imref			 # Reference image for image section
+char	section[ARB]		 # Image section
+int	offsets[nimages,ARB]	 # Image section offset from data to reference
+int	image			 # Image index (for mask I/O)
+int	nimages			 # Number of images in  offsets.
+bool	domode, domedian, domean # Statistics to compute
+real	mode, median, mean	 # Statistics
+
+int	i, j, ndim, n, nv
+real	a
+pointer	sp, v1, v2, dv, va, vb
+pointer	data, mask, dp, lp, mp, imgnl$t()
+
+$if (datatype == csir)
+real	asum$t()
+$else $if (datatype == ld)
+double	asum$t()
+$else
+PIXEL	asum$t()
+$endif $endif
+PIXEL	ic_mode$t()
+
+include	"../icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+	call salloc (dv, IM_MAXDIM, TY_LONG)
+	call salloc (va, IM_MAXDIM, TY_LONG)
+	call salloc (vb, IM_MAXDIM, TY_LONG)
+
+	# Determine the image section parameters.  This must be in terms of
+	# the data image pixel coordinates though the section may be specified
+	# in terms of the reference image coordinates.  Limit the number of
+	# pixels in each dimension to a maximum.
+
+	ndim = IM_NDIM(im)
+	if (project)
+	    ndim = ndim - 1
+	call amovki (1, Memi[v1], IM_MAXDIM)
+	call amovki (1, Memi[va], IM_MAXDIM)
+	call amovki (1, Memi[dv], IM_MAXDIM)
+	call amovi (IM_LEN(imref,1), Memi[vb], ndim)
+	call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim)
+	if (im != imref)
+	    do i = 1, ndim {
+		Memi[va+i-1] = Memi[va+i-1] - offsets[image,i]
+		Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i]
+	    }
+
+	do j = 1, 10 {
+	    n = 1
+	    do i = 0, ndim-1 {
+		Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i]))
+		Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i]))
+		Memi[dv+i] = j
+		nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1)
+		Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i]
+		n = n * nv
+	    }
+	    if (n < NMAX)
+		break
+	}
+
+	call amovl (Memi[v1], Memi[va], IM_MAXDIM)
+	Memi[va] = 1
+	if (project)
+	   Memi[va+ndim] = image
+	call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+
+	# Accumulate the pixel values within the section.  Masked pixels and
+	# thresholded pixels are ignored.
+
+	call salloc (data, n, TY_PIXEL)
+	dp = data
+	while (imgnl$t (im, lp, Memi[vb]) != EOF) {
+	    call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask)
+	    lp = lp + Memi[v1] - 1
+	    if (dflag == D_ALL) {
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			a = Mem$t[lp]
+			if (a >= lthresh && a <= hthresh) {
+			    Mem$t[dp] = a
+			    dp = dp + 1
+			}
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			Mem$t[dp] = Mem$t[lp]
+			dp = dp + 1
+			lp = lp + Memi[dv]
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		mp = mask + Memi[v1] - 1
+		if (dothresh) {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    a = Mem$t[lp]
+			    if (a >= lthresh && a <= hthresh) {
+				Mem$t[dp] = a
+				dp = dp + 1
+			    }
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		} else {
+		    do i = Memi[v1], Memi[v2], Memi[dv] {
+			if (Memi[mp] == 0) {
+			    Mem$t[dp] = Mem$t[lp]
+			    dp = dp + 1
+			}
+			mp = mp + Memi[dv]
+			lp = lp + Memi[dv]
+		    }
+		}
+	    }
+	    for (i=2; i<=ndim; i=i+1) {
+		Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1]
+		if (Memi[va+i-1] <= Memi[v2+i-1])
+		    break
+		Memi[va+i-1] = Memi[v1+i-1]
+	    }
+	    if (i > ndim)
+		break
+	    call amovl (Memi[va], Memi[vb], IM_MAXDIM)
+	}
+
+	# Close mask until it is needed again.
+	call ic_mclose1 (image, nimages)
+
+	n = dp - data
+	if (n < 1) {
+	    call sfree (sp)
+	    call error (1, "Image section contains no pixels")
+	}
+
+	# Compute only statistics needed.
+	if (domode || domedian) {
+	    call asrt$t (Mem$t[data], Mem$t[data], n)
+	    mode = ic_mode$t (Mem$t[data], n)
+	    median = Mem$t[data+n/2-1]
+	}
+	if (domean)
+	    mean = asum$t (Mem$t[data], n) / n
+
+	call sfree (sp)
+end
+
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZRANGE	0.7	# Fraction of pixels about median to use
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+# IC_MODE -- Compute mode of an array.  The mode is found by binning
+# with a bin size based on the data range over a fraction of the
+# pixels about the median and a bin step which may be smaller than the
+# bin size.  If there are too few points the median is returned.
+# The input array must be sorted.
+
+PIXEL procedure ic_mode$t (a, n)
+
+PIXEL	a[n]			# Data array
+int	n			# Number of points
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+PIXEL	mode
+bool	fp_equalr()
+
+begin
+	if (n < NMIN)
+	    return (a[n/2])
+
+	# Compute the mode.  The array must be sorted.  Consider a
+	# range of values about the median point.  Use a bin size which
+	# is ZBIN of the range.  Step the bin limits in ZSTEP fraction of
+	# the bin size.
+
+	i = 1 + n * (1. - ZRANGE) / 2.
+	j = 1 + n * (1. + ZRANGE) / 2.
+	z1 = a[i]
+	z2 = a[j]
+	if (fp_equalr (z1, z2)) {
+	    mode = z1
+	    return (mode)
+	}
+
+	zstep = ZSTEP * (z2 - z1)
+	zbin = ZBIN * (z2 - z1)
+	$if (datatype == sil)
+	zstep = max (1., zstep)
+	zbin = max (1., zbin)
+	$endif
+
+	z1 = z1 - zstep
+	k = i
+	nmax = 0
+	repeat {
+	    z1 = z1 + zstep
+	    z2 = z1 + zbin
+	    for (; i < j && a[i] < z1; i=i+1)
+		;
+	    for (; k < j && a[k] < z2; k=k+1)
+		;
+	    if (k - i > nmax) {
+	        nmax = k - i
+	        mode = a[(i+k)/2]
+	    }
+	} until (k >= j)
+
+	return (mode)
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/mkpkg b/noao/twodspec/longslit/lscombine/src/mkpkg
new file mode 100644
index 00000000..2ed3d8cb
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/mkpkg
@@ -0,0 +1,62 @@
+ Make the IMCOMBINE Task.
+
+$checkout libpkg.a ../../../../
+$update   libpkg.a
+$checkin  libpkg.a ../../../../
+$exit
+
+generic:
+	$set	GEN = "$$generic -k"
+
+        $ifolder (generic/icaclip.x, icaclip.gx)
+	    $(GEN) icaclip.gx -o generic/icaclip.x $endif
+        $ifolder (generic/icaverage.x, icaverage.gx)
+	    $(GEN) icaverage.gx -o generic/icaverage.x $endif
+        $ifolder (generic/iccclip.x, iccclip.gx)
+	    $(GEN) iccclip.gx -o generic/iccclip.x $endif
+        $ifolder (generic/icgdata.x, icgdata.gx)
+	    $(GEN) icgdata.gx -o generic/icgdata.x $endif
+        $ifolder (generic/icgrow.x, icgrow.gx)
+	    $(GEN) icgrow.gx -o generic/icgrow.x $endif
+        $ifolder (generic/icmedian.x, icmedian.gx)
+	    $(GEN) icmedian.gx -o generic/icmedian.x $endif
+        $ifolder (generic/icmm.x, icmm.gx)
+	    $(GEN) icmm.gx -o generic/icmm.x $endif
+        $ifolder (generic/icomb.x, icomb.gx)
+	    $(GEN) icomb.gx -o generic/icomb.x $endif
+        $ifolder (generic/icpclip.x, icpclip.gx)
+	    $(GEN) icpclip.gx -o generic/icpclip.x $endif
+        $ifolder (generic/icsclip.x, icsclip.gx)
+	    $(GEN) icsclip.gx -o generic/icsclip.x $endif
+        $ifolder (generic/icsigma.x, icsigma.gx)
+	    $(GEN) icsigma.gx -o generic/icsigma.x $endif
+        $ifolder (generic/icsort.x, icsort.gx)
+	    $(GEN) icsort.gx -o generic/icsort.x $endif
+        $ifolder (generic/icstat.x, icstat.gx)
+	    $(GEN) icstat.gx -o generic/icstat.x $endif
+
+        $ifolder (generic/xtimmap.x, xtimmap.gx)
+	    $(GEN) xtimmap.gx -o generic/xtimmap.x $endif
+	;
+
+libpkg.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	@generic
+
+	icemask.x	<imhdr.h> <mach.h>
+	icgscale.x	icombine.com icombine.h
+	ichdr.x		<imset.h>
+	icimstack.x	<error.h> <imhdr.h>
+	iclog.x		icmask.h icombine.com icombine.h <imhdr.h> <imset.h>\
+			<mach.h>
+	icmask.x	icmask.h icombine.com icombine.h <imhdr.h> <pmset.h>
+	icombine.x	icombine.com icombine.h <error.h> <imhdr.h> <imset.h>
+	icpmmap.x	<pmset.h>
+	icrmasks.x	<imhdr.h>
+	icscale.x	icombine.com icombine.h <imhdr.h> <imset.h>
+	icsection.x	<ctype.h>
+	icsetout.x	icombine.com <imhdr.h> <imset.h> <mwset.h>
+	tymax.x		<mach.h>
+	xtprocid.x	
+	;
diff --git a/noao/twodspec/longslit/lscombine/src/tymax.x b/noao/twodspec/longslit/lscombine/src/tymax.x
new file mode 100644
index 00000000..a7f4f469
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/tymax.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+
+# TY_MAX -- Return the datatype of highest precedence.
+
+int procedure ty_max (type1, type2)
+
+int	type1, type2		# Datatypes
+
+int	i, j, type, order[8]
+data	order/TY_SHORT,TY_USHORT,TY_INT,TY_LONG,TY_REAL,TY_DOUBLE,TY_COMPLEX,TY_REAL/
+
+begin
+	for (i=1; (i<=7) && (type1!=order[i]); i=i+1)
+	    ;
+	for (j=1; (j<=7) && (type2!=order[j]); j=j+1)
+	    ;
+	type = order[max(i,j)]
+
+	# Special case of mixing short and unsigned short.
+	if (type == TY_USHORT && type1 != type2)
+	    type = TY_INT
+
+	return (type)
+end
diff --git a/noao/twodspec/longslit/lscombine/src/xtimmap.com b/noao/twodspec/longslit/lscombine/src/xtimmap.com
new file mode 100644
index 00000000..61bf314a
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/xtimmap.com
@@ -0,0 +1,8 @@
+int	option
+int	nopen
+int	nopenpix
+int	nalloc
+int	last_flag
+int	min_open
+pointer	ims
+common	/xtimmapcom/ option, ims, nopen, nopenpix, nalloc, last_flag, min_open
diff --git a/noao/twodspec/longslit/lscombine/src/xtimmap.gx b/noao/twodspec/longslit/lscombine/src/xtimmap.gx
new file mode 100644
index 00000000..c0ae26a6
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/xtimmap.gx
@@ -0,0 +1,552 @@
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<config.h>
+
+# The following is for compiling under V2.11.
+define	IM_BUFFRAC	IM_BUFSIZE
+include	<imset.h>
+
+# These routines maintain an arbitrary number of indexed "open" images which
+# must be READ_ONLY.  The calling program may use the returned pointer for
+# header accesses but must call xt_opix before I/O.  Subsequent calls to
+# xt_opix may invalidate the pointer.  The xt_imunmap call will free memory.
+
+define	MAX_OPENIM	(LAST_FD-16)		# Maximum images kept open
+define	MAX_OPENPIX	45			# Maximum pixel files kept open
+
+define	XT_SZIMNAME	299			# Size of IMNAME string
+define	XT_LEN		179			# Structure length
+define	XT_IMNAME	Memc[P2C($1)]		# Image name
+define	XT_ARG		Memi[$1+150]		# IMMAP header argument
+define	XT_IM		Memi[$1+151]		# IMIO pointer
+define	XT_HDR		Memi[$1+152]		# Copy of IMIO pointer
+define	XT_CLOSEFD	Memi[$1+153]		# Close FD?
+define	XT_FLAG		Memi[$1+154]		# Flag
+define	XT_BUFSIZE	Memi[$1+155]		# Buffer size
+define	XT_BUF		Memi[$1+156]		# Data buffer
+define	XT_BTYPE	Memi[$1+157]		# Data buffer type
+define	XT_VS		Memi[$1+157+$2]		# Start vector (10)
+define	XT_VE		Memi[$1+167+$2]		# End vector (10)
+
+# Options
+define	XT_MAPUNMAP	1	# Map and unmap images.
+
+# XT_IMMAP -- Map an image and save it as an indexed open image.
+# The returned pointer may be used for header access but not I/O.
+# The indexed image is closed by xt_imunmap.
+
+pointer procedure xt_immap (imname, acmode, hdr_arg, index)
+
+char	imname[ARB]		#I Image name
+int	acmode			#I Access mode
+int	hdr_arg			#I Header argument
+int	index			#I Save index
+pointer	im			#O Image pointer (returned)
+
+int	i, envgeti()
+pointer	xt, xt_opix()
+errchk	xt_opix
+
+int	first_time
+data	first_time /YES/
+
+include	"../xtimmap.com"
+
+begin
+	if (acmode != READ_ONLY)
+	    call error (1, "XT_IMMAP: Only READ_ONLY allowed")
+
+	# Initialize once per process.
+	if (first_time == YES) {
+	    iferr (option = envgeti ("imcombine_option"))
+		option = 1
+	    min_open = 1
+	    nopen = 0
+	    nopenpix = 0
+	    nalloc = MAX_OPENIM
+	    call calloc (ims, nalloc, TY_POINTER)
+	    first_time = NO
+	}
+
+	# Free image if needed.
+	call xt_imunmap (NULL, index)
+
+	# Allocate structure.
+	if (index > nalloc) {
+	    i = nalloc
+	    nalloc = index + MAX_OPENIM
+	    call realloc (ims, nalloc, TY_STRUCT)
+	    call amovki (NULL, Memi[ims+i], nalloc-i)
+	}
+	call calloc (xt, XT_LEN, TY_STRUCT)
+	Memi[ims+index-1] = xt
+
+	# Initialize.
+	call strcpy (imname, XT_IMNAME(xt), XT_SZIMNAME)
+	XT_ARG(xt) = hdr_arg
+	XT_IM(xt) = NULL
+	XT_HDR(xt) = NULL
+
+	# Open image.
+	last_flag = 0
+	im = xt_opix (NULL, index, 0)
+
+	# Make copy of IMIO pointer for header keyword access.
+	call malloc (XT_HDR(xt), LEN_IMDES+IM_HDRLEN(im)+1, TY_STRUCT)
+	call amovi (Memi[im], Memi[XT_HDR(xt)], LEN_IMDES)
+	call amovi (IM_MAGIC(im), IM_MAGIC(XT_HDR(xt)), IM_HDRLEN(im)+1)
+
+	return (XT_HDR(xt))
+end
+
+
+# XT_OPIX -- Open the image for I/O.
+# If the image has not been mapped return the default pointer.
+
+pointer	procedure xt_opix (imdef, index, flag)
+
+int	index			#I index
+pointer	imdef			#I Default pointer
+int	flag			#I Flag
+
+int	i, open(), imstati()
+pointer	im, xt, xt1, immap()
+errchk	open, immap, imunmap
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imdef)
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Return pointer for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (im)
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || flag == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			im = XT_IM(xt1)
+			if (im == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	if (!IS_INDEFI(XT_BUFSIZE(xt)))
+	    call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	else
+	    XT_BUFSIZE(xt) = imstati (im, IM_BUFSIZE)
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (im)
+end
+
+
+# XT_CPIX -- Close image.
+
+procedure xt_cpix (index)
+
+int	index			#I index
+
+pointer	xt
+errchk	imunmap
+
+include	"../xtimmap.com"
+
+begin
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	if (xt == NULL)
+	    return
+
+	if (XT_IM(xt) != NULL) {
+	    call imunmap (XT_IM(xt))
+	    nopen = nopen - 1
+	    if (XT_CLOSEFD(xt) == NO)
+		nopenpix = nopenpix - 1
+	}
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+end
+
+
+# XT_IMSETI -- Set IMIO value.
+
+procedure xt_imseti (index, param, value)
+
+int	index			#I index
+int	param			#I IMSET parameter
+int	value			#I Value
+
+pointer	xt
+bool	streq()
+
+include	"../xtimmap.com"
+
+begin
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	if (xt == NULL) {
+	    if (streq (param, "option"))
+		option = value
+	} else {
+	    if (streq (param, "bufsize")) {
+		XT_BUFSIZE(xt) = value
+		if (XT_IM(xt) != NULL) {
+		    call imseti (XT_IM(xt), IM_BUFFRAC, 0)
+		    call imseti (XT_IM(xt), IM_BUFSIZE, value)
+		}
+	    }
+	}
+end
+
+
+# XT_IMUNMAP -- Unmap indexed open image.
+# The header pointer is set to NULL to indicate the image has been closed.
+
+procedure xt_imunmap (im, index)
+
+int	im			#U IMIO header pointer
+int	index			#I index
+
+pointer	xt
+errchk	imunmap
+
+include	"../xtimmap.com"
+
+begin
+	# Check for an indexed image.  If it is not unmap the pointer
+	# as a regular IMIO pointer.
+
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+	if (xt == NULL) {
+	    if (im != NULL)
+		call imunmap (im)
+	    return
+	}
+
+	# Close indexed image.
+	if (XT_IM(xt) != NULL) {
+	    iferr (call imunmap (XT_IM(xt))) {
+		XT_IM(xt) = NULL
+		call erract (EA_WARN)
+	    }
+	    nopen = nopen - 1
+	    if (XT_CLOSEFD(xt) == NO)
+		nopenpix = nopenpix - 1
+	    if (index == min_open)
+		min_open = 1
+	}
+
+	# Free any buffered memory.
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+
+	# Free header pointer.  Note that if the supplied pointer is not
+	# header pointer then it is not set to NULL.
+	if (XT_HDR(xt) == im)
+	    im = NULL
+	call mfree (XT_HDR(xt), TY_STRUCT)
+
+	# Free save structure.
+	call mfree (Memi[ims+index-1], TY_STRUCT)
+	Memi[ims+index-1] = NULL
+end
+
+
+# XT_REINDEX -- Reindex open images.
+# This is used when some images are closed by xt_imunmap.  It is up to
+# the calling program to reindex the header pointers and to subsequently
+# use the new index values.
+
+procedure xt_reindex ()
+
+int	old, new
+
+include	"../xtimmap.com"
+
+begin
+	new = 0
+	do old = 0, nalloc-1 {
+	    if (Memi[ims+old] == NULL)
+		next
+	    Memi[ims+new] = Memi[ims+old]
+	    new = new + 1
+	}
+	do old = new, nalloc-1
+	    Memi[ims+old] = NULL
+end
+
+
+$for(sird)
+# XT_IMGNL -- Return the next line for the indexed image.
+# Possibly unmap another image if too many files are open.
+# Buffer data when an image is unmmaped to minimize the mapping of images.
+# If the requested index has not been mapped use the default pointer.
+
+int procedure xt_imgnl$t (imdef, index, buf, v, flag)
+
+pointer	imdef			#I Default pointer
+int	index			#I index
+pointer	buf			#O Data buffer
+long	v[ARB]			#I Line vector
+int	flag			#I Flag (=output line)
+
+int	i, j, nc, nl, open(), imgnl$t(), sizeof(), imloop()
+pointer	im, xt, xt1, ptr, immap(), imggs$t()
+errchk	open, immap, imgnl$t, imggs$t, imunmap
+
+long	unit_v[IM_MAXDIM]
+data	unit_v /IM_MAXDIM * 1/
+
+include	"../xtimmap.com"
+
+begin
+	# Get index pointer.
+	xt = NULL
+	if (index <= nalloc && index > 0)
+	    xt = Memi[ims+index-1]
+
+	# Use default pointer if index has not been mapped.
+	if (xt == NULL)
+	    return (imgnl$t (imdef, buf, v))
+
+	# Close images not accessed during previous line.
+	# In normal usage this should only occur once per line over all
+	# indexed images.
+	if (flag != last_flag) {
+	    do i = 1, nalloc {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL || XT_FLAG(xt1) == last_flag)
+		    next
+		call imunmap (XT_IM(xt1))
+		call mfree (XT_BUF(xt1), XT_BTYPE(xt1))
+		nopen = nopen - 1
+		if (XT_CLOSEFD(xt1) == NO)
+		    nopenpix = nopenpix - 1
+	    }
+
+	    # Optimize the file I/O.
+	    do i = nalloc, 1, -1 {
+		xt1 = Memi[ims+i-1]
+		if (xt1 == NULL)
+		    next
+		im = XT_IM(xt1)
+		if (im == NULL)
+		    next
+		min_open = i
+		if (nopenpix < MAX_OPENPIX) {
+		    if (XT_CLOSEFD(xt1) == NO)
+			next
+		    XT_CLOSEFD(xt1) = NO
+		    call imseti (im, IM_CLOSEFD, NO)
+		    nopenpix = nopenpix + 1
+		}
+	    }
+	    last_flag = flag
+	}
+
+	# Use IMIO for already opened images.
+	im = XT_IM(xt)
+	if (im != NULL) {
+	    XT_FLAG(xt) = flag
+	    return (imgnl$t (im, buf, v))
+	}
+
+	# If the image is not currently mapped use the stored header.
+	im = XT_HDR(xt)
+
+	# Check for EOF.
+	i = IM_NDIM(im)
+	if (v[i] > IM_LEN(im,i))
+	    return (EOF)
+
+	# Check for buffered data.
+	if (XT_BUF(xt) != NULL) {
+	    if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) {
+		if (XT_BTYPE(xt) != TY_PIXEL)
+		    call error (1, "Cannot mix data types")
+		nc = IM_LEN(im,1)
+		buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1)
+		XT_FLAG(xt) = flag
+		if (i == 1)
+		    v[1] = nc + 1
+		else
+		    j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i)
+		return (nc)
+	    }
+	}
+
+	# Handle more images than the maximum that can be open at one time.
+	if (nopen >= MAX_OPENIM) {
+	    if (option == XT_MAPUNMAP || v[2] == 0) {
+		do i = min_open, nalloc {
+		    xt1 = Memi[ims+i-1]
+		    if (xt1 == NULL)
+			next
+		    im = XT_IM(xt1)
+		    if (im == NULL)
+			next
+
+		    # Buffer some number of lines.
+		    nl = XT_BUFSIZE(xt1) / sizeof (TY_PIXEL) / IM_LEN(im,1)
+		    if (nl > 1) {
+			nc = IM_LEN(im,1)
+			call amovl (v, XT_VS(xt1,1), IM_MAXDIM)
+			call amovl (v, XT_VE(xt1,1), IM_MAXDIM)
+			XT_VS(xt1,1) = 1
+			XT_VE(xt1,1) = nc
+			XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2))
+			nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1
+			XT_BTYPE(xt1) = TY_PIXEL
+			call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1))
+			ptr = imggs$t (im, XT_VS(xt1,1), XT_VE(xt1,1),
+			   IM_NDIM(im))
+			call amov$t (Mem$t[ptr], Mem$t[XT_BUF(xt1)], nl*nc)
+		    }
+
+		    call imunmap (XT_IM(xt1))
+		    nopen = nopen - 1
+		    if (XT_CLOSEFD(xt1) == NO)
+			nopenpix = nopenpix - 1
+		    min_open = i + 1
+		    break
+		}
+		if (index <= min_open)
+		    min_open = index
+		else {
+		    do i = min_open, nalloc {
+			xt1 = Memi[ims+i-1]
+			if (xt1 == NULL)
+			    next
+			if (XT_IM(xt1) == NULL)
+			    next
+			min_open = i
+			break
+		    }
+		}
+	    } else {
+		# Check here because we can't catch error in immap.
+		i = open ("dev$null", READ_ONLY, BINARY_FILE)
+		call close (i)
+		if (i == LAST_FD - 1)
+		    call error (SYS_FTOOMANYFILES, "Too many open files")
+	    }
+	}
+	
+	# Open image.
+	im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt))
+	XT_IM(xt) = im
+	call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt))
+	call mfree (XT_BUF(xt), XT_BTYPE(xt))
+	nopen = nopen + 1
+	XT_CLOSEFD(xt) = YES
+	if (nopenpix < MAX_OPENPIX) {
+	    XT_CLOSEFD(xt) = NO
+	    nopenpix = nopenpix + 1
+	}
+	if (XT_CLOSEFD(xt) == YES)
+	    call imseti (im, IM_CLOSEFD, YES)
+	XT_FLAG(xt) = flag
+
+	return (imgnl$t (im, buf, v))
+end
+$endfor
diff --git a/noao/twodspec/longslit/lscombine/src/xtprocid.x b/noao/twodspec/longslit/lscombine/src/xtprocid.x
new file mode 100644
index 00000000..0a82d81b
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/src/xtprocid.x
@@ -0,0 +1,38 @@
+# XT_PROCID -- Set or ppdate PROCID keyword.
+
+procedure xt_procid (im)
+
+pointer	im			#I Image header
+
+int	i, j, ver, patmake(), gpatmatch(), strlen(), ctoi()
+pointer	sp, pat, str
+
+begin
+	call smark (sp)
+	call salloc (pat, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	# Get current ID.
+	iferr (call imgstr (im, "PROCID", Memc[str], SZ_LINE)) {
+	    iferr (call imgstr (im, "OBSID", Memc[str], SZ_LINE)) {
+		call sfree (sp)
+		return
+	    }
+	}
+
+	# Set new PROCID.
+	ver = 0
+	i = patmake ("V[0-9]*$", Memc[pat], SZ_LINE)
+	if (gpatmatch (Memc[str], Memc[pat], i, j) == 0)
+	    ;
+	if (j > 0) {
+	    j = i+1
+	    if (ctoi (Memc[str], j, ver) == 0)
+		ver = 0
+	    i = i - 1
+	} else
+	    i = strlen (Memc[str])
+	call sprintf (Memc[str+i], SZ_LINE, "V%d")
+	    call pargi (ver+1)
+	call imastr (im, "PROCID", Memc[str])
+end
diff --git a/noao/twodspec/longslit/lscombine/t_lscombine.x b/noao/twodspec/longslit/lscombine/t_lscombine.x
new file mode 100644
index 00000000..20fa2ef1
--- /dev/null
+++ b/noao/twodspec/longslit/lscombine/t_lscombine.x
@@ -0,0 +1,593 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<mach.h>
+include	<imhdr.h>
+include	"src/icombine.h"
+
+
+# T_LSCOMBINE - This task combines a list of images into an output image
+# and optional associated images and mask.  There are many combining options
+# from which to choose.
+#
+# This is a variant of IMCOMBINE that combines longslit spectra matched in
+# world coordinates.  The spectral images are first resampled to a common
+# grid of pixels in temporary images and then combined, after which the
+# temporary images are deleted.
+
+procedure t_lscombine ()
+
+pointer	sp, fname, output, headers, bmask, rmask, sigma, nrmask, emask, logfile
+pointer	scales, zeros, wts, im
+int	n, input, ilist, olist, hlist, blist, rlist, slist, nrlist, elist
+int	input1, mask1, delete
+
+bool	clgetb()
+real	clgetr()
+int	clgwrd(), clgeti(), imtopenp(), imtopen(), imtgetim(), imtlen()
+pointer	immap()
+errchk	immap, icombine, lsc_transform
+
+include	"src/icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (headers, SZ_FNAME, TY_CHAR)
+	call salloc (bmask, SZ_FNAME, TY_CHAR)
+	call salloc (rmask, SZ_FNAME, TY_CHAR)
+	call salloc (nrmask, SZ_FNAME, TY_CHAR)
+	call salloc (emask, SZ_FNAME, TY_CHAR)
+	call salloc (sigma, SZ_FNAME, TY_CHAR)
+	call salloc (ictask, SZ_FNAME, TY_CHAR)
+	call salloc (expkeyword, SZ_FNAME, TY_CHAR)
+	call salloc (statsec, SZ_FNAME, TY_CHAR)
+	call salloc (gain, SZ_FNAME, TY_CHAR)
+	call salloc (rdnoise, SZ_FNAME, TY_CHAR)
+	call salloc (snoise, SZ_FNAME, TY_CHAR)
+	call salloc (logfile, SZ_FNAME, TY_CHAR)
+
+	# Get task parameters.  Some additional parameters are obtained later.
+	call strcpy ("LSCOMBINE", Memc[ictask], SZ_FNAME)
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	hlist = imtopenp ("headers")
+	blist = imtopenp ("bpmasks")
+	rlist = imtopenp ("rejmasks")
+	nrlist = imtopenp ("nrejmasks")
+	elist = imtopenp ("expmasks")
+	slist = imtopenp ("sigmas")
+	call clgstr ("logfile", Memc[logfile], SZ_FNAME)
+
+	#project = clgetb ("project")
+	project = false
+	combine = clgwrd ("combine", Memc[fname], SZ_FNAME, COMBINE)
+	reject = clgwrd ("reject", Memc[fname], SZ_FNAME, REJECT)
+	blank = clgetr ("blank")
+	call clgstr ("expname", Memc[expkeyword], SZ_FNAME)
+	call clgstr ("statsec", Memc[statsec], SZ_FNAME)
+	call clgstr ("gain", Memc[gain], SZ_FNAME)
+	call clgstr ("rdnoise", Memc[rdnoise], SZ_FNAME)
+	call clgstr ("snoise", Memc[snoise], SZ_FNAME)
+	lthresh = clgetr ("lthreshold")
+	hthresh = clgetr ("hthreshold")
+	lsigma = clgetr ("lsigma")
+	hsigma = clgetr ("hsigma")
+	pclip = clgetr ("pclip")
+	flow = clgetr ("nlow")
+	fhigh = clgetr ("nhigh")
+	nkeep = clgeti ("nkeep")
+	grow = clgetr ("grow")
+	mclip = clgetb ("mclip")
+	sigscale = clgetr ("sigscale")
+	verbose = false
+
+	# Check lists.
+	n = imtlen (ilist)
+	if (n == 0)
+	    call error (1, "No input images to combine")
+
+	if (project) {
+	    if (imtlen (olist) != n)
+		call error (1, "Wrong number of output images")
+	    if (imtlen (hlist) != 0 && imtlen (hlist) != n)
+		call error (1, "Wrong number of header files")
+	    if (imtlen (blist) != 0 && imtlen (blist) != n)
+		call error (1, "Wrong number of bad pixel masks")
+	    if (imtlen (rlist) != 0 && imtlen (rlist) != n)
+		call error (1, "Wrong number of rejection masks")
+	    if (imtlen (nrlist) > 0 && imtlen (nrlist) != n)
+		call error (1, "Wrong number of number rejected masks")
+	    if (imtlen (elist) > 0 && imtlen (elist) != n)
+		call error (1, "Wrong number of exposure masks")
+	    if (imtlen (slist) > 0 && imtlen (slist) != n)
+		call error (1, "Wrong number of sigma images")
+	} else {
+	    if (imtlen (olist) != 1)
+		call error (1, "Wrong number of output images")
+	    if (imtlen (hlist) > 1)
+		call error (1, "Wrong number of header files")
+	    if (imtlen (blist) > 1)
+		call error (1, "Wrong number of bad pixel masks")
+	    if (imtlen (rlist) > 1)
+		call error (1, "Wrong number of rejection masks")
+	    if (imtlen (nrlist) > 1)
+		call error (1, "Wrong number of number rejected masks")
+	    if (imtlen (elist) > 1)
+		call error (1, "Wrong number of exposure masks")
+	    if (imtlen (slist) > 1)
+		call error (1, "Wrong number of sigma images")
+	}
+
+	# Check parameters, map INDEFs, and set threshold flag
+	if (pclip == 0. && reject == PCLIP)
+	    call error (1, "Pclip parameter may not be zero")
+	if (IS_INDEFR (blank))
+	    blank = 0.
+	if (IS_INDEFR (lsigma))
+	    lsigma = MAX_REAL
+	if (IS_INDEFR (hsigma))
+	    hsigma = MAX_REAL
+	if (IS_INDEFR (pclip))
+	    pclip = -0.5
+	if (IS_INDEFR (flow))
+	    flow = 0
+	if (IS_INDEFR (fhigh))
+	    fhigh = 0
+	if (IS_INDEFR (grow))
+	    grow = 0.
+	if (IS_INDEF (sigscale))
+	    sigscale = 0.
+
+	if (IS_INDEF(lthresh) && IS_INDEF(hthresh))
+	    dothresh = false
+	else {
+	    dothresh = true
+	    if (IS_INDEF(lthresh))
+		lthresh = -MAX_REAL
+	    if (IS_INDEF(hthresh))
+		hthresh = MAX_REAL
+	}
+
+	# Loop through image lists.
+	while (imtgetim (ilist, Memc[fname], SZ_FNAME) != EOF) {
+	    iferr {
+		scales = NULL; input = ilist; input1 = NULL; mask1 = NULL
+
+		if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF) {
+		    if (project) {
+			call sprintf (Memc[output], SZ_FNAME,
+			    "LSCOMBINE: No output image for %s")
+			    call pargstr (Memc[fname])
+			call error (1, Memc[output])
+		    } else
+			call error (1, "LSCOMBINE: No output image")
+		}
+		if (imtgetim (hlist, Memc[headers], SZ_FNAME) == EOF)
+		    Memc[headers] = EOS
+		if (imtgetim (blist, Memc[bmask], SZ_FNAME) == EOF)
+		    Memc[bmask] = EOS
+		if (imtgetim (rlist, Memc[rmask], SZ_FNAME) == EOF)
+		    Memc[rmask] = EOS
+		if (imtgetim (nrlist, Memc[nrmask], SZ_FNAME) == EOF)
+		    Memc[nrmask] = EOS
+		if (imtgetim (elist, Memc[emask], SZ_FNAME) == EOF)
+		    Memc[emask] = EOS
+		if (imtgetim (slist, Memc[sigma], SZ_FNAME) == EOF)
+		    Memc[sigma] = EOS
+
+		# Set the input list and initialize the scaling factors.
+		if (project) {
+		    im = immap (Memc[fname], READ_ONLY, 0)
+		    if (IM_NDIM(im) == 1)
+			n = 0
+		    else
+			n = IM_LEN(im,IM_NDIM(im))
+		    call imunmap (im)
+		    if (n == 0) {
+			call sprintf (Memc[output], SZ_FNAME,
+			    "LSCOMBINE: Can't project one dimensional image %s")
+			    call pargstr (Memc[fname])
+			call error (1, Memc[output])
+		    }
+		    input = imtopen (Memc[fname])
+		} else {
+		    call imtrew (ilist)
+		    n = imtlen (ilist)
+		    input = ilist
+		}
+
+		# Allocate and initialize scaling factors.
+		call malloc (scales, 3*n, TY_REAL)
+		zeros = scales + n
+		wts = scales + 2 * n
+		call amovkr (INDEFR, Memr[scales], 3*n)
+
+		# Register the images.
+		call lsc_transform (input, input1, mask1)
+
+		# Set special values for LSCOMBINE application. 
+		dothresh = true
+		if (IS_INDEF(lthresh))
+		    lthresh = -MAX_REAL
+		if (IS_INDEF(hthresh))
+		    hthresh = MAX_REAL
+		lthresh = max (-MAX_REAL * 0.999, lthresh)
+
+		# Combine and then delete the temporary transformed images.
+		call icombine (input1, Memc[output], Memc[headers], Memc[bmask],
+		    Memc[rmask], Memc[nrmask], Memc[emask], Memc[sigma],
+		    Memc[logfile], Memr[scales], Memr[zeros], Memr[wts], NO,
+		    delete)
+
+		# Delete temporary files.
+		if (input1 != input) {
+		    call imtrew (input1)
+		    while (imtgetim (input1, Memc[fname], SZ_FNAME) != EOF)
+		        iferr (call imdelete (Memc[fname]))
+			    ;
+		    while (imtgetim (mask1, Memc[fname], SZ_FNAME) != EOF)
+		        iferr (call imdelete (Memc[fname]))
+			    ;
+		}
+
+	    } then
+		call erract (EA_WARN)
+
+	    if (input1 != NULL && input1 != input)
+		call imtclose (input1)
+	    if (mask1 != NULL)
+		call imtclose (mask1)
+	    if (input != ilist)
+		call imtclose (input)
+	    call mfree (scales, TY_REAL)
+	    if (!project)
+		break
+	}
+
+	call imtclose (ilist)
+	call imtclose (olist)
+	call imtclose (hlist)
+	call imtclose (blist)
+	call imtclose (rlist)
+	call imtclose (nrlist)
+	call imtclose (elist)
+	call imtclose (slist)
+	call sfree (sp)
+end
+
+
+include	<math/iminterp.h>
+
+
+# LSC_TRANSFORM -- Transform list of spectra to a matching coordinate system.
+# The routine uses additional task parameters to specify the desired
+# coordinate system.
+
+procedure lsc_transform (input, output, masks)
+
+pointer	input			#I List of input spectra
+pointer	output			#O List of transformed spectra
+pointer	masks			#O List of masks
+
+bool	dotransform
+int	i, j, n, err, nwa[2], nw[2], nusf, nvsf, mtype
+real	w1a[2], w2a[2], dwa[2], w1[2], w2[2], dw[2], aux
+pointer	sp, inname, outname, minname, moutname, tmp
+pointer	w1s[2], w2s[2], dws[2], nws[2], linear[2]
+pointer	in, out, pmin, pmout, mw, ct, ptr
+pointer un[2], usf, vsf, xmsi, ymsi, jmsi, xout, yout, dxout, dyout
+
+bool	streq()
+int	clgeti(), clgwrd(), errget()
+int	imtopen(), imtgetim(), imtrgetim(), imtlen()
+real	clgetr()
+real	mw_c1tranr()
+pointer	immap(), mw_openim(), mw_sctran(), yt_mappm()
+errchk	immap, mw_openim, mw_sctran, yt_mappm
+
+include "../transform/transform.com"
+
+begin
+
+	n = imtlen (input)
+
+	call smark (sp)
+	call salloc (inname, SZ_FNAME, TY_CHAR)
+	call salloc (outname, SZ_FNAME, TY_CHAR)
+	call salloc (minname, SZ_FNAME, TY_CHAR)
+	call salloc (moutname, SZ_FNAME, TY_CHAR)
+	call salloc (tmp, SZ_FNAME, TY_CHAR)
+	do j = 1, 2 {
+	    call salloc (w1s[j], n, TY_REAL)
+	    call salloc (w2s[j], n, TY_REAL)
+	    call salloc (dws[j], n, TY_REAL)
+	    call salloc (nws[j], n, TY_INT)
+	    call salloc (linear[j], n, TY_INT)
+	}
+
+	# Get/set parameters.  These are similar to TRANSFORM.
+	itype = clgwrd ("interptype", Memc[inname], SZ_FNAME, II_BFUNCTIONS)
+	u1 = clgetr ("x1"); u2 = clgetr ("x2");
+	du = clgetr ("dx"); nu = clgeti ("nx")
+	v1 = clgetr ("y1"); v2 = clgetr ("y2")
+	dv = clgetr ("dy"); nv = clgeti ("ny")
+	ulog = false; vlog = false
+	flux = true
+	blank = -MAX_REAL
+	usewcs = true
+
+	# The mask is only generated if the COMBINE parameter masktype is set.
+	mtype = clgwrd ("masktype", Memc[tmp], SZ_FNAME, "|none|goodvalue|")
+
+	err = 0; dotransform = false
+	iferr {
+	    in = NULL; pmin = NULL; out = NULL; pmout = NULL;  mw= NULL
+
+	    # Get the linear WCS (or approximation) for each input.
+	    # We get them all first since we need to compute a global
+	    # WCS for the final combined spectrm.
+
+	    do i = 0, n-1 {
+		if (imtrgetim (input, i+1, Memc[inname], SZ_FNAME) == EOF)
+		    call error (1, "Premature end of input list")
+		ptr = immap (Memc[inname], READ_ONLY, 0); in = ptr
+		ptr = mw_openim (in); mw = ptr
+		do j = 1, 2 {
+		    ct = mw_sctran (mw, "logical", "world", j)
+		    Memi[nws[j]+i] = IM_LEN(in,j)
+		    Memr[w1s[j]+i] =  mw_c1tranr (ct, 1.)
+		    Memr[w2s[j]+i] =  mw_c1tranr (ct, real(Memi[nws[j]+i]))
+		    Memr[dws[j]+i] = (Memr[w2s[j]+i] - Memr[w1s[j]+i]) /
+		        (Memi[nws[j]+i] - 1)
+		    call mw_ctfree (ct)
+		    call mw_gwattrs (mw, j, "wtype", Memc[outname], SZ_FNAME)
+		    if (streq (Memc[outname], "linear"))
+		        Memi[linear[j]+i] = YES
+		    else
+		        Memi[linear[j]+i] = NO
+		}
+		call mw_close (mw)
+		call imunmap (in)
+	    }
+
+	    # Set the linear WCS for each axis.  The follow sets values for
+	    # those elements specified by the users as INDEF.
+
+	    w1a[1] = u1; w2a[1] = u2; dwa[1] = du; nwa[1] = nu
+	    w1a[2] = v1; w2a[2] = v2; dwa[2] = dv; nwa[2] = nv
+	    do j = 1, 2 {
+		w1[j] = w1a[j]; w2[j] = w2a[j]; dw[j] = dwa[j]; nw[j] = nwa[j]
+
+		# Starting value.
+		if (IS_INDEFR(w1[j])) {
+		    if (IS_INDEFR(dw[j]) || dw[j] > 0.) {
+			w1[j] = MAX_REAL
+			do i = 0, n-1 {
+			    if (Memr[dws[j]+i] > 0.)
+			        aux = Memr[w1s[j]+i]
+			    else
+			        aux = Memr[w2s[j]+i]
+			    if (aux < w1[j])
+			        w1[j] = aux
+			}
+		    } else {
+			w1[j] = -MAX_REAL
+			do i = 0, n-1 {
+			    if (Memr[dws[j]+i] > 0.)
+			        aux = Memr[w2s[j]+i]
+			    else
+			        aux = Memr[w1s[j]+i]
+			    if (aux > w1[j])
+			        w1[j] = aux
+			}
+		    }
+		}
+
+		# Ending value.
+		if (IS_INDEFR(w2[j])) {
+		    if (IS_INDEFR(dw[j]) || dw[j] > 0.) {
+			w2[j] = -MAX_REAL
+			do i = 0, n-1 {
+			    if (Memr[dws[j]+i] > 0.)
+			        aux = Memr[w2s[j]+i]
+			    else
+			        aux = Memr[w1s[j]+i]
+			    if (aux > w2[j])
+			        w2[j] = aux
+			}
+		    } else {
+			w2[j] = MAX_REAL
+			do i = 0, n-1 {
+			    if (Memr[dws[j]+i] > 0.)
+			        aux = Memr[w1s[j]+i]
+			    else
+			        aux = Memr[w2s[j]+i]
+			    if (aux < w2[j])
+			        w2[j] = aux
+			}
+		    }
+		}
+
+		# Increment.
+		if (IS_INDEFR(dw[j])) {
+		    dw[j] = MAX_REAL
+		    do i = 0, n-1 {
+		        aux = abs (Memr[dws[j]+i])
+			if (aux < dw[j])
+			    dw[j] = aux
+		    }
+		}
+		if ((w2[j] - w1[j]) / dw[j] < 0.)
+		    dw[j] = -dw[j]
+
+		# Number of pixels.
+		if (IS_INDEFI(nw[j]))
+		    nw[j] = int ((w2[j] - w1[j]) / dw[j] + 0.5) + 1
+
+		# Adjust the values.
+		if (IS_INDEFR(dwa[j]))
+		    dw[j] = (w2[j] - w1[j]) / (nw[j] - 1)
+		else if (IS_INDEFR(w2a[j]))
+		    w2[j] = w1[j] + (nw[j] - 1) * dw[j]
+		else if (IS_INDEFR(w1a[j]))
+		    w1[j] = w2[j] - (nw[j] - 1) * dw[j]
+		else {
+		    nw[j] = int ((w2[j] - w1[j]) / dw[j] + 0.5) + 1
+		    w2[j] = w1[j] + (nw[j] - 1) * dw[j]
+		}
+	    }
+
+	    # Check if the images need to be transformed.  If all the
+	    # input are already in the desired system then we don't need
+	    # to need to transform.  But if even one needs to be transformed
+	    # we transform all of them.  This is not ideal but it simplifies
+	    # the code for now.
+
+	    do i = 0, n-1 {
+	        do j = 1, 2 {
+		    if (Memi[linear[j]+i] != YES)
+		        dotransform = true
+		    if (Memr[w1s[j]+i] != w1[j])
+		        dotransform = true
+		    if (Memr[w2s[j]+i] != w2[j])
+		        dotransform = true
+		    if (Memr[dws[j]+i] != dw[j])
+		        dotransform = true
+		    if (dotransform)
+		        break
+		}
+		if (dotransform)
+		    break
+	    }
+
+	    # Transform the images if needed.
+	    if (dotransform) {
+	        u1 = w1[1]; u2 = w2[1]; du = dw[1]; nu = nw[1]
+	        v1 = w1[2]; v2 = w2[2]; dv = dw[2]; nv = nw[2]
+		call mktemp ("lsc", Memc[tmp], SZ_FNAME)
+		do i = 0, n-1 {
+		    # Get the input name.
+		    if (imtrgetim (input, i+1, Memc[inname], SZ_FNAME) == EOF)
+			call error (1, "Premature end of input list")
+
+		    # Map the input, output, and WCS.
+		    ptr = immap (Memc[inname], READ_ONLY, 0); in = ptr
+		    ptr = mw_openim (in); mw = ptr
+		    call sprintf (Memc[outname], SZ_FNAME, "%s%d")
+			call pargstr (Memc[tmp])
+			call pargi (i)
+		    ptr = immap (Memc[outname], NEW_COPY, in); out = ptr
+		    call imastr (out, "ICFNAME", Memc[inname])
+
+		    # Set masks.
+		    if (mtype > 1) {
+			ptr = yt_mappm ("BPM", in,"logical", Memc[minname],
+			    SZ_FNAME)
+		        pmin = ptr
+			if (pmin != NULL) {
+			    call sprintf (Memc[moutname], SZ_FNAME, "m%s%d.pl")
+				call pargstr (Memc[tmp])
+				call pargi (i)
+			    call xt_maskname (Memc[moutname], "", NEW_IMAGE,
+				Memc[moutname], SZ_FNAME)
+			    ptr = immap (Memc[moutname], NEW_COPY, in)
+			    pmout = ptr
+			    call imastr (out, "BPM", Memc[moutname])
+			    call imastr (pmout, "ICBPM", Memc[minname])
+			}
+		    }
+
+		    # Use the TRANSFORM routines.
+		    call tr_gwcs (mw, un, IM_LEN(in,1), IM_LEN(in,2), ct,
+		        usf, nusf, vsf, nvsf)
+		    call tr_setup (ct, usf, nusf, vsf, nvsf, un, xmsi, ymsi,
+		        jmsi, xout, yout, dxout, dyout)
+
+		    call tr_transform (in, out, pmin, pmout, un, xmsi, ymsi,
+		        jmsi, Memr[xout], Memr[yout], Memr[dxout], Memr[dyout])
+
+		    # Finish up.
+		    call mw_close (mw)
+		    if (pmout != NULL)
+			call imunmap (pmout)
+		    if (pmin != NULL)
+			call xt_pmunmap (pmin)
+		    call imunmap (out)
+		    call imunmap (in)
+		    call mfree (xout, TY_REAL)
+		    call mfree (yout, TY_REAL)
+		    call mfree (dxout, TY_REAL)
+		    call mfree (dyout, TY_REAL)
+		    call msifree (xmsi)
+		    call msifree (ymsi)
+		    if (jmsi != NULL)
+			call msifree (jmsi)
+		    if (un[1] != NULL)
+			call un_close (un[1])
+		    if (un[2] != NULL)
+			call un_close (un[2])
+		}
+	    }
+
+	} then {
+	    # Save error for later reporting after cleaning up.
+	    err = errget (Memc[inname], SZ_FNAME)
+
+	    if (mw != NULL)
+	        call mw_close (mw)
+	    if (pmout != NULL)
+		call imunmap (pmout)
+	    if (pmin != NULL)
+		call xt_pmunmap (pmin)
+	    if (out != NULL)
+	        call imunmap (out)
+	    if (in != NULL)
+	        call imunmap (in)
+	    call mfree (xout, TY_REAL)
+	    call mfree (yout, TY_REAL)
+	    call mfree (dxout, TY_REAL)
+	    call mfree (dyout, TY_REAL)
+	    if (xmsi != NULL)
+		call msifree (xmsi)
+	    if (ymsi != NULL)
+		call msifree (ymsi)
+	    if (jmsi != NULL)
+		call msifree (jmsi)
+	    if (un[1] != NULL)
+		call un_close (un[1])
+	    if (un[2] != NULL)
+		call un_close (un[2])
+
+	    # Open the temporary list, delete any found, and report err.
+	    call sprintf (Memc[outname], SZ_FNAME, "%s*,m%s*.pl")
+	        call pargstr (Memc[tmp])
+	        call pargstr (Memc[tmp])
+	    output = imtopen (Memc[outname])
+	    while (imtgetim (output, Memc[outname], SZ_FNAME) != EOF)
+		iferr (call imdelete (Memc[outname]))
+		    ;
+	    call imtclose (output)
+	    masks = NULL
+
+	    call error (err, Memc[inname])
+	}
+
+	# Set the list to combine.  If the input did not need to be
+	# transformed return the input pointer as the output pointer.
+	# The calling program can check for equality to decided whether
+	# to delete the temporary image.
+
+	if (dotransform) {
+	    call sprintf (Memc[outname], SZ_FNAME, "%s*")
+	        call pargstr (Memc[tmp])
+	    output = imtopen (Memc[outname])
+	    call sprintf (Memc[outname], SZ_FNAME, "m%s*.pl")
+	        call pargstr (Memc[tmp])
+	    masks = imtopen (Memc[outname])
+	} else
+	    output = input
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/lstools.x b/noao/twodspec/longslit/lstools.x
new file mode 100644
index 00000000..af16a971
--- /dev/null
+++ b/noao/twodspec/longslit/lstools.x
@@ -0,0 +1,131 @@
+include	<imhdr.h>
+
+# LS_AIMSUM -- Get a one dimensional image vector summed over lines
+# or columns.
+
+procedure ls_aimsum (im, axis, col1, col2, line1, line2, x, y, npts)
+
+pointer	im			# IMIO pointer
+int	axis			# Axis of vector
+int	col1, col2		# Range of columns
+int	line1, line2		# Range of lines
+pointer	x			# Vector ordinates
+pointer	y			# Vector abscissa
+int	npts			# Number of points in vector
+
+int	i, line, ncols, nlines
+
+real	asumr()
+pointer	imgs2r()
+
+begin
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	switch (axis) {
+	case 1:
+	    npts = ncols
+	    call malloc (x, ncols, TY_REAL)
+	    call calloc (y, ncols, TY_REAL)
+
+	    do i = 1, ncols
+	        Memr[x+i-1] = col1 + i - 1
+
+	    do i = 1, nlines {
+		line = line1 + i - 1
+	        call aaddr (Memr[imgs2r (im, col1, col2, line, line)], Memr[y],
+		    Memr[y], ncols)
+	    }
+	case 2:
+	    npts = nlines
+	    call malloc (x, nlines, TY_REAL)
+	    call malloc (y, nlines, TY_REAL)
+
+	    do i = 1, nlines {
+		line = line1 + i - 1
+	        Memr[x+i-1] = line
+	        Memr[y+i-1] = asumr (Memr[imgs2r (im, col1, col2, line, line)],
+		    ncols)
+	    }
+	}
+end
+
+
+# LS_AIMAVG -- Get a one dimensional image vector averaged over lines
+# or columns.
+
+procedure ls_aimavg (im, axis, col1, col2, line1, line2, x, y, npts)
+
+pointer	im			# IMIO pointer
+int	axis			# Axis of vector
+int	col1, col2		# Range of columns
+int	line1, line2		# Range of lines
+pointer	x			# Vector ordinates
+pointer	y			# Vector abscissa
+int	npts			# Number of points in vector
+
+begin
+	call ls_aimsum (im, axis, col1, col2, line1, line2, x, y, npts)
+
+	switch (axis) {
+	case 1:
+	    call adivkr (Memr[y], real (line2-line1+1), Memr[y], npts)
+	case 2:
+	    call adivkr (Memr[y], real (col2-col1+1), Memr[y], npts)
+	}
+end
+
+
+# LS_IMMAP -- Map images for response and illumination calibrations
+
+procedure ls_immap (input, output, in, out)
+
+char	input[ARB]		# Input image
+char	output[ARB]		# Output image
+pointer	in			# Input IMIO pointer
+pointer	out			# Output IMIO pointer
+
+pointer	sp, root, sect, line, data
+
+int	impnlr()
+pointer	immap()
+
+begin
+	# Get the root name and section of the input image.
+
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (sect, SZ_FNAME, TY_CHAR)
+
+	call get_root (input, Memc[root], SZ_FNAME)
+	call get_section (input, Memc[sect], SZ_FNAME)
+
+	# If the output image is not accessible then create it as a new copy
+	# of the full input image and initialize the output to unit response.
+
+	iferr (out = immap (output, READ_WRITE, 0)) {
+	    in = immap (Memc[root], READ_ONLY, 0)
+	    out = immap (output, NEW_COPY, in)
+	    IM_PIXTYPE(out) = TY_REAL
+
+	    call salloc (line, IM_MAXDIM, TY_LONG)
+	    call amovkl (long (1), Meml[line], IM_MAXDIM)
+
+	    while (impnlr (out, data, Meml[line]) != EOF)
+	        call amovkr (1., Memr[data], IM_LEN(out, 1))
+
+	    call imunmap (in)
+	}
+	call imunmap (out)
+
+	# Map the input and output images.
+
+	in = immap (input, READ_ONLY, 0)
+
+	call sprintf (Memc[root], SZ_FNAME, "%s%s")
+	    call pargstr (output)
+	    call pargstr (Memc[sect])
+	out = immap (Memc[root], READ_WRITE, 0)
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/mkpkg b/noao/twodspec/longslit/mkpkg
new file mode 100644
index 00000000..7af807cd
--- /dev/null
+++ b/noao/twodspec/longslit/mkpkg
@@ -0,0 +1,41 @@
+# LONGSLIT Package
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$call	longslit
+	;
+
+install:
+	$move	xx_longslit.e noaobin$x_longslit.e
+	;
+
+longslit:
+	$omake	x_longslit.x
+	$omake	x_longslit.x
+	$link	x_longslit.o libpkg.a -lsmw -lxtools -lcurfit -liminterp\
+		-lgsurfit -o xx_longslit.e
+	;
+
+libpkg.a:
+	@transform
+	@lscombine
+
+	airmass.x	<math.h>
+	extinction.x	<error.h> <imhdr.h>
+	fluxcalib.x	<error.h> <imhdr.h> <math/iminterp.h>
+	getdaxis.x
+	illumination.x	<error.h> <imhdr.h> <math/iminterp.h> <pkg/gtools.h>\
+			<pkg/rg.h> <pkg/xtanswer.h>
+	ilsetbins.x	<gset.h> <imhdr.h> <pkg/gtools.h> <pkg/rg.h>\
+			<pkg/xtanswer.h>
+	lstools.x	<imhdr.h>
+	response.x	<imhdr.h> <pkg/gtools.h> <pkg/xtanswer.h>
+	;
diff --git a/noao/twodspec/longslit/reidentify.par b/noao/twodspec/longslit/reidentify.par
new file mode 100644
index 00000000..63412b0f
--- /dev/null
+++ b/noao/twodspec/longslit/reidentify.par
@@ -0,0 +1,36 @@
+# Parameters for reidentify task.
+
+reference,s,a,,,,Reference image
+images,s,a,,,,Images to be reidentified
+interactive,s,h,"no","no|yes|NO|YES",,Interactive fitting?
+section,s,h,"middle line",,,Section to apply to two dimensional images
+newaps,b,h,yes,,,Reidentify apertures in images not in reference?
+override,b,h,no,,,Override previous solutions?
+refit,b,h,yes,,,"Refit coordinate function?
+"
+trace,b,h,yes,,,Trace reference image?
+step,s,h,"10",,,Step in lines/columns/bands for tracing an image
+nsum,s,h,"10",,,Number of lines/columns/bands to sum
+shift,s,h,"0.",,,Shift to add to reference features (INDEF to search)
+search,r,h,0.,,,Search radius
+nlost,i,h,0,0,,"Maximum number of features which may be lost
+"
+cradius,r,h,5.,,,Centering radius
+threshold,r,h,0.,0.,,Feature threshold for centering
+addfeatures,b,h,no,,,Add features from a line list?
+coordlist,f,h,linelists$idhenear.dat,,,User coordinate list
+match,r,h,-3.,,,Coordinate list matching limit
+maxfeatures,i,h,50,,,Maximum number of features for automatic identification
+minsep,r,h,2.,0.,,"Minimum pixel separation
+"
+database,f,h,database,,,Database
+logfiles,s,h,"logfile",,,List of log files
+plotfile,s,h,"",,,Plot file for residuals
+verbose,b,h,no,,,Verbose output?
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,"Graphics cursor input
+"
+answer,s,q,"yes","no|yes|NO|YES",,Fit dispersion function interactively?
+crval,s,q,,,,"Approximate coordinate (at reference pixel)"
+cdelt,s,q,,,,"Approximate dispersion"
+aidpars,pset,h,,,,"Automatic identification algorithm parameters"
diff --git a/noao/twodspec/longslit/response.par b/noao/twodspec/longslit/response.par
new file mode 100644
index 00000000..c7f1df84
--- /dev/null
+++ b/noao/twodspec/longslit/response.par
@@ -0,0 +1,18 @@
+# RESPONSE -- Determine response calibrations
+
+calibration,s,a,,,,Longslit calibration images
+normalization,s,a,,,,Normalization spectrum images
+response,s,a,,,,Response function images
+interactive,b,h,yes,,,Fit normalization spectrum interactively?
+threshold,r,h,INDEF,,,Response threshold
+
+sample,s,h,"*",,,Sample of points to use in fit
+naverage,i,h,1,,,Number of points in sample averaging
+function,s,h,"spline3","spline3|legendre|chebyshev|spline1",,Fitting function
+order,i,h,1,1,,Order of fitting function
+low_reject,r,h,0.,0.,,Low rejection in sigma of fit
+high_reject,r,h,0.,0.,,High rejection in sigma of fit
+niterate,i,h,1,0,,Number of rejection iterations
+grow,r,h,0.,0.,,Rejection growing radius
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/twodspec/longslit/response.x b/noao/twodspec/longslit/response.x
new file mode 100644
index 00000000..dd61ecc4
--- /dev/null
+++ b/noao/twodspec/longslit/response.x
@@ -0,0 +1,315 @@
+include	<imhdr.h>
+include	<pkg/gtools.h>
+include <pkg/xtanswer.h>
+
+# T_RESPONSE -- Determine the response function for 2D spectra.
+#
+# A calibration image is divided by a normalization spectrum to form
+# a response image.  The normalization spectrum is derived by averaging
+# the normalization image across dispersion.  The normalization spectrum
+# is then smoothed by curve fitting.  The smoothed normalization
+# spectrum is divided into the calibration image to form the response
+# function image.  The curve fitting may be performed interactively
+# using the icfit package.  A response function is determined for each
+# input image.  Image sections in the calibration image may be used to determine
+# the response for only part of an image such as with multiple slits.
+
+# CL callable task.
+#
+# The images are given by image templates.  The number of images must
+# in each list must match.  Image sections are allowed in the calibration
+# image.
+
+procedure t_response ()
+
+int	list1				# List of calibration images
+int	list2				# List of normalization images
+int	list3				# List of response images
+real	threshold			# Response threshold
+int	naverage			# Sample averaging size
+int	order				# Order of curve fitting function
+real	low_reject, high_reject		# Rejection thresholds
+int	niterate			# Number of rejection iterations
+real	grow				# Rejection growing radius
+int	interactive			# Interactive?
+
+pointer	cal, norm, resp, ic, gt
+pointer	sp, image1, image2, image3, history
+
+int	clgeti(), imtopen(), imtgetim(), imtlen(), gt_init(), ic_geti()
+bool	clgetb()
+real	clgetr(), ic_getr()
+pointer	immap()
+
+errchk	immap, ls_immap
+
+begin
+	call smark (sp)
+	call salloc (image1, SZ_LINE, TY_CHAR)
+	call salloc (image2, SZ_LINE, TY_CHAR)
+	call salloc (image3, SZ_LINE, TY_CHAR)
+	call salloc (history, SZ_LINE, TY_CHAR)
+
+	# Get the calibration, normalization, and response image lists and
+	# check that the they match.
+
+	call clgstr ("calibration", Memc[image1], SZ_LINE)
+	call clgstr ("normalization", Memc[image2], SZ_LINE)
+	call clgstr ("response", Memc[image3], SZ_LINE)
+
+	list1 = imtopen (Memc[image1])
+	list2 = imtopen (Memc[image2])
+	list3 = imtopen (Memc[image3])
+	if ((imtlen(list1)!=imtlen(list3)) || (imtlen(list2)!=imtlen(list3))) {
+	    call imtclose (list1)
+	    call imtclose (list2)
+	    call imtclose (list3)
+	    call error (0,  "Image lists do not match")
+	}
+
+	# Get remaining parameters and initialize the curve fitting package.
+
+	threshold = clgetr ("threshold")
+	call clgstr ("sample", Memc[image1], SZ_LINE)
+	naverage = clgeti ("naverage")
+	call clgstr ("function", Memc[image2], SZ_LINE)
+	order = clgeti ("order")
+	low_reject = clgetr ("low_reject")
+	high_reject = clgetr ("high_reject")
+	niterate = clgeti ("niterate")
+	grow = clgetr ("grow")
+	if (clgetb ("interactive"))
+	    interactive = YES
+	else
+	    interactive = ALWAYSNO
+
+	# Set the ICFIT pointer structure.
+	call ic_open (ic)
+	call ic_pstr (ic, "sample", Memc[image1])
+	call ic_puti (ic, "naverage", naverage)
+	call ic_pstr (ic, "function", Memc[image2])
+	call ic_puti (ic, "order", order)
+	call ic_putr (ic, "low", low_reject)
+	call ic_putr (ic, "high", high_reject)
+	call ic_puti (ic, "niterate", niterate)
+	call ic_putr (ic, "grow", grow)
+	call ic_pstr (ic, "ylabel", "")
+
+	gt = gt_init()
+	call gt_sets (gt, GTTYPE, "line")
+
+	# Create the response image for each calibration image.
+
+	while ((imtgetim (list1, Memc[image1], SZ_LINE) != EOF) &&
+	    (imtgetim (list2, Memc[image2], SZ_LINE) != EOF) &&
+	    (imtgetim (list3, Memc[image3], SZ_LINE) != EOF)) {
+
+	    # Map the images.  If the response image does not exist it
+	    # is created and initialized to unit response everywhere.
+	    # If the calibration image is an image section then the response
+	    # image is opened as a section also.
+
+	    call ls_immap (Memc[image1], Memc[image3], cal, resp)
+	    norm = immap (Memc[image2], READ_ONLY, 0)
+
+	    # Determine whether the normalization spectrum is to be fit
+	    # interactively and if so set the graphics title.
+
+	    call sprintf (Memc[image2], SZ_LINE,
+		"Fit the normalization spectrum for %s interactively")
+	        call pargstr (Memc[image1])
+	    call xt_answer (Memc[image2], interactive)
+
+	    if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	        call sprintf (Memc[image2], SZ_LINE,
+		    "Fit the normalization spectrum for %s\n%s")
+	            call pargstr (Memc[image1])
+	            call pargstr (IM_TITLE(cal))
+	        call gt_sets (gt, GTTITLE, Memc[image2])
+	    }
+
+	    # Make the response.
+	    call re_make (cal, norm, resp, ic, gt, threshold, interactive)
+
+	    # Document the fit.
+	    call ic_gstr (ic, "sample", Memc[history], SZ_LINE)
+	    call clpstr ("sample", Memc[history])
+	    naverage = ic_geti (ic, "naverage")
+	    call clputi ("naverage", naverage)
+	    call ic_gstr (ic, "function", Memc[history], SZ_LINE)
+	    call clpstr ("function", Memc[history])
+	    order = ic_geti (ic, "order")
+	    call clputi ("order", order)
+	    low_reject = ic_getr (ic, "low")
+	    call clputr ("low_reject", low_reject)
+	    high_reject = ic_getr (ic, "high")
+	    call clputr ("high_reject", high_reject)
+	    niterate = ic_geti (ic, "niterate")
+	    call clputi ("niterate", niterate)
+	    grow = ic_getr (ic, "grow")
+	    call clputr ("grow", grow)
+
+	    call imaddr (resp, "ccdmean", 1.)
+	    call sprintf (Memc[history], SZ_LINE,
+		"Response determined from %s.")
+		call pargstr (Memc[image2])
+	    call xt_phistory (resp, Memc[history])
+	    call imunmap (cal)
+	    call imunmap (norm)
+	    call imunmap (resp)
+	}
+
+	# Finish up.
+
+	call ic_closer (ic)
+	call imtclose (list1)
+	call imtclose (list2)
+	call imtclose (list3)
+	call gt_free (gt)
+	call sfree (sp)
+end
+
+
+# RE_MAKE -- Given the calibration image determine the response.
+
+procedure re_make (cal, norm, resp, ic, gt, threshold, interactive)
+
+pointer	cal			# Calibration IMIO pointer
+pointer	norm			# Normalization IMIO pointer
+pointer	resp			# Response IMIO pointer
+pointer	ic			# ICFIT pointer
+pointer	gt			# GTOOLS pointer
+real	threshold		# Response threshold
+int	interactive		# Interactive?
+
+char	graphics[SZ_FNAME]	# Graphics output device
+int	laxis, paxis, npts
+pointer	cv, gp, sp, wavelengths, spectrum, wts
+
+pointer	gopen()
+errchk	get_daxis
+
+begin
+	# Determine the dispersion axis and set the axis labels.
+	call get_daxis (cal, laxis, paxis)
+
+	switch (laxis) {
+	case 1:
+	    call ic_pstr (ic, "xlabel", "Column")
+	case 2:
+	    call ic_pstr (ic, "xlabel", "Line")
+	}
+
+	# Get the normalization spectrum.
+
+	call ls_aimavg (norm, laxis, 1, IM_LEN(norm, 1), 1, IM_LEN(norm, 2),
+	    wavelengths, spectrum, npts)
+
+	# Allocate memory for the fit.
+
+	call smark (sp)
+	call salloc (wts, npts, TY_REAL)
+	call amovkr (1., Memr[wts], npts)
+
+	# Smooth the normalization spectrum.
+
+	call ic_putr (ic, "xmin", Memr[wavelengths])
+	call ic_putr (ic, "xmax", Memr[wavelengths+npts-1])
+
+	if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	    call clgstr ("graphics", graphics, SZ_FNAME)
+	    gp = gopen (graphics, NEW_FILE, STDGRAPH)
+	    call icg_fit (ic, gp, "cursor", gt, cv, Memr[wavelengths],
+		Memr[spectrum], Memr[wts], npts)
+	    call gclose (gp)
+	} else {
+	    call ic_fit (ic, cv, Memr[wavelengths], Memr[spectrum], Memr[wts],
+		npts, YES, YES, YES, YES)
+	}
+
+	call cvvector (cv, Memr[wavelengths], Memr[spectrum], npts)
+	call cvfree (cv)
+
+	# Compute the response image by normalizing the calibration
+	# image by the normalization spectrum.
+
+	call re_normalize (cal, resp, laxis, threshold, Memr[spectrum], npts)
+
+	# Free allocated memory.
+
+	call sfree (sp)
+	call mfree (wavelengths, TY_REAL)
+	call mfree (spectrum, TY_REAL)
+end
+	
+
+# RE_NORMALIZE -- Divide each calibration image pixel by the normalization
+# spectrum at that pixel.
+
+procedure re_normalize (cal, resp, axis, threshold, spectrum, npts)
+
+pointer	cal			# Calibration IMIO pointer
+pointer	resp			# Response IMIO pointer
+int	axis			# Dispersion axis
+real	threshold		# Normalization treshold
+real	spectrum[npts]		# Pointer to normalization spectrum
+int	npts			# Number of points in spectrum
+
+int	i, j, ncols, nlines
+real	norm
+pointer	datain, dataout
+
+pointer	imgl2r(), impl2r()
+
+begin
+	ncols = IM_LEN (cal, 1)
+	nlines = IM_LEN (cal, 2)
+
+	# Compute the response image.
+	if (IS_INDEF (threshold)) {
+	    do i = 1, nlines {
+		datain = imgl2r (cal, i)
+		dataout = impl2r (resp, i)
+
+		switch (axis) {
+		case 1:
+		    call adivr (Memr[datain], spectrum, Memr[dataout], ncols)
+		case 2:
+		    call adivkr (Memr[datain], spectrum[i], Memr[dataout],
+			ncols)
+		}
+	    }
+	} else {
+	    do i = 1, nlines {
+		datain = imgl2r (cal, i)
+		dataout = impl2r (resp, i)
+
+		switch (axis) {
+		case 1:
+		    do j = 1, ncols {
+			norm = spectrum[j]
+			if (norm < threshold || Memr[datain] < threshold)
+			    Memr[dataout] = 1.
+			else
+			    Memr[dataout] = Memr[datain] / norm
+			datain = datain + 1
+			dataout = dataout + 1
+		    }
+		case 2:
+		    norm = spectrum[i]
+		    if (norm < threshold)
+			call amovkr (1., Memr[dataout], ncols)
+		    else {
+			do j = 1, ncols {
+			    if (Memr[datain] < threshold)
+				Memr[dataout] = 1.
+			    else
+				Memr[dataout] = Memr[datain] / norm
+			    datain = datain + 1
+			    dataout = dataout + 1
+			}
+		    }
+		}
+	    }
+	}
+end
diff --git a/noao/twodspec/longslit/sensfunc.par b/noao/twodspec/longslit/sensfunc.par
new file mode 100644
index 00000000..94f84f4a
--- /dev/null
+++ b/noao/twodspec/longslit/sensfunc.par
@@ -0,0 +1,17 @@
+standards,s,a,std,,,Input standard star data file (from STANDARD)
+sensitivity,s,a,"sens",,,Output root sensitivity function imagename
+apertures,s,h,"",,,Aperture selection list
+ignoreaps,b,h,yes,,,Ignore apertures and make one sensitivity function?
+logfile,f,h,"logfile",,,Output log for statistics information
+extinction,f,h,)_.extinction,,,Extinction file
+newextinction,f,h,"extinct.dat",,,Output revised extinction file
+observatory,s,h,)_.observatory,,,Observatory of data
+function,s,h,"spline3","chebyshev|legendre|spline3|spline1",,Fitting function
+order,i,h,6,1,,Order of fit
+interactive,b,h,yes,,,Determine sensitivity function interactively?
+graphs,s,h,"sr",,,Graphs per frame
+marks,s,h,"plus cross box",,,Data mark types (marks deleted added)
+colors,s,h,"2 1 3 4",,,Colors (lines marks deleted added)
+cursor,*gcur,h,"",,,Graphics cursor input
+device,s,h,"stdgraph",,,Graphics output device
+answer,s,q, yes,"no|yes|NO|YES",,"(no|yes|NO|YES)"
diff --git a/noao/twodspec/longslit/standard.par b/noao/twodspec/longslit/standard.par
new file mode 100644
index 00000000..99b98877
--- /dev/null
+++ b/noao/twodspec/longslit/standard.par
@@ -0,0 +1,21 @@
+input,f,a,,,,Input image file root name
+output,s,a,std,,,Output flux file (used by SENSFUNC)
+samestar,b,h,yes,,,Same star in all apertures?
+beam_switch,b,h,no,,,Beam switch spectra?
+apertures,s,h,"",,,Aperture selection list
+bandwidth,r,h,INDEF,,,Bandpass widths
+bandsep,r,h,INDEF,,,Bandpass separation
+fnuzero,r,h,3.68e-20,,,Absolute flux zero point
+extinction,s,h,)_.extinction,,,Extinction file
+caldir,s,h,)_.caldir,,,Directory containing calibration data
+observatory,s,h,)_.observatory,,,Observatory for data
+interact,b,h,yes,,,Graphic interaction to define new bandpasses
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
+star_name,s,q,,,,Star name in calibration list
+airmass,r,q,,1.,,Airmass
+exptime,r,q,,,,Exposure time (seconds)
+mag,r,q,,,,Magnitude of star
+magband,s,q,,"U|B|V|R|I|J|H|K|L|Lprime|M",,"Magnitude type"
+teff,s,q,,,,Effective temperature or spectral type
+answer,s,q,no,,,"(no|yes|NO|YES|NO!|YES!)"
diff --git a/noao/twodspec/longslit/transform.par b/noao/twodspec/longslit/transform.par
new file mode 100644
index 00000000..c49485da
--- /dev/null
+++ b/noao/twodspec/longslit/transform.par
@@ -0,0 +1,20 @@
+input,s,a,,,,Input images
+output,s,a,,,,Output images
+minput,s,h,"",,,Input masks
+moutput,s,h,"",,,Output masks
+fitnames,s,a,,,,Names of coordinate fits in the database
+database,f,h,database,,,Identify database
+interptype,s,h,spline3,"nearest|linear|poly3|poly5|spline3",,Interpolation type
+x1,r,h,INDEF,,,Output starting x coordinate
+x2,r,h,INDEF,,,Output ending x coordinate
+dx,r,h,INDEF,,,Output X pixel interval
+nx,r,h,INDEF,,,Number of output x pixels
+xlog,b,h,no,,,Logarithmic x coordinate?
+y1,r,h,INDEF,,,Output starting y coordinate
+y2,r,h,INDEF,,,Output ending y coordinate
+dy,r,h,INDEF,,,Output Y pixel interval
+ny,r,h,INDEF,,,Number of output y pixels
+ylog,b,h,no,,,Logarithmic y coordinate?
+flux,b,h,yes,,,Conserve flux per pixel?
+blank,r,h,INDEF,,,Value for out of range pixels
+logfiles,s,h,"STDOUT,logfile",,,List of log files
diff --git a/noao/twodspec/longslit/transform/Notes b/noao/twodspec/longslit/transform/Notes
new file mode 100644
index 00000000..16f5a7a3
--- /dev/null
+++ b/noao/twodspec/longslit/transform/Notes
@@ -0,0 +1,6 @@
+May 29, 1987
+
+If a user accidentally leaves the user coordinate as INDEF in tracing
+the spatial distortion then FITCOORDS uses the fitted coordinate
+which is the same as the pixel coordinate.  This causes incorrect
+results.  Some thought should be given to this situation.
diff --git a/noao/twodspec/longslit/transform/fcdbio.x b/noao/twodspec/longslit/transform/fcdbio.x
new file mode 100644
index 00000000..caf4ac5d
--- /dev/null
+++ b/noao/twodspec/longslit/transform/fcdbio.x
@@ -0,0 +1,99 @@
+include	<error.h>
+include	<math/gsurfit.h>
+include	<pkg/dttext.h>
+include	<units.h>
+
+# FC_DBWRITE -- Write an fitcoords database entry.
+
+procedure fc_dbwrite (database, fitname, axis, un, sf)
+
+char	database[ARB]		# Database
+char	fitname[ARB]		# Database fit name
+int	axis			# Axis for surface
+pointer	un			# Units pointer
+pointer	sf			# Surface pointer
+
+int	i, nsave
+pointer	dt, coeffs, sp, dbfile
+
+int	xgsgeti()
+pointer	dtmap1()
+
+begin
+	if (sf == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (dbfile, SZ_FNAME, TY_CHAR)
+	call strcpy ("fc", Memc[dbfile], SZ_FNAME)
+	call imgcluster (fitname, Memc[dbfile+2], SZ_FNAME-2)
+	dt = dtmap1 (database, Memc[dbfile], APPEND)
+
+	call dtptime (dt)
+	call dtput (dt, "begin\t%s\n")
+	    call pargstr (fitname)
+	call dtput (dt, "\ttask\tfitcoords\n")
+	call dtput (dt, "\taxis\t%d\n")
+	    call pargi (axis)
+	if (un != NULL) {
+	    call dtput (dt, "\tunits\t%s\n")
+		call pargstr (UN_UNITS(un))
+	}
+
+	nsave = xgsgeti (sf, GSNSAVE)
+	call salloc (coeffs, nsave, TY_DOUBLE)
+	call xgssave (sf, Memd[coeffs])
+	call dtput (dt, "\tsurface\t%d\n")
+	    call pargi (nsave)
+	do i = 1, nsave {
+	    call dtput (dt, "\t\t%g\n")
+		call pargd (Memd[coeffs+i-1])
+	}
+
+	call sfree (sp)
+	call dtunmap (dt)
+end
+
+
+# LM_DBREAD -- Read an lsmap database entry.
+
+procedure lm_dbread (database, fitname, axis, un, sf)
+
+char	database[ARB]		# Database
+char	fitname[ARB]		# Fit name
+int	axis			# Axis for surface
+pointer	un			# Units pointer
+pointer	sf			# Surface pointer
+
+int	rec, ncoeffs
+pointer	dt, coeffs, sp, dbfile, units
+
+int	dtlocate(), dtgeti()
+pointer	dtmap1(), un_open()
+
+errchk	dtlocate(), dtgeti(), dtgad(), un_open()
+
+begin
+	un = NULL
+	sf = NULL
+	coeffs = NULL
+
+	call smark (sp)
+	call salloc (dbfile, SZ_FNAME, TY_CHAR)
+	call salloc (units, SZ_FNAME, TY_CHAR)
+	call strcpy ("fc", Memc[dbfile], SZ_FNAME)
+	call imgcluster (fitname, Memc[dbfile+2], SZ_FNAME-2)
+	dt = dtmap1 (database, Memc[dbfile], READ_ONLY)
+
+	rec = dtlocate (dt, fitname)
+	axis = dtgeti (dt, rec, "axis")
+	ifnoerr (call dtgstr (dt, rec, "units", Memc[units], SZ_FNAME))
+	    un = un_open (Memc[units])
+	ncoeffs = dtgeti (dt, rec, "surface")
+	call salloc (coeffs, ncoeffs, TY_DOUBLE)
+	call dtgad (dt, rec, "surface", Memd[coeffs], ncoeffs, ncoeffs)
+	call xgsrestore (sf, Memd[coeffs])
+
+	call sfree (sp)
+	call dtunmap (dt)
+end
diff --git a/noao/twodspec/longslit/transform/fcdlist.x b/noao/twodspec/longslit/transform/fcdlist.x
new file mode 100644
index 00000000..7b9816a7
--- /dev/null
+++ b/noao/twodspec/longslit/transform/fcdlist.x
@@ -0,0 +1,91 @@
+include	<mach.h>
+include	<error.h>
+
+# FC_DLIST -- Fit Coordinates Deletion List Procedures.
+
+# FC_DLREAD -- Fit Coordinates Deletion List Read.
+# Read the deletion list file and match points in the list with the data
+# and delete them.
+
+procedure fc_dlread (x, y, w, npts)
+
+real	x[npts]			# First coordinate to match
+real	y[npts]			# Second coordinate to match
+real	w[npts]			# Weight of coordinate
+int	npts			# Number of coordinates
+
+int	i, fd
+real	r
+char	file[SZ_FNAME]
+real	xdel, ydel
+
+int	access(), open(), fscan(), nscan()
+
+begin
+	call clgstr ("deletions", file, SZ_FNAME)
+
+	if (access (file, READ_ONLY, TEXT_FILE) == NO)
+	    return
+
+	fd = open (file, READ_ONLY, TEXT_FILE)
+
+	while (fscan (fd) != EOF) {
+	    call gargr (xdel)
+	    call gargr (ydel)
+
+	    if (nscan() != 2)
+		next
+
+	    do i = 1, npts {
+		r = sqrt ((x[i]-xdel)**2 + (y[i]-ydel)**2)
+		if (r < 10*EPSILONR)
+		    w[i] = 0.
+#	        if (x[i] != xdel)
+#		    next
+#	        if (y[i] != ydel)
+#		    next
+#		w[i] = 0.
+	    }
+	}
+
+	call close (fd)
+end
+
+
+# FC_DLWRITE -- Fit Coordinates Deletion List Write.
+
+procedure fc_dlwrite (x, y, w, npts)
+
+real	x[npts]			# First coordinate to match
+real	y[npts]			# Second coordinate to match
+real	w[npts]			# Weight of coordinate
+int	npts			# Number of coordinates
+
+int	i, fd
+char	file[SZ_FNAME]
+
+int	open()
+
+begin
+	call clgstr ("deletions", file, SZ_FNAME)
+
+	if (file[1] == EOS)
+	    return
+
+	iferr (call delete (file))
+	    ;
+	iferr (fd = open (file, NEW_FILE, TEXT_FILE)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	do i = 1, npts {
+	    if (w[i] == 0.) {
+		call fprintf (fd, "%g %g\n")
+		    call pargr (x[i])
+		    call pargr (y[i])
+	    }
+	}
+
+	call close (fd)
+end
diff --git a/noao/twodspec/longslit/transform/fcfitcoords.x b/noao/twodspec/longslit/transform/fcfitcoords.x
new file mode 100644
index 00000000..13943302
--- /dev/null
+++ b/noao/twodspec/longslit/transform/fcfitcoords.x
@@ -0,0 +1,211 @@
+include	<pkg/gtools.h>
+include	<pkg/igsfit.h>
+include	<pkg/xtanswer.h>
+
+# FC_FITCOORDS -- Fit a surface to the user coordinates.
+
+procedure fc_fitcoords (fitname, database, list, logfiles, interactive)
+
+char	fitname[SZ_FNAME]	# Fitname
+char	database[SZ_FNAME]	# Database
+int	list			# List of images
+int	logfiles		# List of log files
+int	interactive		# Interactive?
+
+int	axis			# Axis of surface fit
+pointer	sf			# Surface pointer
+char	logfile[SZ_FNAME], labels[SZ_LINE, IGSPARAMS]
+bool	answer
+int	ncoords, logfd, axes[2]
+real	xmin, xmax, ymin, ymax
+pointer	gp, gplog, gt, coords, title, un
+
+int	imtgetim(), fntgfntb(), open(), igs_geti(), scan()
+real	xgseval()
+pointer	gopen(), gt_init()
+
+errchk	fc_getcoords
+
+begin
+	# Print a header to the log files giving the inputs.  This is
+	# done first so that if one of the logfiles is STDOUT the user
+	# will see that something is happening.
+
+	axis = 0
+	while (fntgfntb (logfiles, logfile, SZ_FNAME) != EOF) {
+	    logfd = open (logfile, APPEND, TEXT_FILE)
+	    call sysid (logfile, SZ_FNAME)
+	    call fprintf (logfd, "\n%s\n")
+		call pargstr (logfile)
+	    call fprintf (logfd, "  Longslit coordinate fit name is %s.\n")
+		call pargstr (fitname)
+	    call fprintf (logfd, "  Longslit database is %s.\n")
+		call pargstr (database)
+	    call fprintf (logfd, "  Features from images:\n")
+	    while (imtgetim (list, logfile, SZ_FNAME) != EOF) {
+		call fprintf (logfd, "    %s\n")
+		    call pargstr (logfile)
+	    }
+	    call imtrew (list)
+	    call close (logfd)
+	}
+	call fntrewb (logfiles)
+
+	# Get the coordinates for the specified images and axis.  The
+	# coordinates are returned in a pointer which must be explicitly
+	# freed.
+
+	call fc_getcoords (database, list, axis, xmin, xmax, ymin, ymax,
+	    coords, ncoords, labels, un)
+
+	# Read points from the deletion list.
+
+	switch (axis) {
+	case 1:
+	    call fc_dlread (Memr[coords+(Z-1)*ncoords],
+		Memr[coords+(Y-1)*ncoords], Memr[coords+(W-1)*ncoords], ncoords)
+	case 2:
+	    call fc_dlread (Memr[coords+(Z-1)*ncoords],
+		Memr[coords+(X-1)*ncoords], Memr[coords+(W-1)*ncoords], ncoords)
+	}
+
+	# Initialize the graphics.
+
+	if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	    call clgstr ("graphics", logfile, SZ_FNAME)
+	    gp = gopen (logfile, NEW_FILE, STDGRAPH)
+	}
+
+	# Set plot log.
+
+	gplog = NULL
+	call clgstr ("plotfile", logfile, SZ_FNAME)
+	if (logfile[1] != EOS) {
+	    logfd = open (logfile, APPEND, BINARY_FILE)
+	    gplog = gopen ("stdplot", APPEND, logfd)
+	} else
+	    gplog = NULL
+
+	gt = gt_init ()
+	call malloc (title, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[title], SZ_LINE,
+	    "Fit User Coordinates to Image Coordinates for %s")
+	    call pargstr (fitname)
+	call gt_sets (gt, GTTITLE, Memc[title])
+	call mfree (title, TY_CHAR)
+
+	# Fit the surface.  The surface is defined over the full range of
+	# image coordinates.
+
+	call igs_setr (IGS_XMIN, xmin)
+	call igs_setr (IGS_XMAX, xmax)
+	call igs_setr (IGS_YMIN, ymin)
+	call igs_setr (IGS_YMAX, ymax)
+
+	switch (axis) {
+	case 1:
+	    if (Memr[coords+ncoords-1] == 1) {
+	        axes[1] = Y
+	        axes[2] = R
+	        call igs_fit2 (sf, gp, gplog, gt, axes, Memr[coords], ncoords,
+		    labels, interactive)
+	    } else {
+	        axes[1] = X
+	        axes[2] = R
+	        call igs_fit1 (sf, gp, gplog, gt, axes, Memr[coords], ncoords,
+		    labels, interactive)
+	    }
+	case 2:
+	    if (Memr[coords+ncoords-1] == 1) {
+	        axes[1] = X
+	        axes[2] = R
+	        call igs_fit3 (sf, gp, gplog, gt, axes, Memr[coords], ncoords,
+		    labels, interactive)
+	    } else {
+	        axes[1] = Y
+	        axes[2] = R
+	        call igs_fit1 (sf, gp, gplog, gt, axes, Memr[coords], ncoords,
+		    labels, interactive)
+	    }
+	}
+
+	# Close graphics.
+
+	if (gp != NULL)
+	    call gclose (gp)
+	if (gplog != NULL) {
+	    call gclose (gplog)
+	    call close (logfd)
+	}
+	call gt_free (gt)
+
+	# Print logs.
+
+	while (fntgfntb (logfiles, logfile, SZ_FNAME) != EOF) {
+	    logfd = open (logfile, APPEND, TEXT_FILE)
+	    call fprintf (logfd,
+		"  Map %s coordinates for axis %d using image features:\n")
+		call pargstr (labels[1, Z])
+		call pargi (axis)
+	    call fprintf (logfd, "  Number of feature coordnates = %d\n")
+		call pargi (ncoords)
+	    call igs_gets (IGS_FUNCTION, logfile, SZ_FNAME)
+	    call fprintf (logfd, "  Mapping function = %s\n")
+		call pargstr (logfile)
+	    call fprintf (logfd, "    X order = %d\n    Y order = %d\n")
+		call pargi (igs_geti (IGS_XORDER))
+		call pargi (igs_geti (IGS_YORDER))
+	    call fprintf (logfd,
+		"  Fitted coordinates at the corners of the images:\n")
+	    call fprintf (logfd, "    (%d, %d) = %g  (%d, %d) = %g\n")
+		call pargr (xmin)
+		call pargr (ymin)
+		call pargr (xgseval (sf, xmin, ymin))
+		call pargr (xmax)
+		call pargr (ymin)
+		call pargr (xgseval (sf, xmax, xmin))
+	    call fprintf (logfd, "    (%d, %d) = %g  (%d, %d) = %g\n")
+		call pargr (xmin)
+		call pargr (ymax)
+		call pargr (xgseval (sf, xmin, ymax))
+		call pargr (xmax)
+		call pargr (ymax)
+		call pargr (xgseval (sf, xmax, ymax))
+	    call close (logfd)
+	}
+	call fntrewb (logfiles)
+
+	# Write the fit to the database.
+
+	answer = true
+	if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	    call printf ("Write coordinate map to the database (yes)? ")
+	    call flush (STDOUT)
+	    if (scan() != EOF)
+	        call gargb (answer)
+	}
+	if (answer)
+	    call fc_dbwrite (database, fitname, axis, un, sf)
+
+	# Write list of deleted points.
+
+	if ((interactive == YES) || (interactive == ALWAYSYES)) {
+	    switch (axis) {
+	    case 1:
+		call fc_dlwrite (Memr[coords+(Z-1)*ncoords],
+		    Memr[coords+(Y-1)*ncoords],
+		    Memr[coords+(W-1)*ncoords], ncoords)
+	    case 2:
+		call fc_dlwrite (Memr[coords+(Z-1)*ncoords],
+		    Memr[coords+(X-1)*ncoords],
+		    Memr[coords+(W-1)*ncoords], ncoords)
+	    }
+	}
+
+	# Free memory.
+
+	call mfree (coords, TY_REAL)
+	if (un != NULL)
+	    call un_close (un)
+	call xgsfree (sf)
+end
diff --git a/noao/twodspec/longslit/transform/fcgetcoords.x b/noao/twodspec/longslit/transform/fcgetcoords.x
new file mode 100644
index 00000000..dda1c0f0
--- /dev/null
+++ b/noao/twodspec/longslit/transform/fcgetcoords.x
@@ -0,0 +1,212 @@
+include	<imio.h>
+include	<mach.h>
+include	<mwset.h>
+include	<pkg/dttext.h>
+include	<pkg/igsfit.h>
+
+# FC_GETCOORDS -- Get feature coordinates for the specified axis and list
+# of images.  Determine the image dimensions.
+
+procedure fc_getcoords (database, list, axis, xmin, xmax, ymin, ymax,
+    coords, ncoords, labels, un)
+
+char	database[ARB]			# Database
+int	list				# List of images
+int	axis				# Image axis
+real	xmin, xmax			# Image X limits
+real	ymin, ymax			# Image Y limits
+pointer	coords				# Coordinate data pointer
+pointer	ncoords				# Number of coordinate points
+char	labels[SZ_LINE,IGSPARAMS]	# Axis labels
+pointer	un				# Units pointer
+
+char	image1[SZ_FNAME], image2[SZ_FNAME], root[SZ_FNAME], units[SZ_FNAME]
+int	i, j, rec, index, imin, imax, nfeatures, ntotal
+real	value, wt, ltm[2,2], ltv[2]
+pointer	dt, im, mw, ct, x, y, user
+
+int	fc_getim(), dtgeti(), dtscan(), mw_stati()
+real	mw_c1tranr()
+bool	strne()
+pointer	dtmap1(), immap(), mw_openim(), mw_sctran(), un_open()
+
+errchk	dtmap1, dtgstr, immap
+
+begin
+	x = NULL
+	ncoords = 0
+	ntotal = 0
+	axis = 0
+	imin = MAX_INT
+	imax = -MAX_INT
+	un = NULL
+
+	while (fc_getim (list, image1, SZ_FNAME) != EOF) {
+	    call strcpy ("id", root, SZ_FNAME)
+	    call imgcluster (image1, root[3], SZ_FNAME-2)
+	    dt = dtmap1 (database, root, READ_ONLY)
+	    do rec = 1, DT_NRECS(dt) {
+
+		iferr (call dtgstr (dt, rec, "task", image2, SZ_FNAME))
+		    next
+		if (strne ("identify", image2))
+		    next
+
+	        call dtgstr (dt, rec, "image", image2, SZ_FNAME)
+		call get_root (image2, root, SZ_FNAME)
+		if (strne (image1, root))
+		    next
+
+		# Map the 1D image section and determine the axis, the
+		# line or column in the 2D image, and the 2D image size.
+
+		im = immap (image2, READ_ONLY, 0)
+		j = IM_VMAP(im, 1)
+		switch (j) {
+		case 1:
+		    index = IM_VOFF (im, 2) + 1
+		case 2:
+		    index = IM_VOFF (im, 1) + 1
+		}
+		imin = min (imin, index)
+		imax = max (imax, index)
+
+		xmin = 1.
+		xmax = IM_SVLEN (im, 1)
+		ymin = 1.
+		ymax = IM_SVLEN (im, 2)
+
+		if (axis == 0)
+		    axis = j
+
+		if (j != axis) {
+		    call imunmap (im)
+		    call eprintf (
+       "Warning: Fit axes don't agree for combine option.  Ignoring %s.\n")
+		       call pargstr (image1)
+		    break
+		}
+
+		# Set the WCS to convert the feature positions from
+		# IDENTIFY/REIDENTIFY which are in "physical" coordinates
+		# to "logical" coordinates currently used by TRANSFORM.
+
+		mw = mw_openim (im)
+		call mw_seti (mw, MW_USEAXMAP, NO)
+		i = mw_stati (mw, MW_NPHYSDIM)
+		call mw_gltermr (mw, ltm, ltv, i)
+		if (ltm[1,1] == 0. && ltm[2,2] == 0.) {
+		    ltm[1,1] = ltm[2,1]
+		    ltm[2,1] = 0.
+		    ltm[2,2] = ltm[1,2]
+		    ltm[1,2] = 0.
+		    call mw_sltermr (mw, ltm, ltv, i)
+		} else if (ltm[1,2] != 0. || ltm[2,1] != 0.) {
+		    ltv[1] = 0.
+		    ltv[2] = 0.
+		    ltm[1,1] = 1.
+		    ltm[2,1] = 0.
+		    ltm[2,2] = 1.
+		    ltm[1,2] = 0.
+		    call mw_sltermr (mw, ltm, ltv, i)
+		}
+		call mw_seti (mw, MW_USEAXMAP, YES)
+		ct = mw_sctran (mw, "physical", "logical", 1)
+
+		# Allocate memory for the feature information and read
+		# the database.
+
+		ifnoerr (call dtgstr (dt, rec, "units", units, SZ_FNAME))
+		    un = un_open (units)
+		nfeatures = dtgeti (dt, rec, "features")
+		if (x == NULL) {
+		    call malloc (x, nfeatures, TY_REAL)
+		    call malloc (y, nfeatures, TY_REAL)
+		    call malloc (user, nfeatures, TY_REAL)
+		} else {
+		    call realloc (x, ncoords+nfeatures, TY_REAL)
+		    call realloc (y, ncoords+nfeatures, TY_REAL)
+		    call realloc (user, ncoords+nfeatures, TY_REAL)
+		}
+
+		do i = 1, nfeatures {
+		    j = dtscan (dt)
+		    call gargr (value)
+		    switch (axis) {
+		    case 1:
+			Memr[x+ncoords] = mw_c1tranr (ct, value)
+			Memr[y+ncoords] = index
+		    case 2:
+			Memr[x+ncoords] = index
+			Memr[y+ncoords] = mw_c1tranr (ct, value)
+		    }
+		    call gargr (value)
+		    call gargr (value)
+		    call gargr (wt)
+		    call gargr (wt)
+		    call gargr (wt)
+		    if (!IS_INDEF (value) && wt > 0.) {
+			Memr[user+ncoords] = value
+			ncoords = ncoords + 1
+		    }
+		    ntotal = ntotal + 1
+		}
+		call mw_close (mw)
+		call imunmap (im)
+	    }
+
+	    # Finish up
+	    call dtunmap (dt)
+	}
+
+	# Set coordinates.  Take error action if no features are found.
+
+	if (ncoords > 0) {
+	    call xt_sort3 (Memr[user], Memr[x], Memr[y], ncoords)
+	    call malloc (coords, ncoords*IGSPARAMS, TY_REAL)
+	    call amovr (Memr[x], Memr[coords+(X-1)*ncoords], ncoords)
+	    call amovr (Memr[y], Memr[coords+(Y-1)*ncoords], ncoords)
+	    call amovr (Memr[user], Memr[coords+(Z-1)*ncoords], ncoords)
+	    call amovkr (1., Memr[coords+(W-1)*ncoords], ncoords)
+
+	    call fc_setfeatures (Memr[coords], Memr[coords+(Z-1)*ncoords],
+		ncoords)
+
+	    call strcpy ("X (pixels)", labels[1,X], SZ_LINE)
+	    call strcpy ("Y (pixels)", labels[1,Y], SZ_LINE)
+	    call strcpy ("User", labels[1,Z], SZ_LINE)
+	    call strcpy ("Surface", labels[1,S], SZ_LINE)
+	    call strcpy ("Residuals", labels[1,R], SZ_LINE)
+	}
+
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+	call mfree (user, TY_REAL)
+
+	if (ncoords == 0) {
+	    if (ntotal == 0)
+		call error (1, "No coordinates found in database")
+	    else
+		call error (1, "Only INDEF coordinates found in database")
+	}
+end
+
+
+# FC_SETFEATURES -- Set the feature numbers.
+
+procedure fc_setfeatures (features, user, npts)
+
+real	features[npts]			# Feature numbers
+real	user[npts]			# User coordinates
+int	npts				# Number of points
+
+int	i
+
+begin
+	features[1] = 1
+	do i = 2, npts {
+	    features[i] = features[i-1]
+	    if (user[i] != user[i-1])
+		features[i] = features[i] + 1
+	}
+end
diff --git a/noao/twodspec/longslit/transform/fcgetim.x b/noao/twodspec/longslit/transform/fcgetim.x
new file mode 100644
index 00000000..e76ba25a
--- /dev/null
+++ b/noao/twodspec/longslit/transform/fcgetim.x
@@ -0,0 +1,32 @@
+# FC_GETIM -- Get next image name with standard image extensions removed.
+# This is necessary to avoid having two legal image names refering to the
+# same image.
+
+int procedure fc_getim (list, image, maxchar)
+
+int	list		# Image list
+char	image[maxchar]	# Image name
+int	maxchar		# Maximum number of chars in image name
+
+int	i, stat, imtgetim(), strmatch()
+
+begin
+	stat = imtgetim (list, image, maxchar)
+
+	if (stat == EOF)
+	    return (stat)
+
+	i = strmatch (image, ".imh")
+	if (i > 0) {
+	    call strcpy (image[i], image[i-4], maxchar)
+	    return (stat)
+	}
+
+	i = strmatch (image, ".hhh")
+	if (i > 0) {
+	    call strcpy (image[i], image[i-4], maxchar)
+	    return (stat)
+	}
+
+  	return (stat)
+end
diff --git a/noao/twodspec/longslit/transform/fitcoords.x b/noao/twodspec/longslit/transform/fitcoords.x
new file mode 100644
index 00000000..e849caf2
--- /dev/null
+++ b/noao/twodspec/longslit/transform/fitcoords.x
@@ -0,0 +1,83 @@
+include	<error.h>
+include	<pkg/igsfit.h>
+include	<pkg/xtanswer.h>
+
+# T_FITCOORDS -- Fit a surface to the coordinates of longslit images.
+#
+# This is the CL entry for this task.  All the real work is done by
+# fc_fitcoords.
+
+procedure t_fitcoords ()
+
+int	list1			# Image list
+char	fitname[SZ_FNAME]	# Database name for coordinate fit
+char	database[SZ_FNAME]	# Database
+int	logfiles		# List of log files
+bool	combine			# Combine input data?
+int	interactive		# Interactive?
+
+char	image[SZ_FNAME], prompt[SZ_LINE]
+int	list2
+
+int	clgeti(), clpopnu(), imtopen(), fc_getim()
+bool	clgetb()
+
+begin
+	# Get the task parameters.
+
+	call clgstr ("fitname", fitname, SZ_FNAME)
+	call xt_stripwhite (fitname)
+	combine = clgetb ("combine")
+
+	if (combine && (fitname[1] == EOS))
+	    call error (0, "Fit name not specified")
+
+	call clgstr ("images", prompt, SZ_LINE)
+	list1 = imtopen (prompt)
+	call clgstr ("database", database, SZ_FNAME)
+	logfiles = clpopnu ("logfiles")
+	if (clgetb ("interactive"))
+	    interactive = YES
+	else
+	    interactive = ALWAYSNO
+
+	# Set the initial surface in the igsfit package.
+
+	call clgstr ("function", prompt, SZ_LINE)
+	call igs_sets (IGS_FUNCTION, prompt)
+	call igs_seti (IGS_XORDER, clgeti ("xorder"))
+	call igs_seti (IGS_YORDER, clgeti ("yorder"))
+
+	# For each fit ask the user whether to do the fit interactively.
+	# If combining the coordinates from all the images in the
+	# input list then pass the list directly to fc_fitcoords.
+	# Otherwise for each image in the list create a second list
+	# containing just that image.  A second list is needed because
+	# fc_fitcoords expects a list.
+
+	if (combine) {
+	    call sprintf (prompt, SZ_LINE, "Fit interactively")
+	    call xt_answer (prompt, interactive)
+	    call fc_fitcoords (fitname, database, list1, logfiles, interactive)
+
+	} else {
+	    while (fc_getim (list1, image, SZ_FNAME) != EOF) {
+	        list2 = imtopen (image)
+	        call sprintf (prompt, SZ_LINE, "Fit %s interactively")
+		    call pargstr (image)
+	        call xt_answer (prompt, interactive)
+		call sprintf (prompt, SZ_LINE, "%s%s")
+		    call pargstr (fitname)
+		    call pargstr (image)
+	        iferr (call fc_fitcoords (prompt, database, list2, logfiles,
+		    interactive))
+		    call erract (EA_WARN)
+	        call imtclose (list2)
+	    }
+	}
+
+	# Finish up.
+
+	call clpcls (logfiles)
+	call imtclose (list1)
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/Revisions b/noao/twodspec/longslit/transform/igsfit/Revisions
new file mode 100644
index 00000000..92b36cca
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/Revisions
@@ -0,0 +1,42 @@
+.help revisions Jun88 noao.twodspec.longslit.transform.igsfit
+.nf
+ igsfit.x
+ igsnearest.x
+     GSCUR was being called with DOUBLE precision values. (12/22/87)
+
+ igsfit.x
+ igscolon.x
+ igsget.x
+     Added colon options to print fit at corners of surface. (8/10/87 Valdes)
+
+ ====
+ V2.5
+ ====
+
+noao$twodspec/longslit/transform/igsfit/*.x
+    Valdes, February 17, 1987
+    1.  GIO changes.
+
+noao$twodspec/longslit/transform/igsfit/igsfit.x
+noao$twodspec/longslit/transform/igsfit/igscolon.x
+    Valdes, January 16, 1987
+    1.  '?' now uses system page facility.
+    2.  Colon command dictionary and switch modified to use macro definitions.
+
+noao$twodspec/longslit/transform/igsfit/igsdelete.x
+noao$twodspec/longslit/transform/igsfit/igsundelete.x
+    Valdes, October 16, 1986
+    1.  Real line type specified in gseti call changed to integer.
+	This caused a crash on AOS/IRAF.
+
+========================================================
+
+From Valdes on Feb 7, 1986:
+
+1.  Bug fixed in deleting and undeleting points.
+------
+From Valdes on Jan 3, 1986:
+
+1.  Modified IGSFIT to allow zooming on constant x, constant y, constant z,
+and constant feature.
+.endhelp
diff --git a/noao/twodspec/longslit/transform/igsfit/igscolon.x b/noao/twodspec/longslit/transform/igsfit/igscolon.x
new file mode 100644
index 00000000..6847974a
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igscolon.x
@@ -0,0 +1,115 @@
+include	<gset.h>
+
+# List of colon commands
+define	CMDS "|show|function|xorder|yorder|corners|"
+
+define	SHOW		1	# Show parameters
+define	FUNCTION	2	# Set or show function type
+define	XORDER		3	# Set or show x order of function
+define	YORDER		4	# Set or show y order of function
+define	CORNERS		5	# Show corners
+
+# IGS_COLON -- Processes colon commands.
+
+procedure igs_colon (cmdstr, gp, sf)
+
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+pointer	sf				# Surface pointer
+
+char	cmd[SZ_LINE]
+int	ncmd, ival
+
+int	nscan(), strdic()
+real	xgseval()
+
+string	funcs "|chebyshev|legendre|"
+
+include	"igsfit.com"
+
+begin
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call sscan (cmdstr)
+	call gargwrd (cmd, SZ_LINE)
+	ncmd = strdic (cmd, cmd, SZ_LINE, CMDS)
+
+	switch (ncmd) {
+	case SHOW: # :show - Show the values of the fitting parameters.
+	    call gdeactivate (gp, AW_CLEAR)
+	    call printf ("function %s\n")
+		call pargstr (function)
+	    call printf ("xorder %d\n")
+		call pargi (xorder)
+	    call printf ("yorder %d\n")
+		call pargi (yorder)
+	    call printf ("Fitted coordinates at the corners of the images:\n")
+	    call printf ("    (%d, %d) = %g  (%d, %d) = %g\n")
+		call pargr (xmin)
+		call pargr (ymin)
+		call pargr (xgseval (sf, xmin, ymin))
+		call pargr (xmax)
+		call pargr (ymin)
+		call pargr (xgseval (sf, xmax, xmin))
+	    call printf ("    (%d, %d) = %g  (%d, %d) = %g\n")
+		call pargr (xmin)
+		call pargr (ymax)
+		call pargr (xgseval (sf, xmin, ymax))
+		call pargr (xmax)
+		call pargr (ymax)
+		call pargr (xgseval (sf, xmax, ymax))
+	    call printf ("rms %g\n")
+		call pargr (rms)
+	    call greactivate (gp, AW_PAUSE)
+
+	case FUNCTION: # :function - List or set the fitting function.
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("function = %s\n")
+		    call pargstr (function)
+	    } else {
+		if (strdic (cmd, cmd, SZ_LINE, funcs) > 0)
+		    call strcpy (cmd, function, SZ_LINE)
+		else
+		    call printf ("Unknown or ambiguous function\n")
+	    }
+
+	case XORDER: # xorder: List or set the function order.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("xorder %d\n")
+		    call pargi (xorder)
+	    } else if (ival < 2)
+		call printf ("xorder must be at least 2\n")
+	    else
+		xorder = ival
+
+	case YORDER: # yorder: List or set the function order.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("yorder %d\n")
+		    call pargi (yorder)
+	    } else if (ival < 2)
+		call printf ("yorder must be at least 2\n")
+	    else
+		yorder = ival
+	case CORNERS: # corners: List coordinates at corners.
+	    call printf ("(%d,%d)=%g (%d,%d)=%g (%d,%d)=%g (%d,%d)=%g\n")
+		call pargr (xmin)
+		call pargr (ymin)
+		call pargr (xgseval (sf, xmin, ymin))
+		call pargr (xmax)
+		call pargr (ymin)
+		call pargr (xgseval (sf, xmax, xmin))
+		call pargr (xmin)
+		call pargr (ymax)
+		call pargr (xgseval (sf, xmin, ymax))
+		call pargr (xmax)
+		call pargr (ymax)
+		call pargr (xgseval (sf, xmax, ymax))
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	}
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsdelete.x b/noao/twodspec/longslit/transform/igsfit/igsdelete.x
new file mode 100644
index 00000000..3de2fb25
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsdelete.x
@@ -0,0 +1,103 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<pkg/igsfit.h>
+
+# IGS_NEARESTD -- Nearest point to delete.
+
+int procedure igs_nearestd (gp, ztype, refpt, axis, pts, npts, wx, wy, wcs)
+
+pointer	gp			# GIO pointer
+int	ztype			# Zoom type
+int	refpt			# Reference point
+int	axis[2]			# Axes
+real	pts[npts, ARB]		# Data points
+int	npts			# Number of data points
+real	wx, wy			# Cursor coordinates
+int	wcs			# WCS
+
+int	i, j, x, y
+real	r2, r2min, x0, y0
+
+begin
+	x = axis[1]
+	y = axis[2]
+
+	call gctran (gp, wx, wy, wx, wy, wcs, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	if (IS_INDEFI (ztype)) {
+	    do i = 1, npts {
+	        if (pts[i,W] == 0.)
+		    next
+	        call gctran (gp, pts[i, x], pts[i, y], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	} else {
+	    do i = 1, npts {
+	        if ((pts[i,ztype] != pts[refpt,ztype]) || (pts[i,W] == 0.))
+		    next
+	        call gctran (gp, pts[i, x], pts[i, y], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	}
+
+	return (j)
+end
+
+# IGS_DELETE -- Delete points or subsets.
+
+procedure igs_delete (gp, gt, ztype, refpt, axis, pts, npts, dtype)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+int	ztype			# Zoom type
+int	refpt			# Reference point for deletion
+int	axis[2]			# Axes
+real	pts[npts, ARB]		# Data points
+int	npts			# Number of data points
+int	dtype			# Deletion type
+
+int	i, x, y
+real	xsize, ysize
+
+real	gt_getr()
+
+begin
+	x = axis[1]
+	y = axis[2]
+
+	xsize = gt_getr (gt, GTXSIZE)
+	ysize = gt_getr (gt, GTYSIZE)
+
+	switch (dtype) {
+	case X, Y, Z:
+	    do i = 1, npts {
+		if (!IS_INDEFI (ztype))
+		    if (pts[i,ztype] != pts[refpt,ztype])
+		        next
+		if (pts[i,dtype] != pts[refpt,dtype])
+		    next
+	        call gseti (gp, G_PMLTYPE, 0)
+	        call gmark (gp, pts[i,x], pts[i,y], GM_PLUS, xsize, ysize)
+	        call gseti (gp, G_PMLTYPE, 1)
+	        call gmark (gp, pts[i,x], pts[i,y], GM_CROSS, xsize, ysize)
+		pts[i,W] = 0.
+	    }
+	default:
+	    call gseti (gp, G_PMLTYPE, 0)
+	    call gmark (gp, pts[refpt,x], pts[refpt,y], GM_PLUS, xsize, ysize)
+	    call gseti (gp, G_PMLTYPE, 1)
+	    call gmark (gp, pts[refpt,x], pts[refpt,y], GM_CROSS, xsize, ysize)
+	    pts[refpt,W] = 0.
+	}
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsfit.com b/noao/twodspec/longslit/transform/igsfit/igsfit.com
new file mode 100644
index 00000000..90bf90aa
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsfit.com
@@ -0,0 +1,10 @@
+# Common parameters.
+
+char	function[SZ_LINE]	# Surface function
+int	xorder			# X order of surface function
+int	yorder			# Y order of surface function
+real	xmin, xmax		# X range
+real	ymin, ymax		# Y range
+real	mean, rms		# Mean and RMS of fit
+
+common	/igscom/ xmin, xmax, ymin, ymax, xorder, yorder, function, mean, rms
diff --git a/noao/twodspec/longslit/transform/igsfit/igsfit.x b/noao/twodspec/longslit/transform/igsfit/igsfit.x
new file mode 100644
index 00000000..14e8e51e
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsfit.x
@@ -0,0 +1,373 @@
+include	<mach.h>
+include	<pkg/gtools.h>
+include <pkg/igsfit.h>
+
+define	HELP	"noao$lib/scr/igsfit.key"
+define	PROMPT	"fitcoords surface fitting options"
+
+
+# IGS_FIT1 -- Fit z = f(x, y)
+
+procedure igs_fit1 (sf, gp, gplog, gt, axis, pts, npts, labels, interactive)
+
+pointer	sf			# GSURFIT pointer
+pointer	gp			# GIO pointer
+pointer	gplog			# GIO pointer for plot log
+pointer	gt			# GTOOLS pointer
+int	axis[2]			# Axis definitions
+real	pts[npts, ARB]		# Data
+int	npts			# Number of pts points
+char	labels[SZ_LINE, ARB]	# Identification labels
+int	interactive		# Interactive?
+
+extern	igs_solve1()
+
+begin
+	call igs_fit (sf, gp, gplog, gt, axis, pts, npts, labels, interactive,
+	    igs_solve1)
+end
+
+
+# IGS_FIT2 -- Fit z = x + f(y)
+
+procedure igs_fit2 (sf, gp, gplog, gt, axis, pts, npts, labels, interactive)
+
+pointer	sf			# GSURFIT pointer
+pointer	gp			# GIO pointer
+pointer	gplog			# GIO pointer for plot log
+pointer	gt			# GTOOLS pointer
+int	axis[2]			# Axis definitions
+real	pts[npts, ARB]		# Data
+int	npts			# Number of pts points
+char	labels[SZ_LINE, ARB]	# Identification labels
+int	interactive		# Interactive?
+
+extern	igs_solve2()
+
+begin
+	call igs_fit (sf, gp, gplog, gt, axis, pts, npts, labels, interactive,
+	    igs_solve2)
+end
+
+
+# IGS_FIT3 -- Fit z = y + f(x)
+
+procedure igs_fit3 (sf, gp, gplog, gt, axis, pts, npts, labels, interactive)
+
+pointer	sf			# GSURFIT pointer
+pointer	gp			# GIO pointer
+pointer	gplog			# GIO pointer for plot log
+pointer	gt			# GTOOLS pointer
+int	axis[2]			# Axis definitions
+real	pts[npts, ARB]		# Data
+int	npts			# Number of pts points
+char	labels[SZ_LINE, ARB]	# Identification labels
+int	interactive		# Interactive?
+
+extern	igs_solve3()
+
+begin
+	call igs_fit (sf, gp, gplog, gt, axis, pts, npts, labels, interactive,
+	    igs_solve3)
+end
+
+
+# IGS_FIT -- Interactive surface fitting.
+
+procedure igs_fit (sf, gp, gplog, gt, axis, pts, npts, labels, interactive, igs_solve)
+
+pointer	sf			# GSURFIT pointer
+pointer	gp			# GIO pointer
+pointer	gplog			# GIO pointer for plot log
+pointer	gt			# GTOOLS pointer
+int	axis[2]			# Axis definitions
+real	pts[npts, ARB]		# Data
+int	npts			# Number of pts points
+char	labels[SZ_LINE, ARB]	# Identification labels
+int	interactive		# Interactive?
+extern	igs_solve()		# Surface solution routine
+
+int	i, newgraph, ztype, dtype, refpt, refpt1
+real	zval, zval1
+pointer	wts
+
+real	wx, wy
+int	wcs, key
+char	cmd[SZ_LINE]
+
+int	clgcur(), gt_gcur(), igs_nearest(), igs_nearestd(), igs_nearestu()
+errchk	igs_solve
+
+include	"igsfit.com"
+
+begin
+	# Compute a solution and set the residuals.
+
+	call igs_solve (sf, pts[1,X], pts[1,Y], pts[1,Z], pts[1,W], npts)
+	call xgsvector (sf, pts[1,X], pts[1,Y], pts[1,S], npts)
+	call asubr (pts[1,Z], pts[1,S], pts[1,R], npts)
+	call aavgr (pts[1,R], npts, mean, rms)
+	call igs_params (gt)
+
+	# Return if not interactive.
+
+	ztype = INDEFI
+	if ((gp == NULL) || (interactive == NO))
+	    goto 30
+
+	call malloc (wts, npts, TY_REAL)
+	call amovr (pts[1,W],  Memr[wts], npts)
+
+	call igs_graph (gp, gt, ztype, refpt, axis, pts, npts, labels)
+	newgraph = NO
+
+	# Read cursor commands.
+
+10	while (gt_gcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) != EOF) {
+	    switch (key) {
+	    case '?':
+		# Print help text.
+
+		call gpagefile (gp, HELP, PROMPT)
+
+	    case ':':
+		# List or set parameters
+
+		if (cmd[1] == '/')
+		    call gt_colon (cmd, gp, gt, newgraph)
+		else
+		    call igs_colon (cmd, gp, sf)
+
+	    # Set abscissa
+
+	    case 'x':
+		call printf ("Select abscissa (x, y, z, s, r): ")
+		if (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto 10
+		call printf ("\n")
+
+		switch (key) {
+		case 'x':
+		    i = X
+		case 'y':
+		    i = Y
+		case 'z':
+		    i = Z
+		case 's':
+		    i = S
+		case 'r':
+		    i = R
+		default:
+		    call printf ("\07\n")
+		    goto 10
+		}
+
+		if (axis[1] != i) {
+		    axis[1] = i
+		    call gt_setr (gt, GTXMIN, INDEF)
+		    call gt_setr (gt, GTXMAX, INDEF)
+		}
+
+	    # Set ordinate
+
+	    case 'y':
+		call printf ("Select ordinate (x, y, z, s, r): ")
+		if(clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto 10
+		call printf ("\n")
+
+		switch (key) {
+		case 'x':
+		    i = X
+		case 'y':
+		    i = Y
+		case 'z':
+		    i = Z
+		case 's':
+		    i = S
+		case 'r':
+		    i = R
+		default:
+		    call printf ("\07\n")
+		    goto 10
+		}
+
+		if (axis[2] != i) {
+		    axis[2] = i
+		    call gt_setr (gt, GTYMIN, INDEF)
+		    call gt_setr (gt, GTYMAX, INDEF)
+		}
+
+	    case 'r':
+		newgraph = YES
+
+	    case 'z':
+		if (IS_INDEFI (ztype)) {
+		    refpt = igs_nearest (gp, ztype, refpt, axis, pts, npts, wx,
+			wy, wcs)
+
+		    call printf ("Zoom type (x, y, z): ")
+		    if (clgcur ("cursor",wx,wy,wcs,key,cmd,SZ_LINE) == EOF)
+			goto 10
+		    call printf ("\n")
+
+		    switch (key) {
+		    case 'x':
+		        ztype = X
+		    case 'y':
+		        ztype = Y
+		    case 'z':
+		        ztype = Z
+		    default:
+		        call printf ("\07\n")
+		        goto 10
+		    }
+
+		    newgraph = YES
+		}
+
+	    case 'p':
+		if (!IS_INDEFI (ztype)) {
+		    ztype = INDEFI
+		    newgraph = YES
+		}
+
+	    case 'l':
+		if (!IS_INDEFI (ztype)) {
+		    refpt1 = 0
+		    zval = pts[refpt, ztype]
+		    zval1 = -MAX_REAL
+		    do i = 1, npts {
+			if ((pts[i,ztype] < zval) && (pts[i,ztype] > zval1)) {
+			    refpt1 = i
+			    zval1 = pts[refpt1,ztype]
+			}
+		    }
+
+		    if (refpt1 != 0) {
+			refpt = refpt1
+		        newgraph = YES
+		    }
+		}
+
+	    case 'n':
+		if (!IS_INDEFI (ztype)) {
+		    refpt1 = 0
+		    zval = pts[refpt, ztype]
+		    zval1 = MAX_REAL
+		    do i = 1, npts {
+			if ((pts[i,ztype] > zval) && (pts[i,ztype] < zval1)) {
+			    refpt1 = i
+			    zval1 = pts[refpt1,ztype]
+			}
+		    }
+
+		    if (refpt1 != 0) {
+			refpt = refpt1
+		        newgraph = YES
+		    }
+		}
+
+	    case 'c':
+		# cursor read
+		i = igs_nearest (gp, ztype, refpt, axis, pts, npts, wx, wy, wcs)
+		call printf ("%g %g %g %g %g %g\n")
+		    call pargr (pts[i, X])
+		    call pargr (pts[i, Y])
+		    call pargr (pts[i, Z])
+		    call pargr (pts[i, W])
+		    call pargr (pts[i, S])
+		    call pargr (pts[i, R])
+
+	    case 'd':
+		i = igs_nearestd (gp, ztype, refpt, axis, pts, npts, wx, wy,
+		    wcs)
+		if (i == 0)
+		    goto 10
+
+	        call gscur (gp, real (pts[i,axis[1]]), real (pts[i,axis[2]]))
+
+		call printf ( "Delete 'p'oint or constant 'x', 'y', or 'z': ")
+		if (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto 10
+		call printf ("\n")
+
+		switch (key) {
+		case 'p':
+		    dtype = 0
+		case 'x':
+		    dtype = X
+		case 'y':
+		    dtype = Y
+		case 'z':
+		    dtype = Z
+		default:
+		    call printf ("\07\n")
+		    goto 10
+		}
+
+		call igs_delete (gp, gt, ztype, i, axis, pts, npts, dtype)
+
+	    case 'u':
+		i = igs_nearestu (gp, ztype, refpt, axis, pts, npts, wx, wy,
+		    wcs)
+		if (i == 0)
+		    goto 10
+
+	        call gscur (gp, real (pts[i,axis[1]]), real (pts[i,axis[2]]))
+
+		call printf ( "Undelete 'p'oint or constant 'x', 'y', or 'z': ")
+		if (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto 10
+		call printf ("\n")
+
+		switch (key) {
+		case 'p':
+		    dtype = 0
+		case 'x':
+		    dtype = X
+		case 'y':
+		    dtype = Y
+		case 'z':
+		    dtype = Z
+		default:
+		    call printf ("\07\n")
+		    goto 10
+		}
+
+		call igs_undelete (gp, gt, ztype, i, axis, pts, Memr[wts],
+		    npts, dtype)
+
+	    case 'f':
+		#call printf ("Fitting ...")
+		#call flush (STDOUT)
+		call igs_solve (sf,pts[1,X],pts[1,Y],pts[1,Z],pts[1,W],npts)
+		call xgsvector (sf, pts[1,X], pts[1,Y], pts[1,S], npts)
+		call asubr (pts[1,Z], pts[1,S], pts[1,R], npts)
+		call aavgr (pts[1,R], npts, mean, rms)
+		call igs_params (gt)
+		newgraph = YES
+
+	    case 'w':
+		call gt_window (gt, gp, "cursor", newgraph)
+
+	    case 'I':
+		call fatal (0, "Interrupt")
+
+	    default:
+		# Ring the bell.
+
+		call printf ("\07\n")
+	    }
+
+	    if (newgraph == YES) {
+		call igs_graph (gp, gt, ztype, refpt, axis, pts, npts, labels)
+		newgraph = NO
+	    }
+	}
+
+	call mfree (wts, TY_REAL)
+
+30	call igs_graph (gplog, gt, ztype, refpt, axis, pts, npts, labels)
+
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsget.x b/noao/twodspec/longslit/transform/igsfit/igsget.x
new file mode 100644
index 00000000..ccd1fb6c
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsget.x
@@ -0,0 +1,62 @@
+include	<pkg/igsfit.h>
+
+# IGS_GETI -- Get the value of an integer parameter.
+
+int procedure igs_geti (param)
+
+int	param			# IGS parameter
+
+include	"igsfit.com"
+
+begin
+	switch (param) {
+	case IGS_XORDER:
+	    return (xorder)
+	case IGS_YORDER:
+	    return (yorder)
+	default:
+	    call error (0, "igs_geti: Unknown parameter")
+	}
+end
+
+
+# IGS_GETS -- Get the value of a string parameter.
+
+procedure igs_gets (param, str, maxchar)
+
+int	param			# IGS parameter
+char	str[maxchar]		# String
+int	maxchar			# Maximum number of characters
+
+include	"igsfit.com"
+
+begin
+	switch (param) {
+	case IGS_FUNCTION:
+	    call strcpy (function, str, maxchar)
+	default:
+	    call error (0, "igs_gets: Unknown parameter")
+	}
+end
+
+
+# IGS_GETR -- Get the values of real valued fitting parameters.
+
+real procedure igs_getr (param)
+
+int	param			# Parameter to be get
+
+include	"igsfit.com"
+
+begin
+	switch (param) {
+	case IGS_XMIN:
+	    return (xmin)
+	case IGS_XMAX:
+	    return (xmax)
+	case IGS_YMIN:
+	    return (ymin)
+	case IGS_YMAX:
+	    return (ymax)
+	}
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsgraph.x b/noao/twodspec/longslit/transform/igsfit/igsgraph.x
new file mode 100644
index 00000000..83eba7e1
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsgraph.x
@@ -0,0 +1,73 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<pkg/igsfit.h>
+
+procedure igs_graph (gp, gt, ztype, refpt, axis, pts, npts, labels)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+int	ztype			# Zoom type
+int	refpt			# Reference point
+int	axis[2]			# Axis definitions
+real	pts[npts, ARB]		# Data
+int	npts			# Number of pts points
+char	labels[SZ_LINE, ARB]	# Data labels
+
+int	i, x, y
+real	xmin, xmax, ymin, ymax, xsize, ysize, gt_getr()
+
+begin
+	if (gp == NULL)
+	    return
+
+	x = axis[1]
+	y = axis[2]
+
+	call gt_sets (gt, GTXLABEL, labels[1, x])
+	call gt_sets (gt, GTYLABEL, labels[1, y])
+	xsize = gt_getr (gt, GTXSIZE)
+	ysize = gt_getr (gt, GTYSIZE)
+
+	call gclear (gp)
+
+	if (IS_INDEFI (ztype)) {
+	    call gascale (gp, pts[1, x], npts, 1)
+	    call gascale (gp, pts[1, y], npts, 2)
+	} else {
+	    xmin = MAX_REAL
+	    xmax = -MAX_REAL
+	    ymin = MAX_REAL
+	    ymax = -MAX_REAL
+	    do i = 1, npts {
+		if (pts[i,ztype] != pts[refpt,ztype])
+		    next
+		xmin = min (xmin, pts[i,x])
+		xmax = max (xmax, pts[i,x])
+		ymin = min (ymin, pts[i,y])
+		ymax = max (ymax, pts[i,y])
+	    }
+	    call gswind (gp, xmin, xmax, ymin, ymax)
+	}
+
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+
+	if (IS_INDEFI (ztype)) {
+	    do i = 1, npts {
+	        if (pts[i,W] == 0.)
+		    call gmark (gp, pts[i,x], pts[i,y], GM_CROSS, xsize, ysize)
+	        else
+		    call gmark (gp, pts[i,x], pts[i,y], GM_PLUS, xsize, ysize)
+	    }
+	} else {
+	    do i = 1, npts {
+		if (pts[i,ztype] != pts[refpt,ztype])
+		    next
+	        if (pts[i,W] == 0.)
+		    call gmark (gp, pts[i,x], pts[i,y], GM_CROSS, xsize, ysize)
+	        else
+		    call gmark (gp, pts[i,x], pts[i,y], GM_PLUS, xsize, ysize)
+	    }
+	}
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsinit.x b/noao/twodspec/longslit/transform/igsfit/igsinit.x
new file mode 100644
index 00000000..f084e7ff
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsinit.x
@@ -0,0 +1,21 @@
+include	<pkg/igsfit.h>
+
+# IGS_INIT -- Initialize the surface fitting parameters.
+
+procedure igs_init (function, xorder, yorder, xmin, xmax, ymin, ymax)
+
+char	function[ARB]		# Function
+int	xorder			# X order
+int	yorder			# Y order
+real	xmin, xmax		# X range
+real	ymin, ymax		# Y range
+
+begin
+	call igs_sets (IGS_FUNCTION, function)
+	call igs_seti (IGS_XORDER, xorder)
+	call igs_seti (IGS_YORDER, yorder)
+	call igs_setr (IGS_XMIN, xmin)
+	call igs_setr (IGS_XMAX, xmax)
+	call igs_setr (IGS_YMIN, ymin)
+	call igs_setr (IGS_YMAX, ymax)
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsnearest.x b/noao/twodspec/longslit/transform/igsfit/igsnearest.x
new file mode 100644
index 00000000..69888509
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsnearest.x
@@ -0,0 +1,51 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/igsfit.h>
+
+int procedure igs_nearest (gp, ztype, refpt, axis, pts, npts, wx, wy, wcs)
+
+pointer	gp			# GIO pointer
+int	ztype			# Zoom type
+int	refpt			# Reference point
+int	axis[2]			# Axes
+real	pts[npts, ARB]		# Data points
+int	npts			# Number of data points
+real	wx, wy			# Cursor coordinates
+int	wcs			# WCS
+
+int	i, j, x, y
+real	r2, r2min, x0, y0
+
+begin
+	x = axis[1]
+	y = axis[2]
+
+	call gctran (gp, wx, wy, wx, wy, wcs, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	if (IS_INDEFI (ztype)) {
+	    do i = 1, npts {
+	        call gctran (gp, pts[i,x], pts[i,y], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	} else {
+	    do i = 1, npts {
+		if (pts[i,ztype] != pts[refpt,ztype])
+		    next
+	        call gctran (gp, pts[i,x], pts[i,y], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	}
+
+	call gscur (gp, real (pts[j,x]), real (pts[j,y]))
+	return (j)
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsparams.x b/noao/twodspec/longslit/transform/igsfit/igsparams.x
new file mode 100644
index 00000000..9ecdd422
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsparams.x
@@ -0,0 +1,23 @@
+include	<pkg/gtools.h>
+
+# IGS_PARAMS -- Set the GTOOLS parameter string.
+
+procedure igs_params (gt)
+
+pointer	gt		# GTOOLS pointer
+
+pointer	params
+
+include	"igsfit.com"
+
+begin
+	call malloc (params, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[params], SZ_LINE,
+	    "Function = %s, xorder = %d, yorder = %d, rms = %.4g")
+	    call pargstr (function)
+	    call pargi (xorder)
+	    call pargi (yorder)
+	    call pargr (rms)
+	call gt_sets (gt, GTPARAMS, Memc[params])
+	call mfree (params, TY_CHAR)
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsset.x b/noao/twodspec/longslit/transform/igsfit/igsset.x
new file mode 100644
index 00000000..ea74e8c9
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsset.x
@@ -0,0 +1,59 @@
+include	<pkg/igsfit.h>
+
+# IGS_SETS -- Set the values of string valued fitting parameters.
+
+procedure igs_sets (param, str)
+
+int	param			# Parameter to be set
+char	str[ARB]		# String value
+
+include	"igsfit.com"
+
+begin
+	switch (param) {
+	case IGS_FUNCTION:
+	    call strcpy (str, function, SZ_LINE)
+	}
+end
+
+
+# IGS_SETI -- Set the values of integer valued fitting parameters.
+
+procedure igs_seti (param, ival)
+
+int	param			# Parameter to be set
+int	ival			# Integer value
+
+include	"igsfit.com"
+
+begin
+	switch (param) {
+	case IGS_XORDER:
+	    xorder = ival
+	case IGS_YORDER:
+	    yorder = ival
+	}
+end
+
+
+# IGS_SETR -- Set the values of real valued fitting parameters.
+
+procedure igs_setr (param, rval)
+
+int	param			# Parameter to be set
+real	rval			# Real value
+
+include	"igsfit.com"
+
+begin
+	switch (param) {
+	case IGS_XMIN:
+	    xmin = rval
+	case IGS_XMAX:
+	    xmax = rval
+	case IGS_YMIN:
+	    ymin = rval
+	case IGS_YMAX:
+	    ymax = rval
+	}
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igssolve.x b/noao/twodspec/longslit/transform/igsfit/igssolve.x
new file mode 100644
index 00000000..a7e39354
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igssolve.x
@@ -0,0 +1,173 @@
+include	<math/gsurfit.h>
+
+
+# IGS_SOLVE1 -- Fit z = f(x, y).
+
+define	SFTYPES		"|chebyshev|legendre|"		# Surface types
+
+procedure igs_solve1 (sf, x, y, z, w, npts)
+
+pointer	sf			# GSURFIT pointer
+real	x[npts]			# X points
+real	y[npts]			# Y points
+real	z[npts]			# Z points
+real	w[npts]			# Weights
+int	npts			# Number of points
+
+int	i, nfunc, ix, iy
+pointer	sf1, sf2, resids
+
+int	strdic()
+
+include	"igsfit.com"
+
+begin
+	# Determine the function type.
+
+	nfunc = strdic (function, function, SZ_LINE, SFTYPES)
+
+	# Fit the first surface.
+
+	ix = min (2, xorder)
+	iy = min (2, yorder)
+	call xgsinit (sf1, nfunc, ix, iy, NO, xmin, xmax, ymin, ymax)
+	call xgsfit (sf1, x, y, z, w, npts, WTS_USER, i)
+
+	switch (i) {
+	case SINGULAR:
+	    call eprintf ("Singular solution\n")
+	case NO_DEG_FREEDOM:
+	    call error (0, "No degrees of freedom")
+	}
+
+	# Evaluate the first surface and fit the residuals.
+
+	call malloc (resids, npts, TY_REAL)
+	call xgsvector (sf1, x, y, Memr[resids], npts)
+	call asubr (z, Memr[resids], Memr[resids], npts)
+
+	call xgsinit (sf2, nfunc, xorder, yorder, YES, xmin,xmax,ymin,ymax)
+	call xgsfit (sf2, x, y, Memr[resids], w, npts, WTS_USER, i)
+
+	switch (i) {
+	case SINGULAR:
+	    call eprintf ("Singular solution\n")
+	case NO_DEG_FREEDOM:
+	    call error (0, "No degrees of freedom")
+	}
+
+	# Add the two surfaces and free memory.
+
+	call xgsadd (sf1, sf2, sf)
+	call xgsfree (sf1)
+	call xgsfree (sf2)
+	call mfree (resids, TY_REAL)
+end
+
+
+# IGS_SOLVE2 -- Fit z = x + f(y).
+
+
+procedure igs_solve2 (sf, x, y, z, w, npts)
+
+pointer	sf			# GSURFIT pointer
+real	x[npts]			# X points
+real	y[npts]			# Y points
+real	z[npts]			# Z points
+real	w[npts]			# Weights
+int	npts			# Number of points
+
+int	i, nfunc
+real	a
+pointer	sf1
+
+int	strdic()
+real	xgsgcoeff()
+
+include	"igsfit.com"
+
+begin
+	nfunc = strdic (function, function, SZ_LINE, SFTYPES)
+	call xgsinit (sf1, nfunc, 1, yorder, NO, xmin, xmax, ymin, ymax)
+
+	call asubr (z, x, z, npts)
+	call xgsfit (sf1, x, y, z, w, npts, WTS_USER, i)
+	call aaddr (z, x, z, npts)
+
+	switch (i) {
+	case SINGULAR:
+	    call eprintf ("Singular solution\n")
+	case NO_DEG_FREEDOM:
+	    call error (0, "No degrees of freedom")
+	}
+
+	call xgsfree (sf)
+	call xgsinit (sf, nfunc, 2, yorder, NO, xmin, xmax, ymin, ymax)
+	a = xgsgcoeff (sf1, 1, 1)
+
+	a = a + (xmin + xmax) / 2
+	call xgsscoeff (sf, 1, 1, a)
+
+	a = (xmax - xmin) / 2
+	call xgsscoeff (sf, 2, 1, a)
+
+	do i = 2, yorder {
+	    a = xgsgcoeff (sf1, 1, i)
+	    call xgsscoeff (sf, 1, i, a)
+	}
+
+	call xgsfree (sf1)
+end
+
+# IGS_SOLVE3 -- Fit z = y + f(x).
+
+procedure igs_solve3 (sf, x, y, z, w, npts)
+
+pointer	sf			# GSURFIT pointer
+real	x[npts]			# X points
+real	y[npts]			# Y points
+real	z[npts]			# Z points
+real	w[npts]			# Weights
+int	npts			# Number of points
+
+int	i, nfunc
+real	a
+pointer	sf1
+
+int	strdic()
+real	xgsgcoeff()
+
+include	"igsfit.com"
+
+begin
+	nfunc = strdic (function, function, SZ_LINE, SFTYPES)
+	call xgsinit (sf1, nfunc, xorder, 1, NO, xmin, xmax, ymin, ymax)
+
+	call asubr (z, y, z, npts)
+	call xgsfit (sf1, x, y, z, w, npts, WTS_USER, i)
+	call aaddr (z, y, z, npts)
+
+	switch (i) {
+	case SINGULAR:
+	    call eprintf ("Singular solution\n")
+	case NO_DEG_FREEDOM:
+	    call error (0, "No degrees of freedom")
+	}
+
+	call xgsfree (sf)
+	call xgsinit (sf, nfunc, xorder, 2, NO, xmin, xmax, ymin, ymax)
+	a = xgsgcoeff (sf1, 1, 1)
+
+	a = a + (ymin + ymax) / 2
+	call xgsscoeff (sf, 1, 1, a)
+
+	a = (ymax - ymin) / 2
+	call xgsscoeff (sf, 1, 2, a)
+
+	do i = 2, xorder {
+	    a = xgsgcoeff (sf1, i, 1)
+	    call xgsscoeff (sf, i, 1, a)
+	}
+
+	call xgsfree (sf1)
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/igsundelete.x b/noao/twodspec/longslit/transform/igsfit/igsundelete.x
new file mode 100644
index 00000000..dc7b802e
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/igsundelete.x
@@ -0,0 +1,107 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<pkg/igsfit.h>
+
+int procedure igs_nearestu (gp, ztype, refpt, axis, pts, npts, wx, wy, wcs)
+
+pointer	gp			# GIO pointer
+int	ztype			# Zoom type
+int	refpt			# Reference point
+int	axis[2]			# Axes
+real	pts[npts, ARB]		# Data points
+int	npts			# Number of data points
+real	wx, wy			# Cursor coordinates
+int	wcs			# WCS
+
+int	i, j, x, y
+real	r2, r2min, x0, y0
+
+begin
+	x = axis[1]
+	y = axis[2]
+
+	call gctran (gp, wx, wy, wx, wy, wcs, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	if (IS_INDEFI (ztype)) {
+	    do i = 1, npts {
+	        if (pts[i,W] != 0.)
+		    next
+	        call gctran (gp, pts[i, x], pts[i, y], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	} else {
+	    do i = 1, npts {
+	        if ((pts[i,ztype] != pts[refpt,ztype]) || (pts[i,W] != 0.))
+		    next
+	        call gctran (gp, pts[i, x], pts[i, y], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	}
+
+	return (j)
+end
+
+
+# IGS_UNDELETE - Undelete point or subset.
+
+procedure igs_undelete (gp, gt, ztype, refpt, axis, pts, wts, npts, dtype)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+int	ztype			# Zoom type
+int	refpt			# Reference point for undeletion
+int	axis[2]			# Axes
+real	pts[npts, ARB]		# Data points
+real	wts[npts]		# Original weights
+int	npts			# Number of data points
+int	dtype			# Undeletion type
+
+int	i, x, y
+real	xsize, ysize
+
+real	gt_getr()
+
+begin
+	x = axis[1]
+	y = axis[2]
+
+	xsize = gt_getr (gt, GTXSIZE)
+	ysize = gt_getr (gt, GTYSIZE)
+
+	switch (dtype) {
+	case X, Y, Z:
+	    do i = 1, npts {
+		if (!IS_INDEFI (ztype))
+		    if (pts[refpt,ztype] != pts[i,ztype])
+		        next
+		if (pts[refpt,dtype] != pts[i,dtype])
+		    next
+	        call gseti (gp, G_PMLTYPE, 0)
+	        call gmark (gp, pts[i,x], pts[i,y], GM_CROSS, xsize, ysize)
+	        call gseti (gp, G_PMLTYPE, 1)
+	        call gmark (gp, pts[i,x], pts[i,y], GM_PLUS, xsize, ysize)
+	        if (wts[i] == 0)
+		    wts[i] = 1
+	        pts[i,W] = wts[i]
+	    }
+	default:
+	    call gseti (gp, G_PMLTYPE, 0)
+	    call gmark (gp, pts[refpt,x], pts[refpt,y], GM_CROSS, xsize, ysize)
+	    call gseti (gp, G_PMLTYPE, 1)
+	    call gmark (gp, pts[refpt,x], pts[refpt,y], GM_PLUS, xsize, ysize)
+	    if (wts[refpt] == 0)
+		wts[refpt] = 1
+	    pts[refpt,W] = wts[refpt]
+	}
+end
diff --git a/noao/twodspec/longslit/transform/igsfit/mkpkg b/noao/twodspec/longslit/transform/igsfit/mkpkg
new file mode 100644
index 00000000..ac5a6ca9
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/mkpkg
@@ -0,0 +1,21 @@
+# Interactive General Surface Fitting Package
+
+$checkout libpkg.a ../../
+$update	  libpkg.a
+$checkin  libpkg.a ../../
+$exit
+
+libpkg.a:
+	igscolon.x	igsfit.com <gset.h>
+	igsdelete.x	<gset.h> <mach.h> <pkg/gtools.h> <pkg/igsfit.h>
+	igsfit.x	igsfit.com <mach.h> <pkg/gtools.h> <pkg/igsfit.h>
+	igsget.x	igsfit.com <pkg/igsfit.h>
+	igsgraph.x	<gset.h> <mach.h> <pkg/gtools.h> <pkg/igsfit.h>
+	igsinit.x	<pkg/igsfit.h>
+	igsnearest.x	<gset.h> <mach.h> <pkg/igsfit.h>
+	igsparams.x	igsfit.com <pkg/gtools.h>
+	igsset.x	igsfit.com <pkg/igsfit.h>
+	igssolve.x	igsfit.com <math/gsurfit.h>
+	igsundelete.x	<gset.h> <mach.h> <pkg/gtools.h> <pkg/igsfit.h>
+	xgs.x		<math/gsurfit.h>
+	;
diff --git a/noao/twodspec/longslit/transform/igsfit/xgs.x b/noao/twodspec/longslit/transform/igsfit/xgs.x
new file mode 100644
index 00000000..7d2ea331
--- /dev/null
+++ b/noao/twodspec/longslit/transform/igsfit/xgs.x
@@ -0,0 +1,243 @@
+include <math/gsurfit.h>
+
+# XGS -- These routines provide an interface between real input data and
+# the double precision surface fitting.  Rather than make the input data
+# be double precision we only want the internal surface fitting arithmetic
+# to be double.  But the surface fitting package only provides real
+# arithmetic for real input and double precision arithmetic for double
+# precision input.  Hence these interfaces.  Note that the save and restore
+# functions use double precision.
+
+# XGSINIT --  Procedure to initialize the surface descriptor.
+
+procedure xgsinit (sf, surface_type, xorder, yorder, xterms, xmin, xmax,
+    ymin, ymax)
+
+pointer	sf		# surface descriptor
+int	surface_type	# type of surface to be fitted
+int	xorder		# x order of surface to be fit
+int	yorder		# y order of surface to be fit
+int	xterms		# presence of cross terms
+real    xmin		# minimum value of x
+real	xmax		# maximum value of x
+real	ymin		# minimum value of y
+real	ymax		# maximum value of y
+
+begin
+	call dgsinit (sf, surface_type, xorder, yorder, xterms, double (xmin),
+	    double (xmax), double (ymin), double (ymax))
+end
+
+
+# XGSFIT -- Procedure to solve the normal equations for a surface.
+
+procedure xgsfit (sf, x, y, z, w, npts, wtflag, ier)
+
+pointer	sf		# surface descriptor
+real	x[npts]		# array of x values
+real	y[npts]		# array of y values
+real	z[npts]		# data array
+real	w[npts]		# array of weights
+int	npts		# number of data points
+int	wtflag		# type of weighting
+int	ier		# ier = OK, everything OK
+			# ier = SINGULAR, matrix is singular, 1 or more
+			# coefficients are 0.
+			# ier = NO_DEG_FREEDOM, too few points to solve matrix
+
+pointer	sp, xd, yd, zd, wd
+errchk	salloc
+
+begin
+	call smark (sp)
+	call salloc (xd, npts, TY_DOUBLE)
+	call salloc (yd, npts, TY_DOUBLE)
+	call salloc (zd, npts, TY_DOUBLE)
+	call salloc (wd, npts, TY_DOUBLE)
+	call achtrd (x, Memd[xd], npts)
+	call achtrd (y, Memd[yd], npts)
+	call achtrd (z, Memd[zd], npts)
+	call achtrd (w, Memd[wd], npts)
+	call dgsfit (sf, Memd[xd], Memd[yd], Memd[zd], Memd[wd], npts,
+	    wtflag, ier)
+	call sfree (sp)
+end
+
+
+# XGSVECTOR -- Procedure to evaluate the fitted surface at an array of points.
+
+procedure xgsvector (sf, x, y, zfit, npts)
+
+pointer	sf		# pointer to surface descriptor structure
+real	x[ARB]		# x value
+real	y[ARB]		# y value
+real	zfit[ARB]	# fits surface values
+int	npts		# number of data points
+
+pointer	sp, xd, yd, zd
+errchk	salloc
+
+begin
+	call smark (sp)
+	call salloc (xd, npts, TY_DOUBLE)
+	call salloc (yd, npts, TY_DOUBLE)
+	call salloc (zd, npts, TY_DOUBLE)
+	call achtrd (x, Memd[xd], npts)
+	call achtrd (y, Memd[yd], npts)
+	call dgsvector (sf, Memd[xd], Memd[yd], Memd[zd], npts)
+	call achtdr (Memd[zd], zfit, npts)
+	call sfree (sp)
+end
+
+
+# XGSEVAL -- Procedure to evaluate the fitted surface at a single point.
+
+real procedure xgseval (sf, x, y)
+
+pointer	sf		# pointer to surface descriptor structure
+real	x		# x value
+real	y		# y value
+
+double	dgseval()
+
+begin
+	return (real (dgseval (sf, double (x), double (y))))
+end
+
+
+# XGSADD -- Procedure to add the fits from two surfaces together.
+
+procedure xgsadd (sf1, sf2, sf3)
+
+pointer	sf1		# pointer to the first surface
+pointer	sf2		# pointer to the second surface
+pointer	sf3		# pointer to the output surface
+
+begin
+	call dgsadd (sf1, sf2, sf3)
+end
+
+
+# XGSFREE -- Procedure to free the surface descriptor
+
+procedure xgsfree (sf)
+
+pointer	sf	# the surface descriptor
+
+begin
+	call dgsfree (sf)
+end
+
+
+# XGSGCOEFF -- Procedure to fetch a particular coefficient.
+
+real procedure xgsgcoeff (sf, xorder, yorder)
+
+pointer	sf		# pointer to the surface fitting descriptor
+int	xorder		# X order of desired coefficent
+int	yorder		# Y order of desired coefficent
+
+double	dgsgcoeff()
+
+begin
+	return (real (dgsgcoeff (sf, xorder, yorder)))
+end
+
+
+# XGSSCOEFF -- Procedure to set a particular coefficient.
+
+procedure xgsscoeff (sf, xorder, yorder, coeff)
+
+pointer	sf		# pointer to the surface fitting descriptor
+int	xorder		# X order of desired coefficent
+int	yorder		# Y order of desired coefficent
+real	coeff		# Coefficient value
+
+begin
+	call dgsscoeff (sf, xorder, yorder, double (coeff))
+end
+
+
+# XGSGETR -- Procedure to fetch a real gsurfit parameter
+
+real procedure xgsgetr (sf, parameter)
+
+pointer	sf		# pointer to the surface fit
+int	parameter	# parameter to be fetched
+
+double	dgsgetd()
+
+begin
+	return (real (dgsgetd (sf, parameter)))
+end
+
+
+# XGSGETI -- Procedure to fetch an integer parameter
+
+int procedure xgsgeti (sf, parameter)
+
+pointer sf		# pointer to the surface fit
+int	parameter	# integer parameter
+
+int	dgsgeti()
+
+begin
+	return (dgsgeti (sf, parameter))
+end
+
+
+# XGSSAVE -- Procedure to save the surface fit for later use by the
+# evaluate routines.
+#
+# NOTE THAT THIS USES DOUBLE PRECISION FOR THE COEFFICIENTS.
+
+procedure xgssave (sf, fit)
+
+pointer	sf		# pointer to the surface descriptor
+double	fit[ARB]	# array for storing fit
+
+begin
+	call dgssave (sf, fit)
+end
+
+
+# XGSRESTORE -- Procedure to restore the surface fit stored by GSSAVE
+# to the surface descriptor for use by the evaluating routines.
+#
+# NOTE THAT THIS USES DOUBLE PRECISION FOR THE COEFFICIENTS.
+
+procedure xgsrestore (sf, fit)
+
+pointer	sf		# surface descriptor
+double	fit[ARB]	# array containing the surface parameters and
+
+begin
+	call dgsrestore (sf, fit)
+end
+
+
+# XGSDER -- Procedure to calculate a new surface which is a derivative of
+# the previous surface
+
+procedure xgsder (sf1, x, y, zfit, npts, nxd, nyd)
+
+pointer	sf1		# pointer to the previous surface
+real	x[npts]		# x values
+real	y[npts]		# y values
+real	zfit[npts]	# fitted values
+int	npts		# number of points
+int	nxd, nyd	# order of the derivatives in x and y
+
+pointer	sp, xd, yd, zd
+
+begin
+	call smark (sp)
+	call salloc (xd, npts, TY_DOUBLE)
+	call salloc (yd, npts, TY_DOUBLE)
+	call salloc (zd, npts, TY_DOUBLE)
+	call achtrd (x, Memd[xd], npts)
+	call achtrd (y, Memd[yd], npts)
+	call dgsder (sf1, Memd[xd], Memd[yd], Memd[zd], npts, nxd, nyd)
+	call achtdr (Memd[zd], zfit, npts)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/transform/mkpkg b/noao/twodspec/longslit/transform/mkpkg
new file mode 100644
index 00000000..8ea1b584
--- /dev/null
+++ b/noao/twodspec/longslit/transform/mkpkg
@@ -0,0 +1,20 @@
+# Coordinate Transformation Tasks
+
+$checkout libpkg.a ../
+$update	  libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	@igsfit
+
+	fcdbio.x	<error.h> <math/gsurfit.h> <pkg/dttext.h> <units.h>
+	fcdlist.x	<error.h> <mach.h>
+	fcfitcoords.x	<pkg/gtools.h> <pkg/igsfit.h> <pkg/xtanswer.h>
+	fcgetcoords.x	<imio.h> <mach.h> <pkg/dttext.h> <pkg/igsfit.h>
+	fcgetim.x	
+	fitcoords.x	<error.h> <pkg/igsfit.h> <pkg/xtanswer.h>
+	trsetup.x	<math.h> <math/gsurfit.h> <math/iminterp.h>
+	t_fceval.x
+	t_transform.x	transform.com <imhdr.h> <math/iminterp.h> <units.h>
+	;
diff --git a/noao/twodspec/longslit/transform/t_fceval.x b/noao/twodspec/longslit/transform/t_fceval.x
new file mode 100644
index 00000000..a9c5cc75
--- /dev/null
+++ b/noao/twodspec/longslit/transform/t_fceval.x
@@ -0,0 +1,107 @@
+# T_FCEVAL -- Evaluate FITCOORDS solutions.
+# Input consists of a text file of pixel coordinates to be evaluated and the
+# user coordinate surfaces from FITCOORDS.  The output is a text file of the
+# input coordinates followed by the output coordinates.  When there is no fit
+# for an axis the unit transformation is used and when there is more than one
+# fit for an axis the average is used.
+
+procedure t_fceval ()
+
+pointer	input			# File of input coordinates
+pointer	output			# File of output coordinates
+int	fitnames		# List of user coordinate fits
+pointer	database		# Database
+
+int	i, j, in, out, nsf[2]
+double	x[2], y[2]
+pointer	sp, fitname, sf[2], un[2], sf1, un1
+
+bool	un_compare()
+int	open(), fscan(), nscan()
+int	clpopnu(), clplen(), clgfil()
+double	dgseval()
+errchk	open, lm_dbread
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call salloc (fitname, SZ_FNAME, TY_CHAR)
+
+	# Get parameters.
+	call clgstr ("input", Memc[input], SZ_FNAME)
+	call clgstr ("output", Memc[output], SZ_FNAME)
+	fitnames = clpopnu ("fitnames")
+	call clgstr ("database", Memc[database], SZ_FNAME)
+
+	# Open the input and output files.
+	in = open (Memc[input], READ_ONLY, TEXT_FILE)
+	out = open (Memc[output], NEW_FILE, TEXT_FILE)
+
+	# Read the solutions.
+	i = max (1, clplen (fitnames))
+	call salloc (sf[1], i, TY_INT)
+	call salloc (sf[2], i, TY_INT)
+
+	nsf[1] = 0; nsf[2] = 0; un[1] = NULL; un[2] = NULL
+	while (clgfil (fitnames, Memc[fitname], SZ_FNAME) != EOF) {
+	    call lm_dbread (Memc[database], Memc[fitname], j, un1, sf1)
+	    if (un1 != NULL) {
+		if (un[j] == NULL)
+		    un[j] = un1
+		else if (un_compare (un1, un[j]))
+		    call un_close (un1)
+		else
+		    call error (1, "Input units disagree")
+	    }
+
+	    if (sf1 != NULL) {
+		Memi[sf[j]+nsf[j]] = sf1
+		nsf[j] = nsf[j] + 1
+	    }
+	}
+
+	if (nsf[1] + nsf[2] == 0)
+	    call error (0, "No user coordinates")
+
+	# Evaluate the fits at each input coordinate.
+	while (fscan (in) != EOF) {
+	    call gargd (x[1])
+	    call gargd (x[2])
+	    if (nscan() != 2)
+		next
+
+	    do j = 1, 2 {
+		if (nsf[j] == 0)
+		    y[j] = x[j]
+		else {
+		    y[j] = dgseval (Memi[sf[j]], x[1], x[2])
+		    do i = 2, nsf[1]
+			y[j]  = y[j]  + dgseval (Memi[sf[j]+i-1], x[1], y[2])
+		    y[j]  = y[j]  / nsf[j]
+		}
+	    }
+
+	    call fprintf (out, "%g %g %g %g\n")
+		call pargd (x[1])
+		call pargd (x[2])
+		call pargd (y[1])
+		call pargd (y[2])
+	    call flush (out)
+	}
+
+	# Free the surfaces and units structures.
+	do j = 1, 2 {
+	    for (i=1; i<=nsf[j]; i=i+1)
+		call dgsfree (Memi[sf[j]+i-1])
+	    if (un[j] != NULL)
+		call un_close (un[j])
+	}
+
+	# Finish up.
+	call clpcls (fitnames)
+	call close (out)
+	call close (in)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/longslit/transform/t_transform.x b/noao/twodspec/longslit/transform/t_transform.x
new file mode 100644
index 00000000..5610858e
--- /dev/null
+++ b/noao/twodspec/longslit/transform/t_transform.x
@@ -0,0 +1,741 @@
+include	<imhdr.h>
+include	<math/iminterp.h>
+include	<units.h>
+
+define	ITYPES	"|nearest|linear|poly3|poly5|spline3|"
+
+# T_TRANSFORM -- Transform longslit images.
+# Input consists of images to be transformed, the user coordinate surfaces
+# describing the output coordinates in terms of the input coordinates,
+# and the desired coordinates for the output images.  The type of image
+# interpolation is also input.  There is a log output as well as the
+# transformed images.  The output image may replace the input image.
+
+procedure t_transform ()
+
+int	input			# List of input images
+int	output			# List of output images
+int	minput			# List of input masks
+int	moutput			# List of output masks
+int	fitnames		# List of user coordinate fits
+pointer	database		# Database
+char	interp[10]		# Interpolation type
+int	logfiles		# List of log files
+
+int	itypes[II_NTYPES2D], logfd, nusf, nvsf
+pointer	in, out, pmin, pmout
+pointer	un[2], mw, ct, usf, vsf, xmsi, ymsi, jmsi, xout, yout, dxout, dyout
+pointer	sp, image1, image2, image3, minname, moutname, mname, str
+
+int	clpopnu(), clgfil(), clplen(), clgeti(), clgwrd(), open()
+int	imtopenp(), imtlen(), imtgetim()
+bool	clgetb()
+real	clgetr()
+pointer	immap(), mw_openim(), yt_mappm()
+errchk	tr_gsf, tr_setup, open, mw_openim, yt_mappm
+
+data	itypes /II_BINEAREST, II_BILINEAR, II_BIPOLY3, II_BIPOLY5,
+	II_BISPLINE3, II_SINC, II_LSINC, II_DRIZZLE/
+
+include	"transform.com"
+
+
+begin
+	call smark (sp)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call salloc (image1, SZ_FNAME, TY_CHAR)
+	call salloc (image2, SZ_FNAME, TY_CHAR)
+	call salloc (image3, SZ_FNAME, TY_CHAR)
+	call salloc (minname, SZ_FNAME, TY_CHAR)
+	call salloc (moutname, SZ_FNAME, TY_CHAR)
+	call salloc (mname, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Get and error check the input and output image lists and the other
+	# task parameters.
+
+	input = imtopenp ("input")
+	output = imtopenp ("output")
+	if (imtlen (input) != imtlen (output)) {
+	    call imtclose (input)
+	    call imtclose (output)
+	    call error (1, "Number of input and output images differ")
+	}
+	minput = imtopenp ("minput")
+	moutput = imtopenp ("moutput")
+	if (imtlen (minput) > 1 && imtlen (minput) != imtlen (input)) {
+	    call imtclose (input)
+	    call imtclose (output)
+	    call imtclose (minput)
+	    call imtclose (moutput)
+	    call error (1, "Can't associate input masks with input images")
+	}
+	if (imtlen (moutput) > 0 && imtlen (input) != imtlen (moutput)) {
+	    call imtclose (input)
+	    call imtclose (output)
+	    call imtclose (minput)
+	    call imtclose (moutput)
+	    call error (1, "Number output masks differ from input")
+	}
+
+	fitnames = clpopnu ("fitnames")
+	call clgstr ("database", Memc[database], SZ_FNAME)
+	itype = itypes[clgwrd ("interptype", interp, 10, II_FUNCTIONS)]
+	logfiles = clpopnu ("logfiles")
+
+	u1 = clgetr ("x1")
+	u2 = clgetr ("x2")
+	du = clgetr ("dx")
+	nu = clgeti ("nx")
+	v1 = clgetr ("y1")
+	v2 = clgetr ("y2")
+	dv = clgetr ("dy")
+	nv = clgeti ("ny")
+
+	ulog = clgetb ("xlog")
+	vlog = clgetb ("ylog")
+	flux = clgetb ("flux")
+	blank = clgetr ("blank")
+
+	usewcs = (clplen (fitnames) == 0)
+
+	# Transform each input image to the output image.
+	Memc[minname] = EOS
+	Memc[moutname] = EOS
+	Memc[mname] = EOS
+	xmsi = NULL
+	while ((imtgetim (input, Memc[image1], SZ_FNAME) != EOF)  &&
+	    (imtgetim (output, Memc[image2], SZ_FNAME) != EOF)) {
+
+	    # Get mask names.
+	    if (imtgetim (minput, Memc[image3], SZ_FNAME) != EOF)
+	        call strcpy (Memc[image3], Memc[minname], SZ_FNAME)
+	    if (imtgetim (moutput, Memc[image3], SZ_FNAME) != EOF)
+	        call strcpy (Memc[image3], Memc[moutname], SZ_FNAME)
+
+	    # Map the input and output images.
+	    call xt_mkimtemp (Memc[image1], Memc[image2], Memc[image3],SZ_FNAME)
+	    in = immap (Memc[image1], READ_ONLY, 0)
+	    out = immap (Memc[image2], NEW_COPY, in)
+
+	    # Map masks.
+	    pmin = NULL; pmout = NULL
+	    if (Memc[minname] != EOS)
+	        pmin = yt_mappm (Memc[minname], in, "logical", Memc[mname],
+		    SZ_FNAME)
+	    if (Memc[moutname] != EOS) {
+	        call xt_maskname (Memc[moutname], "", NEW_IMAGE,
+		    Memc[moutname], SZ_FNAME)
+		pmout = immap (Memc[moutname], NEW_COPY, in)
+		call imastr (out, "BPM", Memc[moutname])
+	    }
+
+	    # Get the coordinate transformation surfaces from the database
+	    # and setup the transformations.
+	    # Do this only on the first pass.
+
+	    if (xmsi == NULL) {
+		if (usewcs) {
+		    mw = mw_openim (in)
+		    call tr_gwcs (mw, un, IM_LEN(in,1), IM_LEN(in,2), ct,
+			usf, nusf, vsf, nvsf)
+		} else {
+		    mw = NULL
+		    ct = NULL
+		    call tr_gsf (Memc[database], fitnames, un, usf, nusf,
+		        vsf, nvsf)
+		}
+		call tr_setup (ct, usf, nusf, vsf, nvsf, un, xmsi, ymsi, jmsi,
+		    xout, yout, dxout, dyout)
+		if (mw != NULL)
+		    call mw_close (mw)
+	    }
+
+	    # Write log information.
+	    while (clgfil (logfiles, Memc[str], SZ_LINE) != EOF) {
+		logfd = open (Memc[str], APPEND, TEXT_FILE)
+		call sysid (Memc[str], SZ_LINE)
+		call fprintf (logfd, "\n%s\n")
+		    call pargstr (Memc[str])
+		call fprintf (logfd, "  Transform %s to %s.\n")
+		    call pargstr (Memc[image1])
+		    call pargstr (Memc[image3])
+		if (pmout != EOS) {
+		    if (pmin != EOS) {
+		        call fprintf (logfd, "  Transform mask %s to %s.\n")
+			    call pargstr (Memc[mname])
+			    call pargstr (Memc[moutname])
+		    } else {
+		        call fprintf (logfd, "  Output mask is %s.\n")
+			    call pargstr (Memc[moutname])
+		    }
+		}
+		if (flux)
+		    call fprintf (logfd, "  Conserve flux per pixel.\n")
+		if (usewcs)
+		    call fprintf (logfd, "  Transforming using image WCS.\n")
+		else {
+		    call fprintf (logfd, "  User coordinate transformations:\n")
+		    while (clgfil (fitnames, Memc[str], SZ_LINE) != EOF) {
+			call fprintf (logfd, "    %s\n")
+			    call pargstr (Memc[str])
+		    }
+		}
+		call fprintf (logfd, "  Interpolation is %s.\n")
+		    call pargstr (interp)
+		if (!IS_INDEFR(blank)) {
+		    call fprintf (logfd, "  Out of bounds pixel value is %g.\n")
+			call pargr (blank)
+		} else
+		    call fprintf (logfd,
+		    "  Using edge extension for out of bounds pixel values.\n")
+		call fprintf (logfd, "  Output coordinate parameters are:\n")
+		call fprintf (logfd,
+	    "    x1 = %10.4g, x2 = %10.4g, dx = %10.4g, nx = %4d, xlog = %b\n")
+		    call pargr (u1)
+		    call pargr (u2)
+		    call pargr (du)
+		    call pargi (nu)
+		    call pargb (ulog)
+		call fprintf (logfd,
+	    "    y1 = %10.4g, y2 = %10.4g, dy = %10.4g, ny = %4d, ylog = %b\n")
+		    call pargr (v1)
+		    call pargr (v2)
+		    call pargr (dv)
+		    call pargi (nv)
+		    call pargb (vlog)
+		call close (logfd)
+	    }
+	    call clprew (logfiles)
+
+	    call tr_transform (in, out, pmin, pmout, un, xmsi, ymsi, jmsi,
+	        Memr[xout], Memr[yout], Memr[dxout], Memr[dyout])
+
+	    if (pmout != NULL)
+	        call imunmap (pmout)
+	    if (pmin != NULL)
+	        call xt_pmunmap (pmin)
+	    call imunmap (in)
+	    call imunmap (out)
+	    call xt_delimtemp (Memc[image2], Memc[image3])
+
+	    if (usewcs) {
+		call mfree (xout, TY_REAL)
+		call mfree (yout, TY_REAL)
+		call mfree (dxout, TY_REAL)
+		call mfree (dyout, TY_REAL)
+		if (xmsi != NULL)
+		    call msifree (xmsi)
+		if (ymsi != NULL)
+		    call msifree (ymsi)
+		if (jmsi != NULL)
+		    call msifree (jmsi)
+		if (un[1] != NULL)
+		    call un_close (un[1])
+		if (un[2] != NULL)
+		    call un_close (un[2])
+		xmsi = NULL
+	    }
+
+	}
+
+	call mfree (xout, TY_REAL)
+	call mfree (yout, TY_REAL)
+	call mfree (dxout, TY_REAL)
+	call mfree (dyout, TY_REAL)
+	if (xmsi != NULL)
+	    call msifree (xmsi)
+	if (ymsi != NULL)
+	    call msifree (ymsi)
+	if (jmsi != NULL)
+	    call msifree (jmsi)
+	if (un[1] != NULL)
+	    call un_close (un[1])
+	if (un[2] != NULL)
+	    call un_close (un[2])
+	call imtclose (minput)
+	call imtclose (moutput)
+	call imtclose (input)
+	call imtclose (output)
+	call clpcls (fitnames)
+	call clpcls (logfiles)
+	call sfree (sp)
+end
+
+
+# TR_SETOUTPUT -- Set the output coordinates in the common block.
+# This procedure allows the user to specifying a part of the output
+# coordinates and let the rest default based on the full limits of
+# the user coordinate surfaces.
+
+procedure tr_setoutput (xmin, xmax, ymin, ymax, umin, umax, vmin, vmax)
+
+real	xmin, xmax, ymin, ymax
+real	umin, umax, vmin, vmax
+
+int	nua, nva
+real	u1a, u2a, dua, v1a, v2a, dva
+
+include	"transform.com"
+
+begin
+	# Save the original values of the user parameters.
+	u1a = u1
+	u2a = u2
+	dua = du
+	nua = nu
+	v1a = v1
+	v2a = v2
+	dva = dv
+	nva = nv
+
+	# If the output coordinate limits are not defined then use the
+	# transformation surface limits.
+
+	if (IS_INDEF (u1))
+	    u1 = umin
+	if (IS_INDEF (u2))
+	    u2 = umax
+	if (IS_INDEF (v1))
+	    v1 = vmin
+	if (IS_INDEF (v2))
+	    v2 = vmax
+
+	# If the number of output pixels are not defined then use the number
+	# of pixels in the input image.
+
+	if (IS_INDEFI (nu))
+	    nu = xmax - xmin + 1
+	if (IS_INDEFI (nv))
+	    nv = ymax - ymin + 1
+
+	# If the coordinate interval is not defined determine it from the
+	# number of pixels and the coordinate limits.  If the interval is
+	# defined then override the number of pixels.
+
+	if (ulog) {
+	    if (IS_INDEF (du))
+		du = (log10 (u2) - log10 (u1)) / (nu - 1)
+	    else if (IS_INDEFI (nua))
+	        nu = nint ((log10 (u2) - log10 (u1)) / du + 1)
+	    else if (IS_INDEF (u1a))
+		u1 = 10.0 ** (log10 (u2) - du * (nu - 1))
+	    else
+		u2 = 10.0 ** (log10 (u1) + du * (nu - 1))
+	} else {
+	    if (IS_INDEF (du))
+	        du = (u2 - u1) / (nu - 1)
+	    else if (IS_INDEFI (nua))
+	        nu = nint ((u2 - u1) / du + 1)
+	    else if (IS_INDEF (u1a))
+		u1 = u2 - du * (nu - 1)
+	    else
+		u2 = u1 + du * (nu - 1)
+	}
+
+	if (vlog) {
+	    if (IS_INDEF (dv))
+		dv = (log10 (v2) - log10 (v1)) / (nv - 1)
+	    else if (IS_INDEFI (nva))
+	        nv = nint ((log10 (v2) - log10 (v1)) / dv + 1)
+	    else if (IS_INDEF (v1a))
+		v1 = 10.0 ** (log10 (v2) - dv * (nv - 1))
+	    else
+		v2 = 10.0 ** (log10 (v1) + dv * (nv - 1))
+	} else {
+	    if (IS_INDEF (dv))
+	        dv = (v2 - v1) / (nv - 1)
+	    else if (IS_INDEFI (nva))
+	        nv = nint ((v2 - v1) / dv + 1)
+	    else if (IS_INDEF (v1a))
+		v1 = v2 - dv * (nv - 1)
+	    else
+		v2 = v1 + dv * (nv - 1)
+	}
+end
+
+
+define	NBUF		16	# Additional buffer for interpolation
+define	NEDGE		2	# Number of edge lines to add for interpolation
+define	MINTERP		100	# Mask value for input mask interpolation
+define	MTHRESH		10	# Interpolated mask value for bad pixels
+define	MBAD		1	# Mask value for output bad pixels
+define	MBLANK		1	# Mask value for out of bounds pixels
+
+# TR_TRANSFORM -- Perform the image transformation using a user specified
+# image interpolator.  If an input and output mask are included the input
+# mask values are set to MINTERP, interpolated in the same way, and any values
+# greater than MTHRESH are set to MBAD.  Note that currently the input mask
+# values are not used in computing the input data interpolation value.
+# The masks MUST be the same size as the input data and are assumed to
+# be registered in logical pixel coordinates.
+
+procedure tr_transform (in, out, pmin, pmout, un, xmsi, ymsi, jmsi, xout, yout,
+	dxout, dyout)
+
+pointer	in, out			#I IMIO data pointers
+pointer	pmin, pmout		#I IMIO mask pointers (NULL if not used)
+pointer	un[2]			#I Units
+pointer xmsi, ymsi		#I Coordinate interpolation pointers
+pointer	jmsi			#I Jacobian interpolation pointer
+real	xout[ARB], yout[ARB]	#I Output grid relative to interpolation surface
+real	dxout[ARB], dyout[ARB]	#I Output coordinate intervals
+
+int	i, j, nxin, nyin, line1, line2, line3, line4, nlines, laxis, paxis
+bool	xofb, yofb
+real	a, b, c, r[2], w[2], cd[2,2]
+pointer	zmsi, mzmsi, buf, mbuf, bufout
+pointer	sp, xin, yin, jbuf, xin1, yin1, y, mw
+
+pointer	mw_open(), impl2r()
+errchk	get_daxis
+
+include	"transform.com"
+
+begin
+	# Initialize the output image header.
+
+	IM_LEN(out, 1) = nu
+	IM_LEN(out, 2) = nv
+	if (pmout != NULL) {
+	    IM_LEN(pmout, 1) = nu
+	    IM_LEN(pmout, 2) = nv
+	}
+
+	mw = mw_open (NULL, 2)
+	call mw_newsystem (mw, "world", 2)
+	do i = 1, 2 {
+	    call mw_swtype (mw, i, 1, "linear", "")
+	    if (un[i] != NULL) {
+		call mw_swattrs (mw, i, "label", UN_LABEL(un[i]))
+		call mw_swattrs (mw, i, "units", UN_UNITS(un[i]))
+	    }
+	}
+
+	r[1] = 1.
+	if (ulog)
+	    w[1] = log10 (u1)
+	else
+	    w[1] = u1
+	cd[1,1] = du
+	cd[1,2] = 0.
+	r[2] = 1.
+	if (vlog)
+	    w[2] = log10 (v1)
+	else
+	    w[2] = v1
+	cd[2,2] = dv
+	cd[2,1] = 0.
+	call mw_swtermr (mw, r, w, cd, 2)
+
+	# The following image parameters are for compatibility with the
+	# ONEDSPEC package if using database solutions.
+
+	if (!usewcs) {
+	    call imastr (out, "DCLOG1", "Transform")
+	    iferr (call imdelf (out, "REFSPEC1"))
+		;
+	    iferr (call imdelf (out, "REFSPEC2"))
+		;
+	    call get_daxis (in, laxis, paxis)
+	    call imaddi (out, "dispaxis", laxis)
+	    switch (laxis) {
+	    case 1:
+		if (ulog)
+		    call imaddi (out, "dc-flag", 1)
+		else
+		    call imaddi (out, "dc-flag", 0)
+		if (un[laxis] == NULL) {
+		    call mw_swattrs (mw, laxis, "label", "Wavelength")
+		    call mw_swattrs (mw, laxis, "units", "Angstroms")
+		}
+	    case 2:
+		if (vlog)
+		    call imaddi (out, "dc-flag", 1)
+		else
+		    call imaddi (out, "dc-flag", 0)
+		if (un[laxis] == NULL) {
+		    call mw_swattrs (mw, laxis, "label", "Wavelength")
+		    call mw_swattrs (mw, laxis, "units", "Angstroms")
+		}
+	    }
+	}
+	call mw_saveim (mw, out)
+	if (pmout != NULL)
+	    call mw_saveim (mw, pmout)
+	call mw_close (mw)
+
+	# Allocate memory for the input coordinates and a vector for the
+	# output y coordinates.  Also initialize the image data buffer.
+
+	call smark (sp)
+	call salloc (xin, nu, TY_REAL)
+	call salloc (yin, nu, TY_REAL)
+	call salloc (y, nu, TY_REAL)
+	if (flux)
+	    call salloc (jbuf, nu, TY_REAL)
+	if (!IS_INDEFR(blank) || pmout != NULL) {
+	    call salloc (xin1, nu, TY_REAL)
+	    call salloc (yin1, nu, TY_REAL)
+	}
+
+	buf = NULL
+	mbuf = NULL
+	nlines = 0
+
+	# Initialize the interpolator.
+
+	call msiinit (zmsi, itype)
+	if (pmin != NULL)
+	    call msiinit (mzmsi, itype)
+
+	# Do each line of the output image.
+
+	nxin = IM_LEN(in, 1)
+	nyin = IM_LEN(in, 2)
+
+	do i = 1, nv {
+
+	    # Evaluate the input coordinates at the output grid for a line
+	    # of the output image using the interpolation surfaces.
+
+	    call amovkr (yout[i], Memr[y], nu)
+	    if (!IS_INDEFR(blank) || pmout != NULL) {
+		call msivector (xmsi, xout, Memr[y], Memr[xin1], nu)
+		call msivector (ymsi, xout, Memr[y], Memr[yin1], nu)
+		call amovr (Memr[xin1], Memr[xin], nu)
+		call amovr (Memr[yin1], Memr[yin], nu)
+	    } else {
+		call msivector (xmsi, xout, Memr[y], Memr[xin], nu)
+		call msivector (ymsi, xout, Memr[y], Memr[yin], nu)
+	    }
+
+	    # Determine the coordinate ranges and check for out of bounds.
+
+	    call alimr (Memr[xin], nu, a, b)
+	    xofb = (a < 1 || b > nxin)
+	    if (xofb) {
+		if (a < 1)
+		    call arltr (Memr[xin], nu, 1., 1.)
+		if (b > nxin)
+		    call argtr (Memr[xin], nu, real (nxin), real (nxin))
+	    }
+
+	    call alimr (Memr[yin], nu, a, b)
+	    yofb = (a < 1 || b > nyin)
+	    if (yofb) {
+		if (a < 1) {
+		    call arltr (Memr[yin], nu, 1., 1.)
+		    a = 1.
+		    b = max (a, b)
+		}
+		if (b > nyin) {
+		    call argtr (Memr[yin], nu, real (nyin), real (nyin))
+		    b = nyin
+		    a = min (a, b)
+		}
+	    }
+
+	    # Get the input image data and fit an interpolator to the data.
+
+	    if ((buf == NULL) || (b > line2) || (a < line1)) {
+		nlines = max (nlines, int (b - a + 2 + NBUF))
+		if (buf == NULL) {
+		    if (a < nyin / 2) {
+		        line1 = max (1, int (a))
+		        line2 = min (nyin, line1 + nlines - 1)
+		    } else {
+		        line2 = min (nyin, int (b+1.))
+		        line1 = max (1, line2 - nlines + 1)
+		    }
+		} else if (b > line2) {
+		    line1 = max (1, int (a))
+		    line2 = min (nyin, line1 + nlines - 1)
+		    line1 = max (1, line2 - nlines + 1)
+		} else {
+		    line2 = min (nyin, int (b+1.))
+		    line1 = max (1, line2 - nlines + 1)
+		    line2 = min (nyin, line1 + nlines - 1)
+		}
+		line3 = max (1, line1 - NEDGE)
+		line4 = min (nyin, line2 + NEDGE)
+	        call tr_bufl2r (in, pmin, line3, line4, buf, mbuf)
+	        call msifit (zmsi, Memr[buf], nxin, line4 - line3 + 1, nxin)
+		if (pmin != NULL)
+		    call msifit (mzmsi, Memr[mbuf], nxin, line4 - line3 + 1,
+		        nxin)
+	    }
+
+	    # The input coordinates must be offset to interpolation data grid.
+	    call asubkr (Memr[yin], real (line3 - 1), Memr[yin], nu)
+
+	    # Evaluate output image pixels, conserve flux (if requested) using
+	    # the Jacobian, and set the out of bounds values.
+
+	    bufout = impl2r (out, i)
+	    call msivector (zmsi, Memr[xin], Memr[yin], Memr[bufout], nu)
+	    if (flux) {
+	        call msivector (jmsi, xout, Memr[y], Memr[jbuf], nu)
+		call amulr (dxout, Memr[jbuf], Memr[jbuf], nu)
+		call amulkr (Memr[jbuf], dyout[i], Memr[jbuf], nu)
+	        call amulr (Memr[bufout], Memr[jbuf], Memr[bufout], nu)
+	    }
+	    if (!IS_INDEFR(blank)) {
+		if (xofb) {
+		    do j = 0, nu-1 {
+			if (Memr[xin1+j] < 1 || Memr[xin1+j] > nxin)
+			    Memr[bufout+j] = blank
+		    }
+		}
+		if (yofb) {
+		    do j = 0, nu-1 {
+			if (Memr[yin1+j] < 1 || Memr[yin1+j] > nyin)
+			    Memr[bufout+j] = blank
+		    }
+		}
+	    }
+
+	    # Evaluate output mask pixels and set output bad values.
+
+	    if (pmout != NULL) {
+		bufout = impl2r (pmout, i)
+		if (pmin != NULL) {
+		    call msivector (mzmsi, Memr[xin], Memr[yin], Memr[bufout],
+		        nu)
+		    do j = 0, nu-1 {
+			c = Memr[bufout+j]
+			if (Memr[xin1+j] < 1 || Memr[xin1+j] > nxin ||
+			    Memr[yin1+j] < 1 || Memr[yin1+j] > nyin)
+			    Memr[bufout+j] = MBLANK
+			else if (c > 0.) {
+			    if (c > MTHRESH)
+				Memr[bufout+j] = MBAD
+			    else
+				Memr[bufout+j] = 0
+			}
+		    }
+		} else {
+		    call aclrr (Memr[bufout], nu)
+		    if (xofb) {
+			do j = 0, nu-1 {
+			    if (Memr[xin1+j] < 1 || Memr[xin1+j] > nxin)
+				Memr[bufout+j] = MBLANK
+			}
+		    }
+		    if (yofb) {
+			do j = 0, nu-1 {
+			    if (Memr[yin1+j] < 1 || Memr[yin1+j] > nyin)
+				Memr[bufout+j] = MBLANK
+			}
+		    }
+		}
+	    }
+	}
+
+	# Free memory.
+
+	call mfree (buf, TY_REAL)
+	call mfree (mbuf, TY_REAL)
+	call msifree (zmsi)
+	if (pmin != NULL)
+	    call msifree (mzmsi)
+	call sfree (sp)
+end
+
+
+# TR_BUFL2R -- Maintain buffer of image lines.  A new buffer is created when
+# the buffer pointer is null or if the number of lines requested is changed.
+# The minimum number of image reads is used.
+
+procedure tr_bufl2r (im, pmin, line1, line2, buf, mbuf)
+
+pointer	im		#I Image pointer
+pointer	pmin		#I Mask pointer
+int	line1		#I First image line of buffer
+int	line2		#I Last image line of buffer
+pointer	buf		#U Output data buffer
+pointer	mbuf		#U Output mask buffer
+
+int	i, nlines, nx, last1, last2, nlast
+pointer	buf1, buf2
+
+pointer	imgl2r()
+
+begin
+	nlines = line2 - line1 + 1
+
+	# If the buffer pointer is undefined then allocate memory for the
+	# buffer.  If the number of lines requested changes reallocate
+	# the buffer.  Initialize the last line values to force a full
+	# buffer image read.
+
+	if (buf == NULL) {
+	    nx = IM_LEN(im, 1)
+	    call malloc (buf, nx * nlines, TY_REAL)
+	    if (pmin != NULL)
+		call malloc (mbuf, nx * nlines, TY_REAL)
+	    last1 = line1 - nlines
+	    last2 = line2 - nlines
+	} else if (nlines != nlast) {
+	    call realloc (buf, nx * nlines, TY_REAL)
+	    if (pmin != NULL)
+		call realloc (mbuf, nx * nlines, TY_REAL)
+	    last1 = line1 - nlines
+	    last2 = line2 - nlines
+	}
+
+	# Read only the image lines with are different from the last buffer.
+
+	if (line1 < last1) {
+	    do i = line2, line1, -1 {
+		if (i > last1)
+		    buf1 = buf + (i - last1) * nx
+		else
+		    buf1 = imgl2r (im, i)
+		    
+		buf2 = buf + (i - line1) * nx
+		call amovr (Memr[buf1], Memr[buf2], nx)
+	    }
+	} else if (line2 > last2) {
+	    do i = line1, line2 {
+		if (i < last2)
+		    buf1 = buf + (i - last1) * nx
+		else
+		    buf1 = imgl2r (im, i)
+		    
+		buf2 = buf + (i - line1) * nx
+		call amovr (Memr[buf1], Memr[buf2], nx)
+	    }
+	}
+	if (pmin != NULL) {
+	    if (line1 < last1) {
+		do i = line2, line1, -1 {
+		    if (i > last1)
+			buf1 = mbuf + (i - last1) * nx
+		    else
+			buf1 = imgl2r (pmin, i)
+			
+		    buf2 = mbuf + (i - line1) * nx
+		    call amovr (Memr[buf1], Memr[buf2], nx)
+		    call argtr (Memr[buf2], nx, 0.1, real(MINTERP))
+		}
+	    } else if (line2 > last2) {
+		do i = line1, line2 {
+		    if (i < last2)
+			buf1 = mbuf + (i - last1) * nx
+		    else
+			buf1 = imgl2r (pmin, i)
+			
+		    buf2 = mbuf + (i - line1) * nx
+		    call amovr (Memr[buf1], Memr[buf2], nx)
+		    call argtr (Memr[buf2], nx, 0.1, real(MINTERP))
+		}
+	    }
+	}
+
+	# Save the buffer parameters.
+
+	last1 = line1
+	last2 = line2
+	nlast = nlines
+end
diff --git a/noao/twodspec/longslit/transform/transform.com b/noao/twodspec/longslit/transform/transform.com
new file mode 100644
index 00000000..baaae3ab
--- /dev/null
+++ b/noao/twodspec/longslit/transform/transform.com
@@ -0,0 +1,14 @@
+# TRANSFORM -- Common task parameters.
+
+int	itype			# Interpolation type
+real	u1, v1			# Starting coordinates
+real	u2, v2			# Ending coordinates
+real	du, dv			# Coordinate intervals
+int	nu, nv			# Number of pixels
+bool	ulog, vlog		# Logrithmic coordinates?
+bool	flux			# Conserve flux per pixel?
+bool	usewcs			# Use WCS?
+real	blank			# Blank value
+
+common	/trcom/ u1, v1, u2, v2, du, dv, nu, nv, itype, ulog, vlog,
+		flux, usewcs, blank
diff --git a/noao/twodspec/longslit/transform/trsetup.x b/noao/twodspec/longslit/transform/trsetup.x
new file mode 100644
index 00000000..72db570d
--- /dev/null
+++ b/noao/twodspec/longslit/transform/trsetup.x
@@ -0,0 +1,663 @@
+include	<math.h>
+include	<math/gsurfit.h>
+include	<math/iminterp.h>
+
+# Wrapper for MWCS CT pointer to include the image pixel range.
+
+define	CT_LW		Memi[$1]		# MWCS CT (logical -> world)
+define	CT_WL		Memi[$1+1]		# MWCS CT (world -> logical)
+define	CT_NX		Memi[$1+2]		# Number of pixels in X
+define	CT_NY		Memi[$1+3]		# Number of pixels Y
+
+
+# TR_GSF -- Get coordinate surface fits from the database.
+
+procedure tr_gsf (database, sflist, un, usf, nusf, vsf, nvsf)
+
+char	database		#I Database containing coordinate surfaces
+int	sflist			#I List of user coordinate surfaces
+pointer	un[2]			#O Units pointers
+pointer	usf			#O Pointer to array of U surface fits
+int	nusf			#O Number of U surface fits
+pointer	vsf			#O Pointer to array of V surface fits
+int	nvsf			#O Number of U surface fits
+
+int	i, nsf
+pointer	sp, sfname, un1, sf
+
+bool	un_compare()
+int	clgfil(), clplen()
+
+begin
+	# Get the user coordinate surfaces and separate them into U and V.
+	# Check that all surfaces have the same range of X and Y and determine
+	# the range of U and V.
+
+	call smark (sp)
+	call salloc (sfname, SZ_FNAME, TY_CHAR)
+
+	nsf = max (1, clplen (sflist))
+	call malloc (usf, nsf, TY_INT)
+	call malloc (vsf, nsf, TY_INT)
+
+	un[1] = NULL
+	un[2] = NULL
+	Memi[usf] = NULL
+	Memi[vsf] = NULL
+	nusf = 0
+	nvsf = 0
+	while (clgfil (sflist, Memc[sfname], SZ_FNAME) != EOF) {
+	    call lm_dbread (database, Memc[sfname], i, un1, sf)
+	    if (un1 != NULL) {
+		if (un[i] == NULL)
+		    un[i] = un1
+		else if (un_compare (un1, un[i]))
+		    call un_close (un1)
+		else {
+		    call un_close (un1)
+		    call un_close (un[i])
+		    call sfree (sp)
+		    call error (1, "Input units disagree")
+		}
+	    }
+
+	    if (sf != NULL) {
+		if (i == 1) {
+		    nusf = nusf+1
+		    Memi[usf+nusf-1] = sf
+		} else if (i == 2) {
+		    nvsf = nvsf+1
+		    Memi[vsf+nvsf-1] = sf
+		}
+	    }
+	}
+	call clprew (sflist)
+
+	if (nusf + nvsf == 0)
+	    call error (0, "No user coordinates")
+
+	call sfree (sp)
+end
+
+
+# TR_GWCS -- Get WCS.
+
+procedure tr_gwcs (mw, un, nx, ny, ct, usf, nusf, vsf, nvsf)
+
+pointer	mw			#I MWCS pointer
+pointer	un[2]			#O Units pointers
+int	nx, ny			#I Image size
+
+pointer	ct			#O CT pointer
+pointer	usf			#O Pointer to array of U surface fits
+int	nusf			#O Number of U surface fits
+pointer	vsf			#O Pointer to array of V surface fits
+int	nvsf			#O Number of U surface fits
+
+int	i
+pointer	sp, units, un_open(), mw_sctran()
+errchk	un_open
+
+begin
+	call smark (sp)
+	call salloc (units, SZ_FNAME, TY_CHAR)
+
+	call malloc (ct, 4, TY_STRUCT)
+	nusf = 1
+	call calloc (usf, nusf, TY_INT) 
+	nvsf = 1
+	call calloc (vsf, nvsf, TY_INT) 
+
+	CT_LW(ct) =  mw_sctran (mw, "logical", "world", 3)
+	CT_WL(ct) =  mw_sctran (mw, "world", "logical", 3)
+	CT_NX(ct) = nx
+	CT_NY(ct) = ny
+
+	do i = 1, 2 {
+	    ifnoerr (call mw_gwattrs (mw, i, "units", Memc[units], SZ_FNAME))
+	        un[i] = un_open (Memc[units])
+	    else
+		un[i] = NULL
+	}
+end
+
+
+# TR_SETUP -- Setup the transformation interpolation.
+# 
+# At each point (U,V) in the output image we need to know the coordinate
+# (X,Y) of the input images to be interpolated.  This means we need
+# to determine X(U,V) and Y(U,V).  The input user coordinate surfaces,
+# however, are U(X,Y) and V(X,Y) (a missing surface implies a one to one
+# mapping of U=X or V=Y).  This requires simultaneously inverting the user
+# coordinate surfaces.  This is a slow process using a gradient following
+# iterative technique.
+# 
+# Note that when an WCS is used, the MWCS routines already provide the
+# inverse mapping.  But even in this case it may be slow and so we use the
+# same sampling and surface fitting technique for setting up the inversion
+# mapping.
+# 
+# The inverted coordinates are determined on a evenly subsampled grid of
+# linear output coordinates.  A linear interpolation surface can then be fit
+# to this grid which is much faster to evaluate at each output coordinate.
+# These interpolation surfaces are returned.  If flux is to be conserved a
+# similar interpolation surface for the Jacobian, J(U,V) is also returned.
+# There may also be a mapping of the output image into logrithmic intervals
+# which maps to the linearly sampled interpolation surfaces.  The mappings
+# of the output U and V intervals to the subsampled interpolation coordinates
+# are also returned.
+# 
+# 1. Set the output coordinate system based on the ranges of X, Y, U, and V.
+# 2. Determine X(U,V), Y(U,V), and J(U,V) on a evenly subsampled grid of
+#    U and V.
+# 3. Fit linear interpolation surfaces to these data.
+# 4. Compute the mapping between output coordinates along each axis, which
+#    may be logrithmic, into the subsampling interpolation coordinates.
+
+procedure tr_setup (ct, usf, nusf, vsf, nvsf, un, xmsi, ymsi, jmsi,
+	uout, vout, duout, dvout)
+
+pointer	ct			#I CT pointer
+pointer	usf			#U Pointers to U surface fits: freed upon return
+int	nusf			#I Number of U surface fits
+pointer	vsf			#U Pointers to V surface fits: freed upon return
+int	nvsf			#I Number of V surface fits
+pointer	un[2]			#O Units pointers
+pointer	xmsi, ymsi, jmsi	#O Surface interpolators for X, Y and Jacobian
+pointer	uout, vout		#O Output coordinates relative to interpolator 
+pointer	duout, dvout		#O Output coordinate intervals
+
+int	i, j, step, nu1, nv1
+real	xmin, xmax, ymin, ymax, umin, umax, vmin, vmax
+real	u, v, x, y, du1, dv1, der[8]
+double	dval
+pointer	xgrid, ygrid, zgrid, ptr1, ptr2, ptr3
+
+real	tr_getr(), tr_eval()
+
+include	"transform.com"
+
+begin
+	#step = clgeti ("step")
+	step = 10
+
+	xmin = INDEF
+	xmax = INDEF
+	ymin = INDEF
+	ymax = INDEF
+	umin = INDEF
+	umax = INDEF
+	vmin = INDEF
+	vmax = INDEF
+	do i = 1, nusf {
+	    if (IS_INDEF (xmin)) {
+		xmin = tr_getr (ct, Memi[usf+i-1], GSXMIN)
+		xmax = tr_getr (ct, Memi[usf+i-1], GSXMAX)
+		ymin = tr_getr (ct, Memi[usf+i-1], GSYMIN)
+		ymax = tr_getr (ct, Memi[usf+i-1], GSYMAX)
+	    } else {
+		if ((xmin != tr_getr (ct, Memi[usf+i-1], GSXMIN)) ||
+		    (xmax != tr_getr (ct, Memi[usf+i-1], GSXMAX)) ||
+		    (ymin != tr_getr (ct, Memi[usf+i-1], GSYMIN)) ||
+		    (ymax != tr_getr (ct, Memi[usf+i-1], GSYMAX)))
+		    call error (0, "tr_setup: Inconsistent coordinate fits")
+	    }
+
+	    if (IS_INDEF (umin)) {
+	        umin = tr_eval (ct, Memi[usf+i-1], 1, xmin, ymin)
+	        umax = umin
+	    }
+	    u = tr_eval (ct, Memi[usf+i-1], 1, xmin, ymin)
+	    umin = min (u, umin)
+	    umax = max (u, umax)
+	    u = tr_eval (ct, Memi[usf+i-1], 1, xmax, ymin)
+	    umin = min (u, umin)
+	    umax = max (u, umax)
+	    u = tr_eval (ct, Memi[usf+i-1], 1, xmin, ymax)
+	    umin = min (u, umin)
+	    umax = max (u, umax)
+	    u = tr_eval (ct, Memi[usf+i-1], 1, xmax, ymax)
+	    umin = min (u, umin)
+	    umax = max (u, umax)
+	}
+	do i = 1, nvsf {
+	    if (IS_INDEF (xmin)) {
+		xmin = tr_getr (ct, Memi[vsf+i-1], GSXMIN)
+		xmax = tr_getr (ct, Memi[vsf+i-1], GSXMAX)
+		ymin = tr_getr (ct, Memi[vsf+i-1], GSYMIN)
+		ymax = tr_getr (ct, Memi[vsf+i-1], GSYMAX)
+	    } else {
+		if ((xmin != tr_getr (ct, Memi[vsf+i-1], GSXMIN)) ||
+		    (xmax != tr_getr (ct, Memi[vsf+i-1], GSXMAX)) ||
+		    (ymin != tr_getr (ct, Memi[vsf+i-1], GSYMIN)) ||
+		    (ymax != tr_getr (ct, Memi[vsf+i-1], GSYMAX)))
+		    call error (0, "tr_setup: Inconsistent coordinate fits")
+	    }
+
+	    if (IS_INDEF (vmin)) {
+	        vmin = tr_eval (ct, Memi[vsf+i-1], 2, xmin, ymin)
+	        vmax = vmin
+	    }
+	    v = tr_eval (ct, Memi[vsf+i-1], 2, xmin, ymin)
+	    vmin = min (v, vmin)
+	    vmax = max (v, vmax)
+	    v = tr_eval (ct, Memi[vsf+i-1], 2, xmax, ymin)
+	    vmin = min (v, vmin)
+	    vmax = max (v, vmax)
+	    v = tr_eval (ct, Memi[vsf+i-1], 2, xmin, ymax)
+	    vmin = min (v, vmin)
+	    vmax = max (v, vmax)
+	    v = tr_eval (ct, Memi[vsf+i-1], 2, xmax, ymax)
+	    vmin = min (v, vmin)
+	    vmax = max (v, vmax)
+	}
+	if (IS_INDEF (umin)) {
+	    umin = xmin
+	    umax = xmax
+	}
+	if (IS_INDEF (vmin)) {
+	    vmin = ymin
+	    vmax = ymax
+	}
+
+	# Set the output coordinate system which is in a common block.
+	call tr_setoutput (xmin, xmax, ymin, ymax, umin, umax, vmin, vmax)
+
+	# Subsample the inverted coordinates and fit an interpolation
+	# surface.  The grid is evaluated in a back and forth pattern to
+	# use the last point evaluated and the starting point for the next
+	# point.  This allows the interative inversion routine to work most
+	# efficiently with typically only two evaluations per step.
+
+	nu1 = max (2, nu / step)
+	nv1 = max (2, nv / step)
+	du1 = (u2 - u1) / (nu1 - 1)
+	dv1 = (v2 - v1) / (nv1 - 1)
+
+	call malloc (xgrid, nu1 * nv1, TY_REAL)
+	call malloc (ygrid, nu1 * nv1, TY_REAL)
+	call malloc (zgrid, nu1 * nv1, TY_REAL)
+
+	call tr_init (ct, Memi[usf], nusf, Memi[vsf], nvsf, xmin, ymin, der)
+	do i = 1, nv1, 2 {
+	    # Do this line from left to right.
+	    ptr1 = xgrid + (i - 1) * nu1 - 1
+	    ptr2 = ygrid + (i - 1) * nu1 - 1
+	    ptr3 = zgrid + (i - 1) * nu1 - 1
+	    v = v1 + (i - 1) * dv1
+	    do j = 1, nu1 {
+		u = u1 + (j - 1) * du1
+		call tr_invert (ct, Memi[usf], nusf, Memi[vsf], nvsf, u, v,
+		    x, y, der, xmin, xmax, ymin, ymax)
+		# V2.10.2
+		#Memr[ptr1+j] = der[1]
+		#Memr[ptr2+j] = der[2]
+		# After V2.10.3
+		Memr[ptr1+j] = x
+		Memr[ptr2+j] = y
+
+		Memr[ptr3+j] = 1. / abs (der[4] * der[8] - der[5] * der[7])
+	    }
+	    if (i == nv1)
+		break
+
+	    # Do the next line from right to left.
+	    ptr1 = xgrid + i * nu1 - 1
+	    ptr2 = ygrid + i * nu1 - 1
+	    ptr3 = zgrid + i * nu1 - 1
+	    v = v1 + i * dv1
+	    do j = nu1, 1, -1 {
+		u = u1 + (j - 1) * du1
+		call tr_invert (ct, Memi[usf], nusf, Memi[vsf], nvsf, u, v,
+		    x, y, der, xmin, xmax, ymin, ymax)
+		# V2.10.2
+		#Memr[ptr1+j] = der[1]
+		#Memr[ptr2+j] = der[2]
+		# V2.10.3
+		Memr[ptr1+j] = x
+		Memr[ptr2+j] = y
+		Memr[ptr3+j] = 1. / abs (der[4] * der[8] - der[5] * der[7])
+	    }
+	}
+
+	# Free the surfaces since we are now done with them.
+	if (ct != NULL)
+	    call mfree (ct, TY_STRUCT)
+	for (i=1; i<=nusf; i=i+1)
+	    if (Memi[usf+i-1] != NULL)
+		call xgsfree (Memi[usf+i-1])
+	call mfree (usf, TY_POINTER)
+	for (i=1; i<=nvsf; i=i+1)
+	    if (Memi[vsf+i-1] != NULL)
+		call xgsfree (Memi[vsf+i-1])
+	call mfree (vsf, TY_POINTER)
+
+	# Fit a linear interpolator to the subsampled grids of X(U,V), Y(U,V),
+	# and J(U,V) to avoid having to evaluate the inverse at each point in
+	# the output image.  The inversion is slow because of the many
+	# evaluations of the surfaces coordinates.  Also compute an return
+	# arrays mapping the output coordinates to the subsampled coordinates.
+	# This may include a transformation to logrithmic intervals.
+
+	call msiinit (xmsi, II_BILINEAR)
+	call msifit (xmsi, Memr[xgrid], nu1, nv1, nu1)
+	call mfree (xgrid, TY_REAL)
+
+	call msiinit (ymsi, II_BILINEAR)
+	call msifit (ymsi, Memr[ygrid], nu1, nv1, nu1)
+	call mfree (ygrid, TY_REAL)
+
+	if (flux) {
+	    call msiinit (jmsi, II_BILINEAR)
+	    call msifit (jmsi, Memr[zgrid], nu1, nv1, nu1)
+	}
+	call mfree (zgrid, TY_REAL)
+
+	# Compute the mapping between output coordinates and the subsampled
+	# interpolation surface.  Also compute the intervals used to define
+	# the pixel areas for conserving flux.
+
+	call malloc (uout, nu, TY_REAL)
+	call malloc (duout, nu, TY_REAL)
+	if (ulog) {
+	    dval = log10 (double(u1))
+	    do i = 0, nu - 1
+		Memr[uout+i] = 10.**(dval+i*du)
+	    call amulkr (Memr[uout], du * LN_10, Memr[duout], nu)
+	} else {
+	    do i = 0, nu - 1
+		Memr[uout+i] = u1 + i * du
+	    call amovkr (du, Memr[duout], nu)
+	}
+	u2 = Memr[uout+nu-1]
+
+	call malloc (vout, nv, TY_REAL)
+	call malloc (dvout, nv, TY_REAL)
+	if (vlog) {
+	    dval = log10 (double(v1))
+	    do i = 0, nv - 1
+		Memr[vout+i] = 10.**(dval+i*dv)
+	    call amulkr (Memr[vout], dv * LN_10, Memr[dvout], nv)
+	} else {
+	    do i = 0, nv - 1
+		Memr[vout+i] = v1 + i * dv
+	    call amovkr (dv, Memr[dvout], nv)
+	}
+	v2 = Memr[vout+nv-1]
+
+	# Convert to interpolation coordinates.
+	umin = 1.; umax = nu
+	do i = 0, nu - 1
+	    Memr[uout+i] = max (umin, min (umax, (Memr[uout+i]-u1)/du1+1))
+	vmin = 1.; vmax = nv
+	do i = 0, nv - 1
+	    Memr[vout+i] = max (vmin, min (vmax, (Memr[vout+i]-v1)/dv1+1))
+end
+
+
+define	MAX_ITERATE	10
+define	ERROR		0.05
+define	FUDGE		0.5
+
+# TR_INVERT -- Given user coordinate surfaces U(X,Y) and V(X,Y)
+# (if none use one-to-one mapping and if more than one average)
+# corresponding to a given U and V and also the various partial
+# derivatives.  This is done using a gradient following interative
+# method based on evaluating the partial derivative at each point
+# and solving the linear Taylor expansions simultaneously.  The last
+# point sampled is used as the starting point.  Thus, if the
+# input U and V progress smoothly then the number of iterations
+# can be small.  The output is returned in x and y and in the derivative array
+# DER.  A point outside of the surfaces is returned as the nearest
+# point at the edge of the surfaces in the DER array.
+#
+# If a WCS is used then we let MWCS do the inversion and compute the
+# derivatives numerically.
+
+procedure tr_invert (ct, usf, nusf, vsf, nvsf, u, v, x, y, der,
+	xmin, xmax, ymin, ymax)
+
+pointer	ct			#I CT pointer
+pointer	usf[ARB], vsf[ARB]	#I User coordinate surfaces U(X,Y) and V(X,Y)
+int	nusf, nvsf		#I Number of surfaces for each coordinate
+real	u, v			#I Input U and V to determine X and Y
+real	x, y			#O Output X and Y
+real	der[8]			#U Last result as input, new result as output 
+				#  1=X, 2=Y, 3=U, 4=DUDX, 5=DUDY, 6=V,
+				#  7=DVDX, 8=DVDY
+real	xmin, xmax, ymin, ymax	#I Limits of coordinate surfaces.
+
+int	i, j, nedge
+real	fudge, du, dv, dx, dy, a, b, tmp[4]
+
+begin
+	# If using a WCS we let MWCS do the inversion.
+	if (ct != NULL) {
+	    call mw_c2tranr (CT_WL(ct), u, v, x, y)
+	    call mw_c2tranr (CT_LW(ct), x-0.5, y, tmp[1], tmp[3])
+	    call mw_c2tranr (CT_LW(ct), x+0.5, y, tmp[2], tmp[4])
+	    der[4] = tmp[2] - tmp[1]
+	    der[7] = tmp[4] - tmp[3]
+	    call mw_c2tranr (CT_LW(ct), x, y-0.5, tmp[1], tmp[3])
+	    call mw_c2tranr (CT_LW(ct), x, y+0.5, tmp[2], tmp[4])
+	    der[5] = tmp[2] - tmp[1]
+	    der[8] = tmp[4] - tmp[3]
+	    return
+	}
+
+	# Use the last result as the starting point for the next position.
+	# If this is near the desired value then the interation will converge
+	# quickly.  Allow a iteration to go off the surface twice.
+	# Quit when DX and DY are within ERROR.
+
+	nedge = 0
+	do i = 1, MAX_ITERATE {
+	    du = u - der[3]
+	    dv = v - der[6]
+	    a = der[8] * du - der[5] * dv
+	    b = der[8] * der[4] - der[5] * der[7]
+	    if (b == 0.) {
+		if (a < 0.)
+		    dx = -2.
+		else
+		    dx = 2.
+	    } else
+	        dx = a / b
+	    a = dv - der[7] * dx
+	    b = der[8]
+	    if (b == 0.) {
+		if (a < 0.)
+		    dy = -2.
+		else
+		    dy = 2.
+	    } else
+	        dy = a / b
+	    fudge = 1 - FUDGE / i
+	    x = der[1] + fudge * dx
+	    y = der[2] + fudge * dy
+	    der[1] = max (xmin, min (xmax, x))
+	    der[2] = max (ymin, min (ymax, y))
+#	    if (x < xmin || x > xmax)
+#	        nedge = nedge + 1
+#	    if (y < ymin || y > ymax)
+#	        nedge = nedge + 1
+#	    if (nedge > 2)
+#	        break
+	    if ((abs (dx) < ERROR) && (abs (dy) < ERROR))
+	        break
+
+	    if (nusf == 0)
+		der[3] = der[1]
+	    else if (nusf == 1) {
+	        call xgsder (usf[1], der[1], der[2], der[3], 1, 0, 0)
+	        call xgsder (usf[1], der[1], der[2], der[4], 1, 1, 0)
+	        call xgsder (usf[1], der[1], der[2], der[5], 1, 0, 1)
+	    } else {
+	        call xgsder (usf[1], der[1], der[2], der[3], 1, 0, 0)
+	        call xgsder (usf[1], der[1], der[2], der[4], 1, 1, 0)
+	        call xgsder (usf[1], der[1], der[2], der[5], 1, 0, 1)
+		do j = 2, nusf {
+	            call xgsder (usf[j], der[1], der[2], tmp[1], 1, 0, 0)
+	            call xgsder (usf[j], der[1], der[2], tmp[2], 1, 1, 0)
+	            call xgsder (usf[j], der[1], der[2], tmp[3], 1, 0, 1)
+		    der[3] = der[3] + tmp[1]
+		    der[4] = der[4] + tmp[2]
+		    der[5] = der[5] + tmp[3]
+		}
+		der[3] = der[3] / nusf
+		der[4] = der[4] / nusf
+		der[5] = der[5] / nusf
+	    }
+
+	    if (nvsf == 0)
+		der[6] = der[2]
+	    else if (nvsf == 1) {
+	        call xgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0)
+	        call xgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0)
+	        call xgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1)
+	    } else {
+	        call xgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0)
+	        call xgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0)
+	        call xgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1)
+		do j = 2, nvsf {
+	            call xgsder (vsf[j], der[1], der[2], tmp[1], 1, 0, 0)
+	            call xgsder (vsf[j], der[1], der[2], tmp[2], 1, 1, 0)
+	            call xgsder (vsf[j], der[1], der[2], tmp[3], 1, 0, 1)
+		    der[6] = der[6] + tmp[1]
+		    der[7] = der[7] + tmp[2]
+		    der[8] = der[8] + tmp[3]
+		}
+		der[6] = der[6] / nvsf
+		der[7] = der[7] / nvsf
+		der[8] = der[8] / nvsf
+	    }
+	}
+end
+
+
+# TR_INIT -- Since the inversion iteration always begins from the last
+# point we need to initialize before the first call to TR_INVERT.
+# When using a WCS this simply returns.
+
+procedure tr_init (ct, usf, nusf, vsf, nvsf, x, y, der)
+
+pointer	ct			#I CT pointer
+pointer	usf[ARB], vsf[ARB]	#I User coordinate surfaces
+int	nusf, nvsf		#I Number of surfaces for each coordinate
+real	x, y			#I Starting X and Y
+real	der[8]			#O Inversion data
+
+int	j
+real	tmp[3]
+
+begin
+	if (ct != NULL)
+	    return
+
+	der[1] = x
+	der[2] = y
+	if (nusf == 0) {
+	    der[3] = der[1]
+	    der[4] = 1.
+	    der[5] = 0.
+	} else if (nusf == 1) {
+	    call xgsder (usf[1], der[1], der[2], der[3], 1, 0, 0)
+	    call xgsder (usf[1], der[1], der[2], der[4], 1, 1, 0)
+	    call xgsder (usf[1], der[1], der[2], der[5], 1, 0, 1)
+	} else {
+	    call xgsder (usf[1], der[1], der[2], der[3], 1, 0, 0)
+	    call xgsder (usf[1], der[1], der[2], der[4], 1, 1, 0)
+	    call xgsder (usf[1], der[1], der[2], der[5], 1, 0, 1)
+	    do j = 2, nusf {
+	        call xgsder (usf[j], der[1], der[2], tmp[1], 1, 0, 0)
+	        call xgsder (usf[j], der[1], der[2], tmp[2], 1, 1, 0)
+	        call xgsder (usf[j], der[1], der[2], tmp[3], 1, 0, 1)
+		der[3] = der[3] + tmp[1]
+		der[4] = der[4] + tmp[2]
+		der[5] = der[5] + tmp[3]
+	    }
+	    der[3] = der[3] / nusf
+	    der[4] = der[4] / nusf
+	    der[5] = der[5] / nusf
+	}
+
+	if (nvsf == 0) {
+	    der[6] = der[2]
+	    der[7] = 0.
+	    der[8] = 1.
+	} else if (nvsf == 1) {
+	    call xgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0)
+	    call xgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0)
+	    call xgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1)
+	} else {
+	    call xgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0)
+	    call xgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0)
+	    call xgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1)
+	    do j = 2, nvsf {
+	        call xgsder (vsf[j], der[1], der[2], tmp[1], 1, 0, 0)
+	        call xgsder (vsf[j], der[1], der[2], tmp[2], 1, 1, 0)
+	        call xgsder (vsf[j], der[1], der[2], tmp[3], 1, 0, 1)
+		der[6] = der[6] + tmp[1]
+		der[7] = der[7] + tmp[2]
+		der[8] = der[8] + tmp[3]
+	    }
+	    der[6] = der[6] / nvsf
+	    der[7] = der[7] / nvsf
+	    der[8] = der[8] / nvsf
+	}
+end
+
+
+# TR_EVAL -- Evalute coordinate function.
+#
+# This is an interface routine to allow using either an MWCS CT (coordinate
+# transform) pointer or a GSURFIT SF (2D surface function) pointer.  The
+# surface method is used with a FITCOORDS database.  The MWCS method is
+# used to retransform an image with a WCS.
+
+real procedure tr_eval (ct, sf, axis, x, y)
+
+pointer	ct			#I CT pointer
+pointer	sf			#I SF pointer
+int	axis			#I World coordinate axis to return
+real	x, y			#I Pixel coordinate to transform
+
+real	w[2], xgseval()
+
+begin
+	if (sf != NULL)
+	    return (xgseval (sf, x, y))
+	
+	call mw_c2tranr (CT_LW(ct), x, y, w[1], w[2])
+	return (w[axis])
+end
+
+
+# TR_GETR -- Get real valued parameter.
+#
+# This is an interface routine to allow using either an MWCS CT (coordinate
+# transform) pointer or a GSURFIT SF (2D surface function) pointer.  The
+# surface method is used with a FITCOORDS database.  The MWCS method is
+# used to retransform an image with a WCS.
+
+real procedure tr_getr (ct, sf, param)
+
+pointer	ct			#I CT pointer
+pointer	sf			#I SF pointer
+int	param			#I Parameter code
+
+real	xgsgetr()
+
+begin
+	if (sf != NULL)
+	    return (xgsgetr (sf, param))
+
+	switch (param) {
+	case GSXMIN, GSYMIN: 
+	    return (real (1))
+	case GSXMAX:
+	    return (real (CT_NX(ct)))
+	case GSYMAX:
+	    return (real (CT_NY(ct)))
+	}
+end
diff --git a/noao/twodspec/longslit/x_longslit.x b/noao/twodspec/longslit/x_longslit.x
new file mode 100644
index 00000000..7c33cf28
--- /dev/null
+++ b/noao/twodspec/longslit/x_longslit.x
@@ -0,0 +1,8 @@
+task	extinction	= t_extinction,
+	fceval		= t_fceval,
+	fitcoords	= t_fitcoords,
+	fluxcalib	= t_fluxcalib,
+	illumination	= t_illumination,
+	lscombine	= t_lscombine,
+	response	= t_response,
+	transform	= t_transform
diff --git a/noao/twodspec/mkpkg b/noao/twodspec/mkpkg
new file mode 100644
index 00000000..379ae40d
--- /dev/null
+++ b/noao/twodspec/mkpkg
@@ -0,0 +1,10 @@
+# Make the TWODSPEC package.
+
+update:
+	$echo "---------------- TWODSPEC.APEXTRACT -----------------"
+	$call update@apextract
+	$echo "---------------- TWODSPEC.LONGSLIT ----------------"
+	$call update@longslit
+	#$echo "---------------- TWODSPEC.MULTISPEC ---------------"
+	#$call update@multispec
+	;
diff --git a/noao/twodspec/multispec/Revisions b/noao/twodspec/multispec/Revisions
new file mode 100644
index 00000000..1e62477c
--- /dev/null
+++ b/noao/twodspec/multispec/Revisions
@@ -0,0 +1,28 @@
+.help revisions Jun88 noao.twodspec.multispec
+.nf
+The multispec package is no longer compiled and defined.  The source code
+will someday be revised and the capabilities of tracing and deblending
+will be returned.  (8/23/90, Valdes)
+
+====
+V2.9
+====
+
+noao$twodspec/multispec/t_fitgauss5.x
+    Valdes, Oct. 3, 1986
+    1.  Missing third argument to msmap.  Found in the AOS port.
+
+====================================
+Version 2.3 Release, August 18, 1986
+====================================
+
+From Valdes Oct. 23, 1985:
+
+1.  Recoded msio.x and dbio.x to remove entry statements and instead use
+separate procedures with a common block.
+------
+From Valdes Oct. 11, 1985:
+
+1.  The MSPLOT script using PLOT.GRAPH has been removed and an interactive
+task based on GIO has replaced it.
+.endhelp
diff --git a/noao/twodspec/multispec/_msfindspec1.cl b/noao/twodspec/multispec/_msfindspec1.cl
new file mode 100644
index 00000000..1d9ae624
--- /dev/null
+++ b/noao/twodspec/multispec/_msfindspec1.cl
@@ -0,0 +1,41 @@
+#{ _MSFINDSPEC1 -- Create a new database, find the peaks, trace, and fit a
+# function.
+
+#image,f,a,,,,Image
+#sample_lines,s,a,"10x50",,,Sample image lines
+#start,i,a,1,,,Starting image line
+#min_nspectra,i,a,1,,,Minimum number of spectra to be found
+#max_nspectra,i,a,100,,,Maximum number of spectra to be found
+#separation,i,a,20,,,Minimum separation between spectra
+#threshold,r,a,0.,,,Minimum peak threshold for selecting spectra
+#contrast,r,a,0.1,,,Maximum contrast between peaks
+#width,r,a,10,,,Width of spectra
+#naverage,i,a,20,1,,Number of lines to average
+#verbose,b,a,no,,,Verbose output?
+
+{
+	# Verbose message.
+	if (verbose) {
+	    time
+	    print ("  Find the spectra in ", image, ".")
+	}
+
+	# Create a new database.
+	newextraction (image, "", sample_lines=sample_lines)
+
+	# Find the peaks.
+	findpeaks (image, start, contrast, separation=separation,
+	    threshold=threshold, min_npeaks=min_nspectra, edge=width/3,
+	    max_npeaks=max_nspectra, naverage=naverage)
+
+	# Initialize the model parameters and fit the model with tracking.
+	msset (image, "s0", 1., lines=start)
+	msset (image, "s1", 0., lines=start)
+	msset (image, "s2", 0., lines=start)
+	fitgauss5 (image, start, lower=-width/2, upper=width/2,
+	    lines="*", spectra="*", naverage=naverage, track=yes,
+	    algorithm=2)
+
+	# Fit the default interpolation function to the positions.
+	fitfunction (image, parameter="x0", lines="*", spectra="*")
+}
diff --git a/noao/twodspec/multispec/_msfindspec1.par b/noao/twodspec/multispec/_msfindspec1.par
new file mode 100644
index 00000000..5263bedb
--- /dev/null
+++ b/noao/twodspec/multispec/_msfindspec1.par
@@ -0,0 +1,15 @@
+
+# _MSFINDSPEC1 -- Create a new database, find the peaks, trace, and fit a
+# function.
+
+image,f,a,,,,Image
+sample_lines,s,a,"10x50",,,Sample image lines
+start,i,a,1,,,Starting image line
+min_nspectra,i,a,1,,,Minimum number of spectra to be found
+max_nspectra,i,a,100,,,Maximum number of spectra to be found
+separation,i,a,20,,,Minimum separation between spectra
+threshold,r,a,0.,,,Minimum peak threshold for selecting spectra
+contrast,r,a,0.1,,,Maximum contrast between peaks
+width,r,a,10,,,Width of spectra
+naverage,i,a,20,1,,Number of lines to average
+verbose,b,a,no,,,Verbose output?
diff --git a/noao/twodspec/multispec/_msfindspec2.cl b/noao/twodspec/multispec/_msfindspec2.cl
new file mode 100644
index 00000000..d09212fc
--- /dev/null
+++ b/noao/twodspec/multispec/_msfindspec2.cl
@@ -0,0 +1,28 @@
+#{ _MSFINDSPEC2 -- Create a new database, initialize with a template
+# image, refine the positions, and fit a position function.
+
+#image,f,a,,,,Image
+#template,f,a,,,,Template image
+#width,r,a,10,,,Width of spectra
+#naverage,i,a,20,1,,Number of lines to average
+#verbose,b,a,no,,,Verbose output?
+
+{
+	# Verbose message.
+	if (verbose) {
+	    time
+	    print ("  Find the spectra in ", image, " using template image ",
+		template, ".")
+	}
+
+	# Create a new database and initialize with a template image.
+	newextraction (image, template)
+
+	# Refit the model.
+	fitgauss5 (image, 1, lower=-width/2, upper=width/2,
+	    lines="*", spectra="*", naverage=naverage, track=no,
+	    algorithm=2)
+
+	# Fit the default interpolation function to the positions.
+	fitfunction (image, parameter="x0", lines="*", spectra="*")
+}
diff --git a/noao/twodspec/multispec/_msfindspec2.par b/noao/twodspec/multispec/_msfindspec2.par
new file mode 100644
index 00000000..d9e10b5d
--- /dev/null
+++ b/noao/twodspec/multispec/_msfindspec2.par
@@ -0,0 +1,8 @@
+# _MSFINDSPEC2 -- Create a new database, initialize with a template
+# image, refine the positions, and fit a position function.
+
+image,f,a,,,,Image
+template,f,a,,,,Template image
+width,r,a,10,,,Width of spectra
+naverage,i,a,20,1,,Number of lines to average
+verbose,b,a,no,,,Verbose output?
diff --git a/noao/twodspec/multispec/_msfindspec3.cl b/noao/twodspec/multispec/_msfindspec3.cl
new file mode 100644
index 00000000..d8150a90
--- /dev/null
+++ b/noao/twodspec/multispec/_msfindspec3.cl
@@ -0,0 +1,22 @@
+#{ _MSFINDSPEC3 -- Refine the model and fit a position function.
+
+#image,f,a,,,,Image
+#width,r,a,10,,,Width of spectra
+#naverage,i,a,20,1,,Number of lines to average
+#verbose,b,a,no,,,Verbose output?
+
+{
+	# Verbose message.
+	if (verbose) {
+	    time
+	    print ("  Refit the spectra in ", image, ".")
+	}
+
+	# Refit the model.
+	fitgauss5 (image, 1, lower=-width/2, upper=width/2,
+	    lines="*", spectra="*", naverage=naverage, track=no,
+	    algorithm=2)
+
+	# Fit the default interpolation function to the positions.
+	fitfunction (image, parameter="x0", lines="*", spectra="*")
+}
diff --git a/noao/twodspec/multispec/_msfindspec3.par b/noao/twodspec/multispec/_msfindspec3.par
new file mode 100644
index 00000000..fccb3d23
--- /dev/null
+++ b/noao/twodspec/multispec/_msfindspec3.par
@@ -0,0 +1,6 @@
+# _MSFINDSPEC3 -- Refine the model and fit a position function.
+
+image,f,a,,,,Image
+width,r,a,10,,,Width of spectra
+naverage,i,a,20,1,,Number of lines to average
+verbose,b,a,no,,,Verbose output?
diff --git a/noao/twodspec/multispec/armsr.x b/noao/twodspec/multispec/armsr.x
new file mode 100644
index 00000000..2f9ce657
--- /dev/null
+++ b/noao/twodspec/multispec/armsr.x
@@ -0,0 +1,44 @@
+# ARMSR -- Compute the rms of an array.
+
+real procedure armsr (a, npoints)
+
+real	a[ARB]				# Return rms of this array
+int	npoints				# Number of points in the array
+
+int	i
+real	avg, rms
+
+begin
+	avg = 0.
+	rms = 0.
+	do i = 1, npoints {
+	    avg = avg + a[i]
+	    rms = rms + a[i] * a[i]
+	}
+	rms = sqrt ((npoints * rms - avg * avg) / (npoints * (npoints - 1)))
+
+	return (rms)
+end
+
+
+# ARMSRR -- Compute the vector rms between two real arrays.
+
+real procedure armsrr (a, b, npoints)
+
+real	a[ARB]				# First array
+real	b[ARB]				# Second array
+int	npoints				# Number of points
+
+int	i
+real	residual, rms
+
+begin
+	rms = 0.
+	do i = 1, npoints {
+	    residual = a[i] - b[i]
+	    rms = rms + residual ** 2
+	}
+	rms = sqrt (rms / npoints)
+
+	return (rms)
+end
diff --git a/noao/twodspec/multispec/clinput.x b/noao/twodspec/multispec/clinput.x
new file mode 100644
index 00000000..163c8354
--- /dev/null
+++ b/noao/twodspec/multispec/clinput.x
@@ -0,0 +1,28 @@
+# Specialized CL get routines.
+
+
+# CLGRANGES -- Get a range.  A range string is input and the string is
+# decoded into a range array.  The number of values in the range array is
+# returned by the function.
+
+int procedure clgranges (param, min_value, max_value, ranges, max_ranges)
+
+char	param[ARB]
+int	min_value
+int	max_value
+int	ranges[ARB]
+int	max_ranges
+
+char	str[SZ_LINE]
+int	n
+
+int	decode_ranges()
+
+begin
+	call clgstr (param, str, SZ_LINE)
+
+	if (decode_ranges (str,ranges,max_ranges,min_value,max_value,n) == ERR)
+	    call error (0, "Error in range string")
+
+	return (n)
+end
diff --git a/noao/twodspec/multispec/dbio/dbio.h b/noao/twodspec/multispec/dbio/dbio.h
new file mode 100644
index 00000000..dd9f65f1
--- /dev/null
+++ b/noao/twodspec/multispec/dbio/dbio.h
@@ -0,0 +1,24 @@
+
+# Definitions for subset DBIO
+
+define	SZ_DB_KEY	79		# Size of database reference keys
+define	MAX_DB_DES	10		# Maximum number of DBIO descriptors
+define	DB_ERRCODE	1000		# Start of DBIO error codes
+
+# DBIO descriptor
+
+define	LEN_DB_DES	3
+
+define	DB_FD		Memi[$1]	# The database FIO descriptor
+define	DB_DIC		Memi[$1+1]	# Pointer to the dictionary memory
+define	DB_UPDATE	Memi[$1+2]	# Has dictionary been change [y/n]
+
+# DBIO dictionary entry.  Each entry is referenced with the pointer to the
+# dictionary memory ($1) and the entry number ($2).
+
+define	LEN_DB_ENTRY	43
+
+define	DB_KEY		Memi[$1+($2-1)*LEN_DB_ENTRY]	# Key
+define	DB_OFFSET	Meml[$1+($2-1)*LEN_DB_ENTRY+40]	# File Offset
+define	DB_SZ_ELEM	Memi[$1+($2-1)*LEN_DB_ENTRY+41]	# Element size
+define	DB_DIM		Memi[$1+($2-1)*LEN_DB_ENTRY+42]	# Number of elements
diff --git a/noao/twodspec/multispec/dbio/dbio.x b/noao/twodspec/multispec/dbio/dbio.x
new file mode 100644
index 00000000..faa21cef
--- /dev/null
+++ b/noao/twodspec/multispec/dbio/dbio.x
@@ -0,0 +1,564 @@
+
+include	<fset.h>
+include	<error.h>
+include "dbio.h"
+
+.help dbio 2 "Subset Database I/O Procedures"
+.sh
+1. Introduction
+
+     These DBIO procedures are a subset of the general
+DBIO design described in "Specifications of the IRAF DBIO Interface" by
+Doug Tody (Oct 1983).  It is designed to allow programs written using
+the subset DBIO to be easily converted to the full DBIO.  It's features
+are:
+.ls 4 1.
+Database open and close.
+.le
+.ls 4 2.
+Reference to entries by a (possibly) subscripted record name string.
+.le
+.ls 4 3.
+Ability to add new record types as desired.
+.le
+.ls 4 4.
+Error recovery procedure to cleanup after an uncaught error.
+.le
+
+The primary limitations are:
+.ls 4 1.
+No aliases.
+.le
+.ls 4 2.
+No datatyping and no self-describing structures.
+.le
+.ls 4 3.
+No deletions of entries.
+.le
+.sh
+2. Procedures
+
+.nf
+		db = dbopen (file_name, mode, max_entries)
+		db = dbreopen (db)
+		     dbclose (db)
+		     dbenter (db, record_name, sz_elem, nreserve)
+	       y/n = dbaccess (db, record_name)
+	     nread = dbread (db, reference, buf, maxelems)
+	  	     dbwrite (db, reference, buf, nelems)
+.fi
+
+     A new, empty database is created by opening with access modes NEW_FILE
+or TEMP_FILE.  The dictionary will be intialized to allow max_entries
+number of dictionary entries.  The other legal access modes are READ_ONLY and
+READ_WRITE.  The max_entries argument is not used with these modes.  To create
+a new entry in the database the name of the record, the size of a record
+element, and the maximum number of such records to be stored are specified.
+This differs from the full DBIO specification in that a record is described
+only by a size instead of a datatype.  Also it is not possible to increase
+the number of elements once it has been entered.  The database read and
+write procedures do no type conversion.  They read procedure returns
+the number of elements read.  If a reference is not found in the
+dictionary in either reading or writing an error condition occurs.
+Also an attempt to read or write an element exceeding the dimension
+entered in the dictionary will create an error condition.
+.endhelp
+
+
+# DBOPEN, DBREOPEN -- Open a database file.
+
+pointer procedure dbopen (file_name, ac_mode, db_nentries)
+
+# Procedure dbopen parameters:
+char	file_name[SZ_FNAME]		# Database filename
+int	ac_mode				# Access mode (new,temp,r,rw)
+int	db_nentries			# Creation dictionary size
+
+# Entry dbreopen parameters:
+pointer	dbreopen			# Function type
+pointer	db_old				# Old database descriptor
+
+int	mode
+pointer	fd, db				# FIO descriptor and DBIO descriptor
+pointer	dic
+int	nelem, nentries
+
+bool	strne()
+int	open(), dbread(), reopen()
+errchk	db_getdes, calloc, dbenter, dbread, db_init
+
+begin
+	# Check for valid access mode.  Valid modes require read permission.
+	# If a valid access mode open database with FIO.
+	mode = ac_mode
+	if ((mode == WRITE_ONLY) || (mode == APPEND))
+	    call error (DB_ERRCODE + 0, "Invalid database access mode")
+	fd = open (file_name, mode, BINARY_FILE)
+	goto 10
+
+entry dbreopen (db_old) 
+
+	fd = reopen (DB_FD(db_old), mode)
+
+	# Get DBIO descriptor
+10	call db_getdes (db)
+	DB_FD(db) = fd
+
+	# If the database is being created enter the dictionary in the file.
+	# If the database already exists read the current dictionary and
+	# check to see if the file is a database.
+	switch (mode) {
+	case NEW_FILE, TEMP_FILE:
+	    # Allocate dictionary space and enter it in the database.
+	    # The request entries is increased by one for the dictionary
+	    # database entry itself.
+	    nentries = db_nentries + 1
+	    call calloc (dic, nentries * LEN_DB_ENTRY, TY_STRUCT)
+	    DB_DIC(db) = dic
+	    call dbenter (db, "db_dictionary", LEN_DB_ENTRY * SZ_STRUCT,
+		nentries)
+	case READ_ONLY, READ_WRITE:
+	    # Read dictionary.
+	    call db_init (db, 1)
+	    dic = DB_DIC(db)
+	    nelem = dbread (db, "db_dictionary", Memi[dic], 1)
+	    if (nelem != 1)
+		call error (DB_ERRCODE + 1, "Error reading database dictionary")
+	    if (strne (DB_KEY(dic, 1), "db_dictionary"))
+		call error (DB_ERRCODE + 2, "File is not a database")
+
+	    nentries = DB_DIM(dic, 1)
+	    call db_init (db, nentries)
+	    dic = DB_DIC(db)
+	    nelem = dbread (db, "db_dictionary", Memi[dic], nentries)
+	    if (nelem != nentries)
+		call error (DB_ERRCODE + 3, "Error reading database dictionary")
+	}
+
+	return (db)
+end
+
+
+# DB_INIT -- Initialize the program dictionary space
+
+procedure db_init (db, db_nentries)
+
+pointer	db
+int	db_nentries
+
+pointer	dic
+
+long	note()
+errchk	mfree, calloc, seek
+
+begin
+	# Allocate dictionary memory
+	dic = DB_DIC(db)
+	if (dic != NULL)
+	    call mfree (dic, TY_STRUCT)
+	call calloc (dic, db_nentries * LEN_DB_ENTRY, TY_STRUCT)
+	DB_DIC(db) = dic
+
+	# Fill in dictionary entry
+	call strcpy ("db_dictionary", DB_KEY(dic, 1), SZ_DB_KEY)
+	DB_SZ_ELEM(dic, 1) = LEN_DB_ENTRY * SZ_STRUCT
+	DB_DIM(dic, 1) = db_nentries
+	call seek (DB_FD(db), BOF)
+	DB_OFFSET(dic, 1) = note (DB_FD(db))
+end
+
+# DBENTER -- Make a new entry in the database dictionary and reserve
+# file space in the database.
+
+procedure dbenter (db, record_name, sz_elem, nreserve)
+
+pointer	db				# DBIO descriptor
+char	record_name[SZ_DB_KEY]		# Record name string
+int	sz_elem				# Size of record element in CHARS
+int	nreserve			# Number of record elements to reserve
+
+int	i
+int	sz_reserve, sz_buf
+pointer	dic, buf
+
+bool	streq()
+int	fstati()
+long	note()
+
+errchk	calloc, dbclose, write, seek
+
+begin
+	# Check access mode
+	if (fstati(DB_FD(db), F_WRITE) == NO)
+	    call error (DB_ERRCODE + 4, "Database is read only")
+
+	# Find the last entry.  Check for attempts to redefine an
+	# entry and to overflow the dictionary.
+	dic = DB_DIC(db)
+	for (i = 1; i <= DB_DIM(dic, 1); i = i + 1) {
+	    if (DB_DIM(dic, i) == 0)
+		break
+	    if (streq (record_name, DB_KEY(dic, i)))
+		call error (DB_ERRCODE + 5, "Attempt to redefine dictionary entry")
+	}
+	if ((i > 1) && (i > DB_DIM(dic, 1)))
+	    call error (DB_ERRCODE + 6, "Database dictionary is full")
+
+	# Make dictionary entry
+	call strcpy (record_name, DB_KEY(dic, i), SZ_DB_KEY)
+	DB_SZ_ELEM(dic, i) = sz_elem
+	DB_DIM(dic, i) = nreserve
+	call seek (DB_FD(db), EOF)
+	DB_OFFSET(dic, i) = note (DB_FD(db))
+	DB_UPDATE(db) = YES
+
+	# Initialize file space to zero.  Zero file blocks for efficiency.
+	sz_reserve = sz_elem * nreserve
+	sz_buf = min (fstati (DB_FD(db), F_BLKSIZE), sz_reserve)
+	call calloc (buf, sz_buf, TY_CHAR)
+
+	while (sz_reserve > 0) {
+	    call write (DB_FD(db), Memc[buf], sz_buf)
+	    sz_reserve = sz_reserve - sz_buf
+	    sz_buf = min (sz_buf, sz_reserve)
+	}
+	call mfree (buf, TY_CHAR)
+end
+
+# DBACCESS -- Is data reference in the database?
+
+bool procedure dbaccess (db, record_name)
+
+pointer	db				# DBIO descriptor
+char	record_name[SZ_DB_KEY]		# Record name string
+
+int	i
+pointer	dic
+
+bool	streq()
+
+begin
+	dic = DB_DIC(db)
+	for (i = 1; i <= DB_DIM(dic, 1); i = i + 1) {
+	    if (DB_DIM(dic, i) == 0)
+		return (FALSE)
+	    if (streq (record_name, DB_KEY(dic, i)))
+		return (TRUE)
+	}
+	return (FALSE)
+end
+
+
+# DBNEXTNAME -- Return name of the next dictionary entry.
+
+int procedure dbnextname (db, previous, outstr, maxch)
+
+pointer	db				# DBIO descriptor
+char	previous[ARB]
+char	outstr[ARB]
+int	maxch
+
+int	i
+pointer	dic
+
+bool	streq(), strne()
+
+begin
+	dic = DB_DIC(db)
+	i = 1
+	if (strne (previous, "")) {
+	    for (; i <= DB_DIM(dic, 1); i = i + 1) {
+	        if (DB_DIM(dic, i) == 0)
+		    return (EOF)
+	        if (streq (previous, DB_KEY(dic, i)))
+		    break
+	    }
+	}
+	i = i + 1
+	if ((i > DB_DIM(dic, 1)) || (DB_DIM(dic, i) == 0))
+	    return (EOF)
+	else
+	    call strcpy (DB_KEY(dic, i), outstr, maxch)
+
+	return (OK)
+end
+
+
+#DBREAD - Read data from the database.
+# The number of data elements read is returned.
+
+int procedure dbread (db, ref, buf, maxelems)
+
+pointer	db			# Database file descriptor
+char	ref[ARB]		# Data reference
+char	buf[ARB]		# Data buffer
+int	maxelems		# Number of elements to be read
+
+int	i, j
+int	stat, sz_elem, index, nread
+long	offset
+pointer	dic
+
+int	strncmp(), strlen(), stridxs(), ctoi()
+bool	streq()
+int	read()
+errchk	read, dbclose
+
+begin
+	dic = DB_DIC(db)
+
+	# Decode the data reference and set the file offset and the size
+	# of the data element.  If a valid data reference is not found
+	# then a read status of 0 is returned.
+
+	j = stridxs ("[", ref)
+	for (i = 1; i <= DB_DIM(dic, 1); i = i + 1) {
+	    if (DB_DIM(dic, i) == 0)
+		call error (DB_ERRCODE + 7, "Database request not found")
+	    if (j == 0) {
+	        if (streq (ref, DB_KEY(dic, i)))
+		    break
+	    } else {
+		if (strlen (DB_KEY(dic, i)) == j - 1)
+		    if (strncmp (ref, DB_KEY(dic, i), j - 1) == 0)
+		        break
+	    }
+	}
+
+	offset = DB_OFFSET(dic, i)
+	sz_elem = DB_SZ_ELEM(dic, i)
+	nread = maxelems
+	if (j > 0) {
+	    j = ctoi (ref, j + 1, index)
+	    if (j > 0) {
+		if (maxelems > DB_DIM(dic, i) - index + 1) {
+		    call error (DB_ERRCODE + 8, "Database request out of bounds")
+		}
+		offset = offset + (index - 1) * sz_elem
+	    }
+	}
+
+	# Seek and read the data
+	call seek (DB_FD(db), offset)
+	stat = read (DB_FD(db), buf, sz_elem * nread) / sz_elem
+	return (stat)
+end
+
+
+# DBWRITE - Write data to the database.
+
+procedure dbwrite (db, ref, buf, nelems)
+
+pointer	db			# DBIO descriptor
+char	ref[ARB]		# Data reference
+char	buf[ARB]		# Data buffer
+int	nelems			# Number of elements to written
+
+int	i, j
+int	sz_elem, index, nwritten
+long	offset
+pointer	dic
+
+int	strncmp(), strlen(), stridxs(), ctoi()
+bool	streq()
+errchk	write, dbclose
+
+begin
+	dic = DB_DIC(db)
+
+	# Decode the data reference and set the file offset and the size
+	# of the data element.  If a valid data reference is not found
+	# then the data is not written and a write status of 0 is returned.
+
+	j = stridxs ("[", ref)
+	for (i = 1; i <= DB_DIM(dic, 1); i = i + 1) {
+	    if (DB_DIM(dic, i) == 0)
+		call error (DB_ERRCODE + 9, "Database request not found")
+	    if (j == 0) {
+	        if (streq (ref, DB_KEY(dic, i)))
+		    break
+	    } else {
+		if (strlen (DB_KEY(dic, i)) == j - 1)
+		    if (strncmp (ref, DB_KEY(dic, i), j - 1) == 0)
+		        break
+	    }
+	}
+
+	offset = DB_OFFSET(dic, i)
+	sz_elem = DB_SZ_ELEM(dic, i)
+	nwritten = nelems
+	if (j > 0) {
+	    j = ctoi (ref, j + 1, index)
+	    if (j > 0) {
+		if (nelems > DB_DIM(dic, i) - index + 1) {
+		    call error (DB_ERRCODE + 10, "Database request out of bounds")
+		}
+		offset = offset + (index - 1) * sz_elem
+	    }
+	}
+
+	# Seek and write the data
+	call seek (DB_FD(db), offset)
+	call write (DB_FD(db), buf, sz_elem * nwritten)
+	return
+end
+
+
+# DBCLOSE -- Update the dictionary in the database, close the database
+# and free DBIO descriptor.
+
+procedure dbclose (db)
+
+pointer	db
+
+begin
+	# Update dictionary in database
+	if (DB_UPDATE(db) == YES)
+	    call dbwrite (db, "db_dictionary", Memi[DB_DIC(db)],
+		DB_DIM(DB_DIC(db), 1))
+
+	call close (DB_FD(db))
+	call db_freedes (db)
+end
+
+
+# Procedures accessing the DBIO descriptor list.
+#
+# DB_GETDES  -- Allocate and return a DBIO descriptor.  Post error recovery.
+# DB_FREEDES -- Close a database and free allocated memory.
+# DB_ERROR   -- Take error recovery action by closing all open databases.
+
+procedure db_getdes (db)
+
+pointer	db			# Allocated DBIO descriptor
+
+extern	db_error()
+errchk	malloc()
+
+int	ndes			# Number of allocated DBIO descriptors
+pointer	dbdes[MAX_DB_DES]	# DBIO descriptor list
+
+common	/dbiocom/ ndes, dbdes
+
+int	init
+data	init/YES/
+
+begin
+	if (init == YES) {
+	    ndes = 0
+	    init = NO
+	}
+
+	# Check to see if the requested descriptor would overflow the descriptor
+	# list.  If not allocate memory for the descriptor otherwise
+	# start error handling.  On the first call post the error handler.
+
+	if (ndes == MAX_DB_DES)
+	    call error (DB_ERRCODE + 11, "Attempt to open too many database files")
+
+	ndes = ndes + 1
+	call malloc (dbdes[ndes], LEN_DB_DES, TY_STRUCT)
+	db = dbdes[ndes]
+	DB_FD(db) = NULL
+	DB_DIC(db) = NULL
+	DB_UPDATE(db) = NO
+
+	if (ndes == 1)
+	    call onerror (db_error)
+end
+
+
+# DB_FREEDES -- Close a database and free allocated memory.
+
+procedure db_freedes (db)
+
+pointer	db			# DBIO descriptor to be freed
+
+int	i
+
+int	ndes			# Number of allocated DBIO descriptors
+pointer	dbdes[MAX_DB_DES]	# DBIO descriptor list
+
+common	/dbiocom/ ndes, dbdes
+
+begin
+
+	# Locate the specified descriptor in the descriptor list.
+	# If the descriptor is not in the list do nothing.
+	# If the descriptor is in the list free allocated
+	# memory and remove the entry from the list.
+
+	for (i = 1; (i <= ndes) && (db != dbdes[i]); i = i + 1)
+	    ;
+	if (i > ndes)
+	    return
+
+	if (DB_DIC(db) != NULL)
+	    call mfree (DB_DIC(db), TY_STRUCT)
+	call mfree (db, TY_STRUCT)
+
+	if (i < ndes)
+	    dbdes[i] = dbdes[ndes]
+	ndes = ndes - 1
+end
+
+
+# DB_ERROR   -- Take error recovery action by closing all open databases.
+
+procedure db_error (error_code)
+
+int	error_code		# Error code
+
+int	i
+
+int	ndes			# Number of allocated DBIO descriptors
+pointer	dbdes[MAX_DB_DES]	# DBIO descriptor list
+
+common	/dbiocom/ ndes, dbdes
+
+begin
+	# Let fio_cleanup deal with the open files and the system
+	# restart deal with freeing the stack.  This procedure
+	# cleans up the dbio descriptors and updates the database
+	# dictionary.
+
+	do i = 1, ndes
+	    # Update dictionary in database.  Catch errors.
+	    if (DB_UPDATE(dbdes[i]) == YES)
+	        iferr (call dbwrite (dbdes[i], "db_dictionary",
+		    Memi[DB_DIC(dbdes[i])], DB_DIM(DB_DIC(dbdes[i]), 1)))
+	            call erract (EA_WARN)
+
+	    call db_freedes (dbdes[i])
+end
+
+
+int procedure dbgeti (db, key, type)
+
+pointer	db
+char	key[ARB]
+char	type[ARB]
+
+int	i
+pointer	dic
+
+bool	streq()
+
+begin
+	dic = DB_DIC(db)
+	for (i = 1; i <= DB_DIM(dic, 1); i = i + 1) {
+	    if (DB_DIM(dic, i) == 0)
+		call error (0, "Key not in database")
+	    if (streq (key, DB_KEY(dic, i)))
+		break
+	}
+	if (i > DB_DIM(dic, 1))
+	    call error (0, "Key not in database")
+	
+	if (streq (type, "r_len"))
+	    return (DB_DIM(dic, i))
+	else if (streq (type, "r_size"))
+	    return (DB_SZ_ELEM(dic, i))
+	else
+	    call error (0, "Unknown database key attribute")
+end
diff --git a/noao/twodspec/multispec/dbio/mkpkg b/noao/twodspec/multispec/dbio/mkpkg
new file mode 100644
index 00000000..f1aee503
--- /dev/null
+++ b/noao/twodspec/multispec/dbio/mkpkg
@@ -0,0 +1,9 @@
+# Multispec/dbio library.
+
+$checkout libpkg.a ../
+$update	  libpkg.a
+$checkin  libpkg.a ../
+
+libpkg.a:
+	dbio.x		dbio.h
+	;
diff --git a/noao/twodspec/multispec/doc/MSalgo.ms b/noao/twodspec/multispec/doc/MSalgo.ms
new file mode 100644
index 00000000..0c64e2b3
--- /dev/null
+++ b/noao/twodspec/multispec/doc/MSalgo.ms
@@ -0,0 +1,1032 @@
+.de FX
+.nf
+.ps -2
+.ss 25
+.cs R 25
+..
+.de EX
+.ps +2
+.ss
+.cs R
+.fi
+..
+.EQ
+delim $$
+.EN
+.RP
+.TL
+Algorithms for the Multi-Spectra Extraction Package
+.AU
+Francisco Valdes
+.K2
+.TU
+.AB
+The algorithms for the Multi-Spectra Extraction Package (\fBmultispec\fR)
+in the Image Reduction and Analysis Facility (\fBIRAF\fR) is described.
+The basic aspects of the general two dimensional aperture spectra extraction
+problem are first discussed.
+The specific algorithms for extraction of multi-aperture plate and
+Echelle digital data are presented.  Results of the authors experiments
+with this type of data are included.
+The detailed specification of the package is given in a second document,
+\fIDetailed Specifications for the Multi-Spectra Extraction Package\fB.
+.AE
+.NH
+Introduction
+.PP
+There are an increasing number of astronomical instruments which produce
+multiple spectra on a two dimensional detector.
+The basic concept is to use one dimension for wavelength,
+the dispersion dimension, and the other, the cross dimension, for
+packing additional information during a single exposure.
+For example, the cross dimension can be different objects or
+different spectral orders.  The classic multi-spectra instrument is
+the Echelle spectrograph.  New instruments are the aperture plate and
+Medusa spectrographs.
+.PP
+There is an additional aspect of the multi-spectra format; namely,
+the individual spectra can contain spatial data.  An example of
+this would be multiple slit spectra in which each slit spectra contains
+sky signal and object signal.  In the following
+discussion we limit the spectra to be simple aperture spectra in
+which we only desire to sum the intensities at each wavelength to form
+a one dimensional spectrum.
+.PP
+The analysis of multi-spectra aperture data consists of two steps; the
+separation and extraction into individual aperture spectra
+and the calibration and measurement of the spectra.  These steps can
+either be incorporated into one analysis package or two separate
+packages.  There are advantages to the first approach since some
+aspects of the individual spectra are directly related by the physical
+geometry of the multi-spectra format.  However, because packages for
+the analysis of individual spectra exist we begin by dividing the
+reduction into separate extraction and analysis tasks.  It is
+important to realize, however, that the existing analysis tools are not well
+suited to reducing the larger number of spectra and treating sets of
+spectra together.
+.PP
+The latter part of this paper describes the algorithms for the
+extraction of two types of data; the multi-aperture plate (MAP)
+and Echelle used with digital detectors.  However,
+it is important to keep the more general problem in mind
+and the remainder of this introduction considers the different
+conceptual aspects of the multi-spectra extraction task.
+Table 1 lists many of the general properties of multi-spectra aperture data.
+The other two columns give possible alternatives that each property may take.
+
+.TS
+center box;
+c s s
+c s s
+c c s
+= = =
+c || c | c.
+Table 1:  Aspects of Multi-Spectral Data
+
+Property	Alternatives
+detector	digital	photographic
+alignment	aligned	skewed
+blending	blended	unblended
+aperture	holes	slits
+spectral resolution	low	high
+.TE
+
+.PP
+The detector determines what kind of calibration procedures are
+required to produce intensity from the measurements.
+A digital detector requires sensitivity calibrations on all scales.
+This is the "flat field" problem.  There are also corrections for
+bias and dark current.  Photographic detectors require
+intensity calibration.  Data which are not aligned with the natural
+dimensions of the digital image require extra procedures.  Two types
+of non-alignment are a rotation of the dispersion dimension relative
+to the pixel dimension and a "wiggling" or "snaking" of the dispersion
+dimension.  Blending refers to the degree of contamination along the
+cross dimension.  Blended data requires extra effort to correct for
+the overlap between different spectra and to determine the background.
+The aperture defines the extent of the spectra in the cross dimension.
+The two most relevant choices are holes and slits.  In some
+instruments, like the Echelle, the size of the aperture can be varied
+at the time of the observations.  Finally, the spectral resolution is
+important in conjunction with digital detectors.  If the resolution is
+high then quartz flat field calibrations are relatively easy because
+the spectral
+signature need not be considered.  Otherwise, the flat field problem
+is more difficult because the gain variations of the detector
+must be separated from the natural spectral intensity variation of the
+quartz.
+.PP
+There is always some confusion of terms when talking about multi-spectra
+data; in particular, the terms x, y, line, and band.
+The image pixel dimensions are refered to as x and y.  We assume
+for the moment that the alignment of the multi-spectra format is such
+that x corresponds to the cross dimension and y to the dispersion
+dimension.  If this is not the case a rotation or interpolation
+program can be used to approximately orient the data in this way.
+A line is the set of intensity values as a function of x at constant y.
+In other words, a line is a cut across the dispersion dimension.
+A band is the average of more than one line.
+The image residing on disk will generally be organized
+such that x varies more rapidly and a line of the image is easily
+obtained.  In this form a display of the image will have the spectra
+running vertically.  In the Cyber extraction package the data is
+organized with x corresponding to the dispersion dimension.
+.NH
+Multi-Spectra Image Formats
+.PP
+The remainder of this paper will refer to two specfic and very
+different multi-spectra formats; the Kitt Peak Multi-Aperture Plate
+System and the Kitt Peak Echelle Spectrograph.
+.NH 2
+Kitt Peak Multi-Aperture Plate System
+.PP
+The reduction of data from multi-aperture plate observations is the 
+driving force for the development of a multi-spectra extraction
+package.  This application turns out to have most of the worse aspects
+of the properties listed in Table 1.  The multi-aperture plate spectrograph uses
+digital dectectors with low resolution, the spectra are blended and
+change alignment along the pixel dimension.  Furthermore, the camera
+has a variable point-spread function and focus,
+suffers from flexture problems, has a different illumination for
+the quartz than object exposures, and unexplained background level
+variations (in the CRYOCAM).  There are two detectors which have been
+used with the multi-aperture plate system, the Cryogenic Camera
+(CRYOCAM) and the High Gain Video Spectrometer (HGVS).
+.NH 2
+Echelle
+.PP
+As some of the algorithms were developed the Echelle data was brought
+to my attention.  It is considerably simpler than the MAP data because
+it is unblended and of high spectral resolution.
+Furthermore, the quartz exposure
+can be made wider than the object exposures and flexture is not a
+problem.  The principle problem in this data was the
+prevalence of cosmic rays.  It pointed to the need to maintain generality
+in dealing with both the MAP data and other types of
+multi-spectra data which have different profiles, may or may not be
+merged, and may or may not have different widths in quartz and object.
+Dealing with the cosmic ray problem lead to a very effective solution
+usable in both the Echelle and multi-aperture plate data.
+.NH
+User Level Extraction Logic
+.PP
+The user should generally only be concerned with the logical steps of
+extracting the individual spectra from the multi-spectra image.  This
+means that apart from specifying the detector system and the format
+he should not deal with details of the detector and the format.
+In the paper, 
+\fIDetailed Specifications for the Multi-Spectra Extraction Package\fB,
+the \fBIRAF\fR extraction package design and program specifications
+are described.
+.NH
+Flat Fields
+.PP
+There are two types of flat field situations depending on the spectral
+resolution.  When the resolution is high then the spectral signature of
+the continum calibration source, a quartz exposure, will be unimportant
+and variations in the signal will be due to detector sensitivity variations.
+In this case the quartz frame, or average of several frames, is the flat
+field and division of the object frames by the quartz frame is all that
+is required.  However, a special
+image division program is desirable to handle the region of low or absent
+signal between the the spectra.  This is described in section 4.2.
+.PP
+In the alternate case of lower resolution the quartz spectral signature is
+larger than the detector response variations.  A flat
+field in which the intrinsic quartz spectrum is removed is produced by
+assuming that the true value of a pixel is given by the smoothed average
+of the pixels near that point in position and wavelength and taking
+the ratio of the data value to the smoothed value.
+This requires a special smoothing program described in section 4.1.
+After the flat field is generated then the same image division
+program used for the Echelle data is applied.
+The image division and smoothing programs are general image operators and
+not specific to the Multi-Spectra Extraction Package.
+.NH 2
+MULTISPEC_FLAT
+.PP
+The multi-aperture plate data varies in both dimensions.  Thus, any averaging
+to smooth the image must take this variation into account.  In the Cyber
+a flat field for the multi-aperture plate data smooths across the dispersion
+by modeling the spectra.  This is a difficult task to do accurately because
+the true shape of the spectra is not known and the counts vary greatly
+and rapidly in this dimension.  This approach has the further difficulty
+that it is not possible to average several quartz exposures directly.
+.PP
+The alternate approach to modeling is statistical averaging.
+Averaging across the dispersion requires very high order polynomials
+because of the rapid variations;
+the spectra are typically spaced about 8 pixels apart and there are on
+the order of 50 spectra.  On the other hand, variations along the dispersion
+are much slower even if the spectra are slightly skewed; a bad case would
+have two peaks in 800 pixels along the y dimension.  This kind
+of variation is tractable with relatively simple averaging polynomials
+and is the one adopted for the multi-aperture plate data.
+.PP
+The flat fields are produced by a quadratic moving average along the
+y direction.  This means that the region centered at a given pixel
+is fitted by a least-squares quadratic polynomial and the value of the
+polynomial at that point is the appropriate statistical average.
+The width of the moving average is an adjustable parameter.
+At the edges of the frame where it is not possible to center a region of
+the specified width about the desired pixel the polynomial fit is used to
+extrapolate the average value to the edge.
+.PP
+Because the quadratic fit will
+be influenced by bad pixels an attempt is made to detect and smooth over
+the bad pixels.  This is accomplished by comparing the smoothed values to
+the observed values and ignoring pixels with a value of
+
+.EQ (1)
+	chi = | observed - smoothed | / sqrt smoothed
+.EN
+
+greater than a specified value.  Then the smoothing is recalculated and tested
+again for bad pixels.  This iteration continues until no further pixels
+are rejected.
+.PP
+Following the smoothing the flat field is produced by ratioing the raw quartz
+to the smoothed quartz.  Pixels of low signal (specified by the
+parameter \fIconstant\fR )
+are treated by the equation
+
+.EQ
+	r = (data + (constant - smoothed) ) / constant  .
+.EN
+
+The resultant flat field image is then divided into the object frames in
+the manner described in the next section.
+.PP
+Experience with data from the Cryogenic Camera has proved very good.
+The flat field which is produced can be examined on a display.  It
+shows fringing at red wavelengths and is not too strongly affected
+by bad pixels.  Some further effort, however, could go into smoothing
+over the bad pixels.
+.PP
+The smoothing operation on data from the Cryogenic Camera actually
+consists of four steps.  The quartz exposures are first averaged.
+The average quartz is rotated so that the dispersion
+direction is the most rapidly varying or x dimension.  Then the
+smoothing is performed along x followed by another rotation to return
+the flat field image to its original orientation.  The reason for the
+rotations is that they can be done quickly and efficiently whereas
+smoothing along the y dimension is very slow and coding an efficient
+version is much more complicated than doing a single line at a time.
+.NH 2
+FLAT_DIVIDE
+.PP
+The Echelle data has quartz frames which can be used directly as flat fields.
+One just has to divide the object frames by the quartz or average of several
+quartz.  However, in image division consideration has to be given the
+problem of division by zero or very small numbers.  In direct imaging this
+may not be much of a problem but in multi-spectra data the region between
+the spectra and near the edges of the spectra will have very low counts.
+Another aspect of image division for making flat field corrections is the
+scaling of the result.  The flat field integer image data must be large
+to give accurate relative response values.  However, one wants to divide
+an object frame by values near unity.
+This section describes a special image division operator allowing the user
+to specify how to handle these cases.
+.PP
+The parameters are a \fIdivision threshold\fR
+(default of zero) and a \fIthreshold violation value\fR.  Values of the
+denominator above the \fIthreshold\fR are treated separatedly from those
+below the \fIthreshold\fR.  The denominator image is scaled to have an
+average of one for pixels above the \fIthreshold\fR.  The pixel by pixel
+division is then performed for those points for which the denominator
+is above the \fIthreshold\fR.  Pixels for which the denominator is below the
+\fIthreshold\fR are set to the \fIthreshold violation value\fR in the resultant
+image if the \fIviolation value\fR is specified.  If the value is not
+specified then the numerator value is taken as the resultant value.
+The divisions can be done in place or the result put into a new image file.
+.PP
+For the multi-spectra situation where the object spectra have a
+smaller width than the quartz, as in the Echelle, one can either
+set the \fIthreshold
+violation value\fR to zero or not set it at all resulting in either
+exactly zero or background values between the spectra while still flattening
+the spectra.  This allows looking at the flattened spectra without the
+annoying "grass" between the spectra caused by dividing by small
+values.
+.NH
+Extraction
+.NH 2
+MULTIAP_EXTRACT
+.PP
+The extraction of spectra from multi-aperture plate images consists of
+a series of steps.  The steps are executed from a script.
+The command
+
+.FX
+ms> multiap_extract "ap165.*", "", 165, 50
+.EX
+
+will take the flattened images, ap165.*, from aperture plate 165 with 50
+spectra and automatically locate the spectra, model the profiles, and
+extract the one dimensional spectra.  The script consists of
+a number of steps as described below.
+.PP
+\fBFind_spectra\fR (section 6) initializes the \fBmultispec\fR data file
+and does a peak search to determine the initial positions of the
+spectra.
+\fBFind_bckgrnd\fR fits a polynomial of order 1 (or more) for the pixels which
+are not near the spectra as defined by \fBfind_spectra\fR.
+.PP
+The spectra are then modeled in bands of 32 lines by the model profiles
+described in section 8.1.  The first \fBmodel_fit\fR uses three Gaussian
+parameters for
+each spectra measuring the peak intensity, peak position, and width.
+The second \fBmodel_fit\fR adds a fourth parameter to modify the wings of the
+profile.
+.PP
+The \fBmodel_extract\fR program extracts the spectra line by line and also
+detects and removes cosmic ray events which do not fit the model
+profiles (see section 9).
+In outline, the extraction of blended spectral data uses the
+model profiles to determine the fraction of light
+from each of the neighboring spectra at the pixel in question.  The
+appropriate fraction of the
+.ul
+observed
+pixel intensity (minus the background) is
+assigned to the luminosities of the spectra.  There are two versions
+of the \fBmodel_extract\fR extraction.  The first simultaneously fits the
+peak intensity of all the spectra and the second uses the
+data value at the peak of each spectra to normalize the model.  The
+first method is slow and accurate and the second is fast and approximate.  
+Because the models are used in extraction only to define the relative
+contributions of neighboring spectra to the total observed pixel luminosity
+the speed of the approximate method far outweighs the need for
+accuracy.  However, cleaning the spectra of cosmic rays is a different
+matter and is discussed further in section 12.
+.PP
+After the extraction the spectra are correlated with the aperture plate
+description using \fBap_plate\fR (see Section 10) to determine the
+relative wavelength offsets and assign identification information to
+the spectra.
+.PP
+For successive frames it is not necessary to resort to the initial
+steps of finding the spectra and fitting from scratch.  The \fBcopy_params\fR
+routine makes a new copy of the fitting database.  Small shifts in positions
+of the spectra and the peak intensities are determined by doing a two
+parameter fit for the peak and position using the previously determined
+shape parameters.
+Changes in the shape of the spectra are then determined by the three
+and four parmater fits.  Because the solution is likely to be close to
+the previously determined shape the transfering of one solution from a
+previously solved image is faster than starting from scratch.
+Note that the shapes as well as the positions and peak intensities
+of all frames including the object exposures are allowed to change.
+.PP
+The spectra are then extracted from the image by \fBmodel_extract\fR and the
+process repeats for the succeeding images.
+.PP
+One useful feature is the ability to specify the bands or lines to be
+modeled or extracted.
+This feature is useful for diagnosising the programs quickly.
+The default is all bands or lines.
+.NH 2
+ECHELLE_EXTRACT
+.PP
+The extraction of the unblended Echelle spectra is performed
+begins in a similar way with \fBfind_spectra\fR and \fBfind_bckgrnd\fR.
+The extraction and cleaning, however, uses \fBstrip_extract\fR which
+adds up the instrumental counts for each unblended spectra at each
+wavelength to get the total luminosity.
+.NH
+FIND_SPECTRA -- Finding the Spectra
+.PP
+The first step in the extraction and processing of multi-spectra data is
+to locate the spectra.  This can be done interactively by
+the user but it is far preferable to automate the process;
+particularly since multi-spectra data can have a large number of
+spectra and frames.  The approach is to find the peaks in a line, or
+average of lines, sort the peaks found in some manner, such as by
+strength, and select the expected number of peaks from the top of the
+list.
+Beyond this simple outline are several algorithmic details such as how
+to define and locate valid peaks and how to sort the list of peaks.
+Peak finding is a general problem and a subroutine for peak finding is
+described below.  The \fBfind_spectra\fR program provides an
+interface between the \fBmultispec\fR data file and the
+general peak finding algorithm.
+.PP
+The \fBpeaks\fR function takes arrays of x (position) and y (value) points
+and the number of
+points in the arrays and returns the number of peaks found.  It also
+returns the estimated positions of the peaks in the x array and the
+extimated peak values in the y array in order of peak likelihood.
+There is one user parameter, the smoothing \fIwidth\fR.
+The choice of the \fIwidth\fR parameter is dicatated by how closely and how
+wide the peaks are to be expected.
+The algorithm takes a region of \fIwidth\fR points
+centered on each x point and fits a quadratic;
+
+.EQ
+y sub fit = a + b x + c x sup 2~.
+.EN
+
+A peak is defined
+when the slopes, $b sub 1$ and $b sub 2$, of two neighboring points
+$x sub 1$ and $x sub 2$ change
+sign from positive to negative and the curvatures, $c sub 1$ and $c
+sub 2$, are less than -0.001 for both points.
+The quadratic polynomials define two estimated peak positions
+
+.EQ
+x sub 1 sub peak = x sub 1 - b sub 1 / (2 * c sub 1 ),~~
+x sub 2 sub peak = x sub 2 - b sub 2 / (2 * c sub 2 )~.
+.EN
+
+The offsets are then normalized to give a linear interpolation
+fraction
+$f = ( x sub 1 sub peak - x sub 1 ) / ( x sub 2 sub peak - x sub 1 sub
+peak )$ in the interval between the two points.
+The estimated position of the peak is then
+
+.EQ
+x sub peak = f * ( x sub 1 - x sub 2 )
+.EN
+
+and the estimated peak value is the average value of the two quadratic
+polynomials at $x sub peak$.  The curvature at the peak is
+estimated by $c sub peak = c sub 1 + f * (c sub 1 - c sub 2 )$.
+Finally, the peaks are sorted by the magnitude of the peak curvature.
+.PP
+This peak finding algorithm works quite well.  I have also used it to
+automatically locate peaks in the extracted one dimensional spectra
+and then do peak correlations between spectra to find a relative
+wavelength solution.  Some such use of this program may be implemented
+in either future additions to the Multi-Spectra Extraction Package or
+the Spectral Reduction Package.
+.PP
+In \fBfind_spectra\fR the number of spectra to be found is specified by
+the user.  The user should have previously looked at an image
+on a display or done a profile plot across the
+dispersion to count the observed spectra.
+Additional parameters specify the columns in which the spectra
+are to be found and the minimum separation and width of the spectra.
+The column specification allows the elimination of problems with defective
+areas of the detector such as the LED in the Cryogenic Camera.  The minimum
+width and separation provide algorithmic constraints to the spectra finding
+procedure.
+.PP
+The peaks are found at two or more points in the
+multi-spectra image for a band of 32 lines using a
+\fBpeaks\fR \fIwidth\fR parameter of 5.  After the peaks are found
+at a number of bands in the image a linear fit is made to determine any small
+slope of the spectra relative to the columns.
+The reason for specifying only a few bands is that the process of
+finding the peaks is moderately slow and only two bands are needed for
+determining the initial position angle of the spectra to the y
+dimension.  Furthermore, some bands do not give a satisfactory result
+because of extraneous data such as the LED in the CRYOCAM or bad
+focus.  Another possibility is that a spectrum may go off the edge
+and in order to "find" the spectrum for partial extraction bands that
+include the on image part of the spectrum must be specified.
+.NH
+FIND_BCKGRND -- Background
+.PP
+The background on a multi-spectra image is the result of very broad
+scattering as opposed to the narrower scattering which produces
+distinguishable wings on individual spectra.
+Modeling of the background in a Cryogenic Camera multi-aperture plate
+image shows that the background is well explained by a broad
+scattering function.
+It is not reasonable, however, to model the scattering to this detail
+in actual extractions.
+Instead a smooth polynomial is fitted to the pixels not covered by
+spectra.  The order of the polynomial is a specified parameter.
+For the CRYOCAM MAP data a quadratic is appropriate.
+.PP
+The algorithm is the same for all multi-spectra data except for the
+choice of parameters.  First, the location of the spectra must be
+determined.  This is done by the \fBfind_spectra\fR program.  There
+are two principle parameters, a buffer distance and the order of the
+fitting polynomial.  Each line, or average of several lines, is fitted
+by least-squares for the points lying farther than the buffer
+distance from any spectra.  If there are no points which completely
+stradle the spectra, i.e. located on each side of the spectra, then
+the order of the fitting polynomial is ignored and a constant, or
+first order polynomial, is determined.
+A hidden parameter specifying the columns allowed for searching for
+background points is available so that bad parts of the image can be
+ignored.
+.PP
+A difference in philosophy with the Cyber programs is that the
+determined background is not subtracted from the image data.  It is
+instead kept in the database for the image.  Generally, it is better to
+modify the basic image data as little as possible.  This is the approach
+used in the Multi-Spectra Extraction Package.
+.NH
+Spectra Profiles
+.NH 2
+MODEL_FIT -- Models for Multi-Spectra Images
+.PP
+The object of modeling is to separate blended spectra for extraction
+and to remove artifacts, such as cosmic rays, which do not fit
+the model.  The models should have the minimum number of parameters
+which give residuals approaching the detector statistics, they
+should incorporate constraints  based on the physics of the
+detector/camera system,  and the models must be ammenable to a
+statistical fitting algorithm which is stable.
+There are a large number of possibilities.
+.PP
+An important point to bear in mind during the following discussion is
+the necessary accuracy of the model fitting.  In the design proposed
+here the model fitting is not used for determining the smooth quartz.
+Use of a model for making a flat field would require a very accurate
+model and using an average quartz is not possible.  However, for
+extraction the model is used only to indicate the
+relative fraction of light for each spectrum when the spectra are
+blended.  The cleaning application is more critical but not nearly so
+much as in the flat field modeling.  Thus, though we do a good job of
+model fitting (better the the Cyber modeling) some additional features
+such as smoothing along the spectra are not included.
+Also, though some improvement can be gained by the additional shape
+parameters in the fit, they are not necessary for the required purpose
+and can be left out leading to a faster extraction.
+.PP
+During the course of my investigation I tried more than one hundred
+models and combinations of constraints.  Some general results of this
+study follow.
+The model which I find gives the best results has six parameters not
+counting the background.  The model is defined by the following
+equations where x is the cross dimension.
+
+.EQ (1)
+I = I sub 0 exp (-s * ( DELTA x sup 2 ))
+.EN
+.EQ
+DELTA x = (x - x sub 0 )
+.EN
+.EQ
+s = s sub 0 + s sub 1 y sup 2 + s sub 2 y sup 3
+.EN
+.EQ
+y = DELTA x / sqrt { DELTA x sup 2 + x sub 1 sup 2 }
+.EN
+
+The model consists of a intensity scale parameter, $I sub 0$,
+and a profile which is
+written in a Gaussian form.  The center of the profile is given by
+the parameter $x sub 0$.  The profile is not exactly Gaussian because the
+scale, $s$, is not a constant but depends on $DELTA x$.  The scale
+function has three terms; a constant term, $s sub 0$, which is the scale
+near the center of the profile, and even and odd terms, $s sub 1$
+and $s sub 2$,
+which change the scale in the wings of the profile.
+.PP
+The characteristic of the profile which must be satisfied is that at
+large distances from the profile center the scale is positive.  This
+requirement means that the profile will be monotonically decreasing at
+large distances and will have a finite luminosity.  This point was
+crucial in determining the form of the scale function.  A straight
+power series in $DELTA x$ does not work because power series diverge.
+Instead, the scale function is defined in terms of a separation
+variable $y$ which is bounded by -1 and 1 at infinite separation and is
+zero at zero separation.  The parameter $x sub 1$ defines a characteristic
+distance where the character of $y$ changes from going as $DELTA x$ to
+asymptotic to 1.  The parameters are, thus, $I sub 0$, $x sub 0$, $s sub 0$,
+$s sub 1$, $s sub 2$, $x sub 1$.
+.PP
+An important property of this model is that the terms have a physical
+interpretation.  The profile scale and profile center are obvious and
+any model must include them.  It is the remaining terms, $s sub 0$,
+$s sub 1$, $s sub 2$,
+and $x sub 1$, which are called the shape parameters, which are interesting.
+In an ideal aperture plate system the shape of a profile would be
+given by the projection of the circular aperture into the cross dimension:
+
+.EQ
+P( DELTA x ) = sqrt {1 - a DELTA x sup 2}
+.EN
+
+where the constant a is related to the size of the hole by 
+
+.EQ
+a = 1 / r sup 2
+.EN
+
+For small $DELTA x$ the profile can be expressed in the Gaussian form with
+a scale
+
+.EQ
+s = a( 1/2  + a DELTA x sup 2 + ...)
+.EN
+
+Thus, even in a perfect aperture plate system a Gaussian form shows the
+scale increasing from a central value determined by the size of the hole.
+In other words, the profile decreases more sharply than a Gaussian.
+.PP
+However, no aperture plate system is ideal because the thickness of
+the aperture plate is finite and there is scattering and changes in
+the focus of the system.  One must
+convolve the profile above with a scattering/focus function.  One can show
+that for reasonable functions, exponential and Gaussian,
+with some scale b the final profile is a function of the ratio b/a.
+If the ratio is less than 1 then the profile will be more like that of
+the hole and the profile will be sharper than a Gaussian in the wings.
+If the ratio is much greater than 1 then the profile will become the
+scattering profile at large separations.  Simulations using Gaussian
+and exponential scattering profiles show behaviors very much like the
+profile (1) with $s sub 1$ greater than zero when b/a < 1
+meaning the profile becomes sharper (than a Gaussian) in the wings
+and $s sub 1$ < 0 when b/a > 1.
+Thus, $s sub 1$ defines the scale of the scattering profile relative
+to the hole size.
+The size of the hole is incorporated into the parameter $x sub 1$.
+The parameter $s sub 2$ allows an asymmetry in the profile.
+.PP
+An interesting property of the scale function is that it is all right
+for it to be negative at small distances from the profile center.  This
+occurs when $s sub 0$ is negative.  The effect of this, provided $s$
+becomes positive at large distances, is to give a two horned profile.
+This, in fact, is observed when the focus of the system becomes very
+poor.
+.PP
+The best fits (least chi-square or rms residual) are
+obtained when each spectrum at each wavelength has independent
+parameters.  However, this sometimes gives rise to unphysical results.
+If left entirely unconstrained the parameter fitting algorithm can
+make one line broad and dominant and a neighboring line weak and
+sharp.
+This is not, of course, a property of the camera or detector.
+Thus, constraints based on the physics of the
+camera/detector are used.  This means that the shape
+parameters $s sub 0$, $s sub 1$, $s sub 2$, and $x sub 1$
+are coupled locally by making them vary as a polynomial of position
+across the dispersion.  One might also
+constrain the variation of the shape along the spectrum as is done in
+the Cyber.  This is not needed because there are no drastic differences
+between the fitted parameters at neighboring points along the spectra.
+.PP
+My experience with the Cyrogenic Camera system has shown the
+following.  The focus ripples twice across the CCD with the
+propagation angle being approximately 30 degrees from the long dimension.
+The change in focus is partly just a scale change.  This is seen in
+the correlation of $s sub 0$ with the image scale found by \fBap_plate\fR.
+The shape parameter $s sub 1$ changes sign from positive to
+negative indicating that when the focus is good the profile
+decreases faster than a Gaussian and when the focus is bad it decreases
+slower.  Occassionally the focus is very bad and $s sub
+0$ is negative and $s sub 1$ is small and positive causing a broad two
+horned profile.  The
+assymetry parameter, $s sub 2$, is useful only when the signal is strong near
+the peak of a quartz exposure.  It is not really necessary to include
+it in the model fits.  The assymetry parameter was dominant, however,
+in some Echelle data which were clearly asymmetric.  The value of
+$x sub 1$ is
+not highly sensitive and can be fixed for a given hole size.  Large
+changes in the hole size would require resetting $x sub 1$.
+The use of the four parameters, $I sub 0$, $x sub 0$, $s sub 0$,
+and $s sub 1$, allow good fits
+to all the data I've examined including those in which the peak/valley
+intensity ratio across the spectra is about 1.1.  It is the importance
+of the parameter $s sub 1$ which improves the fitting dramatically over the
+Cyber three parameter fitting (in addition to a different fitting
+algorithm).
+.PP
+The heart of profile fitting is the solution of the multi-parameter
+least-squares problem.  In a blended multi-spectra image the profile
+parameters of one spectra are affected by its neighbors which are,
+in turn, affected by their neighbors and so forth.  The key to this
+type of problem is to realize that only nearest neighbors affect the
+profile parameters and this leads to a "banded" least-squares matrix.
+A banded matrix is one in which cross terms far from the diagonal are
+zero.  Solution of banded matrices is much more efficient than solving
+the entire matrix.  This allows solution for more than 100 parameters
+simultaneously in a short time.
+.PP
+Use of the banded multi-parameter solution has the restriction, however,
+that there can be no parameters in the model which are not local to
+the profiles.  This affects the way
+global constraints are applied to the parameters.  In particular,
+the way the shape parameters are constrained to vary smoothly across the
+detector.
+The shape parameters are first found as independent parameters by the
+banded matrix solution and then smoothed by a polynomial in x.
+.PP
+An area which was extensively investigated was the appropriate
+weighting to use for the model fitting.  The most likely choices are
+weighting by $1 / sqrt data$ and unit weight corresponding to
+$chi sup 2$
+and least squares fitting.  It was found that the two methods
+agreed fairly closely but that the least squares fitting was more
+appropriate because the blending correction depends largely on the
+value of the peak intensity and less on the exact fit of the wings.
+With $chi sup 2$ the peak is fit with less accuracy in order to improve
+the fit in the wings of the profile.  In some cases this gave clear
+errors in estimating the peak intensity and, hence, the proper contributions
+between the blended spectra were not made.
+.PP
+Now follows the details of the fitting algorithm.
+The algorithm is a series of script steps in \fBmultiap_extract\fR
+which call the model fitting program \fBmodel_fit\fR with different
+parameters.  In the script all bands are fit, $x sub 1$ is fixed,
+and the asymmetry shape parameter $s sub 2$ is ignored.
+The four parameter fit is applied to bands of 32 lines.  The band
+solutions are linearly interpolated to the full image and then only
+the intensity scale parameter is calculated for each line during the
+extraction of the spectra with \fBmodel_extract\fR.
+.PP
+The general fitting scheme proceeds as follows:
+.LP
+1.  Fit the three parameters $I sub 0$, $x sub 0$, $s sub 0$ with
+$x sub 1$ fixed and $s sub 1$ and $s sub 2$
+zero.  This is precisely a Gaussian fit.  The three parameters are
+determined simultaneously for all the lines at once using the banded
+matrix method.  Thus for 50 lines the solution has 150 variables.
+After each fit the scale
+parameter $s sub 0$ is smoothed by a polynomial in x.  The polynomial is
+taken with seven terms.
+.LP
+2.  Once the improvement in each iteration becomes less than a
+specified amount (2% in rms residual) the next parameter $s sub 1$ is added.
+The solution has two steps: fit for $s sub 0$ and $s sub 1$ with $I sub 0$
+and $x sub 0$ fixed and
+then fit $I sub 0$ and $x sub 0$ with $s sub 0$ and $s sub 1$ fixed.  As before the scale terms
+are smoothed by a seventh order polynomial.  Attempts to solve for all
+four parameters a once gave unstable results for reasons I don't
+understand.
+.LP
+3.  If desired, the last shape parameter $s sub 2$ can be added by solving
+for $s sub 0$, $s sub 1$, and $s sub 2$ while holding $I sub 0$ and
+$x sub 0$ fixed and then solving for
+$I sub 0$ and $x sub 0$.  This provides some improvement when the signal is very
+strong but is generally not needed in the multi-aperture plate data.
+It can be an important term in the Echelle data.
+.LP
+4.  It is possible to then adjust $x sub 1$ followed by steps 2 or 3.
+However, this gives very little improvement and $x sub 1$ should be fixed for
+each type of data.
+.LP
+5.  During the final extraction when individual lines are evaluated a one
+parameter fit is used to find $I sub 0$ for each spectra.  This is
+rather slow, however, on the order of 3 hours per frame.  By using
+the pixel value near $x sub 0$ as the value for $I sub 0$ the extraction is reduced
+to 13 minutes per frame (see section 12).
+.PP
+In addition to the preceeding steps the fitting algorithm applies some
+heuristic constraints.  These constraints limit how far the peak positions can
+shift in each iteration, require the peak intensity to remain positive, and
+limit the scale function to be positive at large values of y.
+.NH 2
+STRIP_EXTRACT -- Unblended Profiles
+.PP
+For unblended multi-spectra data the profiles can be anything.  The profiles
+are obtained by averaging a number of lines (say 32) and normalizing
+at some point like the peak value.  These profiles are then used for
+detecting bad pixels, such as cosmic rays, and correcting for them as
+discussed in the section on cleaning.  Modeling using the \fBmodel_fit\fR
+program is only used on Echelle data to find peak positions
+accurately in order to follow any curvature of the spectra.
+.NH
+Extraction and Cleaning
+.PP
+The extraction of spectra are done separately from the modeling.  It is
+possible to extract spectra without any modeling at all using
+\fBstrip_extract\fR.  The extraction step also allows the user to specify
+if cleaning of the spectra for cosmic rays is desired.  Also modifying
+the image is an option.
+.NH 2
+MODEL_EXTRACT
+.PP
+Extraction and cleaning using a model fit is described here.
+First the $I sub 0$ values for the model profiles are determined for
+all the spectra in a line either by multi-parameter fitting or by
+taking the peak value.  The pixel values are then compared to the
+model in a chi-squared way:
+
+.EQ
+r = (data - model) / sqrt model
+.EN
+
+If the value of r is larger than a set amount, say 5, then the pixel
+value is set to that of the model.  Since the "bad" pixel may affect
+the intensity scale $I sub 0$ the cleaning is iterated until no further
+pixels are changed.
+.PP
+The fitting of the data from an individual line of data to the model profiles
+is the key element in this scheme.  The best method is to use all the
+data in a multi-parameter least square fit.  This minimizes the effect
+of bad pixels on the estimated profile which is the essence of this
+cleaning method.  However, while the time required to do this for one
+line is not great, it adds up to nearly three hours for the 800 lines
+in a CRYOCAM frame.  A quick alternative is to scale the model profile
+by the data value at the peak position.  This is
+quite fast.  However, if the peak has a cosmic ray event or is
+otherwise bad then the estimated profile will not correspond closely
+to the data profile and the cleaning procedure will make gross errors.
+The limited experience I've had with the Echelle and MAP data
+has worked well with using the peak estimate.  However, the possible
+problems make me nervous and some compromise based on using more than
+the peak to estimate the intensity scale of the profile to the data
+needs to be found.  This is important because much of the feedback on
+the \fBmultispec\fR package from Paul Hintzen and Caty Pilachowski
+have dealt with
+the particular usefulness of a good cosmic ray cleaning algorithm in
+extracting multi-spectra data.
+.NH 2
+STRIP_EXTRACT
+.PP
+Removing cosmic rays is the major part of Echelle extraction.
+Because these are unblended spectra of arbitrary shape a strip
+extraction is all that is needed.
+The cleaning is done by the same algorithm used for the multi-aperture
+plates except that the profiles are found, as described earlier, by
+averaging a number of lines.
+The intensity scaling is determined from either a least-square fit
+or the peak value.
+The same question about the appropriate way to
+determine the fit of the profiles to the data discussed previously
+applies here except since the spectra are not blended the spectra
+can be treated separately in any least square fitting.
+.NH
+AP_PLATE -- Aperture Plate Correlation
+.PP
+The final step in the extraction of a multi-aperture plate image is to
+correlate the spectra with the on-line database description of the 
+drilled hole positions.  This allows for estimates of relative wavelength
+offsets and the identification of the spectra with the ID, RA, and DEC
+parameters.
+.PP
+The spectra are fitted to the known aperture plate drilled positions, given in
+millimeters, to find an \fIangle\fR for the aperture plate relative to the
+detector x dimension and the image \fIscale\fR in pixels / millimeter,
+
+.EQ
+x sub fit = a + scale (x sub drill cos (angle) + y sub drill sin (angle))~.
+.EN
+
+If the number of spectra is less than that given by the aperture plate drilled
+positions then a correlation is done leaving out sequences of
+consecutive holes until the fit residual is minimized.  If the number of
+spectra is greater than that supposedly drilled then sequences of
+consecutive peaks are left out of the fit to minimize the residual.
+The missing holes or extra peaks are printed out and, if allowed, the aperture
+plate description file is modified, otherwise the program terminates.
+In all cases if the final fit residual is greater than 1
+pixel the program will terminate.
+The program prints out the \fIangle\fR of the aperture plate and the \fIscale\fR
+which is also stored in the database.
+.PP
+An indication that a large part of the focus variation is purely a
+scale change is that the derived image \fIscale\fR correlates very well with
+the width of the spectra as derived from the profile fitting.  I
+estimate that at least 50% of the focus variation is a scale
+variation.  This is good news in the sense that a scale variation will
+be taken out in the dispersion solution and lines in different parts
+of the detector will become more similiar after the solution.
+However, the scale variation does not account for all the profile
+shape changes and there is indeed a change in the point spread function
+across the detector.
+.NH
+Problems
+.PP
+There a few problems which I have not been able to resolve or have not
+had the time to consider.  The problems which are largely intractable
+without a great deal of effort are the unexplained background
+variations and deconvolving the spectra for the variation in the
+point-spread-function.  The background variations are abrupt increases
+in the background in parts of the CRYOCAM detector.  The step edge sometimes
+occurs under the spectra and so any smooth polynomial fit to the
+background will not be very good.  The modeling of the multi-aperture
+plate profiles provides information about the point-spread function
+but a deconvolution of the variation in the PSF is a difficult problem
+and not warrented at this time.
+.PP
+I had expected that the large scale response of the CRYOCAM could be
+corrected by determining an overall average quartz spectrum from all the
+extracted quartz spectra and then dividing the object spectra in each
+hole by the ratio of the average quartz spectra from that hole to the
+overall average quartz spectrum.  This was attempted and it was found
+to work only partially.  Specifically, while there might be a 20%
+difference between a spectrum on the edge and one near the center of
+the detector the quartz correction left a 10% difference in the object
+spectra.  This is apparently due to a poor illumination by the quartz
+light source which does not correspond to the telescope illumination.
+This quartz correction technique may be made available to users if
+desired.
+.NH
+Comparison with the Cyber Extraction Package
+.PP
+The discussion of this section must be qualified by the fact that I
+have not used the Cyber Extraction Package and I base my understanding on the
+algorithms from the Multi-Aperture Plate Data Reduction Manual and
+conversations with knowledgable people.  There are many differences
+both major and minor and this section only seeks to mention the
+some of the important differences.  In the Cyber package:
+
+The background is subtracted from the images as a preliminary process.
+
+The background is either constant or linear across the spectra.
+
+The flat fields are produced by modeling the quartz and data from
+several quartz exposures cannot be easily combined.
+
+The initial peak finding and aperture plate correlation algorithm is less
+automated in determining missing or additional holes.
+
+The model fitting uses only a three parameter Gaussian model
+and the algorithms do not yield results when the focus becomes poor.
+
+The fitting algorithm is neighbor subtraction rather than full
+simultaneous solution for all the profiles.
+
+The model fitting is applied only to a quartz and the model is transfered to
+object exposures.  This does not allow the shape of the profiles to
+change with time as the telescope moves.
+
+The modelling does not couple solutions for neighboring spectra
+across the dispersion as is suggested in this design and it does smooth
+along the spectra which is not done in this proposal.
+
+The extraction is only to some specified sigma in the model profile and
+there is no attempt to correct for blending.
+
+There is no cleaning of the spectra.
+.NH
+Discussion
+.PP
+The only data which has passed beyond the extraction phase using the
+algorithms described here was that of Paul Hintzen.
+Comparison of data reduced by the TV package for
+spectra extracted by both the Cyber package and the techniques of the
+suggested \fBmultispec\fR package were quite comparable.  To the level he
+examined
+the spectra there was no clear increase in accuracy though the \fBmultispec\fR
+extractions generally had higher counts due to the full extraction of
+the blended spectra.  The big advantages found were
+the ability to extract all the data even when the focus
+became very poor and the success of the cosmic ray cleaning
+algorithm.  Thus, Hintzen feels that the need for speed in the extraction
+(primarily dependent on the cleaning algorithm)
+is modified significantly by the difficulty of dealing with cosmic
+rays in the TV spectral analysis programs.  More exploration
+of techniques for determining the profile intensity scale from the
+model without the full multi-parameter solution is warrented for this
+reason.
+.PP
+I have extracted some Echelle data including field flattening.  The
+data had a considerable number of cosmic rays which were removed
+quite well.  The extracted spectra were put into a CAMERA format
+for further analysis.
+.PP
+The programs were recently applied to a long slit analysis problem
+being studied by Vesa Junkkarinen.  The image was already flat fielded.
+The data had two closely spaced and very faint diffuse objects and scattered
+light from a nearby QSO.
+The three spectra were so weak and closely spaced
+that the automatic finding was not used.  However, the rest of the modeling
+and extraction were applied directly.
+The \fBfind_bckgrnd\fR program, whose original purpose was to correct for
+scattered light, worked well to extrapolate the sky across the
+image.  The model fitting accurately followed
+the peaks of the spectra but the shape fitting was only moderately accurate
+since the model shape parameters are not suited to modeling galaxies.
+It successfully extracted spectra with a minimum of effort on my part.
+Analysis of the extracted spectra and comparison with other techniques
+must still be done.  The conclusions to be drawn from this experiment are
+that with sufficiently general multi-spectra tools multiple objects in
+long slit spectroscopy can be handled.
+.PP
+One area in which I do not have practical experience is
+the extraction of HGVS data.  I believe
+the proposed design will work on this type of data.
+.PP
+A point which needs to be considered in the final design are the
+formats of the data files.  The currently used one dimensional spectra
+formats are an IIDS format and a CAMERA image format.
+The formating of data files for the current spectral analysis packages by
+\fBto_iids\fR starts from the \fBmultispec\fR database and throws away a lot 
+of information about the spectra.  
+Some refinement of this database should focus on the format
+to be used by a new \fBIRAF\fR spectral analysis package.
+.PP
+It should be pointed out that many of the operations can have
+alternate algorithms substituted.  In particular, the smoothing
+algorithm for the multi-aperture plate flat fields can be replaced by
+some other scheme.  The links between the multi-parameter fitting
+program and the model have been made very general for investigating
+a broad range of models.  Thus, it is also possible to substitute
+additional model profiles with relative ease.
+.PP
+Estimates of excution time are taken from the experimental C programs
+implementing the algorithms of this design and they are only
+approximate estimates.  The steps corresponding
+to \fBdebias\fR, \fBmultispec_flat\fR, and \fBflat_divide\fR for
+the multi-aperture data from the CRYOCAM take
+about 1 hour for a typical set of frames, say 5 to 15.  This includes
+debiasing, triming, computing a flat field from several quartz frames
+and dividing the quartz into the object frames.
+.PP
+The CRYOCAM \fBmultiap_extract\fR phase takes about 40 minutes for the modeling of a frame using 32 lines per band and either 3 hours for an extraction
+using the profile fitting
+method or 14 minutes for extraction using the peak profile scaling
+method.
+.PP
+Finally, the \fBto_iids\fR takes about 3 minutes per frame.  It takes
+this long because it has to convert the \fBmultispec\fR database organized across
+the dispersion into formats in which the data is stored as consecutive
+spectra; i.e. a type of rotation operation.
diff --git a/noao/twodspec/multispec/doc/MSalgo_c.doc b/noao/twodspec/multispec/doc/MSalgo_c.doc
new file mode 100644
index 00000000..b3322dff
--- /dev/null
+++ b/noao/twodspec/multispec/doc/MSalgo_c.doc
@@ -0,0 +1,522 @@
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+         Algorithms for the Multi-Spectra Extraction Package
+                       Analysis and Discussion
+                           December 2, 1983
+
+
+
+1. Disclaimer
+
+    This  should  not  be  taken as a statement of how the algorithms of
+the final package should  function;  this  is  merely  an  analysis  and
+discussion  of  the  algorithms,  and  should  be  followed  by  further 
+discussion  before  we  decide  what  course  to  follow  in  the  final 
+package.   We  may very well decide that the level of effort required to
+implement  rigorously  correct  nonlinear  fitting  algorithms  is   not 
+justified  by  the  expected scientific usage of the package.  Before we
+can decide that, though, we need an accurate estimate of  the  level  of
+effort required.
+
+In  attacking  nonlinear  surface  fitting  problems  it is important to
+recognize that almost any techniques can  be  made  to  yield  a  result
+without  the  program crashing.  Production of a result (extraction of a
+spectrum)  does  not  mean  that  the  algorithm  converged,  that   the 
+solution   is   unique,   that  the  model  is  accurate,  or  that  the 
+uncertainties in the computed coefficients have been minimized.
+
+
+
+2. Multispec Flat (pg. 4)
+
+    This sounds like a classical high pass  filter  and  might  be  best
+implemented  via  convolution.   Using  a  convolution  operator  with a
+numerical kernel has  the  advantage  that  the  filter  can  be  easily
+modifed  by  resampling  the  kernel  or  by  changing  the  size of the
+kernel.  It is also quite efficient.   The  boundary  extension  feature
+of  IMIO  makes  it  easy  to  deal  with  the  problem  of  the  kernel 
+overlapping  the  edge  of  the  image  in  a  convolution.   Since  the 
+convolution  is  one-dimensional  (the  image is only filtered in Y), it
+will always be desirable to transpose the image.
+
+The method used to detect and reject bad pixels (eqn 1) is not  correct.
+The  rejection  criteria  should  be invariant with respect to a scaling
+of  the  pixel  values.   If  the  data  has  gone  through  very   much 
+processing  (i.e.,  dtoi  on  photographic  data),  the relation between
+photon  counts  and  pixel  value  may  be  linear,  but  the  scale  is 
+unknown.   Rejection  by  comparison  of  a  data  value to a "smoothed"
+value is more commonly done as follows:
+
+        reject if:  abs (observed - smoothed) > (K * sigma)
+
+where sigma is the noise sigma of the  data,  generally  a  function  of
+the signal.
+
+It  is  often  desirable  in rejection algorithms to be able to specify,
+
+
+                                  -1-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+as an option, that all pixels within a specified radius of a  bad  pixel
+be  rejected,  rather  than  just the pixel which was detected.  This is
+only  unnecessary  if  the  bad  pixels  are  single  pixel  events  (no 
+wings).   Region  rejection makes an iterative rejection scheme converge
+faster, as well  as  rejecting  the  faint  wings  of  the  contaminated
+region.
+
+
+
+2.1 Dividing by the Flat (pg. 5)
+
+    There  is  no  mention of any need for registering the flat with the
+data field.  Is it safe  to  assume  that  the  quartz  and  the  object
+frames  are  precisely  registered?   What  if  the  user  does  in fact
+average several quartz frames taken  over  a  period  of  time?   (Image
+registration  is  a  general  problem  that  is probably best left until
+solved in IMAGES).
+
+
+
+3. Multiap Extraction (pg. 5-6, 8-13)
+
+    The thing that bothers me most about  the  modeling  and  extraction
+process  is  that  the  high  signal  to noize quartz information is not
+used  to  full  advantage,  and  the  background  is  not  fitted   very 
+accurately.   The  present  algorithms will work well for high signal to
+noise data, but will result  in  large  (percentage)  errors  for  faint
+spectra.
+
+Basically,  it  seems to me that the high signal to noise quartz spectra
+should, in many cases, be used to determine the position  and  shape  of
+the  spectral  lines.   This  is  especially attractive since the quartz
+and spectra appear  to  be  closely  registered.   Furthermore,  if  the
+position-shape   solution   and   extraction   procedures  are  separate 
+procedures, there is nothing to prevent one from applying  both  to  the
+object  spectum  if  necessary for some reason (i.e., poor registration,
+better signal  to  noise  in  the  object  spectrum  in  the  region  of
+interest,  signal  dependent  distortions, lack of a quartz image, etc.,
+would all justify use of the object frame).  It should  be  possible  to
+model  either  the  quartz or the object frame, and to reuse a model for
+more than one extraction.
+
+Let  us  divide  the  process  up  into  two  steps,   "modeling",   and 
+"extraction"  (as  it  is  now).   The  "calibration  frame"  may be the
+quartz, an averaged quartz, or the object frame.  Ideally it  will  have
+a  high  signal  to  noise ratio and any errors in the background should
+be negligible compared to the signal.
+
+We do not solve  for  the  background  while  modeling  the  calibration
+frame;  we  assume  that  the  background  has  been  fitted by any of a
+variety  of  techniques  and  a  background  frame  written  before  the 
+calibration  frame  is  modeled.   A  "swath"  is the average of several
+image lines, where an image line  runs  across  the  dispersion,  and  a
+
+
+                                  -2-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+column along the dispersion.
+
+
+
+3.1 Modeling
+
+    I  would  set  the thing up to start fitting at any arbitrary swath,
+rather than the first swath, because it not much harder,  and  there  is
+no  guarantee  that  the  calibration frame will have adequate signal to
+noise in the first swath (indeed often the lowest signal to  noise  will
+be  found  there).   We  define the "center" swath as the first swath to
+be fitted, corresponding to the highest signal to noise  region  of  the
+calibration  frame.   By  default  the  center swath should be the swath
+used by find_spectra, especially if there is  significant  curvature  in
+the spectra.
+
+algorithm model_calibration_frame
+
+begin
+        extract center swath
+        initialize coeff using centers from find_spectra
+        model center swath (nonlinear)
+
+        for (successive swaths upward to top of frame) {
+            extract swath
+            initialize coeff to values from last fit
+            model swath (nonlinear)
+            save coeff in datafile
+        }
+
+        set last-fit coeff to values for center swath
+        for (successive swaths downward to bottom of frame) {
+            extract swath
+            initialize coeff to values from last fit
+            model swath (nonlinear)
+            save coeff in datafile
+        }
+
+        smooth model coeff (excluding intensity) along the dispersion 
+            [high freq variations in spectra center and shape from line]
+            [to line are nonphysical]
+        variance of a coeff at line-Y from the smoothed model value is
+            a measure of the uncertainty in that coeff.
+end
+
+
+I   would  have  the  background  fitting  routine  write  as  output  a 
+background frame, the name of which would  be  saved  in  the  datafile,
+rather  than  saving  the  coeff  of  the  bkg fit in the datafile.  The
+background  frame  may  then  be  produced  by  any  of  a   number   of 
+techniques;  storing  the  coefficients  of  the bkg fit in the datafile
+limits the technique used to a particular model.  For  similar  reasons,
+the  standard  bkg  fitting  routine  should  be broken up into a module
+
+
+                                  -3-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+which determines the region to be fitted, and a module  which  fits  the
+bkg pixels and writes the bkg image.
+
+For  example,  if  the  default  background fitting routine is a line by
+line  routine,  the  output  frame  could  be  smoothed  to  remove  the 
+(nonphysical)  fluctuations  in  the  background  from  line to line.  A
+true two dimensional background  fitting  routine  may  be  added  later
+without   requiring   modifications   to  the  datafile.   Second  order 
+corrections could be made to the background by  repeating  the  solution
+using the background fitted by the extraction procedure.
+
+
+procedure extract_swath
+
+begin
+        extract raw swath from calibration frame
+        extract raw swath from background frame
+        return (calib swath minus bkg swath)
+end
+
+
+The  algorithm  used to simultaneously model all spectra in a swath from
+across the dispersion is probably the most difficult and time  consuming
+part  of  the  problem.   The problem is nonlinear in all but one of the
+four or more parameters for each spectra.   You  have  spent  a  lot  of
+time  on  this  and  we  are probably not going to be able to improve on
+your algorithms significantly, though the generation of  the  matrix  in
+each step can probably be optimized significantly.
+
+The  analytic  line-profile  model  is  the most general and should work
+for  most  instruments  with  small  circular  apertures,  even  in  the 
+presence  of  severe  distortions.   It  should be possible, however, to
+fit a simpler model given by  a  lookup  table,  solving  only  for  the
+position  and  height  of  each spectra.  This model may be adequate for
+many instruments, should be must faster to fit,  and  may  produce  more
+accurate  results  since  there  are  fewer  parameters in the fit.  The
+disadvantage of an  empirical  model  is  that  it  must  be  accurately
+interpolated  (including  the  derivatives),  requiring  use  of  spline 
+interpolation or a similar technique (I have  tried  linear  and  it  is
+not  good  enough).  Vesa has implemented procedures for fitting splines
+and evaluating their derivatives.
+
+Fitting the empirical model simultaneously  to  any  number  of  spectra
+should  be  straightforward  provided the signal to noise is reasonable,
+since there are few parameters in the  fit  and  the  matrix  is  banded
+(the  Marquardt  algorithm  would work fine).  However, if you ever have
+to deal with data where a very faint or nonexistent spectra is  next  to
+a  bright  one,  it  may  be difficult to constrain the fit.  I doubt if
+the present approach of smoothing the coeff across  the  dispersion  and
+iterating  would  work  in  such  a case.  The best approach might be to
+fix the center of the faint spectra relative  to  the  bright  one  once
+the  signal  drops  below  a  certain  level, or to drop it from the fit
+entirely.  This requires that the matrix be able to change  size  during
+
+
+                                  -4-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+the fit.
+
+algorithm fit_empirical_model
+
+begin
+        [upon entry, we already have an initial estimate of the coeff]
+
+        # Marquardt (gradient expansion) algorithm.  Make 2nd order
+        # Taylor's expansion to chisquare near minimum and solve for
+        # correction vector which puts us at minimum (subject to
+        # Taylor's approx).  Taylor's approximation rapidly becomes
+        # better as we near the minimum of the multidimensional
+        # chisquare, hence convergence is extremely rapid given a good
+        # starting estimate.
+
+        repeat {
+            evaluate curvature matrix using current coeff.
+            solve banded curvature matrix 
+
+            compute error matrix
+            for (each spectra)
+                if (uncertainty in center coeff > tol) {
+                    fix center by estimation given relative spacing
+                        in higher signal region
+                    remove spectra center from solution
+                }
+
+            if (no center coeff were rejected)
+                tweak correction vector to accelerate convergence
+            new coeff vector = old coeff vector + correction vector
+            compute norm of correction vector
+        } until (no more center coeff rejected and norm < tolerance)
+
+        compute final uncertainties
+end
+
+
+The  following  is  close  to what is currently done to fit the analytic
+model, as far as  I  can  remember  (I  have  modified  it  slightly  to
+stimulate  discussion).   The  solution  is  broken up into two parts to
+reduce the number of free parameters and  increase  stability.   If  the
+uncertainty  in  a  free  parameter  becomes large it is best to fix the
+parameter (it is particularly easy for this data  to  estimate  all  but
+the  intensity  parameter).   A fixed parameter is used in the model and
+affects the solution but is not solved for (i.e., like the background).
+
+The analytic fit will  be  rather  slow,  even  if  the  outer  loop  is
+constrained  to  one  iteration.   If it takes (very rough estimates) .5
+sec to set up the banded matrix and .3 sec to  solve  it,  3  iterations
+to  convergence,  we  have  5  sec  per  swath.  If we have an 800 lines
+broken into swaths of 32 lines, the total  is  125  sec  per  image  (to
+within a factor of 5).
+
+
+
+                                  -5-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+algorithm fit_analytic_model
+
+begin
+        [upon entry, we already have an initial estimate of the coeff]
+
+        repeat {
+            save coeff
+            solve for center,height,width of each line with second
+                order terms fixed (but not necessarily zero)
+            apply constraints on line centers and widths
+            repeat solution adding second order coeff (shape terms)
+
+            compute error matrix
+            for (each coeff)
+                if (uncertainty in coeff > tol) {
+                    fix coeff value to reasonable estimate
+                    remove coeff from solution
+                }
+
+            compute total correction vector given saved coeff
+            if (no coeff were rejected)
+                tweak correction vector to accelerate convergence
+            compute norm of correction vector
+        } until (no additional coeff rejected and norm < tolerance)
+
+        compute final uncertainties
+end
+
+
+
+3.2 Extraction
+
+    The  purpose of extraction is to compute the integral of the spectra
+across the dispersion, producing I(y) for each spectra.  An estimate  of
+the  uncertainty  U(y)  should  also  be produced.  The basic extraction
+techniques  are  summarized  below.   The  number  of  spectra,  spectra 
+centers,  spectra  width  and  shape parameters are taken from the model
+fitted  to  the  calibration  frame  as  outlined  above.   We  make   a 
+simultaneous  solution  for  the  profile  heights and the background (a
+linear problem), repeating the solution independently for each  line  in
+the  image.   For  a  faint  spectrum,  it is essential to determine the
+background accurately, and we can do that safely here since  the  matrix
+will be very well behaved.
+
+    (1) Aperture  sum.   All  of the pixels within a specified radius of
+        the spectra  are  summed  to  produce  the  raw  integral.   The
+        background  image  is  also  summed  and subtracted to yield the
+        final integral.  The radius may be a constant or a  function  of
+        the  width  of  the profile.  Fractional pixel techniques should
+        be used to minimize sampling effects at the  boundaries  of  the
+        aperture.   Pixel  rejection  is  not possible since there is no
+        fitted surface.  The model is  used  only  to  get  the  spectra
+        center  and  width.   This  technique is fastest and may be best
+
+
+                                  -6-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+        if the profile is difficult to model, provided the  spectra  are
+        not crowded.
+
+    (2) Weighted  aperture  sum.   Like  (1),  except  that  a weighting
+        function is applied to correct  for  the  effects  of  crowding.
+        The  model  is  fitted  to  each  object  line,  solving  for  I 
+        (height) and B (background) with  all  other  parameters  fixed.
+        This  is  a  linear  solution  of  a banded matrix and should be
+        quite fast provided the model  can  be  sampled  efficiently  to
+        produce  the  matrix.   It  is possible to iterate to reject bad
+        pixels.  The weight for  a  spectra  at  a  data  pixel  is  the
+        fractional  contribution  of that spectra to the integral of the
+        contributions of all spectra.
+
+    (3) Fit and integrate the model.  The model is fitted as in  (2)  to
+        the   data   pixels  but  the  final  integral  is  produced  by 
+        integrating  the  model.   This   technique   should   be   more 
+        resistant  to  noise  in  the  data  than is (2), because we are
+        using the high signal to  noise  information  in  the  model  to
+        constrain  the  integral.   More  accurate  photometric  results 
+        should therefore be possible.
+
+
+Method (2) has  the  advantage  that  the  integral  is  invariant  with
+respect  to  scale  errors in the fitted models, provided the same error
+is made in each model.  Of course, the same  error  is  unlikely  to  be
+made  in  all  models contributing to a point; it is more likely that an
+error will put more energy into  one  spectra  at  the  expense  of  its
+neighbors.   In  the  limit as the spectra become less crowded, however,
+the effects of errors  in  neighboring  spectra  become  small  and  the
+weighted  average  technique looks good; it becomes quite insensitive to
+errors in the model and in the fit.  For  crowded  spectra  there  seems
+no  alternative  to a good multiparameter fit.  For faint spectra method
+(3) is probably best, and  fitting  the  background  accurately  becomes
+crucial.
+
+In  both (2) and (3), subtraction of the scaled models yields a residual
+image which can be used to evaluate at a glance the quality of the  fit.
+Since  most  all  of  the  effort in (2) and (3) is in the least squares
+solution and the pixel rejection, it might be desirable to  produce  two
+integrals  (output  spectra),  one  for  each  algorithm, as well as the
+uncertainty  vector  (computed  from  the  covariance  matrix,  not  the 
+residual).
+
+
+
+3.3 Smoothing Coefficient Arrays
+
+    In  several  places  we have seen the need for smoothing coefficient
+arrays.  The use of polynomials for  smoothing  is  questionable  unless
+the   order   of  the  polynomial  is  low  (3  or  less).   High  order 
+polynomials are  notoriously  bad  near  the  endpoints  of  the  fitted
+array,   unless  the  data  curve  happens  to  be  a  noisy  low  order 
+
+
+                                  -7-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+polynomial  (rare,  to  say  the  least).   Convolution   or   piecewise 
+polynomial  functions  (i.e., the natural cubic smoothing spline) should
+be considered if there is any reason to  believe  that  the  coefficient
+array  being  smoothed  may  have  high  frequency  components which are
+physical and must be followed (i.e., a bend or kink).
+
+
+
+3.4 Weighting (pg. 11)
+
+    The first weighting scheme (1 / sqrt (data)) seems inverted  to  me.
+The  noise  goes  up  as  with the signal, to be sure, but the signal to
+noise usually goes up faster.  Seems to me the  weight  estimate  should
+be  sqrt(data).   It  also  make  more sense to weight the least blended
+(peak) areas most.
+
+
+
+3.5 Rejection criteria (pg. 13)
+
+    The same comments apply to this rejection criterium  as  in  section
+2.   I  assume  that  "(data  -  model)"  is supposed to be "abs (data -
+model").
+
+
+
+3.6 Uncertainties and Convergence Criteria
+
+    I got the impression that you were using the residual  of  the  data
+minus  the  fitted  surface  both  as the convergence criterium and as a
+measure of the errors in the fit.  It is  neither;  assuming  a  perfect
+model, the residual gives only a measure of the noise in the data.
+
+Using   the   residual   to  establish  a  convergence  criterium  seems 
+reasonable except that it is hard to reliably  say  what  the  criterium
+should  be.   Assuming  that  the  algorithm converges, the value of the
+residual when convergence is acheived is in  general  hard  to  predict,
+so   it  seems  to  me  to  be  difficult  to  establish  a  convergence 
+criterium.  The conventional way  to  establish  when  a  nonlinear  fit
+converges  is  by measuring the norm of the correction vector.  When the
+norm becomes less than some small number the algorithm is said  to  have
+converged.   The  multidimensional  chisquare  surface is parabolic near
+the minimum and a good nonlinear algorithm will  converge  very  rapidly
+once it gets near the minimum.
+
+The  residual  is a measure of the overall goodness of fit, but tells us
+nothing about the uncertainties in the individual  coefficients  of  the
+model.    The  uncertainties  in  the  coefficients  are  given  by  the 
+covariance or error matrix (see Bevington pg. 242).  It is  ok  to  push
+forward  and  produce  an extraction if the algorithm fails to converge,
+but  ONLY  provided  the  code  gives  a  reliable   estimate   of   the 
+uncertainty.
+
+
+
+                                  -8-
+MULTISPEC (Dec83)        Multispec Algorithms          MULTISPEC (Dec83)
+
+
+
+3.6 Evaluating the Curvature Matrix Efficiently
+
+    The  most  expensive  part  of  the  reduction  process  is probably
+evaluating the model to form the curvature matrix at each  iteration  in
+the  nonlinear  solution.   The  most efficient way to do this is to use
+lookup tables.  If the profile shape does not change,  the  profile  can
+be  sampled,  fitted  with a spline, and the spline evaluated to get the
+zero through second derivatives for the curvature matrix.  This  can  be
+done  even  if  the  width  of  the  profile  changes by adding a linear
+term.  If the shape of the profile has to change, it is  still  possible
+to  sample  either  the  gaussian or the exponential function with major
+savings in computation time.
+
+
+
+3.7 Efficient Extraction (pg. 12)
+
+    The reported time of 3 cpu hours to  extract  the  spectra  from  an
+800  line  image  is  excessive for a linear solution.  I would estimate
+the time required for the 800 linear  banded  matrix  solutions  at  4-8
+minutes,  with  a  comparable  time  required  for matrix setup if it is
+done efficiently.  I suspect that the present code  is  not  setting  up
+the   linear   banded   matrix   efficiently  (not  sampling  the  model 
+efficiently).  Pixel rejection should not seriously affect  the  timings
+assuming that bad pixels are not detected in most image lines.
+
+
+
+4. Correcting for Variations in the PSF
+
+    For  all  low  signal  to  noise data it is desirable to correct for
+variations in the point  spread  function,  caused  by  variable  focus,
+scattering,  or  whatever.   This does not seem such a difficult problem
+since the width of the line profile  is  directly  correlated  with  the
+width  of  the  PSF and the information is provided by the current model
+at each point in each extracted spectrum.   The  extracted  spectra  can
+be  corrected  for the variation in the PSF by convolution with a spread
+function the width of which varies along the spectrum.
diff --git a/noao/twodspec/multispec/doc/MSalgo_c.hlp b/noao/twodspec/multispec/doc/MSalgo_c.hlp
new file mode 100644
index 00000000..4b9c3356
--- /dev/null
+++ b/noao/twodspec/multispec/doc/MSalgo_c.hlp
@@ -0,0 +1,449 @@
+.help multispec Dec83 "Multispec Algorithms"
+.ce
+Algorithms for the Multi-Spectra Extraction Package
+.ce
+Analysis and Discussion
+.ce
+December 2, 1983
+
+.sh
+1. Disclaimer
+
+    This should not be taken as a statement of how the algorithms of the
+final package should function; this is merely an analysis and discussion
+of the algorithms, and should be followed by further discussion before we
+decide what course to follow in the final package.  We may very well decide
+that the level of effort required to implement rigorously correct nonlinear
+fitting algorithms is not justified by the expected scientific usage of
+the package.  Before we can decide that, though, we need an accurate estimate
+of the level of effort required.
+
+In attacking nonlinear surface fitting problems it is important to recognize
+that almost any techniques can be made to yield a result without the program
+crashing.  Production of a result (extraction of a spectrum) does not mean
+that the algorithm converged, that the solution is unique, that the model
+is accurate, or that the uncertainties in the computed coefficients have
+been minimized.
+
+.sh
+2. Multispec Flat (pg. 4)
+
+    This sounds like a classical high pass filter and might be best implemented
+via convolution.  Using a convolution operator with a numerical kernel has
+the advantage that the filter can be easily modifed by resampling the kernel
+or by changing the size of the kernel.  It is also quite efficient.  The
+boundary extension feature of IMIO makes it easy to deal with the problem of
+the kernel overlapping the edge of the image in a convolution.  Since the
+convolution is one-dimensional (the image is only filtered in Y), it will
+always be desirable to transpose the image.
+
+The method used to detect and reject bad pixels (eqn 1) is not correct.
+The rejection criteria should be invariant with respect to a scaling of the
+pixel values.  If the data has gone through very much processing (i.e.,
+dtoi on photographic data), the relation between photon counts and pixel value
+may be linear, but the scale is unknown.  Rejection by comparison of a data
+value to a "smoothed" value is more commonly done as follows:
+
+	reject if:  abs (observed - smoothed) > (K * sigma)
+
+where sigma is the noise sigma of the data, generally a function of the signal.
+
+It is often desirable in rejection algorithms to be able to specify,
+as an option, that all pixels within a specified radius of a bad pixel
+be rejected, rather than just the pixel which was detected.  This is only
+unnecessary if the bad pixels are single pixel events (no wings).  Region
+rejection makes an iterative rejection scheme converge faster, as well as
+rejecting the faint wings of the contaminated region.
+
+.sh
+2.1 Dividing by the Flat (pg. 5)
+
+    There is no mention of any need for registering the flat with the data
+field.  Is it safe to assume that the quartz and the object frames are
+precisely registered?  What if the user does in fact average several quartz
+frames taken over a period of time?  (Image registration is a general
+problem that is probably best left until solved in IMAGES).
+
+.sh
+3. Multiap Extraction (pg. 5-6, 8-13)
+
+    The thing that bothers me most about the modeling and extraction
+process is that the high signal to noize quartz information is not used to
+full advantage, and the background is not fitted very accurately.  The
+present algorithms will work well for high signal to noise data, but 
+will result in large (percentage) errors for faint spectra.
+
+Basically, it seems to me that the high signal to noise quartz spectra
+should, in many cases, be used to determine the position and shape of the
+spectral lines.  This is especially attractive since the quartz and spectra
+appear to be closely registered.  Furthermore, if the position-shape solution
+and extraction procedures are separate procedures, there is nothing to prevent
+one from applying both to the object spectum if necessary for some reason
+(i.e., poor registration, better signal to noise in the object spectrum in
+the region of interest, signal dependent distortions, lack of a quartz image,
+etc., would all justify use of the object frame).  It should be possible to
+model either the quartz or the object frame, and to reuse a model for more
+than one extraction.
+
+Let us divide the process up into two steps, "modeling", and "extraction"
+(as it is now).  The "calibration frame" may be the quartz, an averaged
+quartz, or the object frame.  Ideally it will have a high signal to noise
+ratio and any errors in the background should be negligible compared to
+the signal.
+
+We do not solve for the background while modeling the calibration frame;
+we assume that the background has been fitted by any of a variety of
+techniques and a background frame written before the calibration frame
+is modeled.  A "swath" is the average of several image lines, where an
+image line runs across the dispersion, and a column along the dispersion.
+
+.sh
+3.1 Modeling
+
+    I would set the thing up to start fitting at any arbitrary swath, rather
+than the first swath, because it not much harder, and there is no guarantee
+that the calibration frame will have adequate signal to noise in the first
+swath (indeed often the lowest signal to noise will be found there).
+We define the "center" swath as the first swath to be fitted, corresponding
+to the highest signal to noise region of the calibration frame.  By default
+the center swath should be the swath used by find_spectra, especially if
+there is significant curvature in the spectra.
+
+.ks
+.nf
+algorithm model_calibration_frame
+
+begin
+	extract center swath
+	initialize coeff using centers from find_spectra
+	model center swath (nonlinear)
+
+	for (successive swaths upward to top of frame) {
+	    extract swath
+	    initialize coeff to values from last fit
+	    model swath (nonlinear)
+	    save coeff in datafile
+	}
+
+	set last-fit coeff to values for center swath
+	for (successive swaths downward to bottom of frame) {
+	    extract swath
+	    initialize coeff to values from last fit
+	    model swath (nonlinear)
+	    save coeff in datafile
+	}
+
+	smooth model coeff (excluding intensity) along the dispersion 
+	    [high freq variations in spectra center and shape from line]
+	    [to line are nonphysical]
+	variance of a coeff at line-Y from the smoothed model value is
+	    a measure of the uncertainty in that coeff.
+end
+.fi
+.ke
+
+
+I would have the background fitting routine write as output a background
+frame, the name of which would be saved in the datafile, rather than saving
+the coeff of the bkg fit in the datafile.  The background frame may then
+be produced by any of a number of techniques; storing the coefficients of
+the bkg fit in the datafile limits the technique used to a particular model.
+For similar reasons, the standard bkg fitting routine should be broken up
+into a module which determines the region to be fitted, and a module which
+fits the bkg pixels and writes the bkg image.
+
+For example, if the default background fitting routine is a line by line
+routine, the output frame could be smoothed to remove the (nonphysical)
+fluctuations in the background from line to line.  A true two dimensional
+background fitting routine may be added later without requiring modifications
+to the datafile.  Second order corrections could be made to the background
+by repeating the solution using the background fitted by the extraction
+procedure.
+
+
+.ks
+.nf
+procedure extract_swath
+
+begin
+	extract raw swath from calibration frame
+	extract raw swath from background frame
+	return (calib swath minus bkg swath)
+end
+.fi
+.ke
+
+
+The algorithm used to simultaneously model all spectra in a swath from
+across the dispersion is probably the most difficult and time consuming
+part of the problem.  The problem is nonlinear in all but one of the four
+or more parameters for each spectra.  You have spent a lot of time on this
+and we are probably not going to be able to improve on your algorithms
+significantly, though the generation of the matrix in each step can
+probably be optimized significantly.
+
+The analytic line-profile model is the most general and should work for most
+instruments with small circular apertures, even in the presence of severe
+distortions.  It should be possible, however, to fit a simpler model given
+by a lookup table, solving only for the position and height of each spectra.
+This model may be adequate for many instruments, should be must faster to
+fit, and may produce more accurate results since there are fewer parameters
+in the fit.  The disadvantage of an empirical model is that it must be
+accurately interpolated (including the derivatives), requiring use of spline
+interpolation or a similar technique (I have tried linear and it is not good
+enough).  Vesa has implemented procedures for fitting splines and evaluating
+their derivatives.
+
+Fitting the empirical model simultaneously to any number of spectra should
+be straightforward provided the signal to noise is reasonable, since there
+are few parameters in the fit and the matrix is banded (the Marquardt
+algorithm would work fine).  However, if you ever have to deal with data
+where a very faint or nonexistent spectra is next to a bright one, it may
+be difficult to constrain the fit.  I doubt if the present approach of
+smoothing the coeff across the dispersion and iterating would work in such
+a case.  The best approach might be to fix the center of the faint spectra
+relative to the bright one once the signal drops below a certain level,
+or to drop it from the fit entirely.  This requires that the matrix be able
+to change size during the fit.
+
+.ks
+.nf
+algorithm fit_empirical_model
+
+begin
+	[upon entry, we already have an initial estimate of the coeff]
+
+	# Marquardt (gradient expansion) algorithm.  Make 2nd order
+	# Taylor's expansion to chisquare near minimum and solve for
+	# correction vector which puts us at minimum (subject to
+	# Taylor's approx).  Taylor's approximation rapidly becomes
+	# better as we near the minimum of the multidimensional
+	# chisquare, hence convergence is extremely rapid given a good
+	# starting estimate.
+
+	repeat {
+	    evaluate curvature matrix using current coeff.
+	    solve banded curvature matrix 
+
+	    compute error matrix
+	    for (each spectra)
+		if (uncertainty in center coeff > tol) {
+		    fix center by estimation given relative spacing
+			in higher signal region
+		    remove spectra center from solution
+		}
+
+	    if (no center coeff were rejected)
+		tweak correction vector to accelerate convergence
+	    new coeff vector = old coeff vector + correction vector
+	    compute norm of correction vector
+	} until (no more center coeff rejected and norm < tolerance)
+
+	compute final uncertainties
+end
+.fi
+.ke
+
+
+The following is close to what is currently done to fit the analytic
+model, as far as I can remember (I have modified it slightly to stimulate
+discussion).  The solution is broken up into two parts to reduce the number
+of free parameters and increase stability.  If the uncertainty in a free
+parameter becomes large it is best to fix the parameter (it is particularly
+easy for this data to estimate all but the intensity parameter).  A fixed
+parameter is used in the model and affects the solution but is not solved
+for (i.e., like the background).
+
+The analytic fit will be rather slow, even if the outer loop is constrained
+to one iteration.  If it takes (very rough estimates) .5 sec to set up the
+banded matrix and .3 sec to solve it, 3 iterations to convergence, we have
+5 sec per swath.  If we have an 800 lines broken into swaths of 32 lines,
+the total is 125 sec per image (to within a factor of 5). 
+
+
+.ks
+.nf
+algorithm fit_analytic_model
+
+begin
+	[upon entry, we already have an initial estimate of the coeff]
+
+	repeat {
+	    save coeff
+	    solve for center,height,width of each line with second
+		order terms fixed (but not necessarily zero)
+	    apply constraints on line centers and widths
+	    repeat solution adding second order coeff (shape terms)
+
+	    compute error matrix
+	    for (each coeff)
+		if (uncertainty in coeff > tol) {
+		    fix coeff value to reasonable estimate
+		    remove coeff from solution
+		}
+
+	    compute total correction vector given saved coeff
+	    if (no coeff were rejected)
+		tweak correction vector to accelerate convergence
+	    compute norm of correction vector
+	} until (no additional coeff rejected and norm < tolerance)
+
+	compute final uncertainties
+end
+.fi
+.ke
+
+.sh
+3.2 Extraction
+
+    The purpose of extraction is to compute the integral of the spectra
+across the dispersion, producing I(y) for each spectra.  An estimate of
+the uncertainty U(y) should also be produced.  The basic extraction techniques
+are summarized below.  The number of spectra, spectra centers, spectra width
+and shape parameters are taken from the model fitted to the calibration
+frame as outlined above.  We make a simultaneous solution for the profile
+heights and the background (a linear problem), repeating the solution
+independently for each line in the image.  For a faint spectrum, it is
+essential to determine the background accurately, and we can do that safely
+here since the matrix will be very well behaved.
+.ls 4
+.ls (1)
+Aperture sum.  All of the pixels within a specified radius of the spectra
+are summed to produce the raw integral.  The background image is also summed
+and subtracted to yield the final integral.  The radius may be a constant or a
+function of the width of the profile.  Fractional pixel techniques should
+be used to minimize sampling effects at the boundaries of the aperture.
+Pixel rejection is not possible since there is no fitted surface.  The model
+is used only to get the spectra center and width.  This technique is fastest
+and may be best if the profile is difficult to model, provided the spectra
+are not crowded.
+.le
+.ls (2)
+Weighted aperture sum.  Like (1), except that a weighting function is
+applied to correct for the effects of crowding.  The model is fitted
+to each object line, solving for I (height) and B (background) with all
+other parameters fixed.  This is a linear solution of a banded matrix and
+should be quite fast provided the model can be sampled efficiently to
+produce the matrix.  It is possible to iterate to reject bad pixels.
+The weight for a spectra at a data pixel is the fractional contribution
+of that spectra to the integral of the contributions of all spectra.
+.le
+.ls (3)
+Fit and integrate the model.  The model is fitted as in (2) to the data
+pixels but the final integral is produced by integrating the model.
+This technique should be more resistant to noise in the data than is (2),
+because we are using the high signal to noise information in the model to
+constrain the integral.  More accurate photometric results should therefore
+be possible.
+.le
+.le
+
+
+Method (2) has the advantage that the integral is invariant with respect
+to scale errors in the fitted models, provided the same error is made in
+each model.  Of course, the same error is unlikely to be made in all
+models contributing to a point; it is more likely that an error will put
+more energy into one spectra at the expense of its neighbors.  In the limit
+as the spectra become less crowded, however, the effects of errors in
+neighboring spectra become small and the weighted average technique looks
+good; it becomes quite insensitive to errors in the model and in the fit.
+For crowded spectra there seems no alternative to a good multiparameter
+fit.  For faint spectra method (3) is probably best, and fitting the
+background accurately becomes crucial.
+
+In both (2) and (3), subtraction of the scaled models yields a residual
+image which can be used to evaluate at a glance the quality of the fit.
+Since most all of the effort in (2) and (3) is in the least squares solution
+and the pixel rejection, it might be desirable to produce two integrals
+(output spectra), one for each algorithm, as well as the uncertainty vector
+(computed from the covariance matrix, not the residual).
+
+.sh
+3.3 Smoothing Coefficient Arrays
+
+    In several places we have seen the need for smoothing coefficient arrays.
+The use of polynomials for smoothing is questionable unless the order of
+the polynomial is low (3 or less).  High order polynomials are notoriously
+bad near the endpoints of the fitted array, unless the data curve happens
+to be a noisy low order polynomial (rare, to say the least).  Convolution or
+piecewise polynomial functions (i.e., the natural cubic smoothing spline)
+should be considered if there is any reason to believe that the coefficient
+array being smoothed may have high frequency components which are physical and
+must be followed (i.e., a bend or kink).
+
+.sh
+3.4 Weighting (pg. 11)
+
+    The first weighting scheme (1 / sqrt (data)) seems inverted to me.
+The noise goes up as with the signal, to be sure, but the signal to noise
+usually goes up faster.  Seems to me the weight estimate should be sqrt(data).
+It also make more sense to weight the least blended (peak) areas most.
+
+.sh
+3.5 Rejection criteria (pg. 13)
+
+    The same comments apply to this rejection criterium as in section 2.
+I assume that "(data - model)" is supposed to be "abs (data - model").
+
+.sh
+3.6 Uncertainties and Convergence Criteria
+
+    I got the impression that you were using the residual of the data minus
+the fitted surface both as the convergence criterium and as a measure of the
+errors in the fit.  It is neither; assuming a perfect model, the residual gives
+only a measure of the noise in the data.
+
+Using the residual to establish a convergence criterium seems reasonable
+except that it is hard to reliably say what the criterium should be.
+Assuming that the algorithm converges, the value of the residual when
+convergence is achieved is in general hard to predict, so it seems to me to
+be difficult to establish a convergence criterium.  The conventional way
+to establish when a nonlinear fit converges is by measuring the norm of
+the correction vector.  When the norm becomes less than some small number
+the algorithm is said to have converged.  The multidimensional chisquare
+surface is parabolic near the minimum and a good nonlinear algorithm will
+converge very rapidly once it gets near the minimum.
+
+The residual is a measure of the overall goodness of fit, but tells us
+nothing about the uncertainties in the individual coefficients of the model.
+The uncertainties in the coefficients are given by the covariance or error
+matrix (see Bevington pg. 242).  It is ok to push forward and produce an
+extraction if the algorithm fails to converge, but ONLY provided the code 
+gives a reliable estimate of the uncertainty.
+
+.sh
+3.6 Evaluating the Curvature Matrix Efficiently
+
+    The most expensive part of the reduction process is probably evaluating
+the model to form the curvature matrix at each iteration in the nonlinear
+solution.  The most efficient way to do this is to use lookup tables.
+If the profile shape does not change, the profile can be sampled, fitted
+with a spline, and the spline evaluated to get the zero through second
+derivatives for the curvature matrix.  This can be done even if the width
+of the profile changes by adding a linear term.  If the shape of the profile
+has to change, it is still possible to sample either the gaussian or the
+exponential function with major savings in computation time.
+
+.sh
+3.7 Efficient Extraction (pg. 12)
+
+    The reported time of 3 cpu hours to extract the spectra from an 800 line
+image is excessive for a linear solution.  I would estimate the time required
+for the 800 linear banded matrix solutions at 4-8 minutes, with a comparable
+time required for matrix setup if it is done efficiently.  I suspect that the
+present code is not setting up the linear banded matrix efficiently (not
+sampling the model efficiently).  Pixel rejection should not seriously affect
+the timings assuming that bad pixels are not detected in most image lines.
+
+.sh
+4. Correcting for Variations in the PSF
+
+    For all low signal to noise data it is desirable to correct for variations
+in the point spread function, caused by variable focus, scattering, or
+whatever.  This does not seem such a difficult problem since the width of
+the line profile is directly correlated with the width of the PSF and the
+information is provided by the current model at each point in each extracted
+spectrum.  The extracted spectra can be corrected for the variation in the
+PSF by convolution with a spread function the width of which varies along
+the spectrum.
+.endhelp
diff --git a/noao/twodspec/multispec/doc/MSspecs.doc b/noao/twodspec/multispec/doc/MSspecs.doc
new file mode 100644
index 00000000..09955e9c
--- /dev/null
+++ b/noao/twodspec/multispec/doc/MSspecs.doc
@@ -0,0 +1,698 @@
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+   Detailed Specifications for the Multi-Spectra Extraction Package
+                              F. Valdes
+                           December 8, 1983
+
+
+1.  Introduction
+
+     The  multi-spectra  extraction  package  (MULTISPEC)  provides  the 
+basic tools for modeling, cleaning, and extracting spectra  from  images
+containing  multiple  aperture  spectra running roughly parallel.  These
+tools will generally be combined  in  reduction  script  tasks  but  may
+also be used directly for non-standard analysis.
+
+     This  design  presents  the requirements and specifications for the
+MULTISPEC package.  Details concerning the algorithms  are  given  in  a
+separate document, Algorithms for the Multi-Spectra Extraction Package.
+
+
+2.  Input Data Requirements
+
+    The  input  data  for  the MULTISPEC package consists of image files
+containing one or more aperture spectra.  The spectra  are  required  to
+run   roughly  parallel  to  each  other  and  parallel  to  the  second 
+digitization  axis.   The  latter  requirement  may  require  a  general 
+rotation  and  interpolation  image operator.  The images are assumed to
+be  corrected  to  linear  relative  intensity.   Thus,  the  steps   of 
+correcting   digital   detector  images  for  dark  current,  bias,  and 
+pixel-to-pixel sensitivity variations must  be  performed  before  using
+the MULTISPEC tasks.
+
+     Because  the  the MULTISPEC package is being developed concurrently
+with the IRAF standard image processing tools  this  document  specifies
+the   requirements  for  the  preliminary  image  processing  needed  to 
+prepare digital detector images for the MULTISPEC package.
+
+
+2.1  Basic Digital Detector Reduction Tasks
+
+     The prelimary reduction of multi-spectra  images  uses  CL  scripts
+based  on  general  image  operators.   Some  of  the  scripts  are  for 
+specific instruments or specific reduction  applications  and  some  are
+generally   useful  image  processing  tasks.   The  scripts  allow  the 
+specification  of  many  images  for  which  the  operations   will   be 
+repetitively applied.
+
+     The  following  CL  scripts  are  required  to reduce multi-spectra
+images from digital detectors.
+
+
+        debias          multispec_flat          flat_divide
+
+
+
+
+
+                                  -1-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+debias
+    The files in a list of  filenames  are  automatically  debiased  and
+    trimmed.   This  routine  will  be  instrument  specific but used by
+    other reduction tasks beyond MULTISPEC.
+
+multispec_flat
+    The files in a list of quartz  multi-spectra  filenames  are  added,
+    the  result  is  smoothed  along  the dispersion dimension, and then
+    the original image is divided by the smoothed  image  to  produce  a
+    flat  field  image.   The  unsmoothed  to smoothed ratio is computed
+    only  if  the  value  of  the  smoothed  pixel  is  greater  than  a 
+    specified  amount.   Otherwise,  the  ratio  is  set to unity.  This
+    routine is not instrument specific but is used  only  for  MULTISPEC
+    reductions.
+
+flat_divide
+    The  files  in  a  list of filenames are each divided by a specified
+    flat field image.  This routine is  not  instrument  or  application
+    specific.
+
+    The  required  general image processing programs needed to implement
+these scripts are specified below.
+
+
+(1) A routine to compute the average value from a specified area of  the
+    image.  Used to determine the average bias value from a bias strip.
+
+(2) A  routine  to  trim  a specified portion of an image.  Used to trim
+    the bias strip.
+
+(3) Routines to multiply and subtract images by  a  constant.   Used  to
+    scale  images  such as dark exposures and to remove the average bias
+    value as obtained by (1) above.
+
+(4) Routines to subtract, add, and  divide  images.   Used  to  subtract
+    dark  current  and  bias  exposures,  to  add  several  exposures to
+    increase the signal-to-noise, and to divide by a flat  field  image.
+    The  divide  routine  must  give the user the option to substitute a
+    constant or ignore any divisions in which the  denominator  is  less
+    than a specified value.
+
+(5) A  routine  to  rotate  or  transpose  an  image.  Used to align the
+    spectra along lines or columns.
+
+(6) A  routine  to  apply  a  filter  to  lines  of  the   image.    For 
+    multi-spectra  images  a  smooth  quartz  is  produced  by  using  a 
+    running  quadratic  filter  along  each  line  of   the   dispersion 
+    dimension.   The  filter  must  be  able  to  recognize  bad  pixels 
+    (specified by a user defined threshold) and  remove  them  from  the
+    filtering operation.
+
+
+
+
+
+                                  -2-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+3.  Requirements for the MULTSPEC Package
+
+     The MULTISPEC package shall satisfy the following requirements.
+
+(1) The component programs shall be CL callable.
+
+(2) The  programs  shall interact only through image files and MULTISPEC
+    data files.
+
+(3) It shall be possible to extract spectra without modeling.
+
+(4) The entire image shall be extracted and not limited by  failures  in
+    the algorithms.
+
+(5) It  shall  be  possible  to  specify specific lines or swaths in the
+    image on which to operate.
+
+(6) CL scripts shall be provided for the  common  data  sources.   These
+    scripts will work automatically.
+
+The follow functions shall be provided:
+
+o   Make  an  initial  rough but automated identification of the spectra
+    locations.
+
+o   Provide for a user identification list for  the  spectra  locations.
+    This  list  shall  be  of  the  standard  image cursor type to allow
+    generation of the list with the standard image cursor programs.
+
+o   Determine and correct for a slowly varying background.
+
+o   Reliably and accurately trace spectra in the presence  of  geometric
+    distortions (pincushion, s, shear, etc.).
+
+o   Extract spectra by one of:
+
+    a.  Strips  of  constant width about the located spectra.  The width
+        may be specified to fractions of  a  pixel  and  the  extraction
+        will use fractional pixel interpolation.  l
+
+    b.  Strips of width proportional to a Gaussian width parameter.
+
+    c.  Modeling  to  obtain  estimates  of  the  total luminosity.  The
+        estimate will be the integral of the model.
+
+    d.  Summation   of   the   data   pixel   values   with   fractional  
+        contributions  of  the  pixel  value  to  the  spectra  based on
+        modeling.
+
+o   An option shall be available to  specify  whether  to  ignore  blank
+    pixels or use interpolated values.
+
+    o   Programs  shall  be  provided to produce data files which can be
+
+
+                                  -3-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+        accessed by one dimensional  spectroscopic  reduction  routines.
+        At a minimum these formats shall include:
+
+        a.  Reduction  to  an  image  file  consisting  of  one line per
+            extracted spectrum
+
+        b.  The  standard  IIDS  format   available   with   the   CYBER 
+            Multi-Aperture Plate programs
+
+
+3.2  Modeling Requirements
+
+     The  modeling  of multi-spectra images, particularly in the case of
+blended spectra, shall:
+
+(1) Model blended spectra with  sufficient  reliability  and  robustness
+    that  a  reasonable  solution is always obtained, though of possibly
+    limited usefulness.
+
+(2) The modeling shall provide estimates for the  uncertainties  in  the
+    fitted parameters as a function of position along the spectrum.
+
+(3) Remove  cosmic  rays  and other defective pixels by reference to the
+    model.
+
+(4) Allow the transfer of a model solution  for  one  image  to  another
+    image.
+
+(5) Display  numerically and graphically the data, the fitted model, and
+    the residuals.
+
+
+4.  Program Specifications
+
+
+4.1  Basic Programs
+
+     The basic programs of the package are general purpose  tools  which
+initialize  a  MULTISPEC  data  file  and  perform  a single fundamental
+operation on the data in the MULTISPEC data file.   There  is  one  data
+file  associated  with  each  image.   The  data file is hidden from the
+user and so the user need not be aware  of  the  data  file.   The  data
+files  are  referenced  only the image filename specified in the program
+parameters.  The data files contain such  information  as  a  processing
+history,  the  spectra  positions  and extracted luminosities, the model
+parameters (one set for each spectra for each modelled  image  line  (or
+swath),  etc.   The  programs  generally are allowed to specify specific
+lines, columns, and/or spectra on which to operate.   The  line,  column
+and  spectra  specifications  are given as strings which contain numbers
+separated by whitespace, commas,  and  the  range  indicator  "-".   The
+script  tasks  of  section  4.2  will  combine  these  basic programs to
+perform a general multi-spectra extraction.
+
+
+
+                                  -4-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+    ap_plate            copy_params     find_spectra    convolve
+    fit_bckgrnd         find_bckgrnd    line_list       model_extrac
+    model_fit           model_image     model_list      sigma_extract
+    strip_extract       to_iids         to_image        to_onedspec
+
+ap_plate
+    The information from an on-line data  file  containing  descriptions
+    of  all  the aperture plates prepared at Kitt Peak is read to find a
+    specified  aperture  plate.   The  drilled  aperture  positions  are 
+    correlated  with  the  spectra  in  the  image  to  deduce  relative 
+    wavelength offsets.  The identifications for  the  spectra  as  well
+    as  other  auxiliary  information  is recorded in the data file.  If
+    no  image  file  is  specified  then   only   the   aperture   plate 
+    information   is   printed.    This   program   is   used   in   the  
+    MULTIAP_EXTRACT program.  This  program  is  not  essential  to  the
+    operation of the MULTISPEC package.
+
+                    Multi-Spectra image  image = 
+                         Aperture plate  plate = 
+                                        (mode = ql)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                                  -5-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+The Background
+    The  are  two possibilities for dealing with the background.  In the
+    first  case,  FIT_BCKGRND,  the  background  will   be   fitted   by 
+    polynomials  and  the  coefficients  stored  in  the  MULTISPEC data
+    file.  These coefficients are then used by  the  other  programs  to
+    estimate   the  background  at  the  spectra.   The  second  option, 
+    FIND_BCKGRND, generates a background  image  in  which  the  spectra
+    and  other  selected  areas are set to blank pixels.  Then a general
+    image interpolator is used fill in the blank pixels with  background
+    estimates.   The  other  MULTISPEC  programs  will  then access this
+    background frame.  The background frame image name  will  be  stored
+    in the MULTISPEC data file and the image header.
+
+
+    fit_bckgrnd
+        Fit  a  background  in  a  MULTISPEC image by a polynomial using
+        pixels not near the spectra and in  the  user  specified  swaths
+        and  columns.   The buffer distance is in pixels and refers to a
+        minimum distance from the center of any  spectrum  beyond  which
+        the  background  pixels  are found.  Blank pixels are ignored in
+        the background fit.  Deviant pixels will be rejected.
+
+                        Multi-Spectra image  image = 
+                        Buffer from spectra  buffer = 12
+                           Polynomial order  order = 3
+                            Lines per swath (lines_per_swath = 32)
+                              Swaths to fit (swaths = 1-1000)
+                             Columns to fit (columns = 1-1000)
+                        Rejection threshold (threshold = 5)
+                  Print general diagnostics (verbose = no)
+                                            (mode = ql)
+
+    find_bckgrnd
+        The spectra within a buffer distance  and  specified  areas  are
+        set  to  blank  pixels  and  the  remaining  pixels  copied to a
+        background image file.
+
+                        Multi-Spectra image  image = 
+                           Background image  background =
+                        Buffer from spectra  buffer = 12
+                            Lines to ignore (lines = )
+                          Columns to ignore (columns = )
+                                            (mode = ql)
+
+convolve
+    A program will be provided to reduce either the  extracted  spectrum
+    or the modeled image to a common point-spread function.
+
+
+
+
+
+
+
+
+                                  -6-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+copy_params
+    Create  a  MULTISPEC  data  file  for  a new image using appropriate
+    MULTISPEC parameters from an old image.  The  old  image  must  have
+    been  processed  to find the spectra using FIND_SPECTRA and possibly
+    model fit.
+
+                Old Multi-Spectra image  old_image = 
+                New Multi-Spectra image  new_image = 
+                                        (mode = ql)
+
+find_spectra
+    Initially locate the spectra in a MULTISPEC  image.   The  positions
+    of  the  spectra  within the range of columns are determined for the
+    starting line and then the spectra are tracked within the  range  of
+    lines.   The  minimum  separation  and minimum width would generally
+    be set for a particular instrument.   If  the  automatic  search  is
+    not  used  then a list of cursor positions is read from the standard
+    input.
+
+                    Multi-Spectra image  image = 
+                       Automatic search  auto = yes
+                          Starting line  start_line =
+                     Minimum separation (min_sep = 1)
+                          Minimum width (min_width = 1)
+                        Averaging width (average = 32)
+                        Lines to search (lines = 1-1000)
+                      Columns to search (columns = 1-1000)
+              Print general diagnostics (verbose = no)
+                                        (mode = ql)
+
+line_list
+    For the  specified  lines  in  the  image  print  the  image  column
+    number,  data  value  (possibly as a swath average), the model value
+    at that point (i.e. the sum of  the  model  contributions  from  all
+    the  spectra),  the  background  value,  and the residual.  Plotting
+    scripts may be written using this routine to show the quality  of  a
+    model fit.
+
+                    Multi-Spectra image  image = 
+                          Lines to list (lines = 1-1000)
+                                        (mode = ql)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                                  -7-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+model_extract
+    A  previously  fitted  model  is  used  to extract the spectra total
+    luminosity by apportioning the data values to spectra in  the  ratio
+    indicated  by  the model.  If the clean option is specified then the
+    model is used to detect pixels which deviate from  the  model  by  a
+    specified  amount.   The  model  value replaces the deviant pixel in
+    the extraction and, if specified, also in the image file.
+
+                    Multi-Spectra image  image = 
+                       Lines to extract (lines = 1-1000)
+                          Clean spectra (clean = yes)
+                     Cleaning threshold (threshold = 5)
+                           Modify image (modify = yes)
+              Print general diagnostics (verbose = no)
+                                        (mode = ql)
+
+model_fit
+    A specified model is iteratively fitted to the data in each  of  the
+    specified  lines  (or  swaths)  until  the  RMS  residual  fails  to 
+    decrease.  The models  are  selected  by  a  string.   The  possible
+    values are
+
+        (null string) - initialize the model
+        i - fit only the intensity scale
+        ip - fit the intensity scale and the position
+        ips1 - fit the intensity scale, position, and one parameter shape
+        ips2 - fit the intensity scale, position, and two parameter shape
+        ips3 - fit the intensity scale, position, and three parameter shape
+        ips4 - fit the intensity scale, position, and four parameter shape
+    These  models  will  be  combined in a script to search for the best
+    fit.
+
+    The initial shape parameters will generally be set by scripts for  a
+    particular data reduction.
+
+                    Multi-Spectra image  image = 
+                             Model type  model = 
+                        Lines per swath (lines_per_swath = 32)
+                        Swaths to model (swaths = 1-1000)
+                         Initial shape1 (shape1 = .1 )
+                         Initial shape2 (shape2 = 0 )
+                         Initial shape3 (shape3 = 0 )
+                         Initial shape4 (shape4 = 5 )
+              Print general diagnostics (verbose = no)
+                                        (mode = ql)
+
+
+
+
+
+
+
+
+
+
+                                  -8-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+model_image
+    An  image  file of the fitted model is created.  This image may then
+    be displayed or a residual image may be calculated and displayed.
+
+                    Multi-Spectra image  image = 
+                            Model image  model =
+                                        (mode = ql)
+    .nf
+    .le
+    .ls model_list
+    For the specified lines and spectra the model is listed.
+    The listing gives, for each spectra,
+    the spectrum number, the line number, the fitted position,
+    the estimated wavelength, the
+    extracted luminosity, the intensity scale, model width parameters, and
+    the background polynomial coefficients.  This routine can be used in scripts
+    to plot the extracted spectra, the trend of width with wavelength, and so
+    forth.
+    
+    .nf
+                    Multi-Spectra image  image = 
+                          Lines to list (lines = 1-1000)
+                        Spectra to list (spectra = 1-1000)
+                                        (mode = ql)
+
+sigma_extract
+    A previously fitted model is used to extract the spectra  luminosity
+    within  a  specified  sigma  of  the peak.  Because the model is not
+    necessarily a Gaussian the sigma is used to  compute  the  intensity
+    ratio  of  the  cutoff to the peak assumining a Gaussian profile and
+    then the data is extracted to the point the  model  intensity  falls
+    below  that  cutoff.   If  the  clean  option  is specified then the
+    model is used to detect pixels which deviate from  the  model  by  a
+    specified  amount.   The  model  value replaces the deviant pixel in
+    the extraction and, if specified, also in the image file.
+
+                    Multi-Spectra image  image = 
+                 Sigma extraction width  width = 1.
+                       Lines to extract (lines = 1-1000)
+                          Clean spectra (clean = yes)
+                     Cleaning threshold (threshold = 5)
+                           Modify image (modify = yes)
+              Print general diagnostics (verbose = no)
+                                        (mode = ql)
+
+
+
+
+
+
+
+
+
+
+
+                                  -9-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+strip_extract
+    A strip of constant width about the spectra positions is  extracted.
+    If  cleanning  is  desired  a  smoothed  estimate  of the profile is
+    obtained by averaging a  number  of  lines  about  the  line  to  be
+    cleaned.   After  fitting  for  the intensity scale pixels are found
+    which deviate from the profile by a specified amount.   The  profile
+    value   replaces  the  deviant  pixel  in  the  extraction  and,  if 
+    specified, also in the image file.  No prior  modeling  is  required
+    to use this extraction routine.
+
+                    Multi-Spectra image  image = 
+                 Strip extraction width  width = 1.
+                       Lines to extract (lines = 1-1000)
+                          Clean spectra (clean = yes)
+                     Cleaning threshold (threshold = 5)
+              Lines per profile average (averge_lines = 32)
+                           Modify image (modify = yes)
+              Print general diagnostics (verbose = no)
+                                        (mode = ql)
+
+to_iids
+    For  a  specified prefix, files of the form prefix.nn, where nn is a
+    specified spectra  number,  are  created  containing  the  extracted
+    spectra  for  all  the  specified  image  files.   The format of the
+    files is the IIDS format  developed  for  the  CYBER  Multi-Aperture
+    Plate Extractions.
+
+                    Multi-Spectra image  images = 
+                   IIDS filename prefix  iids_file = 
+                      Spectra to format (spectra = 1-1000)
+                                        (mode = ql)
+
+to_image
+    An  image  file  containing  one  line of the extracted luminosities
+    for each specified spectra in the specified MULTISPEC image.
+
+                    Multi-Spectra image  in_image = 
+                Extracted spectra image  out_image = 
+                                Spectra (spectra = 1-1000)
+                                        (mode = ql)
+
+to_onedspec
+    The extractions are converted to an as yet to  be  specified  format
+    for use in the ONEDSPEC reduction package.
+
+                   Multi-Spectra images  images = 
+                     ONEDSPEC data file  onedspec_file = 
+                                Spectra (spectra = 1-1000)
+                                        (mode = ql)
+
+
+
+
+
+
+                                 -10-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+4.2  General MULTISPEC CL Scripts
+
+     The  general  MULTISPEC CL scripts perform a series of steps needed
+to extract the spectra from a specified  list  of  image  files.   These
+steps  have  been found to generally perform the desired extraction task
+fully.
+
+
+        multiap_extract         echelle_extract
+
+multiap_extract
+    The specified multi-aperture plate  images  are  extracted.   If  no
+    starting  solution  image,  one which has previously been extracted,
+    is specified then the script performs an automatic  search  for  the
+    specified  number  of  spectra.   Otherwise  the  solution  from the
+    starting image is used as the  initial  model.   The  background  is
+    then  determined.   This is followed by a series of fitting steps on
+    swaths of data.  (For further details on the fitting steps  see  the
+    Algorithms   paper).    A   MODEL_EXTRACT   and   cleaning  follows. 
+    Finally, the extraction is correlated with  the  specified  aperture
+    plate  using  AP_PLATE.   If  there  was no starting image then this
+    extraction becomes the initial solution  image.   Subsequent  images
+    are extracted starting from the initial solution image.
+
+                  Multi-Aperture images  images = 
+                 Initial solution image  initial = 
+                  Aperture plate number  plate = 
+                      Number of spectra  nspectra = 
+                                        (mode = ql)
+
+echelle_extract
+    The   specified  echelle  images  are  extracted.   If  no  starting 
+    solution  image,  one  which  has  previously  been  extracted,   is 
+    specified  then  the  script  performs  an  automatic search for the
+    specified  number  of  orders.   Otherwise  the  solution  from  the 
+    starting   image  is  used  as  the  initial  starting  point.   The 
+    background  is  then  determined.   Finally  a   STRIP_EXTRACT   and 
+    cleaning  is  performed.   If  there was no starting image then this
+    extraction becomes the initial solution  image.   Subsequent  images
+    are extracted starting from the initial solution image.
+
+                         Echelle images  images = 
+                 Initial solution image  initial = 
+                       Number of orders  norders = 
+                       Extraction width  width =
+                                        (mode = ql)
+
+
+5.  Outline of a MULTISPEC Reduction
+
+     The  following  outline  is for the reduction of a cryogenic camera
+multi-aperture plate.  All the programmer supplied  default  values  are
+used.
+
+
+                                 -11-
+MULTISPEC (Oct83)  Multi-Spectra Extraction Package    MULTISPEC (Oct83)
+
+
+
+        (1)  rcamera mtb, "ap165.", "s", "3-9"
+        (2)  debias "ap165.*"
+        (3)  multispec_flat "ap165.[36]", "ap165.flat"
+        (4)  flat_divide "ap165.*", "ap165.flat"
+        (5)  multiap_extract "ap165.*", "", 165, 50
+        (6)  to_onedspec "ap165.*", oned165
+
+
+(1) The  data  is  read  from  the observing tape(s) using RCAMERA.  The
+    image files created are ap165.3, ap165.4,  ...,  ap165.9.   This  is
+    easily  accomplished  by  using  the filename prefix "ap165." in the
+    RCAMERA program.  The raw images may be examined at  this  point  on
+    a display.
+
+(2) The  images  are  debiased  using DEBIAS with all the "ap165." files
+    specified.  The debias program  knows  about  the  location  of  the
+    bias strip for the cryogenic camera.
+
+(3) A  a  flat  field  is  created  using  MULTISPEC_FLAT  in  which the
+    desired  quartz  frames  are  specified  and  a  flat  field   image 
+    filename  is  defined.  The created flat field image may be examined
+    on an image display if desired.
+
+(4) All the  debiased  images  are  divided  by  the  flat  field  using
+    FLAT_DIVIDE.
+
+(5) The  script  MULTIAP_EXTRACT  is  run  in  which  the aperture plate
+    number, the number of spectra, and the image files to  be  extracted
+    are  specified.   The  number  of  spectra  is found by examining an
+    image on an image display or by plotting a cut  across  the  spectra
+    using a general image profile program.
+
+(6) Finally,  the  extracted  spectra  are  formatted  for  the ONEDSPEC
+    package using TO_ONEDSPEC with the extracted images specified.
diff --git a/noao/twodspec/multispec/doc/MSspecs.hlp b/noao/twodspec/multispec/doc/MSspecs.hlp
new file mode 100644
index 00000000..92f285ed
--- /dev/null
+++ b/noao/twodspec/multispec/doc/MSspecs.hlp
@@ -0,0 +1,659 @@
+.help multispec Oct83 "Multi-Spectra Extraction Package"
+.sp 3
+.ce
+Detailed Specifications for the Multi-Spectra Extraction Package
+.ce
+F. Valdes
+.ce
+December 8, 1983
+.sh
+1.  Introduction
+
+     The multi-spectra extraction package (MULTISPEC) provides the basic tools
+for modeling, cleaning, and extracting spectra from images
+containing multiple aperture spectra running roughly parallel.
+These tools will generally be combined in reduction script tasks
+but may also be used directly for non-standard analysis.
+
+     This design presents the requirements and specifications
+for the MULTISPEC package.  Details concerning the 
+algorithms are given in a separate document, Algorithms for the
+Multi-Spectra Extraction Package.
+.sh
+2.  Input Data Requirements
+
+    The input data for the MULTISPEC package consists of image
+files containing one or more aperture spectra.  The spectra are
+required to run roughly parallel to each other and parallel to the
+second digitization axis.  The latter requirement may require a
+general rotation and interpolation image operator.  The images are
+assumed to be corrected to linear relative intensity.  Thus, the
+steps of correcting digital detector images for dark current, bias, and
+pixel-to-pixel sensitivity variations must be performed before using
+the MULTISPEC tasks.
+
+     Because the MULTISPEC package is being developed
+concurrently with the IRAF standard image processing
+tools this document specifies the requirements for the preliminary
+image processing needed to prepare digital detector images for the MULTISPEC
+package.
+.sh
+2.1  Basic Digital Detector Reduction Tasks
+
+     The prelimary reduction of multi-spectra images uses CL scripts
+based on general image operators.
+Some of the scripts are for specific instruments or specific
+reduction applications and some are generally useful image processing
+tasks.  The scripts allow the specification of many images for which
+the operations will be repetitively applied.
+
+     The following CL scripts are required to reduce multi-spectra images
+from digital detectors.
+
+
+.nf
+	debias		multispec_flat		flat_divide
+.fi
+.ke
+.ks
+.ls 4 debias
+The files in a list of filenames are automatically debiased and trimmed.
+This routine will be instrument specific but used by other reduction
+tasks beyond MULTISPEC.
+.le
+.ke
+.ks
+.ls multispec_flat
+The files in a list of quartz multi-spectra filenames are added,
+the result is smoothed
+along the dispersion dimension, and then the original image is divided
+by the smoothed image to produce a flat field image.  The unsmoothed
+to smoothed ratio is computed only if the value of the smoothed
+pixel is greater than a specified amount.  Otherwise, the ratio is set
+to unity.  This routine is not instrument specific but is used only
+for MULTISPEC reductions.
+.le
+.ke
+.ks
+.ls flat_divide
+The files in a list of filenames are each divided by a specified flat
+field image.  This routine is not instrument or application specific.
+.le
+.ke
+
+    The required general image processing programs needed to implement these
+scripts are specified below.
+
+.ls (1)
+A routine to compute the average value from a specified area of the
+image.  Used to determine the average bias value from a bias strip.
+.le
+.ls (2)
+A routine to trim a specified portion of an image.  Used to trim the
+bias strip.
+.le
+.ls (3)
+Routines to multiply and subtract images by a constant.  Used to scale
+images such as dark exposures and to remove the average bias value as
+obtained by (1) above.
+.le
+.ls (4)
+Routines to subtract, add, and divide images.  Used to subtract dark
+current and bias exposures, to add several exposures to increase the
+signal-to-noise, and to divide by a flat field image.
+The divide routine must give the user the option to substitute a constant or
+ignore any divisions in which the denominator is less than a specified value.
+.le
+.ls (5)
+A routine to rotate or transpose an image.  Used to align the spectra
+along lines or columns.
+.le
+.ls (6)
+A routine to apply a filter to lines of the image.  For multi-spectra images
+a smooth quartz is produced by using a running quadratic filter along each
+line of the dispersion dimension.  The filter must be able to recognize
+bad pixels (specified by a user defined threshold) and remove them from the
+filtering operation.
+.le
+.sh
+3.  Requirements for the MULTSPEC Package
+
+     The MULTISPEC package shall satisfy the following requirements.
+.ls (1)
+The component programs shall be CL callable.
+.le
+.ls (2)
+The programs shall interact only through image files and MULTISPEC data files.
+.le
+.ls (3)
+It shall be possible to extract spectra without modeling.
+.le
+.ls (4)
+The entire image shall be extracted and not limited by failures in the
+algorithms.
+.le
+.ls (5)
+It shall be possible to specify specific lines or swaths in the image
+on which to operate.
+.le
+.ls (6)
+CL scripts shall be provided for the common data sources.  These scripts
+will work automatically.
+.le
+
+The follow functions shall be provided:
+.ls o
+Make an initial rough but automated identification of the spectra
+locations.
+.le
+.ls o
+Provide for a user identification list for the spectra locations.
+This list shall be of the standard image cursor type to allow generation
+of the list with the standard image cursor programs.
+.le
+.ls o
+Determine and correct for a slowly varying background.
+.le
+.ls o
+Reliably and accurately trace spectra in the presence of geometric
+distortions (pincushion, s, shear, etc.).
+.le
+
+Extract spectra by one of:
+.ls a.
+Strips of constant width about the located spectra.  The width may be specified
+to fractions of a pixel and the extraction will use fractional pixel
+interpolation.
+l
+.le
+.ls b.
+Strips of width proportional to a Gaussian width parameter.
+.le
+.ls c.
+Modeling to obtain estimates of the total luminosity.  The estimate will
+be the integral of the model.
+.le
+.ls d.
+Summation of the data pixel values with fractional contributions of the
+pixel value to the spectra based on modeling.
+.le
+.le
+.ls o
+An option shall be available to specify whether to ignore blank pixels
+or use interpolated values.
+.ls o
+Programs shall be provided to produce data files which can be accessed
+by one dimensional spectroscopic reduction routines.  At a minimum
+these formats shall include:
+.ls a.
+Reduction to an image file consisting of one line per extracted
+spectrum
+.le
+.ls b.
+The standard IIDS format available with the CYBER Multi-Aperture Plate
+programs
+.le
+.le
+.sh
+3.2  Modeling Requirements
+
+     The modeling of multi-spectra images, particularly in the case of
+blended spectra, shall:
+.ls (1)
+Model blended spectra with sufficient reliability and robustness that
+a reasonable solution is always obtained, though of possibly limited
+usefulness.
+.le
+.ls (2)
+The modeling shall provide estimates for the uncertainties in the fitted
+parameters as a function of position along the spectrum.
+.le
+.ls (3)
+Remove cosmic rays and other defective pixels by reference to the model.
+.le
+.ls (4)
+Allow the transfer of a model solution for one image to another image.
+.le
+.ls (5)
+Display numerically and graphically the data, the fitted model, and
+the residuals.
+.le
+.sh
+4.  Program Specifications
+.sh
+4.1  Basic Programs
+
+     The basic programs of the package are general purpose tools which
+initialize a MULTISPEC data file and perform a single fundamental operation
+on the data in the MULTISPEC data file.  There is one data file associated
+with each image.  The data file is hidden from the user and so the user
+need not be aware of the data file.
+The data files are referenced only the image filename specified in the
+program parameters.
+The data files contain such information as a processing history, the
+spectra positions and extracted luminosities, the model parameters (one
+set for each spectra for each modelled image line (or swath), etc.
+The programs generally are allowed to specify specific
+lines, columns, and/or spectra on which to operate.
+The line, column and spectra specifications are given as strings which
+contain numbers separated by whitespace, commas, and the range indicator
+"-".  The script tasks
+of section 4.2 will combine these basic programs to perform a general
+multi-spectra extraction.
+
+.ks
+.nf
+    ap_plate		copy_params	find_spectra	convolve
+    fit_bckgrnd		find_bckgrnd	line_list	model_extrac
+    model_fit		model_image	model_list	sigma_extract
+    strip_extract	to_iids		to_image	to_onedspec
+.fi
+.ke
+.ks
+.ls ap_plate
+The information from an on-line data file containing descriptions of all
+the aperture plates prepared at Kitt Peak is read to find a specified
+aperture plate.  The drilled aperture positions are correlated with the
+spectra in the image to deduce relative wavelength offsets.  The
+identifications for the spectra as well as other auxiliary information
+is recorded in the data file.
+If no image file is specified then only the aperture
+plate information is printed.  This program is used in the MULTIAP_EXTRACT
+program.  This program is not essential to the operation of the MULTISPEC
+package.
+
+.nf
+                Multi-Spectra image  image = 
+                     Aperture plate  plate = 
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls The Background
+The are two possibilities for dealing with the background.  In the first
+case, FIT_BCKGRND, the background will be fitted by polynomials and
+the coefficients stored in the MULTISPEC data file.  These coefficients
+are then used by the other programs to estimate the background at the
+spectra.  The second option, FIND_BCKGRND, generates a background image in which
+the spectra and other selected areas are set to blank pixels.  Then a
+general image interpolator is used fill in the blank pixels with background
+estimates.  The other MULTISPEC programs will then access this background
+frame.  The background frame image name will be stored in the MULTISPEC
+data file and the image header.
+
+.ls fit_bckgrnd
+Fit a background in a MULTISPEC image by a polynomial using pixels
+not near the spectra and in the user specified swaths and columns.
+The buffer distance is in pixels and refers to a minimum distance from
+the center of any spectrum beyond which the background pixels are found.
+Blank pixels are ignored in the background fit.  Deviant pixels will be
+rejected.
+
+.nf
+                Multi-Spectra image  image = 
+                Buffer from spectra  buffer = 12
+                   Polynomial order  order = 3
+                    Lines per swath (lines_per_swath = 32)
+                      Swaths to fit (swaths = 1-1000)
+                     Columns to fit (columns = 1-1000)
+		Rejection threshold (threshold = 5)
+	  Print general diagnostics (verbose = no)
+                                    (mode = ql)
+.fi
+.le
+.ls find_bckgrnd
+The spectra within a buffer distance and specified areas are set to blank
+pixels and the remaining pixels copied to a background image file.
+
+.nf
+                Multi-Spectra image  image = 
+		   Background image  background =
+                Buffer from spectra  buffer = 12
+                    Lines to ignore (lines = )
+                  Columns to ignore (columns = )
+                                    (mode = ql)
+.fi
+.le
+.le
+.ke
+.ks
+.ls convolve
+A program will be provided to reduce either the extracted spectrum or
+the modeled image to a common point-spread function.
+.le
+.ke
+.ks
+.ls copy_params
+Create a MULTISPEC data file for a new image using
+appropriate MULTISPEC parameters from an old image.
+The old image must have been processed to find the spectra using FIND_SPECTRA
+and possibly model fit.
+
+.nf
+            Old Multi-Spectra image  old_image = 
+            New Multi-Spectra image  new_image = 
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls find_spectra
+Initially locate the spectra in a MULTISPEC image.
+The positions of the spectra within the range of columns are determined
+for the starting line and then the spectra are tracked within the
+range of lines.  The minimum separation
+and minimum width would generally be set for a particular instrument.
+If the automatic search is not used then a list of cursor positions is
+read from the standard input.
+
+.nf
+                Multi-Spectra image  image = 
+		   Automatic search  auto = yes
+		      Starting line  start_line =
+		 Minimum separation (min_sep = 1)
+		      Minimum width (min_width = 1)
+                    Averaging width (average = 32)
+                    Lines to search (lines = 1-1000)
+                  Columns to search (columns = 1-1000)
+	  Print general diagnostics (verbose = no)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls line_list
+For the specified lines in the image print the image column
+number, data value (possibly as a swath average), the model value at that
+point (i.e. the sum of the model contributions from all the spectra),
+the background value, and the residual.
+Plotting scripts may be written using this routine to
+show the quality of a model fit.
+
+.nf
+                Multi-Spectra image  image = 
+                      Lines to list (lines = 1-1000)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls model_extract
+A previously fitted model is used to extract the spectra total luminosity
+by apportioning the data values to spectra in the ratio indicated by the
+model.  If the clean option is specified then the model is used to detect
+pixels which deviate from the model by a specified amount.
+The model value replaces the deviant pixel in the extraction and, if specified,
+also in the image file.
+
+.nf
+                Multi-Spectra image  image = 
+                   Lines to extract (lines = 1-1000)
+                      Clean spectra (clean = yes)
+                 Cleaning threshold (threshold = 5)
+                       Modify image (modify = yes)
+	  Print general diagnostics (verbose = no)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls model_fit
+A specified model is iteratively fitted to the data in each of the specified
+lines (or swaths) until the RMS residual fails to decrease.  The models
+are selected by a string.  The possible values are
+
+.nf
+    (null string) - initialize the model
+    i - fit only the intensity scale
+    ip - fit the intensity scale and the position
+    ips1 - fit the intensity scale, position, and one parameter shape
+    ips2 - fit the intensity scale, position, and two parameter shape
+    ips3 - fit the intensity scale, position, and three parameter shape
+    ips4 - fit the intensity scale, position, and four parameter shape
+.fi
+These models will be combined in a script to search for the best fit.
+
+The initial shape parameters will generally be set by scripts for a
+particular data reduction.
+
+.nf
+                Multi-Spectra image  image = 
+                         Model type  model = 
+                    Lines per swath (lines_per_swath = 32)
+                    Swaths to model (swaths = 1-1000)
+		     Initial shape1 (shape1 = .1 )
+		     Initial shape2 (shape2 = 0 )
+		     Initial shape3 (shape3 = 0 )
+		     Initial shape4 (shape4 = 5 )
+	  Print general diagnostics (verbose = no)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls model_image
+An image file of the fitted model is created.  This image may then be displayed
+or a residual image may be calculated and displayed.
+
+.nf
+                Multi-Spectra image  image = 
+		        Model image  model =
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls model_list
+For the specified lines and spectra the model is listed.
+The listing gives, for each spectra,
+the spectrum number, the line number, the fitted position,
+the estimated wavelength, the
+extracted luminosity, the intensity scale, model width parameters, and
+the background polynomial coefficients.  This routine can be used in scripts
+to plot the extracted spectra, the trend of width with wavelength, and so
+forth.
+
+.nf
+                Multi-Spectra image  image = 
+                      Lines to list (lines = 1-1000)
+                    Spectra to list (spectra = 1-1000)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls sigma_extract
+A previously fitted model is used to extract the spectra luminosity
+within a specified sigma of the peak.  Because the model is not necessarily
+a Gaussian the sigma is used to compute
+the intensity ratio of the cutoff to the peak assuming a Gaussian profile
+and then the data is extracted to the point the model intensity falls below that
+cutoff.  If the clean option is specified then the model is used to detect
+pixels which deviate from the model by a specified amount.
+The model value replaces the deviant pixel in the extraction and, if specified,
+also in the image file.
+
+.nf
+                Multi-Spectra image  image = 
+             Sigma extraction width  width = 1.
+                   Lines to extract (lines = 1-1000)
+                      Clean spectra (clean = yes)
+                 Cleaning threshold (threshold = 5)
+                       Modify image (modify = yes)
+	  Print general diagnostics (verbose = no)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls strip_extract
+A strip of constant width about the spectra positions is extracted.
+If cleanning is desired a smoothed estimate of the profile is obtained
+by averaging a number of lines about the line to be cleaned.  After fitting
+for the intensity scale pixels are found which deviate from the profile by
+a specified amount.
+The profile value replaces the deviant pixel in the extraction and,
+if specified, also in the image file.  No prior modeling is required
+to use this extraction routine.
+
+.nf
+                Multi-Spectra image  image = 
+             Strip extraction width  width = 1.
+                   Lines to extract (lines = 1-1000)
+                      Clean spectra (clean = yes)
+                 Cleaning threshold (threshold = 5)
+          Lines per profile average (averge_lines = 32)
+                       Modify image (modify = yes)
+	  Print general diagnostics (verbose = no)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls to_iids
+For a specified prefix, files of the form prefix.nn, where nn is a specified
+spectra number, are created containing the extracted spectra for all
+the specified image files.  The format of the files is the IIDS format
+developed for the CYBER Multi-Aperture Plate Extractions.
+
+.nf
+                Multi-Spectra image  images = 
+               IIDS filename prefix  iids_file = 
+                  Spectra to format (spectra = 1-1000)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls to_image
+An image file containing one line of the extracted luminosities for each
+specified spectra in the specified MULTISPEC image.
+
+.nf
+                Multi-Spectra image  in_image = 
+            Extracted spectra image  out_image = 
+                            Spectra (spectra = 1-1000)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls to_onedspec
+The extractions are converted to an as yet to be specified format for
+use in the ONEDSPEC reduction package.
+
+.nf
+               Multi-Spectra images  images = 
+                 ONEDSPEC data file  onedspec_file = 
+                            Spectra (spectra = 1-1000)
+                                    (mode = ql)
+.fi
+.le
+.ke
+.sh
+4.2  General MULTISPEC CL Scripts
+
+     The general MULTISPEC CL scripts perform a series of steps needed to
+extract the spectra from a specified list of image files.  These steps have
+been found to generally perform the desired extraction task fully.
+
+
+.nf
+	multiap_extract		echelle_extract
+.fi
+.ks
+.ls multiap_extract
+The specified multi-aperture plate images are extracted.
+If no starting solution image, one which has previously been extracted,
+is specified then the script performs an automatic search for the
+specified number of spectra.
+Otherwise the solution from the starting image is used as the initial
+model.  The background is then determined.
+This is followed by a series of fitting steps on swaths of data.
+(For further details on the fitting steps see the Algorithms paper).
+A MODEL_EXTRACT and cleaning follows.
+Finally, the extraction is correlated with the specified aperture plate
+using AP_PLATE.
+If there was no starting image then this extraction becomes the
+initial solution image.
+Subsequent images are extracted starting from the initial solution image.
+
+.nf
+              Multi-Aperture images  images = 
+             Initial solution image  initial = 
+              Aperture plate number  plate = 
+                  Number of spectra  nspectra = 
+                                    (mode = ql)
+.fi
+.le
+.ke
+.ks
+.ls echelle_extract
+The specified echelle images are extracted.
+If no starting solution image, one which has previously been extracted,
+is specified then the script performs an automatic search for the
+specified number of orders.
+Otherwise the solution from the starting image is used as the initial
+starting point.  The background is then determined.
+Finally a STRIP_EXTRACT and cleaning is performed.
+If there was no starting image then this extraction becomes the
+initial solution image.
+Subsequent images are extracted starting from the initial solution image.
+
+.nf
+                     Echelle images  images = 
+             Initial solution image  initial = 
+                   Number of orders  norders = 
+		   Extraction width  width =
+                                    (mode = ql)
+.fi
+.le
+.sh
+5.  Outline of a MULTISPEC Reduction
+
+     The following outline is for the reduction of a cryogenic camera
+multi-aperture plate.  All the programmer supplied default values are
+used.
+
+.nf
+	(1)  rcamera mtb, "ap165.", "s", "3-9"
+	(2)  debias "ap165.*"
+	(3)  multispec_flat "ap165.[36]", "ap165.flat"
+	(4)  flat_divide "ap165.*", "ap165.flat"
+	(5)  multiap_extract "ap165.*", "", 165, 50
+	(6)  to_onedspec "ap165.*", oned165
+.fi
+
+.ls (1)
+The data is read from the observing tape(s) using RCAMERA.
+The image files created are ap165.3, ap165.4, ..., ap165.9.  This is
+easily accomplished by using the filename prefix "ap165." in the RCAMERA
+program.  The raw images may be examined at this point on a display.
+.le
+.ls (2)
+The images are debiased using DEBIAS with all the "ap165." files specified.
+The debias program knows about the location of the bias strip for the
+cryogenic camera.
+.le
+.ls (3)
+A a flat field is created
+using MULTISPEC_FLAT in which the desired quartz frames are specified
+and a flat field image filename is defined.  The created flat field
+image may be examined on an image display if desired.
+.le
+.ls (4)
+All the debiased images are divided by the flat field using FLAT_DIVIDE.
+.le
+.ls (5)
+The script MULTIAP_EXTRACT is run in which the aperture plate number,
+the number of spectra, and the image files to be extracted are specified.
+The number of spectra is found by examining an image on an image display
+or by plotting a cut across the spectra using a general image profile
+program.
+.le
+.ls (6)
+Finally, the extracted spectra are formatted for the ONEDSPEC package
+using TO_ONEDSPEC with the extracted images specified.
+.le
+.endhelp
diff --git a/noao/twodspec/multispec/doc/MSspecs_c.hlp b/noao/twodspec/multispec/doc/MSspecs_c.hlp
new file mode 100644
index 00000000..848d589d
--- /dev/null
+++ b/noao/twodspec/multispec/doc/MSspecs_c.hlp
@@ -0,0 +1,243 @@
+
+.help multispec Nov82 "Multispec Specifications"
+.ce
+Comments on Multispec Package Specifications
+.ce
+November 8, 1983
+
+
+
+    The basic package structure and the decomposition of the package into
+tasks looks good.  The requirements for both general operators and canned
+procedures are addressed well.  I got the impression that you have a pretty
+clear idea of what you want to do (which is the thing I am most looking for
+when I read a specs document), but I confess to having to reread the document
+several times to figure out what you have in mind.  Your writing style is
+very terse and leaves much up to the reader!
+
+Most of my comments have to do with details.  These are presented in the
+order in which they occurred while reading the document.  These comments
+apply only to the specs document.  I have started going over the algorithms
+paper, mostly when I could not understand a section of the specs document,
+but I have not finished it yet.
+
+.sh
+General Comments
+.ls 4
+.ls (1)
+When eventually we write the user documentation, the nomenclature
+should be carefully explained up front.  Users will tend to confuse
+image lines and spectral lines, but there is little we can do about
+that other than to make the distinction clear.  The term "band" is
+confusing because it normally refers to the third dimension of an
+image and that is not how it is used here.  A better term might be
+"swath".  In what follows I will continue to use the term band, but
+it is definitely not too late to change.
+.le
+.ls (2)
+It seems to me that the concept of a band or swath is a detail of how
+the algorithm works and should not have such a prominent place in the
+user interface to the package.  Several of the routines require that
+image coordinates be entered in units of band number and column.
+This introduces an unnecessary coupling between two input parameters
+and forces the user to convert from line number to band number.  The
+result will be that the user will be reluctant to change the number
+of lines per band (I'll bet that you have kept this a constant in
+using the prototype).  My inclination would be to have the user enter
+all coordinates in units of lines and columns, and have the program
+select the nearest band depending on the band width parameter.
+The band width could then be easily changed depending on the data,
+without need to respecify the region of the image to be processed.
+.le
+.ls (3)
+Routines all over the system will have an option for printing extra
+information, i.e., a verbose mode of execution.  I think we should
+standardize on the name of this parameter.  "Verbose" seems to me
+more descriptive than "print", and is consistent with UNIX terminology.
+.le
+.le
+
+.sh
+Pages 3,4
+.ls
+.ls (1)
+Functions for extracting spectra.  I assume "strips of constant
+width" means aperture sum out to a specified x-radius from the
+center of a spectra.  Can the radius be specified in fractional
+pixels, and if so, does the routine do fractional pixel interpolation.
+What happens if there are blank pixels in the aperture?
+
+If extraction is based on the model, I gather that you are still
+summing data pixel values, using a weight for each spectra based
+on the modeled contribution of each spectra to the data pixel.  In
+other words we are still taking an aperture sum, but with allowances
+for crowding.  This has the disadvantage that if we sum way out into
+the wings, we will be adding noise to the aperture sum, degrading signal
+to noise.
+
+Extraction based on integration of the model rather than
+the data should be available as another extraction procedure; this may
+yield better photometric results.  I would eventually like to compare
+the two approaches with artificial data.  Also by integrating the model
+there is no need to "clean" (I assume that deviant pixels are detected
+and rejected when the model is fitted, or the model will not be
+accurate).  Blank pixels should be recognized and ignored when fitting
+the model.
+.le
+
+.ls (2)
+I gather that all extracted spectra for an image are put into a single
+imagefile.  This is fine, even desirable, as long as it is ok if all
+spectra share the same header, and as long as all we want to output
+is intensity versus wavelength.  If it is desired to also output the
+signal to noise or whatever than another scheme may be needed.
+.le
+.ls (3)
+The text file output form ('c'pg.4) should be engineered with the idea
+that the user will take the data away in cardimage form.  From the
+description it sounds like there is one pixel (wavelength bin) per
+line in the text file.  This has its advantages, but is not what one
+wants for a cardimage file, which always writes 80 chars per line.
+Also, the detailed technical specs should give some details about
+such a format; it is a major part of the user interface and people
+will want to know what this format is going to look like.  In a way
+it is more important to specify formats like this than the calling
+sequences of the tasks, because it is harder to change after the
+package is released, and other program are written to read the
+text format spectra.
+.le
+.ls (4)
+To item 3.2 (2) (on uncertainty estimates) I would add "as a function
+of position along the spectrum".
+.le
+.le
+
+.sh
+4.1 Basic Programs
+.ls
+.ls (1)
+Evidently there is a datafile associated with each image.  What is
+the function of the datafile?  Is it transparent to the user?  How
+much is stored in the image header and how much in the datafile?
+.le
+.ls (2)
+The distinction between "line_list" and "model_list" is confusing.
+Does "line_list" print the sum of the models for all the spectra
+a each column?  Please specify the form of the output for this
+procedure in more detail.  The line_list and model_list procedures
+are natural candidates for use with the "lists" utilities for
+extracting columns, plotting one column against another, etc. I
+could not tell whether or not this would work well from the info
+given.
+.le
+.ls (3)
+"ap_plate":  "The identifications for the spectra ... is recorded."
+Is recorded where?  In the datafile?  Is this information essential
+to the operation of multispec, or is it merely passed on through
+multispec?
+.le
+.ls (4)
+"find_background":  Might be more aptly named "fit_background".
+I would expect "find" to mean find which regions of the image are
+background and which are spectra.  Find is spatial, fit is grayscale.
+
+We need to decide whether we want to specify polynomials in IRAF by
+the order (0,1,2, etc.) or by the number of coefficients or terms.
+It seems to me that people are most used to talking about second,
+third, fifth etc. order polynomials and that we might better specify
+polynomials with an "order" parameter rather than a "terms" param.
+
+Buffer radius or diameter?  I would assume radius, but it is not
+clear from the docs.  What is being "searched"?  Shouldn't that read
+"bands to be fitted".  The "colummns" parameter should permit a list
+of ranges of columns; I couldn't tell whether this was the case
+from the specs.  Cursor input may be desirable here.
+
+Blank pixels should be detected and ignored when fitting the
+background.  Are deviant pixels detected and rejected?  This is
+generally a desirable option in a bkg fit.  You may be able to
+decompose this routine (internally) into a find_background and
+a fit_background, making use of the Images background fitting
+routines, though these generate an image as output rather than the
+coeff of the fitted functions.  I wuld guess that you are storing
+the bkg coeff for each band in the datafile from the description,
+and that the fit is strictly one-dimensional.
+
+If only a limited number of bands are fitted, what do you do about
+the other bands if the bkg fit is one-dimensional?  Is the user
+req'd to use the same bands range when they do the extraction?
+.le
+
+.ls (5)
+"find_spectra".  It is not clear how this routine uses cursor input.
+Perhaps you should have a gcur type parameter.  Reading cursor
+coordinates from the standard input may be the way to go, but you
+should explain how this is going to work.
+.le
+.ls (6)
+"line_list".  One output line per image line?  One or more spectra
+per output line?  Output should be suitable for further processing
+with the LISTS package utilities (i.e., getcol, and the graphics
+utility which will plot or overplot lists).  The specs should
+specify the form of the output.
+.le
+.ls (7)
+I assume that the extraction procedures extract spectra which
+are put somewhere.  Where, in the datafile?  If the image is
+to be cleaned, it would be safer to write a new output image,
+or at least to rename the original.  It is strange to have these
+two quite different functions in the same module.
+.le
+.ls (8)
+"model_fit".  The range of modeling options is impressive, good
+stuff.  However, there must be something better than magic integer
+numbers for specifying the model to be fitted.  Perhaps the
+strings  "i, ip, ipw, ipw2, ipw3, ipw4", where 'i' is for intensity,
+'p' for position, and 'w' for width.
+
+How are the "initial parameters" specified?
+.le
+.ls (9)
+"model_list".  Again, I can only guess from the description what the
+output will look like.  It sounds like it might be best to have
+this routine print data for only one spectra at a time, particularly
+if the lists package is to be used for analysis.  It might be good
+to have the line number in the output somewhere, especially if the
+wavelength information is not available.
+.le
+.le
+
+.sh
+4.2 Scripts
+.ls
+.ls (1)
+It sounds like there is no easy alternative to an automatic search
+for the line centers.  This is best as long as it works, but the
+users will want easy way to use the cursor available as an option.
+A script such as this can easily use the line plot routine Images
+to make a plot and generate a list of line centers, without even
+requiring find_spectra to be able to access the cursor (and perhaps
+it should not if the script can do it).  The graphics cursor should
+be used here rather than the image cursor.
+.le
+.le
+
+.sh
+5. Example
+.ls
+.ls (1)
+The rcamera example is in error.  Rcamera, as implemented, has only
+three query mode params, while you show four in the example.
+I believe the ranges string should be quoted and should be the second
+argument.
+
+The last command should be "to_onedspec", not "onedspec".
+.le
+.ls (2)
+5.(5): It seems strange to make the user manually count 50 spectra
+by examining a plot.  If the program automatically finds centers,
+this should not be necessary; if the user interactively marks centers,
+it is not necessary.
+.le
+.le
+.endhelp
diff --git a/noao/twodspec/multispec/doc/findpeaks.hlp b/noao/twodspec/multispec/doc/findpeaks.hlp
new file mode 100644
index 00000000..f6118281
--- /dev/null
+++ b/noao/twodspec/multispec/doc/findpeaks.hlp
@@ -0,0 +1,88 @@
+.help findpeaks Jul84 noao.twodspec.multispec
+.ih
+NAME
+findpeaks -- Find peaks in a multi-spectra image
+.ih
+USAGE
+findpeaks image lines contrast
+.ih
+PARAMETERS
+.ls image
+Image to be searched.
+.le
+.ls lines
+Sample image lines in which the peaks are to be found.
+.le
+.ls contrast
+Maximum contrast between the highest peak and the lowest peak.
+.le
+.ls separation = 5
+Minimum separation in pixels between acceptable peaks.
+.le
+.ls edge = 0
+Minimum distance in pixels to the edge of the image for acceptable peaks.
+.le
+.ls threshold = 0.
+The minimum acceptable peak pixel value.
+.le
+.ls min_npeaks = 1
+Minimum number of peaks to be found.  It is an error for fewer than
+this number of peaks to be found.
+.le
+.ls max_npeaks = 1000
+Maximum number of peaks to be found.  If more than this number of peaks
+is found then only the those with the highest peak values are accepted.
+.le
+.ls columns = '*'
+Columns to be searched.
+.le
+.ls naverage = 20
+Number of image lines around the sample line to be averaged before
+finding the peaks.
+.le
+.ls debug = no
+Print detailed information on the progress of the peak finding algorithm.
+.le
+.ih
+DESCRIPTION
+For each specified sample image line the number of peaks and their column
+positions in the image are determined.
+The number of peaks and their positions are assumed to correspond to points
+along the spectra.  This information is entered in the MULTISPEC database.
+
+The \fInaverage\fR image lines about the specified sample line are first
+averaged.  The local maxima in the average line are then located
+in the specified columns more than the minimum distance from the edge of the
+image.  A minimum peak pixel value cutoff is determined as the maximum of
+the specified \fIthreshold\fR and \fIcontrast\fR times the largest peak pixel
+value.  All local maxima with pixel values below the cutoff are rejected.
+Next all peaks with separations less than \fIseparation\fR from a stronger
+peak are rejected.  Finally, if there are more than \fImax_npeaks\fR remaining
+only the \fImax_npeaks\fR strongest peaks are accepted.  If fewer
+than \fImin_npeaks\fR are found then the task quits with an error.
+
+If the number of spectra has been previously determined, such as by an earlier
+use of \fBfindpeaks\fR, then it is an error if a different number of
+peaks is found.
+.ih
+EXAMPLES
+The parameters of this task provide a great deal of flexibility in
+automatically determining the number and positions of the peaks.  
+The most automatic method just uses the contrast to limit the acceptable
+peaks:
+
+	cl> findpeaks image.db 1 .1
+
+However, if the number of spectra in the image is known:
+
+	cl> findpeaks image.db 1 0 min=10 max=10
+
+or if a threshold is known:
+
+	cl> findpeaks image.db 1 0 threshold = 1000
+
+For a noisy image the separation parameter can be set to eliminate spurious
+noise peaks near the peaks to be found:
+
+	cl> findpeaks image.db 1 .1 sep=20
+.endhelp
diff --git a/noao/twodspec/multispec/doc/fitfunc.hlp b/noao/twodspec/multispec/doc/fitfunc.hlp
new file mode 100644
index 00000000..09510bb7
--- /dev/null
+++ b/noao/twodspec/multispec/doc/fitfunc.hlp
@@ -0,0 +1,73 @@
+.help fitfunction Jul84 noao.twodspec.multispec
+.ih
+NAME
+fitfunction -- Fit a function to the spectra parameter values
+.ih
+USAGE
+fitfunction image
+.ih
+PARAMETERS
+.ls image
+Image in which the parameter values are to be fitted.
+.le
+.ls parameter = "x0"
+Parameter to be fit.  The legal minimum match abbreviated parameters
+are x0, s0, s1, s2.
+.le
+.ls lines = "*"
+Sample image lines to be used in the function fit.
+.le
+.ls spectra = "*"
+Spectra for which the parameters are to be fit.
+.le
+.ls function = "interpolation spline"
+Fitting function to be used.  The function is specified as a string
+which may be minimum match abbreviated.  The functions currently available
+are:
+.ls interpolation spline
+Interpolation spline of specified order.
+.le
+.ls smoothing spline
+Smoothing spline of specified order and number of polynomial pieces.
+.le
+.le
+.ls spline_order = 4
+Order of the fitting spline.  The order must be even.
+The minimum value is 2 and maximum value is determined from the number of
+sample lines in the fit.
+.le
+.ls spline_pieces = 1
+The number of polynomial pieces in a smoothing spline.
+The minimum value is 1 and the maximum value is determined from the number of
+sample lines in the fit.
+.le
+.ih
+DESCRIPTION
+A function is fit to the parameter values previously determined at the sample
+lines for each spectrum.  The function coefficients are stored in the
+database and the fitted values replace the original values at all the sample
+lines (not just the sample lines used in the fit).  The type of function,
+the parameter to be fitted, the sample lines used in the fit, and the
+spectra to be fitted are all selected by the user.  The function is
+extrapolated to cover all image lines.
+
+The values of the function fit at arbitrary image lines may be listed
+with \fBmslist\fR.
+.ih
+EXAMPLES
+The extraction of the spectra requires that a fitting function be
+determined for the spectra positions.  This is done by:
+
+	cl> fitfunction image
+
+To smooth the parameter "s0" in model \fIgauss5\fR with a cubic spline
+and leave out a bad point at sample line 7:
+
+.nf
+	cl> fitfunction image parmeter=s0 function=smooth \
+	>>> lines="1-6,8-"
+.fi
+.ih
+SEE ALSO
+mslist
+.endhelp
diff --git a/noao/twodspec/multispec/doc/fitgauss5.hlp b/noao/twodspec/multispec/doc/fitgauss5.hlp
new file mode 100644
index 00000000..bcb37276
--- /dev/null
+++ b/noao/twodspec/multispec/doc/fitgauss5.hlp
@@ -0,0 +1,148 @@
+.help fitgauss5 Jul84 noao.twodspec.multispec
+.ih
+NAME
+fitgauss5 -- Fit spectra profiles with five parameter Gaussian model
+.ih
+USAGE
+fitgauss5 image start
+.ih
+PARAMETERS
+.ls image
+Image to be modeled.
+.le
+.ls start
+Starting sample line containing the initial model parameters.
+.le
+.ls lower = -10
+Lower limit for the profile fit relative to each spectrum position.
+.le
+.ls upper = 10
+Upper limit for the profile fit relative to each spectrum position.
+.le
+.ls lines = "*"
+Sample image lines to be fit.
+.le
+.ls spectra = "*"
+Spectra to be fit.
+.le
+.ls naverage = 20
+Number of data lines to be averaged about each sample image line before
+model fitting.
+.le
+.ls factor = 0.05
+The model fit to each line is iterated until the RMS error between the
+model line and the data line improves by less than this factor.
+.le
+.ls track = yes
+Track the model solution from the starting line to the other sample lines?
+.le
+.ls algorithm = 1
+Parameter fitting algorithm to use.  Legal values are 1 and 2.
+.le
+.ls fit_i0 = yes
+Fit the profile scale parameters i0?
+.le
+.ls fit_x0 = yes
+Fit the spectra position parameters x0?
+.le
+.ls fit_s0 = yes
+Fit the spectra shape parameters s0?
+.le
+.ls fit_s1 = no
+Fit the spectra shape parameters s1?
+.le
+.ls fit_s2 = no
+Fit the spectra shape parameters s2?
+.le
+.ls smooth_s0 = yes
+Fit a smoothing spline to the shape parameters s0 after each iteration?
+.le
+.ls smooth_s1 = yes
+Fit a smoothing spline to the shape parameters s1 after each iteration?
+.le
+.ls smooth_s2 = yes
+Fit a smoothing spline to the shape parameters s2 after each iteration?
+.le
+.ls spline_order = 4
+Order of the smoothing spline to be fit to the shape parameters.
+.le
+.ls spline_pieces = 3
+Number of polynomial pieces for the smoothing spline.
+.le
+.ls verbose = no
+Print general information about the progress of the model fitting.
+.le
+.ih
+DESCRIPTION
+The spectra profiles in the interval (\fIlower, upper\fR) about each
+spectrum position are fit with a five parameter Gaussian model for
+the specified sample lines of the image.  For a description of
+the model see \fBgauss5\fR.  The model fitting is performed using 
+simultaneous linearized least squares on the selected model profile
+parameters as determined by the \fIalgorithm\fR for the specified
+\fIspectra\fR.  The parameter fitting technique computes correction
+vectors for the parameters until the RMS error of the model image line
+to the data image line, which is an average of \fInaverage\fR lines
+about the sample line, improves by less than \fIfactor\fR.
+A solution which increases the RMS error of the model is not allowed.
+
+If the parameter \fItrack\fR is yes then the initial model parameters are
+those given in the database for the sample line \fIstart_line\fR.  From
+this starting point the model parameters are iterated to a best fit at
+each specified sample line and then the best fit is used as the starting
+point at the next line.  The tracking sequence is from the starting line
+to the last line and then, starting again from the starting line, to
+the first line.  Note that the model parameters, including the starting
+spectra positions, need be set only at the starting line.
+
+If \fItrack\fR is no then each specified sample line is fitted independently
+from the initial model parameters previously set for that line.  This option
+is used to add additional parameters to the model after an
+initial solution has been obtained or to refit a new image whose database
+was created as a copy of the database of a previously fit image.
+
+The shape parameters s0, s1, and s2 can be smoothed by fitting a spline of
+specified \fIorder\fR and number of spline pieces, \fInpp\fR to the
+parameters as a function of spectra position.
+The smoothing is performed after each iteration and before
+computing the next RMS error.  The smoothing is a form of local constraint
+to keep neighboring spectra from having greatly different shapes.
+The possibility of such erroneous solutions being obtained is present in
+very blended data.
+
+In \fIverbose\fR mode the RMS errors of each iteration are printed on the
+standard output.
+
+The selection of the parameters to be fit and the order in which they are
+fit is determined by \fIalgorithm\fR.  These algorithms are:
+
+.ls 4 1
+This algorithm fits the selected parameters (\fIfit_i0, fit_x0,
+fit_s0, fit_s1, fit_s2\fR) for the selected \fIspectra\fR simultaneously.
+.le
+.ls 4 2
+This algorithm begins by fitting the parameters i0, x0, and s0
+simultaneously.  Note that the values of s1 and s2 are used but are
+kept fixed.  Next the parameters s0 and s1 (the shape) are fit simultaneously
+keeping i0, x0, and s2 fixed followed by fitting i0 and x0 while
+keeping s0, s1, and s2 (the shape) fixed.  If either of these fits
+fails to improve the RMS then the algorithm terminates.
+Also, if after the two steps (the fit of s0 and s1 followed by the fit
+of i0 and x0), the RMS of the fit has not improved by more than the
+user specified factor the algorithm also terminates.  This algorithm has been
+found to be the best way to fit highly blended spectra.
+.le
+.ih
+EXAMPLES
+The default action is to fit Gaussian profiles to the spectra and trace
+the fit from the starting line.  An example of this is:
+
+	cl> fitgauss5 image 1
+
+To fit heavily blended spectra with the four parameter model (i0, x0, s0, s1):
+
+	cl> fitgauss5 image 1 algorithm=2
+.ih
+SEE ALSO
+findspectra
+.endhelp
diff --git a/noao/twodspec/multispec/doc/modellist.hlp b/noao/twodspec/multispec/doc/modellist.hlp
new file mode 100644
index 00000000..70e95ce4
--- /dev/null
+++ b/noao/twodspec/multispec/doc/modellist.hlp
@@ -0,0 +1,52 @@
+.help modellist Jul84 noao.twodspec.multispec
+.ih
+NAME
+modellist -- List data and model pixel values
+.ih
+USAGE
+modellist image lines
+.ih
+PARAMETERS
+.ls image
+Image whose model is to be listed.
+.le
+.ls lines
+Sample lines to be listed.
+.le
+.ls model = "gauss5"
+Profile model to be used to create the model line.
+The only model currently defined is \fIgauss5\fR.
+.le
+.ls columns = "*"
+Image columns to be listed.
+.le
+.ls naverage = 20
+The number of image lines to be averaged to form the data values.
+.le
+.ls lower = -10
+Lower limit of model profiles measured in pixels from the spectra centers.
+.le
+.ls upper = 10
+Upper limit of model profiles measured in pixels from the spectra centers.
+.le
+.ih
+DESCRIPTION
+The model of the image for the selected sample \fIlines\fR
+are used to generate model image lines.  Only the model \fIgauss5\fR is
+currently available.  The output format is column, sample line, image pixel
+value, and model pixel value.  The image pixel data are formed by averaging
+\fInaverage\fR lines about the sample lines.
+.ih
+EXAMPLES
+To list the image and model pixel values for the first sample line after
+fitting the \fIgauss5\fR model with \fBfitgauss5\fR:
+
+	cl> modellist image 1 >outputlist
+
+The list file \fIoutputlist\fR can be used with the \fBlists\fR and
+\fBplot\fR packages to graph the image and model lines or to compute
+and graph residuals.
+.ih
+SEE ALSO
+newimage
+.endhelp
diff --git a/noao/twodspec/multispec/doc/msextract.hlp b/noao/twodspec/multispec/doc/msextract.hlp
new file mode 100644
index 00000000..fa361b38
--- /dev/null
+++ b/noao/twodspec/multispec/doc/msextract.hlp
@@ -0,0 +1,172 @@
+.help msextract Jul84 noao.twodspec.multispec
+.ih
+NAME
+msextract -- Extract spectra from a multi-spectra image
+.ih
+USAGE
+msextract image output
+.ih
+PARAMETERS
+.ls image
+Image to be extracted.
+.le
+.ls output
+Filename for the three dimensional image to be created containing the
+extracted spectra.
+.le
+.ls lower = -10
+Lower limit of the integral for integrated spectra or the first column of the
+strip spectra.  It is measured in pixels from the spectrum center
+defined by the position function in the MULTISPEC database.
+.le
+.ls upper = 10
+Upper limit of the integral for integrated spectra or (approximately) the
+last column of the strip spectra.  It is measured in pixels from the
+spectrum center defined by the position function in the MULTISPEC database.
+.le
+.ls spectra = "*"
+Spectra to be extracted.
+.le
+.ls lines = "*"
+Image lines to be extracted.
+.le
+.ls ex_model = no
+Extract model spectra fit to the image spectra?
+.le
+.ls integrated = yes
+Extract integrated spectra?
+.le
+.ls unblend = no
+Correct for blending in the extracted spectra?
+.le
+.ls clean = yes
+Replace bad pixels with model values?  The following parameters are used:
+.ls  nreplace = 1000.
+Maximum number of pixels to be replaced per image line when cleaning with
+model \fIgauss5\fR or maximum number of pixels to be replaced per spectrum when
+cleaning with model \fIsmooth\fR.
+.le
+.ls sigma_cut = 4.
+Cleaning threshold in terms of sigma of the fit.
+.le
+.ls niterate = 1
+Maximum number of cleaning iterations per line when cleaning with model
+\fIgauss5\fR.
+.le
+.le
+.ls model = "smooth"
+Choice of \fIgauss5\fR or \fIsmooth\fR.  Minimum match abbreviation is
+allowed.  This parameter is required only if \fIex_model\fR = yes
+or \fIclean\fR = yes.
+.le
+.ls naverage = 20
+Number of lines to be averaged in model \fIsmooth\fR.
+.le
+.ls fit_type = 2
+Model fitting algorithm for model \fIgauss5\fR.
+.le
+.ls interpolator = "spline3"
+Type of image interpolation function to be used.
+The choices are "nearest", "linear", "poly3", "poly5", and "spline3".
+Minimum match abbreviation is allowed.
+.le
+.ls verbose = no
+Print verbose output?
+.le
+.ih
+DESCRIPTION
+The MULTISPEC database describing the spectra positions and shapes
+is used to guide the extraction of the spectra in the multi-spectra image.
+The user selects the \fIspectra\fR and image
+\fIlines\fR to be extracted and whether to extract integrated or strip spectra.
+In addition options are available to extract model spectra, replace bad
+pixels by model spectra values, and correct for blending of the spectra.
+The \fIoutput_file\fR three dimensional
+image consists of one band (the third dimension) per extracted spectrum,
+the extracted lines (the second dimension) and either one column for
+the integrated luminosity or the number of columns in the extracted strip.
+
+Integrated spectra (\fIintegrated\fR = yes) are extracted by summing
+the pixel or model values over the specified limits \fIlower\fR and \fIupper\fR
+measured relative to the spectra centers defined by the position functions in
+the database.  Partial pixel sums are used at the endpoints.
+
+Strip spectra (\fIintegrated\fR = no) are extracted by image interpolation
+of the image line or model profiles to obtain a line of values for
+each spectrum and for each image line.  The length of the strip is the
+smallest integer containing the interval between \fIlower\fR and \fIupper\fR.
+The strips for each spectrum are aligned so that the first column is a distance
+\fIlower\fR from the spectrum center as given by the position function in the
+database.
+
+If \fIex_model\fR = yes, \fIunblend\fR = yes, or \fIclean\fR = yes model
+spectra are fit to the spectra in the image.  There are two models:
+a five parameter Gaussian profile called \fIgauss5\fR and profiles obtained
+by averaging \fInaverage\fR image lines surrounding the image line being
+modeled called \fIsmooth\fR.  The model is selected either when the parameter
+\fIunblend\fR = yes or with the parameter \fImodel\fR.  If \fIunblend\fR = yes
+then the model is \fIgauss5\fR regardless of the value of \fImodel\fR.
+
+When \fIex_model\fR = yes the effect is to substitute model spectra for the
+image spectra in the output extraction image.
+
+When \fIclean\fR = yes pixels with large residuals from the model are
+detected and removed from the model fit.  The selected model is
+fit to the pixels which are not in the bad pixel list (not yet implemented)
+and which have not been removed from the model fit.  The sigma of the fit
+is computed.  Deviant pixels are detected by comparing them to the model
+to determine if they differ by more than \fIsigma_cut\fR times the sigma.
+The model fit is iterated, removing deviant pixels at each iteration, until
+no more pixels are found deviant or \fInreplace\fR pixels have been found.
+The pixels removed or in the bad pixel list are then replaced with
+model values.  (To clean an image with this algorithm see \fBnewimage\fR.)
+
+There are some technical differences in the model fitting and cleaning
+algorithms for the two models.  In model \fIsmooth\fR
+the fit for the profile scale factors is done independently for each spectrum
+and automatically corrected when a bad pixel is detected.  This fitting process
+is fast and rigorous.  The parameter \fInreplace\fR in this model refers to
+the maximum number of pixels replaced \fIper spectrum\fR.
+
+In model \fIgauss5\fR, however, the profile scale factors are fit
+to the entire image line (hence its ability to fit blended spectra).
+There are two fitting algorithms; a rigorous simultaneous fit
+and an approximate method.  The simultaneous fit is selected when
+\fIfit_type\fR = 1.  This step is relatively slow. The
+alternative method of \fIfit_type\fR = 2 sets the scale factor for each
+spectrum by taking the median scale, where scale = data / model profile,
+for the three pixels nearest the center of the profile.  The median
+minimizes the chance of a large error due to a single bad pixel.  This
+scale may be greatly in error in the case of extreme blending but is also
+quite fast; the extraction time is reduced by at least 40%.
+The steps of profile fitting and deviant pixel detection are alternated
+and the maximum number of iterations through these two steps is
+set by \fIniterate\fR.  The default of 1 means that the model fitting is not
+repeated after detecting deviant pixels.
+
+When \fIunblend\fR = yes the \fIgauss5\fR model
+is fitted to the image spectra (including possible cleaning).
+The relative contributions to the total image pixel value from each of the
+blended spectra are determined from the model and applied toward either the
+integrated or strip spectra.  If \fIex_model\fR = yes then this option has
+no effect other than to force the selection of model \fIgauss5\fR.
+
+The option \fIverbose\fR is used to print the image lines being extracted
+and the number of pixels replaced by the cleaning process.
+.ih
+EXAMPLES
+To extract all the integrated spectra from all the image lines:
+
+	cl> msextract image image.ms
+
+To extract model strip spectra:
+
+	cl> msextract image image.ms ex_model=yes int=no
+
+To extract integrated spectra without any modeling:
+
+	cl> msextract image image.ms clean=no
+.ih
+SEE ALSO
+newimage
+.endhelp
diff --git a/noao/twodspec/multispec/doc/mslist.hlp b/noao/twodspec/multispec/doc/mslist.hlp
new file mode 100644
index 00000000..461b52b4
--- /dev/null
+++ b/noao/twodspec/multispec/doc/mslist.hlp
@@ -0,0 +1,77 @@
+.help mslist Jul84 noao.twodspec.multispec
+.ih
+NAME
+mslist -- List entries in a MULTISPEC database
+.ih
+USAGE
+mslist image keyword lines spectra
+.ih
+PARAMETERS
+.ls image
+Image whose MULTISPEC database entries are to be listed.
+.le
+.ls keyword
+Keyword for the database entry to be listed.  The keywords are:
+.ls header
+List general header information.
+.le
+.ls comments
+List the comments.
+.le
+.ls samples
+List the sample image lines.
+.le
+.ls x0
+List the spectra positions for the specified sample lines and spectra.
+.le
+.ls i0
+List the model profile scales for the specified sample lines and spectra.
+.le
+.ls s0, s1, or s2
+List the gauss5 model shape parameter s0, s1, or s2 for the specified sample
+lines and spectra.
+.le
+.ls gauss5
+List the gauss5 model parameters x0, i0, s0, s1, and s2 for the specified
+sample lines and spectra.
+.le
+.ls x0 spline
+List the spline evaluation of the spectra positions for the specified
+image lines and spectra.
+.le
+.ls s0 spline, s1 spline, or s2 spline
+List the spline evaluation of the gauss5 model shape parameters s0, s1, or s2
+for the specified image lines and spectra.
+.le
+.le
+.ls lines
+Lines to be listed.  For the entries x0, i0, s0, s1, s2, and gauss5 the
+lines refer only to the sample image lines. For the spline entries the
+lines refer to the image lines at which the spline is to be evaluated.
+.le
+.ls spectra
+Spectra to be listed.
+.le
+.ls titles = no
+Print additional titles?
+.le
+.ih
+DESCRIPTION
+This task is a general MULTISPEC database listing tool.  A keyword is selected
+and the referenced data is listed.  Some entries require the specification of
+the desired sample or image lines and the desired spectra.
+.ih
+EXAMPLES
+To list the spectra positions for spectrum 3 at all the sample lines:
+
+	cl> mslist image x0 "*" 3
+
+To list the model profile scale parameter for sample line 1:
+
+	cl> mslist image i0 1 "*"
+
+To list the gauss5 model parameters for spectra 2 and 3 and sample lines 5
+and 7:
+
+	cl> mslist image gauss5 "5,7" "2-3" titles+
+.endhelp
diff --git a/noao/twodspec/multispec/doc/msplot.hlp b/noao/twodspec/multispec/doc/msplot.hlp
new file mode 100644
index 00000000..f08eac1b
--- /dev/null
+++ b/noao/twodspec/multispec/doc/msplot.hlp
@@ -0,0 +1,44 @@
+.help msplot Oct85 noao.twodspec.multispec
+.ih
+NAME
+msplot -- Plot data and model image line
+.ih
+USAGE
+msplot image line
+.ih
+PARAMETERS
+.ls image
+Image to be plotted.
+.le
+.ls line
+The image line to be plotted.  Actually the nearest sample line will be
+plotted.
+.le
+.ls naverage = 20
+Number of image lines to average about the specified line.
+.le
+.ls lower = -10., upper = 10.
+Limits of the model profiles relative to the center of each profile.
+.le
+.ls graphics = "stdgraph"
+Graphics output device.
+.le
+.ls cursor = ""
+Graphics cursor input.  If a file is given then the cursor input is taken
+from the file.  If no file is given then the standard graphics cursor will
+be used.
+.le
+.ih
+DESCRIPTION
+A line of image data and the profile model for the line is graphed.
+The model is graphed with a dashed line.  The graph may be then expanded,
+manipulated, and printed with the standard cursor mode commands.
+.ih
+EXAMPLES
+To plot the model fit for image sample for image line 400:
+
+	cl> msplot sample 400
+.ih
+SEE ALSO
+modellist
+.endhelp
diff --git a/noao/twodspec/multispec/doc/msset.hlp b/noao/twodspec/multispec/doc/msset.hlp
new file mode 100644
index 00000000..689e525a
--- /dev/null
+++ b/noao/twodspec/multispec/doc/msset.hlp
@@ -0,0 +1,104 @@
+.help msset Jul84 noao.twodspec.multispec
+.ih
+NAME
+msset -- Set entries in a MULTISPEC database
+.ih
+USAGE
+msset image keyword value
+.ih
+PARAMETERS
+.ls image
+Image in which the MULTISPEC database entries are to be modified or initialized.
+.le
+.ls keyword
+Keyword for the database entry to be set.  The keywords are:
+.ls nspectra
+Set the number of spectra in the header.
+.le
+.ls comments
+Add comments lines to the database comment block.
+.le
+.ls x0
+Set the spectra positions for the specified sample lines and spectra.
+.le
+.ls i0
+Set the model profile central intensities for the specified sample lines
+and spectra.
+.le
+.ls s0, s1, or s2
+Set the gauss5 model shape parameter s0, s1, or s2 for the specified sample
+lines and spectra.
+.le
+.le
+.ls value
+Value to be used for value input.
+.le
+.ls lines = "*"
+Sample lines to be affected by value input.
+.le
+.ls spectra = "*"
+Spectra to be affected by value input.
+.le
+.ls read_list = no
+If yes use list input and if no use value input.
+.le
+.ls list = ""
+List for list input.  See the description below for the appropriate format.
+.le
+.ih
+DESCRIPTION
+The entries in a MULTISPEC database associated with the image
+are modified or initialized.
+The parameters \fIimage\fR, \fIkeyword\fR, and \fIread_list\fR 
+determine the database to be operated upon, the database entry to
+be set, and the input type.  There are two forms of input;
+list input and value input.
+The input type is selected by the boolean parameter
+\fIread_list\fR.  For list input the parameter \fIlist\fR
+is used and for value input the parameter \fIvalue\fR and
+possibly the parameters \fIlines\fR and \fIspectra\fR are used.
+The required parameters and input formats for the different keywords
+are outlined below.
+.ls nspectra
+For list input the list format is the number of spectra and
+for value input the \fIvalue\fR parameter is the number of spectra.
+.le
+.ls comments
+For list input the list format is lines of comments and for value
+input \fIvalue\fR parameter is a comment string.
+.le
+.ls x0, i0, s0, s1, s2
+For list input the list format is sample line, spectrum number, and
+parameter value
+and for value input \fIlines\fR is a range string selecting the
+sample lines to be affected, \fIspectra\fR is a range string selecting
+the spectra to be affected, and \fIvalue\fR is the value to be set for all
+the selected lines and spectra.
+.le
+.ih
+EXAMPLES
+To add several comments to the database by query:
+
+.nf
+	cl> msset image "comments" read_list+
+	Input list> First comment here.
+	Input list> Second comment here.
+	Input list> <eof>
+.fi
+
+where <eof> is the end of file character terminating the list.
+To set the value of s0 to 1 for all the spectra in sample line 1:
+
+	cl> msset image "s0" 1
+
+To set the spectra positions from a list:
+
+	cl> msset image "x0" read_list+ list=positionlist
+
+To add a single comment such as in a script:
+
+	cl> msset image "comments" "Comment here."
+.ih
+SEE ALSO
+findspectra mslist
+.endhelp
diff --git a/noao/twodspec/multispec/doc/multispec.ms b/noao/twodspec/multispec/doc/multispec.ms
new file mode 100644
index 00000000..cc17352e
--- /dev/null
+++ b/noao/twodspec/multispec/doc/multispec.ms
@@ -0,0 +1,532 @@
+.EQ
+delim	$$
+.EN
+.TL
+The Multi-Spectra Extraction Package (multispec)
+.AU
+Francisco Valdes
+.AI
+IRAF Group
+.K2
+October 1984
+.NH
+Introduction
+.PP
+This document provides an introduction and overview of the multi-spectra
+extraction package \fBmultispec\fR.  Detailed descriptions and usage
+information for the tasks of the package are available in the manual
+pages.  The tasks in the package are:
+
+.TS
+center;
+n.
+findpeaks \&- Find the peaks
+fitfunction \&- Fit a function to the spectra parameter values
+fitgauss5 \&- Fit spectra profiles with five parameter Gaussian model
+modellist \&- List data and model pixel values
+msextract \&- Extract spectra
+mslist \&- List entries in a MULTISPEC database
+msplot \&- Plot a line of image and model data
+msset \&- Set entries in a MULTISPEC database
+newextraction \&- Create a new MULTISPEC extraction database
+newimage \&- Create a new multi-spectra image
+.TE
+
+.PP
+The \fBmultispec\fR package is a subpackage of the \fBtwodspec\fR package.
+It provides tools to locate, model, clean, correct for blending,
+and extract integrated or strip spectra from two dimensional, multi-spectra
+images.  These tools may be used directly or combined in scripts to
+extract specific types of spectra or spectra from specific instruments.
+Examples of the latter usage are the tasks in the image reduction package
+\fBcryomap\fR.
+.PP
+The extraction of spectra consists of locating pixels along each
+image line which intersect the spectra and recording either the sum of
+the pixels, \fIintegrated spectra\fR (some times referred to as
+one-dimensional spectra), or the set of pixels,
+\fIstrip spectra\fR, for each line and for each spectrum as output.
+The size and limits of the intersection region are specified by the
+user relative to the centers of the spectra.
+The locations of the spectra in each image line are determined separately
+so that the spectra need not be aligned along the columns of the image nor
+be perfectly straight.  However, since the extraction is done by image line,
+if the spectra are not aligned with the columns then the spectral resolution
+will be decreased.  If the spectra are aligned with the image lines then
+the image should be rotated or transposed using \fBimtranspose\fR.
+.PP
+The \fBmultispec\fR extraction produces three dimensional images with
+one image band (the third dimension) for each extracted spectrum
+and one line (the second dimension) for each extracted image line.
+For integrated spectra there is only one column
+while for strip spectra, the number of columns is equal to the extraction
+strip width.  The strips are aligned to the same positions relative to the
+spectra centers by image interpolation.  If desired the output extractions can
+be reformated in a variety of ways.
+.PP
+In addition to direct extraction of the image spectra the \fBmultispec\fR
+package provides for modeling the spectrum profiles.  The model
+may be extracted instead of the image spectra as either integrated or
+strip spectra.  The model may be used to correct for blending of the spectra
+and to detect and replace bad pixels.  The cleaning replaces data pixels which
+are discrepant from the model by the model values.
+.PP
+The modeling and cleaning features of the \fBmultispec\fR package can also
+be used for creating new multi-spectra images.  In other words a new
+image is created containing cleaned or model spectra for selected
+lines.
+.PP
+Section 2 gives an overview of the \fBmultispec\fR package and the extraction
+process.  The next section briefly describes the tasks in the package.
+This is followed by a description of the extraction database.
+The final section defines the model profiles used in the \fBmultispec\fR
+package.
+.NH
+Overview of the Multispec Package and the Extraction Process
+.PP
+The \fBmultispec\fR package consists of general and flexible tools
+for creating and manipulating databases which describe multi-spectra
+images.  The contents of the databases are described in a later section.
+Each database is associated with a particular image and is referenced
+through the image name.  The first positional argument in all the
+\fBmultispec\fR tasks is an image.  In the current version of the package each
+database exists as a separate binary file with a filename formed by adding
+the extension '.db' to the image name.  Note, however, that this
+need not be the case in the future.
+.PP
+The organization of the package as a set of tools operating on a database
+allows room for the package to evolve.  Different algorithms may be
+designed for different types of multi-spectra images by using combinations
+of the existing tools and by adding new tools.  The discussion below
+points out areas where new tasks might be added as well as citing the
+applicable existing tasks.
+.PP
+The extraction of spectra from a multi-spectra image consists of two
+basic steps; determining the locations of the spectra in the image and
+extracting the spectra.  The positions of the spectra in a multi-spectra
+image are determined at a set of "sample" image lines.  These positions
+are used to fit an interpolation function defining the spectrum positions
+at all the image lines.  This function is then used in the extraction of
+the spectra.
+.PP
+The sample image lines are chosen by the user when the database is first
+created by the task \fBnewextraction\fR.  An exception to this is when
+a template image is used (discussed below).  However, in this case the
+sample image lines are still those chosen by the user when the template
+image database was created.  The sample image lines may consist of
+anywhere from one image line to all the image lines.  The purpose
+of the sample lines is to sample the image often enough to follow changes
+in the positions and shapes of the spectra but to still minimize the
+time spent in finding the spectra and the size of the database.  The choice
+of sample lines also depends on the algorithm used to determine the
+positions of the spectra; a large number of sample
+lines for a fast, approximate method and a smaller number of lines
+for a complex and accurate method.  For example, in order to deal with
+very blended spectra the task \fBfitgauss5\fR provides a sophisticated
+model fitting algorithm.  This technique is computationally slow and, so,
+the user should not choose too many sample lines.
+.PP
+After the database has been created the minimum information needed
+for extraction is the spectrum positions at the sample lines.  There
+are many ways in which the positions may be determined.  Some
+possibilities are listed below.
+
+.IP (1)
+Enter the spectrum positions from a list using \fBmsset\fR.  The
+list might be generated from a graphics/cursor task.
+This is method is very time consuming when the number of spectra and
+the number of images are large.
+.IP (2)
+Determine the spectrum positions automatically by finding the peaks in
+each sample image line.  The task \fBfindpeaks\fR performs this function.
+.IP (3)
+Determine the spectrum positions at just one sample image line
+using either (1) or (2) and trace the spectra by a fast and refined
+peak finding method.  Such a task is desirable but is not a part of the
+current package.
+.IP (4)
+Determine the spectrum positions at just one sample image line
+using either (1) or (2) and trace the spectra by fitting model
+spectrum profiles.  The task \fBfitgauss5\fR does this using
+the model gauss5 described in section 5.  Additional model fitting
+tasks can be added as needed.
+.IP (5)
+Use the positions determined for a previous image and, if necessary,
+refine the positions.  \fBFitgauss5\fR is used to
+refine the spectrum positions at each sample line independently.
+
+.PP
+Several position finding algorithms may be used in stages to achieve
+the degree of accuracy required by the user.
+Thus, the first position determinations may be relatively crude and
+then, if needed, more sophisticated methods may be applied to refine the
+positions.  The task \fBfindpeaks\fR is a crude peak finder.  The positions
+are only determined to the nearest pixel.  The task \fBfitgauss5\fR is
+a sophisticated model fitting techique which is used after \fBfindpeaks\fR
+first determines the approximate positions of the spectra.
+.PP
+The determination of the spectra locations may be performed independently
+at each sample line as in (1) and (2) above or the spectra locations may
+be traced starting from one sample line as in (3) and (4).  The second method
+is preferable.  Generally, \fBfindpeaks\fR is used at only one sample line
+to initially determine the number and approximate locations of the spectra.
+\fBFitgauss5\fR then fits model gauss5 to the spectrum profiles and
+the model solution is used at the next sample line as the starting
+point for the next model fit.  In this manner the positions of
+the spectra are determined at the other sample image lines.
+.PP
+The results of the peak finding and profile fitting are improved
+by using an average of many image lines about the sample image line rather
+than just the sample image line by itself.  Both \fBfindpeaks\fR and
+\fBfitgauss5\fR have this ablility.
+.PP
+It is often the case that several multi-spectra images have essentially
+the same format; i.e. the same image size, the same number of spectra,
+and the same positions (either approximately or identically).
+Commonly, one of the images is used for calibrations and has strong,
+high signal-to-noise spectra while the other images have weaker spectra.
+In this case it is not necessary to repeat the position determinations.
+The spectrum positions in one of the images, generally the one with
+the strong calibration spectra, are determined first.  This image is
+then used as a "template" to provide the initial position estimates for
+the other images.  If the positions are identical no further work is needed,
+otherwise, the positions can be refined to correct for small changes in the
+positions and shapes of the spectra.
+.PP
+The task \fBnewextraction\fR creates new databases.  If a template image
+is specified then a copy is made of the template image database.  This means
+that the number of spectra and the sample image lines remain the same.
+If the spectrum positions are slightly different from the template image
+then the task \fBfitgauss5\fR is used to determine the new positions.
+.PP
+The spectrum positons and possibly any model parameters are interpolated
+from the sample lines to the remaining image lines by fitting a function
+to values at the sample lines.  In addition, the function fits may
+leave out poorly determined points and also smooth the values at the
+sample lines.  The task \fBfitfunction\fR fits selected functions of
+specified order to the selected spectra and sample image lines.
+.PP
+The extraction of the spectra from multi-spectra images is performed by
+the task \fBmsextract\fR.  The task extracts either integrated or strip
+spectra, either data or model values, with or without blending corrections,
+and with or without replacing bad pixels by model values.
+The user specifies the limits of the extraction
+strip as well as the spectra and image lines to be extracted.
+.PP
+For the simplest type of data extractions (basically strip extraction)
+no modeling is required.  Other types of extractions, such as model
+extractions and/or with cleaning and blending corrections require some
+degree of modeling.  There are two models which may be used;
+"smooth" and "gauss5".  These models are described in section 5.
+The model parameters for model gauss5 must be set by \fBfitgauss5\fR
+before \fBmsextract\fR is used.  Additional models may added for
+extraction as well as for the spectrum position determinations.
+.PP
+The model based features of \fBmsextract\fR -- model extractions
+and cleaning -- are available in the related task \fBnewimage\fR.
+This task creates new images which consist of either model spectra
+or cleaned data spectra.
+.PP
+The models in the \fBmultispec\fR package assume that the profiles
+go to zero; i.e. there is no background light.  Background light
+may be removed using \fBbackground\fR.  In the future a task will
+be provided create a mask defining the locations of the spectra from
+the database which can be used with general surface fitting tasks
+to create a background surface to be subtracted from the image.
+.PP
+The final step in using the \fBmultispec\fR package is to convert the
+extraction output to the desired format.  This may include graphs,
+card image formats, and files for the \fBonedspec\fR and \fBlongslit\fR
+packages.  Currently, the available formats are images and IIDS
+card images.
+.NH
+The Tasks of the Multispec Package
+.PP
+Use of the \fBmultispec\fR package begins with \fBnewextraction\fR and
+ends, usually, with \fBmsextract\fR.  In between there are tasks which
+update, refine or change the database and tasks which provide diagnositic
+information.  The informational tasks can be combined with tasks from
+other packages to produce tabular or graphical output.  The task
+\fBmsplot\fR is an example.  In this section a brief description of
+each task is given.  Further information about the tasks, including usage,
+is available in the manual pages.
+.SH
+findpeaks
+.IP
+Selected sample image lines are examined to determine the number and
+column positions of data peaks in the line.  An average of a number of image
+lines surrounding the sample lines is formed in which the local maxima
+are located.  Various criteria are applied to cull the list of local
+maxima to the desired peaks.  These criteria include a peak threshold,
+a maximum peak-to-peak contrast, a minimum peak separation, and a
+maximum number of peaks.  This task is used to determine crude, initial
+estimates for the spectrum positions.  It could be used alone for
+simple extractions.
+.SH
+fitfunction
+.IP
+This task has two roles.  It's primary role is to define the
+interpolation/extrapolation function for the spectra
+positions between the sample lines.  The fitting function can be
+either purely interpolative or may also provide smoothing of the
+parameters from the sample lines.  The second role is to provide
+smoothing of the model parameters along the dispersion and the
+ability to replace bad values by the function fit to the remaining
+parameters.  In this second role the user may iterate between
+smoothing and model fittng.  The functions are always defined between
+the first and last image lines.
+.SH
+fitgauss5
+.IP
+The model profiles gauss5, described in section 5, are fit to the
+selected spectra and sample lines.  The parameters to be determined
+and the fitting algorithm may also be selected.
+The model parameters are recorded in the database.
+The model may be tracked from a starting line to other sample image
+lines or each sample line may be fitted independently.
+This task is used to accurately determine the spectrum positions
+and provide an extraction model for heavily blended spectra.
+.SH
+modellist
+.IP
+For the selected sample image lines and image columns data
+and model values are listed.  This task is used to check how well
+the model fitting tasks (currently just \fBfitgauss5\fR) have fit
+the sample image line.  The task \fBmsplot\fR is used to produce
+graphical output.
+.SH
+msextract
+.IP
+This task does the actual extraction of spectra.  It requires that
+the spectrum positions are defined by fitting functions in the
+database.  If model gauss5 is to be used then the database must
+also contain the model parameters for the sample image lines.  It
+extracts integrated or strip spectra, using data or model values,
+with or without blending corrections, and with or without cleaning
+of bad pixels.
+.SH
+mslist
+.IP
+Of the diagnositic or informational tasks \fBmslist\fR is the most
+general.  The user selects the type of information from the database
+which is desired and it is then printed.  The types of information
+include the database header, the database comments, the spectra
+positions and model parameter values for the sample lines, and the
+interpolation/smoothing function values for any desired set of
+image lines.
+.SH
+msplot
+.IP
+This task extracts data and models values and plots them superposed.
+This task is used as a diagnositic tool to inspect how well model fitting
+represents the image spectra.
+.SH
+msset
+.IP
+This task is a general tool for modifying or setting some of the quantities 
+in the database.  The quantity to be changed or set is
+selected by a keyword and the values are input in two ways;
+with a list structured parameter (such a file containing the list of
+values or the standard input) or as a parameter value.  This task
+is the way a user may enter comments in the database or manually
+set the number and positions of the spectra.  It is also used to
+set the initial values for the gauss5 model parameters s0, s1, and s2
+prior to using \fBfitgauss5\fR.
+.SH
+newextraction
+.IP
+This task has three important roles.  First it creates the database
+associated with the multi-spectra image.  Second, it defines the sample
+image lines to be used.  The user can specify as many or as few sample lines
+as desired.  It should be kept in mind that the more sample lines used
+the larger the database becomes and the longer the processing time when
+modeling the spectra.  Finally, \fBnewextraction\fR allows
+a database from another image (called a template image) to initialize the
+database for the new multi-spectra image.  The template image is generally
+a calibration image with strong, well-defined spectra.
+Initializing a database with a template image saves time, reduces problems
+with bad pixels, and is more accurate when an image with weak spectra is
+to be extracted.
+.SH
+newimage
+.IP
+This task is similar to \fBmsextract\fR; it uses the same algorithms
+and parameters.  It differs in the type output.
+Rather than producing extracted integrated or strip spectra this task
+produces new image lines.  It is particularly useful for extracting
+model images to be compared against the original image or to
+produce images which have been cleaned.
+.NH
+The Multispec Database
+.PP
+The tasks in the \fBmultispec\fR package create and manipulate a database.
+The database contains a description of the multi-spectra image which
+is modified, refined, examined, or otherwise used by the tasks in the package.
+In the current version the database is a separate binary file with a filename
+formed by appending ".db" to the image name described by the database.
+.PP
+The database contains four basic types of data; general information,
+comments and history, position parameters, and model parameters.
+The data in the database is examined with the task \fBmslist\fR.
+The general information section, called the database header, contains the
+the name of the image, the size of the image, and the number of spectra in
+the image.  Once the number of spectra in the image has
+been entered in the database it is an error to attempt to change this
+number.  The database must be deleted and a new database created in order
+to change the number of spectra.
+.PP
+The comment and history section of the database contains text
+strings.  Each task which modifies the contents of the database places
+a dated history line in this section.  The user may also add comments
+with \fBmsset\fR.  Currently this information is not passed on to
+the extraction output.
+.PP
+There are three types of position information in the database.  The
+first is a set of sample image lines.  The sample lines are set when
+the database is created by \fBnewextraction\fR.  The sample lines select
+which image lines from the multi-spectra image are to be examined and used
+during the extraction.  Information from these sample lines, and only
+these sample lines, is entered in the database.  The sample lines
+may be listed with \fBmslist\fR.
+.PP
+The second type of position information is the positions of the
+spectra (centers) at each sample line.  These positions are initially
+set by either \fBfindpeaks\fR or, manually, by \fBmsset\fR.  The
+position information is refined by fitting model profiles.
+.PP
+The third type of position information is a function fit to the
+positions from all the sample lines for each spectrum.
+These function fits are produced by \fBfitfunction\fR.
+The functions define the positions of the spectra at all the image
+lines.  The spectra positions at the sample lines or the function
+evaluation for any image line may be listed with \fBmslist\fR.
+.PP
+The finally type of basic data contained in the database are
+model parameter values.  A model need not be used in the extraction
+but if one is used then the parameters determining the model profiles
+are recorded in the database.  The specific parameters depend on the
+model.  Currently the only model is \fIgauss5\fR.  The model and its
+parameters are described in section 5.
+.PP
+As with the spectra positions the parameters are stored in the database
+in two forms; as values for each spectrum at each sample image line
+and as function fits to the values at the sample lines which interpolate
+them to any image line.  The sample line values are
+set by the model fitting tasks and the function fits are set by
+\fBfitfunction\fR.  The parameter values at the sample lines or the
+function evaluations for any image lines may be listed with \fBmslist\fR.
+.NH
+Multispec Spectrum Profile Models
+.PP
+The spectra profiles in the image are modeled for many reasons:
+To provide accurate, subpixel position determinations, to extract model
+spectra or model images, to detect and replace bad pixels, and
+to estimate and correct for blending between the spectra.
+There are currently two models used in the \fBmultispec\fR package, "gauss5"
+and "smooth".
+.NH 2
+Model Gauss5
+.PP
+The gauss5 model profiles are Gaussian but with a scale which varies
+smoothly between the center and the edge of the profile.  There
+are five parameters:
+
+.RS
+.IP x0
+The column position in the image line of the center of the profile.
+.IP i0
+The intensity scale of the profile.  It corresponds to the intensity
+of the center of the profile.
+.IP s0
+The zeroth order, constant, term in the Gaussian scale.
+.IP s1
+The even first order term in the Gaussian scale.
+.IP s2
+The odd first order term in the Gaussian scale.
+.RE
+
+.PP
+The mathematical form of the the model is shown in equation (1):
+.EQ (1)
+roman profile (x)~=~i0 exp~left { -s( DELTA x )~DELTA x sup 2 right }
+.EN
+where
+.EQ
+DELTA x ~=~x~-~x0~,
+.EN
+.EQ
+s( DELTA x)~=~s0~+~s1~|y| +~s2~y~,
+.EN
+and
+.EQ
+y~=~ DELTA x / ( DELTA x sup 2 + alpha ) sup half ~.
+.EN
+The profile is defined within the user specified limits \fIlower\fR and
+\fIupper\fR measured relative to the the profile center and
+$alpha~=~(upper-lower)/4$.  The quantity $y$ lies in the range
+-1 to 1 over the interval in which the profile is defined.  The odd
+and even terms, s1 and s2, allow for symmetric and antisymmetric profile
+changes relative to a simple Gaussian profile.
+.PP
+The task \fBfitgauss5\fR fits the gauss5 model to the spectrum profiles in
+the sample image lines to determine one or more of the model parameters for
+each spectrum.  The parameter values are stored in the database for the image.
+In \fBmsextract\fR the model profiles for each
+image line are obtained by interpolating the profile shapes from the sample
+lines (with the model parameters in the database determined by
+\fBfitgauss5\fR) and then fitting only the intensity scale "i0".
+There are a number of technical details associated with the model fitting
+in each of these tasks which are discussed in the manual pages.
+.PP
+The gauss5 model is used to accurately determine the positions of the
+spectrum centers at the sample image lines.  Fitting simultaneously
+for the model parameters allows the spectra to be blended.
+This is the chief advantage of this model.
+This model is also used during extraction to correct for blending of
+the spectra and to detect and replace bad pixels.
+.NH 2
+Model Smooth
+.PP
+The spectrum profiles from the lines immediately preceeding
+the image line in which the spectrum profile is to be fit are shifted
+to a common center and averaged to form the model profile.
+An intensity scale factor is then determined which best fits the model
+profile to the image profile.  This is done for each spectrum in the
+image.  The scale factors are determined by least squares with
+possible bad pixel rejection.  Rejected pixels are eliminated
+when the image line is later used in forming new average model profiles.
+.PP
+The advantages of this model are that the image spectrum profiles may
+have any shape and the least squares fitting with bad pixel rejection
+is fast and rigorous.  By passing through the image lines sequentially
+the image lines need be accessed only once and the profile averages
+can be quickly updated for the next image line.
+.PP
+The disadvantages of this model are that the spectrum profiles cannot
+be blended and the model does not measure profile positions.
+This means that the spectrum profile positions must be
+known.  This model is suitable for model extractions and cleaning of
+bad pixels in unblended multi-spectra images.  It is available in
+the task \fBmsextract\fR.
+.bp
+.SH
+Glossary
+.LP
+\fBmultispec\fR
+.IP
+Acronym for Multi-Spectra Extraction as in \fBmultispec\fR Package.
+.LP
+integrated spectra
+.IP
+The spectra are extracted by integrating the pixel values across the spectrum
+to produce a single aperture luminosity value.
+.LP
+sample image line
+.IP
+The spectra positions and model profile shapes are determined at a set
+of image lines selected when the database is created.
+.LP
+strip spectra
+.IP
+The spectra are extracted as a strip of fixed with the spectra shifted by
+image interpolation to a common center.
diff --git a/noao/twodspec/multispec/doc/newextract.hlp b/noao/twodspec/multispec/doc/newextract.hlp
new file mode 100644
index 00000000..37123f28
--- /dev/null
+++ b/noao/twodspec/multispec/doc/newextract.hlp
@@ -0,0 +1,61 @@
+.help newextraction Jul84 noao.twodspec.multispec
+.ih
+NAME
+newextraction -- Initialize a new MULTISPEC extraction
+.ih
+USAGE
+newextraction image template
+.ih
+PARAMETERS
+.ls image
+Image to be extracted.
+.le
+.ls template
+The previously created database for the template image is used to initialize
+the new database.  If the null string is given then the database is not
+initialized.
+.le
+.ls sample_lines = "10x50"
+Sample image lines in which the spectra positions are to be determined and,
+optionally, modeled.  This parameter is not used if a template image is given.
+.le
+.ih
+DESCRIPTION
+To extract the spectra from a multi-spectra image a database must be created
+and associated with the image.  This task creates the database with a name
+formed by adding the extension '.db' and initializes some of the database
+entries.
+
+The sample lines are used to track the spectra positions and, if an analytic
+profile model is to be fit to the spectra, to map profile shape changes.
+The image lines only need be sampled enough to track \fInon-linear\fR position
+distortions and significant profile shape changes since interpolation
+is used between the sample lines.  Though specifying just one sample
+line is allowed using at least two sample lines is recommended to allow for
+any slope in the position of the spectra.  Specifying all the image lines
+will greatly increase the processing time and is never justified.
+
+Using a previous database to initialize the new database is useful if the
+new image is only slightly different in the positions and profiles of the
+spectra.  In some cases extraction may proceed immediately without any
+further position determination and modeling.  Further modeling
+and spectra position determinations will refine the previously determined
+parameters with an increase in execution time.  Using a template image is
+particularly important if the first image extracted has strong spectra
+and subsequent images have much weaker spectra since the automatic spectra
+position location and profile modeling may yield poor results for very weak
+spectra.
+.ih
+EXAMPLES
+To initialize a MULTISPEC database for extracting the spectra in
+the image \fIimage1\fR:
+
+	cl> newextraction image1 ""
+
+To create a new MULTISPEC database for extracting the spectra in
+the image \fIimage2\fR  using \fIimage1\fR as a template image:
+
+.nf
+	cl> newextraction image2 image1
+.fi
+.endhelp
diff --git a/noao/twodspec/multispec/doc/newimage.hlp b/noao/twodspec/multispec/doc/newimage.hlp
new file mode 100644
index 00000000..1ef7fbe0
--- /dev/null
+++ b/noao/twodspec/multispec/doc/newimage.hlp
@@ -0,0 +1,130 @@
+.help newimage Jul84 noao.twodspec.multispec
+.ih
+NAME
+newimage -- Create a new multi-spectra image
+.ih
+USAGE
+newimage image output
+.ih
+PARAMETERS
+.ls image
+Image to be used to create the new image.
+.le
+.ls output
+Filename for the new multi-spectra image.
+.le
+.ls lower = -10
+Lower limit for model profiles.  It is measured in pixels from the
+spectra centers defined by the position functions in the database.
+.le
+.ls upper = -10
+Upper limit for model profiles.  It is measured in pixels from the
+spectra centers defined by the position functions in the database.
+.le
+.ls lines = "*"
+Image lines of the multi-spectra image to be in the new multi-spectra image.
+.le
+.ls ex_model = no
+Create a model image?
+.le
+.ls clean = yes
+Replace bad pixels with model values?  The following parameters are used:
+.ls  nreplace = 1000.
+Maximum number of pixels to be replaced per image line when cleaning with
+model \fIgauss5\fR or maximum number of pixels to be replaced per spectrum when
+cleaning with model \fIsmooth\fR.
+.le
+.ls sigma_cut = 4.
+The cleaning threshold in terms of the predicted pixel sigma.
+.le
+.ls niterate = 1
+Maximum number of cleaning iterations per line when cleaning with model
+\fIgauss5\fR.
+.le
+.le
+.ls model = "smooth"
+Choice of \fIgauss5\fR or \fIsmooth\fR.  Minimum match abbreviation is
+allowed.  This parameter is required only if \fIex_model\fR = yes
+or \fIclean\fR = yes.
+.le
+.ls fit_type = 2
+Model fitting algorithm for model \fIgauss5\fR.
+.le
+.ls naverage = 20
+Number of lines to be averaged in model \fIsmooth\fR.
+.le
+.ls interpolator = "spline3"
+Type of image interpolation function to be used.
+The choices are "nearest", "linear", "poly3", "poly5", and "spline3".
+Minimum match abbreviation is allowed.
+.le
+.ls verbose = no
+Print verbose output?
+.le
+.ih
+DESCRIPTION
+A new multi-spectra image is created using the description of the
+multi-spectra image in the MULTISPEC database associated with \fIimage\fR.
+The user selects the image \fIlines\fR from the original image to be in
+the new image.  The options allow the creation of model images or images in
+which the bad or deviant pixels are replaced by model profile values.
+
+If \fIex_model\fR = yes or \fIclean\fR = yes model
+spectra are fit to the spectra in the image.  There are two models:
+a five parameter Gaussian profile called \fIgauss5\fR and profiles obtained
+by averaging \fInaverage\fR image lines surrounding the image line being
+modeled called \fIsmooth\fR.  The model is selected with the parameter
+\fImodel\fR.
+
+When \fIex_model\fR = yes an image containing model spectra is produced.
+
+When \fIclean\fR = yes pixels with large residuals from the model are
+detected and removed from the model fit.  The selected model is
+fit to the pixels which are not in the bad pixel list (not yet implemented)
+and which have not been removed from the model fit.  The sigma of the fit
+is computed.  Deviant pixels are detected by comparing them to the model
+to determine if they differ by more than \fIsigma_cut\fR times the sigma.
+The model fit is iterated, removing deviant pixels at each iteration, until
+no more pixels are found deviant or \fInreplace\fR pixels have been found.
+The pixels removed or in the bad pixel list are then replaced with
+model values.  (To clean and extract the spectra with this algorithm see
+\fBmsextract\fR.)
+
+There are some technical differences in the model fitting and cleaning
+algorithms for the two models.  In model \fIsmooth\fR
+the fit for the profile scale factors is done independently for each spectrum
+and automatically corrected when a bad pixel is detected.  This fitting process
+is fast and rigorous.  The parameter \fInreplace\fR in this model refers to
+the maximum number of pixels replaced \fIper spectrum\fR.
+
+In model \fIgauss5\fR, however, the profile scale factors are fit
+to the entire image line (hence its ability to fit blended spectra).
+There are two fitting algorithms; a rigorous simultaneous fit
+and an approximate method.  The simultaneous fit is selected when
+\fIfit_type\fR = 1.  This step is relatively slow. The
+alternative method of \fIfit_type\fR = 2 sets the scale factor for each
+spectrum by taking the median scale, where scale = data / model profile,
+for the three pixels nearest the center of the profile.  The median
+minimizes the chance of a large error due to a single bad pixel.  This
+scale may be greatly in error in the case of extreme blending but is also
+quite fast; the extraction time is reduced by at least 40%.
+The steps of profile fitting and deviant pixel detection are alternated
+and the maximum number of iterations through these two steps is
+set by \fIniterate\fR.  The default of 1 means that the model fitting is not
+repeated after detecting deviant pixels.
+
+The option \fIverbose\fR can be used to print the image lines being extracted
+and any pixels replaced by the cleaning process.
+.ih
+EXAMPLES
+To create a cleaned version of the image using model \fIsmooth\fR for cleaning:
+
+	cl> newimage image newimage
+
+To create an model image using model \fIgauss5\fR:
+
+	cl> newimage image newimage ex_model=yes model="gauss5"
+.ih
+SEE ALSO
+msextract
+.endhelp
diff --git a/noao/twodspec/multispec/exgauss5.x b/noao/twodspec/multispec/exgauss5.x
new file mode 100644
index 00000000..5c009239
--- /dev/null
+++ b/noao/twodspec/multispec/exgauss5.x
@@ -0,0 +1,100 @@
+include	<imhdr.h>
+include "ms.h"
+
+
+# EX_GAUSS5 -- Extract spectra using the GAUSS5 model.
+#
+# This procedure is called either by t_extract to extract spectra (either
+# integrated or strip) or by t_newimage to extract a new image (either
+# model or cleaned data).  It is called only if model GAUSS5 must be used
+# for cleaning, blending corrections, or model extraction.
+
+procedure ex_gauss5 (ms, im_in, im_out, spectra, lines, lower, upper,
+    ex_spectra, ex_model, ex_integral)
+
+pointer	ms				# MULTISPEC pointer
+pointer	im_in				# Input image descriptor
+pointer	im_out				# Output image descriptor
+int	spectra[ARB]			# Spectra range list
+int	lines[ARB]			# Line range list
+real	lower				# Lower limit of strip
+real	upper				# Upper limit of strip
+bool	ex_spectra			# Extract spectra or image line
+bool	ex_model			# Extract model or data
+bool	ex_integral			# Extract integrated spectra or strip
+
+int	len_line, len_profile, nspectra, nparams
+int	line_in, line_out
+pointer	data, data_in, data_out
+pointer	sp, model, profiles, ranges, data_profiles
+
+int	get_next_number()
+pointer	imgl2r(), impl2r()
+
+begin
+	# Set array size variables.
+	len_line = MS_LEN(ms, 1)
+	nspectra = MS_NSPECTRA(ms)
+	nparams = MS_NGAUSS5
+	len_profile = nint (upper - lower + 2)
+
+	# Allocate and setup necessary arrays.
+	call smark (sp)
+	call salloc (model, len_line, TY_REAL)
+	call salloc (ranges, nspectra * LEN_RANGES * 3, TY_REAL)
+	call salloc (profiles, len_profile * nspectra * nparams * 3, TY_REAL)
+	call salloc (data_profiles, len_profile * nspectra, TY_REAL)
+
+	# Initialize ranges arrays.
+	Memr[ranges] = INDEFR
+
+	# Loop through the input lines and write an output line for each
+	# input line.
+	line_in = 0
+	line_out = 0
+	while (get_next_number (lines, line_in) != EOF) {
+	    line_out = line_out + 1
+	    call ex_prnt2 (line_in, line_out)
+
+	    # Get the multi-spectra image data.
+	    data = imgl2r (im_in, line_in)
+
+	    # Get the GAUSS5 model profiles using interpolation between the
+	    # sample lines.
+	    call int_gauss5 (ms, lower, Memr[profiles], Memr[ranges],
+		len_profile, nspectra, nparams, line_in)
+
+	    # Iteratively fit the profile scales to the data and replace
+	    # deviant pixels by model values.
+	    call fit_and_clean (ms, Memr[data], Memr[model], Memr[ranges],
+		Memr[profiles], len_line, len_profile, nspectra, nparams)
+
+	    # Unblend data spectra only if needed.
+	    if (ex_spectra && !ex_model)
+		call unblend (Memr[data], Memr[data_profiles], Memr[model],
+		    Memr[profiles], Memr[ranges], len_line, len_profile,
+		    nspectra)
+
+	    if (!ex_spectra) {
+		# Output a new model or data image line.
+		data_out = impl2r (im_out, line_out)
+		if (ex_model)
+		    data_in = model
+		else
+		    data_in = data
+		call amovr (Memr[data_in], Memr[data_out], len_line)
+	    } else {
+		# Output either model or data extracted spectra.
+		if (ex_model)
+		    data_in = profiles
+		else
+		    data_in = data_profiles
+	        call ex_out (im_out, line_out, spectra, lower, upper,
+		    Memr[ranges], Memr[data_in], len_profile, nspectra,
+		    ex_integral)
+	    }
+	}
+
+	# Free allocated memory.
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/exsmooth.x b/noao/twodspec/multispec/exsmooth.x
new file mode 100644
index 00000000..f092529a
--- /dev/null
+++ b/noao/twodspec/multispec/exsmooth.x
@@ -0,0 +1,107 @@
+include	<imhdr.h>
+include	<math/interp.h>
+include "ms.h"
+
+# EX_SMOOTH    -- Extract spectra using the SMOOTH model.
+# FIT_PROFILES -- Get SMOOTH profiles and fit the profiles to the data while
+#                 replacing deviant pixels by model profile values.
+
+
+# EX_SMOOTH -- Extract spectra using the SMOOTH model.
+#
+# This procedure is called either by t_extract to extract spectra (either
+# integrated or strip) or by t_newimage to extract a new image (either
+# model or cleaned data).  It is called only if model SMOOTH must be used
+# for cleaning or model extraction.  It outputs the extracted spectra to
+# the output image file.  Note that this task does CLIO.
+
+procedure ex_smooth (ms, im_in, im_out, spectra, lines, lower, upper,
+    ex_spectra, ex_model, ex_integral)
+
+pointer	ms				# MULTISPEC pointer
+pointer	im_in				# Input image descriptor
+pointer	im_out				# Output image descriptor
+int	spectra[ARB]			# Spectra range list
+int	lines[ARB]			# Line range list
+real	lower				# Lower limit of strips
+real	upper				# Upper limit of strips
+bool	ex_spectra			# Extract spectra or image line?
+bool	ex_model			# Extract model or data?
+bool	ex_integral			# Extract integrated or strip spectra?
+
+# User input parameters:
+int	nlines				# Lines to average for smooth model
+int	interpolator			# Line interpolator type
+
+int	len_line, nspectra, len_profile, len_profiles
+int	line_in, line_out
+pointer	sp, data, data_in, data_out, model, ranges, profiles, coeff
+
+int	clgeti(), get_next_number(), clginterp()
+pointer	impl2r()
+
+begin
+	# Get parameters for model SMOOTH.
+	nlines = clgeti ("naverage") + 1
+	interpolator = clginterp ("interpolator")
+
+	# Set array lengths.
+	len_line = IM_LEN(im_in, 1)
+	nspectra = MS_NSPECTRA(ms)
+	len_profile = nint (upper - lower + 1)
+	len_profiles = len_profile * nspectra
+
+	# Allocate working memory.
+	call smark (sp)
+	call salloc (data, len_profiles, TY_REAL)
+	call salloc (model, len_profiles, TY_REAL)
+	call salloc (ranges, nspectra * LEN_RANGES, TY_REAL)
+	call salloc (profiles, len_profiles * (nlines + 1), TY_REAL)
+	call salloc (coeff, 2 * len_line + SZ_ASI, TY_REAL)
+
+	# Initialize ranges and interpolation arrays.
+	call amovkr (lower, Memr[ranges + (DX_START-1)*nspectra], nspectra) 
+	call asiset (Memr[coeff], interpolator)
+
+	# Get fit position functions from the database.
+	call msgfits (ms, X0_FIT)
+
+	# Loop through the input image lines and write output line.
+	line_in = 0
+	line_out = 0
+	while (get_next_number (lines, line_in) != EOF) {
+	    line_out = line_out + 1
+	    call ex_prnt2 (line_in, line_out)
+
+	    # Get the SMOOTH profiles and the data for the input line.
+	    call set_smooth (ms, im_in, line_in, Memr[ranges], Memr[profiles],
+		Memr[coeff], len_profile, nspectra, nlines, Memr[data],
+		Memr[model])
+
+	    # Fit and clean the data and model.
+	    call fit_smooth (line_in, Memr[data], Memr[model],
+		Memr[profiles], len_profile, nspectra, nlines)
+
+	    # Select model or data to be output.
+	    if (ex_model)
+		data_in = model
+	    else
+		data_in = data
+
+	    if (ex_spectra) {
+		# Extract model or data spectra.
+	        call ex_out (im_out, line_out, spectra, lower, upper,
+		    Memr[ranges], Memr[data_in], len_profile, nspectra,
+		    ex_integral)
+	    } else {
+		# Extract model or data image line.
+		data_out = impl2r(im_out, line_out)
+		call set_model1 (ms, line_in, Memr[data_in], Memr[coeff],
+		    Memr[ranges], len_line, len_profile, nspectra,
+		    Memr[data_out])
+	    }
+	}
+
+	# Free allocated memory.
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/exstrip.x b/noao/twodspec/multispec/exstrip.x
new file mode 100644
index 00000000..a114b5a8
--- /dev/null
+++ b/noao/twodspec/multispec/exstrip.x
@@ -0,0 +1,203 @@
+include	<imhdr.h>
+include	<math/interp.h>
+include "ms.h"
+
+# EX_STRIP  -- Simple strip extraction of spectra.
+# EX_STRIP1 -- Extract integrated spectra.
+# EX_STRIP2 -- Extract two dimensional strip spectra.
+
+
+# EX_STRIP -- Simple strip extraction of spectra.
+#
+# This procedure is called either by t_extract to extract spectra (either
+# integrated or strip) or by t_newimage to extract a new image.
+# Since there is no modeling only data spectra or image lines are extracted.
+# It outputs the extracted spectra or image lines to the output image file.
+
+procedure ex_strip (ms, im_in, im_out, spectra, lines, lower, upper,
+    ex_spectra, ex_model, ex_integral)
+
+pointer	ms				# MULTISPEC pointer
+pointer	im_in				# Input image descriptor
+pointer	im_out				# Output image descriptor
+int	spectra[ARB]			# Spectra range list
+int	lines[ARB]			# Line range list
+real	lower				# Lower limit of strips
+real	upper				# Upper limit of strips
+bool	ex_spectra			# Extract spectra or image line
+bool	ex_model			# Extract model or data
+bool	ex_integral			# Extract integrated spectra or strip
+
+int	line_in, line_out
+pointer	data_in, data_out
+
+int	get_next_number()
+pointer	imgl2r(), impl2r()
+
+begin
+	if (ex_model)
+	    call error (MS_ERROR, "Can't extract model")
+
+	if (ex_spectra) {
+	    # Extract spectra using ex_strip1 for integrated spectra and
+	    # ex_strip2 for strip spectra.
+	    if (ex_integral)
+	        call ex_strip1 (ms, im_in, im_out, spectra, lines, lower,
+		    upper)
+	    else
+	        call ex_strip2 (ms, im_in, im_out, spectra, lines, lower,
+		    upper)
+	} else {
+	    # Create a new multi-spectra image by copying the selected
+	    # input image lines to the output image.
+	    line_in = 0
+	    line_out = 0
+	    while (get_next_number (lines, line_in) != EOF) {
+		line_out = line_out + 1
+		data_in = imgl2r (im_in, line_in)
+		data_out = impl2r (im_out, line_out)
+		call amovr (Memr[data_in], Memr[data_out], IM_LEN(im_out, 1))
+	    }
+	}
+end
+
+# EX_STRIP1 -- Extract integrated spectra.
+#
+# For each spectrum in the spectra range list and for each line in
+# the line range list the pixels between lower and upper (relative
+# to the spectrum center) are summed.
+# The spectra positions are obtained from the MULTISPEC database.
+
+procedure ex_strip1 (ms, im_in, im_out, spectra, lines, lower, upper)
+
+pointer	ms				# MULTISPEC pointer
+pointer	im_in				# Input image descriptor
+pointer	im_out				# Output image descriptor
+int	spectra[ARB]			# Spectra range list
+int	lines[ARB]			# Line range list
+real	lower				# Lower limit of strips
+real	upper				# Upper limit of strips
+
+int	line_in, line_out, spectrum_in, spectrum_out
+real	x_center, x_start, x_end
+pointer	buf_in, buf_out
+
+real	sum_pixels(), cveval()
+int	get_next_number()
+pointer	imgl2r(), impl3r()
+
+begin
+	# Get fit functions for spectra positions. 
+	call msgfits (ms, X0_FIT)
+
+	# Loop through the input lines and write integrated spectra out.
+	line_in = 0
+	line_out = 0
+	while (get_next_number (lines, line_in) != EOF) {
+	    line_out = line_out + 1
+
+	    # Get the input data line.
+	    buf_in = imgl2r (im_in, line_in)
+
+	    # Loop the the spectra, calculate the integrated luminosity and
+	    # write it to the output image.
+	    spectrum_in = 0
+	    spectrum_out = 0
+	    while (get_next_number (spectra, spectrum_in) != EOF) {
+		spectrum_out = spectrum_out + 1
+
+		buf_out = impl3r (im_out, line_out, spectrum_out)
+
+		# Determine the spectrum limits from spectrum center position.
+		x_center = cveval (CV(ms, X0_FIT, spectrum_in), real (line_in))
+		x_start = max (1., x_center + lower)
+		x_end = min (real (IM_LEN(im_in, 1)), x_center + upper)
+		Memr[buf_out] =
+		    sum_pixels (Memr[buf_in], x_start, x_end)
+	    }
+	}
+end
+
+# EX_STRIP2 -- Extract two dimensional strip spectra.
+#
+# Each line in the range list is fit by an image interpolator and then for
+# each spectrum in spectra range list the interpolator values between lower
+# and upper (relative to the spectrum center) are written to a three
+# dimensional image.  There is one band for each spectrum.  The spectra
+# positions are obtained from the MULTISPEC database.
+# The procedure requests the interpolator type using CLIO.
+
+procedure ex_strip2 (ms, im_in, im_out, spectra, lines, lower, upper)
+
+pointer	ms				# MULTISPEC pointer
+pointer	im_in				# Input image descriptor
+pointer	im_out				# Output image descriptor
+int	spectra[ARB]			# Spectra range list
+int	lines[ARB]			# Line range list
+real	lower				# Lower limit of strip
+real	upper				# Upper limit of strip
+
+int	interpolator			# Array interpolar type
+
+int	i, len_in, len_out, line_in, line_out, spectrum_in, spectrum_out
+real	x, x_start
+pointer	buf_in, buf_out
+pointer	sp, coeff
+
+int	get_next_number(), clginterp()
+real	asival(), cveval()
+pointer	imgl2r(), impl3r()
+errchk	salloc, imgl2r, impl3r
+errchk	asiset, asifit, asival, clginterp
+
+begin
+	# Get the image interpolator type.
+	interpolator = clginterp ("interpolator")
+
+	len_in = IM_LEN (im_in, 1)
+	len_out = nint (upper - lower + 1)
+
+	# Set up the interpolator coefficient array.
+	call smark (sp)
+	call salloc (coeff, 2 * len_in + SZ_ASI, TY_REAL)
+	call asiset (Memr[coeff], interpolator)
+
+	# Get the spectra position functions from the database.
+	call msgfits (ms, X0_FIT)
+
+	# Loop through the input lines, do the image interpolation and write
+	# the strip spectra to the output.
+	line_in = 0
+	line_out = 0
+	while (get_next_number (lines, line_in) != EOF) {
+	    line_out = line_out + 1
+
+	    # Get the input data and fit an interpolation function.
+	    buf_in = imgl2r (im_in, line_in)
+	    call asifit (Memr[buf_in], len_in, Memr[coeff])
+
+	    # Loop through the spectra writing the strip spectra.
+	    spectrum_in = 0
+	    spectrum_out = 0
+	    while (get_next_number (spectra, spectrum_in) != EOF) {
+		spectrum_out = spectrum_out + 1
+		buf_out = impl3r (im_out, line_out, spectrum_out)
+
+		# Determine the starting position for the strips and
+		# evaluate the interpolation function at each point in
+		# the strip.
+		x_start = cveval (CV(ms, X0_FIT, spectrum_in), real (line_in)) +
+		    lower
+		do i = 1, len_out {
+		    x = x_start + i - 1
+		    if ((x < 1) || (x > len_in))
+			Memr[buf_out + i - 1] = 0.
+		    else
+		        Memr[buf_out + i - 1] = asival (x, Memr[coeff])
+		}
+	    }
+	}
+
+	# Free interpolator memory.
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/findpeaks.par b/noao/twodspec/multispec/findpeaks.par
new file mode 100644
index 00000000..04d00e1a
--- /dev/null
+++ b/noao/twodspec/multispec/findpeaks.par
@@ -0,0 +1,13 @@
+# FINDPEAKS
+
+image,f,a,,,,Image to be searched
+lines,s,a,,,,Images lines to be searched for peaks
+contrast,r,a,,,,Maximum contrast between peak values
+separation,i,h,5,,,Minimum separation between peaks
+edge,i,h,0,0,,Minimum separation from the image edge
+threshold,r,h,0.,,,Minimum peak threshold for selecting peaks
+min_npeaks,i,h,1,,,Minimum number of peaks to be found
+max_npeaks,i,h,1000,,,Maximum number of peaks to be found
+columns,s,h,"*",,,Image columns to be searched for peaks
+naverage,i,h,20,,,Number of image lines to average
+debug,b,h,no,,,Print debugging information?
diff --git a/noao/twodspec/multispec/fitclean.x b/noao/twodspec/multispec/fitclean.x
new file mode 100644
index 00000000..548f2cf4
--- /dev/null
+++ b/noao/twodspec/multispec/fitclean.x
@@ -0,0 +1,257 @@
+include	"ms.h"
+
+# FIT_AND_CLEAN -- Iteratively fit profile scales using banded matrix method
+# and remove deviant pixels.
+#
+# The profile fitting and cleaning are combined in order to minimize
+# the calculations in re-evaluating the least squares fit after rejecting
+# deviant pixels.
+#
+# The sigma of the fit is calculated and deviant pixels are those whose
+# residual is more than +-sigma_cut * sigma.
+# The maximum number of pixels to be replaced is max_replace.
+# If max_replace is zero then only the model fitting is performed.
+#
+# The output of this routine are the cleaned data profiles and the
+# least-square fitted model profiles.  Return the number of pixels replaced.
+
+
+procedure fit_and_clean (ms, data, model, ranges, profiles, len_line,
+    len_profile, nspectra, nparams)
+
+pointer	ms					# MULTISPEC data structure
+real	data[len_line]				# Input data to be fit
+real	model[len_line]				# Output model line
+real	ranges[nspectra, LEN_RANGES, 3]		# Profile ranges
+real	profiles[len_profile, nspectra, nparams, 3] # Model profiles
+int	len_line				# Length of data/model line
+int	len_profile				# Length of each profile
+int	nspectra				# Number of spectra
+int	nparams					# Number model parameters
+
+int	max_iterate				# Maximum number of iterations
+int	max_replace				# Maximum number of bad pixels
+real	sigma_cut				# Rejection cutoff
+int	fit_type				# Type of I0 fitting
+bool	ex_model				# Extract model?
+
+bool	exmod
+int	i_max, nmax, option, npts
+int	i, iteration, n_total, n_reject
+real	sigma, lower, upper, residual, resid_min, resid_max
+
+begin
+	# Initialize the model and I0 parameters to zero.
+	call aclrr (PARAMETER(ms,I0,1), nspectra)
+	call aclrr (model, len_line)
+
+	# Loop until no further deviant pixels are found.
+	n_total = 0
+
+	do iteration = 1, imax {
+	    # Determine I0 for each profile.
+	    switch (option) {
+	    case 1:
+	        call  full_solution (ms, data, model, ranges, profiles,
+		    len_line, len_profile, nspectra, nparams)
+	    case 2:
+	        call quick_solution (ms, data, ranges, profiles, len_line,
+		    len_profile, nspectra)
+	    }
+
+	    # Set the model to be used to compare against the data.
+	    call set_model (ms, model, profiles, ranges, len_line, len_profile,
+		nspectra)
+
+	    # If number of pixels to reject is zero then skip below.
+	    n_reject = 0
+	    if (n_total == nmax)
+		break
+
+	    # Compute sigma of fit.
+	    sigma = 0.
+	    npts = 0
+	    do i = 1, len_line {
+		if ((model[i] > 0.) && (!IS_INDEFR (data[i]))) {
+		    sigma = sigma + (data[i] - model[i]) ** 2
+		    npts = npts + 1
+		}
+	    }
+	    sigma = sqrt (sigma / npts)
+	    resid_min = -lower * sigma
+	    resid_max = upper * sigma
+
+	    # Compare each pixel against the model and set deviant pixels
+	    # to INDEFR.  If the number of pixels replaced is equal to the
+	    # maximum allowed stop cleaning.  Ignore points with model <= 0.
+	    # Thus, points outside the spectra will not be cleaned.
+	    # Ignore INDEFR pixels.
+	    do i = 1, len_line {
+		if (n_total == nmax)
+		    break
+		if ((model[i] <= 0.) || (IS_INDEFR (data[i])))
+		    next
+
+		# Determine deviant pixels.
+	        residual = data[i] - model[i]
+	        if ((residual < resid_min) || (residual > resid_max)) {
+		    # Flag deviant pixel.
+		    data[i] = INDEFR
+		    n_total = n_total + 1
+		    n_reject = n_reject + 1
+		}
+	    }
+
+	    if (n_reject == 0)
+		break
+	}
+	# Refit model if a model extraction is desired and bad pixels were
+	# in the last fit.
+	if (exmod && n_reject != 0) {
+	    switch (option) {
+	    case 1:
+	        call  full_solution (ms, data, model, ranges, profiles,
+		    len_line, len_profile, nspectra, nparams)
+	    case 2:
+	        call quick_solution (ms, data, ranges, profiles, len_line,
+		    len_profile, nspectra)
+	    }
+	}
+
+	# Scale profiles to form model profiles.
+	do i = 1, nspectra
+	    call amulkr (profiles[1,i,I0_INDEX,1], PARAMETER(ms,I0,i),
+		profiles[1,i,I0_INDEX,1], len_profile)
+
+	# Replace deviant or INDEF pixels by model values.
+	# Even if no cleaning was done there may have been some INDEF points
+	# in the input data line.
+
+	do i = 1, len_line {
+	    if (IS_INDEFR (data[i]))
+		data[i] = model[i]
+	}
+
+	# Print the number of pixels replaced and return.
+	call ex_prnt3 (n_total)
+	return
+
+# SET_FIT_AND_CLEAN -- Set the fitting and cleaning parameters.
+
+entry set_fit_and_clean (max_iterate, max_replace, sigma_cut, fit_type,
+   ex_model)
+
+	imax = max_iterate
+	nmax = max_replace
+	lower = sigma_cut
+	upper = sigma_cut
+	option = fit_type
+	exmod = ex_model
+	return
+end
+
+
+procedure full_solution (ms, data, model, ranges, profiles, len_line,
+    len_profile, nspectra, nparams)
+
+pointer	ms					# MULTISPEC data structure
+real	data[len_line]				# Input data to be fit
+real	model[len_line]				# Output model line
+real	ranges[nspectra, LEN_RANGES, 3]		# Profile ranges
+real	profiles[len_profile, nspectra, nparams, 3] # Model profiles
+int	len_line				# Length of data/model line
+int	len_profile				# Length of each profile
+int	nspectra				# Number of spectra
+int	nparams					# Number model parameters
+
+real	rnorm
+pointer	sp, fitparams, solution, offset
+
+begin
+	# Initialize fitparams and ranges arrays.
+	call smark (sp)
+	call salloc (fitparams, nspectra * nparams, TY_REAL)
+	call salloc (solution, nspectra * nparams, TY_REAL)
+
+	offset = (I0_INDEX - 1) * nspectra
+	call amovki (NO, Memr[fitparams], nspectra * nparams)
+	call amovki (YES, Memr[fitparams + offset], nspectra)
+
+	# Do least squares banded matrix solution for I0 parameters.
+	# The solution vector contains the least square fit values which
+	# must be copied to the I0 parameter vector.
+	call solve (ms, data, model, Memr[fitparams], profiles, ranges,
+	    len_line, len_profile, nspectra, nparams, Memr[solution], rnorm)
+	call aaddr (PARAMETER(ms, I0, 1), Memr[solution + offset],
+	    PARAMETER(ms, I0, 1), nspectra)
+
+	call sfree (sp)
+end
+
+
+# QUICK_SOLUTION -- Quick determination of profile scaling parameters.
+
+procedure quick_solution (ms, data, ranges, profiles, len_line, len_profile,
+    nspectra)
+
+pointer	ms					# MULTISPEC data structure
+real	data[len_line]				# Input data to be fit
+real	ranges[nspectra, LEN_RANGES]		# Profile ranges
+real	profiles[len_profile, nspectra, ARB]	# Model profiles
+int	len_line				# Length of data/model line
+int	len_profile				# Length of each profile
+int	nspectra				# Number of spectra
+
+int	i, ic, j, n, spectrum, xc
+real	i0[3]
+
+begin
+	ic = len_profile / 2
+
+	# Determine a value for I0 for each spectrum which is in the image.
+	do spectrum = 1, nspectra {
+	    n = 0
+
+	    # Check each profile point from ic on until n = 2.
+	    do i = ic, len_profile - 1 {
+	        xc = ranges[spectrum, X_START] + i
+	        if ((xc < 1) || (xc > len_line))
+		    next
+	        if (IS_INDEFR (data[xc]))
+		    next
+		j = i + 1
+	        if (profiles[j, spectrum, I0_INDEX] <= 0)
+		    next
+		n = n + 1
+	        i0[n] = data[xc] / profiles[j, spectrum, I0_INDEX]
+		if (n >= 2)
+		     break
+	    }
+
+	    # Check each profile point from ic - 1 and less until n = 3.
+	    do i = ic - 1, 0, -1 {
+	        xc = ranges[spectrum, X_START] + i
+	        if ((xc < 1) || (xc > len_line))
+		    next
+	        if (IS_INDEFR (data[xc]))
+		    next
+		j = i + 1
+	        if (profiles[j, spectrum, I0_INDEX] <= 0)
+		    next
+		n = n + 1
+	        i0[n] = data[xc] / profiles[j, spectrum, I0_INDEX]
+		break
+	    }
+
+	    # Determine I0.
+	    switch (n) {
+	    case 3:				# Use median I0
+		call asrtr (i0, i0, n)
+	        PARAMETER(ms, I0, spectrum) = i0[2]
+	    case 2:				# Use mean I0
+	        PARAMETER(ms, I0, spectrum) = (i0[1] + i0[2]) / 2
+	    case 1:				# Use only value
+	        PARAMETER(ms, I0, spectrum) = i0[1]
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/fitfunction.par b/noao/twodspec/multispec/fitfunction.par
new file mode 100644
index 00000000..72e61620
--- /dev/null
+++ b/noao/twodspec/multispec/fitfunction.par
@@ -0,0 +1,8 @@
+# FITFUNCTION
+
+image,f,a,,,,Image
+parameter,s,h,x0,,,Database parameter to be fitted
+lines,s,h,"*",,,Images lines in function fit
+spectra,s,h,"*",,,Spectra to be fit
+function,s,h,"spline3",,,Fitting function
+order,i,h,INDEF,,,Order of spline
diff --git a/noao/twodspec/multispec/fitgauss5.com b/noao/twodspec/multispec/fitgauss5.com
new file mode 100644
index 00000000..65bd9bb8
--- /dev/null
+++ b/noao/twodspec/multispec/fitgauss5.com
@@ -0,0 +1,9 @@
+# Common for fitting model GAUSS5.
+
+real	factor				# Convergence factor
+int	spectra[3, MAX_RANGES]		# Spectra to fit
+int	parameters[MS_NGAUSS5]		# Parameters to be fit
+int	smooth[MS_NGAUSS5]		# Smooth parameters?
+int	algorithm			# Fitting algorithm
+
+common /g5_fitcom/ factor, spectra, parameters, smooth, algorithm
diff --git a/noao/twodspec/multispec/fitgauss5.par b/noao/twodspec/multispec/fitgauss5.par
new file mode 100644
index 00000000..276a3b19
--- /dev/null
+++ b/noao/twodspec/multispec/fitgauss5.par
@@ -0,0 +1,23 @@
+# FITGAUSS5
+
+image,f,a,,,,Image
+start,i,a,,,,Starting image line
+lower,r,h,-10.,,,Lower limit of model profiles
+upper,r,h,10.,,,Upper limit of model profiles
+lines,s,h,"*",,,Images lines to be fitted
+spectra,s,h,"*",,,Spectra to be fitted
+naverage,i,h,20,1,,Number of image lines to average
+factor,r,h,.05,0,1,RMS iteration improvement stopping criteria
+track,b,h,yes,,,Track solution?
+algorithm,i,h,1,1,2,Fitting algorithm
+fit_i0,b,h,y,,,Fit spectra central intensities?
+fit_x0,b,h,y,,,Fit spectra positions?
+fit_s0,b,h,y,,,Fit spectra shape parameter 0?
+fit_s1,b,h,n,,,Fit spectra shape parameter 1?
+fit_s2,b,h,n,,,Fit spectra shape parameter 2?
+smooth_s0,b,h,no,,,Smooth parameter s0 across spectra?
+smooth_s1,b,h,no,,,Smooth parameter s1 across spectra?
+smooth_s2,b,h,no,,,Smooth parameter s2 across spectra?
+function,s,h,"spline3",,,"Smoothing function (legendre,chebyshev,spline3)"
+order,i,h,4,,,Order for smoothing function
+verbose,b,h,no,,,Print general information about the fitting?
diff --git a/noao/twodspec/multispec/fitgauss5.x b/noao/twodspec/multispec/fitgauss5.x
new file mode 100644
index 00000000..b1e07b58
--- /dev/null
+++ b/noao/twodspec/multispec/fitgauss5.x
@@ -0,0 +1,460 @@
+include <fset.h>
+include "ms.h"
+
+# FITGAUSS5 -- Procedures used in fitting the GAUSS5 model.
+#
+# G5_FIT1 -- Fitting algorithm #1.
+# G5_FIT2 -- Fitting algorithm #2.
+# G5_FIT -- Fit the selected parameters for the best RMS value.
+# SET_VERBOSE -- Verbose output.
+
+########################################################################
+.helpsys g5fit1 Jul84 MULTISPEC
+.ih
+NAME
+G5_FIT1 -- Fitting algorithm #1.
+.ih
+DESCRIPTION
+This algorithm fits the selected parameters simultaneously.
+The parameters are selected by the parameter array (which of the 5
+model parameters in a profile are to be fit) and the spectra range
+array defined in fitgauss5.com.  These two arrays are used to generate
+the fitparms array with the routine set_fitparams.  The fitparams array
+controls the parameters fit by G5_FIT.
+.ih
+PARAMETERS
+The model parameter values which are part of the MULTISPEC data structure,
+the data array, the model array, the model profiles, and the profile
+ranges must be initialized.  Other parameters for this procedure are
+input via the common in file fitgauss5.com.  These include the spectra
+to be fit and the parameters array.
+.ih
+OUTPUT
+The returned data are the final parameter values, the model and profiles
+arrays and the Y/N function value indicating if the RMS fit has been improved.
+.endhelp
+########################################################################
+
+int procedure g5_fit1 (ms, data, model, profiles, ranges, lower, len_profile)
+
+pointer	ms				# MULTISPEC database data
+real	data[ARB]			# Line of image pixels
+real	model[ARB]			# Line of model pixels
+real	profiles[ARB]			# Model profiles
+real	ranges[ARB]			# Origins of model profiles
+real	lower				# Profile origin
+int	len_profile			# Length of a model profile
+
+int	improved
+real	rms
+pointer	sp, fitparams
+
+int	g5_fit()
+real	armsrr()
+
+include	"fitgauss5.com"
+
+begin
+	# Calculate the initial RMS.  The parameter values are only changed
+	# if the new RMS is less than this value.
+	rms = armsrr (data, model, MS_LEN(ms, 1))
+	call g5_prnt3 (rms)
+
+	# Allocate and set the fitparams array.
+	call smark (sp)
+	call salloc (fitparams, MS_NSPECTRA(ms) * MS_NGAUSS5, TY_REAL)
+	call set_fitparams (spectra, parameters, MS_NSPECTRA(ms), MS_NGAUSS5,
+	    Memr[fitparams])
+
+	# Call the fitting program once to simultaneously minimize the RMS.
+	improved = g5_fit (ms, data, model, profiles, ranges, Memr[fitparams],
+	    lower, len_profile, rms)
+
+	call sfree (sp)
+	return (improved)
+end
+
+###############################################################################
+.helpsys g5fit2 Jul84 MULTISPEC
+.ih
+NAME
+G5_FIT2 -- Fitting algorithm #2.
+.ih
+DESCRIPTION
+This algorithm begins by fitting the parameters I0, X0, and S0
+simultaneously.  Note that the values of S1 and S2 are used but are
+kept fixed.  Next the parameters S0 and S1 (the shape) are fit simultaneously
+keeping I0, X0, and S2 fixed followed by fitting I0 and X0 while
+keeping S0, S1, and S2 (the shape) fixed.  If either of these fits
+fails to improve the RMS then the algorithm terminates.
+Also, if after the two steps (the fit of S0 and S1 followed by the fit
+of I0 and X0), the RMS of the fit has not improved by more than the
+user specified factor the algorithm also terminates.
+.ih
+INPUT
+The model parameter values which are part of the MULTISPEC data structure,
+the data array, the model array, the model profiles, and the profile
+ranges must be initialized.  Other parameters for this procedure are
+input via the common in file fitgauss5.com.  These include the spectra
+to be fit, the parameters array (used as a working array), and the RMS
+stopping factor.
+.ih
+OUTPUT
+The returned data are the final parameter values, the model and profiles
+arrays and the Y/N function value indicating if the RMS fit has been improved.
+.endhelp
+##############################################################################
+
+int procedure g5_fit2 (ms, data, model, profiles, ranges, lower, len_profile)
+
+pointer	ms				# MULTISPEC database data
+real	data[ARB]			# Line of image pixels
+real	model[ARB]			# Line of model pixels
+real	profiles[ARB]			# Model profiles
+real	ranges[ARB]			# Origins of model profiles
+real	lower				# Profile origin
+int	len_profile			# Length of a model profile
+
+int	improved, fit
+real	rms, rms_old
+pointer	sp, fitparams
+
+int	g5_fit()
+real	armsrr()
+
+include	"fitgauss5.com"
+
+begin
+	# Calculate the initial RMS.  The parameter values are only changed
+	# if the new RMS is less than this value.
+	rms = armsrr (data, model, MS_LEN(ms, 1))
+	call g5_prnt3 (rms)
+
+	# Allocate the fitparams array.
+	call smark (sp)
+	call salloc (fitparams, MS_NSPECTRA(ms) * MS_NGAUSS5, TY_REAL)
+
+	# Fit the parameters I0, X0, and S0.
+	parameters[I0_INDEX] = YES
+	parameters[X0_INDEX] = YES
+	parameters[S0_INDEX] = YES
+	parameters[S1_INDEX] = NO
+	parameters[S2_INDEX] = NO
+	call set_fitparams (spectra, parameters, MS_NSPECTRA(ms),
+	    MS_NGAUSS5, Memr[fitparams])
+
+	# Call the fitting procedure to minimze the RMS.
+	improved = g5_fit (ms, data, model, profiles, ranges,
+	    Memr[fitparams], lower, len_profile, rms)
+
+	# Two step fitting algorithm consisting of a fit to S0 and S1 followed
+	# by a fit to I0 and X0.  This loop terminates when either one
+	# of the fits fails to improve the RMS or the RMS has improved
+	# by less than factor after the second step (the I0, X0 fit).
+	repeat {
+	    rms_old = rms
+
+	    # Fit S0 and S1.
+	    parameters[I0_INDEX] = NO
+	    parameters[X0_INDEX] = NO
+	    parameters[S0_INDEX] = YES
+	    parameters[S1_INDEX] = YES
+	    call set_fitparams (spectra, parameters, MS_NSPECTRA(ms),
+		MS_NGAUSS5, Memr[fitparams])
+	    fit = g5_fit (ms, data, model, profiles, ranges,
+		Memr[fitparams], lower, len_profile, rms)
+	    if (fit == NO)
+		break
+	    improved = YES
+
+	    # Fit I0 and X0.
+	    parameters[I0_INDEX] = YES
+	    parameters[X0_INDEX] = YES
+	    parameters[S0_INDEX] = NO
+	    parameters[S1_INDEX] = NO
+	    call set_fitparams (spectra, parameters, MS_NSPECTRA(ms),
+		MS_NGAUSS5, Memr[fitparams])
+	    fit = g5_fit (ms, data, model, profiles, ranges,
+		Memr[fitparams], lower, len_profile, rms)
+	    if (fit == NO)
+	        break
+
+	    if (rms > (1 - factor) * rms_old)
+		break
+	}
+
+	call sfree (sp)
+	return (improved)
+end
+
+
+##############################################################################
+.helpsys g5fit Jul84 MULTISPEC
+.ih
+NAME
+G5_FIT -- Basic parameter fitting procedure.
+.ih
+INPUT
+The input data are the data array to be fit and the initial model
+parameters (part of the MULTISPEC data structure), the model array
+and model profiles (with the profile ranges array) corresponding to the
+initial model parameters, and the RMS of the model relative to the data.
+The parameters to be fit are selected by the fitparams array.
+Parameters controlling the fitting process are input to this procedure
+via the common block in the include file fitgauss5.com.  These parameters are
+the RMS stopping factor and parameters controlling the smoothing of the
+shape parameters.
+.ih
+OUTPUT
+The returned data are the final parameter values, the model and profiles
+arrays and the Y/N function value indicating if the RMS fit has been improved.
+.ih
+DESCRIPTION
+The best RMS fit is obtained by iteration.  Correction vectors for the
+parameters being fit are obtained by the simultaneous banded matrix
+method in the procedure solve.  Heuristic constraints and smoothing
+are applied to the solution and then the RMS of the new fit to the
+data is calculated.  New parameter corrections are computed until the RMS of
+the fit fails to improve by the specified factor.
+.endhelp
+############################################################################
+
+int procedure g5_fit (ms, data, model, profiles, ranges, fitparams, lower,
+    len_profile, rms)
+
+pointer	ms				# MULTISPEC data structure
+int	fitparams[ARB]			# Model parameters to be fit
+real	data[ARB]			# Data line to be fit
+real	model[ARB]			# Model line
+real	profiles[ARB]			# Model profiles
+real	ranges[ARB]			# Profile ranges
+real	lower				# Lower limit of profiles
+int	len_profile			# Length of profiles
+real	rms				# RMS of fit
+
+int	improved
+int	len_line, nspectra, nparams
+real	rms_next, rnorm
+pointer	sp, last_i0, last_x0, last_s0, last_s1, last_s2
+pointer solution, sol_i0, sol_x0, sol_s0, sol_s1, sol_s2
+
+real	armsrr()
+
+include	"fitgauss5.com"
+
+begin
+	# Set array lengths.
+	len_line = MS_LEN(ms, 1)
+	nspectra = MS_NSPECTRA(ms)
+	nparams = MS_NGAUSS5
+
+	# Allocate working memory to temporarily save the previous parameter
+	# values and to hold the correction vector.
+	call smark (sp)
+	call salloc (last_i0, nspectra, TY_REAL)
+	call salloc (last_x0, nspectra, TY_REAL)
+	call salloc (last_s0, nspectra, TY_REAL)
+	call salloc (last_s1, nspectra, TY_REAL)
+	call salloc (last_s2, nspectra, TY_REAL)
+	call salloc (solution, nspectra * nparams, TY_REAL)
+
+	# Offsets in the solution array for the various parameters.
+	sol_i0 = solution + (I0_INDEX - 1) * nspectra
+	sol_x0 = solution + (X0_INDEX - 1) * nspectra
+	sol_s0 = solution + (S0_INDEX - 1) * nspectra
+	sol_s1 = solution + (S1_INDEX - 1) * nspectra
+	sol_s2 = solution + (S2_INDEX - 1) * nspectra
+
+	improved = NO
+	repeat {
+	    # Store the last parameter values so that if the parameter values
+	    # determined in the next iteration yield a poorer RMS fit to
+	    # the data the best fit parameter values can be recovered.
+
+ 	    call amovr (PARAMETER(ms,I0,1), Memr[last_i0], nspectra)
+ 	    call amovr (PARAMETER(ms,X0,1), Memr[last_x0], nspectra)
+ 	    call amovr (PARAMETER(ms,S0,1), Memr[last_s0], nspectra)
+ 	    call amovr (PARAMETER(ms,S1,1), Memr[last_s1], nspectra)
+ 	    call amovr (PARAMETER(ms,S2,1), Memr[last_s2], nspectra)
+
+	    # Determine a correction solution vector for the selected
+	    # parameters simultaneously, apply heuristic constraints to the
+	    # solution vector, apply the correction vector to the parameter
+	    # values, and smooth the shape parameters if requested.
+
+	    # Find a least squares correction vector.
+	    call solve (ms, data, model, fitparams, profiles, ranges,
+		len_line, len_profile, nspectra, nparams, Memr[solution], rnorm)
+
+	    # Apply constraints to the correction vector.
+	    call constrain_gauss5 (ms, Memr[solution], nspectra, nparams)
+
+	    # Add the correction vector to the parameter vector.
+	    call aaddr (PARAMETER(ms,I0,1), Memr[sol_i0], PARAMETER(ms,I0,1),
+		nspectra)
+	    call aaddr (PARAMETER(ms,X0,1), Memr[sol_x0], PARAMETER(ms,X0,1),
+		nspectra)
+	    call aaddr (PARAMETER(ms,S0,1), Memr[sol_s0], PARAMETER(ms,S0,1),
+		nspectra)
+	    call aaddr (PARAMETER(ms,S1,1), Memr[sol_s1], PARAMETER(ms,S1,1),
+		nspectra)
+	    call aaddr (PARAMETER(ms,S2,1), Memr[sol_s2], PARAMETER(ms,S2,1),
+		nspectra)
+
+	    # Smooth the shape parameters.
+	    if (smooth[S0_INDEX] == YES)
+		call ms_smooth (PARAMETER(ms, X0, 1), PARAMETER(ms, S0, 1))
+	    if (smooth[S1_INDEX] == YES)
+		call ms_smooth (PARAMETER(ms, X0, 1), PARAMETER(ms, S1, 1))
+	    if (smooth[S2_INDEX] == YES)
+		call ms_smooth (PARAMETER(ms, X0, 1), PARAMETER(ms, S2, 1))
+
+	    # Calculate new model profiles and new model data line.
+	    # Determine the RMS fit of the new model to the data.
+	    # If the change in the RMS is less than factor times the
+	    # previous RMS the interation is terminated else the improvement
+	    # in the RMS is recorded and the next iteration is begun.
+
+	    # Set new model profiles.
+	    call mod_gauss5 (ms, lower, profiles, ranges, len_profile, nspectra)
+
+	    # Set new model line from the profiles.
+	    call set_model (ms, model, profiles, ranges, len_line,
+		len_profile, nspectra)
+
+	    # Calculate the RMS of the new model.
+	    rms_next = armsrr (data, model, len_line)
+
+	    # Check to see if the RMS is improved enough to continue iteration.
+	    if ((rms - rms_next) < factor * rms) {
+
+		# The RMS has not improved enough to continue iteration.
+
+		if (rms_next < rms) {
+		    # Keep the latest parameter values, profiles, and model
+		    # because the new RMS is lower than the previous RMS.
+		    # Record the improvement.
+		    rms = rms_next
+		    improved = YES
+		    call g5_prnt3 (rms)
+
+		} else {
+		    # Restore the parameter values, profiles, and model to 
+		    # previous values because the new RMS is higher.
+ 	    	    call amovr (Memr[last_i0], PARAMETER(ms,I0,1), nspectra)
+ 	    	    call amovr (Memr[last_x0], PARAMETER(ms,X0,1), nspectra)
+ 	    	    call amovr (Memr[last_s0], PARAMETER(ms,S0,1), nspectra)
+ 	    	    call amovr (Memr[last_s1], PARAMETER(ms,S1,1), nspectra)
+ 	    	    call amovr (Memr[last_s2], PARAMETER(ms,S2,1), nspectra)
+	    	    call mod_gauss5 (ms, lower, profiles, ranges, len_profile,
+			nspectra)
+	    	    call set_model (ms, model, profiles, ranges, len_line,
+			len_profile, nspectra)
+		}
+
+		# Exit the iteration loop.
+		break
+
+	    } else {
+
+		# The RMS has improved significantly.  Record the improvement
+		# and continue the iteration loop.
+
+	        rms = rms_next
+	        improved = YES
+		call g5_prnt3 (rms)
+	    }
+	}
+
+	call sfree (sp)
+	return (improved)
+end
+
+
+# G5_SET_VERBOSE -- Output procedures for verbose mode.
+
+procedure g5_set_verbose (verbose)
+
+bool	verbose
+bool	flag
+
+# entry g5_prnt1 (image, naverage, track, start)
+char	image[1]
+int	naverage
+bool	track
+int	start
+
+# entry g5_prnt2 (line, data, len_data)
+int	line, len_data
+real	data[1]
+real	rms, data_rms
+
+real	armsr()
+include	"fitgauss5.com"
+
+begin
+	# Toggle verbose output.
+	flag = verbose
+	if (flag)
+	    call fseti (STDOUT, F_FLUSHNL, YES)
+	else
+	    call fseti (STDOUT, F_FLUSHNL, NO)
+	return
+
+entry g5_prnt1 (image, naverage, track, start)
+
+	# Print the values of the various task parameters.
+
+	if (!flag)
+	    return
+
+	call printf ("\nMULTISPEC Model Fitting Program\n\n")
+	call printf ("Image file being modeled is %s.\n")
+	    call pargstr (image)
+	call printf ("Average %d lines of the image.\n")
+	    call pargi (naverage)
+	call printf ("Fitting algorithm %d.\n")
+	    call pargi (algorithm)
+	if (algorithm == 1) {
+	    if (parameters[I0_INDEX] == YES)
+	        call printf ("Fit intensity scales.\n")
+	    if (parameters[X0_INDEX] == YES)
+	        call printf ("Fit spectra positions.\n")
+	    if (parameters[S0_INDEX] == YES)
+	        call printf ("Fit spectra widths.\n")
+	    if (parameters[S1_INDEX] == YES)
+	        call printf ("Fit model parameter s1.\n")
+	    if (parameters[S2_INDEX] == YES)
+	        call printf ("Fit model parameter s2.\n")
+	}
+	if (track) {
+	    call printf ("Track model from line %d.\n")
+		call pargi (start)
+	}
+	call printf (
+	    "Iterate model until the fit RMS decreases by less than %g %%.\n\n")
+	    call pargr (factor * 100)
+
+	return
+
+entry g5_prnt2 (line, data, len_data)
+
+	# Print the image line being fit and the data RMS.
+	if (flag) {
+	    call printf ("Fit line %d:\n")
+	        call pargi (line)
+	    data_rms = armsr (data, len_data)
+	    call printf ("  Data RMS = %g\n")
+	        call pargr (data_rms)
+	}
+	return
+
+entry g5_prnt3 (rms)
+
+	# Print the RMS of the fit and the ratio to the data RMS.
+	if (flag) {
+	    call printf ("  Fit RMS = %g  Fit RMS / Data RMS = %g\n")
+	        call pargr (rms)
+	        call pargr (rms / data_rms)
+	}
+end
diff --git a/noao/twodspec/multispec/fitsmooth.x b/noao/twodspec/multispec/fitsmooth.x
new file mode 100644
index 00000000..413f3c46
--- /dev/null
+++ b/noao/twodspec/multispec/fitsmooth.x
@@ -0,0 +1,168 @@
+
+# FIT_SMOOTH -- Least-squares fit of smoothed profiles to data profiles with
+# cleaning of deviant pixels.
+#
+# The profile fitting and cleaning are combined in order to minimize
+# the calculations in re-evaluating the least-squares fit after rejecting
+# deviant pixels.
+#
+# The sigma used for rejection is calculated from the sigma of the fit
+# before rejecting any pixels.  Pixels whose residuals exceed
+# +/- sigma_cut * sigma are rejected.  The maximum number of pixels to be
+# replaced in each spectrum is max_replace.  If max_replace is zero then
+# only the model fitting is performed.
+#
+# The output of this routine are the cleaned data profiles and the least-square
+# fitted model profiles.  The number of pixels replaced is returned.
+
+
+procedure fit_smooth (line, data, model, profiles, len_prof, nspectra, nlines)
+
+int	line					# Image line of data
+real	data[len_prof, nspectra]		# Data profiles
+real	model[len_prof, nspectra]		# Model profiles
+real	profiles[len_prof, nspectra, ARB]	# Work array for SMOOTH profiles
+int	len_prof				# Length of profile
+int	nspectra				# Number of spectra
+int	nlines					# Number of lines profiles
+
+int	max_replace				# Maximum number of bad pixels
+real	sigma_cut				# Sigma cutoff on the residuals
+
+int	i, spectrum
+int	nmax, ntotal, nreplace, nreject, nindef, nsigma
+real	sum1, sum2, scale, sigma
+real	lower, upper, residual, resid_min, resid_max
+pointer	sp, a, b, c
+
+begin
+	# Allocate working memory.
+	call smark (sp)
+	call salloc (a, nspectra, TY_REAL)
+	call salloc (b, nspectra, TY_REAL)
+	call salloc (c, nspectra, TY_INT)
+
+	# Fit each spectrum and compute sigma of fit.
+	sigma = 0.
+	nsigma = 0
+	do spectrum = 1, nspectra {
+	    # Accumulate least squares sums.
+	    sum1 = 0.
+	    sum2 = 0.
+	    nindef = 0
+	    do i = 1, len_prof {
+		if (IS_INDEFR (data[i, spectrum]))
+		    nindef = nindef + 1
+	        else if (model[i, spectrum] > 0.) {
+		    sum1 = sum1 + data[i, spectrum] * model[i, spectrum]
+		    sum2 = sum2 + model[i, spectrum] * model[i, spectrum]
+	        }
+	    }
+
+	    # Compute sigma if cleanning is desired.
+	    if (nmax != 0) {
+	        scale = sum1 / sum2
+	        do i = 1, len_prof {
+		    if (!IS_INDEFR (data[i, spectrum]) &&
+			(model[i, spectrum] > 0.)) {
+		        sigma = sigma +
+		            (data[i,spectrum] - scale * model[i,spectrum]) ** 2
+			nsigma = nsigma + 1
+		    }
+		}
+	    }
+
+	    Memr[a + spectrum - 1] = sum1
+	    Memr[b + spectrum - 1] = sum2
+	    Memi[c + spectrum - 1] = nindef
+	}
+	sigma = sqrt (sigma / nsigma)
+
+	# Reject deviant pixels from the fit, scale the model to data,
+	# and replace rejected and INDEFR pixels with model values.
+	ntotal = 0
+	do spectrum = 1, nspectra {
+	    sum1 = Memr[a + spectrum - 1]
+	    sum2 = Memr[b + spectrum - 1]
+	    nindef = Memi[c + spectrum - 1]
+
+	    # If there are no model data points go to the next spectrum.
+	    if (sum2 == 0.)
+		next
+
+	    # Reject pixels if desired.
+	    nreplace = 0
+	    if (nmax != 0) {
+	        # Compare each pixel in the profile against the model and set
+	        # deviant pixels to INDEFR.  If the number of pixels to be
+		# replaced is equal to the maximum allowed or the number of
+		# pixels rejected equals the entire profile or the number of
+		# deviant pixels is zero in an iteration stop cleaning and
+		# exit the loop.  Ignore INDEFR pixels.
+
+	        repeat {
+		    nreject = 0
+		    scale = sum1 / sum2
+		    resid_min = -lower * sigma
+		    resid_max = upper * sigma
+	            do i = 1, len_prof {
+		        if (IS_INDEFR (data[i, spectrum]))
+			    next
+
+		        # Compute the residual and remove point if it exceeds
+			# the residual limits.
+
+		        residual = data[i,spectrum] - scale * model[i,spectrum]
+		        if ((residual < resid_min) || (residual > resid_max)) {
+			    # Remove point from the least squares fit
+			    # and flag the deviant pixel with INDEFR.
+			    sum1 = sum1 - data[i,spectrum] * model[i,spectrum]
+			    sum2 = sum2 - model[i,spectrum] * model[i,spectrum]
+		            data[i,spectrum] = INDEFR
+			    nreplace = nreplace + 1
+			    nreject = nreject + 1
+		        }
+		        if (nreplace == nmax)
+			    break
+		    }
+	        } until ((nreplace == nmax) || (nreject == 0) || (sum2 == 0.))
+	    }
+
+	    # If there are good pixels remaining scale the model to the
+	    # data profile.
+	    if (sum2 > 0.)
+	        call amulkr (model[1, spectrum], sum1 / sum2,
+		    model[1, spectrum], len_prof)
+
+	    # Replace bad pixels by the model values.
+	    if ((nindef > 0) || (nreplace > 0)) {
+		do i = 1, len_prof {
+		    if (IS_INDEFR (data[i, spectrum]))
+			data[i, spectrum] = model[i, spectrum]
+		}
+		ntotal = ntotal + nreplace
+	    }
+	}
+
+	# Print the number of pixel replaced.
+	call ex_prnt3 (ntotal)
+
+	# Replace the cleaned data profiles in future SMOOTH profiles.
+	if (ntotal > 0)
+	    call update_smooth (line, data, profiles, len_prof, nspectra,
+		nlines)
+
+	# Free allocated memory.
+	call sfree (sp)
+
+	return
+
+# SET_FIT_SMOOTH -- Set the cleaning parameters.
+
+entry set_fit_smooth (max_replace, sigma_cut)
+
+	nmax = max_replace
+	lower = sigma_cut
+	upper = sigma_cut
+	return
+end
diff --git a/noao/twodspec/multispec/history.x b/noao/twodspec/multispec/history.x
new file mode 100644
index 00000000..9c79965b
--- /dev/null
+++ b/noao/twodspec/multispec/history.x
@@ -0,0 +1,29 @@
+include <time.h>
+include	"ms.h"
+
+# HISTORY - Add a dated comment string to the MULTISPEC database.
+
+procedure history (ms, comment)
+
+pointer	ms
+char	comment[ARB]
+
+char	time_string[SZ_TIME]
+
+long	clktime()
+
+begin
+	# Get the clock time and convert to a date string.
+	call cnvdate (clktime(0), time_string, SZ_TIME)
+
+	# Append the following to the comment block:
+	# (date string)(: )(comment string)(newline)
+
+	call strcat (time_string, COMMENT(ms,1), SZ_MS_COMMENTS)
+	call strcat (": ", COMMENT(ms,1), SZ_MS_COMMENTS)
+	call strcat (comment, COMMENT(ms,1), SZ_MS_COMMENTS)
+	call strcat ("\n", COMMENT(ms,1), SZ_MS_COMMENTS)
+
+	# Write the updated comment block to the database.
+	call mspcomments (ms)
+end
diff --git a/noao/twodspec/multispec/intgauss5.x b/noao/twodspec/multispec/intgauss5.x
new file mode 100644
index 00000000..20118802
--- /dev/null
+++ b/noao/twodspec/multispec/intgauss5.x
@@ -0,0 +1,140 @@
+include "ms.h"
+
+# INT_GAUSS5 -- Interpolate the GAUSS5 profiles between sample lines.
+#
+# Because calculation of the model profiles from parameter values interpolated
+# from the sample lines is very slow the profiles at the sample lines are
+# calculated (only when needed) and the profiles are then interpolated.
+
+procedure int_gauss5 (ms, lower, profiles, ranges, len_profile, nspectra,
+    nparams, line)
+
+pointer	ms				# MULTISPEC data structure
+real	lower				# Lower limit of profiles rel. to center
+real	profiles[len_profile, nspectra, nparams, 3] # Model profiles
+real	ranges[nspectra, LEN_RANGES, 3]	# Range array for profiles
+int	len_profile			# Length of each profile
+int	nspectra			# Number of spectra
+int	nparams				# Number of parameters
+int	line				# Image line to be interpolated to
+
+real	f, x
+int	i, a, b, line1, line2
+
+real	cveval()
+
+begin
+	# The values of the static variables are used in successive calls
+	# to record the state of the interpolation endpoints.  To initialize
+	# this routine the value of the first element of the ranges array
+	# is checked for the flag INDEFR.  The profiles array must be
+	# dimensioned to have three sets of profiles (each set consisting
+	# of nspectra * nparams profiles).  The first set is the interpolated
+	# profiles, profiles[*,*,*,1], and the other two sets hold the
+	# latest profiles from the interpolation endpoint sample lines,
+	# profiles[*,*,*,2] and profiles[*,*,*,3].
+
+	# If there is only one sample line then calculate the profiles
+	# only once (when the ranges array has been flagged) and return
+	# the same profiles for every image line.
+	if (MS_NSAMPLES(ms) == 1) {
+	    if (IS_INDEFR (ranges[1,1,1])) {
+	        call msggauss5 (ms, line1)
+	        call mod_gauss5 (ms, lower, profiles, ranges, len_profile,
+		    nspectra)
+	    }
+	    return
+	}
+
+	# If there is more than one sample line then interpolation makes
+	# sense.  Initialize the interpolation algorithm if the ranges array
+	# has been flagged.
+
+	if (IS_INDEFR (ranges[1,1,1])) {
+	    call msgparam (ms, I0, 1)
+	    call msgparam (ms, X0, 1)
+	    call msgfits (ms, X0_FIT)
+	    a = 1
+	    line1 = 0
+	    line2 = 0
+	}
+
+	# Find the nearest sample line which is less than the desired
+	# image line and is not the last sample line and mark this as
+	# endpoint sample line a.  Start from the last endpoint for efficiency.
+	# Search forward if the desired image line is greater than the
+	# endpoint sample line and backwards otherwise.
+
+	if (line > LINE(ms, a)) {
+	    do i = a + 1, MS_NSAMPLES(ms) - 1 {
+		if (line > LINE(ms, i))
+		    a = i
+		else
+		    break
+	    }
+	} else {
+	    do i = a, 1, -1 {
+		if (line <= LINE(ms, a))
+		    a = i
+		else
+		    break
+	    }
+	}
+
+	# Since endpoint a is not allowed to be the last sample line then
+	# the upper interpolation endpoint is the next sample line.
+	b = a + 1
+
+	# Check to see if the new endpoints are different than the previous
+	# endpoints.  If so then read the model parameters from the database
+	# for the endpoints and evaluate the model profiles.
+	if ((line1 == a) && (line2 == b))
+	    ;					# Endpoints are the same.
+	else if ((line1 == b) && (line2 == a))
+	    ;					# Endpoints are the same.
+	else if ((line1 == a) && (line2 != b)) {
+	    line2 = b				# One endpoint is different.
+	    call msggauss5 (ms, line2)
+	    call mod_gauss5 (ms, lower, profiles[1,1,1,3], ranges[1,1,3],
+		len_profile, nspectra)
+	} else if ((line1 == b) && (line2 != a)) {
+	    line2 = a				# One endpoint is different.
+	    call msggauss5 (ms, line2)
+	    call mod_gauss5 (ms, lower, profiles[1,1,1,3], ranges[1,1,3],
+		len_profile, nspectra)
+	} else if ((line1 != b) && (line2 == a)) {
+	    line1 = b				# One endpoint is different.
+	    call msggauss5 (ms, line1)
+	    call mod_gauss5 (ms, lower, profiles[1,1,1,2], ranges[1,1,2],
+		len_profile, nspectra)
+	} else if ((line1 != a) && (line2 == b)) {
+	    line1 = a				# One endpoint is different.
+	    call msggauss5 (ms, line1)
+	    call mod_gauss5 (ms, lower, profiles[1,1,1,2], ranges[1,1,2],
+		len_profile, nspectra)
+	} else {
+	    line1 = a				# Both endpoints are different.
+	    call msggauss5 (ms, line1)
+	    call mod_gauss5 (ms, lower, profiles[1,1,1,2], ranges[1,1,2],
+		len_profile, nspectra)
+	    line2 = b
+	    call msggauss5 (ms, line2)
+	    call mod_gauss5 (ms, lower, profiles[1,1,1,3], ranges[1,1,3],
+		len_profile, nspectra)
+	}
+
+	# Calculate the ranges for the interpolated range array to the
+	# interpolated spectra position.
+	f = real (line)
+	do i = 1, nspectra {
+	    x = cveval (CV(ms, X0_FIT, i), f)
+	    ranges[i, X_START, 1] = int(x) + lower
+	    ranges[i, DX_START, 1] = ranges[i, X_START, 1] - x
+	}
+
+	# Do the profile interpolation.
+	f = float (line - LINE(ms, line1)) /
+	    (LINE(ms, line2) - LINE(ms, line1))
+	call profile_interpolation (f, len_profile, nspectra, nparams,
+	    profiles, ranges)
+end
diff --git a/noao/twodspec/multispec/mkpkg b/noao/twodspec/multispec/mkpkg
new file mode 100644
index 00000000..be03b41f
--- /dev/null
+++ b/noao/twodspec/multispec/mkpkg
@@ -0,0 +1,66 @@
+# MULTISPEC Package.
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$call	multispec
+	;
+
+install:
+	$move	x_multispec.e noaobin$
+	;
+
+multispec:
+	$omake	x_multispec.x
+	$set	LIBS = "-lxtools -lllsq -lcurfit -ldeboor -linterp"
+	$link	x_multispec.o libpkg.a $(LIBS)
+	;
+
+libpkg.a:
+	@dbio
+
+	armsr.x
+	clinput.x
+	exgauss5.x	ms.h
+	exsmooth.x	ms.h
+	exstrip.x	ms.h
+	fitclean.x	ms.h
+	fitgauss5.x	ms.h fitgauss5.com
+	fitsmooth.x	ms.h
+	history.x	ms.h
+	intgauss5.x	ms.h
+	modgauss5.x	ms.h
+	msextract.x	ms.h
+	msget.x		ms.h
+	msio.x		ms.h
+	msnames.x	ms.h
+	msput.x		ms.h
+	mssmooth.x
+	peaks.x
+	profinterp.x	ms.h
+	ranges.x
+	sampline.x	ms.h
+	setfitparams.x	ms.h
+	setmodel.x	ms.h
+	setranges.x	ms.h
+	setsmooth.x	ms.h
+	solve.x		ms.h
+	unblend.x	ms.h
+	msplot.x	<imhdr.h>
+	t_findpeaks.x	ms.h
+	t_fitfunc.x	ms.h
+	t_fitgauss5.x	ms.h fitgauss5.com
+	t_modellist.x	ms.h
+	t_msextract.x	ms.h
+	t_mslist.x	ms.h
+	t_msset.x	ms.h
+	t_newextract.x	ms.h
+	t_newimage.x	ms.h
+	;
diff --git a/noao/twodspec/multispec/modellist.par b/noao/twodspec/multispec/modellist.par
new file mode 100644
index 00000000..2c622668
--- /dev/null
+++ b/noao/twodspec/multispec/modellist.par
@@ -0,0 +1,9 @@
+# MODELLIST
+
+image,f,a,,,,Image
+lines,s,a,,,,Sample image lines to be listed
+model,s,h,"gauss5",,,Model to be listed
+columns,s,h,"*",,,Image columns to be listed
+naverage,i,h,20,,,Number of image lines to average
+lower,r,h,-10,,,Lower limit of model profiles
+upper,r,h,10,,,Upper limit of model profiles
diff --git a/noao/twodspec/multispec/modgauss5.x b/noao/twodspec/multispec/modgauss5.x
new file mode 100644
index 00000000..437b1a85
--- /dev/null
+++ b/noao/twodspec/multispec/modgauss5.x
@@ -0,0 +1,164 @@
+include "ms.h"
+
+# MOD_GAUSS5 -- Set GAUSS5 model profiles and ranges.
+#
+# This routine can be speeded up with look up tables for a and exp(-z).
+
+define	ZMIN	0		# Issue warning if z < ZMIN
+define	ZMAX	10		# The profile values are zero for z > ZMAX
+
+procedure mod_gauss5 (ms, lower, profiles, ranges, len_profile, nspectra)
+
+pointer	ms					# MULTISPEC data structure
+real	lower					# Lower limit of profiles
+real	profiles[len_profile, nspectra, ARB]	# The profiles to be set
+						# The third dim must be >= 5
+real	ranges[nspectra, LEN_RANGES]		# The ranges to be set
+int	len_profile				# The length of each profile
+int	nspectra				# The number of spectra
+
+int	i, j, warn
+real	dx, dx2, y, z
+real	x1, a, s, s0, s1, s2, s3, profile
+real	dIdx0, dIdI0, dIds0, dIds1, dIds2
+real	dydx0, dzdx0
+
+begin
+	# First set the ranges array.
+	call set_ranges (ms, lower, ranges, nspectra)
+
+	# The model quantity x1 is set to 1/4 the profile length.
+	# This could someday become a model parameter.
+	x1 = len_profile / 4
+
+	# For each spectrum and each point in the profile set the
+	# profile/derivative values for the 5 Gauss5 parameters.
+
+	warn = YES
+	do i = 1, nspectra {
+	    s0 = PARAMETER(ms, S0, i)
+	    s1 = PARAMETER(ms, S1, i)
+	    s2 = PARAMETER(ms, S2, i)
+	    do j = 1, len_profile {
+	        dx = ranges[i, DX_START] + j - 1
+	        dx2 = dx * dx
+	        a = 1 / sqrt (dx2 + x1 ** 2)
+	        y = a * dx
+		if (y < 0)
+		    s3 = s2 - s1
+		else
+		    s3 = s2 + s1
+	        s = s0 + y * s3
+	        z = s * dx2
+	        if (z < ZMIN) {
+		    # Issue warning only once.
+		    if (warn == YES) {
+		        call printf ("WARNING: mod_gauss5 error.\n")
+			warn = NO
+		    }
+		}
+	        if (z < ZMAX) {
+		    profile = exp(-z)
+		    dydx0 = -(a ** 3) * (x1 ** 2)
+		    dzdx0 = -2 * s * dx + dydx0 * s3 * dx2
+		    dIdI0 = profile
+		    dIdx0 = -dzdx0 * profile
+		    dIds0 = -dx2 * profile
+		    dIds1 = -dx2 * y * profile
+		    dIds2 = dIds1
+		    if (y < 0)
+			dIds1 = -dIds1
+
+		    profiles[j,i,I0_INDEX] = dIdI0
+		    profiles[j,i,X0_INDEX] = dIdx0
+		    profiles[j,i,S0_INDEX] = dIds0
+		    profiles[j,i,S1_INDEX] = dIds1
+		    profiles[j,i,S2_INDEX] = dIds2
+		} else {
+		    profiles[j,i,I0_INDEX] = 0.
+		    profiles[j,i,X0_INDEX] = 0.
+		    profiles[j,i,S0_INDEX] = 0.
+		    profiles[j,i,S1_INDEX] = 0.
+		    profiles[j,i,S2_INDEX] = 0.
+		}
+	    }
+	}
+end
+
+# CONSTRAIN_GAUSS5 -- Apply constraints to the solution vector for GAUSS5.
+#
+# The constraints are:
+#
+#    DI0 > -I0/2, abs(DX0) < MAX_DX0, DS0 > -S0/2,
+#    (S0+DS0)+-(S1+DS1)+(S2+DS2) > 0.
+#
+# where DI0, DX0, DS0, DS1, DS2 are the solution corrections and I0, S0,
+# S1, and S2 are the original parameter values.  The constraints on DI0,
+# and DS0 insure that I0 and S0 remain positive and the last constraint
+# insures that (S0+-S1+S2) always remains positive so that the profiles
+# always decrease from the center.
+
+define	MAX_DX0		1.		# Maximum change in position
+
+procedure constrain_gauss5 (ms, solution, nspectra, nparams)
+
+pointer	ms
+real	solution[nspectra, nparams]
+int	nspectra
+int	nparams
+
+int	i
+real	max_delta
+real	sa, sb, dsa, dsb, scalea, scaleb, scale
+
+begin
+	do i = 1, nspectra {
+
+	    # Limit any decrease in I0 to 1/2 I0.  This insures I0 > 0.
+	    if (solution[i, I0_INDEX] != 0.) {
+		max_delta = PARAMETER(ms, I0, i) / 2.
+		solution[i, I0_INDEX] = max (solution[i, I0_INDEX], -max_delta)
+	    }
+
+	    # Limit the correction for X0 to MAX_DX0.
+	    # Set the position to INDEF if it falls outside the image.
+	    if (solution[i, X0_INDEX] != 0.) {
+		max_delta = MAX_DX0
+		solution[i, X0_INDEX] = max (solution[i, X0_INDEX], -max_delta)
+		solution[i, X0_INDEX] = min (solution[i, X0_INDEX], max_delta)
+	    }
+
+	    # Limit any decrease in S0 to 1/2 of S0. This insures S0 > 0.
+	    if (solution[i, S0_INDEX] != 0.) {
+		max_delta = PARAMETER(ms, S0, i) / 2.
+		solution[i, S0_INDEX] = max (solution[i, S0_INDEX], -max_delta)
+	    }
+
+	    # Limit the final S0+-S1+S2 to be positive.  If the value would be
+	    # negative scale the correction vector (ds0, ds1, ds2) to make
+	    # the final S0+-S1+S2 be 1/2 the old value.
+	    if ((solution[i,S0_INDEX] != 0.) || (solution[i,S1_INDEX] != 0.) ||
+		(solution[i,S2_INDEX] != 0.)) {
+		sa = PARAMETER(ms, S0, i) + PARAMETER(ms, S1, i) +
+		    PARAMETER(ms, S2, i)
+		sb = PARAMETER(ms, S0, i) - PARAMETER(ms, S1, i) +
+		    PARAMETER(ms, S2, i)
+		dsa = solution[i, S0_INDEX] + solution[i, S1_INDEX] +
+		    solution[i, S2_INDEX]
+		dsb = solution[i, S0_INDEX] - solution[i, S1_INDEX] +
+		    solution[i, S2_INDEX]
+		if (sa + dsa < 0.)
+		    scalea = -sa / 2 / dsa
+		else
+		    scalea = 1.
+		if (sb + dsb < 0.)
+		    scaleb = -sb / 2 / dsb
+		else
+		    scaleb = 1.
+		scale = min (scalea, scaleb)
+		solution[i, S0_INDEX] = scale * solution[i, S0_INDEX]
+		solution[i, S1_INDEX] = scale * solution[i, S1_INDEX]
+		solution[i, S2_INDEX] = scale * solution[i, S2_INDEX]
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/ms.h b/noao/twodspec/multispec/ms.h
new file mode 100644
index 00000000..7343e765
--- /dev/null
+++ b/noao/twodspec/multispec/ms.h
@@ -0,0 +1,77 @@
+
+# MULTISPEC Definitions
+
+define	SZ_MS_IMAGE	79	# Size of image filename string
+define	SZ_MS_TITLE	79	# Size of the image title string
+define	SZ_MS_COMMENTS	1024	# Size of MULTISPEC comment block
+define	SZ_MS_KEY	20	# Size of the database reference strings
+
+define	MS_DB_ENTRIES	20	# Max number of database entries
+define	MS_MAX_DES	1	# Max number of MULTISPEC descriptors
+define	MAX_RANGES	30	# Maximum range dimension.
+
+define	MS_ERROR	1000	# General MULTISPEC error code
+
+# MULTISPEC I/O Descriptor
+
+define	LEN_MS_DES	2 + MS_DB_ENTRIES
+
+define	MS_DB		Memi[$1]	# DBIO descriptor
+define	MS_NAMES	Memi[$1+1]	# Pointer to database names array
+define	MS_DATA		Memi[$1+1+$2]	# Pointers to data from database
+
+# MULTISPEC Header stored in database.
+
+define	LEN_MS_HDR	84			# Length of MULTISPEC Header
+
+define	MS_IMAGE	Memi[MS_DATA($1,HDR)]		# Image filename
+define	MS_TITLE	Memi[MS_DATA($1,HDR)+40]	# Title from the image
+define	MS_NSPECTRA	Memi[MS_DATA($1,HDR)+80]	# Number of spectra
+define	MS_LEN		Memi[MS_DATA($1,HDR)+($2-1)+81] # Image dimensions
+define	MS_NSAMPLES	Memi[MS_DATA($1,HDR)+83]	# Number of sample lines
+
+# User callable macros
+
+define	NAME		Memc[MS_NAMES($1)+($2-1)*(SZ_MS_KEY+1)]
+define	HEADER		Memi[MS_DATA($1,HDR)]
+define	COMMENT		Memc[MS_DATA($1,COMMENTS)+($2-1)]
+define	LINE		Memi[MS_DATA($1,SAMPLE)+($2-1)]
+define	PARAMETER	Memr[MS_DATA($1,$2)+($3-1)]
+define	CV		Memi[MS_DATA($1,$2)+($3-1)]
+
+# Ranges
+
+define	LEN_RANGES	2
+
+define	X_START		1	# Start of profile in image pixel coordinates
+define	DX_START	2	# Start of profile relative to spectra center
+
+# MULTISPEC parameter identifiers
+
+define	HDR		1	# MULTISPEC header
+define	COMMENTS	2	# MULTISPEC comments
+define	SAMPLE		3	# Sample line array
+define	I0		4	# Profile scale parameter
+define	X0		5	# Profile position parameter
+define	X0_FIT		6	# Spectra position fit
+
+define	S0		7	# GAUSS5 shape parameter
+define	S1		8	# GAUSS5 shape parameter
+define	S2		9	# GAUSS5 shape parameter
+define	S0_FIT		10	# GAUSS5 shape paramter fit
+define	S1_FIT		11	# GAUSS5 shape paramter fit
+define	S2_FIT		12	# GAUSS5 shape paramter fit
+
+
+# Models
+define	NONE		0	# No model
+define	GAUSS5		1	# Five parameter Gaussian model
+define	SMOOTH		2	# Data profile smoothing
+
+# Five parameter Gaussian model -- GAUSS5
+define	MS_NGAUSS5	5	# Number of GAUSS5 model parameters
+define	I0_INDEX	1	# Index values for parameter arrays
+define	X0_INDEX	2
+define	S0_INDEX	3
+define	S1_INDEX	4
+define	S2_INDEX	5
diff --git a/noao/twodspec/multispec/msextract.par b/noao/twodspec/multispec/msextract.par
new file mode 100644
index 00000000..f85081c5
--- /dev/null
+++ b/noao/twodspec/multispec/msextract.par
@@ -0,0 +1,20 @@
+# MSEXTRACT
+
+image,f,a,,,,Image to be extracted
+output,f,a,,,,Output extraction image file
+lower,r,h,-10,,,Lower limit of extraction
+upper,r,h,10,,,Upper limit of extraction
+spectra,s,h,"*",,,Spectra to be extracted
+lines,s,h,"*",,,Image lines to be extracted
+ex_model,b,h,no,,,Extract model spectra?
+integrated,b,h,yes,,,Extract integrated spectra?
+unblend,b,h,no,,,Correct spectra for blending?
+clean,b,h,yes,,,Clean bad and discrepant pixels?
+nreplace,i,h,1000,0,,Maximum number of pixels to be cleaned
+sigma_cut,r,h,4.,,,Sigma cutoff for cleaning
+niterate,i,h,1,1,,Maximum number of cleaning iterations per line
+model,s,h,smooth,,,Model for cleaning and/or model extraction
+naverage,i,h,20,,,Number of image lines in average profile model
+fit_type,i,h,2,1,2,Model fitting type for model gauss5
+interpolator,s,h,"spline3",,,Type of image interpolation
+verbose,b,h,no,,,Verbose output?
diff --git a/noao/twodspec/multispec/msextract.x b/noao/twodspec/multispec/msextract.x
new file mode 100644
index 00000000..e3017065
--- /dev/null
+++ b/noao/twodspec/multispec/msextract.x
@@ -0,0 +1,154 @@
+include <fset.h>
+include	<imhdr.h>
+include "ms.h"
+
+# EX_OUT -- Write and format the extracted spectra to the output image.
+# SUM_PIXELS -- Sum pixel array between the limits lower and upper.
+# EX_SET_VEBOSE -- Set and print verbose output.
+
+
+# EX_OUT -- Write and format the extracted spectra to the output image.
+#
+# The type of output is selected by the value of ex_integral.
+# If ex_integral = yes then sum the spectra profiles and output one value
+# per spectrum otherwise output the strip spectra profiles.
+
+procedure ex_out (im_out, line_out, spectra, lower, upper, ranges, profiles,
+	len_profile, nspectra, ex_integral)
+
+pointer	im_out				# Output image file descriptor
+int	line_out			# Output line
+int	spectra[ARB]			# Spectra range list
+real	lower				# Lower integral limit
+real	upper				# Upper integral limit
+real	ranges[nspectra, LEN_RANGES]	# Starting points of profiles
+real	profiles[len_profile, nspectra]	# Real spectra profiles
+int	len_profile			# Length of spectra profiles
+int	nspectra			# Number of spectra profiles
+bool	ex_integral
+
+int	i, spectrum_in, spectrum_out
+real	x_min, x_max
+pointer	buf_out
+
+int	get_next_number()
+real	sum_pixels()
+pointer	impl3r()
+
+begin
+	# Loop through the selected spectra write an image line for one.
+	spectrum_in = 0
+	spectrum_out = 0
+	while (get_next_number (spectra, spectrum_in) != EOF) {
+	    spectrum_out = spectrum_out + 1
+	    buf_out = impl3r (im_out, line_out, spectrum_out)
+
+	    # Select between integrated and strip spectra output.  If
+	    # integrated spectra call sum_pixels to integrate the spectrum
+	    # profile else output the spectrum profile.
+	    if (ex_integral) {
+	        x_min = lower - ranges[spectrum_in, DX_START] + 1
+	        x_max = upper - ranges[spectrum_in, DX_START] + 1
+	        Memr[buf_out] =
+		    sum_pixels (profiles[1, spectrum_in], x_min, x_max)
+	    } else {
+	        do i = 1, len_profile
+		    Memr[buf_out + i - 1] = profiles[i, spectrum_in]
+	    }
+	}
+end
+
+
+# SUM_PIXELS -- Sum pixel array between the limits lower and upper.
+# The limits may be partial pixels.  There is no checking for out of
+# array range limits.
+
+real procedure sum_pixels (pixels, x_min, x_max)
+
+real	pixels[ARB]			# Pixel array to be summed
+real	x_min				# Lower limit of sum
+real	x_max				# Upper limit of sum
+
+int	i, i_min, i_max
+real	f, value
+
+begin
+	# Determine bounding integer limits.
+	i_min = x_min + 0.5
+	i_max = x_max + 0.5
+
+	# Add partial pixel endpoints.
+
+	f = min (x_max, i_min + 0.5) - x_min
+	value = f * pixels[i_min]
+	if (i_min >= i_max)
+	    return (value)
+
+	f = x_max - (i_max - 0.5)
+	value = value + f * pixels[i_max]
+	if (i_min + 1 > i_max - 1)
+	    return (value)
+
+	# Sum non-endpoint pixels.
+
+	do i = i_min + 1, i_max - 1
+	    value = value + pixels[i]
+
+	return (value)
+end
+
+# EX_SET_VERBOSE -- Output procedures for verbose mode.
+
+procedure ex_set_verbose (verbose)
+
+bool	verbose
+
+#entry ex_prnt1 (image_in, image_out)
+char	image_in[1]
+char	image_out[1]
+
+# entry ex_prnt2 (line_in, line_out)
+int	line_in, line_out, nreplaced
+
+bool	flag
+
+begin
+	# Toggle verbose output.
+	flag = verbose
+	if (flag)
+	    call fseti (STDOUT, F_FLUSHNL, YES)
+	else
+	    call fseti (STDOUT, F_FLUSHNL, NO)
+	return
+
+entry ex_prnt1 (image_in, image_out)
+
+	# Set the verbose flag and print general header information.
+	if (flag) {
+	    call printf ("\nMULTISPEC Extraction Program\n\n")
+	    call printf ("Image being extracted is %s.\n")
+	        call pargstr (image_in)
+	    call printf ("Output extraction image is %s.\n")
+	        call pargstr (image_out)
+	}
+	return
+
+entry ex_prnt2 (line_in, line_out)
+
+	# Print the image line being extracted.
+	if (flag) {
+	    call printf ("Input image line = %d and output image line = %d.\n")
+	        call pargi (line_in)
+	        call pargi (line_out)
+	}
+	return
+
+entry ex_prnt3 (nreplaced)
+
+	# Print the number of pixels replaced in cleaning.
+	if (flag && (nreplaced > 0)) {
+	    call printf ("  Number of pixels replaced: %d\n")
+	        call pargi (nreplaced)
+	}
+	return
+end
diff --git a/noao/twodspec/multispec/msget.x b/noao/twodspec/multispec/msget.x
new file mode 100644
index 00000000..e187015a
--- /dev/null
+++ b/noao/twodspec/multispec/msget.x
@@ -0,0 +1,208 @@
+include <imhdr.h>
+include "ms.h"
+
+# MSGET -- Allocate memory and get data from the MULTISPEC database
+# and associated image.
+#
+# MSGHDR	-- Allocate memory and get MULTISPEC header information.
+# MSGCOMMENTS	-- Allocate memory and get MULTISPEC comments.
+# MSGPARAM	-- Allocate memory and get a line of MULTISPEC parameter data.
+# MSGSAMPLE	-- Allocate memory and get SAMPLE line array.
+# MSGFIT	-- Get parameter fit for a spectrum.
+# MSGFITS	-- Get parameter fit for all spectra.
+# MSGGAUSS5	-- Get a line of GAUSS5 parameter data.
+# MSGIMAGE	-- Get a line of the image with possible averaging.
+
+
+# MSGHDR -- Allocate memory and get MULTISPEC header information.
+
+procedure msghdr (ms)
+
+pointer	ms				# MULTISPEC data structure
+
+int	i
+
+int	dbread()
+
+begin
+	if (MS_DATA(ms, HDR) == NULL)
+	    call calloc (MS_DATA(ms, HDR), LEN_MS_HDR, TY_STRUCT)
+	i = dbread (MS_DB(ms), NAME(ms, HDR), HEADER(ms), 1)
+end
+
+# MSGCOMMENTS -- Allocate memory and get MULTISPEC comments.
+
+procedure msgcomments (ms)
+
+pointer	ms				# MULTISPEC data structure
+
+int	i
+
+int	dbread()
+
+begin
+	if (MS_DATA(ms, COMMENTS) == NULL)
+	    call calloc (MS_DATA(ms, COMMENTS), SZ_MS_COMMENTS, TY_CHAR)
+	i = dbread (MS_DB(ms), NAME(ms, COMMENTS), COMMENT(ms, 1), 1)
+end
+
+# MSGPARAM -- Allocate memory and get a line of MULTISPEC parameter data.
+
+procedure msgparam (ms, parameter, line)
+
+pointer	ms				# MULTISPEC data structure
+int	parameter			# Parameter ID
+int	line				# Sample line to be obtained
+
+int	i
+char	reference[SZ_MS_KEY]
+
+bool	is_param_id()
+int	dbread()
+
+begin
+	# Check if the the requested parameter is valid.
+	if (!is_param_id (parameter))
+	    call error (MS_ERROR, "Bad parameter identifier")
+
+	if (MS_DATA(ms, parameter) == NULL)
+	    call calloc (MS_DATA(ms, parameter), MS_NSPECTRA(ms), TY_REAL)
+
+	# Make reference to the desired database record.
+	call sprintf (reference, SZ_MS_KEY, "%s[%d]")
+	    call pargstr (NAME(ms, parameter))
+	    call pargi (line)
+
+	i = dbread (MS_DB(ms), reference, PARAMETER(ms, parameter, 1), 1)
+end
+
+# MSGSAMPLE -- Allocate memory and get SAMPLE line array.
+
+procedure msgsample (ms)
+
+pointer	ms				# MULTISPEC data structure
+
+int	i
+
+int	dbread()
+
+begin
+	if (MS_DATA(ms, SAMPLE) == NULL)
+	    call malloc (MS_DATA(ms, SAMPLE), MS_NSAMPLES(ms), TY_INT)
+	i = dbread (MS_DB(ms), NAME(ms, SAMPLE), LINE(ms,1), 1)
+end
+
+
+# MSGFIT -- Get parameter fit for a spectrum.
+
+procedure msgfit (ms, parameter, spectrum)
+
+pointer	ms				# MULTISPEC data structure
+int	parameter			# Parameter ID for desired fit
+int	spectrum			# Spectrum
+
+int	i
+char	reference[SZ_MS_KEY]
+pointer	sp, fit
+
+bool	is_fit_id()
+int	dbread()
+
+errchk	cvrestore
+
+begin
+	# Check if for valid parameter id.
+	if (!is_fit_id (parameter))
+	    call error (MS_ERROR, "Bad fit identifier")
+
+	# Allocate memory for the curfit pointers.
+	if (MS_DATA(ms, parameter) == NULL)
+	    call malloc (MS_DATA(ms, parameter), MS_NSPECTRA(ms), TY_INT)
+
+	# Allocate memory for the curfit coefficients.
+	call smark (sp)
+	call salloc (fit, 7 + MS_NSAMPLES(ms), TY_REAL)
+
+	# Reference appropriate data.
+	call sprintf (reference, SZ_MS_KEY, "%s[%d]")
+	    call pargstr (NAME(ms, parameter))
+	    call pargi (spectrum)
+
+	i = dbread (MS_DB(ms), reference, Memr[fit], 1)
+	iferr (call cvrestore (CV(ms, parameter, spectrum), Memr[fit]))
+	    ;
+
+	call sfree (sp)
+end
+
+
+# MSGFITS -- Get parameter fits.
+
+procedure msgfits (ms, parameter)
+
+pointer	ms				# MULTISPEC data structure
+int	parameter			# Parameter ID for desired fit
+
+int	i
+
+begin
+	do i = 1, MS_NSPECTRA(ms)
+	    call msgfit (ms, parameter, i)
+end
+
+
+# MSGGAUSS5 -- Get a line of GAUSS5 parameter data.
+
+procedure msggauss5 (ms, line)
+
+pointer	ms				# MULTISPEC data structure
+int	line				# Sample line to be obtained
+
+begin
+	call msgparam (ms, I0, line)
+	call msgparam (ms, X0, line)
+	call msgparam (ms, S0, line)
+	call msgparam (ms, S1, line)
+	call msgparam (ms, S2, line)
+end
+
+
+# MSGIMAGE -- Get a line of the image with possible averaging.
+
+procedure msgimage (im, line, naverage, data)
+
+pointer	im				# Image descriptor
+int	line				# Line to be gotten from the image
+int	naverage			# Number of line to use in average
+real	data[ARB]			# The output data array
+
+int	i, line_start, line_end
+real	nlines
+pointer	buf
+
+pointer	imgl2r()
+
+begin
+	# If naverage is <= 1 copy the image line to the data array
+	# Else average the several lines.
+
+	if (naverage <= 1) {
+	    call amovr (Memr[imgl2r (im, line)], data, IM_LEN(im,1))
+	} else {
+	    # Determine starting and ending lines for the average.
+	    line_start = max (1, line - naverage / 2)
+	    line_end = min (IM_LEN(im, 2), line_start + naverage - 1)
+
+	    # Clear data array for accumulating sum and then vector
+	    # add the image lines.
+	    call aclrr (data, IM_LEN(im, 1))
+	    do i = line_start, line_end {
+	        buf = imgl2r (im, i)
+	        call aaddr (Memr[buf], data, data, IM_LEN(im, 1))
+	    }
+
+	    # Vector divide by the number of lines to form average.
+	    nlines = line_end - line_start + 1
+	    call adivkr (data, nlines, data, IM_LEN(im, 1))
+	}
+end
diff --git a/noao/twodspec/multispec/msio.x b/noao/twodspec/multispec/msio.x
new file mode 100644
index 00000000..583c2253
--- /dev/null
+++ b/noao/twodspec/multispec/msio.x
@@ -0,0 +1,194 @@
+include	<error.h>
+include	<imhdr.h>
+include "ms.h"
+
+# MSIO -- MULTISPEC interface to DBMS.
+#
+# MSMAP		-- Map a MULTISPEC database.
+# MSUNMAP	-- Close MULTISPEC database and free MSIO memory allocation.
+# MSGDES	-- Allocate and return a MSIO descriptor.  Post error recovery.
+# MS_FREE_DES	-- Close a database and free allocated memory.
+# MS_ERROR	-- Take error recovery action by closing all open databases.
+
+
+# MSMAP -- Map a MULTISPEC database.
+#
+# The database name is formed by adding the extension '.db' to the image.
+#
+# For a new database:
+#	Create the database, make entries for the header and comments,
+#	allocate memory for the header and comments and return MSIO descriptor.
+# For an existing database:
+#	Open the database, allocate memory and read the header, comments, and
+#	sample line array, and return MSIO descriptor.
+
+pointer procedure msmap (image, mode, max_entries)
+
+# Procedure msmap parameters:
+char	image[ARB]			# Image
+int	mode				# Access mode for database
+int	max_entries			# Maximum number of entries
+
+char	database[SZ_FNAME]		# MULTISPEC database filename
+pointer	db, ms
+
+pointer	dbopen()
+
+begin
+	# Create the database filename.
+	call sprintf (database, SZ_FNAME, "%s.db")
+	    call pargstr (image)
+
+	# Open the database with specified mode and max_entries.
+	db = dbopen (database, mode, max_entries)
+
+	# Get an MSIO descriptor.
+	call msgdes (ms)
+	MS_DB(ms) = db
+
+	if (mode == NEW_FILE) {
+	    # For a NEW_FILE enter the header and comment records and
+	    # call msghdr and msgcomments to allocate memory.
+	    call dbenter (db, NAME(ms, HDR), LEN_MS_HDR * SZ_STRUCT, 1)
+	    call dbenter (db, NAME(ms, COMMENTS), SZ_MS_COMMENTS + 1, 1)
+	    call msghdr (ms)
+	    call msgcomments (ms)
+	} else {
+	    # For an existing database read the header, comments, and
+	    # sample line array.
+	    call msghdr (ms)
+	    call msgcomments (ms)
+	    call msgsample (ms)
+	}
+
+	# Return MSIO descriptor.
+	return (ms)
+end
+
+
+# MSUNMAP -- Close MULTISPEC database and free MSIO memory allocation.
+
+procedure msunmap (ms)
+
+pointer	ms			# MSIO descriptor
+
+begin
+	call dbclose (MS_DB(ms))
+	call ms_free_des (ms)
+end
+
+
+# Procedures accessing the MSIO descriptor list.
+#
+# MSGDES  -- Allocate and return a MSIO descriptor.  Post error recovery.
+# MS_FREE_DES -- Close a database and free allocated memory.
+# MS_ERROR   -- Take error recovery action by closing all open databases.
+
+procedure msgdes (ms)
+
+pointer	ms			# MSIO descriptor
+
+int	init
+
+extern	ms_error()
+
+int	ndes			# Number of allocated MSIO descriptors
+pointer	msdes[MS_MAX_DES]	# MSIO descriptor list
+
+common	/msiocom/ ndes, msdes
+
+data	init/YES/
+
+begin
+	# Initialize and post error recovery.
+	if (init == YES) {
+	    ndes = 0
+	    call onerror (ms_error)
+	    init = NO
+	}
+
+	# Check if requested descriptor would overflow the descriptor list.
+	if (ndes == MS_MAX_DES)
+	    call error (MS_ERROR, "Attempt to open too many MULTISPEC files")
+
+	# Allocate memory for the descriptor and enter in pointer in list.
+	ndes = ndes + 1
+	call malloc (msdes[ndes], LEN_MS_DES, TY_STRUCT)
+	ms = msdes[ndes]
+
+	# Initialize descriptor to NULL.
+	call amovki (NULL, Memi[ms], LEN_MS_DES)
+
+	# Initialize the MULTISPEC database name list.
+	call msnames (ms)
+end
+
+# MS_FREE_DES -- Close a database and free allocated memory.
+
+procedure ms_free_des (ms)
+
+pointer	ms			# MSIO descriptor to be freed
+
+int	i, j
+
+int	ndes			# Number of allocated MSIO descriptors
+pointer	msdes[MS_MAX_DES]	# MSIO descriptor list
+
+common	/msiocom/ ndes, msdes
+
+begin
+	# Locate the specified descriptor in the descriptor list.
+	# If the descriptor is not in the list do nothing.
+	# If the descriptor is in the list free allocated memory and remove
+	# the entry from the list.
+
+	for (i = 1; (i <= ndes) && (ms != msdes[i]); i = i + 1)
+	    ;
+	if (i > ndes)
+	    return
+
+	call mfree (MS_DATA(ms, HDR), TY_STRUCT)
+	call mfree (MS_DATA(ms, COMMENTS), TY_CHAR)
+	call mfree (MS_DATA(ms, SAMPLE), TY_INT)
+	call mfree (MS_DATA(ms, I0), TY_REAL)
+	call mfree (MS_DATA(ms, X0), TY_REAL)
+	call mfree (MS_DATA(ms, S0), TY_REAL)
+	call mfree (MS_DATA(ms, S1), TY_REAL)
+	call mfree (MS_DATA(ms, S2), TY_REAL)
+	if (MS_DATA(ms, X0_FIT) != NULL) {
+	    do j = 1, MS_NSPECTRA(ms)
+	        if (CV(ms, X0_FIT, j) != NULL)
+		    call cvfree (CV(ms, X0_FIT, j))
+	    call mfree (MS_DATA(ms, X0_FIT), TY_INT)
+	}
+	call mfree (ms, TY_STRUCT)
+
+	if (i < ndes)
+	    msdes[i] = msdes[ndes]
+	ndes = ndes - 1
+end
+
+# MS_ERROR   -- Take error recovery action by closing all open databases.
+
+procedure ms_error (error_code)
+
+int	error_code		# Error code for error recovery
+
+int	i, ndes1
+
+int	ndes			# Number of allocated MSIO descriptors
+pointer	msdes[MS_MAX_DES]	# MSIO descriptor list
+
+common	/msiocom/ ndes, msdes
+
+begin
+	# Let DBMS deal with the database descriptor,
+	# fio_cleanup deal with the open files, and the system
+	# restart deal with freeing the stack.  This procedure
+	# cleans up the msio descriptors and memory allocations.
+	# The system may eventually deal with heap memory recovery.
+
+	ndes1 = ndes
+	do i = 1, ndes1
+	    call ms_free_des (msdes[i])
+end
diff --git a/noao/twodspec/multispec/mslist.par b/noao/twodspec/multispec/mslist.par
new file mode 100644
index 00000000..77f3998b
--- /dev/null
+++ b/noao/twodspec/multispec/mslist.par
@@ -0,0 +1,7 @@
+# MSLIST
+
+image,f,a,,,,Image to be listted
+keyword,s,a,,,,Keyword for data to be listed
+lines,s,a,,,,Images lines to be listed
+spectra,s,a,,,,Spectra to be listed
+titles,b,h,no,,,Print additional titles?
diff --git a/noao/twodspec/multispec/msnames.x b/noao/twodspec/multispec/msnames.x
new file mode 100644
index 00000000..93651b18
--- /dev/null
+++ b/noao/twodspec/multispec/msnames.x
@@ -0,0 +1,140 @@
+include	"ms.h"
+
+# The procedures in this file deal with the mapping of the
+# database names to the MULTISPEC identifiers and relations between the
+# identifiers and their meaning.
+#
+# MSNAMES -- Allocate memory and set name array in MULTISPEC data structure.
+# MS_DB_ID -- Associate a database name to the MULTISPEC identifier.
+# IS_PARAM_ID -- Test if an identifier refers to a model parameter.
+# IS_FIT_ID -- Test if an identifier refers to a curfit parameter fit.
+# MS_FIT_ID -- Return fit identifier for specified parameter identifier.
+# MS_MODEL_ID -- CL get a model name and map to a MULTISPEC identifier.
+
+# MSNAMES -- Allocate memory and set the name array in MULTISPEC data structure.
+#
+# The name array maps the integer identifiers with the names in the
+# database.  The name array is also allocated if necessary.
+# This is the only place where the database names are explicitly known.
+
+procedure msnames (ms)
+
+pointer	ms
+
+begin
+	if (MS_NAMES(ms) == NULL)
+	    call calloc (MS_NAMES(ms), MS_DB_ENTRIES * (SZ_MS_KEY + 1), TY_CHAR)
+
+	# Set name array mapping the MULTISPEC IDs to the database names.
+	call sprintf (NAME(ms, HDR), SZ_MS_KEY, "header")
+	call sprintf (NAME(ms, COMMENTS), SZ_MS_KEY, "comments")
+	call sprintf (NAME(ms, SAMPLE), SZ_MS_KEY, "samples")
+	call sprintf (NAME(ms, I0), SZ_MS_KEY, "i0")
+	call sprintf (NAME(ms, X0), SZ_MS_KEY, "x0")
+	call sprintf (NAME(ms, X0_FIT), SZ_MS_KEY, "x0 fit")
+	call sprintf (NAME(ms, S0), SZ_MS_KEY, "s0")
+	call sprintf (NAME(ms, S1), SZ_MS_KEY, "s1")
+	call sprintf (NAME(ms, S2), SZ_MS_KEY, "s2")
+	call sprintf (NAME(ms, S0_FIT), SZ_MS_KEY, "s0 fit")
+	call sprintf (NAME(ms, S1_FIT), SZ_MS_KEY, "s1 fit")
+	call sprintf (NAME(ms, S2_FIT), SZ_MS_KEY, "s2 fit")
+end
+
+
+# MS_DB_ID -- Associate a database name to the MULTISPEC identifier.
+#
+# The input entry name is matched with a database name and the
+# MULTISPEC identifier is returned.
+
+int procedure ms_db_id (ms, entry)
+
+pointer	ms
+char	entry[ARB]
+
+int	i
+
+bool	streq()
+
+begin
+	do i = 1, MS_DB_ENTRIES
+	    if (streq (entry, NAME(ms, i)))
+		return (i)
+
+	return (0)
+end
+
+
+# IS_PARAM_ID -- Test if an identifier refers to a model parameter.
+
+bool procedure is_param_id (param_id)
+
+int	param_id
+
+begin
+	switch (param_id) {
+	case X0, I0, S0, S1, S2:
+	    return (TRUE)
+	default:
+	    return (FALSE)
+	}
+end
+
+
+# IS_FIT_ID -- Test if an identifier refers to a parameter fit.
+
+bool procedure is_fit_id (fit_id)
+
+int	fit_id
+
+begin
+	switch (fit_id) {
+	case X0_FIT, S0_FIT, S1_FIT, S2_FIT:
+	    return (TRUE)
+	default:
+	    return (FALSE)
+	}
+end
+
+
+# MS_FIT_ID -- Return fit identifier for specified parameter identifier.
+
+int procedure ms_fit_id (param_id)
+
+int	param_id
+
+begin
+	switch (param_id) {
+	case X0:
+	    return (X0_FIT)
+	case S0:
+	    return (S0_FIT)
+	case S1:
+	    return (S1_FIT)
+	case S2:
+	    return (S2_FIT)
+	default:
+	    return (ERR)
+	}
+end
+
+# MS_MODEL_ID -- CL get a model name and map to a MULTISPEC identifier.
+#
+# This procedure isolates the model definitions to protect against
+# changes in the model names or the order and choice of identifiers
+# in ms.h.
+
+int procedure ms_model_id (param)
+
+char	param[ARB]		# CL parameter name
+char	str[SZ_LINE]
+int	i, clgwrd()
+
+begin
+	i = clgwrd (param, str, SZ_LINE, ",gauss5,smooth,")
+	switch (i) {
+	case 1:
+	    return (GAUSS5)
+	case 2:
+	    return (SMOOTH)
+	}
+end
diff --git a/noao/twodspec/multispec/msplot.par b/noao/twodspec/multispec/msplot.par
new file mode 100644
index 00000000..013a40de
--- /dev/null
+++ b/noao/twodspec/multispec/msplot.par
@@ -0,0 +1,9 @@
+# Parameter file for MSPLOT
+
+image,f,a,,,,Image to be plotted
+line,i,a,,,,Image line to be plotted
+naverage,i,h,20,,,Number of image lines to average
+lower,r,h,-10,,,Lower limit of model profiles
+upper,r,h,10,,,Upper limit of model profiles
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/twodspec/multispec/msplot.x b/noao/twodspec/multispec/msplot.x
new file mode 100644
index 00000000..4e02367f
--- /dev/null
+++ b/noao/twodspec/multispec/msplot.x
@@ -0,0 +1,104 @@
+include	<imhdr.h>
+include "ms.h"
+
+# MSPLOT -- Plot image and model values.
+#
+# The output list format is column, image line, data value, model value.
+# This task differs from t_new_image primarily in that there is no profile
+# interpolation.  The model is evaluated only at the sample lines.  It
+# is used to check the results of the model fitting tasks.
+
+procedure msplot ()
+
+char	image[SZ_FNAME]			# Image
+int	line				# Image line to plot
+int	naverage			# Number of image lines to average
+real	lower				# Lower limit of profile model
+real	upper				# Upper limit of profile model
+
+int	sample
+pointer	ms, im
+pointer	sp, data, model
+
+int	clgeti(), get_sample_line
+real	clgetr()
+pointer	msmap(), immap()
+
+begin
+	# Get the task parameters.
+
+	call clgstr ("image", image, SZ_FNAME)
+	line = clgeti ("line")
+	naverage = clgeti ("naverage")
+	lower = clgetr ("lower")
+	upper = clgetr ("upper")
+
+	# Access the database and image.
+
+	ms = msmap (image, READ_ONLY, 0)
+	im = immap (image, READ_ONLY, 0)
+
+	# Allocate memory for the data and model.
+
+	call smark (sp)
+	call salloc (data, IM_LEN(im, 1), TY_REAL)
+	call salloc (model, IM_LEN(im, 1), TY_REAL)
+
+	sample = get_sample_line (ms, line)
+	line = LINE(ms, sample)
+	call msgimage (im, line, naverage, Memr[data])
+	call gauss5_model (ms, sample, lower, upper, Memr[model])
+
+	call ms_graph (Memr[data], Memr[model], IM_LEN(im, 1))
+
+	call sfree (sp)
+	call msunmap (ms)
+	call imunmap (im)
+end
+
+
+include	<gset.h>
+
+# MS_GRAPH -- For the selected line get the data line and compute a model line.
+# Graph the data and model values.
+
+procedure ms_graph (data, model, npts)
+
+real	data[npts]	# Image data
+real	model[npts]	# Model data
+int	npts		# Number of data points
+
+char	str[SZ_LINE]
+real	x1, x2
+pointer	gp, gt
+
+real	wx, wy			# Cursor position
+int	wcs, key		# WCS and cursor key
+
+int	gt_gcur()
+pointer	gopen(), gt_init()
+
+begin
+	call clgstr ("graphics", str, SZ_LINE)
+	gp = gopen (str, NEW_FILE, STDGRAPH)
+	gt = gt_init ()
+
+	x1 = 1
+	x2 = npts
+	call gswind (gp, x1, x2, INDEF, INDEF)
+	call gascale (gp, data, npts, 2)
+	call grscale (gp, model, npts, 2)
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+
+	call gseti (gp, G_PLTYPE, 1)
+	call gvline (gp, data, npts, x1, x2)
+	call gseti (gp, G_PLTYPE, 2)
+	call gvline (gp, model, npts, x1, x2)
+
+	while (gt_gcur ("cursor", wx, wy, wcs, key, str, SZ_LINE) != EOF)
+	    ;
+
+	call gclose (gp)
+	call gt_free (gt)
+end
diff --git a/noao/twodspec/multispec/msput.x b/noao/twodspec/multispec/msput.x
new file mode 100644
index 00000000..e24e825b
--- /dev/null
+++ b/noao/twodspec/multispec/msput.x
@@ -0,0 +1,123 @@
+include "ms.h"
+
+# MSPUT -- Put information in the MULTISPEC database.
+#
+# MSPHDR	-- Put MULTISPEC header record in the database.
+# MSPCOMMENTS	-- Put MULTISPEC comment record into the database.
+# MSPSAMPLE	-- Put MULTISPEC sample record into the database.
+# MSPPARAM	-- Put a line of MULTISPEC parameter data.
+# MSPGAUSS5	-- Put a line of GAUSS5 parameter data.
+# MSPFIT	-- Put fit coefficients for a spectrum.
+# MSPFITS	-- Put fit coefficients for all spectra.
+
+
+# MSPHDR -- Put MULTISPEC header record in the database.
+
+procedure msphdr (ms)
+
+pointer	ms				# MSIO descriptor
+
+begin
+	call dbwrite (MS_DB(ms), NAME(ms, HDR), HEADER(ms), 1)
+end
+
+
+# MSPCOMMENTS -- Put MULTISPEC comment record into the database.
+
+procedure mspcomments (ms)
+
+pointer	ms				# MSIO descriptor
+
+begin
+	call dbwrite (MS_DB(ms), NAME(ms, COMMENTS), COMMENT(ms, 1), 1)
+end
+
+
+# MSPSAMPLE -- Put MULTISPEC sample record into the database.
+
+procedure mspsample (ms)
+
+pointer	ms				# MSIO descriptor
+
+begin
+	call dbwrite (MS_DB(ms), NAME(ms, SAMPLE), LINE(ms,1), 1)
+end
+
+# MSPPARAM -- Put a line of MULTISPEC parameter data.
+
+procedure mspparam (ms, parameter, line)
+
+pointer	ms				# MSIO descriptor
+int	parameter			# Index to parameter array
+int	line				# Line to be read
+
+char	reference[SZ_MS_KEY]
+
+bool	is_param_id()
+
+begin
+	if (!is_param_id (parameter))
+	    call error (MS_ERROR, "Bad parameter identifier")
+
+	call sprintf (reference, SZ_MS_KEY, "%s[%d]")
+	    call pargstr (NAME(ms, parameter))
+	    call pargi (line)
+
+	call dbwrite (MS_DB(ms), reference, PARAMETER(ms,parameter,1), 1)
+end
+
+
+# MSPGAUSS5 -- Put a line of GAUSS5 parameter data.
+
+procedure mspgauss5 (ms, line)
+
+pointer	ms
+int	line
+
+begin
+	call mspparam (ms, I0, line)
+	call mspparam (ms, X0, line)
+	call mspparam (ms, S0, line)
+	call mspparam (ms, S1, line)
+	call mspparam (ms, S2, line)
+end
+
+# MSPFIT -- Put parameter fit data.
+
+procedure mspfit (ms, parameter, spectrum)
+
+pointer	ms				# MSIO descriptor
+int	parameter			# Parameter to be put
+int	spectrum			# Spectrum to be put
+
+char	reference[SZ_MS_KEY]
+pointer	sp, fit
+
+begin
+	call smark (sp)
+	call salloc (fit, 7 + MS_NSAMPLES(ms), TY_REAL)
+
+	call sprintf (reference, SZ_MS_KEY, "%s[%d]")
+	    call pargstr (NAME(ms, parameter))
+	    call pargi (spectrum)
+
+	call cvsave (CV(ms, parameter, spectrum), Memr[fit])
+	call dbwrite (MS_DB(ms), reference, Memr[fit], 1)
+
+	call sfree (sp)
+end
+
+
+# MSPFITS -- Put parameter fits.
+
+procedure mspfits (ms, parameter)
+
+pointer	ms				# MULTISPEC data structure
+int	parameter			# Parameter ID for desired fit
+
+int	i
+
+begin
+	do i = 1, MS_NSPECTRA(ms)
+	    call mspfit (ms, parameter, i)
+end
diff --git a/noao/twodspec/multispec/msset.par b/noao/twodspec/multispec/msset.par
new file mode 100644
index 00000000..8c11c205
--- /dev/null
+++ b/noao/twodspec/multispec/msset.par
@@ -0,0 +1,9 @@
+# MSSET
+
+image,f,a,,,,Image
+keyword,s,a,,,,Keyword for data to be set
+value,s,a,,,,Input value
+lines,s,h,"*",,,Images lines to be affected
+spectra,s,h,"*",,,Spectra to be affected
+read_list,b,h,no,,,Read values from a list?
+list,*s,h,,,,Input list
diff --git a/noao/twodspec/multispec/mssmooth.x b/noao/twodspec/multispec/mssmooth.x
new file mode 100644
index 00000000..be7e01ca
--- /dev/null
+++ b/noao/twodspec/multispec/mssmooth.x
@@ -0,0 +1,81 @@
+include	<math/curfit.h>
+
+# MS_SMOOTH -- Smooth MULTISPEC parameters with the CURFIT package.
+# MS_SET_SMOOTH -- Initialize and define function for smoothing.
+# MS_FREE_SMOOTH -- Free allocated memory from smoothing.
+
+# This procedure is numerical and does not depend on the MULTISPEC
+# package.
+
+procedure ms_smooth (x, y)
+
+real	x[ARB]				# Array of x values
+real	y[ARB]				# Array of y values
+int	curve_type			# Curfit function
+int	order				# Order of function
+real	xmin				# Minimum x value
+real	xmax				# Maximum x value
+int	npoints				# Number of points in fits
+
+int	i, npts, ier
+real	xmn, xmx
+pointer	cv, w
+
+real	cveval()
+
+data	cv/NULL/, w/NULL/
+
+begin
+	# Check for a valid curfit pointer.
+	if (cv == NULL)
+	    call error (0, "param_smooth: Undefined smoothing function")
+	
+	# Zero and fit the data with uniform weights.
+	call cvzero (cv)
+	# call cvfit (cv, x, y, Memr[w], npts, WTS_UNIFORM, ier)
+
+	# Accumulate points and check for out of bounds points.
+	do i = 1, npts
+	    if ((x[i] >= xmn) && (x[i] <= xmx))
+		call cvaccum (cv, x[i], y[i], Memr[w+i-1], WTS_UNIFORM)
+	call cvsolve (cv, ier)
+
+	if (ier != OK)
+	    call error (0, "param_smooth: Error in function fit")
+
+	# Evaluate fit placing fit values back in y array.
+	# call cvvector (cv, x, y, npts)
+	do i = 1, npts
+	    if ((x[i] >= xmn) && (x[i] <= xmx))
+		y[i] = cveval (cv, x[i])
+
+	return
+
+entry ms_set_smooth (xmin, xmax, npoints)
+
+	# Set or reset curfit data structure and allocate memory for weights.
+	if (cv != NULL)
+	    call cvfree (cv)
+	if (w == NULL)
+	    call malloc (w, npoints, TY_REAL)
+
+	# Determine curve_type and order.
+	call clgcurfit ("function", "order", curve_type, order)
+
+	# Initialize curfit data structure and record number of points.
+	xmn = xmin
+	xmx = xmax
+	call cvinit (cv, curve_type, order, xmn, xmx)
+	npts = npoints
+
+	return
+
+entry ms_free_smooth ()
+
+	# Free allocated memory.
+	if (cv != NULL)
+	    call cvfree (cv)
+	if (w != NULL)
+	    call mfree (w, TY_REAL)
+
+end
diff --git a/noao/twodspec/multispec/multispec.cl b/noao/twodspec/multispec/multispec.cl
new file mode 100644
index 00000000..12229f83
--- /dev/null
+++ b/noao/twodspec/multispec/multispec.cl
@@ -0,0 +1,21 @@
+#{ MULTISPEC -- The MULTISPEC package.
+
+package	multispec
+
+task	newextraction,
+	findpeaks,
+	msset,
+	mslist,
+	fitfunction,
+	msextract,
+	newimage,
+	modellist,
+	msplot,
+	fitgauss5	= multispec$x_multispec.e
+
+# Scripts
+task	_msfindspec1	= multispec$_msfindspec1.cl
+task	_msfindspec2	= multispec$_msfindspec2.cl
+task	_msfindspec3	= multispec$_msfindspec3.cl
+
+clbye
diff --git a/noao/twodspec/multispec/multispec.hd b/noao/twodspec/multispec/multispec.hd
new file mode 100644
index 00000000..a798e54a
--- /dev/null
+++ b/noao/twodspec/multispec/multispec.hd
@@ -0,0 +1,14 @@
+# Help directory for the MULTISPEC package.
+
+$doc = "./doc/"
+
+findpeaks	hlp=doc$findpeaks.hlp,	src=t_findpeaks.x
+fitfunction	hlp=doc$fitfunc.hlp,	src=t_fitfunc.x
+fitgauss5	hlp=doc$fitgauss5.hlp,	src=t_fitgauss5.x
+modellist	hlp=doc$modellist.hlp,	src=t_modellist.x
+msextract	hlp=doc$msextract.hlp,	src=t_msextract.x
+mslist		hlp=doc$mslist.hlp,	src=t_mslist.x
+msplot		hlp=doc$msplot.hlp,	src=t_msplot.cl
+msset		hlp=doc$msset.hlp,	src=t_msset.x
+newextraction	hlp=doc$newextract.hlp,	src=t_newextract.x
+newimage	hlp=doc$newimage.hlp,	src=t_newimage.x
diff --git a/noao/twodspec/multispec/multispec.hlp b/noao/twodspec/multispec/multispec.hlp
new file mode 100644
index 00000000..b7083fb3
--- /dev/null
+++ b/noao/twodspec/multispec/multispec.hlp
@@ -0,0 +1,14 @@
+.help multispec OCT85 noao.twodspec.multispec
+.nf
+      findpeaks - Find the peaks
+    fitfunction - Fit a function to the spectra parameter values
+      fitgauss5 - Fit spectra profiles with five parameter Gaussian model
+      modellist - List data and model pixel values
+      msextract - Extract spectra
+         mslist - List entries in a MULTISPEC database
+         msplot - Plot a line of image and model data
+          msset - Set entries in a MULTISPEC database
+  newextraction - Create a new MULTISPEC extraction database
+       newimage - Create a new multi-spectra image
+.fi
+.endhelp
diff --git a/noao/twodspec/multispec/multispec.men b/noao/twodspec/multispec/multispec.men
new file mode 100644
index 00000000..4425164f
--- /dev/null
+++ b/noao/twodspec/multispec/multispec.men
@@ -0,0 +1,10 @@
+      findpeaks - Find the peaks
+    fitfunction - Fit a function to the spectra parameter values
+      fitgauss5 - Fit spectra profiles with five parameter Gaussian model
+      modellist - List data and model pixel values
+      msextract - Extract spectra
+	 mslist - List entries in a MULTISPEC database
+	 msplot - Plot a line of image and model data
+	  msset - Set entries in a MULTISPEC database
+  newextraction - Create a new MULTISPEC extraction database
+       newimage - Create a new multi-spectra image
diff --git a/noao/twodspec/multispec/multispec.par b/noao/twodspec/multispec/multispec.par
new file mode 100644
index 00000000..ce7cb587
--- /dev/null
+++ b/noao/twodspec/multispec/multispec.par
@@ -0,0 +1,3 @@
+# MULTISPEC Package parameter file.
+
+version,s,h,"October 1984"
diff --git a/noao/twodspec/multispec/newextraction.par b/noao/twodspec/multispec/newextraction.par
new file mode 100644
index 00000000..17a0bda5
--- /dev/null
+++ b/noao/twodspec/multispec/newextraction.par
@@ -0,0 +1,5 @@
+# NEWEXTRACTION
+
+image,f,a,,,,Image to be extracted
+template,f,a,"",,,Template image to use for initialization
+sample_lines,s,h,"10x50",,,Sample image lines
diff --git a/noao/twodspec/multispec/newimage.par b/noao/twodspec/multispec/newimage.par
new file mode 100644
index 00000000..24465786
--- /dev/null
+++ b/noao/twodspec/multispec/newimage.par
@@ -0,0 +1,17 @@
+# NEWIMAGE
+
+image,f,a,,,,Image to be used as a model
+outpu,f,a,,,,Output image to be created
+lower,r,h,-10,,,Lower limit of extraction
+upper,r,h,10,,,Upper limit of extraction
+lines,s,h,"*",,,Image lines to be extracted
+ex_model,b,h,no,,,Extract model spectra?
+clean,b,h,yes,,,Clean bad and discrepant pixels?
+nreplace,i,h,1000,0,,Maximum number of pixels to be cleaned
+sigma_cut,r,h,4.,,,Sigma cutoff for cleaning
+niterate,i,h,1,1,,Maximum number of cleaning iterations per line
+model,s,h,smooth,,,Model for cleaning and/or model extraction
+naverage,i,h,20,,,Number of image lines in average profile model
+fit_type,i,h,2,1,2,Model fitting type for model gauss5
+interpolator,s,h,"spline3",,,Type of image interpolation
+verbose,b,h,no,,,Verbose output?
diff --git a/noao/twodspec/multispec/peaks.x b/noao/twodspec/multispec/peaks.x
new file mode 100644
index 00000000..910e66a5
--- /dev/null
+++ b/noao/twodspec/multispec/peaks.x
@@ -0,0 +1,397 @@
+# PEAKS -- The following procedures are general numerical functions
+# dealing with finding peaks in a data array.
+#
+# FIND_PEAKS		Find the peaks in the data array.
+# FIND_LOCAL_MAXIMA	Find the local maxima in the data array.
+# IS_LOCAL_MAX		Test a point to determine if it is a local maximum.
+# FIND_THRESHOLD	Find the peaks with positions satisfying threshold
+#			and contrast constraints.
+# FIND_ISOLATED		Flag peaks which are within separation of a peak
+#			with a higher peak value.
+# FIND_NMAX		Select up to the nmax highest ranked peaks.
+# COMPARE		Compare procedure for sort used in FIND_PEAKS.
+
+# FIND_PEAKS -- Find the peaks in the data array.
+#
+# The peaks are found using the following algorithm:
+#
+# 1.  Find the local maxima.
+# 2.  Reject peaks below the threshold.
+# 3.  Determine the ranks of the remaining peaks.
+# 4.  Flag weaker peaks within separation of a stronger peak.
+# 5.  Accept at most the nmax strongest peaks.
+#
+# Indefinite points are ignored.  The peak positions are returned in the
+# array x.
+
+int procedure find_peaks (data, x, npoints, contrast, separation, edge, nmax,
+    threshold, debug)
+
+# Procedure parameters:
+real	data[npoints]		# Input data array
+real	x[npoints]		# Output peak position array
+int	npoints			# Number of data points
+real	contrast		# Maximum contrast between strongest and weakest
+int	separation		# Minimum separation between peaks
+int	edge			# Minimum distance from the edge
+int	nmax			# Maximum number of peaks to be returned
+real	threshold		# Minimum threshold level for peaks
+bool	debug			# Print diagnostic information?
+
+int	i, j
+int	nlmax, nthreshold, nisolated, npeaks
+pointer	sp, y, rank
+
+int	find_local_maxima(), find_threshold(), find_isolated(), find_nmax()
+int	compare()
+
+extern	compare()
+
+common	/sort/ y
+
+begin
+	# Find the local maxima in data and put column positions in x..
+	nlmax = find_local_maxima (data, x, npoints, debug)
+
+	# Reject local maxima near the edge.
+	if (edge > 0) {
+	    j = 0
+	    do i = 1, nlmax {
+		if ((x[i] > edge) && (x[i] <= npoints - edge)) {
+		    j = j + 1
+		    x[j] = x[i]
+		}
+	    }
+	    nlmax = j
+	}
+
+	# Allocate a working array y.
+	call smark (sp)
+	call salloc (y, npoints, TY_REAL)
+
+	# Reject the local maxima which do not satisfy the thresholds.
+	# The array y is set to the peak values of the remaining peaks.
+	nthreshold = find_threshold (data, x, Memr[y], nlmax,
+	    contrast, threshold, debug)
+
+	# Rank the peaks by peak value.
+	call salloc (rank, nthreshold, TY_INT)
+	do i = 1, nthreshold
+	    Memi[rank + i - 1] = i
+	call qsort (Memi[rank], nthreshold, compare)
+
+	# Reject the weaker peaks within sep of a stronger peak.
+	nisolated = find_isolated (x, Memi[rank], nthreshold, separation,
+	    debug)
+
+	# Select the strongest nmax peaks.
+	npeaks = find_nmax (data, x, Memi[rank], nthreshold, nmax, debug)
+
+	call sfree (sp)
+	return (npeaks)
+end
+
+
+# FIND_LOCAL_MAXIMA -- Find the local maxima in the data array.
+#
+# A data array is input and the local maxima positions array is output.
+# The number of local maxima found is returned.
+
+int procedure find_local_maxima (data, x, npoints, debug)
+
+real	data[npoints]			# Input data array
+real	x[npoints]			# Output local maxima positions array
+int	npoints				# Number of input points
+bool	debug				# Print debugging information?
+
+int	i, nlmax
+
+bool	is_local_max()
+
+begin
+	nlmax = 0
+	do i = 1, npoints {
+	    if (is_local_max (i, data, npoints)) {
+		nlmax = nlmax + 1
+		x[nlmax] = i
+	    }
+	}
+
+	if (debug) {
+	    call printf ("  Number of local maxima found = %d.\n")
+		call pargi (nlmax)
+	}
+
+	return (nlmax)
+end
+
+
+# IS_LOCAL_MAX -- Test a point to determine if it is a local maximum.
+#
+# Indefinite points are ignored.
+
+bool procedure is_local_max (index, data, npoints)
+
+# Procedure parameters:
+int	index			# Index to test for local maximum
+real	data[npoints]		# Data values
+int	npoints			# Number of points in the data vector
+
+int	i, j, nright, nleft
+
+begin
+	# INDEFR points cannot be local maxima.
+	if (IS_INDEFR (data[index]))
+	    return (false)
+
+	# Find the left and right indices where data values change and the
+	# number of points with the same value.  Ignore INDEFR points.
+	nleft = 0
+	for (i = index - 1; i >= 1; i = i - 1) {
+	    if (!IS_INDEFR (data[i])) {
+		if (data[i] != data[index])
+		    break
+		nleft = nleft + 1
+	    }
+	}
+	nright = 0
+	for (j = index + 1; i <= npoints; j = j + 1) {
+	    if (!IS_INDEFR (data[j])) {
+		if (data[j] != data[index])
+		    break
+		nright = nright + 1
+	    }
+	}
+
+	# Test for failure to be a local maxima
+	if ((i == 0) && (j == npoints)) {
+	    return (FALSE)		# Data is constant
+	} else if (i == 0) {
+	    if (data[j] > data[index])
+	        return (FALSE)		# Data increases to right
+	} else if (j == npoints) {
+	    if (data[i] > data[index])	# Data increase to left
+		return (FALSE)
+	} else if ((data[i] > data[index]) || (data[j] > data[index])) {
+	    return (FALSE)		# Not a local maximum
+	} else if (!((nleft - nright == 0) || (nleft - nright == 1))) {
+	    return (FALSE)		# Not center of plateau
+	}
+
+	# Point is a local maxima
+	return (TRUE)
+end
+
+
+
+
+# FIND_THRESHOLD -- Find the peaks with positions satisfying threshold
+# and contrast constraints.
+#
+# The input is the data array, data, and the peak positions array, x.
+# The x array is resorted to the nthreshold peaks satisfying the constraints.
+# The corresponding nthreshold data values are returned the y array.
+# The number of peaks satisfying the constraints (nthreshold) is returned.
+
+int procedure find_threshold (data, x, y, npoints, contrast, threshold, debug)
+
+real	data[ARB]			# Input data values
+real	x[npoints]			# Input/Output peak positions
+real	y[npoints]			# Output peak data values
+int	npoints				# Number of peaks input
+real	contrast			# Contrast constraint
+real	threshold			# Threshold constraint
+bool	debug				# Print debugging information?
+
+int	i, j, nthreshold
+real	minval, maxval, lcut
+
+begin
+	# Set the y array to be the values at the peak positions.
+	do i = 1, npoints {
+	    j = x[i]
+	    y[i] = data[j]
+	}
+
+	# Determine the min and max values of the peaks.
+	call alimr (y, npoints, minval, maxval)
+
+	# Set the threshold based on the max of the absolute threshold and the
+	# contrast.  Use arltr to set peaks below threshold to INDEFR.
+	lcut = max (threshold, contrast * maxval)
+	call arltr (y, npoints, lcut, INDEFR)
+
+	if (debug) {
+	    call printf ("  Highest peak value = %g.\n")
+		call pargr (maxval)
+	    call printf ("  Peak cutoff threshold = %g.\n")
+		call pargr (lcut)
+	    do i = 1, npoints {
+		if (IS_INDEFR (y[i])) {
+		    j = x[i]
+		    call printf (
+			"  Peak at column %d with value %g below threshold.\n")
+			call pargi (j)
+			call pargr (data[j])
+		}
+	    }
+	}
+
+	# Determine the number of acceptable peaks & resort the x and y arrays.
+	nthreshold = 0
+	do i = 1, npoints {
+	    if (IS_INDEFR (y[i]))
+		next
+	    nthreshold = nthreshold + 1
+	    x[nthreshold] = x[i]
+	    y[nthreshold] = y[i]
+	}
+
+	if (debug) {
+	    call printf ("  Number of peaks above the threshold = %d.\n")
+		call pargi (nthreshold)
+	}
+
+	return (nthreshold)
+end
+
+# FIND_ISOLATED -- Flag peaks which are within separation of a peak
+# with a higher peak value.
+#
+# The peak positions, x, and their ranks, rank, are input.
+# The rank array contains the indices of the peak positions in order from
+# the highest peak value to the lowest peak value.  Starting with
+# highest rank (rank[1]) all peaks of lower rank within separation
+# are marked by setting their positions to INDEFR.  The number of
+# unflaged peaks is returned.
+
+int procedure find_isolated (x, rank, npoints, separation, debug)
+
+# Procedure parameters:
+real	x[npoints]		# Positions of points
+int	rank[npoints]		# Rank of peaks
+int	npoints			# Number of peaks
+int	separation		# Minimum allowed separation
+bool	debug			# Print diagnostic information
+
+int	i, j
+int	nisolated
+
+begin
+	# Eliminate close neighbors.  The eliminated
+	# peaks are marked by setting their positions to INDEFR.
+	nisolated = 0
+	do i = 1, npoints {
+	    if (IS_INDEFR (x[rank[i]]))
+		next
+	    nisolated = nisolated + 1
+	    do j = i + 1, npoints {
+		if (IS_INDEFR (x[rank[j]]))
+		    next
+		if (abs (x[rank[i]] - x[rank[j]]) < separation) {
+		    if (debug) {
+			call printf (
+			    "  Peak at column %d too near peak at column %d.\n")
+			    call pargi (int (x[rank[j]]))
+			    call pargi (int (x[rank[i]]))
+		    }
+		    x[rank[j]] = INDEFR
+		}
+	    }
+	}
+
+	if (debug) {
+	    call printf ("  Number of peaks separated by %d pixels = %d.\n")
+		call pargi (separation)
+		call pargi (nisolated)
+	}
+
+	# Return number of isolated peaks.
+	return (nisolated)
+end
+
+
+# FIND_NMAX -- Select up to the nmax highest ranked peaks.
+#
+# The data values, data, peak positions, x, and their ranks, rank, are input.
+# The data values are used only in printing debugging information.
+# Peak positions previously eliminated are flaged by the value INDEFR.
+# The rank array contains the indices to the peak positions in order from
+# the highest peak value to the lowest peak value.
+# First all but the nmax highest ranked peaks (which have not been previously
+# eliminated) are eliminated by marking their positions with the value INDEFR.
+# Then the remaining peaks are resorted to contain only the unflaged
+# peaks and the number of such peaks is returned.
+
+int procedure find_nmax (data, x, rank, npoints, nmax, debug)
+
+real	data[ARB]			# Input data values
+real	x[npoints]			# Peak positions
+int	rank[npoints]			# Ranks of peaks
+int	npoints				# Number of input peaks
+int	nmax				# Max number of peaks to be selected
+bool	debug				# Print debugging information?
+
+int	i, j, npeaks
+
+begin
+	# Only mark peaks to reject if the number peaks is greater than nmax.
+	if (nmax < npoints) {
+	    npeaks = 0
+	    do i = 1, npoints {
+	        if (IS_INDEFR (x[rank[i]]))
+		    next
+	        npeaks = npeaks + 1
+	        if (npeaks > nmax) {
+		    if (debug) {
+			j = x[rank[i]]
+			call printf (
+		    "  Reject peak at column %d with rank %d and value %g.\n")
+			    call pargi (j)
+			    call pargi (i)
+			    call pargr (data[j])
+		    }
+	            x[rank[i]] = INDEFR
+	        }
+	    }
+	}
+
+	# Eliminate INDEFR points and determine the number of spectra found.
+	npeaks = 0
+	do i = 1, npoints {
+	    if (IS_INDEFR (x[i]))
+		next
+	    npeaks = npeaks + 1
+	    x[npeaks] = x[i]
+	}
+
+	return (npeaks)
+end
+
+
+# COMPARE -- Compare procedure for sort used in FIND_PEAKS.
+# Larger values are indexed first.  INDEFR values are indexed last.
+
+int procedure compare (index1, index2)
+
+# Procedure parameters:
+int	index1				# Comparison index
+int	index2				# Comparison index
+
+pointer	y
+
+common	/sort/ y
+
+begin
+	# INDEFR points are considered to be smallest possible values.
+	if (IS_INDEFR (Memr[y - 1 + index1]))
+	    return (1)
+	else if (IS_INDEFR (Memr[y - 1 + index2]))
+	    return (-1)
+	else if (Memr[y - 1 + index1] < Memr[y - 1 + index2])
+	    return (1)
+	else if (Memr[y - 1 + index1] > Memr[y - 1 + index2])
+	    return (-1)
+	else
+	    return (0)
+end
diff --git a/noao/twodspec/multispec/profinterp.x b/noao/twodspec/multispec/profinterp.x
new file mode 100644
index 00000000..9af3af15
--- /dev/null
+++ b/noao/twodspec/multispec/profinterp.x
@@ -0,0 +1,186 @@
+include	"ms.h"
+
+.help profile_interpolation Jul84 MULTISPEC
+     The input to this procedure are the intensity profiles and the derivatives
+of the profiles with position for each spectrum at two sample lines y(2) and
+y(3).  The profiles are gridded on unit position intervals starting at two
+different points x(2) and x(3).  Let us denote the i_th point in these profiles
+(for some given spectrum) by
+
+	I(x(j)+i,y(j)), dI/dx(x(j)+i,y(j))
+
+where j takes the values 2 and 3 in the remaining discussion.
+Note that the profiles contain dI/dx0, the derivative with respect to the
+profile center.  This is related to the derivative with respect to x by
+
+	dI/dx = -dI/dx0
+
+     We want interpolated profiles at line y(1) gridded with a starting point
+x(1).  Denote this profile by
+
+	   I(x(1)+i,y(1))
+
+     The algorithm is to first interpolate to the point x(1)+i from each of
+the two neighboring points at each endpoint.  This yields the quantities:
+
+.nf
+(1)	a(j) = I(x(j)+ileft,y(j))  + dI/dx(x(j)+ileft,y(j))  * dxa(j)
+	b(j) = I(x(j)+iright,y(j)) + dI/dx(x(j)+iright,y(j)) * dxb(j)
+.fi
+
+where
+
+.nf
+(2)	dxa(j) = x(1) - x(j)		x(1) > x(j)
+	dxb(j) = x(1) - (x(j) + 1)	x(1) > x(j)
+	dxa(2) = x(1) - (x(j) - 1)	x(1) < x(j)
+	dxb(2) = x(1) - x(j)		x(1) < x(j)
+.fi
+
+The final value is then obtained by the bi-linear interpolation formula:
+
+.nf
+(3)	I(x(1)+i,y(1)) = a(2) * wta(2) + b(2) * wtb(2) +
+			 a(3) * wta(3) + b(3) * wtb(3)
+.fi
+
+where
+
+.nf
+(4)	f(2) = 1 - (y(1) - y(2)) / (y(3) - y(2))
+	f(3) = 1 - (y(3) - y(1)) / (y(3) - y(2)) = 1 - f(2)
+	wta(j) = -dxb(j) * f(j)
+	wtb(j) = dxa(j) * f(j)
+.fi
+
+     If x(1) > x(j) then b(j) does not exist at the rightmost profile point.
+In this case in equation 1 replace the term
+
+.nf
+(5)	a(j) * wta(j) + b(j) * wtb(j)
+.fi
+
+with
+
+.nf
+(6)	a(j) * f(j)
+.fi
+
+for the rightmost endpoint.
+Similarly, if x(1) < x(j) then a(j) does not exist for the leftmost profile
+point.  Then replace the term (5) with
+
+.nf
+(7)	b(j) * f(j).
+.fi
+
+     Procedure profile_interpolation implements this interpolation scheme.
+The only difference is that instead of equation 3 the profiles are built up
+by accumulation of the terms.
+.endhelp
+
+# PROFILE_INTERPOLATION -- Interpolate between two profiles.
+#
+# The equation references are to those in the help text.
+
+procedure profile_interpolation (fraction, len_profile, nspectra, nparams,
+    profiles, ranges)
+
+real	fraction			# The interpolation point
+int	len_profile			# The length of the profiles
+int	nspectra			# The number of spectra
+int	nparams				# The number of model parameters
+real	profiles[len_profile, nspectra, nparams, 3] # The profiles
+real	ranges[nspectra, LEN_RANGES, 3]	# The ranges array
+
+int	i, j, spectrum
+real	dx, f[3], dxa[3], dxb[3], wta[3], wtb[3], a, b
+
+begin
+	# Clear the final profiles because we accumulate the terms in
+	# equations 3 and 5.
+	call aclrr (profiles[1, 1, I0_INDEX, 1], len_profile * nspectra)
+
+	# Equation 4.
+	f[2] = 1 - fraction
+	f[3] = fraction
+
+	# Do each endpoint and each spectrum.
+	do j = 2, 3 {
+	    do spectrum = 1, nspectra {
+	        dx = ranges[spectrum, DX_START, 1] -
+		    ranges[spectrum, DX_START, j]
+
+	        if (dx < 0.) {
+		    # x(1) < x(j) and ileft = i - 1, iright = i.
+
+		    # Equation 2.
+		    dxa[j] = 1 + dx
+		    dxb[j] = dx
+
+		    # Equation 4.
+		    wta[j] = -dxb[j] * f[j]
+		    wtb[j] = dxa[j] * f[j]
+
+		    # Accumulate the terms from the left neighbor.  Eq. 1 & 3
+	            do i = 2, len_profile {
+		        a = profiles[i - 1, spectrum, I0_INDEX, j] -
+		            profiles[i - 1, spectrum, X0_INDEX, j] * dxa[j]
+		        profiles[i, spectrum, I0_INDEX, 1] =
+			    profiles[i, spectrum, I0_INDEX, 1] + a * wta[j]
+		    }
+
+		    # Accumulate the terms from the right neighbor.  Eq. 1 & 3
+	            do i = 2, len_profile {
+		        b = profiles[i, spectrum, I0_INDEX, j] -
+		            profiles[i, spectrum, X0_INDEX, j] * dxb[j]
+		        profiles[i, spectrum, I0_INDEX, 1] =
+			    profiles[i, spectrum, I0_INDEX, 1] + b * wtb[j]
+		    }
+
+		    # There is no left neighbor for the left profile endpoint.
+		    # Eq. 1 & 7
+		    b = profiles[1, spectrum, I0_INDEX, j] -
+		        profiles[1, spectrum, X0_INDEX, j] * dxb[j]
+		    profiles[1, spectrum, I0_INDEX, 1] =
+			profiles[1, spectrum, I0_INDEX, 1] + b * f[j]
+	        }
+
+	        else {
+		    # x(1) > x(j) and ileft = i, iright = i + 1.
+		    # Equation 2.
+		    dxa[j] = dx
+		    dxb[j] = dx - 1
+
+		    # Equation 4.
+		    wta[j] = -dxb[j] * f[j]
+		    wtb[j] = dxa[j] * f[j]
+
+		    # Accumulate the terms from the left neighbor. Eq. 1 & 3.
+	            do i = 1, len_profile - 1 {
+		        a = profiles[i, spectrum, I0_INDEX, j] -
+		            profiles[i, spectrum, X0_INDEX, j] * dxa[j]
+		        profiles[i, spectrum, I0_INDEX, 1] =
+			    profiles[i, spectrum, I0_INDEX, 1] + a * wta[j]
+		    }
+
+		    # Accumulate the terms from the right neighbor. Eq. 1 & 3.
+	            do i = 1, len_profile - 1 {
+		        b = profiles[i + 1, spectrum, I0_INDEX, j] -
+		            profiles[i + 1, spectrum, X0_INDEX, j] * dxb[j]
+		        profiles[i, spectrum, I0_INDEX, 1] =
+			    profiles[i, spectrum, I0_INDEX, 1] + b * wtb[j]
+		    }
+
+		    # There is no right neighbor for the right profile endpoint.
+		    # Eq. 1 & 6
+		    a = profiles[len_profile, spectrum, I0_INDEX, j] -
+		        profiles[len_profile, spectrum, X0_INDEX, j] * dxa[j]
+		    profiles[len_profile, spectrum, I0_INDEX, 1] =
+			profiles[len_profile, spectrum, I0_INDEX, 1] + a * f[j]
+	        }
+	    }
+	}
+	call amaxkr (profiles[1, 1, I0_INDEX, 1], 0.,
+	    profiles[1, 1, I0_INDEX, 1], len_profile * nspectra)
+end
diff --git a/noao/twodspec/multispec/ranges.x b/noao/twodspec/multispec/ranges.x
new file mode 100644
index 00000000..6704b192
--- /dev/null
+++ b/noao/twodspec/multispec/ranges.x
@@ -0,0 +1,385 @@
+include <mach.h>
+include	<ctype.h>
+
+.help ranges xtools "Range Parsing Tools"
+.ih
+PURPOSE
+
+These tools
+parse a string using a syntax to represent integer values, ranges, and
+steps.   The parsed string is used to generate a list of integers for various
+purposes such as specifying lines or columns in an image or tape file numbers.
+.ih
+SYNTAX
+
+The syntax for the range string consists of positive integers, '-' (minus),
+'x', ',' (comma), and whitespace.  The commas and whitespace are ignored
+and may be freely used for clarity.  The remainder of the string consists
+of sequences of five fields.  The first field is the beginning of a range,
+the second is a '-', the third is the end of the range, the fourth is
+a 'x', and the fifth is a step size.  Any of the five fields may be
+missing causing various default actions.  The defaults are illustrated in
+the following table.
+
+.nf
+-3x1	A missing starting value defaults to 1.
+2-x1	A missing ending value defaults to MAX_INT.
+2x1	A missing ending value defaults to MAX_INT.
+2-4	A missing step defaults to 1.
+4	A missing ending value and step defaults to an ending
+	value equal to the starting value and a step of 1.
+x2	Missing starting and ending values defaults to
+	the range 1 to MAX_INT with the specified step.
+""	The null string is equivalent to "1 - MAX_INT x 1",
+	i.e all positive integers.
+.fi
+
+The specification of several ranges yields the union of the ranges.
+.ih
+EXAMPLES
+
+The following examples further illustrate the range syntax.
+
+.nf
+-	All positive integers.
+1,5,9	A list of integers equivalent to 1-1x1,5-5x1,9-9x1.
+x2	Every second positive integer starting with 1.
+2x3	Every third positive integer starting with 2.
+-10	All integers between 1 and 10.
+5-	All integers greater than or equal to 5.
+9-3x1	The integers 3,6,9.
+.fi
+.ih
+PROCEDURES
+
+.ls 4 decode_ranges
+
+.nf
+int procedure decode_ranges (range_string, ranges, max_ranges, minimum,
+    maximum, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	minimum, maximum	# Minimum and maximum range values allowed
+int	nvalues			# The number of values in the ranges
+.fi
+
+The range string is decoded into an integer array of maximum dimension
+3 * max_ranges.  Each range consists of three consecutive integers
+corresponding to the starting and ending points of the range and the
+step size.  The number of integers covered by the ranges is returned
+as nvalue.  The end of the set of ranges is marked by a NULL.
+The returned status is either ERR or OK.
+.le
+.ls 4 get_next_number, get_last_number
+
+.nf
+int procedure get_next_number (ranges, number)
+int procedure get_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+.fi
+
+Given a value for number the procedures find the next (previous) number in
+increasing (decreasing)
+value within the set of ranges.  The next (previous) number is returned in
+the number argument.  A returned status is either OK or EOF.
+EOF indicates that there are no greater values.  The usual usage would
+be in a loop of the form:
+
+.nf
+	number = 0
+	while (get_next_number (ranges, number) != EOF) {
+	    <Statements using number>
+	}
+.fi
+.le
+.ls 4 is_in_range
+
+.nf
+bool procedure is_in_range (ranges, number)
+
+int	ranges[ARB]		# Ranges array
+int	number			# Number to check againts ranges
+.fi
+
+A boolean value is returned indicating whether number is covered by
+the ranges.
+
+.endhelp
+
+
+# DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by a single NULL.
+
+
+int procedure decode_ranges (range_string, ranges, max_ranges, minimum,
+    maximum, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	minimum, maximum	# Minimum and maximum range values allowed
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, out_of_range, a, b, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nrange = 1
+	nvalues = 0
+	out_of_range = 0
+
+	while (nrange < max_ranges) {
+	    # Default values
+	    a = minimum
+	    b = maximum
+	    step = 1
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '*', '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    if (out_of_range == 0) {
+		        # Null string defaults
+		        ranges[1, 1] = a
+		        ranges[2, 1] = b
+		        ranges[3, 1] = step
+		        ranges[1, 2] = NULL
+	    	        nvalues = (b - a) / step + 1
+		        return (OK)
+		    } else {
+			# Only out of range data
+			return (ERR)
+		    }
+		} else {
+		    ranges[1, nrange] = NULL
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == '*')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, a) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', '*', or 'x' otherwise b = a.
+	    if (range_string[ip] == 'x')
+		;
+	    else if ((range_string[ip] == '-') || (range_string[ip] == '*')) {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, b) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		b = a
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		} else if (range_string[ip] == '-')
+		    ;
+		else if (range_string[ip] == '*')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    first = min (a, b)
+	    last = max (a, b)
+	    if (first < minimum)
+		first = minimum + mod (step - mod (minimum - first, step), step)
+	    if (last > maximum)
+		last = maximum - mod (last - maximum, step)
+	    if (first <= last) {
+	        ranges[1, nrange] = first
+	        ranges[2, nrange] = last
+	        ranges[3, nrange] = step
+	        nvalues = nvalues + (last - first) / step + 1
+		nrange = nrange + 1
+	    } else
+		out_of_range = out_of_range + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure get_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = ranges[ip]
+	    last = ranges[ip+1]
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# GET_PREVIOUS_NUMBER -- Given a list of ranges and the current file number,
+# find and return the previous file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically decreasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure get_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number-1 is anywhere in the list, that is the previous number,
+	# otherwise the previous number is the largest number in the list which
+	# is less than number-1.
+
+	number = number - 1
+	next_number = 0
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = ranges[ip]
+	    last = ranges[ip+1]
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder >= first)
+		    next_number = number - remainder
+	    } else if (last < number) {
+		remainder = mod (last - first, step)
+		if (remainder == 0)
+		    next_number = max (next_number, last)
+		else if (last - remainder >= first)
+		    next_number = max (next_number, last - remainder)
+	    }
+	}
+
+	if (next_number == 0)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IS_IN_RANGE -- Test number to see if it is in range.
+
+bool procedure is_in_range (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Number to be tested against ranges
+
+int	ip, first, last, step
+
+begin
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = ranges[ip]
+	    last = ranges[ip+1]
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last)
+		if (mod (number - first, step) == 0)
+		    return (TRUE)
+	}
+
+	return (FALSE)
+end
+
+# EXPAND_RANGES -- Expand a range string into a array of values.
+
+int procedure expand_ranges (ranges, array, max_nvalues)
+
+int	ranges[ARB]			# Range array
+int	array[max_nvalues]		# Array of values
+int	max_nvalues			# Maximum number of values
+
+int	n, value
+
+int	get_next_number()
+
+begin
+	n = 0
+	value = 0
+	while ((n < max_nvalues) && (get_next_number (ranges, value) != EOF)) {
+	    n = n + 1
+	    array[n] = value
+	}
+
+	return (n)
+end
diff --git a/noao/twodspec/multispec/response.par b/noao/twodspec/multispec/response.par
new file mode 100644
index 00000000..0d6cdf60
--- /dev/null
+++ b/noao/twodspec/multispec/response.par
@@ -0,0 +1,11 @@
+# RESPONSE
+
+input_image,f,a,,,,Input image to be smoothed and cleaned
+output_image,f,a,,,,Smoothed and cleaned output image
+spline_order,i,h,4,2,,Smoothing spline order
+width,i,a,1,1,,Width of smoothing region
+sigma_min,r,h,1,,,Minimum pixel sigma
+above,r,h,5,,,Upper cleaning threshold
+below,r,h,5,,,Lower cleaning threshold
+window,i,h,0,0,,Rejection window radiu
+div_threshold,r,h,1000.,,,Division threshold
diff --git a/noao/twodspec/multispec/sampline.x b/noao/twodspec/multispec/sampline.x
new file mode 100644
index 00000000..37583f9f
--- /dev/null
+++ b/noao/twodspec/multispec/sampline.x
@@ -0,0 +1,73 @@
+include <mach.h>
+include	"ms.h"
+
+
+# GET_SAMPLE_LINE -- Get the nearest sample line to the given image lines.
+#
+# The nearest sample line to each image line is found an returned
+# as the function value.
+
+int procedure get_sample_line (ms, line)
+
+pointer	ms				# MULTISPEC data structure
+int	line				# Image line
+
+int	sample, midpoint
+
+begin
+	sample = 0
+	midpoint = 0
+
+	repeat {
+	    sample = sample + 1
+	    if (sample < MS_NSAMPLES(ms))
+		midpoint = (LINE(ms, sample) + LINE(ms, sample + 1)) / 2
+	    else if (sample == MS_NSAMPLES(ms))
+		midpoint = MAX_INT
+	    else
+		break
+	} until (line < midpoint)
+
+	return (sample)
+end
+
+
+# GET_SAMPLE_LINES -- Get the sample lines for the given image lines.
+#
+# Image lines in the form of a range array are given.
+# The nearest sample line to each image line is found.  The array of
+# sample lines is returned and the function value is the number of
+# sample lines.
+
+int procedure get_sample_lines (ms, lines, samples)
+
+pointer	ms				# MULTISPEC data structure
+int	lines[ARB]			# Image line range array
+int	samples[ARB]			# Return sample lines
+
+int	nsamples, sample, line, midpoint
+int	get_next_number()
+
+begin
+	nsamples = 0
+	sample = 0
+	midpoint = 0
+	line = 0
+
+	while (get_next_number (lines, line) != EOF) {
+	    repeat {
+	        sample = sample + 1
+	        if (sample < MS_NSAMPLES(ms))
+		    midpoint = (LINE(ms, sample) + LINE(ms, sample + 1)) / 2
+	        else if (sample == MS_NSAMPLES(ms))
+		    midpoint = MAX_INT
+	        else
+		    return (nsamples)
+	    } until (line < midpoint)
+
+	    nsamples = nsamples + 1
+	    samples[nsamples] = sample
+	    line = midpoint - 1
+	}
+	return (nsamples)
+end
diff --git a/noao/twodspec/multispec/setfitparams.x b/noao/twodspec/multispec/setfitparams.x
new file mode 100644
index 00000000..780572c3
--- /dev/null
+++ b/noao/twodspec/multispec/setfitparams.x
@@ -0,0 +1,27 @@
+include "ms.h"
+
+# SET_FITPARAMS -- Set the fitparams array from the spectra range array
+# and the parameters array.
+
+procedure set_fitparams (spectra, parameters, nspectra, nparams, fitparams)
+
+int	spectra[ARB]
+int	parameters[nparams]
+int	nspectra
+int	nparams
+int	fitparams[nspectra, nparams]
+
+int	i, j
+
+bool	is_in_range()
+
+begin
+	do i = 1, nspectra {
+	    do j = 1, nparams {
+	        if (is_in_range (spectra, i) && (parameters[j] == YES))
+		    fitparams[i, j] = YES
+		else
+		    fitparams[i, j] = NO
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/setmodel.x b/noao/twodspec/multispec/setmodel.x
new file mode 100644
index 00000000..98c1a630
--- /dev/null
+++ b/noao/twodspec/multispec/setmodel.x
@@ -0,0 +1,86 @@
+include "ms.h"
+
+# SET_MODEL -- Set a line of model data from profiles based on their
+# ranges starting values.
+
+procedure set_model (ms, model, model_profiles, ranges, len_line, len_profile,
+    nspectra)
+
+pointer	ms					# MULTISPEC data structure
+real	model[len_line]				# Model line created
+real	model_profiles[len_profile, nspectra]	# Model profiles
+real	ranges[nspectra, LEN_RANGES]		# Ranges array for the profiles
+int	len_line				# The length of the model line
+int	len_profile				# The length of the profiles
+int	nspectra				# The number of spectra
+
+int	i, x, spectrum
+
+begin
+	# Set the model background to zero.
+	call aclrr (model, len_line)
+
+	# For each spectrum and each profile point add contribution to model.
+	do spectrum = 1, nspectra {
+	    do i = 1, len_profile {
+		# Column corresponding to profile point i and spectrum.
+	        x = ranges[spectrum, X_START] + i - 1
+
+		# Scale the model profile by the model parameter I0 and
+		# add to the model line.
+		if ((x >= 1) && (x <= len_line))
+		    model[x] = model[x] + PARAMETER(ms, I0, spectrum) *
+			model_profiles[i, spectrum]
+	    }
+	}
+end
+
+# SET_MODEL1 -- Set a line of model data from profiles based on the spectra
+# function fit position centers and the ranges dx_start value.
+
+procedure set_model1 (ms, line, profiles, coeff, ranges, len_line, len_profile,
+    nspectra, model)
+
+pointer	ms					# MULTISPEC data structure
+int	line					# Image line for model
+real	profiles[len_profile, nspectra]		# Profiles
+real	coeff[ARB]				# Image interpolation coeff.
+real	ranges[nspectra, LEN_RANGES]		# Ranges array for profiles
+int	len_line				# Length of model line
+int	len_profile				# Length of profiles
+int	nspectra				# Number of spectra
+real	model[len_line]				# Model line to be created
+
+int	i, x, spectrum
+real	x_start, dx
+
+real	cveval(), asival()
+
+begin
+	# Clear the model to a zero background.
+	call aclrr (model, len_line)
+
+	# Add the contribution for each spectrum.
+	do spectrum = 1, nspectra {
+	    # Fit image interpolator to profile.
+	    call asifit (profiles[1,spectrum], len_profile, coeff)
+
+	    # Determine starting column corresponding to spectrum at specified
+	    # line whose central position is given by the fit function.
+	    x_start = cveval (CV(ms, X0_FIT, spectrum), real (line)) +
+		ranges[spectrum, DX_START]
+
+	    # For each column corresponding to a point in the profile determine
+	    # the interpolation point dx within the profile and evaluate the
+	    # the image interpolation function.
+
+	    x = x_start
+	    do i = 1, len_profile - 1 {
+		x = x + 1
+		if ((x >= 1) && (x <= len_line)) {
+		    dx = x - x_start + 1
+		    model[x] = model[x] + asival (dx, coeff)
+		}
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/setranges.x b/noao/twodspec/multispec/setranges.x
new file mode 100644
index 00000000..46247a08
--- /dev/null
+++ b/noao/twodspec/multispec/setranges.x
@@ -0,0 +1,23 @@
+include "ms.h"
+
+# SET_RANGES -- Set profile starting range array.
+#
+# The ranges array relates the starting point of the profiles relative
+# to the center of profile and relative to the image line.  For more
+# details see the MULTISPEC system documentation.
+
+procedure set_ranges (ms, lower, ranges, nspectra)
+
+pointer	ms				# MULTISPEC data structure
+real	lower				# Relative lower limit of profiles
+real	ranges[nspectra, LEN_RANGES]	# Ranges array to be set
+int	nspectra			# Number of spectra
+
+int	i
+
+begin
+	do i = 1, nspectra {
+	    ranges[i, X_START] = int (PARAMETER(ms, X0, i)) + lower
+	    ranges[i, DX_START] = ranges[i, X_START] - PARAMETER(ms, X0, i)
+	}
+end
diff --git a/noao/twodspec/multispec/setsmooth.x b/noao/twodspec/multispec/setsmooth.x
new file mode 100644
index 00000000..10740dce
--- /dev/null
+++ b/noao/twodspec/multispec/setsmooth.x
@@ -0,0 +1,250 @@
+include	<imhdr.h>
+include	"ms.h"
+
+.help set_smooth Jul84 MULTISPEC
+.sh
+Procedure set_smooth
+
+     This procedure returns data profiles for the requested image line and model
+profiles consisting of the sum of (naverage =) nlines - 1 image line data
+profiles surrounding (and excluding) the data image line.
+
+     A buffer of nlines + 1 set of profiles is kept.  The first set of profiles
+is used to keep the sum of the nlines - 1 profiles which excludes the current
+line of data profiles (thus, the number of lines in the sum = nlines - 1).
+The remaining sets of profiles (2 to nlines + 1) contain data profiles for all
+the lines in the sum plus the current data line.  The lines are stored in a
+cyclic fashion with the buffer line being related to the data line by 
+
+	buffer line = 2 + mod (data line - 1, nlines)
+
+Each data line is read and converted into a set of profiles and put into the
+buffer only if it is not already in the buffer.
+
+     The algorithm first checks the state of the previous profiles buffer.
+If it would be unchanged then it returns.  Otherwise, it subtracts the profiles
+which are not in common with the new set of summation lines from the
+sum profiles before replacing those lines in the profiles buffer with new data
+profiles.  If the number of vector subtractions exceeds the number of vector
+additions to readd the common lines to the sum profiles then the common
+profiles are readded instead.  The new data profiles are then obtained from
+the image (with procedure msgprofiles) and added, if needed, to the sum
+profiles.  Finally, the sum profiles are copied to the model profiles and
+the profiles from the profiles buffer corresponding to the requested data
+line are copied to the data profiles array.
+
+     This algorithm is maximumally efficient with its imageio.  If the model
+lines are requested sequentially through the image then each image data line
+will be read only once and each new model line will, on average, require only
+one image read, two vector additions, and two vector subtractions.  The
+number of vector additions and subtractions is two because the current data
+line is excluded from the sum.
+.sh
+Procedure msgprofiles
+
+     In order to obtain model profiles based on summing the profiles from
+a number of neighboring lines, the profiles from each line must be
+shifted to the relative profile centers.  The procedure msgprofiles reads
+an image line and computes an interpolation function for the line.
+The spectra profiles are then extracted using the position interpolation
+function to determine the spectra centers in the image line.  The
+profiles are aligned to the same relative positions in the profiles
+array based on the ranges array.
+.endhelp
+
+
+# SET_SMOOTH -- Set the SMOOTH model profiles.
+
+procedure set_smooth (ms, im, line, ranges, profiles, coeff,
+    len_prof, nspectra, nlines, data, model)
+
+pointer	ms					# MULTISPEC data structure
+int	im					# IMIO image descriptor
+int	line					# Image line to be modeled
+real	ranges[nspectra, LEN_RANGES]		# Ranges array
+real	profiles[len_prof, nspectra, ARB]	# Profiles array
+real	coeff[ARB]				# Image interpolator coeffs.
+int	len_prof				# Length of profiles
+int	nspectra				# Number of spectra
+int	nlines					# Number of lines in average
+real	data[len_prof, nspectra]		# Data profiles for line
+real	model[len_prof, nspectra]		# SMOOTH model profiles
+
+int	i, j, navg
+int	len_profs, last_line, last_start, last_end, line_start, line_end
+pointer	k
+
+data	len_profs/0/
+
+begin
+	# Initialize
+	if (len_profs == 0) {
+	    navg = nlines - 1
+	    len_profs = len_prof * nspectra
+	    last_line = 0
+	    last_start = -nlines
+	    last_end = 0
+	}
+
+	# Determine range of lines for averaging.
+
+	# The following is to use the center of the averaging region.
+	#line_start = max (1, line - nlines / 2)
+
+	# The following uses the preceeding nlines - 1 lines.
+	line_start = max (1, line - (nlines - 1))
+
+	line_start = min (line_start, IM_LEN(im, 2) - nlines)
+	line_end = line_start + nlines - 1
+
+	# Return if the same line is the same and the lines used in the
+	# sum profile are the same.
+
+	if ((line_start == last_start) && (line == last_line))
+	    return
+
+	# If the number of lines in common with the previous sum profile is
+	# < nlines / 2 then it is more efficient to clear the sum profile
+	# and readd the common lines.
+
+	if (abs (line_start - last_start) > nlines / 2) {
+	    call aclrr (profiles[1,1,1], len_profs)
+	    do i = last_start, last_end {
+		j = i - line_start
+
+		# If the old line i is within the new sum add it to the sum.
+		# However, if the line is the new data line do not add it.
+		if ((j >= 0) && (j < nlines) && (i != line)) {
+		    k = 2 + mod (i - 1, nlines)
+		    call aaddr (profiles[1,1,1], profiles[1,1,k],
+			profiles[1,1,1], len_profs)
+		}
+	    }
+
+	# If the number in lines in common is >= nlines / 2 then it is more
+	# efficient to subtract the lines not in common from the sum.
+
+	} else {
+	    do i = last_start, last_end {
+		j = i - line_start
+		k = 2 + mod (i - 1, nlines)
+
+		# If the old line i is not within the new sum subtract it.
+		# Also, if the line is the new data line subtract it.
+		if ((j < 0) || (j >= nlines) || (i == line)) {
+		    # However, don't subtract the last data line since it was
+		    # not in the previous sum.
+		    if (i != last_line) {
+		        call asubr (profiles[1,1,1], profiles[1,1,k],
+			    profiles[1,1,1], len_profs)
+		    }
+
+		# If the old line is within the new sum but it was the old data
+		# line then add it to the sum since it was not in the old sum.
+		} else if (i == last_line) {
+		    call aaddr (profiles[1,1,1], profiles[1,1,k],
+			profiles[1,1,1], len_profs)
+		}
+	    }
+	}
+
+	# Get the new profiles into the profile buffer and the add to the sum.
+	do i = line_start, line_end {
+	    j = i - last_start
+	    if ((j < 0) || (j >= nlines)) {
+	        k = 2 + mod (i - 1, nlines)
+
+		# Get the data profile for line i and put it in profiles k.
+		call msgprofiles (ms, im, i, ranges, profiles[1,1,k], coeff,
+		    len_prof, nspectra)
+
+		# If the new line in the buffer is not the data line then
+		# add it to the sum profile.
+		if (i != line) {
+	            call aaddr (profiles[1,1,1], profiles[1,1,k],
+			profiles[1,1,1], len_profs)
+		}
+	    }
+	}
+
+	# Record current state of the average.
+	last_line = line
+	last_start = line_start
+	last_end = line_end
+
+	# Set the data profiles and model profiles.  The copies are
+	# made rather than working directly from the profiles buffer so that
+	# changes can be made in the data and model profiles without affecting
+	# the buffer.
+
+	k = 2 + mod (line - 1, nlines)
+	call amovr (profiles[1,1,k], data, len_profs)
+	call amovr (profiles[1,1,1], model, len_profs)
+end
+
+
+# UPDATE_SMOOTH -- Replace an updated data profile in the profiles buffer.
+
+procedure update_smooth (line, data, profiles, len_prof, nspectra, nlines)
+
+int	line					# Data image line
+real	data[len_prof, nspectra]		# Data profiles
+real	profiles[len_prof, nspectra, ARB]	# Profiles buffer
+int	len_prof				# Length of profiles
+int	nspectra				# Number of spectra
+int	nlines					# Number of lines in buffer
+
+int	i
+
+begin
+	i = 2 + mod (line - 1, nlines)
+	call amovr (data, profiles[1,1,i], len_prof * nspectra)
+end
+
+
+# MSGPROFILES -- Read image line and extract profiles in standard positions.
+
+procedure msgprofiles (ms, im, line, ranges, profile, coeff, len_prof,
+    nspectra)
+
+pointer	ms					# MULTISPEC data structure
+pointer	im					# IMIO image descriptor
+int	line					# Image line to be read
+real	ranges[nspectra, LEN_RANGES]		# Ranges array for profiles
+real	profile[len_prof, nspectra]		# Profiles to be obtained
+real	coeff[ARB]				# Image interpolator coeffs.
+int	len_prof				# Length of profiles
+int	nspectra				# Number of spectra
+
+int	i, j
+real	x
+pointer	im_buf
+
+pointer	imgl2r()
+real	cveval(), asival()
+
+begin
+	# Read image line.
+	im_buf = imgl2r (im, line)
+
+	# Fit image interpolation function.
+	call asifit (Memr[im_buf], IM_LEN(im, 1), coeff)
+
+	# For each spectrum extract the profiles.
+	do j = 1, nspectra {
+
+	    # Determine profile starting point in image coordinates using the
+	    # fit function for the spectrum center.
+	    x = cveval (CV(ms, X0_FIT, j), real (line)) +
+		ranges[j, DX_START] - 1
+
+	    # For each point in the profile evaluate the image interpolator.
+	    do i = 1, len_prof {
+		x = x + 1
+		if ((x < 1) || (x > IM_LEN(im, 1)))
+		    profile[i, j] = 0.
+		else
+		    profile[i, j] = asival (x, coeff)
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/solve.x b/noao/twodspec/multispec/solve.x
new file mode 100644
index 00000000..b7249242
--- /dev/null
+++ b/noao/twodspec/multispec/solve.x
@@ -0,0 +1,312 @@
+include	"ms.h"
+
+# SOLVE:
+# Solve for the parameter correction vector using the banded matrix
+# technique decribed in Lawson and Hanson.
+#
+# The variables g, mdg, nb, ip, ir, mt, jt, rnorm, x and n have the
+# same meaning as described in Lawson and Hanson.
+
+procedure solve (ms, data, model, fitparams, profiles, ranges, len_line,
+    len_profile, nspectra, nparams, solution, norm)
+
+# Procedure parameters:
+pointer	ms					# MULTISPEC data structure
+real	data[len_line]				# Data to be fit
+real	model[len_line]				# Model to be corrected
+int	fitparams[nspectra, nparams]		# Model parameters to be fit
+real	profiles[len_profile, nspectra, nparams]# Model parameter derivatives
+real	ranges[nspectra, LEN_RANGES]		# Ranges array for profiles
+int	len_line				# Length of data line
+int	len_profile				# Length of profiles
+int	nspectra				# Number of spectra
+int	nparams					# Number of model parameters
+real	solution[nspectra, nparams]		# Solution correction vector
+real	norm					# Measure of fit
+
+# Lawson and Hanson parameters:
+pointer	g				# Working array
+pointer	x				# Working vector
+int	mdg				# Maximum dimension of g
+int	n				# Number of parameters to be determined
+int	nb				# Parameter bandwith
+int	ip, ir, mt, jt, jt_next		# Array pointers
+real	rnorm				# Deviation from fit
+int	ier				# Error flag
+
+int	ns				# Maximum spectra bandwidth
+pointer	columns				# Columns to be used.
+int	ncolumns			# Number of columns
+pointer	spectra				# Spectra to be used.
+int	nspectra_to_solve			# Number of spectra
+int	k_start, k_next			# Indices to the spectra array
+int	column, spectrum, parameter	# Column, spectrum and parameter values
+int	ns_in_band			# Number of spectra in band
+int	i, j, k, l, m
+bool	is_zero
+pointer	sp
+
+begin
+	# Determine columns, spectra, and parameters contributing to
+	# the solution matrix and the bandwidth of the matrix.
+	call smark (sp)
+	call salloc (columns, len_line, TY_INT)
+	call salloc (spectra, nspectra, TY_INT)
+	call band_set (ms, fitparams, data, profiles, ranges, Memi[columns],
+	    Memi[spectra], len_line, len_profile, nspectra, nparams, ncolumns,
+	    nspectra_to_solve, n, ns, nb)
+	if (n == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Allocate working memory for the Lawson and Hanson routines.
+	mdg = ncolumns
+	call salloc (g, mdg * (nb + 1), TY_REAL)
+	call salloc (x, n, TY_REAL)
+
+	# Initialize array indices.
+	ip = 1
+	ir = 1
+	jt = 1
+	mt = 0
+	jt_next = jt
+	k_next = 1
+
+	# Accumulate banded matrix for the specifed columns, spectra, and
+	# parameters.
+	do i = 1, ncolumns {
+	    column = Memi[columns + i - 1]
+
+	    k_start = k_next
+	    j = jt
+	    ns_in_band = 0
+	    do k = k_start, nspectra_to_solve {
+		spectrum = Memi[spectra + k - 1]
+
+		# Evalute parameter derivatives and determine if all
+		# derivatives for the spectrum are zero.
+		is_zero = TRUE
+	        do parameter = 1, nparams {
+		    if (fitparams[spectrum, parameter] == NO)
+		         next
+		    j = j + 1
+		    m = column - ranges[spectrum, X_START] + 1
+		    if ((m < 1) || (m > len_profile))
+			Memr[x + j - 2] = 0.
+		    else {
+		        Memr[x + j - 2] = profiles[m, spectrum, parameter]
+		        if (parameter != I0_INDEX)
+			    Memr[x + j - 2] = Memr[x + j - 2] *
+			        PARAMETER (ms, I0, spectrum)
+		        if (Memr[x + j - 2] != 0.)
+		    	    is_zero = FALSE
+		    }
+		}
+
+		# If the spectrum has a non-zero contribution to the parameter
+		#     matrix then increment the number of spectra in the
+		#     band (ns_in_band).
+		# Else if the number of spectra in the band is still zero then
+		#     increment the spectrum and parameter pointers.
+		# Else the band is assumed complete so break to accumulate
+		#     the band.
+
+		if (!is_zero)
+		    ns_in_band = ns_in_band + 1
+		else if (ns_in_band == 0) {
+		    k_next = min (k + 1, nspectra_to_solve - ns + 1)
+		    jt_next = min (j, n - nb + 1)
+		} else {
+		    do l = j, jt_next + nb - 1
+			Memr[x + (l - 1)] = 0.
+		    break
+		}
+	    }
+
+	    # If the number of spectra in the band is zero then reset the
+	    #     spectrum pointer (k_next) and go to the next column.
+	    # Else if the number of spectra in the band exceeds the specified
+	    #     bandwidth return an error.
+	    # Else accumulate the new band.
+
+	    if (ns_in_band == 0) {
+		k_next = k_start
+		jt_next = jt
+		next
+	    } else if (ns_in_band > ns)
+		call error (MS_ERROR, "Bandwidth too small")
+
+	    # If a new submatrix is being started accumulate last submatrix.
+	    if ((jt_next != jt) && (mt > 0)) {
+	        call bndacc (Memr[g], mdg, nb, ip, ir, mt, jt)
+	        mt = 0
+	    }
+
+	    # Increment the submatrix line pointer (mt) and add the band to
+	    # submatrix being accumulated.
+
+	    mt = mt + 1
+	    jt = jt_next
+	    do k = 1, nb
+		Memr[g+ir+mt-2 + (k-1)*mdg] = Memr[x + (jt - 1) + (k - 1)]
+	    # INDEFR data may already be ignored in the column selection in
+	    # band_set.
+	    if (IS_INDEFR (data[column]))
+	        Memr[g+ir+mt-2 + nb*mdg] = 0.
+	    else
+	        Memr[g+ir+mt-2 + nb*mdg] = data[column] - model[column]
+	}
+
+	# Accumulate last submatrix and calculate banded matrix solution vector.
+	call bndacc (Memr[g], mdg, nb, ip, ir, mt, jt)
+	call bndsol (1, Memr[g], mdg, nb, ip, ir, Memr[x], n, rnorm, ier)
+	if (ier != 0) {
+	    call error (MS_ERROR, "bandsol: Solution error")
+	}
+
+	# Compute error matrix here.  Not yet implemented.
+
+	# The solution from bndsol is in array x.  Copy x to solution.
+	j = 0
+	do i = 1, nspectra_to_solve {
+	    spectrum = Memi[spectra + i - 1]
+	    do parameter = 1, nparams {
+		if (fitparams[spectrum, parameter] == YES) {
+		    solution[spectrum, parameter] = Memr[x + j]
+		    j = j + 1
+		} else
+		    solution[spectrum, parameter] = 0.
+	    }
+	}
+	norm = rnorm
+
+	call sfree (sp)
+end
+
+
+# Reject parameters which have only zero derivatives.  Determine spectra,
+# columns, and number of parameters contributing to the solution.
+# Determine bandwidth of the banded matrix.
+
+procedure band_set (ms, fitparams, data, profiles, ranges, columns, spectra,
+    len_line, len_profile, nspectra, nparams, ncolumns, nspectra_to_solve,
+    n, ns, nb)
+
+pointer	ms					# MULTISPEC data structure
+int	fitparams[nspectra, nparams]		# Parameters to be fit
+real	data[len_line]				# Data being fit
+real	profiles[len_profile, nspectra, nparams]# Parameter derivatives
+real	ranges[nspectra, LEN_RANGES]		# Ranges array for profiles
+int	columns[len_line]			# Return columns to be used
+int	spectra[nspectra]			# Return spectra to used
+int	len_line				# Length of data being fit
+int	len_profile				# Length of profiles
+int	nspectra				# Number of spectra
+int	nparams					# Number of parameters
+int	ncolumns				# Number of useful columns
+int	nspectra_to_solve			# Number of useful spectra
+int	n					# Number of parameters in fit
+int	ns					# Number of spectra in band
+int	nb					# Bandwith of matrix
+
+int	i, j, k
+int	column, spectrum, parameter
+int	col_start
+real	dx
+int	xmin, xmax
+
+begin
+	# Initially set the spectra and columns to NO.
+	call amovki (NO, spectra, nspectra)
+	call amovki (NO, columns, len_line)
+
+	# Determine the spectra and columns in which the fitparams have
+	# non-zero derivatives.  Flag those fitparams which do not have
+	# non-zero derivatives with NO.  Count the number of parameters
+	# which have non-zero derivatives.
+
+	n = 0
+	do spectrum = 1, nspectra {
+	    do parameter = 1, nparams {
+	        if (fitparams[spectrum, parameter] == YES) {
+		    fitparams[spectrum, parameter] = NO
+		    col_start = ranges[spectrum, X_START]
+		    do k = 1, len_profile {
+			if (profiles[k, spectrum, parameter] != 0.) {
+			    column = col_start + k - 1
+			    if ((column >= 1) && (column <= len_line)) {
+
+				# If the INDEFR data points are not to be
+				# ignored but replaced by the model in solve,
+				# replace the if clause with the following.
+			        # columns[column] = YES
+			        # fitparams[spectrum, parameter] = YES
+
+				if (!IS_INDEFR (data[column])) {
+			           columns[column] = YES
+			           fitparams[spectrum, parameter] = YES
+				}
+			    }
+			}
+		    }
+		    if (fitparams[spectrum, parameter] == YES) {
+			n = n + 1
+			spectra[spectrum] = YES
+		    }
+		}
+	    }
+	}
+
+	# Count the number spectra to be used and set the spectra array.
+	nspectra_to_solve = 0
+	do spectrum = 1, nspectra {
+	    if (spectra[spectrum] == YES) {
+		nspectra_to_solve = nspectra_to_solve + 1
+		spectra[nspectra_to_solve] = spectrum
+	    }
+	}
+
+	# Count the number of columns to be used and set the columns array.
+	ncolumns = 0
+	do column = 1, len_line {
+	    if (columns[column] == YES) {
+		ncolumns = ncolumns + 1
+		columns[ncolumns] = column
+	    }
+	}
+
+	# Determine the maximum number spectra contributing to any column.
+	ns = 1
+	do i = 1, nspectra_to_solve - 1 {
+	    xmax = 0
+	    do parameter = 1, nparams {
+		if (fitparams[spectra[i], parameter] == YES)
+		    xmax = max (xmax,
+			int (ranges[spectra[i], X_START] + len_profile - 1))
+	    }
+	    do j = i + 1, nspectra_to_solve {
+		xmin = len_line
+	        do parameter = 1, nparams {
+		    if (fitparams[spectra[j], parameter] == YES)
+		        xmin = min (xmin, int (ranges[spectra[j], X_START]))
+	        }
+		dx = xmax - xmin
+		if (dx < 0)
+		    break
+		else
+		    ns = max (ns, j - i + 1)
+	    }
+	}
+
+	# Determine the banded matrix bandwidth.
+	nb = 0
+	do parameter = 1, nparams {
+	    do i = 1, nspectra_to_solve {
+		if (fitparams[spectra[i], parameter] == YES) {
+		    nb = nb + ns
+		    break
+		}
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/t_findpeaks.x b/noao/twodspec/multispec/t_findpeaks.x
new file mode 100644
index 00000000..2e4cf79e
--- /dev/null
+++ b/noao/twodspec/multispec/t_findpeaks.x
@@ -0,0 +1,137 @@
+include <imhdr.h>
+include <fset.h>
+include "ms.h"
+
+# T_FIND_PEAKS -- Find the spectra peaks in a MULTISPEC image and record
+# their positions in the database.
+#
+# An average of naverage lines from the MULTISPEC image is searched
+# for peaks satisfying constraints on the minimum and maximum number,
+# columns, peak values, and separation between peaks.  The positions
+# of the peaks satisfying these constraints is entered in the database.
+# It is an error if fewer than the minimum number of peaks is found
+# or if the number of peaks differs from a previously determined number.
+# The peak finding is done by the function FIND_PEAKS which is numerical
+# and may be used outside the MULTISPEC package.
+
+procedure t_find_peaks ()
+
+# CL parameters:
+char	image[SZ_FNAME]		# Image to be searched
+int	lines[3, MAX_RANGES]	# Image lines in which to find spectra
+int	min_npeaks		# Minimum number of spectra to be found
+int	max_npeaks		# Maximum number of spectra to be accepted
+int	separation		# Minimum pixel separation between spectra
+int	edge			# Minimum distance to edge of image
+real	threshold		# Minimum peak value
+real	contrast		# Max contrast between strongest and weakest
+int	columns[3, MAX_RANGES]	# Spectra positions limited to these columns
+int	naverage		# Number of image lines to average
+bool	debug			# Print debugging information
+
+char	comment[SZ_LINE]
+int	i, j, k, line, sample, nsamples, npoints, nspectra
+pointer	ms, im
+pointer	sp, data, x, samples
+
+int	find_peaks(), get_sample_lines()
+int	clgeti(), clgranges()
+real	clgetr()
+bool	clgetb(), is_in_range()
+pointer	msmap(), immap()
+
+begin
+	# Get task parameters and access files.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_WRITE, 0)
+	im = immap (image, READ_ONLY, 0)
+	i = clgranges ("lines", 1, IM_LEN(im, 2), lines, MAX_RANGES)
+	min_npeaks = clgeti ("min_npeaks")
+	max_npeaks = clgeti ("max_npeaks")
+	separation = clgeti ("separation")
+	edge = clgeti ("edge")
+	threshold = clgetr ("threshold")
+	contrast = clgetr ("contrast")
+	i = clgranges ("columns", 1, IM_LEN(im, 1), columns, MAX_RANGES)
+	naverage = clgeti ("naverage")
+	debug = clgetb ("debug")
+
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Allocate working memory.
+	npoints = IM_LEN(im, 1)
+	call smark (sp)
+	call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	call salloc (data, npoints, TY_REAL)
+	call salloc (x, npoints, TY_REAL)
+
+	# Get the sample lines.
+	nsamples = get_sample_lines (ms, lines, Memi[samples])
+
+	# Loop through each sample line.
+	do i = 1, nsamples {
+	    sample = Memi[samples + i - 1]
+	    line = LINE(ms, sample)
+
+	    # Get the image data with averaging.
+	    call  msgimage (im, line, naverage, Memr[data])
+
+	    # Mark columns which are to be ignored with INDEFR.
+	    do j = 1, npoints
+	        if (!is_in_range (columns, j))
+		    Memr[data + j - 1] = INDEFR
+
+	    # Find the peaks.
+	    nspectra = find_peaks (Memr[data], Memr[x], npoints,
+		contrast, separation, edge, max_npeaks, threshold, debug)
+
+	    if (debug) {
+	        call printf ("  Number of spectra found in line %d = %d.\n")
+		    call pargi (line)
+	            call pargi (nspectra)
+	    }
+	    if (nspectra < min_npeaks)
+		call error (MS_ERROR, "Too few spectra found")
+
+	    # Enter the spectra found in the database.  If the number of
+	    # spectra has not been previously set in the database then
+	    # enter the number of spectra and make entries in the
+	    # database.  Otherwise check that the number of spectra found
+	    # agrees with that already in the database.
+
+	    if (MS_NSPECTRA(ms) == 0) {
+	        if (nspectra == 0)
+		    next
+		MS_NSPECTRA(ms) = nspectra
+	        call dbenter (MS_DB(ms), NAME(ms, I0), nspectra * SZ_REAL,
+		    MS_NSAMPLES(ms))
+	        call dbenter (MS_DB(ms), NAME(ms, X0), nspectra * SZ_REAL,
+		    MS_NSAMPLES(ms))
+	    } else if (MS_NSPECTRA(ms) != nspectra)
+		call error (MS_ERROR, "Attempt to change the number of spectra")
+
+	    call msgparam (ms, X0, sample)
+	    call amovr (Memr[x], PARAMETER(ms, X0, 1), nspectra)
+	    call mspparam (ms, X0, sample)
+
+	    # The peak scale is taken and the pixel value at the peak.
+	    call msgparam (ms, I0, sample)
+	    do j = 1, nspectra {
+		k = PARAMETER(ms, X0, j)
+		PARAMETER(ms, I0, j) = Memr[data + k - 1]
+	    }
+	    call mspparam (ms, I0, sample)
+
+	    # Enter a comment in the database.
+	    call sprintf (comment, SZ_LINE,
+		"Spectra located in sample line %d.")
+		call pargi (sample)
+	    call history (ms, comment)
+	}
+
+	# Update the database and close the database and image.
+	call msphdr (ms)
+	call msunmap (ms)
+	call imunmap (im)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/t_fitfunc.x b/noao/twodspec/multispec/t_fitfunc.x
new file mode 100644
index 00000000..9f6209ad
--- /dev/null
+++ b/noao/twodspec/multispec/t_fitfunc.x
@@ -0,0 +1,158 @@
+include <math/curfit.h>
+include	"ms.h"
+
+# T_FIT_FUNCTION -- Fit a function to selected spectra parameters.
+#
+# A function is fit to the parameter values determined at the sample
+# lines for selected spectra.  The function coefficients are stored in
+# the database and the fitted values replace the original values at
+# the sample lines.  The type of function, the parameter to be fitted,
+# the sample lines used in the fit, and the spectra to be fitted
+# are all selected by the user.
+
+procedure t_fit_function()
+
+char	image[SZ_FNAME]			# Image affected
+char	parameter[SZ_LINE]		# Parameter to be fit
+int	function			# Type of fitting function
+int	order				# Order of the fitting function
+int	spectra[3, MAX_RANGES]		# Spectra to be fitted
+pointer	samples				# Sample lines to be fitted.
+
+int	i, param_id, nsamples
+pointer	ms, sp
+
+int	ms_db_id(), clgranges(), get_sample_lines()
+pointer	msmap()
+
+begin
+	# Access database and determine parameter to be fit and the
+	# fitting function and order.
+
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_WRITE, 0)
+	call clgstr ("parameter", parameter, SZ_LINE)
+	param_id = ms_db_id (ms, parameter)
+	call clgcurfit ("function", "order", function, order)
+
+	# Get the image lines to be used in the fit and convert to sample
+	# lines.  Get the spectra to be fit.
+
+	i = clgranges ("lines", 1, MS_LEN(ms, 2), spectra, MAX_RANGES)
+	call smark (sp)
+	call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	nsamples = get_sample_lines (ms, spectra, Memi[samples])
+	i = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra,
+	    MAX_RANGES)
+
+	# Fit the parameters for each spectrum, store the fits in the database,
+	# and substitute the fitted values for the parameter values at all
+	# the sample lines.
+
+	call fit_function (ms, Memi[samples], nsamples, spectra, param_id,
+	    function, order)
+
+	# Finish up.
+	call msphdr (ms)
+	call msunmap (ms)
+	call sfree (sp)
+end
+
+
+
+# FIT_FUNCTION -- Fit a function to the parameter data.
+#
+# If the fit coefficients for the specified parameter are not in
+# the database then the database entry is created.
+
+procedure fit_function (ms, lines, nlines, spectra, param_id, function, order)
+
+pointer	ms				# MULTISPEC data structure
+int	lines[nlines]			# Sample lines to be used
+int	nlines				# Number of sample lines
+int	spectra[ARB]			# Spectra to be fitted
+int	param_id			# Parameter being fit
+int	function			# Function to be fit
+int	order				# Order of the function
+
+char	comment[SZ_LINE]
+int	i, spectrum, fit_id, ier
+real	x, wt
+
+int	ms_fit_id(), get_next_number()
+real	cveval()
+bool	dbaccess()
+
+begin
+	# Determine the MULTISPEC fit id from the parameter id.
+	fit_id = ms_fit_id (param_id)
+	if (fit_id == ERR)
+	    call error (MS_ERROR, "Unknown fit identifier")
+
+	# Enter the fit records in the database if necessary.
+	if (!dbaccess (MS_DB(ms), NAME(ms, fit_id)))
+	    call dbenter (MS_DB(ms), NAME(ms, fit_id),
+		(7 + MS_NSAMPLES(ms)) * SZ_REAL, MS_NSPECTRA(ms))
+
+	# Allocate memory for the curfit data structures pointers.
+	if (MS_DATA(ms, fit_id) == NULL)
+	    call malloc (MS_DATA(ms, fit_id), MS_NSPECTRA(ms), TY_INT)
+
+	# Initialize the curfit data structures.
+	# If the order is INDEF then use maximum order assuming no INDEF points.
+	spectrum = 0
+	while (get_next_number (spectra, spectrum) != EOF) {
+	    if (IS_INDEFI (order)) {
+	        switch (function) {
+	        case LEGENDRE, CHEBYSHEV:
+		    order =  nlines
+	        case SPLINE3:
+		    order = nlines - 3
+	        }
+	    }
+	    call cvinit (CV(ms, fit_id, spectrum), function, order, 1.,
+		real (MS_LEN(ms, 2)))
+	}
+
+	# Accumulate the parameter values.
+	do i = 1, nlines {
+	    x = LINE(ms, lines[i])
+	    call msgparam (ms, param_id, lines[i])
+
+	    spectrum = 0
+	    while (get_next_number (spectra, spectrum) != EOF)
+		call cvaccum (CV(ms, fit_id, spectrum), x,
+		    PARAMETER(ms, param_id, spectrum), wt, WTS_UNIFORM)
+	}
+
+	# Compute and write the fit coeffients to the database.
+
+	spectrum = 0
+	while (get_next_number (spectra, spectrum) != EOF) {
+	    call cvsolve (CV(ms, fit_id, spectrum), ier)
+	    if (ier == NO_DEG_FREEDOM)
+		call error (MS_ERROR, "Error fitting parameters")
+	    call mspfit (ms, fit_id, spectrum)
+	}
+
+	# For each sample line and each selected spectrum replace the
+	# selected parameter value with the fit evaluation.
+
+	do i = 1, MS_NSAMPLES(ms) {
+	    x = LINE(ms, i)
+	    call msgparam (ms, param_id, i)
+
+	    spectrum = 0
+	    while (get_next_number (spectra, spectrum) != EOF)
+		PARAMETER(ms, param_id, spectrum) =
+		    cveval (CV(ms, fit_id, spectrum), x)
+
+	    call mspparm (ms, param_id, i)
+	}
+
+	# Add a comment to the database comments.
+
+	call sprintf (comment, SZ_LINE, "Fit a function to parameter %s.")
+	    call pargstr (NAME(ms, param_id))
+	call history (ms, comment)
+end
diff --git a/noao/twodspec/multispec/t_fitgauss5.x b/noao/twodspec/multispec/t_fitgauss5.x
new file mode 100644
index 00000000..146d37b6
--- /dev/null
+++ b/noao/twodspec/multispec/t_fitgauss5.x
@@ -0,0 +1,209 @@
+include "ms.h"
+
+# T_FIT_GAUSS5 -- Fit the GAUSS5 model.
+#
+# This task selects the database, the sample lines to be modeled, the
+# model fitting algorithm, whether to track models from one sample line
+# to the next or model them independently.
+
+procedure t_fit_gauss5 ()
+
+char	image[SZ_FNAME]			# Image
+int	lines[3, MAX_RANGES]		# Sample lines to be modeled
+bool	track				# Track model solution
+int	start				# Starting line for modeling
+int	naverage			# Number of image lines to average
+real	lower				# Starting point of profile
+real	upper				# Ending point of profile
+
+int	i, nsamples, sample_start, sample, line, improved
+int	len_line, len_profile, nspectra, nparams
+pointer	ms, im
+pointer	sp, data, model, profiles, ranges, samples
+
+int	get_sample_line(), get_sample_lines()
+int	g5_fit1(), g5_fit2()
+int	clgeti(), clgranges(), btoi()
+bool	clgetb()
+real	clgetr()
+pointer	msmap(), immap()
+
+include	"fitgauss5.com"
+
+begin
+	# Access the database and the image.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_WRITE, 0)
+	im = immap (image, READ_ONLY, 0)
+
+	# Get the task parameters.
+	i = clgranges ("lines", 1, MS_LEN(ms, 2), lines, MAX_RANGES)
+	i = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra, MAX_RANGES)
+	track = clgetb ("track")
+	start = clgeti ("start")
+	naverage = clgeti ("naverage")
+	lower = clgetr ("lower")
+	upper = clgetr ("upper")
+	factor = clgetr ("factor")
+
+	# Algorithm 1 fits the parameters selected in the parameters array
+	# simultaneously.  Algorithm 2 does not require the user to specify
+	# the parameters.
+
+	algorithm = clgeti ("algorithm")
+	if (algorithm == 1) {
+	    parameters[I0_INDEX] = btoi (clgetb ("fit_i0"))
+	    parameters[X0_INDEX] = btoi (clgetb ("fit_x0"))
+	    parameters[S0_INDEX] = btoi (clgetb ("fit_s0"))
+	    parameters[S1_INDEX] = btoi (clgetb ("fit_s1"))
+	    parameters[S2_INDEX] = btoi (clgetb ("fit_s2"))
+	}
+
+	# Select whether to smooth the shape parameters after fitting.
+	# If smoothing is desired get the spline smoothing parameters.
+
+	smooth[S0_INDEX] = btoi (clgetb ("smooth_s0"))
+	smooth[S1_INDEX] = btoi (clgetb ("smooth_s1"))
+	smooth[S2_INDEX] = btoi (clgetb ("smooth_s2"))
+	if ((smooth[S0_INDEX] == YES) || (smooth[S1_INDEX] == YES) ||
+	    (smooth[S2_INDEX] == YES)) {
+	    call ms_set_smooth (1., real(MS_LEN(ms, 1)), MS_NSPECTRA(ms))
+	}
+
+	call g5_set_verbose (clgetb ("verbose"))
+	call g5_prnt1 (image, naverage, track, start)
+	    
+	# Set the various array dimensions and allocate memory.
+	len_line = MS_LEN(ms, 1)
+	len_profile = nint (upper - lower + 2)
+	nspectra = MS_NSPECTRA(ms)
+	nparams = MS_NGAUSS5
+	call smark (sp)
+	call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	call salloc (data, len_line, TY_REAL)
+	call salloc (model, len_line, TY_REAL)
+	call salloc (profiles, len_profile * nspectra * nparams, TY_REAL)
+	call salloc (ranges, nspectra * LEN_RANGES, TY_REAL)
+
+	# Convert from image lines to sample lines.
+	nsamples = get_sample_lines (ms, lines, Memi[samples])
+	sample_start = get_sample_line (ms, start)
+
+	# Initialize forward tracking.  If tracking get the initial parameters,
+	# model profiles and model line from the starting line.
+
+	if (track) {
+	    call msggauss5 (ms, sample_start)
+	    call mod_gauss5 (ms, lower, Memr[profiles], Memr[ranges],
+		len_profile, nspectra)
+	    call set_model (ms, Memr[model], Memr[profiles], Memr[ranges],
+		len_line, len_profile, nspectra)
+	}
+
+	# Track forward from the starting line to the specified sample lines.
+
+	do i = 1, nsamples {
+	    sample = Memi[samples + i - 1]
+	    if (sample < sample_start)
+		next
+	    line = LINE(ms, sample)
+
+	    # Get the image data line.
+	    call msgimage (im, line, naverage, Memr[data])
+
+	    # If not tracking get the initial parameters, model profiles, and
+	    # model line for the current line.  Otherwise record the starting
+	    # parameters.
+
+	    if (!track) {
+	        call msggauss5 (ms, sample)
+	        call mod_gauss5 (ms, lower, Memr[profiles], Memr[ranges],
+		    len_profile, nspectra)
+	        call set_model (ms, Memr[model], Memr[profiles], Memr[ranges],
+		    len_line, len_profile, nspectra)
+	    } else
+		call mspgauss5 (ms, sample)
+
+	    call g5_prnt2 (line, Memr[data], len_line)
+
+	    # Do the model fitting using the selected algorithm.
+	    switch (algorithm) {
+	    case 1:
+	        improved = g5_fit1 (ms, Memr[data], Memr[model], Memr[profiles],
+		    Memr[ranges], lower, len_profile)
+	    case 2:
+	        improved = g5_fit2 (ms, Memr[data], Memr[model], Memr[profiles],
+		    Memr[ranges], lower, len_profile)
+	    }
+
+	    # If the new model parameters have improved the fit record them in
+	    # the database.
+	    if (improved == YES)
+		call mspgauss5 (ms, sample)
+	}
+
+	# Initialize backward tracking.  If tracking get the initial parameters,
+	# model profiles and model line from the starting line.
+
+	if (track) {
+	    call msggauss5 (ms, sample_start)
+	    call mod_gauss5 (ms, lower, Memr[profiles], Memr[ranges],
+		len_profile, nspectra)
+	    call set_model (ms, Memr[model], Memr[profiles], Memr[ranges],
+		len_line, len_profile, nspectra)
+	}
+
+	# Track backward from the starting line to the specified sample lines.
+
+	do i = nsamples, 1, -1 {
+	    sample = Memi[samples + i - 1]
+	    if (sample >= sample_start)
+		next
+	    line = LINE(ms, sample)
+
+	    # Get the image data line.
+	    call msgimage (im, line, naverage, Memr[data])
+
+	    # If not tracking get the initial parameters, model profiles, and
+	    # model line for the current line.  Else record the starting
+	    # parameters.
+
+	    if (!track) {
+	        call msggauss5 (ms, sample)
+	        call mod_gauss5 (ms, lower, Memr[profiles], Memr[ranges],
+		    len_profile, nspectra)
+	        call set_model (ms, Memr[model], Memr[profiles], Memr[ranges],
+		    len_line, len_profile, nspectra)
+	    } else
+		call mspgauss5 (ms, sample)
+
+	    call g5_prnt2 (line, Memr[data], len_line)
+
+
+	    # Do the model fitting using the selected algorithm.
+	    switch (algorithm) {
+	    case 1:
+	        improved = g5_fit1 (ms, Memr[data], Memr[model], Memr[profiles],
+		    Memr[ranges], lower, len_profile)
+	    case 2:
+	        improved = g5_fit2 (ms, Memr[data], Memr[model], Memr[profiles],
+		    Memr[ranges], lower, len_profile)
+	    }
+
+	    # If the new model parameters have improved the fit record them in
+	    # the database.
+
+	    if (improved == YES)
+		call mspgauss5 (ms, sample)
+	}
+
+	# Finish up.
+	if ((smooth[S0_INDEX] == YES) || (smooth[S1_INDEX] == YES) ||
+	    (smooth[S2_INDEX] == YES)) {
+	    call ms_free_smooth ()
+	}
+	call imunmap (im)
+	call history (ms, "Fit model")
+	call msunmap (ms)
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/t_modellist.x b/noao/twodspec/multispec/t_modellist.x
new file mode 100644
index 00000000..911ec2ee
--- /dev/null
+++ b/noao/twodspec/multispec/t_modellist.x
@@ -0,0 +1,126 @@
+include	<imhdr.h>
+include "ms.h"
+
+
+# T_MODEL_LIST -- List model values for selected columns and sample lines.
+#
+# The output list format is column, image line, data value, model value.
+# This task differs from t_new_image primarily in that there is no profile
+# interpolation.  The model is evaluated only at the sample lines.  It
+# is used to check the results of the model fitting tasks.
+
+procedure t_model_list ()
+
+# User parameters:
+char	image[SZ_FNAME]			# Image
+int	model_type			# Model type: gauss5, profile
+int	columns[3, MAX_RANGES]		# Columns to be listed
+int	lines[3, MAX_RANGES]		# Sample Lines to be listed
+int	naverage			# Number of image lines to average
+real	lower				# Lower limit of profile model
+real	upper				# Upper limit of profile model
+
+int	i, sample, nsamples, line, column
+pointer	ms, im
+pointer	sp, samples, data, model
+
+int	clgeti(), ms_model_id(), clgranges()
+int	get_next_number(), get_sample_lines
+real	clgetr()
+pointer	msmap(), immap()
+
+begin
+	# Access the database and image.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_ONLY, 0)
+	im = immap (image, READ_ONLY, 0)
+
+	# Get the task parameters.
+	model_type = ms_model_id ("model")
+	i = clgranges ("columns", 1, IM_LEN(im, 1), columns, MAX_RANGES)
+	i = clgranges ("lines", 1, IM_LEN(im, 2), lines, MAX_RANGES)
+	naverage = clgeti ("naverage")
+	lower = clgetr ("lower")
+	upper = clgetr ("upper")
+
+	# Currently only model GAUSS5 is available.
+	if (model_type != GAUSS5)
+	    return
+
+	# Allocate memory for the sample lines, data and model.
+	call smark (sp)
+	call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	call salloc (data, IM_LEN(im, 1), TY_REAL)
+	call salloc (model, IM_LEN(im, 1), TY_REAL)
+
+	# Convert to sample lines.
+	nsamples = get_sample_lines (ms, lines, Memi[samples])
+
+	# For each sample line get the data line and compute a model line.
+	# Print the data and model values for the selected image columns.
+	do i = 1, nsamples {
+	    sample = Memi[samples + i - 1]
+	    line = LINE(ms, sample)
+
+	    call msgimage (im, line, naverage, Memr[data])
+
+	    switch (model_type) {
+	    case GAUSS5:
+	        call gauss5_model (ms, sample, lower, upper, Memr[model])
+	    }
+
+	    column = 0
+	    while (get_next_number (columns, column) != EOF) {
+	        call printf ("%d %d %g %g\n")
+		    call pargi (column)
+		    call pargi (line)
+		    call pargr (Memr[data + column - 1])
+		    call pargr (Memr[model + column - 1])
+	    }
+	}
+
+	call sfree (sp)
+	call imunmap (im)
+	call msunmap (ms)
+end
+
+
+# GAUSS5_MODEL -- Generate a line of the GAUSS5 model.
+
+procedure gauss5_model (ms, line, lower, upper,  model)
+
+pointer	ms			# MULTISPEC data structure
+int	line			# Sample line
+real	lower			# Lower profile limit
+real	upper			# Upper profile limit
+real	model[ARB]		# Model data array to be returned
+
+int	nspectra, nparams, len_line, len_profile
+pointer	sp, profiles, ranges
+
+begin
+	# Set the dimensions of the arrays.
+	nspectra = MS_NSPECTRA(ms)
+	nparams = MS_NGAUSS5
+	len_line = MS_LEN(ms, 1)
+	len_profile = nint (upper - lower + 2)
+
+	# Allocate arrays.
+	call smark (sp)
+	call salloc (ranges, nspectra * LEN_RANGES, TY_REAL)
+	call salloc (profiles, len_profile * nspectra * nparams, TY_REAL)
+
+	# Read the model parameters for the specified sample line.
+	call msggauss5 (ms, line)
+
+	# Calculate the model profiles.
+	call mod_gauss5 (ms, lower, Memr[profiles], Memr[ranges], len_profile,
+	    nspectra)
+
+	# Make a model line using the model profiles.
+	call set_model (ms, model, Memr[profiles], Memr[ranges], len_line,
+	    len_profile, nspectra)
+
+	# Return memory.
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/t_msextract.x b/noao/twodspec/multispec/t_msextract.x
new file mode 100644
index 00000000..da649469
--- /dev/null
+++ b/noao/twodspec/multispec/t_msextract.x
@@ -0,0 +1,112 @@
+include	<imhdr.h>
+include "ms.h"
+
+# T_MSEXTRACT -- General MULTISPEC extraction task.
+#
+# The general task parameters are obtained and the desired extraction
+# procedure is called.  The input database and image are accessed and
+# the output image is created.
+
+procedure t_msextract ()
+
+# User parameters:
+char	image[SZ_FNAME]			# Image
+char	output[SZ_FNAME]		# Output image file
+real	lower				# Lower limit of strip
+real	upper				# Upper limit of strip
+int	spectra[3, MAX_RANGES]		# Spectra to be extracted
+int	lines[3, MAX_RANGES]		# Lines to be extracted
+bool	ex_model			# Extract model or data
+bool	integrated			# Extract integrated spectra?
+bool	unblend				# Correct for spectra blending
+bool	clean				# Correct for bad pixels
+int	nreplace			# Maximum number pixels replaced
+real	sigma_cut			# Threshold for replacing bad pixels
+int	model				# Model type: gauss5, profile
+
+bool	ex_spectra
+int	nlines
+int	nspectra
+pointer	ms, im_in, im_out
+
+int	clgeti(), ms_model_id(), clgranges()
+bool	clgetb()
+real	clgetr()
+pointer	msmap(), immap()
+
+begin
+	# Access input and output files.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_ONLY, 0)
+	im_in = immap (image, READ_ONLY, 0)
+	call clgstr ("output", output, SZ_FNAME)
+	im_out = immap (output, NEW_IMAGE, 0)
+
+	# Determine extraction limits.
+	lower = clgetr ("lower")
+	upper = clgetr ("upper")
+	nlines = clgranges ("lines", 1, IM_LEN(im_in, 2), lines, MAX_RANGES)
+	nspectra = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra,
+	    MAX_RANGES)
+
+	# Determine type of extraction.
+	ex_spectra = TRUE
+	ex_model = clgetb ("ex_model")
+	integrated = clgetb ("integrated")
+
+	# Determine whether to clean data spectra and the cleaning parameters.
+	clean = clgetb ("clean")
+	if (clean) {
+	    nreplace = clgeti ("nreplace")
+	    sigma_cut = clgetr ("sigma_cut")
+	} else
+	    nreplace = 0
+
+	# Determine whether to apply blending correction.
+	if (!ex_model)
+	    unblend = clgetb ("unblend")
+
+	# Set type of model to be used.  If a blending correction is desired
+	# the model must GAUSS5 otherwise the user selects the model.
+	model = NONE
+	if (unblend)
+	    model = GAUSS5
+	else if (ex_model || clean)
+	    model = ms_model_id ("model")
+
+	# Set verbose output.
+	call ex_set_verbose (clgetb ("verbose")) 
+	call ex_prnt1 (MS_IMAGE(ms), output) 
+
+	# Set image header for output extraction image file.
+	IM_NDIM(im_out) = 3
+	if (integrated)
+	    IM_LEN(im_out, 1) = 1
+	else
+	    IM_LEN(im_out, 1) = nint (upper - lower + 1)
+	IM_LEN(im_out, 2) = nlines
+	IM_LEN(im_out, 3) = nspectra
+	IM_PIXTYPE(im_out) = TY_REAL
+	call strcpy (IM_TITLE(im_in), IM_TITLE(im_out), SZ_IMTITLE)
+
+	# Select extraction procedure based on model.
+	switch (model) {
+	case GAUSS5:
+	    call set_fit_and_clean (clgeti ("niterate"), nreplace, sigma_cut,
+		clgeti ("fit_type"), ex_model)
+	    call ex_gauss5 (ms, im_in, im_out, spectra, lines, lower, upper,
+		ex_spectra, ex_model, integrated)
+	case SMOOTH:
+	    call set_fit_smooth (nreplace, sigma_cut)
+	    call ex_smooth (ms, im_in, im_out, spectra, lines, lower, upper,
+		ex_spectra, ex_model, integrated)
+	default:
+	    call ex_strip (ms, im_in, im_out, spectra, lines, lower, upper,
+		ex_spectra, ex_model, integrated)
+	}
+
+	# Close files.
+	call imunmap (im_in)
+	call imunmap (im_out)
+	call msunmap (ms)
+end
diff --git a/noao/twodspec/multispec/t_mslist.x b/noao/twodspec/multispec/t_mslist.x
new file mode 100644
index 00000000..e21d685e
--- /dev/null
+++ b/noao/twodspec/multispec/t_mslist.x
@@ -0,0 +1,312 @@
+include <fset.h>
+include "ms.h"
+
+# T_MS_LIST -- Print general MULTISPEC database information.
+
+procedure t_ms_list ()
+
+char	image[SZ_FNAME]
+char	keyword[SZ_LINE]
+bool	titles
+
+int	ms_id
+pointer	ms
+
+bool	clgetb(), streq()
+int	ms_db_id()
+pointer	msmap()
+
+begin
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Get task parameters.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_ONLY, 0)
+	call clgstr ("keyword", keyword, SZ_LINE)
+	titles = clgetb ("titles")
+
+	# Check for special keywords.
+	if (streq (keyword, "gauss5")) {
+	    call g5_list (ms, keyword, titles)
+
+	# Keyword is one of the database record names.  Convert to a
+	# MULTISPEC id and switch to appropriate listing routine.
+	} else {
+	    ms_id = ms_db_id (ms, keyword)
+	    switch (ms_id) {
+	    case HDR:
+	        call hdr_list (ms, keyword, titles)
+	    case COMMENTS:
+	        call com_list (ms, keyword, titles)
+	    case SAMPLE:
+		call sam_list (ms, keyword, titles)
+	    case I0, X0, S0, S1, S2:
+	        call par_list (ms, ms_id, keyword, titles)
+	    case X0_FIT, S0_FIT, S1_FIT, S2_FIT:
+	        call fit_list(ms, ms_id, keyword, titles)
+	    }
+	}
+
+	call msunmap (ms)
+end
+
+
+# HDR_LIST - List the contents of the MULTISPEC database header
+
+procedure hdr_list (ms, keyword, titles)
+
+pointer	ms					# MULTISPEC data structure
+char	keyword[ARB]				# List keyword
+bool	titles					# Print titles?
+
+begin
+	call printf ("Image: %s\n")
+	    call pargstr (MS_IMAGE(ms))
+	call printf ("Keyword:  %s\n")
+	    call pargstr (keyword)
+	call printf ("Title: %s\n")
+	    call pargstr (MS_TITLE(ms))
+	call printf ("Number of spectra: %d\n")
+	    call pargi (MS_NSPECTRA(ms))
+	call printf ("Number of sample image lines: %d\n")
+	    call pargi (MS_NSAMPLES(ms))
+	call printf ("Image size: %d x %d\n")
+	    call pargi (MS_LEN(ms, 1))
+	    call pargi (MS_LEN(ms, 2))
+end
+
+procedure com_list (ms, keyword, titles)
+
+pointer	ms					# MULTISPEC data structure
+char	keyword[ARB]				# List keyword
+bool	titles					# Print titles?
+int	i
+
+begin
+	if (titles) {
+	    call printf ("Image: %s\n")
+		call pargstr (MS_IMAGE(ms))
+	    call printf ("Keyword:  %s\n")
+		call pargstr (keyword)
+	    call printf ("Comments:\n")
+	}
+
+	for (i=1; (i <= SZ_MS_COMMENTS) && (COMMENT(ms, i) != EOS); i=i+1)
+	    call putchar (COMMENT(ms, i))
+end
+
+
+# SAM_LIST -- List the sample image lines.
+
+procedure sam_list (ms, keyword, titles)
+
+pointer	ms					# MULTISPEC data structure
+char	keyword[ARB]				# List keyword
+bool	titles					# Print titles?
+int	i
+
+begin
+	if (titles) {
+	    call printf ("Image: %s\n")
+		call pargstr (MS_IMAGE(ms))
+	    call printf ("Keyword:  %s\n")
+		call pargstr (keyword)
+	    call printf ("Sample Image Lines:\n")
+	}
+
+	do i = 1, MS_NSAMPLES(ms) {
+	    call printf ("%8d\n")
+		call pargi (LINE(ms, i))
+	}
+end
+
+
+# PAR_LIST -- Print MULTISPEC profile parameters.
+#
+# This procedure does some CLIO.
+
+procedure par_list (ms, ms_id, keyword, titles)
+
+pointer	ms					# MULTISPEC data structure
+int	ms_id					# MULTISPEC parameter id
+char	keyword[ARB]				# List keyword
+bool	titles					# Print titles?
+
+int	lines[3, MAX_RANGES], spectra[3, MAX_RANGES]
+int	i, nsamples, sample, spectrum
+pointer	sp, samples
+
+int	clgranges(), get_next_number(), get_sample_lines()
+
+begin
+	if ((MS_NSAMPLES(ms) == 0) || (MS_NSPECTRA(ms) == 0))
+	    return
+
+	# Get desired image lines and spectra to be listed.
+	i = clgranges ("lines", 1, MS_LEN(ms, 2), lines, MAX_RANGES)
+	i = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra, MAX_RANGES)
+
+	# Convert image lines to sample lines.
+	call smark (sp)
+	call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	nsamples = get_sample_lines (ms, lines, Memi[samples])
+
+	# Print header titles if needed.
+	if (titles) {
+	    call printf ("Image: %s\n")
+		call pargstr (MS_IMAGE(ms))
+	    call printf ("Keyword:  %s\n")
+		call pargstr (keyword)
+	    call printf ("%8s %8s %8s\n")
+		call pargstr ("Line")
+		call pargstr ("Spectrum")
+		call pargstr (NAME(ms, ms_id))
+	}
+
+	# For each sample line get the parameter values for the selected
+	# parameter and list those for the selected spectra.
+	do i = 1, nsamples {
+	    sample = Memi[samples + i - 1]
+
+	    call msgparam (ms, ms_id, sample)
+
+	    spectrum = 0
+	    while (get_next_number (spectra, spectrum) != EOF) {
+		call printf ("%8d %8d %8.3g\n")
+		    call pargi (LINE(ms, sample))
+		    call pargi (spectrum)
+		    call pargr (PARAMETER(ms, ms_id, spectrum))
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# FIT_LIST -- Print MULTISPEC fit.
+#
+# This procedure does CLIO.
+
+procedure fit_list (ms, ms_id, keyword, titles)
+
+pointer	ms					# MULTISPEC data structure
+int	ms_id					# MULTISPEC parameter id
+char	keyword[ARB]				# List keyword
+bool	titles					# Print header titles?
+
+int	lines[3, MAX_RANGES]
+int	spectra[3, MAX_RANGES]
+
+int	i, line, spectrum
+
+real	cveval()
+int	clgranges(), get_next_number()
+
+begin
+	if (MS_NSPECTRA(ms) == 0)
+	    return
+
+	# Get the image lines at which to evaluate the function and
+	# the spectra to be listed.
+
+	i = clgranges ("lines", 1, MS_LEN(ms, 2), lines, MAX_RANGES)
+	i = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra, MAX_RANGES)
+
+	# Get the fits.
+	call msgfits (ms, ms_id)
+
+	# Print header titles if needed.
+	if (titles) {
+	    call printf ("Image: %s\n")
+		call pargstr (MS_IMAGE(ms))
+	    call printf ("Keyword:  %s\n")
+		call pargstr (keyword)
+	    call printf ("%8s %8s %8s\n")
+		call pargstr ("Line")
+		call pargstr ("Spectrum")
+		call pargstr (NAME(ms, ms_id))
+	}
+
+	# For each selected image line evalute the functions for the
+	# selected spectra and print the values.
+
+	line = 0
+	while (get_next_number (lines, line) != EOF) {
+	    spectrum = 0
+	    while (get_next_number (spectra, spectrum) != EOF) {
+		call printf ("%8d %8d %8.3g\n")
+		    call pargi (line)
+		    call pargi (spectrum)
+		    call pargr (cveval (CV(ms, ms_id, spectrum), real (line)))
+	    }
+	}
+end
+
+
+# G5_LIST -- Print MULTISPEC model gauss5 profile parameters.
+#
+# This procedure does CLIO.
+
+procedure g5_list (ms, keyword, titles)
+
+pointer	ms					# MULTISPEC data structure
+char	keyword[ARB]				# List keyword
+bool	titles					# Print header titles?
+
+int	lines[3, MAX_RANGES], spectra[3, MAX_RANGES]
+int	i, nsamples, sample, spectrum
+pointer	sp, samples
+
+int	clgranges(), get_next_number(), get_sample_lines()
+
+begin
+	if ((MS_NSAMPLES(ms) == 0) || (MS_NSPECTRA(ms) == 0))
+	    return
+
+	# Get desired image lines and spectra to be listed.
+	i = clgranges ("lines", 1, MS_LEN(ms, 2), lines, MAX_RANGES)
+	i = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra, MAX_RANGES)
+
+	# Convert image lines to sample lines.
+	call smark (sp)
+	call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	nsamples = get_sample_lines (ms, lines, Memi[samples])
+
+	# Print header titles if needed.
+	if (titles) {
+	    call printf ("Image: %s\n")
+		call pargstr (MS_IMAGE(ms))
+	    call printf ("Keyword:  %s\n")
+		call pargstr (keyword)
+	    call printf ("%8s %8s %8s %8s %8s %8s %8s\n")
+		call pargstr ("Line")
+		call pargstr ("Spectrum")
+		call pargstr (NAME (ms, X0))
+		call pargstr (NAME (ms, I0))
+		call pargstr (NAME (ms, S0))
+		call pargstr (NAME (ms, S1))
+		call pargstr (NAME (ms, S2))
+	}
+
+	# For each sample line get the GAUSS5 values and list for the
+	# selected spectra.
+	do i = 1, nsamples {
+	    sample = Memi[samples + i - 1]
+
+	    call msggauss5 (ms, sample)
+
+	    spectrum = 0
+	    while (get_next_number (spectra, spectrum) != EOF) {
+		call printf ("%8d %8d %8.3g %8.3g %8.3g %8.3g %8.3g\n")
+		    call pargi (LINE(ms, sample))
+		    call pargi (spectrum)
+		    call pargr (PARAMETER(ms, X0, spectrum))
+		    call pargr (PARAMETER(ms, I0, spectrum))
+		    call pargr (PARAMETER(ms, S0, spectrum))
+		    call pargr (PARAMETER(ms, S1, spectrum))
+		    call pargr (PARAMETER(ms, S2, spectrum))
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/twodspec/multispec/t_msset.x b/noao/twodspec/multispec/t_msset.x
new file mode 100644
index 00000000..81d94f0c
--- /dev/null
+++ b/noao/twodspec/multispec/t_msset.x
@@ -0,0 +1,189 @@
+include "ms.h"
+
+# T_MS_SET -- Set profile parameters in database.
+
+procedure t_ms_set ()
+
+char	image[SZ_FNAME]
+char	keyword[SZ_LINE]
+
+char	comment[SZ_LINE]
+int	i, nspectra, ms_id
+pointer	ms
+
+bool	streq(), clgetb()
+int	clscan(), nscan(), ms_db_id()
+pointer	msmap()
+
+begin
+	# Get the task parameters and access the database.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_WRITE, 0)
+	call clgstr ("keyword", keyword, SZ_LINE)
+
+	# Decode the keyword for the desired database quantity.
+	if (streq (keyword, "nspectra")) {
+	    # Set the value of MS_NSPECTRA in the MULTISPEC header record.
+	    if (clgetb ("read_list"))
+		i = clscan ("list")
+	    else
+	        i = clscan ("value") 
+	    call gargi (nspectra)
+	    if (nscan () != 1)
+		call error (MS_ERROR, "Bad parameter value")
+
+	    # It is an error to attempt to change the value previously set.
+	    if (MS_NSPECTRA(ms) == 0)
+	        MS_NSPECTRA(ms) = nspectra
+	    else if (MS_NSPECTRA(ms) != nspectra)
+	        call error (MS_ERROR, "Attempt to change number of spectra")
+	} else {
+	    # Keyword is one of the database record names.  Convert to
+	    # a MULTISPEC parameter ID and call the appropriate procedure.
+
+	    ms_id = ms_db_id (ms, keyword)
+	    switch (ms_id) {
+	    case COMMENTS:
+	        call com_set (ms, comment)
+	    case I0, X0, S0, S1, S2:
+	        call par_set (ms, ms_id, comment)
+	    }
+	}
+
+	# Finish up.
+	call msphdr (ms)
+	call msunmap (ms)
+end
+
+
+# COM_SET -- Add a comment to the MULTISPEC database comment block.
+#
+# This procedure does CLIO.
+
+procedure com_set (ms, comment)
+
+pointer	ms				# MULTISPEC data structure
+char	comment[SZ_LINE]		# Input comment buffer.
+
+int	i
+
+bool	clgetb()
+int	clscan()
+
+begin
+	# Desire whether to use list input or CL parameter input.
+	if (clgetb ("read_list")) {
+	    # Read a list of comment strings.
+	    while (clscan ("list") != EOF) {
+	        call gargstr (comment, SZ_LINE)
+	        call history (ms, comment)
+	    }
+	} else {
+	    # Read a comment line from the parameter "value".
+	    i = clscan ("value")
+	    call gargstr (comment, SZ_LINE)
+	    call history (ms, comment)
+	}
+end
+
+
+# PAR_SET -- Set the values of the model parameters.
+#
+# This procedure does CLIO.
+
+procedure par_set (ms, ms_id, comment)
+
+pointer	ms			# MULTISPEC data structure
+int	ms_id			# MULTISPEC ID
+char	comment[SZ_LINE]	# Comment buffer
+
+int	i, line, nsamples, sample, last_sample, spectrum
+int	lines[3, MAX_RANGES], spectra[3, MAX_RANGES]
+real	value
+pointer	sp, samples
+
+int	clscan(), nscan(), clgranges(), get_next_number()
+int	get_sample_line(), get_sample_lines()
+bool	dbaccess(), clgetb()
+
+begin
+	if ((MS_NSAMPLES(ms) == 0) || (MS_NSPECTRA(ms) == 0))
+	    return
+
+	# Enter the parameter in the database if necessary.
+	if (!dbaccess (MS_DB(ms), NAME(ms, ms_id)))
+	    call dbenter (MS_DB(ms), NAME(ms, ms_id),
+		MS_NSPECTRA(ms) * SZ_REAL, MS_NSAMPLES(ms))
+
+	# Determine input source.
+	if (clgetb ("read_list")) {
+	    # Read values from a list.
+	    last_sample = 0
+	    while (clscan ("list") != EOF) {
+
+		# Get line, spectrum, and value from the list.
+	        call gargi (line)
+	        call gargi (spectrum)
+	        call gargr (value)
+
+		# Check that the data is valid otherwise go to next input.
+	        if (nscan () != 3)
+		    next
+	        if ((spectrum < 1) || (spectrum > MS_NSPECTRA(ms)))
+		    next
+
+		# If the last sample is not the same as the previous sample
+		# flush the last parameter values if the last sample is not
+		# zero and get the next line of parameter values.
+
+		sample = get_sample_line (ms, line)
+	        if (sample != last_sample) {
+		    if (last_sample != 0)
+		        call mspparam (ms, ms_id, last_sample)
+	            call msgparam (ms, ms_id, sample)
+		    last_sample = sample
+	        }
+
+		# Set the parameter value.
+	        PARAMETER(ms, ms_id, spectrum) = value
+	    }
+
+	    # Flush the last line of parameter values.
+	    call mspparam (ms, ms_id, last_sample)
+
+	} else {
+	    # Set the parameter values for the selected lines and spectra
+	    # to the CL parameter "value".
+
+	    i = clgranges ("lines", 1, MS_LEN(ms, 2), lines, MAX_RANGES)
+	    i = clgranges ("spectra", 1, MS_NSPECTRA(ms), spectra, MAX_RANGES)
+	    i = clscan ("value")
+
+	    # Convert the image lines to sample lines.
+	    call smark (sp)
+	    call salloc (samples, MS_NSAMPLES(ms), TY_INT)
+	    nsamples = get_sample_lines (ms, lines, Memi[samples])
+
+	    # Check that the parameter value is a real number.
+	    call gargr (value)
+	    if (nscan () != 1)
+		call error (MS_ERROR, "Bad parameter value")
+
+	    # Go through the selected sample lines and spectra setting the
+	    # parameter value.
+
+	    do i = 1, nsamples {
+		sample = Memi[samples + i - 1]
+		call msgparam (ms, ms_id, sample)
+		spectrum = 0
+		while (get_next_number (spectra, spectrum) != EOF)
+		    PARAMETER (ms, ms_id, spectrum) = value
+		call mspparam (ms, ms_id, sample)
+	    }
+	}
+		
+	# Add a history comment.
+	call sprintf (comment, SZ_LINE, "Values of parameter %s set.")
+	    call pargstr (NAME(ms, ms_id))
+	call history (ms, comment)
+end
diff --git a/noao/twodspec/multispec/t_newextract.x b/noao/twodspec/multispec/t_newextract.x
new file mode 100644
index 00000000..0e695222
--- /dev/null
+++ b/noao/twodspec/multispec/t_newextract.x
@@ -0,0 +1,99 @@
+include <imhdr.h>
+include "ms.h"
+
+# T_NEW_EXTRACTION -- Create a new extraction database.
+#
+# This is the first step in using the MULTISPEC package.  The new database
+# may be created from scratch or intialized from an template image.
+
+procedure t_new_extraction ()
+
+# Task parameters:
+char	image[SZ_FNAME]			# Multi-spectra image
+char	template[SZ_FNAME]		# Template image
+int	samples[3, MAX_RANGES]		# Sample line range array
+
+char	comment[SZ_LINE]
+char	database[SZ_FNAME], old_database[SZ_FNAME]
+pointer	im, ms
+
+bool	strne()
+int	clgranges(), expand_ranges()
+pointer	immap(), msmap()
+
+begin
+	# Get database and image name.  Map the image and check that
+	# it is two dimensional.
+	call clgstr ("image", image, SZ_FNAME)
+	im = immap (image, READ_ONLY, 0)
+	if (IM_NDIM(im) != 2)
+	    call error (MS_ERROR, "Image file must be two dimensional.")
+
+	# Get the template image name.
+	call clgstr ("template", template, SZ_FNAME)
+
+	if (strne (template, "")) {
+	    # If a template is given then map the template and check
+	    # that the new image dimensions agree with the old dimensions.
+
+	    ms = msmap (template, READ_ONLY, 0)
+	    if ((MS_LEN(ms, 1) != IM_LEN(im, 1)) ||
+		(MS_LEN(ms, 2) != IM_LEN(im, 2)))
+		call error (MS_ERROR,
+		    "New image size does not agree with the old image size.")
+	    call msunmap (ms)
+
+	    # Copy the old database.  Map the new database and clear the
+	    # the old comments before adding a new comment.
+
+	    call sprintf (database, SZ_FNAME, "%s.db")
+		call pargstr (image)
+	    call sprintf (old_database, SZ_FNAME, "%s.db")
+		call pargstr (template)
+	    call fcopy (old_database, database)
+
+	    ms = msmap (image, READ_WRITE, 0)
+	    COMMENT(ms, 1) = EOS
+	    call sprintf (comment, SZ_LINE,
+		"Database initialized from the template image %s.")
+		call pargstr (template)
+	    call history (ms, comment)
+
+	} else {
+	    # For a new database initialize the  header parameters.
+	    ms = msmap (image, NEW_FILE, MS_DB_ENTRIES)
+	    MS_LEN(ms, 1) = IM_LEN(im, 1)
+	    MS_LEN(ms, 2) = IM_LEN(im, 2)
+	    MS_NSPECTRA(ms) = 0
+
+	    # Get the sample line ranges and set the number of sample lines
+	    # in the database header.
+	    MS_NSAMPLES(ms) = clgranges ("sample_lines", 1, MS_LEN (ms, 2),
+		samples, MAX_RANGES)
+
+	    # Make an entry in the database for the sample lines and then
+	    # access the entry in order to allocate memory for the sample
+	    # line array.
+	    call dbenter (MS_DB(ms), NAME(ms, SAMPLE), MS_NSAMPLES(ms)*SZ_INT,1)
+	    call msgsample (ms)
+
+	    # Expand the sample line range array into the sample line array.
+	    # Then put the sample line array in the database.
+	    MS_NSAMPLES(ms) = expand_ranges (samples, LINE(ms, 1),
+		MS_NSAMPLES(ms))
+	    call mspsample (ms)
+
+	    # Add a history line.
+	    call history (ms, "New MULTISPEC database created.")
+	}
+
+	# Set the image name and image title in the database.
+	call strcpy (image, MS_IMAGE(ms), SZ_MS_IMAGE)
+	call strcpy (IM_TITLE(im), MS_TITLE(ms), SZ_MS_TITLE)
+
+	# Close image and database.  Write the database header record before
+	# closing the database.
+	call imunmap (im)
+	call msphdr (ms)
+	call msunmap (ms)
+end
diff --git a/noao/twodspec/multispec/t_newimage.x b/noao/twodspec/multispec/t_newimage.x
new file mode 100644
index 00000000..c74ce22a
--- /dev/null
+++ b/noao/twodspec/multispec/t_newimage.x
@@ -0,0 +1,97 @@
+include	<imhdr.h>
+include "ms.h"
+
+# T_NEW_IMAGE -- General MULTISPEC extraction task.
+#
+# The general task parameters are obtained and the desired extraction
+# procedure is called.  The input database and image are accessed and
+# the output image is created.
+
+procedure t_new_image ()
+
+# User parameters:
+char	image[SZ_FNAME]			# MULTISPEC database
+char	output[SZ_FNAME]		# Output image file
+real	lower				# Lower limit of strip
+real	upper				# Upper limit of strip
+int	lines[3, MAX_RANGES]		# Lines to be extracted
+int	spectra[3, MAX_RANGES]		# Spectra to be extracted
+bool	ex_model			# Extract model or data
+bool	clean				# Correct for bad pixels
+int	nreplace			# Maximum number of bad pixels replaced
+real	sigma_cut			# Threshold for replacing bad pixels
+int	model				# Model type: gauss5, profile
+
+bool	ex_spectra			# Extract spectra or image line
+bool	integrated			# Extract integrated spectra or strip
+int	nlines
+pointer	ms, im_in, im_out
+
+int	clgeti(), ms_model_id(), clgranges()
+bool	clgetb()
+real	clgetr()
+pointer	msmap(), immap()
+
+begin
+	# Access input and output files.
+	call clgstr ("image", image, SZ_FNAME)
+	ms = msmap (image, READ_ONLY, 0)
+	im_in = immap (image, READ_ONLY, 0)
+	call clgstr ("output", output, SZ_FNAME)
+	im_out = immap (output, NEW_IMAGE, 0)
+
+	# Determine extraction limits.
+	nlines = clgranges ("lines", 1, IM_LEN(im_in, 2), lines, MAX_RANGES)
+	lower = clgetr ("lower")
+	upper = clgetr ("upper")
+
+	# Determine type of extraction.
+	ex_spectra = FALSE
+	ex_model = clgetb ("ex_model")
+	integrated = FALSE
+
+	# Determine whether to clean data lines and the cleaning parameters.
+	clean = clgetb ("clean")
+	if (clean) {
+	    nreplace = clgeti ("nreplace")
+	    sigma_cut = clgetr ("sigma_cut")
+	} else
+	    nreplace = 0
+
+	# Set type of model to be used.
+	model = NONE
+	if (ex_model || clean)
+	    model = ms_model_id ("model")
+
+	# Set verbose output.
+	call ex_set_verbose (clgetb ("verbose"))
+	call ex_prnt1 (image, output)
+
+	# Set image header for output extraction image file.
+	IM_NDIM(im_out) = IM_NDIM(im_in)
+	IM_LEN(im_out, 1) = IM_LEN(im_in, 1)
+	IM_LEN(im_out, 2) = nlines
+	IM_PIXTYPE(im_out) = IM_PIXTYPE(im_in)
+	call strcpy (IM_TITLE(im_in), IM_TITLE(im_out), SZ_IMTITLE)
+
+	# Select extraction procedure based on model.
+	switch (model) {
+	case GAUSS5:
+	    call set_fit_and_clean (clgeti ("niterate"), nreplace,
+		sigma_cut, clgeti ("fit_type"), ex_model)
+	    call ex_gauss5 (ms, im_in, im_out, spectra, lines, lower, upper,
+		ex_spectra, ex_model, integrated)
+	case SMOOTH:
+	    call set_fit_smooth (nreplace, sigma_cut)
+	    call ex_smooth (ms, im_in, im_out, spectra, lines, lower, upper,
+		ex_spectra, ex_model, integrated)
+	default:
+	    call ex_strip (ms, im_in, im_out, spectra, lines, lower, upper,
+		ex_spectra, ex_model, integrated)
+	}
+
+	# Close files.
+	call imunmap (im_in)
+	call imunmap (im_out)
+	call msunmap (ms)
+end
diff --git a/noao/twodspec/multispec/unblend.x b/noao/twodspec/multispec/unblend.x
new file mode 100644
index 00000000..707c6b49
--- /dev/null
+++ b/noao/twodspec/multispec/unblend.x
@@ -0,0 +1,38 @@
+include	"ms.h"
+
+# UNBLEND -- Create unblended data profiles from a blended data line.
+#
+# For each point in each spectrum profile determine the corresponding column
+# in the data line from the ranges array.  If the model is non-zero then the
+# data profile value for that spectrum is a fraction of the total data value
+# at that point given by the fraction of that model profile to the total
+# model at that point.
+
+procedure unblend (data, data_profiles, model, model_profiles, ranges,
+    len_line, len_profile, nspectra)
+
+real	data[len_line]				# Data line to be unblended
+real	data_profiles[len_profile, nspectra]	# Output data profiles
+real	model[len_line]				# Model line
+real	model_profiles[len_profile, nspectra]	# Model profiles
+real	ranges[nspectra, LEN_RANGES]		# Ranges for model profiles
+int	len_line				# Length of data/model line
+int	len_profile				# Length of each profile
+int	nspectra				# Number of spectra
+
+int	i, x, spectrum
+
+begin
+	do spectrum = 1, nspectra {
+	    do i = 1, len_profile {
+		x = ranges[spectrum, X_START] + i - 1
+		if ((x >= 1) && (x <= len_line)) {
+		    if (model[x] > 0.)
+		        data_profiles[i, spectrum] =
+		            data[x] * model_profiles[i, spectrum] / model[x]
+		    else
+		        data_profiles[i, spectrum] = data[x]
+	        }
+	    }
+	}
+end
diff --git a/noao/twodspec/multispec/x_multispec.x b/noao/twodspec/multispec/x_multispec.x
new file mode 100644
index 00000000..accdb148
--- /dev/null
+++ b/noao/twodspec/multispec/x_multispec.x
@@ -0,0 +1,10 @@
+task	newextraction	= t_new_extraction,
+	findpeaks	= t_find_peaks,
+	mslist		= t_ms_list,
+	msset		= t_ms_set,
+	fitfunction	= t_fit_function,
+	modellist	= t_model_list,
+	fitgauss5	= t_fit_gauss5,
+	msextract	= t_msextract,
+	newimage	= t_new_image,
+	msplot
diff --git a/noao/twodspec/twodspec.cl b/noao/twodspec/twodspec.cl
new file mode 100644
index 00000000..bfdf4c67
--- /dev/null
+++ b/noao/twodspec/twodspec.cl
@@ -0,0 +1,13 @@
+#{ TWODSPEC -- Two dimensional spectra reduction package.
+
+set	apextract	= "twodspec$apextract/"
+set	longslit	= "twodspec$longslit/"
+set	multispec 	= "twodspec$multispec/"
+
+package twodspec
+
+task	apextract.pkg	= apextract$apextract.cl
+task	longslit.pkg	= longslit$longslit.cl
+#task	multispec.pkg	= multispec$multispec.cl
+
+clbye
diff --git a/noao/twodspec/twodspec.hd b/noao/twodspec/twodspec.hd
new file mode 100644
index 00000000..80bdd07b
--- /dev/null
+++ b/noao/twodspec/twodspec.hd
@@ -0,0 +1,22 @@
+# Help directory for the TWODSPEC package.
+
+$apextract	= "noao$twodspec/apextract/"
+$longslit	= "noao$twodspec/longslit/"
+$multispec	= "noao$twodspec/multispec/"
+
+apextract	men=apextract$apextract.men,
+		hlp=..,
+		sys=apextract$doc/apextract.ms,
+		pkg=apextract$apextract.hd,
+		src=apextract$apextract.cl
+
+longslit	men=longslit$longslit.men,
+		hlp=..,
+		pkg=longslit$longslit.hd,
+		src=longslit$longslit.cl
+
+#multispec	men=multispec$multispec.men,
+#		hlp=..,
+#		sys=multispec$multispec.hlp,
+#		pkg=multispec$multispec.hd,
+#		src=multispec$multispec.cl
diff --git a/noao/twodspec/twodspec.men b/noao/twodspec/twodspec.men
new file mode 100644
index 00000000..d4221efc
--- /dev/null
+++ b/noao/twodspec/twodspec.men
@@ -0,0 +1,2 @@
+      apextract - Aperture Extraction Package
+       longslit - Longslit Package
diff --git a/noao/twodspec/twodspec.par b/noao/twodspec/twodspec.par
new file mode 100644
index 00000000..a29d0304
--- /dev/null
+++ b/noao/twodspec/twodspec.par
@@ -0,0 +1,3 @@
+# TWODSPEC Package parameter file.
+
+version,s,h,"March 1986"