519 files changed, 131524 insertions, 0 deletions

diff --git a/noao/onedspec/Revisions b/noao/onedspec/Revisions
new file mode 100644
index 00000000..6da71399
--- /dev/null
+++ b/noao/onedspec/Revisions
@@ -0,0 +1,5321 @@
+.help revisions Jun88 noao.onedspec
+.nf
+
+splot/eqwidthcp.x
+    The 'sg' and 'lg' pointers were allocated as TY_REAL and re-allocated
+    as TY_INT (5/4/13)
+
+splot/anshdr.x
+    Added a F_FLUSHNL flag to the logfile descriptors to flush the 
+    data as it is written (5/12/12, MJF)
+
+splot/spdeblend.x
+    Added overplotting of individual components.  (12/5/11, Valdes)
+
+====
+2.16
+====
+
+hireswcal.cl
+    A script I wrote for Simon Schuler to apply the wavelength calibrations
+    that he got for hires spectra from Geoff Marcy.  This is put here for
+    safe keeping.  (11/16/11, Valdes)
+
+t_deredden.x
+    There was a small error in coding the formulae of Cardelli, et al.
+    (6/28/11, Valdes)
+
+splot/spdeblend.x
+    An integer allocated array was being freed as a real array causing
+    an error with deblending on 64-bit systems.  (6/6/11, Valdes)
+
+=======
+2.15.1a
+=======
+
+======
+2.15.1
+======
+
+scombine/icgdata.x
+    This code uses the SX array to pass in mask values.  The code, taken from
+    an old version of imcombine, treats the mask array as integers.  All the
+    dereferencing of this mask array were changed to reals.
+
+scombine/t_scombine.x
+    The SX pointer (allocated as real) was being used in a Memi, causing
+    a segfault on some 64-bit systems (4/3/11/, MJF)
+
+specplot.h
+    Fixed improper use of P2R in macro. (3/31/11, MJF)
+
+continuum.par
+odcombine.par
+sfit.par
+splot.par
+    The prompt strings which said the "grow" parameter is in pixels were
+    changed to remove this.  The grow parameter is in user coordinate units.
+    (6/28/10, Valdes)
+
+=======
+V2.14.1
+=======
+
+t_specplot.x
+specplot.par
+doc/specplot.hlp
+    Added a new "transform" parameter to allow scaling the spectrum pixel
+    values.  Currently on "log" is implemented.  (1/5/09, Valdes)
+
+doc/splot.hlp
+    The description of the 'e' key incorrectly said a core flux is
+    output.  (8/22/08, Valdes)
+
+dispcor.par
+    Changed "Conserve flux" to "Conserve total flux" per user request.
+    (6/13/08)
+
+rspectext.cl
+    Added "addonly" values to all hedit commands.  (4/1/08, Valdes)
+
+odcombine/t_odcombine.x
+    Fixed some procedure calls being closed with a ']' instead of a ')'
+    (2/17/08, MJF)
+
+ecidentify/eclinelist.x
+    A check is made that the second closest match has a match distance
+    more that 25% greater than the nearest match.  (12/10/07, Valdes)
+
+t_dopcor.x
+    For clarity when the velocity applied is in km/s this is used in the
+    log and in DOPCORn keywords.  (12/10/07, Valdes)
+
+=====
+V2.14
+=====
+
+doc/standard.hlp
+    Clarified the equations and formating.  There was an inconsistency
+    between the Vega flux and magnitude given in the text.  Either value
+    could be changed but the old version of this task was based on the
+    specified Vega flux so the magnitude was changes (0.048-0.0336)
+    to make the description consistent.  (4/3/07, Valdes)
+
+splot/wrspect.x
+    For log sampled data (dc-flag=1) that also has a ltv offset the
+    new WCS for the output was wrong.  (12/4/06, Valdes)
+
+smw/shdr.x
+    The shdr_rebin procedure was rebinning the target spectrum to its natural
+    units while the reference spectrum might be in different units.  The
+    correct thing to do is rebin in the reference units.  (10/27/06, Valdes)
+
+
+=======
+V2.12.3
+=======
+
+splot/splot.x
+    Needed to initialize the aperture so that the aperture selection
+    behavior is consistent when calling splot more than once.  (5/16/06, Valdes)
+
+doc/specplot.hlp
+    Added a quick example illustrating using batch mode plotting.
+    (5/2/05, Valdes)
+
+t_specplot.x
+    To support cursor file input without including the x, y, wcs fields
+    the call to sp_nearest was modified to avoid floating exceptions.
+    (5/2/05, Valdes)
+
+t_sarith.x
+    Error handling was improved for onedspec output.  When no pixels
+    were selected by using w1/w2 the warning was reported but then
+    a segmentation error would occur when trying to close the output
+    image.  (3/8/05, Valdes)
+
+t_tweak.x
+doc/telluric.hlp
+    The normalization used is now printed.  (1/12/05, Valdes)
+
+t_dopcor.x
+doc/dopcor.hlp
+    A keyword is added to log the operation.  (10/29/04, Valdes)
+
+t_deredden.x
+    Adjusted the error reporting to print the warning before closing and
+    deleting the output image.  (9/27/04, Valdes)
+
+ecidentify/ecfitdata.x
+    The EC_FITPT routine used the wrong pointer for the physical to logical
+    coordinate conversion.  (9/10/04, Valdes)
+
+odcombine/		+
+doc/odcombine.hlp	+
+x_onedspec.x
+onedspec.cl
+onedspec.men
+onedspec.hd
+mkpkg
+    Added a new task ODCOMBINE which is layered more directly on the
+    source for IMCOMBINE.  This version supports bad pixel masks as well
+    as most of the new features of IMCOMBINE.  (6/21/04, Valdes)
+
+scombine/x_scombine.x	+
+scombine/mkpkg
+onedspec.cl
+mkpkg
+    Packaged SCOMBINE as its own executable noaobin$x_scombine.e.
+    (6/21/04, Valdes)
+
+t_standard.x
+    In case someone puts the query parameter "star_name" on the command
+    line and the calibration cannot be found the task will not only try
+    twice before aborting rather than go into an infinite loop.
+    (5/21/04, Valdes)
+
+dispcor/t_dispcor.x
+dispcor/dispcor.x
+dispcor.par
+doc/dispcor.hlp
+    Added the new parameter "blank" to control the output values when there
+    are no input values; i.e. the out of bounds values.  (5/18/04, Valdes)
+
+dispcor/t_discpor.x
+    For 2D spectra the "global" option was not working.  (5/14/04, Valdes)
+
+scombine/t_scombine.x
+    A check for the input format was added.  If the input is 2D spectra
+    then a format error is printed.  (5/14/04, Valdes)
+
+identify/autoid/autoid.x
+    Changed "AID_NT(aid) = min (2 * AID_NR(aid), AID_NTF(aid))" to
+    "AID_NT(aid) = AID_NTF(aid)".  While this may have speed consequences
+    it avoids preselecting target lines.  (4/23/04, Cooke, Valdes)
+
+doc/scombine.hlp
+    Made corrections suggested by Francois Schweizer on 2/25/04.
+    (3/10/04, valdes with input from schweizer)
+
+t_sarith.x
+    When the task was modified 8/3/02 to add something to the WCS the
+    wrong pointer was used resulting in a segmentation violation when
+    using the "merge" option.  (3/9/04, Valdes)
+
+=======
+V2.12.2
+=======
+
+identify/autoid/aidlog.x
+    Added a test to avoid an arithmetic error if the dispersion
+    turns out to be zero.  (1/29/04, Valdes)
+
+identify/autoid/aidautoid.x
+identify/autoid/autoid.x
+    Two new debugging characters, "nm", were added.
+    (1/29/04, Valdes)
+
+aidpars.par
+    Default values were changed:
+	cddir: "unknown" -> "sign"
+	ntarget: 30 -> 100
+	ndmax: 20 -> 500
+	fmatch: 0.3 -> 0.2
+    (1/29/04, Valdes)
+
+identify/autoid/autoid.x
+    The parameters that can be specified by header keywords can now be
+    either the keyword or the keyword prefixed by '!'.  This was done
+    because there are a number of other IRAF tasks that use the '!' prefix
+    and users may be confused and use this syntax.  (1/29/04, Valdes)
+
+identify/autoid/autoid.x
+aidpars.par
+    The number of highest vote potential dispersions checked was
+    previously limited to a maximum of three times the number of target lines.
+    Now the number may be as large as specified by the "ndmax" parameter.
+    The default parameter value was greatly increased to 500.
+    (1/29/04, Valdes)
+
+identify/autoid/aidautoid.x
+doc/aidpars.hlp
+    The algorithm was modified to iterate on the pattern parameter
+    "npattern".  After exhausting the search with the initial
+    number of lines per pattern the value is reduced successively by
+    one down to the minimum of 3.  This makes the algorithm take longer
+    but the search is more exhaustive.  Use of larger patterns initially
+    allows finding fewer and more likely candidates first to speed
+    a solution.  (1/29/04, Valdes)
+
+aidpars.par
+identify/autoid/autoid.x
+doc/aidpars.hlp
+    The "rms" parameter is now specified in units of the "fwidth"
+    parameter rather than in pixels.  This is because if fwidth is
+    made larger to deal with broad lines (i.e. a wide slit) then the
+    expected uncertainties in pixel centroids will be larger.  The
+    default value was changed from 0.3 pixels to 0.1 of fwidth.
+    (1/29/04, Valdes)
+
+identify/autoid/autoid.x
+doc/aidpars.hlp
+identify/id_peaks.x
+    The selection of target lines was changed from using id_peaks to a
+    new routine id_upeaks.  In the former routine the ntarget strongest
+    peaks are selected regardless of position in the spectrum.  But this
+    can result in no lines being used in some parts of the spectrum if
+    the spectrum is dominated by strong lines in just one part of the
+    spectrum.  The id_upeaks routine finds lines over the whole spectrum
+    by dividing the spectrum into regions and then alternatively selecting
+    the brightest line in each region until the desired number of lines
+    is obtained.  In this case the number of regions if hardwired at 5.
+    (1/29/04, Valdes)
+
+aidpars.par
+identify/autoid/autoid.h
+doc/aidpars.hlp
+identify/autoid/aidinit.x
+identify/autoid/aidset.x
+identify/autoid/autoid.x
+    Added two new parameters to aidpars.  The first is "maxnl" which
+    defines the maximum non-linearity to accept after a dispersion function
+    fit.  Previously the maximum was hardwired in the code to be 0.5%
+    which was too small for many applications.  The default is set at
+    2%.  The second new parameter is "crquad" which defines a quadratic
+    correction to the pixel positions of detected lines in order to
+    "linearize" the pattern of line spacings which are matched against
+    the coordinate list.  This was found to not be as important as the
+    "maxnl" limitation in handling non-linear dispersion and has a default
+    value of zero.  (1/29/04)
+
+sensfunc/sfstds.x
+    Added a check for names with a kernel section.  Specifically, names
+    that end in ']'.  (12/18/03, Valdes)
+
+smw/shdr.x
+    Now if CUNITn is specified in velocity (m/s or km/s) and if
+    CTYPEn is VELO (or VELOCITY) then internally the velocity zero point
+    reference of 21 centimenters will be automatically added.
+    (8/19/03, Valdes)
+
+smw/shdr.x
+    Experience has shown that data with no units that users want to
+    import is mostly in Angstroms.  So rather than use the old FITS
+    standard that units are meters it will now assume Angstroms.
+    (8/15/03, Valdes)
+
+smw/smwaxes.x
+    A check is made if the physical axis is ra or dec in which case the
+    image is considered not to be dispersion corrected.  (8/5/03, Valdes)
+
+smw/smwsctran.x
+    If there is an error the physical coordinate system is used instead of
+    the world coordinate system.  This is meant to allow coupled WCS
+    (particularly celestial WCS) to be used without an error.
+    (8/5/03, Valdes)
+
+t_dopcor.x
+    Moved the erract before the imunmap/imdelete to produce the correct
+    error message.  (7/8/03, Valdes)
+
+dispcor/t_disptrans.x
+    When the subroutine dispcor was modified with an extra arguement this
+    task was not modified.  The extra argument was added.  (6/4/03, Valdes)
+
+identify/idinit.x
+    The restore function was not resetting the shift value at the right
+    time.  This had the effect of causing the user shift to be wrong
+    in the REIDENTIFY output when refit=no.  (5/27/03, Valdes)
+
+t_tweak.x
+    The statistics computation is now relative to neighboring points.
+    This change was developed working with the Coude-Feed spectral atlas
+    pipeline.  (4/3/03, Valdes)
+
+t_tweak.x
+    WHen an error, such as calibration values too low, occurs in twk_fit it
+    would exit without closing the graphics.  Now the graphics is opened with
+    AW_DEFER and the error action is to first close the graphics before
+    returning to the calling routine with the error.  (2/28/03, Valdes)
+
+t_tweak.x (Bug 520)
+    The erract was after error cleanup which could cause the incorrect
+    error to be reported.  Since the error action is to WARN it makes sense
+    to immediate report the error and then do the clean up.  (2/24/03, Valdes)
+
+dispcor/refspectra.x
+dispcor/refgspec.x
+dispcor/refspectra.com
+    The "select" parameter is now included in the common so that
+    refgspec does not try to look for the sort and group keyword if
+    it is not needed.  (9/5/02, Valdes)
+
+t_sarith.x
+    When a new MWCS pointer is created the attribute "sformat" has to
+    be added.  (8/3/02, Valdes)
+
+t_fitprofs.x
+    Incorrectly used pargi instead of pargb.  (8/2/02, Valdes)
+
+splot/getimage.x
+    Gt_setr was being called with an integer argument.  (8/2/02, Valdes)
+
+
+splot/eqwidthcp.x
+    1.  A pargd was used with the real variable cont.
+    2.  Variable pi never used.
+    (8/2/02, Valdes)
+
+scombine/icscale.x
+    Needed to dereference the error string in icgscale.
+    (8/2/02, Valdes)
+
+t_dispcor.x
+    String argument was incorrectly given as NULL.
+    (8/2/02, Valdes)
+
+t_dispcor.x
+dispcor/dcio.x
+sensfunc/sfoutput.x
+    The axis variable is not used and was deleted.  (8/2/02, Valdes)
+
+=======
+V2.12.1
+=======
+
+scombine/t_scombine.x
+doc/scombine.hlp
+    The rejection option is ignored when "combine=sum".  The documentation
+    did not make this clear and the output log would show whatever was
+    set for the rejection parameter.  The help was clarified and the
+    code changed to show a rejection of none.  (7/5/02, Valdes)
+
+irsiids/libpkg.a
+    Removed a stray libpkg.a link (6/5/02, MJF)
+
+identify/idcenter.x
+ecidentify/eccenter.x
+    The handling of INDEF values between reals and doubles was not done
+    correctly.  (5/28/02, Valdes)
+
+=====
+V2.12
+=====
+
+t_slist.x
+irsiids/t_slist1d.x
+    The SMW pointer was being closed without resetting the pointer in
+    the SHDR structure.  (5/30/02, Valdes)
+
+identify/iddofit.x
+identify/idinit.x
+    When deleting features during the fitting the memory allocated for
+    the labels was not being updated correctly.  Also in freeing the
+    feature memory there was no need to free labels beyond the number
+    of features.  (4/30/02, Valdes)
+
+splot/wrspect.x
+    Removed possibility of an infinite loop and make error checking
+    a little more obvious.  (2/28/02, Valdes, 3/21/02, Valdes))
+
+dispcor/dcio.x
+    Removed the special test for dispersion corrected data with no DCLOG
+    keyword which prevents re-calibration.  (2/4/02, Valdes)
+
+doc/bplot.hlp
+    Fixed a typo in the help page. (1/5/02, MJF)
+
+mkpkg
+    Added missing <mach.h> dependency to getcalib.x  (12/13/01, MJF)
+
+sensfunc/mkpkg
+    Removed unneeded dependencies for sfimage.x  (12/13/01, MJF)
+
+irsiids/t_flatfit.x
+irsiids/t_subsets.x
+irsiids/t_sums.x
+t_mkspec.x
+t_sinterp.x
+irsiids/t_bswitch.x
+    imgl1r() called with extra arg. (9/20/01, Valdes)
+
+dispcor/t_dispcor.x
+    dc_gec() missing arg. (9/20/01, Valdes)
+
+identify/autoid/aidautoid.x
+    aid_eval() called with extra arg. (9/20/01, Valdes)
+
+identify/idinit.x
+    id_gid() define as a function but should be a subroutine.
+    (9/20/01, Valdes)
+
+identify/idshift.x
+    id_getid() called as subroutine. (9/20/01, Valdes)
+
+ecidentify/ecffit/ecfshift.x
+    ecf_pshift() was incorrect. (9/20/01, Valdes)
+
+identify/iddofit.x
+    When removing lines deleted during fitting the labels were not being
+    correctly maintained.  (8/2/01, Valdes)
+
+splot/eqwidth.x
+    Instead of refusing to compute errors when there is a negative value
+    (anywhere in the spectrum and not just in the region) the routine
+    simply sets the pixel value in evaluating the sigma.
+    (5/16/01, Valdes)
+
+doc/deredden.hlp
+    Added information about the range of validity of the extinction
+    function.  (4/9/01, Valdes)
+
+t_fitprof.x
+    The input image was being unmmaped before the output image which
+    can cause problems.  (3/9/01, Valdes)
+
+splot/getimage.x
+    The nline parameter was not being set to the current line which could
+    cause the ')' and '(' to misbehave.  (2/15/01, Valdes)
+
+doc/sarith.hlp
+    The help said incorrectly that flux conservation was used.
+    (1/17/01, Valdes)
+
+smw/smwsaveim.x
+smw/smwequispec.x
+    The APNUM keywords change to AP when the aperture number is greater
+    than 999.  (11/8/00, Valdes)
+
+identify/iddb.x
+    The user units string is now recorded.  This is to allow velocity
+    units to include the reference point.  (5/4/00, Valdes)
+
+splot/eqwidthcp.x
+    When x becomes large enough the parabola fitting routine has a
+    divide by zero.  The parabola fitting routine was converted to work in
+    double, to check the x values for degeneracy, and to avoid the squares
+    of large numbers.  The calling routine was also modified to work in
+    double.  (2/15/00, Valdes)
+
+smw/smwonedspec.x
+smw/smwoldms.x
+    Put an error check on imdelf.  The list expansion should have expanded
+    to only the header keywords present but for some undiagnosed reason
+    sometimes the list expansion returned a non-existant keyword which
+    wouod cause an error.  (2/2/00)
+
+dispcor/dispcor.x
+    The input linei argument should really be the aperture number needed
+    to go back to pixel coordinates.  The change was to use this value only
+    to flag if the WCS is 1D (for long slit data) and otherwise to do
+    what the procedure did before.  (2/1/00, Valdes)
+
+dispcor/t_dispcor.x
+    During changes for 2D dispcor the arguments for a routine changed and
+    this was not reflected in the dc_global routines resulting in a
+    segmentation violation when the global option is selected.
+    (1/27/00, Valdes)
+
+dispcor/dcio.o
+    Touched but not changes.  (1/27/00, Valdes)
+
+getcalib.x
+t_standard.x
+standard.par
+lcalib.par
+splot.par
+doc/standard.hlp
+doc/lcalib.hlp
+doc/splot.hlp
+    1.  The calibration files may now be blackbody curves scaled to a
+	specified magnitude.
+    2.	STANDARD displays the data and bandpasses in the units of the
+	data rather than Angstroms.  The changes were made to allow
+	output in other untis but for now this has been disabled.
+    (1/24/00, Valdes)
+
+t_sarith.x
+    The WCS was set wrong when copying/extracting a region of a
+    log-linear spectrum.  (12/14/99, Valdes)
+
+=======
+V2.11.3
+=======
+
+t_fitprof.x
+    Fixed double/int mismatch in a min call.  (11/22/99, Valdes)
+
+smw/mkpkg
+ecidentify/ecffit/mkpkg
+sensfunc/mkpkg
+splot/mkpkg
+mkpkg
+    Added missing dependencies.  (10/11/99, Valdes)
+
+t_fitprofs.x
+doc/fitprofs.hlp
+    The background region specification was extended to allow a third
+    argument as a scaling factor.  (9/22/99, Valdes)
+
+doc/specwcs.hlp
+    Fixed typo defining the variable n.  (9/13/99, Valdes)
+
+t_tweak.x
+    1.  Changed wavelength evaluations to double precision.
+    2.  The normalization step for the rms calculation was removed for
+	the case of sky subtraction.
+    (9/8/99, Valdes)
+
+dispcor/t_dispcor.x
+dispcor/dcio.x
+dispcor/dispcor.x
+doc/dispcor.hlp
+    Now allows NDSPEC format spectra.  (9/7/99, Valdes)
+
+t_fitprofs.x
+doc/fitprofs.hlp
+    1.  The background region specification was extended to allow taking
+	the average or median or a region.
+    2.  The image identification label was incorrect.
+    3.  If verbose=no there was an attempt to close a non-existent structure.
+    (6/26/99, Valdes)
+
+t_fitprofs.x
+    Fixed bug which only allowed the last component to be saved to an
+    image.  (8/25/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+smw/units.x
+smw/funits.x
+    Stripped trailing whitespace from units label.  (8/5/99, Valdes)
+
+identify/t_reidentify.x
+    File date changed but no changes made to the file.  (7/22/99, Valdes)
+
+rspectext.cl
+    Added explicit add and del parameters to all the HEDIT calls.
+    (7/15/99, Valdes)
+
+t_sarith.x
+    The option to have a single second operand to work on a set of
+    first operands was not working.  (5/28/99, Valdes)
+
+splot/splot.key
+doc/splot.hlp
+    Added a reference to :.help and :/help.  (5/12/99, Valdes)
+
+doc/sys/1and2dspec.hlp
+doc/sys/Onedspec.hlp
+doc/sys/Review.hlp
+doc/fitprofs.hlp
+doc/reidentify.hlp
+doc/sensfunc.hlp
+doc/aidpars.hlp
+doc/autoidentify.hlp
+doc/skytweak.hlp
+doc/telluric.hlp
+irsiids/doc/powercor.hlp
+irsiids/doc/widstape.hlp
+    Fixed minor formating problems.  (4/22/99, Valdes)
+
+identify/idlinelist.x
+    The call to id_peak was using physical pixels while the subroutine
+    expects logical pixels.  A conversion from physical to logical was
+    added before calling id_peak.  (3/8/99, Valdes)
+
+scombine/t_scombine.x
+    Changed  UT(shin) = imgetr (im, Memc[gain -> snoise]).
+    (1/29/99, Valdes)
+
+identify/idgraph.x
+    Removed violation of GTOOLS data structure.  (12/18/98, Valdes)
+
+identify/t_reidentify.x
+    1.	When interactive=yes and ans is not NO when starting on a new
+	image in ri_image, the curfit descriptor was initialized to the
+	defaults rather than to reference solution.  This was because
+	of a missing ic_copy.
+    2.  When the reference and image names are the same the task will now
+	skip the reidentify,
+    (12/3/98, Valdes)
+
+shdr.x
+    Needed to check if data is defined for associated types before trying
+    to set flux units.  (11/27/98, Valdes)
+
+shdr.x
+    Improved the recognition of CTYPE values.  Most notably WAVELENGTH
+    is converted to "waveleng" by MWCS in making the label attribute.
+    (11/25/98, Valdes)
+
+doc/splot.hlp
+    Fixed help that said the output of a long slit or ND image would be
+    a 1D image.  (11/18/98, Valdes)
+
+dispcor/dispcor.x
+dispcor/refspectra.x
+    The weights when weighting multiple dispersion solutions were only
+    being recorded in the WCS attributes to 3 significant digits.  This
+    could cause the weights to become unnormalized and cause small
+    shifts.  Now whenever the weights are converted to strings the
+    format is %.8g.  (11/17/98, Valdes)
+
+t_fitprofs.x
+    When the input peak value was INDEF the task would fail with a
+    floating overflow value if scale < 1.  This was caused by not checking
+    for INDEF before dividing by the scale.  (11/5/98, Valdes)
+
+smw/smwnewcopy.x
+    The structure copy was wrong.  (10/28/98, Valdes)
+
+sensfunc/sfimage.x
+t_calibraate.x
+    The flux calibration gets the wrong sign if dw<0.  (9/25/98, Valdes)
+
+smw/shdr.x
+    Default units of Angstroms was added if DC-FLAG is dispersion corrected.
+    (9/24/98, Valdes)
+
+dispcor/dcio.x
+    The weights are now adjusted to produce weighted average rather than
+    weighted sum.  (8/25/98, Valdes)
+
+splot/wrspect.x
+    The filling in of data outside of NP1/NP2 was done incorrectly.
+    Normally NP1/NP2 cover the entire image line but in echelle data
+    it is common for NP2 to be less than the full line.  In this case
+    the result of saving an image was loss of the last valid point.
+    (7/14/98, Valdes)
+ 
+identify/idinit.x
+    When restoring a solution without a dispersion function the shift
+    failed to be restored.  This causes a problem with REIDENTIFY when
+    working on long slit data with a significant systematic tilt and
+    measuring the spatial distortion.  (6/1/98, Valdes)
+
+t_tweak.x
+telluric.par
+doc/telluric.hlp
+    If the calibration is < 0 it is detected but there was an error in
+    the error clean up giving a "memory corruption" error.  This error
+    was fixed and a new threshold parameter was added to allow the task
+    to continue if the calibration data has low values.
+    (4/21/98, Valdes)
+
+t_sarith.x
+    When rebinning non-linear spectra the dispersion type was not be reset
+    to linear resulting in an incorrect spectral WCS.  See buglog 400.
+    (4/17/98, Valdes)
+
+doc/scopy.hlp
+    Added a note about using epar to set nsum to examples in section III
+    as suggested by Ivan King on 4/3/98.  (4/8/98, Valdes)
+
+scombine/t_scombine.x
+    If the input spectra are not dispersion corrected and first=no the
+    task was incorrectly setting the dispersion correction flag.
+    (3/3/98, Valdes)
+
+splot/deblend.x
+    The dorefit code was not handling the case of a mixture of profile types.
+    (2/12/98, Valdes)
+
+t_tweak.x
+    The extra argument in a twk_colon call was removed.
+    (2/5/98, Valdes)
+
+dispcor/t_dispcor.x
+    Added some errchk declarations.
+    (1/26/98, Valdes)
+
+identify/idlinelist.x
+doc/autoidentify.hlp
+doc/identify.hlp
+doc/reidentify.hlp
+    When a coordinate list is read it will be sorted and identical
+    entries will be eliminated.  Thus, line lists no longer need to
+    be sorted.  (1/12/98, Valdes)
+
+=======
+V2.11.1
+=======
+
+doc/splot.hlp
+    Added another paragraph and a correction to the flux calculation
+    done by 'e'.  (12/22/97, Valdes)
+
+splot/gfit.x
+    The test for computing errors when negative data is detected was
+    incorrect and would given an error message even when errors were
+    not desired.  (10/23/97, Valdes)
+
+dispcor/dispcor.x
+smw/shdr.x
+    Changed the maximum distance that the endpoints can be from pixel
+    edges before using the pixel values directly instead of integrating
+    the interpolator from 0.001 to 0.00001.  (10/7/97, Valdes)
+
+doc/calibrate.hlp
+    Added brief discussion about pixels falling outside the wavelength
+    range of the sensitivity function.  (9/23/97, Valdes)
+
+===========
+V2.11export
+===========
+
+identify/iddb.x
+ecidentify/ecdb.x
+    Increased the number of digits recorded in the database for the fit
+    and user values to 9.  (8/22/97, Valdes)
+
+swm/shdr.x
+    Added an arbitrary reference for the velocity CTYPE value.
+    (8/20/97, Valdes)
+
+smw/smwsaxes.x
+    The earlier fix for transposed data was incorrect.  The origin terms
+    do not need to be changed but the order of the CD matrix terms
+    was incorrect.  (8/15/97, Valdes)
+
+dispcor/refnoextn.x
+    Added fit and fits to the possible extensions.  (8/14/97, Valdes)
+
+smw/smwsaxes.x
+    When the LTERM is adjusted to correct for a transpose only the matrix
+    terms were being corrected.  The origin terms also needed to be
+    corrected.  (8/6/97, Valdes)
+
+scombine/t_scombine.x
+    Previously an end input pixel had to  completely overlap an output pixel
+    otherwise it was flagged as missing data.  This was changed to use
+    the end pixels if they overlapped at all.  This change was done to
+    allow small dispersion shifts to not affect the end point combining.
+    (8/6/97, Valdes)
+
+smw/shdr.x
+    No change.  (8/6/97, Valdes)
+
+identify/t_reidentify.x
+doc/reidentify.hlp
+reidentify.par
+imred/*/reidentify.par
+twodspec/longslit/reidentify.par
+    The shift parameter was restored to it's previous usage.  The automatic
+    pattern matching algorithm is not selected by setting the shift to INDEF
+    and using the new parameter crsearch.  (7/21/97, Valdes)
+
+identify/idshift.x
+identify/t_reidentify.x
+    The symbol table of reference solutions was being modified by the shift
+    calculation causing the loop over solutions to be wrong.  Now
+    ri_image marks and frees the symbol table between calls and loops
+    through the symbol table solutions in a way that is not affected by
+    new entries in the symbol table.  Also idshift marks and frees the
+    symbol table.  Note that marking and freeing is not enough because
+    the loop using sthead/stnext will not work.  (7/19/97, Valdes)
+
+identify/autoid/aidshift.x
+identify/ididentify.x
+identify/idreidentify.x
+identify/doc/reidentify.x
+identify/reidentify.par
+    1.	aid_shift was not using crsearch/cdsearch as expected.
+    2.  The call to id_shift in the interactive routines had an incorrect
+	argument value.
+    3.	The help page for REIDENTIFY was clarified about what the shift
+	parameter means.
+    4.	The parameter prompt for shift in REIDENTIFY was corrected.
+	parameter means.
+    (7/17/97, Valdes)
+
+identify/t_reidentify.x
+    The nlost parameter now applies when not tracing.  (7/17/97, Valdes)
+
+t_sarith.x
+    The power option did not work because the apow routine takes only
+    integer powers.  Replace the apow routine with an explicit calculation.
+    (7/15/97, Valdes)
+
+=========
+V2.11Beta
+=========
+
+identify/t_reidentify.x
+    The number of features was being used to calculate how many features
+    might be lost before it was set.  (6/3/97, Valdes)
+
+doc/disptrans.hlp
+doc/onedspec.hlp
+doc/splot.hlp
+    Added new unit abbreviations.  (5/27/97, Valdes)
+
+splot/splot.x
+splot/splotcolon.x
+splot/splabel.x		+
+splot/splot.key
+doc/splot.hlp
+    Added colon commands for labeling.  (5/16/97, Valdes)
+
+t_tweak.x
+    1. The ? help file was specified as .hlp instead of .key.
+    2  Add a divide by zero check.
+    (5/14/97, Valdes)
+
+t_scoords.x	+
+scoords.par	+
+doc/scoords.hlp	+
+x_onedspec.x
+mkpkg
+onedspec.cl
+onedspec.hd
+onedspec.men
+    Added a new task that sets a pixel array spectral coordinate system
+    in 1D spectra.  (5/9/97, Valdes)
+
+doc/sapertures.hlp
+doc/sinterp.hlp
+doc/sflip.hlp
+doc/disptrans.hlp
+doc/skytweak.hlp
+doc/telluric.hlp
+doc/sfit.hlp
+doc/continuum.hlp
+doc/fitprofs.hlp
+irsiids/doc/slist1d.hlp
+    Changed revision versions.  (4/22/97, Valdes)
+
+t_tweak.x	 +
+skytweak.par	 +
+telluric.par	 +
+doc/skytweak.hlp +
+doc/telluric.hlp +
+x_onedspec.x
+onedspec.cl
+onedspec.men
+onedspec.hd
+    Added tasks for tweaking calibration spectra and applying a sky
+    subtraction or telluric correction.  (3/28/97, Valdes)
+
+t_sarith.x
+    The wrong INDEF type was used.  (3/17/97, Valdes)
+
+smw/shdr.x
+    The shdr_linear needed to transform the requested input range to
+    the image WCS units.  (3/13/97, Valdes)
+
+t_calibrate.x
+t_standard.x
+    Changed to allow input spectra in various units.  (3/12/97, Valdes)
+
+autoidentify.par
+identify.par
+ecidentify.par
+identify/t_autoid.x
+identify/t_identify.x
+identify/identify.h
+identify/idinit.x
+identify/idgdata.x
+identify/iddofit.x
+identify/idmap.x
+identify/iddb.x
+identify/idlinelist.x
+identify/idfitdata.x
+ecidentify/ecinit.x
+ecidentify/ecgdata.x
+ecidentify/t_eciden.x
+ecidentify/eclinelist.x
+ecidentify/ecidentify.h
+ecidentify/ecdb.x
+ecidentify/ecfitdata.x
+dispcor/t_dispcor.x
+dispcor/dcio.x
+dispcor/dispcor.h
+doc/autoidentify.hlp
+doc/identify.hlp
+imred/echelle/doc/ecidentify.hlp
+imred/irs/identify.par
+imred/iids/identify.par
+imred/kpnocoude/identify.par
+noao/lib/linelists/*
+    Changes to allow IDENTIFY/ECIDENTIFY to work in user or line list
+    specified units and to have DISPCOR pass on the units.  (3/11/97, Valdes)
+
+splot/usercoords.x
+    This routine had a couple of places where it calls smw_c?tran? and
+    then takes log sampling in EQUISPEC/NDSPEC explicitly into account.
+    Since this is now done by the lower level routines the log conversions
+    were removed. (3/3/97, Valdes)
+
+dispcor/dcio.x
+doc/dispcor.hlp
+    The coordinate transformation between logical and world was changed
+    to always produce linear wavelength.  It use to be that for
+    equispec and ndspec formats with dc-flag=1 this would produce
+    log wavelengths.  This prevented resampling from log back to
+    linear.  [The date on dcio.x was touched but no actual change was
+    made.] (3/3/97, Valdes)
+
+smw/shdr.x
+    The SHDR routines that convert between world and logical were updated
+    for the changes in smw_c?tran?.  Previously, these routines explicitly
+    applied the log transformation for log sample spectra.  For this
+    reason most ONEDSPEC tasks operated correctly.  However, DISPCOR
+    does not use SHDR_LW/SHDR_WL so it failed.  Now the log conversions
+    are done in smw_c?tran? and not in the SHDR routines.
+    (3/3/97, Valdes)
+
+smw/smwsctran.x
+smw/smwctran.gx		+
+noao/lib/smw.h
+    The coordinate transformations in ONEDSPEC tasks assume that dispersion
+    coordinates are always in linear dispersion whether or not the
+    spectra are stored in log sampling (DC-FLAG=1).  However, this
+    was not true for EQUISPEC/NDSPEC format.  Now calls to the smw_c?tran?
+    routines will return linear dispersion for all supported ONEDSPEC
+    WCS types.  This was needed to fix the problem with DISPCOR and
+    log sampled input spectra.
+
+smw/smwsaveim.x
+    Deleted unused procedure name in errchk.  No functional change.
+    (3/3/97, Valdes)
+
+scombine/t_scombine.x
+    Moved the call to smw_openim to "clean up" the WCS from after the
+    image size is changed to before because otherwise an error would
+    occur trying to access aperture information for any new lines added.
+    I no longer recall the purpose of this "clean up" step.
+    (2/19/97, Valdes)
+
+splot/sumflux.x
+    The conversion to "angstrom" units used the wpc instead of abs(wpc).
+    (2/6/97, Valdes)
+
+identify/idpeak.x
+identify/ididentify.x
+identify/idshift.x
+identify/reidentify.x
+identify/autoid/autoid.x
+    Added a new procedure, id_peaks, that replaces calls to find_peaks.
+    The new procedure calls find_peaks and then converts the pixels to
+    physical coordinates.  (1/30/97, Valdes)
+
+t_calibrate.x
+    The calculation of dw for the flux correction used the index i
+    instead of k.  This means that dw was constant which is incorrect
+    for spectra with non-linear dispersion.   (1/22/97, Valdes)
+
+doc/splot.hlp
+splot/autoexp.x
+    The intensity range produced by the 'a', ',', '.', and 'z' keys
+    could be wrong if the dispersion function was sufficiently non-linear.
+    This now fixed and if the positions for the 'a' key are the same
+    it autoscales; i.e. 'a' 'a' is a short cut to autoscale.
+    (1/10/97, Valdes)
+
+splot/splot.x
+    The whitespace was being removed from the units parameter so that
+    any units string that requires whitespace (such as "km/s 4000 ang")
+    would fail to be recognized.  (12/3/96, Valdes)
+
+scombine/t_scombine.x
+scombine/icscale.x
+    The feature of getting scaling, zero, and weight values from the image
+    headers did not work because the header values were not cached.
+    (11/11/96, Valdes)
+
+t_sarith.x
+doc/sarith.hlp
+    The noise spectrum type is now only copied unmodified.  This is
+    a quick kludge until the noise is properly handled.
+    (9/11/96, Valdes)
+
+smw/shdr.x
+    Added a spectrum type field to the spectrum structure and a specific
+    procedure to decode the spectrum type.
+    (9/11/96, Valdes)
+
+splot/gfit.x
+splot/spdeblend.x
+    Allow error estimates with negative pixels if invgain=0 otherwise
+    print a warning.  (7/23/96, Valdes)
+
+doc/standard.hlp
+    Added comments about proper use of extinction files.
+    (6/26/96, Valdes)
+
+doc/dispcor.hlp
+    Update the help file to indicate that the input limits are in
+    non-log units even with logarithmic sampling is selected.
+    (6/14/96, Valdes)
+
+t_standard.x
+    Make minor change to beginning of std_flux to avoid optimizer error
+    on Solaris with V4.0 compiler.  (6/10/96, Valdes)
+
+t_sarith.x
+    Altered order of opening the output so that any error in reading
+    the input data is caught first.  (5/14/96, Valdes)
+
+smw/shdr.x
+    Separated call for imgs3r in order to error check for failure to
+    get the pixel data (such as occurs with a long pathname to the pixel
+    file).  (5/14/96, Valdes)
+
+rspectext.cl
+    Removed use of CL variable "list".  (5/6/96, Valdes)
+
+noao$lib/smw.h
+    Changed SMW_NSPLIT from 200 to 500.  (4/18/96, Valdes)
+
+smw/smwmerge.x
+    1.  When the output format is multispec the code did not open a
+	single MWCS but simply opened another split MWCS.
+    2.  A pointer rather than the string was incorrectly passed to
+	smw_swattrs.
+    (4/18/96, Valdes)
+
+smw/shdr.x
+    If the units are not defined by an attribute a check is made for
+    a CUNITn keyword.  (4/17/96, Valdes)
+
+identify/autoid/autoid.x
+    1. Removed useless call to id_log.
+    2. Fixed realloc bug.
+    3. Fixed bug allowing lines to be found multiple times.
+    (4/12/96, Valdes)
+
+identify/autoid/aidshift.x
+    Added missing argument in call to aid_init.  (4/11/96, Valdes)
+
+identify/idlinelist.x
+    Minor efficiency change that avoids extract calls to id_fitpt.
+    (4/11/96, Valdes)
+
+identify/t_autoid.x
+    Minor bug fix so that log header is printed.  (4/5/96, Valdes)
+
+t_rstext.x
+rspectext.cl
+doc/rspectext.hlp
+    The task now automatically senses the presence of a header.
+    (3/7/96, Valdes)
+
+identify/identify.h
+identify/peaks.gx
+identify/autoid/autoid.x
+    1. The ID_FTYPE entry in the structure was being clobbered by a typo
+	in the include file which also mapped ID_LABEL to the same location.
+    2.	The peak finding routines were modified so that values of INDEF
+	for the threshold and contrast would disable these tests.  This
+	is needed when absorption peak data is negated to find the
+	absorption peaks which are all negative.
+    3.  The autoid.x uses of find_peaks were modified to set the contrast
+	and threshold to INDEF instead of zero.
+    (2/24/96, Valdes)
+
+splot/getimage.x
+    There was a bug in initializing the image section limits such that
+    when an image section of the form [n,*] is used and there is not
+    display limits (xmin and xmax are INDEF) then the plotted spectrum
+    will cover the range of the first axis rather than the second.
+    (2/22/96, Valdes)
+
+identify/autoid/*	+
+identify/t_autoid.x	+
+identify/t_identify.x
+identify/t_reidentify.x
+identify/idcolon.x
+identify/iddb.x
+identify/iddoshift.x
+identify/idfitdata.x
+identify/idgdata.x
+identify/ididentify.x
+identify/idinit.x
+identify/idlinelist.x
+identify/idlog.x
+identify/idmap.x
+identify/idshift.x
+identify/idshow.x
+identify/peaks.gx
+identify/peaks.x
+identify/reidentify.x
+identify/identify.h
+identify/identify.key
+identify/mkpkg
+doc/aidpars.hlp		+
+doc/autoidentify.hlp	+
+doc/identify.hlp
+doc/reidentify.hlp
+x_onedspec.x
+aidpars.par		+
+autoidentify.par
+identify.par
+reidentify.par
+onedspec.cl
+onedspec.par
+onedspec.men
+onedspec.hd
+    Added an automatic line identification algorithm.  This algorithm
+    is part of the new task AUTOIDENTIFY and modified versions of
+    IDENITFY and REIDENTIFY.  A new pset task AIDPARS contains the
+    algorithm parameters.  (2/1/96, Valdes)
+
+onedspec.hd
+onedspec.men
+    Added linelists$README and onedstds$README as the help topics
+    "linelists" and "onedstds".  (1/26/96, Valdes)
+
+smw/shdr.x
+    When extracting a wavelength range (without rebinning) and with the
+    range flipped there was an error in not checking for the existence
+    of the associated spectra causing a segmentation violation.
+    (1/22/96, Valdes)
+
+specplot.x
+    The scale and offset parameters may now be a constant value, an
+    @file containing the values, or a keyword name.  (1/13/96, Valdes)
+
+smw/smwopen.x
+    The arrays for the aperture, beam, and limits in equispec format were
+    not being initialized to reasonable values which could cause an
+    error when doing an ES to MS conversion.  Replaced
+    mallocs with callocs. (1/9/96, Valdes)
+
+smw/smwesms.x
+    Fixed a typo: smwopn -> smw_open.  (1/9/96, Valdes)
+
+smw/smwsaxes.x
+    Uncalibrated long slit (2D) spectra which have been rotated are now
+    allowed.  The rotated WCS is reset to pixels.  If the dispersion
+    calibration flag is set and the spectra have been rotated then
+    an error is reported.  (1/4/96, Valdes)
+
+t_sarith.x
+doc/sarith.hlp
+doc/scopy.hlp
+    Preiously both w1 and w2 had to be specified to select a wavelength
+    region to be copied or operated upon.  Now if only one is specified
+    the second will default to the appropriate starting or ending
+    pixel.  (12/20/95, Valdes)
+
+t_sbands.x
+    1.  Converted to work in double precision except the spectrum data
+	obtained by shdr_open is only in real.
+    2.	Increased the index and eqwidth precision printed from
+	%7.4g to %9.6g.
+    (12/5/95, Valdes)
+
+identify/idgraph.x
+    If the graph x window is outside of the data the x window is now
+    autoscaled.  This occurs when a user sets window limits in pixel space
+    and then does a fit to wavelength.  The new graph was then plotted in
+    the windowed pixel space and no data would be seen.  (12/5/95, Valdes)
+
+t_calibrate.x
+    The airmass value computed by get_airm was being ignored causing
+    a floating exception (bug log 321).  This was fixed.  (12/4/95, Valdes).
+
+scombine/generic/icpclip.x
+    Fixed a bug where a variable was improperly used for two different
+    purposes causing the algorithm to fail (bug 316).  (10/19/95, Valdes)
+
+identify/peaks.x
+    There was an index bug in is_local_max.  (9/26/95, Valdes)
+
+t_slist.x
+    Fixed another case of closing the mwcs pointer without invalidating
+    it in the shdr pointer.  (9/26/95, Valdes)
+
+t_fitprofs.x
+    Added a check and appropriate error message for a missing positions
+    file.  (9/22/95, Valdes)
+
+doc/splot.hlp
+    Added explicit equations for the quantities measured by the 'e'
+    key in SPLOT.  (9/22/95, Valdes)
+
+identify/ididentify.x
+idenitfy/identify.key
+doc/identify.hlp
+    A new key, 'e', has been added to add features from a line list without
+    doing any fits.  This is like the 'l' but without the automatic
+    fitting before and after adding new features.  (9/5/95, Valdes)
+
+identify/t_reidentify.x
+doc/reidentify.hlp
+    If there are no reference features the "addfeatures" option will add
+    new features before doing a fit or shift.  (9/5/95, Valdes)
+
+splot/getimage.x
+    The change of 5/1/95 allows parsing an image section to determine
+    the dispersion line.  However this ignored any range along the
+    dispersion.  This change completely parses any image section and
+    sets the display range in pixels or wavelength to that of the
+    image section along the dispersion.  (8/28/95, Valdes)
+
+identify/t_reidentify.x
+identify/iddb.x
+    1.  If the reference image does not exist REIDENTIFY would catch the
+	error but then attempt to close an unopened database leading to
+	a seg vio error rather than the warning.  A check was added for
+	the database being open.
+    2.  Added a new database procedure that scans a database and saves
+	the records.  This allows REIDENTIFY to use a reference database
+	even when the reference image doesn't exist.
+    (8/23/95, Valdes)
+
+smw/smwdaxis.x
+smw/shdr.x
+    In the absence of DISPAXIS the software will recognize the FITS
+    CTYPE keyword with values of LAMBDA, FREQ, VELO*, WAVELENGTH
+    in the units defined in the original FITS paper.  (8/20/95, Valdes)
+
+t_sfit.x
+    The logic for checking whether all lines and all bands has been done
+    is not as straightforward as indicated in the entry of 4/29/94.
+    The checking on bands has been eliminated though a record of
+    the bands dones is written to the header.  (8/15/95, Valdes)
+
+smw/smwsaveim.x
+scombine/t_scombine.x
+    When a new image is opened NEW_COPY it inherits IM_NPHYSDIM and IM_NDIM.
+    A routine can change IM_NDIM but not IM_NPHYSDIM.  The routine to
+    save an equispec WCS needs to preserve the IM_NPHYSDIM when updating
+    an exisiting 2D image which may have been specified as a 1D section.
+    In order to tell the routine that a new lower dimensional image
+    is desired with a NEW_COPY header the higher level routine can set
+    the temporary keyword SMW_NDIM and the routine setting up the WCS
+    will use this in prference to the IM_NPHYSDIM.  (8/14/95, Valdes)
+
+identify/idlinelist.x
+    The way memory was being allocated for labels was such that not
+    all memory would be deallocated at the end.  (8/3/95, Valdes)
+
+identify/iddb.x
+    When "adding" features the NALLOC value was not properly updated
+    resulting in free uninitialized pointers leading to a segvio.
+    (8/3/95, Valdes)
+
+smw/smwdaxis.x
+    If the image header dispersion axis is unreasonable a warning is
+    printed and the "dispaxis" parameter is used instead.  (8/2/95, Valdes)
+
+sbands.x
+    Changed the index and eq width format from 7.2f to 7.4g.
+    (7/28/95, Valdes)
+
+splot/voigt.x	+
+t_fitprofs.x
+splot/splot.x
+splot/anshdr.x
+splot/eqwidthcp.x
+splot/gfit.x
+splot/deblend.x
+splot/spdeblend.x
+splot/splot.key
+splot/mkpkg
+doc/fitprofs.hlp
+doc/splot.hlp
+fitprofs.par
+splot.par
+    Added lorentzian and voigt profile fitting and deblending.  This changed
+    the FITPROFS parameters and the input line lists for FITPROFS and
+    SPLOT though the old line lists will still work.  A new parameter was
+    also added to SPLOT and FITPROFS to set the number of Monte-Carlo
+    samples used in the error estimates.
+    (7/28/95, Valdes)
+
+splot/splot.x
+    Changed when the shdr structure is closed to avoid an error.
+    (8/24/95, Valdes)
+
+t_sapertures.x
+doc/sapertures.hlp
+    Modified to allow aperture ID table to be from an image header
+    in the same way as done in the APEXTRACT package.
+    (7/24/95, Valdes)
+
+t_specplot.x
+specplot.key
+doc/specplot.hlp
+    Added a new key 'f' to toggle between logical pixels and world
+    coordinates.  (7/21/95, Valdes)
+
+dispcor/dcio.x
+dispcor/dispcor.h
+    The application of a shift now also works with non-linear dispersions
+    in the input image.  This is a feature used in the DOFIBERS script
+    to align sky lines.  (7/19/95, Valdes)
+
+splot/wrspect.x
+    The BANDID keyword was being written with garbage characters
+    because a pargstr was used instead of pargi.  (7/14/95, Valdes)
+
+dispcor/dcio.x
+    When there is only a shift in the database (a feature added 4/21/94)
+    and the image has more than one aperture the weight parameter was being
+    clobbered causing incorrect results.  (7/13/95, Valdes)
+
+t_sapertures.x
+    Fixed the "dtype" parameter behavior which was not correct.
+    (6/30/95, Valdes)
+
+smw/smwonedspec.x
+smw/smwsaxes.x
+    1.	For the simplest spectra a heuristic to determine DC-FLAG was
+	added such that if the wavelength of the first pixel and the
+	increment per pixel are both unequal to 1 then the spectrum is
+	assumed to be dispersion calibrated.
+    2.	The label and units are not overridden if either is present.
+	If neither is present but the spectrum is considered to be
+	dispersion corrected then it defaults to Wavlength(angstroms).
+    (6/30/95, Valdes)
+
+ididentify.x
+reidentify.x
+    When a line center fails to be found with the 'm' key a message is
+    printed pointing to the threshold parameter.  (6/30/95, Valdes)
+
+t_sbands.x
+    The allocation scheme was incorrect causing a segmentation violation
+    after the first 10 bands.  (6/30/95, Valdes)
+
+=======
+V2.10.4
+=======
+
+t_sarith.x
+    The "units_display" WCS attribute is copied if set.  (5/13/95, Valdes)
+
+splot/splot.x
+splot/getimage.x
+t_specplot.x
+    1.  The task "units" parameter value is mapped to "display" if null.
+    2.  The units are set with shdr_units.
+    (5/13/95, Valdes)
+
+smw/shdr.x
+    1.  The spectrum structure is loaded in the image MWCS units ("units").
+    2.  The special unit string "display" changes units to the "units_display"
+	attribute in shdr_units.
+    3.  The special unit string "default" changes units to the image MWCS
+	units in shdr_units.
+    (5/13/95, Valdes)
+
+doc/sfit.hlp
+    Added a description of the "sample" range syntax.  (5/12/95, Valdes)
+
+splot/splot.x
+splot/getimage.x
+doc/splot.hlp
+    Because it can be desirable to use image sections on the input but
+    this will cause problems if the user attempts to update the image
+    SPLOT was modified to parse the image section for the specified image
+    line, column, or band and then map the full image.  (5/1/95, Valdes)
+
+t_sbands.x
+doc/t_sbands.x
+    Increase the length and changed to g format for the flux so that
+    flux calibrated data will print.  (4/12/95, Valdes)
+
+doc/wspectext.hlp
+    Fixed typo in example.  (4/12/95, Valdes)
+
+t_sarith.x
+    Image extensions are no only stripped for onedspec format output
+    images rather than in all image names.  This is necessary to allow
+    STF images with explicit extensions not matching the imtype value
+    to be specified.  (3/31/95, Valdes)
+
+scombine/icscale.x
+doc/scombine.hlp
+    The behavior of the weights when using both multiplicative and zero
+    point scaling was incorrect; the zero levels have to account for
+    the scaling.  (3/27/95, Valdes)
+
+splot/flatten.x
+    Removed use of faulty fp_equal test for equality with zero.  This would
+    cause continuum normalization to fail for fluxed data.  (2/23/95, Valdes)
+
+sensfunc/sfshift.x
+    Deleted points and stars are now ignored in the grey shift calculation.
+    (2/22/95, Valdes)
+
+t_sinterp.x
+    Updated the image header keywords to give a complete and standard
+    linear WCS.  (2/21/95, Valdes)
+
+splot/gfit.x
+    If the marked region does not span the profile peak then an pointer
+    indexing error occurs when estimating the initial sigma.  Modified
+    to estimate the sigma differently in this case.  (2/17/95, Valdes)
+
+t_fitprofs.x
+splot/spdeblend.x
+splot/gfit.x
+    1.  The indexing was incorrect in the Monte-Carlo error estimation.
+    2.  Change the number of Monte-Carlo samples from 100 to 50.
+    (2/16/95, Valdes)
+
+smw/shdr.x
+    If an associated spectrum doesn't exist free any previous spectrum.
+    (2/13/95, Valdes)
+
+getcalib.x
+    Added missing length argument to strcpy which caused an unaligned
+    access error on the Alpha.  (1/27/95, Valdes)
+
+t_dopcor.x
+    Fixed typo bug which prevents more than 8 spectra in multispec format
+    to work.  This affects primarily echelle data.  (1/18/95, Valdes)
+
+smw/swmctran.x
+    The equispec coordinate transformations now include mapping apertures
+    and lines.  (1/16/95, Valdes)
+
+smw/smwopenim.x
+    Changed unknown coordinate system from a fatal error to a warning.
+    (1/14/95, Valdes)
+
+t_standard.x
+    Fixed bug in closing sh structure.  (1/3/95, Valdes)
+
+t_standard.x
+t_calibrate.x
+standard.par
+calibrate.par
+doc/standard.hlp
+doc/calibrate.hlp
+    If the exposure time and airmass cannot be determined from the header
+    they are queried and updated in the images.  New query parameters
+    were added.  (1/2/95, Valdes)
+
+dispcor/refmsgs.x
+dispcor/refgspec.x
+dispcor/reftable.x
+dispcor/refspectra.h
+dispcor/refinterp.x
+dispcor/reffollow.x
+dispcor/refnearest.x
+dispcor/refprecede.x
+    Added error information if no reference spectrum is found to aid in
+    diagnosing the problem.  (12/30/94, Valdes)
+
+dispcor/t_dispcor.x
+dispcor/dcio.x
+    1.	Improved the error messages again to more clearly pinpoint problems
+	with the dispersion database.
+    2.	The image extensions are now stripped in REFSPEC keywords.
+    (12/30/94, Valdes)
+
+identify/identify.x
+identify/reidentify.x
+identify/iddofit.x
+identify/identify.key
+    1.  Added 'v' to change fitting weights.  (12/29/94, Valdes)
+
+identify/t_reidentify.x
+doc/reidentify.hlp
+    The step parameter for multispec/equispec data is now ignored and
+    all apertures are reidentified expect for a value of zero indicates
+    don't reidentify anything but the reference aperture.  (11/15/94, Valdes)
+
+onedspec.men
+doc/mkspec.hlp
+    Highlighted the fact that the MKSPEC task is obsolete.  (11/12/94, Valdes)
+
+doc/identify.hlp
+identify/identify.key
+identify/idcolon.x
+    The help described one of the options for :label to be "coords" when
+    it is actually "coord".  Rather than modify the code I modified the
+    help.  The colon procedure was modified only in that when it
+    reports the current value of the label parameter it shows coord
+    and not coords.  (11/8/94, Valdes)
+
+doc/onedspec.hlp
+doc/specwcs.hlp
+    Added description of dispaxis and nsum package parameters to the package
+    description.  (11/1/94, Valdes)
+
+scombine/t_scombine.x
+    There was a problem with using SCOMBINE with 2D/3D spectra in that
+    it assumed the number of spectra is the second image dimension.
+    Changed this to the approriate number of spectra for all spectral
+    formats.  (10/27/94, Valdes)
+
+dispcor/dctable.x
+    If ignoreaps=yes and there are apertures defined with an aperture table
+    or reference image then the defaults for the wavelength scale if
+    an undefined aperture is encountered will be that of the first defined
+    aperture unless an explicit value has been given with the task parameters.
+    This is needed to make the IMRED reductions scripts run as desired.
+    (10/12/94, Valdes)
+
+smw/smwonedspec.x
+smw/smwoldms.x
+    Added a missing call to close the image header keyword template list
+    which caused memory to not be freed.  (10/4/94, Valdes)
+
+identify/t_reidentify.x
+    Now checks for a zero step and only operates on the specified reference
+    line.  (9/15/94, Valdes)
+
+t_sfit.x
+doc/sfit.hlp
+doc/continuum.hlp
+    Extended SFIT and CONTINUUM to work on NDSPEC spectra.  (9/13/94, Valdes)
+
+splot/splot.x
+    1.  The 'p' and 'u' now restore the "world" system before setting the
+    	dispersion.  Previously if the user switched to "pixel" (with '$')
+    	then a units conversion error would occur if the user tried to
+	set the dispersion.
+    2.  The 'v' key now toggles even if no input units are specified.
+    (8/17/94, Valdes)
+
+splot/wrspect.x
+    Fixed a bug in which the output units when saving a spectrum were
+    incorrectly set to be the current display units rather than the MWCS
+    units.
+    (8/17/94, Valdes)
+
+splot/wrspect.x
+    Fixed a typo in a pointer assignment in the case of overwriting
+    an existing 2D image which caused a segmentation violation.
+    (8/17/94, Valdes)
+
+doc/splot.hlp
+doc/fitprofs.hlp
+    Fixed various typos and added suggestions as pointed out by Dave Bell.
+    (8/17/94, Valdes)
+
+splot/gfit.x
+splot/spdeblend.x
+t_fitprofs.x
+    Added a check for both sigma0 and invgain being zero.
+    (8/17/94, Valdes)
+    
+t_fitprofs.x
+    Failed to treat the scaling of the sigmas properly to avoid overflow 
+    problems.
+    (8/17/94, Valdes)
+
+onedspec.cl
+onedspec.hd
+onedspec.men
+x_onedspec.x
+dispcor/mkpkg
+dispcor/t_disptrans.x	+
+disptrans.par		+
+doc/disptrans.hlp	+
+    Added a new task to convert the WCS dispersion relation between units
+    and to apply a vacuum/air conversion.  (8/8/94, Valdes)
+
+t_slist.x
+    Removed the restriction against N-dim spectra so that this could
+    be used with BPLOT to expand a list of apertures.  (7/29/94, Valdes)
+
+splot/spdeblend.x
+splot/gfit.x
+    1.  The sigmas needed to be scaled to unit mean to avoid possible
+	overflow problems during the fitting.
+    2.  There was an incorrect calling sequence in gfit for the new
+	model parameters.
+    (7/26/94, Valdes)
+
+noao/lib/units.h
+smw/units.x
+splot/splot.key
+specplot.key
+doc/onedspec.hlp
+doc/splot.hlp
+    Added nanometers as a unit.  (7/21/94, Valdes)
+
+noao/lib/smw.h
+smw/shdr.x
+splot/wrspect.x
+splot/splot.x
+    1.  Added a reddening correction flag to the basic spectrum data structure.
+    2.  When writing out a spectrum with WRSPECT also update the calibration
+	parameters.
+    3.  Restructured WRSPECT to be more general for use with SPECTOOL and
+	put an SPLOT specific routine to handle the parameter queries.
+    (7/20/94, Valdes)
+
+t_sflip.x		+
+sflip.par		+
+doc/sflip.hlp		+
+x_onedspec.x
+mkpkg
+onedspec.cl
+onedspec.men
+onedspec.hd
+    Added a new task for flipping spectra.  (7/18/94, Valdes)
+
+splot/wrspect.x
+splot/splot.x
+smw/smwswattrs.x
+    Fixed a rather tricky bug with replacing a spectrum in the current
+    image with SPLOT.  (7/13/94, Valdes)
+
+splot/spdeblend.x	+
+splot/deblend.x
+splot/gfit.x
+splot/sumflux.x
+splot/eqwidth.x
+splot/splot.x
+splot.par
+t_fitprofs.x
+fitprofs.par
+doc/splot.hlp
+doc/fitprofs.hlp
+    1.  Separated the SPLOT specific delending routine from the mathematical
+        deblending routines called by the various gaussian fitting routines.
+    2.  Replaced deblending code with a version that uses a sigma array
+	and subsampling of the pixels.  This version also allows contraining
+	the relative line strengths but this feature is not used by
+	SPLOT of FITPROFS.
+    3.  Added constant noise and inverse gain parameters to SPLOT and FITPROFS.
+    4.  If a sigma0 and inverse gain are specified the deblending estimates
+	errors in the fit parameters using Monte-Carlo simulation.  The
+	errors are recorded in the log and :show output.  This was
+	added to both SPLOT and FITPROFS.
+    5.  If a sigma0 and inverse gain are specified the centroid, flux, and
+	equivalent width estimates (from 'e' key) include error estimates.
+	The errors are recorded in the log and :show output.
+    (7/12/94, Valdes)
+
+dispcor/t_dispcor.x
+dispcor/dcio.x
+    1.  Added a check for the existence of both IDENTIFY and ECIDENTIFY
+	database files for the same image.
+    2.  The recent errcode check addition (5/20) was incorrect in that
+	it would not proceed to look for an ECIDENTIFY file if no
+	IDENTIFY file was found; i.e. echelle data would fail.  The
+	appropriate checking of errors is now done.
+    (7/11/94, Valdes)
+
+t_dopcor.x
+    The verbose output was enhanced to show the old redshift in the case
+    of adding to warn a user.  This only applies to multispec images
+    which store the redshift separately.  (7/7/94, Valdes)
+
+t_sbands.x
+    Instead of passing a file name to the routine which reads the bandpass
+    descriptions a file descriptor is not passed.  This allows the
+    calling procedure to use either a file or a string file.
+    (6/30/94, Valdes)
+
+doc/sbands.hlp
+doc/splot.hlp
+    Typo fixes.  (6/30/94, Valdes)
+
+doc/dopcor.hlp
+    Made a slight change to description of isvelocity to make as clear as
+    possible that velocities are relativistic and not c*z velocities.
+    (6/30/94, Valdes)
+
+t_rstext.x	+
+rstext.par	+
+rspectext.cl
+x_onedspec.e
+onedspec.cl
+mkpkg
+    Added a compiled task to reformat the input RSPECTEXT file into the
+    formats needed by RTEXTIMAGE and DISPCOR and modified RSPECTEXT
+    to use it.  This improves the speed of this script task enormously for
+    large input text files since the CL facilities can be slow.
+    (6/20/94, Valdes)
+
+splot/wrspect.x
+    Failed to initialize a pointer to NULL.  This became a seg vio after the
+    changes for the BANDID info.  (6/15/94, Valdes)
+
+scombine/generic/iccclip.x
+scombine/generic/icsclip.x
+    Found and fixed another typo bug.  (6/7/94, Valdes/Zhang)
+
+scombine/generic/icaclip.x
+scombine/generic/iccclip.x
+scombine/generic/icpclip.x
+scombine/generic/icsclip.x
+scombine/generic/icgrow.x
+scombine/generic/icmedian.x
+    The restoration of deleted pixels to satisfy the nkeep parameter
+    was being done inside the iteration loop causing the possiblity
+    of a non-terminating loop; i.e. pixels are rejected, they are
+    restored, and the number left then does not statisfy the termination
+    condition.  The restoration step was moved following the iterative
+    rejection.
+
+    There was a bug in how the restored points were added back when
+    mclip=no and there are multiple residuals with the same value.
+    
+    Also updated icgrow and icmedian.  All these files are the same
+    as the generic files from IMCOMBINE reduced to only the real datatype.
+    (6/13/94, Valdes)
+
+t_sbands.x
+    When scanning the bandpass file, if there was an filter file then
+    the scanning of the filter file caused the remaining scan of the
+    bandpass line to be terminated.  This was fixed by using getline
+    instead of fscan in the scanning the bandpass file.  (6/3/94, Valdes)
+
+doc/sbands.hlp
+    Fixed a discrepancy in the bandpass file description between the
+    description section and the examples.  (6/2/94, Valdes)
+
+splot/splot.x
+splot/splotcolon.x
+splot/splot.key
+splot.par
+doc/splot.hlp
+    Added an overplot options to permanently toggle overplotting.
+    (5/31/94, Valdes)
+
+scombine/icscale.x
+    The sigma scaling flag, doscale1, would not be set in the case of
+    a mean offset of zero though the scale factors could be different.
+    (5/25/94, Valdes/Zhang)
+
+scombine/generic/icsclip.gx
+    There was a missing line: l = Memi[mp1].  (5/25/94, Valdes/Zhang)
+
+scombine/generic/icaclip.x
+scombine/generic/iccclip.x
+scombine/generic/icpclip.x
+scombine/generic/icsclip.x
+    The reordering step when a central median is used during rejection
+    but the final combining is average was incorrect if the number
+    of rejected low pixels was greater than the number of pixel
+    number of pixels not rejected.  (5/25/94, Valdes)
+
+dispcor/dcio.x
+dispcor/t_dispcor.x
+    All warning messages were being converted to a single warning which
+    was not appropriate in all cases.  Added an errcode check.
+    (5/20/94, Valdes)
+
+============================
+V2.10.3beta internal release
+============================
+
+noao/lib/smw.h
+smw/shdr.x
+t_fitprofs.x
+t_sarith.x
+splot/wrspect.x
+    The spectrum data structure was modified so that it can contain
+    all the associated spectra such as the spectrum, raw spectrum,
+    sky, continuum, and sigma.  Also the STYPE field was changed
+    to an array of string pointers SID to contain the specturm
+    type strings for all the associated spectra.  Except for the
+    SID changes (in FITPROFS, SARITH, and SPLOT) the structure
+    changes are invisible to any spectral task.  (5/4/94, Valdes)
+
+scombine/icscale.x
+scombine/t_scombine.x
+    There is now a warning error if the scale, zero, or weight type
+    is unknown.  (5/2/94, Valdes)
+
+t_sfit.x
+sfit.par
+continuum.par
+doc/sfit.hlp
+doc/continuum.hlp
+    1.	The sample regions are now set to the task parameter after each
+	fit.  Previously this was only done for the first spectrum and
+	after that it was set to "*".
+    2.  A straightforward replication of the line selection mechanism
+	to allow band selection was added.
+    (4/29/94, Valdes)
+
+identify/t_reidentify.x
+    The refit=no options would not work if there was not dispersion
+    function even though it makes sense to do so.  It was case of
+    the if clauses not being defined correctly.  (4/28/94, Valdes)
+
+dispcor/dcio.x
+    A possibly very useful and common case is when IDENITFY/REIDENTIFY
+    are used on previously dispersion corrected data to get only a
+    shift with no dispersion function.  DISPCOR was modified to
+    allow this case.  (4/21/94, Valdes)
+
+scombine/iclog.x
+    Changed the mean, median, mode, and zero formats from 6g to 7.5g to
+    insure 5 significant digits regardless of signs and decimal points.
+    (4/13/94, Valdes)
+
+noao/lib/smw.h
+smw/shdr.x
+    The standard spectrum data structure now includes a pointer for a
+    continuum spectrum.  Currently it is unused.  (4/12/94, Valdes)
+
+scombine/icscale.x
+    When the combine object is "sum" the task attempts to compute the
+    total exposure time.  Since a missing exposure time is represented
+    as INDEF this caused an arithmetic error.  The task was modified to
+    not compute or output a total exposure time if any of the spectra
+    have an undefined exposure time.  (4/11/94, Valdes)
+
+identify/idmark.x
+    Changed the mark and mark label color to be the tick label color
+    currently in effect.  Eventually the user should have more control
+    over the color but this cannot be done without changing GTOOLS or
+    IDENTIFY more than is appropriate at the moment.  (4/11/94, Valdes)
+
+doc/identify.hlp
+    Fixed a typo in the description of the Legendre polynomial formula.
+    (4/11/94, Valdes)
+
+smw/shdr.x
+    The case of DC-FLAG=-1 was not being handled by shdr_lw and shdr_wl.
+    (4/9/93, Valdes)
+
+smw/shdr.x
+    The flux units were not being copied when the spectrum header is
+    copied.  (3/31/94, Valdes)
+
+t_sarith.x
+    The string used to read in the aperture, band, and beam lists was
+    SZ_FNAME which is too short for possible input lines.  Changed
+    the lengths to SZ_LINE.  (3/31/94, Valdes)
+
+splot.par
+    Changed the mode of line and band to be query so that if SPLOT is run
+    from epar line and band queries will still be made.  (3/21/94, Valdes)
+
+scombine/generic/icaclip.x
+scombine/generic/iccclip.x
+scombine/generic/icsclip.x
+    The image sigma was incorrectly computed when an offset scaling is used.
+    (3/8/94, Valdes)
+
+smw/shdr.x
+    The call to shdr_units can specify "default" to restore the original
+    units.  (3/7/94, Valdes)
+
+smw/shdr.x
+splot/wrspect.x
+t_sarith.x
+t_fitprofs.
+    Fixed problems when NP1 > 1 due to a IMSHIFT operation that moves
+    the first physical pixel higher logical coordinates (or the
+    first logical pixel in the image corresponds to a negative
+    physical pixel coordinate).  (3/5/94, Valdes)
+    
+t_deredden.x
+    Fixed bug causing memory corruption.  (3/2/94, Valdes)
+
+scombine/icscale.x
+scombine/iclog.x
+    1.  The exposure time was not being summed when summing spectra.
+    2.  The exposure time is now printed whenever the exposure time is used
+	even if the times are all equal.
+    (2/24/94, Valdes)
+
+t_deredden.x
+doc/deredden.hlp
+    Overriding a previous correction will apply to the original data
+    rather than being incremental.  (2/23/94, Valdes)
+
+smw/shdr.x
+noao$lib/smw.h
+    Added structure fields for the flux units and shdr_open sets the
+    field if possible.  The flux units are determined first by any
+    BUNIT keyword, then if the flux calibration flag is set by
+    the magnitude of the data.  (2/22/94, Valdes)
+
+smw/funits.x		+
+noao$lib/funits.h	+
+    Added a flux units package.  (2/21/94, Valdes)
+
+smw/shdr.x
+    Added a routine to change the units.  (2/19/94, Valdes)
+
+splot/usercoord.x
+    The routine was not correct for input log-linear spectra (dc-flag=1).
+    (2/19/94, Valdes)
+
+dispcor/dispcor.x
+    Fixed typo (out[1] -> out[i]) which was causing the non-flux conserving
+    mode to fail.  (2/18/94, Valdes)
+
+splot.par
+specplot.par
+doc/splot.hlp
+doc/specplot.hlp
+    1.  SPLOT will write out the current display units to the WCS attribute
+	"units_display".
+    2.  The default "units" task parameter now has the null string value
+	to allow selecting the units given by "units_display" or the WCS
+	units in that order.  (2/18/94, Valdes)
+
+smw/smwsaveim.x
+smw/smwesms.x
+smw/smwmerge.x
+smw/smwndes.x
+smw/shdr.x
+    1.  A new WCS attribute "units_display" has been defined.  It is now
+	stored in the image and transfered when copying WCS if it is defined.
+    2.  When a spectrum is opened with shdr_open the user units are set
+	to that specified by "units_display" if present.  Otherwise
+	the units of the WCS are used.
+	(2/18/94, Valdes)
+
+noao$lib/smw.h
+shdr.x
+    Added a field to the standard spectrum data structure to contain an
+    error array.  This array is filled in by shdr_open if a new flag
+    value is used.  Since there are no current tasks which use the
+    new value this feature is unused in current tasks.  (2/7/94, Valdes)
+
+noao$lib/smw.h
+t_fitprofs.x
+t_sarith.x
+splot/wrspect.x
+smw/smwsaveim.x
+    Added a field to the standard spectrum data structure to contain the
+    type of spectrum; i.e. spectrum, background, sigma.  This type is
+    stored in the BANDIDn keywords for multispec format data extracted by
+    APEXTRACT.  This information, if present, is now updated on outputing a
+    new spectrum.  This is particularly important for SCOPY when the bands
+    are adjusted.  (2/4/94, Valdes)
+
+dispcor/t_dispcor.x
+    Deleted unused variable, junk, which somehow snuck in.  (2/7/94, Valdes)
+
+t_specplot.x
+specplot.key
+doc/specplot.hlp
+    Extended the :units command to allow specifying individual spectra.
+    This is intended to allow multiple spectra to be plotted on a velocity
+    scale with different zero points.  (2/4/94, Valdes)
+
+smw/shdr.x
+smw/smwmw.x
+    Added checks for the aperture number to be outside of the range of
+    spectra in N-dimensional spectra.  (1/8/94, Valdes)
+
+splot/splot.x
+splot/splotcolon.x
+splot/splot.key
+doc/splot.hlp
+splot.par
+    A new options, "flip", has been added to select plotting the spectra
+    in decreasing wavelength.  (12/8/93, Valdes)
+
+dispcor/dispcor.x
+doc/dispcor.hlp
+    When flux=no DISPCOR now computes an average across the output pixel
+    rather than interpolating to the pixel center.  This allows
+    flux density conservation.  (12/6/93, Valdes)
+
+identify/idinit.x
+    Changed aclrr to aclri.  (12/1/93, Valdes)
+
+doc/identify.hlp
+    Added a description of the function coefficients. (12/1/93, Valdes)
+
+t_calibrate.x
+    Added a warning if the exposure time is not found.  (11/19/93, Valdes)
+
+sensfunc/sfoutput.x
+    Instead of using the dispersion range from a single standard star
+    the code now uses the maximum range and minimum dispersion.
+    (11/15/93, Valdes)
+
+t_sbands.x	+
+sbands.par	+
+doc/sbands.hlp	+
+x_onedspec.x
+onedspec.cl
+onedspec.men
+onedspec.hd
+mkpkg
+    Added a new task to do bandpass spectrophotometry.  (11/1/93, Valdes)
+
+rspectext.cl
+wspectext.cl
+doc/rspectext.hlp
+doc/wspectext.hlp
+onedspec.cl
+onedspec.men
+onedspec.hd
+    Added two script tasks to convert between 1D image spectra and
+    ascii text spectra.  (10/22/93, Valdes)
+
+splot/splot.x
+splot/getimage.x
+splot/splotfun.x
+doc/splot.hlp
+    If a wavelength scale is set with 'p' or 'u' then all subsequent
+    spectra which are not dispersion calibrated will use that wavelength
+    scale.  (9/2/93, Valdes)
+
+t_sapertures.x
+    The negative beam number warning is only issued if verbose = yes.
+    (9/1/93, Valdes)
+
+dispcor/t_dispcor.x
+smw/smwesms.x
+    The aperture IDs were not being properly propagated.  (9/1/93, Valdes)
+
+t_fitprofs.x
+fitprofs.par
+doc/fitprofs.hlp
+    1.  Fixed bug with close MWCS
+    2.  Add a bands parameter for 3D images.
+    (8/31/93, Valdes)
+
+t_deredden.x
+    There was an error in freeing the sh pointer causing a segmentation
+    violation after the spectra are successfully dereddened.  (8/13/93, Valdes)
+
+splot/splot.x
+doc/splot.hlp
+    The '(' and ')' keys will now cycle in bands if there is only one line.
+    (8/10/93, Valdes)
+
+t_sapertures.x
+    Modified to ignore attempts to set a negative beam number.
+    (8/9/93, Valdes)
+
+splot/wrspect.x
+    Added check against an error opening an output image in shdr_open.
+    (8/4/93, Valdes)
+
+splot/fudgex.x
+    Added check against a divide by zero if the cursor is not moved.
+    (8/4/93, Valdes)
+
+splot/splotcolon.x
+    The call to ans_hdr in the COMMENT case was missing the key argument.
+    (8/3/93, Valdes)
+
+smw/smwonedspec.x
+    For spectra which are dispersion corrected (DC-FLAG set) but have no
+    units the code was setting the "label" rather than "units" to
+    "angstroms".  (8/3/93, Valdes)
+
+============
+V2.10.3 beta
+============
+
+splot.par
+splot/smooth.x
+doc/splot.hlp
+    1.  The parameter file parameter prompt for the smoothing box size was
+	modified to request an odd number.
+    2.  If an even number is given, a warning is printed.
+    3.  The help for the parameter boxsize indicates the the value must
+	be odd.
+    (6/28/93, Valdes)
+
+scombine/icscale.x
+    The result of reading an @file for the zero or weight parameter was
+    being placed in the scales array.  This has been fixed.  This
+    affected only one IRAFX users.  (6/28/93, Valdes)
+
+specplot.key
+    Added missing :redshift and :velocity commands in the summary.  Also
+    sorted and cleaned up the multicolumn lists.  (6/15/93, Valdes)
+
+t_dopcor.x
+dopcor.par
+doc/dopcor.hlp
+    An new parameter has been added to allow combining sequential
+    corrections in "multispec" format spectra.  (6/15/93, Valdes)
+
+usercoord.x
+wrspect.x
+t_dopcor.x
+    When smw_swattrs is called it is possible that the smw pointer will be
+    changes (promoting an equispec format to multispec).  If this happens
+    and the pointer is part of an open shdr structure then the routine
+    must invalidate the mwcs stuff and possibly open or update the shdr
+    structure.  (6/14/93, Valdes)
+
+bplot.cl
+doc/bplot.hlp
+    The query parameters from SPLOT were added as hidden parameters in
+    BPLOT to allow such things as writing output spectra without generating
+    queries.  (6/8/93, Valdes)
+
+identify/ididentify.x
+    Added newlines when printing to the status line.  This is needed when
+    redirecting the output to a file in the IMRED scripts.  (6/4/93, Valdes)
+   
+identify/iddelete.x
+    The label pointers needed to be updated when deleting a feature.
+    (6/4/93, Valdes)
+
+t_specplot.x
+    Modified the log output format to include the aperture number.
+    (5/25/93, Valdes)
+
+t_sarith.x
+t_fitprofs.x
+wrspect.x
+    The conversion from logical to physical coordinates was incorrect in
+    that it truncated the physical coordinates.  This could cause a subtle
+    error in the coordinate system.  (5/20/93, Valdes)
+
+identify/idmap.x
+    The user specified vector axis is interpreted as a logical axis rather
+    than a physical axis.  This is only significant for transposed images.
+    (5/14/93, Valdes)
+
+smw/smwsaxes.x
+smw/smwsaveim.x
+    Transposed NDSPEC images are now allowed.  (5/11/93, Valdes)
+
+getcalib.x
+    Added a search for alternate standard names in a file <caldir>names.men
+    if that file is present.  (5/4/93, Valdes)
+
+splot/splot.x
+splot/anshdr.x
+splot/avgsnr.x
+    Added logging of the 'm' key output.  (5/4/93, Valdes)
+
+splot/splot.x
+splot/splotfun.x
+    1.  fun_do was not initializing the pointers passed to getimage.
+	This proves to be a problem if an error occurs in getting the
+	second image data, such as due to a mistype, so that the
+	next time the routine is called an invalid pointer is found
+	and a segmentation error occurs.
+    2.  Added a time delay on an error message in fun_do followed by the
+	function mode prompt.
+    (3/2/93, Valdes)
+
+sensfunc/sfstds.x
+    1.  Eliminated input stars/apertures that have no data.
+    2.  Eliminated input flux points outside the range of the
+	star/aperture wavelength range.
+    3.  Improved the iterative fitting to drop back to a polynomial
+	function if the lowest order spline does not fit.
+    (2/12/93, Valdes)
+
+identify/idgraph.x
+    Because these procedures used the SX array as temporary storage it
+    caused the initialize option to fail.  (2/3/92, Valdes)
+
+onedspec.men
+    Removed reference to dispaxis.  (1/21/93, Valdes)
+
+scombine/generic/icaclip.x
+scombine/generic/iccclip.x
+scombine/generic/icpclip.x
+scombine/generic/icsclip.x
+    When using mclip=yes and when more pixels are rejected than allowed by
+    the nkeep parameter there was a subtle bug in how the pixels are added
+    back which can result in a segmentation violation.
+	if (nh == n2)  ==>  if (nh == n[i])
+    (1/20/93, Valdes)
+
+sensfunc/sensfunc.h
+sensfunc/sfgraph.x
+sensfunc/sfginit.x
+sensfunc/sfimage.x
+sensfunc/sfcgraph.x
+sensfunc/sfextinct.x
+sensfunc/sfcolors.x
+sensfunc/sfcolon.x
+sensfunc/sfmove.x
+sensfunc/sfundelete.x
+sensfunc/sfdelete.x
+sensfunc/sfadd.x
+sensfunc/mkpkg
+sensfunc/sensfunc.key
+sensfunc.par
+doc/sensfunc.hlp
+    Added color support. (12/17/92, Valdes)
+
+splot/gfit.x
+splot/eqwidthcp.x
+splot/deblend.x
+splot/splot.x
+identify/idmark.x
+    Added color support.  (12/8/92, Valdes)
+
+splot/sumflux.x
+    1.  There was no check of whether esum was INDEF (a possible value) before
+        multiplying by wpc.  A check was added.
+    2.  Because of a change to fp_equalr which occured on (10/18) the
+        equivalent widths of flux calibrated data would be INDEF.  To
+	compensate the test is made on scaled data.
+	(12/7/92, Valdes)
+
+units.h
+    The conversion factors for millimeter and centimeter were off by a
+    factor of 10.  (12/4/92, Valdes)
+
+dispcor/dcio.x
+    The wrong axis was selected in computing the logical NW.  (11/24/92, Valdes)
+
+splot/splot.x
+splot/usercoord.x
+splot/splot.key
+splot/mkpkg
+doc/splot.hlp
+splot.par
+    Changed the 'u' and 'p' keys to include additional ways to adjust the
+    dispersion scale.  In particular a doppler and zeropoint adjustment can
+    be made using the cursor and entering a coordinate.  Note that these
+    two adjustments apply to all coordinate systems and units and do not
+    require assuming a linear dispersion.  In effect these are interactive,
+    cursor marking versions of DOPCOR (without the flux correction) and
+    SPECSHIFT.  The coordinates are specified in the current displayed
+    units.  The code that does the adjustment is now well integrated with
+    the MWCS rather than fudging the W0 and WP entries.  The output of a
+    new spectrum with 'i' will properly handle the adjusted coordinate
+    system.  (11/20/92, Valdes)
+
+bplot.cl
+irsiids/bplot.cl
+doc/bplot.hlp
+gcurval -> gcurval.dat
+    Changed the name of the default cursor file to avoid stripping.
+    (11/20/92, Valdes)
+
+splot/wrspect.x
+    Fixed typo affecting 3D images:  PNDIM(out) --> PNDIM(sh2).
+    (11/19/92, Valdes)
+
+splot/wrspect.x
+    A spectrum was being written using the W0, WPC of the current units
+    rather than Angstroms as it should be.  A call to un_ctran to convert
+    to the MWCS units was added.  (11/17/92, Valdes)
+
+t_specplot.x
+specplot.h
+doc/specplot.hlp
+specplot.key
+    Added a color parameter for specifying the color of each spectrum
+    on color graphics terminals.  (10/30/92, Valdes)
+
+t_sarith.x
+t_fitprofs.x
+splot/wrspect.x
+    1.	The doppler correction was still not properly handled.  Instead of
+	dividing by (1 - z) it should multiple by (1 + z) in order to
+	be symmetric with the WCS driver.
+    2.  To avoid roundoff with multispec format W0 and W1 (which are real)
+	are not used when recalculating the w1, dw attribute values.  Instead
+	shdr_lw is called to get the double precision values.
+	(10/16/92, Valdes)
+
+dispcor/t_dispcor.x
+dispcor/dcio.x
+doc/dispcor.hlp
+    DISPCOR will now allow multiple uses of IDENTIFY dispersion solutions
+    in a simple way with but with continuing protection against accidental
+    multiple uses of the same dispersion solutions.  When a spectrum is
+    first dispersion corrected using one or more reference spectra keywords
+    the dispersion flag is set and the reference spectra keywords are moved to
+    DCLOGn keywords.  If DISPCOR is called again without setting new
+    reference spectra keywords then the spectra are resampled (rebinned)
+    using the current coordinate system.  If new reference spectra are set
+    then DISPCOR will apply these new dispersion functions.  Thus the user
+    now explicitly enables multiple dispersion functions by adding
+    reference spectra keywords and DISPCOR eliminates accidental multiple
+    uses of the same dispersion function by renaming the reference
+    spectra.  The renamed keywords also provide a history.
+
+    Some additional log and verbose output was added to better inform the
+    user about what is done.
+    (10/15/92, Valdes)
+
+t_specshift.x		+
+specshift.par		+
+doc/specshift.hlp	+
+x_onedspec.x
+mkpkg
+onedspec.cl
+onedspec.men
+onedspec.hd
+imred$argus/argus.cl
+imred$ctioslit/ctioslit.cl
+imred$echelle/echelle.cl
+imred$hydra/hydra.cl
+imred$iids/iids.cl
+imred$irs/irs.cl
+imred$kpnocoude/kpnocoude.cl
+imred$kpnoslit/kpnoslit.cl
+imred$specred/specred.cl
+imred$argus/argus.men
+imred$ctioslit/ctioslit.men
+imred$echelle/echelle.men
+imred$hydra/hydra.men
+imred$iids/iids.men
+imred$irs/irs.men
+imred$kpnocoude/kpnocoude.men
+imred$kpnoslit/kpnoslit.men
+imred$specred/specred.men
+    The new task SPECSHIFT applies a coordinate system shift to selected
+    spectra.  For linear coordinate systems this is done by changing
+    the wavelength of the first physical pixel.  For nonlinear systems
+    the existing shift coefficient is adjusted.
+    (10/14/92, Valdes)
+
+dispcor/dcio.x
+    Added step to update the linear part of the nonlinear WCS.
+    This is mostly cosmetic.
+    (10/14/92, Valdes)
+
+dispcor/idmap.x
+    Changed the way the image is opened to avoid updating the WCS.
+    (10/14/92, Valdes)
+
+*doc/onedspec.hlp
+smw.x
+    1.  Spectra in a single image which all have the same linear dispersion
+	are now stored with linear axis types.  This gives a simpler header
+	structure than the multispec axis type for this common case.  This
+	modification applies to 1, 2, and 3 dimensional images.
+    2.  Extensions were added to allow importing spectra which use
+	a different WCS driver than multispec or linear.
+    (10/13/92, Valdes)
+
+doc/onedspec.hlp
+    First an error in a font switch causing part of the text to all be in
+    standout.  (10/9/92, Valdes)
+
+scombine/t_scombine.x
+scombine/icombine.h
+scombine/icombine.com
+scombine/icombine.x
+scombine/icscale.x
+scombine/iclog.x
+scombine/generic/iccclip.x
+scombine/generic/icsclip.x
+scombine/generic/icpclip.x
+scombine/generic/icaclip.x
+scombine/generic/icgrow.x
+scombine.par
+doc/scombine.hlp
+    The weighting was changed from using the square root of the exposure time
+    or spectrum statistics to using the values directly.  This corresponds
+    to variance weighting.  Other options for specifying the scaling and
+    weighting factors were added; namely from a file or from a different
+    image header keyword.  The \fInkeep\fR parameter was added to allow
+    controling the maximum number of pixels to be rejected by the clipping
+    algorithms.  The \fIsnoise\fR parameter was added to include a sensitivity
+    or scale noise component to the noise model.
+    (10/2/92, Valdes)
+
+splot/usercoords.x
+    This routine no longer puts a default value in the wavelength parameters.
+    This will allow using SPLOT to noninteractively set wavelengths.
+    (9/17/92, Valdes)
+
+identify/idfitdata.x
+identify/idmark.x
+identify/idgdata.x
+identify/idcenter.x
+    IDENITFY/REIDENTIFY use the standard SHDR interface which eliminates
+    data with negative physical coordinates.  This occurs because NP1 is
+    then computed to be positive.  The case where this can occur is using
+    IMSHIFT with a positive shift though explicit use of NP1 could also do
+    it.  However, the above routines use the MWCS logical-physical and
+    physical-logical conversions without accounting for NP1.  This results
+    in incorrect results.  The routines were fixed to apply NP1.  (9/16/92,
+    Valdes)
+
+splot/splot.x
+splot/getimage.x
+    Modified getimage to also allow specification of the aperture.  This
+    is needed in order for the scrolling through lines, the '(' and ')'
+    keys, to work correctly by indicating that the aperture number is
+    to be ignored.  (9/8/92, Valdes)
+
+dispcor/dcio.x
+    The computation of the aperture center was not prepared to deal with
+    INDEF aperture limits.  (9/3/92, Valdes)
+
+smw.x
+    There was a type mismatch when setting aplow and aphigh to INDEF.
+    Changed to set them to INDEFD.  This bug caused the APLOW and APHIGH
+    keywords to appear in the image header unexpectedly with IDENTIFY
+    on the VaxStation port.  (8/31/92, Valdes)
+
+ecidentify/ecgetim.x
+identify/idnoextn.x
+    The algorithm for stripping the image extension could get confused
+    with the name such as ec025.john.ec --> ec025n.ec.  The routines
+    were modified to use xt_imroot which does a better job.  (8/31/92, Valdes)
+
+t_sarith.x
+smw.x
+    Added provision to save multispec title in MSTITLE keyword when
+    separating out multispec spectra or converting to simple 1D format and
+    to restore the title when combining 1D spectra into a multispec
+    spectrum.  (8/24/92, Valdes)
+
+sensfunc/sfsvstats.x
+    A real variable was used where a double should have been giving round
+    off errors in the computation of the standard deviation.  (8/13/92, Valdes)
+
+t_sfit.x
+    Output images are of type real regardless of the input type.
+    (8/11/92, Valdes)
+
+scombine/icscale.x
+    The zero level offsets were being incorrectly scaled twice.
+    (8/10/92, Valdes)
+
+dispcor/refgspec.x
+    Arguments incompatible with intrinsic function:
+	sortval = mod (sortval + 24. - timewrap, 24.)
+    Changed second 24. to 24.0D0.  (8/10/92, Valdes)
+
+splot/fixx.x
+    Arguments incompatible with intrinsic function:
+	z1 = max (0.5, min (double (SN(sh)+.499), shdr_wl(sh, z1)))
+	z2 = max (0.5, min (double (SN(sh)+.499), shdr_wl(sh, z2)))
+    The 0.5 should be double.  (8/10/92, Valdes)
+
+shdr.x
+    Arguments incompatible with intrinsic function:  on lines 268-269,
+    319-320, need to real the image limits.  (8/10/92, Valdes)
+
+units.x
+onedspec.hlp
+    The velocity label was changed to "cz velocity" to show that it
+    is c*z and not a true velocity.  (7/30/92, Valdes)
+
+dispcor/t_dispcor.x
+    Changed WCSDIM to be 3 in the case of a 3D image.  (7/27/92, Valdes)
+
+splot/splot.x
+    Getttng a new image always forces the data to be read even if the
+    same image is given.  (7/20/92, Valdes)
+
+smw.x
+    Altered the way in which old APNUM keywords are deleted to avoid
+    a problem with the limit on the number of keywords that can be
+    mapped with imofnl in the imio$db package.  (7/17/92, Valdes)
+
+splot/replot.x
+    Replaced gascale with gt_ascale to do the autoscaling only within
+    the GTOOLS window.  (7/16/92, Valdes)
+
+t_sapertures.x
+sapertures.par
+doc/sapertures.hlp
+    Modified this task to allow resetting the WCS to pixels and changing
+    any of the WCS fields.  (7/2/92, Valdes)
+
+splot/wrspect.x
+    Harmless typo fix mwopen -> mw_open.  (7/1/92, Valdes)
+
+t_sarith.x
+    Modified to properly handle 3D images.  (7/1/92, Valdes)
+
+t_sarith.x
+    Onedspec output format now splits out the bands as well.
+    (7/1/92, Valdes)
+
+=======
+V2.10.2
+=======
+
+t_dopcor.x
+doc/dopcor.hlp
+    1.  The conversion from velocity to z was incorrect.
+    2.  Checks were added for reasonable velocities and redshifts.
+    3.  A negative sign for a header parameter changes the sense of
+	a redshift if the parameter is a redshift.
+
+=======
+V2.10.1
+=======
+
+t_deredden.x
+    The declaration for decode_ranges was incorrect.  Changed from bool to int.
+    (7/21/92, Valdes)
+
+shdr.x
+    1.  An earlier fix left the aaxis parameter undefined for longslit images.
+    This meant that references to IM_LEN(im,aaxis) yield the dimension
+    of the image rather than the axis length.
+    2.  Discovered that image sections don't automatically reset the lengths
+    of the higher dimensions to 1 as assumed in several tasks.  SHDR now
+    resets these.  (7/20/92, Valdes)
+
+=======
+V2.10.0
+=======
+
+irsiids/batchred.cl
+    The parameter "recformat" in STANDARD and CALIBRATE and "apertures" in
+    CALIBRATE are no longer present.  The BATCHRED task was modified to not
+    add these parameters to the PROCESS script.  (7/6/92, Valdes)
+
+shdr.x
+    The resampling in shdr_linear and shdr_rebin is now an average rather
+    than a sum.  (6/23/92, Valdes)
+
+splot/wrspect.x
+    New output spectra are created type real.  (6/22/92, Valdes)
+
+scombine/icscale.x
+scombine/t_scombine.x
+    The exposure time is only required now if scaling or weighting by
+    the exposure time.  (6/22/92, Valdes)
+    
+mwcs$wfmspec.x
+    The inverse coordinate transform could fail in some cases.  An extra
+    check was added to avoid this.  (6/17/92, Valdes)
+
+smw.x
+    Added special case to convert a 2D image which has a second dimension
+    length of 1 to a 1D image.  Note this is different than a 1D section
+    of a 2D image.  (6/17/92, Valdes)
+
+shdr.x
+    Added additional check for a 2D image with the dispersion axis
+    along a dimension of length 1; for example [800,1] with dispaxis=2.
+    This will also give an warning and then choose the appropriate
+    axis.  (6/17/92, Valdes)
+
+t_sarith.x
+t_fitprofs.x
+splot/wrspect.x
+    The doppler correction was not properly handled when creating a new
+    output spectrum.  (6/17/92, Valdes)
+
+shdr.x
+    The change to catch an inappropriate dispersion axis for TWODSPEC
+    images was not complete.  I'm not fully sure anymore what should be
+    done but I made the checking better. (6/3/92, Valdes)
+
+t_sinterp.x
+    Change the roundoff when computing the number of pixels to nearest
+    integer.  (6/3/92, Valdes)
+
+scombine/t_scombine:
+    There was a bug in which the j loop index was redefined in the loop
+    when checkin the MINMAX rejection limits.  (6/1/92, Valdes)
+
+t_sarith.hlp
+    Needed to allocate the coeff pointer in sa_1d.  Attempting to copy
+    a long slit spectrum to onedspec format caused a segmentation violation.
+    (5/27/92, Valdes)
+
+doc/scopy.hlp
+doc/sarith.hlp
+    The examples incorrectly showed nsum to be a task parameter.
+    (5/21/92, Valdes)
+
+bplot.cl
+    The error when a nonexistent image was specified was not properly
+    handled.  (5/18/92, Valdes)
+
+splot/splot.key
+    Clarified 'o' key description.  (5/14/92, Valdes)
+
+smw.x
+scombine/t_scombine.x
+    1. Added additional commands to delete keywords which should not be
+       present.
+    2. When mapping the output image a copy of the input image header is
+       made.  This header may contain WCS keywords which are invalid.
+       A call is now made to smw_openim() which has the effect of cleaning
+       up the header.
+    (5/14/92, Valdes)
+
+=====
+V2.10
+=====
+
+doc/*.hlp
+doc/sys/onedv210.ms +
+    Make documentation changes to allow all revisions to be obtained with
+    "help onedspec.* sec=rev".  The package revisions summary was prepared
+    and installed.  (5/6/92, Valdes)
+
+splot/splot.x
+splot/splotcolon.x
+splot/splot.key
+splot.par
+doc/splot.hlp
+    1.	Added the option "wreset" to have the graph limits automatically
+	restored to the initial values for each new spectrum.
+    2.  Added colon commands to change the options interactively.
+    (5/6/92, Valdes)
+
+shdr.x
+    A 1D image section of a 2D (not multispec) image which is not along
+    the specified dispersion axis will now print a warning and use the
+    specified axis rather than aborting.  (5/6/92, Valdes)
+
+smw.x
+shdr.x
+    Added checks in the case of log-linear dispersion (DC-FLAG=1) that
+    the coordinates make sense.  Otherwise a linear dispersion is used.
+    This comes up when DC-FLAG is set to 1 but the other coordinate
+    information is incorrect or missing resulting in pixel coordinates.
+    Without this check there would be an attempt to take the dex of
+    a pixel coordinate causing a floating overflow error.
+    (5/5/92, Valdes)
+
+identify/t_reidentify.x
+    Added call to strip whitespace from the reference image name
+    accidentally entered by the user.  Extra whitespace  caused a
+    mysterious behavior in finding a database entry which was hard
+    to track down.
+    (5/1/92, Valdes)
+
+identify/idinit.x
+    Added check to not unmap the database if it was never openned.
+    This would cause a segmentation error if a database was never
+    accessed.
+    (5/1/92, Valdes)
+
+identify/iddb.x
+identify/t_reidentify.x
+identify/identify.h
+    The database interaction was poorly done resulting in repeatedly
+    opening and reading the database file.  If there are many entries this
+    becomes very slow.  The DTTEXT routines were modified to add a remap
+    routine allowing a database file to remain open but automatically
+    closing and opening a new database if the database name changes.  It
+    also allows changing access modes by closing and opening the file but
+    leaving the rest of the data structure alone. This avoids the need to
+    rescan the file each time the access mode changes and allows existence
+    checks for entries (from the original scan) while still in APPEND mode
+    without having to switch file access modes.  The identify structure was
+    extended to include the database pointer so that id_dbread and
+    id_dbwrite could use the remap routine without closing the database
+    between calls.  Thus, repeated calls to id_dbread and id_dbwrite for
+    the same image are much more efficient and the database is only scanned
+    once in the first read.  There is still a slight inefficiency in that
+    switching between reading and writing requires reopening the file.  For
+    the purposes of simple checking for existing entries without needing to
+    read the entry and change modes a new routine id_dbcheck was added.
+    Finally, the logic in REIDENTIFY was modified so that repeated mode
+    switches between reading and writing are avoided.  The id_dbcheck
+    routine is used when override checking is enabled.  REIDENTIFY
+    is now much faster when dealing with large numbers of spectra in
+    images (long slit with a fine step size or multifiber spectra with
+    many fibers).  (4/30/92, Valdes)
+
+smw.x
+    An axis map is set for 1D multispec images.  (4/27/92, Valdes)
+
+shdr.x
+    Shdr_system was changing the wrong pointers causing later calls to
+    shdr_open to produce an invalid coordinate system.  (2/18/92, Valdes)
+
+scombine/t_scombine.x
+scombine/iclog.x
+scombine/icscale.x
+scombine/icombine.x
+scombine.par
+doc/scombine.hlp
+    1.  The gain and read noise must be read when the image is open and
+    	are stored in the RA and DEC spectrum structure parameters.
+    2.  NCOMBINE is not used on input.
+    3.  The exposure time is taken from the spectrum structure and the
+        keyword name is no longer a parameter.
+    (2/12/92, Valdes)
+
+scombine/icscale.x
+    Changed action for negative scaling, etc. to a warning.
+    (2/10/92, Valdes)
+
+calibrate.par
+sensfunc.par
+standard.par
+onedspec.par
+doc/calibrate.hlp
+doc/sensfunc.hlp
+doc/standard.hlp
+doc/package.hlp
+    1. Redirected observatory parameter to package parameter
+    2. Added observatory package parameter
+    (2/6/92, Valdes)
+
+ecidentify/ecdofit.x
+ecidentify/ecffit/ecfcolon.x
+    1.  The rejected points were not being reset between fits resulting in
+	misleading RMS values.
+    2.  Expanded the :show in fit mode.
+    (2/6/92, Valdes)
+
+t_standard.x
+standard.key
+    1.  The abbreviation of N or Y for NO or YES is now allowed.
+    2.  The key file was moved from noaolib$scr to onedspec$
+    (2/6/92, Valdes)
+
+t_calibrate.x
+t_standard.x
+irsiids/t_bswitch.x
+    Converted from obsimcheck to obsimopen.  (2/4/92, Valdes)
+
+identify/*
+doc/identify.hlp
+    Added feature labels.  (1/30/92, Valdes)
+
+refspectra.par
+doc/refspectra.hlp
+dispcor/ref*
+    1.  Added group parameter
+    2.  Sort parameter is now used as a double
+    3.  If group or sort keywords are specified but not found it is a fatal
+	error.
+    (1/29/92, Valdes)
+
+t_sfit.x
+sfit.par
+continuum.par
+eccontinuum.par
+doc/sfit.hlp
+doc/continuum.hlp
+    Added the new "markrej" parameter used in ICFIT to control whether
+    rejected points are marked.  (1/21/92, Valdes)
+
+getcalib.x
+    The standard star parameter query will now print the file "standards.men"
+    in the calibration directory if the user supplied name does not match an
+    available file. (1/20/92, Valdes)
+
+irsiids/t_widstape.x
+    Modified the widstape task to support the new mag tape name syntax.
+    (1/7/92, Davis)
+
+identify/t_reidentify.x
+    If there is no dispersion function then no shift will now be computed.
+    (11/18/91, Valdes)
+
+ecidentify/ecffit/ecffit.x
+    Removed the progress print statements because they mess up the screen
+    clear on XTERM.  Someday it might be desirable to put them back again.
+    (11/11/91, Valdes)
+
+doc/bswitch.hlp
+    Fixed minor typo where the keyword BEAM-NUM was refered to as BEAM.
+    (6/19/91, Valdes)
+
+t_combine.x
+    1. The final coord scale must have WPC > 0.  Needed to add an abs(WPC)
+       in case an input spectrum had negative WPC.  (5/3/91, Valdes)
+
+getnimage.x
+t_bswitch.x
+    Moved procedure add_spec from getnimage.x to t_bswitch.x (4/25/91, Valdes)
+
+t_calibrate.x
+    MWCS modifications.  Aperture selection option removed.  (4/24/91, Valdes)
+
+splot/getimage.x
+splot/splotfun.x
+splot/splot.x
+splot/replot.x
+splot/autoexp.x
+    Modified to use separate coordinate array. (3/29/91, Valdes)
+
+iwewcs.x
+gmwcs.x
+wfinit.x
+wfmspec.x
+mwopenim1.x
+mkpkg
+idsm_keywrds.x
+load_hdr.x
+    Initial WCS modifications (3/28/91, Valdes)
+
+====
+V3.1
+====
+
+t_calibrate.x
+    Moved calibration messages outside of loop over bands.
+    (3/26/91, Valdes)
+
+ecidentify/ecidentify.x
+ecidentify.par
+    Added autowrite parameter which is similar to that of IDENTIFY.
+    (3/21/91, Valdes)
+
+ecidentify/ecffit/ecfsolve.x
+    The residual vector was not correctly set by ecf_solve.  (3/18/91, Valdes)
+
+t_scopy.x
+    1.  If no beam number is found for ONEDSPEC images it defaults to 1.
+    2.  The image titles are converted to APID for ONEDSPEC images
+	going to MULTISPEC if the title differs from the main MULTISPEC
+	title.
+    3.  Added checking for repeated aperture numbers in ONEDSPEC to
+	MULTISPEC.
+    (3/13/91, Valdes)
+
+identify/t_reidentify.x
+reidentify.par
+    Interactive parameter is now four valued to allow better control
+    of reidentification queries such as in the IMRED scripts.
+
+dispcor/ecio.x
+dispcor/ecdispcor.x
+    1. Fixed datatype error when reading the low and high values from the
+       APNUM keywords.
+    2. Added REFSHFT capability for use with the FOE package.
+    3. Added support for third dimension produced by APEXTRACT.
+    (1/31/91, Valdes)
+
+t_scopy.x
+    Fixed bugs in renumber option.  It was renumbering before checking the
+    aperture list rather than after.
+    (1/31/91, Valdes)
+
+ecdispcor.par
+    The parameter override needed to be changed to the parameter rebin.
+    (1/16/91, Valdes)
+
+identify/iddb.x
+    REIDENTIFY checked if an entry in the database was absent by checking for
+    an error return from id_dbread.  The error return was made without
+    first closing the database file.  When reidentifying a large number
+    of images/apertures the task would run out of file descriptors.
+    The fix was to put a database close statement before the error
+    call.  (1/7/91, Valdes)
+
+splot/getimage.x
+load_hdr.x
+    1.  Added error checking for aperture out of bounds in multispec format.
+    2.  Added automatic limit on band specification in multispec format.
+    3.  Added missing nband=0 for case of 1D image section.
+    (1/7/91, Valdes)
+
+identify/idlinelist.x
+    The 'l' did not find lines because the first pass to finding MAXFEATURES
+    did not discriminate against finding the same line with different
+    user coordinates.  This locked out weaker features during the finding.
+    Then when the features were added to the feature least the MINSEP
+    parameter eliminated the duplicates resulting in fewer than MAXFEATURES
+    features.  (12/19/90, Valdes)
+
+splot/stshelp.key
+splot/getimage.x
+splot/anshdr.x
+splot/mktitle.x
+splot/mkpkg
+splot/splotfun.x
+splot/splot.x
+splot/splot.key
+splot.par
+    1.  Added support for bands in 3D images.  This involved adding a
+	band task parameter and a '%' key.
+    2.  The 'o' overplot key is now a toggle for the next graph.  It
+	does not query for the image.  The user follows 'o' with 'g',
+	'#', or '%'.
+    (12/19/90, Valdes)
+
+splot/deblend.x
+splot/gfit.x +
+splot/stsfit.x
+splot/stsfit.key +
+splot/splot.x
+splot/mkpkg
+noao$lib/scr/splot.key -
+splot/splot.key +
+    1.  The background was not subtracted in the initial amplitude estimate.
+    2.  The tau parameter in the call the hfti was too large.  Changed
+	from .001 to 1E-10.
+    3.  Added new gaussian fitting function, key 'G'.
+    4.  Changed line help to use a file rather than coding the print
+	statements.
+    5.  Moved key file to source directory.
+    (12/19/90, Valdes)
+
+t_scopy.x
+    1.  Added a renumber option.
+    2.  For an input list of 1D images without onedspec extensions one can
+	uses a null aperture list to pack them into a single multispec
+	image.
+	(12/13/90, Valdes)
+
+splot/deblend.x
+    1.  Fixed bug that was scaling twice in computing the initial peak values.
+        This was also fixed in NEWIMRED.
+    2.  Last deblending prompt was not erased.  Replaced with exiting
+	deblending message.
+    (12/4/90, Valdes)
+
+t_sfit.x
+    Fixed logfile prefix string from STFONTINUUM to SFIT.
+    (11/20/90, Valdes and Seaman)
+
+t_bswitch.x
+t_calibrate.x
+t_standard.x
+sensfunc/sfimage.x
+bswitch.par
+calibrate.par
+standard.par
+sensfunc.par
+doc/bswitch.hlp
+doc/calibrate.hlp
+doc/standard.hlp
+doc/sensfunc.hlp
+    Converted to using observatory database.  (11/19/90, Valdes)
+
+t_fitprofs.x
+onedspec.hd
+doc/fitprofs.hlp +
+    1. Modified to write output model even if there is a fitting error to
+       avoid output images with not pixel file.
+    2. The image title was not dereferenced when generating the log title
+       string with onedspec format.
+    3. Added help page.
+    (11/2/90, Valdes)
+
+identify/iddoshift.x
+    Added image label shift info.
+    (10/29/90, Valdes)
+
+indentify/t_reidentify.x
+    1. The entrance into the interactive mode was not initializing such things
+    as the feature type and width.  It now initializes using parameters from
+    IDENTIFY if needed.
+    2. When not in verbose mode but when entering the interactive IDENTIFY
+    it did not print the revised statistics line.  This has been fixed.
+    (10/22/90, Valdes)
+
+ecidentify.par
+noao$imred/echelle/doc/ecidentify.hlp
+ecidentify/ ecidentify/ecffit
+noao$lib/scr/ecidentify.key --> ecidentify/ecidentify.key
+noao$lib/scr/ecffit.key --> ecidentify/ecffit/ecffit.key
+    1.  Moved key files to source directory.
+    2.  Made changes allowing iterative rejection in the echelle dispersion
+	tasks.  This adds three parameters to the ECIDENTIFY parameter
+	file, the database files (backwards compatible), and colon
+	commands in fitting mode.  The feature lists printed and in the
+	database now include an additional column to indicated rejected
+	lines. (10/15/90, Valdes)
+
+splot/splot.x
+    Changed the temporary spool file to be in tmp$.  (10/3/90, Valdes)
+
+doc/dispcor.hlp
+    Added notes warning that flux conservation will change the units of the
+    flux.  (10/3/90, Valdes)
+
+splot/splot.x
+doc/splot.hlp
+noao$lib/scr/splot.key
+    Added :log and :nolog commands to toggle logging of measurements.
+    (10/3/90, Valdes)
+
+load_hdr.x
+    Header keyword datatype conversion errors are now a warning.
+    (10/3/90, Valdes)
+
+identify/idcolon.x
+    Unrecognized or ambiguous colon commands are now noted.  (10/2/90, Valdes)
+
+dispcor.par (also in imred.iids and imred.irs)
+dispcor/dispcor.x
+dispcor/dcio.x
+dispcor/ranges.x
+doc/dispcor.hlp
+    1.  is_in_range not considers INDEF to be equivalent to MAX_INT.  This
+	has the effect that if no range is specified, "", then INDEF is in
+	the range while is some specific range which is not open ended will
+	not include INDEF in the list.
+    2.  Added new verbose parameter and modified program to print messages
+	when spectra are skipped.
+    3.  Ignoreaps now only applies to the global wavelength determination.
+    (10/2/90, Valdes)
+
+ecidentify/ecffit/ecfgraph.x
+    Put a check to avoid trying to plot points outside the defined window.
+    Plotting very deviant points outside the rescaled window causes a
+    gio floating overflow error.  This fix is a workaround before the
+    real bug gets fixed.  (9/20/90, Valdes)
+
+identify/idgdata.x
+identify/idmap.x
+    Make changes to allow working with 3D multispec images.
+    (9/14/90, Valdes)
+
+calibrate.x
+sensfunc/sfgimage.x
+    Make simple changes to allow working with 3D multispec images.
+    (9/12/90, Valdes)
+
+splot/splot.x
+splot/fudgex.x
+doc/splot.hlp
+    1.  Changed the 'x' key to use only the x cursor values and connect the
+	nearest pixels.  (8/31/90, Valdes)
+    2.  Added a new option, xydraw, to select drawing between x-y points
+	instead of using nearest pixel values.  (9/5/90, Valdes)
+
+bplot.cl
+doc/bplot.hlp
+    BPLOT revised to use new SLIST.  This is a much simpler and better
+    script.  It selects on aperture numbers.
+    (8/24/90, Valdes)
+
+t_slist.x
+doc/slist.hlp
+    SLIST now has a format parameter.  In multispec mode more approriate
+    output is obtained.  The multispec mode allows selection by aperture.
+    The short header listing is good for making lists for scripts to scan.
+    (8/24/90, Valdes)
+
+================================
+V3 of ONEDSPEC installed 8/23/90
+================================
+
+fortran/polft1.f
+    Fixed bug in which reference was made to a part of some work arrays
+    not used by the program.  This caused an arithmetic error on the MIPS.
+    (7/20/90, Valdes)
+
+onedspec.cl
+onedspec.men
+onedspec.cl
+bplot.cl
+doc/msdispcor.hlp +
+doc/bplot.hlp
+    1.  Added MSDISPCOR to the package.
+    2.  Replaced the old BPLOT with the code from MSBPLOT.  This program
+	also uses change to SPLOT which selects by aperture number.
+
+load_hdr.x
+splot/splot.x
+splot/mktitle.x
+splot/deblend.x
+splot/eqwidth.x
+splot/eqwidthcp.x
+splot/anshdr.x +
+splot/anssave.x -
+splot/mkpkg
+doc/splot.hlp
+noao$lib/scr/splot.key
+t_standard.x
+    1.  Added mapping of APID keyword, if present, to the iids structure
+	LABEL field.
+    2.  SPLOT, STANDARD  modified to use LABEL field instead of IM_TITLE.
+    3.  SPLOT modified to use different line type during overplotting.
+    4.  Removed maximum number limit for deblending.
+    5.  SPLOT now uses aperture number if the image is multispec/echelle.
+    6.  Added a new key, "#", to get new aperture without query about
+	image.
+
+t_specplot.x
+load_hdr.x
+idsm_keywrds.x
+dispcor/dcio.x
+dispcor/dispcor.x
+dispcor/msdispcor.x
+dispcor/ecdispcor.x
+sensfunc/sfoutput.x
+    Added CD1_1 as allowed substitute for WPC and CDELT1
+
+onedspec.hd
+    The revisions help is now a sys option.
+
+t_scopy.x +
+t_sapertures.x +
+scopy.par +
+sapertures.par +
+doc/scopy.hlp +
+doc/sapertures.hlp +
+mkpkg
+x_onedspec.x
+t_msselect.x -
+    1.  New task SCOPY added to handle copying and extraction apertures
+	between different formats
+    2.  New task SAPERTURES added to modify APNUM and APID info using
+	a text file.
+    3.	Removed MSSELECT/ECSELECT as they are replaced by SCOPY.
+
+onedspec.cl
+onedspec.hd
+onedspec.men
+x_onedspec.x
+t_sfit.x +
+sfit.par +
+continuum.par
+t_ecctm.x -
+continuum.cl -
+mkpkg
+doc/sfit.hlp
+doc/continuum.hlp
+    1.	New task SFIT added.  This is a modification of Rob Seamans ECCONTINUUM
+	task.
+    2.  A new output option was added to output the data with any rejected
+	points replaced by fitting values.  This replacement also may be used
+	with the difference and ratio output types.
+    3. 	ECCONTINUUM is just a different name for SFIT.
+    4. 	CONTINUUM is just a different name for SFIT.  The script version
+	based on FIT1D has been removed.
+
+onedspec.par
+    Incremented version number to V3.
+
+t_specplot.x
+specplot.par
+specplot.key +
+doc/specplot.hlp
+noao$lib/scr/specplot.key -
+    1.  Added apertures and logfile parameters.
+    2.	Moved key file to source directory
+    3.  Added to save sp_vshow parameters in logfile.
+    4.  Added option to undelete last deleted spectrum.
+    5.  Extended to also plot anything in third dimension.
+    6.  Added sysid parameter.
+    7.  Added ability to set line type to histogram
+
+dispcor/dispcor.x
+    1.	Added aperture position information to APNUM keyword.
+
+msdispcor.par +
+dispcor/msdispcor.x
+dispcor/msio.x
+dispcor/msdispcor.com
+dispcor/mkpkg
+    1.  Added logfile.  This is particularly for logging reference
+	shift interpolation information.
+    2.  Added support for 3D format
+    3.  Added aperture position info for spatial interpolation.  The positions
+	are read for the object from the APNUM keyword, propagated as
+	needed, and read from the database for the dispersion functions.
+    3a.	A reference shift spectrum may be specified.
+    4.  Communicate aperture number through ms_seteval call and then do a
+	lookup for all other parameters.
+    5.  Propagate independent beam number.
+    6.  The number of apertures in the reference spectrum need not be
+	the same as the object spectrum though all object spectra must
+	have a reference dispersion function.
+    7.  Everything is now done by aperture number.  This allows line
+	numbers to change, particularly between the dispersion reference
+	image and the data image.
+    8.  Dependence of msdispcor.x on msdispcor.com removed.
+    9.  Fixed rounding problem in wavelengths.
+
+dispcor/ecdispcor.x
+dispcor/ecio.x
+dispcor/ecdispcor.com
+dispcor/mkpkg
+    1.  Everything is done by aperture number using a call to ec_seteval.
+	This removes dependence on ecdispcor.com
+    2.  Aperture limit info is propagated
+
+identify/identify.x --> identify/t_identify.x
+identify/identify.h
+identify/linelist.x + *.x
+identify/iddoshift.x
+identify/iddb.x
+identify.par
+mkpkg
+    1.	Added an autowrite parameter to IDENTIFY.
+    2.  Simplified linelist package by passing id pointer.  This affects
+	calling sequence of a number of procedures.
+    3.  Zero weight points are ignored and the number of valid features
+	used in the shift is printed.
+    4.  New id structure made some minor changes in main task.
+    5.  Dependence on center1d.h removed by including emmission/absorption
+	definitions in identify.h and new field in id structure.
+
+identify/iddb.x
+identify/identify.h
+identify/idgdata.x
+identify/ididentify.x
+identify/idinit.x
+identify/identify.key +
+identify/idmap.x +
+identify/idnoextn.x +
+identify/idgetim.x -
+idreplot.x -
+mkpkg
+    Added support for multispec format.
+    1.  The database name string includes aperture number.
+    2.  Image remains open for efficient movement through 2D image.
+    3.  A number of new fields are part of the id structure including
+	the image pointer, spectrum format, image axis, line number,
+	aperture info, and structure for saving copies of id structure.
+    4.  Added j, k, o keys to scroll through apertures.
+    5.  Changes are saved internally for multiple apertures until done
+	with the image.
+
+identify/idreidentify.x --> identify/t_reidentify.x
+reidentify.par
+reidentify.x -
+    1.  REIDENTIFY completely rewritten for efficiency, support for
+	multiaperture data, and for additional features and algorithms.
+    2.  The same number or order of apertures is not required.
+    3.  REIDENTIFY parameters changed to include interactive, track,
+	override, addfeatures, coordlist, match, maxfeatures, minsep,
+	graphics, cursor, and answer.
+
+------------------------------------------------------------------------------
+
+load_hdr.x
+splot/getimage.x
+    1.	Fixed bug that was setting NP1 to 1 instead of zero.
+    2.  Now load_hdr adjusts W0 to first good pixel.
+    3.  SPLOT no longer adjust W0 to first good pixel since it is done
+	by load_hdr.
+    (7/11/90, Valdes)
+
+onedspec$ecidentify/ecidentify.x
+onedspec$ecidentify/t_ecreid.x
+onedspec$ecidentify/ecdofit.x
+onedspec$ecidentify/ecffit/ecffit.x
+onedspec$ecidentify/ecffit/ecfsolve.x
+    1.	Added a fixed order fitting option so that ECREIDENTIFY will refit
+	with order fixed.  This is mostly just passing a parameter down
+	to ecf_solve.  (6/12/90, Valdes)
+
+onedspec$dispcor/msio.x
+    If an aperture identify entry was missing from the database the task
+    would quit with not error message.  This is fixed now though the
+    new version to be installed soon will not have this approach to
+    mapping the dispersion solutions anyway.  (6/4/90, Valdes)
+
+onedspec$doc/splot.hlp
+    Included query parameters since a user was asking about them.
+    (6/1/90, Valdes)
+
+====
+V2.9
+====
+
+onedspec$t_sums.x
+onedspec$sums.par
+    If an image already exists a new query parameter will be used to get
+    a new image name.  (3/29/90, Valdes)
+
+onedspec$batchred.cl
+    Turned on extinction correction in calibrate for the case the spectra
+    are not already extinction calibrated.  (3/29/90, Valdes)
+
+onedspec$ecidentify/ecdofit.x
+    When INDEF valued lines were used and features were deleted during
+    fitting the resorting of the feature list would get messed up.
+    This is a very rare condition which has now been fixed.
+    (3/16/90, Valdes)
+
+onedspec$identify/idgdata.x
+onedspec$dispcor/dcio.x
+onedspec$dispcor/ecdispcor.x
+onedspec$dispcor/dispcor.x
+onedspec$dispcor/msdispcor.x
+onedspec$dispcor/disptable.r
+onedspec$sensfunc/sfoutput.x
+onedspec$load_hdr.x
+onedspec$idsm_keywrds.x
+onedspec$t_specplot.x
+    Added CDn_n to the set of keywords which may be used for the dispersion.
+    (2/8/90, Valdes)
+
+onedspec$splot/eqwidths.x
+onedspec$splot/sumflux.x
+    The equivalent width is now computed using the ratio of the spectrum
+    to the continuum.  The previous approximation is printed in the log
+    file for comparison.
+    (3/5/90, Valdes)
+
+onedspec$splot/splot.x
+onedspec$splot/mktitle.x
+    1. For :show added test for existence of spool file and an appropriate
+       message if it does not exist.
+    2. Increase length of plotted title to SZ_LINE from 32.
+       (3/2/90, Valdes)
+
+onedspec$identify/iddofit.x
+    When INDEF valued lines were used and features were deleted during
+    fitting the resorting of the feature list would get messed up.
+    This is a very rare condition which has now been fixed.
+    (1/17/90, Valdes)
+
+onedspec$dispcor/ecdispcor.x
+    The sum option was actually the same as the average option!
+    (1/15/90, Valdes)
+
+199c199
+< 	call calloc (spec, nw, TY_REAL) 
+---
+> 	call malloc (spec, nw, TY_REAL) 
+208a209
+> 	    call aclrr (Memr[spec], nw)
+212c213,218
+< 	    case SUM, AVERAGE:
+---
+> 	    case SUM:
+> 		do j = 1, nw
+> 		    if (Memr[spec+j-1] != 0.)
+> 		        Memr[outdata+j-1] = Memr[outdata+j-1] +
+> 			    Memr[spec+j-1]
+> 	    case AVERAGE:
+
+onedspec$load_hdr.x
+    Add limit checks for NP1 and NP2.  (11/8/89, Valdes)
+
+onedspec$sensfunc/sfstds.x
+    The data for apertures which are in the aperture list when the ignoreaps
+    flag is set was not being read unless the aperture list included
+    aperture 1.  This has been fixed. (11/8/89, Valdes)
+
+onedspec$load_hdr.x
+onedspec$t_specplot.x
+onedspec$splot/splot.x
+onedspec$splot/mktitle.x
+	1. The new APID titles for multispec format spectra is now mapped into
+	the unused LABEL element of the IDS structure.  For other formats
+	or if the keyword is missing then the image title is substituted.
+	2. SPLOT now labels with the LABEL string rather the the image
+	title to allow individual titles for multispec spectra.
+	3. SPECPLOT uses the APID titles if present.
+	(10/27/89, Valdes)
+
+onedspec$identify/iddofit.x
+    The order of evaluation in complex if statements is not necessarily
+    left to right as I'd thought.  This caused a bus error on the
+    Convex.  The particular change is as follows:
+
+    old:
+	if (rejpts != NULL && Memi[rejpts+k-1] == YES)
+	    WTS(id,j) = 0.
+	else
+	    WTS(id,j) = Memd[wts+k-1]
+    new:
+	WTS(id,j) = Memd[wts+k-1]
+	if (rejpts != NULL)
+	    if (Memi[rejpts+k-1] == YES)
+		WTS(id,j) = 0.
+
+onedspec$load_hdr.x
+    Modified header access to use imaccf to check if header parameter exists
+    rather than rely on an error return.  On a Sun3x the error checking
+    results in an exception.  (9/28/89, Valdes)
+
+onedspec$t_calibrate.x
+    The data outside of calibration range message was changed to print how many
+    pixels are outside of the calibration range is printed once.
+    (8/8/89, Valdes)
+
+====
+V2.8
+====
+
+onedspec$idsmtn.h
+onedspec$t_subsets.x
+onedspec$t_standard.x
+onedspec$t_slist.x
+onedspec$t_shedit.x
+onedspec$t_flatdiv.x
+onedspec$t_calibrate.x
+onedspec$t_bswitch.x
+onedspec$t_addsets.x
+onedspec$load_hdr.x
+onedspec$idsm_keywrds.x
+onedspec$sensfunc/sfimage.x
+onedspec$splot/mktitle.x
+onedspec$shparams.par
+    The exposure time is used as a real rather than an integer (7/11/89, Valdes)
+
+onedspec$t_specplot.x
+    The wavelengths were off by one pixel because CRPIX was uninitialized
+    and so defaulting to zero instead of 1.  (6/6/89, Valdes)
+
+onedspec$sensfunc/sfstds.x
+    Previously added check for INDEF exposure time extended to also check
+    for zero exposure time.  (6/1/89, Valdes)
+
+onedspec$dispcor/msio.x
+    Because of a recent change in IDENTIFY in which 2D images with a
+    second dimension of 1 are treated as 1D images a related change
+    was required to allow multispec format spectra to be dispersion
+    corrected if there is only one spectrum.  (5/15/89, Valdes)
+
+onedspec$load_hdr.x
+    Airmass values less than 1 are mapped in INDEF to force an airmass
+    computation.  (5/8/89, Valdes)
+
+onedspec$splot/getimage.x
+    If the spectrum has only 1 line (even if it is two dimensional) there
+    is no query for the line number.  Also the line number given by the
+    user for 2D images is limited to the range of image lines to avoid
+    an out of bounds error.  (5/6/89, Valdes)
+
+onedspec$dispcor/dispcor.x
+onedspec$dispcor/dcio.x
+onedspec$doc/dispcor.hlp
+    1. The output spectrum will be of real datatype if the input spectrum
+       is short datatype.
+    2. The last dispersion function defined for a 2D image is used for
+       all lines of a 2D image.
+       (5/6/89, Valdes)
+
+onedspec$doc/dispcor.hlp
+    Fixed mistake in description of the ignoreaps parameter.  (5/6/89, Valdes)
+
+onedspec$identify/identify.h
+onedspec$identify/*.x
+    1.  Added weights to the IDENTIFY data structure.
+    2.  Modified files to use the weights parameter.
+    3.  The weights are currently used to flag iteratively rejected points
+	during fitting of the dispersion function.
+    4.  Reidentify now prints the RMS of only those lines used in the fit
+	and shows the number of points fit.
+    5.  The database files now include a column for the weights.
+    (5/5/89, Valdes)
+
+onedspec$t_standard.x
+onedspec$standard.par
+    1.  A warning message is printed if the exposure time is not found.
+    2.  Removed ennumerated value in parameter file.
+    (4/10/89, Valdes)
+
+onedspec$sensfunc/sfstds.x
+    1.	Standard values with negative counts are ignored thus avoiding
+	arithmetic problems.
+    2.	Warning message is printed if the exposure time in not defined and
+    	a value of 1 is used.  (4/10/89, Valdes)
+
+onedspec$dispcor/msio.x +
+onedspec$dispcor/msdispcor.com +
+onedspec$dispcor/msdispcor.x +
+onedspec$t_msselect.x +
+onedspec$dispcor/dispcor.x
+onedspec$dispcor/mkpkg
+onedspec$mkpkg
+onedspec$x_onedspec.x
+    1.  New task MSDISPCOR to make dispersion correction in related
+	spectra in "multispec" format.  This is a cross between
+	ECDISPCOR and DISPCOR.
+    2.  New tasks MSSELECT and ECSELECT to extract subsets of spectra
+	from echelle and multispec format.  ECSELECT is simply an
+	alternate task name for MSSELECT.
+    3.  These new tasks use the procedures in the ONEDSPEC object
+	library but appear as logical tasks in the new MSRED package
+	and in the ECHELLE package.
+	(3/29/89, Valdes)
+
+onedspec$dispcor/dispcor.x
+    When not flux conserving the procedure asieval was being called
+    with a double value instead of a real giving completely incorrect
+    results.  (3/22/89, Valdes)
+
+onedspec$dispcor/refmatch.x
+    There was a bug in the matching option in which the object image was
+    begin substituted for the reference image.  (3/14/89, Valdes)
+
+onedspec$t_specplot.x
+onedspec$splot.par
+onedspec$splot/wrspect.x
+onedspec$load_hdr.x
+onedspec$identify/iddb.x
+    1.  Modified SPECPLOT to accept "multispec" and "echelle" formats.
+    2.  Modified SPLOT to accept "multispec" format for output.  This is
+	only cosmetic since it is the same as "echelle" format.
+    3.  Modified ONEDSPEC header reader to accept "multispec" format.
+	This is only cosmetic since it is the same as "echelle" format.
+    4.  Modified IDENTIFY to not include the image section in the REFSPEC
+	parameter for use with "multispec" format.
+    (3/8/89, Valdes)
+
+onedspec$dispcor/dispcor.x
+onedspec$doc/dispcor.hlp
+    Simple modification to allow task to operate on all lines in a 2D
+    image.  This is how the old program also worked.  (3/8/89, Valdes)
+
+onedspec$t_calibrate.x
+    1.	CALIBRATE did not take the differing lengths of the echelle orders
+	into account and so gave many warnings about spectrum extends outside
+	of flux calibration limits.
+    2.	The warning is now only printed once per spectrum/order rather than
+	for each pixel.
+    (2/27/89, Valdes)
+
+onedspec$t_specplot.x
+    Made CRPIX1 a real valued parameter. (2/27/89, Valdes)
+
+onedspec$t_widstape.x
+	The function mtfile is now used to determine if the input file is
+	a mag tape.  Previously, the code was checking that the first two
+	letters of the input file were 'mt', which fails for remote tape
+	drives.  (2/22/89 ShJ)
+
+onedspec$doc/refspectra.hlp
+    A new help page for the refspectra task has been installed.
+    (2/27/88, Davis)
+
+onedspec$doc/continuum.hlp
+    Added a warning about near zero divisions.  (2/14/89, Valdes)
+
+onedspec$identify/idlinelist.x
+onedspec$ecidentify/eclinelist.x
+    Setting the coordinate line list to null no longer issues a warning.
+    (2/13/89, Valdes)
+
+onedspec$specplot.x
+onedspec$doc/specplot.hlp
+noao$lib/scr/specplot.key
+    1. Added vertical shifts in scale.
+    2. Added horizontal shifts in velocity.
+    3. Added velocity and redshift colon commands.
+    (2/8/89, Valdes)
+
+onedspec$splot/splot.x
+    The default key now prints the spectrum value at the x coordinate in
+    addition to the cursor x, y coordinates.  (2/7/89, Valdes)
+
+onedspec$dispcor/dispcor.x
+onedspec$dispcor/ecdispcor.x
+onedspec$dispcor.par
+onedspec$ecdispcor.par
+imred$coude/dispcor.par
+imred$echelle/ecdispcor.par
+imred$iids/dispcor.par
+imred$irs/dispcor.par
+imred$specphot/dispcor.par
+onedspec$doc/dispcor.hlp
+imred$echelle/doc/ecdispcor.hlp
+    Changed "override" parameter to "rebin".  Also rebin=no acts only
+    on nondispersion corrected spectra while rebin=yes acts only on
+    dispersion corrected spectra.  (2/2/89, Valdes)
+
+onedspec$dispcor/refaverage.x
+onedspec$dispcor/reffollow.x
+onedspec$dispcor/refgspec.x
+onedspec$dispcor/refinterp.x
+onedspec$dispcor/refmatch.x
+onedspec$dispcor/refnearest.x
+onedspec$dispcor/refprecede.x
+onedspec$refspectra.par
+onedspec$doc/refspectra.hlp
+imred$coude/refspectra.par
+imred$echelle/refspectra.par
+imred$iids/refspectra.par
+imred$irs/refspectra.par
+imred$specphot/refspectra.par
+    Added timewrap parameter and reorganized calling sequences so the
+    sortval is set only in refgspec.  (2/2/89, Valdes)
+
+onedspec$reidentify.x
+    Stripped the image extension from the reference spectrum.
+    (1/31/89, Valdes)
+
+noao$lib/scr/ecidentify.key
+    Fixed minor typo "j Go to next order" --> "k Go to next order".
+    (1/26/89, Valdes)
+
+onedspec$dcio.x
+    An erroneous sfree in dc_gspec was removed. (1/26/89, Valdes)
+
+onedspec$idsm_keywrds.x
+onedspec$load_hdr.x
+onedspec$dispcor/dispcor.x
+onedspec$dispcor/ecdispcor.x
+    Changed CRPIX usage to real.  (1/26/89, Valdes)
+
+onedspec$names.par
+imred$coude/names.par
+imred$iids/names.par
+imred$irs/names.par
+    Made the "input" parameter prompt indicate it is a list rather than
+    a single file.  (1/24/89, Valdes)
+
+onedspec$splot.par
+imred$coude/splot.par
+imred$echelle/splot.par
+imred$iids/splot.par
+imred$irs/splot.par
+imred$specphot/splot.par
+    Made the minimum line number be 1 instead of 0.  (1/24/89, Valdes)
+
+onedspec$splot/splot.x
+    The 'w' window option in SPLOT now only redraws automatically in
+    "auto" mode.  (1/24/89, Valdes)
+
+onedspec$ecidentify/ecffit/ecffit.x
+    The 'o' key now accepts the default order for fitting; i.e. a
+    carriage return for the prompt.  Also the message about fitting
+    now also includes the order offset being used.  (1/24/89, Valdes)
+
+onedspec$idgdata.x
+    Now allow 2D images with a second dimension of 1. (1/24/89, Valdes)
+
+onedspec$dispcor/refinterp.x
+    When interpolating on a parameter that is the same for a set of arcs
+    and an object one wants two arcs to be identified; i.e. the one before
+    and after.  This did not happen until this bug fix.  (1/20/89 Valdes)
+
+onedspec$sensfunc.par
+imred$echelle/sensfunc.par
+imred$iids/sensfunc.par
+imred$irs/sensfunc.par
+imred$specphot/sensfunc.par
+onedspec$standard.par
+imred$echelle/standard.par
+imred$iids/standard.par
+imred$irs/standard.par
+imred$specphot/standard.par
+    Fixed missing default value for answer parameter.  (1/20/89, Valdes)
+
+onedspec$splot/pixind.x
+    Removed use of AINT function which was misbehaving on Sun386i.
+    (12/16/88 Valdes)
+
+onedspec$identify/reidentfy.x
+onedspec$identify/idreidentfy.x
+onedspec$identify/idreplot.x	+
+onedspec$doc/reidentfy.hlp
+onedspec$reidentfy.par
+twodspec$longslit/reidentfy.par
+imred$coude/reidentfy.par
+imred$iids/reidentfy.par
+imred$irs/reidentfy.par
+imred$specplot/reidentfy.par
+    Added plotfile for residuals.  (12/16/88 Valdes)
+
+onedspec$dispcor/dcio.x
+    If a reference spectrum is an image section its database entry will
+    be the file with the section stripped.  Since the database entry
+    is written by IDENTIFY I copied the database access code that
+    strips the image section.  (12/8/88 Valdes)
+
+onedspec$dispcor/dispcor.x
+    The use of some real variables in the flux conservation calculation
+    resulted in incorrect results when the resolution was very high.
+    The code was carefully rewritten to do all possible calculations in
+    double precision. (12/8/88 Valdes)
+
+onedspec$t_specplot.x +
+onedspec$specplot.par +
+onedspec$specplot.h +
+onedspec$doc/specplot.hlp +
+noao$lib/scr/specplot.key +
+onedspec$x_onedspec.x
+onedspec$onedspec.cl
+onedspec$onedspec.men
+onedspec$onedspec.hd
+onedspec$mkpkg
+    New task added (12/7/88 Valdes)
+
+onedspec$t_standard.x
+    Fixed minor bug: missing parg in eprintf when dispersion solution
+    missing.  (11/4/88 & 11/17/88)
+
+onedspec$identify/ididentify.x
+onedspec$identify/idfitdata.x
+    The nonmonotonic error message was being lost because it is flushed
+    immediately to the screen and then the screen is cleared to redraw
+    the graph.  This has now been fixed by checking for an error just
+    before the cursor read.  (11/2/88)
+
+onedspec$identify/identify.x
+onedspec$identify/iddb.x
+onedspec$identify.par
+onedspec$doc/identify.hlp
+    1.  Added the additional icfit parameters (except naverage) to IDENTIFY
+	so the user can set the default fitting parameters more fully.
+    2.  All the ICFIT fitting parameters are now written to the database and
+	read back.  This allows IDENTIFY and REIDENTIFY to start with exactly
+	the same fitting parameters as previously used.  (11/2/88)
+
+onedspec$t_bswitch.x
+    Added a test for the extinction correction request before trying to compute
+    the airmass.  (11/1/88)
+
+onedspec$ecidentify/eccolon.x
+    1.	When the label parameter was initially set to user all the labels
+    were being printed not just those for the current aperture. The bug has
+    been fixed. (9/9/88)
+
+onedspec$dispcor/dispcor.x
+    1.	A bug was fixed in the log+ option of dispcor and ecdispcor. The
+	problem was that the end points of the wavelength region were in
+	linear wavelength units but the w1 and dw parameters were in log units,
+	causing an erroneous computation of the index for the first pixel.
+	This bug has been fixed.  (9/9/88)
+
+onedspec$dispcor/refspectra.x
+onedspec$onedspec.cl
+onedspec$onedspec.men
+onedspec$batchred.cl +
+onedspec$batchred.par +
+onedspec$bswitch.par +
+onedspec$coefs.par -
+onedspec$standard.par
+onedspec$sensfunc.par
+    1.  BATCHRED and BSWITCH were put back into this package.
+    2.  COEFS was removed from this package.
+    3.  Enumerated strings were added to SENSFUNC and STANDARD parameter
+	files to prevent the tasks from dying on a bad value (i.e. clgwrd
+	was causing an error).  By putting the allowed values in the parameter
+	file the CL will wait for an allowed value.
+    4.  REFSPECTRA does not change the value of the confirm parameter now.
+	(7/29/88 Valdes)
+
+
+onedspec$splot/deblend.x
+onedspec$doc/splot.hlp
+    1.  The fitting parameter initialization was being done even before the
+	'q'.  Thus, the '-' subtraction did not use the fit but the initial
+	parameters.
+    2.  Modified the initial sigma to be 1/4 of the range divided by the number
+	of lines.  The 1/2 was too large.  (7/26/88 Valdes)
+
+onedspec$splot.par
+onedspec$splot/deblend.x
+onedspec$splot/scr_help.x -
+onedspec$doc/splot.hlp
+    1.  Removed unused parameters inblend, fixsep, difference, subtract from
+	parameter file.
+    2.  Fixed bug with '-' in deblending (continuum was not being subtracted).
+    3.  Removed unused source file.
+    4.  Update the help page.  (7/19/88 Valdes)
+
+onedspec$splot/deblend.x
+    Fixed bug introduced below.  (7/12/88 Valdes)
+
+onedspec$splot/deblend.x
+onedspec$onedspec.hd
+noao$lib/scr/deblend.key
+onedspec$doc/splot.hlp
+    1.  After moving the parameter initialization to within the options loop the
+        initializations were being done wrong.
+    2.  The 'd' option was not doing what it was supposed to.
+    3.  Added a print newline to clear the status line if four lines were
+	entered since this does not go through the 'q' case which was
+	doing the clear.
+    4.  The n sigma cases had the wrong mneumonics in the help.
+    5.  The src definitions in the help table were pointing to wrong files
+	since the names and directories for the files have been changed
+	(7/1/88 Valdes)
+
+
+onedspec$t_names.x
+onedspec$mkpkg
+    Modified this task to use the ODR package.  This also strips the image
+    extension allowing the append option to work.  (6/28/88 Valdes)
+
+onedspec$coincor.x
+    When doing both coincidence and power law corrections failed to put the
+    output of the coicidence correction as the input to the power law
+    correction.	(6/23/88 Valdes)
+
+onedspec$identify/idgdata.x
+    Added an error check to IMMAP.  Failure to do this gave a segmentation
+    violation on the SUNS.	(6/23/88 Valdes)
+
+onedspec$continuum.cl
+    1. Added a parameter to allow a cursor list text file to be passed to the
+    normcontinuum task.
+
+onedspec$ecidentify/ecgdata.x
+onedspec$ecidentify/ecffit/ecfcolon.x
+onedspec$ecidentify/ecffit/ecfset.x
+onedspec$ecidentify/ecffit/ecfsolve.x
+onedspec$ecidentify/ecffit/ecfrms.x +
+onedspec$ecidentify/ecffit/mkpkg
+noao$lib/scr/ecidentify.key
+noao$lib/scr/ecffit.key +
+    The following was fixed.				(5/20/88 Valdes)
+    1.	Error in graph title string.
+    2.	Missing cursor key help.
+    3.	Error in ":function" command in fitting mode.
+    4.	Rms calculated with deleted points.
+
+onedspec$dispcor/dispcor.x
+onedspec$dispcor/ecdispcor.x
+    1.	Failed to initialize the output spectrum to zero so that points
+	outsided the input data range are zero.  (5/17/88 Valdes)
+
+onedspec$dispcor/refaverage.x
+    1.  Instead of checking the reference spectra for aperture and reference
+	flag it was test the input image.  This was changed. (5/17/88 Valdes)
+
+onedspec$load_hdr.x
+onedspec$splot/deblend.x
+    1. The deblending was fitting a function without the factor of 2 in
+       the Gaussian sigma definition.  This caused the printed Gaussian
+       parameters to be off by a factor of sqrt(2).
+    2. Slight change to not have the header loading change the specified
+       input line.  It is up to the calling code to determine if this is
+       a valid line.  (5/17/88 Valdes)
+
+onedspec$identify/idreidentify.x
+    1. Added check for nonmonotonic dispersion solution.  (4/30/88)
+
+onedspec$onedspec.cl
+onedspec$onedspec.men
+onedspec$onedspec.hd
+    1. Task EXTINCT was removed.  The script and help page remain in case
+    they are desired.  Later they will also disappear.  The function of
+    this script is replaced by CALIBRATE.  (4/26/88 Valdes)
+    2. Task BATCHRED was removed to the IMRED packages.  (4/27/88 Valdes)
+
+onedspec$splot/splot.x
+onedspec$splot/deblend.x
+onedspec$t_flatfit.x
+onedspec$identify/ididentify.x
+onedspec$ecidentify/ecidentify.x
+onedspec$ecidentify/ecffit/ecffit.x
+noao$lib/scr/splot.key
+noao$lib/scr/identify.key
+noao$lib/scr/ecidentify.key
+noao$lib/scr/deblend.key
+noao$lib/scr/ecffit.key
+noao$lib/scr/flatfit.key
+    Added 'I' interrupt key. (4/20/88 Valdes)
+
+onedspec$identify/identify.h
+    Variables defined as integers instead of real (ID_MATCH, ID_MINSEP)
+    (4/18/88 Valdes)
+
+onedspec$sensfunc/t_sensfunc.x
+onedspec$sensfunc/sfsensfunc.x
+onedspec$sensfunc/sfstds.x
+onedspec$sensfunc/sfginit.x
+onedspec$sensfunc/sfoutput.x
+onedspec$sensfunc.par
+onedspec$doc/sensfunc.hlp
+noao$lib/scr/sensfunc.key
+    1. Added beam number to output sensitivity image header.
+    2. Added 'I' interrupt key.
+    3. Added aperture number selection.
+    4. Added interactive query.  (4/15/88 Valdes)
+
+onedspec$splot/getimage.x
+    Modified to recognize echelle format spectra on input.  (4/8/88 Valdes)
+
+onedspec$load_hdr.x
+    Modified to recognize echelle format spectra on input.  (4/8/88 Valdes)
+
+onedspec$mkpkg
+onedspec$splot/mkpkg
+onedspec$identify/mkpkg
+onedspec$fortran/mkpkg
+onedspec$onedutil.cl
+onedspec$onedspec.cl
+onedspec$onedspec.par
+onedspec$onedspec.men
+onedspec$onedspec.hd
+onedspec$identify/*
+onedspec$t_flatdiv.x
+onedspec$t_coefs.x
+onedspec$t_combine.x
+onedspec$dispcor.par
+onedspec$identify/identify.par --> onedspec$identify.par
+onedspec$identify/reidentify.par --> onedspec$reidentify.par
+onedspec$doc/dispcor.hlp
+
+onedspec$dispcor/* +
+onedspec$ecidentify/* +
+onedspec$x_onedspec.x +
+onedspec$refspectra.par +
+onedspec$dispcor1.par +
+onedspec$ecidentify.par +
+onedspec$ecreidentify.par +
+onedspec$doc/refspectra.hlp +
+
+onedspec$x_wavecal.x -
+onedspec$x_fluxcal.x -
+onedspec$x_onedutil.x -
+onedspec$identify/x_identify.x -
+onedspec$identify/libpkg.a -
+onedspec$dbx/ -
+onedspec$dbxio.h -
+onedspec$userstd/ -
+onedspec$t_dispcor.x -
+onedspec$fudge.x -
+onedspec$rlsq.x -
+onedspec$userstdc.x -
+onedspec$readstd.x -
+onedspec$qsortra.x -
+onedspec$statfile.x -
+onedspec$ascrcomp.x -
+onedspec$identify/icghelp.x -
+onedspec$splot/spflip.x -
+    The ONEDSPEC package has been completely reorganized by combining
+    executables, eliminating obsolete procedures, and adding new
+    versions of IDENTIFY and DISPCOR as well and new tasks for echelle
+    format data.  (4/7/88 Valdes)
+
+-------------------------------------------------------------------------------
+
+onedspec$mkpkg
+onedspec$splot/deblend.x
+    Fixed bugs related to initial guesses for width and peak and scaling.
+    Replaced Gauss-Jordan routine by Householder transformation routine
+    for stability.  (4/6/88 Valdes)
+
+onedspec$load_hdr.x
+    The test for wavelengths in meters per second was W0 < 0.001.
+    Now the test is abs(W0) < 0.001.  (3/10/88 Valdes)
+
+onedspec$identify/ididentify.x
+    The 't' was calling fit_to_pix with the real valued cursor position
+    while the procedure expects a double.  Added a double coercion to fix
+    the bug.  (2/18/88 Valdes)
+
+onedspec$splot/anssave.x
+onedspec$splot/mktitle.x
+onedspec$splot/getimage.x
+onedspec$splot/splot.x
+onedspec$splot/splotfun.x
+    1.  Titles (on the graph and in the log file) for two dimensional images
+	now contain the line number given as an image section.
+    2.  The log file title now includes a time stamp. (1/29/88 Valdes)
+
+onedspec$identify/ididentify.x
+    When recentering all the features the fitted coordinates are now
+    updated and the tick marks moved to the new center position.
+    (1/4/87 Valdes)
+
+onedspec$identify/iddb.x
+    DBGETR was declared as real for the new shift parameter causing a wrong
+    wavelength scale to appear. (12/22/87 Valdes)
+
+onedspec$doc/identify.hlp
+    Fixed minor typo. (12/7/87 Valdes)
+
+onedspec$sextract.cl +
+onedspec$doc/sextract.cl +
+onedspec$onedutil.cl
+onedspec$onedutil.par
+onedspec$onedutil.men
+onedspec$onedutil.hd
+    Added a new task, SEXTRACT, to extract subspectra. (11/19/87)
+
+onedspec$t_dispcor.x
+    The default starting wavelength and wavelength interval are now printed
+    in g format so that the user sees the full value.  (11/9/87)
+
+onedspec$identify/identify.x
+onedspec$identify/reidentify.x
+onedspec$identify/idgraph.x
+    1.  The XTOOLS change to XT_MK1D now permits the sections "column 51"
+	and "column 051" to be recognized identically.
+    2.  REIDENTIFY now aborts with a useful error message if their is not
+	database record for the reference image instead of later causing
+	a segmentation error.
+    3.  IDENTIFY can now plot in point mode using the GTOOLS commands if
+	desired.
+    (11/9/97 Valdes)
+
+noao$onedspec$sensfunc/sfextinct.x
+noao$onedspec$sensfunc/sfsensfunc.x
+noao$onedspec$sensfunc/sfreset.x
+noao$onedspec$sensfunc/sfmarks.x
+noao$onedspec$sensfunc/sfadd.x
+noao$onedspec$sensfunc/sfdelete.x
+noao$onedspec$sensfunc/sfundelete.x
+noao$onedspec$sensfunc/sfmove.x
+noao$onedspec$sensfunc/sfgraph.x
+noao$onedspec$sensfunc/sfginit.x
+noao$onedspec$sensfunc/sfcomposite.x
+noao$onedspec$sensfunc/sfcolon.x
+noao$onedspec$sensfunc/sfshift.x
+noao$onedspec$sensfunc/sensfunc.h
+noao$onedspec$doc/sensfunc.hlp
+noao$lib/scr/sensfunc.key
+    A number of changes were made based on user comments.
+    1.  A bug was fixed which caused the ":order" command to crash the task.
+	The integer valued order was being passed as a char in the colon
+	decoding task.
+    2.  The shift key 's' now toggles allowing a shift to be undone
+	without initializing all the data.  Also a message is printed
+	to indicate what has been done.
+    3.  The composite key 'c' now toggles allowing a composite to be undone
+	without initializing all the data.  Also a message is printed
+	to indicate what has been done.  A deleted composite point deletes
+	the original data at that wavelength when toggling back.
+    4.  The extinction key 'e' now toggles allowing an extinction
+	correction to be undone without initializing all the data.
+	Also a message is printed to indicate what has been done.
+    5.  A different symbol may be used to indicated added points.
+    6.  Changing the function or order does not automatically do a
+	new fit.
+    7.  A new key 'g' was added to do a fit and redraw the graph(s).
+	The existing 'f' key does a fit and overplots as before.
+    (11/6/87 Valdes)
+
+onedspec$splot/replot.x
+onedspec$splot/splot.x
+onedspec$splot/autoexp.x
+    Modified REPLOT to use GTOOLS task GTVPLOT.  This allows the user to
+    select point mode.  The calling sequence for REPLOT has a new argument
+    to allow calling this procedure for overplotting.  (11/5/87 Valdes)
+
+onedspec$identify/*
+onedspec$identify/iddoshift.x +
+    Added shift options to IDENTIFY and a refit option to REIDENTIFY.
+    This allows maintaining the same coordinate function with an additive
+    shift. (11/3/87 Valdes)
+
+onedspec$sensfunc/sfgraphs.x -
+onedspec$sensfunc/mkpkg.x
+    A zero length file, possibly confused with sfgraph.x was deleted and
+    deleted from the mkpkg. (10/26/87 Valdes)
+
+onedspec$splot/deblend.x
+onedspec$splot/sumflux.x
+    1. The input data to the deblending routine are now scaled to values
+    near unity.  Also the fitting is iterated three times to make the
+    results more consistent.
+    2. When computing the line center with 'e' the data is scaled to
+    avoid underflows in summing residuals to the 1.5 power.
+    (See bug report 16) (10/22/87 Valdes)
+
+onedspec$sensfunc/sfsensfunc.x
+onedspec$sensfunc/sfextinct.x
+    1. Aperture number for new aperture in title was undefined in the first
+    graph.  Set title after determining aperture number.
+    2. In a rare case it was possible for a square root of zero to occur
+    in the extinction significance calculation which is fatal on VMS.
+    Added check of argument before square root call. (Valdes)
+
+onedspec$splot.par
+    Changed all interactive query parameters from auto mode to query
+    mode to force a query even when run in menu mode and with :go.
+    (9/15/87 Valdes)
+
+onedspec$t_standard.x
+onedspec$t_lcalib.x
+onedspec$splot/plotstd.x
+onedspec$standard.par
+onedspec$lcalib.par
+onedspec$splot.par
+onedspec$doc/standard.hlp
+onedspec$doc/lcalib.hlp
+onedspec$doc/splot.hlp
+    The magnitude to absolute flux conversion constant has been made a
+    user changable parameter in the three tasks dealing with the flux
+    calibration tables.  (9/3/87 Valdes)
+
+onedspec$t_sensfunc.x -
+onedspec$sensfunc/* +
+noao$lib/scr/sensfunc.key +
+onedspec$sensfunc.par
+onedspec$doc/sensfunc.hlp
+onedspec$t_standard.x
+onedspec$doc/standard.hlp
+onedspec$bswitch.par
+onedspec$getextn.x
+    SENSFUNC has been completely rewritten.  It now allows determination
+    of extinction, display of flux calibrated spectra, and many nice
+    features for displaying and manipulating the data.  For full details
+    read the new help page.
+
+    The new sensfunc required some modifications to STANDARD in the
+    format of the output file produced by standard.  The parameters for
+    BSWITCH no longer have the grey scale parameter add_const or the
+    (never implemented) revised extinction file rev_ext_file which are
+    not produced by SENSFUNC any more.
+
+    The extinction loading procedure was modified to allow a null
+    extinction file to correspond to no extinction and to eliminate the
+    procedure get_new_ext and fix_ext which were used for the old grey
+    constant and never implemented revised extinction file. (9/3/87
+    Valdes)
+
+onedspec$splot/mkpkg
+onedspec$splot/splot.x
+onedspec$splot/splotfun.x
+    Errors getting a spectrum in function mode were ignored and the spectrum
+    was replotted.  Changed to return the error as a warning and not redraw
+    the plot.
+
+onedspec$t_dispcor.x (routine reinterp)
+    The reinterpolation now has additional tests:
+    1)  When the interpolation point is within a minimum distance of
+	an input pixel (0.001) it does not interpolate.  This was
+	done because the interpolation grid is sometimes meant to be
+	identical with the input but the computation of the output grid
+	is very slightly off (this was observed in COMBINE).
+    2)	If one of the points to be interpolated between has a value of
+	0.0 (used to mark missing data in ONEDSPEC) then the rebinned
+	point is set to 0.0 in order to propagate the missing point.
+	This is important for combining spectra with COMBINE. (8/5/87 Valdes)
+
+====
+V2.5
+====
+
+onedspec$t_sinterp.x
+    Valdes, June 22, 1987
+    1.  Removed a warning message to allow comments in the input table.
+
+onedspec$splot/avgsnr.x
+    Valdes, June 19, 1987
+    1.  A possible type of data is Fnu calibrated data with values in the
+	range 1e-25.  Attempting to determine an average, rms, and
+	signal-to-noise ratio with SPLOT caused a divide by zero error
+	due to underflowing the sum of squares.  This has been modified
+	to shift and scale the data before computing the sum of squares.
+
+onedspec$t_standard.x
+    Valdes, June 12, 1987
+    1.  There was an uninitialized memory problem with the space allocated
+	for adding points.  This bug was introduced with the May 15th
+	modifications to the structure of the calibration files.
+
+onedspec$load_hdr.x
+onedspec$idsm_keywrds.x
+onedspec$t_calibrate.x
+    Valdes, June 9, 1987
+    1.  Added EXPTIME as a recognized exposure time keyword.
+    2.  Added check against INDEF or 0 exposure time in CALIBRATE.
+
+onedspec$bplot.cl
+    Valdes, June 4, 1987
+    1.  The BPLOT script is now back the way it was earlier because the
+	earlier bug with the CL and list files seems to have gone away
+	while the new script relies on writing to parameter files which
+	doesn't work in the background.
+
+onedspec$onedspec.cl
+onedspec$onedspec.hd
+onedspec$onedspec.men
+onedspec$powercor.cl +
+onedspec$powercor.par +
+onedspec$getcalib.x
+onedspec$doc/powercor.hlp +
+    Valdes, June 1, 1987
+    1.  Added task POWERCOR from IIDS.
+    2.  Added an error check for a bad extinction file.
+
+onedspec$splot/deblend.x
+    Valdes, May 19, 1987
+    1.  A bug that was introduced into deblending during the last set of
+	changes was fixed.
+
+onedspec$onedutil.par
+onedspec$lcalib.par
+onedspec$t_lcalib.x
+    Valdes, May 19, 1987
+    1.  Make the default for the calibration parameters in LCALIB to
+	be package parameters of the same name in keeping with the way these
+	parameters are used in the other ONEDSPEC tasks.
+    2.  Added the calibration parameters to the ONEDUTIL package and
+	the default is to refer to the parameters of the package that loaded
+	it.  This will be either ONEDSPEC or one of the IMRED packages.
+    3.  Modified LCALIB to not require the extinction file when reading
+	star calibration info.
+
+onedspec$mkpkg
+onedspec$bswitch.par
+onedspec$lcalib.par
+onedspec$onedspec.par
+onedspec$splot.par
+onedspec$standard.par
+onedspec$t_lcalib.x
+onedspec$t_standard.x
+onedspec$x_fluxcal.x
+onedspec$x_onedutil.x
+onedspec$getcalib.x
+onedspec$getextn.x
+onedspec$plotstd.x -
+onedspec$splot/mkpkg
+onedspec$splot/plotstd.x +
+onedspec$doc/standard.hlp
+onedspec$doc/lcalib.hlp
+onedspec$doc/onedspec.hlp
+onedspec$doc/splot.hlp
+onedspec$doc/bswitch.hlp
+noao$imred/echelle (par files)
+noao$imred/iids (par files)
+noao$imred/irs (par files)
+noao$imred/specphot (par files)
+noao$lib/onedstds (data files)
+    Valdes, May 15, 1987
+    1.  The major change was to change the format of the calibration data
+	from the very constrained old format to a more flexible format.
+	This also involved adding a new parameter "extinction" and changing
+	"calib_file" to "caldir".
+    2.  The calibration data files were converted to the new format in a
+	number of subdirectories.
+    3.  The parameter files in the IMRED directories were also updated.
+    4.  Moved plotstd.x to splot directory.  It is an splot routine and should
+	be with the other splot source.
+    5.  Moved LCALIB from the FLUXCAL executable to the ONEDUTIL executable.
+
+onedspec$splot/usercoord.x
+    Valdes, May 8, 1987
+    1.  When setting a wavelength scale using the 'u' key on data lacking
+	any wavelength information (W0 and WPC == INDEF) there was a bug
+	causing a message of the form "cursor not moved".
+
+onedspec$splot/deblend.x
+onedspec$splot/splot.x
+onedspec$splot/eqwidthcp.x
+    Valdes, April 30, 1987
+    1.  I missed a couple of places where READ_WRITE access was used
+	in SPLOT (see March 13, 1987).  These have been removed.
+    2.  There was a bug in the 'k' and 'v' type equivalent width
+	procedures which produced wrong results unless the cursor was
+	very near the center.
+    3.  When applying deblending to a single line the starting position
+	is now the minimum or maximum point of the continuum subtracted
+	profile rather than the center of the continuum limits.
+
+onedspec$splot/deblend.x
+onedspec$splot/splot.x
+onedspec$splot/anssave.x
+onedspec$splot/eqwidthcp.x
+onedspec$splot/eqwidth.x
+onedspec$doc/splot.hlp
+noao$lib/scr/splot.key
+    Valdes, April 28, 1987
+    1.  SPLOT now prints only one line of output on the graphics status line
+	when doing deblending or equivalent width measurments.  The full
+	output is saved in the log file and also internally.  These changes
+	were made to allow reasonable behavior in terminals which cannot
+	display text and graphics simultaneously (PC emulators, VT240's).
+    2.  To get the full output of previous measurements during the course of
+	the task execution a new command ":show" has been added.
+    3.  It was possible for deblending to yeild negative sigmas.  This has been
+	fixed as well.
+
+onedspec$doc/names.hlp
+    Valdes, April 27, 1987
+    1.  A bug note was added to the task help stating that the append option
+	is intended only for image sections.  Appending any other string
+	produces names not acceptable to ONEDSPEC.
+
+onedspec$identify/identify.x
+onedspec$identify/ididentify.x
+onedspec$identify/idlinelist.x
+onedspec$identify/idnewfeature.x
+    Valdes, April 15, 1987
+    1.  Added bell if feature not found with 'm'.
+    2.  When automatically identifying lines, 'l' it now requires a new line
+	to be within the matching distance relative to the current fit and
+	if two centers are withing "minsep" then the closest match to the
+	user coordinate is selected.
+    3.  Default initial graph for fitting is residuals vs. wavelength.
+
+onedspec$t_standard.x
+    Davis, April 13, 1987
+    1. At Frank's suggestion I added a test in STANDARD to make sure that
+    the exposure time is never less than 1 second.
+
+onedspec$t_standard.x
+    Davis, April 10, 1987
+    1. In order to check for an INDEF valued exposure time STANDARD on VMS/IRAF
+    was testing a boolean compared to a fp 0.0. The test was always coming up
+    true if the exposure keyword was defined; and exposure time was being set
+    to 1. If no exposure keyword was present INDEFI was being used for the
+    exposure time. I changed the test to test for an integer INDEF and
+    every thing seemed ok. Lyra, IRAF and IRAFX were updated.
+
+onedspec$t_standard.x
+    Valdes, April 3, 1987
+    1.  STANDARD was using INDEF if there was no exposure time in the
+	header rather than the intended 1.0 as described in the
+	documentation.  It now uses 1 for the exposure time if there
+	is no exposure time in the header.
+
+onedspec$coincor.x
+    Valdes, March 23, 1987
+    1.  In the power correction the value of the output when the input
+	was negative was undefined.  Now it is the input value.
+
+onedspec$splot/getimage.x
+onedspec$splot/wrspect.x
+onedspec$splot/deblend.x
+onedspec$splot/eqwidth.x
+onedspec$splot/eqwidthcp.x
+    Valdes, March 13, 1987
+    1.  SPLOT no longer opens the image READ_WRITE.  This was unnecessary
+	and would prevent someone from examining data for which they don't
+	have write permission.
+    2.  Modified the deblend and eqivalent width options to deactivate the
+	workstation since they produce multiline output.
+
+onedspec$t_dispcor.x
+onedspec$dispcor.par
+onedspec$doc/dispcor.par
+    Valdes, March 5, 1987
+    1.  It is now a fatal error if the dispersion solution (from IDENTIFY)
+	is nonmonotonic.
+    2.  The starting wavelength and wavelength intervals are now list
+	structured parameters to allow files containing the values to
+	be used.  With no file the user is queried and a carriage
+	return or nonnumeric value will use the default value.
+    3.  The way wavelength information is printed out has been improved.
+    4.  A missing carriage return was added to the error message when
+	an image is not found.
+    5.  The order of the parameters, some default values, some of the
+	prompts, and their modes have been changed to be more consistent
+	with other tasks and more easily useable with command line arguments.
+    6.  The help page was modified to reflect these changes.
+
+onedspec$identify/ididentify.x
+onedspec$identify/idreidentify.x
+onedspec$identify/idfitdata.x
+onedspec$identify/idcolon.x
+    Valdes, March 5, 1987
+    1.  IDENTIFY now prints a warning about a nonmonotonic coordinate
+	solution.
+    2.  Changes were made to not print the current feature when error
+	messages are printed thus giving the user a change to read them.
+    3.  When attempting to change images to a nonexistant image
+	the immap was improperly error checked.  This could result in
+	fatal errors (particularly on VMS).
+
+onedspec$dispcor.par
+    Valdes, February 27, 1987
+    1.  Prompt was changed from
+	"File containing ..." to "Database containing ..."
+
+onedspec$userstd/nearpt.x
+onedspec$oned.h
+    Valdes, February 25, 1987
+    1.  Changed nearest point algorithm to use NDC coordinates. This required
+	adding the GIO pointer to the arguments.
+    2.  Change all procedures calling near_pt to include GIO pointer
+	argument.
+    3.	Changed maximum distance to 0.05 (NDC)
+
+onedspec$splot/splot.x
+    Valdes, February 25, 1987
+    1.  When exiting from the 'f' function mode in SPLOT the function
+	status line is now erased.
+
+noao$onedspec
+    Valdes, February 19, 1987
+    1.  Made required GIO modifications.  The tasks affected are SPLOT,
+	STANDARD, FLATFIT, SENSFUNC, and IDENTIFY.  Please report any
+	bugs.
+
+onedspec$coincor.x
+onedspec$t_coincor.x
+onedspec$t_flatdiv.x
+onedspec$t_flatfit.x
+onedspec$doc/coincor.hlp
+    Valdes, February 9, 1987
+    1.  A number of interface errors were fixed.
+    2.  The coincidence correction procedure now takes an input and output
+	array.  Previously it modified the given array.
+    3.  The basic IIDS correction is now checked for values which would
+	cause the log function to give an exception or instruction error.
+    4.  The major change in COINCOR is that if the output root image name
+	is null then the operation is done in place.  When dealing with
+	~1000 images this saves on disk space and directory manipulations.
+    5.  The help page for COINCOR was appropriately updated.
+
+onedspec$fortran/polft1.f
+onedspec$getextn.x
+onedspec$t_calibrate.x
+onedspec$t_sensfunc.x
+    Valdes, February 5, 1987
+    1.  The following errors reported by Skip Schaller (Steward Obs, AOS port)
+	were fixed.
+	polft1.f:	Minus sign out of place in expression
+	getextn.x:	Remove declaration for max(), min(), log10()
+	t_calibrate.x:	Remove declaration for min()
+	t_sensfunc.x:	Remove declaration for log10()
+
+onedspec$oned.h
+    Valdes, January 30, 1987
+    1.  The maximum number of beams the package can handle has been
+	increased from 50 to 100.
+
+onedspec$t_combine.x
+onedspec$combine.par
+onedspec$doc/combine.hlp
+    Valdes, January 30, 1987
+    1.  An new parameter called "combine" was added which specifies the type
+	of combining (either average or sum).  The help documentation was
+	updated.
+
+onedspec$identify/idcolon.x
+onedspec$identify/ididentify.x
+    Valdes, January 16, 1987
+    1.  Colon command dictionary and switch rewritten to use macro definitions.
+    2.  ? help facility rewritten to use system paging facility instead of ad
+	hoc menu facility.
+
+onedspec$gcurval
+    Valdes, January 12, 1987
+    1.  Changed "0 0 0 q" to "0 0 1 q" since this was detected as an error
+	in V2.5.  This file is used by BPLOT.
+
+onedspec$batchred.cl
+noao$imred/iids/batchred.cl
+noao$imred/irs/batchred.cl
+    Valdes, December 29, 1986
+    1.  This script creates the user script "process.cl".  It was creating
+	it with an out-of-date syntax which no longer worked.  Modified
+	BATCHRED to create a valid script.
+
+onedspec$lcalib.par
+    Valdes, December 18, 1986
+    1.  The default for the calibration file in task LCALIB is now that
+	for the task STANDARD.
+
+onedspec$identify/idreidentify.x
+    Valdes, December 3, 1986
+    1.  REIDENTIFY was not correctly tracking when there was no fit.
+	75: FIT(j) = FIT(i)	==>	FIT(j) = fit
+
+onedspec$t_flatfit.x
+onedspec$t_flatdiv.x
+onedspec$flatfit.par
+onedspec$flatdiv.par
+onedspec$doc/flatfit.hlp
+onedspec$doc/flatdiv.hlp
+    Valdes, December 2, 1986
+    1.  The tasks FLATFIT and FLATDIV may optionally apply coincidence
+	corrections.  They were not updated to include the IIDS nonlinear
+	correction made earlier.  They have now been updated.
+
+onedspec$t_bswitch.x
+onedspec$t_flatfit.x
+onedspec$t_sums.x
+    Valdes, December 1, 1986
+    1.  The tasks BSWITCH, FLATFIT, and SUMS created new images with only
+	the standard ONEDSPEC header information and without any other
+	user parameters.  These tasks worked this way because they may
+	sum many spectra for each beam and the connection between the
+	input image header and output image header was not obvious.  They
+	have been modified to use the last input image for each beam as
+	the image header template for the output image of that beam.
+	When there is no summing then the output image header will be
+	a copy of the input image header with updated ONEDSPEC parameters.
+
+onedspec$identify/idlinelist.x
+    Valdes, November 25, 1986
+    1.  It used to be that if there were no coordinate list then the
+	default user coordinate was the pixel coordinate.  This changed
+	at some point.  This has been fixed.
+
+onedspec$identify/identify.x
+    Valdes, November 21, 1986
+    1.  The common variable labels is now initialized every time the
+	task runs.
+
+onedspec$load_hdr.x
+onedspec$splot/splot.x
+onedspec$splot/usercoord.x
+    Valdes, November 17, 1986
+    1.  Since people insist on using W0 and WPC to define the wavelength
+	coordinates and are then confused because CRVAL1 and CDELT1 are
+	used I changed the default precedence.  The ONEDSPEC package now
+	looks for W0 and WPC first and then resorts to the FITS coordinate
+	keywords.  Also if the coordinate values are less the 0.001
+	it assumes that the units are meters and converts to Angstroms.
+	This arises when a strict interpretation of the FITS coordinates
+	(units of meters) is used for optical spectral data.
+    2.  The key 'p' in SPLOT has been modified to query for the starting
+	and ending wavelength.  The default values are those last defined.
+	Thus, this key may be used at any time to set the wavelength scale.
+	To return to wavelength scale after '$' the user simply types
+	carriage return to accept the defaults.
+    3.  The key 'u' in SPLOT has been modified to work in all cases.
+	Previously it only worked if the plot was in pixel coordinates.
+	If run in wavelength coordinates funny results would be obtained.
+	Now the user may mark two points even in wavelength coordinates.
+
+onedspec$coincor.x
+    Valdes, November 13, 1986
+    1.  The power law correction is applied only to positive data.
+	Negative data is not changed.
+
+onedspec$splot/eqwidth.x
+onedspec$splot/deblend.x
+onedspec$splot/eqwidthcp.x
+    Valdes, November 3, 1986
+    1.  Changed print format statements to keep columns from running together
+	for flux calibrated data.
+
+onedspec$splot/*.x
+onedspec$splot/mkpkg
+onedspec$splot/idsmtn.h -
+onedspec$splot/oned.h -
+    Valdes, October 28, 1986
+    1.  Changed include references to point to include files in the main
+	package directory ("idsmtn.h" -> "../idsmtn.h" and
+	"oned.h" -> "../oned.h").
+    2.  Deleted the copies of the include file in this directory.
+
+onedspec$t_coincor.x
+onedspec$coincor.x
+onedspec$coincor.par
+onedspec$doc/coincor.hlp
+onedspec$oned.h
+onedspec$onedspec.par
+onedspec$onedspec.men
+    Valdes, October 21, 1986
+    1.  Modified COINCOR to include a power law correction as part of the
+	IIDS correction.
+    2.  A new paramter was added to COINCOR and ONEDSPEC, called "power",
+	for the IIDS power law correction.
+    3.  The help page for COINCOR was revised.
+
+onedspec$splot/splot.x
+onedspec$splot/getimage.x
+onedspec$splot/wrspect.x
+    Valdes, October 20, 1986
+    1.  Added ability to write modified spectrum to the current image in
+	SPLOT.
+    2.  There were several errors in the code which were fixed.  These
+	included modifying an IMIO buffer and extra arguments.
+
+onedspec$splot/splot.x
+onedspec$splot/eqwidth.x
+onedspec$splot/eqwidthcp.x
+onedspec$splot/deblend.x
+onedspec$splot/saveans.x
+onedspec$doc/splot.hlp
+    Valdes, October 15, 1986
+    1.  The routines for the keys 'd', 'e', 'h', 'k', and 'v' now print
+	information in a same format.  They all have a header line and
+	a line containing the values.  There reason for this is that,
+	with the additional information now included, it requires two
+	lines for "quantity: value" format anyway.  They also print the
+	information which is common to all methods in the same order.
+    2.  The deblending routine 'd' now includes the continuum, equivalent
+	width, and sigma of the Gaussian fits.  It also plots the continuum
+	slope as is done with the 'e' key.
+    3.  The equivalent width routine 'e' now includes the continuum.
+    4.  The 'h', 'k', and 'v' routines now include flux and FWHM.
+    5.  The 'h', 'k', and 'v' routines now work on emission lines as well
+	as absorption lines.
+    6.  The 'h', 'k', and 'v' routines define the gaussian profile in the
+	same way as the deblend routine; i.e. exp (-0.5 * (dw/sigma)**2)
+    7.  Help revised.
+
+onedspec$splot/splot.x
+onedspec$splot/autoexp.x
+    Valdes, October 14, 1986
+    1.	The SPLOT windowing keys 'a', 'z', ',', and '.' were not compatible
+	with the GTOOLS windowing.  AUTOEXP.X was rewritten to use the
+	GTOOLS structure while operating as before.
+
+onedspec$splot/splot.x
+onedspec$splot/eqwidthcp.x
+onedspec$splot/scrhelp.x
+onedspec$splot/stshelp.x
+onedspec$doc/splot.hlp
+    Valdes, October 8, 1986
+    1.  There are two methods of measuring equivalent widths using a simple
+	Gaussian line model.  The original method which requires a unit
+	continuum has been restored as the 'k' key. (See the revision
+	of September 18, 1986).
+    2.  The second method recently added which uses the y cursor to mark
+	the continuum and uses the half flux level for determining the
+	line width is available with the last available key; the 'v' key.
+    3.  The 'h' key for one sided measurements still requires a second key
+	but now in addition to defining which side of the line to use
+	it also defines which method to used.
+    4.  The help page has been updated to reflect the changes.
+
+onedspec$doc/rebin.hlp
+    Valdes, October 7, 1986
+    1.  Typo in V2.3 documentation fixed: "set to know" -> "set to no".
+
+onedspec$t_shedit.x +
+onedspec$shedit.par +
+onedspec$shparams.par +
+onedspec$doc/shedit.hlp +
+onedspec$onedspec.cl
+onedspec$onedspec.men
+onedspec$onedspec.hd
+    Valdes, September 29, 1986
+    1.  A onedspec header editor called SHEDIT has been added.  It uses
+	EPARAM as the editor.
+    2.  A help page is available.
+
+onedspec$identify/reidentify.x
+    Valdes, September 25, 1986
+    1.  REIDENTIFY was passing a constant 0. to ID_REIDENTIFY which expects
+	a double.  Replaced 0. with "double (0.)" as the argument.
+	This caused a failure in the AOS IRAF.
+
+onedspec$splot/eqwidthcp.x
+onedspec$splot/doc/splot.hlp
+    Valdes, September 18, 1986
+    1.  The 'k' key used to determine equivalent widths by fitting a Gaussian
+	profile based only on the depth of the core, the line width at some
+	point, and the continuum had several problems.  First, people failed
+	to realize that the continuum had to be 1.  Second, the y cursor
+	position was used for measuring the width of the line.  Third, if
+	the y cursor position was not within the line then square root and
+	logarithm exceptions occured.  These problems have been fixed as
+	follows:
+	    1.  The y cursor is now used to mark the continuum.  This
+	    has been made very clear in the documentation.
+	    2.  This allows equivalent widths to be measured for any
+	    absorption line even when the continuum is not 1!
+	    3.  The level at which the width of the line is measured is
+	    now the point half way between the continuum and the minimum
+	    point in the line.  Previously this point was set by the
+	    y cursor position.
+	    4.  If the y cursor position is below the line minimum or
+	    the left and right edges of the line are not found at the half
+	    flux point an informative error is printed and the equivalent
+	    width is not evaluated.
+	    5.  The search for the left and right edges was previously
+	    limited to +- 9 pixels.  This limit has been removed.  The
+	    search now extends to the limits of the spectrum if necessary.
+	    6.  The information printed includes the gaussian parameters
+	    as well as the equivalent width.
+	    7.  The gaussian model is plotted over the spectrum in order
+	    to judge the reasonableness of the equivalent width measurement.
+
+onedspec$splot.par
+onedspec$doc/splot.hlp
+    Valdes, September 11, 1986
+    1.  Added ? to boolean prompts.  The prompt
+	    Fix separation of lines:
+	was confusing a user who tried to give the value of the separation.
+	The new prompt is
+	    Fix separation of lines?:
+    2.  This parameter was also not in the documentation!
+
+onedspec$t_dispcor.x
+    Valdes, September 11, 1986
+    1.  DISPCOR requires reference spectra to exist as well as the identify
+	database entry.  The error message was misleading.  The error message
+	is now more specific.
+
+onedspec$splot/splot.x
+onedspec$splot/anssave.x
+    Valdes, September 8, 1986
+    1.  Modified SPLOT to append to the answer file each time an aswer is
+	written rather than opening the answer file at the beginning and
+	closing it at the end.  This eliminates the annoying creation of
+	a file everytime SPLOT is used.
+
+onedspec$t_dispcor.x
+    Valdes, September 8, 1986
+    1.  Procedure dcorrect was defined as a function but used as a subroutine.
+	This was found and corrected during the Alliant port.
+
+onedspec$identify/xtpage.x +
+onedspec$identify/xtmenu.x +
+onedspec$identify/ididentify.x
+    Valdes, September 5, 1986
+    1.  Added paging and menu features to '?' help.
+
+onedspec$bplot.cl
+    Valdes, August 26, 1986
+    1.  The BPLOT script has been rewritten.  Rather than calling SPLOT
+	in a loop, once for each image, a cursor command file is created
+	containing cursor commands for all the images and then SPLOT is
+	called with a list of images.  This fixes an undiagnosed bug and
+	is more efficient.
+
+onedspec$identify/ididentify.x
+onedspec$identify/iddofit.x
+onedspec$identify/idgdata.x
+onedspec$identify/idfitdata.x
+    Valdes, August 22, 1986
+    1.  ICFIT no longer inherits the window from IDENTIFY.  Entering ICFIT
+	will do autoscaling.
+    2.  IDENTIFY now uses the image header coordinate information if there
+	is no database dispersion solution.  The parameters used are
+	CRPIX, CRVAL, and CDELT.  This allows IDENTIFY to be used with
+	linearized spectra in the ONEDSPEC related packages.
+
+onedspec$identify/identify.com
+onedspec$identify/identify.x
+onedspec$identify/idcenter.x
+onedspec$identify/idcolon.x
+onedspec$identify/idshow.x
+onedspec$identify/reidentify.x
+onedspec$identify/identify.par
+onedspec$identify/reidentify.par
+    Valdes, August 18, 1986
+    1.  IDENTIFY and REIDENTIFY modified to include a detection threshold
+	parameter for feature centering.
+    2.  The help pages were updated.
+
+====================================
+Version 2.3 Release, August 18, 1986
+====================================
+
+onedspec$splot/wrspect.hlp:  Valdes, August 14, 1986
+    1.  The test for whether a new image will overwrite an existing image
+	used ACCESS which is for nonimage files only.  This caused a problem
+	with recognizing the automatic image extensions.  The modification
+	uses IMMAP and IFERR to check if the new image would overwrite an
+	existing image.
+
+onedspec$doc/setdisp.hlp:  Valdes, August 8, 1986
+    1.  The wording defining the meaning of "dispaxis" was changed because
+	of user confusion.
+
+onedspec$identify/idmark.x: Valdes, August 8, 1986
+    1.  The optional labels have been adjusted to be half size and
+	to have a path of up.  Note that on a vt640 the default text
+	quality uses hardware generation so this change will not be
+	visible unless you reset the text quality to high.
+    2.  The size of the ticks and the gaps have changed slightly.
+
+onedspec$t_dispcor.x: Davis, July 28, 1986
+    1. DISPCOR was failing with a bus error on class2. It turned out that
+        the get_feature1 routine was trying to get the flex_par parameter out
+        of the image header after the image had been closed. I moved the
+        imunmap call to the end of the routine.
+
+onedspec$t_dispcor.x: Valdes, July 7, 1986
+    1.  DISPCOR was opening comparison images when collecting dispersion
+	solutions from the database and failing to close them.  In one
+	particular large usage 509 images were opened before
+	an out of memory failure!
+
+onedspec$splot: Valdes, July 7, 1986
+    1.  In SPLOT the 'w' key has been redefined to 'i' (create a new image).
+	Key 'w' now windows the graph.
+    2.  The help page and menus updated.
+
+onedspec$identify/: Valdes, July 7, 1986
+    1.  Redefined the 'r' key to be 't' so that 'r' can be the standard
+	redraw key.
+    2.  Help page and '?' menu updated.
+
+onedspec$doc/standard.hlp, lcalib.hlp, sinterp.hlp:  Valdes, July 7, 1986
+    1.  Help pages updated to reflect name changes in the standard
+	calibration files.
+
+onedspec$identify/: Valdes, July 3, 1986
+    1.  Modified package to use new ICFIT package.
+    2.  Changed coordinate list parameter to onedstds$henear.dat.
+    3.  Updated help page for IDENTIFY to refect new default coordlist.
+
+onedspec$identify/identify.x,reidentify.x,idgetim.x:  Valdes, July 1, 1986
+    1.  Replaced calls to imtgetim with idgetim.  Idgetim calls
+	imtgetim to get next image name but it then removes any
+	image extension.  This is necessary to prevent having two
+	different names by which an image may be identified in the
+	database.
+
+=====================================
+STScI Pre-release and SUN 2.3 Release
+=====================================
+	
+ondespec$getnimage.x:  Valdes, June 19, 1986
+    1.  Changed BOOLS in common to INTS for safety's sake.
+
+onedspec$(t_sensfunc.x,fudge.x,userstd.x): Valdes, June 19, 1986
+    1.  SENSFUNC was not correctly accumulating grey constant corrections
+	between different apertures.  This was fixed by rewriting the
+	RLSQ procedures (moved into a file of their own, rlsq.x) and
+	making appropriate changes in the rest of the code.
+    2.  The grey constant was being computed incorrectly.
+
+onedspec$t_flatfit.x: Valdes, June 18, 1986
+    1.  FLATFIT aborted when an error is made specifying a nonexistant
+	image.  It now prints an error message and goes on to the
+	next spectrum.
+
+onedspec$t_coefs.x: Valdes, June 16, 1986
+    1.  Task was calling the wrong database package.  This produced
+	totally wrong code since one package returns a structure
+	pointer and the other returns FIO channel number.
+	This error was probably introduced in May.
+
+onedspec$t_standard.x: Valdes, June 12, 1986
+    1.  Minor bug in STANDARD introduced when fixing problem with
+	wavelengths (May 19).  Title was no longer being written to
+	the STD file.
+
+onedspec$t_dispcor.x: Valdes, June 12, 1986
+    1.  DISPCOR had a fixed limit of 100 comparison spectra for all
+	apertures in the database.  If this limit was exceeded memory
+	would be corrupted (i.e. no check for exceeding the end of the
+	array).  This has been changed to use dynamic memory allocation
+	so that there is no limit on the number of comparison spectra.
+
+onedspec$identify/ididentify.x: Valdes, June 11, 1986
+    1.  Windowing key 'w' added.
+    2.  Help page updated to reflect the 'w' and 'y' keys.
+
+onedspec$splot.x: Valdes, June 10, 1986
+    1.  Now sets dispersion correction flag when the user defines
+	a wavelength scale and writes a new image.
+
+onedspec$identify/splot.x: Valdes, June 9, 1986
+    1.  Added check on the validity of the imio pointer when attempting
+	to unmap the image.  This occured with a next image failed to
+	access the specified image.
+
+onedspec$identify/ididentify.x: Valdes, June 9, 1986
+    1.  Changed Memr to Memd in 'y' option.
+
+onedspec$identify/reidentify.x: Valdes, June 2, 1986
+    1.  Changed from file template to image template.
+
+onedspec$t_sensfunc.x: Valdes, June 2, 1986
+    1.  Added check for square root of zero which is a fatal error on VMS.
+
+onedspec$t_standard.x,t_sensfunc.x: Valdes, May 19, 1986
+    1.  The output of STANDARD gave the wavelengths of the left edge of the
+	first pixel and the right edge of the last pixel instead of the
+	centers.  This causes slight errors downstream in SENSFUNC.
+	This has been changed to give the actual W0 and WEND.
+        I tried to check that all wavelengths were being calculated and
+	used correctly.
+    2.  SENSFUNC was not correctly using the output of STANDARD.  In some
+	cases it assumed the starting and ending wavelengths were at
+	the edges of the pixel and in other cases it assumed they were
+	at the centers of the pixels.  The errors largely canceled out
+	except that the W0 in the header for the SENSITIVITY image was
+	wrong but WPC and the number of points was correct.  Again, I tried
+	to check that everything is now consistent.
+    3.  SENSFUNC was extrapolating observations when forming the composite
+	sensitivity curve.  This leads to significant errors when some
+	observations do not extend as far as others in wavelength.  This
+	was noticed as a large increase in the RMS relative to the original
+	RMS based only on the observations.  Now extrapolations are not
+	allowed and only observations covering a given range of wavelengths
+	are used in forming the composite curve.  Note that interpolations
+	are still used if an observation does not contain a point at a
+	particular wavelength.
+    4.  The help page for SENSFUNC was modified to explain the difference
+	between the RMS of the input points and the RMS of the composite
+	points.
+    5.  INTRP.F had to be modified because it considered a wavelength
+	equal to the first wavelength in the table as an extrapolation.
+
+onedspec$bswitch.par: Valdes, May 19, 1986
+    1.  The BSWITCH parameter "add_const" has been changed to use the value
+	from SENSFUNC of the same name.  The help page was also modified
+
+onedspec$t_sensfunc.x: Valdes, May 16, 1986
+    1.  SENSFUNC was not writing a complete header needed by LONGSLIT.
+	Now it goes through the standard ONEDSPEC header package to create
+	the senstivity images.
+
+onedspec$t_bswitch.x: Valdes, May 14, 1986
+    1.  BSWITCH was not reinitializing properly when not using IDSMODE.
+	The effect was to give extraneous output.
+    2.  All occurances of "== INDEFI" where changed to use the "IS_INDEF"
+	macro.
+
+onedspec$t_rebin.x: Valdes, May 14, 1986
+    1.  If the image has not been dispersion corrected then an error is
+	printed and the next image is processed.
+
+onedspec$bplot.cl: Valdes, May 13, 1986
+    1.  BPLOT has been modified to call SPLOT separately for each input
+	image.  This has the effect of repeating the cursor file for each
+	image.
+
+onedspec$t_coefs.x: Valdes, May 12, 1986
+    1.  COEFS was not writing a correct IDENTIFY database entry.
+
+onedspec$t_rebin.x: Valdes, May 10, 1986
+    1.  Rebinning into logarithmic intervals was not working.  This has
+	been fixed.  A number of logical changes were required.
+    2.  Rather than use an interative method for determining the coordinate
+	transformation the transformation can be determined explicitly since
+	both the input and output coordinates are linear.
+    3.  The logarithm flag was previously ignored if a primary spectrum was
+	used.  This prevented making the input and primary spectrum
+	the same and then specifying either log or linear output.  This
+	is a common way to use this task for converting to log intervals.
+    4.  The primary spectrum was not being unmapped.
+
+onedutil$bplot.cl: Valdes, May 9, 1986
+    1.  BPLOT has been modified to use the new SPLOT.  The script is now
+	a simple one line call to splot.
+    2.  The input is now a image list instead of a file containing
+	image names.  Note that to use a file containing image names
+	the syntax is now "@file".
+    3.  The cursor input file is now a parameter of the task allowing
+	users to define their own set of commands.
+    4.  The graphics device parameter is now standardized with other
+	graphics tasks.
+    5.  A modified help page is available.
+
+onedspec$splot.x: Valdes, May 9, 1986
+    1.  SPLOT now accepts a list of input spectra and processes them
+	sequentially.  The parameter name has been changed from "image"
+	to "images".
+    2.  New SPLOT parameters XMIN, XMAX, YMIN, YMAX allow the user to
+	set the limits of the initial plot.  These values may be modified
+	interactively with :/xwindow and :/ywindow.
+    3.  A modified help page is available.
+
+onedspec$identify/reidentify.x: Valdes, May 8, 1986
+    1.  Set log output to be flushed with every line written instead of
+	being buffered.
+
+onedspec$sflip.x:  Valdes, May 8, 1986
+    1.  A new task has been added to the ONEDUTIL package call SFLIP.
+	It flips the dispersion direction of spectra while maintaining
+	the proper dispersion image header parameters.
+    2.  A help page has been added for the task SFLIP.
+
+onedspec$splot:  Valdes, May 7, 1986
+    1.  Changed interpretation of W0 in logarithmic binning to be the
+	logarithm of the wavelength of the first pixel.
+
+onedspec$t_dispcor.x, t_rebin.x, t_combine.x:  Valdes, May 7, 1986
+    1.  Changed meaning of w0 in logarithmic coordinates to be consistent
+	with usual linear formula.  That is with a logarithmic wavelength
+	interval the zero point is the logarithm of the starting wavelength.
+    2.  Assumed increasing wavelengths in both the output spectra
+	and the input spectra.  This restriction has been lifted.
+    3.  Default output bins are in increasing wavelength with increasing pixel
+	coordinate even when the input dispersion relation has the opposite
+	sense.
+    4.  The logic in REBIN for col_out = 0 was modified appropriately.
+    5.  The help page for DISPCOR has been modified to indicate the new
+	ability to have arbitrary input and output dispersion directions.
+
+onedspec$userstd:  Valdes, May 6, 1986
+    1.  Previously no graph of the errors would be made if the residuals
+	were all the same.
+    2.  Warning message was removed.
+    3.  Boxes now drawn in NDC with standard size and do not depend on the
+	range of the data or the size of the graph.
+
+onedspec$userstdc.x: Valdes, May 6, 1986
+    1.  Code incorrectly limited highest order for fit to one less than the
+	number of points.  The order is now limited to the number of points.
+    2.  Previously no graph of the errors would be made if the residuals
+	were all the same.
+    3.  Warning messages were removed.
+    4.  Boxes now drawn in NDC with standard size and do not depend on the
+	range of the data or the size of the graph.
+
+onedspec$identify/idlog.x: Valdes, May 1, 1986
+    1.  Column headings were adjusted.
+
+onedspec$onedspec.cl:  Valdes, May 1, 1986
+    1.  Removed loading of list and plot packages in ONEDSPEC package script.
+	These packages are loaded with the NOAO package.
+
+onedspec:  Valdes, April 27, 1986
+    1.  Package pathname "noao.onedspec.onedutil" added to help pages for
+	ONEDUTIL package tasks.
+
+onedspec:  Valdes, April 7, 1986
+    1.  OBSERVATORY task from IMRED package loaded with ONEDSPEC.
+    2.  Latitude parameter removed from the ONEDSPEC package parameters.
+    3.  DISPCOR, STANDARD, and BSWITCH latitude parameters changed to
+	reference OBSERVATORY parameters.
+    4.  The help pages for these tasks were revised.
+
+onedspec$t_flatfit.x:  Valdes, April 7, 1986
+    1.  Fixed minor bug.
+
+onedspec$t_sinterp.x:  Valdes, April 6, 1986
+    1.  Fixed bug in SINTERP.  It was using CURFIT with a pointer argument
+	for the weights instead of a real array.  CURFIT is used only if
+	the interpolation mode is one of the CURFIT types.  Obviously
+	this option was never tested.
+    2.  Entry points removed for portability.
+    3.  The interpolation wavelengths when generating a curve were strongly
+	subject to accumulated roundoff error; x = x + dx.  This was modified
+	to use the construct, x = x1 + (i - 1) * dx, which may still have
+	a precision limitation but not an accumulated roundoff error.
+
+onedspec:  Valdes, April 5, 1986
+    1.  Found very bad error in numerous places.  The arguments to CLGCUR
+	were too few and of those that were there one was of the wrong
+	datatype!!!  This was not a problem on the VAXes but very
+	bad and hard to find on the SUN.
+    2.  Fixed SUN bugs in SENSFUNC due to the statement:
+	    call amovks (1, Mems[flags], npts)
+	Apparently numeric constants are integer sized which causes problems
+	on the SUN which has high order bytes first.  Watch out for this
+	construct!
+
+onedspec$getnimage:  Valdes, April 4, 1986
+    1.  The entry points in this procedure caused tasks to fail on the
+	SUN.  USE OF ENTRY POINTS IS HAZARDOUS TO THE HEALTH OF PORTABLE
+	PROGRAMS.  I shall have to see if there are any more entry points
+	in ONEDSPEC.
+
+onedspec$getairm:  Valdes, April 4, 1986
+    1.  Fixed minor bug in determining HA from ST and RA.  ST was still
+	assumed to be in seconds which is not the case any more.
+
+onedspec:  Valdes, March 28, 1986
+    1.  ADDSETS would fail if an image was missing.  I modified it
+	to detect missing files and continue on.
+
+onedspec:  Valdes, March 27, 1986
+    1.  The header parameters CRPIXn, CRVALn, CDELTn have been added to
+	the image headers.  They replace W0 and WPC though W0 and WPC
+	are still recorded in the header (for now).
+    2.  A new task, SETDISP, has been added to set the dispersion axis
+	(must be 1 for ONEDSPEC), the dispersion type, and the dispersion
+	unit.  These are currently only used for labeling in IDENTIFY
+	and thus the task is optional for the moment.
+    3.  SPLOT modified to label the wavelength axis using CTYPE1 and CUNIT1.
+
+onedspec$splot/deblend.x: Valdes, March 27, 1986
+    1.  Moved deblend.x and eqwidthcp.x to splot directory.
+    2.  There was a typo(?) in deblend.x of SPLOT which converted
+	sigma to FWHM as FWHM = 2.345 * sigma.  This has been corrected
+	to FWHM = 2.355 * sigma.
+    3.  The help page for SPLOT was updated.
+
+onedspec$identify: Valdes, March 26, 1986
+    1.  Fixed bug in IDENTIFY which failed to add new lines with the 'l'
+	command when the initial wavelength axis was pixels.
+
+onedspec$identify: Valdes, March 24, 1986
+    1.  Fixed minor bug in REIDENTIFY.  It was calling IC_FREE instead
+	of IC_FREED (the new double precision version) while the rest
+	of the package was in double precision.
+
+onedspec: Valdes, March 21-22, 1986
+    1.  Continued changes in the ONEDSPEC header parameters.  All the
+	internal ONEDSPEC header parameters are initialized.  Those not
+	in the image header are initialized to INDEF if no other default
+	makes sense.  Then when a new image is created only the parameters
+	which are not INDEF are written to the new image header.  Hopefully
+	there isn't a obscure use in the package that assumes the default
+	value of a parameter is zero (this was the previous default default).
+	A bug of this sort occurred in SPLOT which assumed that W0 and WPC
+	are zero if the image has not been dispersion corrected.  This was
+	changed.
+    2.  SLIST now prints INDEF for the parameters which are indefinite.
+    3.  UT and ST are now stored internally as real values like all the other
+	time and angle parameters.  Previously the were stored as integer
+	seconds.
+    4.  UT, ST, RA, DEC, and HA are written to new images as sexigesimal
+	strings instead of real values.  This is contrary to the FITS standard
+	but this is the way its been done previously.
+    5.  Comments for parameters which are updated by ONEDSPEC are deleted
+	when a new image is created.  This is because the database interface
+	does not allow comments and when entering a new value the comment
+	could be partially overwritten resulting in a nonsensical FITS cards.
+	Parameters which ONEDSPEC does not use are not touched.
+
+onedspec$fortran/intrp.f: Valdes, March 20, 1986
+    1.  Converted entry points into separate procedures.  Entry points,
+	while legal FORTRAN, tend to cause problems except in the very
+	best compilers.  The change was sparked by the failure of the
+	SUN optimizer.  It is not 100% certain that this caused the
+	failure but it works now.
+	
+onedspec: Valdes, March 19, 1986
+    1.  All double precision variables have been change to single
+	precision.  The double precision is an anachronism.  There were
+	numerous type mismatches with calling procedures using double
+	precision and the called procedure expecting single precision.
+	These problems were only found recently on the SUN workstation
+	which has a reversed order to the bytes.  On the VAX this error
+	is not caught.
+    2.  The header parameters are accessed through the image database
+	interface rather than directly.  This cleans things up alot and
+	will make the transition to a real database easier.
+	It does, however, mean that comments and sexigesimal notation are
+	no longer used.
+    3.  Most tasks creating an output image now make a copy of the relevant
+	input image header.  This allows header parameters which are not
+	recognized by ONEDSPEC to be propagated to the new images.
+
+onedspec$t_combine.x: Valdes, March 19, 1986
+    1.  Rebinning did not work after fix to DISPCOR (Feb 14) because macro codes
+	were wrong.
+
+onedspec$t_rebin.x: Valdes, March 19, 1986
+    1.  Did not work after fix to DISPCOR (Feb 14) because macro codes
+	were wrong.
+
+onedspec$identify: Valdes, March 14, 1986
+    1.  Modified IDENTIFY to store the line list internally instead of
+	scanning the line list file every time.
+
+onedspec:  Valdes, March 14, 1986
+    1.  Fixed a bug in LOAD_HDR.X which caused a roundoff error in the UT
+	and ST values.  This was a problem when creating a new image since
+	it inherited slightly different values than the original image.
+    2.  A double precision airmass variable was being passed to GET_AIRM which
+	expected a single precisions variable.  This bug became apparent
+	on the SUN workstation.  Modified GET_AIRM to expect a double
+	precision airmass variable.
+
+onedspec:  Valdes, March 13, 1986
+    1.  Modified IDENTIFY and REIDENTIFY to be double precision.  It uses
+	the double precision ICFIT and CURFIT procedures.
+    2.  The help pages for IDENTIFY and REIDENTIFY were updated for the
+	changes since Release 2.2
+    3.  Fixed bug in SLIST which printed W0, WPC, and AIRMASS incorrectly
+	on the SUN workstation.  Pargr was used instead of pargd.  Also fixed
+	possible problem with assigning INDEFR to a double variable.
+
+onedspec:  Valdes, March 11, 1986
+    1.  SENSFUNC was not putting the dispersion correction flag, DC-FLAG,
+	in the header for the sensitivity image.  This causes LONGSLIT.FLUXCAL
+	to fail.  This has been fixed.
+
+onedspec:  Valdes, March 6, 1986
+    1.  Added parameter to SPLOT to allow selection of the graphics output
+	device.
+    2.  Help page for SPLOT modified.
+    3.  New parameter file for SPLOT.  Also installed in IMRED packages.
+
+onedspec:  Valdes, Feb 27, 1986
+    1.  IDENTIFY and REIDENTIFY have been modified to do shifts in user
+	coordinates instead of pixel coordinates.  This applies to the 's'
+	and 'x' keys in IDENTIFY and to REIDENTIFY.  The shift specified in
+	REIDENTIFY is now in user coordinates.  Unless otherwise specified
+	the shifts printed by these tasks are in user coordinates instead
+	of pixels.
+    2.  A new key has been added to IDENTIFY.  The key 'r' resets the
+	current feature to the position of the cursor.  This replaces the
+	need to mark the new position and then delete the old position.
+    3.  The output of 's' and 'x' in IDENTIFY is slightly different.
+===========
+Release 2.2
+===========
+From Valdes Feb 28, 1986:
+
+1.  Fixed bug in FLATDIV which printed the image title as garbage.  Also
+the output record number is increment for each input spectrum regardless
+of whether the input spectrum is found, has already been flatted, or
+is flattened.
+------
+From Valdes Feb 24, 1986:
+
+1.  Removed junk file identify/isdir.x.
+------
+From Valdes Feb 14, 1986:
+
+1.  t_sensfunc.x, userstd.x, and fudge.x have been modified to allow
+the grey scale correction to be determined interactively even when
+points are deleted.
+
+2.  Fixed bug in DISPCOR to allow interpolation between solutions.  This
+did not work before.
+------
+From Valdes Feb 10, 1986:
+
+1.  FLATDIV has been modified to do in-place flattening when the input
+and output spectra are the same.
+------
+From Valdes Jan 24, 1986:
+
+1.  In IDENTIFY the 'l' always does a fit first before identifying
+additional lines.
+------
+From Valdes Jan 21, 1986:
+
+1.  HELP pages updated.
+
+2.  The log information written by REIDENTIFY has been made more compact
+and a option to futher reduce this log information "verbose" has been added.
+------
+From Valdes Jan 17, 1986:
+
+1.  Bugs fixed affecting SPLOT and DISPCOR.
+------
+From Valdes Jan 6, 1986:
+
+1.  Problem with cursor key 'o' in SENSFUNC fixed.
+
+2.  The 's' shift option in IDENTIFY has been modified.  It now prints
+the initial shift, the mean pixel shift, and the mean fractional shift
+in user units.  This can be conveniently used for determining velocity
+shifts from a standard.
+------
+From Valdes Jan 2, 1986:
+
+1.  If the HA field was missing from a field it was being initialized to
+0. which is a valid HA value.  This has been changed to initialize to -100.
+This value will force recomputation of the HA when determining the air mass.
+
+2.  A bug in computing the air mass when the HA is not defined was found
+and fixed.
+------
+From Valdes Dec 30, 1985:
+
+1.  A bug in DISPCOR when using a reference image and the directory
+structured database has been fixed.
+------
+From Valdes Dec 9, 1985:
+
+1.  NORMCONTINUUM has been renamed to CONTINUUM and modified to have the
+output type as a hidden parameter.
+
+2.  The standard line lists have been put in the directory stdlines$.
+------
+From Valdes Nov 26, 1985:
+
+1.  SPLOT modified to use gtools graphics options.  These options are
+accessed with :/ commands; i.e. ":/xwindow x1 x2" sets the x display
+window.
+
+2.  SPLOT parameter "auto" replaced by parameter "options" which allows
+several plotting options to be given.  The options are given as a list of
+possibly abbreviated strings.  The two options currently defined are
+"auto" and "zero".  Auto is the same as before; it replots the graph
+after any command that changes the graph.  Zero makes the initial
+default for the graph have zero as the minimum Y.
+------
+From Valdes Nov 15, 1985:
+
+1.  Modified IDENTIFY, REIDENTIFY, and DISPCOR to use directory type database
+structure.  Instead of a single massive database textfile separate
+database text files are created for each image in the database directory.
+------
+From Valdes Oct 28, 1985:
+
+1.  Increased the efficiency of widstape from 7 seconds per spectrum to
+about 2 seconds per spectrum by using low level formating.
+------
+From Valdes Oct 23, 1985:
+
+1.  Bug fix to allow zero entries in the calibration files.
+------
+From Valdes Oct 9, 1985:
+
+1.  Cursor parameter added to the tasks flatfit, splot, and standard.
+
+2.  Defined widstape from ONEDSPEC package in the DATAIO package.  The
+source and executable, however, still reside in ONEDSPEC (x_onedutil.e).
+Widstape and widsout should be combined and the source put in DATAIO
+at some point.
+------
+From Valdes Oct 7, 1985:
+
+1.  Parameter indirections removed.
+
+2.  Tasks IRS and IIDS moved to the IMRED package.  ONEDSPEC need not
+be loaded directly.  The usually method should be to load IMRED and then
+the appropriate instrument package.
+------
+From Valdes Oct 4, 1985:
+
+1.  Add script task normcontinuum to fit the continuum of spectra and
+output a continuum normalized spectrum.  This script is based on
+images.fit1d.
+------
+From Valdes October 1, 1985:
+
+1.  The source code for identify and reidentify has been moved from the
+longslit package to the onedspec package since these tasks are essentially
+one dimensional.
+
+------
+From Valdes August 19, 1985:
+
+1.  Makelib file created to maintain archive for the onedspec package.
+The archive is libods.a.  Makefile modified to use the library.
+This removes all the .o files making directory easier to list.
+
+2.  An attempt to write to an existing image in splot requires the
+user to confirm.  Overwriting an existing image now maintains the pixel
+files correctly.
+
+3.  New script task revisions pages the package revision file.
+.endhelp
diff --git a/noao/onedspec/aidpars.par b/noao/onedspec/aidpars.par
new file mode 100644
index 00000000..005414c0
--- /dev/null
+++ b/noao/onedspec/aidpars.par
@@ -0,0 +1,25 @@
+# Parameters for autoidentify task.
+
+reflist,s,h,"",,,Reference coordinate list
+refspec,s,h,"",,,Reference spectrum
+#crval,s,h,"INDEF",,,Coordinate reference value
+#cdelt,s,h,"INDEF",,,Coordinate interval per pixel
+crpix,s,h,"INDEF",,,Coordinate reference pixel
+crquad,s,h,"INDEF",,,Quadratic pixel distortion at reference pixel
+cddir,s,h,"sign","unknown|sign|increasing|decreasing",,Dispersion direction
+crsearch,s,h,"INDEF",,,Coordinate value search radius
+cdsearch,s,h,"INDEF",,,Coordinate interval search radius
+ntarget,i,h,100,,,Number of target features
+#nreference,i,h,40,,,Number of reference features
+npattern,i,h,5,3,10,Number of lines in patterns
+nneighbors,i,h,10,2,,Number of nearest neighbors in patterns
+nbins,i,h,6,1,,Maximum number of search bins
+ndmax,i,h,500,1,,Maximum number of dispersions to evaluate
+aidord,i,h,3,2,,Dispersion fitting order
+maxnl,r,h,0.02,0.,,Maximum non-linearity
+nfound,i,h,6,3,,Minimum number of lines in final solution
+sigma,r,h,.05,0.,,Sigma of line centering (pixels)
+minratio,r,h,0.1,0., 1.,Minimum spacing ratio to use
+rms,r,h,0.1,0.,,RMS goal (fwidths)
+fmatch,r,h,0.2,0.,1.,Matching goal (fraction unmatched)
+debug,s,h,"",,,Print debugging information
diff --git a/noao/onedspec/autoidentify.par b/noao/onedspec/autoidentify.par
new file mode 100644
index 00000000..4d6c4c27
--- /dev/null
+++ b/noao/onedspec/autoidentify.par
@@ -0,0 +1,38 @@
+# Parameters for AUTOIDENTIFY.
+
+images,s,a,,,,"Images containing features to be identified"
+crval,s,a,,,,"Approximate coordinate (at reference pixel)"
+cdelt,s,a,,,,"Approximate dispersion"
+coordlist,f,h,,,,"Coordinate list"
+units,s,h,"",,,Coordinate units
+interactive,s,h,"yes","no|yes|NO|YES",,"Examine identifications interactively?"
+aidpars,pset,h,,,,"Automatic identification algorithm parameters
+"
+section,s,h,"middle line",,,"Section to apply to two dimensional images"
+nsum,s,h,"1",,,"Number of lines/columns/bands to sum in 2D/3D images
+"
+ftype,s,h,"emission","emission|absorption",,Feature type
+fwidth,r,h,4.,,,Feature width in pixels
+cradius,r,h,5.,,,Centering radius in pixels
+threshold,r,h,0.,0.,,Feature threshold for centering
+minsep,r,h,2.,0.,,"Minimum pixel separation"
+match,r,h,-3.,,,"Coordinate list matching limit
+"
+function,s,h,"spline3","legendre|chebyshev|spline1|spline3",,"Coordinate function"
+order,i,h,1,1,,"Order of coordinate function"
+sample,s,h,"*",,,"Coordinate sample regions"
+niterate,i,h,10,0,,"Rejection iterations"
+low_reject,r,h,2.,0.,,"Lower rejection sigma"
+high_reject,r,h,2.,0.,,"Upper rejection sigma"
+grow,r,h,0.,0.,,"Rejection growing radius
+"
+dbwrite,s,h,"yes","no|yes|NO|YES",,"Write results to database?"
+overwrite,b,h,"yes",,,"Overwrite existing database entries?"
+database,f,h,database,,,"Database in which to record feature data"
+verbose,b,h,yes,,,"Verbose output?"
+logfile,s,h,"logfile",,,"List of log files"
+plotfile,s,h,"",,,"Plot file for residuals"
+graphics,s,h,"stdgraph",,,"Graphics output device"
+cursor,*gcur,h,"",,,"Graphics cursor input
+"
+query,s,q,,,," "
diff --git a/noao/onedspec/bplot.cl b/noao/onedspec/bplot.cl
new file mode 100644
index 00000000..146fa2f5
--- /dev/null
+++ b/noao/onedspec/bplot.cl
@@ -0,0 +1,54 @@
+# BPLOT -- Batch plotting of spectra with SPLOT
+
+procedure bplot (images)
+
+string	images				{prompt="List of images to plot"}
+string	apertures = ""			{prompt="List of apertures to plot"}
+int	band = 1			{prompt="Band to plot"}
+string	graphics = "stdgraph"		{prompt="Graphics output device"}
+string	cursor   = "onedspec$gcurval.dat"	{prompt="Cursor file(s)\n\nSPLOT query parameters to fix"}
+
+string	next_image = ""			{prompt="Next image to plot"}
+string	new_image = ""			{prompt="Image to create"}
+bool	overwrite = yes			{prompt="Overwrite image?"}
+string	spec2 = ""			{prompt="Spectrum"}
+real	constant = 0.			{prompt="Constant to be applied"}
+real	wavelength = 0.			{prompt="Dispersion coordinate"}
+file	linelist = ""			{prompt="File"}
+real	wstart = 0.			{prompt="Starting wavelength"}
+real	wend = 0.			{prompt="Ending wavelength"}
+real	dw = 0.				{prompt="Wavelength per pixel"}
+int	boxsize = 2			{prompt="Smoothing box size\n"}
+
+struct	*ilist, *clist
+
+begin
+	int	line, ap
+	file	ifile, cfile, cur, image
+
+	ifile = mktemp ("bplot")
+	cfile = mktemp ("bplot")
+
+	slist (images, apertures=apertures, long_header=no, > ifile)
+	files (cursor, > cfile) 
+	cur = ""
+
+	ilist = ifile; clist = cfile
+	while (fscan (ilist, image, line, ap) != EOF) {
+	    if (nscan() < 3)
+		next
+	    if ((cursor != "") && (fscan (clist, cur) == EOF)) {
+		clist = cfile
+		line = fscan (clist, cur)
+	    }
+	    splot (image, line=ap, band=band, graphics=graphics, cursor=cur,
+		next_image=next_image, new_image=new_image,
+		overwrite=overwrite, spec2=spec2, constant=constant,
+		wavelength=wavelength, linelist=linelist, wstart=wstart,
+		wend=wend, dw=dw, boxsize=boxsize)
+	}
+	clist = ""; ilist = ""
+
+	delete (ifile, verify=no)
+	delete (cfile, verify=no)
+end
diff --git a/noao/onedspec/calibrate.par b/noao/onedspec/calibrate.par
new file mode 100644
index 00000000..5f805c46
--- /dev/null
+++ b/noao/onedspec/calibrate.par
@@ -0,0 +1,13 @@
+# 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,,,,Extinction file
+observatory,s,h,)_.observatory,,,Observatory of observation
+ignoreaps,b,h,no,,,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?
+airmass,r,q,,1.,,Airmass
+exptime,r,q,,,,Exposure time (seconds)
diff --git a/noao/onedspec/continuum.par b/noao/onedspec/continuum.par
new file mode 100644
index 00000000..6a43d804
--- /dev/null
+++ b/noao/onedspec/continuum.par
@@ -0,0 +1,25 @@
+input,s,a,,,,Input images
+output,s,a,,,,Output images
+lines,s,h,"*",,,Image lines to be fit
+bands,s,h,"1",,,Image bands to be fit
+type,s,h,"ratio","data|fit|difference|ratio",,Type of output
+replace,b,h,no,,,Replace rejected points by fit?
+wavescale,b,h,yes,,,Scale the X axis with wavelength?
+logscale,b,h,no,,,Take the log (base 10) of both axes?
+override,b,h,no,,,Override previously fit lines?
+listonly,b,h,no,,,List fit but don't modify any images?
+logfiles,s,h,"logfile",,,List of log files
+interactive,b,h,yes,,,Set fitting parameters interactively?
+sample,s,h,"*",,,Sample 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,2.,0.,,Low rejection in sigma of fit
+high_reject,r,h,0.,0.,,High rejection in sigma of fit
+niterate,i,h,10,0,,Number of rejection iterations
+grow,r,h,1.,0.,,Rejection growing radius
+markrej,b,h,yes,,,Mark rejected points?
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
+ask,s,q,"yes","yes|no|skip|YES|NO|SKIP",,"                                     "
+mode,s,h,"ql"
diff --git a/noao/onedspec/deredden.par b/noao/onedspec/deredden.par
new file mode 100644
index 00000000..f787033a
--- /dev/null
+++ b/noao/onedspec/deredden.par
@@ -0,0 +1,10 @@
+# DEREDDEN parameter file
+
+input,s,a,,,,Input spectra to correct
+output,s,a,,,,Output corrected spectra
+value,r,a,,,,Extinction parameter value
+R,r,h,3.1,,,A(V)/E(B-V)
+type,s,h,"E(B-V)","A(V)|E(B-V)|c",,Type of extinction parameter
+apertures,s,h,"",,,Apertures to correct
+override,b,h,no,,,Override previous correction?
+uncorrect,b,h,yes,,,Uncorrect previous correction?
diff --git a/noao/onedspec/dispcor.par b/noao/onedspec/dispcor.par
new file mode 100644
index 00000000..0fd17027
--- /dev/null
+++ b/noao/onedspec/dispcor.par
@@ -0,0 +1,19 @@
+input,s,a,,,,List of input spectra
+output,s,a,,,,List of output spectra
+linearize,b,h,yes,,,Linearize (interpolate) spectra?
+database,s,h,"database",,,Dispersion solution database
+table,s,h,"",,,Wavelength table for apertures
+w1,r,h,INDEF,,,Starting wavelength
+w2,r,h,INDEF,,,Ending wavelength
+dw,r,h,INDEF,,,Wavelength interval per pixel
+nw,i,h,INDEF,,,Number of output pixels
+log,b,h,no,,,Logarithmic wavelength scale?
+flux,b,h,yes,,,Conserve total flux?
+blank,r,h,0.,,,Output value of points not in input
+samedisp,b,h,no,,,Same dispersion in all apertures?
+global,b,h,no,,,Apply global defaults?
+ignoreaps,b,h,no,,,Ignore apertures?
+confirm,b,h,no,,,Confirm dispersion coordinates?
+listonly,b,h,no,,,List the dispersion coordinates only?
+verbose,b,h,yes,,,Print linear dispersion assignments?
+logfile,s,h,"",,,Log file
diff --git a/noao/onedspec/dispcor/dcio.x b/noao/onedspec/dispcor/dcio.x
new file mode 100644
index 00000000..b700da6a
--- /dev/null
+++ b/noao/onedspec/dispcor/dcio.x
@@ -0,0 +1,1155 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<pkg/dttext.h>
+include	<smw.h>
+include	<units.h>
+include	"dispcor.h"
+
+# Symbol table structure for the dispersion solutions.
+define	LEN_DC		11		# Length of dispersion solution struct.
+define	DC_FORMAT	Memi[$1]	# Type of dispersion
+define	DC_PAPS		Memi[$1+1]	# Pointer to aperture numbers
+define	DC_PAPCEN	Memi[$1+2]	# Pointer to aperture centers
+define	DC_PUN		Memi[$1+3]	# Pointer to units
+define	DC_PSHIFT	Memi[$1+4]	# Pointer to shifts
+define	DC_PCOEFF	Memi[$1+5]	# Pointer to coefficients
+define	DC_NAPS		Memi[$1+6]	# Number of apertures
+define  DC_OFFSET       Memi[$1+7]      # Aperture to order offset
+define  DC_SLOPE        Memi[$1+8]      # Aperture to order slope
+define  DC_COEFFS       Memi[$1+9]      # Dispersion coefficients
+define  DC_SHIFT        Memr[P2R($1+10)]# Dispersion function shift
+
+
+# DC_OPEN    -- Initialize the dispersion data structures
+# DC_CLOSE   -- Close the dispersion data structures
+# DC_GMS     -- Get a multispec spectrum
+# DC_GMSDB   -- Get a multispec dispersion database entry
+# DC_REFSHFT -- Get a reference shift
+# DC_GEC     -- Get an echelle spectrum
+# DC_GECDB   -- Get an echelle dispersion database entry
+# DC_ECMS    -- Convert echelle dispersion coeffs to multispec coeffs
+
+
+# DC_OPEN -- Initialize the dispersion routines.  This consists
+# of opening a symbol table for the dispersion solution functions.  A
+# symbol table is used since the same dispersion reference (arc image)
+# may be be used multiple times and the database access is slow.
+
+procedure dc_open (stp, db)
+
+pointer	stp			# Symbol table pointer
+char	db[SZ_FNAME]		# Database name
+
+pointer	sym, stopen(), stenter(), stpstr()
+
+begin
+	stp = stopen ("disp", 10, 10, 10*SZ_FNAME)
+	sym = stenter (stp, "database", 1)
+	Memi[sym] = stpstr (stp, db, 0)
+end
+
+
+# DC_CLOSE -- Close the dispersion data structures.
+
+procedure dc_close (stp)
+
+int	i
+pointer stp, sym, sthead, stnext
+
+begin
+	# Close each dispersion function and then the symbol table.
+	for (sym = sthead (stp); sym != NULL; sym = stnext (stp, sym)) {
+	    if (DC_FORMAT(sym) == 1) {
+		do i = 1, DC_NAPS(sym) {
+		    call un_close (Memi[DC_PUN(sym)+i-1])
+		    call mfree (Memi[DC_PCOEFF(sym)+i-1], TY_DOUBLE)
+		}
+		call mfree (DC_PAPS(sym), TY_INT)
+		call mfree (DC_PAPCEN(sym), TY_REAL)
+		call mfree (DC_PUN(sym), TY_POINTER)
+		call mfree (DC_PSHIFT(sym), TY_DOUBLE)
+		call mfree (DC_PCOEFF(sym), TY_POINTER)
+	    } else if (DC_FORMAT(sym) == 2) {
+		call un_close (DC_PUN(sym))
+		call mfree (DC_COEFFS(sym), TY_DOUBLE)
+	    }
+	}
+	call stclose (stp)
+end
+
+
+# DC_GMS -- Get a multispec spectrum.  This consists of mapping the image
+# and setting a MWCS coordinate transformation.  If not dispersion corrected
+# the dispersion function is found in the database for the reference
+# spectra and set in the SMW.
+
+procedure dc_gms (spec, im, smw, stp, ignoreaps, ap, fd1, fd2)
+
+char	spec[ARB]	#I Spectrum name
+pointer	im		#I IMIO pointer
+pointer	smw		#I SMW pointer
+pointer	stp		#I Dispersion symbol table
+int	ignoreaps	#I Ignore aperture numbers?
+pointer	ap		#O Aperture data structure
+int	fd1		#I Logfile descriptor
+int	fd2		#I Logfile descriptor
+
+double	wt1, wt2, dval
+int	i, j, k, k1, k2, l, dc, sfd, naps, naps1, naps2, ncoeffs
+pointer	sp, str1, str2, papcen, pshift, coeffs, ct1, ct2, un, un1, un2
+pointer	paps1, paps2, punits1, punits2, pshift1, pshift2, pcoeff1, pcoeff2
+
+bool	un_compare()
+double	smw_c1trand()
+int	imaccf(), nscan(), stropen()
+pointer	smw_sctran(), un_open()
+errchk	dc_gmsdb, dc_refshft, imgstr, smw_sctran, un_open
+
+define	done_	90
+
+begin
+	call smark (sp)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+
+	# Set WCS attributes
+	naps = IM_LEN(im,2)
+	call calloc (ap, LEN_AP(naps), TY_STRUCT)
+	do i = 1, naps {
+	    DC_PL(ap,i) = i
+	    DC_CF(ap,i) = NULL
+	    call smw_gwattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), DC_CF(ap,i))
+	    if (i == 1) {
+		iferr (call mw_gwattrs (SMW_MW(smw,0), 1, "units", Memc[str1],
+		    SZ_LINE))
+		    Memc[str1] = EOS
+		DC_UN(ap,i) = un_open (Memc[str1])
+	    }
+	    dc = DC_DT(ap,i)
+	}
+
+	# Check if the spectra have been dispersion corrected
+	# by an earlier version of DISPCOR.  If so then don't allow
+	# another database dispersion correction.  This assumes all
+	# spectra have the same dispersion type.  Check for a
+	# reference spectrum.
+
+	#if ((imaccf (im, "REFSPEC1") == NO) ||
+	#    (dc > -1 && imaccf (im, "DCLOG1") == NO)) {
+	if (imaccf (im, "REFSPEC1") == NO) {
+	    if (fd1 != NULL) {
+		call fprintf (fd1,
+		    "%s: Resampling using current coordinate system\n")
+		    call pargstr (spec)
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2,
+		    "%s: Resampling using current coordinate system\n")
+		    call pargstr (spec)
+	    }
+	    goto done_
+	}
+	    
+	# Get the reference spectra dispersion function from the database
+	# and determine a reference shift.
+
+	iferr {
+	    call imgstr (im, "REFSPEC1", Memc[str1], SZ_LINE)
+	    call sscan (Memc[str1])
+	    call gargwrd (Memc[str1], SZ_LINE)
+	    call gargd (wt1)
+	    if (nscan() == 1)
+		wt1 = 1.
+	} then {
+	    call strcpy (spec, Memc[str1], SZ_FNAME)
+	    wt1 = 1.
+	}
+	iferr (call dc_gmsdb (Memc[str1], stp, paps1, papcen, punits1, pshift,
+	    pcoeff1, naps1)) {
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+	call salloc (pshift1, naps1, TY_DOUBLE)
+	call amovd (Memd[pshift], Memd[pshift1], naps1)
+	if (fd1 != NULL) {
+	    call fprintf (fd1, "%s: REFSPEC1 = '%s %.8g'\n")
+		call pargstr (spec)
+		call pargstr (Memc[str1])
+		call pargd (wt1)
+	}
+	if (fd2 != NULL) {
+	    call fprintf (fd2, "%s: REFSPEC1 = '%s %.8g'\n")
+		call pargstr (spec)
+		call pargstr (Memc[str1])
+		call pargd (wt1)
+	}
+
+	iferr (call  dc_refshft (spec, stp, Memc[str1], "REFSHFT1", im,
+	    Memi[paps1], Memr[papcen], Memd[pshift1], naps1, fd1, fd2))
+	    ;
+
+	iferr {
+            call imgstr (im, "REFSPEC2", Memc[str1], SZ_LINE)
+            call sscan (Memc[str1])
+            call gargwrd (Memc[str1], SZ_LINE)
+            call gargd (wt2)
+            if (nscan() == 1)
+                wt2 = 1.
+            call dc_gmsdb (Memc[str1], stp, paps2, papcen, punits2, pshift,
+		pcoeff2, naps2)
+            call salloc (pshift2, naps2, TY_DOUBLE)
+            call amovd (Memd[pshift], Memd[pshift2], naps2)
+	    if (fd1 != NULL) {
+		call fprintf (fd1, "%s: REFSPEC2 = '%s %.8g'\n")
+		    call pargstr (spec)
+		    call pargstr (Memc[str1])
+		    call pargd (wt2)
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2, "%s: REFSPEC2 = '%s %.8g'\n")
+		    call pargstr (spec)
+		    call pargstr (Memc[str1])
+		    call pargd (wt2)
+	    }
+	    iferr (call  dc_refshft (spec, stp, Memc[str1],
+		"REFSHFT2", im, Memi[paps2], Memr[papcen], Memd[pshift2],
+		naps2, fd1, fd2))
+	        ;
+	} then
+	    wt2 = 0.
+
+	# Adjust weights to unit sum.
+	dval = wt1 + wt2
+	wt1 = wt1 / dval
+	wt2 = wt2 / dval
+
+	# Enter dispersion function in the MWCS.
+	do i = 1, naps {
+	    j = DC_AP(ap,i)
+	    for (k1=0; k1<naps1 && Memi[paps1+k1]!=j; k1=k1+1)
+		;
+	    if (k1 == naps1)
+		for (k1=0; k1<naps1 && !IS_INDEFI(Memi[paps1+k1]); k1=k1+1)
+		    ;
+	    if (k1 == naps1) {
+		if (ignoreaps == YES)
+		    k1 = 0
+		else {
+		    call sprintf (Memc[str1], SZ_LINE,
+			"%s - Missing reference for aperture %d")
+			call pargstr (spec)
+			call pargi (j)
+		    call fatal (1, Memc[str1])
+		}
+	    }
+	    un1 = Memi[punits1+k1]
+
+	    # The following assumes some knowledge of the data structure in
+	    # order to shortten the the attribute string.
+	    coeffs = Memi[pcoeff1+k1]
+	    if (coeffs == NULL) {
+		if (DC_DT(ap,i) == 2) {
+		    sfd = NULL
+		    if (wt2 <= 0.)
+			call sshift1 (Memd[pshift1+k1], DC_CF(ap,i))
+		} else {
+		    ncoeffs = 6
+		    l = 20 * (ncoeffs + 2)
+		    if (wt2 > 0.)
+			l = 2 * l
+		    call realloc (DC_CF(ap,i), l, TY_CHAR)
+		    call aclrc (Memc[DC_CF(ap,i)], l)
+		    sfd = stropen (Memc[DC_CF(ap,i)], l, NEW_FILE)
+		    call fprintf (sfd, "%.8g %g")
+			call pargd (wt1)
+			call pargd (Memd[pshift1+k1])
+		    dval = DC_DW(ap,i) * (DC_NW(ap,i) - 1) / 2.
+		    call fprintf (sfd, " 1 2 1 %d %g %g")
+			call pargi (DC_NW(ap,i))
+			call pargd (DC_W1(ap,i) + dval)
+			call pargd (dval)
+		}
+	    } else {
+		ncoeffs = nint (Memd[coeffs])
+		l = 20 * (ncoeffs + 2)
+		if (wt2 > 0.)
+		    l = 2 * l
+		call realloc (DC_CF(ap,i), l, TY_CHAR)
+		call aclrc (Memc[DC_CF(ap,i)], l)
+		sfd = stropen (Memc[DC_CF(ap,i)], l, NEW_FILE)
+		call fprintf (sfd, "%.8g %g %d %d")
+		    call pargd (wt1)
+		    call pargd (Memd[pshift1+k1])
+		    call pargi (nint (Memd[coeffs+1]))
+		    call pargi (nint (Memd[coeffs+2]))
+		do k = 3, ncoeffs {
+		    call fprintf (sfd, " %.15g")
+			call pargd (Memd[coeffs+k])
+		}
+	    }
+
+	    if (wt2 > 0.) {
+		for (k2=0; k2<naps2 && Memi[paps2+k2]!=j; k2=k2+1)
+		    ;
+		if (k2 == naps2)
+		    for (k2=0; k2<naps2 && !IS_INDEFI(Memi[paps2+k2]); k2=k2+1)
+			;
+		if (k2 == naps2) {
+		    if (ignoreaps == YES)
+			k2 = 0
+		    else {
+			call sprintf (Memc[str1], SZ_LINE,
+			    "%s - Missing reference for aperture %d")
+			    call pargstr (spec)
+			    call pargi (j)
+			if (sfd != NULL)
+			    call strclose (sfd)
+			call sfree (sp)
+			call fatal (1, Memc[str1])
+		    }
+		}
+		un2 = Memi[punits2+k2]
+		if (!un_compare (un1, un2)) {
+		    call sfree (sp)
+		    call error (2,
+			"Can't combine references with different units")
+		}
+		if (DC_DT(ap,i)==2 && !(coeffs==NULL&&Memi[pcoeff2+k2]==NULL)) {
+		    call sfree (sp)
+		    call error (2,
+			"Can't combine references with non-linear dispersions")
+		}
+		coeffs = Memi[pcoeff2+k2]
+		if (coeffs == NULL) {
+		    if (DC_DT(ap,i) == 2) {
+			dval = (wt1*Memd[pshift1+k1] + wt2*Memd[pshift2+k2]) /
+			    (wt1 + wt2)
+			call sshift1 (dval, DC_CF(ap,i))
+		    } else {
+			call fprintf (sfd, " %.8g %g")
+			    call pargd (wt2)
+			    call pargd (Memd[pshift2+k2])
+			dval = DC_DW(ap,i) * (DC_NW(ap,i) - 1) / 2.
+			call fprintf (sfd, " 1 2 1 %d %g %g")
+			    call pargi (DC_NW(ap,i))
+			    call pargd (DC_W1(ap,i) + dval)
+			    call pargd (dval)
+		    }
+		} else {
+		    call fprintf (sfd, " %.8g %g %d %d")
+			call pargd (wt2)
+			call pargd (Memd[pshift2+k2])
+			call pargi (nint (Memd[coeffs+1]))
+			call pargi (nint (Memd[coeffs+2]))
+		    ncoeffs = nint (Memd[coeffs])
+		    do k = 3, ncoeffs {
+			call fprintf (sfd, " %.15g")
+			    call pargd (Memd[coeffs+k])
+		    }
+		}
+	    }
+
+	    if (i == 1) {
+		un = un1
+		if (UN_LABEL(un) != EOS)
+		    call mw_swattrs (SMW_MW(smw,0), 1, "label", UN_LABEL(un))
+		if (UN_UNITS(un) != EOS)
+		    call mw_swattrs (SMW_MW(smw,0), 1, "units", UN_UNITS(un))
+		call un_close (DC_UN(ap,i))
+		DC_UN(ap,i) = un
+	    } else if (!un_compare (un, un1)) {
+		call sfree (sp)
+		call error (3, "Units must be the same for all apertures")
+	    }
+	    DC_DT(ap,i) = 2
+	    call smw_swattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), Memc[DC_CF(ap,i)])
+	    if (sfd != NULL)
+		call strclose (sfd)
+	}
+
+	# Update the linear part of WCS.
+	ct1 = smw_sctran (smw, "logical", "physical", 2)
+	ct2 = smw_sctran (smw, "physical", "world", 3)
+	do i = 1, naps {
+	    call smw_gwattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), DC_CF(ap,i))
+	    wt1 = nint (smw_c1trand (ct1, double(i)))
+	    call smw_c2trand (ct2, double(DC_NW(ap,i)), wt1, DC_W2(ap,i), wt2)
+	    DC_DW(ap,i) = (DC_W2(ap,i) - DC_W1(ap,i)) / (DC_NW(ap,i) - 1)
+	    call smw_swattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), Memc[DC_CF(ap,i)])
+	}
+	call smw_ctfree (ct1)
+	call smw_ctfree (ct2)
+
+done_	# Set aperture parameters in terms of logical image.
+	ct1 = smw_sctran (smw, "physical", "logical", 1)
+	j = nint (smw_c1trand (ct1, 1D0))
+	do i = 1, naps {
+	    k = nint (smw_c1trand (ct1, double(DC_NW(ap,i))))
+	    DC_NW(ap,i) = min (IM_LEN(im,1), max (j, k))
+	}
+	call smw_ctfree (ct1)
+
+	ct1 = smw_sctran (smw, "logical", "world", 3)
+	do i = 1, naps {
+	    wt1 = i
+	    call smw_c2trand (ct1, 1D0, wt1, DC_W1(ap,i), wt2)
+	    call smw_c2trand (ct1, double(DC_NW(ap,i)), wt1, DC_W2(ap,i), wt2)
+	    DC_DW(ap,i) = (DC_W2(ap,i) - DC_W1(ap,i)) / (DC_NW(ap,i) - 1)
+	}
+	call smw_ctfree (ct1)
+
+	do i = 1, naps
+	    call mfree (DC_CF(ap,i), TY_CHAR)
+	call sfree (sp)
+end
+
+
+# DC_GMSDB -- Get a dispersion database entry.
+# The database entry is read only once from the database and stored in a
+# symbol table keyed by the spectrum name.  Subsequent requests for the
+# reference spectrum returns the data from the symbol table.
+
+procedure dc_gmsdb (spec, stp, paps, papcen, punits, pshift, pcoeff, naps)
+
+char	spec[ARB]	# Spectrum image name
+pointer	stp		# Symbol table pointer
+pointer	paps		# Pointer to aperture numbers
+pointer	papcen		# Pointer to aperture centers
+pointer	punits		# Pointer to units
+pointer	pshift		# Pointer to shifts
+pointer	pcoeff		# Pointer to coefficients
+int	naps		# Number of apertures
+
+double	dval
+int	i, n, dtgeti(), getline(), ctod()
+real	low, high, dtgetr()
+pointer	sp, str, coeffs, sym, db, dt, dt1
+pointer	stfind(), stenter(), strefsbuf(), dtmap1(), un_open()
+errchk	dtmap1, dtgeti, dtgad, un_open
+
+begin
+	# Check if dispersion solution is in the symbol table from a previous
+	# call.  If not in the symbol table get it from the database and
+	# store it in the symbol table.
+
+	sym = stfind (stp, spec)
+	if (sym == NULL) {
+	    call smark (sp)
+	    call salloc (str, SZ_LINE, TY_CHAR)
+	    call strcpy ("id", Memc[str], SZ_LINE)
+	    call imgcluster (spec, Memc[str+2], SZ_LINE-2)
+	    call xt_imroot (Memc[str+2], Memc[str+2], SZ_LINE-2)
+	    db = strefsbuf (stp, Memi[stfind (stp, "database")])
+	    dt = dtmap1 (Memc[db], Memc[str], READ_ONLY)
+	    call strcpy ("ec", Memc[str], SZ_LINE)
+	    call imgcluster (spec, Memc[str+2], SZ_LINE-2)
+	    call xt_imroot (Memc[str+2], Memc[str+2], SZ_LINE-2)
+	    ifnoerr (dt1 = dtmap1 (Memc[db], Memc[str], READ_ONLY)) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "Ambiguous database files: %s/%s and %s/%s")
+		    call pargstr (DT_DNAME(dt))
+		    call pargstr (DT_FNAME(dt))
+		    call pargstr (DT_DNAME(dt1))
+		    call pargstr (DT_FNAME(dt1))
+		call dtunmap (dt)
+		call dtunmap (dt1)
+		call fatal (3, Memc[str])
+	    }
+
+	    naps = max (1, DT_NRECS(dt))
+	    call calloc (paps, naps, TY_INT)
+	    call calloc (papcen, naps, TY_REAL)
+	    call calloc (punits, naps, TY_POINTER)
+	    call calloc (pshift, naps, TY_DOUBLE)
+	    call calloc (pcoeff, naps, TY_POINTER)
+	    if (DT_NRECS(dt) > 0) {
+		for (i = 1; i <= naps; i = i + 1) {
+		    iferr (Memi[paps+i-1] = dtgeti (dt, i, "aperture"))
+			Memi[paps+i-1] = INDEFI
+		    iferr (low = dtgetr (dt, i, "aplow"))
+			low = INDEF
+		    iferr (high = dtgetr (dt, i, "aphigh"))
+			high = INDEF
+		    if (IS_INDEF(low) || IS_INDEF(high))
+			Memr[papcen+i-1] = 0.
+		    else
+			Memr[papcen+i-1] = (low + high) / 2.
+		    iferr (call dtgstr (dt, i, "units", Memc[str], SZ_LINE))
+			call strcpy ("Angstroms", Memc[str], SZ_LINE)
+		    Memi[punits+i-1] = un_open (Memc[str])
+		    iferr (Memd[pshift+i-1] = dtgetr (dt, i, "shift"))
+			Memd[pshift+i-1] = 0.
+		    iferr {
+			n = dtgeti (dt, i, "coefficients")
+			call malloc (coeffs, 1+n, TY_DOUBLE)
+			Memd[coeffs] = n
+			call dtgad (dt, i, "coefficients", Memd[coeffs+1], n, n)
+			Memi[pcoeff+i-1] = coeffs
+		    } then
+			Memi[pcoeff+i-1] = NULL
+		}
+	    } else {
+		Memi[paps] = INDEFI
+		Memr[papcen] = INDEFR
+		Memi[punits] = un_open ("")
+		Memd[pshift] = 0.
+		call malloc (coeffs, 100, TY_DOUBLE)
+		n = 3
+		call seek (Memi[dt], BOF)
+		while (getline (Memi[dt], Memc[str]) != EOF) {
+		    i = 1
+		    if (ctod (Memc[str], i, dval) == 0)
+			next
+		    if (mod (n, 100) == 0)
+			call realloc (coeffs, n+100, TY_DOUBLE)
+		    Memd[coeffs+n] = dval
+		    n = n + 1
+		}
+		Memd[coeffs] = n - 1
+		Memd[coeffs+1] = 5
+		Memd[coeffs+2] = n - 3
+		Memi[pcoeff] = coeffs
+	    }
+
+	    call dtunmap (dt)
+	    call sfree (sp)
+
+	    sym = stenter (stp, spec, LEN_DC)
+	    DC_FORMAT(sym) = 1
+	    DC_PAPS(sym) = paps
+	    DC_PAPCEN(sym) = papcen
+	    DC_PUN(sym) = punits
+	    DC_PSHIFT(sym) = pshift
+	    DC_PCOEFF(sym) = pcoeff
+	    DC_NAPS(sym) = naps
+	} else {
+	    if (DC_FORMAT(sym) != 1)
+		call error (1, "Not a multispec dispersion function")
+	    paps = DC_PAPS(sym)
+	    papcen = DC_PAPCEN(sym)
+	    punits = DC_PUN(sym)
+	    pshift = DC_PSHIFT(sym)
+	    pcoeff = DC_PCOEFF(sym)
+	    naps = DC_NAPS(sym)
+	}
+end
+
+
+# DC_REFSHFT -- Compute dispersion shift.
+
+procedure dc_refshft (spec, stp, refspec, keywrd, im, aps, apcens, shifts,
+	naps, fd1, fd2)
+
+char	spec[ARB]		# Spectrum to be corrected
+pointer	stp			# Symbol table pointer
+char	refspec[ARB]		# Reference spectrum
+char	keywrd[ARB]		# Header keyword (for log only)
+pointer	im			# IMIO pointer to spectrum to be corrected
+int	aps[naps]		# Reference apertures
+real	apcens[naps]		# Reference aperture centers
+double	shifts[naps]		# Reference aperture shifts (to be modified)
+int	naps			# Number of refernce apertures
+int	fd1			# Logfile descriptor
+int	fd2			# Logfile descriptor
+
+int	i, j, k, pnaps
+double	apcen, shift, sumx, sumy, sumxx, sumyy, sumxy, a, b
+pointer	sp, refshft, option, paps, papcen, punits, pshift, pcoeff
+bool	streq()
+errchk	imgstr, dc_gmsdb
+
+begin
+	call smark (sp)
+	call salloc (refshft, SZ_FNAME, TY_CHAR)
+	call salloc (option, SZ_FNAME, TY_CHAR)
+
+	# Parse header parameter.
+	call imgstr (im, keywrd, Memc[refshft], SZ_FNAME)
+	call sscan (Memc[refshft])
+	call gargwrd (Memc[refshft], SZ_FNAME)
+	if (streq (Memc[refshft], refspec)) {
+	    call sfree (sp)
+	    return
+	}
+	call gargwrd (Memc[option], SZ_FNAME)
+
+	# Get reference shift apertures.
+	call dc_gmsdb (Memc[refshft], stp, paps, papcen, punits, pshift,
+	    pcoeff, pnaps)
+	if (pnaps == 0) {
+	    call sfree (sp)
+	    return
+	}
+	
+	# Compute mean shift and RMS.
+	sumy = 0.
+	sumyy = 0.
+	do i = 1, pnaps {
+	    sumy = sumy + Memd[pshift+i-1]
+	    sumyy = sumyy + Memd[pshift+i-1] ** 2
+	}
+	sumy = sumy / pnaps
+	sumyy = sqrt (max (0.D0, sumyy / pnaps - sumy ** 2))
+
+	# Print.
+	if (fd1 != NULL) {
+	    call fprintf (fd1, "%s: %s = '%s %s', shift = %.6g, rms = %.6g\n")
+		call pargstr (spec)
+		call pargstr (keywrd)
+		call pargstr (Memc[refshft])
+		call pargstr (Memc[option])
+		call pargd (sumy)
+		call pargd (sumyy)
+	}
+	if (fd2 != NULL) {
+	    call fprintf (fd2, "%s: %s = '%s %s', shift = %.6g, rms = %.6g\n")
+	        call pargstr (spec)
+		call pargstr (keywrd)
+	        call pargstr (Memc[refshft])
+	        call pargstr (Memc[option])
+	        call pargd (sumy)
+	        call pargd (sumyy)
+	}
+
+	if (streq (Memc[option], "interp")) {
+	    if (pnaps > 1) {
+	        sumx = 0.
+	        sumy = 0.
+	        sumxx = 0.
+	        sumyy = 0.
+	        sumxy = 0.
+	        do i = 0, pnaps-1 {
+		    apcen = Memr[papcen+i]
+		    shift = Memd[pshift+i]
+		    sumx = sumx + apcen
+		    sumy = sumy + shift
+		    sumxx = sumxx + apcen * apcen
+		    sumyy = sumyy + shift * shift
+		    sumxy = sumxy + apcen * shift
+	        }
+	        b = pnaps * sumxx - sumx * sumx
+	        a = (sumy * sumxx - sumx * sumxy) / b
+	        b = (pnaps * sumxy - sumx * sumy) / b
+	    } else {
+	        a = sumy
+	        b = 0.
+	    }
+	    do i = 1, naps
+	        shifts[i] = shifts[i] + a + b * apcens[i]
+	    if (fd1 != NULL) {
+	        call fprintf (fd1, "\tintercept = %.6g, slope = %.6g\n")
+		    call pargd (a)
+		    call pargd (b)
+	    }
+	    if (fd2 != NULL) {
+	        call fprintf (fd2, "\tintercept = %.6g, slope = %.6g\n")
+		    call pargd (a)
+		    call pargd (b)
+	    }
+	} else if (streq (Memc[option], "nearest")) {
+	    do i = 1, naps {
+	        k = 0
+	        sumy = abs (apcens[i] - Memr[papcen])
+	        for (j = 1; j < pnaps; j = j + 1)
+		    if (abs (apcens[i] - Memr[papcen+j]) < sumy) {
+		        k = j
+		        sumy = abs (apcens[i] - Memr[papcen+k])
+		    }
+	        shifts[i] = shifts[i] + Memd[pshift+k]
+	        if (fd1 != NULL) {
+		    call fprintf (fd1, "\t%4d %7.2f %4d %7.2f %.6g\n")
+		        call pargi (aps[i])
+		        call pargr (apcens[i])
+		        call pargi (Memi[paps+k])
+		        call pargr (Memr[papcen+k])
+		        call pargd (Memd[pshift+k])
+	        }
+	        if (fd2 != NULL) {
+		    call fprintf (fd2, "\t%4d %7.2f %4d %7.2f %.6g\n")
+		        call pargi (aps[i])
+		        call pargr (apcens[i])
+		        call pargi (Memi[paps+k])
+		        call pargr (Memr[papcen+k])
+		        call pargd (Memd[pshift+k])
+	        }
+	    }
+	} else
+	    call aaddkd (shifts, sumy, shifts, naps)
+
+	call sfree (sp)
+end
+
+
+# DC_GEC -- Get an echelle spectrum.  This consists of mapping the image
+# and setting a MWCS coordinate transformation.  If not dispersion corrected
+# the dispersion function is found in the database for the reference
+# spectra and set in the SMW.
+
+procedure dc_gec (spec, im, smw, stp, ap, fd1, fd2)
+
+char	spec[ARB]	#I Spectrum name
+pointer	im		#I IMIO pointer
+pointer	smw		#I SMW pointers
+pointer	stp		#I Symbol table
+pointer	ap		#O Aperture data structure
+int	fd1		#I Logfile descriptor
+int	fd2		#I Logfile descriptor
+
+double	wt1, wt2, dval
+int	i, j, k, l, dc, sfd, naps, ncoeffs, offset, slope
+pointer	sp, str1, str2, coeff, coeffs, ct1, ct2, un1, un2, un3
+pointer	pshift1, pshift2, pshift3, pcoeff1, pcoeff2, pcoeff3
+
+bool	un_compare()
+double	smw_c1trand()
+int	imaccf(), nscan(), stropen()
+pointer	smw_sctran(), un_open()
+errchk	dc_gecdb, imgstr, smw_sctran, un_open
+
+define	done_	90
+
+begin
+	call smark (sp)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+	coeff = NULL
+
+	# Set WCS attributes
+	naps = IM_LEN(im,2)
+	call calloc (ap, LEN_AP(naps), TY_STRUCT)
+	do i = 1, naps {
+	    DC_PL(ap,i) = i
+	    call smw_gwattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), coeff)
+	    if (i == 1) {
+		iferr (call mw_gwattrs (SMW_MW(smw,0), 1, "units", Memc[str1],
+		    SZ_LINE))
+		    Memc[str1] = EOS
+		DC_UN(ap,i) = un_open (Memc[str1])
+	    }
+	    dc = DC_DT(ap,i)
+	}
+
+	# Check if the spectra have been dispersion corrected
+	# by an earlier version of DISPCOR.  If so then don't allow
+	# another database dispersion correction.  This assumes all
+	# spectra have the same dispersion type.  Check for a
+	# reference spectrum.
+
+	#if ((imaccf (im, "REFSPEC1") == NO) ||
+	#    (dc > -1 && imaccf (im, "DCLOG1") == NO)) {
+	if (imaccf (im, "REFSPEC1") == NO) {
+	    if (fd1 != NULL) {
+		call fprintf (fd1,
+		    "%s: Resampling using current coordinate system\n")
+		    call pargstr (spec)
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2,
+		    "%s: Resampling using current coordinate system\n")
+		    call pargstr (spec)
+	    }
+	    goto done_
+	}
+
+	# Get the reference spectra dispersion function from the database
+	# and determine a reference shift.
+
+	iferr {
+	    call imgstr (im, "REFSPEC1", Memc[str1], SZ_LINE)
+	    call sscan (Memc[str1])
+	    call gargwrd (Memc[str1], SZ_LINE)
+	    call gargd (wt1)
+	    if (nscan() == 1)
+		wt1 = 1.
+	} then {
+	    call strcpy (spec, Memc[str1], SZ_LINE)
+	    wt1 = 1.
+	}
+	call salloc (pshift1, naps, TY_DOUBLE)
+	call salloc (pcoeff1, naps, TY_POINTER)
+	slope = 0
+	iferr (call dc_gecdb (Memc[str1], stp, ap, un1, Memd[pshift1],
+	    Memi[pcoeff1], naps, offset, slope)) {
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+	if (fd1 != NULL) {
+	    call fprintf (fd1, "%s: REFSPEC1 = '%s %.8g'\n")
+		call pargstr (spec)
+		call pargstr (Memc[str1])
+		call pargd (wt1)
+	}
+	if (fd2 != NULL) {
+	    call fprintf (fd2, "%s: REFSPEC1 = '%s %.8g'\n")
+		call pargstr (spec)
+		call pargstr (Memc[str1])
+		call pargd (wt1)
+	}
+
+        iferr {
+            call imgstr (im, "refshft1", Memc[str1], SZ_LINE)
+	    call salloc (pshift3, naps, TY_DOUBLE)
+	    call salloc (pcoeff3, naps, TY_POINTER)
+	    call dc_gecdb (Memc[str1], stp, ap, un3, Memd[pshift3],
+		Memi[pcoeff3], naps, offset, slope)
+            if (fd1 != NULL) {
+                call fprintf (fd1, "%s: REFSHFT1 = '%s', shift = %.6g\n")
+                    call pargstr (spec)
+                    call pargstr (Memc[str1])
+                    call pargd (Memd[pshift3])
+            }
+            if (fd2 != NULL) {
+                call fprintf (fd2, "%s: REFSHFT1 = '%s', shift = %.6g\n")
+                    call pargstr (spec)
+                    call pargstr (Memc[str1])
+                    call pargd (Memd[pshift3])
+            }
+	    call aaddd (Memd[pshift1], Memd[pshift3], Memd[pshift1], naps)
+        } then
+            ;
+
+	iferr {
+            call imgstr (im, "REFSPEC2", Memc[str1], SZ_LINE)
+            call sscan (Memc[str1])
+            call gargwrd (Memc[str1], SZ_LINE)
+            call gargd (wt2)
+            if (nscan() == 1)
+                wt2 = 1.
+	    call salloc (pshift2, naps, TY_DOUBLE)
+	    call salloc (pcoeff2, naps, TY_POINTER)
+	    call dc_gecdb (Memc[str1], stp, ap, un2, Memd[pshift2],
+		Memi[pcoeff2], naps, offset, slope)
+	    if (fd1 != NULL) {
+		call fprintf (fd1, "%s: REFSPEC2 = '%s %.8g'\n")
+		    call pargstr (spec)
+		    call pargstr (Memc[str1])
+		    call pargd (wt2)
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2, "%s: REFSPEC2 = '%s %.8g'\n")
+		    call pargstr (spec)
+		    call pargstr (Memc[str1])
+		    call pargd (wt2)
+	    }
+
+	    iferr {
+		call imgstr (im, "refshft2", Memc[str1], SZ_LINE)
+		call salloc (pshift3, naps, TY_DOUBLE)
+		call salloc (pcoeff3, naps, TY_POINTER)
+		call dc_gecdb (Memc[str1], stp, ap, un3, Memd[pshift3],
+		    Memi[pcoeff3], naps, offset, slope)
+		if (fd1 != NULL) {
+		    call fprintf (fd1, "%s: REFSHFT2 = '%s', shift = %.6g\n")
+			call pargstr (spec)
+                    call pargstr (Memc[str1])
+                    call pargd (Memd[pshift3])
+		}
+		if (fd2 != NULL) {
+		    call fprintf (fd2, "%s: REFSHFT2 = '%s', shift = %.6g\n")
+			call pargstr (spec)
+                    call pargstr (Memc[str1])
+                    call pargd (Memd[pshift3])
+		}
+		call aaddd (Memd[pshift1], Memd[pshift3], Memd[pshift1], naps)
+	    } then
+		;
+	} then
+	    wt2 = 0.
+
+	# Adjust weights to unit sum.
+	dval = wt1 + wt2
+	wt1 = wt1 / dval
+	wt2 = wt2 / dval
+
+	# Enter dispersion function in the MWCS.
+	do i = 1, naps {
+	    coeffs = Memi[pcoeff1+i-1]
+	    ncoeffs = nint (Memd[coeffs])
+	    l = 20 * (ncoeffs + 2)
+	    if (wt2 > 0.)
+		l = 2 * l
+	    call realloc (coeff, l, TY_CHAR)
+	    call aclrc (Memc[coeff], l)
+	    sfd = stropen (Memc[coeff], l, NEW_FILE)
+	    call fprintf (sfd, "%.8g %g")
+		call pargd (wt1)
+		call pargd (Memd[pshift1+i-1])
+
+	    # The following assumes some knowledge of the data structure in
+	    # order to shortten the the attribute string.
+
+	    call fprintf (sfd, " %d %d %.8g %.8g")
+		call pargi (nint (Memd[coeffs+1]))
+		call pargi (nint (Memd[coeffs+2]))
+		call pargd (Memd[coeffs+3])
+		call pargd (Memd[coeffs+4])
+	    do j = 5, ncoeffs {
+		call fprintf (sfd, " %.15g")
+		    call pargd (Memd[coeffs+j])
+	    }
+
+	    if (wt2 > 0.) {
+		coeffs = Memi[pcoeff2+i-1]
+		ncoeffs = nint (Memd[coeffs])
+		call fprintf (sfd, "%.8g %g")
+		    call pargd (wt2)
+		    call pargd (Memd[pshift2+i-1])
+		call fprintf (sfd, " %d %d %.8g %.8g")
+		    call pargi (nint (Memd[coeffs+1]))
+		    call pargi (nint (Memd[coeffs+2]))
+		    call pargd (Memd[coeffs+3])
+		    call pargd (Memd[coeffs+4])
+		do j = 5, ncoeffs {
+		    call fprintf (sfd, " %.15g")
+			call pargd (Memd[coeffs+j])
+		}
+		if (!un_compare (un1, un2)) {
+		    call sfree (sp)
+		    call error (2,
+			"Can't combine references with different units")
+		}
+	    }
+
+	    if (i == 1) {
+		if (UN_LABEL(un1) != EOS)
+		    call mw_swattrs (SMW_MW(smw,0), 1, "label", UN_LABEL(un1))
+		if (UN_UNITS(un1) != EOS)
+		    call mw_swattrs (SMW_MW(smw,0), 1, "units", UN_UNITS(un1))
+		call un_close (DC_UN(ap,i))
+		DC_UN(ap,i) = un1
+	    }
+	    DC_DT(ap,i) = 2
+	    call smw_swattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), Memc[coeff])
+	    call strclose (sfd)
+	}
+
+	# Update the linear part of WCS.
+	ct1 = smw_sctran (smw, "logical", "physical", 2)
+	ct2 = smw_sctran (smw, "physical", "world", 3)
+	do i = 1, naps {
+	    call smw_gwattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), coeff)
+	    wt1 = nint (smw_c1trand (ct1, double(i)))
+	    call smw_c2trand (ct2, 1D0, wt1, DC_W1(ap,i), wt2)
+	    call smw_c2trand (ct2, double(DC_NW(ap,i)), wt1, DC_W2(ap,i), wt2)
+	    DC_DW(ap,i) = (DC_W2(ap,i) - DC_W1(ap,i)) / (DC_NW(ap,i) - 1)
+	    call smw_swattrs (smw, DC_PL(ap,i), 1, DC_AP(ap,i), DC_BM(ap,i),
+		DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i), DC_Z(ap,i),
+		DC_LW(ap,i), DC_UP(ap,i), Memc[coeff])
+	}
+	call smw_ctfree (ct1)
+	call smw_ctfree (ct2)
+
+done_	# Set aperture parameters in terms of logical image.
+	ct1 = smw_sctran (smw, "physical", "logical", 1)
+	j = nint (smw_c1trand (ct1, 1D0))
+	do i = 1, naps {
+	    k = nint (smw_c1trand (ct1, double(DC_NW(ap,i))))
+	    DC_NW(ap,i) = min (IM_LEN(im,1), max (j, k))
+	}
+	call smw_ctfree (ct1)
+
+	ct1 = smw_sctran (smw, "logical", "world", 3)
+	do i = 1, naps {
+	    wt1 = i
+	    call smw_c2trand (ct1, 1D0, wt1, DC_W1(ap,i), wt2)
+	    call smw_c2trand (ct1, double(DC_NW(ap,i)), wt1, DC_W2(ap,i), wt2)
+	    DC_DW(ap,i) = (DC_W2(ap,i) - DC_W1(ap,i)) / (DC_NW(ap,i) - 1)
+	}
+	call smw_ctfree (ct1)
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# DC_GECDB -- Get a dispersion database entry.
+# The database entry is read only once from the database and stored in a
+# symbol table keyed by the spectrum name.  Subsequent requests for the
+# reference spectrum returns the data from the symbol table.
+
+procedure dc_gecdb (spec, stp, ap, un, shifts, pcoeff, naps, offset, slope)
+
+char	spec[ARB]	# Spectrum image name
+pointer	stp		# Symbol table pointer
+pointer	ap		# Aperture data structure
+pointer	un		# Units
+double	shifts[naps]	# Shifts
+pointer	pcoeff[naps]	# Pointer to coefficients
+int	naps		# Number of apertures
+int     offset          # Aperture to order offset
+int     slope           # Aperture to order slope
+
+double  shift
+real    dtgetr()
+int     i, rec, offst, slpe, n, dtlocate(), dtgeti()
+pointer sp, str, coeffs, sym, db, dt
+pointer	stfind(), stenter(), strefsbuf(), dtmap1(), un_open()
+errchk  dtmap1, dtlocate, dtgeti, dtgad, un_open
+
+begin
+	# Check if dispersion solution is in the symbol table from a previous
+	# call.  If not in the symbol table get it from the database and
+	# store it in the symbol table.
+
+	sym = stfind (stp, spec)
+	if (sym == NULL) {
+	    call smark (sp)
+	    call salloc (str, SZ_LINE, TY_CHAR)
+	    call strcpy ("ec", Memc[str], SZ_LINE)
+	    call imgcluster (spec, Memc[str+2], SZ_LINE-2)
+	    call xt_imroot (Memc[str+2], Memc[str+2], SZ_LINE-2)
+	    db = strefsbuf (stp, Memi[stfind (stp, "database")])
+	    dt = dtmap1 (Memc[db], Memc[str], READ_ONLY)
+
+            call sprintf (Memc[str], SZ_LINE, "ecidentify %s")
+                call pargstr (spec)
+            iferr (rec = dtlocate (dt, Memc[str])) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "DISPCOR: Echelle dispersion function not found (%s/%s)")
+		    call pargstr (DT_DNAME(dt))
+		    call pargstr (DT_FNAME(dt))
+                call fatal (0, Memc[str])
+	    }
+
+	    iferr (call dtgstr (dt, rec, "units", Memc[str], SZ_LINE))
+		call strcpy ("Angstroms", Memc[str], SZ_LINE)
+	    un = un_open (Memc[str])
+            iferr (offst = dtgeti (dt, rec, "offset"))
+                offst = 0
+            iferr (slpe = dtgeti (dt, rec, "slope"))
+                slpe = 1
+            iferr (shift = dtgetr (dt, rec, "shift"))
+                shift = 0.
+            n = dtgeti (dt, rec, "coefficients")
+            call malloc (coeffs, n, TY_DOUBLE)
+            call dtgad (dt, rec, "coefficients", Memd[coeffs], n, n)
+
+            sym = stenter (stp, spec, LEN_DC)
+	    DC_FORMAT(sym) = 2
+	    DC_PUN(sym) = un
+            DC_OFFSET(sym) = offst
+            DC_SLOPE(sym) = slpe
+            DC_SHIFT(sym) = shift
+            DC_COEFFS(sym) = coeffs
+
+	    call dtunmap (dt)
+	    call sfree (sp)
+	} else {
+	    if (DC_FORMAT(sym) != 2)
+		call error (1, "Not an echelle dispersion function")
+	    un = DC_PUN(sym)
+            offst = DC_OFFSET(sym)
+            slpe = DC_SLOPE(sym)
+            coeffs = DC_COEFFS(sym)
+            shift = DC_SHIFT(sym)
+	}
+
+	# Check aperture to order parameters.
+	if (slope == 0) {
+	    offset = offst
+	    slope = slpe
+	} else if (offset != offst || slope != slpe) {
+	    call eprintf (
+		"WARNING: Echelle order offsets/slopes are not the same.\n")
+	}
+
+	# Convert to multispec coefficients
+	do i = 1, naps {
+	    DC_BM(ap,i) = offset + slope * DC_AP(ap,i)
+	    call dc_ecms (DC_BM(ap,i), Memd[coeffs], pcoeff[i])
+	    shifts[i] = shift / DC_BM(ap,i)
+	}
+end
+
+
+# DC_ECMS -- Convert echelle dispersion coefficients to multispec coefficients
+
+procedure dc_ecms (order, eccoeff, mscoeff)
+
+int	order			# Echelle order
+double	eccoeff[ARB]		# Echelle dispersion coefficients
+pointer	mscoeff			# Pointer to multispec coefficients
+
+int	i, j, k, type, xorder, yorder
+double	xmin, xmax, ymin, ymax, ymaxmin, yrange, y, coeff, a, b, c
+
+begin
+	type = nint (eccoeff[1])
+	xorder = nint (eccoeff[2])
+	yorder = nint (eccoeff[3])
+	xmin = eccoeff[5]
+	xmax = eccoeff[6]
+	ymin = eccoeff[7]
+	ymax = eccoeff[8]
+
+	yrange = 2. / (ymax - ymin)
+	ymaxmin = (ymax + ymin) / 2
+	y = (order - ymaxmin) * yrange
+
+	call malloc (mscoeff, 5+xorder, TY_DOUBLE)
+	Memd[mscoeff] = 4+xorder
+	Memd[mscoeff+1] = type
+	Memd[mscoeff+2] = xorder
+	Memd[mscoeff+3] = xmin
+	Memd[mscoeff+4] = xmax
+
+	switch (type) {
+	case 1:
+	    do k = 1, xorder {
+		j = 9 + k - 1
+		coeff = eccoeff[j]
+		if (yorder > 1) {
+		    j = j + xorder
+		    coeff = coeff + eccoeff[j] * y
+		}
+		if (yorder > 2) {
+		    a = 1
+		    b = y
+		    do i = 3, yorder {
+			c = 2 * y * b - a
+			j = j + xorder
+			coeff = coeff + eccoeff[j] * c
+			a = b
+			b = c
+		    }
+		}
+		Memd[mscoeff+4+k] = coeff / order
+	    }
+	case 2:
+	    do k = 1, xorder {
+		j = 9 + k - 1
+		coeff = eccoeff[j]
+		if (yorder > 1) {
+		    j = j + xorder
+		    coeff = coeff + eccoeff[j] * y
+		}
+		if (yorder > 2) {
+		    a = 1
+		    b = y
+		    do i = 3, yorder {
+			c = ((2 * i - 3) * y * b - (i - 2) * a) / (i - 1)
+			j = j + xorder
+			coeff = coeff + eccoeff[j] * c
+			a = b
+			b = c
+		    }
+		}
+		Memd[mscoeff+4+k] = coeff / order
+	    }
+	}
+end
diff --git a/noao/onedspec/dispcor/dctable.h b/noao/onedspec/dispcor/dctable.h
new file mode 100644
index 00000000..4cf3657a
--- /dev/null
+++ b/noao/onedspec/dispcor/dctable.h
@@ -0,0 +1,11 @@
+# Wavelength table structure
+define	TBL_LEN		14
+define	TBL_W1		Memd[P2D($1)]	# Starting wavelength
+define	TBL_W2		Memd[P2D($1+2)]	# Ending wavelength
+define	TBL_DW		Memd[P2D($1+4)]	# Wavelength interval
+define	TBL_WMIN	Memd[P2D($1+6)]	# Minimum wavelength for global
+define	TBL_WMAX	Memd[P2D($1+8)]	# Maximum wavelength for global
+define	TBL_AP		Memi[$1+10]	# Aperture
+define	TBL_NW		Memi[$1+11]	# Number of points
+define	TBL_NWMAX	Memi[$1+12]	# Maximum number of points for global
+define	TBL_CONFIRM	Memi[$1+13]	# Confirm?
diff --git a/noao/onedspec/dispcor/dctable.x b/noao/onedspec/dispcor/dctable.x
new file mode 100644
index 00000000..93f27531
--- /dev/null
+++ b/noao/onedspec/dispcor/dctable.x
@@ -0,0 +1,145 @@
+include	<imhdr.h>
+include	<mach.h>
+include	"dctable.h"
+include	<smw.h>
+
+
+# DC_TABLE -- Set default wavelengths.
+# This may be specified by the task parameters alone, from a reference image,
+# or from a text table.  A reference image or table allows separate
+# wavelength parameters for each aperture.  The text table columns are the
+# aperture number, starting wavelength, ending wavelength, wavelength
+# interval per pixel, and number of pixels.  Any of these values may be
+# INDEF.
+
+procedure dc_table (table, naps)
+
+pointer	table			# Table pointer (returned)
+int	naps			# Number of apertures (returned)
+
+int	i, j, ap, nw, fd, clgeti(), open(), fscan(), nscan(), btoi(), nowhite()
+double	ws, we, dw, clgetd()
+pointer	sp, fname, tbl, mw, sh, immap(), smw_openim()
+bool	clgetb()
+errchk	smw_openim(), shdr_open()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call clgstr ("table", Memc[fname], SZ_FNAME)
+
+	# Set defaults.
+	naps = 0
+	call malloc (table, 10, TY_INT)
+	call malloc (Memi[table], TBL_LEN, TY_STRUCT)
+	tbl= Memi[table]
+	TBL_W1(tbl) = clgetd ("w1")
+	TBL_W2(tbl) = clgetd ("w2")
+	TBL_DW(tbl) = clgetd ("dw")
+	TBL_NW(tbl) = clgeti ("nw")
+	TBL_WMIN(tbl) = MAX_REAL
+	TBL_WMAX(tbl) = -MAX_REAL
+	TBL_NWMAX(tbl) = 0
+	TBL_CONFIRM(tbl) = btoi (clgetb ("confirm"))
+
+	# Read a reference image or table if specified and add entries to
+	# the table array.
+
+	if (nowhite (Memc[fname], Memc[fname], SZ_FNAME) > 0) {
+	    ifnoerr (fd = immap (Memc[fname], READ_ONLY, 0)) {
+		mw = smw_openim (fd)
+		call shdr_open (fd, mw, 1, 1, INDEFI, SHHDR, sh)
+		if (DC(sh) == DCLINEAR || DC(sh) == DCLOG) {
+		    do j = 1, IM_LEN(fd,2) {
+			call shdr_open (fd, mw, j, 1, INDEFI, SHHDR, sh)
+			call dc_getentry (false, AP(sh), table, naps, i)
+			tbl = Memi[table+i]
+			TBL_AP(tbl) = AP(sh)
+			TBL_NW(tbl) = SN(sh)
+			TBL_W1(tbl) = W0(sh)
+			TBL_W2(tbl) = W1(sh)
+			TBL_DW(tbl) = WP(sh)
+		    }
+		}
+		call shdr_close (sh)
+		call smw_close (mw)
+		call imunmap (fd)
+	    } else {
+		ifnoerr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE)) {
+		    while (fscan (fd) != EOF) {
+			call gargi (ap)
+			call gargd (ws)
+			call gargd (we)
+			call gargd (dw)
+			call gargi (nw)
+			if (nscan() < 5)
+			    next
+
+			call dc_getentry (false, ap, table, naps, i)
+			tbl = Memi[table+i]
+			TBL_AP(tbl) = ap
+			TBL_W1(tbl) = ws
+			TBL_W2(tbl) = we
+			TBL_DW(tbl) = dw
+			TBL_NW(tbl) = nw
+		    }
+		    call close (fd)
+		} else
+		    call error (1, "Can't access wavelength table")
+	    }
+	}
+
+	# If ignoreaps=yes then replace INDEFs in the default entry with
+	# the first non-INDEF entry.
+
+	if (clgetb ("ignoreaps") && naps > 0) {
+	    tbl= Memi[table]
+	    if (IS_INDEFD(TBL_W1(tbl)))
+		TBL_W1(tbl) = TBL_W1(Memi[table+1])
+	    if (IS_INDEFD(TBL_W2(tbl)))
+		TBL_W2(tbl) = TBL_W2(Memi[table+1])
+	    if (IS_INDEFD(TBL_DW(tbl)))
+		TBL_DW(tbl) = TBL_DW(Memi[table+1])
+	    if (IS_INDEFI(TBL_NW(tbl)))
+		TBL_NW(tbl) = TBL_NW(Memi[table+1])
+	}
+
+	call sfree (sp)
+end
+
+
+# DC_GETENTRY -- Get entry from wavelength table.  Return the index.  Allocate
+# a new entry if needed.
+
+procedure dc_getentry (apflag, ap, table, naps, index)
+
+bool	apflag		# Ignore aperture numbers?
+int	ap		# Aperture
+pointer	table		# Wavelength table
+int	naps		# Number of apertures
+int	index		# Table index of entry
+
+pointer	tbl
+
+begin
+	for (index=1; index<=naps; index=index+1)
+	    if (apflag || TBL_AP(Memi[table+index]) == ap)
+		return
+
+	naps = naps + 1
+	if (mod (naps, 10) == 0)
+	    call realloc (table, naps+10, TY_INT)
+	call malloc (Memi[table+naps], TBL_LEN, TY_STRUCT)
+
+	index = naps
+	tbl = Memi[table+index]
+	TBL_AP(tbl) = ap
+	TBL_W1(tbl) = TBL_W1(Memi[table])
+	TBL_W2(tbl) = TBL_W2(Memi[table])
+	TBL_DW(tbl) = TBL_DW(Memi[table])
+	TBL_NW(tbl) = TBL_NW(Memi[table])
+	TBL_WMIN(tbl) = TBL_WMIN(Memi[table])
+	TBL_WMAX(tbl) = TBL_WMAX(Memi[table])
+	TBL_NWMAX(tbl) = TBL_NWMAX(Memi[table])
+	TBL_CONFIRM(tbl) = TBL_CONFIRM(Memi[table])
+end
diff --git a/noao/onedspec/dispcor/dispcor.h b/noao/onedspec/dispcor/dispcor.h
new file mode 100644
index 00000000..51167973
--- /dev/null
+++ b/noao/onedspec/dispcor/dispcor.h
@@ -0,0 +1,16 @@
+# Aperture data structure
+
+define	LEN_AP	($1*20)				# Length of DC data structure
+define	DC_PL	Memi[$1+($2-1)*20+1]		# Physical line number
+define	DC_AP	Memi[$1+($2-1)*20+2]		# Aperture number
+define	DC_BM	Memi[$1+($2-1)*20+3]		# Beam number
+define	DC_DT	Memi[$1+($2-1)*20+4]		# Dispersion type
+define	DC_NW	Memi[$1+($2-1)*20+5]		# Number of pixels in spectrum
+define	DC_W1	Memd[P2D($1+($2-1)*20+6)]	# Wavelength of first pixel
+define	DC_W2	Memd[P2D($1+($2-1)*20+8)]	# Wavelength of last pixel
+define	DC_DW	Memd[P2D($1+($2-1)*20+10)]	# Wavelength interval per pixel
+define	DC_Z	Memd[P2D($1+($2-1)*20+12)]	# Redshift
+define	DC_LW	Memr[P2R($1+($2-1)*20+14)]	# Aperture lower limit (2)
+define	DC_UP	Memr[P2R($1+($2-1)*20+16)]	# Aperture upper limit (2)
+define	DC_CF	Memi[$1+($2-1)*20+18]		# Pointer to coefficients
+define	DC_UN	Memi[$1+($2-1)*20+19]		# Units
diff --git a/noao/onedspec/dispcor/dispcor.x b/noao/onedspec/dispcor/dispcor.x
new file mode 100644
index 00000000..7f2c32a8
--- /dev/null
+++ b/noao/onedspec/dispcor/dispcor.x
@@ -0,0 +1,233 @@
+include	<math/iminterp.h>
+
+# DISPCOR -- Dispersion correct input spectrum to output spectrum.
+# This procedure uses the MWCS forward and inverse transformations
+# and interpolate the input data, conserving flux if desired.  Image
+# interpolation uses the image interpolation package and flux conservation
+# integrates the interpolation function across the output pixel.  This
+# procedure does some CLIO to get the interpolation function and to
+# query whether to conserve flux.
+
+procedure dispcor (cti, linei, cto, lineo, in, npts, out, nw, flux)
+
+pointer	cti			#I MWCS input inverse transformation
+int	linei			#I Spectrum line
+pointer	cto			#I MWCS output forward transformation
+int	lineo			#I Spectrum line
+real	in[npts]		#I Input spectrum
+int	npts			#I Number of input pixels
+real	out[nw]			#O Output spectrum
+int	nw			#I Number of output pixels
+bool	flux			#I Conserve flux
+
+char	interp[10]
+bool	ofb_a, ofb_b
+int	i, j, ia, ib, clgwrd()
+real	a, b, sum, asieval(), asigrl()
+double	x, xmin, xmax, w, y1, y2, smw_c1trand()
+pointer	asi, temp
+
+begin
+	# Get the image buffers fit the interpolation function to the
+	# input spectrum.  Extend the interpolation by one pixel at each end.
+
+	call malloc (temp, npts+2, TY_REAL)
+	call amovr (in, Memr[temp+1], npts)
+	Memr[temp] = in[1]
+	Memr[temp+npts+1] = in[npts]
+
+	call asiinit (asi, clgwrd ("interp", interp, 10, II_FUNCTIONS))
+	call asifit (asi, Memr[temp], npts+2)
+
+	call mfree (temp, TY_REAL)
+
+	# Determine edges of output pixels in input spectrum and integrate
+	# using ASIGRL.  If not flux conserving take the average.
+
+	xmin = 0.5
+	xmax = npts + 0.5
+
+	x = 0.5
+	if (IS_INDEFI(lineo))
+	    w = smw_c1trand (cto, x)
+	else {
+	    y1 = lineo
+	    call smw_c2trand (cto, x, y1, w, y2)
+	}
+	if (IS_INDEFI(linei))
+	    x = smw_c1trand (cti, w)
+	else {
+	    #y2 = linei
+	    call smw_c2trand (cti, w, y2, x, y1)
+	}
+	ofb_b = (x < xmin || x > xmax)
+	b = max (xmin, min (xmax, x)) + 1
+	do i = 1, nw {
+	    ofb_a = ofb_b
+	    a = b
+	    x = i + 0.5
+	    if (IS_INDEFI(lineo))
+		w = smw_c1trand (cto, x)
+	    else {
+		y1 = lineo
+		call smw_c2trand (cto, x, y1, w, y2)
+	    }
+	    if (IS_INDEFI(linei))
+		x = smw_c1trand (cti, w)
+	    else {
+		#y2 = linei
+		call smw_c2trand (cti, w, y2, x, y1)
+	    }
+	    ofb_b = (x < xmin || x > xmax)
+	    b = max (xmin, min (xmax, x)) + 1
+	    if (ofb_a && ofb_b)
+		out[i] = 0.
+	    else if (a <= b) {
+		ia = nint (a + 0.5)
+		ib = nint (b - 0.5)
+		if (abs (a+0.5-ia) < 0.00001 && abs (b-0.5-ib) < 0.00001) {
+		    sum = 0.
+		    do j = ia, ib
+			sum = sum + asieval (asi, real(j))
+		    out[i] = sum
+		} else
+		    out[i] = asigrl (asi, a, b)
+		if (!flux)
+		    out[i] = out[i] / max (b - a, 1e-4)
+	    } else {
+		ib = nint (b + 0.5)
+		ia = nint (a - 0.5)
+		if (abs (a-0.5-ia) < 0.00001 && abs (b+0.5-ib) < 0.00001) {
+		    sum = 0.
+		    do j = ib, ia
+			sum = sum + asieval (asi, real(j))
+		    out[i] = sum
+		} else
+		    out[i] = asigrl (asi, b, a)
+		if (!flux)
+		    out[i] = out[i] / max (a - b, 1e-4)
+	    }
+	}
+
+	call asifree (asi)
+end
+
+
+# DISPCORA -- Dispersion correct input spectrum to output spectrum.
+# This procedure uses the MWCS forward and inverse transformations
+# and interpolate the input data, conserving flux if desired.  Image
+# interpolation uses the image interpolation package and flux conservation
+# integrates the interpolation function across the output pixel.  This
+# procedure does some CLIO to get the interpolation function and to
+# query whether to conserve flux.
+# 
+# This differs from DISPCOR by the "blank" argument.
+
+procedure dispcora (cti, linei, cto, lineo, in, npts, out, nw, flux, blank)
+
+pointer	cti			#I MWCS input inverse transformation
+int	linei			#I Spectrum line
+pointer	cto			#I MWCS output forward transformation
+int	lineo			#I Spectrum line
+real	in[npts]		#I Input spectrum
+int	npts			#I Number of input pixels
+real	out[nw]			#O Output spectrum
+int	nw			#I Number of output pixels
+bool	flux			#I Conserve flux
+real	blank			#I Out of bounds value (INDEF to leave unchanged
+
+char	interp[10]
+bool	ofb_a, ofb_b
+int	i, j, ia, ib, clgwrd()
+real	a, b, sum, asieval(), asigrl()
+double	x, xmin, xmax, w, y1, y2, smw_c1trand()
+pointer	asi, temp
+
+begin
+	# Get the image buffers fit the interpolation function to the
+	# input spectrum.  Extend the interpolation by one pixel at each end.
+
+	call malloc (temp, npts+2, TY_REAL)
+	call amovr (in, Memr[temp+1], npts)
+	Memr[temp] = in[1]
+	Memr[temp+npts+1] = in[npts]
+
+	call asiinit (asi, clgwrd ("interp", interp, 10, II_FUNCTIONS))
+	call asifit (asi, Memr[temp], npts+2)
+
+	call mfree (temp, TY_REAL)
+
+	# Determine edges of output pixels in input spectrum and integrate
+	# using ASIGRL.  If not flux conserving take the average.
+
+	xmin = 0.5
+	xmax = npts + 0.5
+
+	x = 0.5
+	if (IS_INDEFI(lineo))
+	    w = smw_c1trand (cto, x)
+	else {
+	    y1 = lineo
+	    call smw_c2trand (cto, x, y1, w, y2)
+	}
+	if (IS_INDEFI(linei))
+	    x = smw_c1trand (cti, w)
+	else {
+	    #y2 = linei
+	    call smw_c2trand (cti, w, y2, x, y1)
+	}
+	ofb_b = (x < xmin || x > xmax)
+	b = max (xmin, min (xmax, x)) + 1
+	do i = 1, nw {
+	    ofb_a = ofb_b
+	    a = b
+	    x = i + 0.5
+	    if (IS_INDEFI(lineo))
+		w = smw_c1trand (cto, x)
+	    else {
+		y1 = lineo
+		call smw_c2trand (cto, x, y1, w, y2)
+	    }
+	    if (IS_INDEFI(linei))
+		x = smw_c1trand (cti, w)
+	    else {
+		#y2 = linei
+		call smw_c2trand (cti, w, y2, x, y1)
+	    }
+	    ofb_b = (x < xmin || x > xmax)
+	    b = max (xmin, min (xmax, x)) + 1
+	    if (ofb_a && ofb_b) {
+		if (!IS_INDEFR(blank))
+		    out[i] = blank
+	    } else if (a == b) {
+		if (!IS_INDEFR(blank))
+		    out[i] = blank
+	    } else if (a < b) {
+		ia = nint (a + 0.5)
+		ib = nint (b - 0.5)
+		if (abs (a+0.5-ia) < 0.00001 && abs (b-0.5-ib) < 0.00001) {
+		    sum = 0.
+		    do j = ia, ib
+			sum = sum + asieval (asi, real(j))
+		    out[i] = sum
+		} else
+		    out[i] = asigrl (asi, a, b)
+		if (!flux)
+		    out[i] = out[i] / max (b - a, 1e-4)
+	    } else {
+		ib = nint (b + 0.5)
+		ia = nint (a - 0.5)
+		if (abs (a-0.5-ia) < 0.00001 && abs (b+0.5-ib) < 0.00001) {
+		    sum = 0.
+		    do j = ib, ia
+			sum = sum + asieval (asi, real(j))
+		    out[i] = sum
+		} else
+		    out[i] = asigrl (asi, b, a)
+		if (!flux)
+		    out[i] = out[i] / max (a - b, 1e-4)
+	    }
+	}
+
+	call asifree (asi)
+end
diff --git a/noao/onedspec/dispcor/mkpkg b/noao/onedspec/dispcor/mkpkg
new file mode 100644
index 00000000..e609106e
--- /dev/null
+++ b/noao/onedspec/dispcor/mkpkg
@@ -0,0 +1,28 @@
+# DISPCOR Task
+
+$checkout libpkg.a ..
+$update   libpkg.a
+$checkin  libpkg.a ..
+$exit
+
+libpkg.a:
+	dcio.x		dispcor.h <error.h> <imhdr.h> <imset.h> <pkg/dttext.h>\
+			<smw.h> <units.h>
+	dctable.x	dctable.h <imhdr.h> <mach.h> <smw.h>
+	dispcor.x	<math/iminterp.h>
+	ranges.x	<ctype.h> <mach.h>
+	refaverage.x	refspectra.h
+	reffollow.x	refspectra.h <mach.h>
+	refgspec.x	refspectra.com refspectra.h <error.h>
+	refinterp.x	refspectra.h <mach.h>
+	refmatch.x	refspectra.h
+	refmsgs.x	refspectra.com refspectra.h
+	refnearest.x	refspectra.h <mach.h>
+	refnoextn.x	
+	refprecede.x	refspectra.h <mach.h>
+	refspectra.x	refspectra.com refspectra.h
+	reftable.x	refspectra.h <error.h>
+	t_dispcor.x	dctable.h dispcor.h <error.h> <imhdr.h> <imio.h>\
+			<mach.h> <mwset.h> <smw.h> <units.h>
+	t_disptrans.x	<error.h> <imhdr.h> <math/curfit.h> <smw.h> <units.h>
+	;
diff --git a/noao/onedspec/dispcor/ranges.x b/noao/onedspec/dispcor/ranges.x
new file mode 100644
index 00000000..403b81f7
--- /dev/null
+++ b/noao/onedspec/dispcor/ranges.x
@@ -0,0 +1,239 @@
+include	<mach.h>
+include	<ctype.h>
+
+define	FIRST	0		# Default starting range
+define	LAST	MAX_INT		# Default ending range
+define	STEP	1		# Default step
+define	EOLIST	-1		# End of list
+
+# 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 EOLIST.
+
+int procedure decode_ranges (range_string, ranges, max_ranges, 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	nvalues			# The number of values in the ranges
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all nonnegative integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # 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) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = EOLIST
+	    	    nvalues = MAX_INT
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = EOLIST
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 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 last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (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, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # 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
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 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] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], 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] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], 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.
+# If the number is INDEFI then it is mapped to the maximum integer.
+
+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, num
+
+begin
+	if (IS_INDEFI (number))
+	    num = MAX_INT
+	else
+	    num = number
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (num >= first && num <= last)
+		if (mod (num - first, step) == 0)
+		    return (true)
+	}
+
+	return (false)
+end
diff --git a/noao/onedspec/dispcor/refaverage.x b/noao/onedspec/dispcor/refaverage.x
new file mode 100644
index 00000000..e25866c4
--- /dev/null
+++ b/noao/onedspec/dispcor/refaverage.x
@@ -0,0 +1,84 @@
+include	"refspectra.h"
+
+# REFAVERAGE -- Assign reference spectrum by averageing reference list.
+# In earlier version the reference apertures were always set to all
+
+procedure refaverage (input, refs)
+
+pointer	input			# List of input spectra
+pointer	refs			# List of reference spectra
+
+int	ap
+double	sortval
+real	wt1, wt2
+pointer	sp, image, ref1, ref2, gval
+
+bool	refgref(), refginput()
+int	imtgetim(), imtlen()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (ref1, SZ_FNAME, TY_CHAR)
+	call salloc (ref2, SZ_FNAME, TY_CHAR)
+
+	# Get reference spectra to average.
+	switch (imtlen (refs)) {
+	case 0:
+	    call error (0, "No reference spectra specified")
+	case 1:
+	    ap = imtgetim (refs, Memc[ref1], SZ_FNAME)
+	    call refnoextn (Memc[ref1])
+	    if (!refgref (Memc[ref1], ap, sortval, gval)) {
+		call sfree (sp)
+		return
+	    }
+	    wt1 = 1.
+	    wt2 = 0.
+	case 2:
+	    ap = imtgetim (refs, Memc[ref1], SZ_FNAME)
+	    ap = imtgetim (refs, Memc[ref2], SZ_FNAME)
+	    call refnoextn (Memc[ref1])
+	    call refnoextn (Memc[ref2])
+	    if (!refgref (Memc[ref1], ap, sortval, gval)) {
+		call sfree (sp)
+		return
+	    }
+	    if (!refgref (Memc[ref2], ap, sortval, gval)) {
+		call sfree (sp)
+		return
+	    }
+	    wt1 = 0.5
+	    wt2 = 0.5
+	default:
+	    ap = imtgetim (refs, Memc[ref1], SZ_FNAME)
+	    ap = imtgetim (refs, Memc[ref2], SZ_FNAME)
+	    call refnoextn (Memc[ref1])
+	    call refnoextn (Memc[ref2])
+	    if (!refgref (Memc[ref1], ap, sortval, gval)) {
+		call sfree (sp)
+		return
+	    }
+	    if (!refgref (Memc[ref2], ap, sortval, gval)) {
+		call sfree (sp)
+		return
+	    }
+	    wt1 = 0.5
+	    wt2 = 0.5
+	    call eprintf ("WARNING: Averaging only first two reference spectra")
+	}
+
+	# Assign reference spectra to each input spectrum.
+	# Skip spectra which are not of the appropriate aperture
+	# or have been assigned previously (unless overriding).
+
+	while (imtgetim (input, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refginput (Memc[image], ap, sortval, gval))
+		next
+
+	    call refspectra (Memc[image], Memc[ref1], wt1, Memc[ref2], wt2)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/reffollow.x b/noao/onedspec/dispcor/reffollow.x
new file mode 100644
index 00000000..a320c504
--- /dev/null
+++ b/noao/onedspec/dispcor/reffollow.x
@@ -0,0 +1,114 @@
+include	<mach.h>
+include	"refspectra.h"
+
+
+# REFFOLLOW -- Assign following reference spectrum based on sort key.
+# If there is no following spectrum assign the nearest preceding spectrum.
+
+procedure reffollow (input, refs)
+
+pointer	input			# List of input spectra
+pointer	refs			# List of reference spectra
+
+bool	ignoreaps		# Ignore apertures?
+
+int	i, i1, i2, nrefs, ap
+double	sortval, d, d1, d2
+pointer	sp, image, gval, refimages, refaps, refvals, refgvals
+
+bool	clgetb(), streq(), refginput(), refgref()
+int	imtgetim(), imtlen()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Task parameters
+	ignoreaps = clgetb ("ignoreaps")
+
+	# Tabulate reference spectra.  This expands the reference list,
+	# checks the spectrum is a reference spectrum of the appropriate
+	# aperture.
+
+	call salloc (refimages, imtlen (refs), TY_INT)
+	call salloc (refaps, imtlen (refs), TY_INT)
+	call salloc (refvals, imtlen (refs), TY_DOUBLE)
+	call salloc (refgvals, imtlen (refs), TY_INT)
+	nrefs = 0
+	while (imtgetim (refs, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refgref (Memc[image], ap, sortval, gval))
+		next
+
+	    for (i=0; i<nrefs; i=i+1)
+		if (streq (Memc[image], Memc[Memi[refimages+i]]))
+		    break
+	    if (i == nrefs) {
+		call salloc (Memi[refimages+nrefs], SZ_FNAME, TY_CHAR)
+		call salloc (Memi[refgvals+nrefs], SZ_FNAME, TY_CHAR)
+		call strcpy (Memc[image], Memc[Memi[refimages+i]], SZ_FNAME)
+		Memi[refaps+i] = ap
+		Memd[refvals+i] = sortval
+		call strcpy (Memc[gval], Memc[Memi[refgvals+i]], SZ_FNAME)
+		nrefs = i + 1
+	    }
+	}
+	if (nrefs < 1)
+	    call error (0, "No reference images specified")
+
+	# Assign following reference spectra to each input spectrum.
+	# Skip input spectra which are not of the appropriate aperture
+	# or have been assigned previously (unless overriding).
+
+	while (imtgetim (input, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refginput (Memc[image], ap, sortval, gval))
+		next
+
+	    i1 = 0
+	    i2 = 0
+	    d1 = MAX_REAL
+	    d2 = -MAX_REAL
+	    do i = 1, nrefs {
+		if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]]))
+		    next
+	        if (!ignoreaps  && ap != Memi[refaps+i-1])
+		    next
+	        d = sortval - Memd[refvals+i-1]
+	        if ((d > 0.) && (d < d1)) {
+		    i1 = i
+		    d1 = d
+	        }
+	        if ((d <= 0.) && (d > d2)) {
+		    i2 = i
+		    d2 = d
+	        }
+	    }
+
+	    if (i2 > 0)		# Nearest following spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i2-1]], 1.,
+		    Memc[Memi[refimages+i2-1]], 0.)
+	    else if (i1 > 0)	# Nearest preceding spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i1-1]], 1.,
+		    Memc[Memi[refimages+i1-1]], 0.)
+	    else {		# No reference spectrum found
+		call refprint (STDERR, NO_REFSPEC, Memc[image], "", "", "",
+		    ap, 0, "")
+		do i = 1, nrefs {
+		    if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]])) {
+			call refprint (STDERR, REF_GROUP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		    }
+		    if (!ignoreaps  && ap != Memi[refaps+i-1])
+			call refprint (STDERR, REF_AP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/refgspec.x b/noao/onedspec/dispcor/refgspec.x
new file mode 100644
index 00000000..bb851307
--- /dev/null
+++ b/noao/onedspec/dispcor/refgspec.x
@@ -0,0 +1,268 @@
+include	<error.h>
+include	"refspectra.h"
+
+# REFOPEN   -- Set verbose and log file descriptors and open symbol table.
+# REFCLOSE  -- Close file descriptors and symbol table
+# REFGSPEC  -- Get a spectrum from the symbol table.  Map it only once.
+# REFGINPUT -- Get input spectrum.  Apply various checks.
+# REFGREF   -- Get reference spectrum.  Apply various checks.
+
+define	REF_LEN		6		# Length of reference structure
+define	REF_SORTVAL	Memd[P2D($1)]	# Sort value
+define	REF_AP		Memi[$1+2]	# Aperture number
+define	REF_GVAL	Memi[$1+3]	# Sort value
+define	REF_SPEC1	Memi[$1+4]	# Offset for reference spectrum 1
+define	REF_SPEC2	Memi[$1+5]	# Offset for reference spectrum 2
+
+
+# REFOPEN  -- Set verbose and log file descriptors and open symbol table.
+# The file descriptors and symbol table pointer are in common.  A null
+# file descriptor indicates no output.
+
+procedure refopen ()
+
+bool	clgetb()
+real	clgetr()
+pointer	rng_open(), stopen()
+int	fd, btoi(), clpopnu(), clgfil(), open(), nowhite()
+errchk	open()
+
+include	"refspectra.com"
+
+begin
+	call malloc (sort, SZ_FNAME, TY_CHAR)
+	call malloc (group, SZ_FNAME, TY_CHAR)
+
+	# Check log files
+	logfiles = clpopnu ("logfiles")
+	while (clgfil (logfiles, Memc[sort], SZ_FNAME) != EOF) {
+	    fd = open (Memc[sort], APPEND, TEXT_FILE)
+	    call close (fd)
+	}
+	call clprew (logfiles)
+
+	# Get other parameters
+	call clgstr ("apertures", Memc[sort], SZ_FNAME)
+	iferr (aps = rng_open (Memc[sort], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture list")
+	call clgstr ("refaps", Memc[sort], SZ_FNAME)
+	iferr (raps = rng_open (Memc[sort], INDEF, INDEF, INDEF))
+	    call error (0, "Bad reference aperture list")
+	call clgstr ("sort", Memc[sort], SZ_FNAME)
+	call clgstr ("group", Memc[group], SZ_FNAME)
+	time = btoi (clgetb ("time"))
+	timewrap = clgetr ("timewrap")
+	verbose = btoi (clgetb ("verbose"))
+
+	fd = nowhite (Memc[sort], Memc[sort], SZ_FNAME)
+	fd = nowhite (Memc[group], Memc[group], SZ_FNAME)
+
+	# Open symbol table.
+	stp = stopen ("refspectra", 10, 20, 10*SZ_FNAME)
+end
+
+
+# REFCLOSE  -- Finish up
+
+procedure refclose ()
+
+include	"refspectra.com"
+
+begin
+	call mfree (sort, TY_CHAR)
+	call mfree (group, TY_CHAR)
+	call clpcls (logfiles)
+	call stclose (stp)
+	call rng_close (raps)
+	call rng_close (aps)
+end
+
+
+# REFGSPEC  -- Get a spectrum from the symbol table.  Map it only once.
+# All access to spectra is through this routine.  It returns header parameters.
+# Because the spectra may be accessed in very random order and many times
+# the information is stored in a symbol table keyed on the spectrum name.
+# The spectrum need be mapped only once!  Any error from IMMAP is returned.
+
+procedure refgspec (spec, ap, sortval, gval, ref1, ref2)
+
+char	spec[ARB]	# Spectrum image name
+int	ap		# Spectrum aperture number
+double	sortval		# Spectrum sort value
+pointer	gval		# Group string
+pointer	ref1		# Reference spectrum 1
+pointer	ref2		# Reference spectrum 2
+
+pointer	sym, stfind(), stenter(), stpstr(), strefsbuf()
+pointer	im, str, immap()
+bool	streq()
+int	imgeti(), strlen()
+double	imgetd()
+errchk	immap, imgetd, imgstr
+
+include	"refspectra.com"
+
+begin
+	# Check if spectrum is in the symbol table from a previous call.
+	# If not in the symbol table map the image, get the header parameters,
+	# and store them in the symbol table.
+
+	sym = stfind (stp, spec)
+	if (sym == NULL) {
+	    im = immap (spec, READ_ONLY, 0)
+	    iferr (ap = imgeti (im, "BEAM-NUM"))
+		ap = 1
+
+	    # Failure to find a specified keyword is a fatal error.
+	    iferr {
+		if (Memc[sort] == EOS || streq (Memc[sort], "none") ||
+		    select == MATCH || select == AVERAGE)
+		    sortval = INDEFD
+		else {
+		    sortval = imgetd (im, Memc[sort])
+		    if (time == YES)
+			sortval = mod (sortval + 24. - timewrap, 24.0D0)
+		}
+
+		call malloc (str, SZ_FNAME, TY_CHAR)
+		if (Memc[group] == EOS || streq (Memc[group], "none") ||
+		    select == MATCH || select == AVERAGE)
+		    Memc[str] = EOS
+		else
+		    call imgstr (im, Memc[group], Memc[str], SZ_FNAME)
+		gval = stpstr (stp, Memc[str], strlen (Memc[str])+1)
+	    } then
+		call erract (EA_FATAL)
+
+	    iferr (call imgstr (im, "refspec1", Memc[str], SZ_FNAME))
+		Memc[str] = EOS
+	    ref1 = stpstr (stp, Memc[str], strlen (Memc[str])+1)
+	    iferr (call imgstr (im, "refspec2", Memc[str], SZ_FNAME))
+		Memc[str] = EOS
+	    ref2 = stpstr (stp, Memc[str], strlen (Memc[str])+1)
+	    call mfree (str, TY_CHAR)
+
+	    call imunmap (im)
+
+	    sym = stenter (stp, spec, REF_LEN)
+	    REF_AP(sym) = ap
+	    REF_SORTVAL(sym) = sortval
+	    REF_GVAL(sym) = gval
+	    REF_SPEC1(sym) = ref1
+	    REF_SPEC2(sym) = ref2
+	}
+	ap = REF_AP(sym)
+	sortval = REF_SORTVAL(sym)
+	gval = strefsbuf (stp, REF_GVAL(sym))
+	ref1 = strefsbuf (stp, REF_SPEC1(sym))
+	ref2 = strefsbuf (stp, REF_SPEC2(sym))
+end
+
+
+# REFGINPUT -- Get input spectrum.  Apply various checks.
+# This calls REFGSPEC and then checks:
+#	1. The spectrum is found.
+#	2. The spectrum has not been assigned reference spectra previously.
+#	   If it has then determine whether to override the assignment.
+#	3. Check if the aperture is correct.
+# Return true if the spectrum is acceptable and false if not.
+
+bool procedure refginput (spec, ap, val, gval)
+
+char	spec[ARB]	# Spectrum image name
+int	ap		# Spectrum aperture number (returned)
+double	val		# Spectrum sort value (returned)
+pointer	gval		# Spectrum group value (returned)
+
+bool	clgetb(), rng_elementi()
+pointer	ref1, ref2
+errchk	refgspec
+
+include	"refspectra.com"
+
+define	err_	99
+
+begin
+	# Get the spectrum from the symbol table.
+	iferr (call refgspec (spec, ap, val, gval, ref1, ref2)) {
+	    call refmsgs (NO_SPEC, spec, "", "", "", ap, 0, "")
+	    goto err_
+	}
+
+	# Check if it has a previous reference spectrum.  Override if desired.
+	if (Memc[ref1] != EOS) {
+	    if (!clgetb ("override")) {
+		call refmsgs (DEF_REFSPEC, spec, Memc[ref1], "", "", ap, 0,
+		    Memc[ref2])
+	       goto err_
+	    } else {
+		call refmsgs (OVR_REFSPEC, spec, Memc[ref1], "", "", ap, 0,
+		    Memc[ref2])
+	    }
+	}
+	
+	# Check aperture numbers.
+	if (aps != NULL) {
+	    if (!rng_elementi (aps, ap)) {
+	        call refmsgs (BAD_AP, spec, "", "", "", ap, 0, "")
+	        goto err_
+	    }
+	}
+
+	return (true)
+
+err_
+	return (false)
+end
+
+
+# REFGREF   -- Get reference spectrum.  Apply various checks.
+# This calls REFGSPEC and then checks:
+#	1. The spectrum is found.
+#	2. The spectrum is a reference spectrum, i.e. has an IDENTIFY
+#	   record.  This is signaled by having a reference equivalent to
+#	   itself.
+#	3. Check if the aperture is correct.
+# Return true if the spectrum is acceptable and false if not.
+
+bool procedure refgref (spec, ap, val, gval)
+
+char	spec[ARB]	# Spectrum image name
+int	ap		# Spectrum aperture number (returned)
+double	val		# Spectrum sort value (returned)
+pointer	gval		# Spectrum group value (returned)
+
+bool	strne(), rng_elementi()
+pointer	ref1, ref2
+errchk	refgspec
+
+include	"refspectra.com"
+
+define	err_	99
+
+begin
+	# Get spectrum from symbol table.
+	iferr (call refgspec (spec, ap, val, gval, ref1, ref2)) {
+	    call refmsgs (NO_REF, spec, "", "", "", ap, 0, "")
+	    goto err_
+	}
+
+	# Check if spectrum is a reference spectrum.
+	if (strne (spec, Memc[ref1])) {
+	    call refmsgs (NOT_REFSPEC, spec, "", "", "", ap, 0, "")
+	    goto err_
+	}
+	
+	# Check aperture numbers.
+	if (raps != NULL) {
+	    if (!rng_elementi (raps, ap)) {
+	        call refmsgs (BAD_REFAP, spec, "", "", "", ap, 0, "")
+	        goto err_
+	    }
+	}
+
+	return (true)
+
+err_
+	return (false)
+end
diff --git a/noao/onedspec/dispcor/refinterp.x b/noao/onedspec/dispcor/refinterp.x
new file mode 100644
index 00000000..b074c053
--- /dev/null
+++ b/noao/onedspec/dispcor/refinterp.x
@@ -0,0 +1,127 @@
+include	<mach.h>
+include	"refspectra.h"
+
+
+# REFINTERP -- Assign reference spectra to interpolate between based on sort
+# key.  The nearest preceding and following spectra are assigned weights based
+# on their distance.  If there is no preceding and following spectrum then
+# the nearest spectrum is assigned.
+
+procedure refinterp (input, refs)
+
+pointer	input			# List of input spectra
+pointer	refs			# List of reference spectra
+
+bool	ignoreaps		# Ignore apertures?
+
+int	i, i1, i2, nrefs, ap
+double	sortval, d, d1, d2
+real	wt1, wt2
+pointer	sp, image, gval, refimages, refaps, refvals, refgvals
+
+bool	clgetb(), streq(), refginput(), refgref()
+int	imtgetim(), imtlen()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Task parameters
+	ignoreaps = clgetb ("ignoreaps")
+
+	# Tabulate reference spectra.  This expands the reference list,
+	# checks the spectrum is a reference spectrum of the appropriate
+	# aperture.
+
+	call salloc (refimages, imtlen (refs), TY_INT)
+	call salloc (refaps, imtlen (refs), TY_INT)
+	call salloc (refvals, imtlen (refs), TY_DOUBLE)
+	call salloc (refgvals, imtlen (refs), TY_INT)
+	nrefs = 0
+	while (imtgetim (refs, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refgref (Memc[image], ap, sortval, gval))
+		next
+
+	    for (i=0; i<nrefs; i=i+1)
+		if (streq (Memc[Memi[refimages+i]], Memc[image]))
+		    break
+	    if (i == nrefs) {
+		call salloc (Memi[refimages+nrefs], SZ_FNAME, TY_CHAR)
+		call salloc (Memi[refgvals+nrefs], SZ_FNAME, TY_CHAR)
+		call strcpy (Memc[image], Memc[Memi[refimages+i]], SZ_FNAME)
+		Memi[refaps+i] = ap
+		Memd[refvals+i] = sortval
+		call strcpy (Memc[gval], Memc[Memi[refgvals+i]], SZ_FNAME)
+		nrefs = i + 1
+	    }
+	}
+	if (nrefs < 1)
+	    call error (0, "No reference images specified")
+
+
+	# Assign following reference spectra to each input spectrum.
+	# Skip input spectra which are not of the appropriate aperture
+	# or have been assigned previously (unless overriding).
+
+	while (imtgetim (input, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refginput (Memc[image], ap, sortval, gval))
+		next
+
+	    i1 = 0
+	    i2 = 0
+	    d1 = MAX_REAL
+	    d2 = -MAX_REAL
+	    do i = 1, nrefs {
+		if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]]))
+		    next
+	        if (!ignoreaps  && ap != Memi[refaps+i-1])
+		    next
+	        d = sortval - Memd[refvals+i-1]
+	        if ((d >= 0.) && (d < d1)) {
+		    i1 = i
+		    d1 = d
+	        } else if ((d <= 0.) && (d > d2)) {
+		    i2 = i
+		    d2 = d
+	        }
+	    }
+
+	    if (i1 > 0 && i2 > 0) {	# Weight spectra
+		if (d1 - d2 == 0.) {
+		    wt1 = 0.5
+		    wt2 = 0.5
+		} else {
+		    wt1 = -d2 / (d1 - d2)
+		    wt2 =  d1 / (d1 - d2)
+		}
+		call refspectra (Memc[image], Memc[Memi[refimages+i1-1]], wt1,
+		    Memc[Memi[refimages+i2-1]], wt2)
+	    } else if (i1 > 0)	# Nearest preceding spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i1-1]], 1.,
+		    Memc[Memi[refimages+i1-1]], 0.)
+	    else if (i2 > 0)	# Nearest following spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i2-1]], 1.,
+		    Memc[Memi[refimages+i2-1]], 0.)
+	    else {		# No reference spectrum found
+		call refprint (STDERR, NO_REFSPEC, Memc[image], "", "", "",
+		    ap, 0, "")
+		do i = 1, nrefs {
+		    if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]])) {
+			call refprint (STDERR, REF_GROUP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		    }
+		    if (!ignoreaps  && ap != Memi[refaps+i-1])
+			call refprint (STDERR, REF_AP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/refmatch.x b/noao/onedspec/dispcor/refmatch.x
new file mode 100644
index 00000000..c94a7113
--- /dev/null
+++ b/noao/onedspec/dispcor/refmatch.x
@@ -0,0 +1,43 @@
+include	"refspectra.h"
+
+# REFMATCH -- Assign reference spectrum by match against reference list.
+
+procedure refmatch (input, refs)
+
+pointer	input			# List of input spectra
+pointer	refs			# List of reference spectra
+
+int	ap
+double	sortval
+pointer	sp, image, refimage, gval
+
+bool	refgref(), refginput()
+int	imtgetim(), imtlen()
+
+begin
+	if (imtlen (input) != imtlen (refs))
+	    call error (0, "Input and reference list have different lengths")
+
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (refimage, SZ_FNAME, TY_CHAR)
+
+	# Assign reference spectra to each input spectrum.
+	# Skip spectra which are not of the appropriate aperture
+	# or have been assigned previously (unless overriding).
+
+	while ((imtgetim (input, Memc[image], SZ_FNAME) != EOF) &&
+	       (imtgetim (refs, Memc[refimage], SZ_FNAME) != EOF)) {
+	    call refnoextn (Memc[image])
+	    call refnoextn (Memc[refimage])
+	    if (!refginput (Memc[image], ap, sortval, gval))
+		next
+	    if (!refgref (Memc[refimage], ap, sortval, gval))
+		next
+
+	    call refspectra (Memc[image], Memc[refimage], 1.,
+		    Memc[refimage], 0.)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/refmsgs.x b/noao/onedspec/dispcor/refmsgs.x
new file mode 100644
index 00000000..a374088e
--- /dev/null
+++ b/noao/onedspec/dispcor/refmsgs.x
@@ -0,0 +1,108 @@
+include	"refspectra.h"
+
+
+# REFMSGS -- Print any verbose messages to log files.  All messages
+# except the assignments go through this procedure.  It calls REFPRINT with
+# each output stream.
+
+procedure refmsgs (msg, spec, ref, gval, gvalref, ap, apref, ref2)
+
+int	msg		# Message code
+char	spec[ARB]	# Spectrum
+char	ref[ARB]	# Reference spectrum
+char	gval[ARB]	# Group value
+char	gvalref[ARB]	# Group value in reference
+int	ap		# Aperture
+int	apref		# Aperture in reference
+char	ref2[ARB]	# Reference spectrum 2
+
+int	fd, clgfil(), open()
+pointer	sp, logfile
+include	"refspectra.com"
+
+begin
+	if (verbose == NO)
+	    return
+
+	call smark (sp)
+	call salloc (logfile, SZ_FNAME, TY_CHAR)
+	while (clgfil (logfiles, Memc[logfile], SZ_FNAME) != EOF) {
+	    fd = open (Memc[logfile], APPEND, TEXT_FILE)
+	    call refprint (fd, msg, spec, ref, gval, gvalref, ap, apref, ref2)
+	    call close (fd)
+	}
+	call clprew (logfiles)
+
+	call sfree (sp)
+end
+
+
+# REFPRINT -- Print requested message with appropriate parameters if non-null
+# stream is specified.
+
+procedure refprint (fd, msg, spec, ref, gval, gvalref, ap, apref, ref2)
+
+int	fd		# File descriptor
+int	msg		# Message code
+char	spec[ARB]	# Spectrum
+char	ref[ARB]	# Reference spectrum
+char	gval[ARB]	# Group value
+char	gvalref[ARB]	# Group value in reference
+int	ap		# Aperture
+int	apref		# Aperture in reference
+char	ref2[ARB]	# Reference spectrum 2
+
+include	"refspectra.com"
+
+begin
+	if (fd == NULL)
+	    return
+
+	switch (msg) {
+	case NO_SPEC:
+	    call fprintf (fd, "[%s] Spectrum not found\n")
+		call pargstr (spec)
+	case NO_REF:
+	    call fprintf (fd, "[%s] Reference spectrum not found\n")
+		call pargstr (spec)
+	case NOT_REFSPEC:
+	    call fprintf (fd, "[%s] Not a reference spectrum\n")
+		call pargstr (spec)
+	case NO_REFSPEC:
+	    call fprintf (fd, "[%s] No reference spectrum found\n")
+		call pargstr (spec)
+	case DEF_REFSPEC:
+	    call fprintf (fd, "[%s] Reference spectra already defined: %s %s\n")
+		call pargstr (spec)
+		call pargstr (ref)
+		call pargstr (ref2)
+	case OVR_REFSPEC:
+	    call fprintf (fd, 
+		"[%s] Overriding previous reference spectra: %s %s\n")
+		call pargstr (spec)
+		call pargstr (ref)
+		call pargstr (ref2)
+	case BAD_AP:
+	    call fprintf (fd, "[%s] Wrong aperture: %d\n")
+		call pargstr (spec)
+		call pargi (ap)
+	case BAD_REFAP:
+	    call fprintf (fd, "[%s] Wrong reference aperture: %d\n")
+		call pargstr (spec)
+		call pargi (ap)
+	case REF_GROUP:
+	    call fprintf (fd, "Input [%s] %s = %s : Ref [%s] %s = %s\n")
+		call pargstr (spec)
+		call pargstr (Memc[group])
+		call pargstr (gval)
+		call pargstr (ref)
+		call pargstr (Memc[group])
+		call pargstr (gvalref)
+	case REF_AP:
+	    call fprintf (fd, "Input [%s] ap = %d : Ref [%s] ap = %d\n")
+		call pargstr (spec)
+		call pargi (ap)
+		call pargstr (ref)
+		call pargi (apref)
+	}
+end
diff --git a/noao/onedspec/dispcor/refnearest.x b/noao/onedspec/dispcor/refnearest.x
new file mode 100644
index 00000000..78ebb62b
--- /dev/null
+++ b/noao/onedspec/dispcor/refnearest.x
@@ -0,0 +1,104 @@
+include	<mach.h>
+include	"refspectra.h"
+
+
+# REFNEAREST -- Assign nearest reference spectrum based on sort key.
+
+procedure refnearest (input, refs)
+
+pointer	input			# List of input spectra
+pointer	refs			# List of reference spectra
+
+bool	ignoreaps		# Ignore apertures?
+
+int	i, i1, nrefs, ap
+double	sortval, d, d1
+pointer	sp, image, gval, refimages, refaps, refvals, refgvals
+
+bool	clgetb(), streq(), refginput(), refgref()
+int	imtgetim(), imtlen()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Task parameters
+	ignoreaps = clgetb ("ignoreaps")
+
+	# Tabulate reference spectra.  This expands the reference list,
+	# checks the spectrum is a reference spectrum of the appropriate
+	# aperture.
+
+	call salloc (refimages, imtlen (refs), TY_POINTER)
+	call salloc (refaps, imtlen (refs), TY_INT)
+	call salloc (refvals, imtlen (refs), TY_DOUBLE)
+	call salloc (refgvals, imtlen (refs), TY_POINTER)
+	nrefs = 0
+	while (imtgetim (refs, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refgref (Memc[image], ap, sortval, gval))
+		next
+
+	    for (i=0; i<nrefs; i=i+1)
+		if (streq (Memc[image], Memc[Memi[refimages+i]]))
+		    break
+	    if (i == nrefs) {
+		call salloc (Memi[refimages+nrefs], SZ_FNAME, TY_CHAR)
+		call salloc (Memi[refgvals+nrefs], SZ_FNAME, TY_CHAR)
+		call strcpy (Memc[image], Memc[Memi[refimages+i]], SZ_FNAME)
+		Memi[refaps+i] = ap
+		Memd[refvals+i] = sortval
+		call strcpy (Memc[gval], Memc[Memi[refgvals+i]], SZ_FNAME)
+		nrefs = i + 1
+	    }
+	}
+	if (nrefs < 1)
+	    call error (0, "No reference images specified")
+
+
+	# Assign nearest reference spectra to each input spectrum.
+	# Skip input spectra which are not of the appropriate aperture
+
+	while (imtgetim (input, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refginput (Memc[image], ap, sortval, gval))
+		next
+
+	    i1 = 0
+	    d1 = MAX_REAL
+	    do i = 1, nrefs {
+		if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]]))
+		    next
+	        if (!ignoreaps && ap != Memi[refaps+i-1])
+		    next
+	        d = abs (sortval - Memd[refvals+i-1])
+	        if (d < d1) {
+		    i1 = i
+		    d1 = d
+	        }
+	    }
+
+	    if (i1 > 0)		# Assign nearest reference spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i1-1]], 1.,
+		    Memc[Memi[refimages+i1-1]], 0.)
+	    else {		# No reference spectrum found
+		call refprint (STDERR, NO_REFSPEC, Memc[image], "", "", "",
+		    ap, 0, "")
+		do i = 1, nrefs {
+		    if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]])) {
+			call refprint (STDERR, REF_GROUP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		    }
+		    if (!ignoreaps  && ap != Memi[refaps+i-1])
+			call refprint (STDERR, REF_AP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/refnoextn.x b/noao/onedspec/dispcor/refnoextn.x
new file mode 100644
index 00000000..4c48b194
--- /dev/null
+++ b/noao/onedspec/dispcor/refnoextn.x
@@ -0,0 +1,29 @@
+# REFNOEXTN -- Strip any image extensions
+
+procedure refnoextn (spec)
+
+char	spec[ARB]		# Image name
+
+int	i, strlen()
+bool	streq()
+
+begin
+	i = strlen (spec)
+	call imgimage (spec, spec, i)
+
+	i = strlen (spec)
+	switch (spec[i]) {
+	case 'h':
+	    if (i > 3 && spec[i-3] == '.')
+		spec[i-3] = EOS
+	case 'l':
+	    if (i > 2 && streq (spec[i-2], ".pl"))
+		spec[i-2] = EOS
+	case 's':
+	    if (i > 4 && streq (spec[i-4], ".fits"))
+		spec[i-4] = EOS
+	case 't':
+	    if (i > 3 && streq (spec[i-3], ".fit"))
+		spec[i-3] = EOS
+	}
+end
diff --git a/noao/onedspec/dispcor/refprecede.x b/noao/onedspec/dispcor/refprecede.x
new file mode 100644
index 00000000..c2ba0467
--- /dev/null
+++ b/noao/onedspec/dispcor/refprecede.x
@@ -0,0 +1,114 @@
+include	<mach.h>
+include	"refspectra.h"
+
+
+# REFPRECEDE -- Assign preceding reference spectrum based on sort key.
+# If there is no preceding spectrum assign the nearest following spectrum.
+
+procedure refprecede (input, refs)
+
+pointer	input			# List of input spectra
+pointer	refs			# List of reference spectra
+
+bool	ignoreaps		# Ignore aperture numbers?
+
+int	i, i1, i2, nrefs, ap
+double	sortval, d, d1, d2
+pointer	sp, image, gval, refimages, refaps, refvals, refgvals
+
+bool	clgetb(), streq(), refginput(), refgref()
+int	imtgetim(), imtlen()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Task parameters
+	ignoreaps = clgetb ("ignoreaps")
+
+	# Tabulate reference spectra.  This expands the reference list,
+	# checks the spectrum is a reference spectrum of the appropriate
+	# aperture.
+
+	call salloc (refimages, imtlen (refs), TY_INT)
+	call salloc (refaps, imtlen (refs), TY_INT)
+	call salloc (refvals, imtlen (refs), TY_DOUBLE)
+	call salloc (refgvals, imtlen (refs), TY_INT)
+	nrefs = 0
+	while (imtgetim (refs, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refgref (Memc[image], ap, sortval, gval))
+		next
+
+	    for (i=0; i<nrefs; i=i+1)
+		if (streq (Memc[image], Memc[Memi[refimages+i]]))
+		    break
+	    if (i == nrefs) {
+		call salloc (Memi[refimages+nrefs], SZ_FNAME, TY_CHAR)
+		call salloc (Memi[refgvals+nrefs], SZ_FNAME, TY_CHAR)
+		call strcpy (Memc[image], Memc[Memi[refimages+i]], SZ_FNAME)
+		Memi[refaps+i] = ap
+		Memd[refvals+i] = sortval
+		call strcpy (Memc[gval], Memc[Memi[refgvals+i]], SZ_FNAME)
+		nrefs = i + 1
+	    }
+	}
+	if (nrefs < 1)
+	    call error (0, "No reference images specified")
+
+	# Assign preceding reference spectra to each input spectrum.
+	# Skip input spectra which are not of the appropriate aperture
+	# or have been assigned previously (unless overriding).
+
+	while (imtgetim (input, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    if (!refginput (Memc[image], ap, sortval, gval))
+		next
+
+	    i1 = 0
+	    i2 = 0
+	    d1 = MAX_REAL
+	    d2 = -MAX_REAL
+	    do i = 1, nrefs {
+		if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]]))
+		    next
+	        if (!ignoreaps && ap != Memi[refaps+i-1])
+		    next
+	        d = sortval - Memd[refvals+i-1]
+	        if ((d >= 0.) && (d < d1)) {
+		    i1 = i
+		    d1 = d
+	        }
+	        if ((d < 0.) && (d < d2)) {
+		    i2 = i
+		    d2 = d
+	        }
+	    }
+
+	    if (i1 > 0)		# Nearest preceding spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i1-1]], 1.,
+		    Memc[Memi[refimages+i1-1]], 0.)
+	    else if (i2 > 0)	# Nearest following spectrum
+		call refspectra (Memc[image], Memc[Memi[refimages+i2-1]], 1.,
+		    Memc[Memi[refimages+i2-1]], 0.)
+	    else {		# No reference spectrum found
+		call refprint (STDERR, NO_REFSPEC, Memc[image], "", "", "",
+		    ap, 0, "")
+		do i = 1, nrefs {
+		    if (!streq (Memc[gval], Memc[Memi[refgvals+i-1]])) {
+			call refprint (STDERR, REF_GROUP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		    }
+		    if (!ignoreaps  && ap != Memi[refaps+i-1])
+			call refprint (STDERR, REF_AP, Memc[image],
+			    Memc[Memi[refimages+i-1]], Memc[gval],
+			    Memc[Memi[refgvals+i-1]], ap, Memi[refaps+i-1], "")
+			next
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/refspectra.com b/noao/onedspec/dispcor/refspectra.com
new file mode 100644
index 00000000..7c5dc622
--- /dev/null
+++ b/noao/onedspec/dispcor/refspectra.com
@@ -0,0 +1,15 @@
+# Common parameters for logging and the spectrum symbol table.
+
+pointer	aps		# Pointer to aperture list
+pointer	raps		# Pointer to reference aperture list
+pointer	sort		# Pointer to sort keyword
+pointer	group		# Pointer to group keyword
+int	select		# Selection type
+int	time		# Is sort keyword a time?
+real	timewrap	# Timewrap parameter
+int	verbose		# Verbose output?
+int	logfiles	# List of log files
+pointer	stp		# Symbol table for previously mapped spectra
+
+common	/refcom/ aps, raps, sort, group, select, time, timewrap, verbose,
+		logfiles, stp
diff --git a/noao/onedspec/dispcor/refspectra.h b/noao/onedspec/dispcor/refspectra.h
new file mode 100644
index 00000000..c7ba397a
--- /dev/null
+++ b/noao/onedspec/dispcor/refspectra.h
@@ -0,0 +1,30 @@
+# Selection method keywords and codes.
+
+define	SELECT	"|match|nearest|preceding|following|interp|average|"
+define	MATCH		1	# Match input and reference lists
+define	NEAREST		2	# Nearest reference
+define	PRECEDING	3	# Preceding reference
+define	FOLLOWING	4	# Following reference
+define	INTERP		5	# Interpolate between nearest references
+define	AVERAGE		6	# Average first two reference spectra
+
+# Reference list types.
+
+define	LIST		1	# References are an image list
+define	TABLE		2	# Referenece are a table
+
+# Maximum number of aperture ranges.
+define	NRANGES		100
+
+# Message codes (see procedure refprint)
+
+define	NO_SPEC		1	# Spectrum not found (immap failed)
+define	NO_REF		2	# Reference spectrum not found (immap failed)
+define	NOT_REFSPEC	3	# Not a reference spectrum
+define	NO_REFSPEC	4	# No reference spectrum found
+define	DEF_REFSPEC	5	# Reference spectra already defined
+define	OVR_REFSPEC	6	# Override reference spectra
+define	BAD_AP		7	# Bad aperture
+define	BAD_REFAP	8	# Bad reference aperture
+define	REF_GROUP	9	# Group
+define	REF_AP		10	# Aperture
diff --git a/noao/onedspec/dispcor/refspectra.x b/noao/onedspec/dispcor/refspectra.x
new file mode 100644
index 00000000..57a18e43
--- /dev/null
+++ b/noao/onedspec/dispcor/refspectra.x
@@ -0,0 +1,186 @@
+include	"refspectra.h"
+
+
+# T_REFSPECTRA -- Assign reference spectra.
+# Reference spectra are assigned to input spectra from a specified list of
+# reference spectra with various criteria.  This procedure only gets some
+# of the task parameters and switches to separate procedures for each
+# implemented assignment method.  The reference spectra may be specified by
+# and image list or a lookup table.  The difference is determined by attempting
+# to map the first reference element in the list as an image.
+
+procedure t_refspectra ()
+
+pointer	input			# List of input images
+pointer	refs			# List of reference images
+#int	select			# Selection method for reference spectra
+int	type			# Type of reference specification
+
+int	clgwrd(), imtgetim()
+pointer	sp, ref, im, imtopenp(), immap()
+errchk	immap
+
+include	"refspectra.com"
+
+begin
+	call smark (sp)
+	call salloc (ref, SZ_LINE, TY_CHAR)
+
+	# Get input and reference spectra lists.  Determine selection method.
+	input = imtopenp ("input")
+	call clgstr ("records", Memc[ref], SZ_LINE)
+	call odr_openp (input, Memc[ref])
+	refs = imtopenp ("references")
+	select = clgwrd ("select", Memc[ref], SZ_FNAME, SELECT)
+
+	# Determine if reference list is a table.
+	if (imtgetim (refs, Memc[ref], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[ref])
+	    iferr {
+		im = immap (Memc[ref], READ_ONLY, 0)
+	        call imunmap (im)
+		type = LIST
+	    } then
+		type = TABLE
+	} else
+	    call error (0, "No reference spectra specified")
+	call imtrew (refs)
+
+	# Initialize confirm flag, symbol table and logging streams.
+	call refconfirm1 ()
+	call refopen ()
+
+	# Switch of reference list type and selection method.
+	if (type == LIST) {
+	    switch (select) {
+	    case MATCH:
+	        call refmatch(input, refs)
+	    case NEAREST:
+	        call refnearest (input, refs)
+	    case PRECEDING:
+	        call refprecede (input, refs)
+	    case FOLLOWING:
+	        call reffollow (input, refs)
+	    case INTERP:
+	        call refinterp (input, refs)
+	    case AVERAGE:
+	        call refaverage (input, refs)
+	    }
+	} else
+	    call reftable (input, Memc[ref], select)
+
+	call refclose ()
+	call imtclose (input)
+	call imtclose (refs)
+	call sfree (sp)
+end
+
+
+# REFSPECTRA -- Confirm and set reference spectra in header.
+# 	1.  Confirm assignments if desired.
+#	2.  Log output to logfiles if desired.
+#	3.  Update assignment if desired.
+# Note that if wt1 > 0.995 then only the first reference spectrum is
+# set with no weight specified.  No weight implies no interpolation.
+
+procedure refspectra (image, ref1, wt1, ref2, wt2)
+
+char	image[ARB]		# Spectrum image name
+char	ref1[ARB]		# Reference spectrum image name
+real	wt1			# Weight
+char	ref2[ARB]		# Reference spectrum image name
+real	wt2			# Weight
+bool	confirm			# Confirm assignments?
+
+int	fd, clgfil(), open(), clgwrd()
+bool	clgetb(), streq()
+pointer	im, sp, str, immap()
+errchk	immap
+
+include	"refspectra.com"
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Confirm assignments.
+	if (confirm) {
+	    if (wt1 < 0.995) {
+	        call printf ("[%s] refspec1='%s %.8g'\n")
+	            call pargstr (image)
+	            call pargstr (ref1)
+		    call pargr (wt1)
+	        call printf ("[%s] refspec2='%s %.8g'   ")
+	            call pargstr (image)
+	            call pargstr (ref2)
+		    call pargr (wt2)
+	    } else {
+	        call printf ("[%s] refspec1='%s'   ")
+	            call pargstr (image)
+	            call pargstr (ref1)
+	    }
+	    call flush (STDOUT)
+	    fd = clgwrd ("answer", Memc[str], SZ_LINE, "|no|yes|YES|")
+	    switch (fd) {
+	    case 1:
+		call sfree (sp)
+		return
+	    case 3:
+		confirm = false
+	    }
+	}
+
+	# Log output.
+	while (clgfil (logfiles, Memc[str], SZ_LINE) != EOF) {
+	    if (streq (Memc[str], "STDOUT") && confirm)
+		next
+	    fd = open (Memc[str], APPEND, TEXT_FILE)
+	    if (wt1 < 0.995) {
+	        call fprintf (fd, "[%s] refspec1='%s %.8g'\n")
+	            call pargstr (image)
+	            call pargstr (ref1)
+		    call pargr (wt1)
+	        call fprintf (fd, "[%s] refspec2='%s %.8g'\n")
+	            call pargstr (image)
+	            call pargstr (ref2)
+		    call pargr (wt2)
+	    } else {
+	        call fprintf (fd, "[%s] refspec1='%s'\n")
+	            call pargstr (image)
+	            call pargstr (ref1)
+	    }
+	    call close (fd)
+	}
+	call clprew (logfiles)
+
+	# If updating the assigments map the spectrum READ_WRITE and set
+	# the keywords REFSPEC1 and REFSPEC2.  REFSPEC2 is not set if not
+	# interpolating.
+
+	if (clgetb ("assign")) {
+	    im = immap (image, READ_WRITE, 0)
+	    if (wt1 < 0.9999995D0) {
+	        call sprintf (Memc[str], SZ_LINE, "%s %.8g")
+	            call pargstr (ref1)
+		    call pargr (wt1)
+	        call imastr (im, "refspec1", Memc[str])
+	        call sprintf (Memc[str], SZ_LINE, "%s %.8g")
+	            call pargstr (ref2)
+		    call pargr (wt2)
+	        call imastr (im, "refspec2", Memc[str])
+	    } else {
+	        call imastr (im, "refspec1", ref1)
+	        iferr (call imdelf (im, "refspec2"))
+		    ;
+	    }
+	    call imunmap (im)
+	}
+
+	call sfree (sp)
+	return
+
+entry refconfirm1 ()
+
+	confirm = clgetb ("confirm")
+
+end
diff --git a/noao/onedspec/dispcor/reftable.x b/noao/onedspec/dispcor/reftable.x
new file mode 100644
index 00000000..abdf1f4a
--- /dev/null
+++ b/noao/onedspec/dispcor/reftable.x
@@ -0,0 +1,109 @@
+include	<error.h>
+include	"refspectra.h"
+
+
+# REFTABLE -- For each input image select reference spectrum list from a table.
+# The table is read from the file and stored in a simple symbol table.
+#
+# The table consists of pairs of words.  The first word is a list of spectra
+# and the second word is the reference spectrum list to be used for each
+# spectrum in the first list.  Note that the first list is  not an input
+# list.  As a convenience if a reference list is missing the preceding list
+# is implied.  Some examples follow.
+#
+#	spec1		spec2,spec3,spec4
+#	spec5
+#	spec6,spec7	spect8,spec9
+#	spec10		spec11
+#	spec12		spec13
+#	spec14		spec15
+
+procedure reftable (list, table, select)
+
+pointer	list			# List of input spectra
+char	table[ARB]		# Reference table
+int	select			# Selection method
+
+int	i, fd, input, refs
+pointer	stp, sym
+pointer	sp, image, ref1, ref2
+
+pointer	stopen(), strefsbuf(), stenter(), stpstr(), stfind(), imtopen()
+int	imtgetim(), open(), fscan(), nscan()
+errchk	open
+
+begin
+	# Read the table.  Return an error if the file can't be opened.
+	# Read each table entry of spectrum list and reference list.
+	# Expand the input list to make a symbol table keyed on the
+	# spectrum with the reference list string as it's value.
+	# As a convenience if a reference list is missing the preceding
+	# list is implied.
+
+	fd = open (table, READ_ONLY, TEXT_FILE)
+
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (ref1, SZ_FNAME, TY_CHAR)
+	call salloc (ref2, SZ_FNAME, TY_CHAR)
+
+	stp = stopen ("table", 10, 10, 20*SZ_FNAME)
+	while (fscan (fd) != EOF) {
+	    call gargwrd (Memc[image], SZ_FNAME)
+	    call gargwrd (Memc[ref1], SZ_FNAME)
+	    if (nscan() < 1)
+		next
+	    if (nscan() < 2)
+		call strcpy (Memc[ref2], Memc[ref1], SZ_FNAME)
+	    else
+		call strcpy (Memc[ref1], Memc[ref2], SZ_FNAME)
+
+	    i = stpstr (stp, Memc[ref1], SZ_FNAME)
+
+	    input = imtopen (Memc[image])
+	    while (imtgetim (input, Memc[image], SZ_FNAME) != EOF) {
+		call refnoextn (Memc[image])
+	        sym = stenter (stp, Memc[image], 1)
+	        Memi[sym] = i
+	    }
+	    call imtclose (input)
+	}
+	call close (fd)
+
+	# For each input spectrum find the appropriate reference spectrum list.
+	# If no list is found print a message and continue.  Switch on the
+	# selection method.
+
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+	    call refnoextn (Memc[image])
+	    sym = stfind (stp, Memc[image])
+	    if (sym == NULL) {
+		call refmsgs (NO_REFSPEC, Memc[image], "", "", "", 0, 0, "")
+		next
+	    }
+
+	    input = imtopen (Memc[image])
+	    refs = imtopen (Memc[strefsbuf (stp, Memi[sym])])
+
+	    switch (select) {
+	    case MATCH:
+	        call refmatch(input, refs)
+	    case NEAREST:
+	        call refnearest (input, refs)
+	    case PRECEDING:
+	        call refprecede (input, refs)
+	    case FOLLOWING:
+	        call reffollow (input, refs)
+	    case INTERP:
+	        call refinterp (input, refs)
+	    case AVERAGE:
+	        call refaverage (input, refs)
+	    }
+
+	    call imtclose (input)
+	    call imtclose (refs)
+	}
+
+	call stclose (stp)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/t_dispcor.x b/noao/onedspec/dispcor/t_dispcor.x
new file mode 100644
index 00000000..94aeba44
--- /dev/null
+++ b/noao/onedspec/dispcor/t_dispcor.x
@@ -0,0 +1,1336 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	<mwset.h>
+include	"dispcor.h"
+include	"dctable.h"
+include	<smw.h>
+include	<units.h>
+ 
+# Dispersion types.
+define	MULTISPEC	1
+define	ECHELLE		2
+
+ 
+# T_DISPCOR -- Dispersion correct spectra.
+ 
+procedure t_dispcor ()
+ 
+int	in			# List of input spectra
+int	out			# List of output spectra
+bool	linearize		# Linearize spectra?
+bool	log			# Log scale?
+bool	flux			# Conserve flux?
+real	blank			# Blank value
+int	ignoreaps		# Ignore aperture numbers?
+int	fd1			# Log file descriptor
+int	fd2			# Log file descriptor
+ 
+int	i, format, naps
+int	open(), nowhite(), imtopenp(), imtgetim(), errcode(), btoi()
+pointer	sp, input, output, str, err, stp, table
+pointer	im, im1, smw, smw1, ap, immap(), smw_openim()
+bool	clgetb()
+real	clgetr()
+errchk	open, immap, smw_openim, dc_gms, dc_gec, dc_multispec, dc_echelle
+ 
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (err, SZ_LINE, TY_CHAR)
+ 
+	# Task parameters
+	in = imtopenp ("input")
+	out = imtopenp ("output")
+	call clgstr ("records", Memc[str], SZ_LINE)
+	call odr_openp (in, Memc[str])
+	call odr_openp (out, Memc[str])
+	call clgstr ("database", Memc[str], SZ_FNAME)
+	call clgstr ("logfile", Memc[err], SZ_LINE)
+	linearize = clgetb ("linearize")
+	ignoreaps = btoi (clgetb ("ignoreaps"))
+ 
+	# Initialize the database cacheing and wavelength table.
+	call dc_open (stp, Memc[str])
+	if (linearize) {
+	    log = clgetb ("log")
+	    flux = clgetb ("flux")
+	    blank = clgetr ("blank")
+
+	    call dc_table (table, naps)
+	    if (clgetb ("global")) {
+		if (clgetb ("samedisp"))
+		    call dc_global1 (in, stp, log, table, naps)
+		else
+		    call dc_global (in, stp, log, table, naps)
+	    }
+	}
+
+	# Open logfile if specified.
+	if (clgetb ("verbose"))
+	    fd1 = STDOUT
+	if (nowhite (Memc[err], Memc[err], SZ_LINE) != 0)
+	    fd2 = open (Memc[err], APPEND, TEXT_FILE)
+	else
+	    fd2 = NULL
+
+	# Loop through each input image.  Do the dispersion correction
+	# in place if no output spectrum list is given or if the input
+	# and output spectra names are the same.
+ 
+	while (imtgetim (in, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (out, Memc[output], SZ_FNAME) == EOF)
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+		
+	    iferr {
+		im = NULL; im1 = NULL
+		smw = NULL; smw1 = NULL
+		ap = NULL
+
+		i = immap (Memc[input], READ_ONLY, 0); im = i
+		i = smw_openim (im); smw = i
+
+		switch (SMW_FORMAT(smw)) {
+		case SMW_ND:
+		    # Use first line for reference.
+		    switch (SMW_LDIM(smw)) {
+		    case 1:
+			call strcpy (Memc[input], Memc[str], SZ_LINE)
+		    case 2:
+			switch (SMW_LAXIS(smw,1)) {
+			case 1:
+			    call sprintf (Memc[str], SZ_LINE, "%s[*,1]")
+				call pargstr (Memc[input])
+			case 2:
+			    call sprintf (Memc[str], SZ_LINE, "%s[1,*]")
+				call pargstr (Memc[input])
+			}
+		    case 3:
+			switch (SMW_LAXIS(smw,1)) {
+			case 1:
+			    call sprintf (Memc[str], SZ_LINE, "%s[*,1,1]")
+				call pargstr (Memc[input])
+			case 2:
+			    call sprintf (Memc[str], SZ_LINE, "%s[1,*,1]")
+				call pargstr (Memc[input])
+			case 3:
+			    call sprintf (Memc[str], SZ_LINE, "%s[*,1,1]")
+				call pargstr (Memc[input])
+			}
+		    }
+		    im1 = immap (Memc[str], READ_ONLY, 0)
+		    smw1 = smw_openim (im1)
+		    call smw_ndes (im1, smw1)
+		    if (SMW_PDIM(smw1) == 1)
+			call smw_esms (smw1)
+
+		    call dc_gms (Memc[input], im1, smw1, stp, YES, ap, fd1, fd2)
+		    call dc_ndspec (im, smw, smw1, ap, Memc[input],
+			Memc[output], linearize, log, flux, blank, table, naps,
+			fd1, fd2)
+		default:
+		    # Get dispersion functions.  Determine type of dispersion
+		    # by the error return.
+
+		    format = MULTISPEC
+		    iferr (call dc_gms (Memc[input], im, smw, stp, ignoreaps,
+			ap, fd1, fd2)) {
+			if (errcode() > 1 && errcode() < 100)
+			    call erract (EA_ERROR)
+			format = ECHELLE
+			iferr (call dc_gec (Memc[input], im, smw, stp, ap,
+			    fd1, fd2)) {
+			    if (errcode() > 1 && errcode() < 100)
+				call erract (EA_ERROR)
+			    call erract (EA_WARN)
+			    iferr (call dc_gms (Memc[input], im, smw, stp,
+				ignoreaps, ap, fd1, fd2))
+				call erract (EA_WARN)
+			    call sprintf (Memc[err], SZ_LINE,
+				"%s: Dispersion data not found")
+				call pargstr (Memc[input])
+			    call error (1, Memc[err])
+			}
+		    }
+
+		    switch (format) {
+		    case MULTISPEC:
+			call dc_multispec (im, smw, ap, Memc[input],
+			    Memc[output], linearize, log, flux, blank, table,
+			    naps, fd1, fd2)
+		    case ECHELLE:
+			call dc_echelle (im, smw, ap, Memc[input],
+			    Memc[output], linearize, log, flux, blank, table,
+			    naps, fd1, fd2)
+		    }
+		}
+	    } then
+		call erract (EA_WARN)
+
+	    if (ap != NULL)
+		call mfree (ap, TY_STRUCT)
+	    if (smw1 != NULL)
+		call smw_close (smw1)
+	    if (im1 != NULL)
+		call imunmap (im1)
+	    if (smw != NULL)
+		call smw_close (smw)
+	    if (im != NULL)
+		call imunmap (im)
+	}
+
+	# Finish up.
+	if (linearize)
+	    do i = 0, naps
+		call mfree (Memi[table+i], TY_STRUCT)
+	call mfree (table, TY_INT)
+	call dc_close (stp)
+	call imtclose (in)
+	call imtclose (out)
+	if (fd1 != NULL)
+	    call close (fd1)
+	if (fd2 != NULL)
+	    call close (fd2)
+	call sfree (sp)
+end
+ 
+ 
+# DC_NDSPEC -- Dispersion correct N-dimensional spectrum.
+ 
+procedure dc_ndspec (in, smw, smw1, ap, input, output, linearize, log, flux,
+	blank, table, naps, fd1, fd2)
+ 
+pointer	in			# Input IMIO pointer
+pointer	smw			# SMW pointer
+pointer	smw1			# SMW pointer
+pointer	ap			# Aperture pointer
+char	input[ARB]		# Input multispec spectrum
+char	output[ARB]		# Output root name
+bool	linearize		# Linearize?
+bool	log			# Log wavelength parameters?
+bool	flux			# Conserve flux?
+real	blank			# Blank value
+pointer	table			# Wavelength table
+int	naps			# Number of apertures
+int	fd1			# Log file descriptor
+int	fd2			# Log file descriptor
+
+int	i, j, nin, ndim, dispaxis, n1, n2, n3
+pointer	sp, temp, str, out, mwout, cti, cto, indata, outdata
+pointer	immap(), imgs3r(), imps3r(), mw_open(), smw_sctran()
+bool	clgetb(), streq()
+errchk	immap, mw_open, smw_open, dispcor, imgs3r, imps3r
+
+begin
+	# Determine the wavelength parameters.
+	call dc_wavelengths (in, ap, output, log, table, naps, 1,
+	    DC_AP(ap,1), DC_W1(ap,1), DC_W2(ap,1), DC_DW(ap,1), DC_NW(ap,1))
+	DC_Z(ap,1) = 0.
+	if (log)
+	    DC_DT(ap,1) = 1
+	else
+	    DC_DT(ap,1) = 0
+	
+	call dc_log (fd1, output, ap, 1, log)
+	call dc_log (fd2, output, ap, 1, log)
+
+	if (clgetb ("listonly"))
+	    return
+
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Open output image.  Use temp. image if output is the same as input.
+	if (streq (input, output)) {
+	    call mktemp ("temp", Memc[temp], SZ_LINE)
+	    out = immap (Memc[temp], NEW_COPY, in)
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+	} else {
+	    out = immap (output, NEW_COPY, in)
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+	}
+
+	# Set dimensions.
+	ndim = SMW_LDIM(smw)
+	dispaxis = SMW_LAXIS(smw,1)
+	n1 = DC_NW(ap,1)
+	n2 = SMW_LLEN(smw,2)
+	n3 = SMW_LLEN(smw,3)
+	nin = IM_LEN(in,dispaxis)
+	IM_LEN(out,dispaxis) = n1
+
+	# Set WCS header.
+	mwout = mw_open (NULL, ndim)
+	call mw_newsystem (mwout, "world", ndim)
+	do i = 1, ndim
+	    call mw_swtype (mwout, i, 1, "linear", "")
+	if (UN_LABEL(DC_UN(ap,1)) != EOS)
+	    call mw_swattrs (mwout, dispaxis, "label", UN_LABEL(DC_UN(ap,1)))
+	if (UN_UNITS(DC_UN(ap,1)) != EOS)
+	    call mw_swattrs (mwout, dispaxis, "units", UN_UNITS(DC_UN(ap,1)))
+	call smw_open (mwout, NULL, out)
+	call smw_swattrs (mwout, INDEFI, INDEFI, INDEFI, INDEFI, DC_DT(ap,1),
+	    DC_W1(ap,1), DC_DW(ap,1), DC_NW(ap,1), DC_Z(ap,1), INDEFR, INDEFR,
+	    "")
+
+	# Set WCS transformations.
+	cti = smw_sctran (smw1, "world", "logical", 3)
+	switch (dispaxis) {
+	case 1:
+	    cto = smw_sctran (mwout, "logical", "world", 1)
+	case 2:
+	    cto = smw_sctran (mwout, "logical", "world", 2)
+	case 3:
+	    cto = smw_sctran (mwout, "logical", "world", 4)
+	}
+
+	# Dispersion correct.
+	do j = 1, n3 {
+	    do i = 1, n2 {
+		switch (dispaxis) {
+		case 1:
+		    indata = imgs3r (in, 1, nin, i, i, j, j)
+		    outdata = imps3r (out, 1, n1, i, i, j, j)
+		case 2:
+		    indata = imgs3r (in, i, i, 1, nin, j, j)
+		    outdata = imps3r (out, i, i, 1, n1, j, j)
+		case 3:
+		    indata = imgs3r (in, i, i, j, j, 1, nin)
+		    outdata = imps3r (out, i, i, j, j, 1, n1)
+		}
+
+		call aclrr (Memr[outdata], n1)
+		call dispcora (cti, 1, cto, INDEFI, Memr[indata], nin,
+		    Memr[outdata], n1, flux, blank)
+	    }
+	}
+
+	# Save REFSPEC keywords if present.
+	call dc_refspec (out)
+ 
+	# Finish up.  Replace input by output if needed.
+	call smw_ctfree (cti)
+	call smw_ctfree (cto)
+	call smw_saveim (mwout, out)
+	call smw_close (mwout)
+	call imunmap (out)
+	call imunmap (in)
+	if (streq (input, output)) {
+	    call imdelete (input)
+	    call imrename (Memc[temp], output)
+	}
+ 
+	call sfree (sp)
+end
+ 
+ 
+# DC_MULTISPEC -- Linearize multispec apertures into an MULTISPEC format
+# spectrum.  The number of pixels in each image line is the maximum
+# required to contain the longest spectrum.
+ 
+procedure dc_multispec (in, smw, ap, input, output, linearize, log, flux,
+	blank, table, naps, fd1, fd2)
+ 
+pointer	in			# Input IMIO pointer
+pointer	smw			# SMW pointer
+pointer	ap			# Aperture pointer
+char	input[ARB]		# Input multispec spectrum
+char	output[ARB]		# Output root name
+bool	linearize		# Linearize?
+bool	log			# Log wavelength parameters?
+bool	flux			# Conserve flux?
+real	blank			# Blank value
+pointer	table			# Wavelength table
+int	naps			# Number of apertures
+int	fd1			# Log file descriptor
+int	fd2			# Log file descriptor
+ 
+int	i, j, nc, nl, nb, axis[2]
+pointer	sp, temp, str, out, mwout, cti, cto, indata, outdata
+pointer	immap(), imgl3r(), impl3r()
+pointer	mw_open(), smw_sctran()
+bool	clgetb(), streq()
+errchk	immap, mw_open, smw_open, dispcor, imgl3r, impl3r
+
+data	axis/1,2/
+ 
+begin
+	# Determine the wavelength parameters for each aperture.
+	# The options are to have all apertures have the same dispersion
+	# or have each aperture have independent dispersion.  The global
+	# parameters have already been calculated if needed.
+
+	nc = IM_LEN(in,1)
+	nl = IM_LEN(in,2)
+	nb = IM_LEN(in,3)
+ 
+	if (linearize) {
+	    if (log)
+		DC_DT(ap,1) = 1
+	    else
+		DC_DT(ap,1) = 0
+	    if (clgetb ("samedisp")) {
+		call dc_wavelengths1 (in, smw, ap, output, log, table, naps,
+		    DC_W1(ap,1), DC_W2(ap,1), DC_DW(ap,1), DC_NW(ap,1))
+		if ((DC_DW(ap,1)*(DC_W2(ap,1)-DC_W1(ap,1)) <= 0.) ||
+		    (DC_NW(ap,1) < 1))
+		    call error (1, "Error in wavelength scale")
+		do i = 2, nl {
+		    DC_W1(ap,i) = DC_W1(ap,1)
+		    DC_W2(ap,i) = DC_W2(ap,1)
+		    DC_DW(ap,i) = DC_DW(ap,1)
+		    DC_NW(ap,i) = DC_NW(ap,1)
+		    DC_Z(ap,i) = 0.
+		    DC_DT(ap,i) = DC_DT(ap,1)
+		}
+	    } else {
+		do i = 1, nl {
+		    call dc_wavelengths (in, ap, output, log, table, naps, i,
+			DC_AP(ap,i), DC_W1(ap,i), DC_W2(ap,i), DC_DW(ap,i),
+			DC_NW(ap,i))
+		    DC_Z(ap,i) = 0.
+		    DC_DT(ap,i) = DC_DT(ap,1)
+		}
+	    }
+	}
+	call dc_log (fd1, output, ap, nl, log)
+	call dc_log (fd2, output, ap, nl, log)
+
+	if (clgetb ("listonly"))
+	    return
+
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Use a temporary image if the output has the same name as the input.
+	if (streq (input, output)) {
+	    if (linearize) {
+		call mktemp ("temp", Memc[temp], SZ_LINE)
+		out = immap (Memc[temp], NEW_COPY, in)
+		if (IM_PIXTYPE(out) != TY_DOUBLE)
+		    IM_PIXTYPE(out) = TY_REAL
+	    } else {
+		call imunmap (in)
+		i = immap (input, READ_WRITE, 0)
+		in = i
+		out = i
+	    }
+	} else {
+	    out = immap (output, NEW_COPY, in)
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+	}
+
+	# Set MWCS or linearize
+	if (!linearize) {
+	    if (out != in)
+		do j = 1, nb
+		    do i = 1, nl
+			call amovr (Memr[imgl3r(in,i,j)], Memr[impl3r(out,i,j)],
+			    IM_LEN(in,1))
+	    call smw_saveim (smw, out)
+	} else {
+	    if (nb > 1)
+		i = 3
+	    else
+		i = 2
+	    mwout = mw_open (NULL, i)
+	    call mw_newsystem (mwout, "multispec", i)
+	    call mw_swtype (mwout, axis, 2, "multispec", "")
+	    if (UN_LABEL(DC_UN(ap,1)) != EOS)
+		call mw_swattrs (mwout, 1, "label", UN_LABEL(DC_UN(ap,1)))
+	    if (UN_UNITS(DC_UN(ap,1)) != EOS)
+		call mw_swattrs (mwout, 1, "units", UN_UNITS(DC_UN(ap,1)))
+	    if (i == 3)
+		call mw_swtype (mwout, 3, 1, "linear", "")
+	    call smw_open (mwout, NULL, out)
+	    do i = 1, nl {
+		call smw_swattrs (mwout, i, 1, DC_AP(ap,i), DC_BM(ap,i),
+		    DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i),
+		    DC_Z(ap,i), DC_LW(ap,i), DC_UP(ap,i), "")
+		call smw_gapid (smw, i, 1, Memc[str], SZ_LINE)
+		call smw_sapid (mwout, i, 1, Memc[str])
+	    }
+
+	    IM_LEN(out,1) = DC_NW(ap,1)
+	    do i = 2, nl
+		IM_LEN(out,1) = max (DC_NW(ap,i), IM_LEN(out,1))
+	    cti = smw_sctran (smw, "world", "logical", 3)
+	    cto = smw_sctran (mwout, "logical", "world", 3)
+	    do j = 1, nb {
+		do i = 1, nl {
+		    indata = imgl3r (in, i, j)
+		    outdata = impl3r (out, i, j)
+		    call aclrr (Memr[outdata], IM_LEN(out,1))
+		    call dispcora (cti, i, cto, i, Memr[indata], nc,
+			Memr[outdata], DC_NW(ap,i), flux, blank)
+		    if (DC_NW(ap,i) < IM_LEN(out,1))
+			call amovkr (Memr[outdata+DC_NW(ap,i)-1],
+			    Memr[outdata+DC_NW(ap,i)],IM_LEN(out,1)-DC_NW(ap,i))
+		}
+	    }
+	    call smw_ctfree (cti)
+	    call smw_ctfree (cto)
+	    call smw_saveim (mwout, out)
+	    call smw_close (mwout)
+	}
+
+	# Save REFSPEC keywords if present.
+	call dc_refspec (out)
+ 
+	# Finish up.  Replace input by output if needed.
+	if (out == in) {
+	    call imunmap (in)
+	} else {
+	    call imunmap (in)
+	    call imunmap (out)
+	    if (streq (input, output)) {
+		call imdelete (input)
+		call imrename (Memc[temp], output)
+	    }
+	}
+ 
+	call sfree (sp)
+end
+ 
+ 
+# DC_ECHELLE -- Linearize echelle orders into an ECHELLE format
+# spectrum.  The number of pixels in each image line is the maximum
+# required to contain the longest spectrum.
+ 
+procedure dc_echelle (in, smw, ap, input, output, linearize, log, flux,
+	blank, table, naps, fd1, fd2)
+ 
+pointer	in			# IMIO pointer
+pointer	smw			# SMW pointers
+pointer	ap			# Aperture pointer
+char	input[ARB]		# Input multispec spectrum
+char	output[ARB]		# Output root name
+bool	linearize		# Linearize?
+bool	log			# Log wavelength parameters?
+bool	flux			# Conserve flux?
+real	blank			# Blank value
+pointer	table			# Wavelength table
+int	naps			# Number of apertures
+int	fd1			# Log file descriptor
+int	fd2			# Log file descriptor
+ 
+int	i, j, nc, nl, nb, axis[2]
+pointer	sp, temp, str, out, mwout, cti, cto, indata, outdata
+pointer	immap(), imgl3r(), impl3r()
+pointer	mw_open(), smw_sctran()
+bool	clgetb(), streq()
+errchk	immap, mw_open, smw_open, dispcor, imgl3r, impl3r
+
+data	axis/1,2/
+ 
+begin
+	# Determine the wavelength parameters for each aperture.
+ 
+	nc = IM_LEN(in,1)
+	nl = IM_LEN(in,2)
+	nb = IM_LEN(in,3)
+ 
+	if (linearize) {
+	    if (log)
+		DC_DT(ap,1) = 1
+	    else
+		DC_DT(ap,1) = 0
+	    do i = 1, nl {
+		call dc_wavelengths (in, ap, output, log, table, naps,
+		    i, DC_AP(ap,i), DC_W1(ap,i), DC_W2(ap,i), DC_DW(ap,i),
+		    DC_NW(ap,i))
+		DC_Z(ap,i) = 0.
+		DC_DT(ap,i) = DC_DT(ap,1)
+	    }
+	}
+	call dc_log (fd1, output, ap, nl, log)
+	call dc_log (fd2, output, ap, nl, log)
+
+	if (clgetb ("listonly"))
+	    return
+
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Use a temporary image if the output has the same name as the input.
+	if (streq (input, output)) {
+	    if (linearize) {
+		call mktemp ("temp", Memc[temp], SZ_LINE)
+		out = immap (Memc[temp], NEW_COPY, in)
+		if (IM_PIXTYPE(out) != TY_DOUBLE)
+		    IM_PIXTYPE(out) = TY_REAL
+	    } else {
+		call imunmap (in)
+		i = immap (input, READ_WRITE, 0)
+		in = i
+		out = i
+	    }
+	} else {
+	    out = immap (output, NEW_COPY, in)
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+	}
+
+	# Set MWCS or linearize
+	if (!linearize) {
+	    if (out != in)
+		do j = 1, nb
+		    do i = 1, nl
+			call amovr (Memr[imgl3r(in,i,j)], Memr[impl3r(out,i,j)],
+			    IM_LEN(in,1))
+	    call smw_saveim (smw, out)
+	} else {
+	    if (nb > 1)
+		i = 3
+	    else
+		i = 2
+	    mwout = mw_open (NULL, i)
+	    call mw_newsystem (mwout, "multispec", i)
+	    call mw_swtype (mwout, axis, 2, "multispec", "")
+	    if (UN_LABEL(DC_UN(ap,1)) != EOS)
+		call mw_swattrs (mwout, 1, "label", UN_LABEL(DC_UN(ap,1)))
+	    if (UN_UNITS(DC_UN(ap,1)) != EOS)
+		call mw_swattrs (mwout, 1, "units", UN_UNITS(DC_UN(ap,1)))
+	    if (i == 3)
+		call mw_swtype (mwout, 3, 1, "linear", "")
+	    call smw_open (mwout, NULL, out)
+	    do i = 1, nl {
+		call smw_swattrs (mwout, i, 1, DC_AP(ap,i), DC_BM(ap,i),
+		    DC_DT(ap,i), DC_W1(ap,i), DC_DW(ap,i), DC_NW(ap,i),
+		    DC_Z(ap,i), DC_LW(ap,i), DC_UP(ap,i), "")
+		call smw_gapid (smw, i, 1, Memc[str], SZ_LINE)
+		call smw_sapid (mwout, i, 1, Memc[str])
+	    }
+
+	    IM_LEN(out,1) = DC_NW(ap,1)
+	    do i = 2, nl
+		IM_LEN(out,1) = max (DC_NW(ap,i), IM_LEN(out,1))
+	    cti = smw_sctran (smw, "world", "logical", 3)
+	    cto = smw_sctran (mwout, "logical", "world", 3)
+	    do j = 1, nb {
+		do i = 1, nl {
+		    indata = imgl3r (in, i, j)
+		    outdata = impl3r (out, i, j)
+		    call aclrr (Memr[outdata], IM_LEN(out,1))
+		    call dispcora (cti, i, cto, i, Memr[indata], nc,
+			Memr[outdata], DC_NW(ap,i), flux, blank)
+		    if (DC_NW(ap,i) < IM_LEN(out,1))
+			call amovkr (Memr[outdata+DC_NW(ap,i)-1],
+			    Memr[outdata+DC_NW(ap,i)],IM_LEN(out,1)-DC_NW(ap,i))
+		}
+	    }
+	    call smw_ctfree (cti)
+	    call smw_ctfree (cto)
+	    call smw_saveim (mwout, out)
+	    call smw_close (mwout)
+	}
+
+	# Save REFSPEC keywords if present.
+	call dc_refspec (out)
+ 
+	# Finish up.  Replace input by output if needed.
+	if (out == in) {
+	    call imunmap (in)
+	} else {
+	    call imunmap (in)
+	    call imunmap (out)
+	    if (streq (input, output)) {
+		call imdelete (input)
+		call imrename (Memc[temp], output)
+	    }
+	}
+ 
+	call sfree (sp)
+end
+ 
+ 
+# DC_GLOBAL1 -- Set global wavelength parameters using the minimum and
+# maximum wavelengths and and the minimum dispersion over all apertures.
+ 
+procedure dc_global1 (in, stp, log, table, naps)
+ 
+pointer	in			# Input list
+pointer	stp			# Symbol table
+bool	log			# Logarithmic scale?
+pointer	table			# Wavelength table
+int	naps			# Number of apertures
+ 
+int	i, nwmax, imtgetim()
+double	w1, w2, dw, wmin, wmax, dwmin
+pointer	sp, input, str, im, mw, ap, tbl, immap(), smw_openim()
+errchk	dc_gms, dc_gec, smw_openim
+ 
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Go through all the reference spectra and determine the
+	# minimum and maximum wavelengths and maximum number of pixels.
+	# If there is no entry in the wavelength table add it.
+
+	wmin = MAX_REAL
+	wmax = -MAX_REAL
+	dwmin = MAX_REAL
+
+	while (imtgetim (in, Memc[input], SZ_FNAME) != EOF) {
+	    iferr (im = immap (Memc[input], READ_ONLY, 0))
+		next
+	    mw = smw_openim (im)
+	    switch (SMW_FORMAT(mw)) {
+	    case SMW_ND:
+		nwmax = SMW_NW(mw)
+		dw = SMW_DW(mw)
+		w1 = SMW_W1(mw)
+		w2 = w1 + dw * (nwmax - 1)
+		wmin = min (wmin, w1, w2)
+		wmax = max (wmax, w1, w2)
+		dwmin = min (dwmin, abs (dw))
+	    default:
+		iferr {
+		    iferr (call dc_gms (Memc[input], im, mw, stp, NO, ap,
+			NULL, NULL)) {
+			iferr (call dc_gec (Memc[input], im, mw, stp, ap,
+			    NULL, NULL)) {
+			    call sprintf (Memc[str], SZ_LINE,
+				"%s: Dispersion data not found")
+				call pargstr (Memc[input])
+			    call error (1, Memc[str])
+			}
+		    }
+     
+		    do i = 1, IM_LEN(im,2) {
+			w1 = DC_W1(ap,i)
+			w2 = DC_W2(ap,i)
+			dw = DC_DW(ap,i)
+			wmin = min (wmin, w1, w2)
+			wmax = max (wmax, w1, w2)
+			dwmin = min (dwmin, abs (dw))
+		    }
+		} then
+		    ;
+	    }
+
+	    call mfree (ap, TY_STRUCT)
+	    call smw_close (mw)
+	    call imunmap (im)
+	}
+	call imtrew (in)
+
+	nwmax = (wmax - wmin) / dwmin + 1.5
+ 
+	# Enter the global entry in the first table entry.
+	tbl = Memi[table]
+	call dc_defaults (wmin, wmax, nwmax,
+	    TBL_W1(tbl), TBL_W2(tbl), TBL_DW(tbl), TBL_NW(tbl))
+ 
+	call sfree (sp)
+end
+ 
+ 
+# DC_GLOBAL -- Set global wavelength parameters.  This is done for each
+# aperture separately.  The wavelength table may be used to specify separate
+# fixed parameters for each aperture.
+ 
+procedure dc_global (in, stp, log, table, naps)
+ 
+pointer	in			# Input list
+pointer	stp			# Symbol table
+bool	log			# Logarithmic scale?
+pointer	table			# Wavelength table
+int	naps			# Number of apertures
+ 
+int	i, j, nw, imtgetim()
+double	w1, w2, dw
+pointer	sp, input, str, im, mw, ap, tbl, immap(), smw_openim()
+errchk	dc_gms, dc_gec, smw_openim
+ 
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Go through all the reference spectra and determine the
+	# minimum and maximum wavelengths and maximum number of pixels.
+	# Do this by aperture.  If there is no entry in the wavelength
+	# table add it.
+ 
+	while (imtgetim (in, Memc[input], SZ_FNAME) != EOF) {
+	    iferr (im = immap (Memc[input], READ_ONLY, 0))
+		next
+	    mw = smw_openim (im)
+	    switch (SMW_FORMAT(mw)) {
+	    case SMW_ND:
+		tbl = Memi[table]
+		nw = SMW_NW(mw)
+		dw = SMW_DW(mw)
+		w1 = SMW_W1(mw)
+		w2 = w1 + dw * (nw - 1)
+		TBL_WMIN(tbl) = min (TBL_WMIN(tbl), w1, w2)
+		TBL_WMAX(tbl) = max (TBL_WMAX(tbl), w1, w2)
+		TBL_NWMAX(tbl) = max (TBL_NWMAX(tbl), nw)
+	    default:
+		iferr {
+		    iferr (call dc_gms (Memc[input], im, mw, stp, NO, ap,
+			NULL, NULL)) {
+			iferr (call dc_gec (Memc[input], im, mw, stp, ap,
+			    NULL, NULL)) {
+			    call sprintf (Memc[str], SZ_LINE,
+				"%s: Dispersion data not found")
+				call pargstr (Memc[input])
+			    call error (1, Memc[str])
+			}
+		    }
+     
+		    do i = 1, IM_LEN(im,2) {
+			call dc_getentry (false, DC_AP(ap,i), table, naps, j)
+			tbl = Memi[table+j]
+	 
+			nw = DC_NW(ap,i)
+			w1 = DC_W1(ap,i)
+			w2 = DC_W2(ap,i)
+			TBL_WMIN(tbl) = min (TBL_WMIN(tbl), w1, w2)
+			TBL_WMAX(tbl) = max (TBL_WMAX(tbl), w1, w2)
+			TBL_NWMAX(tbl) = max (TBL_NWMAX(tbl), nw)
+		    }
+		} then
+		    ;
+	    }
+
+	    call mfree (ap, TY_STRUCT)
+	    call smw_close (mw)
+	    call imunmap (im)
+	}
+	call imtrew (in)
+ 
+	do i = 0, naps {
+	    tbl = Memi[table+i]
+	    call dc_defaults (TBL_WMIN(tbl), TBL_WMAX(tbl), TBL_NWMAX(tbl),
+		TBL_W1(tbl), TBL_W2(tbl), TBL_DW(tbl), TBL_NW(tbl))
+	}
+
+	call sfree (sp)
+end
+ 
+
+# DC_WAVELENGTHS1 -- Set output wavelength parameters for a spectrum.
+# Fill in any INDEF values using the limits of the dispersion function
+# over all apertures and the minimum dispersion over all apertures.  The
+# user may then confirm and change the wavelength parameters if desired.
+ 
+procedure dc_wavelengths1 (im, smw, ap, output, log, table, naps, w1, w2, dw,nw)
+ 
+pointer	im		# IMIO pointer
+pointer	smw		# SMW pointer
+pointer	ap		# Aperture structure
+char	output[ARB]	# Output image name
+bool	log		# Logarithm wavelength parameters?
+pointer	table		# Wavelength table
+int	naps		# Number of apertures
+double	w1, w2, dw	# Image wavelength parameters
+int	nw		# Image wavelength parameter
+ 
+int	i, n, nwt, clgeti(), clgwrd()
+double	a, b, c, w1t, w2t, dwt, y1, y2, dy, clgetd()
+pointer	sp, key, str, tbl
+bool	clgetb()
+ 
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Get aperture parameters.
+	tbl = Memi[table]
+	w1t = TBL_W1(tbl)
+	w2t = TBL_W2(tbl)
+	dwt = TBL_DW(tbl)
+	nwt = TBL_NW(tbl)
+ 
+	# If there are undefined wavelength scale parameters get
+	# defaults based on the reference spectrum.
+ 
+	if (IS_INDEFD(w1t)||IS_INDEFD(w2t)||IS_INDEFD(dwt)||IS_INDEFD(nwt)) {
+	    a = MAX_REAL
+	    b = -MAX_REAL
+	    c = MAX_REAL
+ 
+	    do i = 1, IM_LEN(im,2) {
+		n = DC_NW(ap,i)
+		y1 = DC_W1(ap,i)
+		y2 = DC_W2(ap,i)
+		dy = DC_DW(ap,i)
+		a = min (a, y1, y2)
+		b = max (b, y1, y2)
+		c = min (c, dy)
+	    }
+	    n = (b - a) / c + 1.5
+	}
+ 
+	call dc_defaults (a, b, n, w1t, w2t, dwt, nwt)
+	w1 = w1t
+	w2 = w2t
+	dw = dwt
+	nw = nwt
+ 
+	# Print the wavelength scale and allow the user to confirm and
+	# change the wavelength scale.  A test is done to check which
+	# parameters the user changes and give them priority in filling
+	# in the remaining parameters.
+ 
+	if (TBL_CONFIRM(tbl) == YES) {
+	    repeat {
+		call printf ("%s: w1 = %g, w2 = %g, dw = %g, nw = %d\n")
+		    call pargstr (output)
+		    call pargd (w1)
+		    call pargd (w2)
+		    call pargd (dw)
+		    call pargi (nw)
+ 
+		i = clgwrd ("dispcor1.change", Memc[str],SZ_LINE, "|yes|no|NO|")
+		switch (i) {
+		case 2:
+		    break
+		case 3:
+		    TBL_CONFIRM(tbl) = NO
+		    break
+		}
+		call clputd ("dispcor1.w1", w1)
+		call clputd ("dispcor1.w2", w2)
+		call clputd ("dispcor1.dw", dw)
+		call clputi ("dispcor1.nw", nw)
+		a = w1
+		b = w2
+		c = dw
+		n = nw
+		w1 = clgetd ("dispcor1.w1")
+		w2 = clgetd ("dispcor1.w2")
+		dw = clgetd ("dispcor1.dw")
+		nw = clgeti ("dispcor1.nw")
+ 
+		# If no INDEF's set unchanged parameters to INDEF.
+		i = 0
+		if (IS_INDEFD(w1))
+		    i = i + 1
+		if (IS_INDEFD(w2))
+		    i = i + 1
+		if (IS_INDEFD(dw))
+		    i = i + 1
+		if (IS_INDEFI(nw))
+		    i = i + 1
+		if (i == 0) {
+		    if (w1 == a)
+		        w1 = INDEFD
+		    if (w2 == b)
+		        w2 = INDEFD
+		    if (dw == c)
+		        dw = INDEFD
+		    if (nw == n)
+		        nw = INDEFI
+		}
+ 
+	        call dc_defaults (a, b, n, w1, w2, dw, nw)
+ 
+		if (clgetb ("global")) {
+		    TBL_W1(tbl) = w1
+		    TBL_W2(tbl) = w2
+		    TBL_DW(tbl) = dw
+		    TBL_NW(tbl) = nw
+		}
+	    }
+	}
+	call sfree (sp)
+end
+ 
+ 
+# DC_WAVELENGTHS -- Set output wavelength parameters for a spectrum for
+# each aperture.  The fixed parameters are given in the wavelength table.
+# If there is no entry in the table for an aperture use the global
+# default (entry 0).  Fill in INDEF values using the limits and number
+# of pixels for the aperture.  The user may then confirm and change the
+# wavelength parameters if desired.
+ 
+procedure dc_wavelengths (im, ap, output, log, table, naps, line, apnum,
+	w1, w2, dw, nw)
+ 
+pointer	im		# IMIO pointer
+pointer	ap		# Aperture structure
+char	output[ARB]	# Output image name
+bool	log		# Logarithm wavelength parameters?
+pointer	table		# Wavelength table
+int	naps		# Number of apertures
+int	line		# Line
+int	apnum		# Aperture number
+double	w1, w2, dw	# Image wavelength parameters
+int	nw		# Image wavelength parameter
+ 
+int	i, n, nwt, clgeti(), clgwrd()
+double	a, b, c, w1t, w2t, dwt, clgetd()
+pointer	sp, str, tbl
+bool	clgetb()
+ 
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Get aperture parameters.
+	call dc_getentry (false, apnum, table, naps, i)
+	tbl = Memi[table+i]
+ 
+	w1t = TBL_W1(tbl)
+	w2t = TBL_W2(tbl)
+	dwt = TBL_DW(tbl)
+	nwt = TBL_NW(tbl)
+ 
+	# If there are undefined wavelength scale parameters get
+	# defaults based on the reference spectrum.
+ 
+	if (IS_INDEFD(w1t)||IS_INDEFD(w2t)||IS_INDEFD(dwt)||IS_INDEFI(nwt)) {
+	    a = DC_W1(ap,line)
+	    b = DC_W2(ap,line)
+	    n = DC_NW(ap,line)
+	}
+ 
+	call dc_defaults (a, b, n, w1t, w2t, dwt, nwt)
+	w1 = w1t
+	w2 = w2t
+	dw = dwt
+	nw = nwt
+ 
+	# Print the wavelength scale and allow the user to confirm and
+	# change the wavelength scale.  A test is done to check which
+	# parameters the user changes and give them priority in filling
+	# in the remaining parameters.
+ 
+	if (TBL_CONFIRM(tbl) == YES) {
+	    repeat {
+		call printf (
+		    "%s: ap = %d, w1 = %g, w2 = %g, dw = %g, nw = %d\n")
+		    call pargstr (output)
+		    call pargi (apnum)
+		    call pargd (w1)
+		    call pargd (w2)
+		    call pargd (dw)
+		    call pargi (nw)
+		i = clgwrd ("dispcor1.change", Memc[str],SZ_LINE, "|yes|no|NO|")
+		switch (i) {
+		case 2:
+		    break
+		case 3:
+		    TBL_CONFIRM(tbl) = NO
+		    break
+		}
+		call clputd ("dispcor1.w1", w1)
+		call clputd ("dispcor1.w2", w2)
+		call clputd ("dispcor1.dw", dw)
+		call clputi ("dispcor1.nw", nw)
+		a = w1
+		b = w2
+		c = dw
+		n = nw
+		w1 = clgetd ("dispcor1.w1")
+		w2 = clgetd ("dispcor1.w2")
+		dw = clgetd ("dispcor1.dw")
+		nw = clgeti ("dispcor1.nw")
+ 
+		# If no INDEF's set unchanged parameters to INDEF.
+		i = 0
+		if (IS_INDEFD(w1))
+		    i = i + 1
+		if (IS_INDEFD(w2))
+		    i = i + 1
+		if (IS_INDEFD(dw))
+		    i = i + 1
+		if (IS_INDEFI(nw))
+		    i = i + 1
+		if (i == 0) {
+		    if (w1 == a)
+		        w1 = INDEFD
+		    if (w2 == b)
+		        w2 = INDEFD
+		    if (dw == c)
+		        dw = INDEFD
+		    if (nw == n)
+		        nw = INDEFI
+		}
+ 
+	        call dc_defaults (a, b, n, w1, w2, dw, nw)
+ 
+		if (clgetb ("global")) {
+		    TBL_W1(tbl) = w1
+		    TBL_W2(tbl) = w2
+		    TBL_DW(tbl) = dw
+		    TBL_NW(tbl) = nw
+		}
+	    }
+	}
+	call sfree (sp)
+end
+
+
+# DC_DEFAULTS -- Given some set of wavelength scale with others undefined
+# (INDEF) plus some defaults fill in the undefined parameters and make
+# the wavelength scale consistent.  The logic of this task is complex
+# and is meant to provide an "intelligent" result based on what users
+# want.
+
+procedure dc_defaults (a, b, n, w1, w2, dw, nw)
+
+double	a		# Default wavelength endpoint
+double	b		# Default wavelength endpoint
+int	n		# Default number of pixels
+double	w1		# Starting wavelength
+double	w2		# Ending wavelength
+double	dw		# Wavelength interval
+int	nw		# Number of pixels
+
+int	nindef
+
+begin
+	# Determine how many input parameters are specfied.
+	nindef = 0
+	if (IS_INDEFD(w1))
+	    nindef = nindef + 1
+	if (IS_INDEFD(w2))
+	    nindef = nindef + 1
+	if (IS_INDEFD(dw))
+	    nindef = nindef + 1
+	if (IS_INDEFI(nw))
+	    nindef = nindef + 1
+
+	# Depending on how many parameters are specified fill in the
+	# INDEF parameters.
+
+	switch (nindef) {
+	case 0:
+	    # All parameters specified.  First round NW to be consistent with
+	    # w1, w2, and dw.  Then adjust w2 to nearest pixel.  It is possible
+	    # that nw will be negative.  Checks for this should be made by the
+	    # call in program.
+
+	    nw = (w2 - w1) / dw + 1.5
+	    w2 = w1 + dw * (nw - 1)
+	case 1:
+	    # Find the unspecified parameter and compute it from the other
+	    # three specified parameters.  For nw need to adjust w2 to
+	    # agree with a pixel.
+
+	    if (IS_INDEFD(w1))
+		w1 = w2 - dw * (nw - 1)
+	    if (IS_INDEFD(w2))
+		w2 = w1 + dw * (nw - 1)
+	    if (IS_INDEFD(dw))
+		dw = (w2 - w1) / (nw - 1)
+	    if (IS_INDEFI(nw)) {
+	        nw = (w2 - w1) / dw + 1.5
+		w2 = w1 + dw * (nw - 1)
+	    }
+	case 2:
+	    # Fill in two unspecified parameters using the defaults.
+	    # This is tricky.
+
+	    if (IS_INDEFD(dw)) {
+		if (IS_INDEFD(w1)) {
+		    if (abs (w2 - a) > abs (w2 - b))
+			w1 = a
+		    else
+			w1 = b
+		    dw = (w2 - w1) / (nw - 1)
+		} else if (IS_INDEFD(w2)) {
+		    if (abs (w1 - a) > abs (w1 - b))
+			w2 = a
+		    else
+			w2 = b
+		    dw = (w2 - w1) / (nw - 1)
+		} else {
+		    dw = (b - a) / n
+		    nw = abs ((w2 - w1) / dw) + 1.5
+		    dw = (w2 - w1) / (nw - 1)
+		}
+	    } else if (IS_INDEFI(nw)) {
+		if (IS_INDEFD(w1)) {
+		    if (dw > 0.)
+			w1 = min (a, b)
+		    else
+			w1 = max (a, b)
+		    nw = (w2 - w1) / dw + 1.5
+		    w1 = w2 - dw * (nw - 1)
+		} else {
+		    if (dw > 0.)
+			w2 = max (a, b)
+		    else
+			w2 = min (a, b)
+		    nw = (w2 - w1) / dw + 1.5
+		    w2 = w1 + dw * (nw - 1)
+		}
+	    } else {
+		if (dw > 0.)
+		    w1 = min (a, b)
+		else
+		    w1 = max (a, b)
+		w2 = w1 + dw * (nw - 1)
+	    }
+	case 3:
+	    # Find the one specfied parameter and compute the others using
+	    # the supplied defaults.
+
+	    if (!IS_INDEFD(w1)) {
+		if (abs (w1 - a) > abs (w1 - b))
+		    w2 = a
+		else
+		    w2 = b
+		dw = (b - a) / n
+		nw = abs ((w2 - w1) / dw) + 1.5
+		dw = (w2 - w1) / (nw - 1)
+	    } else if (!IS_INDEFD(w2)) {
+		if (abs (w2 - a) > abs (w2 - b))
+		    w1 = a
+		else
+		    w1 = b
+		dw = (b - a) / n
+		nw = abs ((w2 - w1) / dw) + 1.5
+		dw = (w2 - w1) / (nw - 1)
+	    } else if (!IS_INDEFI(nw)) {
+		w1 = min (a, b)
+		w2 = max (a, b)
+	        dw = (w2 - w1) / (nw - 1)
+	    } else if (dw < 0.) {
+		w1 = max (a, b)
+		w2 = min (a, b)
+		nw = (w2 - w1) / dw + 1.5
+		w2 = w1 + dw * (nw - 1)
+	    } else {
+		w1 = min (a, b)
+		w2 = max (a, b)
+		nw = (w2 - w1) / dw + 1.5
+		w2 = w1 + dw * (nw - 1)
+	    }
+	case 4:
+	    # Given only defaults compute a wavelength scale.  The dispersion
+	    # is kept close to the default.
+	    w1 = min (a, b)
+	    w2 = max (a, b)
+	    dw = (b - a) / (n - 1)
+	    nw = abs ((w2 - w1) / dw) + 1.5
+	    dw = (w2 - w1) / (nw - 1)
+	}
+end
+
+
+# DC_LOG -- Print log of wavlength paramters
+
+procedure dc_log (fd, output, ap, naps, log)
+
+int	fd		# Output file descriptor
+char	output[ARB]	# Output image name
+pointer	ap		# Aperture structure
+int	naps		# Number of apertures
+bool	log		# Log dispersion?
+
+int	i
+
+begin
+	if (fd == NULL)
+	    return
+
+	for (i=2; i<=naps; i=i+1) {
+	    if (DC_W1(ap,i) != DC_W1(ap,1))
+		break
+	    if (DC_W2(ap,i) != DC_W2(ap,1))
+		break
+	    if (DC_DW(ap,i) != DC_DW(ap,1))
+		break
+	    if (DC_NW(ap,i) != DC_NW(ap,1))
+		break
+	}
+
+	if (naps == 1 || i <= naps) {
+	    do i = 1, naps {
+		call fprintf (fd,
+		    "%s: ap = %d, w1 = %8g, w2 = %8g, dw = %8g, nw = %d")
+		    call pargstr (output)
+		    call pargi (DC_AP(ap,i))
+		    call pargd (DC_W1(ap,i))
+		    call pargd (DC_W2(ap,i))
+		    call pargd (DC_DW(ap,i))
+		    call pargi (DC_NW(ap,i))
+		if (log) {
+		    call fprintf (fd, ", log = %b")
+			call pargb (log)
+		}
+		call fprintf (fd, "\n")
+	    }
+	} else {
+	    call fprintf (fd,
+		"%s: w1 = %8g, w2 = %8g, dw = %8g, nw = %d")
+		call pargstr (output)
+		call pargd (DC_W1(ap,1))
+		call pargd (DC_W2(ap,1))
+		call pargd (DC_DW(ap,1))
+		call pargi (DC_NW(ap,1))
+	    if (log) {
+		call fprintf (fd, ", log = %b")
+		    call pargb (log)
+	    }
+	    call fprintf (fd, "\n")
+	}
+	call flush (fd)
+end
+
+
+# DC_REFSPEC -- Save REFSPEC keywords in DCLOG keywords.
+
+procedure dc_refspec (im)
+
+pointer	im			#U IMIO pointer
+
+int	i, j, imaccf()
+pointer	sp, dckey, dcstr, refkey, refstr
+
+begin
+	call smark (sp)
+	call salloc (dckey, SZ_FNAME, TY_CHAR)
+	call salloc (dcstr, SZ_LINE, TY_CHAR)
+	call salloc (refkey, SZ_FNAME, TY_CHAR)
+	call salloc (refstr, SZ_LINE, TY_CHAR)
+
+	for (i=1;; i=i+1) {
+	    call sprintf (Memc[dckey], SZ_FNAME, "DCLOG%d")
+		call pargi (i)
+	    if (imaccf (im, Memc[dckey]) == NO)
+		break
+	}
+
+	do j = 1, 4 {
+	    if (j == 1)
+		call strcpy ("REFSPEC1", Memc[refkey], SZ_FNAME)
+	    else if (j == 2)
+		call strcpy ("REFSPEC2", Memc[refkey], SZ_FNAME)
+	    else if (j == 3)
+		call strcpy ("REFSHFT1", Memc[refkey], SZ_FNAME)
+	    else if (j == 4)
+		call strcpy ("REFSHFT2", Memc[refkey], SZ_FNAME)
+
+	    ifnoerr (call imgstr (im, Memc[refkey], Memc[refstr], SZ_LINE)) {
+		call sprintf (Memc[dckey], SZ_FNAME, "DCLOG%d")
+		    call pargi (i)
+		call sprintf (Memc[dcstr], SZ_LINE, "%s = %s")
+		    call pargstr (Memc[refkey])
+		    call pargstr (Memc[refstr])
+		call imastr (im, Memc[dckey], Memc[dcstr])
+		call imdelf (im, Memc[refkey])
+		i = i + 1
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor/t_disptrans.x b/noao/onedspec/dispcor/t_disptrans.x
new file mode 100644
index 00000000..ee108472
--- /dev/null
+++ b/noao/onedspec/dispcor/t_disptrans.x
@@ -0,0 +1,413 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math/curfit.h>
+include	<smw.h>
+include	<units.h>
+
+define	AIRVAC	"|none|air2vac|vac2air|"
+define	NONE	1		# No correction
+define	AIR2VAC	2		# Correct air to vacuum
+define	VAC2AIR	3		# Correct vacuum to air
+
+
+# T_DISPTRANS -- Tranform dispersion systems and apply air-vac conversion.
+# This task uses the UNITS package to convert the input dispersion
+# coordinates to the desired output coordinates.  An air to vacuum or
+# vacuum to air correction is made.  Since the input and output units
+# may not be linearly related and the MWCS supports only polynomial
+# representations a cubic splines are fit to the desired output coordinates
+# until an error tolerance is reached.  The user may then select to
+# store the new WCS as either the spline approximation or to linearize
+# the coordinates by resampling the data.  Note that if the input and
+# output units ARE linearly related and there is no air/vacuum conversion
+# then linearization or storing of a nonlinear dispersion function is
+# skipped.  The operations are done in double precision.
+
+procedure t_disptrans ()
+
+int	inlist			# List of input spectra
+int	outlist			# List of output spectra
+pointer	units			# Output dispersion units
+double	maxerr			# Maximum error (in pixels)
+bool	linearize		# Linearize ouptut dispersion?
+bool	verbose			# Verbose?
+
+int	air			# Air-vacuum conversion?
+double	t			# Temperture in degrees C
+double	p			# Pressure in mmHg
+double	f			# Water vapour pressure in mmHg
+
+int	i, j, n, nw, format, dtype, dtype1, axis[2]
+double	err, w1, dw
+pointer	ptr, in, out, mwin, mwout, ctin, ctout, sh, cv, inbuf, outbuf
+pointer	sp, input, output, title, coeff, x, y, w, nx
+
+bool	clgetb(), streq()
+int	clgwrd(), imtopenp(), imtgetim()
+double	clgetd(), shdr_lw(), dcveval()
+pointer	immap(), smw_openim(), smw_sctran(), mw_open(), imgl3r(), impl3r()
+errchk	immap, impl3r
+errchk	smw_openim, smw_gwattrs, shdr_open, mw_open
+errchk	dt_airvac, dt_cvfit, dt_setwcs, dispcor
+
+data	axis/1,2/
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (units, SZ_FNAME, TY_CHAR)
+	call salloc (title, SZ_LINE, TY_CHAR)
+	coeff = NULL
+
+	# Parameters
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	call clgstr ("units", Memc[units], SZ_FNAME)
+	maxerr = clgetd ("error")
+	linearize = clgetb ("linearize")
+	verbose = clgetb ("verbose")
+	air = clgwrd ("air", Memc[input], SZ_FNAME, AIRVAC)
+	t = clgetd ("t")
+	p = clgetd ("p")
+	f = clgetd ("f")
+
+	# Loop over input images.
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    iferr {
+		in = NULL
+		out = NULL
+		mwin = NULL
+		mwout = NULL
+		ctin = NULL
+		ctout = NULL
+		sh = NULL
+		cv = NULL
+
+		# Open input and output images and wcs.
+		if (streq (Memc[input], Memc[output]))
+		    ptr = immap (Memc[input], READ_WRITE, 0)
+		else
+		    ptr = immap (Memc[input], READ_ONLY, 0)
+		in = ptr
+
+		if (streq (Memc[input], Memc[output]))
+		    ptr = in
+		else
+		    ptr = immap (Memc[output], NEW_COPY, in)
+		out = ptr
+
+		ptr = smw_openim (in); mwin = ptr
+		format = SMW_FORMAT(mwin)
+		switch (format) {
+		case SMW_ND:
+		    call error (1,
+			"DISPTRANS does not apply to 2D and 3D images")
+		case SMW_ES:
+		    call smw_esms (mwin)
+		}
+
+		if (IM_NDIM(out) == 3 && IM_LEN(out,3) == 1)
+		    IM_NDIM(out) = 2
+		i = max (2, IM_NDIM(out))
+		ptr = mw_open (NULL, i); mwout = ptr
+		call mw_newsystem (mwout, "multispec", i)
+		call mw_swtype (mwout, axis, 2, "multispec", "")
+		if (i == 3)
+		    call mw_swtype (mwout, 3, 1, "linear", "")
+		call smw_open (mwout, NULL, out)
+		    
+		# Allocate and set arrays.
+		call malloc (x, SMW_LLEN(mwin,1), TY_DOUBLE)
+		call malloc (y, SMW_LLEN(mwin,1), TY_DOUBLE)
+		call malloc (w, SMW_LLEN(mwin,1), TY_DOUBLE)
+		call malloc (nx, SMW_NSPEC(mwin), TY_INT)
+		do i = 1, SMW_LLEN(mwin,1)
+		    Memd[x+i-1] = i
+
+		# Set the output MWCS dispersion function.
+		# Only compute new coordinates once if possible.
+
+		dtype = DCLINEAR
+		do i = 1, SMW_NSPEC(mwin) {
+		    if (format == SMW_MS || i == 1) {
+			call shdr_open (in, mwin, i, 1, INDEFI, SHDATA, sh)
+			call shdr_units (sh, Memc[units])
+			n = SN(sh)
+			do j = 1, n
+			    Memd[y+j-1] = shdr_lw (sh, Memd[x+j-1])
+			call dt_airvac (sh, Memd[y], n, air, t, p, f)
+
+			# Fit dispersion function.
+			dtype1 = DCLINEAR
+			call dt_cvfit (cv, CHEBYSHEV, 2, Memd[x], Memd[y],
+			    Memd[w], n, err)
+			if (err > maxerr) {
+			    dtype1 = DCFUNC
+			    do j = 1, n-4 {
+				call dt_cvfit (cv, SPLINE3, j, Memd[x],
+				    Memd[y], Memd[w], n, err)
+				if (err <= maxerr)
+				    break
+			    }
+			}
+
+			w1 = dcveval (cv, 1D0)
+			dw = (dcveval (cv, double(n)) - w1) / (n - 1)
+		    }
+		    if (linearize) {
+			call dt_setwcs (cv, mwin, mwin, i, dtype1, w1, dw)
+			call dt_setwcs (cv, mwin, mwout, i, DCLINEAR, w1, dw)
+			if (dtype1 != DCLINEAR)
+			    dtype = dtype1
+		    } else
+			call dt_setwcs (cv, mwin, mwout, i, dtype1, w1, dw)
+		    Memi[nx+i-1] = n
+		}
+		call dcvfree (cv)
+
+		# Set label and units.  The check on unit class is done
+		# so that if not a velocity the dictionary expansion
+		# unit is used.  However for velocity the units do not
+		# include the reference coordinate so the user string
+		# is used.
+
+		call mw_swattrs (SMW_MW(mwout,0), 1, "label", LABEL(sh))
+		if (UN_CLASS(UN(sh)) != UN_VEL) {
+		    call mw_swattrs (SMW_MW(mwout,0), 1, "units", UNITS(sh))
+		    call mw_swattrs (SMW_MW(mwout,0), 1, "units_display",
+			UNITS(sh))
+		} else {
+		    call mw_swattrs (SMW_MW(mwout,0), 1, "units", Memc[units])
+		    call mw_swattrs (SMW_MW(mwout,0), 1, "units_display",
+			Memc[units])
+		}
+
+		# Linearize or copy the pixels as requested.
+		if (linearize && dtype != DCLINEAR) {
+		    ptr = smw_sctran (mwin, "world", "logical", 3); ctin = ptr
+		    ptr = smw_sctran (mwout, "logical", "world", 3); ctout = ptr
+		    n = IM_LEN(in,1)
+		    do j = 1, IM_LEN(out,3) {
+			do i = 1, IM_LEN(out,2) {
+			    nw = Memi[nx+i-1]
+			    inbuf = imgl3r (in, i, j)
+			    outbuf = impl3r (out, i, j)
+			    call dispcor (ctin, i, ctout, i, Memr[inbuf], n,
+				Memr[outbuf], nw, NO)
+			    if (nw < n)
+				call amovkr (Memr[outbuf+nw-1], Memr[outbuf+nw],
+				    n-nw)
+			}
+		    }
+		    call smw_ctfree (ctin)
+		    call smw_ctfree (ctout)
+		} else if (in != out) {
+		    n = IM_LEN(in,1)
+		    do j = 1, IM_LEN(out,3) {
+			do i = 1, IM_LEN(out,2) {
+			    inbuf = imgl3r (in, i, j)
+			    outbuf = impl3r (out, i, j)
+			    call amovr (Memr[inbuf], Memr[outbuf], n)
+			}
+		    }
+		}
+
+		# Verbose output
+		if (verbose) {
+		    call printf ("%s: Dispersion transformed to %s")
+			call pargstr (Memc[output])
+			call pargstr (UNITS(sh))
+		    switch (air) {
+		    case 1:
+			call printf (".\n")
+		    case 2:
+			call printf (" in vacuum with\n")
+			call printf (
+			    "  t = %.4g C, p = %.6g mmHg, f = %.4g mmHg.\n")
+			    call pargd (t)
+			    call pargd (p)
+			    call pargd (f)
+		    case 3:
+			call printf (" in air with\n")
+			call printf (
+			    "  t = %.4g C, p = %.6g mmHg, f = %.4g mmHg.\n")
+			    call pargd (t)
+			    call pargd (p)
+			    call pargd (f)
+		    }
+		    call flush (STDOUT)
+		}
+
+	    } then {
+		if (out != NULL && out != in) {
+		    call imunmap (out)
+		    call imdelete (Memc[output])
+		}
+		call erract (EA_WARN)
+	    }
+
+	    # Finish up.
+	    call mfree (x, TY_DOUBLE)
+	    call mfree (y, TY_DOUBLE)
+	    call mfree (w, TY_DOUBLE)
+	    call mfree (nx, TY_INT)
+	    if (mwout != NULL && out != NULL)
+		call smw_saveim (mwout, out)
+	    if (sh != NULL)
+		call shdr_close (sh)
+	    if (ctin != NULL)
+		call smw_ctfree (ctin)
+	    if (ctout != NULL)
+		call smw_ctfree (ctout)
+	    if (mwin != NULL)
+		call smw_close (mwin)
+	    if (mwout != NULL)
+		call smw_close (mwout)
+	    if (out != NULL && out != in)
+		call imunmap (out)
+	    if (in != NULL)
+		call imunmap (in)
+	}
+
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# DT_AIRVAC -- Convert dispersion coordinates to air or vacuum values.
+# The coordinates are first transformed to microns since that is what
+# the formulas expect.  After correction they are transformed back to the
+# original units.  The index of refraction formulas used are from
+# Allen's Astrophysical Quantities (1973).
+
+procedure dt_airvac (sh, x, n, air, t, p, f)
+
+pointer	sh		#I Spectrum pointer
+double	x[n]		#U Dispersion vector
+int	n		#I Number of pixels
+int	air		#I Correction type
+double	t		#I Temperture in deg C
+double	p		#I Total pressure in mmHg
+double	f		#I Water vapour pressure in mmHg
+
+int	i
+double	x2, a
+pointer	un, un_open()
+errchk	un_open, un_ctrand
+
+begin
+	if (air == NONE)
+	    return
+
+	un = un_open ("microns")
+	call un_ctrand (UN(sh), un, x, x, n)
+	do i = 1, n {
+	    x2 = 1 / x[i] **2
+	    a = 64.328 + 29498.1 / (146 - x2) + 255.4 / (41 - x2)
+	    a = a * p * (1 + (1.049 - 0.0157 * t) * 1e-6 * p) /
+		(720.883 * (1 + 0.003661 * t))
+	    a = a - (0.0624 - 0.000680 * x2) / (1 + 0.003661 * t) * f
+	    a = 1 + a / 1e6
+	    switch (air) {
+	    case AIR2VAC:
+		x[i] = a * x[i]
+	    case VAC2AIR:
+		x[i] = x[i] / a
+	    }
+	}
+	call un_ctrand (un, UN(sh), x, x, n)
+	call un_close (un)
+end
+
+
+# DT_CVFIT -- Fit a dispersion function and return the curfit pointer and
+# maximum error in pixels.
+
+procedure dt_cvfit (cv, func, order, x, y, w, n, maxerr)
+
+pointer	cv		#O Fitted dispersion function
+int	func		#I Dispersion function type
+int	order		#I Dispersion function order
+double	x[n]		#I Pixel coordinates
+double	y[n]		#I Desired world coordinates
+double	w[n]		#O Errors in pixels
+int	n		#I Number of pixels
+double	maxerr		#O Maximum error
+
+int	i
+double	minerr, dcveval()
+
+begin
+	if (cv != NULL)
+	    call dcvfree (cv)
+	call dcvinit (cv, func, order, x[1], x[n])
+	call dcvfit (cv, x, y, w, n, WTS_UNIFORM, i)
+	do i = 2, n-1
+	    w[i] = abs ((y[i] - dcveval (cv, x[i])) / ((y[i+1] - y[i-1]) / 2))
+	w[1] = abs ((y[1] - dcveval (cv, x[1])) / (y[2] - y[1]))
+	w[n] = abs ((y[n] - dcveval (cv, x[n])) / (y[n] - y[n-1]))
+	call alimd (w, n, minerr, maxerr)
+end
+
+
+# DT_SETWCS -- Set the multispec WCS.  If the type is nonlinear then
+# the fitted function is stored.
+
+procedure dt_setwcs (cv, mwin, mwout, l, dtype, w1, dw)
+
+pointer	cv		#I Dispersion function
+pointer mwin		#I Input SMW pointer
+pointer mwout		#I Output, SMW pointer
+int	l		#I Image line
+int	dtype		#I Dispersion function type
+double	w1		#I Coordinate of first pixel
+double	dw		#I Coordinate interval at first physical pixel
+
+int	i, ap, bm, dt, nw, n, fd, dcvstati(), stropen()
+double	a, b, z, lw, up
+pointer	sp, title, coeff, coeffs
+
+begin
+	call smark (sp)
+	call salloc (title, SZ_LINE, TY_CHAR)
+
+	coeff = NULL
+	call smw_gwattrs (mwin, l, 1, ap, bm, dt, a, b, nw, z, lw, up, coeff)
+	call smw_gapid (mwin, l, 1, Memc[title], SZ_LINE)
+
+	switch (dtype) {
+	case DCFUNC:
+	    n = dcvstati (cv, CVNSAVE)
+	    call malloc (coeffs, n, TY_DOUBLE)
+	    call dcvsave (cv, Memd[coeffs])
+	    call realloc (coeff, 20*(n+2), TY_CHAR)
+	    fd = stropen (Memc[coeff], 20*(n+2), NEW_FILE)
+	    call fprintf (fd, "1 0 %d %d")
+	    call pargi (nint (Memd[coeffs]))
+	    call pargi (nint (Memd[coeffs+1]))
+	    do i = 2, n-1 {
+		call fprintf (fd, " %g")
+		    call pargd (Memd[coeffs+i])
+	    }
+	    call close (fd)
+	    call mfree (coeffs, TY_DOUBLE)
+	default:
+	    Memc[coeff] = EOS
+	}
+	dt = dtype
+	a = w1
+	b = dw
+	z = 0.
+	call smw_swattrs (mwout, l, 1, ap, bm, dt, a, b, nw, z, lw, up,
+	    Memc[coeff])
+	call smw_sapid (mwout, l, 1, Memc[title])
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/dispcor1.par b/noao/onedspec/dispcor1.par
new file mode 100644
index 00000000..633ae4ca
--- /dev/null
+++ b/noao/onedspec/dispcor1.par
@@ -0,0 +1,5 @@
+change,s,q,,"yes|no|NO",,"  Change wavelength coordinate assignments?"
+w1,r,q,,,,"  Starting wavelength"
+w2,r,q,,,,"  Ending wavelength"
+dw,r,q,,,,"  Wavelength interval per pixel"
+nw,i,q,,,,"  Number of output pixels"
diff --git a/noao/onedspec/disptrans.par b/noao/onedspec/disptrans.par
new file mode 100644
index 00000000..1c40c895
--- /dev/null
+++ b/noao/onedspec/disptrans.par
@@ -0,0 +1,12 @@
+input,s,a,,,,Input spectra
+output,s,a,,,,Output spectra
+units,s,a,,,,Output dispersion units
+error,r,h,0.01,1E-6,,Maximum output coordinate error in pixels
+linearize,b,h,no,,,Resample the output to linear dispersion intervals?
+verbose,b,h,yes,,,"Print log of transformations?
+
+# AIR/VACUUM CONVERSION"
+air,s,h,"none","none|air2vac|vac2air",,Air-vacuum conversion?
+t,r,h,15.,,,Temperture in degrees C
+p,r,h,760,,,Pressure in mmHg
+f,r,h,4,,,Water vapour pressure in mmHg
diff --git a/noao/onedspec/doc/aidpars.hlp b/noao/onedspec/doc/aidpars.hlp
new file mode 100644
index 00000000..be846306
--- /dev/null
+++ b/noao/onedspec/doc/aidpars.hlp
@@ -0,0 +1,563 @@
+.help aidpars Jan04 noao.onedspec
+.ih
+NAME
+aidpars -- Automatic line identification parameters and algorithm
+.ih
+SUMMARY
+The automatic line identification parameters and algorithm used in
+\fBautoidentify\fR, \fBidentify\fR, and \fBreidentify\fR are described.
+.ih
+USAGE
+aidpars
+.ih
+PARAMETERS
+.ls reflist = ""
+Optional reference coordinate list to use in the pattern matching algorithm
+in place of the task coordinate list.  This file is a simple text list of
+dispersion coordinates.  It would normally be a culled and limited list of
+lines for the specific data being identified.
+.le
+.ls refspec = ""
+Optional reference dispersion calibrated spectrum.  This template spectrum
+is used to select the prominent lines for the pattern matching algorithm.
+It need not have the same dispersion increment or dispersion coverage as
+the target spectrum.
+.le
+.ls crpix = "INDEF"
+Coordinate reference pixel for the coordinate reference value specified by
+the \fIcrval\fR parameter.  This may be specified as a pixel coordinate
+or an image header keyword name (with or without a '!' prefix).  In the
+latter case the value of the keyword in the image header of the spectrum
+being identified is used.  A value of INDEF translates to the middle of
+the target spectrum.
+.le
+.ls crquad = INDEF
+Quadratic correction to the detected pixel positions to "linearize" the
+pattern of line spacings.  The corrected positions x' are derived from
+the measured positions x by
+
+.nf
+    x' = x + crquad * (x - crpix)**2
+.fi
+
+where crpix is the pixel reference point as defined by the \fIcrpix\fR
+parameter.  The measured and corrected positions may be examined by
+using the 't' debug flag.  The value may be a number or a header
+keyword (with or without a '!' prefix).  The default of INDEF translates
+to zero; i.e. no quadratic correction.
+.le
+.ls cddir = "sign" (unknown|sign|increasing|decreasing)
+The sense of the dispersion increment with respect to the pixel coordinates
+in the input spectrum.  The possible values are "increasing" or
+"decreasing" if the dispersion coordinates increase or decrease with
+increasing pixel coordinates, "sign" to use the sign of the dispersion
+increment (positive is increasing and negative is decreasing), and
+"unknown" if the sense is unknown and to be determined by the algorithm.
+.le
+.ls crsearch = "INDEF"
+Coordinate reference value search radius.  The value may be specified
+as a numerical value or as an image header keyword (with or without
+a '!' prefix) whose value is to be used.  The algorithm will search
+for a final coordinate reference value within this amount of the value
+specified by \fIcrval\fR.  If the value is positive the search radius is
+the specified value.  If the value is negative it is the absolute value
+of this parameter times \fIcdelt\fR times the number of pixels in the
+input spectrum; i.e. it is the fraction of dispersion range covered by the
+target spectrum assuming a dispersion increment per pixel of \fIcdelt\fR.
+A value of INDEF translates to -0.1 which corresponds to a search radius
+of 10% of the estimated dispersion range.
+.le
+.ls cdsearch = "INDEF"
+Dispersion coordinate increment search radius.  The value may be specified
+as a numerical value or as an image header keyword (with or without
+a '!' prefix) whose value is to be used.  The algorithm will search
+for a dispersion coordinate increment within this amount of the value
+specified by \fIcdelt\fR.  If the value is positive the search radius is
+the specified value.  If the value is negative it is the absolute value of
+this parameter times \fIcdelt\fR; i.e.  it is a fraction of \fIcdelt\fR.
+A value of INDEF translates to -0.1 which corresponds to a search radius
+of 10% of \fIcdelt\fR.
+.le
+.ls ntarget = 100
+Number of spectral lines from the target spectrum to use in the pattern
+matching.
+.le
+.ls npattern = 5
+Initial number of spectral lines in patterns to be matched.  There is a
+minimum of 3 and a maximum of 10.  The algorithm starts with the specified
+number and if no solution is found with that number it is iteratively
+decreased by one to the minimum of 3.  A larger number yields fewer
+and more likely candidate matches and so will produce a result sooner.
+But in order to be thorough the algorithm will try smaller patterns to
+search more possiblities.
+.le
+.ls nneighbors = 10
+Number of neighbors to use in making patterns of lines.  This parameter
+restricts patterns to include lines which are near each other.
+.le
+.ls nbins = 6
+Maximum number of bins to divide the reference coordinate list or spectrum
+in searching for a solution.  When there are no weak dispersion constraints
+the algorithm subdivides the full range of the coordinate list or reference
+spectrum into one bin, two bins, etc. up to this maximum.  Each bin is
+searched for a solution.
+.le
+.ls ndmax = 1000
+Maximum number of candidate dispersions to examine.  The algorithm ranks
+candidate dispersions by how many candidate spectral lines are fit and the
+the weights assigned by the pattern matching algorithm.  Starting from
+the highest rank it tests each candidate dispersion to see if it is
+a satisfactory solution.  This parameter determines how many candidate
+dispersion in the ranked list are examined.
+.le
+.ls aidord = 3 (minimum of 2)
+The order of the dispersion function fit by the automatic identification
+algorithm.  This is the number of polynomial coefficients so
+a value of two is a linear function and a value of three is a quadratic
+function.  The order should be restricted to values of two or three.
+Higher orders can lead to incorrect solutions because of the increased
+degrees of freedom if finding incorrect line identifications.
+.le
+.ls maxnl = 0.02
+Maximum non-linearity allowed in any trial dispersion function.
+The definition of the non-linearity test is
+
+.nf
+    maxnl > (w(0.5) - w(0)) / (w(1) - w(0)) - 0.5
+.fi
+
+where w(x) is the dispersion function value (e.g. wavelength) of the fit
+and x is a normalized pixel positions where the endpoints of the spectrum
+are [0,1].  If the test fails on a trial dispersion fit then a linear
+function is determined.
+.le
+.ls nfound = 6
+Minimum number of identified spectral lines required in the final solution.
+If a candidate solution has fewer identified lines it is rejected.
+.le
+.ls sigma = 0.05
+Sigma (uncertainty) in the line center estimates specified in pixels.
+This is used to propagate uncertainties in the line spacings in
+the observed patterns of lines.
+.le
+.ls minratio = 0.1
+Minimum spacing ratio used.  Patterns of lines in which the ratio of
+spacings between consecutive lines is less than this amount are excluded.
+.le
+.ls rms = 0.1
+RMS goal for a correct dispersion solution.  This is the RMS in the
+measured spectral lines relative to the expected positions from the
+coordinate line list based on the coordinate dispersion solution.
+The parameter is specified in terms of the line centering parameter
+\fIfwidth\fR since for broader lines the pixel RMS would be expected
+to be larger.  A pixel-based RMS criterion is used to be independent of
+the dispersion.  The RMS will be small for a valid solution.
+.le
+.ls fmatch = 0.2
+Goal for the fraction of unidentified lines in a correct dispersion
+solution.  This is the fraction of the strong lines seen in the spectrum
+which are not identified and also the fraction of all lines in the
+coordinate line list, within the range of the dispersion solution, not
+identified.  Both fractions will be small for a valid solution.
+.le
+.ls debug = ""
+Print or display debugging information.  This is intended for the developer
+and not the user.  The parameter is specified as a string of characters
+where each character displays some information.  The characters are:
+
+.nf
+    a: Print candidate line assignments.
+    b: Print search limits.
+    c: Print list of line ratios.
+*   d: Graph dispersions.
+*   f: Print final result.
+*   l: Graph lines and spectra.
+    r: Print list of reference lines.
+*   s: Print search iterations.
+    t: Print list of target lines.
+    v: Print vote array.
+    w: Print wavelength bin limits.
+.fi
+
+The items with an asterisk are the most useful.  The graphs are exited
+with 'q' or 'Q'.
+.le
+.ih
+DESCRIPTION
+The \fBaidpars\fR parameter set contains the parameters for the automatic
+spectral line identification algorithm used in the task \fBautoidentify\fR,
+\fBidentify\fR, and \fBreidentify\fR.  These tasks include the parameter
+\fIaidpars\fR which links to this parameters set.  Typing \fBaidpars\fR
+allows these parameters to be edited.  When editing the parameters of the
+other tasks with \fBeparam\fR one can edit the \fBaidpars\fR parameters by
+type ":e" when pointing to the \fIaidpars\fR task parameter.  The values of
+the \fBaidpars\fR parameters may also be set on the command line for the
+task.  The discussion which follows describes the parameters and the
+algorithm.
+
+The goal of the automatic spectral line identification algorithm is to
+automate the identification of spectral lines so that given an observed
+spectrum of a spectral line source (called the target spectrum) and a file
+of known dispersion coordinates for the lines, the software will identify
+the spectral lines and use these identifications to determine a
+dispersion function.  This algorithm is quite general so that the correct
+identifications and dispersion function may be found even when there is
+limited or no knowledge of the dispersion coverage and resolution of the
+observation.
+
+However, when a general line list, including a large dispersion range and
+many weak lines, is used and the observation covers a much smaller portion
+of the coordinate list the algorithm may take a long to time or even fail
+to find a solution.  Thus, it is highly desirable to provide additional
+input giving approximate dispersion parameters and their uncertainties.
+When available, a dispersion calibrated reference spectrum (not necessarily
+of the same resolution or wavelength coverage) also aids the algorithm by
+indicating the relative strengths of the lines in the coordinate file.  The
+line strengths need not be very similar (due to different lamps or
+detectors) but will still help separate the inherently weak and strong
+lines.
+
+
+The Input
+
+The primary inputs to the algorithm are the observed one dimensional target
+spectrum in which the spectral lines are to be identified and a dispersion
+function determined and a file of reference dispersion coordinates.  These
+inputs are provided in the tasks using the automatic line identification
+algorithm.
+
+One way to limit the algorithm to a specific dispersion region and to the
+important spectral lines is to use a limited coordinate list.  One may do
+this with the task coordinate list parameter (\fIcoordlist\fR).  However,
+it is desirable to use a standard master line list that includes all the
+lines, both strong and weak.  Therefore, one may specify a limited line
+list with the parameter \fIreflist\fR.  The coordinates in this list will
+be used by the automatic identification algorithm to search for patterns
+while using the primary coordinate list for adding weaker lines during the
+dispersion function fitting.
+
+The tasks \fBautoidentify\fR and \fBidentify\fR also provide parameters to
+limit the search range.  These parameters specify a reference dispersion
+coordinate (\fIcrval\fR) and a dispersion increment per pixel (\fIcdelt\fR).
+When these parameters are INDEF this tells the algorithm to search for a
+solution over the entire range of possibilities covering the coordinate
+line list or reference spectrum.
+
+The reference dispersion coordinate refers to an approximate coordinate at
+the reference pixel coordinate specified by the parameter \fIcrpix\fR.
+The default value for the reference pixel coordinate is INDEF which
+translates to the central pixel of the target spectrum.
+
+The parameters \fIcrsearch\fR and \fIcdsearch\fR specify the expected range
+or uncertainty of the reference dispersion coordinate and dispersion
+increment per pixel respectively.  They may be specified as an absolute
+value or as a fraction.  When the values are positive they are used
+as an absolute value;
+
+.nf
+    crval(final) = \fIcrval\fR +/- \fIcrsearch\fR
+    cdelt(final) = \fIcdelt\fR +/- \fIcdsearch\fR.
+.fi
+
+When the values are negative they are used as a fraction of the dispersion
+range or fraction of the dispersion increment;
+
+.nf
+    crval(final) = \fIcrval\fR +/- abs (\fIcrsearch\fR * \fIcdelt\fR) * N_pix
+    cdelt(final) = \fIcdelt\fR +/- abs (\fIcdsearch\fR * \fIcdelt\fR)
+.fi
+
+where abs is the absolute value function and N_pix is the number of pixels
+in the target spectrum.  When the ranges are not given explicitly, that is
+they are specified as INDEF, default values of -0.1 are used.
+
+The parameters \fIcrval\fR, \fIcdelt\fR, \fIcrpix\fR, \fIcrsearch\fR,
+and \fIcdsearch\fR may be given explicit numerical values or may
+be image header keyword names.  In the latter case the values of the
+indicated keywords are used.  This feature allows the approximate
+dispersion range information to be provided by the data acquisition
+system; either by the instrumentation or by user input.
+
+Because sometimes only the approximate magnitude of the dispersion
+increment is known and not the sign (i.e. whether the dispersion
+coordinates increase or decrease with increasing pixel coordinates)
+the parameter \fIcdsign\fR specifies if the dispersion direction is
+"increasing", "decreasing", "unknown", or defined by the "sign" of the
+approximate dispersion increment parameter (sign of \fIcdelt\fR).
+
+The above parameters defining the approximate dispersion of the target
+spectrum apply to \fIautoidentify\fR and \fIidentify\fR.  The task
+\fBreidentify\fR does not use these parameters except that the \fIshift\fR
+parameter corresponds to \fIcrsearch\fR if it is non-zero.  This task
+assumes that spectra to be reidentified are the same as a reference
+spectrum except for a zero point dispersion offset; i.e. the approximate
+dispersion parameters are the same as the reference spectrum.  The
+dispersion increment search range is set to be 5% and the sign of the
+dispersion increment is the same as the reference spectrum.
+
+An optional input is a dispersion calibrated reference spectrum (referred to
+as the reference spectrum in the discussion).  This is specified either in
+the coordinate line list file or by the parameter \fIrefspec\fR.  To
+specify a spectrum in the line list file the comment "# Spectrum <image>"
+is included where <image> is the image filename of the reference spectrum.
+Some of the standard line lists in linelists$ may include a reference
+spectrum.  The reference spectrum is used to select the strongest lines for
+the pattern matching algorithm.
+
+
+The Algorithm
+
+First a list of the pixel positions for the strong spectral lines in the
+target spectrum is created.  This is accomplished by finding the local
+maxima, sorting them by pixel value, and then using a centering algorithm
+(\fIcenter1d\fR) to accurately find the centers of the line profiles.  Note
+that task parameters \fIftype\fR, \fIfwidth\fR, \fIcradius\fR,
+\fIthreshold\fR, and \fIminsep\fR are used for the centering.  The number
+of spectral lines selected is set by the parameter \fIntarget\fR.
+
+In order to insure that lines are selected across the entire spectrum
+when all the strong lines are concentrated in only a part of the
+spectrum, the spectrum is divided into five regions and approximately
+a fifth of the requested number of lines is found in each region.
+
+A list of reference dispersion coordinates is selected from the coordinate
+file (\fIcoordlist\fR or \fIreflist\fR).  The number of reference
+dispersion coordinates is set at twice the number of target lines found.
+The reference coordinates are either selected uniformly from the coordinate
+file or by locating the strong spectral lines (in the same way as for the
+target spectrum) in a reference spectrum if one is provided.  The selection
+is limited to the expected range of the dispersion as specified by the
+user.  If no approximate dispersion information is provided the range of
+the coordinate file or reference spectrum is used.
+
+The ratios of consecutive spacings (the lists are sorted in increasing
+order) for N-tuples of coordinates are computed from both lists.  The size
+of the N-tuple pattern is set by the \fInpattern\fR parameter.  Rather than
+considering all possible combinations of lines only patterns of lines with
+all members within \fInneighbors\fR in the lists are used; i.e. the first
+and last members of a pattern must be within \fInneighbors\fR of each other
+in the lists.  The default case is to find all sets of five lines which are
+within ten lines of each other and compute the three spacing ratios.
+Because very small spacing ratios become uncertain, the line patterns are
+limited to those with ratios greater than the minimum specified by the
+\fIminratio\fR parameter.  Note that if the direction of the dispersion is
+unknown then one computes the ratios in the reference coordinates in both
+directions.
+
+The basic idea is that similar patterns in the pixel list and the
+dispersion list will have matching spacing ratios to within a tolerance
+derived by the uncertainties in the line positions (\fIsigma\fR) from the
+target spectrum.  The reference dispersion coordinates are assumed to have
+no uncertainty.  All matches in the ratio space are found between patterns
+in the two lists.  When matches are made then the candidate identifications
+(pixel, reference dispersion coordinate) between the elements of the
+patterns are recorded.  After finding all the matches in ratio space a
+count is made of how often each possible candidate identification is
+found.  When there are a sufficient number of true pairs between the lists
+(of order 25% of the shorter list) then true identifications will appear in
+common in many different patterns.  Thus the highest counts of candidate
+identifications are the most likely to be true identifications.
+
+Because the relationship between the pixel positions of the lines in the
+target spectrum and the line positions in the reference coordinate space
+is generally non-linear the line spacing ratios are distorted and may
+reduce the pattern matching.  The line patterns are normally restricted
+to be somewhat near each other by the \fInneighbors\fR so some degree of
+distortion can be tolerated.  But in order to provide the ability to remove
+some of this distortion when it is known the parameter \fIcrquad\fR is
+provided.  This parameter applies a quadratic transformation to the measured
+pixel positions to another set of "linearized" positions  which are used
+in the line ratio pattern matching.  The form of the transformation is
+
+.nf
+    x' = x + crquad * (x - crpix)**2
+.fi
+
+where x is the measured position, x' is the transformed position,
+crquad is the value of the distortion parameter, and crpix is the value
+of the coordinate reference position.
+
+If approximate dispersion parameters and search ranges are defined then
+candidate identifications which fall outside the range of dispersion
+function possibilities are rejected.  From the remaining candidate
+identifications the highest vote getters are selected.  The number selected
+is three times the number of target lines.
+
+All linear dispersions functions, where dispersion and pixel coordinates
+are related by a zero point and slope, are found that pass within two
+pixels of two or more of the candidate identifications.  The dispersion
+functions are ranked primarily by the number of candidate identifications
+fitting the dispersion and secondarily by the total votes in the
+identifications.  Only the highest ranking candidate linear dispersion
+are kept.  The number of candidate dispersions kept is set by the
+parameter \fIndmax\fR.
+
+The candidate dispersions are evaluated in order of their ranking.  Each
+line in the coordinate file (\fIcoordlist\fR) is converted to a pixel
+coordinate based on the dispersion function.  The centering algorithm
+attempts to find a line profile near that position as defined by the
+\fImatch\fR parameter.  This may be specified in pixel or dispersion
+coordinates.  All the lines found are used to fit a polynomial dispersion
+function with \fIaidord\fR coefficients.  The order should be linear or
+quadratic because otherwise the increased degrees of freedom allow
+unrealistic dispersion functions to appear to give a good result.  A
+quadratic function (\fIaidord\fR = 3) is allowed since this is the
+approximate form of many dispersion functions.
+
+However, to avoid unrealistic dispersion functions a test is made that
+the maximum amplitude deviation from a linear function is less than
+an amount specified by the \fImaxnl\fR parameter.  The definition of
+the test is
+
+.nf
+    maxnl > (w(0.5) - w(0)) / (w(1) - w(0)) - 0.5
+.fi
+
+where w(x) is the dispersion function value (e.g. wavelength) of the fit
+and x is a normalized pixel positions where the endpoints of the spectrum
+are [0,1].  What this relation means is that the wavelength interval
+between one end and the center relative to the entire wavelength interval
+is within maxnl of one-half.  If the test fails then a linear function
+is fit.  The process of adding lines based on the last dispersion function
+and then refitting the dispersion function is iterated twice.  At the end
+of this step if fewer than the number of lines specified by the parameter
+\fInfound\fR have been identified the candidate dispersion is eliminated.
+
+The quality of the line identifications and dispersion solution is
+evaluated based on three criteria.  The first one is the root-mean-square
+of the residuals between the pixel coordinates derived from lines found
+from the dispersion coordinate file based on the dispersion function and
+the observed pixel coordinates.  This pixel RMS is normalized by the target
+RMS set with the \fIrms\fR parameter.  Note that the \fIrms\fR parameter
+is specified in units of the \fIfwidth\fR parameter.  This is because if
+the lines are broader, requiring a larger fwidth to obtain a centroid,
+then the expected uncertainty would be larger.  A good solution will have
+a normalized rms value less than one.  A pixel RMS criterion, as opposed
+to a dispersion coordinate RMS, is used since this is independent of the
+actual dispersion of the spectrum.
+
+The other two criteria are the fraction of strong lines from the target
+spectrum list which were not identified with lines in the coordinate file
+and the fraction of all the lines in the coordinate file (within the
+dispersion range covered by the candidate dispersion) which were not
+identified.  These are normalized to a target value given by \fIfmatch\fR.
+The default matching goal is 0.3 which means that less than 30% of
+the lines should be unidentified or greater than 70% should be identified.
+As with the RMS, a value of one or less corresponds to a good solution.
+
+The reason the fraction identified criteria are used is that the pixel RMS
+can be minimized by finding solutions with large dispersion increment per
+pixel.  This puts all the lines in the coordinate file into a small range
+of pixels and so (incorrect) lines with very small residuals can be found.
+The strong line identification criterion is clearly a requirement that
+humans use in evaluating a solution.  The fraction of all lines identified,
+as opposed to the number of lines identified, in the coordinate file is
+included to reduce the case of a large dispersion increment per pixel
+mapping a large number of lines (such as the entire list) into the range of
+pixels in the target spectrum.  This can give the appearance of finding a
+large number of lines from the coordinate file.  However, an incorrect
+dispersion will also find a large number which are not matched.  Hence the
+fraction not matched will be high.
+
+The three criteria, all of which are normalized so that values less
+than one are good, are combined to a single figure of merit by a weighted
+average.  Equal weights have been found to work well; i.e. each criterion
+is one-third of the figure of merit.  In testing it has been found that all
+correct solutions over a wide range of resolutions and dispersion coverage
+have figures of merit less than one and typically of order 0.2.  All
+incorrect candidate dispersion have values of order two to three.
+
+The search for the correct dispersion function terminates immediately,
+but after checking the first five most likely candidates, when
+a figure of merit less than one is found.  The order in which the candidate
+dispersions are tested, that is by rank, was chosen to try the most promising
+first so that often the correct solution is found on the first attempt.
+
+When the approximate dispersion is not known or is imprecise it is
+often the case that the pixel and coordinate lists will not overlap
+enough to have a sufficient number true coordinate pairs.  Thus, at a
+higher level the above steps are iterated by partitioning the dispersion
+space searched into bins of various sizes.  The largest size is the
+maximum dispersion range including allowance for the search radii.
+The smallest size bin is obtained by dividing the dispersion range by
+the number specified by the \fInbins\fR parameter.  The actual number
+of bins searched at each bin size is actually twice the number of
+bins minus one because the bins are overlapped by 50%.
+
+The search is done starting with bins in the middle of the size range and
+in the middle of the dispersion range and working outward towards larger
+and smaller bins and larger and smaller dispersion ranges.  This is done to
+improved the chances of finding the correction dispersion function in the
+smallest number of steps.
+
+Another iteration performed if no solution is found after trying all the
+candidate dispersion and bins is to reduce the number of lines in the
+pattern.  So the parameter \fInpattern\fR is an initial maximum pattern.
+A larger pattern gives fewer and higher quality candidate identifications
+and so converges faster.  However, if no solution is found the algorithm
+tries more possible matches produced by a lower number of lines in
+the pattern.  The pattern groups are reduced to a minimum of three lines.
+
+When a set of line identifications and dispersion solution satisfying the
+figure of merit criterion is found a final step is performed.
+Up to this point only linear dispersion functions are used since higher order
+function can be stretch in unrealistic ways to give good RMS values
+and fit all the lines.  The final step is to use the line identifications
+to fit a dispersion function using all the parameters specified by the
+user (such as function type, order, and rejection parameters).  This
+is iterated to add new lines from the coordinate list based on the
+more general dispersion function and then obtain a final dispersion
+function.  The line identifications and dispersion function are then
+returned to the task using this automatic line identification algorithm.
+
+If a satisfactory  solution is not found after searching all the
+possibilities the algorithm will inform the task using it and the task will
+report this appropriately.
+.ih
+EXAMPLES
+1. List the parameters.
+
+.nf
+    cl> lpar aidpars
+.fi
+
+2. Edit the parameters with \fBeparam\fR.
+
+.nf
+    cl> aidpars
+.fi
+
+3. Edit the \fBaidpars\fR parameters from within \fBautoidentify\fR.
+
+.nf
+    cl> epar autoid
+	[edit the parameters]
+	[move to the "aidpars" parameter and type :e]
+	[edit the aidpars parameters and type :q or EOF character]
+	[finish editing the autoidentify parameters]
+	[type :wq or the EOF character]
+.fi
+
+4. Set one of the parameters on the command line.
+
+.nf
+    cl> autoidentify spec002 5400 2.5 crpix=1
+.fi
+.ih
+REVISIONS
+.ls AIDPARS V2.12.2
+There were many changes made in the paramters and algorithm.  New parameters
+are "crquad" and "maxnl".  Changed definitions are for "rms".  Default
+value changes are for "cddir", "ntarget", "ndmax", and "fmatch".  The most
+significant changes in the algorithm are to allow for more non-linear
+dispersion with the "maxnl" parameter, to decrease the "npattern" value
+if no solution is found with the specified value, and to search a larger
+number of candidate dispersions.
+.le
+.ls AIDPARS V2.11
+This parameter set is new in this version.
+.le
+.ih
+SEE ALSO
+autoidentify, identify, reidentify, center1d
+.endhelp
diff --git a/noao/onedspec/doc/autoidentify.hlp b/noao/onedspec/doc/autoidentify.hlp
new file mode 100644
index 00000000..a344031a
--- /dev/null
+++ b/noao/onedspec/doc/autoidentify.hlp
@@ -0,0 +1,370 @@
+.help autoidentify Jan96 noao.onedspec
+.ih
+NAME
+autoidentify -- Automatically identify lines and fit dispersion
+.ih
+SUMMARY
+Spectral lines are automatically identified from a list of coordinates
+by pattern matching.  The identified lines are then used to fit a
+dispersion function which is written to a database for later use
+in dispersion calibration.  After a solution is found the identified
+lines and dispersion function may be examined interactively.
+.ih
+USAGE
+autoidentify images crval cdelt
+.ih
+PARAMETERS
+.ls images
+List of images containing one dimensional spectra in which to identify
+spectral lines and fit dispersion functions.  For two and three dimensional
+spectral and spatial data one may use an image section to select a one
+dimensional spectral vector or use the \fIsection\fR parameter.
+.le
+.ls crval, cdelt
+These parameters specify an approximate coordinate value and coordinate
+interval per pixel.  They may be specified as numerical values, INDEF, or
+image header keyword names whose values are to be used.  The coordinate
+reference value is for the pixel specified by the parameter
+\fIaidpars.crpix\fR.  The default reference pixel is INDEF which means the
+middle of the spectrum.  By default only the magnitude of the coordinate
+interval is used and the search will include both increasing and decreasing
+coordinate values with increasing pixel values.  If one or both of these
+parameters are specified as INDEF the search for a solution will be slower
+and more likely to fail.
+.le
+.ls coordlist = ""
+Coordinate list consisting of an list of spectral line coordinates.
+A comment line of the form "# units <units>", where <units> is one of the
+understood units names, defines the units of the coordinate list.  If no units
+are specified then Angstroms are assumed.
+The line list is used for both the final identifications and for the set of
+lines to use in the automatic search.  A restricted search list may be
+specified with the parameter \fIaidpars.reflist\fR.  The line list may
+contain a comment line of the form "# Spectrum <name>", where <name> is a
+filename containing a reference spectrum.  The reference spectrum will be
+used in selecting the strong lines for the automatic search.  A reference
+spectrum may also be specified with the parameter \fIaidpars.refspec\fR.
+
+Some standard line lists are available in the directory "linelists$".
+See the help topic \fIlinelists\fR for the available line lists.
+.le
+.ls units = ""
+The units to use if no database entry exists.  The units are specified as
+described in
+
+.nf
+    cl> help onedspec.package section=units
+.fi
+
+If no units are specified and a coordinate list is used then the units of
+the coordinate list are selected.  If a database entry exists then the
+units defined there override both this parameter and the coordinate list.
+.le
+.ls interactive = yes (no|yes|NO|YES)
+After automatically identifying the spectral lines and dispersion function
+review and modify the solution interactively?  If "yes" a query is given
+for each spectrum providing the choice of interactive review.  The
+query may be turned off during execution.  If "YES" the interactive review
+is entered automatically without a query.  The interactive, graphical
+review is the same as the task \fBidentify\fR with a few restriction.
+.le
+.ls aidpars = "" (parameter set)
+Parameter set for the automatic line identification algorithm.  The
+parameters are described in the help topic \fBaidpars\fR.
+.le
+
+For two and three dimensional spectral images the following parameters are
+used to select a one dimensional spectrum.
+.ls section = "middle line"
+If an image is not one dimensional or specified as a one dimensional image
+section then the image section given by this parameter is used.  The
+section defines a one dimensional spectrum.  The dispersion direction is
+derived from the vector direction.
+
+The section parameter may be specified directly as an image section or
+in one of the following forms
+
+.nf
+line|column|x|y|z first|middle|last|# [first|middle|last|#]]
+first|middle|last|# [first|middle|last|#] line|column|x|y|z
+.fi
+
+where each field can be one of the strings separated by | except for #
+which is an integer number.  The field in [] is a second designator which
+is used with three dimensional data.  Abbreviations are allowed though
+beware that 'l' is not a sufficient abbreviation.
+.le
+.ls nsum = "1"
+Number of lines, columns, or bands across the designated dispersion axis to
+be summed when the image is a two or three dimensional image.
+It does not apply to multispec format spectra.  If the image is three
+dimensional an optional second number can be specified for the higher
+dimensional axis  (the first number applies to the lower axis number and
+the second to the higher axis number).  If a second number is not specified
+the first number is used for both axes.
+.le
+
+The following parameters are used in finding spectral lines.
+.ls ftype = "emission"
+Type of spectral lines to be identified.  The possibly abbreviated choices are
+"emission" and "absorption".
+.le
+.ls fwidth = 4.
+Full-width at the base (in pixels) of the spectral lines to be identified.
+.le
+.ls cradius = 5.
+The maximum distance, in pixels, allowed between a line position
+and the initial estimate when defining a new line.
+.le
+.ls threshold = 0.
+In order for a line center to be determined the range of pixel intensities
+around the line must exceed this threshold.
+.le
+.ls minsep = 2.
+The minimum separation, in pixels, allowed between line positions
+when defining a new line.
+.le
+.ls match = -3.
+The maximum difference for a match between the line coordinate derived from
+the dispersion function and a coordinate in the coordinate list.  Positive
+values are in user coordinate units and negative values are in units of
+pixels.
+.le
+
+The following parameters are used to fit a dispersion function to the user
+coordinates.  The \fBicfit\fR routines are used and further descriptions
+about these parameters may be found under that topic.
+.ls function = "spline3"
+The function to be fit to user coordinates as a function of the pixel
+coordinates.  The choices are "chebyshev", "legendre", "spline1", or "spline3".
+.le
+.ls order = 1
+Order of the fitting function.  The order is the number of polynomial
+terms (coefficients) or the number of spline pieces.
+.le
+.ls sample = "*"
+Sample regions for fitting specified in pixel coordinates.
+.le
+.ls niterate = 10
+Number of rejection iterations.
+.le
+.ls low_reject = 3.0, high_reject = 3.0
+Lower and upper residual rejection in terms of the RMS of the fit.
+.le
+.ls grow = 0
+Distance from a rejected point in which additional points are automatically
+rejected regardless of their residuals.
+.le
+
+The following parameters control the input and output.
+.ls dbwrite = "yes"  (no|yes|NO|YES)
+Automatically write or update the database with the line identifications
+and dispersion function?  If "no" or "NO" then there is no database
+output.  If "YES" the results are automatically written to the database.
+If "yes" a query is made allowing the user to reply with "no", "yes", "NO"
+or "YES".  The negative responses do not write to the database and the
+affirmative ones do write to the database.  The upper-case responses
+suppress any further queries for any remaining spectra.
+.le
+.ls overwrite = yes
+Overwrite previous solutions in the database?  If there is a previous
+solution for the spectrum being identified this parameter selects whether
+to skip the spectrum ("no") or find a new solution ("yes").  In the later
+case saving the solution to the database will overwrite the previous
+solution.
+.le
+.ls database = "database"
+Database for reading and writing the line identifications and
+dispersion functions.
+.le
+.ls verbose = yes
+Print results of the identification on the standard output?
+.le
+.ls logfile = "logfile"
+Filename for recording log information about the identifications.
+The null string, "", may be specified to skip recording the log information.
+.le
+.ls plotfile = ""
+Filename for recording log plot information as IRAF metacode.  A
+null string, "", may be specified to skip recording the plot information.
+(Plot output is currently not implemented.)
+.le
+.ls graphics = "stdgraph"
+Graphics device for the interactive review.  The default is the standard
+graphics device which is generally a graphics terminal.
+.le
+.ls cursor = ""
+Cursor input file for the interactive review.  If a cursor file is not
+given then the standard graphics cursor is read.
+.le
+
+.ls query
+Parameter used by the program to query the user.
+.le
+.ih
+DESCRIPTION
+\fBAutoidentify\fR automatically identifies spectral lines from a list of
+spectral line coordinates (\fIcoordlist\fR) and determines a dispersion
+function.  The identified lines and the dispersion function may be reviewed
+interactively (\fIinteractive\fR) and the final results are recorded in a
+\fIdatabase\fR.
+
+Each image in the input list (\fIimages\fR) is considered in turn.  If the
+image is not one dimensional or a one dimensional section of an image then
+the parameter \fIsection\fR is used to select a one dimensional
+spectrum.  It defines the dispersion direction and central spatial
+coordinate(s).  If the image is not one dimensional or a set of one
+dimensional spectra n multispec format then the \fInsum\fR parameter
+selects the number of neighboring lines, columns, and bands to sum.
+
+This task is not intended to be used on all spectra in an image since in
+most cases the dispersion functions will be similar though possibly with a
+zero point shift.  Once one spectrum is identified the others may be
+reidentified with \fBreidentify\fR.
+
+The coordinate list of spectral lines often covers a much larger dispersion
+range than the spectra being identified.  This is true of the standard line
+lists available in the "linelists$" directory.  While the algorithm for
+identifying the lines will often succeed with a large line list it is not
+guaranteed nor will it find the solution quickly without additional
+information.  Thus it is highly desirable to provide the algorithm with
+approximate information about the spectra.  Generally this information is
+known by the observer or recorded in the image header.
+
+As implied in the previous paragraph, one may use a
+limited coordinate line list that matches the dispersion coverage of the
+spectra reasonably well (say within 100% of the dispersion range).
+This may be done with the \fIcoordlist\fR parameter or a second
+coordinate list used only for the automatic search may be specified
+with the parameter \fIaidpars.reflist\fR.  This allows using a smaller
+culled list of lines for finding the matching patterns and a large list
+with weaker lines for the final dispersion function fit.
+
+The alternative to a limited list is to use the parameters \fIcrval\fR and
+\fIcdelt\fR to specify the approximate coordinate range and dispersion
+interval per pixel.  These parameters may be given explicitly or by
+specifying image header keywords.  The pixel to which \fIcrval\fR refers is
+specified by the parameter \fIaidpars.crpix\fR.  By default this is INDEF
+which means use the center of the spectrum.  The direction in which the
+dispersion coordinates increase relative to the pixel coordinates may be
+specified by the \fIaidpars.cddir\fR parameter.  The default is "unknown"
+to search in either direction.
+
+The algorithm used to automatically identify the spectral lines and
+find a dispersion function is described under the help topic
+\fBaidpars\fR.  This topic also describes the various algorithm
+parameters.  The default parameters are adequate for most data.
+
+The characteristics of the spectral lines to be found and identified are
+set by several parameters.  The type of spectral lines, whether "emission"
+or "absorption", is set by the parameter \fIftype\fR.  For arc-line
+calibration spectra this parameter is set to "emission".  The full-width
+(in pixels) at the base of the spectral lines is set by the parameter
+\fIfwidth\fR.  This is used by the centering algorithm to define the extent
+of the line profile to be centered.  The \fIthreshold\fR parameter defines
+a minimum contrast (difference) between a line peak and the neighboring
+continuum.  This allows noise peaks to be ignored.  Finding the center of a
+possible line begins with an initial position estimate.  This may be an
+interactive cursor position or the expected position from the coordinate
+line list.  The centering algorithm then searches for a line of the
+specified type, width, and threshold within a given distance, specified by
+the \fIcradius\fR parameter.  These parameters and the centering algorithm
+are described by the help topic \fBcenter1d\fR.
+
+To avoid finding the same line multiple times, say when there are two lines
+in the line list which are blended into a single in the observation, the
+\fIminsep\fR parameter rejects any new line position found within that
+distance of a previously defined line.
+
+The automatic identification of lines includes matching a line position in
+the spectrum against the list of coordinates in the coordinate line list.
+The \fImatch\fR parameter defines how close the measured line position must
+be to a coordinate in the line list to be considered a possible
+identification.  This parameter may be specified either in user coordinate
+units (those used in the line list) by using a positive value or in pixels
+by using a negative value.  In the former case the line position is
+converted to user coordinates based on a dispersion function and in the
+latter the line list coordinate is converted to pixels using the inverse of
+the dispersion function.
+
+The dispersion function is determined by fitting a set of pixel positions
+and user coordinate identifications by least squares to a specified
+function type.  The fitting requires a function type, \fIfunction\fR, and
+the order (number of coefficients or spline pieces), \fIorder\fR.
+In addition the fitting can be limited to specified regions, \fIsample\fR,
+and provide for the rejection of points with large residuals.  These
+parameters are set in advance and used during the automatic dispersion
+function determination.  Later the fitting may be modified interactively.
+For additional discussion of these parameters see \fBicfit\fR.
+
+The output of this program consists of log information, plot information,
+and the line identifications and dispersion function.  The log information
+may be appended to the file specified by the \fIlogfile\fR parameter
+and printed to the standard output (normally the terminal) by
+setting the \fIverbose\fR parameter to yes.  This information consists
+of a banner line, a line of column labels, and results for each spectrum.
+For each spectrum the spectrum name, the number of spectral lines found,
+the dispersion coordinate at the middle of the spectrum, the dispersion
+increment per pixel, and the root-mean-square (RMS) of the residuals for
+the lines used in the dispersion function fit is recorded.  The units of
+the RMS are those of the user (line list) coordinates.  If a solution is
+not found the spectrum name and a message is printed.
+
+The line identifications and dispersion function are written to the
+specified \fIdatabase\fR.  The current format of the database is described
+in the help for \fIidentify\fR.  If a database entry is already present for
+a spectrum and the parameter \fIoverwrite\fR is "no" then the spectrum is
+skipped and a message is printed to the standard output.   After a solution
+is found and after any interactive review (see below) the results may be
+written to the database.  The \fIdbwrite\fR parameter may be specified as
+"no" or "NO" to disable writing to the database (and no queries will be
+made), as "yes" to query whether to or not to write to the database, or as
+"YES" to automatically write the results to the database with no queries.
+When a query is given the responses may be "no" or "yes" for an individual
+spectrum or "NO" or "YES" for all remaining spectra without further
+queries.
+
+After a solution is found one may review and modify the line
+identifications and dispersion function using the graphical functions of
+the \fBidentify\fR task (with the exception that a new spectrum may not be
+selected).  The review mode is selected with the \fIinteractive\fR
+parameter.  If the parameter is "no" or "NO" then no interactive review
+will be provided and there will be no queries either.  If the parameter is
+"YES" then the graphical review mode will be entered after each solution is
+found without any query.  If the parameter is "yes" then a query will be
+made after a solution is found and after any log information is written to
+the terminal.  One may respond to the query with "no" or "yes" for an
+individual spectrum or "NO" or "YES" for all remaining spectra without
+further queries.  For "yes" or "YES" the \fIidentify\fR review  mode is
+entered.  To exit type 'q'.
+.ih
+EXAMPLES
+1.  The following example finds a dispersion solution for the middle column
+of a long slit spectrum of a He-Ne-Ar arc spectrum using all the
+interactive options.
+
+.nf
+    cl> autoid arc0022 6000 6 coord=linelists$henear.dat sec="mid col"
+    AUTOIDENITFY: NOAO/IRAF IRAFX valdes@puppis Thu 15:50:31 25-Jan-96
+      Spectrum                # Found   Midpoint Dispersion        RMS
+      arc0022[50,*]                50      5790.       6.17      0.322
+    arc0022[50,*]: Examine identifications interactively?  (yes): 
+    arc0022[50,*]: Write results to database?  (yes): yes
+.fi
+
+2.  The next example shows a non-interactive mode with no queries for
+the middle fiber of an extracted multispec image.
+
+.nf
+    cl> autoid.coordlist="linelists$henear.dat"
+    cl> autoid a0003 5300 3.2 interactive- verbose- dbwrite=YES
+.fi
+.ih
+REVISIONS
+.ls AUTOIDENTIFY V2.11
+This task is new in this version.
+.le
+.ih
+SEE ALSO
+identify, reidentify, aidpars, linelists, center1d, icfit, gtools
+.endhelp
diff --git a/noao/onedspec/doc/bplot.hlp b/noao/onedspec/doc/bplot.hlp
new file mode 100644
index 00000000..f2214b94
--- /dev/null
+++ b/noao/onedspec/doc/bplot.hlp
@@ -0,0 +1,201 @@
+.help bplot Mar92 noao.onedspec
+.ih
+NAME
+bplot -- Plot spectra noninteractively using SPLOT
+.ih
+USAGE
+bplot images [records]
+.ih
+PARAMETERS
+.ls images
+List of images to be plotted.  These may be one dimensional, multiaperture,
+long slit, or nonspectral images.
+.le
+.ls records (imred.irs and imred.iids only)
+List of records to be appended to the input image root names when
+using record number extension format.  The syntax of this list is comma
+separated record numbers or ranges of record numbers.  A range consists of
+two numbers separated by a hyphen.  A null list may be used if no record
+number extensions are desired.
+.le
+.ls apertures = ""
+List of apertures/lines/columns to be plotted in each image.  If
+\fIapertures\fR is null all of the apertures/lines/columns will be plotted.
+.le
+.ls band = 1
+The band or plane of a three dimensional image to be plotted in each image.
+.le
+.ls graphics = "stdgraph"
+Output graphics device.  This may be one of "stdgraph", "stdplot",
+"stdvdm", or the actual device name.
+.le
+.ls cursor = "onedspec$gcurval.dat"
+File(s) containing cursor commands for the SPLOT task.
+The files will be cycled sequentially.  If there is more than one file
+usually the number of files will agree with the number of apertures
+for each image since otherwise different cursor/aperture pairings will
+occur.  The default is a file containing only the (q)uit command.
+.le
+
+The following parameters are used in response to particular keystrokes.
+In \fBsplot\fR they are query parameters but in \fBbplot\fR they are hidden
+parameters.
+.ls next_image = ""
+In response to 'g' (get next image) this parameter specifies the image.
+.le
+.ls new_image = ""
+In response to 'i' (write current spectrum) this parameter specifies the
+name of a new image to create or existing image to overwrite.
+.le
+.ls overwrite = yes
+Overwrite an existing output image?  If set to yes it is possible to write
+back into the input spectrum or to some other existing image.  Otherwise
+the user is queried again for a new image name.
+.le
+.ls spec2 = ""
+When adding, subtracting, multiplying, or dividing by a second spectrum
+('+', '-', '*', '/' keys in the 'f' mode) this parameter is used to get
+the name of the second spectrum.
+.le
+.ls constant = 0.
+When adding or multiplying by a constant ('p' or 'm' keys in the 'f' mode)
+the parameter is used to get the constant.
+.le
+.ls wavelength = 0.
+This parameter is used to get a dispersion coordinate value during deblending or
+when changing the dispersion coordinates with 'u'.
+.le
+.ls linelist = ""
+During deblending this parameter is used to get a list of line positions
+and widths.
+.le
+.ls wstart = 0., wend = 0., dw = 0.
+In response to 'p' (convert to a linear wavelength scale) these parameter
+specify the starting wavelength, ending wavelength, and wavelength per pixel.
+.le
+.ls boxsize = 2
+In response to 's' (smooth) this parameter specifies the box size in pixels
+to be used for the boxcar smooth
+.le
+.ih
+DESCRIPTION
+The spectra in the input image list are successively processed by the task
+\fBsplot\fR with input supplied by the cursor parameter and the output sent
+to the specified graphics device.  The range of apertures and bands
+specified by \fIapertures\fR and \fIbands\fR will be processed for each
+image.  In the \fBiids/irs\fR packages the record extension syntax is used
+with input root names and a record number list.  The hidden parameters from
+\fBsplot\fR apply to this task.
+
+The cursor file(s) consists of line(s) of the form:
+
+	[x y 1] key [command]
+
+where x and y are the position of the cursor (may be zero or absent if the
+cursor position is irrelevant) and key is one of the keystrokes understood
+by \fBsplot\fR.  If the key is ":" then the \fIcolon\fR command string follows.
+The default cursor file consists of the single line:
+
+	0 0 1 q
+
+If more than one cursor file is specified they are sequentially assigned to
+each aperture and the list is repeated as needed.  This allows the aperture
+to be manipulated in differing ways.
+.ih
+EXAMPLES
+1. To plot all of apertures of the multiaperture spectra indicated by the file
+"nite1.lst" on the default plotter and run in the background:
+
+.nf
+    cl> bplot @nite1.lst graphics=stdplot &
+.fi
+
+2. To preview the plots:
+
+.nf
+    cl> bplot @nite1.lst graphics=stdgraph
+.fi
+
+3.  To produce a histogram type plot about Balmer alpha for aperture 5 of
+each spectrum with the IRAF banner suppressed:
+
+.nf
+    cl> type curfile
+    6555 0 1 a
+    6570 0 1 a
+    q
+    cl> splot.options="auto hist nosysid"
+    cl> splot.xmin=6555
+    cl> splot.xmax=6570
+    cl> bplot @nite1.lst apertures=5 cursor=curfile
+.fi
+
+4. To produce plots with four spectra per page:
+
+.nf
+    cl> bplot @nite1.lst ... >G nite1.mc
+    cl> gkimosaic nite1.mc dev=stdplot
+.fi
+
+The first command redirects the output of the graphics to the metacode
+file nite1.mc.  The task \fBgkimosaic\fR is used to make multiple plots
+per page.  Other tasks in the \fBplot\fR package may be used to
+manipulate and redisplay the contents of the metacode file.
+
+5. To plot a list of apertures with a different cursor file for each aperture:
+
+.nf
+    cl> bplot @nite1.lst apertures=3,9,14 cursor=@nite1.cur
+.fi
+
+In this case the file "nite1.cur" is assumed to be a list of
+individual cursor file names, for instance:
+
+.nf
+	cur.03
+	cur.09
+	cur.14
+.fi
+
+that are in one to one correspondence with the range of apertures.
+.ih
+REVISIONS
+.ls BPLOT V2.10.3
+The query parameters from SPLOT were added as hidden parameters in BPLOT
+to allow use of those keys in a batch way.
+.le
+.ls BPLOT V2.10
+The \fIapertures\fR and \fIband\fR parameters been added to select
+apertures from multiple spectra and long slit images, and bands from 3D
+images.  Since the task is a script calling \fBsplot\fR, the many revisions
+to that task also apply.  The version in the \fBirs/iids\fR packages
+selects spectra using the record number extension syntax.
+.le
+.ih
+BUGS
+The cursor file command keystrokes cannot include any of the cursor
+mode (CAPITALIZED) keys.  This results from the implementation of
+the cursor mode commands as external to both BPLOT and SPLOT.
+
+When first entered, SPLOT will always display an initial plot.  BPLOT
+calls SPLOT once for each aperture in each image and thus produces
+N(apertures)*N(images) initial plots.  The plots are not optional because
+of the possible confusion a blank screen might cause an inexperienced
+user.  If the initial plots are unwanted they must be edited out of the
+graphics stream.  This can be done as follows, by directing the
+graphics output of BPLOT to a metacode file and then using GKIEXTRACT
+to remove only the desired plots from the metacode file:
+
+.nf
+    cl> bplot @nite1.lst cursor=curfile >G nite1.mc
+    cl> gkiextract nite1.mc 2x2 | gkimosaic dev=stdplot
+.fi
+
+This assumes that curfile is designed to produce only one plot in
+addition to the non-optional initial plot.  In this case there will be
+two plots per aperture per image and we extract every other plot starting
+with the second (as encoded in the range string:  "2x2").
+.ih
+SEE ALSO
+splot, specplot, slist, gkiextract, gkimosaic, implot, graph, ranges
+.endhelp
diff --git a/noao/onedspec/doc/calibrate.hlp b/noao/onedspec/doc/calibrate.hlp
new file mode 100644
index 00000000..cf68ac29
--- /dev/null
+++ b/noao/onedspec/doc/calibrate.hlp
@@ -0,0 +1,195 @@
+.help calibrate Mar93 noao.onedspec
+.ih
+NAME
+calibrate -- Apply extinction corrections and flux calibrations
+.ih
+USAGE
+calibrate input output [records]
+.ih
+PARAMETERS
+.ls input
+List of input spectra to be calibrated.  When using record format
+extensions the root names are specified, otherwise full image names
+are used.
+.le
+.ls output
+List of calibrated spectra.  If no output list is specified or if the
+output name is the same as the input name then the calibrated spectra
+replace the input spectra.  When using record format extensions the output
+names consist of root names to which the appropriate record number
+extension is added.  The record number extension will be the same as the
+input record number extension.  The output spectra are coerced to have
+real datatype pixels regardless of the  pixel type.
+.le
+.ls records (imred.irs and imred.iids only)
+The set of record number extensions to be applied to each input and output
+root name when using record number extension format.  The syntax consists
+of comma separated numbers or ranges of numbers.  A range consists of
+two numbers separated by a hyphen.  This parameter is not queried
+when record number formats are not used.
+.le
+.ls extinct = yes
+Apply extinction correction if a spectrum has not been previously
+corrected?  When applying an extinction correction, an extinction file
+is required.
+.le
+.ls flux = yes
+Apply a flux calibration if a spectrum has not been previously calibrated?
+When applying a flux calibration, sensitivity spectra are required.
+.le
+.ls extinction = <no default>
+Extinction file for the observation.  Standard extinction files
+are available in the "onedstds$" directory.
+.le
+.ls observatory = ")_.observatory"
+Observatory at which the spectra were obtained if not specified in the
+image header by the keyword OBSERVAT.  The default is a redirection to the
+package parameter of the same name.  The observatory may be one of the
+observatories in the observatory database, "observatory" to select the
+observatory defined by the environment variable "observatory" or the
+parameter \fBobservatory.observatory\fR, or "obspars" to select the current
+parameters in the \fBobservatory\fR task.  See \fBobservatory\fR for
+additional information.
+.le
+.ls ignoreaps = no
+Ignore aperture numbers and apply a single flux calibration to all
+apertures?  Normally multiaperture instruments have separate sensitivity
+functions for each aperture while long slit or Fabry-Perot data use a
+single sensitivity function where the apertures are to be ignored.  The
+sensitivity spectra are obtained by adding the aperture number as an
+extension to the sensitivity spectrum root name.  When apertures are
+ignored the specified sensitivity spectrum name is used without adding an
+extension and applied to all input apertures.
+.le
+.ls sensitivity = "sens"
+The root name for the sensitivity spectra produced by \fBsensfunc\fR.
+Normally with multiaperture instruments, \fBsensfunc\fR will produce a
+spectrum appropriate to each aperture with an aperture number extension.
+If the apertures are ignored (\fIignoreaps\fR = yes) then the sensitivity
+spectrum specified is used for all apertures and no aperture number is
+appended automatically.
+.le
+.ls fnu = no
+The default calibration is into units of flux per unit wavelength (F-lambda).
+If \fIfnu\fR = yes then the calibrated spectrum will be in units of
+flux per unit frequency (F-nu).
+.le
+.ls airmass, exptime
+If the airmass and exposure time are not in the header nor can they be
+determined from other keywords in the header then these query parameters
+are used to request the airmass and exposure time.  The values are updated
+in the input and output images.
+.le
+.ih
+DESCRIPTION
+The input spectra are corrected for extinction and calibrated to a flux
+scale using sensitivity spectra produced by the task \fBsensfunc\fR.
+One or both calibrations may be performed by selecting the appropriate
+parameter flags.  It is an error if no calibration is specified.  Normally
+the spectra should be extinction corrected if also flux calibrating.
+The image header keywords DC-FLAG (or the dispersion type field in the
+"multispec" world coordinate system), EX-FLAG, and CA-FLAG are checked for
+dispersion solution (required), previous extinction correction, and
+previous flux calibration.  If previously calibrated the spectrum is
+skipped and a new output image is not created.
+
+The input spectra are specified by a list of root names (when using record
+extension format) or full image names.  The output calibrated spectra may
+replace the input spectra if no output spectra list is specified or if the
+output name is the same as the input name.  When using record number
+extensions the output spectra will have the same extensions applied to the
+root names as those used for the input spectra.
+
+When applying an extinction correction the AIRMASS keyword is sought.
+If the keyword is not present then the airmass at the time defined
+by the other header keywords is computed using the
+latitude of the observatory and observation parameters in the image
+header.  The observatory is first determined from the image under the
+keyword OBSERVAT.  If absent the observatory specified by the task
+parameter "observatory" is used.  See \fBobservatory\fR for further
+details of the observatory database.  If the air mass cannot be
+determined an error results.  Currently a single airmass is used
+and no correction for changing extinction during the observation is
+made and adjustment to the middle of the exposure.  The task
+\fBsetairmass\fR provides a correction for the exposure time to compute
+an effective air mass.  Running this task before calibration is
+recommended.
+
+If the airmass is not in the header and cannot be computed then
+the user is queried for a value.  The value entered is then
+recorded in both the input and output image headers.  Also if
+the exposure time is not found then it is also queried and
+recorded in the image headers.
+
+The extinction correction is given by the factor
+
+		10. ** (0.4 * airmass * extinction)
+
+where the extinction is the value interpolated from the specified
+extinction file for the wavelength of each pixel.  After extinction
+correction the EX-FLAG is set to 0.
+
+When applying a flux calibration the spectra are divided by the
+aperture sensitivity which is represented by a spectrum produced by
+the task \fBsensfunc\fR.  The sensitivity spectrum is in units of:
+
+	2.5 * Log10 [counts/sec/Ang / ergs/cm2/sec/Ang].
+
+A new spectrum is created in "F-lambda" units - ergs/cm2/sec/Angstrom
+or "F-nu" units - ergs/cm2/sec/Hz.  The sensitivity must span the range of
+wavelengths in the spectrum and interpolation is used if the wavelength
+coordinates are not identical.  If some pixels in the spectrum being
+calibrated fall outside the wavelength range of the sensitivity function
+spectrum a warning message giving the number of pixels outside the
+range.  In this case the sensitivity value for the nearest wavelength
+in the sensitivity function is used.
+
+Multiaperture instruments typically have
+a separate aperture sensitivity function for each aperture.  The appropriate
+sensitivity function for each input spectrum is selected based on the
+spectrum's aperture by appending this number to the root sensitivity function
+spectrum name.  If the \fIignoreaps\fR flag is set, however, the aperture
+number relation is ignored and the single sensitivity spectrum (without
+extension) is applied.
+.ih
+EXAMPLES
+1.  To flux calibrates a series of spectra replacing the input spectra by
+the calibrated spectra:
+
+	cl> calibrate nite1 ""
+
+2.  To only extinction correct echelle spectra:
+
+	cl> calibrate ccd*.ec.imh new//ccd*.ec.imh flux-
+
+3. To flux calibrate a long slit spectrum:
+
+.nf
+	cl> dispaxis = 2
+	cl> calibrate obj.imh fcobj.imh
+.fi
+.ih
+REVISIONS
+.ls CALIBRATE V2.10.3
+This task was revised to operate on 2D and 3D spatial spectra; i.e. long
+slit and Fabry-Perot data cubes.  This task now includes the functionality
+previously found in \fBlongslit.extinction\fR and \fBlongslit.fluxcalib\fR.
+
+A query for the airmass and exposure time is now made if the information
+is not in the header and cannot be computed from other header keywords.
+.le
+.ls CALIBRATE V2.10
+This task was revised to operate on nonlinear dispersion corrected spectra
+and 3D images (the \fBapextract\fR "extras").  The aperture selection
+parameter was eliminated (since the header structure does not allow mixing
+calibrated and uncalibrated spectra) and the latitude parameter was
+replaced by the observatory parameter.  The observatory mechanism insures
+that if the observatory latitude is needed for computing an airmass and the
+observatory is specified in the image header the correct calibration will
+be applied.  The record format syntax is available in the \fBirs/iids\fR
+packages.  The output spectra are coerced to have real pixel datatype.
+.le
+.ih
+SEE ALSO
+setairmass, standard, sensfunc, observatory, continuum
+.endhelp
diff --git a/noao/onedspec/doc/continuum.hlp b/noao/onedspec/doc/continuum.hlp
new file mode 100644
index 00000000..6bb4e05e
--- /dev/null
+++ b/noao/onedspec/doc/continuum.hlp
@@ -0,0 +1,263 @@
+.help continuum Mar92 noao.onedspec
+.ih
+NAME
+continuum -- Continuum normalize spectra
+.ih
+USAGE	
+continuum input output
+.ih
+PARAMETERS
+.ls input
+Input spectra to be continuum normalized.  These may be any combination
+of echelle, multiaperture, one dimensional, long slit, and spectral
+cube images.
+.le
+.ls output
+Output continuum normalized spectra.  The number of output spectra must
+match the number of input spectra.  \fBOutput\fR may be omitted if
+\fBlistonly\fR is yes.
+.le
+.ls lines = "*", bands = "1"
+A range specifications for the image lines and bands to be fit.  Unspecified
+lines and bands will be copied from the original.  If the value is "*", all of
+the currently unprocessed lines or bands will be fit.  A range consists of
+a first line number and a last line number separated by a hyphen.  A
+single line number may also be a range and multiple ranges may be
+separated by commas.
+.le
+.ls type = "ratio"
+Type of output spectra.  The choices are "fit" for the fitted function,
+"ratio" for the ratio of the input spectra to the fit, "difference" for
+the difference between the input spectra and the fit, and "data" for
+the data minus any rejected points replaced by the fit.
+.le
+.ls replace = no
+Replace rejected points by the fit in the difference, ratio, and
+data output types?
+.le
+.ls wavescale = yes
+Wavelength scale the X axis of the plot?  This option requires that the
+spectra be wavelength calibrated.  If \fBwavescale\fR is no, the plots
+will be in "channel" (pixel) space.
+.le
+.ls logscale = no
+Take the log (base 10) of both axes?  This can be used when \fBlistonly\fR
+is yes to measure the exponent of the slope of the continuum.
+.le
+.ls override = no
+Override previously normalized spectra?  If \fBoverride\fR is yes and
+\fBinteractive\fR is yes, the user will be prompted before each order is
+refit.  If \fBoverride\fR is no, previously fit spectra are silently
+skipped.
+.le
+.ls listonly = no
+Don't modify any images?  If \fBlistonly\fR is yes, the \fBoutput\fR
+image list may be skipped.
+.le
+.ls logfiles = "logfile"
+List of log files to which to write the power series coefficients.  If
+\fBlogfiles\fR = NULL (""), the coefficients will not be calculated.
+.le
+.ls interactive = yes
+Perform the fit interactively using the icfit commands?  This will allow
+the parameters for each spectrum to be adjusted independently.  A separate
+set of the fit parameters (below) will be used for each spectrum and any
+interactive changes to the parameters for a specific spectrum will be
+remembered when that spectrum is fit in the next image.
+.le
+.ls sample = "*"
+The ranges of X values to be used in the continuum fits.  The units will vary
+depending on the setting of the \fBwavescale\fR and \fBlogscale\fR
+parameters.  The default units are in wavelength if the spectra have
+been dispersion corrected.
+.le
+.ls naverage = 1
+Number of sample points to combined to create a fitting point.
+A positive value specifies an average and a negative value specifies
+a median.
+.le
+.ls function = spline3
+Function to be fit to the spectra.  The functions are
+"legendre" (legendre polynomial), "chebyshev" (chebyshev polynomial),
+"spline1" (linear spline), and "spline3" (cubic spline).  The functions
+may be abbreviated.  The power series coefficients can only be
+calculated if \fBfunction\fR is "legendre" or "chebyshev".
+.le
+.ls order = 1
+The order of the polynomials or the number of spline pieces.
+.le
+.ls low_reject = 2., high_reject = 0.
+Rejection limits below and above the fit in units of the residual sigma.
+.le
+.ls niterate = 10
+Number of rejection iterations.
+.le
+.ls grow = 1.
+When a pixel is rejected, pixels within this distance of the rejected pixel
+are also rejected.
+.le
+.ls markrej = yes
+Mark rejected points?  If there are many rejected points it might be
+desired to not mark rejected points.
+.le
+.ls graphics = "stdgraph"
+Graphics output device for interactive graphics.
+.le
+.ls cursor = ""
+Graphics cursor input.
+.le
+.ih
+DESCRIPTION
+A one dimensional function is fit to the continuum of spectra in a list of
+echelle, multispec, or onedspec format images and then divided into the
+spectrum to produce continuum normalized spectra.  The first two formats
+will normalize the spectra or orders (i.e. the lines) in each image.  In
+this description the term "spectrum" will refer to a line (in whatever
+band) of an image while "image" will refer to all spectra in an image.  The
+parameters of the fit may vary from spectrum to spectrum within images and
+between images.  The fitted function may be a legendre polynomial,
+chebyshev polynomial, linear spline, or cubic spline of a given order or
+number of spline pieces.  The output image is of pixel type real.
+
+The line/band numbers (for two/three dimensional images) are written to a
+list of previously processed lines in the header keywords \fISFIT\fR and
+\fISFITB\fR of the output image.  A subsequent invocation of SFIT will only
+process those requested spectra that are not in this list.  This ensures
+that even if the output image is the same as the input image that no
+spectra will be processed twice and permits an easy exit from the task in
+the midst of processing many spectra without losing any work or requiring
+detailed notes.
+
+The points to be fit in each spectrum are determined by
+selecting a sample of X values specified by the parameter \fIsample\fR
+and taking either the average or median of the number of points
+specified by the parameter \fInaverage\fR.  The type of averaging is
+selected by the sign of the parameter with positive values indicating
+averaging, and the number of points is selected by the absolute value
+of the parameter.  The sample units will vary depending on the settings
+of the \fBwavescale\fR and the \fBlogscale\fR parameters.  Note that a
+sample that is specified in wavelength units may be entirely outside
+the domain of the data (in pixels) if some of the spectra are not
+dispersion corrected.  The syntax of the sample specification is a comma
+separated, colon delimited list similar to the image section notation.
+For example, the \fBsample\fR, "6550:6555,6570:6575" might be used to
+fit the continuum near H-alpha.
+
+If \fIlow_reject\fR and/or \fIhigh_reject\fR are greater than zero the
+sigma of the residuals between the fitted points and the fitted
+function is computed and those points whose residuals are less than
+\fI-low_reject\fR * sigma and greater than \fIhigh_reject\fR * sigma
+are excluded from the fit.  Points within a distance of \fIgrow\fR
+pixels of a rejected pixel are also excluded from the fit.  The
+function is then refit without the rejected points.  This rejection
+procedure may be iterated a number of times given by the parameter
+\fIniterate\fR.  This is how the continuum is determined.
+
+If \fIreplace\fR is set then any rejected points from the fitting
+are  replaced by the fit in the data before outputing the difference,
+ratio, or data.  For example with replacing the difference will
+be zero at the rejected points and the data output will be cleaned
+of deviant points.
+
+A range specification is used to select the \fIlines\fR and \fIbands\fR to be
+fit.  These parameters may either be specified with the same syntax as the
+\fBsample\fR parameter, or with the "hyphen" syntax used elsewhere in
+IRAF.  Note that a NULL range for \fBlines/bands\fR expands to \fBno\fR
+lines, not to all lines.  An asterisk (*) should be used to represent a
+range of all of the image lines/bands.  The fitting parameters (\fIsample,
+naverage, function, order, low_reject, high_reject, niterate, grow\fR)
+may be adjusted interactively if the parameter \fIinteractive\fR is
+yes.  The fitting is performed with the \fBicfit\fR package.  The
+cursor mode commands for this package are described in a separate help
+entry under "icfit".  Separate copies of the fitting parameters are
+maintained for each line so that interactive changes to the parameter
+defaults will be remembered from image to image.
+.ih
+PROMPTS
+If several images or lines/bands are specified, the user is asked whether
+to perform an interactive fit for each spectrum.  The response
+may be \fByes, no, skip, YES, NO\fR or \fBSKIP\fR.  The meaning of each
+response is:
+
+.nf
+	yes   - Fit the next spectrum interactively.
+	no    - Fit the next spectrum non-interactively.
+	skip  - Skip the next spectrum in this image.
+
+	YES   - Interactively fit all of the spectra of
+		all of the images with no further prompts.
+	NO   	Non-interactively fit all chosen spectra of all images.
+	SKIP  - This will produce a second prompt, "Skip what?",
+		with the choices:
+
+		spectrum - skip this spectrum in all images
+		image    - skip the rest of the current image
+		all      - \fBexit\fR the program
+		           This will \fBunlearn\fR the fit parameters
+			   for all spectra!
+		cancel  - return to the main prompt
+.fi
+.ih
+EXAMPLES
+1.  To normalize all orders of the echelle spectrum for hd221170
+
+	cl> continuum hd221170.ec nhd221170.ec type=ratio
+
+Each order of the spectrum is graphed and the interactive options for
+setting and fitting the continuum are available.  The important
+parameters are low_rejection (for an absorption spectrum), the function
+type, and the order of the function; these fit parameters are
+originally set to the defaults in the \fBcontinuum\fR parameter file.  A
+'?' will display a menu of cursor key options.  Exiting with 'q' will
+update the output normalized order for the current image and proceed to
+the next order or image.
+
+The parameters of the fit for each order are initialized to the current
+values the first time that the order is fit.  In subsequent images, the
+parameters for a order are set to the values from the previous image.
+The first time an order is fit, the sample region is reset to the
+entire order.  Deleted points are ALWAYS forgotten from order to order
+and image to image.
+
+2.  To do several images at the same time
+
+	cl> continuum spec*.imh c//spec*.imh
+
+Note how the image template concatenation operator is used to construct
+the output list of spectra.  Alternatively:
+
+	cl> continuum @inlist @outlist
+
+where the two list files could have been created with the sections
+command or by editing.
+
+3.  To measure the power law slope of the continuum (fluxed data)
+
+	cl> continuum uv.* type=ratio logscale+ listonly+ fun=leg order=2
+.ih
+REVISIONS
+.ls CONTINUUM V2.10.4
+The task was expanded to include fitting specified bands in 3D multispec
+spectra.
+
+The task was expanded to include long slit and spectral cube data.
+.le
+.ls CONTINUUM V2.10
+This task was changed from a script based on \fBimages.fit1d\fR to a
+task based on \fBsfit\fR.  This provides for individual independent
+continuum fitting in multiple spectra images and for additional
+flexibility and record keeping.  The parameters have been largely
+changed.
+.le
+.ih
+BUGS
+The errors are not listed for the power series coefficients.
+
+Spectra that are updated when \fBlogscale\fR is yes are written with a
+linear wavelength scale, but with a log normalized data value.
+
+Selection by aperture number is not supported.
+.ih
+SEE ALSO
+sfit, fit1d, icfit, ranges
+.endhelp
diff --git a/noao/onedspec/doc/deredden.hlp b/noao/onedspec/doc/deredden.hlp
new file mode 100644
index 00000000..862c441c
--- /dev/null
+++ b/noao/onedspec/doc/deredden.hlp
@@ -0,0 +1,201 @@
+.help deredden Feb94 noao.onedspec
+.ih
+NAME
+deredden -- Apply interstellar reddening correction
+.ih
+USAGE
+deredden input output [records] value
+.ih
+PARAMETERS
+.ls input
+List of input spectra to be dereddened.  When using record
+format extensions the root names are specified, otherwise full
+image names are used.
+.le
+.ls output
+List of derreddened spectra.  If no output list is specified then
+the input spectra are modified.  Also the output name may be
+the same as the input name to replace the input spectra by the
+calibrated spectra.  When using record format extensions the
+output names consist of root names to which the appropriate
+record number extension is added.  The record number extension
+will be the same as the input record number extension.
+.le
+.ls records (imred.irs and imred.iids only)
+The set of record number extensions to be applied to each input
+and output root name when using record number extension 
+format.  The syntax consists of comma separated numbers or
+ranges of numbers.  A range consists of two numbers separated
+by a hyphen.  This parameter is not queried when record number
+formats are not used.
+.le
+.ls value
+Extinction parameter value as selected by the type parameter.
+This value may be a visual extinction, A(V), the color excess between
+B and V, E(B-V), or the logarithmic H beta extinction.
+These quantities are discussed further below.
+.le
+.ls R = 3.1
+The ratio of extinction at V, A(V), to color excess between B and V, E(B-V).
+.le
+.ls type = "E(B-V)"
+The type of extinction parameter used.  The values may be:
+.ls A(V)
+The absolute extinction at the V band at 5550 Angstroms.
+.le       
+.ls E(B-V)
+The color excess between the B and V bands.
+.le
+.ls c     
+The logarithmic H beta extinction.
+.le
+.le
+.ls apertures = ""
+List of apertures to be selected from input one dimensional spectra
+to be calibrated.  If no list is specified then all apertures are
+corrected.  The syntax is the same as the record number
+extensions.  This parameter is ignored for N-dimensional spatial
+spectra such as calibrated long slit and Fabry-Perot data.
+.le
+.ls override = no, uncorrect = yes
+If a spectrum has been previously corrected it will contain the header
+parameter DEREDDEN.  If this parameter is present and the override
+parameter is no then a warning will be issued and no further correction
+will be applied.  The override parameter permits overriding this check.  If
+overriding a previous correction the \fIuncorrect\fR parameter determines
+whether the spectra are first uncorrected to the original values before
+applying the new correction.  If \fIuncorrect\fR is yes then the image
+header DEREDDEN parameter will refer to a correction from the original data
+while if it is no then the new correction is differential and the keyword
+will only reflect the last correction.  When correcting individual spectra
+separately in a multispectra image with different extinction parameters the
+uncorrect parameter should be no.
+.le
+.ih
+DESCRIPTION
+The input spectra are corrected for interstellar extinction, or
+reddening, using the empirical selective extinction function of
+Cardelli, Clayton, and Mathis, \fBApJ 345:245\fR, 1989, (CCM).
+The function is defined over the range 0.3-10 inverse microns
+or 100-3333 nanometers.  If the input data extend outside this
+range an error message will be produced.
+
+The extinction function requires two parameters, the absolute extinction at
+5550A, A(V), and the ratio, R(V), of this extinction to the color excess
+between 4350A and 5550A, E(B-V).
+
+One of the input task parameters is R(V).  If it is not known one
+may use the default value of 3.1 typical of the average 
+interstellar extinction.  The second input parameter is chosen by
+the parameter \fItype\fR which may take the values "A(V)", "E(B-V)", or
+"c".  The value of the parameter is specified by the parameter
+\fIvalue\fR.
+
+If A(V) is used then the CCM function can be directly evaluated.  If
+E(B-V) is used then A(V) is derived by:
+
+.nf
+(1)     A(V) = R(V) * E(B-V)
+.fi
+
+For planetary nebula studies the logarithmic extinction at H beta,
+denoted as c, is often determined instead of E(B-V).  If this type
+of input is chosen then A(V) is derived by:
+
+.nf
+(2)     A(V) = R(V) * c * (0.61 + 0.024 * c).
+.fi
+
+This relation is based on the relation betwen E(B-V) and c computed
+by Kaler and Lutz, \fBPASP 97:700\fR, 1985 to include corrections between
+the monochromatic parameter c and the broadband parameter E(B-V).
+In particular the function is a least squares fit to the values of
+c and E(B-V) in Table III of the form:
+
+.nf
+(3)     E(B-V) = c * (A + B * c)
+.fi
+
+The input spectra are specified by a list of root names (when using record
+extension format) or full image names.  They are required to be dispersion
+corrected (DC-FLAG >= 0) and not previously corrected (DEREDDEN absent).
+Spectra not satisfying these requirements are skipped with a warning.  The
+DEREDDEN flag may be overridden with the \fIoverride\fR parameter.  This
+may be done if different extinction parameters are required for different
+spectra in the same multiple spectrum image or if a new correction is
+to be applied.  The \fIuncorrect\fR parameter determines whether the
+previous correction is removed so that the final correction is relative
+to the original data or if the new correction is differential on the
+previous correction.  Note that if applying separate corrections to
+different spectra in a single multispectral image then override should
+be yes and uncorrect should be no.
+
+A subset of apertures to be corrected may be selected from one dimensional
+spectra with the \fIapertures\fR parameter.  Long slit or other higher
+dimensional spatially sampled spectra are treated as a unit.  The output
+calibrated spectra may replace the input spectra if no output spectra list
+is specified or if the output name is the same as the input name.  When
+using record number extensions the output spectra will have the same
+extensions applied to the root names as those used for the input spectra.
+
+Note that by specifying a negative extinction parameter this task may
+be used to add interstellar extinction.
+.ih
+EXAMPLES
+1.  To deredden a spectrum with an extinction of 1.2 magnitudes at V:
+    
+.nf
+	cl> deredden obj1.ms drobj1.ms 1.2 type=A
+.fi
+
+2.  To deredden a spectrum in place with a color excess of 0.65 and
+and R(V) value of 4.5:
+
+.nf
+	cl> deredden obj2.ms obj2.ms R=4.5
+	E(B-V): .65
+.fi
+
+3.  To deredden a series of IRS planetary nebula spectra using the
+H beta extinction in the irs package:
+
+.nf
+	cl> deredden pn12 drpn12 1-5,12-14 type=c
+	c: 1.05
+.fi
+
+4.  To redden a spectrum:
+
+.nf
+	cl> deredden artspec artspec -1.2 type=A
+.fi
+
+5. To deredden a long slit or Fabry-Perot spectrum either DISPAXIS
+must be in the image header or be specified in the package parameters.
+The summing parameters are ignored.
+    
+.nf
+	cl> deredden obj1 drobj1 1.2 type=A
+.fi
+.ih
+REVISIONS
+.ls DEREDDEN V2.10.3
+Extended to operate on two and three dimensional spatial spectra such as
+calibrated long slit and Fabry-Perot data.
+
+An option was added to allow a previous correction to be undone in order
+to keep the DEREDDEN information accurate relative to the original
+data.
+.le
+.ls DEREDDEN V2.10
+This task is new.
+.le
+.ih
+NOTES
+Since there can be only one deredding flag in multispectral images
+one needs to override the flag if different spectra require different
+corrections and then only the last correction will be recorded.
+.ih
+SEE ALSO
+calibrate
+.endhelp
diff --git a/noao/onedspec/doc/dispcor.hlp b/noao/onedspec/doc/dispcor.hlp
new file mode 100644
index 00000000..9e916e70
--- /dev/null
+++ b/noao/onedspec/doc/dispcor.hlp
@@ -0,0 +1,497 @@
+.help dispcor Oct92 noao.onedspec
+.ih
+NAME
+dispcor -- Dispersion correct and resample spectra
+.ih
+USAGE
+dispcor input output [records]
+.ih
+PARAMETERS
+.ls input
+List of input spectra or root names to be dispersion corrected.  These may
+be echelle or non-echelle spectra, the task will determine which from the
+database dispersion functions.  When using the record number extension
+format, record number extensions will be appended to each root name in the
+list.
+.le
+.ls output
+List of dispersion corrected output spectra or root names.  When using the
+record number extension format, record number extensions will be appended
+to each root name in the list.  The output extension will be the same as
+the input extension.  If "no" output list is specified then the output
+spectrum will replace the input spectrum after dispersion correction.
+.le
+.ls records (imred.irs and imred.iids only)
+List of records or ranges of records to be appended to the input and output
+root names when using record number extension format.  The syntax of this
+list is comma separated record numbers or ranges of record numbers.  A
+range consists of two numbers separated by a hyphen.  A null list may be
+used if no record number extensions are desired.  This is a positional
+query parameter only if the record format is specified.
+.le
+.ls linearize = yes
+Interpolate the spectra to a linear dispersion sampling?  If yes, the
+spectra will be interpolated to a linear or log linear sampling using
+the linear dispersion parameters specified by other parameters.  If
+no, the nonlinear dispersion function(s) from the dispersion function
+database are assigned to the input image world coordinate system
+and the spectral data are not interpolated.
+.le
+.ls database = "database"
+Database containing dispersion solutions created by \fBidentify\fR or
+\fBecidentify\fR.  If the spectra have been previous dispersion corrected
+this parameter is ignored unless a new reference spectra are defined.
+.le
+.ls table = ""
+Wavelength coordinate table or reference image.  Elements in this optional
+table or reference image override the wavelength coordinates given below
+for specified apertures.  See the DISCUSSION for additional information.
+.le
+.ls w1 = INDEF, w2 = INDEF, dw = INDEF, nw = INDEF
+The starting wavelength, ending wavelength, wavelength interval per pixel,
+and the number of pixels in the output spectra.  Any combination of these
+parameters may be used to restrict the wavelength coordinates of the output
+spectra.  If two or more have the value INDEF then suitable defaults based
+on the number of input pixels and the wavelength range of the reference
+dispersion solutions are used.  These defaults may either come from all
+spectra, all spectra of the same aperture, or individually for each
+spectrum depending on the values of the \fIglobal\fR and \fIsamedisp\fR
+parameters.  Note that these parameters are specified in linear units even
+if a logarithmic wavelength scale is selected.  The conversion between
+linear and logarithmic intervals between pixels is given below.  These
+values may be overridden for specified apertures by a wavelength table or
+reference image.  Otherwise these values apply to all apertures.
+.le
+.ls log = no
+Transform to linear logarithmic wavelength coordinates?  Linear logarithmic
+wavelength coordinates have wavelength intervals which are constant
+in the logarithm (base 10) of the wavelength.  Note that if conserving flux
+this will change the flux units to flux per log lambda interval.
+Note that if the input spectra are in log sampling then \fIlog\fR=no will
+resample back to linear sampling and \fIlog\fR=yes will resample keeping
+the output spectra in log sampling.
+.le
+.ls flux = yes
+Conserve the total flux during interpolation rather than the flux density?
+If "no", the output spectrum is average of the input spectrum across each
+output wavelength coordinate.  This conserves flux density.  If "yes" the
+input spectrum is integrated over the extent of each output pixel.  This
+conserves the total flux.  Note that in this case units of the flux will
+change; for example rebinning to logarithmic wavelengths will produce flux
+per log lambda.  For flux calibrated data you most likely would not want to
+conserve flux.
+.le
+.ls blank = 0.
+Output value corresponding to points outside the range of the input
+data.  In other words, the out of bounds value.  This only has an
+effect when linearizing and the output spectral coordinates extend
+beyond the input spectral range.
+.le
+.ls samedisp = no
+Use the same dispersion parameters for all apertures?  If yes then all
+apertures in a single image will have the same dispersion parameters.
+If the \fIglobal\fR parameter is all selected then all spectra in all
+images will have the same dispersion paramters.  This parameter
+would not normally be used with echelle spectra where each order
+has a different wavelength coverage.
+.le
+.ls global = no
+Apply global wavelength defaults?  Defaults for the INDEF wavelength
+coordinate parameters are determined if two or less of the wavelength
+parameters are specified.  The defaults are based on the number of
+pixels and the wavelengths of the first and last pixel as given by the
+dispersion solution.  If this parameter is "no" this is done
+independently for each input spectrum.  If this parameter is "yes"
+then the maximum number of pixels and the minimum and maximum
+wavelengths of all the input spectra or those of the same aperture are
+used to provide defaults for the spectra.  The parameter
+\fIsamedisp\fR determines whether the global coordinates are over all
+spectra or only those with the same aperture number.  The global option
+is used to have all the dispersion corrected spectra have the same
+wavelength coordinates without actually specifying the wavelength
+parameters.
+.le
+.ls ignoreaps = no
+If a reference dispersion solution is not found for an aperture
+use the first reference dispersion solution and ignore the aperture
+number?  If not ignoring the apertures all spectra must have a matching
+aperture for the dispersion solution and the task aborts if this is
+not the case.  Ignoring the apertures avoids this abort and instead
+the first dispersion solution is used.  Note this parameter does not
+mean ignore matches between reference and spectrum aperture numbers
+but only ignore the aperture number if no matching reference is
+found.
+
+Also if a reference table or image is given and \fIignoreaps\fR=yes
+then the default dispersion parameters for any aperture not defined
+by the table or image will be that of the first defined aperture.
+This can still be overridden by giving explicit values for
+\fIw1, w2, dw\fR and \fInw\fR.
+.le
+.ls confirm = no
+Confirm the wavelength parameters for each spectrum?  If \fIyes\fR
+the wavelength parameters will be printed and the user will be asked
+whether to accept them.  If the parameters are not acceptable the
+user will be queried for new values.  The confirmation and parameter
+changes are repeated until an acceptable set of parameters is obtained.
+When the \fIglobal\fR parameter is \fIyes\fR changes to the wavelength
+parameters will remain in effect until changed again.
+.le
+.ls listonly = no
+List the dispersion coordinates only?  If set then the dispersion coordinates
+are listed but the spectra are not dispersion corrected.  This may be used
+to determine what the default wavelengths would be based on the dispersion
+solutions.
+.le
+.ls verbose = yes
+Print the dispersion function and coordinate assignments?
+.le
+.ls logfile = ""
+Log file for recording the dispersion correction operations.  If no file
+name is given then no log information is recorded.
+.le
+.ih
+DESCRIPTION
+The dispersion coordinate systems of the input spectra are set or changed
+in the output spectra.  The output spectra may be the same as the input
+spectra if no output spectra are specified or the output name is the
+same as the input name.  The input and output spectra are specified
+by image templates or lists.  In the \fBirs/iids\fR packages the
+input and output spectra are specified as root names and the record
+numbers are specified by the \fIrecord\fR parameter.  The records are
+given as a set of comma separate single numbers or ranges of hyphen
+separated numbers.  If no records are specified then the input and output
+images are assumed to be full names.
+
+The dispersion coordinate system is defined either in the image header or
+by dispersion functions in the specified database.  To use reference
+spectra dispersion functions they must first be assigned to the image with
+\fBidentify (reidentify)\fR, \fBecidentify (ecreidentify)\fR,
+\fBrefspectra\fR, or \fBhedit\fR.  These tasks define the image header
+keywords REFSPEC1, REFSPEC2, REFSHFT1, and REFSHFT2.  The test which
+determines whether to use the current dispersion coordinate system or
+reference spectra dispersion solutions is the presence of the REFSPEC1
+keyword.  Since it is an error to apply a dispersion function to data which
+have already been dispersion corrected the any dispersion function keywords
+are deleted after use and a record of them entered in sequential image
+header keywords beginning with DCLOG.
+
+Dispersion functions are specified by one or both of the reference spectrum
+image header keywords REFSPEC1 and REFSPEC2 containing the name of
+calibration spectra with dispersion function solutions (either echelle
+dispersion functions from \fBecidentify\fR or non-echelle dispersion
+functions from \fBidentify\fR) in the database.  There must be a dispersion
+function for each aperture in the input spectrum unless the \fIignoreaps\fR
+flag is set.  If the flag is not set the task will abort if a matching
+aperture is not found while if it is set spectra without a matching
+aperture in the reference dispersion solutions will use the first
+dispersion solution.  Note that aperture number matching is done in both
+cases and the \fIignoreaps\fR parameter only applies to non-matching
+spectra.  The common situation for using the \fIignoreaps\fR option is when
+there is a single reference dispersion solution which is to be applied to a
+number of spectra with different aperture numbers; hence effectively
+ignoring the reference spectrum aperture number.
+
+If two reference spectra are specified the names may be followed by a
+weighting factor (assumed to be 1 if missing).  The wavelength of a pixel
+is then the weighted averge of the wavelengths of the two dispersion
+functions.  The task \fBrefspectra\fR provides a number of ways to assign
+reference spectra.  Note, however, that these assignments may be made
+directly using the task \fBhedit\fR or with some other task or script if
+none of the methods are suitable.  Also note that \fBidentify\fR and
+\fBreidentify\fR add the REFSPEC1 keyword refering to the image itself
+when a database entry is written.
+
+In addition to the one or two reference dispersion functions for each input
+aperture there may also be image header keywords REFSHFT1 and REFSHFT2
+specifying reference spectra whose dispersion function zero point shifts
+(the "shift" parameter in the database files) are to be applied to the
+reference dispersion functions.  The shifts from REFSHFT1 will be applied
+to the dispersion functions from REFSPEC1 and similarly for the second
+dispersion functions.  The reference shifts need not be present for every
+aperture in a multispectrum image.  By default the mean shift from all the
+reference apertures having a zero point shift is applied to all the
+reference dispersion functions.  If the REFSHFT keyword has the modifier
+word "nearest" following the spectrum name then the shift from the nearest
+aperture in spatial position (from the aperture extraction limits in the
+original 2D spectrum as recorded in the 6th and 7th fields of the APNUM
+keywords) is used for a particular input aperture.  If the modifier word is
+"interp" then the nearest two apertures are used to interpolate a zero
+point shift spatially.
+
+The purpose of the reference shift keywords is to apply a wavelength zero
+point correction to the reference dispersion functions determined from
+separate arc calibration observations using a few apertures taken at the
+same time as object observations.  For example, consider multifiber
+observations in which one or more fibers are assigned to arc lamps at the
+same time the other fibers are used to observe various objects.  The basic
+dispersion reference, the REFSPEC keywords, will come from arc observations
+taken through all the fibers.  The arc fibers used during an object
+observation are then calibrated against their corresponding fibers in the
+arc calibration observations to determine a zero point shift.  The REFSHFT
+keywords will contain the name of the object spectrum itself and the shifts
+from the simultaneous arc fibers will be interpolated spatially to the
+nonarc object fibers and applied to the dispersion functions from the arc
+calibrations for those fibers.
+
+The reference shift keywords are currently added with \fBhedit\fR and zero
+point shifts computed with \fBidentify/reidentify\fR.  The complexities of
+this have been hidden in the multifiber \fBimred\fR instrument reduction
+packages.  The reference shift correction feature was added primarily for
+use in those reduction packages.
+
+If the \fIlinearize\fR parameter is no the dispersion functions, weights,
+and shifts are transferred from the database to the world coordinate system
+keywords in the image header.  Except for printing processing information
+that is all that is done to the spectra.
+
+If the \fIlinearize\fR parameter is yes the spectra are interpolated to a
+linear wavelength scale and the dispersion coordinate system in the header
+is set apprpriately.  A linear wavelength coordinate system is defined by a
+starting wavelength, an ending wavelength, a wavelength interval per pixel,
+and the number of pixels.  These four parameters actually overspecify the
+coordinate system and only three of these values are needed to define it.
+The output coordinate system is specified by giving a set or subset of
+these parameters using the parameters \fIw1\fR, \fIw2\fR, \fIdw\fR, and
+\fInw\fR.
+
+When the \fIlog\fR option is used these parameters are still specified and
+computed in non-log units but the effective interval per pixel is
+
+.nf
+	dw_log = (log10(w2) - log10(w1)) / (nw - 1)
+	dw_log = (log10(w1+dw*(nw-1)) - log10(w1)) / (nw - 1)
+.fi
+
+In other words, the logarithmic interval divides the starting and ending
+wavelength into the required number of pixels in log step.  To avoid
+confusion in this case it is best to specify the starting and ending
+wavelengths (in non-log units) and the number of pixels.
+
+Note that if \fIlog\fR=yes the input spectra in either linear
+or log sampling will be resampled to produces an output spectrum in
+log sampling.  Similarly, if \fIlog\fR=no the input spectra will
+be resampled to linear sampling.  This means that log sampled input
+spectra will be resampled to linear sampling.
+
+Default values for any parameters which are not specified, by using the
+value INDEF, are supplied based on the wavelengths of the first and last
+pixel as given by the dispersion function and the number of pixels in the
+input image.  The defaults may either be determined separately for each
+spectrum (\fIglobal\fR = \fIno\fR), from all spectra with the same aperture
+(\fIglobal\fR = \fIyes\fR and \fIsamedisp\fR = \fIno\fR), or from all the
+spectra (\fIglobal\fR = \fIyes\fR and \fIsamedisp\fR = \fIyes\fR).  As
+indicated, the parameter \fIsamedisp\fR determines whether defaults are
+determined independently for each aperture or set the same for all
+apertures.
+
+Another way to specify the wavelengths when there are many apertures is to
+use a wavelength table or reference image.  If an spectrum image name is
+specified with the \fItable\fR parameter then the dispersion parameters for
+each apertures are set to be the same as the reference spectrum.
+Alternatively, a text file table consisting of lines containing an aperture
+number, the starting wavelength, the ending wavelength, the wavelength
+interval per pixel, and the number of output pixels may be specified.  Any
+of these values may be specified as INDEF (though usually the aperture
+number is not).  One way to view the wavelength table/reference spectrum is
+that an entry in the wavelength table/reference spectrum overrides the
+values of the parameters \fIw1\fR, \fIw2\fR, \fIdw\fR, and \fInw\fR, which
+normally apply to all apertures, for the specified aperture.  The
+wavelength table is used to specify explicit independent values for
+apertures.  The global mechanism can supply independent values for the
+INDEF parameters when the \fIsamedisp\fR parameter is no.
+
+If one wishes to verify and possibly change the defaults assigned,
+either globally or individually, the \fIconfirm\fR flag may be set.  The
+user is asked whether to accept these values.  By responding with no the
+user is given the chance to change each parameter value.  Then the new
+parameters are printed and the user is again asked to confirm the
+parameters.  This is repeated until the desired parameters are set.  When
+the defaults are not global the changed parameters will not be used for the
+next spectrum.  When the global option is used any changes made are
+retained (either for all apertures or independently for each aperture)
+until changed again.
+
+When adjusting the wavelengths the user should specify which parameter is
+free to change by entering INDEF.  If none of the parameters are specified
+as INDEF then those values which were not changed, i.e. by accepting the
+current value, are the first to be changed.
+
+Once the wavelength scale has been defined the input spectrum is
+interpolated for each output pixel.  Output wavelengths outside the range
+of the input spectrum are set to the value given by the \fIblank\fR parameter
+value.  The default interpolation function
+is a 5th order polynomial.  The choice of interpolation type is made
+with the package parameter "interp".  It may be set to "nearest",
+"linear", "spline3", "poly5", or "sinc".  Remember that this
+applies to all tasks which might need to interpolate spectra in the
+\fBonedspec\fR and associated packages.  For a discussion of interpolation
+types see \fBonedspec\fR.
+
+When it is desired to conserve total flux, particularly when the dispersion is
+significantly reduced, the parameter \fIflux\fR is set to yes and the
+output pixel value is obtained by integrating the interpolation function
+across the wavelength limits of the output pixel.  If it is set to no
+then the flux density is conserved by averaging across the output pixel
+limits.
+
+The input spectrum name, reference spectra, and the wavelength parameters
+will be printed on the standard output if the \fIverbose\fR parameter is
+set and printed to a log file if one is specified with the \fIlogfile\fR
+parameter.  If one wishes to only check what wavelengths will be determined
+for the defaults without actually dispersion correcting the spectra the
+\fIlistonly\fR flag may be set.
+
+Other tasks which may be used to change the dispersion coordinate system
+are \fBscopy\fR, \fBspecshift\fR, and \fBsapertures\fR.
+.ih
+EXAMPLES
+In the examples when the task is used in the IRS and IIDS packages,
+shown with the "ir>" prompt the spectra have a record number extension
+image name format and the records parameter must be specified.  In
+the other case shown with the "on>" prompt the records parameter is
+not used.
+
+1.  Dispersion correct spectra so that they have the same number of pixels
+and the wavelengths limits are set by the reference spectra.
+
+.nf
+ir> dispcor spec dcspec 9,10,447-448
+dcspec.0009: ap = 0, w1 = 5078.84, w2 = 6550.54, dw = 1.797, nw = 820
+dcspec.0010: ap = 1, w1 = 5078.71, w2 = 6552.81, dw = 1.800, nw = 820
+dcspec.0447: ap = 0, w1 = 5082.57, w2 = 6551.45, dw = 1.794, nw = 820
+dcspec.0448: ap = 1, w1 = 5082.03, w2 = 6553.66, dw = 1.797, nw = 820
+
+on> dispcor allspec.ms dcallspec.ms
+dcallspec.ms: ap = 1, w1 = 5078.84, w2 = 6550.54, dw = 1.797, nw = 820
+dcallspec.ms: ap = 2, w1 = 5078.71, w2 = 6552.81, dw = 1.800, nw = 820
+dcallspec.ms: ap = 3, w1 = 5082.57, w2 = 6551.45, dw = 1.794, nw = 820
+dcallspec.ms: ap = 4, w1 = 5082.03, w2 = 6553.66, dw = 1.797, nw = 820
+.fi
+
+2.  Confirm and change assignments.
+
+.nf
+on> dispcor spec* %spec%new%* confirm+
+new009: ap = 0, w1 = 5078.84, w2 = 6550.54, dw = 1.797, nw = 820
+  Change wavelength coordinate assignments? (yes):
+  Starting wavelength (5078.8421234): 5070
+  Ending wavelength (6550.535123):
+  Wavelength interval per pixel (1.79693812):
+  Number of output pixels (820): INDEF
+new009: ap = 0, w1 = 5070., w2 = 6550.53, dw = 1.795, nw = 826
+  Change wavelength coordinate assignments? (yes): no
+new010: ap = 1, w1 = 5078.71, w2 = 6552.81, dw = 1.800, nw = 820
+  Change wavelength coordinate assignments? (no): yes
+  Starting wavelength (5078.7071234): 5100
+  Ending wavelength (6550.805123): 6500
+  Wavelength interval per pixel (1.79987512): INDEF
+  Number of output pixels (820): INDEF
+new010: ap = 1, w1 = 5100., w2 = 6500., dw = 1.797, nw = 780
+  Change wavelength coordinate assignments? (yes): no
+new447: ap = 0, w1 = 5082.57, w2 = 6551.45, dw = 1.793, nw = 820
+  Change wavelength coordinate assignments? (yes): no
+new448: ap = 1, w1 = 5082.03, w2 = 6553.66, dw = 1.797, nw = 820
+  Change wavelength coordinate assignments? (no):
+.fi
+
+3. Confirm global assignments and do dispersion correction in place.
+record format.
+
+.nf
+ir> dispcor irs "" 9,10,447,448 confirm+ global+ samedisp+
+irs.0009: ap = 0, w1 = 5078.71, w2 = 6553.66, dw = 1.801, nw = 820
+  Change wavelength coordinate assignments? (yes):
+  Starting wavelength (5078.7071234): 5100
+  Ending wavelength (6553.664123): 6500
+  Wavelength interval per pixel (1.80092412):
+  Number of output pixels (820):
+irs.0009: ap = 0, w1 = 5100., w2 = 6500., dw = 1.799, nw = 779
+  Change wavelength coordinate assignments? (yes): no
+irs.0010: ap = 1, w1 = 5100., w2 = 6500., dw = 1.799, nw = 779
+  Change wavelength coordinate assignments? (no):
+irs.0447: ap = 0, w1 = 5100., w2 = 6500., dw = 1.799, nw = 779
+  Change wavelength coordinate assignments? (no):
+irs.0448: ap = 1, w1 = 5100., w2 = 6500., dw = 1.799, nw = 779
+  Change wavelength coordinate assignments? (no):
+.fi
+
+4. Make a nonlinear dispersion correction in place.
+
+.nf
+on> dispcor spec* ""  linearize=no verbose- logfile=logfile
+.fi
+
+5. Apply a single dispersion solution to a set of record number format
+images.
+
+ir> dispcor nite101 dcnite101 "1-10" ignore+ confirm-
+
+.ih
+REVISIONS
+.ls DISPCOR V2.12.3
+Added the blank parameter value.
+.le
+.ls DISPCOR V2.11.3
+Long slit and data cubes can be used with this task to either resample
+using the existing WCS or to use a single dispersion function from
+IDENTIFY.  It uses the first one found.
+.le
+.ls DISPCOR V2.10.3
+Provision was added for IDENTIFY dispersion solutions consisting of
+only a shift (as produced by the 'g' key in IDENTIFY or the refit=no
+flag in REIDENTIFY) to be applied to previously LINEARIZED spectra.
+Thus it is possible to use IDENIFY/REIDENTIFY to automatically
+compute a zero point shift based on 1 or more lines and then shift
+all the spectra to that zero point.
+
+DISPCOR will now allow multiple uses of IDENTIFY dispersion solutions
+in a simple way with but with continuing protection against accidental
+multiple uses of the same dispersion solutions.  When a spectrum is
+first dispersion corrected using one or more reference spectra keywords
+the dispersion flag is set and the reference spectra keywords are moved to
+DCLOGn keywords.  If DISPCOR is called again without setting new
+reference spectra keywords then the spectra are resampled (rebinned)
+using the current coordinate system.  If new reference spectra are set
+then DISPCOR will apply these new dispersion functions.  Thus the user
+now explicitly enables multiple dispersion functions by adding
+reference spectra keywords and DISPCOR eliminates accidental multiple
+uses of the same dispersion function by renaming the reference
+spectra.  The renamed keywords also provide a history.
+
+The flux conservation option now computes an average across the
+output pixel rather than interpolating to the middle of the output
+pixel when \fIflux\fR is no.  This preserves the flux density and
+includes all the data; i.e. a coarse resampling will not eliminate
+features which don't fall at the output pixel coordinates.
+
+Some additional log and verbose output was added to better inform the
+user about what is done.
+
+Better error information is now printed if a database dispersion function
+is not found.
+.le
+.ls DISPCOR V2.10
+This is a new version with many differences.  It replaces the previous
+three tasks \fBdispcor, ecdispcor\fR and \fBmsdispcor\fR.  It applies both
+one dimensional and echelle dispersion functions.  The new parameter
+\fIlinearize\fR selects whether to interpolate the spectra to a uniform
+linear dispersion (the only option available previously) or to assign a
+nonlinear dispersion function to the image without any interpolation.  The
+interpolation function parameter has been eliminated and the package
+parameter \fIinterp\fR is used to select the interpolation function.  The
+new interpolation type "sinc" may be used but care should be exercised.
+The new task supports applying a secondary zero point shift spectrum to a
+master dispersion function and a spatial interpolation of the shifts when
+calibration spectra are taken at the same time on a different region of the
+same 2D image.  The optional wavelength table may now also be an image to
+match dispersion parameters.  The \fIapertures\fR and \fIrebin\fR
+parameters have been eliminated.  If an input spectrum has been previously
+dispersion corrected it will be resampled as desired.  Verbose and log file
+parameters have been added to log the dispersion operations as desired.
+The record format syntax is available in the \fBirs/iids\fR packages.
+.le
+.ih
+SEE ALSO
+package, refspectra, scopy, specshift, sapertures
+.endhelp
diff --git a/noao/onedspec/doc/disptrans.hlp b/noao/onedspec/doc/disptrans.hlp
new file mode 100644
index 00000000..d73a4cb4
--- /dev/null
+++ b/noao/onedspec/doc/disptrans.hlp
@@ -0,0 +1,193 @@
+.help disptrans Aug94 noao.onedspec
+.ih
+NAME
+disptrans -- Transform dispersion units and apply air correction
+.ih
+USAGE
+disptrans input output units
+.ih
+PARAMETERS
+.ls input
+List of dispersion calibrated input spectra to be dispersion transformed.
+.le
+.ls output
+List of output dispersion transformed spectra.  If given the input names
+(or a null list), each input spectrum will be replaced by the transformed
+output spectrum.
+.le
+.ls units
+Output dispersion units.  A wide range of dispersion units may be
+specified and they are described in the UNITS section.
+.le
+.ls error = 0.01
+Maximum error allowed in the output dispersion transformation expressed
+as a pixel error; that is, the equivalent pixel shift in the output
+dispersion function corresponding to the maximum difference between
+the exact transformation and the dispersion function approximation.
+The smaller the allowed error the higher the order of dispersion
+function used.
+.le
+.ls linearize = no
+Resample the spectrum data to linear increments in the output dispersion
+system?  If no then the output dispersion function is stored in the
+spectrum header and if yes the spectrum is resampled into the same
+number of pixels over the same dispersion range but in even steps
+of the output dispersion units.
+.le
+.ls verbose = yes
+Print a log of each spectrum transformed to the standard output?
+.le
+
+.ls air = "none" (none|air2vac|vac2air)
+Apply an air to vacuum or vacuum to air conversion?  It is the
+responsibility of the user to know whether the input dispersion
+is in air or vacuum units and to select the appropriate conversion.
+The conversion types are "none" for no conversion, "air2vac" to
+convert from air to vacuum, and "vac2air" to convert from vacuum
+to air.
+.le
+.ls t = 15, p = 760, f = 4
+Temperature t in degrees C, pressure p in mmHg, and water vapour pressure f
+in mmHg for the air index of refraction.
+.le
+
+OTHER PARAMETERS
+
+.ls interp = "poly5" (nearest|linear|poly3|poly5|spline3|sinc)
+Spectrum interpolation type used when spectra are resampled.  The choices are:
+
+.nf
+	nearest - nearest neighbor
+	 linear - linear
+	  poly3 - 3rd order polynomial
+	  poly5 - 5th order polynomial
+	spline3 - cubic spline
+	   sinc - sinc function
+.fi
+.le
+.ih
+DESCRIPTION
+The dispersion function in the input spectra, y = f(x) where x is the
+pixel coordinate and y is the input dispersion coordinate, is
+transformed to y' = g(x) where y' is in the new dispersion units.  This is done
+by evaluating the input dispersion coordinate y at each pixel, applying an
+air to vacuum or vacuum to air conversion if desired, and applying the
+specified unit transformation y' = h(y).  Since the transformations are
+nonlinear functions and the output dispersion function must be expressed in
+polynomial form, the function g(x) is determined by fitting a cubic spline
+to the set of x and y' values.  The lowest number of spline pieces is used
+which satisfies the specified error.  Note that this error is not a random
+error but difference between the smooth fitted function and the smooth
+dispersion function in the header.  As a special case, the first
+fit tried is a linear function.  If this satisfies the error condition
+then a simpler dispersion description is possible.  Also this is
+appropriate for dispersion units which are simply related by a
+scale change such as Angstroms to nanometers or Hertz to Mev.
+
+The error condition is that the maximum difference between the exact or
+analytic (the air/vacuum conversion is never exact) transformation and the
+fitted function value at any pixel be less than the equivalent shift in
+pixel coordinate evaluated at that point.  The reason for using an error
+condition in terms of pixels is that it is independent of the dispersion of
+the spectra and the resolution of spectra is ultimately limited by the
+pixel sampling.
+
+After the new dispersion function is determined the function is either
+stored in the coordinate system description for the spectrum or used to
+resample the pixels to linear increments in the output dispersion units.
+The resampling is not done if the new dispersion function is already linear
+as noted above.  The sampling uses the mean value over the input spectrum
+covered by an output spectrum pixel (it is flux per unit dispersion element
+preserving as opposed to flux/counts preserving).  The linear sampling
+parameters are limited to producing the same number of output pixels as
+input pixels over the same range of dispersion.  If one wants to have more
+control over the resampling then the \fIlinearize\fR parameter should be
+set to no and the task \fBdispcor\fR used on the output spectrum.
+
+Note that an alternative to using this task is to do the original
+dispersion calibration (based on calibration spectra) with IDENTIFY
+and DISPCOR in the desired units.  However, currently the standard
+lines lists are in Angstroms.  There are, however, linelists for
+He-Ne-Ar, Th-Ar, and Th in vacuum wavelengths.
+.ih
+UNITS
+The dispersion units are specified by strings having a unit type from the
+list below along with the possible preceding modifiers, "inverse", to
+select the inverse of the unit and "log" to select logarithmic units. For
+example "log angstroms" to select the logarithm of wavelength in Angstroms
+and "inv microns" to select inverse microns.  The various identifiers may
+be abbreviated as words but the syntax is not sophisticated enough to
+recognized standard scientific abbreviations except for those given
+explicitly below.
+
+.nf
+	   angstroms - Wavelength in Angstroms
+	  nanometers - Wavelength in nanometers
+	millimicrons - Wavelength in millimicrons
+	     microns - Wavelength in microns
+	 millimeters - Wavelength in millimeters
+	  centimeter - Wavelength in centimeters
+	      meters - Wavelength in meters
+	       hertz - Frequency in hertz (cycles per second)
+	   kilohertz - Frequency in kilohertz
+	   megahertz - Frequency in megahertz
+	    gigahertz - Frequency in gigahertz
+	         m/s - Velocity in meters per second
+	        km/s - Velocity in kilometers per second
+	          ev - Energy in electron volts
+	         kev - Energy in kilo electron volts
+	         mev - Energy in mega electron volts
+
+	          nm - Wavelength in nanometers
+	          mm - Wavelength in millimeters
+	          cm - Wavelength in centimeters
+	           m - Wavelength in meters
+	          Hz - Frequency in hertz (cycles per second)
+	         KHz - Frequency in kilohertz
+	         MHz - Frequency in megahertz
+	         GHz - Frequency in gigahertz
+		  wn - Wave number (inverse centimeters)
+.fi
+
+The velocity units require a trailing value and unit defining the
+velocity zero point.  For example to transform to velocity relative to
+a wavelength of 1 micron the unit string would be:
+
+.nf
+	km/s 1 micron
+.fi
+.ih
+AIR/VACUUM CONVERSION
+The air to vacuum and vacuum to air conversions are obtained by multiplying
+or dividing by the air index of refraction as computed from the
+formulas in Allen's Astrophysical Quantities (p. 124 in 1973 edition).
+These formulas include temperature, pressure, and water vapour terms
+with the default values being the standard ones.
+.ih
+EXAMPLES
+1. Convert a spectrum dispersion calibrated in Angstroms to electron
+volts and resample to a linear sampling.
+
+.nf
+    cl> disptrans spec1 evspec1 ev linear+
+    evspec1: Dispersion transformed to ev.
+.fi
+
+2. Apply an air to vacuum correction to an echelle spectrum using the
+default standard temperature and pressure.  Don't resample but rather use
+a nonlinear dispersion function.
+
+.nf
+    cl> disptrans highres.ec vac.ec angs air=air2vac
+    vac.ec: Dispersion transformed to angstroms in vacuum with
+      t = 15. C, p = 760. mmHg, f = 4. mmHg.
+.fi
+.ih
+REVISIONS
+.ls DISPTRANS V2.10.4
+New task with this release.
+.le
+.ih
+SEE ALSO
+dispcor, identify, scopy, dopcor
+.endhelp
diff --git a/noao/onedspec/doc/dopcor.hlp b/noao/onedspec/doc/dopcor.hlp
new file mode 100644
index 00000000..6bcd0992
--- /dev/null
+++ b/noao/onedspec/doc/dopcor.hlp
@@ -0,0 +1,184 @@
+.help dopcor Jun94 noao.onedspec
+.ih
+NAME
+dopcor -- Apply doppler correction
+.ih
+USAGE
+dopcor input output redshift
+.ih
+PARAMETERS
+.ls input
+List of input spectra to be doppler corrected.
+.le
+.ls output
+List of doppler corrected spectra.  If no output list is specified then
+the input spectra are modified.  Also the output name may be
+the same as the input name to replace the input spectra by the
+calibrated spectra.
+.le
+.ls redshift
+Redshift or radial velocity (km/s) to be removed?  The spectra are corrected so
+that the specified redshift is removed; i.e. spectra with a positive
+velocity are shifted to shorter wavelengths and vice-versa.  This parameter
+may be either a number or an image header keyword with the desired redshift
+or velocity value.  An image header keyword may also have an initial minus
+sign, '-', to specify the negative of a velocity or the redshift complement
+(1/(1+z)-1) of a redshift.  The choice between a redshift and a velocity is
+made with the \fIisvelocity\fR parameter.
+.le
+.ls isvelocity = no
+Is the value specified by the \fIredshift\fR parameter a velocity?  If
+no then the value is interpreted as a redshift and if it is yes then
+it is interpreted as a physical  velocity in kilometers per second.  Note that
+this is a relativistic velocity and not c*z!  For nearby cosmological
+velocities users should specify a redshift (z = v_cosmological / c).
+.le
+.ls add = no
+Add doppler correction to existing correction in "multispec" spectra?
+.le
+.ls dispersion = yes
+Apply a correction to the dispersion function?
+.le
+.ls flux = no
+Apply a flux correction?
+.le
+.ls factor = 3
+Flux correction factor as a power of 1+z when applying a flux correction.
+.le
+.ls apertures = ""
+List of apertures to be corrected.  If none are specified then all apertures
+are corrected.  An aperture list consists of comma separated aperture
+number or aperture number ranges.  A range is hypen separated and may
+include an interval step following the character 'x'.  See \fBranges\fR
+for further information.  For N-dimensional spatial spectra such as
+long slit and Fabry-Perot spectra this parameter is ignored.
+.le
+.ls verbose = no
+Print corrections performed?  The information includes the output image
+name, the apertures, the redshift, and the flux correction factor.
+.le
+.ih
+DESCRIPTION
+The input spectra (as specified by the input image list and apertures) are
+corrected by removing a specified doppler shift and written to the
+specified output images.  The correction is such that if the actual
+shift of the observed object is specified then the corrected spectra
+will be the rest spectra.  The opposite sign for a velocity or the
+redshift complement (1/(1+z)-1) may be used to add a doppler shift
+to a spectrum.
+
+There are two common usages.  One is to take spectra with high doppler
+velocities, such as cosmological sources, and correct them to rest with
+respect to the earth.  In this case the measured redshift or velocity is
+specified to "remove" this component.  The other usage is to correct
+spectra to heliocentric or local standard of rest.  The heliocentric or LSR
+velocities can be computed and entered in the image header with the task
+\fBrvcorrect\fR.  In this case it is tempting to again think you are
+"removing" the velocity so that you specify the velocity as given in the
+header.  But actually what is needed is to "add" the computed standard of
+rest velocity to the observed spectrum taken with respect to the telescope
+to place the dispersion in the desired center of rest.  Thus, in this case
+you specify the opposite of the computed heliocentric or LSR velocity; i.e.
+use a negative.
+
+The redshift or space velocity in km/s is specified either as a number or
+as an image header keyword containing the velocity or redshift.  If a
+number is given it applies to all the input spectra while an image header
+keyword may differ for each image.  The latter method of specifying a
+velocity is useful if velocity corrections are recorded in the image
+header.  See \fBrvcorrect\fR for example.
+
+The choice between a redshift and a space velocity for the \fIredshift\fR
+parameter is made using the \fIisvelocity\fR parameter. If isvelocity=yes
+then the header dispersion solution is modified according to the
+relativistic Doppler correction:
+
+	lambda_new = lamda_old * sqrt((1 + v/c)/(1 - v/c))
+
+where v is the value of "redshift".  If isvelocity=no, \fIredshift\fR is
+interpreted as a cosmological redshift and the header dispersion solution
+is modified to give:
+
+	lambda_new = lamda_old * z
+
+where z is the value of "redshift"
+
+If the \fIadd\fR parameter is used and the image uses a "multispec"
+format where the previous doppler factor is stored separately
+then the new doppler factor is:
+
+	znew = (1 + z) * (1 + zold) - 1 = z + zold + z * zold
+
+where z is the specified doppler factor, zold is the previous one,
+and znew is the final doppler factor.  If the \fIadd\fR parameter
+is no then the previous correction is replaced by the new correction.
+Note that for images using a linear or equispec coordinate system
+the corrections are always additive since a record is not kept of
+the previous correction.  Also any flux correction is made based
+on the specified doppler correction rather than znew.
+
+There are two corrections which may be made and the user selects one
+or both of these.  A correction to the dispersion function is selected
+with the \fIdispersion\fR parameter.  This correction is a term to be
+applied to the dispersion coordinates defined for the image.  \fIThe spectrum
+is not resampled, only the dispersion coordinate function is affected\fR.
+A correction to the flux, pixel values, is selected with the \fIflux\fR
+parameter.  This correction is only significant for cosmological redshifts.
+As such the correction is dependent on a cosmological model as well as
+whether a total flux or surface brightness is measured.  To provide the
+range of possible corrections the flux correction factor is defined by
+the \fIfactor\fR parameter as the power of 1+z (where z is the
+redshift) to be multiplied into the observed pixel values.
+
+A keyword DOPCORnn is added to the image header.  The index starts from
+01 and increments if multiple corrections are applied.  The value of
+the keywords gives the redshift applied, the flux factor if used, and
+the apertures which were corrected.
+.ih
+EXAMPLES
+1.  To dispersion and flux correct a quasar spectrum with redshift of
+3.2 to a rest frame:
+
+.nf
+	cl> dopcor qso001.ms qso001rest.ms 3.2 flux+
+.fi
+
+2.  To correct a set of spectra (in place) to heliocentric rest the task
+\fBrvcorrect\fR is used to set the VHELIO keyword using an observed
+velocity of 0.  Then:
+
+.nf
+	cl> dopcor *.imh "" -vhelio isvel+
+.fi
+
+3.  To artificially add a redshift of 3.2 to a spectrum the complementary
+redshift is computed:
+
+.nf
+	cl> = 1/(1+3.2)-1
+	-0.76190476190476
+	cl> dopcor artspec "" -0.762 flux+
+.fi
+.ih
+REVISIONS
+.ls DOPCOR V2.10.3
+This task was extended to work on two and three dimensional spatial spectra
+such as long slit and Fabry-Perot spectra.
+
+The \fIadd\fR parameter was added.
+.le
+.ls DOPCOR V2.10.3
+A keyword is added to log the correction applied.
+.le
+.ls DOPCOR V2.10.2
+A sign error in converting velocity to redshift was fixed.  A validity
+check on the velocities and redshifts was added.  The documentation
+was corrected and improved.
+.le
+.ls DOPCOR V2.10
+This task is new.
+.le
+.ih
+SEE ALSO
+ranges, rvcorrect
+.endhelp
diff --git a/noao/onedspec/doc/fitprofs.hlp b/noao/onedspec/doc/fitprofs.hlp
new file mode 100644
index 00000000..ed21e7b1
--- /dev/null
+++ b/noao/onedspec/doc/fitprofs.hlp
@@ -0,0 +1,403 @@
+.help fitprofs Mar92 noao.onedspec
+.ih
+NAME
+fitprofs -- Fit 1D profiles to features in image vectors
+.ih
+USAGE
+fitprofs input
+.ih
+PARAMETERS
+.ls input
+List of input images to be fit.  The images may be one dimensional
+spectra (one or more spectra per image) or long slit spectra.  Other
+types of nonspectral images may also be used and for two dimensional
+images the fitting direction will be determined from either the keyword
+DISPAXIS in the image header or the \fIdispaxis\fR parameter.
+.le
+.ls lines = ""
+List of lines, columns, or apertures to be selected from the input image
+format.  The default empty list, "", selects all vectors in the images.
+The syntax is a list of comma separated numbers or ranges, where a range
+is a pair of hyphen separated numbers.
+.le
+.ls bands = ""
+List of bands for 3D images.  The empty list, "", selects all bands.
+.le
+.ls dispaxis = ")_.dispaxis", nsum = ")_.nsum"
+Parameters for defining vectors in 2D and 3D images.  The
+dispersion axis is 1 for line vectors, 2 for column vectors, and 3 for band
+vectors.  A DISPAXIS parameter in the image header has precedence over the
+\fIdispaxis\fR parameter.  The default values defer to the package
+parameters of the same name.
+.le
+
+The following are the fitting parameters.
+.ls region = ""
+Region of the input vectors to be fit specified as a pair of space
+separated numbers.  The coordinates are defined in terms of the linear
+image header coordinate parameters.  For dispersion corrected spectra this
+is usually wavelength in Angstroms and for other data it is usually pixels.
+A fitting region must be specified.
+.le
+.ls positions = ""
+File of initial or fixed profile positions and (optional) peaks, profile
+types, and widths.  The
+format consists of lines with one or more whitespace separated fields.
+The fields are the position, peak relative to the continuum with
+negative values being absorption, profile type of gaussian, lorentzian,
+or voigt, and the gaussian and/or lorentzian full width at half maximum.
+Trailing fields may be missing and fields to be set from default parameters
+or the image data (the peak value) may be given as INDEF.
+Comments and any additional columns are ignored.  The positions and
+widths are specified in the coordinate units of the image, usually
+wavelength for dispersion corrected spectra and pixels otherwise.
+.le
+.ls background = ""
+Background values defining the linear background.  If not specified the
+single pixel values nearest the fitting region endpoints are used.
+Otherwise two whitespace separated values are expected.  If a value is
+a number then that is the background at the lower or upper end of the
+fitting region (ordered in pixel space not wavelength).  The special
+values "avg(w1,w2,z)" or "med(w1,w2,z)" (note that there can be no
+whitespace) may be specified, where w1 and w2 are dispersion values, and z
+is a multiplier.  This will take the average or median of pixels within the
+specified range and multiply the result by the third argument.  The
+dispersion point used for that value in computing the linear background is
+the average of the dispersion coordinates of the pixels used.
+.le
+.ls profile = "gaussian" (gaussian|lorentzian|voigt)
+Default profile type to be fit when a profile type is not specified in
+the positions file.  The type are "gaussian", "lorentzian", or "voigt".
+.le
+.ls gfwhm = 20., lfwhm = 20.
+Default gaussian and lorentzian full width at half maximum (FWHM).
+These values are used for the initial and/or fixed width when they are
+not specified in the position file.
+.le
+.ls fitbackground = yes
+Fit the background?  If "yes" a linear background across the fitting region
+will be fit simultaneously with the profiles.  If "no" the background will
+be fixed.
+.le
+.ls fitpositions = "all"
+Position fitting option.  This may be "fixed" to fix all positions at their
+initial values, "single" to fit a single shift to the positions while
+keeping their separations fixed, or "all" to independently fit all the
+positions.
+.le
+.ls fitgfwhm = "all", fitlfwhm = "all"
+Profile width fitting options.  These may be "fixed" to fix all widths
+at their initial values, "single" to fit a single scale factor to the initial
+widths, or "all" to independently fit all the widths.
+.le
+
+The following parameters are used for error estimates as described
+below in the ERROR ESTIMATES section.
+.ls nerrsample = 0
+Number of samples for the error computation.  A value less than 10 turns
+off the error computation.  A value of ~10 does a rough error analysis, a
+value of ~50 does a reasonable error analysis, and a value >100 does a
+detailed error analysis.  The larger this value the longer the analysis
+takes.
+.le
+.ls sigma0 = INDEF, invgain = INDEF
+The pixel sigmas are modeled by the formula:
+
+.nf
+    sigma**2 = sigma0**2 + invgain * I
+.fi
+
+where I is the pixel value and "**2" means the square of the quantity.  If
+either parameter is specified as INDEF or with a value less than zero then
+no sigma estimates are made and so no error estimates for the measured
+parameters is made.
+.le
+
+The following parameters determine the output of the task.
+.ls components = ""
+All profiles defined by the position file are simultaneously fit but only
+a subset of the fitted profiles may be selected for output.  A profile
+or component is identified by the order number in the position file;
+i.e. the first entry in the position file is 1, the second is 2, etc.
+The components to be output are specified by a range list.  The empty
+list, "", selects all profiles.
+.le
+.ls verbose = yes
+Print fitting results and record of output images created on the
+standard output (normally the terminal).
+The fitting information is printed to the logfile so there is normally
+no need to redirect this output.  The output may be turned off when
+the task is run as a background task.
+.le
+.ls logfile = "logfile"
+Logfile for fitting results.  If not specified the results will not be
+logged.
+.le
+.ls plotfile = "plotfile"
+File to contain plot output.  The plots show the image vector with
+overplots of the total fit, the individual components, and the residuals.
+The plotfile may be examined and manipulated later with tools such as
+\fBgkimosaic\fR.
+.le
+.ls output = ""
+List of output images.  If not specified then no output images are created.
+If images are specified the list is matched with the input list.
+.le
+.ls option = "fit" (fit|difference)
+Image output option.  The choices are "fit" to output the fitted image
+vector which is the sum of the fitted profiles (without a background),
+or "difference" to output the data with the profiles subtracted.
+.le
+.ls clobber = no, merge = no
+Clobber or modify any existing output images?  If clobbering is not
+enabled a warning is printed and any existing output images are not
+modified.  If clobbering is enabled then either new images are created
+if merge is "no" or the new fits are merged with the existing images.
+Merging is meaningful when only a subset of the input is fit such
+as selected lines or apertures.
+.le
+.ih
+DESCRIPTION
+\fBFitprofs\fR fits one dimensional profile functions to image vectors
+and outputs the fitting parameters, plots, and model or residual
+image vectors.  This is done noninteractively using a file of initial
+profile positions and widths.  Interactive profile fitting may be
+done with the deblending option of \fBsplot\fR or
+\fBstsdas.fitting.ngaussfit\fR.
+
+The input consists of images in a variety of formats.  These include
+all the spectral formats as well as standard images.  For two dimensional
+images (or the first 2D plane of higher dimensional images) either the
+lines or columns may be fit with possible summing of adjacent lines or
+columns to increase the signal-to-noise.  A subset of the image apertures,
+lines, or columns may be specified or all image vectors may be fit.
+
+The fitting parameters consist of a fitting region, a list of initial
+positions, peaks, and widths, initial background endpoints, the fitting
+function, and the parameters to be fit or constrained.  The coordinates and
+units used for the positions and widths are those defined by the standard
+linear coordinate header parameters.  For dispersion corrected spectra
+these are generally wavelengths in Angstroms and otherwise they are
+generally pixels.  A fitting region must be specified by a pair of
+numbers.
+
+The background parameter may be left empty to select the pixel values at
+the endpoints of the fitting region for defining the initial linear
+background.  Or values at the endpoints of the fitting region may be given
+explicitly in pixel space order (i.e. the first value is for the edge of
+the fitting region which has smaller pixel coordinate0 Values can also be
+computed from the data using the functions "avg(w1,w2)" or "med(w1,w2)"
+where w1 and w2 are dispersion coordinates.  The pixels in the specified
+range are average or medianed and the dispersion point for the linear
+background is the average of the dispersion coordinates of the pixels.
+
+The position list file consists of one or more columns.
+The format of this file has
+one or more columns.  The columns are the wavelength, the peak value
+(relative to the continuum with negative values being absorption),
+the profile type (gaussian, lorentzian, or voigt), and the
+gaussian and/or lorentzian FWHM.  End columns may be missing
+or INDEF values may be specified to use the default parameter
+values (the profile and widths) or determine the peak from the data.
+Below are examples of the file line formats
+
+.nf
+	wavelength
+	wavelength peak
+	wavelength peak (gaussian|lorenzian|voigt)
+	wavelength peak gaussian gfwhm
+	wavelength peak lorentzian lfwhm
+	wavelength peak voigt gfwhm
+	wavelength peak voigt gfwhm lfwhm
+
+	1234.5			<- Wavelength only
+	1234.5 -100		<- Wavelength and peak
+	1234.5 INDEF v		<- Wavelength and profile type
+	1234.5 INDEF g 12	<- Wavelength and gaussian FWHM
+.fi
+
+where peak is the peak value, gfwhm is the gaussian FWHM, and lfwhm is
+the lorentzian FWHM.  This format is the same as used by \fBsplot\fR
+and also by \fBartdata.mk1dspec\fR (except in the latter case the
+peak is normalized to a continuum of 1).
+
+The profile parameters fit are the central position, the peak amplitude,
+and the profile widths.  The fitting may be constrained in number of ways.
+The linear background may be fixed or simultaneously fit with the
+profiles.  The profile positions may be fixed, the relative separations
+fixed but a single zero point shift fit, or all positions may be fit
+simultaneously.  The profile widths may also be fixed, the relative ratios
+of the widths fixed while fitting a single scale factor, or all widths fit
+simultaneously.  The profile amplitudes are always fit.
+
+The fitting technique uses a nonlinear iterative Levenberg-Marquardt
+algorithm to reduce the Chi-square of the fit.  The execution time
+increases rapidly with the number of profiles fit so there is an
+effective limit to the number of profiles that can be fit at once.
+
+The output includes a number of formats.  The fitted parameters  are
+recorded in a logfile (if specified) and printed on the standard
+output (if the verbose flag is set).  This output includes the date,
+image vector, fitting parameters used, and a table of fitted or
+derived quantities.  The parameters included some quantities relevant to
+spectral lines but others apply to any image data.  The quantities are
+the profile center, the background or continuum at the center of the
+profile, the integral or flux of the profile (which is negative for
+profiles below the background), the equivalent width, the profile peak
+amplitude or core value, and the profile full width at half
+maximum.  Pure gaussian and lorentzian profiles will have one of
+the widths set to zero while voigt profiles will have both values.
+
+Summary plots are recored in a plotfile (if specified).  The plots
+show the data with the total fit, individual profiles, and residuals
+overplotted.  The plotfile may be examined and printed using the
+task \fBgkimosaic\fR as well as other tasks which interpret GKI metacode.
+
+The final output consists of images in the same format as the input.
+The images  may be of the total fit (sum of profiles without background)
+or of the difference (residuals) of the data minus the model.
+.ih
+ERROR ESTIMATES
+Error estimates may be computed for the fitted parameters.
+This requires a model for the pixel sigmas.  Currently this
+model is based on a Poisson statistics model of the data.  The model
+parameters are a constant Gaussian sigma and an "inverse gain" as specified
+by the parameters \fIsigma0\fR and \fIinvgain\fR.  These parameters are
+used to compute the pixel value sigma from the following formula:
+
+.nf
+    sigma**2 = sigma0**2 + invgain * I
+.fi
+
+where I is the pixel value and "**2" means the square of the quantity.
+
+If either the constant sigma or the inverse gain are specified as INDEF or
+with values less than zero then no noise model is applied and no error
+estimates are computed.  Also if the number of error samples is less than
+10 then no error estimates are computed.  Note that for processed spectra
+this noise model will not generally be the same as the detector readout
+noise and gain.  These parameters would need to be estimated in some way
+using the statistics of the spectrum.  The use of an inverse gain rather
+than a direct gain was choosed to allow a value of zero for this
+parameters.  This provides a model with constant uncertainties.
+
+The error estimates are computed by Monte-Carlo simulation.  The model is
+fit to the data (using the noise sigmas) and this model is used to describe
+the noise-free spectrum.  A number of simulations, given by the
+\fInerrsample\fR, are created in which random Gaussian noise is added to
+the noise-free spectrum based on the pixel sigmas from the noise model.
+The model fitting is done for each simulation and the absolute deviation of
+each fitted parameter to model parameter is recorded.  The error estimate
+for the each parameter is then the absolute deviation containing 68.3% of
+the parameter estimates.  This corresponds to one sigma if the distribution
+of parameter estimates is Gaussian though this method does not assume
+this.
+
+The Monte-Carlo technique automatically includes all effects of
+parameter correlations and does not depend on any approximations.
+However the computation of the errors does take a significant
+amount of time.  The amount of time and the accuracy of the
+error estimates depend on how many simulations are done.  A
+small number of samples (of order 10) is fast but gives crude
+estimates.  A large number (greater than 100) is slow but gives
+very good estimates.  A compromise value of 50 is recommended
+for many applications.
+
+.ih
+EXAMPLES
+1.  The following example creates an artificial spectrum and fits it.
+It requires the \fBartdata\fR and \fBproto\fR packages be loaded.
+
+.nf
+    cl> mk1dspec test slope=1 temp=0 lines=testlines nl=20
+    cl> mknoise test rdnoise=10 poisson=yes
+    cl> fields testlines fields=1,3 > fitlines
+    cl> fitprofs test reg="4000 8000" pos=fitlines
+    # Jul 27 17:49 test - Ap 1: 
+    # Nfit=20, background=YES, positions=all, gfwhm=all, lfwhm=all
+    #   center      cont      flux      eqw      core   gfwhm   lfwhm
+      6832.611  1363.188  -13461.8    9.875  -408.339   30.97      0.
+      7963.674  1507.641  -8193.58    5.435  -395.207   19.48      0.
+      5688.055   1217.01  -7075.11    5.814  -392.006   16.96      0.
+	6831.3   1363.02  -7102.01     5.21  -456.463   14.62      0.
+      7217.335  1412.323   -10110.    7.158  -427.797    22.2      0.
+      6709.286  1347.437  -4985.06      3.7  -225.346   20.78      0.
+      6434.317  1312.319  -7121.03    5.426  -342.849   19.51      0.
+      6130.415  1273.506    -6164.     4.84  -224.146   25.83      0.
+      4569.375  1074.138   -3904.6    3.635  -183.963   19.94      0.
+      5656.645  1212.999  -8202.81    6.762  -303.617   25.38      0.
+       4219.53  1029.458  -5161.64    5.014  -241.135   20.11      0.
+      4551.424  1071.845  -3802.61    3.548   -139.39   25.63      0.
+      4604.649  1078.643  -5539.15    5.135  -264.654   19.66      0.
+      6966.557  1380.294  -11717.5    8.489  -600.581   18.33      0.
+      4259.019  1034.501  -4280.38    4.138  -213.446   18.84      0.
+      5952.958  1250.843  -8006.98    6.401  -318.313   23.63      0.
+       4531.89  1069.351  -712.598   0.6664  -155.197   4.313      0.
+      7814.418  1488.579  -2926.49    1.966  -164.891   16.67      0.
+      5310.929  1168.846  -10132.2    8.669  -487.502   19.53      0.
+      5022.948  1132.066   -7532.8    6.654  -325.594   21.73      0.
+
+.fi
+
+2.  Suppose there is no obvious continuum level near the fitting
+region but you want to specify a flat continuum level as the average
+of pixels in a specified wavelength region.  The background region
+would be specified as
+
+.nf
+    background = "avg(4250,4425.3) avg(4250,4425.3)"
+.fi
+
+Note that the value must be given twice to get a flat continuum.
+.ih
+REVISIONS
+.ls FITPROFS V2.11.3
+Modified to allow a more general specification of the background.
+.le
+.ls FITPROFS V2.11
+Modified to include lorentzian and voigt profiles.  The parameters and
+positions file format have changed in this version.  A new parameter
+controls the number of Monte-Carlo samples used in the error estimates.
+.le
+.ls FITPROFS V2.10.3
+Error estimates based on a simple noise model are now computed.
+.le
+.ls FITPROFS V2.10
+This task is new.
+.le
+.ih
+TIME REQUIREMENTS
+The following CPU times were obtained with a Sun Sparcstation I.  The
+number of pixels in the fitting region and the number of lines fit
+were varied.   The worst case of fitting all parameters and a background
+was considered as well as the constrained case of  fitting line positions
+and a single width with fixed background.
+
+.nf
+	Npixels Nprofs Fitbkg Fitpos  Fitsig   CPU(sec)
+	  100	   5	 yes	all	all	  1.9
+	  100	  10	 yes	all	all	  3.3
+	  100	  15	 yes	all	all	  5.6
+	  100	  20	 yes	all	all	  9.0
+	  512	   5	 yes	all	all	  4.7
+	  512	  10	 yes	all	all	 10.0
+	  512	  15	 yes	all	all	 17.6
+	  512	  20	 yes	all	all	 27.8
+	 1000	   5	 yes	all	all	  8.0
+	 1000	  10	 yes	all	all	 18.0
+	 1000	  15	 yes	all	all	 31.8
+	 1000	  20	 yes	all	all	 50.2
+	 1000	  25	 yes	all	all	 72.8
+	 1000	  30	 yes	all	all	100.2
+	  512	   5	  no	all  single	  2.8
+	  512	  10	  no	all  single	  5.3
+	  512	  15	  no	all  single	  8.6
+	  512	  20	  no	all  single	 12.8
+.fi
+
+Crudely this implies CPU time goes as the 1.4 power of the number of profiles
+and the 0.75 power of the number of pixels.
+.ih
+SEE ALSO
+splot, stsdas.fitting.ngaussfit
+.endhelp
diff --git a/noao/onedspec/doc/identify.hlp b/noao/onedspec/doc/identify.hlp
new file mode 100644
index 00000000..fea7086c
--- /dev/null
+++ b/noao/onedspec/doc/identify.hlp
@@ -0,0 +1,810 @@
+.help identify Jan96 noao.onedspec
+.ih
+NAME
+identify -- Identify features in one dimensional image vectors
+.ih
+SUMMARY
+Features are interactively marked in one dimensional image vectors.
+The features may be spectral lines when the vector is a spectrum
+or profile positions when the vector is a spatial cut.  A function
+may be fit to the user coordinates as a function of pixel coordinates.
+This is primarily used to find dispersion functions for spectra
+such as arc-line calibration spectra.  The profile position measurements
+are generally used for geometric calibrations.
+.ih
+USAGE
+identify images
+.ih
+PARAMETERS
+.ls images
+List of images in which to identify features and fit coordinate functions.
+.le
+.ls section = "middle line"
+If an image is not one dimensional or specified as a one dimensional image
+section then the image section given by this parameter is used.  The
+section defines a one dimensional vector.  The image is still considered to
+be two or three dimensional.  It is possible to change the data vector
+within the program.
+
+The section parameter may be specified directly as an image section or
+in one of the following forms
+
+.nf
+line|column|x|y|z first|middle|last|# [first|middle|last|#]]
+first|middle|last|# [first|middle|last|#] line|column|x|y|z
+.fi
+
+where each field can be one of the strings separated by | except for #
+which is an integer number.  The field in [] is a second designator
+which is used with three dimensional data.  See the example section for
+examples of this syntax.  Abbreviations are allowed though beware that 'l'
+is not a sufficient abbreviation.
+.le
+.ls database = "database"
+Database in which the feature data and coordinate functions are recorded.
+.le
+.ls coordlist = "linelists$idhenear.dat"
+User coordinate list consisting of an list of line coordinates.  A
+comment line of the form "# units <units>", where <units> is one of the
+understood units names, defines the units of the line list.  If no units
+are specified then Angstroms are assumed.  Some standard line lists are
+available in the directory "linelists$".  The standard line lists are
+described under the topic \fIlinelists\fR.
+.le
+.ls units = ""
+The units to use if no database entry exists.  The units are specified as
+described in
+
+.nf
+    cl> help onedspec.package section=units
+.fi
+
+If no units are specified and a coordinate list is used then the units of
+the coordinate list are selected.  If a database entry exists then the
+units defined there override both this parameter and the coordinate list.
+.le
+.ls nsum = "10"
+Number of lines, columns, or bands across the designated vector axis to be
+summed when the image is a two or three dimensional spatial spectrum.
+It does not apply to multispec format spectra.  If the image is three
+dimensional an optional second number can be specified for the higher
+dimensional axis  (the first number applies to the lower axis number and
+the second to the higher axis number).  If a second number is not specified
+the first number is used for both axes.
+.le
+.ls match = -3.
+The maximum difference for a match between the feature coordinate function
+value and a coordinate in the coordinate list.  Positive values
+are in user coordinate units and negative values are in units of pixels.
+.le
+.ls maxfeatures = 50
+Maximum number of the strongest features to be selected automatically from
+the coordinate list (function 'l') or from the image data (function 'y').
+.le
+.ls zwidth = 100.
+Width of graphs, in user coordinates, when in zoom mode (function 'z').
+.le
+
+The following parameters are used in determining feature positions.
+.ls ftype = "emission"
+Type of features to be identified.  The possibly abbreviated choices are
+"emission" and "absorption".
+.le
+.ls fwidth = 4.
+Full-width at the base (in pixels) of features to be identified.
+.le
+.ls cradius = 5.
+The maximum distance, in pixels, allowed between a feature position
+and the initial estimate when defining a new feature.
+.le
+.ls threshold = 0.
+In order for a feature center to be determined the range of pixel intensities
+around the feature must exceed this threshold.
+.le
+.ls minsep = 2.
+The minimum separation, in pixels, allowed between feature positions
+when defining a new feature.
+.le
+
+The following parameters are used to fit a function to the user coordinates.
+The \fBicfit\fR package is used and further descriptions about these parameters
+may be found under that package.
+.ls function = "spline3"
+The function to be fit to the user coordinates as a function of the pixel
+coordinate.  The choices are "chebyshev", "legendre", "spline1", or "spline3".
+.le
+.ls order = 1
+Order of the fitting function.  The order is the number of polynomial terms
+or number of spline pieces.
+.le
+.ls sample = "*"
+Sample regions for fitting. This is in pixel coordinates and not the user
+coordinates.
+.le
+.ls niterate = 0
+Number of rejection iterations.
+.le
+.ls low_reject = 3.0, high_reject = 3.0
+Lower and upper residual rejection in terms of the RMS of the fit.
+.le
+.ls grow = 0
+Distance from a rejected point in which additional points are automatically
+rejected regardless of their residuals.
+.le
+
+The following parameters control the input and output.
+.ls autowrite = no
+Automatically write or update the database?  If "no" then when exiting the
+program a query is given if the feature data and fit have been modified.
+The query is answered with "yes" or "no" to save or not save the results.
+If \fIautowrite\fR is "yes" exiting the program automatically updates the
+database.
+.le
+.ls graphics = "stdgraph"
+Graphics device.  The default is the standard graphics device which is
+generally a graphics terminal.
+.le
+.ls cursor = ""
+Cursor input file.  If a cursor file is not given then the standard graphics
+cursor is read.
+.le
+
+The following parameters are queried when the 'b' key is used.
+.ls crval, cdelt
+These parameters specify an approximate coordinate value and coordinate
+interval per pixel when the automatic line identification
+algorithm ('b' key) is used.  The coordinate value is for the
+pixel specified by the \fIcrpix\fR parameter in the \fBaidpars\fR
+parameter set.  The default value of \fIcrpix\fR is INDEF which then
+refers the coordinate value to the middle of the spectrum.  By default
+only the magnitude of the coordinate interval is used.  Either value
+may be given as INDEF.  In this case the search for a solution will
+be slower and more likely to fail.  The values may also be given as
+keywords in the image header whose values are to be used.
+.le
+.ls aidpars = "" (parameter set)
+This parameter points to a parameter set for the automatic line
+identification algorithm.  See \fIaidpars\fR for further information.
+.le
+.ih
+CURSOR KEYS
+.ls ?
+Clear the screen and print a menu of options.
+.le
+.ls a
+Apply next (c)enter or (d)elete operation to (a)ll features
+.le
+.ls b
+Identify features and find a dispersion function automatically using
+the coordinate line list and approximate values for the dispersion.
+.le
+.ls c
+(C)enter the feature nearest the cursor.  Used when changing the position
+finding parameters or when features are defined from a previous feature list.
+.le
+.ls d
+(D)elete the feature nearest the cursor.  (D)elete all features when preceded
+by the (a)ll key.  This does not affect the dispersion function.
+.le
+.ls e
+Find features from a coordinate list without doing any fitting.  This is
+like the 'l' key without any fitting.
+.le
+.ls f
+(F)it a function of the pixel coordinates to the user coordinates.  This enters
+the interactive function fitting package.
+.le
+.ls g
+Fit a zero point shift to the user coordinates by minimizing the difference
+between the user and fitted coordinates.  The coordinate function is
+not changed.
+.le
+.ls i
+(I)nitialize (delete features and coordinate fit).
+.le
+.ls j
+Go to the preceding line, column, or band in a 2D/3D or multispec image.
+.le
+.ls k
+Go to the next line, column, or band in a 2D/3D or multispec image.
+.le
+.ls l
+(L)ocate features in the coordinate list.  A coordinate function must be
+defined or at least two features must have user coordinates from which a
+coordinate function can be determined.  If there are features an
+initial fit is done, then features are added from the coordinate list,
+and then a final fit is done.
+.le
+.ls m
+(M)ark a new feature using the cursor position as the initial position
+estimate.
+.le
+.ls n
+Move the cursor or zoom window to the (n)ext feature (same as +).
+.le
+.ls o
+Go to the specified line, column, or band in a 2D/3D or multispec image.
+For 3D images two numbers are specified.
+.le
+.ls p
+(P)an to the original window after (z)ooming on a feature.
+.le
+.ls q
+(Q)uit and continue with next image.
+.le
+.ls r
+(R)edraw the graph.
+.le
+.ls s
+(S)hift the fit coordinates relative to the pixel coordinates.  The
+user specifies the desired fit coordinate at the position of the cursor
+and a zero point shift to the fit coordinates is applied.  If features
+are defined then they are recentered and the shift is the average shift.
+The shift in pixels, user coordinates, and z (fractional shift) is printed.
+.le
+.ls t
+Reset the current feature to the position of the cursor.  The feature
+is \fInot\fR recentered.  This is used to mark an arbitrary position.
+.le
+.ls u
+Enter a new (u)ser coordinate for the current feature.
+When (m)arking a new feature the user coordinate is also requested.
+.le
+.ls v
+Modify the fitting weight of the current feature.  The weights are
+integers with the lowest weight being the default of 1.
+.le
+.ls w
+(W)indow the graph.  A window prompt is given and a number of windowing
+options may be given.  For more help type '?' to the window prompt or
+see help under \fIgtools\fR.
+.le
+.ls x
+Find a zero point shift for the current dispersion function.  This is used
+by starting with the dispersion solution and features from a different
+spectrum.  The mean shift in user coordinates, mean shift in pixels, and
+the fractional shift in user coordinates is printed.
+.le
+.ls y
+Up to \fImaxfeatures\fR emission peaks are found automatically (in order of
+peak intensity) and, if a dispersion solution is defined, the peaks are
+identified from the coordinate list.
+.le
+.ls z
+(Z)oom on the feature nearest the cursor.  The width of the zoom window
+is determined by the parameter \fIzwidth\fR.
+.le
+.ls .
+Move the cursor or zoom window to the feature nearest the cursor.
+.le
+.ls 4 +
+Move the cursor or zoom window to the (n)ext feature.
+.le
+.ls 4 -
+Move the cursor or zoom window to the previous feature.
+.le
+
+Parameters are shown or set with the following "colon commands", which may be
+abbreviated.  To show the value of a parameter type the parameter name alone
+and to set a new value follow the parameter name by the value.
+.ls :show file
+Show the values of all the parameters.  If a file name is given then the
+output is appended to that file.  If no file is given then the terminal
+is cleared and the output is sent to the terminal.
+.le
+.ls :features file
+Print the feature list and the fit rms.  If a file name is given then the
+output is appended to that file.  If no file is given then the terminal
+is cleared and the output is sent to the terminal.
+.le
+.ls :coordlist file
+Set or show the coordinate list file.
+.le
+.ls :cradius value
+Set or show the centering radius in pixels.
+.le
+.ls :threshold value
+Set or show the detection threshold for centering.
+.le
+.ls :database name
+Set or show the database for recording feature records.
+.le
+.ls :ftype value
+Set or show the feature type (emission or absorption).
+.le
+.ls :fwidth value
+Set or show the feature width in pixels.
+.le
+.ls :image imagename
+Set a new image or show the current image.
+.le
+.ls :labels value
+Set or show the feature label type (none, index, pixel, coord, user, or both).
+None produces no labeling, index labels the features sequentially in order
+of pixel position, pixel labels the features by their pixel coordinates,
+coord labels the features by their user coordinates (such as wavelength),
+user labels the features by the user or line list supplied string, and
+both labels the features by both the user coordinates and user strings.
+.le
+.ls :match value
+Set or show the coordinate list matching distance.
+.le
+.ls :maxfeatures value
+Set or show the maximum number of features automatically found.
+.le
+.ls :minsep value
+Set or show the minimum separation allowed between features.
+.le
+.ls :read name ap
+Read a record from the database.  The record name defaults to the image name
+and, for 1D spectra, the aperture number defaults to aperture of
+the current image.
+.le
+.ls :write name ap
+Write a record to the database.  The record name defaults to the image name
+and, for 1D spectra, the aperture number defaults to aperture of
+the current image.
+.le
+.ls :add name ap
+Add features from a database record.  The record name defaults to the image name
+and, for 1D spectra, the aperture number defaults to aperture of
+the current image.  Only the features are added to any existing list
+of features.  The dispersion function is not read.
+.le
+.ls :zwidth value
+Set or show the zoom width in user units.
+.le
+.ls :/help
+Print additional help for formatting graphs.  See help under "gtools".
+.le
+.ih
+DESCRIPTION
+Features in the input images are identified interactively and assigned
+user coordinates.  A "coordinate function" mapping pixel coordinates to
+user coordinates may be determined from the identified features.  A
+user coordinate list may be defined to automatically identify additional
+features.  This task is used to measure positions of features,
+determine dispersion solutions for spectra, and to identify features in
+two and three dimensional images for mapping a two or three dimensional
+coordinate transformation.  Because of this dual use the terms vector
+and feature are used rather than spectrum and spectral line.
+
+Each image in the input list is considered in turn.  If the image is
+not one dimensional or a one dimensional section of an image
+then the image section given by the parameter
+\fIsection\fR is used.  This parameter may be specified in several ways as
+described in the PARAMETERS and EXAMPLES sections.  The image section is used
+to select a starting vector and image axis.
+
+If the image is not one dimensional or in multispec format then the number
+of lines, columns, or bands given by the parameter \fInsum\fR are summed.
+The one dimensional image vector is graphed.  The initial feature list and
+coordinate function are read from the database if an entry exists.  The
+features are marked on the graph.  The image coordinates are in pixels
+unless a coordinate function is defined, in which case they are in user
+coordinate units.  The pixel coordinate, coordinate function value, and
+user coordinate for the current feature are printed.
+
+The graphics cursor is used to select features and perform various
+functions.  A menu of the keystroke options and functions is printed
+with the key '?'.  The cursor keys and their functions are defined in
+the CURSOR KEYS section and described further below.  The standard
+cursor mode keys are also available to window and redraw the graph and
+to produce hardcopy "snaps".
+
+There are a number of ways of defining features.  They fall into
+two categories; interactively defining features with the cursor
+and using automatic algorithms.
+
+The 'm' key is the principle interactive feature marking method.  Typing
+'m' near the position of a feature applies a feature centering algorithm
+(see \fBcenter1d\fR) and, if a center is found, the feature is entered in
+the feature list and marked on the spectrum.  If the new position is within
+a distance given by the parameter \fIminsep\fR of a previous feature it is
+considered to be the same feature and replaces the old feature.  Normally
+the position of a new feature will be exactly the same as the original
+feature.  The coordinate list is searched for a match between the
+coordinate function value (when defined) and a user coordinate in the
+list.  If a match is found it becomes the default user coordinate which the
+user may override.  The new feature is marked on the graph and it becomes
+the current feature.  The redefinition of a feature which is within the
+minimum separation may be used to set the user coordinate from the
+coordinate list.  The 't' key allows setting the position of a feature to
+other than that found by the centering algorithm.
+
+The principle automatic feature identification algorithm is executed
+with the 'b' key.  The user is queried for an approximate coordinate
+value and coordinate interval per pixel.  The coordinate value
+is for the center of the spectrum by default though this may be changed
+with the \fBaidpars\fR parameters.  Only the magnitude of the
+coordinate interval per pixel is used by default though this also
+may be changed.  Either value may be given as INDEF to do an unconstrained
+search, however, this will be much slower and more likely to fail.
+The algorithm searches for matches between the strong lines in the
+spectrum and lines in the coordinate list.  The algorithm is described
+in the documentation for \fBaidpars\fR.
+
+The 'b' key works with no predefined dispersion solution or features.  If
+two or more features are identified, with 'm', spanning the range of the
+data or if a coordinate function is defined, from a previous solution, then
+the 'e', 'l', and 'y' keys may be used to identify additional features from
+a coordinate list.  The 'e' key only adds features at the coordinates of
+the line lists if the centering algorithm finds a feature at that
+wavelength (as described below).  The 'y' key works in reverse by finding
+the prominent features using a peak finding algorithm and then looking in
+the coordinate list for entries near the estimated position.  Up to a
+maximum number of features (\fImaxfeatures\fR) will be selected.  If there
+are more peaks only the strongest are kept.  In either of these cases there
+is no automatic fitting and refitting of the dispersion function.
+
+The 'l' key combines automatic fits with locating lines from the coordinate
+list.  If two or more features are defined an initial fit is made.  Then
+for each coordinate value in the coordinate list the pixel coordinate is
+determined and a search for a feature at that point is made.  If a feature
+is found (based on the parameters \fIftype, fwidth\fR, \fIcradius\fR, and
+\fBthreshold\fR) its user coordinate value based on the coordinate function
+is determined.  If the coordinate function value matches the user
+coordinate from the coordinate list within the error limit set by the
+parameter \fImatch\fR then the new feature is entered in the feature list.
+Up to a maximum number of features, set by the parameter \fImaxfeatures\fR,
+may be defined in this way.  A new user coordinate function is fit to all
+the located features.  Finally, the graph is redrawn in user coordinates
+with the additional features found from the coordinate list marked.
+
+A minimum of two features must be defined for the 'l' key algorithm to
+work.  However, three or more features are preferable to determine changes
+in the dispersion as a function of position.
+
+The 'f' key fits a function of the pixel coordinates to the user
+coordinates.  The type of function, order and other fitting parameters
+are initially set with the parameters \fIfunction, order, sample,
+niterate, low_reject, high_reject\fR and \fIgrow\fR..  The value of the
+function for a particular pixel coordinate is called the function
+coordinate and each feature in the feature list has a function
+coordinate value.  The fitted function also is used to convert pixel
+coordinates to user coordinates in the graph.  The fitting is done
+within the interactive curve fitting package which has its own set of
+interactive commands.  For further information on this package see the
+help material under \fBicfit\fR.
+
+If a zero point shift is desired without changing the coordinate function
+the user may specify the coordinate of a point in the spectrum with
+the 's' key from which a shift is determined.  The 'g' key also
+determines a shift by minimizing the difference between the user
+coordinates and the fitted coordinates.  This is used when a previously
+determined coordinate function is applied to a new spectrum having
+fewer or poorer lines and only a zero point shift can reasonably be
+determined.  Note that the zero point shift is in user coordinates.
+This is only an approximate correction for shifts in the raw spectra
+since these shifts are in pixels and the coordinate function should
+also be appropriately shifted.
+
+One a set of features is defined one may select features for various
+operations.  To select feature as the current feature the keys '.', 'n',
+'+', and '-' are used.  The '.' selects the feature nearest the cursor, the
+'n' and '+' select the next feature, and the '-' selects the previous
+feature relative to the current feature in the feature list as ordered by
+pixel coordinate.  These keys are useful when redefining the user
+coordinate with the 'u' key, changing the fitting weight of a feature with
+'v', and when examining features in zoom mode.
+
+Features may be deleted with the key 'd'.  All features are deleted
+when the 'a' key immediately precedes the delete key.  Deleting the
+features does not delete the coordinate function.  Features deleted in the
+curve fitting package also are removed from the feature list upon
+exiting the curve fitting package.
+
+It is common to transfer the feature identifications and coordinate function
+from one image to another.  When a new image without a database entry
+is examined, such as when going to the next image in the input list,
+changing image lines or columns with 'j', 'k' and 'o', or selecting
+a new image with the ":image" command, the current feature list and coordinate
+function are kept.  Alternatively, a database record from a different
+image may be read with the ":read" command.  When transferring feature
+identifications between images the feature coordinates will not agree exactly
+with the new image feature positions and several options are available to
+reregister the feature positions.  The key 'c' centers the feature nearest
+the cursor using the current position as the starting point.  When preceded
+with the 'a' key all the features are recentered (the user must refit
+the coordinate function if desired).  As an aside, the recentering
+function is also useful when the parameters governing the feature
+centering algorithm are changed.  An additional options is the ":add"
+command to add features from a database record.  This does not overwrite
+previous features (or the fitting functions) as does ":read".
+
+The (c)entering function is applicable when the shift between the current
+and true feature positions is small.  Larger shifts may be determined
+automatically with the 's' or 'x' keys.
+
+A zero point shift is specified interactively with the 's' key by using the
+cursor to indicate the coordinate of a point in the spectrum.  If there are
+no features then the shift is exactly as marked by the cursor.  If there
+are features the specified shift is applied, the features are recentered,
+and the mean shift for all the features is determined.
+
+The 'x' key uses the automatic line identification algorithm (see
+\fBaidpars\fR) with the constraint that the dispersion is nearly the
+same and the is primarily a shift in the coordinate zero point.  If
+features are defined, normally by inheritance from another spectrum, then a
+first pass is done to identify those features in the spectrum.  Since this
+only works when the shifts are significantly less than the dispersion range
+of the spectrum (i.e. a significant number of features are in common) a
+second pass using the full coordinate line list is performed if a shift
+based on the features is not found.  After a shift is found any features
+remaining from the original list are recentered and a mean shift is
+computed.
+
+In addition to the single keystroke commands there are commands initiated
+by the key ':' (colon commands).  As with the keystroke commands there are
+a number of standard graphics features available beginning with ":."
+(type ":.help" for these commands).  The identify colon commands
+allow the task parameter values to be listed and to be reset
+within the task.  A parameter is listed by typing its name.  The colon command
+":show" lists all the parameters.  A parameter value is reset by
+typing the parameter name followed by the new value; for example
+":match 10".  Other colon commands display the feature list (:features),
+control reading and writing records to the database (:read and :write),
+and set the graph display format.
+
+The feature identification process for an image is completed by typing
+'q' to quit.  Attempting to quit an image without explicitly
+recording changes in the feature database produces a warning message
+unless the \fIautowrite\fR parameter is set.  If this parameter is
+not set a prompt is given asking whether to save the results otherwise
+the results are automatically saved.  Also
+the reference spectrum keyword REFSPEC is added to the image header at
+this time.  This is used by \fBrefspectra\fR and \fBdispcor\fR.
+As an immediate exit the 'I' interrupt key may be used.  This does not save
+the feature information and may leave the graphics in a confused state.
+.ih
+DATABASE RECORDS
+The database specified by the parameter \fIdatabase\fR is a directory of
+simple text files.  The text files have names beginning with 'id' followed
+by the entry name, usually the name of the image.  The database text files
+consist of a number of records.  A record begins with a line starting with the
+keyword "begin".  The rest of the line is the record identifier.  Records
+read and written by \fBidentify\fR have "identify" as the first word of the
+identifier.  Following this is a name which may be specified following the
+":read" or ":write" commands.  If no name is specified then the image name
+is used.  For 1D spectra the database entry includes the aperture number
+and so to read a solution from a aperture different than the current image
+and aperture number must be specified.  For 2D/3D images the entry name
+has the 1D image section which is what is specified to read the entry.
+The lines following the record identifier contain
+the feature information and dispersion function coefficients.
+
+The dispersion function is saved in the database as a series of
+coefficients.  The section containing the coefficients starts with the
+keyword "coefficients" 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
+1.  Because this task is interactive and has many possible applications
+it is difficult to provide actual examples.  Instead some uses of the task
+are described.
+
+.ls o
+For defining distortions in the slit dimension as a function of
+wavelength the positions of objects are marked at some wavelength.
+The task \fBreidentify\fR is then used to trace the features to other
+wavelengths.
+.le
+.ls o
+For determining dispersion solutions in a one dimensional
+spectrum an arc calibration is used.  Three emission features are marked
+and the (l)ocate key is used to find additional features from a
+coordinate list of arc lines.  The dispersion solution is fit interactively
+and badly determined or misidentified lines are deleted.  The
+solution may be written to the database or transferred to the object
+spectrum by reading the object image and deleting all the features.
+Deleting the features does not delete the coordinate function.
+.le
+.ls o
+For determining a two or three dimensional coordinate transformation a
+dispersion solution is determined at one slit position in a long slit arc
+spectrum or one spatial position in a Fabry-Perot spectrum as in the
+previous example.  The features are then traced to other positions with the
+task \fBreidentify\fR.
+.le
+
+2.  For images which are two or three dimensional it is necessary to
+specify the image axis for the data vector and the number of pixels at each
+point across the vector direction to sum.  One way specify a vector is to
+use an image section to define a vector.  For example, to select column
+20:
+
+.nf
+    cl> identify obj[20,*]
+.fi
+
+The alternative is to use the section parameter.  Below are some examples
+of the section parameter syntax for an image "im2d" which is 100x200
+and "im3d" which is 100x200x50.  On the left is the section string syntax
+and on the right is the image section
+
+.nf
+    Section parameter |  Image section      |  Description
+    ------------------|---------------------|---------------------
+    first line        |  im2d[*,1]          |  First image line
+    middle column     |  im2d[50,*]         |  Middle image column
+    last z            |  im3d[100,200,*]    |  Last image z vector
+    middle last y     |  im3d[50,*,50]      |  Image y vector
+    line 20           |  im2d[*,20]         |  Line 20
+    column 20         |  im2d[20,*]         |  Column 20
+    x 20              |  im2d[*,20]         |  Line 20
+    y 20              |  im2d[20,*]         |  Column 20
+    y 20 30           |  im2d[20,*,30]      |  Column 20
+    z 20 30	      |  im3d[20,30,*]      |  Image z vector
+    x middle          |  im3d[*,100,25]     |  Middle of image
+    y middle          |  im3d[50,*,25]      |  Middle of image
+    z middle          |  im3d[50,100,*]     |  Middle of image
+.fi
+
+The most common usage should be "middle line", "middle column" or "middle z".
+
+The summing factors apply to the axes across the specified vector.  For
+3D images there may be one or two values.  The following shows which axes
+are summed, the second and third columns, when the vector axis is that shown
+in the first column.
+
+.nf
+    Vector axis       |   Sum axis in 2D    |  Sum axes in 3D
+    ------------------|---------------------|--------------------
+         1            |         2           |      2 3                 
+         2            |         1           |      1 3                 
+         3            |         -           |      1 2                 
+.fi
+
+.ih
+REVISIONS
+.ls IDENTIFY V2.11
+The dispersion units are now determined from a user parameter,
+the coordinate list, or the database entry.
+
+A new key, 'e', has been added to add features from a line list without
+doing any fits.  This is like the 'l' but without the automatic
+fitting before and after adding new features.
+
+A new key, 'b', has been added to apply an automatic line identification
+algorithm.
+
+The 'x' key has been changed to use the automatic line identification
+algorithm.  The allows finding much larger shifts.
+
+The match parameter may now be specified either in user coordinates or
+in pixels.  The default is now 3 pixels.
+
+The default threshold value has been changed to 0.
+.le
+.ls IDENTIFY V2.10.3
+The section and nsum parameter syntax was extended to apply to 3D
+images.  The previous values and defaults may still be used.
+
+The 'v' key was added to allow assigning weights to features.
+.le
+.ls IDENTIFY V2.10
+The principle revision is to allow multiple aperture images and long slit
+spectra to be treated as a unit.  New keystrokes allow jumping or scrolling
+within multiple spectra in a single image.  For aperture spectra the
+database entries are referenced by image name and aperture number and not
+with image sections.  Thus, IDENTIFY solutions are not tied to specific
+image lines in this case.  There is a new autowrite parameter which may
+be set to eliminate the save to database query upon exiting.  The new
+colon command "add" may be used to add features based on some other
+spectrum or arc type and then apply the fit to the combined set of features.
+.le
+.ih
+SEE ALSO
+autoidentify, reidentify, aidpars, center1d, linelists, fitcoords, icfit,
+gtools
+.endhelp
diff --git a/noao/onedspec/doc/lcalib.hlp b/noao/onedspec/doc/lcalib.hlp
new file mode 100644
index 00000000..cc327217
--- /dev/null
+++ b/noao/onedspec/doc/lcalib.hlp
@@ -0,0 +1,125 @@
+.help lcalib Mar92 noao.onedspec
+.ih
+NAME
+lcalib -- List information about the spectral calibration data
+.ih
+USAGE
+lcalib option star_name
+.ih
+PARAMETERS
+.ls option
+Chooses calibration data to be listed.  Option
+may be: "bands" to list the bandpasses at each wavelength, "ext" to
+list the extinction at each wavelength, "mags", "fnu", or "flam"
+to list the magnitude, or flux of
+the star (selected by the star_name parameter) at each wavelength, or
+"stars" to list the star names available in the calibration directory.
+.le
+.ls star_name
+Selects which star's magnitude list is chosen if the option parameter
+is "mags", "fnu", "flam", or "bands".  Also if '?' a list of available
+stars in the specified calibration directory is given.
+.le
+
+The following three queried parameters apply if the selected calibration
+file is for a blackbody.  See \fBstandard\fR for further details.
+.ls mag
+The magnitude of the observed star in the band given by the
+\fImagband\fR parameter.  If the magnitude is not in the same band as
+the blackbody calibration file then the magnitude may be converted to
+the calibration band provided the "params.dat" file containing relative
+magnitudes between the two bands is in the calibration directory
+.le
+.ls magband
+The standard band name for the input magnitude.  This should generally
+be the same band as the blackbody calibration file.  If it is
+not the magnitude will be converted to the calibration band.
+.le
+.ls teff
+The effective temperature (deg K) or the spectral type of the star being
+calibrated.  If a spectral type is specified a "params.dat" file must exist
+in the calibration directory.  The spectral types are specified in the same
+form as in the "params.dat" file.  For the standard blackbody calibration
+directory the spectral types are specified as A0I, A0III, or A0V, where A
+can be any letter OBAFGKM, the single digit subclass is between 0 and 9,
+and the luminousity class is one of I, III, or V.  If no luminousity class
+is given it defaults to dwarf.
+.le
+
+.ls extinction
+Extinction file.  The current standard extinction files:
+.nf
+	onedstds$kpnoextinct.dat - KPNO standard extinction
+	onedstds$ctioextinct.dat - CTIO standard extinction
+.fi
+.le
+.ls caldir
+Calibration directory containing standard star data.  The directory name
+must end with /.  The current calibration directories available in the
+onedstds$ may be listed with the command:
+
+.nf
+	cl> page onedstds$README
+.fi
+.le
+.ls fnuzero = 3.68e-20
+The absolute flux per unit frequency at a magnitude of zero.  This is used
+to convert the calibration  magnitudes to absolute flux by the formula
+
+	Flux = fnuzero * 10. ** (-0.4 * magnitude)
+
+The flux units are also determined by this parameter.  However, the
+frequency to wavelength interval conversion assumes frequency in hertz.
+The default value is based on a calibration of Vega at 5556 Angstroms of
+3.52e-20 ergs/cm2/s/hz for a magnitude of 0.048.  This default value
+is that used in earlier versions of this task which did not allow the
+user to change this calibration.
+.le
+.ih
+DESCRIPTION
+LCALIB provides a means of checking the flux calibration data.  The calibration
+data consists of extinction, bandpasses, and stellar magnitudes.
+
+The extinction is given in an extinction file consisting of lines with
+wavelength and extinction.  The wavelengths must be order in increasing
+wavelength and the wavelengths must be in Angstroms.  There are two
+standard extinction files currently available, "onedstds$kpnoextinct.dat",
+and "onedstds$ctioextinct.dat".
+
+The standard star data are in files in a calibration
+directory specified with the parameter \fIcaldir\fR.  A standard star
+file is selected by taking the star name given, by the parameter
+\fIstar_name\fR, removing blanks, +'s and -'s, appending ".dat", and converting
+to lower case.  This file name is appended to the specified calibration
+directory.  A calibration file consists of lines containing a wavelength,
+a stellar magnitude, and a bandpass full width.  The wavelengths are in
+Angstroms.  Comment lines beginning with # may be included in the file.
+The star names printed by this task are just the first line of each file
+in the calibration directory with the first character (#) removed.
+The calibration files may be typed, copied, and printed.  \fBLcalib\fR
+may also be used to list data from the calibration files.
+.ih
+EXAMPLES
+
+.nf
+	# List the extinction table
+	cl> lcalib ext
+	# Plot the extinction table
+	cl> lcalib ext | graph
+	# Plot the energy distribution
+	cl> lcalib mags "bd+28 4211" | graph
+	# List the names of all the stars
+	cl> lcalib stars caldir=onedstds$irscal/
+	# As above but for IIDS file
+	cl> lcalib stars calib_file=onedstds$iidscal/
+.fi
+.ih
+REVISIONS
+.ls LCALIB V2.10
+This task has a more compact listing for the "stars" option and allows
+paging a list of stars when the star name query is not recognized.
+.le
+.ih
+SEE ALSO
+standard, sensfunc, onedstds$README
+.endhelp
diff --git a/noao/onedspec/doc/mkspec.hlp b/noao/onedspec/doc/mkspec.hlp
new file mode 100644
index 00000000..96efd726
--- /dev/null
+++ b/noao/onedspec/doc/mkspec.hlp
@@ -0,0 +1,86 @@
+.help mkspec Mar92 noao.onedspec
+.ih
+NAME
+mkspec -- generate an artificial spectrum or image (obsolete)
+.ih
+USAGE
+mkspec image_name image_title ncols nlines function
+.ih
+PARAMETERS
+.ls image_name
+The name to be given to the image file
+.le
+.ls image_title
+A character string to be used to describe the image
+.le
+.ls ncols
+The number of pixels in the spectrum (the length of the image).
+.le
+.ls nlines
+The number or lines (rows) in the image.
+.le
+.ls function
+An indicator specifying the form of the spectrum: 1 - a constant,
+2 - a ramp running from start_level to end_level, 3 - a black body
+extending in wavelength (Angstroms) from start_wave to end_wave
+at a given temperature (in degrees K).
+.le
+.ls constant
+The value to be assigned to the spectrum if function=1 (constant).
+.le
+.ls start_level
+The starting value to be assigned to the spectrum at pixel 1 if
+function=2 (ramp).
+.le
+.ls end_level
+The ending value of the spectrum assigned at pixel=ncols if function=2.
+.le
+.ls start_wave
+The wavelength (Angstroms) assigned to pixel 1 if function=3 (Black Body).
+.le
+.ls end_wave
+The wavelength (Angstroms) assigned to the last pixel if function=3.
+.le
+.ls temperature
+The black body temperature (degrees K) for which the spectrum
+is to be created if function=3.
+.le
+.ih
+DESCRIPTION
+An artificial image is created with the specified name and length.
+The image may have a constant value (function=1), or may be a ramp
+with either positive or negative slope (function=2), or may be
+a black body curve (function=3).
+
+Only those parameters specific to the functional form of the image
+need be specified. In all cases the parameters image_name, image_title,
+ncols, nlines, and function are required. If function=1, parameter constant
+is required; if function=2, start_level and end_level are required;
+if function=3, start_wave, end_wave, and temperature are required.
+
+All black body functions are normalized to 1.0 at their peak
+intensity which may occur at a wavelength beyond the extent of
+the generated spectrum.
+
+NOTE THAT THIS TASK IS OBSOLETE AND ARTDATA.MK1DSPEC SHOULD BE USED.
+In particular this task does not set the header dispersion coordinate
+system.
+.ih
+EXAMPLES
+
+.nf
+	cl> mkspec allones "Spectrum of 1.0" 1024 1 1 constant=1.0
+	cl> mkspec ramp "From 100.0 to 0.0" 1024 64 2 start=100 \
+	>>> end=0.0
+	cl> mkspec bb5000 "5000 deg black body" 512 1 3 start=3000 \
+	>>> end=8000 temp=5000
+.fi
+.ih
+REVISIONS
+.ls MKSPEC V2.10
+This task is unchanged.
+.le
+.ih
+SEE ALSO
+artdata.mk1dspec, artdata.mk2dspec, artdata.mkechelle
+.endhelp
diff --git a/noao/onedspec/doc/names.hlp b/noao/onedspec/doc/names.hlp
new file mode 100644
index 00000000..9004b20e
--- /dev/null
+++ b/noao/onedspec/doc/names.hlp
@@ -0,0 +1,67 @@
+.help names Mar92 noao.onedspec
+.ih
+NAME
+names -- Generate image names from a root and a range descriptor
+.ih
+USAGE
+names input records
+.ih
+PARAMETERS
+.ls input
+The root file name for the input records to be calibrated.
+.le
+.ls records
+The range of spectra to be included in the calibration operation.
+Each range item will be appended to the root name to form an
+image file name.
+.le
+.ls append = ""
+If not a null string, this character string will be appended to
+all the generated image names. This allows for a specification of
+image sections.
+.le
+.ls check = no
+If set to yes, a check is made that each name implied by the range
+specification has at least an image header. The pixel file is not
+checked. If set to no, then all possible image names are generated
+even if no image exists.
+.le
+.ih
+DESCRIPTION
+A sequence of image names is generated from the input root file name
+and the range description by appending the possible range values to
+the root in the form "root.nnnn". At least four digits will follow the
+root.
+
+If an append string is specified, this is added to the image name as well.
+
+The generated image names are written to STDOUT, but may be redirected
+to a file for further use.
+.ih
+EXAMPLES
+The following will generate names of the form nite1.0001, nite1.0002 ...
+nite1.0010 and place the list in the file nite1.lst.
+
+.nf
+	cl> names nite1 1-10 >nite1.lst
+.fi
+
+The next example uses the append option to specify that only the
+first 512 pixels of each image (spectrum) are to used in the image name.
+
+.nf
+	cl> names nite1 1-10 append="[1:512]" >nite1.lst
+.fi
+.ih
+REVISIONS
+.ls NAMES V2.10
+This task is unchanged.
+.le
+.ih
+.ih
+BUGS
+The append option is only useful for adding image sections since it is
+added after the ONEDSPEC name is generated.  Appending other strings
+produces names such as root.0012str which are not recognized by
+the package.
+.endhelp
diff --git a/noao/onedspec/doc/ndprep.hlp b/noao/onedspec/doc/ndprep.hlp
new file mode 100644
index 00000000..6f59ba4b
--- /dev/null
+++ b/noao/onedspec/doc/ndprep.hlp
@@ -0,0 +1,115 @@
+.help ndprep Mar92 noao.onedspec
+.ih
+NAME
+ndprep -- Make a neutral density filter calibration image
+.ih
+USAGE
+ndprep filter_curve output
+.ih
+PARAMETERS
+.ls filter_curve
+Neutral density filter curve.  The directory specified by the parameter
+\fIdirectory\fR is prepended to this name so if a directory is specified
+then it should not be given here.  If '?' a list of filter curves
+in the specified directory is typed.
+.le
+.ls output
+Output neutral density filter image.
+.le
+.ls w0   
+Starting wavelength for the output image in Angstroms.
+.le
+.ls dw   
+Wavelength increment for the output image in Angstroms.
+.le
+.ls nw   
+Number of wavelength points for the output image (i.e. the size of the
+output image).
+.le
+.ls nspace = 0
+Number of spatial points for a two dimensional image.  If the value is
+zero then a one dimensional image is created.
+.le
+.ls logarithm = no
+Use logarithmic wavelengths and intervals?  If yes then the wavelengths
+will have the same starting and ending points and number of pixels but
+the wavelength intervals will be logarithmic.
+.le
+.ls flux = yes
+Conserve flux when rebinning to logarithmic wavelength intervals?
+.le
+.ls dispaxis = 1
+Dispersion axis for two dimensional images.  Dispersion along the lines
+is 1 and dispersion along the columns is 2.
+.le
+.ls directory = "onedstds$ctio/"
+Directory containing neutral density filter curves.  This directory is
+prepended to the specified fiter curve file (and so must end with '/'
+or '$').
+.le
+.ih
+DESCRIPTION
+A neutral density (ND) filter curve is converted to a calibration image
+with the same size and wavelength range as the images to be calibrated.
+A list of standard neutral density curves is typed if the filter
+curve name is given as '?'.  The ND curves are text files containing
+wavelength and filter transmission pairs.  Comments begin with '#'.
+A plot of the ND curve can be obtained using \fBgraph\fR.
+
+The ND curve is first interpolated to a one dimensional image of
+\fInw\fR wavelength points with starting wavelength \fIwO\fR and
+wavelength increment \fIdw\fR using the task \fBsinterp\fR.  The
+wavelength parameters must be in the same units as the filter curves
+(currently Angstroms) even if the final calibration image is to be in
+logarithmic wavelength intervals.  If logarithmic wavelength format
+is specified the image is rebinned over the same wavelength range with
+the same number of points using the task \fBdispcor\fR.  The rebinning
+may include flux conservation to account for the changing size of
+pixels or simply interpolate.  Note that flux conservation will
+change the apparent shape of the ND curve.
+
+If the number of points across the dispersion, \fInspace\fR is zero then
+the final calibration image is one dimensional.  If it is greater than
+zero the one dimensional ND image is expanded to the specified number
+of spatial points with the dispersion axis specified by the parameter
+\fIdispaxis\fR (1 = dispersion along the lines, 2 = dispersion along
+the columns).
+.ih
+EXAMPLES
+To get a list of standard ND filter curves:
+
+	cl> ndprep ?
+
+To graph the ND filter curve:
+
+	cl> graph onedstds$ctio/nd1m.100mag.dat
+
+Naturally, if a calibration image is made then the image plotting tasks
+such as \fBgraph\fR, \fBimplot\fR, and \fBsplot\fR may also be used.
+
+To make a one dimensional ND calibration spectrum:
+
+.nf
+	cl> ndprep w0=4000 dw=1.2 nw=512
+	Input ND filter curve:  onedstds$ctio/nd1m.100mag.dat
+	Output calibration image: NDimage
+.fi
+
+To make a two dimensional ND calibration spectrum in logarithmic wavelength:
+
+.nf
+	cl> ndprep w0=4000 dw=1.2 nw=512 nspace=200 log+
+	Input ND filter curve:  onedstds$ctio/nd4m.u000mag.dat
+	Output calibration image: NDimage
+.fi
+.ih
+REVISIONS
+.ls NDPREP V2.10
+This task was moved from the \fBproto\fR package.  It was originally
+written at CTIO for CTIO data.  It's functionality is largely unchanged
+though it has been updated for changes in the \fBonedspec\fR package.
+.le
+.ih
+SEE ALSO
+sinterp, dispcor
+.endhelp
diff --git a/noao/onedspec/doc/odcombine.hlp b/noao/onedspec/doc/odcombine.hlp
new file mode 100644
index 00000000..11ddffe5
--- /dev/null
+++ b/noao/onedspec/doc/odcombine.hlp
@@ -0,0 +1,480 @@
+.help odcombine Apr04 onedspec
+.ih
+NAME
+odcombine -- Combine spectra using various algorithms
+.ih
+USAGE	
+odcombine input output
+.ih
+PARAMETERS
+.ls input
+List of input images containing spectra to be combined.  The spectra
+in the images to be combined are selected with the \fIapertures\fR and
+\fIgroup\fR parameters.  Only the primary spectrum is combined and
+the associated band spectra are ignored.  This task does not work on
+higher dimensional spectra data.  To apply it first use a task to
+extract it to 1D spectra.  The simplest method is \fBscopy\fR.
+.le
+.ls output
+List of output images to be created containing the combined spectra.  If
+the grouping option is "all" then only one output image is created with the
+specified name.  If the grouping option is "images" then there will be one
+output image for each input image and the output list must match the input
+list in number.  If the grouping option is "apertures" then only one output
+root name is specified and there will be one output image for each selected
+aperture.  In this case the output images will have a name formed from the
+root name and a four digit aperture number extension.  In all cases the
+output images contain a single 1D spectrum.  Other tasks, such as
+\fBscopy\fR, may be used to pack the spectra into a single file.
+.le
+
+
+There are a number of additional optional output files that may be produced.
+The lists are handled in the same was as for the primary output; i.e.
+depending on the grouping a single name, root name, or a matching list
+is specified.
+.ls headers = "" (optional)
+Optional output multiextension FITS file(s).  The extensions are dataless
+headers from each input image.
+.le
+.ls bpmasks = "" (optional)
+Optional output bad pixel mask(s) 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(s) 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(s) giving the number of input pixels rejected or
+excluded from the input images.
+.le
+.ls expmasks = "" (optional)
+Optional output exposure mask(s) 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(s).  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
+
+
+.ce
+Grouping Parameters
+.ls apertures = ""
+List of apertures to be selected for combining.  If none is specified
+then all apertures are selected.  The syntax is a blank or comma separated
+list of aperture numbers or hypen separated aperture ranges.
+.le
+.ls group = "apertures" (all|images|apertures)
+Option for grouping input spectra for combining (after selection by aperture)
+from one or more input images.  The options are:
+.ls "all"
+Combine all spectra from all images in the input list into a single output
+spectrum.
+.le
+.ls "images"
+Combine all spectra in each input image into a single spectrum in
+separate output images.
+.le
+.ls "apertures"
+Combine all spectra of the same aperture from all input images and put it
+into an output image with specified root name and a four digit aperture
+number extension.
+.le
+.le
+
+
+.ce
+Dispersion Matching Parameters
+.ls first = no
+Use the first input spectrum of each set to be combined to define the
+dispersion coordinates for combining and output?  If yes then all other
+spectra to be combined will be interpolated to the dispersion of this
+spectrum and that dispersion defines the dispersion of the
+output spectrum.  If no, then all the spectra are interpolated to a linear
+dispersion as determined by the following parameters.  The interpolation
+type is set by the package parameter \fIinterp\fR.
+.le
+.ls w1 = INDEF, w2=INDEF, dw = INDEF, nw = INDEF, log = no
+The output linear or log linear wavelength scale if the dispersion of the
+first spectrum is not used.  INDEF values are filled in from the maximum
+wavelength range and minimum dispersion of the spectra to be combined.  The
+parameters are aways specified in linear wavelength even when the log
+parameter is set to produce constant pixel increments in the log of the
+wavelength.  The dispersion is interpreted in that case as the difference
+in the log of the endpoints divided by the number of pixel.
+.le
+
+
+.ce
+Combining Parameters
+.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
+help page for \fBimcombine\fR.  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 specified as a pair of whitespace separated pixel
+values.
+.le
+
+
+.ce
+Masking Parameters
+.ls smaskformat = "bpmspectrum" (bpmspectrum|bpmpixel)
+When a mask is applied it must be matched to the input spectrum.  If the
+value of this parameter is "bpmspectrum" the mask file is assumed to have a
+spectral file structure with aperture and dispersion information.  The mask
+spectrum is matched to the input spectrum by aperture number and is
+rebinned from its dispersion to match the rebinned dispersion of the input
+spectrum.  If the value is "bpmpixel" the mask file is assumed to have
+minimal header information and the pixel information is matched to the
+input image pixels.  This means the mask pixels are extracted from the same
+line as the input spectrum and the mask pixels are resampled in the same
+way as the input spectrum pixels.
+.le
+.ls smasktype = "none" (none|goodvalue|badvalue|goodbits|badbit)
+Type of pixel masking to use.  If "none" or "" then no pixel masking is
+done even if an image has an associated  pixel mask.  The other choices are
+to select the value in the pixel mask to be treated as good (goodvalue) or
+bad (badvalue) or the bits (specified as a value) to be treated as good
+(goodbits) or bad (badbits).  The pixel mask filename is specified by the
+image header keyword "BPM".  Note that if the input image contains
+multiple spectra then the mask file must also contain at least the
+selected apertures if the mask format is "bpmspectrum" or matching
+image dimensions if the mask format is "bpmpixel".
+.le
+.ls maskvalue = 0
+Mask value used with the \fImasktype\fR parameter.  If the mask type
+selects good or bad bits the value may be specified using IRAF notation
+for decimal, octal, or hexadecimal; i.e 12, 14b, 0cx to select bits 3
+and 4.
+.le
+.ls blank = 0.
+Output value to be used when there are no pixels.
+.le
+
+
+.ce
+Scaling/Weighting Parameters
+
+The following scaling and weighting parameters have the following behavior
+and constraints, which are particularly relevant to multispec formats where
+multiple spectra are contained in an image with a single image header.
+When using image statistics these are calculated from the rebinned spectra
+being combined as expected.  When using header keywords the values will be
+the same for all spectra from the same input file.
+
+When using a file then the list will be applied repeatedly to each
+group being combined.  If the grouping is by aperture then the values will
+be matched in the order of the input images.  Note that if an image does
+not contain a specified aperture the ordering will be wrong.  If the
+grouping is by image then the file will be matched to the spectra in the
+order of the apertures in the image.  And if the grouping is "all" then the
+list is matched in the order of the images and apertures within the
+images with the apertures in an image varying first.
+
+.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.
+See the DESCRIPTION section for further details.
+.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
+
+The following parameters are internal to the task and not user parameters:
+
+.nf
+    offsets, masktype, maskvalue
+.fi
+
+.ce
+Environment Variables
+
+.ls <package>.interp
+When the spectra have to be interpolated to a common pixel sampling
+the "interp" parameter from the package from which ODCOMBINE is used
+will be used.
+.le
+.ih
+DESCRIPTION
+\fBOdcombine\fR combines input spectra by interpolating them (if necessary)
+to a common dispersion sampling, rejecting pixels exceeding specified low
+and high thresholds or identified as bad in a bad pixel mask, scaling them
+in various ways, applying a rejection algorithm based on known or empirical
+noise statistics, and computing the sum, weighted average, or median of the
+remaining pixels.  Note that the "sum" option is the direct summation of
+the pixels and does not perform any rejection or scaling of the data
+regardless of the parameter settings.
+
+The input spectra are specified using an image list in which each image
+may contain multiple spectra.  The set of spectra may be restricted
+by the \fIaperture\fR parameter to specific apertures.  The set of input
+spectra may then be grouped using the \fIgroup\fR parameter and each
+group combined separately into final output spectra.  The grouping
+options are to select all the input spectra regardless of the input
+image or aperture number, select all spectra of the same aperture,
+or select all the spectra from the same input image.
+
+The output consists of one image for each combined group.  The output
+images and combined spectra inherit the header parameters from the first
+spectrum in the combined group.  There are a number of additional optional
+outputs provided.  The optional logfile lists parameters, the spectra
+combined for each group, scaling, weights, etc., and the output names.
+
+The spectral combining is done using pixels at common dispersion
+coordinates rather than physical or logical pixel coordinates.  If the
+spectra to be combined do not have identical dispersion coordinates then
+the spectra are interpolated to a common dispersion sampling before
+combining.  The interpolation conserves pixel values rather pixel fluxes.
+This means that flux calibrated data is treated correctly and that
+spectra in counts are not corrected in the interpolation for changes in
+pixel widths.  The default interpolation function is a 5th order
+polynomial.  The choice of interpolation type is made with the package
+parameter "interp".  It may be set to "nearest", "linear", "spline3",
+"poly5", or "sinc".  Remember that this applies to all tasks which might
+need to interpolate spectra in the \fBonedspec\fR and associated packages.
+For a discussion of interpolation types see \fBonedspec\fR.
+
+There are two choices for the common dispersion coordinate sampling. If the
+\fIfirst\fR parameter is set then the dispersion sampling of the first
+spectrum is used.  If this dispersion is nonlinear then the end points and
+number of pixels are preserved and a linear dispersion is applied between
+the endpoints.  If the parameter is not set then the user specified linear
+or log linear dispersion system is used.  Any combination of starting
+wavelength, ending wavelength, wavelength per pixel, and number of output
+pixels may be specified.  Unspecified values will default to reasonable
+values based on the minimum or maximum wavelengths of all spectra, the
+minimum dispersion, and the number of pixels needed to satisfy the other
+parameters.  If the parameters overspecify the linear system then the
+ending wavelength is adjusted based on the other parameters.  Note that for
+a log linear system the wavelengths are still specified in nonlog units and
+the dispersion is finally recalculated using the difference of the log
+wavelength endpoints divided by the number pixel intervals (the number of
+pixels minus one).
+
+This task is layered on top of the \fBimcombine\fR task.  What happens
+is that the spectra for each group to be combined is extracted from
+the input, resampled to a common dispersion, and the resulting spectra
+written to temporary images, one per spectrum.  The temporary images
+are written to the current working directory with names begining with
+"tmp".  The same is done with any bad pixel masks.  Then the list of
+images are combined using the IMCOMBINE algorithms.  When the combining
+is completed the temporary images are removed.  If ODCOMBINE aborts
+for some reason these file may be left behind and the user may delete
+them.  Details of what IMCOMBINE does are presented separate under the
+help topic for the IMCOMBINE task.
+
+.ih
+EXAMPLES
+1.  Combine orders of echelle images.
+
+.nf
+	cl> odcombine *.ec *%.ec%% group=images combine=sum
+.fi
+
+2.  Combine all spectra using range syntax and scale by the exposure times.
+
+.nf
+	cl> names irs 10-42 > irs.dat
+	cl> odcombine @irs.dat irscombine group=all scale=exptime
+.fi
+
+3.  Combine spectra by apertures using exposure time scaling and weighting.
+
+.nf
+	cl> odcombine *.ms comb1d \\
+	>>> group=apertures scale=exptime weights=exptime
+	cl> scopy comb1d.* comb.ms format="multispec"
+	cl> imdel comb1d.*
+.fi
+.ih
+REVISIONS
+.ls ODCOMBINE V2.12.3
+This is a new version that incorporates most of the features of
+IMCOMBINE.
+
+In addition to the many new features, including application of pixel
+masks, the following functional differences from the old SCOMBINE
+are noted.
+
+.ls 1
+The output is always a single spectrum per image.
+.le
+.ls 2
+The "first" option does not allow rebinning to a non-linear dispersion.
+Instead, it rebins to the nearest linear dispersion matching the first
+spectrum.
+.le
+.ih
+SEE ALSO
+imcombine, scombine, scopy, sarith, lscombine
+.endhelp
diff --git a/noao/onedspec/doc/onedspec.hlp b/noao/onedspec/doc/onedspec.hlp
new file mode 100644
index 00000000..a1c06ab9
--- /dev/null
+++ b/noao/onedspec/doc/onedspec.hlp
@@ -0,0 +1,293 @@
+.help package Nov94 noao.onedspec
+.ih
+NAME
+onedspec -- generic 1D spectral reduction and analysis package
+.ih
+USAGE
+onedspec
+.ih
+PARAMETERS
+.ls observatory = "observatory"
+Observatory at which the spectra were obtained if not specified in the
+image header by the keyword OBSERVAT.  This parameter is used by several
+tasks in the package through parameter redirection so this parameter may be
+used to affect all these tasks at the same time.  The observatory may be
+one of the observatories in the observatory database, "observatory" to
+select the observatory defined by the environment variable "observatory" or
+the parameter \fBobservatory.observatory\fR, or "obspars" to select the
+current parameters set in the \fBobservatory\fR task.  See help for
+\fBobservatory\fR for additional information.
+.le
+.ls caldir = ""
+Calibration directory containing standard star data.  This parameter
+is used by several tasks in the package through redirection.  A list of
+standard calibration directories may be obtained by listing the file
+"onedstds$README"; for example:
+
+	cl> page onedstds$README
+
+The user may copy or create their own calibration files and specify
+the directory.  The directory "" refers to the current working directory.
+.le
+.ls interp = "poly5" (nearest|linear|poly3|poly5|spline3|sinc)
+Spectrum interpolation type used when spectra are resampled.  The choices are:
+
+.nf
+	nearest - nearest neighbor
+	 linear - linear
+	  poly3 - 3rd order polynomial
+	  poly5 - 5th order polynomial
+	spline3 - cubic spline
+	   sinc - sinc function
+.fi
+.le
+
+The following parameters apply to two and three dimensional images
+such as long slit or Fabry-Perot spectra.  They allow selection of
+a line or column as the spectrum "aperture" and summing of neighboring
+elements to form a one dimensional spectrum as the tasks in the
+ONEDSPEC package expect.
+
+.ls dispaxis = 1
+The image axis corresponding to the dispersion.  If there is an image
+header keyword DISPAXIS then the value of the keyword will be used
+otherwise this package parameter is used.  The dispersion coordinates
+are a function of column, line, or band when this parameter is 1, 2
+or 3.
+.le
+.ls nsum = "1"
+The number of neighboring elements to sum.  This is a string parameter
+that can have one or two numbers.  For two dimensional images only
+one number is needed and specifies the number of lines or columns
+to sum depending on the dispersion axis.  For three dimensional
+images two numbers may be given (if only one is given it defaults
+to the same value for both spatial axes) to specify the summing of
+the two spatial axes.  The order is the lower dimensional spatial
+axis first.
+
+For an even value the elements summed are the central specified
+"aperture", nsum / 2 - 1 below, and nsum /2 above; i.e the
+central value is closer to the lower element than the upper.
+For example, for nsum=4 and an aperture of 10 for a dispersion
+axis of 1 in a two dimensional image the spectrum used will be
+the sum of lines 9 to 12.
+.le
+
+.ls records = ""
+This is a dummy parameter.  It is applicable only in the \fBimred.irs\fR
+and \fBimred.iids\fR packages.
+.le
+.ls version = "ONEDSPEC V3: November 1991"
+Package version identification.
+.le
+.ih
+DESCRIPTION
+The \fBonedspec\fR package contains generic tasks for the reduction,
+analysis, and display of one dimensional spectra.  The specifics of
+individual tasks may be found in their IRAF "help" pages.  This document
+describes the general and common features of the tasks.
+
+The functions provided in the \fBonedspec\fR package with applicable tasks
+are summarized in Table 1.
+
+.ce
+Table 1:  Functions provided in the \fBonedspec\fR package
+
+.nf
+1.  Graphical display of spectra
+          bplot - Batch plots of spectra
+       identify - Identify features and fit dispersion functions
+       specplot - Stack and plot multiple spectra
+          splot - Interactive spectral plot/analysis
+
+2.  Determining and applying dispersion calibrations
+        dispcor - Dispersion correct spectra
+         dopcor - Apply doppler corrections
+       identify - Identify features and fit dispersion functions
+     refspectra - Assign reference spectra to other spectra
+     reidentify - Automatically identify features in spectra
+      specshift - Shift spectral dispersion coordinate system
+
+3.  Determining and applying flux calibrations
+      calibrate - Apply extinction and flux calibrations to spectra
+       deredden - Apply interstellar extinction correction
+         dopcor - Apply doppler corrections
+         lcalib - List calibration file data
+       sensfunc - Create sensitivity function
+       standard - Tabulate standard star data
+
+4.  Fitting spectral features and continua
+      continuum - Fit the continuum in spectra
+       fitprofs - Fit gaussian profiles
+           sfit - Fit spectra and output fit, ratio, or difference
+          splot - Interactive spectral plot/analysis
+
+5.  Arithmetic and combining of spectra
+         sarith - Spectrum arithmetic
+       scombine - Combine spectra
+          splot - Interactive spectral plot/analysis
+
+6.  Miscellaneous functions
+         mkspec - Generate an artificial spectrum
+          names - Generate a list of image names from a string
+     sapertures - Set or change aperture header information
+          scopy - Select and copy spectra
+        sinterp - Interpolate a table of x,y to create a spectrum
+          slist - List spectrum header parameters
+          splot - Interactive spectral plot/analysis
+.fi
+
+There are other packages which provide additional functions or specialized
+tasks for spectra.  Radial velocity measurements are available in the
+\fBnoao.rv\fR package.  The \fBnoao.imred\fR package contains a number
+of packages for specific types of data or instruments.  These packages
+are listed in Table 2.
+
+.ce
+Table 2:  \fBImred\fR spectroscopy packages
+
+.nf
+ 	  argus - CTIO ARGUS reduction package
+       ctioslit - CTIO spectrophotometric reduction package
+	echelle - Echelle spectral reductions (slit and FOE)
+ 	  hydra - KPNO HYDRA (and NESSIE) reduction package
+	   iids - KPNO IIDS spectral reductions
+	    irs - KPNO IRS spectral reductions
+      kpnocoude - KPNO coude reduction package (slit and 3 fiber)
+       kpnoslit - KPNO low/moderate dispersion slits (Goldcam, RCspec, Whitecam)
+        specred - Generic slit and fiber spectral reduction package
+.fi
+
+Finally, there are non-NOAO packages which may contain generally useful
+software for spectra.  Currently available packages are \fBstsdas\fR
+and \fBxray\fR.
+.ih
+SPECTRUM IMAGE FORMATS AND COORDINATE SYSTEMS
+See the separate help topic \fIspecwcs\fR.
+.ih
+INTERPOLATION
+Changing the dispersion sampling of spectra, such as when converting to a
+constant sampling interval per pixel or a common sampling for combining or
+doing arithmetic on spectra, requires interpolation.  The tasks which
+reinterpolate spectra, if needed, are \fBdispcor, sarith, scombine,\fR and
+\fBsplot\fR.
+
+The interpolation type is set by the package parameter \fIinterp\fR.
+The available interpolation types are:
+
+.nf
+	nearest - nearest neighbor
+	 linear - linear
+	  poly3 - 3rd order polynomial
+	  poly5 - 5th order polynomial
+	spline3 - cubic spline
+	   sinc - sinc function
+.fi
+
+The default interpolation type is a 5th order polynomial.
+
+The choice of interpolation type depends on the type of data, smooth
+verses strong, sharp, undersampled features, and the requirements of
+the user.  The "nearest" and "linear" interpolation are somewhat
+crude and simple but they avoid "ringing" near sharp features.  The
+polynomial interpolations are smoother but have noticible ringing
+near sharp features.  They are, unlike the sinc function described
+below, localized.
+
+In V2.10 a "sinc" interpolation option is available.  This function
+has advantages and disadvantages.  It is important to realize that
+there are disadvantages!  Sinc interpolation approximates applying a phase
+shift to the fourier transform of the spectrum.  Thus, repeated
+interpolations do not accumulate errors (or nearly so) and, in particular,
+a forward and reverse interpolation will recover the original spectrum
+much more closely than other interpolation types.  However, for
+undersampled, strong features, such as cosmic rays or narrow emission or
+absorption lines, the ringing can be more severe than the polynomial
+interpolations.  The ringing is especially a concern because it extends
+a long way from the feature causing the ringing; 30 pixels with the
+truncated algorithm used.  Note that it is not the truncation of the
+interpolation function which is at fault!
+
+Because of the problems seen with sinc interpolation it should be used with
+care.  Specifically, if there are no undersampled, narrow features it is a
+good choice but when there are such features the contamination of the
+spectrum by ringing is much more severe than with other interpolation
+types.
+.ih
+UNITS
+In versions of the NOAO spectroscopy packages prior to V2.10 the dispersion
+units used were restricted to Angstroms.  In V2.10 the first,
+experimental, step of generalizing to other units was taken by
+allowing the two principle spectral plotting tasks, \fBsplot\fR and
+\fBspecplot\fR, to plot in various units.  Dispersion functions are still
+assumed to be in Angstroms but in the future the generalization will be
+completed to all the NOAO spectroscopy tasks.
+
+The dispersion units capability of the plotting tasks allows specifying
+the units with the "units" task parameter and interactively changing the
+units with the ":units" command.  In addition the 'v' key allows plotting
+in velocity units with the zero point velocity defined by the cursor
+position.
+
+The units are specified by strings having a unit type from the list below
+along with the possible preceding modifiers, "inverse", to select the
+inverse of the unit and "log" to select logarithmic units. For example "log
+angstroms" to plot the logarithm of wavelength in Angstroms and "inv
+microns" to plot inverse microns.  The various identifiers may be
+abbreviated as words but the syntax is not sophisticated enough to
+recognized standard scientific abbreviations except as noted below.
+
+.nf
+		Table 1:  Unit Types
+
+	   angstroms - Wavelength in Angstroms
+	  nanometers - Wavelength in nanometers
+	millimicrons - Wavelength in millimicrons
+	     microns - Wavelength in microns
+	 millimeters - Wavelength in millimeters
+	  centimeter - Wavelength in centimeters
+	      meters - Wavelength in meters
+	       hertz - Frequency in hertz (cycles per second)
+	   kilohertz - Frequency in kilohertz
+	   megahertz - Frequency in megahertz
+	   gigahertz - Frequency in gigahertz
+	         m/s - Velocity in meters per second
+	        km/s - Velocity in kilometers per second
+	          ev - Energy in electron volts
+	         kev - Energy in kilo electron volts
+	         mev - Energy in mega electron volts
+		   z - Redshift
+
+	          nm - Wavelength in nanometers
+	          mm - Wavelength in millimeters
+	          cm - Wavelength in centimeters
+	           m - Wavelength in meters
+	          Hz - Frequency in hertz (cycles per second)
+	         KHz - Frequency in kilohertz
+	         MHz - Frequency in megahertz
+	         GHz - Frequency in gigahertz
+		  wn - Wave number (inverse centimeters)
+.fi
+
+The velocity and redshift units require a trailing value and unit defining the
+velocity zero point.  For example to plot velocity relative to
+a wavelength of 1 micron the unit string would be:
+
+.nf
+	km/s 1 micron
+.fi
+
+Some additional examples of units strings are:
+
+.nf
+	milliang
+	megahertz
+	inv mic
+	log hertz
+	m/s 3 inv mic
+	z 5015 ang
+.fi
+.ih
+SEE ALSO
+apextract, longslit, rv, imred, specwcs
+.endhelp
diff --git a/noao/onedspec/doc/refspectra.hlp b/noao/onedspec/doc/refspectra.hlp
new file mode 100644
index 00000000..01cfab30
--- /dev/null
+++ b/noao/onedspec/doc/refspectra.hlp
@@ -0,0 +1,413 @@
+.help refspectra Mar92 noao.onedspec
+.ih
+NAME
+refspectra -- Assign reference spectra
+.ih
+USAGE
+refspectra input [records]
+.ih
+PARAMETERS
+.ls input
+List of input spectra or root names to be assigned reference spectra.
+When using the record number extension format, record number extensions
+will be appended to each root name in the list.
+.le
+.ls records (imred.irs and imred.iids packages only)
+List of records or ranges of records to be appended to the input root
+names when using record number extension format.  The syntax of this
+list is comma separated record numbers or ranges of record numbers.  A
+range consists of two numbers separated by a hyphen. An example of this
+syntax is "1-5,13,17-19".  A null list ("") may
+be used if no record number extensions are desired.  This is a
+positional query parameter only if the record format is specified with
+the \fIrecformat\fR parameter.
+.le
+.ls references = "*.imh"
+List of reference spectra to be assigned or a "reference spectra assignment
+table" (see DESCRIPTION section).
+.le
+.ls apertures = ""
+List of apertures to be SELECTED from the input list of spectra.  If no list
+is specified then all apertures are selected.  The syntax is the same as the
+record number extensions.
+.le
+.ls refaps = ""
+List of reference spectra apertures to be SELECTED.  If no list is specified
+then all apertures are selected.  The syntax is the same as the record number
+extensions.
+.le
+.ls ignoreaps = yes
+Ignore the input and reference apertures when ASSIGNING reference spectra.
+If the aperture numbers are not ignored then only the reference spectra with
+the same aperture number as a particular input spectra are used when assigning
+reference spectra.  Otherwise all the reference spectra are used.  This does
+not apply to the "match" and "average" options which always ignore the aperture
+numbers.  Note that this parameter applies to relating reference spectra to
+input spectra and does not override the aperture selections on the input
+spectra and reference spectra.
+.le
+.ls select = "interp"
+Selection method for assigning reference spectra.  The methods are:
+.ls average
+Average two reference spectra without regard to any aperture,
+sort, or group parameters.
+If only one reference spectrum is specified then it is assigned with a
+warning.  If more than two reference spectra are specified then only the
+first two are used and a warning is given.  There is no checking of the
+aperture numbers or group values.
+.le
+.ls following
+Select the nearest following spectrum in the reference list based on the
+sort and group parameters.  If there is no following spectrum use the
+nearest preceding spectrum.
+.le
+.ls interp
+Interpolate between the preceding and following spectra in the reference
+list based on the sort and group parameters.  If there is no preceding and
+following spectrum use the nearest spectrum.  The interpolation is weighted
+by the relative distances of the sorting parameter (see cautions in
+DESCRIPTION section).
+.le
+.ls match
+Match each input spectrum with the reference spectrum list in order.
+This overrides any aperture or group values.
+.le
+.ls nearest
+Select the nearest spectrum in the reference list based on the sort and
+group parameters.
+.le
+.ls preceding
+Select the nearest preceding spectrum in the reference list based on the
+sort and group parameters.  If there is no preceding spectrum use the
+nearest following spectrum.
+.le
+.le
+.ls sort = "jd"
+Image header keyword to be used as the sorting parameter for selection
+based on order.  The header parameter must be numeric but otherwise may
+be anything.  Common sorting parameters are times or positions.
+A null string, "", or the word "none" may be use to disable the sorting
+parameter.
+.le
+.ls group = "ljd"
+Image header keyword to be used to group spectra.  For those selection
+methods which use the group parameter the reference and object spectra must
+have identical values for this keyword.  This can be anything but it must
+be constant within a group.  Common grouping parameters are the date of
+observation "date-obs" (provided it does not change over a night) or the
+local Julian day number.  A null string, "", or the word "none" may be use
+to disable the grouping parameter.
+.le
+.ls time = no, timewrap = 17.
+Is the sorting parameter a 24 hour time?  If so then the time orgin
+for the sorting is specified by the timewrap parameter.  This time
+should precede the first observation and follow the last observation
+in a 24 hour cycle.
+.le
+.ls override = no
+Override previous assignments?  If an input spectrum has reference
+spectra assigned previously the assignment will not be changed unless
+this flag is set.
+.le
+.ls confirm = yes
+Confirm reference spectrum assignments?  If \fIyes\fR then the reference
+spectra assignments for each input spectrum are printed and the user may
+either accept the assignment or not.  Rejected assignments leave the
+input spectrum unchanged.
+.le
+.ls assign = yes
+Assign the reference spectrum by entering it in the image header?
+The input spectra are only modified if this parameter is \fIyes\fR.
+This parameter may be set to \fIno\fR to get a list of assignments
+without actually entering the assignments in the image headers.
+.le
+.ls logfiles = "STDOUT,logfile"
+List of log files for recording reference spectra assignments.
+The file STDOUT prints to the standard output.  If not specified ("")
+then no logs will be recorded.
+.le
+.ls verbose = yes
+Verbose log output?  This prints additional information about the input
+and reference spectra.  This is useful for diagnosing why certain spectra
+are ignored or not assigned as intended.
+.le
+.ih
+DESCRIPTION
+This task allows the user to define which reference spectra are to be 
+used in the calculation of the dispersion solution of object spectra.
+The assignment of reference spectra to object spectra is often
+a complex task because of the number of spectra, the use of many distinct
+apertures, and different modes of observing such as interspersed arc
+calibration spectra or just one calibration for a night.  This task
+provides a number of methods to cover many of the common cases.
+
+A reference spectrum is defined to be a spectrum that has been used to
+calculate a wavelength solution with the tasks IDENTIFY or REIDENTIFY.
+These tasks have set the keyword REFSPEC1 in the image header
+equal to the spectrum's own name.
+
+Wavelength reference spectra are assigned to input spectra by entering
+the reference spectrum name or pair of names in the image
+header under the keywords REFSPEC1 and REFSPEC2.  When two reference
+spectra are assigned, the spectrum names may be followed by a weighting
+factor (assumed to be 1 if missing).  The wavelength of a pixel is
+then the weighted average of the wavelengths from the reference
+spectra dispersion solutions.  The weighting factors are calculated
+by choosing an appropriate selection method, ie average, interpolation,
+etc. Note, however, that these assignments may be made directly using
+the task \fBhedit\fR or with some other task or script if none of the
+methods are suitable. 
+
+The spectra to be assigned references are specified by an input list.
+Optional numeric record format extensions may be appended to each name
+(used as a root name) in the input list in the \fBiids/irs\fR packages.
+The input spectra may be restricted to a particular set of aperture numbers
+by the parameter \fIapertures\fR; the spectra not in the list of apertures
+are skipped.  If the aperture list is null (i.e. specified as "") then all
+apertures are selected.  One further selection may be made on the input
+spectra.  If the parameter \fIoverride\fR is no then input spectra which
+have existing reference spectra assignments (which includes the reference
+spectra) are skipped.
+
+The reference spectra parameter \fIreferences\fR may take two forms.
+It may be an image list of spectra or a text file containing
+a "reference spectrum assignment table".  The table consists of pairs
+of strings/lists with the first string being a list of object spectra
+and the second string being a list of reference spectra.  If this
+table is used, then only those object spectra in the table that are also
+listed in the input parameter list are processed.  The example below
+illustrates the reference spectrum assignment table:
+
+.nf
+	spec1		spec2,spec3,spec4
+	spec5
+	spec6,spec7	spect8,spec9
+	spec10		spec11
+	spec12		spec13
+	spec14		spec15
+.fi
+
+As a convenience, if a reference list in the table is missing, the preceding
+reference list is implied. This table may be used to make arbitrary assignments.
+
+The reference spectra in the specified list may also be restricted to a
+subset of aperture numbers.  However, in the case of averaging, the
+reference aperture selection is ignored. In the case of matching, if
+a reference spectrum is not selected then the matching input spectrum
+is also skipped (in order to maintain a one-to-one correspondence).
+Spectra in the reference list which are not reference spectra (as
+defined earlier) are also ignored and a warning is printed.  Note that
+no check is made that a dispersion solution actually exists in the
+dispersion solution database.
+
+There may be cases where there are only reference spectra for some
+apertures and it is desired to apply these reference spectra to the
+other apertures.  The \fIignoreaps\fR flag may be used to force an
+assignment between reference and object spectra with different
+aperture numbers.  Note that this flag is applied after the input and
+reference list aperture number selections are made; in other words this
+applies only to the assignments and not the input selection process.
+
+Once the appropriate reference spectra from the reference list have been
+determined for an input spectrum they are assigned using one of the
+methods selected by the parameter \fIselect\fR.  The "match" method
+simply pairs each element of the input spectrum list with each element
+in the reference spectrum list.  If a reference assignment table
+is used with "match", then only the first spectrum in the reference
+list for each input spectrum is assigned.
+
+The "average" method assigns the first two spectra in the reference list
+ignoring aperture numbers or groups. The spectra are averaged by assigning
+equal weights.  There is no weighting based on any sort parameter.  If
+there are more than two spectra in the reference list then only the first
+two spectra are used and the remainder are ignored.  If a reference
+assignment table is used only the first two reference spectra listed for
+each object in the table are averaged.
+
+The remaining selection methods group the spectra using a header keyword
+which must be constant within a group.  If no group parameter is specfied
+(the null string "" or the word "none")
+then grouping does not occur.  Only reference spectra with the same
+group header value as the object are assigned to an object spectrum.
+One likely group parameter is the "date-obs" keyword.  This is usually
+constant over a night at CTIO and KPNO.  At other sites this may not
+be the case.  Therefore, the task \fBsetjd\fR may be used to set a
+local Julian day number which is constant over a night at any
+observatory.
+
+Within a group the spectra are ordered based on a numeric image header
+parameter specified by the \fIsort\fR parameter.  A null string "" or the
+word "null" may be used to select no sort parameter.  Parameters which are
+times, as indicated by the \fItime\fR parameter, are assumed to be cyclic
+with a period of 24 hours.  The time wrap parameter defines the origin of a
+cycle and should precede the first observation and follow the last
+observation in a 24 hour period; i.e. for nighttime observations this
+parameter value should bee sometime during the day.  Particularly with
+interpolating or choosing the nearest reference spectrum it is important
+that the sorting parameter refer to the middle of the exposure.  A Julian
+date at the middle of an exposure may be calculated with the task
+\fBsetjd\fR or a middle UT time may be computed with the task
+\fBsetairmass\fR.
+
+The selection methods may choose the "nearest", "preceding", or "following"
+reference spectrum.  Alternatively, the reference wavelengths may be
+interpolated between the preceding and following reference spectra with
+weights given by the relative distances measured by the sorting parameter.
+In the cases where a preceding or following spectrum is required and one is
+not found then the nearest reference spectrum is used.  These methods are
+used for observing sequences where the reference spectra are taken either
+nearby in time or space.
+
+The option "interp" should not be used without some thought as to the
+nature of the interpolation.  If the sorting parameter is a time (a 24 hour
+cyclic parameter as opposed to a continuous parameter such as a Julian
+date) then the user must be aware of when these times were recorded in the
+header.  For example, let us assume that the sort parameter is "ut" and
+that this time was recorded in the header at the beginning of the
+exposure.  If the object spectrum exposure time is longer than the
+reference spectra exposure times, then interpolation will weight the
+preceding reference spectrum too heavily.  This problem can be circumvented
+by using the "average" selection method along with the reference assignment
+table.  Or the sort time parameter in the headers of the spectra can be
+changes with \fIsetjd\fR or \fIsetairmass\fR or edited to reflect the
+values at mid-exposure (see EXAMPLES).
+
+Once the reference spectrum or spectra for a input spectrum have been 
+identified the user may also chose to override any previous reference
+assignments, to accept or not accept the current reference assignments
+(in the case of not accepting the reference assignment the image header
+is not updated), to only list the current reference assignments and not
+update any image headers, as well as to record the reference assignments
+to log files.  These options are separately controlled by the remaining
+task parameters. 
+.ih
+KEYWORDS
+This task uses the header keyword BEAM-NUM to sort the apertures.  It
+has an integer value.  If the keyword does not exist then all apertures
+are assumed to be 1.
+
+The keyword REFSPEC1 is used to search for reference spectra. This 
+keyword can be previously created by the tasks IDENTIFY and REIDENTIFY.
+
+The two keywords REFSPEC1 and optionally REFSPEC2 are created by the
+task when the assign parameter is set to yes.  They take the form:
+
+.nf
+           REFSPEC1='d1.0001'  or
+
+           REFSPEC1='d5.0001 0.756'
+           REFSPEC2='d5.0002 0.244'
+.fi
+
+.ih
+EXAMPLES
+1.  Compute a Julian date at the midpoint of the exposure for sorting
+and a local Julian day number for grouping and then assign spectra
+using interpolation.
+
+.nf
+    cl> setjd *.imh jd=jd ljd=ljd
+    cl> refspec *.imh sort=jd group=ljd select=interp
+.fi
+
+2.  Specifically assign reference spectra to input spectra.
+
+.nf
+    cl> refspectra spec1,spec3 refe=spec2,spec4 select=match
+.fi
+
+3.  Use a reference assignment table to assign reference spectra to input
+spectra using the "average" option.  First a table is created using an
+editor.
+
+.nf
+    cl> type reftable
+    spec1		spec2,spec3,spec4
+    spec5
+    spec6,spec7		spect8,spec9
+    spec10		spec11
+    spec12		spec13
+    spec14		spec15
+    cl> refspec spec*.imh recfor- select=average refe=reftable
+.fi
+
+4.  Assign the nearest reference spectrum in zenith distance using
+wildcard lists.  By default the aperture numbers must match.
+
+    cl> refspec *.imh "" sort=zd select=nearest time-
+
+5.  Assign a specific reference spectrum to all apertures.
+
+    cl> refspec *.imh "" refer=refnite1 ignoreaps+
+
+6.  Confirm assignments.
+
+.nf
+    cl> hselect irs.*.imh "$I,beam-num,ut,refspec1" yes
+    irs.0009.imh	0	0:22:55		irs.0009
+    irs.0010.imh	1	0:22:53		irs.0010
+    irs.0100.imh	0	8:22:55
+    irs.0101.imh	1	8:22:53
+    irs.0447.imh	0	13:00:07	irs.0447
+    irs.0448.imh	1	13:00:05	irs.0448
+    cl> refspec irs 100-101 refer=irs.*.imh conf+ ver+ select=nearest\
+       >>> ignoreaps-
+    [irs.0100] Not a reference spectrum
+    [irs.0101] Not a reference spectrum
+    [irs.0100] refspec1='irs.0447'   Accept assignment (yes)?
+    [irs.0101] refspec1='irs.0448'   Accept assignment (yes)?
+.fi
+
+Because the reference spectrum list includes all spectra the
+warning messages "Not a reference spectrum" are printed with verbose
+output.  Remember a reference spectrum is any spectrum which has a
+reference spectrum assigned which refers to itself.
+
+7.  Assign reference spectra with weights using interpolation.  In this
+example we want to sort by "ut" but this keyword value was 
+recorded at the beginning of the integration. So we first create an
+new keyword and then compute its value to be that of mid-exposure.  The
+new keyword is then used as the sorting parameter.
+
+.nf
+    cl> hedit *.imh utmid 0. add+ ver- show-     
+    cl> hedit *.imh utmid "(ut)" ver- show-
+    cl> hedit *.imh utmid "(mod(utmid+exptime/7200.,24.))" ver- show-
+    cl> refspec *.imh refer=*.imh recfor- select=interp sort=utmid
+.fi
+
+8.  Assign reference spectra using the "average" option and the reference
+assignment table with data with record number extensions.  First edit
+the file reftable:
+
+.nf
+     cl> type reftable
+            spec.0001     arc1.0001,arc2.0001
+            spec.0002     arc1.0002,arc2.0002
+            spec.0003     arc1.0003,arc2.0003
+            spec.0004     arc1.0004,arc2.0004
+     cl> refspec spec.*.imh recfor- refer=reftable select=average
+.fi
+
+9.  Assign a reference spectrum for aperture 1 to the object spectra
+for apertures 2 thru 5.
+
+.nf
+     cl> refspec spec 2-5 recfor+ refer=arc.*.imh refaps=1 ignoreaps+
+.fi
+.ih
+REVISIONS
+.ls REFSPECTRA V2.10.3
+If no reference spectrum is found in the interp, nearest, following,
+preceding methods then a list of the reference spectra is given
+showing why each was not acceptable.
+.le
+.ls REFSPECTRA V2.10
+A group parameter was added to allow restricting assignments by observing
+period; for example by night.  The record format option was removed and
+the record format syntax is available in the \fBirs/iids\fR packages.
+.le
+.ih
+SEE ALSO
+identify, reidentify, dispcor, setjd, setairmass
+.endhelp
diff --git a/noao/onedspec/doc/reidentify.hlp b/noao/onedspec/doc/reidentify.hlp
new file mode 100644
index 00000000..07eb2238
--- /dev/null
+++ b/noao/onedspec/doc/reidentify.hlp
@@ -0,0 +1,516 @@
+.help reidentify Jan96 noao.onedspec
+.ih
+NAME
+reidentify -- Reidentify features
+.ih
+SUMMARY
+Given a reference vector with identified features and (optionally) a
+coordinate function find the same features in other elements of the
+reference image and fit a new dispersion function or determine a
+zero point shift.  After all vectors of the reference image are
+reidentified use the reference vectors to reidentify corresponding
+vectors in other images.  This task is used for transferring dispersion
+solutions in arc calibration spectra and for mapping geometric and
+dispersion distortion in two and three dimensional images.
+.ih
+USAGE
+reidentify reference images
+.ih
+PARAMETERS
+.ls reference
+Image with previously identified features to be used as features reference for
+other images.  If there are multiple apertures, lines, or columns in the
+image a master reference is defined by the \fIsection\fR parameter.
+The other apertures in multispec images or other lines, or columns
+(selected by \fIstep\fR) are reidentified as needed.
+.le
+.ls images
+List of images in which the features in the reference image are to be
+reidentified.  In two and three dimensional images the reidentifications are
+done by matching apertures, lines, columns, or bands with those in the reference
+image.
+.le
+.ls interactive = no
+Examine and fit features interactively?  If the task is run interactively a
+query (which may be turned off during execution) will be given for each
+vector reidentified after printing the results of the automatic fit and the
+user may chose to enter the interactive \fBidentify\fR task.
+.le
+.ls section = "middle line"
+If the reference image is not one dimensional or specified as a one dimensional
+image section then this parameter selects the master reference image
+vector.  The master reference is used when reidentifying other vectors in
+the reference image or when other images contain apertures not present in
+the reference image.  This parameter also defines the direction
+(columns, lines, or z) of the image vectors to be reidentified.
+
+The section parameter may be specified directly as an image section or
+in one of the following forms
+
+.nf
+line|column|x|y|z first|middle|last|# [first|middle|last|#]]
+first|middle|last|# [first|middle|last|#] line|column|x|y|z
+.fi
+
+where each field can be one of the strings separated by | except for #
+which is an integer number.  The field in [] is a second designator which
+is used with three dimensional data.  See the example section for
+\fBidentify\fR for examples of this syntax.  Abbreviations are allowed
+though beware that 'l' is not a sufficient abbreviation.
+.le
+.ls newaps = yes
+Reidentify new apertures in the images which are not in the reference
+image?  If no, only apertures found in the reference image will be
+reidentified in the other images.  If yes, the master reference spectrum
+is used to reidentify features in the new aperture and then the
+new aperture solution will be added to the reference apertures.  All
+further identifications of the new aperture will then use this solution.
+.le
+.ls override = no
+Override previous solutions?  If there are previous solutions for a
+particular image vector being identified, because of a previous
+\fBidentify\fR or \fBreidentify\fR, this parameter selects whether
+to simply skip the reidentification or do a reidentification and
+overwrite the solution in the database.
+.le
+.ls refit = yes
+Refit the coordinate function?  If yes and there is more than one feature
+and a coordinate function was defined in the reference image database then a new
+coordinate function of the same type as in the reference is fit
+using the new pixel positions.  Otherwise only a zero point shift is
+determined for the revised coordinates without changing the
+form of the coordinate function.
+.le
+
+The following parameters are used for selecting and reidentifying additional
+lines, columns, or apertures in two dimensional formats.
+.ls trace = no
+There are two methods for defining additional reference lines, columns, or
+bands in two and three dimensional format images as selected by the
+\fIstep\fR parameter.  When \fItrace\fR is no the master reference line or
+column is used for each new reference vector.  When this parameter is yes
+then as the reidentifications step across the image the last reidentified
+features are used as the reference.  This "tracing" is useful if there is a
+coherent shift in the features such as with long slit spectra.  However,
+any features lost during the tracing will be lost for all subsequent lines
+or columns while not using tracing always starts with the initial set of
+reference features.
+.le
+.ls step = "10"
+The step from the reference line, column, or band used for selecting and/or
+reidentifying additional lines, columns, or bands in a two or three
+dimensional reference image.  For three dimensional images there may be two
+numbers to allow independent steps along different axes.  If the step is
+zero then only the reference aperture, line, column, or band is used.  For
+multiaperture images if the step is zero then only the requested aperture
+is reidentified and if it is non-zero (the value does not matter) then all
+spectra are reidentified.  For long slit or Fabry-Perot images the step is
+used to sample the image and the step should be large enough to map any
+significant changes in the feature positions.
+.le
+.ls nsum = "10"
+Number of lines, columns, or bands across the designated vector axis to be
+summed when the image is a two or three dimensional spatial spectrum.
+It does not apply to multispec format spectra.  If the image is three
+dimensional an optional second number can be specified for the higher
+dimensional axis  (the first number applies to the lower axis number and
+the second to the higher axis number).  If a second number is not specified
+the first number is used for both axes.  This parameter is not used for
+multispec type images.
+.le
+.ls shift = "0"
+Shift in user coordinates to be added to the reference features before
+centering.  If the image is three dimensional then two numbers may be
+specified for the two axes.  Generally no shift is used by setting the
+value to zero.  When stepping to other lines, columns, or bands in the
+reference image the shift is added to the primary reference spectrum if not
+tracing.  When tracing the shift is added to last spectrum when stepping to
+higher lines and subtracted when stepping to lower lines.  If a value
+if INDEF is specified then an automatic algorithm is applied to find
+a shift.
+.le
+.ls search = 0.
+If the \fIshift\fR parameter is specified as INDEF then an automatic
+search for a shift is made.  There are two algorithms.  If the search
+value is INDEF then a cross-correlation of line peaks is done.  Otherwise
+if a non-zero value is given then a pattern matching algorithm (see
+\fIautoidentify\fR) is used.  A positive value specifies the search radius in
+dispersion units and a negative value specifies a search radius as a
+fraction of the reference dispersion range.
+.le
+.ls nlost = 0
+When reidentifying features by tracing, if the number of features not found
+in the new image vector exceeds this number then the reidentification
+record is not written to the database and the trace is terminated.  A
+warning is printed in the log and in the verbose output.
+.le
+
+The following parameters define the finding and recentering of features.
+See also \fBcenter1d\fR.
+.ls cradius = 5.
+Centering radius in pixels.  If a reidentified feature falls further
+than this distance from the previous line or column when tracing or
+from the reference feature position when reidentifying a new image
+then the feature is not reidentified.
+.le
+.ls threshold = 0.
+In order for a feature center to be determined, the range of pixel
+intensities around the feature must exceed this threshold.  This parameter
+is used to exclude noise peaks and terminate tracing when the signal
+disappears.  However, failure to properly set this parameter, particularly
+when the data values are very small due to normalization or flux
+calibration, is a common error leading to failure of the task.
+.le
+
+The following parameters select and control the automatic addition of
+new features during reidentification.
+.ls addfeatures = no
+Add new features from a line list during each reidentification?  If
+yes then the following parameters are used.  This function can be used
+to compensate for lost features from the reference solution, particularly
+when tracing.  Care should be exercised that misidentified features
+are not introduced.
+.le
+.ls coordlist = "linelists$idhenear.dat"
+User coordinate list consisting of a list of line coordinates.
+Some standard line lists are available in the directory "linelists$".
+The standard line lists are described under the topic \fIlinelists\fR.
+.le
+.ls match = -3.
+The maximum difference for a match between the feature coordinate function
+value and a coordinate in the coordinate list.  Positive values
+are in user coordinate units and negative values are in units of pixels.
+.le
+.ls maxfeatures = 50
+Maximum number of the strongest features to be selected automatically from
+the coordinate list.
+.le
+.ls minsep = 2.
+The minimum separation, in pixels, allowed between feature positions
+when defining a new feature.
+.le
+
+The following parameters determine the input and output of the task.
+.ls database = "database"
+Database containing the feature data for the reference image and in which
+the features for the reidentified images are recorded.
+.le
+.ls logfiles = "logfile"
+List of files in which to keep a processing log.  If a null file, "",
+is given then no log is kept.
+.le
+.ls plotfile = ""
+Optional file to contain metacode plots of the residuals.
+.le
+.ls verbose = no
+Print reidentification information on the standard output?
+.le
+.ls graphics = "stdgraph"
+Graphics device.  The default is the standard graphics device which is
+generally a graphics terminal.
+.le
+.ls cursor = ""
+Cursor input file.  If a cursor file is not given then the standard graphics
+cursor is read.
+.le
+
+The following parameters are queried when the 'b' key is used in the
+interactive review.
+.ls crval, cdelt
+These parameters specify an approximate coordinate value and coordinate
+interval per pixel when the automatic line identification
+algorithm ('b' key) is used.  The coordinate value is for the
+pixel specified by the \fIcrpix\fR parameter in the \fBaidpars\fR
+parameter set.  The default value of \fIcrpix\fR is INDEF which then
+refers the coordinate value to the middle of the spectrum.  By default
+only the magnitude of the coordinate interval is used.  Either value
+may be given as INDEF.  In this case the search for a solution will
+be slower and more likely to fail.  The values may also be given as
+keywords in the image header whose values are to be used.
+.le
+.ls aidpars = "" (parameter set)
+This parameter points to a parameter set for the automatic line
+identification algorithm.  See \fIaidpars\fR for further information.
+.le
+.ih
+DESCRIPTION
+Features (spectral lines, cross-dispersion profiles, etc.) identified in a
+single reference vector (using the tasks \fBidentify\fR or
+\fBautoidentify\fR) are reidentified in other reference vectors and the set
+of reference vectors are reidentified in other images with the same type of
+vectors.  A vector may be a single one dimensional (1D) vector in a two or
+three dimensional (2D or 3D) image, the sum of neighboring vectors to form
+a 1D vector of higher signal, or 1D spectra in multiaperture images.  The
+number of vectors summed in 2D and 3D images is specified by the parameter
+\fInsum\fR.  This parameter does not apply to multiaperture images.
+
+As the previous paragraph indicates, there are two stages in this task.
+The first stage is to identify the same features from a single reference
+vector to a set of related reference vectors.  This generally consists
+of other vectors in the same reference image such as other lines or
+columns in a long slit spectrum or the set of 1D aperture spectra in
+a multiaperture image.  In these cases the vectors are identified by
+a line, column, band, or aperture number.  The second stage is to
+reidentify the features from the reference vectors in the matching
+vectors of other images.  For example the same lines in the reference
+image and another image or the same apertures in several multiaperture
+images.  For multiaperture images the reference vector and target vector
+will have the same aperture number but may be found in different image
+lines.  The first stage may be skipped if all the reference vectors
+have been identified.
+
+If the images are 2D or 3D or multiaperture format and a \fIstep\fR greater
+than zero is specified then additional vectors (lines/columns/bands) in the
+reference image will be reidentified from the initial master reference
+vector (as defined by an image section or \fIsection\fR parameter) provided
+they have not been reidentified previously or the \fIoverride\fR flag is
+set.  For multiple aperture spectral images, called multiaperture, a step
+size of zero means don't reidentify any other aperture and any other step
+size reidentifies all apertures.  For two and three dimensional images,
+such as long slit and Fabry-Perot spectra, the step(s) should be large
+enough to minimize execution time and storage requirements but small enough
+to follow shifts in the features (see the discussion below on tracing).
+
+The reidentification of features in other reference image vectors
+may be done in two ways selected by the parameter \fItrace\fR.  If not
+tracing, the initial reference vector is applied to the other selected
+vectors.  If tracing, the reidentifications are made with respect to the
+last set of identifications as successive steps away from the reference
+vector are made.  The tracing method is appropriate for two and three
+dimensional spatial images, such as long slit and Fabry-Perot spectra, in
+which the positions of features traced vary smoothly.  This allows
+following large displacements from the initial reference by using suitably
+small steps.  It has the disadvantage that features lost during the
+reidentifications will not propagate (unless the \fIaddfeatures\fR option
+is used).  By not tracing, the original set of features is used for every
+other vector in the reference image.
+
+When tracing, the parameter \fInlost\fR is used to terminate the
+tracing whenever this number of features has been lost.  This parameter,
+in conjunction with the other centering parameters which define
+when a feature is not found, may be useful for tracing features
+which disappear before reaching the limits of the image.
+
+When reidentifying features in other images, the reference
+features are those from the same aperture, line, column, or band of the
+reference image.  However, if the \fInewaps\fR parameter is set
+apertures in multiaperture spectra which are not in the reference
+image may be reidentified against the master reference aperture and
+added to the list of apertures to be reidentified in other images.
+This is useful when spectra with different aperture numbers are
+stored as one dimensional images.
+
+The reidentification of features between a reference vector and
+a target vector is done as follows.  First a mean shift between
+the two vectors is determined.  After correcting for the shift
+the estimated pixel position of each reference feature in the
+target vector is used as the starting point for determining
+a feature center near this position.  The centering fails the
+feature is dropped and a check against the \fInlost\fR is made.
+If it succeeds it is added to the list of features found in the
+target spectrum.  A zero point shift or new dispersion
+function may be determined.  New features may then be added from
+a coordinate list.  The details are given below.
+
+There may be a large shift between the two vectors such that the same
+feature in the target vector is many pixels away from the pixel position in
+the reference spectrum.  A shift must then be determined.   The \fIshift\fR
+parameter may be used to specify a shift.  The shift is in user coordinates
+and is added to the reference user coordinates before trying to center
+on a feature.  For example if the reference spectrum has a feature at
+5015A but in the new spectrum the feature is at 5025A when the reference
+dispersion function is applied then the shift would be +10.  Thus
+a reference feature at 5015A would have the shift added to get 5025A,
+then the centering would find the feature some pixel value and that
+pixel value would be used with the true user coordinate of 5015A in the
+new dispersion solution.
+
+When tracing a 2D/3D reference spectrum the shift is applied to the
+previous reidentified spectrum rather than the initial reference spectrum.
+The shift is added for increasing line or column values and subtracted for
+decreasing line or column values.  This allows "tracing" when there is a
+rotation or tilt of the 2D or 3D spectrum.  When not tracing the shift is
+always added to the reference spectrum features as described previously.
+
+When reidentify other images with the reference spectrum the shift
+parameter is always just added to the reference dispersion solution
+matching the aperture, line, or column being reidentified.
+
+If the \fIshift\fR parameter is given as INDEF then an automatic
+search algorithm is applied.  There are two algorithms that may be
+used.  If the \fIsearch\fR parameter is INDEF then a cross-correlation
+of the features list with the peaks found in the target spectrum is
+performed.  This algorithm can only find small shifts since otherwise
+many lines may be missing off either end of the spectrum relative to
+the reference spectrum.
+
+If the search parameter is non-zero then the pattern matching algorithm
+described in \fIaidpars\fR is used.  The search parameter specified a
+search radius from the reference solution.  If the value is positive the
+search radius is a distance in dispersion units.  If the value is negative
+then the absolute value is used as a fraction of the dispersion range in
+the reference solution.  For example, a value of -0.1 applied to reference
+dispersion solution with a range of 1000A would search for a new solution
+within 100A of the reference dispersion solution.
+
+The pattern matching algorithm has to stages.  First if there are
+more than 10 features in the reference the pattern matching tries
+to match the lines in the target spectrum to those features with
+a dispersion per pixel having the same sign and a value within 2%.
+If no solution is found then the \fIlinelist\fR is used to match
+against the lines in the target spectrum, again with the dispersion
+per pixel having the same sign and a value within 5%.  The first
+stage works when the set of features is nearly the same while the
+second stage works when the shifts are large enough that many features
+in the reference and target spectra are different.
+
+The centering algorithm is described under the topic \fIcenter1d\fR and
+also in \fBidentify\fR.  If a feature positions shifts by more than the
+amount set by the parameter \fIcradius\fR from the starting position
+(possibly after adding a shift) or the feature strength (peak to valley) is
+less than the detection \fIthreshold\fR then the new feature is discarded.
+The \fIcradius\fR parameter should be set large enough to find the correct
+peak in the presence of any shifts but small enough to minimize incorrect
+identifications.  The \fIthreshold\fR parameter is used to eliminate
+identifications with noise.  Failure to set this parameter properly for the
+data (say if data values are very small due to a calibration or
+normalization operation) is the most common source of problems in using
+this task.
+
+If a fitting function is defined for the features in the reference image,
+say a dispersion function in arc lamp spectra, then the function is refit
+at each reidentified line or column if the parameter \fIrefit\fR is yes.
+If refitting is not selected then a zero point shift in the user
+coordinates is determined without changing the form of the fitting
+function.  The latter may be desirable for tracking detector shifts through
+a sequence of observation using low quality calibration spectra.  When
+refitting, the fitting parameters from the reference are used including
+iterative rejection parameters to eliminate misidentifications.
+
+If the parameter \fIaddfeatures\fR is set additional features may be added
+from a line list.  If there are reference features then the new features
+are added AFTER the initial reidentification and function fit.  If the
+reference consists only of a dispersion function, that is it has no
+features, then new features will be added followed by a function fit and
+then another pass of adding new features.  A maximum number of added
+features, a matching distance in user coordinates, and a minimum separation
+from other features are additional parameters.  This option is similar to
+that available in \fBidentify\fR and is described more fully in the help
+for that task.
+
+A statistics line is generated for each reidentified vector.  The line
+contains the name of the image being reidentified (which for two
+dimensional images includes the image section and for multiaperture
+spectra includes the aperture number), the number of features found
+relative to the number of features in the reference, the number of
+features used in the function fit relative to the number found,  the
+mean pixel, user coordinate, and fractional user coordinate shifts
+relative to the reference coordinates, and the RMS relative to the
+final coordinate system (whether refit or simply shifted) excluding any
+iteratively rejected features from the calculation.
+
+If the task is run with the \fIinteractive\fR flag the statistics line
+is printed to the standard output (the terminal) and a query is
+made whether to examine and/or refit the features.  A response
+of yes or YES will put the user in the interactive graphical mode
+of \fBidentify\fR.  See the description of this task for more
+information.  The idea is that one can monitor the statistics information,
+particularly the RMS if refitting, and select only those which may be
+questionable to examine interactively.  A response of no or NO will
+continue on to the next reidentification.  The capitalized responses
+turn off the query and act as permanent response for all other
+reidentifications.
+
+This statistics line, including headers, is written to any specified
+log files.  The log information includes the image being
+reidentified and the reference image, and the initial shift.
+
+If an accessible file name is given for the plot file then a residual plot
+of the reidentified lines is recorded in this file.  The plot file can
+be viewed with \fBgkimosaic, stdgraph\fR or reading the file
+with ".read" when in cursor mode (for example with "=gcur").
+
+The reidentification results for this task are recorded in a
+\fIdatabase\fR.  Currently the database is a directory and entries
+in the database are text files with filenames formed by adding
+the prefix "id" to the image name without an image extension.
+.ih
+EXAMPLES
+1.  Arc lines and a dispersion solution were defined for the middle
+aperture in the multispec for arc spectrum a042.ms.  To reidentify the
+other apertures in the reference image and then another arc image:
+
+.nf
+  cl> reiden a042.ms a045.ms inter+ step=1 ver+
+  REIDENTIFY: NOAO/IRAF V2.9 valdes@puppis Fri 29-Jun-90
+    Reference image = a042.ms.imh, New image = a042.ms, Refit = yes
+     Image Data    Found     Fit Pix Shift  User Shift     RMS
+  a042.ms - Ap 24  48/48   47/48   -2.38E-4    -3.75E-6  0.699
+  Fit dispersion function interactively? (no|yes|NO|YES) (yes): y
+  a042.ms - Ap 24  48/48   47/48   -2.38E-4    -3.75E-6  0.699
+  a042.ms - Ap 23  48/48   47/48      0.216        1.32  0.754
+  Fit dispersion function interactively? (no|yes|NO|YES) (yes): n
+  a042.ms - Ap 22  48/48   47/48     0.0627       0.383  0.749
+  Fit dispersion function interactively? (no|yes|NO|YES) (yes): n
+  a042.ms - Ap 21  48/48   47/48      0.337        2.06  0.815
+  <etc>
+    Reference image = a042.ms.imh, New image = a045.ms, Refit = yes
+     Image Data    Found     Fit Pix Shift  User Shift     RMS
+  a045.ms - Ap 24  48/48   47/48   -2.38E-4    -3.75E-6  0.699
+  Fit dispersion function interactively? (no|yes|NO|YES) (yes): y
+  a045.ms - Ap 24  48/48   47/48   -2.38E-4    -3.75E-6  0.699
+  a045.ms - Ap 23  48/48   47/48      0.216        1.32  0.754
+  Fit dispersion function interactively? (no|yes|NO|YES) (yes): N
+  a045.ms - Ap 22  48/48   47/48     0.0627       0.383  0.749
+  a042.ms - Ap 21  48/48   47/48      0.337        2.06  0.815
+  a042.ms - Ap 20  48/48   47/48     -0.293       -1.79  0.726
+  a042.ms - Ap 19  48/48   48/48      0.472        2.88  0.912
+.fi
+
+This example is verbose and includes interactive review of reidentifications.
+The statistics lines have been shortened.
+
+2.  To trace a stellar profile and arc lines in long slit images for the
+purpose of making a distortion correction:
+
+.nf
+  cl> reiden rog022[135,*] "" trace+
+  cl> reiden rog023 "" sec="mid line" trace+
+.fi
+.ih
+REVISIONS
+.ls REIDENTIFY V2.11
+The \fIsearch\fR parameter and new searching algorithm has been added.
+
+The task will now work with only a warning if the reference image is absent;
+i.e. it is possible to reidentify given only the database.
+
+The \fIaddfeatures\fR function will now add features before a fit if there
+are no reference database features.  Previously features could only be
+added after an initial fit using the reference features and, so, required
+the reference database to contain features for reidentification.  This
+new feature is useful if one wants to uses a dispersion function from one
+type of calibration but wants to add features for a different kind of
+calibration.
+.le
+.ls REIDENTIFY V2.10.3
+The section, nsum, step, and shift parameter syntax was extended to apply to 3D
+images.  The previous values and defaults may still be used.
+
+For multiaperture data a step of zero selects only the reference aperture
+to be reidentified and any other step selects reidentifying all apertures.
+.le
+.ls REIDENTIFY V2.10
+This task is a new version with many new features.  The new features
+include an interactive options for reviewing identifications, iterative
+rejection of features during fitting, automatic addition of new features
+from a line list, and the choice of tracing or using a single master
+reference when reidentifying features in other vectors of a reference
+spectrum.  Reidentifications from a reference image to another image is
+done by matching apertures rather than tracing.  New apertures not present
+in the reference image may be added.
+.le
+.ih
+SEE ALSO
+autoidentify, identify, aidpars, center1d, linelists, fitcoords
+.endhelp
diff --git a/noao/onedspec/doc/rspectext.hlp b/noao/onedspec/doc/rspectext.hlp
new file mode 100644
index 00000000..2973f552
--- /dev/null
+++ b/noao/onedspec/doc/rspectext.hlp
@@ -0,0 +1,138 @@
+.help rspectext Oct93 onedspec
+.ih
+NAME
+rspectext -- convert 1D ascii text spectra to IRAF image spectra
+.ih
+USAGE
+rspectext input output
+.ih
+PARAMETERS
+.ls input
+Input list of ascii text spectra.  These may have a optional FITS header
+at the beginning and then two columns of wavelength and flux.
+.le
+.ls output
+Output list of IRAF spectra image names.  The list must match the
+input list.
+.le
+
+
+The following parameters are only used if there is no FITS header
+with the data.
+.ls title = ""
+Title to be assigned to the spectra.
+.le
+.ls flux = no
+Are the flux values flux calibrated?  If so then header keywords are
+inserted to identify this for the IRAF spectral software.
+.le
+.ls dtype = "linear" (none|linear|log|nonlinear|interp)
+Type of dispersion to assign to the spectra.  The options are:
+.ls none
+No dispersion function and nothing is added to the image header.
+.le
+.ls linear
+Store the linear dispersion parameters \fBcrval1\fR and \fBcdelt1\fR
+in the image header.  The wavelength values are ignored.  This may
+be used if the wavelength values are known to be linear but one wants
+to avoid possible roundoff and resampling errors introduced by the
+"interp" option.
+.le
+.ls log
+Store the log-linear dispersion parameters \fBcrval1\fR and \fBcdelt1\fR in
+the image header.  The wavelength values are ignored.  This may be used if
+the wavelength values are known to be linear in the log of the wavelength
+but one wants to avoid possible roundoff and resampling errors introduced
+by the "interp" option.
+.le
+.ls nonlinear
+Store the wavelength values in the image header as a lookup table.
+The flux values are not resampled.  The wavelength values need not
+be evenly sampled.
+.le
+.ls interp
+Use the wavelength values to resample to a linear dispersion between
+the first and last wavelength values.  The dispersion per pixel is
+determined by the number of pixels and the endpoint wavelengths.
+.le
+.le
+.ls crval1 = 1., cdelt1 = 1.
+The wavelength coordinate of the first pixel and the wavelength interval
+per pixel to be used with the linear and log dispersion types.
+.le
+.ih
+DESCRIPTION
+Ascii text files consisting of an optional FITS header (usually produced
+by \fBwspectext\fR) and a two column list of wavelengths and fluxes
+are converted to IRAF image spectra.  If a header is included then
+the header information is assumed to describe the spectra including
+any dispersion function.  If no header is given then the minimal
+information for describing spectra in IRAF is added.  The dispersion
+function can be set either a linear or log-linear based on two
+keywords (ignoring the wavelength values) or from the wavelength
+values.  The latter may be stored in the header as a lookup table
+allowing for nonlinear dispersions or resample to a linear dispersion.
+This task is a script based on \fBrtextimage\fR for the creating
+the image and entering the flux values, \fBhedit\fR to set some
+of the header keywords, and \fBdispcor\fR to handle the nonlinear
+or resampled dispersion functions.
+.ih
+EXAMPLES
+1.  Create spectrum from a text file originally produced by \fBwspectext\fR.
+
+.nf
+    cl> type text001
+    BITPIX  =                    8  /  8-bit ASCII characters
+    NAXIS   =                    1  /  Number of Image Dimensions
+    NAXIS1  =                  100  /  Length of axis
+    ORIGIN  = 'NOAO-IRAF: WTEXTIMAGE'  /
+    IRAF-MAX=                   0.  /  Max image pixel (out of date)
+    IRAF-MIN=                   0.  /  Min image pixel (out of date)
+    IRAF-B/P=                   32  /  Image bits per pixel
+    IRAFTYPE= 'REAL FLOATING     '  /  Image datatype
+    OBJECT  = 'TITLE             '  /
+    FILENAME= 'TEST              '  /  IRAF filename
+    FORMAT  = '5G14.7            '  /  Text line format
+    APNUM1  = '1 1     '
+    DC-FLAG =                    0
+    WCSDIM  =                    1
+    CTYPE1  = 'LINEAR  '
+    CRVAL1  =                4000.
+    CRPIX1  =                   1.
+    CDELT1  =     10.1010101010101
+    CD1_1   =     10.1010101010101
+    LTM1_1  =                   1.
+    WAT0_001= 'system=equispec                                 '
+    WAT1_001= 'wtype=linear label=Wavelength units=Angstroms   '
+    END
+										    
+    4000.00  1000.
+    4010.10  1005.54
+    4020.20  1011.05
+    ...
+    cl> rspectext text001 spec001
+.fi
+
+2.  Create a spectrum with a nonlinear dispersion using the wavelength
+values as a lookup table.
+
+.nf
+    cl> type text002
+    4000.00  1000.
+    4010.10  1005.54
+    4020.20  1011.05
+    ...
+    cl> rspectext text002 spec002 title="HH12" dtype=nonlinear
+.fi
+.ih
+REVISIONS
+.ls RSPECTEXT V2.11
+The task now automatically senses the presence of a header.
+.le
+.ls RSPECTEXT V2.10.3
+This is a new task with this version.
+.le
+.ih
+SEE ALSO
+wspectext, rtextimage, dispcor, mkms, imspec, sinterp
+.endhelp
diff --git a/noao/onedspec/doc/sapertures.hlp b/noao/onedspec/doc/sapertures.hlp
new file mode 100644
index 00000000..37398d6a
--- /dev/null
+++ b/noao/onedspec/doc/sapertures.hlp
@@ -0,0 +1,217 @@
+.help sapertures Jul95 noao.onedspec
+.ih
+NAME
+sapertures -- Set or change aperture header information
+.ih
+USAGE
+sapertures input
+.ih
+PARAMETERS
+.ls input
+List of spectral images to be modified.
+.le
+.ls apertures = ""
+List of apertures to be modified.  The null list
+selects all apertures.  A list consists of comma separated
+numbers and ranges of numbers.  A range is specified by a hyphen.  An
+optional step size may be given by using the 'x' followed by a number.
+See \fBxtools.ranges\fR for more information.
+.le
+.ls apidtable = ""
+Aperture table.  This may be either a text file or an image.
+A text file consisting of lines with an aperture number,
+beam number, dispersion type code, coordinate of the first physical
+pixel, coordinate interval per physical pixel, redshift factor,
+lower extraction aperture position, upper extraction aperture position,
+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.
+Any field except the aperture number may be given the value INDEF to
+indicate that the value is not to be changed from the current value.  Any
+apertures not in this table are assigned the values given by the task
+parameters described below.
+
+As a special case a file having just the aperture number, beam number, and
+spectrum aperture identification may be used.  This file format as well as
+use of an image header is the same as that in the \fBapextract\fR package.
+.le
+.ls wcsreset = no
+Reset the world coordinate system (WCS) of the selected apertures to
+uncorrected pixels.  If this parameter is set the \fIapidtable\fR and task
+aperture parameters are ignored.  This option sets the dispersion type flag
+to -1, the starting coordinate value to 1, the interval per pixel to 1, and
+no redshift factor and leaves the other parameters unchanged.  The option
+is useful when it is desired to apply a second dispersion correction using
+\fBidentify\fR and \fBdispcor\fR.
+.le
+.ls verbose = no
+Print a record of each aperture modified?  Only those apertures 
+in which the beam number or label are changed are printed.
+.le
+
+If no aperture table is specified or if there is not an aperture
+entry in the table for a selected aperture the following parameter
+values are used.  A value of INDEF will leave the corresponding
+parameter unchanged.
+.ls beam = INDEF
+Beam number.
+.le
+.ls dtype = INDEF
+Dispersion type.  The dispersion types are:
+
+.nf
+	-1  Linear with dispersion correction flag off
+	 0  Linear with dispersion correction flag on
+	 1  Log-linear with dispersion correction flag on
+.fi
+
+.le
+.ls w1 = INDEF
+Coordinate of the first physical pixel.  Note that it is possible
+that the physical pixels are not the same as the logical pixels if
+an image section has been extracted.
+.le
+.ls dw = INDEF
+Coordinate interval per physical pixel.  Note that it is possible
+that the physical pixels intervals are not the same as the logical pixels
+intervals if an image section has been extracted.
+.le
+.ls z = INDEF
+Redshift factor.  This is usually set with the task \fBdopcor\fR.
+Coordinates are divided by one plus the redshift factor (1+z).
+.le
+.ls aplow = INDEF, aphigh = INDEF
+The aperture extraction limits.  These are set when the \fBapextract\fR
+package is used and it is unlikely that one would use this task to
+change them.
+.le
+.ls title = INDEF
+Aperture title or identification string.
+.le
+.ih
+DESCRIPTION
+This task sets or changes any of the aperture specific parameters except
+the aperture number and the number of  valid pixels.  It is particularly
+useful for images which use the "multispec" world coordinate system
+attribute strings which are not readily accessible with other header
+editors.  A list of images and a list of apertures is used to select which
+spectra are to be modified.  The default empty string for the apertures
+selects all apertures.  The new values are specified either in an aperture
+table file or with task parameters.  The aperture table is used to give
+different values to specific apertures.  If all apertures are to have the
+same values this file need not be used.
+
+The aperture parameters which may be modified are the beam number, the
+dispersion type, the coordinate of the first physical pixel, the coordinate
+interval per physical pixel, the redshift factor, the aperture extraction
+limits, and the title.  The task has parameters for each of these and the
+aperture table consists of lines starting with an aperture number followed
+by the above parameters in the list order and separated by whitespace.  As
+a special case the aperture table may be a file abbreviated to aperture
+number, beam number, and title or an image with keywords SLFIBnnn
+containing the aperture number, beam number, optional right ascension and
+declination, and title.  These special cases allow use of the same file
+orimage used in the \fBapextract\fR package.  If any of the parameters are
+specified as INDEF then the value will be unchanged.
+
+If the \fIwcsreset\fR parameter is set then the aperture table and
+task aperture parameters are ignored and the selected apertures are
+reset to have a dispersion type of -1, a starting coordinate of 1,
+a coordinate interval of 1, and a redshift factor of 0.  This other
+parameters are not changed.  These choice of parameters has the effect
+of resetting the spectrum to physical pixel coordinates and flagging
+the spectra as not being dispersion calibrated.  One use of this option
+is to allow the \fBdispcor\fR task to be reapplied to previously
+dispersion calibrated spectra.
+
+The \fIverbose\fR parameter lists the old and new values when there is
+a change.  If there are no changes there will be no output.
+.ih
+EXAMPLES
+1.  To add titles to a multifiber extraction and change one of the
+beam numbers:
+
+.nf
+	cl> type m33aps
+	36 2 Henear
+	37 0 Sky
+	38 1 New title
+	39 1 Another title
+	41 0 Sky
+	42 1 Yet another title
+	43 1 YAT
+	44 1 Was a sky but actually has an object
+	45 1 Wow
+	46 1 Important new discovery
+	47 0 Sky
+	48 2 Henear
+	cl> saper m33.ms apid=m33aps v+
+	demoobj1.ms:
+	  Aperture 37:  --> Sky
+	  Aperture 38:  --> New title
+	  Aperture 39:  --> Another title
+	  Aperture 41:  --> Sky
+	  Aperture 42:  --> Yet another title
+	  Aperture 43:  --> YAT
+	  Aperture 44: beam 0 --> beam 1
+	  Aperture 44:  --> Was a sky but actually has an object
+	  Aperture 45:  --> Wow
+	  Aperture 46:  --> Important new discovery
+	  Aperture 47:  --> Sky
+.fi
+
+2.  To reset a dispersion calibrated multifiber spectrum:
+
+.nf
+	cl> saper test.ms wcsreset+ verbose+
+	test.ms:
+	  Aperture 1:
+	    w1 4321. --> 1.
+	    dw 1.23 --> 1.
+	  Aperture 2:
+	    w1 4321. --> 1.
+	    dw 1.23 --> 1.
+	  <etc.>
+.fi
+
+3.  To set a constant wavelength length scale (with the default parameters):
+
+.nf
+	cl> saper test.ms dtype=0 w1=4321 dw=1.23 v+
+	test.ms:
+	  Aperture 1:
+	    w1 1. --> 4321.
+	    dw 1. --> 1.23
+	  Aperture 2:
+	    w1 1. --> 4321.
+	    dw 1. --> 1.23
+	  <etc.>
+.fi
+
+4. To reset the wavelengths and title of only aperture 3:
+
+.nf
+	cl> saper test.ms aper=3 w1=4325 dw=1.22 title=HD12345 v+
+	test.ms:
+	  Aperture 3:
+	    w1 4321. --> 4325.
+	    dw 1.23 --> 1.22
+	    apid  --> HD12345
+.fi
+.ih
+REVISIONS
+.ls SAPERTURES V2.11
+This task has been modified to allow use of image header keywords
+as done in the APEXTRACT package.
+.le
+.ls SAPERTURES V2.10.3
+This task has been greatly expanded to allow changing any of the WCS
+parameters as well as the beam number and aperture title.
+.le
+.ls SAPERTURES V2.10
+This task is new.
+.le
+.ih
+SEE ALSO
+specshift, imcoords.wcsreset, hedit, ranges, onedspec.package
+.endhelp
diff --git a/noao/onedspec/doc/sarith.hlp b/noao/onedspec/doc/sarith.hlp
new file mode 100644
index 00000000..a7e7cf87
--- /dev/null
+++ b/noao/onedspec/doc/sarith.hlp
@@ -0,0 +1,571 @@
+.help sarith Mar93 noao.onedspec
+.ih
+NAME
+sarith -- Spectrum arithmetic
+.ih
+USAGE	
+sarith input1 op input2 output
+.ih
+PARAMETERS
+.ls input1
+List of input images to be used as operands.
+.le
+.ls op    
+Operator to be applied to the first operand or to both operands.  The
+unary or single operand operators are:
+
+.nf
+	abs  - absolute value
+	copy - copy (see also \fBscopy\fR)
+	dex  - decimal exponentiation (antilog of base 10 logarithm)
+	exp  - base e exponentiation (antilog of natural logarithm)
+	flam - convert F-nu to F-lambda
+	fnu  - convert F-lambda to F-nu
+	inv  - inverse
+	ln   - natural logarithm
+	log  - base 10 logarithm
+	lum  - convert magnitude to luminosity
+	mag  - convert luminosity to magnitude
+	sqrt - square root
+.fi
+
+The binary or two operand operators are:
+
+.nf
+	replace - replace first operand values by second operand values
+	+       - addition
+	-       - subtraction
+	*       - multiplication
+	/       - division
+	^       - exponentiation
+.fi
+.le
+.ls input2
+Lists of input spectra or constants to be used as second operands for
+binary operations.  If a single value is specified it applies
+to all the first operand input images otherwise the list must match
+the first operand list in number.
+.le
+.ls output
+List of resultant output images or root names.  Image
+sections are ignored and if the output format is "onedspec" then any record
+extensions are stripped to form the root name.  If no output list is
+specified then the input list is used and the input images are replaced by
+the resultant spectra.  If a single output name is specified then all
+resultant spectra are written to the same output image or image root
+name.  This allows packing or merging multiple spectra and requires
+properly setting the \fIclobber\fR, \fImerge\fR, \fIrenumber\fR and
+\fIoffset\fR parameters to achieve the desired output.  If more than one
+output image is specified then it must match the input image list in
+number.
+.le
+.ls w1 = INDEF, w2 = INDEF
+Starting and ending wavelengths to be copied.  If \fIw1\fR is not specified
+then the wavelength of the starting edge of the first pixel is used
+(wavelength at pixel coordinate 0.5) and if \fIw2\fR is not specified then
+the wavelength of the ending edge of the last pixel is used (wavelength of
+the last pixel plus 0.5).  If both are not specified, that is set to INDEF,
+then the whole spectrum is copied and the \fIrebin\fR parameter is
+ignored.  Note that by specifying both endpoints the copied region can be
+set to have increasing or decreasing wavelength per pixel.  If the spectrum
+only partially covers the specified range only that portion of the spectrum
+within the range is copied.  It is an error if the range is entirely
+outside that of a spectrum.
+.le
+.ls apertures = "", beams = ""
+List of apertures and beams to be selected from the input spectra.  The
+logical intersection of the two lists is selected.  The null list
+selects all apertures or beams.  A list consists of comma separated
+numbers and ranges of numbers.  A range is specified by a hyphen.  An
+optional step size may be given by 'x' followed by a number.
+See \fBxtools.ranges\fR for more information.  If the first character
+is "!" then the apertures/beams not in the list are selected.  Note
+that a "!" in either of the lists complements the intersection of the
+two lists.
+For longslit input spectra the aperture numbers
+selects the lines or columns to be extracted.  For 3D Fabry-Perot
+spectra the aperture numbers select the first spatial axis.
+.le
+.ls bands = ""
+List of bands in 3D multispec.
+For 3D spatial spectra the band parameter applies to the second
+spatial axis.
+The null list selects all bands.  The syntax is as described above.
+.le
+.ls apmodulus = 0
+Modulus to be applied to the input aperture numbers before matching against
+the aperture list.  If zero then no modulus is used.  This is used to
+select apertures which are related by the same modulus, typically a
+factor of 10; for example, 10, 1010, and 2010 with a modulus of 1000 are
+related.
+.le
+.ls reverse = no
+Reverse the order of the operands in a binary operation?  Because the first
+operand is used as the image header template, dispersion coordinate
+template, and output image in the case of a null output list it  must be an
+image and not a constant.  To allow certain operations, for
+example subtracting a spectra from a constant or using the subtractand as
+the dispersion coordinate template, the reverse option is used to reverse
+the order of the operands in a binary operation.
+.le
+.ls ignoreaps = no
+Ignore aperture numbers in the second operand?  Normally, spectra in
+binary operations must have matching aperture numbers, otherwise an
+error is printed.  If this parameter is yes then the spectra are matched
+by line number with the last line being used if the second operand spectrum
+has fewer lines than the first operand spectrum.  This is generally
+used to allow using a single spectrum with multiple aperture spectra.
+.le
+.ls format = "multispec" (multispec|onedspec)
+Output image format and name syntax.  The "multispec" format consists of
+one or more spectra in the same image file.  The "onedspec" format consists
+of a single spectrum per image with names having a root name and a four
+digit aperture number extension.  Note that converting to "onedspec" format
+from three dimensional images where the third dimension contains associated
+spectra will not include data from the extra dimension.  Image sections may
+be used in this case.
+.le
+.ls renumber = no
+Renumber the output aperture numbers?  If set the output aperture
+numbers, including any preexisting spectra when merging, are renumbered
+beginning with 1.  The \fIoffset\fR parameter may be used to
+change the starting number.
+.le
+.ls offset = 0
+Offset to be added to the input or renumbered aperture number to form
+the final output aperture number.
+.le
+.ls clobber = no
+Modify an existing output image either by overwriting or merging?
+.le
+.ls merge = no
+Merge apertures into existing spectra?  This
+requires that the \fIclobber\fR parameter be set.  If not merging
+then the selected spectra entirely replace those in existing output images.
+If merging then the input spectra replace those in the output image
+with the same aperture number and new apertures are added if not present.
+.le
+.ls rebin = yes
+Rebin the spectrum to the exact wavelength range specified by the \fIw1\fR
+and \fIw2\fR parameters?  If the range is given as INDEF for both endpoints
+this parameter does not apply.  If a range is given and this parameter is
+not set then the pixels in the specified range (using the nearest pixels to
+the endpoint wavelengths) are copied without rebinning.  In this case the
+wavelength of the first pixel may not be exactly that specified by \fIw1\fR
+and the dispersion, including non-linear dispersions, is unchanged.  If
+this parameter is set the spectra are interpolated to have the first and
+last pixels at exactly the specified endpoint wavelengths while preserving
+the same number of pixels in the interval.  Linear and log-linear
+dispersion types are maintained while non-linear dispersions are
+linearized.
+.le
+.ls errval = 0.
+Value for resultant pixel if an arithmetic error occurs such as dividing
+by zero or the square root of a negative number.
+.le
+.ls verbose = no
+Print a record of each operation?
+.le
+.ih
+DESCRIPTION
+\fBSarith\fR performs arithmetic operations on spectra.  It is
+distinguished from \fBimarith\fR in that it includes unary operators, like
+\fBimfunction\fR but with some specific to astronomical spectra, and binary
+operations between two spectra are performed in dispersion coordinate space
+(typically wavelength) rather than logical pixel space.  In the latter case
+the spectra are checked for matching dispersion functions (which are not
+necessarily linear) and, if they don't match, the second operand is
+interpolated without flux conservation.  (If flux conservation is desired
+then the task \fBdispcor\fR should be used first.) Thus, the spectra may
+have different dispersion functions but the arithmetic is done at matching
+wavelengths.  The default interpolation function is a 5th order
+polynomial.  The choice of interpolation type is made with the package
+parameter "interp".  It may be set to "nearest", "linear", "spline3",
+"poly5", or "sinc".  Remember that this applies to all tasks which might
+need to interpolate spectra in the \fBonedspec\fR and associated packages.
+For a discussion of interpolation types see \fBonedspec\fR.
+
+The unary operators operate on the spectra in the first operand list to
+produce the specified output spectra, which may be the same as the
+input spectra.  The operators include:
+
+.nf
+	abs  - absolute value
+	copy - copy (see also \fBscopy\fR)
+	dex  - decimal exponentiation (antilog of base 10 logarithm)
+	exp  - base e exponentiation (antilog of natural logarithm)
+	flam - convert F-nu to F-lambda
+	fnu  - convert F-lambda to F-nu
+	inv  - inverse
+	ln   - natural logarithm
+	log  - base 10 logarithm
+	lum  - convert magnitude to luminosity
+	mag  - convert luminosity to magnitude
+	sqrt - square root
+.fi
+
+The luminosity to magnitude and magnitude to luminosity operators are
+based on the standard relation:
+
+.nf
+	mag = -2.5 * log (lum)
+.fi
+
+where the log is base 10.  The F-nu to F-lambda and F-lambda to F-nu
+operators are based on the relation:
+
+.nf
+	F-nu = F-lambda * lambda / nu
+.fi
+
+where lambda is wavelength and nu is frequency (currently the wavelength
+is assumed to be Angstroms and so F-lambda is in units of per Angstrom
+and F-nu is in units of per Hertz).  In all the operators it is the
+responsibility of user as to the appropriateness of the operator to
+the input.
+
+The binary operators operate on the spectra in the first operand list
+and the spectra or numerical constants in the second operand.  Numeric
+constants are equivalent to spectra having the specified value at all
+pixels.  The binary operators are the standard arithmetic ones plus
+exponentiation and replacement:
+
+.nf
+	replace - replace first operand values by second operand values
+	+       - addition
+	-       - subtraction
+	*       - multiplication
+	/       - division
+	^       - exponentiation
+.fi
+
+If the second operand is a spectrum, as mentioned previously, it is
+interpolated, without flux conservation, to the dispersion
+function of the first operand spectrum if necessary.
+
+There is a distinctions between the first operand and the second operand.
+The first operand must always be a spectrum.  It supplies the dispersion
+function to be matched by the second operand spectrum.  It also supplies
+a copy of it's image header when a new output spectrum is created.
+In cases where it is desired to have the second operand be the
+dispersion/header reference and/or the first operand be a constant
+the \fIreverse\fR parameter is used.  For example to subtract a
+spectrum from the constant 1:
+
+.nf
+	cl> sarith 1 - spec invspec reverse+
+.fi
+
+or to subtract two spectra using the subtractand as the dispersion
+reference:
+
+.nf
+	cl> sarith spec1 - spec2 diff reverse+
+.fi
+
+When a binary operation on a pair of spectra is performed the aperture
+numbers may be required to be the same if \fIignoreaps\fR is no.  For
+images containing multiple spectra the apertures need not be in the
+same order but only that matching apertures exist.  If this parameter
+is set to yes then aperture numbers are ignored when the operation is
+performed.  For multiple spectra images the second operand spectra
+are matched by image line number rather than by aperture.  If the
+second operand image has fewer lines, often just one line, then the
+last line is used repeatedly.  This feature allows multiple spectra
+in the primary operand list to be operated upon by a single spectrum;
+for example to subtract one spectrum from all spectra in the
+in a multiple spectrum image.
+
+If it is an error to perform an operation on certain data values, for
+example division by zero or the square root of a negative number,
+then the output value is given the value specified by the parameter
+\fIerrval\fR.
+
+A log of the operations performed may be printed to the standard
+output, which may then be redirected if desired, if the \fIverbose\fR
+parameter is set.  In the output the last bracketed number is the
+aperture number of the spectrum.
+
+INPUT/OUTPUT
+
+The arithmetic part of \fBsarith\fR is fairly straightforward and
+intuitive.  The selection of input spectra from input images and
+the placing of output spectra in output images can be more confusing
+because there are many possibilities.  This section concentrates
+on the topics of the input and output.  Since the concepts apply to all
+of the operators it simplifies things to think in terms of copying
+input spectra to output spectra; the "copy" operator.  Note that the
+task \fBscopy\fR is actually just this case of \fBsarith\fR with
+parameters set for copying.  While the discussion here is similar
+to that in the help for \fBscopy\fR, the examples for that task
+are more focused for illustrating this topic than the \fBsarith\fR
+examples which concentrate more on the arithmetic aspects of 
+the task.
+
+Input spectra are specified by an image list which may include explicit
+image names, wildcard templates and @files containing image names.
+The image names may also include image sections such as to select portions of
+the wavelength coverage.  The input images may be either one or two
+dimensional spectra.  One dimensional spectra may be stored in
+individual one dimensional images or as lines in two (or three)
+dimensional images.  The one dimensional spectra are identified by
+an aperture number, which must be unique within an image, and a beam number.
+Two dimensional long slit and three dimensional Fabry-Perot spectra are
+treated, for the purpose of this
+task, as a collection of spectra with dispersion either along any axis
+specified by the DISPAXIS image header parameter
+or the \fIdispaxis\fR package parameter.  The aperture and band
+parameters specify a spatial position.  A number of adjacent
+lines, columns, and bands, specified by the \fInsum\fR package parameter,
+will be summed to form an aperture spectrum.  If number is odd then the
+aperture/band number refers to the middle and if it is even it refers to the
+lower of the two middle lines or columns.
+
+In the case of many spectra each stored in separate one dimensional
+images, the image names may be such that they have a common root name
+and a four digit aperture number extension.  This name syntax is
+called "onedspec" format.  Including such spectra in an
+input list may be accomplished either with wildcard templates such as
+
+.nf
+	name*
+	name.????.imh
+.fi
+
+where the image type extension ".imh" must be given to complete the
+template but the actual extension could also be that for an STF type
+image, or using an @file prepared with the task \fBnames\fR.
+To generate this syntax for output images the \fIformat\fR parameter
+is set to "onedspec" (this will be discussed further later).
+
+From the input images one may select a range of wavelengths with the
+\fIw1\fR and \fIw2\fR parameters and a subset of spectra based on aperture and
+beam numbers using the \fIaperture\fR and \fIbeam\fR parameters.
+If the wavelength range is specified as INDEF the full spectra are
+used without any resampling.  If the aperture and beam lists are not
+specified, an empty list, then all apertures and beams are selected.  The
+lists may be those spectra desired or the complement obtained by prefixing
+the list with '!'.  Only the selected wavelength range and spectra will
+be operated upon and passed on to the output images.
+
+Specifying a wavelength range is fairly obvious except for the question
+of pixel sampling.  Either the pixels in the specified range are used
+without resampling or the pixels are resampled to correspond eactly
+to the requested range.  The choice is made with the \fIrebin\fR parameter.
+In the first case the nearest pixels to the specified wavelength
+endpoints are determined and those pixels and all those in between
+are used.  The dispersion relation is unchanged.  In the second case
+the spectra are reinterpolated to have the specified starting and
+ending wavelengths with the same number of pixels between those points
+as in the original spectrum.  The reinterpolation is done in either
+linear or log-linear dispersion.  The non-linear dispersion functions
+are interpolated to a linear dispersion.
+
+Using \fBsarith\fR with long slit and Fabry-Perot images provides a quick
+and simple type of extraction as opposed to using the \fBapextract\fR
+package.  When summing it is often desired to start each aperture after the
+number of lines summed.  To do this specify a step size in the aperture/band
+list.  For example to extract columns 3 to 23 summing every 5 columns you
+would use an aperture list of "3-23x5" and an \fInsum\fR of 5.  If you do
+not use the step in the aperture list you would extract the sum of columns
+1 to 5, then columns 2 to 6, and so on.
+
+In the special case of subapertures extracted by \fBapextract\fR, related
+apertures are numbered using a modulus; for example apertures
+5, 1005, 2005.  To allow selecting all related apertures using a single
+aperture number the \fIapmodulus\fR parameter is used to specify the
+modulus factor; 1000 in the above example.  This is a very specialized
+feature which should be ignored by most users.
+
+The output list of images may consist of an empty list, a single image,
+or a list of images matching the input list in number.  Note that it
+is the number of image names that matters and not the number of spectra
+since there may be any number of spectra in an image.  The empty list
+converts to the same list as the input and is shorthand for replacing
+the input image with the output image upon completion; therefore it
+is equivalent to the case of a matching list.  If the input
+consists of just one image then the distinction between a single
+output and a matching list is moot.  The interesting distinction is
+when there is an input list of two or more images.  The two cases
+are then a mapping of many-to-many or many-to-one.  Note that it is
+possible to have more complex mappings by repeating the same output
+name in a matching list provided clobbering, merging, and possibly
+renumbering is enabled.
+
+In the case of a matching list, spectra from different input images
+will go to different output images.  In the case of a single output
+image all spectra will go to the same output image.  Note that in
+this discussion an output image when "onedspec" format is specified
+is actually a root name for possibly many images.  However,
+it should be thought of as a single image from the point of view
+of image lists.
+
+When mapping many spectra to a single output image, which may have existing
+spectra if merging, there may be a conflict with repeated aperture
+numbers.  One option is to consecutively renumber the aperture numbers,
+including any previous spectra in the output image when merging and then
+continuing with the input spectra in the order in which they are selected.
+This is specified with the \fIrenumber\fR parameter which renumbers
+beginning with 1.
+
+Another options which may be used independently of renumbering or in
+conjunction with it is to add an offset as specified by the \fIoffset\fR
+parameter.  This is last step in determining the output aperture
+numbers so that if used with the renumber option the final aperture
+numbers begin with one plus the offset.
+
+It has been mentioned that it is possible to write and add to
+existing images.  If an output image exists an error will be
+printed unless the \fIclobber\fR parameter is set.  If clobbering
+is allowed then the existing output image will be replaced by the
+new output.  Rather than replacing an output image sometimes one
+wants to replace certain spectra or add new spectra.  This is
+done by selecting the \fImerge\fR option.  In this case if the output
+has a spectrum with the same aperture number as the input spectrum
+it is replaced by the input spectrum.  If the input spectrum aperture
+number is not in the output then the spectrum is added to the output
+image.  To add spectra with the same aperture number and not
+replace the one in the output use the \fIrenumber\fR or
+\fIoffset\fR options.
+.ih
+EXAMPLES
+In addition to the examples in this section there are many examples
+in the help for \fBscopy\fR which illustrate aspects of selecting
+input spectra and producing various types of output.  Those examples
+are equivalent to using the "copy" operator.  The same examples will
+also apply with other operators where the input spectra are modified
+arithmetically before being copied to the output images.
+
+I.  SIMPLE EXAMPLES
+
+The simple examples use only a single input image and create a new
+output image.
+
+1.  Examples of unary operations:
+
+.nf
+	cl> sarith example1 mag "" magexample
+	cl> sarith magexample lum "" example2
+	cl> sarith example1 log "" logexample
+.fi
+
+Note that a place holder for the second operand is required on the command
+line which will be ignored.
+
+2.  Examples of binary operations using constants:
+
+.nf
+	cl> sarith example1 + 1000 example2
+	cl> sarith example1 - 1000 example2 reverse+
+	cl> sarith example1 / 1000 example2
+	cl> sarith example1 ** 2 example2
+.fi
+
+3.  Examples of binary operations between spectra with matching apertures:
+
+.nf
+	cl> sarith example1 + example2 example3
+	cl> sarith example1 - example2 example3
+.fi
+
+4.  Example of binary operations between spectra with the second image
+consisting of a single spectrum:
+
+.nf
+	cl> sarith example1 / flatspec flatexample1 ignore+ errval=1
+.fi
+
+II.  MORE COMPLEX EXAMPLES
+
+5.  Unary and constant operations on a list of images:
+
+.nf
+	cl> sarith example* fnu "" %example%fnu%
+	cl> sarith example* + 1000 %example%fnu%
+.fi
+
+6.  Binary operations on a list of images using a single second operand
+with matching apertures:
+
+.nf
+	cl> sarith example* - skyspec %example%skysub%*
+.fi
+
+7.  Selecting apertures to operate upon:
+
+.nf
+	cl> sarith example* - skyspec %example%skysub%* aper=1,5,9
+.fi
+
+8.  Extract the sum of each 10 columns in a long slit spectrum and normalize
+by the central spectrum:
+
+.nf
+	cl> nsum = "10"
+	cl> sarith longslit copy "" longslit.ms aper=5-500x10
+	longslit[5]  -->  longslit.ms[5]
+	longslit[15]  -->  longslit.ms[15]
+	longslit[25]  -->  longslit.ms[25]
+	...
+	cl> sarith longslit.ms / longslit.ms[*,25] norm ignore+
+	longslit.ms[5]  /  longslit.ms[*,25][245]  -->  norm[5]
+	longslit.ms[15]  /  longslit.ms[*,25][245]  -->  norm[15]
+	longslit.ms[25]  /  longslit.ms[*,25][245]  -->  norm[25]
+	...
+.fi
+
+9.  In place operations:
+
+.nf
+	cl> sarith example* + 1000 example* clobber+
+	example1[1]  +  1000.  -->  example1[1]
+	example1[2]  +  1000.  -->  example1[2]
+	...
+	example2[1]  +  1000.  -->  example2[1]
+	example2[2]  +  1000.  -->  example2[2]
+	...
+	cl> sarith example* flam "" example* clobber+
+	example1[1]  -- flam -->  example1[1]
+	example1[2]  -- flam -->  example1[2]
+	...
+	example2[1]  -- flam -->  example2[1]
+	example2[2]  -- flam -->  example2[2]
+	...
+	cl> sarith example* - skyspec "" clobber+ ignore+
+	example1[1]  +  skyspec[1]  -->  example1[1]
+	example1[2]  +  skyspec[1]  -->  example1[2]
+	...
+	example2[1]  +  skyspec[1]  -->  example2[1]
+	example2[2]  +  skyspec[1]  -->  example2[2]
+	...
+.fi
+
+10.  Merging existing spectra with the results of operations:
+
+.nf
+	cl> sarith example* / flat "" clobber+ merge+ renum+ ignor+
+.fi
+.ih
+REVISIONS
+.ls SARITH V2.11
+Previously both w1 and w2 had to be specified to select a range to
+be used.  Now if only one is specified the second endpoint defaults
+to the first or last pixel.
+
+The noise band in multispec data is only copied from the primary
+spectrum and not modified.  This is a kludge until the noise is
+handled properly.
+.le
+.ls SARITH V2.10.3
+Additional support for 3D multispec/equispec or spatial spectra has been
+added.  The "bands" parameter allows selecting specific bands and
+the onedspec output format creates separate images for each selected
+aperture and band.
+.le
+.ls SARITH V2.10
+This task is new.
+.le
+.ih
+SEE ALSO
+scopy, splot, imarith, imfunction
+.endhelp
diff --git a/noao/onedspec/doc/sbands.hlp b/noao/onedspec/doc/sbands.hlp
new file mode 100644
index 00000000..0bde52ac
--- /dev/null
+++ b/noao/onedspec/doc/sbands.hlp
@@ -0,0 +1,209 @@
+.help sbands Nov93 onedspec
+.ih
+NAME
+sbands -- bandpass spectrophotometry of spectra
+.ih
+USAGE
+sbands input output bands
+.ih
+PARAMETERS
+.ls input
+Input list of spectra to be measured.  These may be one dimensional
+spectra in individual or "multispec" format or calibrated spatial spectra such
+as long slit or Fabry-Perot images.  The dispersion axis and summing
+parameters are specified by package parameters for the spatial spectra.
+.le
+.ls output
+Output file for the results.  This may be a filename or "STDOUT" to
+write to the terminal.
+.le
+.ls bands
+Bandpass file consisting of lines with one, two, or three bandpasses per
+line.  A bandpass is specified by an identification string (quoted if it is
+null or contains whitespace), the central wavelength, the width of the
+bandpass in wavelength, and a filter filename with the special value "none"
+if there is no filter (a flat unit response).  This format is described
+further in the description section.
+.le
+.ls apertures = ""
+List of apertures to select from the input spectra.  For one dimensional
+spectra this is the aperture number and for spatial spectra it is
+the column or line.  If the null string is specified all apertures are
+selected.  The aperture list syntax is a range list which includes
+intervals and steps (see \fBranges\fR).
+.le
+.ls normalize = yes
+Normalize the bandpass fluxes by the bandpass response?  If no then
+the results will depend on the bandpass widths and filter function
+values.  If yes then fluxes will be comparable to an average pixel
+value.  When computing indices and equivalent widths the flux must
+either be normalized or the bandpasses and filter response functions
+must be the same.
+.le
+.ls mag = no, magzero = 0.
+Output the bandpass fluxes as magnitudes with specified magnitude
+zero point?
+.le
+.ls verbose = yes
+Include a verbose header giving a banner, the parameters used,
+the bandpasses, and column headings?
+.le
+.ih
+DESCRIPTION
+\fBSbands\fR performs bandpass spectrophotometry with one or more bandpasses
+on one or more spectra.  A list of input spectra is specified.  The spectra
+may be of any type acceptable in the \fBnoao.onedspec\fR package including
+multispec format with nonlinear dispersion, long slit spectra, and even
+3D cubes with one dispersion axis.  The \fIapertures\fR parameter allows
+selecting a subset of the spectra by aperture number.
+
+The bandpasses are specified in a text file.  A bandpass consists of four
+fields; an identification name, the wavelength of the bandpass center, a
+bandpass width, and a filename for a filter.  The identification is a
+string which must be quoted if a null name or a name with whitespace is
+desired.  The identification could be given as the central wavelength if
+nothing else is appropriate.  The filter field is a filename for a text
+file containing the filter values.  A filter file consists of a wavelength
+ordered list of wavelength and relative response.  Extrapolation uses the
+end point values and interpolation is linear.  The special name "none" is
+used if there is no filter.  This is equivalent to unit response at all
+wavelengths.
+
+In the bandpass file there may be one, two, or three bandpasses on
+a line.  Below are some examples of the three cases:
+
+.nf
+   alpha 5000 10 myalpha.dat
+   beta1 4000 100 none	     beta2 4100 100 none
+   line  4500 100 none	     red   4000 200 none blue 5000 200 none
+.fi
+
+The flux in each bandpass is measured by summing each pixel in the interval
+multiplied by the interpolated filter response at that pixel.  At the edges
+of the bandpass the fraction of the pixel in the bandpass is used.  If the
+bandpass goes outside the range of the data an INDEF value will be reported.
+If the \fInormalize\fR option is yes then the total flux is divided by
+the sum of the filter response values.  If the \fImag\fR option is
+yes the flux will be converted to a magnitude (provided it is positive)
+using the formula
+
+.nf
+    magnitude = magzero - 2.5 * log10 (flux)
+.fi
+
+where \fImagzero\fR is a parameter for the zero point magnitude and log10
+is the base 10 logarithm.  Note that there is no attempt to deal with the
+pixel flux units.  This is the responsibility of the user.
+
+If there is only one bandpass (on one line of the band file) then only
+the band flux or magnitude is reported.  If there are two bandpasses
+the fluxes or magnitudes for the two bands are reported as well as a
+band index, the flux ratio or magnitude difference (depending on the \fImag\fR)
+flag, and an equivalent width using the second band as the continuum.
+If there are three bandpasses then a continuum bandpass flux is computed
+as the interpolation between the bandpass centers to the center of the
+first bandpass.  The special bandpass identification "cont" will
+be reported.
+
+The equivalent width is obtained from the two bandpasses by the
+formula
+
+.nf
+    eq. width = (1 - flux1 / flux2) * width1
+.fi
+
+where flux1 and flux2 are the two bandpass fluxes and width1 is the
+width of the first bandpass.  Note that for this to be meaningful
+the bandpasses should be normalized or have the same width/response.
+
+The results of measuring each bandpass in each spectrum are written
+to the specified output file.  This file may be given as "STDOUT" to
+write the results to the terminal.  The output file contains lines
+with the spectrum name and aperture, the band identifications and
+fluxes or magnitudes, and the band index and equivalent width (if
+appropriate).  The \fIverbose\fR option allows creating a more
+documented output by including a commented header with the task
+name and parameters, the bandpass definitions, and column labels.
+The examples below show the form of the output.
+.ih
+EXAMPLES
+The following examples use artificial data and arbitrary bands.
+
+1.  Show example results with one, two, and three bandpass entries in
+the bandpass file.
+
+.nf
+    cl> type bands
+    test 6125 50 none red 6025 100 none blue 6225 100 none
+    test 6125 50 none red 6025 100 none
+    test 6125 50 none blue 6225 100 none
+    test 6125 50 none
+    cl> sbands oned STDOUT bands
+
+    # SBANDS: NOAO/IRAF IRAFX valdes@puppis Mon 15:31:45 01-Nov-93
+    #   bands = bands, norm = yes, mag = no
+    #       band     filter wavelength      width
+    #       test       none      6125.        50.
+    #        red       none      6025.       100.
+    #       blue       none      6225.       100.
+    #       test       none      6125.        50.
+    #        red       none      6025.       100.
+    #       test       none      6125.        50.
+    #       blue       none      6225.       100.
+    #       test       none      6125.        50.
+    #
+    #       spectrum    band    flux    band    flux   index eqwidth
+	     oned(1)    test   44.33    cont   97.97    0.45   27.37
+	     oned(1)    test   44.33     red   95.89    0.46   26.89
+	     oned(1)    test   44.33    blue  100.04    0.44   27.84
+	     oned(1)    test   44.33
+.fi
+
+2.  This example shows measurements on a long slit spectrum with an
+aperture selection and magnitude output.
+
+.nf
+    cl> type lsbands.dat
+    band1 4500 40 none
+    band2 4600 40 none
+    band3 4700 40 none
+    cl> nsum=5
+    cl> sbands ls STDOUT lsbands.dat apertures=40-60x5 mag+ magzero=10.1
+
+    # SBANDS: NOAO/IRAF IRAFX valdes@puppis Mon 15:37:18 01-Nov-93
+    #   bands = lsbands.dat, norm = yes, mag = yes, magzero = 10.10
+    #       band     filter wavelength      width
+    #      band1       none      4500.        40.
+    #      band2       none      4600.        40.
+    #      band3       none      4700.        40.
+    #
+    #       spectrum    band     mag
+     ls[38:42,*](40)   band1    3.14
+     ls[38:42,*](40)   band2    3.19
+     ls[38:42,*](40)   band3    3.15
+     ls[43:47,*](45)   band1    3.13
+     ls[43:47,*](45)   band2    3.15
+     ls[43:47,*](45)   band3    3.14
+     ls[48:52,*](50)   band1    2.34
+     ls[48:52,*](50)   band2    2.43
+     ls[48:52,*](50)   band3    2.43
+     ls[53:57,*](55)   band1    3.10
+     ls[53:57,*](55)   band2    3.15
+     ls[53:57,*](55)   band3    3.12
+     ls[58:62,*](60)   band1    3.14
+     ls[58:62,*](60)   band2    3.19
+     ls[58:62,*](60)   band3    3.15
+.fi
+.ih
+REVISIONS
+.ls SBANDS V2.10.4
+The flux column is now printed to 6 digits of precision with possible
+exponential format to permit flux calibrated spectra to print properly.
+.le
+.ls SBANDS V2.10.3
+The task is new in this release
+.le
+.ih
+SEE ALSO
+splot
+.endhelp
diff --git a/noao/onedspec/doc/scombine.hlp b/noao/onedspec/doc/scombine.hlp
new file mode 100644
index 00000000..06e63003
--- /dev/null
+++ b/noao/onedspec/doc/scombine.hlp
@@ -0,0 +1,765 @@
+.help scombine Sep97 noao.onedspec
+.ih
+NAME
+scombine -- Combine spectra
+.ih
+USAGE
+scombine input output
+.ih
+PARAMETERS
+.ls input
+List of input images containing spectra to be combined.  The spectra
+in the images to be combined are selected with the \fIapertures\fR and
+\fIgroup\fR parameters.  Only the primary spectrum is combined and
+the associated band spectra are ignored.
+.le
+.ls output
+List of output images to be created containing the combined spectra.
+If the grouping option is "all"
+or "apertures" then only one output image will be created.  In the
+first case the image will contain only one spectrum and in the latter case
+there will be a spectrum for each selected aperture.
+If the grouping option is "images" then there will be one
+output spectrum per input spectrum.
+.le
+.ls noutput = ""
+List of output images to be created containing the number of spectra combined.
+The number of images required is the same as the \fIoutput\fR list.
+Any or all image names may be given as a null string, i.e. "", in which
+case no output image is created.
+.le
+.ls logfile = "STDOUT"
+File name for recording log information about the combining operation.
+The file name "STDOUT" is used to write the information to the terminal.
+If the null string is specified then no log information is printed or
+recorded.
+.le
+
+.ls apertures = ""
+List of apertures to be selected for combining.  If none is specified
+then all apertures are selected.  The syntax is a blank or comma separated
+list of aperture numbers or aperture ranges separated by a hyphen.
+.le
+.ls group = "apertures" (all|images|apertures)
+Option for grouping input spectra for combining (after selection by aperture)
+from one or more input images.  The options are:
+.ls "all"
+Combine all spectra from all images in the input list into a single output
+spectrum.
+.le
+.ls "images"
+Combine all spectra in each input image into a single spectrum in
+separate output images.
+.le
+.ls "apertures"
+Combine all spectra of the same aperture from all input images and put it
+into a single output image with the other selected apertures.
+.le
+.le
+.ls combine = "average" (average|median|sum)
+Option for combining pixels at the same dispersion coordinate.  after any
+rejection operation.  The options are to compute the  "average", "median",
+or "sum" of the pixels.  The first two are applied after any pixel
+rejection.  The sum option ignores the rejection and scaling parameters and
+no rejection is performed.  In other words, the "sum" option is simply the
+direct summation of the pixels.  The median uses the average of the two
+central values when the number of pixels is even.
+.le
+.ls reject = "none" (none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip)
+Type of rejection operation performed on the pixels which overlap at each
+dispersion coordinate.  The algorithms are discussed in the
+DESCRIPTION section.  The rejection choices are:
+
+.nf
+      none - No rejection
+    minmax - Reject the nlow and nhigh pixels
+   sigclip - Reject pixels using a sigma clipping algorithm
+ avsigclip - Reject pixels using an averaged sigma clipping algorithm
+   ccdclip - Reject pixels using CCD noise parameters
+  crreject - Reject only positive pixels using CCD noise parameters
+     pclip - Reject pixels using sigma based on percentiles
+.fi
+
+.le
+
+.ls first = no
+Use the first input spectrum of each set to be combined to define the
+dispersion coordinates for combining and output?  If yes then all other
+spectra to be combined will be interpolated to the dispersion of this
+reference spectrum and that dispersion defines the dispersion of the
+output spectrum.  If no, then all the spectra are interpolated to a linear
+dispersion as determined by the following parameters.  The interpolation
+type is set by the package parameter \fIinterp\fR.
+.le
+.ls w1 = INDEF, w2=INDEF, dw = INDEF, nw = INDEF, log = no
+The output linear or log linear wavelength scale if the dispersion of the
+first spectrum is not used.  INDEF values are filled in from the maximum
+wavelength range and minimum dispersion of the spectra to be combined.  The
+parameters are aways specified in linear wavelength even when the log
+parameter is set to produce constant pixel increments in the log of the
+wavelength.  The dispersion is interpreted in that case as the difference
+in the log of the endpoints divided by the number of pixel increments.
+.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, scale by 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 spectra.
+.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 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 spectra. 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 spectra.
+.le
+.ls sample = ""
+Wavelength sample regions to use in computing spectrum statistics for
+scaling and weighting.  If no sample regions are given then the entire
+input spectrum is used.  The syntax is colon separated wavelengths
+or a file containing colon separated wavelengths preceded by the
+@ character; i.e. @<file>.
+.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 spectra
+so that if no rejections have taken place the specified number of pixels
+are rejected while if pixels have been rejected by 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.  This is actually converted to a number
+to keep by adding it to the number of images.
+.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)
+Effective 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.  Note that if the spectra
+have been extracted from a 2D CCD image then the noise parameters must be
+adjusted for background and the aperture summing.
+.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.
+See the DESCRIPTION section for further details.
+.le
+.ls grow = 0
+Number of pixels to either side of a rejected pixel
+to also be rejected.  This applies only to pixels rejected by one of
+the rejection algorithms and not the threshold rejected pixels.
+.le
+.ls blank = 0.
+Value to use when there are no input pixels to combine for an output pixel.
+.le
+.ih
+DESCRIPTION
+\fBScombine\fR combines input spectra by interpolating them (if necessary)
+to a common dispersion sampling, rejecting pixels exceeding specified low
+and high thresholds, scaling them in various ways, applying a rejection
+algorithm based on known or empirical noise statistics, and computing the
+sum, weighted average, or median of the remaining pixels.  Note that
+the "sum" option is the direct summation of the pixels and does not
+perform any rejection or scaling of the data regardless of the parameter
+settings.
+
+The input spectra are specified using an image list in which each image
+may contain multiple spectra.  The set of spectra may be restricted
+by the \fIaperture\fR parameter to specific apertures.  The set of input
+spectra may then be grouped using the \fIgroup\fR parameter and each
+group combined separately into a final output spectrum.  The grouping
+options are to select all the input spectra regardless of the input
+image or aperture number, select all spectra of the same aperture,
+or select all the spectra from the same input image.
+
+The output consists of either a single image with one spectrum for each
+combined group or, when grouping by image, an image with the single
+combined spectra from each input image.  The output images and
+combined spectra inherit the header parameters from the first spectrum
+of the combined group.  In addition to the combined spectrum an associated
+integer spectrum containing the number of pixels combined
+and logfile listing the combined spectra, scaling, weights, etc, may
+be produced.
+
+The spectral combining is done using pixels at common dispersion
+coordinates rather than physical or logical pixel coordinates.  If the
+spectra to be combined do not have identical dispersion coordinates then
+the spectra are interpolated to a common dispersion sampling before
+combining.  The interpolation conserves pixel values rather pixel fluxes.
+This means that flux calibrated data is treated correctly and that
+spectra in counts are not corrected in the interpolation for changes
+in pixel widths.  
+The default interpolation function is a 5th order polynomial.  The
+choice of interpolation type is made with the package parameter "interp".
+It may be set to "nearest", "linear", "spline3", "poly5", or "sinc".
+Remember that this applies to all tasks which might need to interpolate
+spectra in the \fBonedspec\fR and associated packages.  For a discussion of
+interpolation types see \fBonedspec\fR.
+
+There are two choices for the common dispersion coordinate sampling. If the
+\fIfirst\fR parameter is set then the dispersion sampling of the first
+spectrum is used.  This dispersion system may be nonlinear.  If the
+parameter is not set then the user specified linear or log linear
+dispersion system is used.  Any combination of starting wavelength, ending
+wavelength, wavelength per pixel, and number of output pixels may be
+specified.  Unspecified values will default to reasonable values based on
+the minimum or maximum wavelengths of all spectra, the minimum dispersion,
+and the number of pixels needed to satisfy the other parameters.  If the
+parameters overspecify the linear system then the ending wavelength is
+adjusted based on the other parameters.  Note that for a log linear system
+the wavelengths are still specified in nonlog units and the dispersion is
+finally recalculated using the difference of the log wavelength endpoints
+divided by the number pixel intervals (the number of pixels minus one).
+
+There are several stages to combining a selected group of spectra.  The
+first is interpolation to a common dispersion sampling as discussed
+above.  The second stage is to eliminate any pixels outside the specified
+thresholds.  Note that the thresholds apply to the interpolated
+spectra.  Scaling and zero offset factors are computed and applied to the
+spectra if desire.  The computation of these factors as well as weights is
+discussed in the following section.  Next there is a choice of rejection
+algorithms to identify and eliminate deviant pixels.  Some of these are
+based on order statistics and some relative to the distance from an initial
+median or average using a noise model cutoff.  A growing factor may be
+applied to neighbors of rejected pixels to reject additional pixels.  The
+various algorithms are described in detail in a following section.
+Finally, the remaining pixels are combined by summing (which may not be
+appropriate when pixels are rejected), computing a median, or computing a
+weighted or unweighted average.  The combined spectrum is written to an
+output image as well the number of pixels used in the final combining.
+
+SCALES AND WEIGHTS
+
+In order to combine spectra with rejection of pixels based on deviations
+from some average or median they must be scaled to a common level.  There
+are two types of scaling available, a multiplicative intensity scale and an
+additive zero point shift.  The intensity scaling is defined by the
+\fIscale\fR parameter and the zero point shift by the \fIzero\fR
+parameter.  These parameters may take the values "none" for no scaling,
+"mode", "median", or "mean" to scale by statistics of the spectrum pixels,
+"exposure" (for intensity scaling only) to scale by the exposure time
+keyword in the image header, any other image header keyword specified by
+the keyword name prefixed by the character '!', and the name of a file
+containing the scale factors for the input image prefixed by the
+character '@'.
+
+Examples of the possible parameter values are shown below where
+"myval" is the name of an image header keyword and "scales.dat" is
+a text file containing a list of scale factors.
+
+.nf
+	scale = none		No scaling
+	zero = mean		Intensity offset by the mean
+	scale = exposure	Scale by the exposure time
+	zero = !myval		Intensity offset by an image keyword
+	scale = @scales.dat	Scales specified in a file
+.fi
+
+The spectrum statistics factors are computed within specified sample
+regions given as a series of colon separated wavelengths.  If no
+regions are specified then all pixels are used.  If the
+wavelength sample list is too long the regions can be defined in a file and
+specified in the \fIsample\fR parameter using the syntax @<file> where file
+is the filename.
+
+The statistics are as indicated by their names.  In particular, the
+mode is a true mode using a bin size which is a fraction of the
+range of the pixels and is not based on a relationship between the
+mode, median, and mean.  Also thresholded pixels are excluded from the
+computations as well as during the rejection and combining operations.
+
+The "exposure" option in the intensity scaling uses the value of the image
+header keyword (EXPTIME, EXPOSURE, or ITIME).  Note that the exposure
+keyword is also updated in the final image as the weighted average of the
+input values.  If one wants to use a nonexposure time keyword and keep the
+exposure time updating feature the image header keyword syntax is
+available; i.e. !<keyword>.
+
+Scaling values may be defined as a list of values in a text file.  The file
+name is specified by the standard @file syntax.  The list consists of one
+value per line.  The order of the list is assumed to be the same as the
+order of the input spectra.  It is a fatal error if the list is incomplete
+and a warning if the list appears longer than the number of input spectra.
+Consideration of the grouping parameter must be included in
+generating this list since spectra may come from different images,
+some apertures may be missing, and, when there are multiple output spectra
+or images, the same list will be repeatedly used.
+
+If both an intensity scaling and zero point shift are selected the
+multiplicative scaling is done first.  Use of both makes sense for images
+if the intensity scaling is the exposure time to correct for
+different exposure times and with the zero point shift allowing for
+sky brightness changes.  This is less relevant for spectra but the option
+is available.
+
+The spectrum statistics and scale factors are recorded in the log file
+unless they are all equal, which is equivalent to no scaling.  The
+intensity scale factors are normalized to a unit mean and the zero
+point shifts are adjusted to a zero mean.  When scal factors
+or zero point shifts are specified by the user in an @file or by an
+image header keyword, no normalization is done.
+
+Scaling affects not only the mean values between spectra but also the
+relative pixel uncertainties.  For example scaling an spectrum by a
+factor of 0.5 will reduce the effective noise sigma of the spectrum
+at each pixel by the square root of 0.5.  Changes in the zero
+point also changes the noise sigma if the spectrum noise characteristics
+are Poissonian.  In the various rejection algorithms based on
+identifying a noise sigma and clipping large deviations relative to
+the scaled median or mean, one may need to account for the scaling induced
+changes in the spectrum noise characteristics.
+
+In those algorithms it is possible to eliminate the "sigma correction"
+while still using scaling.  The reasons this might be desirable are 1) if
+the scalings are similar the corrections in computing the mean or median
+are important but the sigma corrections may not be important and 2) the
+spectrum statistics may not be Poissonian, either inherently or because the
+spectra have been processed in some way that changes the statistics.  In the
+first case because computing square roots and making corrections to every
+pixel during the iterative rejection operation may be a significant
+computational speed limit the parameter \fIsigscale\fR selects how
+dissimilar the scalings must be to require the sigma corrections.  This
+parameter is a fractional deviation which, since the scale factors are
+normalized to unity, is the actual minimum deviation in the scale factors.
+For the zero point shifts the shifts are normalized by the mean shift
+before adjusting the shifts to a zero mean.  To always use sigma scaling
+corrections the parameter is set to zero and to eliminate the correction in
+all cases it is set to a very large number.
+
+If the final combining operation is "average" then the spectra may be
+weighted during the averaging.  The weights are specified in the same way
+as the scale factors.  The weights, scaled to a unit sum, are printed in
+the log output.
+
+The weights are only used for the final weighted average and sigma image
+output.  They are not used to form averages in the various rejection
+algorithms.  For weights in the case of no scaling or only multiplicative
+scaling the weights are used as given or determined so that images
+with lower signal levels will have lower weights.  However, for
+cases in which zero level scaling is used the weights are computed
+from the initial weights (the exposure time, image statistics, or
+input values) using the formula:
+
+.nf
+	weight_final = weight_initial / (scale * zero)
+.fi
+
+where the zero values are those before adjustment to zero mean over
+all images.  The reasoning is that if the zero level is high the sky
+brightness is high and so the S/N is lower and the weight should be lower.
+
+
+THRESHOLD REJECTION
+
+There is an initial threshold rejection step which may be applied.  The
+thresholds are given by the parameters \fIlthreshold\fR and
+\fIhthreshold\fR.  Values of INDEF mean that no threshold value is
+applied.  Threshold rejection may be used to exclude very bad pixel values
+or as a way of masking images.  The former case is useful to exclude very
+bright cosmic rays.  Some of the rejection algorithms, such as "avsigclip",
+can perform poorly if very strong cosmic rays are present.  For masking one
+can use a task like \fBimedit\fR or \fBimreplace\fR to set parts of the
+spectra to be excluded to some very low or high magic value.
+
+
+REJECTION ALGORITHMS
+
+The \fIreject\fR parameter selects a type of rejection operation to
+be applied to pixels not thresholded.  If no rejection
+operation is desired the value "none" is specified.  This task is
+closely related to the image combining task \fBimcombine\fR and, in
+particular, has the same rejection algorithms.
+Some the algorithms are more appropriate to images but are available
+in this task also for completeness.
+
+MINMAX
+.in 4
+A specified fraction of the highest and lowest pixels are rejected.
+The fraction is specified as the number of high and low pixels, the
+\fInhigh\fR and \fInlow\fR parameters, when data from all the input spectra
+are used.  If pixels are missing where there is no overlap or have been
+rejected by thresholding then a matching fraction of the remaining pixels,
+truncated to an integer, are used.  Thus,
+
+.nf
+	nl = n * nlow/nspectra + 0.001 
+	nh = n * nhigh/nspectra + 0.001 
+.fi
+
+where n is the number of pixels to be combined, nspectra is the number
+of input spectra, nlow and nhigh
+are task parameters and nl and nh are the final number of low and
+high pixels rejected by the algorithm.  The factor of 0.001 is to
+adjust for rounding of the ratio.
+
+As an example with 10 input spectra and specifying one low and two high
+pixels to be rejected the fractions to be rejected are 0.1 and 0.2
+and the number rejected as a function of n is:
+
+.nf
+	 n   0  1  2  3  4  5  6  7  8  9 10
+	 nl  0  0  0  0  0  1  1  1  1  1  2
+	 nh  0  0  0  0  0  0  0  0  0  0  1
+.fi
+.in -4
+CCDCLIP
+.in 4
+If the noise characteristics of the spectra can be described by fixed
+gaussian noise, a poissonian noise which scales with the square root of
+the intensity, and a sensitivity noise which scales with the intensity,
+the sigma in data values at a pixel with true value <I>,
+as approximated by the median or average with the lowest and highest value
+excluded, is given as:
+
+.nf
+	sigma = ((rn / g) ** 2 + <I> / g + (s * <I>) ** 2) ** 1/2
+.fi
+
+where rn is the read out noise in electrons, g is the gain in
+electrons per data value, s is a sensitivity noise given as a fraction,
+and ** is the exponentiation operator.  Often the sensitivity noise,
+due to uncertainties in the pixel sensitivities (for example from the
+flat field), is not known in which case a value of zero can be used.
+
+This model is typically valid for CCD images.  During extraction of 
+spectra from CCD images the noise parameters of the spectrum pixels
+will be changed from those of the CCD pixels.  Currently it is up to
+the user to determine the proper modifications of the CCD read noise
+gain, and sensitivity noise.
+
+The read out noise is specified by the \fIrdnoise\fR parameter.  The value
+may be a numeric value to be applied to all the input spectra or an image
+header keyword containing the value for spectra from each image.
+Similarly, the parameter \fIgain\fR specifies the gain as either a value or
+image header keyword and the parameter \fIsnoise\fR specifies the
+sensitivity noise parameter as either a value or image header keyword.
+
+The algorithm operates on each output pixel independently.  It starts by
+taking the median or unweighted average (excluding the minimum and maximum)
+of the unrejected pixels provided there are at least two input pixels.  The
+expected sigma is computed from the CCD noise parameters and pixels more
+that \fIlsigma\fR times this sigma below or \fIhsigma\fR times this sigma
+above the median or average are rejected.  The process is then iterated
+until no further pixels are rejected.  If the average is used as the
+estimator of the true value then after the first round of rejections the
+highest and lowest values are no longer excluded.  Note that it is possible
+to reject all pixels if the average is used and is sufficiently skewed by
+bad pixels such as cosmic rays.
+
+If there are different CCD noise parameters for the input images
+(as might occur using the image header keyword specification) then
+the sigmas are computed for each pixel from each image using the
+same estimated true value.
+
+If the images are scaled and shifted and the \fIsigscale\fR threshold
+is exceedd then a sigma is computed for each pixel based on the
+spectrum scale parameters; i.e. the median or average is scaled to that of the
+original image before computing the sigma and residuals.
+
+After rejection the number of retained pixels is checked against the
+\fInkeep\fR parameter.  If there are fewer pixels retained than specified
+by this parameter the pixels with the smallest residuals in absolute
+value are added back.  If there is more than one pixel with the same
+absolute residual (for example the two pixels about an average
+or median of two will have the same residuals) they are all added
+back even if this means more than \fInkeep\fR pixels are retained.
+Note that the \fInkeep\fR parameter only applies to the pixels used
+by the clipping rejection algorithm and does not apply to threshold
+or bad pixel mask rejection.
+
+This is the best clipping algorithm to use if the CCD noise parameters are
+adequately known.  The parameters affecting this algorithm are \fIreject\fR
+to select this algorithm, \fImclip\fR to select the median or average for
+the center of the clipping, \fInkeep\fR to limit the number of pixels
+rejected, the CCD noise parameters \fIrdnoise, gain\fR and \fIsnoise\fR,
+\fIlsigma\fR and \fIhsigma\fR to select the clipping thresholds,
+and \fIsigscale\fR to set the threshold for making corrections to the sigma
+calculation for different image scale factors.
+
+.in -4
+CRREJECT
+.in 4
+This algorithm is identical to "ccdclip" except that only pixels above
+the average are rejected based on the \fIhsigma\fR parameter.  This
+is appropriate for rejecting cosmic ray events and works even with
+two spectra.
+
+.in -4
+SIGCLIP
+.in 4
+The sigma clipping algorithm computes at each output pixel the median or
+average excluding the high and low values and the sigma about this
+estimate.  There must be at least three input pixels, though for this method
+to work well there should be at least 10 pixels.  Values deviating by more
+than the specified sigma threshold factors are rejected.  These steps are
+repeated, except that after the first time the average includes all values,
+until no further pixels are rejected or there are fewer than three pixels.
+
+After rejection the number of retained pixels is checked against the
+\fInkeep\fR parameter.  If there are fewer pixels retained than specified
+by this parameter the pixels with the smallest residuals in absolute
+value are added back.  If there is more than one pixel with the same
+absolute residual (for example the two pixels about an average
+or median of two will have the same residuals) they are all added
+back even if this means more than \fInkeep\fR pixels are retained.
+Note that the \fInkeep\fR parameter only applies to the pixels used
+by the clipping rejection algorithm and does not apply to threshold
+rejection.
+
+The  parameters affecting this algorithm are \fIreject\fR to select
+this algorithm, \fImclip\fR to select the median or average for the
+center of the clipping, \fInkeep\fR to limit the number of pixels
+rejected, \fIlsigma\fR and \fIhsigma\fR to select the
+clipping thresholds, and \fIsigscale\fR to set the threshold for
+making corrections to the sigma calculation for different spectrum scale
+factors.
+
+.in -4
+AVSIGCLIP
+.in 4
+The averaged sigma clipping algorithm assumes that the sigma about the
+median or mean (average excluding the low and high values) is proportional
+to the square root of the median or mean at each point.  This is
+described by the equation:
+
+.nf
+	sigma(column,line) = sqrt (gain(line) * signal(column,line))
+.fi
+
+where the \fIestimated\fR signal is the mean or median (hopefully excluding
+any bad pixels) and the gain is the \fIestimated\fR proportionality
+constant having units of photons/data number.
+
+This noise model is valid for spectra whose values are proportional to the
+number of photons recorded.  In effect this algorithm estimates a
+photon per data value gain for each spectrum.
+The gain proportionality factor is computed
+independently for each output spectrum by averaging the square of the residuals
+(at points having three or more input values) scaled by the median or
+mean.
+
+Once the proportionality factor is determined, deviant pixels exceeding the
+specified thresholds are rejected at each point by estimating the sigma
+from the median or mean.  If any values are rejected the median or mean
+(this time not excluding the extreme values) is recomputed and further
+values rejected.  This is repeated until there are no further pixels
+rejected or the number of remaining input values falls below three.  Note
+that the proportionality factor is not recomputed after rejections.
+
+If the spectra are scaled differently and the sigma scaling correction
+threshold is exceedd then a correction is made in the sigma
+calculations for these differences, again under the assumption that
+the noise in an spectra scales as the square root of the mean intensity.
+
+After rejection the number of retained pixels is checked against the
+\fInkeep\fR parameter.  If there are fewer pixels retained than specified
+by this parameter the pixels with the smallest residuals in absolute
+value are added back.  If there is more than one pixel with the same
+absolute residual (for example the two pixels about an average
+or median of two will have the same residuals) they are all added
+back even if this means more than \fInkeep\fR pixels are retained.
+Note that the \fInkeep\fR parameter only applies to the pixels used
+by the clipping rejection algorithm and does not apply to threshold
+rejection.
+
+This algorithm works well for even a few input spectra.  It works better if
+the median is used though this is slower than using the average.  Note that
+if the spectra have a known read out noise and gain (the proportionality
+factor above) then the "ccdclip" algorithm is superior.  However, currently
+the CCD noise characteristics are not well propagated during extraction so
+this empirical algorithm is the one most likely to be useful.  The two
+algorithms are related in that the average sigma proportionality factor is
+an estimate of the gain.
+
+The  parameters affecting this algorithm are \fIreject\fR to select
+this algorithm, \fImclip\fR to select the median or average for the
+center of the clipping, \fInkeep\fR to limit the number of pixels
+rejected, \fIlsigma\fR and \fIhsigma\fR to select the
+clipping thresholds, and \fIsigscale\fR to set the threshold for
+making corrections to the sigma calculation for different image scale
+factors.
+
+.in -4
+PCLIP
+.in 4
+The percentile clipping algorithm is similar to sigma clipping using the
+median as the center of the distribution except that, instead of computing
+the sigma of the pixels from the CCD noise parameters or from the data
+values, the width of the distribution is characterized by the difference
+between the median value and a specified "percentile" pixel value.  This
+width is then multipled by the scale factors \fIlsigma\fR and \fIhsigma\fR
+to define the clipping thresholds above and below the median.  The clipping
+is not iterated.
+
+The pixel values at each output point are ordered in magnitude and the
+median is determined.  In the case of an even number of pixels the average
+of the two middle values is used as the median value and the lower or upper
+of the two is the median pixel when counting from the median pixel to
+selecting the percentile pixel.  The parameter \fIpclip\fR selects the
+percentile pixel as the number (if the absolute value is greater
+than unity) or fraction of the pixels from the median in the ordered set.
+The direction of the percentile pixel from the median is set by the sign of
+the \fIpclip\fR parameter with a negative value signifying pixels with
+values less than the median.  Fractional values are internally converted to
+the appropriate number of pixels for the number of input spectra.  A minimum
+of one pixel and a maximum corresponding to the extreme pixels from the
+median are enforced.  The value used is reported in the log output.  Note
+that the same percentile pixel is used even if pixels have been rejected by
+nonoverlap or thresholding; for example, if the 3nd pixel below
+the median is specified then the 3rd pixel will be used whether there are
+10 pixels or 5 pixels remaining after the preliminary steps.
+
+After rejection the number of retained pixels is checked against the
+\fInkeep\fR parameter.  If there are fewer pixels retained than specified
+by this parameter the pixels with the smallest residuals in absolute
+value are added back.  If there is more than one pixel with the same
+absolute residual (for example the two pixels about an average
+or median of two will have the same residuals) they are all added
+back even if this means more than \fInkeep\fR pixels are retained.
+Note that the \fInkeep\fR parameter only applies to the pixels used
+by the clipping rejection algorithm and does not apply to threshold
+or bad pixel mask rejection.
+
+Some examples help clarify the definition of the percentile pixel.  In the
+examples assume 10 pixels.  The median is then the average of the
+5th and 6th pixels.  A \fIpclip\fR value of 2 selects the 2nd pixel
+above the median (6th) pixel which is the 8th pixel.  A \fIpclip\fR
+value of -0.5 selects the point halfway between the median and the
+lowest pixel.  In this case there are 4 pixels below the median,
+half of that is 2 pixels which makes the percentile pixel the 3rd pixel.
+
+The percentile clipping algorithm is most useful for clipping small
+excursions, such as the wings of bright lines when combining
+disregistered observations, that are missed when using
+the pixel values to compute a sigma.  It is not as powerful, however, as
+using the CCD noise parameters (provided they are accurately known) to clip
+about the median.  This algorithm is primarily used with direct images
+but remains available for spectra.
+
+The  parameters affecting this algorithm are \fIreject\fR to select this
+algorithm, \fIpclip\fR to select the percentile pixel, \fInkeep\fR to limit
+the number of pixels rejected, and \fIlsigma\fR and \fIhsigma\fR to select
+the clipping thresholds.
+
+
+.in -4
+GROW REJECTION
+
+Neighbors of pixels rejected by the rejection algorithms
+may also be rejected.  The number of neighbors to be rejected on either
+side is specified by the \fIgrow\fR parameter.
+
+This rejection step is also checked against the \fInkeep\fR parameter
+and only as many pixels as would not violate this parameter are
+rejected.  Unlike it's application in the rejection algorithms at
+this stage there is no checking on the magnitude of the residuals
+and the pixels retained which would otherwise be rejected are randomly
+selected.
+
+
+COMBINING
+
+After all the steps of offsetting the input images, masking pixels,
+threshold rejection, scaling, and applying a rejection algorithms the
+remaining pixels are combined and output.  The pixels may be combined
+by computing the median or by computing a weighted average.
+.ih
+EXAMPLES
+1.  Combine orders of echelle images.
+
+.nf
+	cl> scombine *.ec *%.ec%% group=images combine=sum
+.fi
+
+2.  Combine all spectra using range syntax and scale by the exposure times.
+
+.nf
+	cl> names irs 10-42 > irs.dat
+	cl> scombine @irs.dat irscombine group=all scale=exptime
+.fi
+
+3.  Combine spectra by apertures using exposure time scaling and weighting.
+
+.nf
+	cl> scombine *.ms combine.ms nout=ncombine.ms \\
+	>>> group=apertures scale=exptime weights=exptime
+.fi
+.ih
+REVISIONS
+.ls SCOMBINE V2.10.3
+The weighting was changed from using the square root of the exposure time
+or spectrum statistics to using the values directly.  This corresponds
+to variance weighting.  Other options for specifying the scaling and
+weighting factors were added; namely from a file or from a different
+image header keyword.  The \fInkeep\fR parameter was added to allow
+controlling the maximum number of pixels to be rejected by the clipping
+algorithms.  The \fIsnoise\fR parameter was added to include a sensitivity
+or scale noise component to the noise model.
+.le
+.ls SCOMBINE V2.10
+This task is new.
+.le
+.ih
+NOTES
+The pixel uncertainties and CCD noise model are not well propagated.  In
+particular it would be desirable to propagate the pixel uncertainties
+and CCD noise parameters from the initial CCD images.
+.ih
+SEE ALSO
+imcombine, odcombine, lscombine
+.endhelp
diff --git a/noao/onedspec/doc/scoords.hlp b/noao/onedspec/doc/scoords.hlp
new file mode 100644
index 00000000..9a529ffa
--- /dev/null
+++ b/noao/onedspec/doc/scoords.hlp
@@ -0,0 +1,83 @@
+.help scoords May97 onedspec
+.ih
+NAME
+scoords -- set spectrum coordinates from a pixel array (1D only)
+.ih
+USAGE
+scoords images coords
+.ih
+PARAMETERS
+.ls images
+List of one dimensional spectrum image names.
+.le
+.ls coords
+List of file names containing the coordinate values.  There may be
+one file which applies to all input images or a matching list
+of one coordinate file for each input image.  The coordinate files
+are a list of coordinate values with one coordinate per line.
+The coordinates must be ordered in increasing or decreasing value.
+The number of coordinates must match the number of pixels in the image.
+.le
+.ls label = ""
+Optional coordinate axis label.  A typical value is "Wavelength"
+for wavelength coordinates.
+.le
+.ls units = ""
+Optional coordinate axis units.  A typical value is "Angstroms".  In
+order to allow coordinate conversions by other IRAF spectra tasks
+the value should be specified as one of the known units
+(see units description in \fBonedspec.package\fR).
+.le
+.ls verbose = yes
+Print a line as each spectrum is processed?
+.le
+.ih
+DESCRIPTION
+\fBScoords\fR sets spectral coordinates in one dimensional spectral
+images as a list of coordinates in the image header.  The
+coordinate file(s) consists of coordinate values given one per line.
+Each coordinate value is assigned to an image pixel in the order given
+and so the number of coordinate values must match the number of pixels
+in the spectrum.  Also the coordinates must be monotonically increasing
+or decreasing.
+
+When multiple spectra are to be set a matching list of coordinates can
+be specified or a single coordinate file for all images may be used.
+
+The coordinate system set in the header is an example of the "multispec"
+world coordinate system.  This is understood by all the standard
+IRAF tasks.  It is described under the help topic "onedspec.specwcs".
+Once the coordinates are set one may resample the spectrum to a
+more compact linear description using the task \fBdispcor\fR.
+
+Since the coordinate values are stored in the header (double
+precision numbers) the header can become quite large if the spectrum
+is long.  Be sure the environment variable "min_lenuserarea" which
+defines the maximum size of the image header in number of characters
+is large enough to hold all the coordinates.
+.ih
+EXAMPLES
+1.  Set the coordinates for a spectrum.
+
+.nf
+    cl> type coords.dat
+    4000.
+    4010.123
+    4020.246
+    4031.7
+    <etc>
+    cl> scoords spec coords.dat label=Wavelength units=Angstroms
+    cl> listpix spec wcs=world
+    4000.  	124.
+    4010.123	543
+    <etc>
+.fi
+.ih
+REVISIONS
+.ls SCOORDS V2.11
+This is a new task with this version.
+.le
+.ih
+SEE ALSO
+rtextimage, dispcor, specwcs, onedspec.package
+.endhelp
diff --git a/noao/onedspec/doc/scopy.hlp b/noao/onedspec/doc/scopy.hlp
new file mode 100644
index 00000000..d0863687
--- /dev/null
+++ b/noao/onedspec/doc/scopy.hlp
@@ -0,0 +1,541 @@
+.help scopy Mar93 noao.onedspec
+.ih
+NAME
+scopy -- Select and copy spectra
+.ih
+USAGE
+scopy input output
+.ih
+PARAMETERS
+.ls input
+List of input images containing spectra to be copied.
+.le
+.ls output
+List of output image names or root names.  Image
+sections are ignored and if the output format is "onedspec" then any record
+extensions are stripped to form the root name.  If no output list is
+specified then the input list is used and the input images are replaced by
+the copied output spectra.  If a single output name is specified then all
+copied spectra are written to the same output image or image root
+name.  This allows packing or merging multiple spectra and requires
+properly setting the \fIclobber\fR, \fImerge\fR, \fIrenumber\fR and
+\fIoffset\fR parameters to achieve the desired output.  If more than one
+output image is specified then it must match the input image list in
+number.
+.le
+.ls w1 = INDEF, w2 = INDEF
+Starting and ending wavelengths to be copied.  If \fIw1\fR is not specified
+then the wavelength of the starting edge of the first pixel is used
+(wavelength at pixel coordinate 0.5) and if \fIw2\fR is not specified then
+the wavelength of the ending edge of the last pixel is used (wavelength of
+the last pixel plus 0.5).  If both are not specified, that is set to INDEF,
+then the whole spectrum is copied and the \fIrebin\fR parameter is
+ignored.  Note that by specifying both endpoints the copied region can be
+set to have increasing or decreasing wavelength per pixel.  If the spectrum
+only partially covers the specified range only that portion of the spectrum
+within the range is copied.  It is an error if the range is entirely
+outside that of a spectrum.
+.le
+.ls apertures = "", beams = ""
+List of apertures and beams to be selected from the input spectra.  The
+logical intersection of the two lists is selected.  The null list
+selects all apertures or beams.  A list consists of comma separated
+numbers and ranges of numbers.  A range is specified by a hyphen.  An
+optional step size may be given by 'x' followed by a number.
+See \fBxtools.ranges\fR for more information.  If the first character
+is "!" then the apertures/beams not in the list are selected.  Note
+that a "!" in either of the lists complements the intersection of the
+two lists.  For longslit input spectra the aperture numbers
+selects the lines or columns to be extracted.  For 3D Fabry-Perot
+spectra the aperture numbers select the first spatial axis.
+.le
+.ls bands = ""
+List of bands in 3D multispec.
+For 3D spatial spectra the band parameter applies to the second
+spatial axis.
+The null list selects all bands.  The syntax is as described above.
+.le
+.ls apmodulus = 0
+Modulus to be applied to the input aperture numbers before matching against
+the aperture list.  If zero then no modulus is used.  This is allows
+selecting apertures which are related by the same modulus, typically a
+factor of 10; for example, 10, 1010 and 2010 with a modulus of 1000 are
+related.
+.le
+.ls format = "multispec" (multispec|onedspec)
+Output image format and name syntax.  The "multispec" format consists of
+one or more spectra in the same image file.  The "onedspec" format consists
+of a single spectrum per image with names having a root name and a four
+digit aperture number extension.  Note that converting to "onedspec" format
+from three dimensional images where the third dimension contains associated
+spectra will not include data from the extra dimension.  Image sections may
+be used in that case.
+.le
+.ls renumber = no
+Renumber the output aperture numbers?  If set the output aperture
+numbers, including any preexisting spectra when merging, are renumbered
+beginning with 1.  The \fIoffset\fR parameter may be used to
+change the starting number.
+.le
+.ls offset = 0
+Offset to be added to the input or renumbered aperture number to form
+the final output aperture number.
+.le
+.ls clobber = no
+Modify an existing output image either by overwriting or merging?
+.le
+.ls merge = no
+Merge apertures into existing spectra?  This
+requires that the \fIclobber\fR parameter be set.  If not merging
+then the selected spectra entirely replace those in existing output images.
+If merging then the input spectra replace those in the output image
+with the same aperture number and new apertures are added if not present.
+.le
+.ls rebin = yes
+Rebin the spectrum to the exact wavelength range specified by the \fIw1\fR
+and \fIw2\fR parameters?  If the range is given as INDEF for both endpoints
+this parameter does not apply.  If a range is given and this parameter is
+not set then the pixels in the specified range (using the nearest pixels to
+the endpoint wavelengths) are copied without rebinning.  In this case the
+wavelength of the first pixel may not be exactly that specified by \fIw1\fR
+and the dispersion, including non-linear dispersions, is unchanged.  If
+this parameter is set the spectra are interpolated to have the first and
+last pixels at exactly the specified endpoint wavelengths while preserving
+the same number of pixels in the interval.  Linear and log-linear
+dispersion types are maintained while non-linear dispersions are
+linearized.
+.le
+.ls verbose = no
+Print a record of each aperture copied?
+.le
+.ih
+DESCRIPTION
+\fBScopy\fR selects regions of spectra from an input list of spectral
+images and copies them to output images.  This task can be used to extract
+aperture spectra from long slit and Fabry-Perot images and to select,
+reorganize, merge, renumber, pack, and unpack spectra in many ways.  Below
+is a list of some of the uses and many examples are given in the EXAMPLES
+section.
+
+.nf
+   o Pack many spectra into individual images into a single image
+   o Unpack images with multiple spectra into separate images
+   o Extract a set of lines or columns from long slit spectra
+   o Extract a set of spatial positions from Fabry-Perot spectra
+   o Extract specific wavelength regions
+   o Select a subset of spectra to create a new image
+   o Merge a subset of spectra into an existing image
+   o Combine spectra from different images into one image
+   o Renumber apertures
+.fi
+
+Input spectra are specified by an image list which may include explicit
+image names, wildcard templates and @files containing image names.
+The image names may also include image sections such as to select portions of
+the wavelength coverage.  The input images may be either one or two
+dimensional spectra.  One dimensional spectra may be stored in
+individual one dimensional images or as lines in two (or three)
+dimensional images.  The one dimensional spectra are identified by
+an aperture number, which must be unique within an image, and a beam number.
+Two dimensional long slit and three dimensional Fabry-Perot spectra are
+treated, for the purpose of this
+task, as a collection of spectra with dispersion either along any axis
+specified by the DISPAXIS image header parameter
+or the \fIdispaxis\fR package parameter.  The aperture and band
+parameters specify a spatial position.  A number of adjacent
+lines, columns, and bands, specified by the \fInsum\fR package parameter,
+will be summed to form an aperture spectrum.  If number is odd then the
+aperture/band number refers to the middle and if it is even it refers to the
+lower of the two middle lines or columns.
+
+In the case of many spectra each stored in separate one dimensional
+images, the image names may be such that they have a common root name
+and a four digit aperture number extension.  This name syntax is
+called "onedspec" format.  Including such spectra in an
+input list may be accomplished either with wildcard templates such as
+
+.nf
+	name*
+	name.????.imh
+.fi
+
+where the image type extension ".imh" must be given to complete the
+template but the actual extension could also be that for an STF type
+image, or using an @file prepared with the task \fBnames\fR.
+To generate this syntax for output images the \fIformat\fR parameter
+is set to "onedspec" (this will be discussed further later).
+
+From the input images one may select a range of wavelengths with the
+\fIw1\fR and \fIw2\fR parameters and a subset of spectra based on aperture and
+beam numbers using the \fIaperture\fR and \fIbeam\fR parameters.
+If the wavelength range is specified as INDEF the full spectra are
+copied without any resampling.  If the aperture and beam lists are not
+specified, an empty list, then all apertures and beams are selected.  The
+lists may be those spectra desired or the complement obtained by prefixing
+the list with '!'.  Only the selected wavelength range and spectra will
+be operated upon and passed on to the output images.
+
+Specifying a wavelength range is fairly obvious except for the question
+of pixel sampling.  Either the pixels in the specified range are copied
+without resampling or the pixels are resampled to correspond eactly
+to the requested range.  The choice is made with the \fIrebin\fR parameter.
+In the first case the nearest pixels to the specified wavelength
+endpoints are determined and those pixels and all those in between
+are copied.  The dispersion relation is unchanged.  In the second case
+the spectra are reinterpolated to have the specified starting and
+ending wavelengths with the same number of pixels between those points
+as in the original spectrum.  The reinterpolation is done in either
+linear or log-linear dispersion.  The non-linear dispersion functions
+are interpolated to a linear dispersion.
+
+Using \fBscopy\fR with long slit or Fabry-Perot images provides a quick and
+simple type of extraction as opposed to using the \fBapextract\fR package.
+When summing it is often desired to start each aperture after the number of
+lines summed.  To do this specify a step size in the aperture/band list.  For
+example to extract columns 3 to 23 summing every 5 columns you would use an
+aperture list of "3-23x5" and an \fInsum\fR of 5.  If you do not use the
+step in the aperture list you would extract the sum of columns 1 to 5, then
+columns 2 to 6, and so on.
+
+In the special case of subapertures extracted by \fBapextract\fR, related
+apertures are numbered using a modulus; for example apertures
+5, 1005, 2005.  To allow selecting all related apertures using a single
+aperture number the \fIapmodulus\fR parameter is used to specify the
+modulus factor; 1000 in the above example.  This is a very specialized
+feature which should be ignored by most users.
+
+The output list of images may consist of an empty list, a single image,
+or a list of images matching the input list in number.  Note that it
+is the number of image names that matters and not the number of spectra
+since there may be any number of spectra in an image.  The empty list
+converts to the same list as the input and is shorthand for replacing
+the input image with the output image upon completion; therefore it
+is equivalent to the case of a matching list.  If the input
+consists of just one image then the distinction between a single
+output and a matching list is moot.  The interesting distinction is
+when there is an input list of two or more images.  The two cases
+are then a mapping of many-to-many or many-to-one.  Note that it is
+possible to have more complex mappings by repeating the same output
+name in a matching list provided clobbering, merging, and possibly
+renumbering is enabled.
+
+In the case of a matching list, spectra from different input images
+will go to different output images.  In the case of a single output
+image all spectra will go to the same output image.  Note that in
+this discussion an output image when "onedspec" format is specified
+is actually a root name for possibly many images.  However,
+it should be thought of as a single image from the point of view
+of image lists.
+
+When mapping many spectra to a single output image, which may have existing
+spectra if merging, there may be a conflict with repeated aperture
+numbers.  One option is to consecutively renumber the aperture numbers,
+including any previous spectra in the output image when merging and then
+continuing with the input spectra in the order in which they are selected.
+This is specified with the \fIrenumber\fR parameter which renumbers
+beginning with 1.
+
+Another options which may be used independently of renumbering or in
+conjunction with it is to add an offset as specified by the \fIoffset\fR
+parameter.  This is last step in determining the output aperture
+numbers so that if used with the renumber option the final aperture
+numbers begin with one plus the offset.
+
+It has been mentioned that it is possible to write and add to
+existing images.  If an output image exists an error will be
+printed unless the \fIclobber\fR parameter is set.  If clobbering
+is allowed then the existing output image will be replaced by the
+new output.  Rather than replacing an output image sometimes one
+wants to replace certain spectra or add new spectra.  This is
+done by selecting the \fImerge\fR option.  In this case if the output
+has a spectrum with the same aperture number as the input spectrum
+it is replaced by the input spectrum.  If the input spectrum aperture
+number is not in the output then the spectrum is added to the output
+image.  To add spectra with the same aperture number and not
+replace the one in the output use the \fIrenumber\fR or
+\fIoffset\fR options.
+
+To print a record as each input spectrum is copied the \fIverbose\fR
+parameter may be set.  The syntax is the input image name followed
+by the aperture number in [].  An arrow then points to the output
+image name with the final aperture number also in [], except for
+"onedspec" format where the image name extension gives the aperture
+number.  It is important to remember that it is the aperture numbers
+which are shown and not the image lines; there is not necessarily any
+relation between image lines and aperture numbers though often they
+are the same.
+.ih
+EXAMPLES
+Because there are so many possiblities there are many examples.  To
+help find examples close to those of interest they are divided into
+three sections; examples involving standard multispec images only, examples
+with onedspec format images, and examples with long slit and Fabry-Perot
+images.  In the examples the verbose flag is set to yes and the output is
+shown.
+
+I.   MULTISPEC IMAGES
+
+The examples in this section deal with the default spectral format of
+one or more spectra in an image.  Note that the difference between
+a "onedspec" image and a "multispec" image with one spectrum is purely
+the image naming syntax.
+
+1.  Select a single spectrum (aperture 3):
+
+.nf
+	cl> scopy example1 ap3 aperture=3
+	example1[3]  -->  ap3[3]
+.fi
+
+2.  Select a wavelength region from a single spectrum:
+
+.nf
+	cl> scopy example1 ap3 aperture=3 w1=5500 w2=6500
+	example1[3]  -->  ap3[3]
+.fi
+
+3.  Select a subset of spectra (apertures 1, 2, 4, 6, and 9): 
+
+.nf
+	cl> scopy example1 subset apertures="1-2,4,6-9x3"
+	example1[1]  -->  subset[1]
+	example1[2]  -->  subset[2]
+	example1[4]  -->  subset[4]
+	example1[6]  -->  subset[6]
+	example1[9]  -->  subset[9]
+.fi
+
+This example shows various features of the aperture list syntax.
+
+4.  Select the same apertures (1 and 3) from multiple spectra and in the
+same wavelength region:
+
+.nf
+	cl> scopy example* %example%subset%* apertures=1,3 w1=5500 w2=6500
+	example1[1]  -->  subset1[1]
+	example1[3]  -->  subset1[3]
+	example2[1]  -->  subset2[1]
+	example2[3]  -->  subset2[3]
+	...
+.fi
+
+The output list uses the pattern substitution feature of image templates.
+
+5.  Select the same aperture from multiple spectra and pack them in a
+a single image:
+
+.nf
+	cl> scopy example* ap2 aperture=2 renumber+
+	example1[2]  -->  ap2[1]
+	example2[2]  -->  ap2[2]
+	example3[2]  -->  ap2[3]
+	...
+.fi
+
+6.  To renumber the apertures sequentially starting with 11:
+
+.nf
+	cl> scopy example1 renum renumber+
+	example1[1]  -->  renum[11]
+	example1[5]  -->  renum[12]
+	example1[9]  -->  renum[13]
+	...
+.fi
+
+7.  To replace apertures (2) in one image with that from another:
+
+.nf
+	cl> scopy example1 example2 aperture=2 clobber+ merge+
+	example1[2]  --> example2[2]
+.fi
+
+8.  To merge two sets of spectra with different aperture numbers into
+    one image:
+
+.nf
+	cl> scopy example![12]* merge
+	example1[1]  ->  merge[1]
+	example1[3]  ->  merge[3]
+	...
+	example2[2]  ->  merge[2]
+	example2[4]  ->  merge[4]
+	...
+.fi
+
+The input list uses the ![] character substitution syntax of image templates.
+
+9.  To merge a set of spectra with the same aperture numbers into another
+existing image:
+
+.nf
+	cl> scopy example2 example1 clobber+ merge+ renumber+
+	example1[5]  -->  example1[2]
+	example1[9]  -->  example1[3]
+	example2[1]  -->  example1[4]
+	example2[5]  -->  example1[5]
+	example2[9]  -->  example1[6]
+.fi
+
+Both images contained apertures 1, 5, and 9.  The listing does not show
+the renumbering of the aperture 1 from example1 since the aperture number
+was not changed.
+
+10.  Select parts of a 3D image where the first band is the
+variance weighted extraction, band 2 is nonweighted extraction,
+band 3 is the sky, and band 4 is the sigma:
+
+.nf
+	cl> scopy example3d.ms[*,*,1] var1.ms
+	example3d.ms[*,*,1][1]  -->  var1.ms[1]
+	example3d.ms[*,*,1][2]  -->  var1.ms[2]
+	...
+	cl> scopy example3d.ms[10:400,3,3] skyap3
+	example3d.ms[10:400,3,3][3]  -->  skyap3[3]
+	cl> scopy example3d.ms[*,*,1] "" clobber+
+	example3d.ms[*,*,1][1]  -->  example3d.ms[1]
+	example3d.ms[*,*,1][2]  -->  example3d.ms[2]
+	...
+.fi
+
+Note that this could also be done with \fBimcopy\fR.  The last example
+is done in place; i.e. replacing the input image by the output image
+with the other bands eliminatated; i.e. the output image is two dimensional.
+
+II.  ONEDSPEC IMAGES
+
+1.  Expand a multi-spectrum image to individual single spectrum images:
+
+.nf
+	cl> scopy example1 record format=onedspec
+	example1[1]  -->  record.0001
+	example1[5]  -->  record.0005
+	example1[9]  -->  record.0009
+	...
+.fi
+
+2.  Pack a set of individual 1D spectra into a single image:
+
+.nf
+	cl> scopy record.????.imh record.ms
+	record.0001[1]  -->  record.ms[1]
+	record.0005[5]  -->  record.ms[5]
+	record.0009[9]  -->  record.ms[9]
+	...
+.fi
+
+3.  Copy a set of record syntax spectra to a different rootname and renumber:
+
+.nf
+	cl> scopy record.????.imh newroot format=onedspec
+	record.0001[1]  -->  newroot.0001
+	record.0005[5]  -->  newroot.0002
+	record.0009[9]  -->  newroot.0003
+	...
+.fi
+
+III. LONG SLIT IMAGES
+
+To define the dispersion axis either the image header parameter DISPAXIS
+must be set (using HEDIT for example) or a the package \fIdispaxis\fR
+parameter must be set.  In these examples the output is the default
+multispec format.
+
+1.  To extract column 250 into a spectrum:
+
+.nf
+	cl> scopy longslit1 c250 aperture=250
+	longslit1[250]  -->  c250[250]
+.fi
+
+2.  To sum and extract every set of 10 columns:
+
+.nf
+	cl> nsum = 10  (or epar the package parameters)
+	cl> scopy longslit1 sum10 apertures=5-500x10
+	longslit1[5]  -->  sum10[5]
+	longslit1[15]  -->  sum10[15]
+	longslit1[25]  -->  sum10[25]
+	...
+.fi
+
+3.  To extract the sum of 10 columns centered on column 250 from a set
+of 2D images:
+
+.nf
+	cl> nsum = 10  (or epar the package parameters)
+	cl> scopy longslit* %longslit%c250.%* aperture=250
+	longslit1[250]  -->  c250.1[250]
+	longslit2[250]  -->  c250.2[250]
+	longslit3[250]  -->  c250.3[250]
+	...
+.fi
+
+4.  To extract the sum of 10 columns centered on column 250 from a set of
+2D images and merge them into a single, renumbered output image:
+
+.nf
+	cl> nsum = 10  (or epar the package parameters)
+	cl> scopy longslit* c250 aperture=250 renum+
+	longslit1[250]  -->  c250[1]
+	longslit2[250]  -->  c250[2]
+	longslit3[250]  -->  c250[3]
+	...
+.fi
+
+IV. FABRY-PEROT IMAGES
+
+To define the dispersion axis either the image header parameter DISPAXIS
+must be set (using HEDIT for example) or a the package \fIdispaxis\fR
+parameter must be set.  In these examples the output is the default
+multispec format.
+
+1.  To extract a spectrum from the spatial position (250,250) where
+dispaxis=3:
+
+.nf
+	cl> scopy fp1 a250 aperture=250 band=250
+	longslit1[250]  -->  a250[250]
+.fi
+
+2.  To sum and extract every set of 10 lines and bands (dispaxis=1):
+
+.nf
+	cl> nsum = "10"
+	cl> scopy fp1 sum10 apertures=5-500x10 bands=5-500x10
+	longslit1[5]  -->  sum10[5]
+	longslit1[15]  -->  sum10[15]
+	longslit1[25]  -->  sum10[25]
+	...
+.fi
+
+3.  To extract the sum of 10 columns and 20 lines centered on column 250 and
+line 100 from a set of 3D images with dispaxis=3:
+
+.nf
+	cl> nsum = "10 20"
+	cl> scopy longslit* %longslit%c250.%* aperture=250 band=100
+	longslit1[250]  -->  c250.1[250]
+	longslit2[250]  -->  c250.2[250]
+	longslit3[250]  -->  c250.3[250]
+	...
+.fi
+.ih
+REVISIONS
+.ls SCOPY V2.11
+Previously both w1 and w2 had to be specified to select a range to
+copy.  Now if only one is specified the second endpoint defaults
+to the first or last pixel.
+.le
+.ls SCOPY V2.10.3
+Additional support for 3D multispec/equispec or spatial spectra has been
+added.  The "bands" parameter allows selecting specific bands and
+the onedspec output format creates separate images for each selected
+aperture and band.
+.le
+.ls SCOPY V2.10
+This task is new.
+.le
+.ih
+SEE ALSO
+ranges, sarith, imcopy, dispcor, specshift
+.endhelp
diff --git a/noao/onedspec/doc/sensfunc.hlp b/noao/onedspec/doc/sensfunc.hlp
new file mode 100644
index 00000000..1ebd7e24
--- /dev/null
+++ b/noao/onedspec/doc/sensfunc.hlp
@@ -0,0 +1,447 @@
+.help sensfunc Mar93 noao.onedspec
+.ih
+NAME
+sensfunc -- Determine sensitivity and extinction functions
+.ih
+USAGE
+sensfunc standards sensitivity
+.ih
+PARAMETERS
+.ls standards = "std"
+Input standard star data file created by the task \fBstandard\fR.
+.le
+.ls sensitivity = "sens"
+Output sensitivity function image name or rootname.  Generally each
+aperture results in an independent sensitivity function with the
+aperture number appended to the rootname.  If the parameter \fIignoreaps\fR
+is set, however, the aperture numbers are ignored and a single sensitivity
+function is determined with the output image having the specified name
+with no extension.
+.le
+.ls apertures = ""
+List of apertures to be selected from the input file.  All other apertures
+are ignored.  If no list is specified then all apertures are selected.
+See \fBranges\fR for the syntax.
+.le
+.ls ignoreaps = no
+Ignore aperture numbers and create a single sensitivity function?  Normally
+each aperture produces an independent sensitivity function.  If the
+apertures are ignored then all the observations are combined into
+a single sensitivity function.
+.le
+.ls logfile = "logfile"
+Output log filename for statistical information about the stars used
+and the sensitivity function and extinction function.
+If no filename is given then no file is written.
+.le
+.ls extinction = <no default>
+Input extinction file.  Any extinction determination made will be
+relative to this extinction.  If no file is given then no extinction
+correction is applied and any extinction determination from the
+standard star data will be an absolute determination of the
+extinction.  The default value is redirected to the package parameter
+of the same name.  The extinction file is generally one of the standard
+extinctions in the calibration directory "onedstds$".
+
+If extinction corrected spectra were used as input to \fBstandard\fR
+then it is important that the same extinction file be used here.
+This includes using no extinction file in both tasks.
+.le
+.ls newextinction = "extinct.dat"
+Output revised extinction file.  If the extinction is revised and an
+output filename is given then a revised extinction file is written.  It
+has the same format as the standard extinction files.
+.le
+.ls observatory = ")_.observatory"
+Observatory at which the spectra were obtained if not specified in the
+image header by the keyword OBSERVAT.  The default is a redirection to look
+in the parameters for the parent package for a value.  This is only used
+when graphing flux calibrated data of spectra which do not include the
+airmass in the image header.  The observatory may be one of the
+observatories in the observatory database, "observatory" to select the
+observatory defined by the environment variable "observatory" or the
+parameter \fBobservatory.observatory\fR, or "obspars" to select the current
+parameters set in the \fBobservatory\fR task.  See help for
+\fBobservatory\fR for additional information.
+.le
+.ls function = "spline3"
+Function used to fit the sensitivity data.  The function types are
+"chebyshev" polynomial, "legendre" polynomial, "spline3" cubic spline,
+and "spline1" linear spline.  The default value may be changed interactively.
+.le
+.ls order = 6
+Order of the sensitivity fitting function.  The value corresponds to the
+number of polynomial terms or the number of spline pieces.  The default
+value may be changed interactively.
+.le
+.ls interactive = yes
+Determine the sensitivity function interactively?  If yes the user
+graphically interacts with the data, modifies data and parameters
+affecting the sensitivity function, and determines a residual extinction.
+.le
+.ls graphs = "sr"
+Graphs to be displayed per frame.  From one to four graphs may be displayed
+per frame.  The graph types are selected by single characters and are:
+
+.nf
+a - residual sensitivity vs airmass
+c - composite residual sensitivity and error bars vs wavelength
+e - input extinction and revised extinction vs wavelength
+i - Flux calibrated spectrum vs wavelength
+r - residual sensitivity vs wavelength
+s - sensitivity vs wavelength
+.fi
+
+All other characters including whitespace and commas are ignored.  The order
+and number of graphs determines the positions of the graphs.
+.le
+.ls marks = "plus cross box"
+Symbols used to mark included, deleted, and added data respectively.
+The available mark types are point, box, plus, cross, diamond, hline
+(horizontal line), vline (vertical line), hebar (horizontal error bar),
+vebar (vertical error bar), and circle.
+.le
+.ls colors = "2 1 3 4"
+Colors to use for "lines", "marks", "deleted" data, and "added" data.
+The colors associated with the numbers is graphics device dependent.
+For example in XGTERM they are defined by resources while on other
+devices that don't support colors only one color will appear.
+.le
+.ls cursor = ""
+Graphics cursor input list.  If not specified as a file then standard
+graphics cursor is read.
+.le
+.ls device = "stdgraph"
+Graphics output device.
+.le
+.ls answer
+Query parameter for selecting whether to fit apertures interactively.
+.le
+.ih
+CURSOR COMMANDS
+
+.nf
+?	Print help
+a	Add a point at the cursor position
+c	Toggle use of composite points
+d	Delete point, star, or wavelength nearest the cursor
+e	Toggle residual extinction correction
+f	Fit data with a sensitivity function and overplot
+g	Fit data with a sensitivity function and redraw the graph(s)
+i	Print information about point nearest the cursor
+m	Move point, star, wavelength nearest the cursor to new sensitivity
+o	Reset to original data
+q	Quit and write sensitivity function for current aperture
+r	Redraw graph(s)
+s	Toggle shift of standard stars to eliminate mean deviations
+u	Undelete point, star, or wavelength nearest the cursor
+w	Change weights of point, star, or wavelength nearest the cursor
+
+:flux [min] [max]  Limits for flux calibrated graphs (INDEF for autoscale)
+:function [type]   Function to be fit to sensitivity data:
+			chebyshev - Chebyshev polynomial
+			legendre  - Legendre polynomial
+			spline1   - Linear spline
+			spline3   - Cubic spline
+:graphs [types]    Graphs to be displayed (up to four):
+		a - Residual sensitivity vs airmass
+		c - Composite residuals and error bars vs wavelength
+		e - Extinction (and revised extinction) vs wavelength
+		i - Flux calibrated image vs wavelength
+		l - Log of flux calibrated image vs wavelength
+		r - Residual sensitivity vs wavelength
+		s - Sensitivity vs wavelength
+:images [images]   Images to flux calibrate and plot (up to four)
+:marks marks       Mark types to use for included, delete, and added points:
+			point, box, plus, cross, diamond, hline,
+			vline, hebar, vebar, circle
+:order [order]     Order of function
+:skys [images]     Sky images for flux calibration (up to four)
+:stats [file]      Statistics about stars and sensitivity fit
+:vstats [file]     Verbose statistics about sensitivity fit
+.fi
+.ih
+DESCRIPTION
+Standard star calibration measurements are used to determine the system
+sensitivity as a function of wavelength for each independent aperture.
+If the parameter \fIignoreaps\fR is set then the aperture numbers are
+ignored and a single sensitivity function is determined from all the
+observations.  Using measurements spanning a range of airmass it is
+also possible to derive an adjustment to the standard extinction curve
+or even an absolute determination.  Extinction determination requires
+that the observations span a good range of airmass during photometric
+conditions.  When conditions are poor and standard star observations
+are obtained during periods of variable transparency, the entire
+sensitivity curve may vary by a constant factor, assuming that the
+cause of the variations has no color effect.  This is often the case
+during periods of thin clouds.  In this case the mean sensitivity of
+each observation may be shifted to match the observation of greatest
+sensitivity.  This allows for the possibility of deriving correct
+absolute fluxes if one observation of a standard was obtained during a
+clear period.
+
+The input data is a file of calibration information produced by the
+task \fBstandard\fR.  The data consists of a spectrum identification
+line containing the spectrum image name, the sky image name if beam
+switching, the aperture number, the length of the spectrum, the
+exposure time, airmass, wavelength range, and title.  Following the
+identification line are calibration lines consisting of the central
+bandpass wavelengths, the tabulated fluxes in the bandpasses, the
+bandpass widths, and the observed counts in the bandpasses.  The
+spectrum identification and calibration lines repeat for each standard
+star observation.  The parameter \fIapertures\fR may be used to select
+only specific apertures from the input data.  This parameter is in the
+form of a range list (see help for \fBranges\fR) and if no list is
+given (specified by the null string "") then all apertures are selected.
+
+An input extinction file may also be specified.  Any extinction
+determinations are then residuals to this input extinction table.
+The format of this table is described in \fBlcalib\fR.
+
+The calibration factor at each point is computed as
+
+	(1) C = 2.5 log (O / (T B F)) + A E
+
+where O is the observed counts in a bandpass of an observation,
+T is the exposure time of the observation, B is the bandpass width,
+F is the flux per Angstrom at the bandpass for the standard star,
+A is the airmass of the observation, and E is the extinction
+at the bandpass.  Thus, C is the ratio of the observed count rate per
+Angstrom corrected to some extinction curve to the expected flux
+expressed in magnitudes.  The goal of the task is to fit the observations
+to the relation
+
+	(2) C = S(W) + AE(W)
+
+where W is wavelength, S(W) is the sensitivity function, and E(W) is
+a residual extinction function relative to the extinction used in (1).
+In later discussion we will also refer to the residual sensitivity which
+is defined by
+
+	(3) R = C - S(W) - AE(W)
+
+The sensitivity function S(W) is output as an one dimensional image
+much like the spectra.  The sensitivities are in magnitude units to
+better judge the variations and because the interpolation is smoother
+in the logarithmic space (mags = 2.5 log10[sensitivity]).  There is one
+sensitivity function for each aperture unless the parameter
+\fIignoreaps\fR is set.  In the first case the image names are formed
+from the specified rootname with the aperture number as a four digit
+numerical extension.  In the latter case a single sensitivity function
+is determined from all data, ignoring the aperture numbers, and the
+specified output image is created without an extension.  These images
+are used by \fBcalibrate\fR to correct observations to a relative of
+absolute flux scale.  If no sensitivity function image rootname is
+specified then the sensitivity curves are not output.
+
+If a revised extinction function E(W) has been determined for one or
+more of the apertures then the functions are averaged over all
+apertures, added to the original extinction, and written to the
+specified extinction table.  The format of this table is the same as
+the standard extinction tables and are, thus, interchangeable.  If no
+new extinction filename is specified then no extinction table is
+recorded.
+
+If a log filename is given then statistical information about the
+sensitivity function determinations are recorded.  This includes the
+names of the input standard star observations and the tabulated
+sensitivity, extinction, and error information.
+
+Some points to note are that if no input extinction is given then the
+E in (1) are zero and the E determined in (2) is the absolute extinction.
+If the data are not good enough to determine extinction then using one
+of the standard extinction curves the problem reduces to fitting
+
+	(4) C = S(W)
+
+The sensitivity and extinction functions are determined as fitted
+curves.  The curves are defined by a function type and order.  There
+are four function types and the order specifies either the number of
+terms in the polynomial or the number of pieces in the spline.  The
+order is automatically reduced to the largest
+value which produces a nonsingular result.  In this case the function
+will attempt to pass through every calibration point.  Lower orders
+provide for a smoother representation of the function.  The latter
+is generally more appropriate for a detector.  The initial function
+type and order for the sensitivity function is specified by the
+parameters \fIfunction\fR and \fIorder\fR.
+
+If the \fIinteractive\fR flag is no then the default function and order
+is fit to equation (4) (i.e. there is no residual extinction determination
+or manipulation of the data).  The sensitivity functions are output
+if an image rootname is given and the log information is output if a
+log filename is given.
+
+When the sensitivity is determined interactively a query is given for
+each aperture.  The responses "no" and "yes" select fitting the sensitivity
+interactively or not for the specified aperture.  The responses "NO" and
+"YES" apply to all apertures and no further queries will be given.
+When interactive fitting is selected the data are graphed
+on the specified graphics device and input is through the specified
+cursor list.  The graphics output consists of from one to four graphs.
+The user selects how many and which types of graphs to display.  The
+graph types and their single character code used to select them are:
+
+.nf
+   a - residual sensitivity vs airmass
+   c - composite residual sensitivity and error bars vs wavelength
+   e - input extinction and revised extinction vs wavelength
+   i - Flux calibrated spectrum vs wavelength
+   r - residual sensitivity vs wavelength
+   s - sensitivity vs wavelength
+.fi
+
+The initial graphs are selected with the parameter \fBgraphs\fR and changed
+interactively with the colon command ':graphs \fItypes\fR'.  The ability
+to view a variety of graphs allows evaluating the effects of the
+sensitivity curve and extinction in various ways.  The flux calibrated
+spectrum graph uses the current sensitivity function and checks for
+possible wiggles in the sensitivity curve which affect the shape of the
+continuum.  The choice of graphs also allows the
+user to trade off plotting speed and resolution against the amount of
+information available simultaneously.  Thus, with some graphics devices
+or over a slow line one can reduce the number of graphs for greater speed
+while on very fast devices with large screens one can look at more
+data.  The parameter \fImarks\fR and the associated colon command
+':marks \fItypes\fR' also let the user define the symbols used to mark
+included, deleted, and added data points.
+
+The list of interactive commands in given in the section on CURSOR COMMANDS.
+The commands include deleting, undeleting, adding, moving, and identifying
+individual data points, whole stars, or all points at the same wavelength.
+Some other commands include 'c' to create composite points by averaging
+all points at the same wavelength (this requires exact overlap in the
+bandpasses) which then replace the individual data points in the fit.
+This is different than the composite point graph which displays the
+residual in the mean sensitivity
+and error \fIin the mean\fR but uses the input data in the fitting.
+The 's' command shifts the data so that the mean sensitivity of each
+star is the same as the star with the greatest mean sensitivity.
+This compensates for variable grey extinction due to clouds.  Note
+that delete points are excluded from the shift calculation and a
+deleted star will not be used as the star of greatest sensitivity.
+Another useful command is 'o' to recover the original data.  This cancels
+all changes made due to shifting, extinction corrections, deleting points,
+creating composite points, etc.
+
+The 'e' command attempts to compute a residual extinction by finding
+correlations between the sensitivity points at different airmass.
+Note that this is not iterative so that repeating this after having
+added an extinction correction simply redetermines the correction.
+At each wavelength or wavelength regions having multiple observations at
+different airmass a slope with airmass is determined.  This slope is
+the residual extinction at that wavelength.  A plot of the residual
+extinctions at each wavelength is made using the ICFIT procedure.
+The user may then examine and fit a curve through the residual extinction
+estimates as a function of wavelength (see \fBicfit\fR for a description
+of the commands).  The user must decide how much wavelength dependence
+is derivable from the data.  In many cases only a constant fit
+to a "gray extinction" or possibly a linear fit is realistic.
+The fitting is exited by the key 'q'.
+
+To help evaluate how important the residual extinction determination
+is a t-statistic significance is computed.  This statistic is defined by
+
+	(5) t = sqrt (r**2 * (N - 2) / (1 - r**2))
+
+where the correlation coefficient
+
+	(6) r = RMS with correction / RMS without correction
+
+is the fractional improvement in the RMS due to the added extinction
+correction and N is the number of wavelength points.  For large
+N this approaches a gaussian sigma but a more precise significance
+requires the t-distribution for N-2 degrees of freedom.  Basically this
+asks, was the improvement in the RMS significantly more than would
+occur with random errors?  A value greater than 3 is good while
+a value less than 1 is not significant.  The user may then accept the
+revised extinction and apply it to the data.
+
+Note that when there are multiple apertures used each aperture has an
+independent system sensitivity but the residual extinction is the same.
+Therefore, the residual extinctions from each aperture are averaged at
+the end.  If one determines a new extinction then one may replace the
+original input extinction by the new extinction and rederive the
+sensitivity.
+.ih
+EXAMPLES
+1.  The following command generates sensitivity spectra
+
+	cl> sensfunc std sens
+
+This command uses the data from the \fBstandard\fR output
+file "std" to create sensitivity functions with rootname "sens".
+If not interactive the task will produce the output with some
+progress messages being printed.  If it is interactive the graphics
+device will be used to display the data and the fit and user can
+change the function and order of the fit, delete bad points, shift
+data to correct for clouds or bandpass errors, and possibly determine
+a revised extinction function.  The statistics of the
+sensitivity determination are written to the logfile ("logfile" by
+default).
+
+2. The following examples illustrate the colon command syntax.  Generally
+if no argument is given the current value is displayed.  For the statistics
+commands an optional output file may be given to record the information.
+
+.nf
+:flux 1e-12 INDEF    Set lower limit for flux plots
+:flux INDEF INDEF    Restore autoscaling in flux plots
+:func spline3	     Select cubic spline function
+:g srae		     Graph sensitivity, residuals, airmass,
+		     and extinction
+:g sii		     Graph sensitivity and two images
+:i n1.0004 n1.0008   Set first two images to graph (the defaults
+		     are taken from the standard star list)
+:skys n1.0005	     Subtract this sky image from first image
+		     for flux calibrated spectrum
+:m plus		     Change the mark type for included points and
+		     don't change the deleted or added point mark type
+:stats		     Print statistics to terminal
+:vstats stdstats     Print verbose statistics to file
+.fi
+.ih
+REVISIONS
+.ls SENSFUNC V2.10.3+
+Deleted points and stars are now ignored from the grey shift calculation.
+.le
+.ls SENSFUNC V2.10.3
+A color parameter was added for graphics terminals supporting color.
+.le
+.ls SENSFUNC V2.10
+The latitude parameter has been replaced by the observatory parameter.
+The 'i' flux calibrated graph type now shows flux in linear scaling 
+while the new graph type 'l' shows flux in log scaling.  A new colon
+command allows fixing the flux limits for the flux calibrated graphs.
+.le
+.ls SENSFUNC V2.8
+This task has been completely rewritten from that of versions 2.5 and
+earlier.
+
+.nf
+1. The input standard data format is different.
+2. Extinction corrections beyond a grey term are now supported.
+3. Weighting by the counts is not supported.
+4. Tabular input is not supported.
+5. The data which can be displayed is greatly improved.
+6. The fitting options have been greatly enhanced.
+7. The fitting function types available have been extended.
+8. One or more flux calibrated images may be displayed using the
+   current sensitivity function.
+9. Additional flexibility is provided for treating apertures.
+.fi
+.le
+.ih
+BUGS
+If the flux points do not span the wavelength range, set by the
+standard star observations, then the fitting may fail at some maximum
+order.  When it fails there is no message but the highest order which
+can be successfully fit is used.  To work around this one can either
+add fake points, truncate the wavelength range in the first line of each
+tabulated object in the file produced by \fBstandard\fR, or exclude the
+part of the image data which cannot be uncalibrated (using
+\fBscopy\fR or \fBdispcor\fR).
+.ih
+SEE ALSO
+standard, lcalib, calibrate, observatory, icfit, ranges, scopy, dispcor
+.endhelp
diff --git a/noao/onedspec/doc/sfit.hlp b/noao/onedspec/doc/sfit.hlp
new file mode 100644
index 00000000..0416c622
--- /dev/null
+++ b/noao/onedspec/doc/sfit.hlp
@@ -0,0 +1,262 @@
+.help sfit Mar92 noao.onedspec
+.ih
+NAME
+sfit -- Fit spectra
+.ih
+USAGE	
+sfit input output
+.ih
+PARAMETERS
+.ls input
+Input spectra to be fit.  These may be any combination of echelle,
+multispec, onedspec, long slit, and spectral cube format images.
+.le
+.ls output
+Output fitted spectra.  The number of output spectra must
+match the number of input spectra.  \fBOutput\fR may be omitted if
+\fBlistonly\fR is yes.
+.le
+.ls lines = "*", bands = "1"
+A range specifications for the image lines and bands to be fit.  Unspecified
+lines and bands will be copied from the original.  If the value is "*", all of
+the currently unprocessed lines or bands will be fit.  A range consists of
+a first line number and a last line number separated by a hyphen.  A
+single line number may also be a range and multiple ranges may be
+separated by commas.
+.le
+.ls type = "fit"
+Type of output spectra.  The choices are "fit" for the fitted function,
+"ratio" for the ratio of the input spectra to the fit, "difference" for
+the difference between the input spectra and the fit, and "data" for
+the data minus any rejected points replaced by the fit.
+.le
+.ls replace = no
+Replace rejected points by the fit in the difference, ratio, and
+data output types?
+.le
+.ls wavescale = yes
+Wavelength scale the X axis of the plot?  This option requires that the
+spectra be wavelength calibrated.  If \fBwavescale\fR is no, the plots
+will be in "channel" (pixel) space.
+.le
+.ls logscale = no
+Take the log (base 10) of both axes?  This can be used when \fBlistonly\fR
+is yes to measure the exponent of the slope of the continuum.
+.le
+.ls override = no
+Override previously fit spectra?  If \fBoverride\fR is yes and
+\fBinteractive\fR is yes, the user will be prompted before each order is
+refit.  If \fBoverride\fR is no, previously fit spectra are silently
+skipped.
+.le
+.ls listonly = no
+Don't modify any images?  If \fBlistonly\fR is yes, the \fBoutput\fR
+image list may be skipped.
+.le
+.ls logfiles = "logfile"
+List of log files to which to write the power series coefficients.  If
+\fBlogfiles\fR = NULL (""), the coefficients will not be calculated.
+.le
+.ls interactive = yes
+Perform the fit interactively using the icfit commands?  This will allow
+the parameters for each spectrum to be adjusted independently.  A separate
+set of the fit parameters (below) will be used for each spectrum and any
+interactive changes to the parameters for a specific spectrum will be
+remembered when that spectrum is fit in the next image.
+.le
+.ls sample = "*"
+The ranges of X values to be used in the fits.  The units will vary
+depending on the setting of the \fBwavescale\fR and \fBlogscale\fR
+parameters.  The default units are in wavelength if the spectra have
+been dispersion corrected.  The sample range syntax consists of
+pairs of values separated by colons and multiple ranges can be
+given separated by commas.
+.le
+.ls naverage = 1
+Number of sample points to combined to create a fitting point.
+A positive value specifies an average and a negative value specifies
+a median.
+.le
+.ls function = spline3
+Function to be fit to the spectra.  The functions are
+"legendre" (legendre polynomial), "chebyshev" (chebyshev polynomial),
+"spline1" (linear spline), and "spline3" (cubic spline).  The functions
+may be abbreviated.  The power series coefficients can only be
+calculated if \fBfunction\fR is "legendre" or "chebyshev".
+.le
+.ls order = 1
+The order of the polynomials or the number of spline pieces.
+.le
+.ls low_reject = 3., high_reject = 3.
+Rejection limits below and above the fit in units of the residual sigma.
+.le
+.ls niterate = 0
+Number of rejection iterations.
+.le
+.ls grow = 1.
+When a pixel is rejected, pixels within this distance of the rejected pixel
+are also rejected.
+.le
+.ls markrej = yes
+Mark rejected points?  If there are many rejected points it might be
+desired to not mark rejected points.
+.le
+.ls graphics = "stdgraph"
+Graphics output device for interactive graphics.
+.le
+.ls cursor = ""
+Graphics cursor input.
+.le
+.ih
+DESCRIPTION
+A one dimensional function is fit to spectra in a list of echelle,
+multispec, or onedspec format images.  The first two formats will
+fit the spectra or orders (i.e. the lines) in each image.
+In this description the term "spectrum" will refer to a line of
+an image while "image" will refer to all spectra in an image.
+The parameters of the fit may vary from spectrum to spectrum within
+images and between images.  The fitted function may
+be a legendre polynomial, chebyshev polynomial, linear spline, or cubic
+spline of a given order or number of spline pieces.  The output spectra
+are formed from the fit, the ratio between the pixel values and the fit,
+the difference of the spectra to the fit, and the original data with
+rejected points possibly replaced.  The output image is of pixel type real.
+
+The line/band numbers (for two/three dimensional images) are written to a
+list of previously processed lines in the header keywords \fISFIT\fR and
+\fISFITB\fR of the output image.  A subsequent invocation of SFIT will only
+process those requested spectra that are not in this list.  This ensures
+that even if the output image is the same as the input image that no
+spectra will be processed twice and permits an easy exit from the task in
+the midst of processing many spectra without losing any work or requiring
+detailed notes.
+
+The points to be fit in each spectrum are determined by
+selecting a sample of X values specified by the parameter \fIsample\fR
+and taking either the average or median of the number of points
+specified by the parameter \fInaverage\fR.  The type of averaging is
+selected by the sign of the parameter with positive values indicating
+averaging, and the number of points is selected by the absolute value
+of the parameter.  The sample units will vary depending on the settings
+of the \fBwavescale\fR and the \fBlogscale\fR parameters.  Note that a
+sample that is specified in wavelength units may be entirely outside
+the domain of the data (in pixels) if some of the spectra are not
+dispersion corrected.  The syntax of the sample specification is a comma
+separated, colon delimited list similar to the image section notation.
+For example, the \fBsample\fR, "6550:6555,6570:6575" might be used to
+fit the continuum near H-alpha.
+
+If \fIlow_reject\fR and/or \fIhigh_reject\fR are greater than zero the
+sigma of the residuals between the fitted points and the fitted
+function is computed and those points whose residuals are less than
+\fI-low_reject\fR * sigma and greater than \fIhigh_reject\fR * sigma
+are excluded from the fit.  Points within a distance of \fIgrow\fR
+pixels of a rejected pixel are also excluded from the fit.  The
+function is then refit without the rejected points.  This rejection
+procedure may be iterated a number of times given by the parameter
+\fIniterate\fR.
+
+If \fIreplace\fR is set then any rejected points from the fitting
+are  replaced by the fit in the data before outputing the difference,
+ratio, or data.  For example with replacing the difference will
+be zero at the rejected points and the data output will be cleaned
+of deviant points.
+
+A range specification is used to select the \fIlines\fR and \fIbands\fR to be
+fit.  These parameters may either be specified with the same syntax as the
+\fBsample\fR parameter, or with the "hyphen" syntax used elsewhere in
+IRAF.  Note that a NULL range for \fBlines/bands\fR expands to \fBno\fR
+lines, not to all lines.  An asterisk (*) should be used to represent a
+range of all of the image lines/bands.  The fitting parameters (\fIsample,
+naverage, function, order, low_reject, high_reject, niterate, grow\fR)
+may be adjusted interactively if the parameter \fIinteractive\fR is
+yes.  The fitting is performed with the \fBicfit\fR package.  The
+cursor mode commands for this package are described in a separate help
+entry under "icfit".  Separate copies of the fitting parameters are
+maintained for each line so that interactive changes to the parameter
+defaults will be remembered from image to image.
+.ih
+PROMPTS
+If several images or lines are specified, the user is asked whether
+to perform an interactive fit for each spectrum.  The response
+may be \fByes, no, skip, YES, NO\fR or \fBSKIP\fR.  The meaning of each
+response is:
+
+.nf
+	yes   - Fit the next spectrum interactively.
+	no    - Fit the next spectrum non-interactively.
+	skip  - Skip the next spectrum in this image.
+
+	YES   - Interactively fit all of the spectra of
+		all of the images with no further prompts.
+	NO   	Non-interactively fit all chosen spectra of all images.
+	SKIP  - This will produce a second prompt, "Skip what?",
+		with the choices:
+
+		spectrum - skip this spectrum in all images
+		image    - skip the rest of the current image
+		all      - \fBexit\fR the program
+		           This will \fBunlearn\fR the fit parameters
+			   for all spectra!
+		cancel  - return to the main prompt
+.fi
+.ih
+EXAMPLES
+1.  To normalize all orders of the echelle spectrum for hd221170
+
+	cl> sfit hd221170.ec nhd221170.ec type=ratio
+
+Each order of the spectrum is graphed and the interactive options for
+setting and fitting the continuum are available.  The important
+parameters are low_rejection (for an absorption spectrum), the function
+type, and the order of the function; these fit parameters are
+originally set to the defaults in the SFIT parameter file.  A
+'?' will display a menu of cursor key options.  Exiting with 'q' will
+update the output normalized order for the current image and proceed to
+the next order or image.
+
+The parameters of the fit for each order are initialized to the current
+values the first time that the order is fit.  In subsequent images, the
+parameters for a order are set to the values from the previous image.
+The first time an order is fit, the sample region is reset to the
+entire order.  Deleted points are ALWAYS forgotten from order to order
+and image to image.
+
+2.  To do several images at the same time
+
+	cl> sfit spec*.imh c//spec*.imh
+
+Note how the image template concatenation operator is used to construct
+the output list of spectra.  Alternatively:
+
+	cl> sfit @inlist @outlist
+
+where the two list files could have been created with the sections
+command or by editing.
+
+3.  To measure the power law slope of the continuum (fluxed data)
+
+	cl> sfit uv.* type=ratio logscale+ listonly+ fun=leg order=2
+.ih
+REVISIONS
+.ls SFIT V2.10.4
+The task was expanded to include fitting specified bands in 3D multispec
+spectra.
+
+The task was expanded to include long slit and spectral cube data.
+.le
+.ls SFIT V2.10
+This task is new.
+.le
+.ih
+BUGS
+The errors are not listed for the power series coefficients.
+
+Spectra that are updated when \fBlogscale\fR is yes are written with a
+linear wavelength scale, but with a log normalized data value.
+
+Selection by aperture number is not supported.
+.ih
+SEE ALSO
+continuum, fit1d, icfit, ranges
+.endhelp
diff --git a/noao/onedspec/doc/sflip.hlp b/noao/onedspec/doc/sflip.hlp
new file mode 100644
index 00000000..66790e4e
--- /dev/null
+++ b/noao/onedspec/doc/sflip.hlp
@@ -0,0 +1,114 @@
+.help sflip Jul94 noao.onedspec
+.ih
+NAME
+sflip -- Flip data and/or dispersion coordinates in spectra
+.ih
+USAGE
+sflip input output
+.ih
+PARAMETERS
+.ls input
+List of input images containing spectra to be flipped.
+.le
+.ls output
+Matching list of output image names for flipped spectra.
+If no list is specified then the flipped spectra will replace the input
+spectra.  If the output image name matching an input image name is the
+same then the flipped spectrum will replace the original spectrum.
+.le
+.ls coord_flip = no
+Flip the dispersion coordinates?  If yes then the relationship between the
+logical pixel coordinates and the dispersion coordinates will be reversed so
+that the dispersion coordinate of the first pixel of the output image will
+correspond to the coordinate of the last pixel in the input image and
+vice-versa for the other endpoint pixel.  The physical coordinates
+will also be flipped.  Only the coordinate system along the dispersion
+axis is flipped.
+.le
+.ls data_flip = yes
+Flip the order of the data pixels as they are stored in the image along
+the dispersion axis?  If yes then the first pixel in the input spectrum
+becomes the last pixel in the output spectrum along the dispersion
+axis of the image.
+.le
+.ih
+DESCRIPTION
+The dispersion coordinate system and/or the data in the spectra specified
+by the input list of images are flipped and stored in the matching output
+image given in the output list of images.  If the output image list is left
+blank or an output image name is the same as an input image name then the
+operation is done so that the flipped spectra in the image replace the
+original spectra.  All of the supported spectrum types are allowed; one
+dimensional images, collections of spectra in multispec format, and two and
+three dimensional spatial spectra in which one axis is dispersion.  In all
+cases the flipping affects only the dispersion axis of the image as
+specified by the DISPAXIS header keyword or the "dispaxis" parameter.  The
+parameters \fIcoord_flip\fR and \fIdata_flip\fR select whether the
+coordinate system and data are flipped.  If neither operation is selected
+then the output spectra will simply be copies of the input spectra.
+
+Flipping of the coordinate system means that the relation between
+"logical" pixel coordinates (the index system of the image array)
+and the dispersion and physical coordinate systems is reversed.
+The dispersion coordinate of the first pixel in the flipped spectrum
+will be the same as the dispersion coordinate of the last pixel
+in the original spectrum and vice-versa for the other endpoint.
+
+Flipping of the data means that the order in which the pixels are stored
+in the image file is reversed along the image axis corresponding to
+the dispersion.
+
+While flipping spectra seems simple there are some subtleties.  If
+both the coordinate system and the data are flipped then plots of
+the spectra in which the dispersion coordinates are shown will appear
+the same as in the original spectra.  In particular the coordinate
+of a feature in the spectrum will remain unchanged.  In contrast
+flipping either the coordinate system or the data will cause features
+in the spectrum to move to opposite ends of the spectrum relative
+to the dispersion coordinates.
+
+Since plotting programs often plot the dispersion axis in some standard way
+such as increasing from left to right, flipping both the dispersion
+coordinates and the data will produce plots that look identical even though
+the order of the points plotted will be reversed.  Only if the spectra are
+plotted against logical pixel coordinates will a change be evident.  Note
+also that the plotting programs themselves have options to reverse the
+displayed graph.  So if all one wants is to reverse the direction of
+increasing dispersion in a plot then physically flipping of the spectra is
+not generally necessary.
+
+Flipping of both the coordinate system and the data is also equivalent
+to using an image section with a reversed axis.  For example
+a one dimensional spectrum can be flipped in both dispersion coordinates
+and data pixel order by
+
+.nf
+    cl> imcopy spec1[-*] spec2
+.fi
+
+Higher dimensional spectra need appropriate dimensions in the image
+sections.  One advantage of \fBsflip\fR is that it will determine the
+appropriate dispersion axis itself.
+.ih
+EXAMPLES
+In the following the spectra can be one dimensional, multispec,
+long slit, or spectral data cubes.
+
+.nf
+    cl> sflip spec1 spec1f		# Flip data to new image
+    cl> sflip spec1 spec1		# Flip data to same image
+    cl> sflip spec1 spec1f coord+ data-	# Flip coordinates and not data
+    cl> sflip spec1 spec1f coord+ 	# Flip both coordinates and data
+    cl> sflip spec* f//spec*		# Flip a list of images
+.fi
+.ih
+REVISIONS
+.ls SFLIP V2.10.4
+New in this release.  Note that the V2.9 SFLIP was different in that
+it was script which simply flipped the data.  Coordinate systems were
+not handled in the same way.
+.le
+.ih
+SEE ALSO
+imcopy, scopy, dispcor, sapertures
+.endhelp
diff --git a/noao/onedspec/doc/sinterp.hlp b/noao/onedspec/doc/sinterp.hlp
new file mode 100644
index 00000000..b983beba
--- /dev/null
+++ b/noao/onedspec/doc/sinterp.hlp
@@ -0,0 +1,146 @@
+.help sinterp Mar92 noao.onedspec
+.ih
+NAME
+sinterp -- Interpolate a tables of x,y pairs to produce a spectrum
+.ih
+USAGE
+sinterp tbl_file
+.ih
+PARAMETERS
+.ls tbl_file
+The name of a file which contains the x,y pairs to be used as
+the basis for interpolation. The pairs must be in order of
+increasing x.
+.le
+
+The following parameters may or may not be necessary, depending
+on the options selected.
+
+.ls input
+If a few single elements are desired, rather than a full
+array of elements, the user may enter a sequence of x values
+from the terminal or a file to be used to interpolate into
+the x,y table (parameter curve_gen=no).
+.le
+.ls image
+If parameter make_image=yes, then an image file name is needed
+.le
+.ls order = 5
+If the interpolator is a polynomial fit or spline (interp_mode=
+chebyshev, legnedre, spline3, spline1), the order of the fit
+is required.
+.le
+.ls x1
+If parameter curve_gen=yes, this is the starting x value to
+begin the curve generation.
+.le
+
+Of the following three parameters, two must be specified, and the
+third will be derived.
+
+.ls x2 = 0.0
+As above, but x2 determines the endpoint of the curve.
+.le
+.ls dx = 0.0
+As above, but dx determines the pixel-to-pixel increment
+to be used during the curves generation.
+.le
+.ls npts = 0
+As above, but this determines the number of pixels to be generated.
+.le
+
+.ls curve_gen = no
+If this parameter is set to yes, then parameters x1, and two of
+the three x2, dx, npts are required. The output is in the form
+of new x,y pairs and may be redirected to a text file.
+But if parameter make_image is also yes, the output is
+in the form of an IRAF image file having the name given by
+the parameter image. If curve_gen=no, the user must supply
+a set of x values and interpolation is performed on those values.
+.le
+.ls make_image = no
+If set to yes, then curve_gen=yes is implied and an image file name
+is requied. A one dimensional IRAF image is created.
+.le
+.ls tbl_size = 1024
+This parameter defines the maximum size to be set aside for
+memory storage of the input x,y pairs.
+.le
+.ls interp_mode = "chebyshev"
+This parameter controls the method of interpolation. The linear
+and curve options are true interpolators, while chebyshev,
+legendre, spline3, and splin1 are fits to the data.
+.le
+.ih
+DESCRIPTION
+The specified file is read assuming it is a text file containing
+pairs of x,y values in the form: xxx yyy. The table is used
+to define the function y(x). The pairs must be entered in the file
+in increasing order of x.
+
+The user specifies either specific x values for which the function
+is to be evaluated, or specifies that a sequence of values beginning
+with x1 are to be generated. In the former case, the explicit x values
+may come either from the keyboard or from a file. In the latter case
+the user must also specify the sequence by defining the increment, dx,
+the endpoint, x2, and the number of points to generate in the sequence.
+Then y(x) is evaluated at x1, x1+dx, x1+2*dx, ...  , x1+(n-2)*dx, x2.
+Only 2 of the 3 parameters (x2, dx, npts) are needed to fully
+specify the sequence.
+
+The output of the function evaluation is either new x,y pairs written
+to STDOUT, or an IRAF image.
+
+The function used to evaluated the tabular data may be any of the following
+forms:
+
+.ls (1)
+Linear interpolation between points.
+.le
+.ls (2)
+Smooth interpolation between points.
+.le
+.ls (3)
+A polynomial fit of either Legendre or Chebyshev types.
+.le
+.ls (4)
+A cubic or linear spline.
+.le
+
+If the table of x,y pairs is very large, the parameter tbl_size
+should be set to the number of pairs. For example, if a spectrum
+is available as a text file of x,y pairs (such as might be
+obtained from IUE), and the number of pairs is 4096, then tbl_size
+should be set to 4096. This provides for sufficient memory to
+contain the table.
+
+.ih
+EXAMPLES
+The following shows how a text file may be used to generate a spectrum:
+
+.nf
+	cl> sinterp textfile make+ x1=4000 x2=5000 npts=1024 \
+	>>> image=testimage interp_mode=curve
+.fi
+
+The following sequence shows how to generate a spectrum of an IRS
+standard star using the calibration file data as the source.
+
+.nf
+	cl> lcalib flam feige34 caldir=onedstds$irscal/ >textfile
+	cl> sinterp textfile make+ x1=3550 dx=1.242 npts=1024 \
+	>>> interp_mode=linear image=feige34
+.fi
+.ih
+REVISIONS
+.ls SINTERP V2.10.3+
+The image header dispersion coordinate system has been updated to the
+current system.
+.le
+.ls SINTERP V2.10
+This task is unchanged.
+.le
+.ih
+SEE ALSO
+lcalib
+.endhelp
diff --git a/noao/onedspec/doc/skytweak.hlp b/noao/onedspec/doc/skytweak.hlp
new file mode 100644
index 00000000..857e4380
--- /dev/null
+++ b/noao/onedspec/doc/skytweak.hlp
@@ -0,0 +1,311 @@
+.help skytweak Mar97 noao.onedspec
+.ih
+NAME
+skytweak -- sky subtract 1D spectra after tweaking sky spectra
+.ih
+SUMMARY
+Sky spectra are shifted and scaled to best subtract sky features from data
+spectra.  This may be done non-interactively to minimize the RMS in some
+region or regions of the data spectra and interactively with a graphically
+search.
+.ih
+USAGE
+skytweak input output cal
+.ih
+PARAMETERS
+.ls input
+List of input data images containing one dimensional spectra to be
+corrected.  All spectra in each image are corrected. The spectra need not
+be wavelength calibrated.
+.le
+.ls output
+List of output corrected images.  The list must either match the input list
+or be an empty list.  If an empty list is specified the input spectra will
+be replaced by the corrected spectra.  The input spectra will also be
+replaced if the input and output image names are the same.  Any other image
+name must be for a new image otherwise a warning message will be given and
+the task will proceed to the next input image.
+.le
+.ls cal  
+List of sky calibration images.  If a single image is specified it
+will apply to all the input images.  Otherwise the list of calibration
+images must match the list of input images.
+.le
+.ls ignoreaps = no
+Ignore aperture numbers between the input spectra and the calibration
+spectra?  If "no" then the calibration image must contain a spectrum
+with the same aperture number as each spectrum in the input image.
+Otherwise the first spectrum in the calibration image will be used
+for all spectra in the input image.
+.le
+.ls xcorr = yes
+Cross-correlate each input spectrum with the calibration spectrum to
+determine an shift for the calibration spectrum?  Only regions specified by
+the sample regions parameter will be used in the cross-correlation.
+.le
+.ls tweakrms = yes
+Search for the minimum RMS in the corrected spectrum by adjusting the
+shifts and scales between the input spectrum and the calibration spectrum?
+The RMS is minimized in the specified sample regions.
+.le
+.ls interactive = yes
+Enter an interactive graphical mode to search for the best shift
+and scale between the input spectra and calibration spectra?  This
+is done after the optional automatic cross-correlation and RMS minimization
+step.  A query is made for each input spectrum so that the interactive
+step may be skipped during the execution of the task.
+.le
+.ls sample = "*"
+Sample regions to use for cross-correlation, automatic RMS minimization,
+and RMS values.  The sample regions are specified by a list of comma
+separated ranges.  The ranges are colon separate coordinate values.
+For dispersion calibrated spectra the coordinate values are in the
+dispersion units otherwise they are in pixel coordinates.  The string "*"
+selects the entire spectrum.  The sample regions may be changed
+interactively either with the cursor or with a colon command.
+.le
+.ls lag = 10
+The cross-correlation lag to use when \fIxcorr\fR = yes.  The lag
+is given in pixels.   This is the distance to either side of the
+initial shift over which the cross-correlation profile is computed.
+If a value of zero is given then the cross-correlation step is not done.
+.le
+.ls shift = 0., dshift = 1.
+The initial shift and shift step in pixels.  This initializes the shift
+search parameters for the first spectrum.  If \fIdshift\fR is zero then
+there will be no search for a new shift and the 'x' interactive function is
+disabled.  These parameters may be changed interactively.  After the
+first spectrum subsequent spectra begin with the values from the last
+spectrum.
+.le
+.ls scale = 1., dscale = 0.2
+The initial scale and scale step.  This initializes the scale
+search parameters for the first spectrum.  If \fIdscale\fR is zero then
+there will be no search for a new scale and the 'y' interactive function is
+disabled.  These parameters may be changed interactively.  After the
+first spectrum subsequent spectra begin with the values from the last
+spectrum.
+.le
+.ls offset = 1.
+The interactive search displays three candidate corrected spectra which
+have been normalized to a mean of one.  The offset is added and subtracted
+to separate the three candidates.  The value may be changed interactively.
+.le
+.ls smooth = 1
+The displayed candidate corrected spectra are smoothed by a moving
+boxcar average with a box size specified by this parameter.  The smoothing
+only applies to the displayed spectra and does not affect the measured
+RMS or the output corrected spectra.  The value may be changed interactively.
+.le
+.ls cursor = ""
+Input cursor for the interactive graphics.  A null value selects the
+graphics cursor otherwise a file of cursor values may be specified.
+.le
+.ls answer
+Query parameter for responding to the interactive question.  This parameter
+should not be specified on the command line.
+.le
+.ls interp = poly5
+The \fBpackage\fR parameter specifying the interpolation function for shifting
+the calibration spectra to match the input spectra.
+.le
+.ih
+DESCRIPTION
+Input one dimensional spectra are corrected to remove sky features by
+subtracting a shifted and scaled sky calibration spectra.
+The shifting
+allows for possible small shifts or errors in the dispersion zeropoints.
+
+The following describes the correction.  Let J(x_i) be the calibration
+spectrum at a set of pixels x_i.  An interpolation function is fit to this
+spectrum to give J(x).  The shifted and scaled calibration function
+is then
+
+.nf
+    (1)  J'(x) = J(x+dx) *scale
+.fi
+
+where dx is the pixel shift parameter and
+scale is the scale parameter.
+The output corrected spectrum is then computed as
+
+.nf
+    (2)  I'(x_i) = I(x_i) - J'(x_i)
+.fi
+
+where I' is the corrected spectrum and I is the input spectrum.  If the
+spectra are dispersion calibrated, possibly with different dispersion
+parameters, then the x values in (2) from the input spectrum are converted
+to matching pixels in the calibration spectrum using the dispersion
+functions of the two spectra.
+
+The purpose of this task is to determine the best values of the
+shift and scale parameters dx and scale.  There
+are automatic and interactive methods provided.  The automatic
+methods are cross-correlation of the calibration and input spectra
+to find a shift and an iterative search for the in both
+shift and scale that minimizes the RMS of I' in some region.
+The automatic methods are performed first, if selected, followed
+by the interactive, graphical step.  The following describes
+the steps in the order in which they occur.
+
+The initial values of the shift and scale are set by the parameters
+\fIshift\fR and \fIscale\fR for the first spectrum.  After that the values
+determined for the previous spectrum, those actually applied to correcting
+that spectrum, are used as the initial values for the next spectrum.  The
+search steps and sample regions are also initialized by task parameters but
+may be modified during the interactive step and the modified values apply
+to subsequent spectra.
+
+If the \fIxcorr\fR parameter is yes and the \fIlag\fR parameter is
+not zero the calibration spectrum is cross-correlated against the input
+spectrum.  Each spectrum is prepared as follows.  A large scale continuum
+is fit by a quadratic chebyshev using 5 iterations of sigma clipping with a
+clipping factor of 3 sigma below the fit and 1 sigma above the fit and
+rejecting the deviant points along with one pixel on either side.  This
+attempts to eliminate the effects of absorption lines.  The continuum fit
+is subtracted from the spectrum and the spectrum is extended and tapered by
+a cosine function of length given by the \fIlag\fR parameter.
+
+The prepared spectra are then cross-correlated by shifting the calibration
+spectrum plus and minus the specified \fIlag\fR amount about the current
+shift value.  Only the regions in the input spectrum specified by the
+sample regions parameter are used in the correlation.  This produces a
+correlation profile whose peak defines the relative shift between the two
+spectra.  The current shift value is updated.  This method assumes the
+common telluric features dominate within the specified sample regions.  The
+lag size should be roughly the profile widths of the telluric features.
+
+If the \fItweakrms\fR parameter is yes and \fIdshift\fR is greater than
+zero trial corrections at the current shift value and plus and minus one
+shift step with the scale value fixed at its current value are made and the
+RMS in the sample regions computed.  If the RMS is smallest at the current
+shift value the shift step is divided in half otherwise the current shift
+value is set to the shift with the lowest RMS.  The process is then
+repeated with the new shift and shift step values.  This continues until
+either the shift step is less than 0.01 pixels or the shift is more than
+two pixels from the initial shift.  In the latter case the final shift is
+reset to the original shift.
+
+The scale factor is then varied if \fIdscale\fR is greater than zero by the
+scale step at a fixed shift in the same way as above to search for a
+smaller RMS in the sample regions.  This search terminates when the scale
+step is less than 0.01 or if the scale value has departed by 100% of the
+initial value.  In the latter case the scale value is left unchanged.
+
+The search over the shifts and scales is repeated a second time after which
+the tweak algorithm terminates.
+
+After the optional cross-correlation and tweak steps the interactive search
+mode may be entered.  This occurs if \fIinteractive\fR = yes.  A query is
+asking whether to search interactively.  The answers may be "no", "yes",
+"NO", or "YES".  The lower case answers apply to the current spectrum and
+the upper case answers apply to all subsequent spectra.  This means that if
+an answer of "NO" or "YES" is given then there will be no further queries
+for the remaining input spectra.
+
+If the interactive step is selected a graph of three candidate corrections
+for the input spectrum is displayed.  There also may be a graph of the
+calibration or input spectrum shown for reference.  Initially the
+calibration spectrum is displayed.  The additional graph may be toggled off
+and on and between the input and calibration spectra with the 'c' and 'd'
+keys.  The three candidate corrected spectra will be with the current shift
+and scale in the middle and plus or minus one step in either the shift or
+scale.  Initially the spectra will be at different scale values.
+Information about the current shift and scale and the step used is given in
+the graph title.
+
+One may toggle between shift steps and scale steps with the 'x' (for shift)
+or 'y' (for scale) keys.  The RMS in the title is the RMS within the
+currently defined sample regions.  If one of the step values is zero then a
+display of different values of that parameter will not be selected.  The
+step size will need to be set with a colon command to search in that
+parameter.
+
+If 'x' is typed when the three spectra are at different shifts then the
+nearest spectrum to the y cursor at the x cursor position will be
+selected.  If the central spectrum is selected the step size is divided in
+half otherwise the current shift is changed and the  selected spectrum
+becomes the middle spectrum.  Three new spectra are then shown.  The same
+applies if 'y' is typed when the three spectra are at different scales.
+This allows an interactive search similar to the iterative tweakrms method
+described previously except the user can use whatever criteria is desired
+to search for the best scale and shift.
+
+There are additional keystrokes and colon commands to set or change sample
+regions, reset the current shift, scale, and step sizes, expand the step
+size in the current mode, adjust the offsets between the spectra, and
+get help.  The 'w' key and GTOOLS colon commands are available to window
+the graphs.  Any changes in the x limits apply to both graphs while y limit
+adjustments apply to the graph pointed to by the cursor.
+
+Two other commands require a short explanation.  The 'a' key may
+be used to run the tweakrms algorithm starting from the current
+shift, scale, and steps and the current sample regions.  This allows
+one to graphically set or reset the sample regions before doing
+the RMS minimization.  The ":smooth" command and associated
+\fIsmooth\fR task parameter allow the corrected spectra to be
+displayed with a boxcar smoothing to better see faint features in
+noise.  It is important to realize that the smoothing is only
+done on the displayed spectra.  The telluric correction and computed RMS
+are done in the unsmoothed data.
+
+After the interactive step is quit with 'q' or if the interactive
+step is not done then the final output spectrum is computed and
+written to the output image.  A brief log output is printed for
+each spectrum.
+.ih
+CURSOR KEYS AND COLON COMMANDS
+.nf
+? - print help
+a - automatic RMS minimization within sample regions
+c - toggle calibration spectrum display
+d - toggle data spectrum display
+e - expand (double) the step for the current selection
+q - quit
+r - redraw the graphs
+s - add or reset sample regions
+w - window commands (see :/help for additional information)
+x - graph and select from corrected shifted candidates
+y - graph and select from corrected scaled candidates
+
+:help           - print help
+:shift  [value] - print or reset the current shift
+:scale  [value] - print or reset the current scale
+:dshift [value] - print or reset the current shift step
+:dscale [value] - print or reset the current scale step
+:offset [value] - print or reset the current offset between spectra
+:sample [value] - print or reset the sample regions
+:smooth [value] - print or reset the smoothing box size
+.fi
+.ih
+EXAMPLES
+1.  To interactively search for a best correction with the default
+cross-correlation and tweak steps:
+
+.nf
+    cl> skytweak spec001.ms skyspec001.ms spec005.ms
+.fi
+
+2.  To search only for a scale factor:
+
+.nf
+    cl> skytweak spec001.ms skyspec001.ms spec005.ms xcorr- dshift=0.
+.fi
+
+3.  To processes a set of spectra non-interactively with the same calibration
+spectrum and to replace the input spectra with the corrected spectra and
+log the processing:
+
+.nf
+    cl> skytweak spec* "" skyspec inter- > log
+.fi
+.ih
+REVISIONS
+.ls SKYTWEAK V2.11
+This task is new in this version.
+.le
+.ih
+SEE ALSO
+telluric
+.endhelp
diff --git a/noao/onedspec/doc/skytweak.key b/noao/onedspec/doc/skytweak.key
new file mode 100644
index 00000000..a694ba36
--- /dev/null
+++ b/noao/onedspec/doc/skytweak.key
@@ -0,0 +1,35 @@
+		SKYTWEAK COMMAND SUMMARY
+
+? - print help
+a - automatic RMS minimization within sample regions
+c - toggle calibration spectrum display
+d - toggle data spectrum display
+e - expand (double) the step for the current selection
+q - quit
+r - redraw the graphs
+s - add or reset sample regions
+w - window commands (see :/help for additional information)
+x - graph and select from corrected shifted candidates
+y - graph and select from corrected scaled candidates
+
+:help           - print help
+:shift  [value] - print or reset the current shift
+:scale  [value] - print or reset the current scale
+:dshift [value] - print or reset the current shift step
+:dscale [value] - print or reset the current scale step
+:offset [value] - print or reset the current offset between spectra
+:sample [value] - print or reset the sample regions
+:smooth [value] - print or reset the smoothing box size
+
+
+The stacked display shows three corrected candidate spectra.  The center
+one is for the current shift and scale and the other two are one step
+higher or lower in the shift or scale.  The current values and the
+step is shown in the title.  Toggle between the shift and scale candidates
+with 'x' or 'y'.  Select the best spectrum with the cursor and typing
+'x' or 'y'.  Selecting the middle spectrum with 'x' in the shift display
+divides the shift step in half.  Selecting one of the other spectra
+changes the current shift.  Selecting the middle spectrum with 'y'
+in the scale display divides the scale step in half.  Selecting one of
+the other spectra changes the current scale.  When 'q' is typed the
+final shift and scale will be that of the middle spectrum.
diff --git a/noao/onedspec/doc/slist.hlp b/noao/onedspec/doc/slist.hlp
new file mode 100644
index 00000000..322914b0
--- /dev/null
+++ b/noao/onedspec/doc/slist.hlp
@@ -0,0 +1,142 @@
+.help slist Mar92 noao.onedspec
+.ih
+NAME
+slist -- List spectral header information
+.ih
+USAGE
+slist images
+.ih
+PARAMETERS
+.ls images
+List of images to be listed.
+.le
+.ls apertures = ""
+List of apertures to be selected from the images for listing.  A null
+list selects all apertures.  See \fBranges\fR for the syntax of
+this list.
+.le
+.ls long_header = no
+If set to yes, then a multiline listing of the header elements is given.
+If set to no, then a single line per spectrum is given.  The contents
+of the listing depend on the format.
+.le
+.ih
+DESCRIPTION
+This task lists header information from apertures in a list of input
+images.  There is a short one line per spectrum listing and a more
+extended listing selected by the \fIlong_header\fR parameter.
+
+In both short and long outputs the aperture information consists of
+lines with the following whitespace separated fields: the image line,
+the aperture number, the beam number, the dispersion type, the
+wavelength of the first pixel, the wavelength interval per pixel,
+the number of valid pixels, and the aperture title.  The dispersion
+type is an integer with a value of -1 if not dispersion corrected,
+0 if dispersion corrected to a linear wavelength sampling, 1 if
+dispersion corrected to a log wavelength sampling, and 2 if dispersion
+corrected to a nonlinear sampling.  The wavelength per pixel is
+an approximation based on the wavelength endpoints divided by the
+number of pixels in the case of a nonlinear dispersion function.
+Also the wavelengths refer to the actual pixels taking any image sections
+into account and so may differ from the coordinate system information in
+the header which is defined for the original physical coordinates.
+The aperture titles may be identical with the image title if individual
+aperture titles are not defined.
+
+In the short output format the image title is given first followed
+by the above described information.  This format is compact and
+suitable for easy use in other programs (see the example below).
+The long output format is blocked by image and gives the image name
+and title on the first line, the exposure time, universal time,
+and siderial time on the second line, the right ascention, declination,
+hour angle, and airmass on the third line, and then the individual
+aperture information on the remaining lines.  If some of the header
+information is missing a value of INDEF is printed.  The keywords used
+are EXPTIME/ITIME/EXPOSURE (in that order) for the exposure time,
+and UT, ST, RA, DEC, HA, and AIRMASS for the remaining values.
+
+    demoobj.ms: Hydra artificial image
+	EXPTIME = 2133.33 UT = 9:10:09.0    ST = 20:09:34.0
+	RA = 1:34:02.00   DEC = 30:37:03.0  HA = INDEF    AIRMASS = 2.3
+.ih
+EXAMPLES
+1.  List short header for an object and arc from a Hydra multifiber reduction
+for fibers 36 to 39.
+
+.nf
+    cl> slist demoobj.ms,demoarc1.ms ap=36-39
+    demoobj.ms 1 37 0 0 5785.85 6.140271 256 Sky fiber
+    demoobj.ms 2 38 1 0 5785.85 6.140271 256 SS313
+    demoobj.ms 3 39 1 0 5785.85 6.140271 256 SS444
+    demoarc1.ms 1 36 2 0 5785.85 6.140271 256 Arc fiber
+    demoarc1.ms 2 37 0 0 5785.85 6.140271 256 Sky fiber
+    demoarc1.ms 3 38 1 0 5785.85 6.140271 256 SS313
+    demoarc1.ms 4 39 1 0 5785.85 6.140271 256 SS444
+.fi
+
+Note that fiber 37 is the first image line in demoobj.ms and teh second image
+line in demoarc.ms.  The dispersion is the same in all fibers by design.
+
+2.  List long headers for the two images of example 1 but restricted to
+apertures 38 and 39.
+
+.nf
+    cl> slist demoobj.ms,demoarc1.ms ap=38,39 l+
+    demoobj.ms: Hydra artificial image
+	EXPTIME = 2133.33 UT = 9:10:09.0    ST = 20:09:34.0
+	RA = 1:34:02.00   DEC = 30:37:03.0  HA = INDEF    AIRMASS = 2.3
+        2 38 1 0 5785.85 6.140271 256 SS313
+	3 39 1 0 5785.85 6.140271 256 SS444
+    demoarc1.ms: Hydra artificial image
+	EXPTIME = 2133.33 UT = 9:10:09.0    ST = 20:09:34.0
+	RA = 1:34:02.00   DEC = 30:37:03.0  HA = INDEF    AIRMASS = 2.3
+        3 38 1 0 5785.85 6.140271 256 SS313
+	4 39 1 0 5785.85 6.140271 256 SS444
+.fi
+
+The other header parameters are the same because this is artificial
+data using the same template header.
+
+3.  Dump the set of image headers on a printer in long format.
+
+.nf
+    cl> slist *.ms.imh l+ | lprint
+.fi
+
+4.  The short form of SLIST may be used to get some of the aperture
+information for use in a script.  The following simply prints the
+image line corresponding to a specified aperture.  In a real application
+something more complex would be done.
+
+.nf
+	procedure example (images, aperture)
+
+	string	images		{prompt="List of images"}
+	int	aperture	{prompt="Aperture"}
+
+	begin
+		string temp, image
+		int	line
+
+		# Use SLIST to print to a temporary file.
+		temp = mktemp ("example")
+		slist (images, aperture=aperture, long=no, > temp)
+
+		# Scan each line and print the line number.
+		list = temp
+		while (fscan (list, image, line) != EOF)
+		    print (image, ": ", line)
+		list = ""
+		delete (temp, verify=no)
+	end
+.fi
+.ih
+REVISIONS
+.ls SLIST V2.10
+This task was revised to be relevant for the current spectral image
+formats.  The old version is still available in the IRS/IIDS package.
+.le
+.ih
+SEE ALSO
+imheader, hselect
+.endhelp
diff --git a/noao/onedspec/doc/specplot.hlp b/noao/onedspec/doc/specplot.hlp
new file mode 100644
index 00000000..222d77ff
--- /dev/null
+++ b/noao/onedspec/doc/specplot.hlp
@@ -0,0 +1,387 @@
+.help specplot Jan96 noao.onedspec
+.ih
+NAME
+specplot -- stack and plot multiple spectra
+.ih
+USAGE
+specplot spectra
+.ih
+PARAMETERS
+.ls spectra
+List of spectra to plot.  The spectra are assigned index numbers increasing
+from one in the order of the list.
+.le
+.ls apertures = ""
+List of apertures to plot.  An empty list selects all apertures.
+An aperture list consists of a comma separated list of aperture numbers or
+hyphen separated range of numbers.  A step size may also be specified preceded
+by 'x'.  See \fBranges\fR for more.
+.le
+.ls bands = "1"
+List of bands to plot if the image is three dimensional.  The list has
+the same syntax as for the apertures.
+.le
+.ls dispaxis = 1, nsum = 1
+Parameters for defining vectors in 2D images.  The
+dispersion axis is 1 for line vectors and 2 for column vectors.
+A DISPAXIS parameter in the image header has precedence over the
+\fIdispaxis\fR parameter.  These may be changed interactively.
+.le
+.ls autolayout = yes
+Automatically layout the spectra by shifting or scaling to a common mean
+and determining a separation step which does overlaps the spectra
+by the specified fraction?  The algorithm uses the following parameters.
+.ls autoscale = yes
+Scale the spectra to a common mean?  If no then the spectra are shifted
+to a common mean and if yes they are scaled to a common mean.
+.le
+.ls fraction = 1.
+The separation step which just avoids overlapping the spectra is multiplied
+by this number.  Numbers greater than 1 increase the separation while numbers
+less than 1 decrease the separation and provide some amount of overlap.
+.le
+.le
+.ls units = ""
+Dispersion coordinate units.  If the spectra have known units, currently
+this is generally Angstroms, the plotted units may be converted
+for plotting to other units as specified by this parameter.
+If this parameter is the null string then the units specified by the
+world coordinate system attribute "units_display" is used.  If neither
+is specified than the units of the coordinate system are used.
+The units
+may also be changed interactively.  See the units section of the
+\fBonedspec\fR help for a further description and available units.
+.le
+.ls transform = "none" (none|log)
+Transform for the input pixel values.  Currently only "log" is implemented.
+If all pixels are negative the spectrum values will be unchanged and if
+some pixels are negative they are mapped to the lowest non-negative value in
+the spectrum.  Note that this cannot be changed interactively or applied
+independently for each spectrum.  To change the setting one must exit
+the task and execute it with the new value.
+.le
+.ls scale = 1., offset = 0. (value, @file, keyword)
+The scale and offset to apply to each spectrum.  The value of the parameter
+may be a constant value applying to all spectra, a file containing the
+values specified as @<file> where <file> is the filename, or an image
+header keyword whose value is to be used.
+.le
+.ls step = 0
+The step separating spectra when not using the autolayout option.
+The value of this parameter depends on the range of the data.
+.le
+.ls ptype = "1"
+Default plotting type for the spectra.  A numeric value selects line plots
+while marker type strings select marker plots.  The sign of the line type
+number selects histogram style lines when negative or connected pixel
+values when positive.  The absolute value selects the line type with 0
+being an invisible line, 1 being a solid line, and higher integers
+different types of lines depending on the capabilities of the graphics
+device.  The marker type strings are "point", "box", "plus", "cross",
+"diamond", "hline", "vline", "hebar", "vebar", and "circle".
+The types for individual spectra may be changed interactively.
+.le
+.ls labels = "user"
+Spectrum labels to be used.  If the null string or the word "none" is
+given then the spectra are not labeled.  The word "imname" labels the
+spectra with the image name, the word "imtitle" labels them wih the
+image title, the word "index" labels them with the index number, and
+the word "user" labels them with user defined labels.  The user labels
+may be given in the file specified by the parameter \fIulabels\fR, which
+are matched with the list of spectra, and also added interactively.
+.le
+.ls ulabels = ""
+File containing user labels.
+.le
+.ls xlpos = 1.02, ylpos = 0.0
+The starting position for the spectrum labels in fractions of the
+graph limits.  The horizontal (x) position is measured from the left
+edge while the vertical position is measured from the mean value of the
+spectrum.  For vertical positions a negative value may be used to label
+below the spectrum.  The default is off the right edge of the graph at
+the mean level of the spectrum.
+.le
+.ls sysid = yes
+Include system banner and separation step label?  This may be changed
+interactively using ":/sysid".
+.le
+.ls yscale = no
+Draw a Y axis scale?  Since stacked plots are relative labeling the Y
+axes may not be useful.  This parameter allows adding the Y axis scale
+if desired.  The default is to not have a Y axis scale.
+.le
+.ls title = "", xlabel = "", ylabel = ""
+Title, x axis label, and y axis label for graphs.  These may be changed
+interactively using ":/title", ":/xlabel", and ":/ylabel".
+.le
+.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF
+The default limits for the initial graph.  If INDEF then the limit is
+determined from the range of the data (autoscaling).  These values can
+be changed with 'w' cursor key or the cursor commands ":/xwindow" and
+":/ywindow".
+.le
+.ls logfile = ""
+Logfile to record the final set of spectra and scale factors displayed.
+.le
+.ls graphics = "stdgraph"
+Output graphics device.  One of "stdgraph", "stdplot", "stdvdm",
+@(enviroment variable), or actual device.
+.le
+.ls cursor = ""
+Graphics cursor input.  When null the standard cursor is used otherwise
+the specified file is used.
+.le
+.ih
+DESCRIPTION
+\fBSpecplot\fR plots multiple spectra with provisions for scaling them,
+separating them vertically, shifting them horizontally, and labeling them.
+The layout can be defined by an automatic algorithm or explicitly and
+adjusted noninteractively (with some limitations) or interactively.  The
+plotting units can be selected and the vertical axis scale can be shown or
+not as desired.  This task is used for compressing many spectra to a page
+for review, intercomparison of spectra, classification against standards,
+and final display.
+
+The input list of spectra consists of one, two, or three dimensional images.
+The set of spectra may be restricted to specific apertures using the
+\fIapertures\fR parameter.  Note that for true 2D images, such as long slit
+spectra, the aperture number corresponds to the line or column to be plotted
+and the dispersion axis and nsum parameter are determined either from the
+image header or the package parameters.  Spectra extracted
+with the \fBapextract\fR package may be three dimensional where the 3rd
+dimension corresponds to related data.  The higher dimensional data is
+also plotted though it may be restricted with the \fIbands\fR
+parameter.
+
+Each spectrum has a number of associated parameters which are initially
+assigned default values but which may be changed interactively.  First each
+spectrum is assigned an index number.  This is generally sequential
+starting from 1.  Spectra added interactively are assigned the next higher
+or lower index relative to the spectrum being appended or inserted.  The
+index is used for refering to parameters of a particular spectrum and for
+separating the spectra vertically.  The spectra are scaled and shifted by
+the equation
+
+	I = value * scale + offset + (index - 1) * step
+
+where "I" is the final plotted value, "value" is the pixel value, "scale"
+is a multiplicative scaling, "offset" is a additive offset, and "step" is
+an additive separation step used to stack spectra vertically.
+
+The default values of the vertical scaling parameters may be set by an
+automatic layout algorithm or with explicit constants (the same for all
+spectra).  The automatic mode is selected with the parameter
+\fIautolayout\fR and works as follows.  All spectra are scaled or shifted
+to a common mean (depending on the parameter \fIautoscale\fR) relative to
+the lowest indexed spectrum.  A step size is then computed to just avoid
+overlapping of the minimum of one spectrum with the maximum of another.
+Note that this may not yield a good layout if the spectra have large
+continuum slopes.  Finally, to add some extra space between the spectra or
+to allow some overlap, the minimum step is multiplied by a specified
+overlap factor, \fIfraction\fR.
+
+In nonautomatic mode the user specifies the intensity scale, offset,
+and separation step explicitly with the parameters, \fIscale, offset\fR
+and \fIstep\fR.  If the step is zero then spectra will be directly
+overplotted while a positive or negative value will separate the
+spectra either upward or downward with the index 1 spectrum having no
+offset.  The scale and offset parameters may be specified as either
+constant values, the name of file containing the values (one per line)
+preceded by the '@' character, or the name of an image header keyword.
+This parameter as well as the scale and offset may be set or
+changed interactively via colon commands and the "offset" may also be
+set using the cursor to shift a spectrum vertically.
+
+In addition to shifting spectra vertically they may also be shifted
+horizontally as a velocity/redshift or a zero point change with either
+cursor or colon commands.  The dispersion, inteval per pixel, may be
+modified, either with the 't' key or the "wpc" command, in which case if
+the dispersion is nonlinear the spectra will be linearized.
+
+Each spectrum may have a label associated with it.  The label type may
+be the image name, the image title, the index number, or a user defined
+label.  The default label type is specified by the parameter
+\fIlabels\fR.  For user labels the initial labels may be specified in a
+file.  Interactively the label type may be changed using the ":labels"
+command and the user assigned labels may be defined by a colon command
+or by using the cursor to mark the position for the label.  The label
+position is given relative to the range of the graph and the mean
+intensity.  The default values are set by the parameters \fIxlpos\fR
+and \fIylpos\fR.  The positions may be changed interactively for all
+the spectra or individually.  The latter may be done using the cursor
+to mark exactly where the label is to go.
+
+Each spectrum has an associated plotting type.  The default type which
+applies to all spectra initially is specified by the parameter
+\fIptype\fR.  This parameter specifies both whether line mode or
+marker mode is used and the line type, line style, or marker type to use.
+The line
+mode and types are given by a small integers with the style, connected
+pixel centers or histogram style, chosed by the sign of the integer.
+The type of lines produced depend on the capabilities of the terminal.  In most
+cases a zero line type is invisible.  (This may be used interactively
+to temporarily eliminate a spectrum from a plot instead of deleting the
+spectrum from the list of spectra).  A line type of 1 is a solid line
+and additional line types are specified by higher numbers.
+The marker types are given by name as described in the parameter
+section.  There is currently no combination of line and marker (such as
+connected points with vertical bars) or histogram type plotting.  The
+plotting type may be changed interactively for individual spectra or
+for all spectra using colon commands.
+
+The cursor and colon commands generally apply to the spectrum nearest
+the cursor.  This is determined by finding the nearest data point to
+the cursor.  For the colon commands the spectrum may also be specified
+explicitly by the index number using an optional suffix "[index]", where
+index is the index number for the spectrum.  Also the special index "*"
+may be specified to apply to all spectra.
+
+The operations of adding, deleting, moving, or shifting spectra affect
+the index numbers of the other spectra.  When deleting a spectrum the
+index numbers of all spectra with greater index numbers are decreased
+by one resulting in the plotted spectra moving down (positive step).
+When adding a spectrum the index numbers above the inserted spectrum
+are increased by one resulting in the spectra moving up.  Moving a
+spectrum to a new index number is equivalent to deleting the spectrum
+and then inserting it at the new index position.  Spectra may be
+shifted to insert gaps in the plotted spectra.  The specified value is
+added to all spectra above and including the one indicated if the value
+is positive to all spectra below and including the one indicated if the
+value is negative.
+.ih
+CURSOR COMMANDS
+
+The indicated spectrum is the one with a point closest to the cursor position.
+.nf
+
+? - Print help summary
+a - Append a new spectrum following the indicated spectrum
+i - Insert a new spectrum before the indicated spectrum
+d - Delete the indicated spectrum
+e - Insert last deleted spectrum before indicated spectrum
+f - Toggle between world coordinates and logical pixel coordinates
+l - Define the user label at the indicated position
+p - Define the label position at the indicated position
+o - Reorder the spectra to eliminate gaps
+q - Quit
+r - Redraw the plot
+s - Repeatedly shift the indicated spectrum position with the cursor
+     q - Quit shift                      x - Shift horizontally in velocity
+     s - Shift vertically in scale       y - Shift vertically in offset
+     t - Shift horizontally in velocity  z - Shift horizontally in velocity
+         and vertically in scale             and vertically in offset
+t - Set a wavelength scale using the cursor
+u - Set a wavelength point using the cursor
+v - Set velocity plot with zero point at cursor
+w - Window the plot
+x - Cancel all scales and offsets
+y - Automatically layout the spectra with offsets to common mean
+z - Automatically layout the spectra scaled to common mean
+.fi
+.ih
+COLON COMMANDS
+
+A command without a value generally shows the current value of the
+parameter while with a value it sets the value of the parameter.  The show
+commands print to the terminal unless a file is given.  For the spectrum
+parameters the index specification, "[index]", is optional.  If absent the
+nearest spectrum to the cursor when the command is given is selected except
+for the "units" command which selects all spectra.  The index is either a
+number or the character *.  The latter applies the command to all the
+spectra.
+
+.nf
+:show <file>		   Show spectrum parameters (file optional)
+:vshow <file>		   Show verbose parameters (file optional)
+:step <value>		   Set or show step
+:fraction <value>	   Set or show autolayout fraction
+:label <value>		   Set or show label type
+				(none|imtitle|imname|index|user)
+
+:move[index] <to_index>	   Move spectrum to new index position
+:shift[index|*] <value>	   Shift spectra by adding to index
+:w0[index|*] <value>	   Set or show zero point wavelength
+:wpc[index|*] <value>	   Set or show wavelength per channel
+:velocity[index|*] <value> Set or show radial velocity (km/s)
+:redshift[index|*] <value> Set or show redshift
+:offset[index|*] <value>   Set or show intensity offset
+:scale[index|*] <value>	   Set or show intensity scale
+:xlpos[index|*] <value>	   Set or show X label position
+:ylpos[index|*] <value>	   Set or show Y label position
+:ptype[index|*] <value>	   Set or show plotting type
+:color[index|*] <value>    Set or show color (1-9)
+:ulabel[index|*] <value>   Set or show user labels
+:units[index|*] <value>	   Change coordinate units
+
+:/title <value>		   Set the title of the graph
+:/xlabel <value>	   Set the X label of the graph
+:/ylabel <value>	   Set the Y label of the graph
+:/xwindow <min max>	   Set the X graph range
+				(use INDEF for autoscaling)
+:/ywindow <min max>	   Set the X graph range
+				(use INDEF for autoscaling)
+ 
+
+Examples:
+    w0		  Print value of wavelength zero point
+    w0 4010	  Set wavelength zero point of spectrum nearest the cursor
+    w0[3] 4010	  Set wavelength zero point of spectrum with index 3
+    w0[*] 4010	  Set wavelength zero point of all spectra
+.fi
+.ih
+EXAMPLES
+1. To make a nice plot of a set of spectra with the default layout:
+
+	cl> specplot spec*
+
+2.  To set the colors or line types for multiple spectra in a batch
+mode application create a cursor file like:
+
+	cl> type cursor.dat
+	:color[1] 2
+	:color[2] 3
+	:color[3] 4
+	r
+	cl> specplot im1,im2,im3 cursor=cursor.dat
+
+Note that the 'r' key is necessary redraw the graph with the changed
+attributes.
+.ih
+REVISIONS
+.ls SPECPLOT V2.11
+The scale and offset parameters may now be a value, a filename, or
+and image header keyword.
+
+The 'f' key was added to toggle between world and logical pixel coordinates.
+.le
+.ls SPECPLOT V2.10.3
+A color parameter was added for graphics terminals supporting color.
+
+The :units command was extended to have an optional spectrum specifier.
+This is primarily intended to plot different (or the same) spectra in
+velocity but with different velocity zeros.
+
+The default task units parameter has been changed to "" to allow picking
+up a "units_display" WCS attribute if defined.
+.le
+.ls SPECPLOT V2.10
+New parameters were added to select apertures and bands, plot
+additional dimensions (for example the additional output from the extras
+option in \fBapextract\fR), suppress the system ID banner, suppress the Y
+axis scale, output a logfile, and specify the plotting units.  The \fIptype\fR
+parameter now allows negative numbers to select histogram style lines.
+Interactively, the plotting units may be changed and the 'v' key allows
+setting a velocity scale zero point with the cursor.  The new version
+supports the new spectral WCS features including nonlinear dispersion
+functions.
+.le
+.ih
+NOTES
+The automatic layout algorithm is relatively simple and may not
+provide visually satisfactory results in all cases.  The fonts and Y axis
+scale capabilities are not as good as might be desired for publication
+quality plots.
+.ih
+SEE ALSO
+bplot, splot, onedspec, gtools, ranges
+.endhelp
diff --git a/noao/onedspec/doc/specshift.hlp b/noao/onedspec/doc/specshift.hlp
new file mode 100644
index 00000000..c72ebd0a
--- /dev/null
+++ b/noao/onedspec/doc/specshift.hlp
@@ -0,0 +1,67 @@
+.help specshift Oct92 noao.onedspec
+.ih
+NAME
+specshift -- Shift dispersion coordinate systems
+.ih
+USAGE
+specshift spectra shift
+.ih
+PARAMETERS
+.ls spectra
+List of spectra to be modified.
+.le
+.ls shift
+Dispersion coordinate shift to be added to the current dispersion coordinate
+system.
+.le
+.ls apertures = ""
+List of apertures to be modified.  The null list
+selects all apertures.  A list consists of comma separated
+numbers and ranges of numbers.  A range is specified by a hyphen.  An
+optional step size may be given by using the 'x' followed by a number.
+See \fBxtools.ranges\fR for more information.  This parameter is ignored
+for N-dimensional spatial spectra such as long slit and Fabry-Perot.
+.le
+.ls verbose = no
+Print a record of each aperture modified?
+.le
+.ih
+DESCRIPTION
+This task applies a shift to the dispersion coordinate system of selected
+spectra.  The image data is not modified as with \fBimshift\fR but rather
+the coordinate system is shifted relative to the data.  The spectra to be
+modified are selected by specifying a list of images and apertures.  If no
+aperture list is specified then all apertures in the images are modified.
+For N-dimensional spatial spectra such as long slit and Fabry-Perot the
+aperture list is ignored.
+
+The specified shift is added to the existing world coordinates.  For linear
+coordinate systems this has the effect of modifying CRVAL1, for linear
+"multispec" coordinate systems this modifies the dispersion coordinate of
+the first physical pixel, and for nonlinear "multispec" coordinate systems
+this modifies the shift coefficient(s).
+
+It is also possible to shift the linearized coordinate systems (but not the
+nonlinear coordinate systems) with \fBsapertures\fR or possibly with
+\fBwcsedit\fR or \fBhedit\fR if the coordinate system is stored with a
+global linear system.
+
+The \fIverbose\fR parameter lists the images, the apertures, the shift, and
+the old and new values for the first physical pixel are printed.
+.ih
+EXAMPLES
+1.  To add 1.23 Angstroms to the coordinates of all apertures in the
+image "ngc456.ms":
+
+.nf
+	cl> specshift ngc456.ms 1.23
+.fi
+.ih
+REVISIONS
+.ls SPECSHIFT V2.10.3
+First version.
+.le
+.ih
+SEE ALSO
+sapertures, dopcor, imcoords.wcsreset, hedit, ranges, onedspec.package
+.endhelp
diff --git a/noao/onedspec/doc/specwcs.hlp b/noao/onedspec/doc/specwcs.hlp
new file mode 100644
index 00000000..ed8852e3
--- /dev/null
+++ b/noao/onedspec/doc/specwcs.hlp
@@ -0,0 +1,586 @@
+.help specwcs Mar93 noao.onedspec
+
+.ce
+\fBThe IRAF/NOAO Spectral World Coordinate Systems\fR
+
+
+.sh
+1. Types of Spectral Data
+
+Spectra are stored as one, two, or three dimensional images with one axis
+being the dispersion axis.  A pixel value is the flux over
+some interval of wavelength and position.  The simplest example of a
+spectrum is a one dimensional image which has pixel values as a
+function of wavelength.
+
+There are two types of higher dimensional spectral image formats.  One type
+has spatial axes for the other dimensions and the dispersion axis may be
+along any of the image axes.  Typically this type of format is used for
+long slit (two dimensional) and Fabry-Perot (three dimensional) spectra.
+This type of spectra is referred to as \fIspatial\fR spectra and the
+world coordinate system (WCS) format is called \fIndspec\fR.
+The details of the world coordinate systems are discussed later.
+
+The second type of higher dimensional spectral image consists of multiple,
+independent, one dimensional spectra stored in the higher dimensions with
+the first image axis being the dispersion axis; i.e. each line is a
+spectrum.  This format allows associating many spectra and related
+parameters in a single data object.  This type of spectra is referred to
+as \fImultispec\fR and the there are two coordinate system formats,
+\fIequispec\fR and \fImultispec\fR.  The \fIequispec\fR format applies
+to the common case where all spectra have the same linear dispersion
+relation.  The \fImultispec\fR format applies to the general case of spectra
+with differing dispersion relations or non-linear dispersion functions.
+These multi-spectrum formats are important since maintaining large numbers
+of spectra as individual one dimensional images is very unwieldy for the
+user and inefficient for the software.
+
+Examples of multispec spectral images are spectra extracted from a
+multi-fiber or multi-aperture spectrograph or orders from an echelle
+spectrum.  The second axis is some arbitrary indexing of the spectra,
+called \fIapertures\fR, and the third dimension is used for
+associated quantities.  The IRAF \fBapextract\fR package may produce
+multiple spectra from a CCD image in successive image lines with an
+optimally weighted spectrum, a simple aperture sum spectrum, a background
+spectrum, and sigma spectrum as the associated quantities along the third
+dimension of the image.
+
+Many \fBonedspec\fR package tasks which are designed to operate on
+individual one dimensional spectra may operate on spatial spectra by
+summing a number of neighboring spectra across the dispersion axis.  This
+eliminates the need to "extract" one dimensional spectra from the natural
+format of this type of data in order to use tasks oriented towards the
+display and analysis of one dimensional spectra.  The dispersion axis is
+either given in the image header by the keyword DISPAXIS or the package
+\fIdispaxis\fR parameter.  The summing factors across the
+dispersion are specified by the \fInsum\fR package parameter.
+See "help onedspec.package" for information on these parmaeters.
+
+One dimensional spectra, whether from multispec spatial spectra, have
+several associated quantities which may appear in the image header as part
+of the coordinate system description.  The primary identification of a
+spectrum is an integer aperture number.  This number must be unique within
+a single image.  There is also an integer beam number used for various
+purposes such as discriminating object, sky, and arc spectra in
+multi-fiber/multi-aperture data or to identifying the order number in
+echelle data.  For spectra summed from spatial spectra the aperture number
+is the central line, column, or band.  In 3D images the aperture index
+wraps around the lowest non-dispersion axis.  Since most one dimensional
+spectra are derived from an integration over one or more spatial axes, two
+additional aperture parameters record the aperture limits.  These limits
+refer to the original pixel limits along the spatial axis.  This
+information is primarily for record keeping but in some cases it is used
+for spatial interpolation during dispersion calibration.  These values are
+set either by the \fBapextract\fR tasks or when summing neighboring vectors
+in spatial spectra.
+
+An important task to be aware of for manipulating spectra between image
+formats is \fBscopy\fR.  This task allows selecting spectra from multispec
+images and grouping them in various ways and also "extracts" apertures from
+long slit and 3D spectra simply and without resort to the more general
+\fBapextract\fR package.
+.sh
+2. World Coordinate Systems
+
+IRAF images have three types of coordinate systems.  The pixel array
+coordinates of an image or image section, i.e. the lines and
+columns, are called the \fIlogical\fR coordinates.  The logical coordinates of
+individual pixels change as sections of the image are used or extracted.
+Pixel coordinates are tied to the data, i.e. are fixed to features
+in the image, are called \fIphysical\fR coordinates.  Initially the logical
+and physical coordinates are the equivalent but differ when image sections
+or other tasks which modify the sampling of the pixels are applied.
+
+The last type of coordinate system is called the \fIworld\fR coordinate
+system.  Like the physical coordinates, the world coordinates are tied to
+the features in the image and remain unchanged when sections of the image
+are used or extracted.  If a world coordinate system is not defined for an
+image, the physical coordinate system is considered to be the world
+coordinate system.  In spectral images the world coordinate system includes
+dispersion coordinates such as wavelengths.  In many tasks outside the
+spectroscopy packages, for example the \fBplot\fR, \fBtv\fR and
+\fBimages\fR packages, one may select the type of coordinate system to be
+used.  To make plots and get coordinates in dispersion units for spectra
+with these tasks one selects the "world" system.  The spectral tasks always
+use world coordinates.
+
+The coordinate systems are defined in the image headers using a set of
+reserved keywords which are set, changed, and updated by various tasks.
+Some of the keywords consist of simple single values following the FITS
+convention.  Others, the WAT keywords, encode long strings of information,
+one for each coordinate axis and one applying to all axes, into a set of
+sequential keywords.  The values of these keywords must then be pasted
+together to recover the string.  The long strings contain multiple pieces
+called WCS \fIattributes\fR.  In general the WCS keywords should be left to
+IRAF tasks to modify.  However, if one wants modify them directly some
+tasks which may be used are \fBhedit\fR, \fBhfix\fR, \fBwcsedit\fR,
+\fBwcsreset\fR, \fBspecshift\fR, \fBdopcor\fR, and \fBsapertures\fR.  The
+first two are useful for the simple keywords, the two  "wcs" tasks are
+useful for the linear ndspec and equispec formats, the next two are for the
+common cases of shifting the coordinate zero point or applying a doppler
+correction, and the last one is the one to use for the more complex
+multispec format attributes.
+.sh
+3. Physical Coordinate System
+
+The physical coordinate system is used by the spectral tasks when there is
+no dispersion coordinate information (such as before dispersion
+calibration), to map the physical dispersion axis to the logical dispersion
+axis, and in the multispec world coordinate system dispersion functions
+which are defined in terms of physical coordinates.
+
+The transformation between logical and physical coordinates is defined by
+the header keywords LTVi, LTMi_j (where i and j are axis numbers) through
+the vector equation
+
+.nf
+    l = |m| * p + v
+.fi
+
+where l is a logical coordinate vector, p is a physical
+coordinate vector, v is the origin translation vector specified by
+the LTV keywords and |m| is the scale/rotation matrix
+specified by the LTM keywords.  For spectra rotation terms (nondiagonal
+matrix elements) generally do not make sense (in fact many tasks will not
+work if there is a rotation) so the transformations along each axis are
+given by the linear equation
+
+where l is a logical coordinate vector, p is a physical coordinate vector,
+v is the origin translation vector specified by the LTV keywords and |m| is
+the scale/rotation matrix specified by the LTM keywords.  For spectra a
+rotation term (nondiagonal matrix elements) generally does not make sense
+(in fact many tasks will not work if there is a rotation) so the
+transformations along each axis are given by the linear equation
+
+.nf
+    li = LTMi_i * pi + LTVi.
+.fi
+
+If all the LTM/LTV keywords are missing they are assumed to have zero
+values except that the diagonal matrix terms, LTMi_i, are assumed to be 1.
+Note that if some of the keywords are present then a missing LTMi_i will
+take the value zero which generally causes an arithmetic or matrix
+inversion error in the IRAF tasks.
+
+The dimensional mapping between logical and physical axes is given by the
+keywords WCSDIM and WAXMAP01.  The WCSDIM keyword gives the dimensionality
+of the physical and world coordinate system.  There must be coordinate
+information for that many axes in the header (though some may be missing
+and take their default values).  If the WCSDIM keyword is missing it is
+assumed to be the same as the logical image dimensionality.
+
+The syntax of the WAXMAP keyword are pairs of integer values,
+one for each physical axis.  The first number of each pair indicates which
+current \fIlogical\fR axis corresponds to the original \fIphysical\fR axis
+(in order) or zero if that axis is missing.   When the first number is zero
+the second number gives the offset to the element of the original axis
+which is missing.  As an example consider a three dimensional image in
+which the second plane is extracted (an IRAF image section of [*,2,*]).
+The keyword would then appear as WAXMAP01 = '1 0 0 1 2 0'.  If this keyword
+is missing the mapping is 1:1; i.e. the dimensionality and order of the
+axes are the same.
+
+The dimensional mapping is important because the dispersion axis for
+the nspec spatial spectra as specified by the DISPAXIS keyword or task
+parameter, or the axis definitions for the equispec and or multispec
+formats are always in terms of the original physical axes.
+.sh
+4. Linear Spectral World Coordinate Systems
+
+When there is a linear or logarithmic relation between pixels and
+dispersion coordinates which is the same for all spectra the WCS header
+format is simple and uses the FITS convention (with the CD matrix keywords
+proposed by Hanisch and Wells 1992) for the logical pixel to world
+coordinate transformation.  This format applies to one, two, and three
+dimensional data.  The higher dimensional data may have either linear
+spatial axes or the equispec format where each one dimensional spectrum
+stored along the lines of the image has the same dispersion.
+
+The FITS image header keywords describing the spectral world coordinates
+are CTYPEi, CRPIXi, CRVALi, and CDi_j where i and j are axis numbers.  As
+with the physical coordinate transformation the nondiagonal or rotation
+terms are not expected in the spectral WCS and may cause problems if they
+are not zero.  The CTYPEi keywords will have the value LINEAR to identify
+the type of coordinate system.  The transformation between dispersion
+coordinate, wi, and logical pixel coordinate, li, along axis i is given by
+
+.nf
+    wi = CRVALi + CDi_i * (li - CRPIXi)
+.fi
+
+If the keywords are missing then the values are assumed to be zero except
+for the diagonal elements of the scale/rotation matrix, the CDi_i, which
+are assumed to be 1.  If only some of the keywords are present then any
+missing CDi_i keywords will take the value 0 which will cause IRAF tasks to
+fail with arithmetic or matrix inversion errors.  If the CTYPEi keyword is
+missing it is assumed to be "LINEAR".
+
+If the pixel sampling is logarithmic in the dispersion coordinate, as
+required for radial velocity cross-correlations, the WCS coordinate values
+are logarithmic and wi (above) is the logarithm of the dispersion
+coordinate.  The spectral tasks (though not other tasks) will recognize
+this case and automatically apply the anti-log.  The two types of pixel
+sampling are identified by the value of the keyword DC-FLAG.  A value of 0
+defines a linear sampling of the dispersion and a value of 1 defines a
+logarithmic sampling of the dispersion.  Thus, in all cases the spectral
+tasks will display and analyze the spectra in the same dispersion units
+regardless of the pixel sampling.
+
+Other keywords which may be present are DISPAXIS for 2 and 3 dimensional
+spatial spectra, and the WCS attributes "system", "wtype", "label", and
+"units".  The system attribute will usually have the value "world" for
+spatial spectra and "equispec" for equispec spectra.  The wtype attribute
+will have the value "linear".  Currently the label will be either "Pixel"
+or "Wavelength" and the units will be "Angstroms" for dispersion corrected
+spectra.  In the future there will be more generality in the units
+for dispersion calibrated spectra.
+
+Figure 1 shows the WCS keywords for a two dimensional long slit spectrum.
+The coordinate system is defined to be a generic "world" system and the
+wtype attributes and CTYPE keywords define the axes to be linear.  The
+other attributes define a label and unit for the second axis, which is the
+dispersion axis as indicated by the DISPAXIS keyword.  The LTM/LTV keywords
+in this example show that a subsection of the original image has been
+extracted with a factor of 2 block averaging along the dispersion axis.
+The dispersion coordinates are given in terms of the \fIlogical\fR pixel
+coordinates by the FITS keywords as defined previously.
+
+.ce
+Figure 1: Long Slit Spectrum
+
+.nf
+    WAT0_001= 'system=world'
+    WAT1_001= 'wtype=linear'
+    WAT2_001= 'wtype=linear label=Wavelength units=Angstroms'
+    WCSDIM  =                    2
+    DISPAXIS=                    2
+    DC-FLAG =                    0
+
+    CTYPE1  = 'LINEAR  '
+    LTV1    =                 -10.
+    LTM1_1  =                   1.
+    CRPIX1  =                  -9.
+    CRVAL1  =     19.5743865966797
+    CD1_1   =     1.01503419876099
+
+    CTYPE2  = 'LINEAR  '
+    LTV2    =                -49.5
+    LTM2_2  =                  0.5
+    CRPIX2  =                 -49.
+    CRVAL2  =       4204.462890625
+    CD2_2   =     12.3337936401367
+.fi
+
+Figure 2 shows the WCS keywords for a three dimensional image where each
+line is an independent spectrum or associated data but where all spectra
+have the same linear dispersion.  This type of coordinate system has the
+system name "equispec".  The ancillary information about each aperture is
+found in the APNUM keywords.  These give the aperture number, beam number,
+and extraction limits.  In this example the LTM/LTV keywords have their
+default values; i.e. the logical and physical coordinates are the same.
+
+.ce
+Figure 2: Equispec Spectrum
+
+.nf
+    WAT0_001= 'system=equispec'
+    WAT1_001= 'wtype=linear label=Wavelength units=Angstroms'
+    WAT2_001= 'wtype=linear'
+    WAT3_001= 'wtype=linear'
+    WCSDIM  =                    3
+    DC-FLAG =                    0
+    APNUM1  = '41 3 7.37 13.48'
+    APNUM2  = '15 1 28.04 34.15'
+    APNUM3  = '33 2 43.20 49.32'
+
+    CTYPE1  = 'LINEAR  '
+    LTM1_1  =                   1.
+    CRPIX1  =                   1.
+    CRVAL1  =             4204.463
+    CD1_1   =     6.16689700000001
+
+    CTYPE2  = 'LINEAR  '
+    LTM2_2  =                   1.
+    CD2_2   =                   1.
+
+    CTYPE3  = 'LINEAR  '
+    LTM3_3  =                   1.
+    CD3_3   =                   1.
+.fi
+.sh
+5. Multispec Spectral World Coordinate System
+
+The \fImultispec\fR spectral world coordinate system applies only to one
+dimensional spectra; i.e. there is no analog for the spatial type spectra.
+It is used either when there are multiple 1D spectra with differing
+dispersion functions in a single image or when the dispersion functions are
+nonlinear.
+
+The multispec coordinate system is always two dimensional though there may
+be an independent third axis.  The two axes are coupled and they both have
+axis type "multispec".  When the image is one dimensional the physical line
+is given by the dimensional reduction keyword WAXMAP.  The second, line
+axis, has world coordinates of aperture number.  The aperture numbers are
+integer values and need not be in any particular order but do need to be
+unique.  This aspect of the WCS is not of particular user interest but
+applications use the inverse world to physical transformation to select a
+spectrum line given a specified aperture.
+
+The dispersion functions are specified by attribute strings with the
+identifier \fIspecN\fR where N is the \fIphysical\fR image line.  The
+attribute strings contain a series of numeric fields.  The fields are
+indicated symbolically as follows.
+
+.nf
+         specN = ap beam dtype w1 dw nw z aplow aphigh [functions_i]
+.fi
+
+where there are zero or more functions having the following fields,
+
+.nf
+    function_i =  wt_i w0_i ftype_i [parameters] [coefficients]
+.fi
+
+The first nine fields in the attribute are common to all the dispersion
+functions.  The first field of the WCS attribute is the aperture number,
+the second field is the beam number, and the third field is the dispersion
+type with the same function as DC-FLAG in the \fInspec\fR and
+\fIequispec\fR formats.  A value of -1 indicates the coordinates are not
+dispersion coordinates (the spectrum is not dispersion calibrated), a value
+of 0 indicates linear dispersion sampling, a value of 1 indicates
+log-linear dispersion sampling, and a value of 2 indicates a nonlinear
+dispersion.
+
+The next two fields are the dispersion coordinate of the first
+\fIphysical\fR pixel and the average dispersion interval per \fIphysical\fR
+pixel.  For linear and log-linear dispersion types the dispersion
+parameters are exact while for the nonlinear dispersion functions they are
+approximate.  The next field is the number of valid pixels, hence it is
+possible to have spectra with varying lengths in the same image.  In that
+case the image is as big as the biggest spectrum and the number of pixels
+selects the actual data in each image line.  The next (seventh) field is a
+doppler factor.  This doppler factor is applied to all dispersion
+coordinates by multiplying by 1/(1+z) (assuming wavelength dispersion
+units).  Thus a value of 0 is no doppler correction.  The last two fields
+are extraction aperture limits as discussed previously.
+
+Following these fields are zero or more function descriptions.  For linear
+or log-linear dispersion coordinate systems there are no function fields.
+For the nonlinear dispersion systems the function fields specify a weight,
+a zero point offset, the type of dispersion function, and the parameters
+and coefficients describing it.  The function type codes, ftype_i,
+are 1 for a chebyshev polynomial, 2 for a legendre polynomial, 3 for a
+cubic spline, 4 for a linear spline, 5 for a pixel coordinate array, and 6
+for a sampled coordinate array.  The number of fields before the next
+function and the number of functions are determined from the parameters of
+the preceding function until the end of the attribute is reached.
+
+The equation below shows how the final wavelength is computed based on
+the nfunc individual dispersion functions W_i(p).  Note that this
+is completely general in that different function types may be combined.
+However, in practice when multiple functions are used they are generally of
+the same type and represent a calibration before and after the actual
+object observation with the weights based on the relative time difference
+between the calibration dispersion functions and the object observation.
+
+.nf
+    w = sum from i=1 to nfunc {wt_i * (w0_i + W_i(p)) / (1 + z)}
+.fi
+
+The multispec coordinate systems define a transformation between physical
+pixel, p, and world coordinates, w.  Generally there is an intermediate
+coordinate system used.  The following equations define these coordinates.
+The first one shows the transformation between logical, l, and physical,
+p, coordinates based on the LTM/LTV keywords.  The polynomial functions
+are defined in terms of a normalized coordinate, n, as shown in the
+second equation.  The normalized coordinates run between -1 and 1 over the
+range of physical coordinates, pmin and pmax which are
+parameters of the function, upon which the coefficients were defined.  The
+spline functions map the physical range into an index over the number of
+evenly divided spline pieces, npieces, which is a parameter of the
+function.  This mapping is shown in the third and fourth equations where
+s is the continuous spline coordinate and j is the nearest integer less
+than or equal to s.
+
+.nf
+    p = (l - LTV1) / LTM1_1
+    n = (p - pmiddle) / (prange / 2)
+      = (p - (pmax+pmin)/2) / ((pmax-pmin) / 2)
+    s = (p - pmin) / (pmax - pmin) * npieces
+    j = int(s)
+.fi
+.sh
+5.1 Linear and Log Linear Dispersion Function
+
+The linear and log-linear dispersion functions are described by a
+wavelength at the first \fIphysical\fR pixel and a wavelength increment per
+\fIphysical\fR pixel.  A doppler correction may also be applied.  The
+equations below show the two forms.  Note that the coordinates returned are
+always wavelength even though the pixel sampling and the dispersion
+parameters may be log-linear.
+
+.nf
+    w = (w1 + dw * (p - 1)) / (1 + z)
+    w = 10 ** {(w1 + dw * (p - 1)) / (1 + z)}
+.fi
+
+Figure 3 shows an example from a multispec image with
+independent linear dispersion coordinates.  This is a linearized echelle
+spectrum where each order (identified by the beam number) is stored as a
+separate image line.
+
+.ce
+Figure 3: Echelle Spectrum with Linear Dispersion Function
+
+.nf
+    WAT0_001= 'system=multispec'
+    WAT1_001= 'wtype=multispec label=Wavelength units=Angstroms'
+    WAT2_001= 'wtype=multispec spec1 = "1 113 0 4955.44287109375 0.05...
+    WAT2_002= '5 256 0. 23.22 31.27" spec2 = "2 112 0 4999.0810546875...
+    WAT2_003= '58854293 256 0. 46.09 58.44" spec3 = "3 111 0 5043.505...
+    WAT2_004= '928358078002 256 0. 69.28 77.89"
+    WCSDIM  =                    2
+
+    CTYPE1  = 'MULTISPE'
+    LTM1_1  =                   1.
+    CD1_1   =                   1.
+
+    CTYPE2  = 'MULTISPE'
+    LTM2_2  =                   1.
+    CD2_2   =                   1.
+.fi
+.sh
+5.2 Chebyshev Polynomial Dispersion Function
+
+The parameters for the chebyshev polynomial dispersion function are the
+order (number of coefficients) and the normalizing range of physical
+coordinates, pmin and pmax, over which the function is
+defined and which are used to compute n.  Following the parameters are
+the order coefficients, ci.  The equation below shows how to
+evaluate the function using an iterative definition where x_1 = 1,
+x_2 = n, and x_i = 2 * n * x_{i-1} - x_{i-2}.
+
+The parameters for the chebyshev polynomial dispersion function are the
+order (number of coefficients) and the normalizing range of physical
+coordinates, pmin and pmax, over which the function is defined
+and which are used to compute n.  Following the parameters are the
+order coefficients, c_i.  The equation below shows how to evaluate the
+function using an iterative definition
+where x_1 = 1, x_2 = n, and x_i = 2 * n * x_{i-1} - x_{i-2}.
+
+.nf
+    W = sum from i=1 to order {c_i * x_i}
+.fi
+.sh
+5.3 Legendre Polynomial Dispersion Function
+
+The parameters for the legendre polynomial dispersion function are the
+order (number of coefficients) and the normalizing range of physical
+coordinates, pmin and pmax, over which the function is defined
+and which are used to compute n.  Following the parameters are the
+order coefficients, c_i.  The equation below shows how to evaluate the
+function using an iterative definition where x_1 = 1, x_2 = n, and
+x_i = ((2i-3)*n*x_{i-1}-(i-2)*x_{i-2})/(i-1).
+
+.nf
+    W = sum from i=1 to order {c_i * x_i}
+.fi
+
+Figure 4 shows an example from a multispec image with independent nonlinear
+dispersion coordinates.  This is again from an echelle spectrum.  Note that
+the IRAF \fBechelle\fR package determines a two dimensional dispersion
+function, in this case a bidimensional legendre polynomial, with the
+independent variables being the order number and the extracted pixel
+coordinate.  To assign and store this function in the image is simply a
+matter of collapsing the two dimensional dispersion function by fixing the
+order number and combining all the terms with the same order.
+
+.ce
+Figure 4: Echelle Spectrum with Legendre Polynomial Function
+
+.nf
+    WAT0_001= 'system=multispec'
+    WAT1_001= 'wtype=multispec label=Wavelength units=Angstroms'
+    WAT2_001= 'wtype=multispec spec1 = "1 113 2 4955.442888635351 0.05...
+    WAT2_002= '83 256 0. 23.22 31.27 1. 0. 2 4 1. 256. 4963.0163112090...
+    WAT2_003= '976664 -0.3191636898579552 -0.8169352858733255" spec2 =...
+    WAT2_004= '9.081188912082 0.06387049476832223 256 0. 46.09 58.44 1...
+    WAT2_005= '56. 5007.401409453303 8.555959076467951 -0.176732458267...
+    WAT2_006= '09935064388" spec3 = "3 111 2 5043.505764869474 0.07097...
+    WAT2_007= '256 0. 69.28 77.89 1. 0. 2 4 1. 256. 5052.586239197408 ...
+    WAT2_008= '271 -0.03173489817897474 -7.190562320405975E-4"
+    WCSDIM  =                    2
+
+    CTYPE1  = 'MULTISPE'
+    LTM1_1  =                   1.
+    CD1_1   =                   1.
+
+    CTYPE2  = 'MULTISPE'
+    LTM2_2  =                   1.
+    CD2_2   =                   1.
+.fi
+.sh
+5.4 Linear Spline Dispersion Function
+
+The parameters for the linear spline dispersion function are the number of
+spline pieces, npieces, and the range of physical coordinates, pmin
+and pmax, over which the function is defined and which are used to
+compute the spline coordinate s.  Following the parameters are the
+npieces+1 coefficients, c_i.  The two coefficients used in a linear
+combination are selected based on the spline coordinate, where a and b
+are the fractions of the interval in the spline piece between the spline
+knots, a=(j+1)-s, b=s-j, and x_0=a, and x_1=b.
+
+.nf
+    W = sum from i=0 to 1 {c_(i+j) * x_i}
+.fi
+.sh
+5.5 Cubic Spline Dispersion Function
+
+The parameters for the cubic spline dispersion function are the number of
+spline pieces, npieces, and the range of physical coordinates, pmin
+and pmax, over which the function is defined and which are used
+to compute the spline coordinate s.  Following the parameters are the
+npieces+3 coefficients, c_i.  The four coefficients used are
+selected based on the spline coordinate.  The fractions of the interval
+between the integer spline knots are given by a and b, a=(j+1)-s,
+b=s-j, and x_0 =a sup 3, x_1 =(1+3*a*(1+a*b)),
+x_2 =(1+3*b*(1+a*b)), and x_3 =b**3.
+
+The parameters for the cubic spline dispersion function are the number of
+spline pieces, npieces, and the range of physical coordinates, pmin
+and pmax, over which the function is defined and which are used to
+compute the spline coordinate s.  Following the parameters are the
+npieces+3 coefficients, c_i.  The four coefficients used are selected
+based on the spline coordinate.  The fractions of the interval between the
+integer spline knots are given by a and b, a=(j+1)-s, b=s-j,
+and x_0=a**3, x_1=(1+3*a*(1+a*b)), x_2=(1+3*b*(1+a*b)), and x_3=b**3.
+
+.nf
+    W = sum from i=0 to 3 {c_(i+j) * x_i}
+.fi
+.sh
+5.6 Pixel Array Dispersion Function
+
+The parameters for the pixel array dispersion function consists of just the
+number of coordinates ncoords.  Following this are the wavelengths at
+integer physical pixel coordinates starting with 1.  To evaluate a
+wavelength at some physical coordinate, not necessarily an integer, a
+linear interpolation is used between the nearest integer physical coordinates
+and the desired physical coordinate where a and b are the usual
+fractional intervals k=int(p), a=(k+1)-p, b=p-k,
+and x_0=a, and x_1=b.
+
+.nf
+    W = sum from i=0 to 1 {c_(i+j) * x_i}
+.fi
+.sh
+5.7 Sampled Array Dispersion Function
+
+The parameters for the sampled array dispersion function consists of
+the number of coordinate pairs, ncoords, and a dummy field.
+Following these are the physical coordinate and wavelength pairs
+which are in increasing order.  The nearest physical coordinates to the
+desired physical coordinate are located and a linear interpolation
+is computed between the two sample points.
+.endhelp
diff --git a/noao/onedspec/doc/splot.hlp b/noao/onedspec/doc/splot.hlp
new file mode 100644
index 00000000..a5bc3b96
--- /dev/null
+++ b/noao/onedspec/doc/splot.hlp
@@ -0,0 +1,1118 @@
+.help splot Jul95 noao.onedspec
+.ih
+NAME
+splot -- plot and analyze spectra
+.ih
+USAGE
+splot images [line [band]]
+.ih
+PARAMETERS
+.ls images
+List of images (spectra) to plot.  If the image is 2D or 3D the line
+and band parameters are used.  Successive images are plotted
+following each 'q' cursor command.  One may use an image section
+to select a desired column, line, or band but the full image will
+be in memory and any updates to the spectrum will be part of the
+full image.
+.le
+.ls line, band
+The image line/aperture and band to plot in two or three dimensional
+images.  For multiaperture spectra the aperture specified by the line
+parameter is first sought and if not found the specified image line is
+selected.  For other two dimensional images, such as long slit spectra, the
+line parameter specifies a line or column.  Note that if
+the line and band parameters are specified on the command line it will not
+be possible to change them interactively.
+.le
+.ls units = ""
+Dispersion coordinate units for the plot.  If the spectra have known units,
+currently this is generally Angstroms, the units may be converted
+to other units for plotting as specified by this task parameter.
+If this parameter is the null string and the world coordinate system
+attribute "units_display" is defined then that will
+be used.  If both this task parameters and "units_display" are not
+given then the spectrum dispersion units will be used.
+The units
+may also be changed interactively.  See the units section of the
+\fBpackage\fR help for a further description and available units.
+.le
+.ls options = "auto" [auto,zero,xydraw,histogram,nosysid,wcreset,flip,overplot]
+A list of zero or more, possibly abbreviated, options.  The options can
+also be toggled with colon commands.  The currently defined options are
+"auto", "zero", "xydraw", "histogram", "nosysid", "wreset", "flip", and
+"overplot".  Option "auto" automatically replots the graph whenever changes
+are made.  Otherwise the graph is replotted with keystrokes 'c' or 'r'.
+Option "zero" makes the initial minimum y of the graphs occur at zero.
+Otherwise the limits are set automatically from the range of the data or
+the \fIymin\fR parameter.  Option "xydraw" changes the 'x' draw key to use
+both x and y cursor values for drawing rather than the nearest pixel value
+for the y value.  Option "histogram" plots the spectra in a histogram style
+rather than connecting the pixel centers.  Option "nosysid" excludes the
+system banner from the graph title.  Option "wreset" resets the graph
+limits to those specified by the \fIxmin, xmax, ymin, ymax\fR parameters
+whenever a new spectrum is plotted.  The "flip" option selects that
+initially the spectra be plotted with decreasing wavelengths.  The options
+may be queried and changed interactively.  The "overplot" options overplots
+all graphs and a screen erase only occurs with the redraw key.
+.le
+.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF
+The default limits for the initial graph.  If INDEF then the limit is
+determined from the range of the data (autoscaling).  These values can
+be changed interactively with 'w' window key options or the cursor commands
+":/xwindow" and ":/ywindow" (see \fBgtools\fR).
+.le
+.ls save_file = "splot.log"
+The file to contain any results generated by the equivalent width or
+deblending functions.  Results are added to this file until the file is
+deleted.  If the filename is null (""), then no results are saved.
+.le
+.ls graphics = "stdgraph"
+Output graphics device: one of "stdgraph", "stdplot", "stdvdm", or device
+name.
+.le
+.ls cursor = ""
+Graphics cursor input.  When null the standard cursor is used otherwise
+the specified file is used.
+.le
+
+The following parameters are used for error estimates in the 'd',
+'k', and 'e' key measurements.  See the ERROR ESTIMATES section for a
+discussion of the error estimates.
+.ls nerrsample = 0
+Number of samples for the error computation.  A value less than 10 turns
+off the error computation.  A value of ~10 does a rough error analysis, a
+value of ~50 does a reasonable error analysis, and a value >100 does a
+detailed error analysis.  The larger this value the longer the analysis
+takes.
+.le
+.ls sigma0 = INDEF, invgain = INDEF
+The pixel sigmas are modeled by the formula:
+
+.nf
+    sigma**2 = sigma0**2 + invgain * I
+.fi
+
+where I is the pixel value and "**2" means the square of the quantity.  If
+either parameter is specified as INDEF or with a value less than zero then
+no sigma estimates are made and so no error estimates for the measured
+parameters are made.
+.le
+
+The following parameters are for the interactive curve fitting function
+entered with the 't' key.  This function is usually used for continuum
+fitting.  The values of these parameters are updated during the fitting.
+See \fBicfit\fR for additional details on interactive curve fitting.
+.ls function = "spline3"
+Function to be fit to the spectra.  The functions are
+"legendre" (legendre polynomial), "chebyshev" (chebyshev polynomial),
+"spline1" (linear spline), and "spline3" (cubic spline).  The functions
+may be abbreviated.
+.le
+.ls order = 1
+The order of the polynomials or the number of spline pieces.
+.le
+.ls low_reject = 2., high_reject = 4.
+Rejection limits below and above the fit in units of the residual sigma.
+Unequal limits are used to reject spectral lines on one side of the continuum
+during continuum fitting.
+.le
+.ls niterate = 10
+Number of rejection iterations.
+.le
+.ls grow = 1.
+When a pixel is rejected, pixels within this distance of the rejected pixel
+are also rejected.
+.le
+.ls markrej = yes
+Mark rejected points?  If there are many rejected points it might be
+desired to not mark rejected points.
+.le
+
+The following parameters are used to overplot standard star fluxes with
+the 'y' key.  See \fBstandard\fR for more information about these parameters.
+.ls star_name
+Query parameter for the standard star fluxes to be overplotted.
+Unrecognized names or a "?" will print a list of the available stars
+in the specified calibration directory.
+.le
+.ls mag
+The magnitude of the observed star in the band given by the
+\fImagband\fR parameter.  If the magnitude is not in the same band as
+the blackbody calibration file then the magnitude may be converted to
+the calibration band provided the "params.dat" file containing relative
+magnitudes between the two bands is in the calibration directory
+.le
+.ls magband
+The standard band name for the input magnitude.  This should generally
+be the same band as the blackbody calibration file.  If it is
+not the magnitude will be converted to the calibration band.
+.le
+.ls teff
+The effective temperature (deg K) or the spectral type of the star being
+calibrated.  If a spectral type is specified a "params.dat" file must exist
+in the calibration directory.  The spectral types are specified in the same
+form as in the "params.dat" file.  For the standard blackbody calibration
+directory the spectral types are specified as A0I, A0III, or A0V, where A
+can be any letter OBAFGKM, the single digit subclass is between 0 and 9,
+and the luminousity class is one of I, III, or V.  If no luminousity class
+is given it defaults to dwarf.
+.le
+.ls caldir = ")_.caldir"
+The standard star calibration directory.  The default value redirects the
+value to the parameter of the same name in the package parameters.
+.le
+.ls fnuzero = 3.68e-20
+The absolute flux per unit frequency at a magnitude of zero used to
+to convert the calibration magnitudes to absolute flux.
+.le
+
+The following parameters are used for queries in response to particular
+keystrokes.
+.ls next_image
+In response to 'g' (get next image) this parameter specifies the image.
+.le
+.ls new_image
+In response to 'i' (write current spectrum) this parameter specifies the
+name of a new image to create or existing image to overwrite.
+.le
+.ls overwrite = no
+Overwrite an existing output image?  If set to yes it is possible to write
+back into the input spectrum or to some other existing image.  Otherwise
+the user is queried again for a new image name.
+.le
+.ls spec2
+When adding, subtracting, multiplying, or dividing by a second spectrum
+('+', '-', '*', '/' keys in the 'f' mode) this parameter is used to get
+the name of the second spectrum.
+.le
+.ls constant
+When adding or multiplying by a constant ('p' or 'm' keys in the 'f' mode)
+the parameter is used to get the constant.
+.le
+.ls wavelength
+This parameter is used to get a dispersion coordinate value during deblending or
+when changing the dispersion coordinates with 'u'.
+.le
+.ls linelist
+During deblending this parameter is used to get a list of line positions,
+peak values, profile types, and widths.
+.le
+.ls wstart, wend, dw
+In response to 'p' (convert to a linear wavelength scale) these parameters
+specify the starting wavelength, ending wavelength, and wavelength per pixel.
+.le
+.ls boxsize
+In response to 's' (smooth) this parameter specifies the box size in pixels
+to be used for the boxcar smooth.  The value must be odd.  If an even
+value is specified the next larger odd value is actually used.
+.le
+.ih
+DESCRIPTION
+\fBSplot\fR provides an interactive facility to display and analyze
+spectra.  See also \fBbplot\fR for a version of this task useful for making
+many plots noninteractively.  Each spectrum in the image list is displayed
+successively.  To quit the current image and go on to the next the 'q'
+cursor command is used.  If an image is two-dimensional, such as with
+multiple aperture or long slit spectra, the aperture or image column/line
+to be displayed is needed.  If the image is three-dimensional, such as with
+the extra information produced by \fBapextract\fR, the band is needed.
+These parameters are queried unless specified on the command line.  If
+given on the command line it will not be possible to change them
+interactively.
+
+The plots are made on the specfied graphics device which is usually to
+the graphics terminal.  The initial plot limits are set with the parameters
+\fIxmin, xmax, ymin\fR, and \fIymax\fR.  If a limit is INDEF then that limit
+is determined from the range of the data.  The "zero" option may also
+be set in the \fIoptions\fR parameter to set the lower intensity limit
+to zero.  Other options that may be set to control the initial plot
+are to exclude the system identification banner, and to select a
+histogram line type instead of connecting the pixel centers.
+The dispersion units used in the plot are set by the \fIunits\fR
+parameter.  This allows converting to units other than those in which the
+dispersion coordinates are defined in the spectra.
+
+The \fIoption\fR parameter, mentioned in the previous paragraph, is a
+a list of zero or more options.  As previously noted, some of the options
+control the initial appearance of the plots.  The "auto" option determines
+how frequently plots are redrawn.  For slow terminals or via modems one
+might wish to minimize the redrawing.  The default, however, is to redraw
+when changes are made.  The "xydraw" parameter is specific to the 'x'
+key.
+
+After the initial graph is made an interactive cursor loop is entered.
+The \fIcursor\fR parameter may be reset to read from a file but generally
+the graphics device cursor is read.  The cursor loop takes single
+keystroke commands and typed in commands begun with a colon, called
+colon commands.  These commands are described below and a summary of
+the commands may be produced interactively with the '?' key or
+a scrolling help on the status line with the '/' key.
+
+Modifications to the spectra being analyzed may be saved using the 'i' key
+in a new, the current, or other existing spectra.  A new image is created
+as a new copy of the current spectrum and so if the current spectrum is
+part of a multiple spectrum image (including a long slit spectrum) the
+other spectra are copied.  If other spectra in the same image are then
+modified and saved use the overwrite option to replace then in the new
+output image.  If the output spectrum already exists then the
+\fIoverwrite\fR flag must be set to allow modifying the data.  This
+includes the case when the output spectrum is the same as the input
+spectrum.  The only odd case here is when the input spectrum is one
+dimensional and the output spectrum is two dimensional.  In this case the
+user is queried for the line to be written.
+
+The other form of output, apart from that produced on the terminal, are
+measurements of equivalent widths, and other analysis functions.  This
+information will be recorded in the \fIsave_file\fR if specified.
+
+The following keystrokes are active in addition to the normal IRAF
+cursor facilities (available with ":.help"):
+
+.ls ?
+Page help information.
+.le
+.ls /
+Cycle through short status line help.
+.le
+.ls <space>
+The space bar prints the cursor position and value of the nearest
+pixel.
+.le
+.ls a
+Expand and autoscale to the data range between two cursor positions.
+See also 'w', and 'z'.  Selecting no range, that is the two
+cursor positions the same, produces an autoscale of the whole spectrum.
+.le
+.ls b
+Set the plot base level to zero rather than autoscaling.
+.le
+.ls c
+Clear all windowing and redraw the full current spectrum.  This redraws the
+spectrum and cancels any effects of the 'a', 'z', and 'w' keys.  The 'r'
+key is used to redraw the spectrum with the current windowing.
+.le
+.ls d
+Mark two continuum points and fit (deblend) multiple line profiles.
+The center, continuum at the center, core intensity, integrated flux,
+equivalent width, FWHMs for each profile are printed and saved
+in the log file.  See 'k' for fitting a single profile and
+'-' to subtract the fitted profiles.
+.le
+.ls e
+Measure equivalent width by marking two continuum points around the line
+to be measured.  The linear continuum is subtracted and the flux is
+determined by simply summing the pixels with partial pixels at the ends.
+Returned values are the line center, continuum at the region center,
+flux above or below the continuum, and the equivalent width.
+.le
+.ls f
+Enter arithmetic function mode. This mode allows arithmetic functions to be
+applied to the spectrum. The pixel values are modified according to the
+function request and may be saved as a new spectrum with the 'i'
+command.  Operations with a second spectrum are done in wavelength
+space and the second spectrum is automatically resampled if necessary.
+If one spectrum is longer than the other, only the smaller number of
+pixels are affected.  To exit this mode type 'q'.
+
+The following keystrokes are available in the function mode.  Binary
+operations with a constant or a second spectrum produce a query for the
+constant value or spectrum name.
+.ls a
+Absolute value
+.le
+.ls d
+Power of base 10 (inverse log base 10)
+.le
+.ls e
+Power of base e (inverse log base e)
+.le
+.ls i
+Inverse/reciprocal (values equal to zero are set to 0.0 in the inverse)
+.le
+.ls l
+Log base 10 (values less than or equal to 0.0 are set to -0.5)
+.le
+.ls m
+Multiply by a constant (constant is queried)
+.le
+.ls n
+Log base e (values less than or equal to 0.0 are set to -0.5)
+.le
+.ls p
+Add by a constant (constant is queried)
+.le
+.ls q
+Quit Function mode
+.le
+.ls s
+Square root (values less than 0.0 are set to 0.0)
+.le
+.ls +
+Add another spectrum
+.le
+.ls -3 -
+Subtract another spectrum
+.le
+.ls *
+Multiply by another spectrum
+.le
+.ls /
+Divide by another spectrum
+.le
+.le
+.ls g
+Get another spectrum. The current spectrum is replaced by the new spectrum.
+The aperture/line and band are queried is necessary.
+.le
+.ls h
+Measure equivalent widths assuming a gaussian profile with the width
+measured at a specified point.  Note that this is not a gaussian fit (see
+'k' to fit a gaussian)!  The gaussian profile determined here may be
+subtracted with the '-' key.  A second cursor key is requested with one of
+the following values:
+.ls a
+Mark the continuum level at the line center and use the LEFT half width
+at the half flux point.
+.le
+.ls b
+Mark the continuum level at the line center and use the RIGHT half width
+at the half flux point.
+.le
+.ls c
+Mark the continuum level at the line center and use the FULL width
+at the half flux point.
+.le
+.ls l
+Mark a flux level at the line center relative to a normalized continuum
+and use the LEFT width at that flux point.
+.le
+.ls r
+Mark a flux level at the line center relative to a normalized continuum
+and use the RIGHT width at that flux point.
+.le
+.ls k
+Mark a flux level at the line center relative to a normalized continuum
+and use the FULL width at that flux point.
+.le
+.le
+.ls i
+Write the current spectrum out to a new or existing image.  The image
+name is queried and overwriting must be confirmed.
+.le
+.ls j
+Set the value of the nearest pixel to the x cursor to the y cursor position.
+.le
+.ls k + (g, l or v)
+Mark two continuum points and fit a single line profile.  The second key
+selects the type of profile: g for gaussian, l for lorentzian, and v for
+voigt.  Any other second key defaults to gaussian.  The center, continuum
+at the center, core intensity, integrated flux, equivalent width, and FWHMs
+are printed and saved in the log file.  See 'd' for fitting multiple
+profiles and '-' to subtract the fit.
+.le
+.ls l
+Convert to flux per unit wavelength (f-lambda). The spectrum is assumed
+to be flux calibrated in flux per unit frequency (f-nu).  See also 'n'.
+.le
+.ls m
+Compute the mean, RMS, and signal-to-noise over a region marked with two
+x cursor positions.
+.le
+.ls n
+Convert to flux per unit frequency (f-nu). The spectrum is assumed
+to be flux calibrated in flux per unit wavelength (f-lambda).  See also 'l'.
+.le
+.ls o
+Set overplot flag.  The next plot will overplot the current plot.
+Normally this key is immediately followed by one of 'g', '#', '%', '(', or ')'.
+The ":overplot" colon command and overplot parameter option may be
+used to set overplotting to be permanently on.
+.le
+.ls p
+Define a linear wavelength scale.  The user is queried for a starting
+wavelength and an ending wavelength.  If either (though not both)
+are specified as INDEF a dispersion is queried for and used to compute
+an endpoint.  A wavelength scale set this way will be used for
+other spectra which are not dispersion corrected.
+.le
+.ls q
+Quit and go on to next input spectrum.  After the last spectrum exit.
+.le
+.ls r
+Redraw the spectrum with the current windowing.  To redraw the full
+spectrum and cancel any windowing use the 'c' key.
+.le
+.ls s
+Smooth via a boxcar.  The user is prompted for the box size.
+.le
+.ls t
+Fit a function to the spectrum using the ICFIT mode.  Typically
+interactive rejection is used to exclude spectra lines from the fit
+in order to fit a smooth continuum.  A second keystroke
+selects what to do with the fit.
+.ls /
+Normalize by the fit.  When fitting the continuum this continuum
+normalizes the spectrum.
+.le
+.ls -3 -
+Subtract the fit.  When fitting the continuum this continuum subtracts
+the spectrum.
+.le
+.ls f
+Replace the spectrum by the fit.
+.le
+.ls c
+Clean the spectrum by replacing any rejected points by the fit.
+.le
+.ls n
+Do the fitting but leave the spectrum unchanged (a NOP on the spectrum).
+This is useful to play with the spectrum using the capabilities of ICFIT.
+.le
+.ls q
+Quit and don't do any fitting.  The spectrum is not modified.
+.le
+.le
+.ls u
+Adjust the user coordinate scale.  There are three options, 'd' mark a
+position with the cursor and doppler shift it to a specified value,
+'z' mark a position with the cursor and zeropoint shift it to a specified
+value, or 'l' mark two postions and enter two values to define a linear
+(in wavelength) dispersion scale.  The units used for input are those
+currently displayed.  A wavelength scale set this way will be used for
+other spectra which are not dispersion corrected.
+.le
+.ls v
+Toggle to a velocity scale using the position of the cursor as the
+velocity origin and back.
+.le
+.ls w
+Window the graph.  For further help type '?' to the "window:" prompt or
+see help under \fBgtools\fR.  To cancel the windowing use 'a'.
+.le
+.ls x
+"Etch-a-sketch" mode. Straight lines are drawn between successive
+positions of the cursor. Requires 2 cursor settings in x.  The nearest pixels
+are used as the endpoints.  To draw a line between arbitrary y values first
+use 'j' to adjust the endpoints or set the "xydraw" option.
+.le
+.ls y
+Overplot standard star values from a calibration file.
+.le
+.ls z
+Zoom the graph by a factor of 2 in x.
+.le
+.ls (
+In multiaperture spectra go to the spectrum in the preceding image line.
+If there is only one line go to the spectrum in the preceding band.
+.le
+.ls )
+In multiaperture spectra go to the spectrum in the following image line.
+If there is only one line go to the spectrum in the following band.
+.le
+.ls #
+Get a different line in multiaperture spectra or two dimensional images.
+The aperture/line/column is queried.
+.le
+.ls %
+Get a different band in a three dimensional image.
+.le
+.ls $
+Switch between physical pixel coordinates and world (dispersion) coordinates.
+.le
+.ls -4 -
+Subtract the fits generated by the 'd' (deblend), 'k' (single profile fit),
+and 'h' (gaussian of specified width).  The region to be subtracted is
+marked with two cursor positions.
+.le
+.ls -4 ','
+Shift the graph window to the left.
+.le
+.ls .
+Shift the graph window to the right.
+.le
+.ls I
+Force a fatal error interupt to leave the graph.  This is used because
+the normal interupt character is ignored in graphics mode.
+.le
+
+.ls :show
+Page the full output of the previous deblend and equivalent width
+measurements.
+.le
+.ls :log
+Enable logging of measurements to the file specified by the parameter
+\fIsave_file\fR.  When the program is first entered logging is enabled
+(provided a log file is specified).  There is no way to change the file
+name from within the program.
+.le
+.ls :nolog
+Disable logging of measurements.
+.le
+.ls :dispaxis <val>
+Show or change dispersion axis for 2D images.
+.le
+.ls :nsum <val>
+Show or change summing for 2D images.
+.le
+.ls :units <value>
+Change the coordinate units in the plot.  See below for more information.
+.le
+.ls :# <comment>
+Add comment to logfile.
+.le
+.ls Labels:
+.ls :label <label> <format>
+Add a label at the cursor position.
+.le
+.ls :mabove <label> <format>
+Add a tick mark and label above the spectrum at the cursor position.
+.le
+.ls :mbelow <label> <format>
+Add a tick mark and label below the spectrum at the cursor position.
+.le
+
+The label must be quoted if it contains blanks.  A label beginning
+with % (i.e. %.2f) is treated as a format for the x cursor position.
+The optional format is a gtext string (see help on "cursors").
+The labels are not remembered between redraws.
+.le
+
+.ls :auto [yes|no]
+Enable/disable autodraw option
+.le
+.ls :zero [yes|no]
+Enable/disable zero baseline option
+.le
+.ls :xydraw [yes|no]
+Enable/disable xydraw option
+.le
+.ls :hist [yes|no]
+Enable/disable histogram line type option
+.le
+.ls :nosysid [yes|no]
+Enable/disable system ID option
+.le
+.ls :wreset [yes|no]
+Enable/disable window reset for new spectra option
+.le
+.ls :flip [yes|no]
+Enable/disable the flipped coordinates option
+.le
+.ls :overplot [yes|no]
+Enable/disable the permanent overplot option
+.le
+
+
+.ls :/help
+Get help on GTOOLS options.
+.le
+.ls :.help
+Get help on standard cursor mode options
+.le
+.ih
+PROFILE FITTING AND DEBLENDING
+The single profile ('k') and multiple profile deblending ('d') commands fit
+gaussian, lorentzian, and voigt line profiles with a linear background.
+The single profile fit, 'k' key, is a special case of the multiple profile
+fitting designed to be simple to use.  Two cursor positions define the
+region to be fit and a fixed linear continuum.  The second key is used to
+select the type of profile to fit with 'g' for gaussian, 'l' for
+lorentzian, and 'v' for voigt.  Any other second key will default to a
+gaussian profile.  The profile center, peak strength, and width(s) are then
+determined and the results are printed on the status line and in the log
+file.  The meaning of these quantities is described later.  The fit is also
+overplotted and may be subtracted from the spectrum subsequently with
+the '-' key.
+
+The more complex deblending function, 'd' key, defines the fitting region
+and initial linear continuum in the same way with two cursor positions.
+The continuum may be included in the fitting as an option.  The lines to be
+fit are entered with the cursor near the line center ('g' for gaussian, 'l'
+for lorentzian, 'v' for voigt), by typing the wavelengths ('t'), or read
+from a file ('f').  The latter two methods are useful if the wavelengths of
+the lines are known accurately and if fits restricting the absolute or
+relative positions of the lines will be used.  The 't' key is
+restricted to gaussian fits only.
+
+The 'f' key asks for a line list file.  The format of this file has
+one or more columns.  The columns are the wavelength, the peak value
+(relative to the continuum with negative values being absorption),
+the profile type (gaussian, lorentzian, or voigt), and the
+gaussian and/or lorentzian FWHM.  End columns may be missing
+or INDEF values may be used to have values be approximated.
+Below are examples of the file line formats
+
+.nf
+	wavelength
+	wavelength peak
+	wavelength peak (gaussian|lorenzian|voigt)
+	wavelength peak gaussian gfwhm
+	wavelength peak lorentzian lfwhm
+	wavelength peak voigt gfwhm
+	wavelength peak voigt gfwhm lfwhm
+
+	1234.5			<- Wavelength only
+	1234.5 -100		<- Wavelength and peak
+	1234.5 INDEF v		<- Wavelength and profile type
+	1234.5 INDEF g 12	<- Wavelength and gaussian FWHM
+.fi
+
+where peak is the peak value, gfwhm is the gaussian FWHM, and lfwhm is
+the lorentzian FWHM.  This format is the same as used by \fBfitprofs\fR
+and also by \fBartdata.mk1dspec\fR (except in the latter case the
+peak is normalized to a continuum of 1).
+
+There are four queries made to define the set of parameters to be fit or
+constrained.  The positions may be held "fixed" at their input values,
+allowed to shift by a "single" offset from the input values, or "all"
+positions may be fit independently.  The widths may be
+constrained to a "single" value or "all" fit independently.  The linear
+background may be included in the fit or kept fixed at that input using the
+cursor.
+
+As noted above, sometimes the absolute or relative wavelengths of the lines
+are known a priori and this information may be entered by typing the
+wavelengths explicitly using the 't' option or read from a file using the
+'f' option during marking.  In this case one should fix or fit a single
+shift for the position.  The latter may be useful if the lines are known
+but there is a measurable doppler shift.
+
+After the fit, the modeled lines are overplotted.  The line center,
+flux, equivalent width, and full width half maxima are printed on the
+status line for the first line.  The values for the other lines and
+the RMS of the fit may be examined by scrolling the status line
+using the '+', '-', and 'r' keys.  To continue enter 'q'.
+
+The fitting may be repeated with different options until exited with 'q'.
+For each line in the blend the line center, continuum intensity at the
+line center, the core intensity above or below the continuum, the
+FWHM for the gaussian and lorentzian parts, the flux above or below the continuum, and the
+equivalent width are recorded in the log file.  All these parameters
+except the continuum are based on the fitted analytic profiles.
+Thus, even though the fitted region may not extend into the wings of a line
+the equivalent width measurements include the wings in the fitted profile.
+For direct integration of the flux use the 'e' key.
+
+The fitted model may be subtracted from the data (after exiting the
+deblending function) using the '-' (minus) keystroke to delimit the region
+for which the subtraction is to be performed. This allows you to fit a
+portion of a line which may be contaminated by a blend and then subtract
+away the entire line to examine the remaining components.
+
+The fitting uses an interactive algorithm based on the Levenberg-Marquardt
+method.  The iterations attempt to improve the fit by varying the parameters
+along the gradient of improvement in the chi square.  This method requires
+that the initial values for the parameters be close enough that the
+gradient leads to the correct solution rather than an incorrect local
+minimum in the chi square.  The initial values are determined as follows:
+
+.nf
+    1.  If the lines are input from a data file then those values
+	in the file are used.  Missing information is determined
+	as below.
+    2.  The line centers are those specified by the user
+	either by marking with the cursor, entering the wavelenths,
+	for read from a file.
+    3.  The initial widths are obtained by dividing the width of
+	the marked fitting region by the number of lines and then
+	dividing this width by a factor depending on the profile
+	type.
+    4.  The initial peak intensities are the data values at the
+	given line centers with the marked continuum subtracted.
+.fi
+
+Note that each time a new fitting option is specified the initial parameters
+are those from the previous fits.
+Thus the results do depend on the history of previous fits until the
+fitting is exited.
+Within each fit an iteration of parameters is performed as
+described next.
+
+The iteration is more likely to fail if one initially attempts to fit too
+many parameters simultaneously.  A constrained approach to the solution
+is obtained by iterating starting with a few parameters and then adding
+more parameters as the solution approaches the true chi square minimum.
+This is done by using the solutions from the more constrained options
+as the starting point for the less constrained options.  In particular,
+the positions and a single width are fit first with fixed background.
+Then multiple widths and the background are added.
+
+To conclude, here are some general comments.  The most restrictive
+(fixed positions and single width(s)) will give odd results if the initial
+positions are not close to the true centers.  The most general
+(simultaneous positions, widths, and background) can also lead to
+incorrect results by using unphysically different widths to make one
+line very narrow and another very broad in an attempt to fit very
+blended lines.  The algorithm works well when the lines are not
+severely blended and the shapes of the lines are close to the profile
+type.
+.ih
+CENTROID, FLUX, AND EQUIVALENT WIDTH DETERMINATIONS
+There are currently five techniques in SPLOT to measure equivalent widths
+and other line profile parameters. The simplest (conceptually) is by
+integration of the pixel values between two marked pixels. This is
+invoked  with the 'e' keystroke.  The user marks the two edges of the line
+at the continuum.  The measured line center, contiuum value, line flux, and
+equivalent width are given by:
+
+.nf
+	center = sum (w(i) * (I(i)-C(i))**3/2) / sum ((I(i)-C(i))**3/2)
+	continuum = C(midpoint)
+	flux = sum ((I(i)-C(i)) * (w(i2) - w(i1)) / (i2 - i2)
+	eq. width = sum (1 - I(i)/C(i))
+.fi
+
+where w(i) is the wavelength of pixel i,  i1 and i2 are the nearest integer
+pixel limits of the integrated wavelength range, I(i) is the data value of
+pixel i, C(i) is the continuum at pixel (i), and the sum is over the marked
+range of pixels.  The continuum is a linear function between the two points
+marked.  The factor mulitplying the continuum subtracted pixel values
+in the flux calculation is the wavelength interval per pixel so that
+the flux integration is done in wavelength units.  (See the discussion
+at the end of this section concerning flux units).
+
+The most complex method for computing line profile parameters is performed
+by the profile fitting and deblending commands which compute a non-linear
+least-squares fit to the line(s).  These are invoked with the 'd' or 'k'
+keystroke.  These were described in detail previously.
+
+The fourth and fifth methods, selected with the 'h' key, determine the
+equivalent width from a gaussian profile defined by a constant continuum
+level "cont", a core depth "core", and the width of the line "dw" at some
+intermediate level "Iw".
+
+.nf
+     I(w) = cont + core * exp (-0.5*((w-center)/sigma)**2)
+     sigma = dw / 2 / sqrt (2 * ln (core/Iw))
+     fwhm = 2.355 * sigma
+     flux = core * sigma * sqrt (2*pi)
+     eq. width = abs (flux) / cont
+.fi
+
+where w is wavelength.
+
+For ease of use with a large number of lines only one cursor position is
+used to mark the center of the line and one flux level.  Note that both
+the x any y cursor positions are read simultaneously.  From the x cursor
+position the line center and core intensity are determined.  The region around
+the specified line position is searched for a minimum or maximum and a
+parabola is fit to better define the extremum.
+
+The two methods based on the simple gaussian profile model differ in how
+they use the y cursor position and what part of the line is used.  After
+typing 'h' one selects the method and whether to use the left, right, or
+both sides of the line by a second keystroke.  The 'l', 'r', and 'k' keys
+require a continuum level of one.  The y cursor position defines where the
+width of the line is determined.  The 'a', 'b', and 'c' keys use the y
+cursor position to define the continuum and the line width is determined at
+the point half way between the line core and the continuum.  In both cases
+the width at the appropriate level is determined by the interception of the
+y level with the data using linear interpolation between pixels.  The
+one-sided measurements use the half-width on the appropriate side and
+the two-sided measurements use the full-width.
+
+The adopted gaussian line profile is drawn over the spectrum and the
+horizontal and vertical lines show the measured line width and the depth of
+the line center from the continuum.  This model may also be subtracted
+from the spectrum using the '-' key.
+
+The major advantages of these methods are that only a single cursor setting
+(both the x and y positions are used) is required and they are fast.  The
+'l', 'r', and 'k' keys give more flexibility in adjusting the width of the
+gaussian line at the expense or requiring that the spectrum be normalized
+to a unit continuum.  The 'a', 'b', and 'c' keys allow measurements at any
+continuum level at the expense of only using the half flux level to
+determine the gaussian line width.
+
+All these methods print and record in the log file the line center,
+continuum intensity at the line center, the flux, and the equivalent
+width.  For the 'e' key the flux is directly integrated while for the other
+methods the fitted gaussian is integrated.  In addition, for the profile
+fitting methods the core intensity above or below the continuum, and the
+FWHMs are also printed.  A zero value is record for the gaussian or
+lorentzian width if the value is not determined by profile fit.  A brief
+line of data for each measurement is printed on the graphics status line.
+To get the full output and the output from previous measurements use the
+command ":show".  This pages the output on the text output which may
+involve erasing the graphics.
+
+The integrated fluxes for all the methods  are in the same units as the
+intensities and the integration is done in the same units as the
+plotted scale.  It is the user's responsibility to keep track of the flux
+units.  As a caution, if the data is in flux per unit frequency, say
+ergs/cm2/sec/hz, and the dispersion in Angstroms then the integrated
+flux will not be in the usual units but will be A-ergs/cm2/sec/hz.
+For flux in wavelength units, ergs/cm2/sec/A and the dispersion scale
+in Angstroms the integrated flux will be correct; i.e. ergs/cm2/sec.
+
+Note that one can compute integrated flux in pixel units  by using the '$'
+to plot in pixels.  This is appropriate if the pixel values are in
+data numbers or photon counts to get total data number or photons.
+.ih
+ERROR ESTIMATES
+The deblending ('d'), single profile fitting ('k'), and profile integration and
+equivalent width ('e') functions provide error estimates for the measured
+parameters.  This requires a model for the pixel sigmas.  Currently this
+model is based on a Poisson statistics model of the data.  The model
+parameters are a constant gaussian sigma and an "inverse gain" as specified
+by the parameters \fIsigma0\fR and \fIinvgain\fR.  These parameters are
+used to compute the pixel value sigma from the following formula:
+
+.nf
+    sigma**2 = sigma0**2 + invgain * I
+.fi
+
+where I is the pixel value and "**2" means the square of the quantity.
+
+If either the constant sigma or the inverse gain are specified as INDEF or
+with values less than zero then no noise model is applied and no error
+estimates are computed.  Also if the number of error samples is less than
+10 then no error estimates are computed.  Note that for processed spectra
+this noise model will not generally be the same as the detector readout
+noise and gain.  These parameters would need to be estimated in some way
+using the statistics of the spectrum.  The use of an inverse gain rather
+than a direct gain was choosed to allow a value of zero for this
+parameters.  This provides a model with constant uncertainties.
+
+The direct profile integration error estimates are computed by error
+propagation assuming independent pixel sigmas.  Also it is assumed that the
+marked linear background has no errors.  The error estimates are one sigma
+estimates.  They are given in the log output (which may also be view
+without exiting the program using the :show command) below the value to
+which they apply and in parenthesis.
+
+The deblending and profile fit error estimates are computed by Monte-Carlo
+simulation.  The model is fit to the data (using the sigmas) and this model
+is used to describe the noise-free spectrum.  A number of simulations,
+given by the \fInerrsample\fR parameter, are created in which random
+gaussian noise is added to the noise-free spectrum using the pixel
+sigmas from the noise model.  The model fitting is done for each simulation
+and the absolute deviation of each fitted parameter to model parameter is
+recorded.  The error estimate for the each parameter is then the absolute
+deviation containing 68.3% of the parameter estimates.  This corresponds to
+one sigma if the distribution of parameter estimates is gaussian though
+this method does not assume this.
+
+The Monte-Carlo technique automatically includes all effects of
+parameter correlations and does not depend on any approximations.
+However the computation of the errors does take a significant
+amount of time.  The amount of time and the accuracy of the
+error estimates depend on how many simulations are done.  A
+small number of samples (of order 10) is fast but gives crude
+estimates.  A large number (greater than 100) is slow but gives
+good estimates.  A compromise value of 50 is recommended
+for many applications.
+.ih
+UNITS
+The dispersion units capability of \fBsplot\fR allows specifying the
+units with the \fIunits\fR parameter and interactively changing the units
+with the ":units" command.  In addition the 'v' key allows plotting in
+velocity units with the zero point velocity defined by the cursor
+position.
+
+The units are specified by strings having a unit type from the list below
+along with the possible preceding modifiers, "inverse", to select the
+inverse of the unit and "log" to select logarithmic units. For example "log
+angstroms" to plot the logarithm of wavelength in Angstroms and "inv
+microns" to plot inverse microns.  The various identifiers may be
+abbreviated as words but the syntax is not sophisticated enough to
+recognized standard scientific abbreviations except as noted below.
+
+.nf
+	   angstroms - Wavelength in Angstroms
+	  nanometers - Wavelength in nanometers
+	millimicrons - Wavelength in millimicrons
+	     microns - Wavelength in microns
+	 millimeters - Wavelength in millimeters
+	  centimeter - Wavelength in centimeters
+	      meters - Wavelength in meters
+	       hertz - Frequency in hertz (cycles per second)
+	   kilohertz - Frequency in kilohertz
+	   megahertz - Frequency in megahertz
+	    gigahertz - Frequency in gigahertz
+	         m/s - Velocity in meters per second
+	        km/s - Velocity in kilometers per second
+	          ev - Energy in electron volts
+	         kev - Energy in kilo electron volts
+	         mev - Energy in mega electron volts
+
+	          nm - Wavelength in nanometers
+	          mm - Wavelength in millimeters
+	          cm - Wavelength in centimeters
+	           m - Wavelength in meters
+	          Hz - Frequency in hertz (cycles per second)
+	         KHz - Frequency in kilohertz
+	         MHz - Frequency in megahertz
+	         GHz - Frequency in gigahertz
+		  wn - Wave number (inverse centimeters)
+.fi
+
+The velocity units require a trailing value and unit defining the
+velocity zero point.  For example to plot velocity relative to
+a wavelength of 1 micron the unit string would be:
+
+.nf
+	km/s 1 micron
+.fi
+
+Some additional examples of units strings are:
+
+.nf
+	milliang
+	megahertz
+	inv mic
+	log hertz
+	m/s 3 inv mic
+.fi
+.ih
+EXAMPLES
+This task has a very large number of commands and capabilities which
+are interactive and  graphical.  Therefore it these examples are
+fairly superficial.  The user is encouraged to simply experiment with
+the task.  To get some help use the '?' or '/' keys.
+
+1.  To plot a single spectrum and record any measurements in the file
+'ngc7662':
+
+	cl> splot spectrum save_file=ngc7662
+
+2.  To force all plots to display zero as the minimum y value:
+
+	cl> splot spectrum options="auto, zero"
+
+Note that the options auto and zero can be abbreviated to one character.
+
+3.  To successively display graphs for a set of spectra with the wavelength
+limits set to 3000 to 6000 angstroms:
+
+	cl> splot spec* xmin=3000 xmax=6000
+
+4.  To make batch plots create a file containing the simple cursor command
+
+	0 0 0 q
+
+or an empty file and then execute one of the following:
+
+.nf
+	cl> splot spec* graphics=stdplot cursor=curfile
+	cl> set stdvdm=splot.mc
+	cl> splot spec* graphics=stdvdm cursor=curfile
+	cl> splot spec* cursor=curfile >G splot.mc
+.fi
+
+The first example sends the plots to the standard plot device specified
+by the environment variable "stdplot".  The next example sends the plots
+to the standard virtual display metacode file specified by the
+environment variable "stdvdm".  The last example redirects the
+standard graphics to the metacode file splot.mc.  To spool the metacode
+file the tasks \fBstdplot\fR and \fBgkimosaic\fR may be used.
+For a large number of plots \fBgkimosaic\fR is prefered since it places
+many plots on one page instead of one plot per page.
+The other GKI tasks in the \fBplot\fR package may be used to examine
+the contents of a metacode file.  A simple script call \fBbplot\fR is provided
+which has the default cursor file given above and default device of "stdplot".
+
+5.  More complex plots may be produced both interactively using the
+'=' key or the ":.snap"  or ":.write" commands or by preparing a script
+of cursor commands.
+.ih
+REVISIONS
+.ls SPLOT V2.11
+The profile fitting and deblending was expanded to include lorentzian
+and voigt profiles.  A new parameter controls the number of Monte-Carlo
+samples used in the error estimates.
+
+Added colon commands for labeling.
+.le
+.ls SPLOT V2.10.3
+The 'u' key now allows three ways to adjust the dispersion scale.  The
+old method of setting a linear dispersion scale is retained as well
+as adding a doppler and zeropoint adjustment.  The coordinates are
+input in the currently displayed units.
+
+If a wavelength scale is set with either 'p' or 'u' then any other
+spectra which are not dispersion corrected will adopt this wavelength
+scale.
+
+The '(' and ')' keys cycle through bands if there is only one spectrum.
+
+A new option, "flip", has been added to the options parameter to select
+that the spectra are plotted in decreasing wavelength.
+
+A new options "overplot" has been added to the options parameters and
+colon commands to permanently set overplotting.  This allows quickly
+overplotting many spectra.
+
+This task will now write out the current display units in the "units_display"
+WCS attribute.  The default task units have been changed to "" to allow
+picking up the "units_display" units if defined.
+
+The deblending and gaussian fitting code now subsamples the profile by
+a factor of 3 and fits the data pixels to the sum of the three
+subsamples.  This accounts for finite sampling of the data.
+
+Error estimates are provided for the deblending ('d'), gaussian fitting
+('k'), and profile integration ('e') results.
+.le
+.ls SPLOT V2.10
+This is a new version with a significant number of changes.  In addition to
+the task changes the other general changes to the spectroscopy packages
+also apply.  In particular, long slit spectra and spectra with nonlinear
+dispersion functions may be used with this task.  The image header or
+package dispaxis and nsum parameters allow automatically extracting spectra
+from 2D image.  The task parameters have been modified primarily to obtain
+the desired initial graph without needing to do it interactively.  In
+particular, the new band parameter selects the band in 3D images, the units
+parameter selects the dispersion units, and the new histogram, nosysid, and
+xydraw options select histogram line type, whether to include a system ID
+banner, and allow editing a spectrum using different endpoint criteria.
+
+Because nearly every key is used there has been some shuffling,
+consolidating, or elimination of keys.  One needs to check the run time '?'
+help or the help to determine the key changes.
+
+Deblending may now use any number of components and simultaneous fitting of
+a linear background.  A new simplified version of Gaussian fitting for a
+single line has been added in the 'k' key.  The old 'k', 'h', and 'v'
+equivalent width commands are all part of the single 'h' command using a
+second key to select a specific option.  The Gaussian line model from these
+modes may now be subtracted from the spectrum in the same way as the
+Gaussian fitting.  The one-sided options, in particular, are interesting in
+this regard as a new capability.
+
+The arithmetic functions between two spectra are now done in wavelength
+with resampling to a common dispersion done automatically.  The 't' key now
+provides for the full power of the ICFIT package to be used on a spectrum
+for continuum normalization, subtraction, or line and cosmic ray removal.
+The 'x' editing key may now use the nearest pixel values rather than only
+the y cursor position to replace regions by straight line segments.  The
+mode is selected by the task option parameter "xydraw".
+
+Control over the graph window (plotting limits) is better integrated so
+that redrawing, zooming, shifting, and the GTOOLS window commands all work
+well together.  The new 'c' key resets the window to the full spectrum
+allowing the 'r' redraw key to redraw the current window to clean up
+overplots from the Gaussian fits or spectrum editing.
+
+The dispersion units may now be selected and changed to be from hertz to
+Mev and the log or inverse (for wave numbers) of units taken.  As part of
+the units package the 'v' key or colon commands may be used to plot in
+velocity relative to some origin.  The $ key now easily toggles between the
+dispersion units (whatever they may be) and pixels coordinates.
+
+Selection of spectra has become more complex with multiaperture and long
+slit spectra.  New keys allow selecting apertures, lines, columns, and
+bands as well as quickly scrolling through the lines in multiaperture
+spectra.  Overplotting is also more general and consistent with other tasks
+by using the 'o' key to toggle the next plot to be overplotted.  Overplots,
+including those of the Gaussian line models, are now done in a different
+line type.
+
+There are new colon commands to change the dispersion axis and summing
+parameters for 2D image, to toggle logging, and also to put comments
+into the log file.  All the options may also be set with colon commands.
+.le
+.ih
+SEE ALSO
+bplot, gtools, icfit, standard, package, specplot, graph, implot, fitprofs
+.endhelp
diff --git a/noao/onedspec/doc/standard.hlp b/noao/onedspec/doc/standard.hlp
new file mode 100644
index 00000000..d0c84aef
--- /dev/null
+++ b/noao/onedspec/doc/standard.hlp
@@ -0,0 +1,551 @@
+.help standard Jan00 noao.onedspec
+.ih
+NAME
+standard -- Add standard stars to sensitivity file
+.ih
+USAGE
+standard input [records] output
+.ih
+PARAMETERS
+.ls input
+List of input standard star spectra or root names if using the record number
+extension format.  All spectra of the same aperture must be of the same
+standard star.  In beam switch mode or when the same star parameter is set
+all spectra must be of the same standard star regardless of aperture number.
+Normally the spectra will not be extinction corrected but if they are
+then the extinction file should also be given and the same extinction
+file should be used with \fBsensfunc\fR.
+.le
+.ls records (imred.irs and imred.iids only)
+List of records or ranges of records to be appended to the input spectra
+names when using record number extension format.  The
+syntax of this list is comma separated record numbers or ranges of record
+numbers.  A range consists of two numbers separated by a hyphen.
+A null list may be used if no record number extensions are
+desired.  This is a positional query parameter only if the record
+format is specified.
+.le
+.ls output
+The name of a text file which will contain the output from \fBstandard\fR.
+Each execution of \fBstandard\fR appends to this file information about the
+standard stars, the calibration bandpasses, and observed counts (see the
+DESCRIPTION section for more details).  The output must be explicitly
+deleted by the user if the filename is to be reused.
+.le
+.ls samestar = yes
+Is the same star in all apertures?  If set to no then each aperture may
+contain a different standard star.  The standard star name is queried
+each time a new aperture is encountered.  Note that this occurs only
+once per aperture and multiple spectra with the same aperture number
+must be of the same star.  If set to yes the standard star name is only
+queried once.  When in beam switch mode this parameter is ignored since
+all apertures must contain the same star.
+.le
+.ls beam_switch = no
+Beam switch the spectra?  If yes then a beam switch mode is used for the spectra
+in which successive pairs of object and sky observations from the same aperture
+are sky subtracted.  This requires that the object type flag OFLAG be present
+and that the spectra are appropriately ordered.  All object observations must be
+of the same standard star and the \fIsamestar\fR parameter is ignored.
+.le
+.ls apertures = ""
+List of apertures to be selected from the input list of spectra.  If no list
+is specified then all apertures are selected.  The syntax is the same as the
+record number extensions.
+.le
+.ls bandwidth = INDEF, bandsep = INDEF
+Bandpass widths and separations in wavelength units.  If INDEF then the
+default bandpasses are those given in the standard star calibration
+file.  If values for these parameters are specified then a default set
+of bandpasses of equal width and separation are defined over the range
+of the input spectrum.  In both cases the default bandpasses can be
+changed interactively if desired.
+.le
+.ls fnuzero = 3.68e-20
+The absolute flux per unit frequency at an AB magnitude of zero.  This is used
+to convert the calibration  AB magnitudes to absolute flux by the formula
+
+.nf
+    f_nu = fnuzero * 10. ** (-0.4 * m_AB)
+.fi
+
+The flux units are also determined by this parameter.  However, the
+frequency to wavelength interval conversion assumes frequency in hertz.
+The default value is based on a calibration of Vega at 5556 Angstroms of
+3.52e-20 ergs/cm2/s/Hz for an AB magnitude of 0.0336.  This default value
+is that used in earlier versions of this task which did not allow the
+user to change this calibration.
+.le
+.ls extinction = <no default>
+Extinction file used to make second order extinction corrections across
+the bandpasses.  The default value is  redirected to the package
+parameter of the same name.  See \fBlcalib\fR for a list of standard
+extinction files.  Normally the input spectra will not be extinction
+corrected.  But if they are this file will be used to remove the
+extinction and then the same file should be specified in \fBsensfunc\fR.
+Note that one can choose to use a null extinction file in both.
+.le
+.ls caldir = ")_.caldir"
+Calibration directory containing standard star data.  The
+default value of ")_.caldir" means to use the package parameter "caldir".
+A list of standard calibration directories may be obtained by listing the
+file "onedstds$README"; for example:
+
+.nf
+    cl> page onedstds$README
+.fi
+
+The user may copy or create their own calibration files and specify the
+directory.  The directory "" refers to the current working directory.  The
+standard calibration directory for blackbody curves is
+"onedstds$blackbody/".
+.le
+.ls observatory = ")_.observatory"
+Observatory at which the spectra were obtained if not specified in the
+image header by the keyword OBSERVAT.  The default is a redirection to look
+in the parameters for the parent package for a value.  The observatory may
+be one of the observatories in the observatory database, "observatory" to
+select the observatory defined by the environment variable "observatory" or
+the parameter \fBobservatory.observatory\fR, or "obspars" to select the
+current parameters set in the \fBobservatory\fR task.  See help for
+\fBobservatory\fR for additional information.
+.le
+.ls interact = no
+If set to no, then the default wavelength set (either that from the star
+calibration file or the set given by the \fIbandwidth\fR and \fIbandsep\fR
+parameters) is used to select wavelength points along the spectrum where the
+sensitivity is measured. If set to yes, the spectra may be plotted
+and the bandpasses adjusted.
+.le
+.ls graphics = "stdgraph"
+Graphics output device for use with the interactive mode.  Normally this is
+the user's graphics terminal.
+.le
+.ls cursor = ""
+Graphics cursor input for use with the interactive mode.  When null the
+standard graphics cursor is used otherwise the specified file is used.
+.le
+.ls star_name
+The name of the star observed in the current series of spectra.  Calibration
+data for the star must be in the specified calibration directory "caldir".
+This is normally a interactive query parameter and should not be specified on
+the command line unless all spectra are of the same standard star.
+.le
+
+The following three queried parameters apply if the selected calibration
+file is for a blackbody.
+.ls mag
+The magnitude of the observed star in the band given by the
+\fImagband\fR parameter.  If the magnitude is not in the same band as
+the blackbody calibration file then the magnitude may be converted to
+the calibration band provided the "params.dat" file containing relative
+magnitudes between the two bands is in the calibration directory
+.le
+.ls magband
+The standard band name for the input magnitude.  This should generally
+be the same band as the blackbody calibration file.  If it is
+not the magnitude will be converted to the calibration band.
+.le
+.ls teff
+The effective temperature (deg K) or the spectral type of the star being
+calibrated.  If a spectral type is specified a "params.dat" file must exist
+in the calibration directory.  The spectral types are specified in the same
+form as in the "params.dat" file.  For the standard blackbody calibration
+directory the spectral types are specified as A0I, A0III, or A0V, where A
+can be any letter OBAFGKM, the single digit subclass is between 0 and 9,
+and the luminousity class is one of I, III, or V.  If no luminousity class
+is given it defaults to dwarf.
+.le
+
+The following two parameters are queried if the image does not contain
+the information.
+.ls airmass, exptime
+If the airmass and exposure time are not in the header nor can they be
+determined from other keywords in the header then these query parameters
+are used to request the airmass and exposure time.  The values are updated
+in the image.
+.le
+
+The following parameter is for the task to make queries.
+.ls answer
+Interactive query parameter.
+.le
+.ih
+CURSOR KEYS
+.nf
+?  Display help page
+a  Add a new band by marking the endpoints
+d  Delete band nearest the cursor in wavelength
+r  Redraw current plot
+q  Quit with current bandpass definitions
+w  Window plot  (follow with '?' for help)
+I  Interrupt task immediately
+
+:show	Show current bandpass data
+.fi
+.ih
+DESCRIPTION
+Observations of standard stars are integrated over calibration bandpasses
+and written to an output file along with the associated calibration
+fluxes.  The fluxes are obtained from tabulated standard star calibration
+files or a model flux distribution (currently just a blackbody) based on
+the magnitude and spectral type of the star.  The output data is used by
+the task \fBsensfunc\fR to determine the detector sensitivity function and
+possibly the extinction.  The spectra are required to be dispersion
+corrected.  The input spectra may be in either "onedspec" or "echelle"
+format and may have many different observation apertures.  The spectra may
+also be beam switched and use the a record number extension format.
+
+The input spectra are specified by a list of names or root names if using
+the record number extension format.  In the latter case each name in the
+list has each of the specified record numbers appended.  A subset of the
+input spectra may be selected by their aperture numbers using the parameter
+\fIapertures\fR.  The spectrum name, aperture number, and title are printed
+to the standard output.  The airmass is required but if absent from the image
+header it may be computed from the observation header parameters and the
+latitude task parameter (normally obtained from the \fBobservatory\fR task).
+If the airmass cannot be computed, due to missing keywords, then a
+query is made for the airmass.  The airmass is then updated in the header.
+
+The name of the standard star or blackbody curve is obtained by querying
+the user.  If the parameter \fIsamestar\fR is yes or beam switch mode is
+selected then all spectra are assumed to be of the same standard star and
+the query is made once.  If the parameter is no then a query is made for
+each aperture.  This allows each aperture to contain a different standard
+star.  Note however that multiple observations with the same aperture
+number must be of the same standard star.
+
+The standard star name is either the name of an actual standard star or of
+a blackbody calibration.  The latter generally have a star name consisting
+of just the standard bandpass identifier.  If the standard star name is not
+recognized a menu of the available standard stars in the calibration
+directory, the file "standards.men", is printed and then the query is
+repeated.  Thus, to get a list you can type ?  or help.
+
+The standard star names must map to a file containing tabulated
+calibration data.  The calibration filename is formed from the star
+name with blanks, "+", and "-" removed, converted to lower case, and
+the extension ".dat" added.  This name is appended to a calibration
+directory, so the directory name must have an appropriate directory
+delimiter such as "$" or "/".  Generally one of the system calibration
+directories is used but one may copy and modify or create new
+calibration files in a personal directory.  For the current working
+directory the calibration directory is either null or "./".
+
+The calibration files may include comment parameter information consisting
+of the comment character '#', a parameter name, and the parameter value.
+These elements are separated by whitespace.  Any other comment where the
+first word does not match one of the allowed parameter names is ignored by
+the program.  The parameter names are "type" identifying the type of
+calibration file, "units" identifying wavelength units, "band" identifying
+the band for magnitudes, and "weff" identifying the effective wavelength of
+the band.
+
+There are two types of standard star calibration files as described
+below.
+
+.ls STANDARD STAR CALIBRATION FILES
+This type of file is any file that does not contain the parameter "type"
+with a value of "blackbody".  The only other parameter used by this type of
+calibration file is the "units" parameter for the wavelength units.  If the
+units are not specified then the wavelengths default to Angstroms.  All
+older calibration files will have no parameter information so they are
+interpreted as standard star calibration files with wavelengths in
+Angstroms.
+
+The calibration files consist of lines with wavelengths, calibration
+magnitudes, and bandpass widths.  The magnitudes are m_AB defined as
+
+.nf
+    m_AB(star) = -2.5 * log10 (f_nu) - 48.60
+.fi
+
+where f_nu is in erg/cm^2/s/Hz.  The m_AB calibration magnitudes
+are converted to absolute flux per unit frequency using the
+parameter \fIfnuzero\fR defined by
+
+.nf
+    f_nu = fnuzero * 10. ** (-0.4 * m_AB)
+.fi
+
+Thus, \fIfnuzero\fR is the flux at m_AB of zero.  The flux units are
+determined by this number.  The default value was chosen such that Vega
+at 5556 Angstroms has an AB magnitude of 0.0336 and a flux of 3.52e-20
+ergs/cm2/s/Hz.  This is the same value that was used by all previous
+versions of this task.
+.le
+
+.ls BLACKBODY CALIBRATION FILES
+This type of file has the comment parameter "type" with a value of
+"blackbody".  It must also include the "band" and "weff"
+comment parameters.  If no "units" comment parameter is given then
+the default units are Angstroms.
+
+The rest of the file consists of lines with wavelengths, m_AB of a zero
+magnitude star (in that band magnitude system), and the bandpass widths.
+The m_AB are defined as described previously.  Normally all the m_AB values
+will be the same though it is possible to adjust them to produce a
+departure from a pure blackbody flux distribution.
+
+The actual m_AB calibration magnitudes for the star are obtained by
+the relation
+
+.nf
+    m_AB(star) = mag + m_AB(m=0) -
+        2.5 * log10 (B(weff,teff)/B(w,teff))
+.fi
+
+where m is the magnitude of the star in the calibration band, m_AB(m=0) is
+the calibration value in the calibration file representing the magnitude of
+a m=0 star (basically the m_AB of Vega), weff is the effective wavelength
+for the calibration file, and teff is the effective temperature of the
+star.  The function B(w,T) is the blackbody function in f_nu that provides
+the shape of the calibration.  Note how the normalization is such that at
+weff the last term is zero and m_AB(star) = m + m_AB(m=0).
+
+The m_AB(star) computed using the calibration values and the blackbody
+function are then in the same units and form as for the standard
+star files.  The conversion to f_nu and the remaining processing
+proceeds in the same way as for standard star calibration data.
+
+The parameters \Imag\fR and \fIteff\fR are specified by the user for each
+star as described in the section BLACKBODY PARAMETERS.  These parameters
+are queried by the task for each star (unless forced to a value on the
+command line).
+.le
+
+The beam switch mode is selected with the \fIbeam_switch\fR parameter.
+This mode requires that all apertures are of the same star, the header
+keyword OFLAG be present to identify object and sky spectra, and that
+the sequence of spectra specified are paired such that if an object
+spectrum is encountered first the next spectrum for that aperture
+(spectra from other apertures may appear in between) is a sky spectrum
+or the reverse.  These restrictions are not fundamental but are made so
+that this mode behaves the same as with the previous version of this
+task.  The sky spectrum is subtracted from the object spectrum and the
+result is then used in generating the observed intensities in the calibration
+bandpasses.
+
+If the spectra have been extinction corrected (EX-FLAG = 0) the
+extinction correction is removed.  The specified extinction file is
+used for this operation and so must be the same as that used when the
+extinction correction was made.  The airmass is also required in this step
+and, if needed to compute the airmass, the observatory specified in the
+image or observatory parameter is used.  The
+treatment of extinction in this task is subtle.  The aim of this task
+is to produce observed integrated instrumental intensities without
+extinction correction.  Thus, the extinction correction is removed from
+extinction corrected spectra.  However, a correction is made for an
+extinction gradient across the bandpasses.  This is done by applying an
+extinction correction, integrating across the bandpass, and then
+correcting the integrated intensity for the extinction at the center of
+the bandpass.  An alternative way to look at this is that the integral
+is weighted by the ratio of the extinction correction at each pixel to
+the extinction correction at the center of the bandpass.  This
+correction or weighting is why the extinction file and latitude are
+parameters in this task even though for nonextinction corrected spectra
+they appear not to be needed.
+
+The observed instrumental intensities are integrated within a set of
+bandpasses by summing the pixels using partial pixels at the bandpass
+edges.  Initial bandpasses are defined in one of two ways.  A set of
+evenly spaced bandpasses of constant width covering the range of the
+input spectrum may be specified using the parameters \fIbandwidth\fR
+and \fIbandsep\fR in the same units as the spectrum dispersion.  If
+these parameters have the value INDEF then the bandpasses from the
+calibration file which are entirely within the spectrum are selected.
+Generally these bandpasses are the actual measured bandpasses though
+one is free to make calibration files using estimated points.  The
+calibration bandpasses are preferable because they have been directly
+measured and they have been placed to avoid troubles with spectral
+lines.  However, when the coverage or resolution is such that these
+bandpasses do not allow a good determination of the instrumental
+response the evenly spaced bandpasses may be needed.  The calibration
+fluxes are linearly interpolated (or extrapolated) from the calibration
+data points to the defined bandpasses.
+
+Each spectrum adds a line to the output file containing the spectrum image
+name, the sky spectrum image name if beam switching, the aperture or beam
+number, the number of points in the spectrum, the exposure time, airmass,
+wavelength range, and title.  If the airmass is not found in the image
+header it is computed using the latitude parameter and observation
+information from the header.  If the airmass cannot be computed, due to
+missing keywords, then a query is made for the airmass.
+
+Following the spectrum information, calibration data is added for each
+bandpass.  The bandpass wavelength, absolute flux (per Angstrom),
+bandpass width, and observed instrumental intensity in the bandpass are
+added to the output file.  As discussed above, the observed intensity
+does not include an extinction term but does apply a small correction
+or weighting for the variation of the extinction across the bandpass.
+
+The setting and editing of the bandpasses may be performed
+interactively if the \fIinteract\fR flag is set.  In this case the user
+is queried for each spectrum.  The answers to this query may be "no" or
+"yes" to skip editing or edit the bandpasses for this spectrum, "NO" or
+"YES" to skip or not skip editing all spectra of the same aperture with
+no further queries for this aperture, and "NO!" or "YES!" to skip
+editing or edit all spectra with no further queries.
+
+When editing the bandpasses a graph of the spectrum is made with the
+bandpasses plotted at the computed intensity per pixel.  The cursor and
+colon commands available are summarized in the section CURSOR KEYS.
+Basically bandpasses may be added or deleted and the current bandpass
+data may be examined.  Additional keys allow the usual windowing and
+cursor mode operations.  When satisfied with the bandpasses exit with
+'q'.  The edited bandpasses for that aperture remain in effect until
+changed again by the user.  Thus if there are many spectra from the
+same aperture one may reply with "NO" to queries for the next spectra
+to accept the current bandpasses for all other spectra of the same
+aperture.
+
+BLACKBODY PARAMETERS
+
+When a blackbody calibration is selected (the calibration file selected by
+the \fIstar_name\fR parameter has "# type blackbody") there are two
+quantities needed to scale the blackbody to the observation.  These are the
+magnitude of the star in the same band as the observation and the effective
+temperature.  The magnitude is used for the flux scaling and the effective
+temperature for the shape of the flux distribution.  The values are
+obtained or derived from the user specified parameters \fImag\fR,
+\fImagband\fR, and \fIteff\fR.  This section describes how the the
+values are derived from other parameters using the data file "params.dat"
+in the calibration directory.
+
+The effective temperature in degrees Kelvin may be specified directly or it
+may be derived from a spectral type for the star.  In the latter case the
+file "params.dat" is searched for the effective temperature.  The file
+consists of lines with the first value being the spectral type and the
+second the effective temperature.  Other columns are described later.  The
+spectral type can be any string without whitespace that matches what is in
+the file.  However, the program finds the last spectral type that matches
+the first two characters when there is no complete match.  This scheme is
+intended for the case where the spectral types are of the form A0I, A0III,
+or A0V, where A can be any spectral type letter OBAFGKM, the single digit
+subtype is between 0 and 9, and the luminousity class is one of I, III, or
+V.  The two character match selects the last spectral type independent of
+the luminosity class.  The standard file "onedstds$blackbody/params.dat"
+uses these spectral type identifiers with the dwarf class acting as the
+default.
+
+The magnitude band is specified along with the input magnitude.  If the
+band is the same as the calibration band given in the calibration file then
+no further transformation is required.  However if the magnitude is
+specified in a different band, a conversion is performed using information
+from the "params.dat" file based on the spectral type of the star.
+
+When an effective temperature is specified rather and a spectral type then
+the nearest tabulated temperature for the spectral types that have "V" as
+the third character is used.  For the standard spectral type designations
+this means that when an effective temperature is specified the dwarf
+spectral type is used for the magnitude transformation.
+
+As mentioned previously, the "params.dat" data file has additional columns
+following the spectral type and effective temperature.  These columns are
+relative magnitudes in various bands.  The standard file has V magnitudes
+of zero so in this case the columns are also the X-V colors (where X is the
+appropriate magnitude).  Given the spectral type the relative magnitudes
+for the calibration band, m_1, and the input magnitude band, m_2, are found
+and the calibration magnitude for the star is given by
+
+.nf
+    m_calibration = m_input + m_1 - m_2
+.fi
+
+If one of the magnitudes is missing,  given as "INDEF" because the
+transformation is not available for the spectral type, the last spectral
+type matching the first two characters which does specify the two
+magnitudes will be used.  For example if there is no information for a
+B3III star for a M-J color then the spectral type B3V might be used.
+
+In order for the program to determine the bands for each column in the data
+file there must be a comment before the data with the column names.  It must
+begin with "# Type Teff" and then be followed by the same band identifiers
+used in the blackbody calibration files and as specified by the
+\fImagband\fR parameter.  Any amount whitespace (space or tab) is used to
+separate the various fields in the comment and in the fields of the table.
+For example the file might have the comment
+
+.nf
+    # Type    Teff     V      J      H      K      L   Lprime    M
+.fi
+
+identifying the third column of the file as the V magnitude and the
+ninth file as the M magnitude.
+.ih
+EXAMPLES
+1.  To compile observations of three standard stars using a beam
+switched instrument like the IIDS:
+
+.nf
+    cl> standard.recformat=yes
+    cl> standard nite1 1001-1008 std beam_switch+ interact-
+    [nite1.1001][0]: HZ 44 - Night 1
+    [nite1.1004][0]: HZ 44 - Night 1
+    [nite1.1005][0]: HZ 44 - Night 1
+    [nite1.1008][0]: HZ 44 - Night 1
+    Star name in calibration list: hz 44
+    cl> standard nite1 1009-1016 std beam_switch+ interact-
+    	...
+    cl> standard nite1 1017-1024 std beam_switch+ interact-
+    	...
+.fi
+
+This will create a file "std" which will contain sensitivity measurements
+from the beam-switched observations of the three standard stars given.
+Note that \fBstandard\fR is run separately for each standard star.
+
+The spectra will be from the images: nite1.1001, nite.1002 ... nite1.1024,
+and the default calibration file, "onedstds$irscal.dat" will be used.
+
+2.  For echelle spectra all apertures, the orders, are of the same star and
+so the samestar parameter is set.  Usually the resolution is much higher than
+the calibration data so in order to get sufficient coverage bandpasses must
+be interpolated from the calibration data.  Therefore the evenly spaced
+bandpasses are used.
+
+.nf
+    cl> standard.recformat=no
+    cl> standard.samestar=yes
+    cl> standard ech001.ec std bandwidth=10 bandsep=15
+    [ech001.ec][0]: Feige 110
+    Star name in calibration list: feige 110
+    [ech001.ec][0]: Edit bandpasses? (no|yes|NO|YES|NO!|YES!): yes
+    [ech001.ec][1]: Edit bandpasses? (no|yes|NO|YES|NO!|YES!): yes
+    [ech001.ec][2]: Edit bandpasses? (no|yes|NO|YES|NO!|YES!): NO!
+.fi
+
+3. To use a blackbody infrared calibration where the V magnitude of
+the star is known.
+
+.nf
+    cl> standard std1.ms std caldir=onedstds$blackbody/
+    std1.ms(1): Standard Star
+    Star name in calibration list: J
+    Magnitude of star: 10.3
+    Magnitude type (|V|J|H|K|L|Lprime|M|): V
+    Effective temperature or spectral type: B3III
+    WARNING: Effective temperature for B3III not found - using B3V
+    Blackbody: V = 10.30, J = 10.32, Teff = 19000
+    std1[1]: Edit bandpasses? (no|yes|NO|YES|NO!|YES!) (yes): 
+.fi
+
+Note the warning message and the confirmation information.
+.ih
+REVISIONS
+.ls STANDARD V2.10.4
+The calibration files can be defined to compute blackbody values.
+.le
+.ls STANDARD V2.10.3
+A query for the airmass and exposure time is now made if the information
+is not in the header and cannot be computed from other header keywords.
+.le
+.ls STANDARD V2.10
+Giving an unrecognized standard star name will page a list of standard
+stars available in the calibration directory and then repeat the
+query.
+.le
+.ih
+SEE ALSO
+observatory, lcalib, sensfunc
+.endhelp
diff --git a/noao/onedspec/doc/sys/1and2dspec.hlp b/noao/onedspec/doc/sys/1and2dspec.hlp
new file mode 100644
index 00000000..01f01763
--- /dev/null
+++ b/noao/onedspec/doc/sys/1and2dspec.hlp
@@ -0,0 +1,66 @@
+.help onedspec (Oct84) "Spectral Reductions"
+.ce
+Relationship Between Onedspec and Twodspec
+.ce
+Discussion
+.ce
+October 24, 1984
+.sp 3
+Two types of interactions between one dimensional and two dimensional
+spectra may be defined:
+
+.ls (1)
+Perform a one dimensional operation on the average or sum of a set
+of lines in a two dimensional image.
+.le
+.ls (2)
+Perform a one dimensional operation successively on a set of lines
+in a two dimensional image.
+.le
+
+The two functions might be combined as:
+
+.ls (3)
+Perform a one dimensional operation on the average or sum of a set
+of lines in a two dimensional image and apply the one dimensional
+result successively on a set of lines in a two dimensional image.
+.le
+
+Examples of this are dispersion solutions and flux calibrations for
+longslit spectra.
+
+     Some choices for implementation are:
+
+.ls (1)
+Use a 2-D to 1-D operator to create a 1-D spectrum by averaging or summing
+lines.
+.le
+.ls (2)
+Use an apply a 1-D arithmetic correction to a 2-D image operator.
+Alternatively, expand a 1-D correction to a 2-D correction.
+.le
+.ls (3)
+Convert the 2-D image to a group of 1-D images and provide the 1-D operators
+with the ability to perform averaging or summation.
+.le
+.ls (4)
+To perform a one dimensional operation successively on
+a set of lines first convert the two dimensional image into a group
+of one dimensional spectra.  Perform the 1-D operation on the desired
+elements of the group and then reconstruct the 2-D image from the group
+of 1-D images.
+.le
+.ls (5)
+Built separate operators for 2-D images using the 1-D subroutines.
+.le
+.ls (6)
+Provide the ability in the 1-D operators to perform the desired 2-D
+operations directly.
+.le
+
+     Options (1) and (2) are essentially what is done on the IPPS.  Option (5)
+would lessen the amount of development but increase the number of tasks
+to be written.  I find option (6) desirable because of its
+increased generality but it would require a
+further definition of the data structures allowed and the syntax.
+.endhelp
diff --git a/noao/onedspec/doc/sys/Headers.hlp b/noao/onedspec/doc/sys/Headers.hlp
new file mode 100644
index 00000000..9bb394b7
--- /dev/null
+++ b/noao/onedspec/doc/sys/Headers.hlp
@@ -0,0 +1,189 @@
+.LP
+.SH
+Image Header Parameters
+.PP
+The ONEDSPEC package uses the extended image header to extract
+information required to direct processing of spectra. If the
+header information were to be ignored, the user would need to
+enter observing parameters to the program at the risk of
+typographical errors, and with the burden of supplying the
+data. For more than a few spectra this is a tedious job,
+and the image header information provides the means to eliminate
+almost all the effort and streamline the processing.
+.PP
+However, this requires that the header information be present,
+correct, and in a recognizable format. To meet the goal of
+providing a functional package in May 1985, the first iteration
+of the header format was to simply adopt the IIDS/IRS headers.
+This allowed for processing of the data which would be first
+used heavily on the system, but would need to be augmented at
+a later date. The header elements may be present in any order,
+but must be in a FITS-like format and have the following names
+and formats for the value fields:
+.sp 1
+.TS
+l c l
+l l l.
+Parameter	Value Type	Definition
+
+HA	SX	Hour angle (+ for west, - for east)
+RA	SX	Right Ascension
+DEC	SX	Declination
+UT	SX	Universal time
+ST	SX	Sidereal time
+AIRMASS	R	Observing airmass  (effective)
+W0	R	Wavelength at center of pixel 1
+WPC	R	Pixel-to-pixel wavelength difference
+NP1	I	Index to first pixel containing good data (actually first-1)
+NP2	I	Index to last pixel containing good data (last really)
+EXPOSURE	I	Exposure time in seconds (ITIME is an accepted alias)
+BEAM-NUM	I	Instrument aperture used for this data (0-49)
+SMODE	I	Number of apertures in instrument - 1 (IIDS only)
+OFLAG	I	Object or sky flag (0=sky, 1=object)
+DF-FLAG	I	Dispersion fit made on this spectrum (I=nr coefs in fit)
+SM-FLAG	I	Smoothing operation performed on this spectrum (I=box size)
+QF-FLAG	I	Flat field fit performed on this spectrum (0=yes)
+DC-FLAG	I	Spectrum has been dispersion corrected (0=linear, 1=logarithmic)
+QD-FLAG	I	Spectrum has been flat fielded (0=yes)
+EX-FLAG	I	Spectrum has been extinction corrected (0=yes)
+BS-FLAG	I	Spectrum is derived from a beam-switch operation (0=yes)
+CA-FLAG	I	Spectrum has been calibrated to a flux scale (0=yes)
+CO-FLAG	I	Spectrum has been coincidence corrected (0=yes)
+DF1	I	If DF-FLAG is set, then coefficients DF1-DFn (n <= 25) exist
+.TE
+.PP
+The values for the parameters follow the guidelines adopted for
+FITS format tapes. All keywords occupy 8 columns and contain
+trailing blanks. Column 9 is an "=" followed by a space. The value field
+begins in column 11. Comments to the parameter may follow a "/" after
+the value field.  The value type code is as follows:
+.RS
+.IP SX
+This is a sexagesimal string of the form '12:34:56   ' where the first
+quote appears in column 11 and the last in column 30.
+.IP R
+This is a floating point ("real") value beginning in column 11 and
+extending to column 30 with leading blanks.
+.IP I
+This is an integer value beginning in column 11 and extending to
+column 30 with leading blanks.
+.RE
+.sp 1
+.PP
+The parameters having FLAG designations all default to -1 to indicate
+that an operation has not been performed.
+The ONEDSPEC subroutines "load_ids_hdr" and "store_keywords" follow
+these rules when reading and writing spectral header fields.
+If not present in a header, load_ids_hdr will assume a value of zero
+except that all flags are set to -1, and the object flag parameter
+defaults to object.
+.PP
+When writing an image, only the above parameters are stored by store_keywords.
+Other header information is lost. This needs to be improved.
+.PP
+Not all programs need all the header elements. The following table
+indicates who needs what. Tasks not listed generally do not require
+any header information. Header elements not listed are not used.
+The task SLIST requires all the elements listed above.
+The task WIDTAPE requires almost all (except NP1 and NP2).
+The headings are abbreviated task names as follows:
+.sp 1
+.nr PS 8
+.ps 8
+.TS
+center;
+l l | l l | l l.
+ADD	addsets	COE	coefs	FIT	flatfit
+BSW	bswitch	COM	combine	REB	rebin
+CAL	calibrate	DIS	dispcor	SPL	splot
+COI	coincor	FDV	flatdiv	STA	standard
+.TE
+.sp 1
+.TS
+center, tab(/);
+l | l | l | l | l | l | l | l | l | l | l | l | l.
+Key/ADD/BSW/CAL/COI/COE/COM/DIS/FDV/FIT/REB/SPL/STA
+_
+HA// X////////// X/
+RA// X////////// X/
+DEC// X////////// X/
+ST// X////////// X/
+UT// X////////// X/
+AIRMASS// X////////// X/
+W0// X/ X/// X//// X/ X/ X/
+WPC// X/ X/// X//// X/ X/ X/
+NP1/////////// X///
+NP2/////////// X///
+EXPOSURE/ X/ X/// X/ X///// X///
+BEAM-NUM// X/ X//// X/ X/ X// X/ X//
+OFLAG// X////////// X/
+DF-FLAG//// X
+DC-FLAG// X//// X//// X/ X/ X/
+QD-FLAG//////// X/
+EX-FLAG// X/
+BS-FLAG// X/
+CA-FLAG/ X// X//////// X/
+CO-FLAG///// X//
+DFn//// X/
+.TE
+.nr PS 10
+.ps 10
+.bp
+.SH
+Headers From Other Instruments
+.PP
+The header elements listed above are currently created only when reading
+IIDS and IRS data from one of the specific readers: RIDSMTN and RIDSFILE.
+The time-like parameters, (RA, DEC, UT, ST, HA), are created in a
+compatible fashion by RCAMERA and RFITS (when the FITS tape is written
+by the KPNO CCD systems).
+.PP
+For any other header information, the ONEDSPEC package is at a loss
+unless the necessary information is edited into the headers with
+an editing task such as HEDIT. This is not an acceptable long term
+mode of operation, and the following suggestion is one approach to
+the header problem.
+.PP
+A translation table can be created as a text file which outlines
+the mapping of existing header elements to those required by the
+ONEDSPEC package. A mapping line is needed for each parameter
+and may take the form:
+.sp 1
+.RS
+.DC
+1D_param    default    hdr_param    key_start   value_start   type   conversion
+.DE
+.RE
+where the elements of an entry have the following definitions:
+.TS
+center;
+l l.
+1D_param	T{The name of the parameter expected by the ONEDSPEC package,
+such as EXPOSURE, OFLAG, BEAM-NUM.  T}
+
+default	T{A value to be used if no entry is found for this parameter.T}
+
+hdr_param	T{The string actually present in the existing image header to be
+associated with the ONEDSPEC parameter. T}
+
+key_start	T{The starting column number at which the string starts 
+in the header. T}
+
+value_start	T{The starting column number at which the string describing the
+value of the parameter starts in the header. T}
+
+type	T{The format type of the parameter: integer, real, string, boolean,
+sexagesimal. T}
+
+conversion	T{If the format type is string, a further conversion may 
+optionally be made to one of the formats listed under type. T}
+.TE
+.sp 1
+.PP
+A translation file can be built for each instrument and its
+peculiar header formats, and the file name associated with a
+package parameter. The two subroutines in ONEDSPEC dealing
+directly with the headers (load_ids_hdr and store_keywords)
+can be modified or replaced to access this file and
+translate the header elements.
+.endhelp
diff --git a/noao/onedspec/doc/sys/Onedspec.hlp b/noao/onedspec/doc/sys/Onedspec.hlp
new file mode 100644
index 00000000..85a3f20e
--- /dev/null
+++ b/noao/onedspec/doc/sys/Onedspec.hlp
@@ -0,0 +1,2219 @@
+.help spbasic
+.sh
+One Dimensional Package - Basic Operators
+
+.sh
+INTRODUCTION
+
+     The IRAF One Dimensional Package is intended to provide the basic
+tools required to reduce, analyze, and display data having a
+single dimension. This primarily refers to spectra, but may have
+applicability to time series photometry, or any other
+source of data which can be considered a simple vector.
+All such data will be referred to as spectra in the following discussion.
+Furthermore, the spectrum vector is assumed to be equally spaced
+along the independent variable (wavelength, channel, frequency,
+wavenumber,...). For the purposes of discussion, the independent
+variable will be referred to as wavelength but may be any of the
+possible physical transformations.
+
+     Spectra are to be stored as 2 dimensional IRAF floating point images
+having a single line
+and are therefore limited to lengths smaller than or equal to the
+largest representable positive integer. For 32 bit machines, this
+is about 2 billion points, so that disk space will likely be the
+operational limit.  The precision and dynamic range  for each pixel
+will be determined by the local machine.
+The second dimension of the spectrum is spatial, and therefore
+represents a special case of the long slit spectroscopic mode.
+
+     Each spectrum will, by default, be stored as a separate image
+file.  Alternatively, an association
+can be declared for a related set of spectra
+through a "data group" mechanism. A data group can be defined to
+contain any number of related spectra so that an operation can
+be specified for the group. For example, one can group a single
+night of IIDS spectra into a group labeled JAN28, and then
+wavelength linearize JAN28. This helps minimize
+the user interaction which would otherwise be repetitive, and
+also reduces the user bookkeeping required.
+
+     Data input to the package is provided through the DATAIO
+package. Tape readers will be provided for FITS, IIDS and IRS mountain
+formats, Text ("card-image"),  REDUCER and PDS. The descriptor fields
+included in these formats will be mapped into standard IRAF
+image header fields when possible. Special fields will be
+added to the image header to represent instrument
+related parameters.
+
+     Data output to tape (for visitor take home) will be
+either in FITS or text format.
+
+     A variety of graphics display options will be provided
+for both interactive use and for hardcopy generation.
+Scale expansion and contraction, labeling, multiple spectra
+plots, and axis limit specification are to be included in the
+options.
+
+     Specific reduction scripts will be provided to efficiently
+process raw data from the Kitt Peak instruments IIDS and IRS.
+
+
+.sh
+SCOPE OF SPECIFICATIONS
+
+This paper specifies the command format, parameters, and
+operations for the Basic contents of the One Dimensional
+Spectral Package. The Basic functions are those comprising the
+minimum set to reduce a large variety of spectra.
+More complicated operators and analysis functions
+are described in a companion paper on Intermediate Functions.
+Major projects in spectral analysis will be considered at
+a later date in the Advanced function set.
+
+The primary functions within the Basic operator set are:
+
+.ls 4 Transport
+Primarily magtape readers for the common tape formats. Included
+are FITS, IIDS/IRS, REDUCER, PDS, and Card-image formats.
+Tape writers will be initially limited to FITS and Card-image.
+.le
+.ls 4 Mathematical
+Add, subtract, multiply, divide spectra by spectra or constants.
+Apply functional operators such as log, exp, sqrt, sin, cos.
+Weighted sums and averages of spectra.
+.le
+.ls 4 Reduction operators
+Line identification, dispersion solution, flux calibration,
+coincidence correction, atmospheric extinction correction,
+flat fielding.
+.le
+.ls 4 Plotting
+Terminal package to expand, overplot, annotate plots. Hard
+copy package for printer/plotters.
+.le
+.ls 4 Utilities
+Header examination and modification. List, copy, delete spectra.
+Define, add, delete entries in a data group.
+.le
+.ls 4 Artificial spectra
+Generate ramps, Gaussian and Voigt lines, noise.
+.le
+
+These functions will be considered in detail in the following
+discussion.
+
+.ks
+A summary of the commands is given below:
+
+.nf
+rfits       -- Convert FITS data files to IRAF data files
+riids       -- Convert IIDS mountain tape format to IRAF data files
+rreducer    -- Convert Reducer format tape to IRAF data files
+rpds        -- Convert a PDS format tape to IRAF data files
+rtext       -- Convert a card-image text file to an IRAF image file
+wfits       -- Convert IRAF data files to FITS data format
+wtext       -- Convert an IRAF image file to a card-image text file
+.sp 1
+coin_cor    -- Correct specified spectra for photon coincidence
+line_list   -- Create a new line list, or modify an existing one
+mlinid      -- Manually identify line features in a spectrum
+alinid      -- Automatically locate spectral features in a spectrum
+disp_sol    -- Determine the dispersion relation for a set of spectra
+disp_cor    -- Linearize spectra having dispersion relation coefficients
+cr_flat     -- Create a flat field spectrum
+flt_field   -- Correct spectra for pixel-to-pixel variations
+std_star    -- Define the standard stars to be used for solving the 
+               extinction and system sensitivity functions
+crext_func  -- Create an extinction function from a set of observations
+crsens_func -- Create system sensitivity function
+ext_cor     -- Extinction correct specified spectra
+sens_cor    -- Correct the specified spectra for system sensitivity
+.fi
+.ju
+.ke
+
+.bp
+.sh
+TRANSPORT - INPUT
+
+Although the primary data input source for the near future
+will be magtape, direct links from other computers will
+be a likely source of input. The IRAF DATAIO package
+treats magtape as simple bit streams so that alternate
+input devices (e.g. disk, ethernet, phone lines) can also
+be accommodated with no programming modifications.
+
+This section describes the different formats to be made
+available in the initial release of the Spectroscopic
+package. Additional formats may be added if needed.
+
+In general, the following information will be copied to
+the standard image header: length of spectrum, title, 
+abscissa units, brightness units, reference pixel
+abscissa value and increment, right ascension and declination
+of telescope.
+
+Non-standard header parameters include but are not limited to:
+integration time, UT and LST of the observation, airmass (or 
+zenith distance), processing history, and comments.
+
+.sh
+FITS
+.ih
+NAME
+rfits -- Convert FITS data files to IRAF data files
+.ih
+USAGE
+rfits [source, filename, files]
+.ih
+DESCRIPTION
+FITS data is read from the specified source.
+The FITS header may optionally be printed on the standard
+output as either a full listing or a short description.  Image data may
+optionally be converted to an IRAF image of specified data type.
+
+Eventually all data from the mountain will be in FITS format,
+with the exception of time-critical data transfer projects
+and special applications. The IRAF FITS reader will
+copy the data to disk for most applications.
+
+.ih
+PARAMETERS
+.ls 4 fits_source
+The FITS data source.  If the data source is a disk file or an explicit tape file
+specification of the form mt*[n] where n is a file number then only that file
+is converted.  If the general tape device name is given, i.e. mta, mtb800, etc,
+then the files specified by the files parameter will be read from the tape.
+.le
+.ls filename
+The IRAF file which will receive the FITS data if the make_image parameter
+switch set.  For tape files specified by the files parameter the filename
+will be used as a prefix and the file number will be appended.   Otherwise,
+the file will be named as specified.  Thus,
+reading files 1 and 3 from a FITS tape with a filename of data will produce
+the files data1 and data3.  It is legal to use a null filename.  However,
+converting a source without a file number and with a null filename will cause
+a default file fits to be created.
+.le
+.ls files
+The files to be read from a tape are specified by the files string.  The
+string can consist of any sequence of file numbers separated by
+at least one of whitespace, comma, or dash.
+A dash specifies a range of files.  For example the string
+
+1 2, 3 - 5,8-6
+
+will convert the files 1 through 8.
+.le
+.ls print_header
+If this switch is set header information is printed on the standard output
+output. (default = yes)
+.le
+.ls short_header
+This switch controls the format of the header information printed when the
+print_header switch is set.
+When the short_header switch is set only the output filename,
+the FITS OBJECT string, and the image dimensions are printed.
+Otherwise, the output filename is followed by the full FITS header.
+(default = yes)
+.le
+.ls bytes_per_record
+The FITS standard record size is 2880 bytes which is the default for this
+parameter.  However, non-standard FITS tapes with different record sizes can
+be read by setting the appropriate size.
+.le
+.ls make_image
+This switch determines whether FITS image data is converted to an IRAF image
+file.  This switch is set to no to obtain just header information with the
+print_header switch. (default = yes)
+.le
+.ls data_type
+The IRAF image file may be of a different data type than the FITS image data.
+The data type may be specified as s for short, l for long, and r for real.
+The user must beware of truncation problems if an inappropriate data type is
+specified.  If the FITS keywords BSCALE and BZERO are found then the image
+data is scaled appropriately.  In this case the real data type may be most
+appropriate.
+.le
+.sh
+For spectroscopic applications, the parameter data_type would be
+specified as r for real, and the filename would probably be assigned
+as the "group" name as well. (see section on data groups.)
+
+
+.sh
+IIDS/IRS
+.ih
+NAME
+riids -- Convert IIDS mountain tape format to IRAF data files
+.ih
+USAGE
+riids [source, filename, form, records]
+.ih
+DESCRIPTION
+IIDS/IRS mountain format data is read from the specified source.
+The header may be printed
+on the standard output either in short form, label only, or a long
+form containing telescope and time information, processing flags,
+and wavelength solution values.
+
+Either raw or "mountain reduced" tapes can be specified with the
+parameter form.
+
+The IIDS format is destined for extinction. A FITS format will
+replace the current tape format, but an interim period will exist
+for which this tape reader must exist.
+.ih
+PARAMETERS
+.ls 4 iids_source
+The data source, either magtape or a data stream (e.g. disk file).
+The current IIDS tape format produces tapes having only a single
+file. If the source is a magtape, the general tape specification
+mt*[n], should either have n specified as 1, or [n] should not be present.
+.le
+.ls 4 filename
+The IRAF file which will contain the data if the make_image parameter
+is set. The filename will be used as a prefix and the record number
+will be used as the suffix. Thus reading records 1 through 100 from
+an IIDS tape with a file name of 'blue' will produce 100 files having
+names blue1, blue2, ..., blue100. A null filename will default to 'iids'.
+.le
+.ls 4 form
+This string parameter defines the tape to be either 'new' or 'red'.
+The 'new' designation refers to tapes made after January 1977, and
+'red' refers to mountain reduced tapes. (default = 'red')
+.le
+.ls 4 records
+The records specified by this string parameter will be copied to disk.
+The syntax is identical to that for the files parameter of the FITS reader.
+.le
+.ls 4 print_header
+If this switch is set, header information is printed on the standard
+output. (default = yes)
+.le
+.ls 4 short_header
+If this switch is set, only the filename and label information will be printed
+if the print_header switch is also set. If set to 'no', the long form
+will be printed. (default = yes)
+.le
+.ls 4 make_image
+See definition of this parameter under FITS.
+.le
+
+
+.sh
+REDUCER
+
+REDUCER tapes require several considerations beyond the
+previous simple formats. The spectra actually consist of
+many spectra having lengths of 4096 but slightly different
+spectral sampling. Thus, the reader can create many small
+independent spectra, or interpolate the data onto a common
+spectral scale to create a single large spectrum.
+The latter alternative seems to be more generally useful,
+unless the interpolation process introduces significant errors.
+Probably the initial reader will provide both options.
+   
+A second consideration is the 60 bit word length conversion.
+The IRAF images are limited to 32 bit reals on most 32 bit machines.
+Some loss of precision and dynamic range will result while reading REDUCER
+format data.
+   
+Also, there may be a considerable number (~100) of non-standard header
+elements. These can be handled in a normal fashion, and tools
+will be provided to extract or modify these elements as needed.
+New elements may be added as well.
+
+.ih
+NAME
+rreducer -- Convert Reducer format tape to IRAF data files
+.ih
+USAGE
+rreducer [source, filename, files]
+.ih
+DESCRIPTION
+REDUCER format data is read from the specified source.
+The header may be printed on the standard output either in short form
+consisting of the 80 character ID field, or a long form containing some
+selection (to be agreed upon) of the many header elements.
+
+Either a single long spectrum requiring interpolation
+to match the spectral characteristics of the first data block, or
+multiple short spectra having individual spectral parameters can
+be specified with the hidden parameter, interp.
+Interpolation is performed via a fifth order polynomial.
+
+Subsets of the spectrum can be selected with the blocks string
+parameter. This specifies which blocks in the file are to be extracted.
+
+.ih
+PARAMETERS
+.ls 4 reducer_source
+The data source, either magnetic tape or a data stream (e.g. disk
+file). See the definition of fits_source above for a description
+of how this parameter interacts with the files parameter.
+.le
+.ls 4 filename
+The filename which will contain the data.
+See the definition of this parameter under FITS.
+If no name is given, the default of 'reducer' will be used.
+.le
+.ls 4 files
+The files to be read from tape are given by the files string. See
+the description of this parameter under FITS.
+.le
+.ls 4 print_header
+If this switch is set header information will be printed on the
+standard output. (default = yes)
+.le
+.ls 4 short_header
+If this switch is set only the filename and the first 60 characters
+of the 80 character ID field will be printed if the print_header
+switch is also set. If set to no, the long form of the header
+will be printed, containing selected elements of the 100 word
+header record. (default = yes)
+.le
+.ls 4 make_image
+See the definition of this parameter under FITS.
+.le
+.ls 4 interp
+If this switch is set, a single long spectrum is produced. If
+set to no, multiple spectra will be generated, one for each
+header-data block. The resulting filenames will have suffixes
+of '.1' , '.2' ... '.n'. For example, if the given filename is
+fts and the tape file is 2, the resulting spectrum will be
+fts2 if interp is set to yes, but will be fts2.1, fts2.2, and
+fts2.3 if there are 3 header-data block sets and interp is set
+to no. (default = yes).
+.le
+.ls 4 blocks
+This string parameter allows selected extraction of the
+specified header-block sets, rather than the entire spectrum.
+Thus subsets of the spectrum may be extracted. The parameter
+specifies the starting block and ending block within a tape file.
+If an end-of-file is found prior to exhaustion of the
+specification, reading is terminated.
+For example, the string '12 19' specifies that the eight sets
+starting with the twelfth block are to be extracted to
+form the spectrum. (default = '1 32767', or all)
+.le
+
+
+.sh
+PDS
+
+Tapes from the new PDS 11/23 system will be either FITS or
+old format PDS 9 track tapes. This reader will accept the
+old format tapes which are based on the PDP 8 character set
+and either 10 or 12 bit format.
+
+.ih
+NAME
+rpds -- Convert a PDS format tape to IRAF data files
+.ih
+USAGE
+rpds [source, filename, files]
+.ih
+DESCRIPTION
+PDS format data is read from the specified source. The header
+may be printed on the standard output either in short form
+consisting of the 40 character ID field, filename, and size,
+or in long form including raster parameters and origin.
+
+Because PDS data is limited to no more than 12 bit data, the output image
+will be short integers if the number of lines ("scans") implies
+two dimensional data. If one dimensional data is implied, the
+output image will be converted to reals.
+.ih
+PARAMETERS
+.ls 4 pds_source
+The data source, either magtape or a data stream. See the definition
+of fits_source above for a description of how this parameter interacts
+with the files parameter.
+.le
+.ls 4 filename
+If no filename is given, the default of 'pds' will be used.
+.le
+.ls 4 files
+See the definition of this parameter under FITS.
+.le
+.ls 4 print_header
+If this switch is set, header information will be printed on the
+standard output. (default = yes).
+.le
+.ls 4 short_header
+If this switch is set, only the filename, size, and the 40 character ID
+field will be printed if the print_header switch is also set.
+If set to no, the long form of the header will be printed
+containing the full information block (delta X, delta Y, scan type,
+speed, origin, corner, travel). (default = yes)
+.le
+.ls 4 make_image
+See the definition of this parameter under FITS. (default = yes)
+.le
+.ls 4 data_type
+Specifies the IRAF image file output data type. Normally one
+dimensional PDS data (NSCANS=1) will be stored as real and
+two dimensional PDS data (NSCANS>1) will be stored as short.
+The data type may be specified as s (short), l (long), or r
+(real).
+.le
+
+
+.sh
+TEXT (Read Card-Image)
+
+Card-image tapes are probably the most portable form of data transport.
+Unlike FITS, there is no standard for internally documenting the
+contents of the text file. Header information is essentially
+lost. This makes card-image data transfer a relatively unattractive
+format.
+
+
+.ih
+NAME
+rtext -- Convert a card-image text file to an IRAF image file.
+.ih
+USAGE
+rtext [source, filename, files, ncols, nlines, label]
+.ih
+DESCRIPTION
+The card-image text file specified by the source parameter is 
+converted to an IRAF image file. The file is read in a free form
+mode (values separated by spaces) converting data along lines (1-ncols) first.
+No header information is stored except for the image size and
+the label.
+
+If additional header information is to be stored, the standard
+image header utility must be used.
+
+Pixel values exactly equal to some constant will be assumed to be blanks
+if the blank switch is set to yes. The flag value for blanks can be
+set with the blank_value parameter.
+
+.ih
+PARAMETERS
+.ls 4 text_source
+The input data source. See the definition of this parameter under FITS.
+.le
+.ls 4 filename
+The IRAF file which will contain the image data if the make_image
+switch is set. If no filename is given, the default of 'text'
+will be used.
+.le
+.ls 4 files
+See the definition of this parameter under FITS.
+.le
+.ls 4 ncols
+The number of columns of data which describe the image extent.
+.le
+.ls 4 nlines
+The number of lines (or 'rows') of data which describe the image extent.
+For one dimensional spectra, this parameter will be 1.
+.le
+.ls 4 label
+This string parameter becomes the image identification label.
+Up to 80 characters may be stored.
+.le
+.ls 4 print_header
+If this switch is set, header information consisting of the filename,
+image label, and image size will be printed on the standard output.
+(default = yes)
+.le
+.ls 4 make_image
+If this switch is set, an IRAF image will be created. (default = yes)
+.le
+.ls 4 data_type
+The IRAF image may be either s (short), l (long), or r (real).
+(default = r)
+.le
+.ls 4 card_length
+The number of columns on the "card" in the card-image file.
+(default = 80)
+.le
+.ls 4 blank_value
+The value used to flag blank pixels if the blank switch is set to yes.
+(default = -32767)
+.le
+.ls 4 blank
+If this switch is set to yes, any pixel having exactly the value
+specified by the parameter blank_value will be flagged as a blank
+pixel. If set to no, all pixel values are assumed to be valid.
+.le
+
+
+.bp
+.sh
+TRANSPORT - OUTPUT
+
+The primary format for take away tapes will eventually be FITS.
+Because many facilities currently cannot read FITS format,
+the card-image format will also be provided.
+
+.sh
+FITS
+.ih
+NAME
+wfits -- Convert IRAF data files to FITS data format
+.ih
+USAGE
+wfits [destination, filename, files]
+.ih
+DESCRIPTION
+Data is read from the specified filename(s) and written to the
+destination, usually a magnetic tape specification. 
+A short header consisting of the filename, size, and label
+may optionally be printed on the standard output.
+
+The data will be automatically scaled to either 16 or 32 bit integer format
+(BITPIX = 16 or 32) depending on the number of bits per pixel in the
+image data, unless the bitpix parameter is specified
+otherwise. The scaling parameters may be forced to
+exactly represent the original data (BSCALE = 1.0, BZERO = 0.0)
+by setting the scale switch to no.
+
+If only the header information is to be copied to the destination,
+the write_image parameter can be set to no. If this is the case,
+then the NAXIS FITS keyword will be assigned the value of 0;
+otherwise the value for
+NAXIS will be taken from the IRAF image header.
+
+Each non-standard header element will be written into the FITS file
+in a form to be determined. These elements may be entered as FITS
+COMMENT records, or perhaps added to the file as FITS "special
+records".
+
+Other keywords will be written following standard FITS specifications.
+A few special cases will be set as follows:
+
+.ls 4 NAXISn
+The NAXIS1, NAXIS2, ... NAXISn values will be taken from the
+image header
+.le
+.ls 4 OBJECT
+The first 60 characters of the image label will be used.
+.le
+.ls 4 BLANK
+Blank pixels will be written to tape having the IRAF value for
+indefinite appropriate to 8, 16, or 32 bit integers.
+.le
+.ls 4 ORIGIN = 'KPNO IRAF'
+.le
+
+.ih
+PARAMETERS
+.ls 4 fits_destination
+The data destination, usually a magnetic tape, but may be a disk
+file or STDOUT. If magtape,
+the tape should be specified with a file number of either 1
+or "eot". The file number refers to the file which will be written.
+Thus a file number of 2 would overwrite file 2. If the tape already
+has data written on it, the safest specification would be "eot".
+This forces the tape to be positioned between the double end-of-tape
+marks prior to writing.
+.le
+.ls 4 filename
+The IRAF filename providing the root for the source name. The files
+string, if given, will be used as the suffix for the file names
+to be written to tape. For example, if the filename is given as
+"image", and the files string is "1 -5", then files image1, image2,
+image3, image4, and image5 will be written to the destination
+in FITS format. If the files string is empty, only the specified
+filename will be converted.
+.le
+.ls 4 files
+See the definition of this parameter under the FITS reader.
+.le
+.ls 4 print_header
+If this switch is set, a short header will be printed on the
+standard output for each image converted. (default = yes)
+.le
+.ls 4 write_image
+If this switch is set to no, only header information will be
+written to the destination, but no image data.
+By using this parameter,
+one can generate a FITS tape containing header information only
+and may be used as a means for examining the IRAF image header
+or for generating a table of contents on a tape prior to writing
+the data. (default = yes)
+.le
+.ls 4 bitpix
+This parameter must be either 8, 16, or 32 to specify the
+allowable FITS pixel sizes.
+.le
+.ls 4 scale
+If this switch parameter is set to no, the FITS scaling
+parameters BSCALE and BZERO will be set to 1.0 and 0.0
+respectively. The data will be copied as it appears in the
+original data, with possible loss of dynamic range.
+Values exceeding the maximum value implied by the bitpix
+parameter will be set to the maximum representable value.
+(default = yes)
+.le
+
+
+.sh
+TEXT (Write Card-Image)
+
+Although this format is easily readable by the destination
+machine, there is no real standard for encoding information,
+neither the image data itself nor the descriptive parameters.
+
+.ih
+NAME
+wtext -- Convert an IRAF image file to a card-image text file
+.ih
+USAGE
+wtext [destination, filename, files]
+.ih
+DESCRIPTION
+Data is read from the specified filename(s) and written to
+the destination, usually a magnetic tape. The data will be
+blank padded, ASCII in a format consistent with the data type
+of the image pixels, (integer or floating point).
+A short header description, consisting of the filename
+being converted and the image label, may optionally be printed
+on the standard output.
+
+The column length of the "card" may be changed from the default
+of 80 using the card_length parameter, and the field width
+to be allocated for each data element may be changed from the
+default of 10 columns by setting the field_width parameter.
+
+If the data are integers, the equivalent of the FORTRAN format
+I<field_width> will be used;
+if the data are reals, the equivalent of the FORTRAN format
+1P<n>E<field_width>.3
+will be used, where n is the number of elements which can
+be output into one card length. For the default values of
+card_length = 80, and field_width = 10, n will be 8. (1P8E10.3).
+
+Several cards may be written as a single "block" for
+improving the efficiency on magtape. Reasonable efficiency (80 percent)
+is attained with a blocking factor of 50, but this value
+may be modified by changing the parameter blocking_factor.
+If the last block is unfilled, it will be truncated to the
+minimum number of card images required to flush the data.
+
+A legitimate value must be defined to represent blank pixels.
+The parameter blank_value is used to define this value and
+defaults to -32767.
+
+.ih
+PARAMETERS
+.ls 4 text_destination
+See the definition for fits_destination for a description of this
+parameter.
+.le
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 print_header
+If this switch is set, a short header is printed for each
+file converted. (default = yes)
+.le
+.ls 4 card_length
+The number of columns on the "card" to be generated. (default = 80)
+.le
+.ls 4 field_width
+The number of columns on the "card" to be allocated for each pixel value.
+(default = 10)
+.le
+.ls 4 blocking_factor
+The number of card images to be written as a single blocked record.
+(default = 50)
+.le
+.ls 4 blank_value
+The value to be assigned to blank pixels for the purpose of
+representing them on the card image. (default = -32767)
+.le
+.bp
+
+
+.sh
+MATHEMATICAL OPERATORS
+
+Because spectra are stored as IRAF images, the standard image
+calculator utility provides the basic arithmetic services.
+For example, to create a spectrum (called spavg) which is the average of two
+other spectra (sp1 and sp2), one can enter the command:
+.ls 8 cl>imcalc "spavg = (sp1 + sp2) / 2"
+.le
+
+Other arithmetic operations are performed in a similar fashion.
+The general form of the command string is
+output_image = expression where "expression" may consist of:
+.ls 8 1. Spectra or segments of spectra
+A segment of a spectrum is specified by the notation spectrum[x1:x2]
+where x1 and x2 are pixel indices along the spectrum. For example,
+to create a spectrum which is the difference of the first 100
+pixels of two other spectra, the following command would be used:
+.ls 16 cl> imcalc "spdiff = sp1[1:100] - sp2[1:100]"
+.le
+An option to specify wavelength delineated segments may be added
+if this appears generally feasible.
+.le
+.ls 8 2. Numeric constants
+.le
+.ls 8 3. Data group names
+If an operation is performed on a data group, the output
+will be a new data group containing spectra which have been
+individually treated by the specified calculation.
+For example, if JAN28 is a group containing 100 congruent spectra
+and response is the instrumental response as a function of
+wavelength as determined from a set of standards, then
+the after the following command is entered:
+.ls 16 cl> imcalc "JAN28X = JAN28 * response"
+.le
+
+a new data group will be generated containing 100 spectra which
+have been calibrated for the instrument response. The new spectra will
+be given names JAN28X1 through JAN28X100.
+.le
+.ls 8 4. Intrinsic functions
+.ks
+The following intrinsic functions are to be provided:
+
+.nf
+    abs      atan2    cos      int      min      sin       
+    acos     ceil     cosh     log      mod      sinh      
+    aimag    char     double   log10    nint     sqrt      
+    asin     complex  exp      long     real     tan       
+    atan     conjug   floor    max      short    tanh      
+.fi
+.ke
+.le
+
+Expression elements are to be
+separated by arithmetic and boolean operators (+,-,*,/,**,<,>,<=,=>,==,!,!=). 
+The boolean operators provide a means to generate masks.
+
+Rules governing operations on non-congruent spectra are not yet fully defined.
+.bp
+
+.sh
+REDUCTION OPERATORS
+
+Most of the reduction operators discussed in this section are
+intended for spectra of the IIDS/IRS class, although they
+are sufficiently general to accommodate data obtained with
+the CryoCam (either multi-aperture or long-slit mode), Echelle,
+Coude Feed, and photographic (PDS) instruments. Some 
+application to FTS data is also feasible.
+
+It is intended that many of these operators will never be
+directly executed by users, but that they will be driven by
+CL command scripts tuned for individual instruments.
+In some cases the scripts will be fairly elaborate and extensive
+to lead new users through the reduction phase along a reliable
+path.
+
+It will no doubt be necessary to either modify some
+of these operators, or create more specific operators for
+certain other instruments. These operators should be considered
+a sample of what will eventually be available in this package. 
+
+The basic path which most spectroscopic data follows is:
+
+.ls 4 1.
+Coincidence Correction.
+.ls
+Many detectors can respond to incoming photevents at a limited
+rate. Once an event occurs, the detector cannot respond for some
+instrument dependent period, or dead-time. If events occur during
+this period, they will not be counted. If the event rate
+does not greatly exceed the detector limits, the uncounted events
+can be corrected for statistically.
+
+For many detectors, the coincidence correction is a well
+determined function and can be applied to the raw data
+to produce a reasonably corrected spectrum.
+.le
+.le
+.ls 4 2.
+Wavelength linearization.
+.ls
+Few instruments produce spectra having pixel to pixel wavelength
+differences which are constant across the entire spectrum.
+For subsequent reduction and analysis purposes, it is
+desirable to rectify the spectra. This is done by mapping the spectrum
+from the non-linear wavelength coordinate to a linear one.
+It is also desirable to provide a means of forcing the mapping
+to a grid which is common to many observations, and in some cases,
+to observations acquired with other instruments as well.
+
+The processes required for the mapping are outlined below.
+
+.le
+.ls 4 a.
+Manually identify a small number of spectral features having
+known wavelengths thereby creating a table of wavelength as
+a function of pixel number.
+.le
+.ls 4 b.
+Compute estimated relationship between wavelength and pixel number
+.le
+.ls 4 c.
+Automatically locate many features found in a user definable line list.
+Optionally locate additional features from other spectra using an alternate
+line list. (This allows spectra from several different sources to be used
+for the wavelength calibration, such as arc lamps, night/day sky.)
+.le
+.ls 4 d.
+Compute improved relationship between wavelength and pixel number.
+.le
+.ls 4 e.
+Perform 2.c. and 2.d. for all other spectral entries in the wavelength
+calibration data group.
+.le
+.ls 4 f.
+Compute relationship for wavelength as a function of pixel number and time (or
+zenith distance, or some other flexure parameter) as deduced from 2.e.
+.le
+.ls 4 g.
+Apply inverse of wavelength function to a data group. This requires
+interpolation of the data at pixels having fixed steps in wavelength.
+The start wavelength and the step size must be user definable.
+The interpolation may be via a polynomial of a user specified order (typically
+1 to 5), or a more sophisticated interpolator. The linearization
+in wavelength may also be a simple rebinning of the data to exactly preserve
+photon statistics.
+.le
+.le
+.ls 4 3.
+Field flattening.
+.ls
+Pixel to pixel sensitivity variations and other small scale
+fluctuations are removed by dividing the object spectra by the spectrum of
+a continuum source. The latter spectrum should have a very high
+signal-to-noise ratio so as not to introduce additional uncertainties
+into the data.
+
+If the spectrum of the continuum source has much low frequency
+modulation,
+it may be necessary to filter these variations before the division is performed.
+Otherwise fluctuations not characteristic
+of the instrument response may be introduced, and may be difficult to remove
+during the subsequent flux calibration process.
+.le
+.le
+.ls 4 4.
+Sky Subtraction
+.ls
+Except for extremely bright sources, all spectra require that the
+spectrum of the night sky be removed. In some cases, sky will
+be the dominant contributor to the raw spectrum.
+Sky subtraction is a simple subtraction operation and can be
+accomplished with the image calculator tools.
+.le
+.le
+.ls 4 5.
+Extinction Correction
+.ls
+The effects of the Earth's atmosphere produce a wavelength dependent
+reduction of flux across the spectrum. The extinction function
+is approximately known from extensive photometric measurements
+obtained at the observatory over a period of many years. But on
+any given night this function may deviate from the average, sometimes
+significantly. If the spectroscopic observer has acquired the necessary
+data, it is possible to solve for the extinction function directly.
+
+Therefore, it should be possible for the user to either derive the
+extinction function, input a user-defined function, or use the
+standard average function and subsequently correct spectra for the
+effects of the atmosphere as described by that function and the effective
+observing airmass. (Note that because  exposures may be quite long, the
+effective airmass must be calculated as a function
+of position on the sky.)
+.le
+.le
+.ls 4 6.
+Flux Calibration (Correction for Instrument Response)
+.ls
+By observing objects having known wavelength dependent flux
+distributions, it is possible to determine the sensitivity
+variations of the instrument as a function of wavelength.
+Usually several standards are observed for each group of data
+and these must be averaged together after corrections for
+"grey shift" variations (wavelength independent flux reductions
+such as those introduced by thin clouds).
+
+Although the actual flux of the standards is generally known only
+for a limited selection of wavelengths, the instrument response
+usually varies smoothly between those wavelengths and a smooth
+interpolator generally provides satisfactory calibration values
+at intermediate wavelengths.
+
+In some cases, the system sensitivity response may be known
+from other observations, and the user will be allowed to directly
+enter the sensitivity function.
+.le
+.le
+
+The above reduction path is primarily tuned to IIDS/IRS style data.
+Other instruments may require additional or alternate steps.
+It may be necessary for multiaperture Cryocam spectra, for example,
+to undergo an additional hole to hole sensitivity correction
+based on the total sky flux through each hole.
+
+The tasks performing the procedures outlined above will be described
+in more detail in the following discussion.
+
+.sh
+COINCIDENCE CORRECTION
+.ih
+NAME
+coin_cor -- Correct specified spectra for photon coincidence
+.ih
+USAGE
+coin_cor [filename, files, destination, dead_time]
+.ih
+DESCRIPTION
+The spectra specified by the root filename and the files parameter
+are corrected for photon counting losses due to detector dead-time.
+The corrected spectra are written to filenames having the root
+specified by the destination.
+
+The correction, if typical of photomultiplier discriminators,
+is usually of the form:
+
+.br
+         Co(i) = C(i) exp[C(i) dt],
+.br
+         dt = t/T,
+.br
+
+where Co(i) is the corrected count at pixel i, C(i) is the raw count,
+t is the detector/discriminator dead-time, and T is the
+exposure time at pixel i.
+
+Clearly, the correction factor can become extremely large when the
+count rate, C(i)/T, is large compared with the dead-time, t.
+The above formula cannot be expected to
+exactly remove the effects of undetected photo-events when
+large corrections are required.
+
+The exposure time will be read from the image header.
+If no value exists, or if the value is less than or equal to
+zero, a request from standard input will be issued for this parameter.
+
+Because each detector may have unique coincidence properties,
+this routine may be package dependent.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 destination
+The IRAF filename providing the root for the name of the result
+spectra. The files parameter, if specified, will be used for the
+suffix. If the filename parameter is actually a data group name,
+the destination name will be used to create a new data group
+containing spectra having IRAF filenames with the destination
+group name as a root and a suffix starting with 1 and incremented for
+each converted spectrum.
+.le
+.ls 4 dead_time
+The value of this parameter, in seconds, represents the detector
+dead-time.
+.le
+.ls 4 print_header
+If this switch is set, a short header will be printed on the
+standard output for each spectrum corrected. (default = yes)
+.le
+.ls 4 exposure
+This parameter should be entered into the image header. If not
+present or not realistic, a request is made from standard input.
+.le
+
+.sh
+WAVELENGTH LINEARIZATION
+
+A package of routines is required to perform the operations
+leading to linearized data. These include:
+.ls 4 1. Spectral line list definition and editing facility
+.le
+.ls 4 2. Manual line identifier using graphics cursor.
+.le
+.ls 4 3. Automatic line identifier using preliminary identifications
+from manual identifier and locating lines from the predefined list.
+.le
+.ls 4 4. Computation of dispersion relationship as a function of
+pixel coordinate and a flexure parameter, probably zenith distance.
+.le
+.ls 4 5. Linearization of spectra according to dispersion relation.
+Correction can be to either a linear or logarithmic dispersion in
+the pixel coordinate.
+.le
+
+Perhaps the most critical aspect of determining the dispersion
+relation is the algorithm for locating spectral line centers.
+A variety of techniques are available, and some testing will
+be required before adopting a standard scheme. Probably several
+algorithms will be available and switch selectable at the command
+level.
+
+.sh
+LINE LIST PREPARATION
+.ih
+NAME
+line_list -- Create a new line list, or modify an existing one
+.ih
+USAGE
+line_list [filename, option]
+.ih
+DESCRIPTION
+The line list specified by the IRAF filename parameter will be
+either created, listed, or modified according to the option
+given. The IRAF database facility will be used to manage the
+line list file.
+
+Each entry within the list will contain an identification tag (e.g. HeII)
+a reference value (e.g. wavelength, frequency, wavenumber), and a weighting
+value such as 1.0 or 2.0 to be used later in the least-squares fitting.
+An optional descriptive header may be associated with the line list.
+(e.g. "HeII arc from 3500 to 11,000A")
+
+Either the header, entry identifier or value may be changed
+if the modify option is specified. Deletion or addition of
+entries is also possible with the appropriate option flags
+specifications.
+.ih
+PARAMETERS
+
+.ls 4 filename
+The IRAF filename to be assigned to the line list. The list will
+referenced by this name thereafter.
+.le
+.ls 4 option
+This string parameter determines the action of the line list task.
+If no option is specified, the default action is to list the
+specified line list on the standard output if the line list
+exists; if it does not exist, a new line list will be created
+with the given name.
+.ls 4 = create
+The identifications and values for the line list are read from
+the standard input on a record by record basis. Each input
+record contains data for one line according to the format:
+.br
+.ls 4 identification value
+.le
+.le
+.ls 4 = header
+A descriptive header is read from the standard input.
+.le
+.ls 4 = list (default)
+The line list is listed on the standard output.
+.le
+.ls 4 = add
+Additional entries to the list are read from the standard input.
+.le
+.ls 4 = delete
+The entries defined by the values read from the standard input
+are deleted from the line list. The entries deleted will be those
+having values nearest the entered value, unless the absolute
+difference from the listed value is too large. For example, one
+can enter 5015 to delete the helium line at 5015.675, but entering
+5014 would result in an error message that no match could be found.
+.le
+.ls 4 = id
+The entries defined by values entered as for delete will be modified.
+Input is expected in the format:
+.br
+approxvalue  newidentifier
+.le
+.ls 4 = value
+As for option = id except that the input format contains
+the newvalue instead of the newidentifier.
+.le
+.ls 4 = weight
+As for option = id except that the nput format contains the newweight
+instead of the newidentifier.
+.le
+.le
+
+.sh
+MANUAL LINE IDENTIFICATION
+
+This routine provides the option of manually identifying the locations
+of spectral features by either setting a graphics cursor interactively,
+or by entering a list of feature positions.
+
+The primary uses for this routine are to identify features of known
+wavelength in preparation for a dispersion solution, and also to
+identify features in linearized spectra for velocity measurements.
+
+.ih
+NAME
+mlinid -- Manually identify line features in a spectrum
+.ih
+USAGE
+mlinid [filename, files]
+.ih
+DESCRIPTION
+A list file is created for each of
+the spectra specified by the IRAF filename parameter and files string
+containing the locations of spectral features and their associated
+reference value (e.g. wavelength, frequency, wavenumber).
+If invoked as an interactive task from a graphics terminal,
+the spectra will be displayed and cursor input requested to ascertain
+the approximate position of the feature. An improved position will
+be obtained via one of the line centering algorithms, and
+a request will be made for the reference value of the feature.
+The requests continue until EOF is detected.
+The name of the created list file is added to the spectral image
+header.
+
+Positions of features are given in the coordinate system defined
+by the standard image header entries CRPIX and CDELT
+defining the reference pixel and the
+pixel to pixel distance. For raw spectra these values simply define
+the pixel position of the feature. For dispersion corrected spectra
+these values define the position of the feature in wavelength units.
+
+If invoked as a background task, or from a non-graphics terminal,
+additional requests for the cursor x-coordinate  and intensity
+will be made from the standard input.
+
+The procedure is repeated for all specified spectra.
+
+Because the dispersion solution may be a function of an additional
+instrument dependent parameter (e.g. zenith distance),
+the driving package script can indicate the header entry to be
+used as the second parameter. Values for this parameter, if present,
+will be written to the output list file.
+.ih
+PARAMETERS
+
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 cur (x,y)
+This is a list structured parameter of type "graphics cursor".
+The list contains the approximate values of the pixel
+coordinate for the spectral features to be identified
+and the intensity value of the continuum at the feature. If the
+task is invoked from a graphics terminal in an interactive mode,
+values for this parameter will be read from the terminal's
+graphics cursor.
+.le
+.ls 4 value
+This is a list structured parameter containing the reference values
+for the spectral features to be identified. If the task is invoked in
+an interactive mode, the user will be prompted for these values.
+.le
+.ls 4 center_option
+This string parameter controls which algorithm is to be used during
+the improved centering phase of the process. (default = cg)
+.ls 4 = cg
+This specifies a center of gravity algorithm defined as the
+first moment of the intensity above the continuum level
+across the spectral feature.
+The integrals are evaluated using the trapezoidal rule and
+the intensity will be weighted by the square root of the intensity
+if the switch parameter cgweight is set to yes. The integral
+is evaluated from the approximate position defined by x cursor position
+plus and minus the number of pixels specified by the parameter
+cgextent.
+.ls 4 cgweight
+This switch defines whether a weighted moment is used in the
+center of gravity centering algorithm. (default = yes)
+.le
+.ls 4 cgextent
+This integer parameter defines the limits of the integrals in the
+center of gravity centering algorithm. The integral extends from
+the approximate position minus the extent to the approximate position
+plus the extent in units of pixels. (default = 5).
+.le
+.le
+.ls 4 = parabola
+This specifies that the centering algorithm is to be a parabolic
+fit to the central 3 pixels. The improved center is taken as the
+center of the parabola. The central 3 pixels are defined as the
+most extreme local pixel plus and minus one pixel. The most extreme
+local pixel is that pixel nearest the approximate center having the
+greatest deviation from the local average value of the spectrum. The
+extent of "local" is taken as plus and minus the parameter parextent.
+.ls 4 parextent
+This integer parameter defines the extent in units of pixels
+of the search for a local extreme pixel. (default = 3)
+.le
+.le
+.ls 4 = gauss
+(This algorithm will not be implemented in the initial system release.)
+This specifies that the centering algorithm is to be a Gaussian
+fit to the region near the approximate center. The fit is
+made to a region specified by the parameter gextent. Because
+this is a three parameter non-linear least-squares fit
+(center, width, peak intensity), it is likely to
+be slow. It may also produce poor results with noisy data
+although centering on high signal to noise data should be
+excellent.
+.ls 4 gextent
+This integer parameter specifies the extent in pixels of the Gaussian fit.
+It may be necessary to include a significant region of continuum.
+(default = 9)
+.le
+.le
+.ls 4 = none
+If this option is chosen, no improvement to the approximate center
+will be made. This may be useful for asymmetric and weak features
+where the other techniques can be systematically incorrect.
+.le
+.ls 4 second_order
+This string parameter defines the name of the image header entry to be
+used as the second order correction parameter in the dispersion
+solution. Values for this parameter, if present, are read from the image header
+and written to the output list file. Examples of values are zenith_distance,
+sidereal_time, instr_temp. (default = none)
+.le
+
+.sh
+AUTOMATIC LINE IDENTIFICATION
+
+This task allows a user to locate a set of spectral features defined
+in a previously prepared list.
+
+.ih
+NAME
+alinid -- Automatically locate spectral features in a spectrum
+.ih
+USAGE
+alinid [filename, files, mfilename, mfiles, list]
+.ih
+DESCRIPTION
+A list file is created for each of the spectra specified by the
+IRAF filename and files parameters. The file will contain
+the positions of the features defined in the line list file
+specified by the list parameter. The name of the list file
+will be added to the spectral image header.
+
+A preliminary estimate of the
+relationship of feature position as a function of feature
+wavelength is obtained from the list file(s) created by the
+task MLINID and defined by the parameters mfilename and mfiles. 
+A single preliminary estimate may be applied to a number of
+spectra by specifying a null mfiles string. Otherwise,
+a one-to-one correspondence is assumed between preliminary
+list files and spectra. If the entry for mfilename is also null,
+the linear dispersion relation for the pixel coordinate contained
+in the image header will be used. This provides the option
+of locating features in linearized spectra.
+
+The initial position estimate is improved using one of the centering
+algorithms defined by the center_option parameter and then
+written to a list file. Also written to the list file will be
+the feature's reference value (e.g. wavelength), weight,
+identification string, and the acceptability of the line.
+Acceptibility is noted as either accepted, set, deleted, or not
+found (see below).
+
+If the task is invoked from a graphics terminal as an interactive
+task, the interact switches may be set to yes.
+Then each spectrum will
+be displayed in segments expanded about each feature with the
+automatically defined center marked. The user can then accept
+the given position, mark a new center, or declare the line
+unacceptable.
+
+If the display switch is set, the spectrum is displayed
+and the features marked.
+
+If the task is invoked as a background task, or if the
+user terminal is non-graphics, then the display and interact
+switches cannot assume values of yes.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS
+.le
+.ls 4 files
+See the definition of this parameter under RFITS
+.le
+.ls 4 mfilename
+The root for the spectra names used to define the preliminary
+relationship between spectral feature coordinate and reference
+value. The mfiles string parameter is used to define the
+suffix of the spectral name. If this parameter is null, the
+preliminary relationship is assumed to be linear and defined
+by the standard image header entries CRPIX and CDELT.
+.le
+.ls 4 mfiles
+This string parameter serves the same purpose for mfilename
+as the files parameter serves for filename. Note that if this
+parameter is null, the single spectrum defined by mfilename
+is used to define the preliminary relationship for all
+spectra defined by filename and files.
+.le
+.ls 4 list
+This parameter specifies the IRAF file name containing the
+spectral line list to be scanned for features. (See the
+task LINE_LIST)
+.le
+.ls 4 interact
+If this switch is set to yes and the task is invoked interactively
+from a graphics terminal, the spectrum will be displayed on the
+terminal. Each feature will be marked with its computed center
+and the user can type one of the following single keystrokes:
+.ls 4 a
+to accept the displayed position
+.le
+.ls 4 s
+to set the cursor to the desired position
+.le
+.ls 4 d
+to delete the displayed feature from the line list during this
+invocation of the task
+.le
+.ls 4 b
+to reset the operational mode to a "batch" environment where
+no display or interaction is desired
+.le
+.ls 4 p
+to reset the operational mode to a "passive" environment where
+the spectra are displayed and marked, but no interaction is desired
+.le
+.le
+.ls 4 display
+If this switch is set to yes, and the task is invoked from
+a graphics terminal, the spectrum will be displayed and the
+identified lines marked for the user's inspection. No
+interaction is allowed unless the interact switch is also set to yes.
+(default = yes)
+.le
+.ls 4 center_option
+See the description of this parameter under MLINID.
+.le
+.ls 4 second_order
+See the description of this parameter under MLINID.
+.le
+
+.sh
+DISPERSION SOLUTION
+
+After several spectral features have been identified, either
+manually with MLINID or automatically with ALINID, the relationship
+between feature reference value and pixel coordinate can be calculated.
+The dispersion relation may require a second order correction
+to account for variations as a function of some additional
+parameter, such as zenith distance or time of day.
+
+.ih
+NAME
+disp_sol -- Determine the dispersion relation for a set of spectra.
+.ih
+USAGE
+disp_sol [filename, files, order, global]
+.ih
+DESCRIPTION
+The list files containing the postions and reference values for
+features in the specified spectra are combined to solve for the
+dispersion relation by a polynomial least-squares fit to the lists.
+The solution can include a second order
+correction parameter which is also contained in the list file.
+
+The solution takes the form of a polynomial in the pixel
+coordinate having the specified order. The second order
+is also fit by a polynomial. (The choice of a polynomial
+applies to the initial release. Additional forms, selectable by
+parameter, of the solution may be available later.)
+The polynomial coefficients are stored in the spectral image header
+if the store_coeffs switch is set to yes and the spectrum does not already
+contain a solution. If a solution already exists, the user is
+asked for confirmation to overwrite the solution, unless the overwrite
+switch is set to yes.
+
+If filename is the name of a data group, all line list files for
+spectra in that data group are combined into the solution.
+
+If invoked as an interactive task from a graphics terminal,
+a representation of the solution will be displayed and the user
+will be allowed to alter the weights of the line entries.
+If invoked from a non-graphics terminal, the representation
+will be in a tabular format (also available at a graphics terminal)
+for inspection and alteration. If invoked as a background task,
+an attempt will be made to reject discrepant points.
+
+The solution is made using all available line lists combined
+into a single data set if the global switch is set to yes.
+If global is set to no, each spectrum is treated as an
+independent data set.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 order
+The order of the polynomial for a least-squares fit to the
+dispersion solution. If the specified order exceeds the number
+of free parameters, the order will be reset to the maximum
+allowable. (default = 1 --> linear).
+.le
+.ls 4 global
+This switch determines if the data from all the specified spectra are
+to be treated as a single large data set. This is appropriate if the
+data represent a single congruent "setup". But if the data represent
+several different configurations, such as for multiaperture data,
+the global switch should be set to no. Note that if global is no, then
+no second order parameter solution is possible.
+.le
+.ls second_order
+This parameter specifies the order for the fit to the second
+order parameter. The limit described for the order parameter
+applies. (default = 0 --> no second parameter solution).
+.le
+.ls 4 interact
+If this switch is set to yes and the task is invoked interactively
+from a graphics terminal, the residuals of the solution will be displayed
+on the terminal. The user can type one of the following keystrokes:
+.ls 4 a
+to accept the current solution. The parameters of the fit
+are written into the headers of the spectra contributing to the fit.
+.le
+.ls 4 e
+to exit without saving the solution
+.le
+.ls 4 w
+to reset the weight of the point near the cursor positioned by the user.
+The user is then prompted for the new weight which may be set to zero
+to delete the point from the solution.
+.le
+.ls 4 t
+to display the solution parameters in tabular form
+.le
+.ls 4 o
+to specify a new order for the solution
+.le
+.ls 4 s
+to specify a new order for the second order parameter solution
+.le
+.ls 4 b
+to revert to batch mode to process the remainder of the solutions.
+This is only meaningful if the global switch is set to no.
+.le
+.ls 4 p
+to revert to passive mode as for ALINID. This is only meaningful
+if the global switch is set to no
+.le
+.le
+.ls 4 store_coeffs
+If this switch is set to yes, the dispersion solution polynomial
+coefficients will be written into the image header as special
+header elements. Otherwise, the solution is discarded. (default = yes)
+.le
+.ls 4 overwrite
+If this switch is set to yes, any existing dispersion solution contained
+in the image header will be overwritten without any request for confirmation
+from the user. If set to no, the user is asked if overwriting of the solution
+is acceptable. If no prior solution exists, this switch has no meaning.
+(default = no)
+.le
+
+.sh
+DISPERSION CORRECTION
+
+After the dispersion relation has been determined, the spectra
+are usually re-binned to create spectra having a linear
+relationship with wavelength. Although this is not always
+done, nor is it always desirable, subsequent processing
+is often simplified greatly by having to deal with only
+linearized data.
+
+.ih
+NAME
+disp_cor -- Linearize spectra having dispersion relation coefficients
+.ih
+USAGE
+disp_cor [filename, files, destination, option]
+.ih
+DESCRIPTION
+The spectra specified by the root filename and the files parameter
+are corrected for deviations from a linear wavelength relationship.
+The corrected spectra are written to filenames having the root
+specified by the destination parameter.
+
+The correction is performed by solving for the inverse relationship
+of pixel number as a function of equal increments in the wavelength.
+The new starting wavelength and increment are optionally specified
+by the parameters start and increment. If not specified, the current
+wavelength of the first pixel will be taken as the starting wavelength
+and the increment will be chosen to exactly fill the length of the
+current spectrum. The spectrum will be padded with INDEF on either
+end if the specified parameters request a larger spectral window than
+actually exists.
+
+The actual re-binning can be performed using one of several algorithms.
+The most efficient minimally smoothing algorithm to be available in the
+initial release is the fifth order polynomial interpolation.
+The most efficient count preserving algorithm is the simple partial-pixel
+summer.
+
+The interpolation can be either linear in wavelength or in the logarithm
+of wavelength. The latter is useful for subsequent radial velocity
+analyses. The choice is specified by the logarithm switch.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS
+.le
+.ls 4 destination
+See the definition of this parameter under COIN_COR.
+.le
+.ls 4 option
+This parameter specifies the algorithm to be used for the
+re-binning operation. The initial release will contain the
+following options:
+.ls 4 = linear
+to use a linear interpolation
+.le
+.ls 4 = poly
+to use a fifth order polynomial
+.le
+.ls 4 = sinc
+to use a sinc function interpolator
+.le
+.ls 4 = sum
+to use partial pixel summation
+.le
+.le
+.ls 4 start
+This parameter specifies the wavelength at which the corrected
+spectrum is to begin. The wavelength of the first pixel will
+be assigned this value. This parameter, combined with the increment
+parameter, allows data taken on different nights
+or with different instruments to be forced to be congruent.
+(default = value at first pixel)
+.le
+.ls 4 increment
+This parameter specifies the pixel to pixel wavelength (or logarithm of
+wavelength) increment
+that is to be used during the linearization process.
+(default = [wavelength at last pixel minus wavelength at first pixel]
+divided by [number of points in spectrum - 1])
+.le
+.ls 4 logarithm
+If this switch is set to yes, the linearization occurs with equal
+increments in the logarithm of wavelength. Otherwise, equal
+increments of wavelength are used. (default = no)
+.le
+.ls 4 print_header
+See the definition of this parameter for COIN_COR.
+.le
+
+.sh
+FIELD FLATTENING
+
+Most detectors exhibit variations in sensitivity across the field
+of interest. These are removed by dividing all observations by
+the spectrum of a smooth continuous source, such as an incandescant
+lamp. In order that these lamps, which usually have a low color
+temperature, produce sufficient energy in the blue and ultraviolet,
+they are often enclosed in a quartz rather than a glass bulb.
+Thus, the field flattening operation is often referred to as
+"quartz division".
+
+The operation is of marginal value unless the continuum source is
+observed properly. First, a very high signal-to-noise ratio per
+pixel is required. For certain detectors and applications this
+may not be possible in a reasonable amount of time. Second, the
+continuum source should not have any significant variations
+across small regions of the spectrum (high frequency "bumps").
+Otherwise the division will add these variations into the spectrum.
+
+There are basically two aspects to flat fielding spectra. The first
+is the removal of pixel-to-pixel sensitivity variations. The second
+is a more global pattern due to non-uniform iillumination and
+spatial and wavelength sensitivity variations across the detector.
+
+The very high frequency pixel-to-pixel variations are easily handled
+by a straightforward division of the observations by the continuum
+spectrum.
+
+The second problem is usually postponed in one-dimensional data
+reductions and included in the
+solution for the system sensitivity by observing standard stars.
+This aspect of the problem is adequately handled in this fashion
+and no special operators are provided in this package.
+
+If the continuum source exhibits large low frequency variations
+across the spectrum, it may be desirable to filter these.
+This is most easily done by fitting a moderately high order
+polynomial through the spectrum, and then dividing the polynomial
+representation into the original continuum spectrum. The result
+is a flat spectrum having an average value of unity and
+containing only the pixel-to-pixel sensitivity variations.
+
+Finally, it should be noted that the field flattening operation
+is most properly performed prior to the wavelength linearization
+of the spectra because the linearization process can smooth
+pixel-to-pixel variations.
+
+Flat fielding consists of two logical operations. The first
+is the solution for a continuum spectrum with the low frequency
+variations removed (CR_FLAT). It is assumed that multiple observations
+of the continuum source have been already averaged (using the
+image calculator program, for example).
+
+The second operation is the actual field flattening of the object
+spectra (FLT_FIELD).
+
+.ih
+NAME
+cr_flat -- Create a flat field spectrum
+.ih
+USAGE
+cr_flat [filename, destination]
+.ih
+DESCRIPTION
+The continuum spectrum specified by filename is corrected for
+low frequency spectral variations. Several algorithms may be
+available. The initial release will contain only a polynomial
+fitting technique. A fourier filtering algorithm may be added
+at a later date.
+
+The spectrum is fit by a polynomial in the pixel coordinate
+and the polynomial is divided into the original spectrum.
+Discrepant pixels may be rejected and the solution re-iterated.
+
+If invoked as an interactive task from a graphics terminal, the
+resultant spectrum is displayed and the user may alter the
+solution parameters if the interact switch is set to yes.
+If invoked from a non-graphics terminal, sufficient information
+concerning the fit is written to the terminal to allow
+the user to judge the quality of the fit and then alter the
+solution parameters.
+
+If invoked as a background task, or if the interact switch is set
+to no, default parameters will be assumed.
+
+The parameters of the fit are added to the image header for
+the corrected spectra.
+.ih
+PARAMETERS
+.ls 4 filename
+The IRAF filename containing the spectrum of the continuum
+source. If this is a data group name, then all spectra
+in the group will be corrected.
+.le
+.ls 4 destination
+The IRAF filename into which the resultant corrected
+spectrum is written. If the source filename is a data group,
+then the destination will be a new data group containing
+the names of the corrected spectra. The names will be
+assigned using the destination as a root name, and the
+ordinal of the spectrum in the list as a suffix.
+.le
+.ls 4 option
+This string parameter specifies the algorithm to be used
+in the correction process. Currently only option = poly
+is recognized.
+.le
+.ls 4 order
+This integer parameter specifies the initial order of the
+polynomial fit. (default = 8)
+.le
+.ls 4 reject
+This parameter specifies the number of standard deviations
+beyond which pixels are to be rejected. If the task
+is interactive, pixel rejection is performed only on command.
+If invoked as a background task, rejection is iterated 
+until no further pixels are rejected, or until the iteration
+count has been attained (see parameter niter). (default = 2.2)
+.le
+.ls 4 niter
+This integer parameter specifies the number of iterations
+to be performed in background mode. It may be set to 0 to
+specify no pixel rejection. (default = 2).
+.le
+.ls 4 interact
+If this switch is set to yes and the task is invoked as
+an interactive task, the user can alter the fit parameters
+order, reject, and niter. If at a graphics terminal, the resultant
+spectrum is displayed and the user can command the operation
+with the following single keystrokes:
+.ls 4 a
+to accept the solution
+.le
+.ls 4 o
+to change the order of the fit
+.le
+.ls 4 r
+to reset the reject parameter
+.le
+.ls 4 n
+to reset the niter parameter
+.le
+.ls 4 b
+to reset the operational mode to a batch environment
+.le
+.ls 4 p
+to reset the operational mode to a passive environment
+.le
+.le
+
+If at a non-graphics terminal, the fit parameters are
+written to the terminal so that the user may assess the quality
+of the fit. A request for one of the interactive commands
+is then issued and the user may proceed as if on a graphics
+terminal.
+.le
+
+.ih
+NAME
+flt_field -- Correct spectra for pixel-to-pixel variations
+.ih
+USAGE
+flt_field [filename, files, flatname, destination]
+.ih
+DESCRIPTION
+The spectra specified by the IRAF filename parameter and the files
+string are divided by the flat field spectra specified by
+the parameter flatname. If filename and flatname are data group names,
+the division is performed on a one-for-one basis.
+
+This operation is little more than a simple division. An image
+header entry is added indicating that flattening by the
+appropriate spectrum has been performed.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 flatname
+This string parameter sepcifies the name of the flat field
+spectrum, or spectra if a data group name.
+It is not necessary that the flat field spectra be corrected
+for low frequency spectral variations.
+It is required that the spectra be congruent with the spectra
+to be flattened; that is, all spectra must have the same
+length, reference pixel, and pixel-to-pixel increment.
+.le
+.ls 4 destination
+See the definition of this parameter under COIN_COR.
+.le
+.ls 4 print_header
+See the definition of this parameter under COIN_COR.
+.le
+
+.sh
+EXTINCTION CORRECTION/FLUX CALIBRATION
+
+At each wavelength (lambda) along the spectrum, the observed
+flux (fobs) must be corrected for extinction (k) due to the
+Earth's atmosphere and the system sensitivity (S) to obtain
+a true flux (f) above the atmosphere.
+.sp 1
+fobs(lambda) = f(lambda) * exp{-z[k(lambda)+C]} * S(lambda)
+.sp 1
+where z is the path through the Earth's atmosphere during the
+observation and C is an optional "grey" opacity term.
+
+For most observations, the standard extinction function is adequate,
+but occasionally the additive term is beneficial. In rare cases,
+the observer has acquired sufficient high quality data to
+determine the extinction function across the spectral region
+of interest. And in other cases, the user may have a priori
+knowledge of the extinction function.
+
+Observations of standard stars are used to determine
+either the additive constant or a new extinction function,
+and the system sensitivity.
+The two operations, determining the extinction parameters
+and the system sensitivity curve, are therefore intimately
+related.
+
+The process breaks down into four basic operations:
+.ls 4 1.
+Define the standard stars and their observations. (STD_STAR)
+.le
+.ls 4 2.
+Define the extinction solution option and solve for the extinction
+additive term or complete function if necessary. (CREXT_FUNC)
+.le
+.ls 4 3.
+Determine the system sensitivity function. (CRSENS_FUNC)
+.le
+.ls 4 4.
+Remove the effects of the extinction and the system sensitivity
+from the observations. (EXT_COR, SENS_COR)
+.le
+
+These will be described below in more detail.
+
+.ih
+NAME
+std_star -- Define the standard stars to be used for solving the extinction and
+system sensitivity functions.
+.ih
+USAGE
+std_star [fnamelist, filelist, namelist, std_file]
+.ih
+DESCRIPTION
+The spectra defined by the list of filenames and associated files
+contained in the string list parameters fnamelist and filelist
+are compared with the standard flux measurements for the stars
+listed in the string list parameter namelist. The resultant
+table of ratios as a function of wavelength are saved in the
+IRAF file specified by the std_file parameter.
+
+All spectra must be wavelength linearized. The star names given
+in namelist must be in a form similar to that in the IIDS Reduction
+manual. If a star name cannot be matched to the standards contained
+in a calibration file, the user is prompted for additional
+information. The calibration file containing the list of reference
+flux values is specified by the calib_file parameter.
+.ih
+PARAMETERS
+.ls 4 fnamelist
+This is a list structured parameter containing the IRAF filenames
+associated with the spectra for each of the standard stars contained
+in the list of starnames defined by the list structured parameter
+namelist. Both these parameters must have the same number of elements.
+The filename specifications are defined as in RFITS.
+.le
+.ls 4 fileslist
+This is also a list structured parameter having the same number of
+elements as fnamelist although some may be null.
+The entries are defined as in RFITS.
+.le
+.ls 4 namelist
+This is also a list structured parameter having the same number
+of elements as fnamelist. All elements must exist and have a
+form to be decided on, but probably similar to that given in the IIDS
+Reduction manual, page 36. For example, a typical star name might
+be BD+8 2015, or HILTNER 102. Case will not be significant.
+.le
+.ls 4 std_file
+This string parameter defines the IRAF filename in which the
+results from the standard star observations are stored.
+This file will be used to contain further calibration information
+such as the extinction and sensitivity function for the
+current set of observations.
+.le
+.ls 4 calib_file
+This string parameter defines which of several calibration
+data files are to be accessed for the comparison of the
+observational data to the standard fluxes. Separate tools
+to examine, modify, and create these files are available
+in the utilities package. (default = onedspec$iids.cal)
+.le
+.ls 4 print_header
+If this parameter is set to yes, an informative header
+is listed on the standard output as the standard stars are processed
+(default = yes).
+.le
+
+.ih
+NAME
+crext_func -- Create an extinction function from a set of observations
+.ih
+USAGE
+crext_func [std_file, option]
+.ih
+DESCRIPTION
+The user may specify via the option parameter which of the four
+extinction solutions is to be used. These are:
+.sp 1
+.ls 4 1.
+Adopt standard extinction function (option = standard).
+.le
+.ls 4 2.
+Solve for an additive constant (option = additive).
+.le
+.ls 4 3.
+Solve for extinction function (option = new_function).
+.le
+.ls 4 4.
+Input a tabular extinction function consisting of extinction
+values at specified wavelengths (option = input).
+.le
+.sp 1
+If the first or last options are chosen, the std_file may be empty.
+If the second option is chosen, several observations at
+differing air masses must be included in the file specified by std_file.
+If the third option is chosen,
+at least two standard stars must be included in the list of observations.
+
+The derived extinction function is added to the IRAF file specified
+by the std_file parameter by creating a new spectrum containing the
+function and adding the spectrum name to the std_file.
+The new spectrum will adopt a name having a root from the
+name std_file and a suffix of ".ext". The spectrum is created by
+a spline interpolation through the extinction values.
+
+If invoked as an interactive task from a graphics terminal, the
+derived extinction function  is displayed. The user may interactively
+alter the derived extinction values using the graphics cursor.
+If invoked from a non-graphics terminal, the user may alter the
+values by specifying the wavelength and new extinction value
+from the standard input. Interaction may be suppressed by setting the
+interact switch to no.
+
+.ih
+PARAMETERS
+.ls 4 std_file
+See the definition of this parameter under STD_STAR.
+.le
+.ls 4 option
+This parameter specifies which aspects of the extinction solution
+are to be computed. See description section for CREXT_FUNC.
+.le
+.ls 4 interact
+If this switch is set the user may alter the derived extinction values.
+If invoked from a graphics terminal and interact is set to yes, the
+following single keystroke commands may be typed:
+.ls 4 a
+to accept the current solution
+.le
+.ls 4 m
+to modify the extinction value at the cursor wavelength position (cursor-x)
+to the cursor extinction value position (cursor-y).
+.le
+.ls 4 i
+to insert a new wavelength-extinction value pair at the current
+crosshair position.
+.le
+.ls 4 d
+to delete the wavelength-extinction value pair at the current
+cursor wavelength position.
+.le
+.le
+
+.ih
+NAME
+crsens_func -- Create system sensitivity function.
+.ih
+USAGE
+crsens_func [std_file, option]
+.ih
+DESCRIPTION
+The standard star data and extinction function contained in the
+IRAF file specified by the std_file parameter are used to
+compute the system sensitivity as a function of wavelength.
+The derived function is written to the file specified by
+std_file.
+
+There must be at least one standard star observation contained
+in the std_file, unless the parameter option = input.
+This allows the user to enter any function in the
+form of wavelength-sensitivity pairs.
+
+If option = shift, a "grey" shift is applied to all observations
+necessary to bring relatively faint values up to the brightest
+to account for possible cloud variations.
+
+If invoked as an interactive task from a graphics terminal,
+and the interact switch is set to yes, the sensitivity values
+from each standard are plotted with any "grey" shift correction
+added. The user may delete or add new points as desired using
+the cursor. If invoked from a non-graphics terminal, a tabular
+list of the solution is presented and additions or deletions
+may be entered through the standard input.
+
+The final function written to the std_file is simply the name of a new
+spectrum derived from a spline fit to the sensitivity
+if the spline switch is set to yes. If spline = no, a linear
+interpolation between sensitivity points will be used.
+The sensitivity spectrum name will be taken from the file name
+given to std_file and with the suffix ".sen".
+.ih
+PARAMETERS
+.ls 4 std_file
+See the definition of this parameter under STD_STAR.
+.le
+.ls 4 option
+This parameter can assume the following string values:
+.ls 4 = input
+to indicate that the sensitivity function is to be entered as
+wavelength-sensitivity pairs. 
+.le
+.ls 4 = shift
+to force a "grey" shift between all standard star spectra to
+account for clouds. This is actually a multiplicative factor
+across each of the affected spectra.
+.le
+.le
+.ls 4 spline
+This switch parameter determines if a spline fit is to be made
+between the sensitivity points (spline = yes), or a linear
+fit (spline = no). (default = yes).
+.le
+.ls 4 interact
+If invoked as an interactive task, the user may alter the sensitivity
+function values. If at a graphics terminal, the sensitivity curve
+is displayed first for each star in the solution. The user may
+add or delete values for any or all stars at a given wavelength.
+Subsequently, the derived average curve is displayed and the user
+may further modify the solution. The following keystrokes are
+available from the graphics terminal:
+.ls 4 a
+to accept the current displayed data (solution).
+.le
+.ls 4 d
+to delete the value at the cross-hairs. If several values
+are very close together, an expanded display is presented.
+.le
+.ls 4 i
+to insert the sensitivity value of the y-cursor at the wavelength position.
+.le
+.ls 4 c
+to "create" new sensitivity values at the wavelength position of the
+x-cursor. Normally sensitivity values are computed only at pre-defined
+wavelengths specified in the calib_file. Additional values
+may be computed by interpolation of the standard star fluxes
+from the calib_file. The name of the calib_file and the spectra
+in the current solution are taken from the std_file.
+.le
+.le
+
+.ih
+NAME
+ext_cor -- Extinction correct specified spectra
+.ih
+USAGE
+ext_cor [filename, files, std_file, destination]
+.ih
+DESCRIPTION
+The spectra specified by the filename and files parameters
+are corrected for atmospheric extinction according to the
+extinction correction function pointed to by the function
+name in std_file. The resulting new spectra are created with the
+root of the destination parameter and having suffixes of
+1 through n corresponding to the n spectra corrected.
+If filename is a data group name, a new data group will be created having
+the name given by the destination parameter.
+
+The correction has the form:
+.sp 1
+f(lambda) = fobs(lambda) / 10**{-z[a(lambda) + C]}
+.sp 1
+where:
+.ls 4 f(lambda) = the flux at wavelength lambda above the Earth's atmosphere.
+.le
+.ls 4 fobs(lambda) = the flux observed through the atmosphere
+.le
+.ls 4 z = the path length through the atmosphere is units of air masses
+(= 1 at the zenith)
+.le
+.ls 4 a(lambda) = the extinction function at wavelength lambda
+in magnitudes per airmass.
+.le
+.ls 4 C = the additive constant, if any, in magnitudes per airmass.
+.le
+.sp 1
+For each spectrum, the zenith distance must be present in the image header.
+This is assumed to be correct for the beginning of the observation.
+For short exposures, this is adequate for the correction, but for
+long exposures, an effective air mass must be calculated over the
+integration. To do so requires knowledge of the altitude and azimuth
+of the telescope (or equivalantly RA, Dec, and sidereal time).
+If these are not present, the approximate air mass calculation will be used
+based solely on the available zenith distance. If the zenith distance
+is not present, user input is requested.
+
+The air mass is calculated according to the following equation for a given
+telescope position (based on Allen p.125,133):
+.sp 1
+z = sqrt{[q sin (alt)]**2 + 2q + 1} - q sin(alt)
+.sp 1
+where:
+.ls 4 q
+= atmospheric scale height (approx = 750).
+.le
+.ls 4 alt
+= telescope altitude
+.le
+.sp 1
+If the telescope traverses a significant distance in elevation during
+the integration, an effective correction can be computed as:
+.sp 1
+f(lambda)a = f(lambda)obs*T / integral{10**[-z(t)(a(lambda) + c)]}dt
+.sp 1
+where the integral is over the integration time, T.
+
+This expression can then be evaluated numerically at each wavelength.
+Because this is a time-consuming operation, the switch effective_cor
+can be set to no and then a simplified correction scheme will be used.
+This will be to compute a midpoint airmass if sufficient information
+is available, or simply to use the header airmass otherwise.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 std_file
+See the definition of this parameter under STD_STAR.
+.le
+.ls 4 destination
+See the definition of this parameter under COIN_COR.
+.le
+.ls 4 effective_cor
+If this switch is set to yes, the procedure to compute an effective
+corrective term averaged over the integration time will be used.
+Although a slow process, this method is more accurate than
+simply using the correction at any given time of the integration
+such as the midpoint. If set to no, a midpoint zenith distance
+will be computed and used if sufficient header information
+exists. (default = no).
+.le
+.ls 4 print_header
+See the definition of this parameter for COIN_COR.
+.le
+
+.ih
+NAME
+sens_cor -- Correct the specified spectra for system sensitivity
+variations across the spectrum.
+.ih
+USAGE
+sens_cor [filename, files, std_file, destination]
+.ih
+DESCRIPTION
+The spectra specified by the filename and files parameters are
+corrected for instrumental sensitivity by the 
+function pointed to by the spectrum name contained in std_file.
+The resulting spectra are stored according to the destination parameter.
+Filename may be a data group name. If so, then destination will be
+a new data group containing the names of the corrected spectra.
+
+This correction is a simple vector multiplcation.
+.ih
+PARAMETERS
+.ls 4 filename
+See the definition of this parameter under RFITS.
+.le
+.ls 4 files
+See the definition of this parameter under RFITS.
+.le
+.ls 4 std_file
+See the definition of this parameter under STD_STAR.
+.le
+.ls 4 destination
+See the definition of this parameter under COIN_COR.
+.le
+.ls 4 print_header
+See the definition of this parameter under COIN_COR.
+.le
+.endhelp
diff --git a/noao/onedspec/doc/sys/Review.hlp b/noao/onedspec/doc/sys/Review.hlp
new file mode 100644
index 00000000..5139f630
--- /dev/null
+++ b/noao/onedspec/doc/sys/Review.hlp
@@ -0,0 +1,512 @@
+.help onedspec Sep84 "Spectral Reductions"
+.ce
+\fBOne Dimensional Spectral Reductions\fR
+.ce
+Analysis and Discussion
+.ce
+September 4, 1984
+.sp 3
+.nh
+Introduction
+
+    The \fBonedspec\fR package is a collection of programs for the reduction
+and analysis of one dimensional spectral data.  The more general problem of
+operations upon one dimensional images or vectors shall be dealt with elsewhere,
+primarily in the \fBimages\fR and \fBplot\fR packages.  The problems of getting
+data in and out of the system are handled by the \fBdataio\fR package, at least
+for the standard data formats such as FITS.
+
+The operators provided in \fBonedspec\fR shall be general purpose and, as far
+as possible, independent of the instrument which produced the data.  Instrument
+dependent reductions tailored for specific instruments will be implemented as
+subpackages of the \fBimred\fR (image reductions) package.  For example,
+the subpackages \fBiids\fR and \fBirs\fR will be provided in \fBimred\fR for
+reducing data from the KPNO instruments of the same name.  The \fBimred\fR
+packages shall call upon the basic operators in \fBonedspec\fR, \fBimages\fR,
+and other packages to reduce the data for a specific instrument.
+
+
+.ks
+.nf
+	iids(etc)
+		imred
+		imredtools
+		onedspec
+			plot
+			tv
+				dataio
+				images
+					dbms
+					lists
+					system
+					language
+
+.fi
+.ce
+Relationship of \fBOnedspec\fR to other IRAF Packages
+.ke
+
+
+The relationship of the \fBonedspec\fR packages to other related packages in
+the IRAF system is shown above.  A program (CL script) in a package at one
+level in the hierarchy may only call programs in packages at lower levels.
+The system will load packages as necessary if not already loaded by the
+user.  The user is expected to be familiar with the standard system packages.
+
+.nh
+Basic Functions Required for One-Dimensional Spectral Reductions
+
+    The following classes of functions have been identified (in the preliminary
+specifications document for \fBonedspec\fR) as necessary to perform basic one
+dimensional spectral reductions.  Only a fraction of the functionality
+required is specific to the reduction of spectral data and is therefore
+provided by the \fBonedspec\fR package itself.
+
+.ls Transport
+Provided by the \fBdataio\fR package, although we do not currently have a
+reader for REDUCER format data tapes.  Readers for all standard format
+tapes are either available or planned.
+.le
+.ls Mathematical
+Standard system functions provided by \fBimages\fR (arithmetic, forward and
+inverse FFT, filtering, etc.).
+.le
+.ls Reduction Operators
+The heart of \fBonedspec\fR.  Operators are required (at a minimum) for
+coincidence correction, dispersion determination and correction, flat
+fielding, sky subtraction, extinction correction, and flux calibration.
+Operators for flat fielding and sky subtraction are already available elsewhere
+in IRAF.  Basic continuum fitting and subtraction is possible with existing
+software but additional algorithms designed for spectral data are desirable.
+.le
+.ls Plotting
+Standard system functions provided by the \fBplot\fR package.
+.le
+.ls Utilities
+Standard system functions provided by the \fBdbms\fR package.
+.le
+.ls Artificial Spectra
+These functions belong in the \fBartdata\fR package, but it is expected that
+prototype operators will be built as part of the initial \fBonedspec\fR
+development.
+.le
+
+.nh
+Data Structures
+
+    Spectra will be stored as one or two dimensional IRAF images embedded in
+database format files.  A free format header is associated with each image.
+Spectra may be grouped together as lines of a two dimensional image provided
+all can share the same header, but more commonly each image will contain a
+single spectrum.  The second image dimension, if used, will contain vectors
+directly associated with the images, such as a signal to noise vector.
+If the image is two dimensional the spectrum must be the first image line.
+The database facilities will allow images to be grouped together in a single
+file if desired.
+
+While most or all \fBonedspec\fR operators will expect a one dimensional
+image as input, image sections may be used to operate on vector subsections
+of higher dimensioned images if desired.  The datatype of an image is
+arbitrary, but all pixel data will be single precision real within
+\fBonedspec\fR.  While the IRAF image format does not impose any restrictions on
+the size of an image or image line, not all spectral operators may be usable
+on very large images.  In general, pointwise and local operations may easily
+be performed on images of any size with modest memory requirements, and
+most of the \fBonedspec\fR operations appear to fall into this class.
+
+.nh 2
+The IRAF Database Faciltities
+
+    An understanding of the IRAF database facilities is necessary to visualize
+how data will be treated by operators in \fBonedspec\fR and other packages.
+The database facilities will be used not just for image storage but also for
+program intercommunication, program output, and the storage of large
+astronomical catalogs (e.g. the SAO catalog).  Access to both small and
+large databases will be quite efficient; achieving this requires little
+innovation since database technology is already highly developed.  We begin by
+defining some important terms.
+
+.ls
+.ls DBIO
+The database i/o package, used by compiled programs to access a database.
+.le
+.ls DBMS
+The database management package, a CL level package used by the user to
+inspect, analyze, and manipulate the contents of a database.
+.le
+.ls database
+A set of one or more "relations" or tables (DBIO is a conventional relational
+database).  A convenient way to think of an IRAF database is as a directory.
+The relations appear as distinct files in the directory.
+.le
+.ls relation
+A relation is a set of \fBrecords\fR.  Each record consists of a set of
+\fBfields\fR, each characterized by a name and a datatype.  All the records
+in a relation have the same set of fields.  Perhaps the easiest way to
+visualize a relation is as a \fBtable\fR.  The rows and columns of the table
+correspond to the records and fields of the relation.
+.le
+.ls field
+A field of a record is characterized by an alphanumeric name, datatype, and
+size.  Fields may be one dimensional arrays of variable size.  Fields may be
+added to a relation dynamically at run time.  When a new field is added to
+a relation it is added to all records in the relation, but the value of the
+field in a particular record is undefined (and consumes no storage) until
+explicitly written into.
+.le
+.ls key
+.br
+A function of the values of one or more fields, used to select a subset of
+rows from a table.  Technically, a valid key will permit selection of any
+single row from a table, but we often use the term is a less strict sense.
+.le
+.le
+
+
+An \fBimage\fR appears in the database as a record.  The record is really
+just the image header; the pixels are stored external to the database in a
+separate file, storing only the name of the pixel storage file in the record
+itself (for very small images we are considering storing the pixels directly
+in the database file).  Note that the record is a simple flat structure;
+this simple structure places restrictions on the complexity of objects which
+can be stored in the database.
+
+The records in a relation form a set, not an array.  Records are referred to
+by a user-defined key.  A simple key might be a single field containing a
+unique number (like an array index), or a unique name.  More complex keys
+might involve pattern matching over one or more fields, selection of records
+with fields within a certain range of values, and so on.
+
+From the viewpoint of \fBonedspec\fR, a relation can be considered a
+\fBdata group\fR, consisting of a set of \fBspectra\fR.
+
+.nh 2
+Image Templates
+
+    The user specifies the set of spectra to be operated upon by means of an
+image template.  Image templates are much like the filename templates commonly
+used in operating systems.  The most simple template is the filename of
+a single data group; this template matches all spectra in the group.  If there
+is only one spectrum in a file, then only one spectrum is operated upon.
+A slightly more complex template is a list of filenames of data groups.
+More complex templates will permit use of expressions referencing the values
+of specific fields to select a subset of the spectra in a group.  The syntax
+of such expressions has not yet been defined (examples are given below
+nonetheless), but the function performed by an image template will be the same
+regardless of the syntax.  In all cases the image template will be a single
+string valued parameter at the CL level.
+
+.nh 2
+Standard Calling Sequence
+
+    The standard calling sequence for a unary image operator is shown below
+The calling sequence for a binary operator would be the same with a second input
+parameter added as the second argument.  In general, any data dependent
+control parameters should be implemented as positional arguments following
+the primary operands, and data independent or optional (rarely used) parameters
+should be implemented as hidden parameters.
+
+
+.ks
+.nf
+	imop (input, output, data_dependent_control_params)
+
+	imop	image operator name
+	input	image template specifying set of input images
+	output	filename of output datagroup
+
+	data_dependent_control_parameters
+	(hidden parameters)
+
+for example,
+
+	coincor (spectra, newgroup, dead_time)
+.fi
+.ke
+
+
+If a series of spectra are to be processed it seems reasonable to add the
+processed spectra to a new or existing data group (possibly the same as an
+input datagroup).  If the operation is to be performed in place a special
+notation (e.g. the null string) can be given as the output filename.
+At the \fBonedspec\fR level output filenames will not be defaulted.
+
+.nh 2
+Examples
+
+    Some examples of image templates might be useful to give a more concrete
+idea of the functionality which will be available.  Bear in mind that what we
+are describing here is really the usage of one of the fundamental IRAF system
+interfaces, the DBMS database management subsystem, albeit from the point of
+view of \fBonedspec\fR.  The same facilities will be available in any program
+which operates upon images, and in some non-image applications as well (e.g.
+the new \fBfinder\fR).  Our philosopy, as always, is to make standard usage
+simple, with considerable sophistication available for those with time to
+learn more about the system.
+
+The simplest case occurs when there is one spectrum per data group (file).
+For example, assuming that the file "a" contains a single spectrum, the
+command
+
+	cl> coincor a, b, .2
+
+would perform coincidence correction for spectrum A, placing the result in
+B, using a dead time parameter of .2.  For a more complex example, consider
+the following command:
+
+	cl> coincor "a.type=obj&coincor=no,b", a, .2
+
+This would perform coincidence correction for all spectra in group B plus all
+object spectra in group A which have not already been coincidence corrected,
+adding the corrected spectra to group A (notation approximate only).  If the
+user does not trust the database explicit record numbers may be used and
+referenced via range list expressions, e.g.,
+
+	cl> coincor "a.recnum=(1,5,7:11),b", a, .2
+
+would select records 1, 5, and 7 through 11 from data group A.  Alternatively
+the database utilities could be used to list the spectra matching the selection
+criteria prior to the operation if desired.  For example,
+
+	cl> db.select "a.type=obj"
+
+would write a table on the standard output (the terminal) wherein each spectrum
+in data group A is shown as a row of field values.  If one wanted to generate
+an explicit list of records to be processed with help from the database
+utilities, a set of records could be selected from a data group and selected
+fields from each record written into a text file:
+
+	cl> db.select "a.type=obj", "recnum, history" > reclistfile
+
+The output file "reclistfile" produced by this command would contain the
+fields "recnum" (record number) and "history" (description of processing
+performed to generate the record).  The editor could be used to delete
+unwanted records, producing a list of record numbers suitable for use as
+an image template:
+
+	cl> coincor "a.recnum=@reclistfile", a, .2
+
+.nh
+Reduction Operators
+
+.nh 2
+Line List Preparation
+
+    I suggest maintaining the line lists as text files so that the user can
+edit them with the text editor, or process them with the \fBlists\fR operators.
+A master line list might be maintained in a database and the DBMS \fBselect\fR
+operator used to extract ASCII linelists in the wavelength region of interest,
+but this would only be necessary if the linelist is quite large or if a linelist
+record contains many fields.  I don't think we need the \fBline_list\fR task.
+
+.nh 2
+Dispersion Solution
+
+    The problem with selecting a line list and doing the dispersion solution
+in separate operations is that the dispersion solution is invaluable as an aid
+for identifying lines and for rejecting lines.  Having a routine which merely
+tweaks up the positions of lines in an existing lineset (e.g., \fBalinid\fR)
+is not all that useful.  I would like to suggest the following alternate
+procedure for performing the dispersion solution for a set of calibration
+spectra which have roughly the same dispersion.
+
+.ls
+.ls [1] Generate Lineset [and fit dispersion]
+.sp
+Interactively determine the lineset to be used, i.e., wavelength (or whatever)
+and approximate line position in pixel units for N lines.  Input is one or more
+comparison spectra and optionally a list of candidate lines in the region
+of interest.  Output is the order for the dispersion curve and a linelist of
+the following (basic) form:
+
+	L#  X  Wavelength [Weight]
+
+It would be very useful if the program, given a rough guess at the dispersion,
+could match the standard linelist with the spectra and attempt to automatically
+identify the lines thus detected.  The user would then interactively edit the
+resultant line set using plots of the fitted dispersion curve to reject
+misidentified or blended lines and to adjust weights until a final lineset
+is produced.
+.le
+
+.ls [2] Fit Dispersion
+.sp
+Given the order and functional type of the curve to be fitted and a lineset
+determined in step [1] (or a lineset produced some any other means, e.g. with
+the editor), for each spectrum in the input data group tweak the center of
+each line in the lineset via an automatic centering algorithm, fit the
+dispersion curve, and save the coefficients of the fitted curve in the
+image header.  The approximate line positions would be used to find and measure
+the positions of the actual lines, and the dispersion curve would be fitted and
+saved in the image header of each calibration spectrum.
+
+While this operator would be intended to be used noninteractively, the default
+textual and graphics output devices could be the terminal.  To use the program
+in batch mode the user would redirect both the standard output and the graphics
+output (if any), e.g.,
+
+.nf
+	cl> dispsol "night1.type=comp", linelistfile, order,
+	>>> device=stdplot, > dispsol.spool &
+.fi
+
+Line shifts, correlation functions, statistical errors, the computed residuals
+in the fitted dispersion curves, plots of various terms of the dispersion
+curves, etc. may be generated to provide a means for later checking for
+erroneous solutions to the individual spectra.  There is considerable room for
+innovation in this area.
+.le
+
+.ls [3] Second Order Correction
+.sp
+If it is desired to interpolate the dispersion curve in some additional
+dimension such as time or hour angle, fit the individual dispersion solutions
+produced by [1] or [2] as a group to one or more additional dimensions,
+generating a dispersion solution of one, two or more dimensions as output.
+If the output is another one dimensional dispersion solution, the input
+solutions are simply averaged with optional weights.  This "second order"
+correction to a group of dispersion solutions is probably best performed by
+a separate program, rather than building it into \fBalineid\fR, \fBdispsol\fR,
+etc.  This makes the other programs simpler and makes it possible to exclude
+spectra from the higher dimensional fit without repeating the dispersion
+solutions.
+.le
+.le
+
+If the batch run [2] fails for selected spectra the dispersion solution for
+those spectra can be repeated interactively with operator [1].
+The curve fitting package should be used to fit the dispersion curve (we can
+extend the package to support \fBonedspec\fR if necessary).
+
+.nh 2
+Dispersion Correction
+
+    This function of this procedure is to change the dispersion of a
+spectrum or group of spectra from one functional form to another.
+At a mimimum it must be possible to produce spectra linear in wavelength or
+log wavelength (as specified), but it might also be useful to be able
+to match the dispersion of a spectrum to that of a second spectrum, e.g., to
+minimize the amount of interpolation required to register spectra, or
+to introduce a nonlinear dispersion for testing purposes.  This might be
+implemented at the CL parameter level by having a string parameter which
+takes on the values "linear" (default), "log", or the name of a record
+defining the dispersion solution to be matched.
+
+It should be possible for the output spectrum to be a different size than
+the input spectrum, e.g., since we are already interpolating the data,
+it might be nice to produce an output spectrum of length 2**N if fourier
+analysis is to be performed subsequently.  It should be possible to
+extract only a portion of a spectrum (perform subraster extraction) in the
+process of correcting the dispersion, producing an output spectrum of a
+user-definable size.  It should be possible for an output pixel to lie at
+a point outside the bounds of the input spectrum, setting the value of the
+output pixel to INDEF or to an artificially generated value.  Note that
+this kind of generality can be implemented at the \fBonedspec\fR level
+without compromising the simplicity of dispersion correction for a particular
+instrument at the \fBimred\fR level.
+
+.nh 3
+Line Centering Algorithms
+
+    For most data, the best algorithm in the set described is probably the
+parabola algorithm.  To reject nearby lines and avoid degradation of the
+signal to noise the centering should be performed within a small aperture,
+but the aperture should be allowed to move several pixels in either direction
+to find the peak of the line.
+
+The parabola algorithm described has these features,
+but as described it finds the extrema within a window about the
+initial position.  It might be preferable to simply walk up the peak nearest
+to the initial center.  This has the advantage that it is possible to center
+on a line which has a nearby, stronger neighbor which cannot itself be used
+for some reason, but which might fall within \fBparextent\fR pixels of the
+starting center.  The parabola algorithm as described also finds a local extrema
+rather than a local maximum; probably not what is desired for a dispersion
+solution.  The restriction to 3 pixels in the final center determination is
+bad; the width of the centering function must be a variable to accommodate
+the wide range of samplings expected.
+
+The parabola algorithm described is basically a grid search over
+2*\fIparextent\fR pixels for the local extrema.  What I am suggesting is
+an iterative gradient search for the local maximum.  The properties of the
+two algorithms are probably sufficiently different to warrant implementation
+of both as an option (the running times are comparable).  I suspect that
+everyone else who has done this will have their own favorite algorithm as
+well; probably we should study half a dozen but implement only one or two.
+
+.nh 2
+Field Flattening
+
+    It is not clear that we need special flat fielding operators for
+\fBonedspec\fR.  We have a two-dimensional operator which fits image lines
+independently which might already do the job.  Probably we should experiment
+with both the smoothing spline and possibly fourier filtering for removing
+the difficult medium frequency fluctuations.  The current \fBimred\fR flat field
+operator implements the cubic smoothing spline (along with the Chebyshev and
+Legendre polynomials), and is available for experimentation.
+
+Building interactive graphics into the operator which fits a smooth curve to
+the continuum is probably not necessary.  If a noninteractive \fBimred\fR or
+\fBimages\fR operator is used to fit the continuum the interactive graphics
+can still be available, but might better reside in a higher level CL script.
+The basic operator should behave like a subroutine and not write any output
+to the terminal unless enabled by a hidden parameter (we have been calling
+this parameter \fIverbose\fR in other programs).
+
+.nh 3
+Extinction Correction and Flux Calibration
+
+    I did not have time to review any of this.
+
+.nh
+Standard Library Packages
+
+    The following standard IRAF math library packages should be used in
+\fBonedspec\fR.  The packages are very briefly described here but are
+fully documented under \fBhelp\fR on the online (kpnob:xcl) system.
+
+.nh 2
+Curve Fitting
+
+    The curve fitting package (\fBcurfit\fR) is currently capable of fitting
+the Chebyshev and Legendre polynomials and the cubic smoothing spline.
+Weighting is supported as an option.
+We need to add a piecewise linear function to support the
+dispersion curves for the high resolution FTS spectra.  We may have to add a
+double precision version of the package to provide the 8-10 digits of
+precision needed for typical comparison line wavelength values, but
+normalization of the wavelength values may make this unnecessary for moderate
+resolution spectra.
+
+Ordinary polynomials are not supported because their numerical properties are
+very much inferior to those of orthogonal polynomials (the ls matrix can have
+a disastrously high condition number, and lacking normalization the function
+begin fitted is not invariant with respect to scale changes and translations
+in the input data).  For low order fits the Chebyshev polynomials are
+considered to have the best properties from an approximation theoretic point
+of view, and for high order fits the smoothing spline is probably best because
+it can follow arbitrary trends in the data.
+
+.nh 2
+Interpolation
+
+    The image interpolation package (\fBiminterp\fR) currently supports the
+nearest neighbor, linear, third and fifth order divided differences,
+cubic interpolating spline, and sinc function interpolators.
+We should add the zeroth and first order partial pixel ("flux conserving")
+interpolants because they offer unique properties not provided by any
+of the other interpolants.
+
+.nh 2
+Interactive Graphics
+
+    We will define a standard interactive graphics utility package for
+interactive operations upon data vectors (to be available in a system library
+in object form).  It should be possible to define a general package which
+can be used anywhere a data vector is to be plotted and
+examined interactively (not just in \fBonedspec\fR).  Standard keystrokes
+should be defined for common operations such as expanding a region of
+the plot and restoring the original scale.  This will not be attempted
+until an interactive version of the GIO interface is available later this
+fall.
+.endhelp
diff --git a/noao/onedspec/doc/sys/TODO b/noao/onedspec/doc/sys/TODO
new file mode 100644
index 00000000..0dfa136b
--- /dev/null
+++ b/noao/onedspec/doc/sys/TODO
@@ -0,0 +1,28 @@
+scombine:
+    1.  Combine with weights:
+	    By signal level
+	    By sigma spectrum
+
+doc:
+    Install SENSFUNC memo in the doc directory. (8/14)
+
+calibrate:
+    Have calibrate apply neutral density filter function.  This may also
+    have to be included in STANDARD and SENSFUNC. (2/25/87)
+
+splot:
+    Add a deblend option for PCYGNI profiles. (Tyson, 3/19/87)
+
+Tim Heckman (U. Maryland) came by with questions and requests
+concerning deblending in SPLOT.  Tim's comments are indicated in
+quotations.
+
+2. "The deblending should allow additional constraints if known.
+Specifically fixing the ratios of lines based on atomic physics."
+
+3.  "The deblending should provide some uncertainty estimates."  I added
+that there has also been a request to use known statistics in the
+pixel data themselves to generate uncertainty estimates.
+
+4.  "It would be useful to provide other choices for the profile rather
+than just gaussians."
diff --git a/noao/onedspec/doc/sys/coincor.ms b/noao/onedspec/doc/sys/coincor.ms
new file mode 100644
index 00000000..1b4d29cc
--- /dev/null
+++ b/noao/onedspec/doc/sys/coincor.ms
@@ -0,0 +1,46 @@
+.EQ
+delim $$
+.EN
+.OM
+.TO
+IIDS Users
+.FR
+F. Valdes
+.SU
+IIDS count rate corrections
+.PP
+The IRAF task \fBcoincor\fR transforms the observed count rates to
+something proportional to the input count rate.  The correction applied
+to the observed count rates depends upon the count rate and is instrument
+dependent.  One correction common to photomultiplier detectors and the
+IIDS is for coincident events, which is the origin of the task name.  
+The parameter \fIccmode\fR selects a particular type of correction.
+The value \fIccmode\fR = "iids" applies the following transformation to
+observed IIDS count rates.
+
+.EQ (1)
+	C sup ' ~=~(- ln (1- deadtime C)/ deadtime ) sup power
+.EN
+
+where $C$ is the orginal count rate, $C sup '$ is the corrected count
+rate, and $deadtime$ and $power$ are \fBcoincor\fR parameters.  The term
+inside the parenthesis is the correction for dead-time in the counting
+of coincident events on the back phospher of the image tube.  The power
+law correction is due to the non-linearity of the IIDS image tube chain.
+.PP
+The correction applied with the Mountain Reduction Code is only for
+coincidences, i.e. equation (1) with $power = 1$.  To obtain just this
+correction with \fBcoincor\fR set $power = 1$.  To take mountain reduced
+data and correct only for the non-linearity set \fIccmode\fR = "power".
+With raw IIDS data use \fBcoincor\fR with the default
+parameters.
+
+.LP
+References:
+.IP (1)
+L. Goad, \fBSPIE 172\fR, 1979, p. 86.
+.IP (2)
+G. Jacoby, Some Notes on the ONEDSPEC Package, \fBIRAF Handbook\fR
+.IP (3)
+P. Massey and J. De Veny, How Linear is the IIDS, \fBNOAO Newsletter\fR,
+#6, June 1986.
diff --git a/noao/onedspec/doc/sys/identify.ms b/noao/onedspec/doc/sys/identify.ms
new file mode 100644
index 00000000..6a69204b
--- /dev/null
+++ b/noao/onedspec/doc/sys/identify.ms
@@ -0,0 +1,347 @@
+.RP
+.TL
+Radial Velocity Measurements with IDENTIFY
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+August 1986
+Revised August 1990
+.AB
+The IRAF task \fBidentify\fP may be used to measure radial velocities.  
+This is done using the classical method of determining 
+the doppler shifted wavelengths of emission and absorption lines.  
+This paper covers many of the features and techniques available 
+through this powerful and versatile task which are not immediately 
+evident to a new user.
+.AE
+.sp 3
+.NH
+\fBIntroduction\fP
+.PP
+The task \fBidentify\fP is very powerful and versatile.  It can 
+be used to measure wavelengths and wavelength shifts for 
+doing radial velocity measurements from emission and 
+absorption lines.  When combined with the CL's ability 
+to redirect input and output both from the standard text 
+streams and the cursor and graphics streams virtually 
+anything may be accomplished either interactively or 
+automatically.  This, of course, requires quite a bit of 
+expertise and experience with \fBidentify\fP and with 
+the CL which a new user is not expected to be aware of initially.  
+This paper attempts to convey some of the possibilities.  
+There are many variations on these methods which the user 
+will learn through experience.
+.PP
+I want to make a caveat about the suggestions made in 
+this paper.  I wrote the \fBidentify\fP task and so I am 
+an expert in its use.  However, I am not a spectroscopist, 
+I have not been directly involved in the science of 
+measuring astronomical radial velocities, and I am not 
+very familiar with the literature.  Thus, the suggestions 
+contained in this paper are based on my understanding of 
+the basic principles and the abilities of the \fBidentify\fP 
+task.
+.PP
+The task \fBidentify\fP is used to measure radial velocities 
+by determining the wavelengths of individual emission 
+and absorption lines.  The user must compute the 
+radial velocities separately by relating the observed 
+wavelengths to the known rest wavelengths via the Doppler 
+formula.  This is a good method when the lines are 
+strong, when there are only one or two features, and 
+when there are many, possibly, weaker lines.  The 
+accuracy of this method is determined by the accuracy 
+of the line centering algorithm.
+.PP
+The alternative method is to compare an observed spectrum 
+to a template spectrum of known radial velocity.  This 
+is done by correlation or fourier ratio methods.  These 
+methods have the advantage of using all of the spectrum 
+and are good when there are many very weak and possibly 
+broad features.  Their disadvantages are confusion 
+with telluric lines, they don't work well with just a 
+few real features, and they require a fair amount of 
+preliminary manipulation of the spectrum to remove 
+continuum and interpolate the spectrum in logarithmic 
+wavelength intervals. IRAF tasks for correlation 
+and fourier ratio methods are under development at 
+this time.  Many people assume that these more abstract 
+methods are inherently better than the classical method.  
+This is not true, it depends on the quality and type of 
+data.
+.PP
+Wavelength measurements are best done on the original 
+data rather than after linearizing the wavelength 
+intervals. This is because 1) it is not necessary as 
+will be shown below and 2) the interpolation used to 
+linearize the wavelength scale can change the shape 
+of the lines, particularly strong, narrow emission 
+lines which are the best ones for determining radial 
+velocities.
+.PP
+This paper is specifically about \fBidentify\fP but one 
+should be aware of the task \fBsplot\fP which also may 
+be used to measure radial velocities.  It differs in 
+several respects from \fBidentify\fP.  \fBSplot\fP works 
+only on linearized data; the wavelength and pixel 
+coordinates are related by a zero point and wavelength 
+interval.  The line centering algorithms are different; 
+the line centering is generally less robust (tolerant 
+of error) and often less accurate.  It has many nice 
+features but is not designed for the specific purpose 
+of measuring positions of lines and, thus, is not as 
+easy to use for this purpose.
+.PP
+There are a number of sources of additional information 
+relating to the use of the task \fBidentify\fP.  The 
+primary source is the manual pages for the task.  As 
+with all manual pages it is available online with the 
+\fBhelp\fP command and in the \fIIRAF User Handbook\fP.  
+The NOAO reduction guides or cookbooks for the echelle 
+and IIDS/IRS include additional examples and discussion.  
+The line centering algorithm is the most critical 
+factor in determining dispersion solutions and radial 
+velocities.  It is described in more detail under the 
+help topic \fBcenter1d\fP online or in the handbook.
+.NH
+Method 1
+.PP
+In this method, arc calibration images are used to determine 
+a wavelength scale.  The dispersion solution is then transferred 
+to the object spectrum and the wavelengths of emission and 
+absorption lines are measured and recorded.  This is 
+relatively straightforward but some tricks will make this easier 
+and more accurate.
+.NH 2
+Transferring Dispersion Solutions
+.PP
+There are several ways to transfer the dispersion solution 
+from an arc spectrum to an object spectrum differing in the 
+order in which things are done.
+.IP (1)
+One way is to determine the dispersion solution for all the arc images
+first.  To do this interactively specify all the arc images as the
+input to \fBidentify\fP.  After determining the dispersion solution for
+the first arc and quitting (\fIq\fP key) the next arc will be displayed
+with the previous dispersion solution and lines retained.  Then use the
+cursor commands \fIa\fP and \fIc\fP (all center) to recenter and
+\fIf\fP (fit) to recompute the dispersion solution.  If large shifts
+are present use \fIs\fP (shift) or \fIx\fR (correlate peaks) to shift,
+recenter, and compute a wavelength zero point shift to the dispersion
+function.  A new dispersion function should then be fit with \fIf\fP.
+These commands are relatively fast and simple.
+.IP
+An important reason for doing all the arc images first 
+is that the same procedure can be done mostly noninteractively 
+with the task \fBreidentify\fP.  After determining a 
+dispersion solution for one arc image \fBreidentify\fP 
+does the recenter (\fIa\fP and \fIc\fP), shift and 
+recenter (\fIs\fP), or correlation features, shift, and 
+recenter (\fIx\fP) to transfer the dispersion solutions 
+between arcs.  This is usually done as a background task.
+.IP
+To transfer the solution to the object spectra specify 
+the list of object spectra as input to \fBidentify\fP.  
+For each image begin by entering the colon command 
+\fI:read arc\fP where arc is the name of the arc image 
+whose dispersion solution is to be applied; normally 
+the one taken at the same time and telescope position as 
+the object.  This will read the dispersion solution and arc 
+line positions.  Delete the arc line positions with the 
+\fIa\fP and \fId\fP (all delete) cursor keys.  You 
+can now measure the wavelengths of lines in the spectrum.
+.IP (2)
+An alternative method is to interactively alternate between 
+arc and object spectra either in the input image list or 
+with the \fI:image name\fP colon command.
+.NH 2
+Measuring Wavelengths
+.IP (1)
+To record the feature positions at any time use the \fI:features 
+file\fP colon command where \fIfile\fP is where the feature 
+information will be written.  Repeating this with the same 
+file appends to the file.  Writing to the database with the 
+\fI:write\fP colon command also records this information.  
+Without an argument the results are put in a file with 
+the same name as the image and a prefix of "id".  You 
+can use any name you like, however, with \fI:write 
+name\fP.  The \fI:features\fP command is probably preferable 
+because it only records the line information while the 
+database format includes the dispersion solution and 
+other information not needed for computing radial 
+velocities.
+.IP (2)
+Remember that when shifting between emission and absorption 
+lines the parameter \fIftype\fP must be changed.  This may be done 
+interactively with the \fI:ftype emission\fP and \fI:ftype 
+absorption\fP commands.  This parameter does not need to be 
+set except when changing between types of lines.
+.IP (3)
+Since the centering of the emission or absorption line is the 
+most critical factor, one should experiment with the parameter 
+\fIfwidth\fP.  To change this parameter type \fI:fwidth value\fP.  
+The positions of the marked features are not changed until a 
+center command (\fIc\fP) command is given.
+.IP
+A narrow \fIfwidth\fP is less influenced by blends and wings but 
+has a larger uncertainty.  A broad \fIfwidth\fP uses all of the 
+line profile and is thus stable but may be systematically influenced 
+by blending and wings.  One possible approach is to measure 
+the positions at several values of \fIfwidth\fP and decide which 
+value to use or use some weighting of the various measurements.  
+You can record each set of measurements with the \fI:fe 
+file\fP command.
+.IP (4)
+For calibration of systematic effects from the centering one should 
+obtain the spectrum of a similar object with a known radial 
+velocity.  The systematic effect is due to the fact that the 
+centering algorithm is measuring a weighted function of the 
+line profile which may not be the true center of the line as 
+tabulated in the laboratory or in a velocity standard.  By 
+using the same centering method on an object with the same line 
+profiles and known velocity this effect can be eliminated.
+.IP (5)
+Since the arcs are not obtained at precisely the same time 
+as the object exposures, there may be a wavelength shift relative 
+to the arc dispersion solution.  This may be calibrated from 
+night sky lines in the object itself (the night sky lines are 
+"good" in this case and should not be subtracted away).  There are 
+generally not enough night sky lines to act as the primary 
+dispersion calibrator but just one can determine a possible 
+wavelength zero point shift.  Measure the night sky line 
+positions at the same time the object lines are measured.  
+Determine a zero point shift from the night sky to be 
+taken out of the object lines.
+.NH
+Method 2
+.PP
+This method is similar to the correlation method in that a 
+template spectrum is used and the average shift relative 
+to the template measures the radial velocity. This has the 
+advantage of not requiring the user to do a lot of calculations 
+(the averaging of the line shifts is done by identify) but is 
+otherwise no better than method 1.  The template spectrum must 
+have the same features as the object spectrum.
+.IP (1)
+Determine a dispersion solution for the template spectrum 
+either from the lines in the spectrum or from an arc calibration.
+.IP (2)
+Mark the features to be correlated in the template spectrum.
+.IP (3)
+Transfer the template dispersion solution and line positions 
+to an object spectrum using one of the methods described 
+earlier.  Then, for the current feature, point the cursor near 
+the same feature in the object spectrum and type \fIs\fP.  The 
+mean shift in pixels, wavelength, and fractional wavelength (like 
+a radial velocity without the factor of the speed of light) 
+for the object is determined and printed.  A new dispersion 
+solution is determined but you may ignore this.
+.IP (4)
+When doing additional object spectra, remember to start over 
+again with the template spectrum (using \fI:read template\fP) 
+and not the solution from the last object spectrum.
+.IP (5)
+This procedure assumes that the dispersion solution between 
+the template and object are the same.  Checks for zero point
+shifts with night sky lines, as discussed earlier, should be 
+made if possible.  The systematic centering bias, however, is 
+accounted for by using the same lines from the template radial 
+velocity standard.
+.IP (6)
+One possible source of error is attempting to use very weak 
+lines.  The recentering may find the wrong lines and affect 
+the results.  The protections against this are the \fIthreshold\fP 
+parameter and setting the centering error radius to be relatively small.
+.NH
+Method 3
+.PP
+This method uses only strong emission lines and works with 
+linearized data without an \fBidentify\fP dispersion 
+solution; though remember the caveats about rebinning the
+spectra.  The recipe involves measuring 
+the positions of emission lines.  The 
+strongest emission lines may be found automatically using 
+the \fIy\fP cursor key.  The number of emission lines to 
+be identified is set by the \fImaxfeatures\fP parameter.  
+The emission line positions are then written to a data file 
+using the \fI:features file\fP colon command.  This may 
+be done interactively and takes only a few moments per 
+spectrum.  If done interactively, the images may be chained 
+by specifying an image template. The only trick required 
+is that when proceeding to the next spectrum the previous 
+features are deleted using the cursor key combination \fIa\fP 
+and \fId\fP (all delete).
+.PP
+For a large number of images, on the order of hundreds, this 
+may be automated as follows.  A file containing the cursor 
+commands is prepared.  The cursor command format consists 
+of the x and y positions, the window (usually window 1), and 
+the key stroke or colon command.  Because each new image from 
+an image template does not restart the cursor command file, 
+the commands would have to be repeated for each image in 
+the list.  Thus, a CL loop calling the task each time with 
+only one image is preferable.  Besides redirecting the 
+cursor input from a command file, we must also redirect the 
+standard input for the response to the database save query, the 
+standard output to discard the status line information, and , 
+possibly, the graphics to a metacode file which can then be 
+reviewed later. The following steps indicate what is to be 
+done.
+.IP (1)
+Prepare a file containing the images to be measured (one per line).
+This can usually be done using the sections command to expand 
+a template and directing the output into a file.
+.IP (2)
+Prepare a cursor command file (let's call it cmdfile) 
+containing the following two lines.
+.RS
+.IP
+.nf
+.ft CW
+1 1 1 y
+1 1 1 :fe positions.dat
+.ft P
+.fi
+.RE
+.IP (3)
+Enter the following commands.
+.RS
+.IP
+.nf
+.ft CW
+list="file"
+while (fscan (list,s1) !=EOF){
+print ("no") \(or identify (sl,maxfeatures=2, cursor="cmdfile",
+>"dev$null", >G "plotfile")
+}
+.ft P
+.fi
+.RE
+.LP
+Note that these commands could be put in a CL script and executed 
+using the command
+.sp
+.IP
+.ft CW
+on> cl <script.cl
+.ft P
+.sp
+.PP
+The commands do the following.  The first command initializes the 
+image list for the loop.  The second command is the loop to 
+be run until the end of the image file is reached.  The 
+command in the loop directs the string "no" to the standard 
+input of identify which will be the response to the database save 
+query.  The identify command uses the image name obtained from the list 
+by the fscan procedure, sets the maximum number of features to be 
+found to be 2 (this can be set using \fBeparam\fP instead), the 
+cursor input is taken from the cursor command file, the standard 
+output is discarded to the null device, and the STDGRAPH output 
+is redirected to a plot file.  If the plot file redirection is 
+not used, the graphs will appear on the specified graphics 
+device (usually the graphics terminal).  The plot file can then 
+be disposed of using the \fBgkimosaic\fP task to either the  
+graphics terminal or a hardcopy device.
diff --git a/noao/onedspec/doc/sys/onedproto.ms b/noao/onedspec/doc/sys/onedproto.ms
new file mode 100644
index 00000000..b1b05201
--- /dev/null
+++ b/noao/onedspec/doc/sys/onedproto.ms
@@ -0,0 +1,1673 @@
+.RP
+.ND
+.TL
+Some Notes on the ONEDSPEC Package
+.AU
+G. Jacoby
+.AI
+.K2 "" "" "*"
+June 1985
+.AB
+The first phase of the ONEDSPEC prototype package is complete.
+Comments and some internal description is presented for each task 
+in the package. Also presented are some more global descriptions
+of strategies used in the package and considerations for future
+improvements.
+.AE
+.SH
+1. Why is ONEDSPEC Different?
+.PP
+This section describes some of the ways in which the ONEDSPEC
+package diverges from other IRAF package strategies.
+A few of these should someday be modified to more closely
+adhere to IRAF conventions, but in other cases, restrictions
+or limitations in the IRAF system are revealed.
+.sp 1
+.SH
+Quantity
+.PP
+One of the major differences between a two dimensional image processing
+package and a one dimensional package is that spectra 
+frequently congregate in groups of hundreds to thousands while two-dimensional
+images live in groups of tens to hundreds. What this means is that spectral
+processing must be somewhat more automated and streamlined - the software cannot
+rely on user input to provide assistance and it cannot afford
+excessive overhead; otherwise  a large fraction of the processing time will be
+spent where it is least useful.
+.PP
+To process large volumes of spectra in a reasonably automated fashion,
+the software must be smart enough to know what to do with a variety
+of similar but different spectra. The way adopted here is to key
+off header parameters which define the type of spectrum and the
+processing required. In fact, most of the ONEDSPEC package will not
+work smoothly without some header parameter information.
+.PP
+It is also important that each task be self-reliant so that the
+overhead of task stop and restart is avoided. For many operations,
+the actual computation time is a fraction of a second, yet no
+operation in the ONEDSPEC package is faster than one second per spectrum
+due to task overhead. If task startup and stop were required for each
+spectrum, then the overhead would be much worse.
+.PP
+So the philosophy is one in which each task uses as much information
+as it can reasonably expect from the spectral image header.
+Usually this is not more than three or four elements.
+The strategy of using header information should not be limited to
+ONEDSPEC. Many image processing problems can be automated
+to a large degree if header information is used. The success of
+the KPNO CCD Mountain reduction system emphasizes this point.
+It would seem prudent that other IRAF applications make use of
+such information when possible.
+[See section 3 for a more detailed discussion of headers.]
+.sp 1
+.SH
+Spectral Image Names
+.PP
+One implication of the quantity problem is that it must be easy for the user to
+specify the names of large numbers of spectra.  The approach taken for ONEDSPEC
+was to assign a root name to a group of spectra and then
+append an index number of 4 or more digits starting with 0000.
+So spectra, by default, have the form root.0000, root.0001, ...
+To specify the spectra, the user types only the root name and the range
+of indices such as "root" and "0-99,112-113,105-108".
+The range decoder accesses the spectral indices in the order given
+as opposed to access in ascending order, so that the spectrum root.0112
+will be processed before root.0105 in the example specification above.
+Spectra having more general names may be specified using the
+standard IRAF filename expansion methods if the 
+the range specification is given as null.
+.PP
+The specification of large numbers of images is an area where
+most IRAF applications are weak. Resorting to odd combinations
+of bracket and backslash characters in filename specifications 
+is obscure to new users and still fails to
+meet the general need. The range specification adopted for ONEDSPEC
+comes closer but introduces a fixed image name format.
+.sp 1
+.SH
+Apertures -- A way to group data
+.PP
+Many spectrographs generate multiple spectra simultaneously by
+placing more than one slit or aperture in the focal plane.
+Examples include the IIDS, IRS, and Cryogenic Camera in use
+at Kitt Peak. The Echelle may be considered a multi-aperture
+instrument for purposes of reductions by associating each order
+with an "aperture" number. 
+.PP
+The concept of aperture can be generalized to indicate a set of
+spectral data having common group properties such as
+wavelength coverage. Most tasks in ONEDSPEC will key off
+an aperture number in the image header and treat those
+common aperture spectra uniformly.
+Defining data groups which are to be processed in this fashion
+is a technique not generally exploited by reduction programs.
+This is  due in part to the problem of image header usage.
+.PP
+For programming convenience and to avoid an additional level
+of indirectness, in ONEDSPEC the aperture number is used directly as an
+index in many static arrays. The current implementation has
+a declaration for 50 apertures and due to the IIDS/IRS
+notation of apertures 0 and 1, the apertures are zero-indexed, contrary
+to standard IRAF nomenclature,
+from 0-49. It would certainly be better to map the aperture numbers
+to the allowable index range, but the added complexity of another
+level of indirectness seemed distracting. Actually the mapping
+can still be done by the header reader, "load_ids_hdr", and
+unmapped by the header writer, "store_keywords".
+.sp 1
+.SH
+Static versus dynamic arrays
+.PP
+Although dynamic storage would alleviate some of the memory
+requirements in the package, the use of static arrays aids
+readability and accounts for only about 10 percent of the total
+task memory space. Many of the arrays are arrays of pointers.
+For example, in the task BSWITCH, there is an array (called "imnames") 
+of pointers for the names of spectral images, several for each aperture.
+The actual space for the names is dynamically allocated,
+so first we allocate an array of pointers for each
+aperture:
+.sp 1
+.DS
+     call salloc (imnames[aperture], nr_names, TY_POINT)
+.DE
+.sp 1
+Then, for each of these pointers, space must be allocated for the
+character arrays:
+.sp 1
+.DS
+     do i = 1, nr_names
+         call salloc (Memp[imnames[aperture]+i-1], SZ_LINE, TY_CHAR)
+.DE
+.sp 1
+Later to access the character strings, a name is specified as:
+.sp 1
+.DS
+     Memc[Memp[imnames[aperture]+nr_of_this_spectrum-1]]
+.DE
+.sp 1
+If the "imnames" array was also dynamically allocated, the
+above access would be even less readable.
+If memory requirements become a serious problem, then these ONEDSPEC
+tasks should be modified.
+.sp 1
+.SH
+Output image names
+.PP
+To retain the consistent usage of root names and ranges, output
+spectra also have the form root.nnnn. For user convenience,
+the current output root name and next suffix are maintained as
+package parameters onedspec.output and onedspec.next_rec.
+The latter parameter is automatically updated each time a
+new spectrum is written. This is done by the individual tasks
+which directly access this package parameter.
+.PP
+There is an interesting side effect when using indirect parameters
+(e.g. )onedspec.output) for input. In the local task parameter
+file, the mode of the parameter must be declared hidden. So when the user
+does an "lpar task", those parameters appear to be unnecessary
+(that is, they are enclosed in parenthesis). When run,
+prompts appear because the parameter is an automatic mode
+parameter in the package parameter file.
+If run as a background task, this is more annoying.
+Unfortunately, any other choice of parameter modes produces
+less desirable actions.
+.sp 1
+.SH
+ONEDUTIL
+.PP
+As the number of tasks in ONEDSPEC started growing, the
+need for a subdivision of the package became clear.
+The first cut was made at the utility level, and a number
+of task names (not necessarily physical tasks) were
+moved out into the ONEDUTIL submenu. In the future,
+additional tasks will eventually require another subpackage.
+.PP
+Actually, many of the tasks in ONEDUTIL may be more at home
+in some other package, but a conscious effort was made to
+avoid contaminating other IRAF packages with tasks written for
+the ONEDSPEC project.  If all the following tasks are relocated, 
+then the need for ONEDUTIL is reduced.
+.PP
+Two of the entries in ONEDUTIL may be considered as more appropriate
+to DATAIO - RIDSMTN and WIDSTAPE. In fact RIDSMTN can
+replace the version currently in DATAIO. WIDSTAPE may replace the
+DATAIO task WIDSOUT if the usage of header parameters does not
+present a problem.
+.PP
+The task MKSPEC may be a candidate for the ARTDATA package.
+It should be enhanced to include optional noise generation.
+Also, it may be appropriate for SINTERP to replace INTERP
+in the UTILITY package.
+.PP
+I suppose one could argue that SPLOT belongs in the PLOT package.
+Certainly, the kludge script BPLOT should be replaced by a more
+general batch plot utility in PLOT.
+Also, the two task names, IDENTIFY and REIDENTIFY are present
+in the ONEDSPEC menu for user convenience, but the task declarations
+in ONEDSPEC.CL refer to tasks in the LONGSLIT package.
+.PP
+Because ONEDUTIL is a logical separation of the tasks, not
+a complete physical task breakup, there is no subdirectory
+for ONEDUTIL as there is in other packages. This is a bit messy
+and it may be best to completely disentangle the tasks in the
+subpackage into a true package having all the implications.
+.LP
+.SH
+2. Task Information
+.PP
+There are currently about 30 tasks in the ONEDSPEC package.
+These are summarized in the menu listing below and
+a brief description of some less obvious aspects of each follows.
+.sp 1
+.DS L
+   ONEDSPEC
+
+	addsets   - Add subsets of strings of spectra
+	batchred  - Batch processing of IIDS/IRS spectra
+	bswitch   - Beam-switch strings of spectra to make obj-sky pairs
+	calibrate - Apply sensitivity correction to spectra
+	coincor   - Correct spectra for photon coincidence
+	dispcor   - Dispersion correct spectra
+	extinct   - Correct data for atmospheric extinction
+	flatfit   - Sum and normalize flat field spectra
+	flatdiv   - Divide spectra by flat field
+	identify  - Identify features in spectrum for dispersion solution
+	iids	  - Set reduction parameters for IIDS
+	irs	  - Set reduction parameters for IRS
+	onedutil  - Enter ONEDSPEC Utility package
+	process   - A task generated by BATCHRED
+	reidentify- Automatically identify features in spectra
+	sensfunc  - Create sensitivity function
+	slist     - List spectral header elements
+	splot     - Preliminary spectral plot/analysis
+	standard  - Identify standard stars to be used in sensitivity calc
+	subsets   - Substract pairs in strings of spectra
+
+   ONEDUTIL
+
+	bplot	  - Batch plots of spectra
+	coefs     - Extract mtn reduced ceofficients from henear scans
+	combine   - Combine spectra having different wavelength ranges
+	lcalib	  - List calibration file data
+	mkspec    - Generate an artificial spectrum
+	names     - Generate a list of image names from a string
+	rebin     - Rebin spectra to new dispersion parameters
+	ridsmtn   - Read IIDS/IRS mountain format tapes
+	sinterp   - Interpolate a table of x,y pairs to create a spectrum
+	widstape  - Write Cyber format IDSOUT tapes
+.DE
+.sp 1
+.SH
+ADDSETS
+.PP
+Spectra for a given object may have been observed through more than
+one instrument aperture. For the IIDS and IRS, this is the most common
+mode of operation. Both apertures are used to alternately observe
+the program objects. 
+.PP
+Each instrument aperture may be considered an
+independent instrument having unique calibration properties, and
+the observations may then be processed completely independently
+until fully calibrated. At that point the data may be combined to
+improve signal-to-noise and reduce systematic errors associated
+with the alternating observing technique. Because the data are
+obtained in pairs for IIDS and IRS (but may be obtained in groups
+of larger sizes from other instruments), ADDSETS provides a way 
+to combine the pairs of observations.
+.PP
+Each pair in the input string is added to produce a single output
+spectrum. Although the word "pair" is used here, the parameter
+"subset" defines the number of elements in a "pair" (default=2).
+The input string is broken down into groups where each group
+consists of the pair of spectra defined in order of the input
+list of image names.
+.PP
+"Add" in ADDSETS means:
+.RS
+.IP 1.
+Average the pairs if the data are calibrated to flux (CA_FLAG=0)
+optionally weighted by the integration time.
+.IP 2.
+Add the pairs if uncalibrated (CA_FLAG=-1).
+.RE
+.sp 1
+.SH
+BATCHRED
+.PP
+This is a script task which allows spectra from dual aperture instruments
+to be processed completely in a batch mode after the initial wavelength
+calibration and correction has been performed. The processes which
+may be applied and the tasks referenced are:
+.RS
+.IP 1.
+Declaring observations as standard stars for flux calibration (STANDARD).
+.IP 2.
+Solving for the sensitivity function based on the standard stars (SENSFUNC).
+.IP 3.
+Generating object minus sky differences and summing individual
+observations if several were made (BSWITCH).
+.IP 4.
+Correcting for atmospheric extinction (BSWITCH).
+.IP 5.
+Applying the system sensitivity function to generate flux calibrated
+data (CALIBRATE).
+.IP 6.
+Adding pairs of spectra obtained through the dual apertures (ADDSETS).
+.RE
+Any or all of these operations may be selected through the task
+parameters.
+.PP
+BATCHRED generates a secondary script task called PROCESS.CL
+which is a text file containing  constructed commands to the
+ONEDSPEC package. This file may be edited by the user if an
+entry to BATCHRED is incorrect. It may also be saved, or appended
+by further executions of BATCHRED.
+.PP
+BATCHRED also generates a log file of the output generated by the
+ONEDSPEC tasks it calls.
+.sp 1
+.SH
+BSWITCH
+.PP
+This task combines multiple observations of a single object
+or multiple objects taken through a multiaperture instrument.
+Object minus sky differences are generated as pairs of
+spectra are accumulated, then optionally corrected for
+atmospheric extinction, and the differences added together
+with optional weighting using counting statistics.
+Each instrument aperture is considered an independent
+device.
+.PP
+Despite the apparently simple goal of this task, it is probably
+the most complicated in the ONEDSPEC package due to the
+bookkeeping load associated with automated handling of large data sets
+having a number of properties associated with each spectrum (e.g
+object or sky, aperture number, exposure times).
+.PP
+There are several modes in which BSWITCH can operate. The mode
+appropriate to the IIDS and IRS assumes that the spectra
+are input in an order such that after 2N (N=number of
+instrument apertures) spectra have been
+accumulated, an equal number of object and sky spectra have been
+encountered in each aperture. 
+When in this mode, a check is made after 2N spectra
+have been processed, and the optional extinction correction is
+applied to the differences of the object minus sky, and then
+(optionally weighted and) added into an accumulator for the aperture.
+.PP
+If the IIDS mode is switched off, then no guarantee can be
+made that sky and object spectra pair off. If extinction
+correction is required, it is performed on each spectrum
+as it arrives, including sky spectra if any. The spectra are
+then added into separate accumulators for object and sky for
+each aperture after optional weighting is applied.
+.PP
+If after all spectra have been processed, there are no sky
+spectra, the object spectrum is written out. If there is no
+object spectrum, the sky spectrum is written out after
+multiplying by -1. (This allows adding an object later on with
+addsets, but the -1 multiply is probably a mistake.)
+If at least one of each, object and sky spectra were encountered,
+then the difference is computed and written out. Since
+all accumulations are performed in count rates and later converted
+back to counts, the object and sky spectra may have different
+exposure times (non IIDS mode only).
+.PP
+A statistics file is maintained to provide an indication of the
+quality of the individual spectra going into the sum. The
+statistics information is maintained internally and only
+written out after the sums have been generated.
+The basic data in the file is the count rate of the spectrum
+having the largest count rate, and the ratios of the count rates from
+all other spectra to that one.
+.PP
+If weighting is selected, the weights are taken as proportional to
+the count rate (prior to extinction correction) over a wavelength 
+delimited region of the spectrum. (Perhaps the weight
+should be proportional to counts, not count rate.)
+The default wavelength region is the entire spectrum.
+If the total count rate is negative, the weight is assigned
+a value of 0.0 and will be disregarded in the sum. (The counts
+may be negative if the object minus sky difference approaches zero
+on a bright and cloudy night.)
+.PP
+If extinction is selected, an extinction table is read from the
+package calibration file. An optional additive term may be applied
+as computed by the system sensitivity task SENSFUNC which is placed
+in the parameter sensfunc.add_const. A revision to the standard
+extinction table (delta extinction as a function of wavelength)
+may be read from a text file whose name is specified by the parameter
+sensfunc.rev_ext_file. The file format is that of a text file
+having pairs of (wavelength, delta extinction) on each line.
+[The option to solve for this function in SENSFUNC has not yet been
+implemented, but BSWITCH can read the file that would be generated.
+Thus, one can experiment with revisions, although this has never been
+tested.] BSWITCH will interpolate the values given in the file
+so that a course estimate of the revision may be entered, say if the
+deltas at U, B, V, R, and I are known.
+.PP
+BEWARE that the extinction correction is performed assuming the
+header parameters used for airmass refer to a "mean" airmass value
+for the exposure. In general the header value is wrong! It usually
+refers to the beginning, middle, or end of the exposure. I have
+never seen a header airmass value which was an equivalent airmass
+for the duration of the exposure. This is partly because there is
+no way to compute a single effective airmass; it is a function
+of wavelength, telescope position as a function of time, and
+the extinction function. Fortunately, for most observations
+this is not very significant. But anyone taking a one hour exposure near 
+3500 Angstroms at airmass values greater than 2, should not complain
+when the fluxes look a bit odd.
+.sp 1
+.SH
+CALIBRATE
+.PP
+Having a system sensitivity function allows the data to be
+placed on an absolute flux scale. CALIBRATE performs this
+correction using the output sensitivity function from SENSFUNC. Operations are
+keyed to the instrument aperture, and a system sensitivity
+function is required for each observing aperture, although
+this requirement may be overriden.
+.PP
+A valid exposure time is required (a value of 1.0 should
+probably be assumed if not present) to compute the observed
+count rate. Input counts are transformed to units of
+ergs/cm2/sec/Angstrom (or optionally ergs/cm2/sec/Hz).
+CALIBRATE will calibrate two dimensional images as well, applying the
+sensitivity function to all image lines.
+.PP
+The operation is performed on a pixel-by-pixel basis so that
+the defined sensitivity function should overlap precisely
+with data in terms of wavelength.
+.sp 1
+.SH
+COINCOR
+.PP
+This task applies a statistical correction to each pixel
+to account for undetected photoevents as a result of
+coincidental arrival of photons. This is a detector
+specific correcton, although the photoelectric detector
+model provides a reasonable correction for many detectors
+when a judicious value for the deadtime parameter is chosen.
+This model assumes that the correction follows the
+typical procedures applied to photoelectric photometer data:
+.sp 1
+.DS L
+     Ic = Io * exp [Io * dt / T]
+.DE
+.sp 1
+where Ic is the corrected count rate in a pixel, Io is the
+observed count rate in that pixel, dt is the detector deadtime,
+and T is the observation integration time.
+.PP
+In addition to the photoelectric model, a more accurate model
+is available for the IIDS and is included in COINCOR. This
+model is taken from Goad (1979, SPIE Vol 172, 86.) and the correction
+is applied as:
+.sp 1
+.DS L
+     Ic = ln [1 - Io * t] / t
+.DE
+.sp 1
+where t is sweep time between pixel samples (t=1.424 msec).
+The IIDS differs from a photomultiplier detector, in that
+there is a fixed rate at which each pixel is sampled due to
+time required for the dissector to sweep across the image tube
+phospher whether a photoevent has occurred in a pixel or not. 
+The photomultiplier plus discriminator system
+assumes that once a photoevent has been recorded, the detector is
+dead until a fixed interval has elapsed.
+.sp 1
+.SH
+DISPCOR
+.PP
+If a relation is known linking pixel coordinate to user coordinate
+(i.e. wavelength as a function of pixel number), then any non-linearities
+can be removed by remapping the pixels to a linear wavelength coordinate.
+This procedure, dispersion correction, is complicated by the
+lack of a wavelength-pixel solution which is derived from data simultaneously
+obtained with the object data. Any drifts in the detector then require
+an interpolation among solutions for the solution appropriate to
+the object observations. Depending on the detector, this interpolation
+may be a function of the time of observation, temperature, or some telescope
+parameter such as airmass.
+When multiple solutions are available, DISPCOR will linearly interpolate
+the solution in any available header parameter known to ONEDSPEC (see
+section 3).
+.PP
+Each solution is read from the database file created by the IDENTIFY
+task (in TWODSPEC$LONGSLIT), and the image name leading to that solution
+is also read from the database file. The image is opened to extract
+the header parameter to be used in the above interpolation.
+A null name for the interpolation parameter indicates that none
+is to be used. In this case, one of the options on the "guide"
+parameter should be set to indicate what solution should be used.
+The guide may be "precede", "follow", or "nearest" to select
+the most appropriate choice for each spectrum.
+.PP
+If an explicit wavelength solution is to be used, the parameter
+"reference" may be used to specify the image name of a comparison
+spectrum to be used as the reference for the wavelength solution.
+In this case all spectra will be corrected using a single solution - 
+no flexure correction will be applied.
+.PP
+If the parameter to be used for interpolation is a "time-like"
+variable, such as RA, UT, ST, then the variable is discontinuous
+at 24|0 hours. If UT is the chosen parameter (as has been the
+case for IIDS and IRS spectra), the discontinuity occurs at
+5 PM local Kitt Peak time. A comparison spectrum taken at 4:59PM
+(=23:59h UT, =just before dinner), will be treated as an "end of
+the night" observation rather than a beginning of the night
+observation. To circumvent this error, the parameter, "time_wrap",
+can be specified to a time at which a true zero should be assigned.
+For UT at Kitt Peak, a choice like 17h UT (=10AM local, =asleep),
+is an unlikely hour for nighttime observations to be made. Then for
+a given night's observations, 17h UT becomes the new zero point in time.
+.PP
+Each solution in the database may be any of the forms legal 
+to IDENTIFY: legendre, chebyshev, spline3, or spline1 - the form 
+is encoded in the database and will automatically be recalled.
+The interpolation in the solution is performed by locating the
+pixel location for each required wavelength for the two
+solutions bounding each observation and linearly interpolating
+for the appropriate pixel location. One cannot simply interpolate
+across the coefficients of the solutions to derive a new
+single solution because the solutions may have different forms
+or orders, so that the coefficients may have quite different
+meanings.
+.PP
+Dispersion correction requires that there be equal intervals
+of wavelength between pixels. The wavelength solution
+is of a form describing the wavelength for a given pixel location,
+not a pixel location for a given wavelength. So the solution
+must be inverted.
+.PP
+The inversion to pixel location for wavelength is done in the
+following way: The pixel coordinate in the solution is incremented
+until the desired wavelength is bounded. The pixel value for the
+desired wavelength is obtained by linearly interpolating across these
+two bounding pixel locations. A linear approximation appears to be
+very good for typical solutions, providing proper pixel locations to
+better than 0.01 pixels. An improvement may be obtained by
+increasing the order of the interpolation, but the improvement
+is generally not warranted because the wavelength solutions
+are rarely known to this accuracy. [Note that the use of real
+and not double precision limits the precision of this technique!
+For spectra longer than 50,000 pixels, the errors due to
+the precision of reals can be serious.]
+.PP
+Note that a transformation to
+a wavelength coordinate which is linear in the logarithm of
+wavelength only requires that the inversion occur at wavelengths
+selected by equal increments in the logarithm of wavelength.
+.PP
+During the actual remapping, 5 possible techniques are available.
+Actually there are only two techniques: re-interpolation in 4 flavors,
+and rebinning by partial pixel summation. The re-interpolation
+may be performed with polynomials of order 1 (=linear), 3, or 5,
+or by a cubic spline. The 3rd and 5th order polynomials may introduce
+some ringing in the wings of strong, sharp, features, but the 5th order
+is good at preserving the high frequency component of the data.
+The linear and spline interpolators introduce significant smoothing.
+The rebinning algorithm offers conservation of flux but also smooths
+the data. In fact, rebinning to a course grid offers a good smoothing
+algorithm.
+.PP
+At some future date, it would be a good idea to include a "synch"
+function interpolator in the image interpolator package. This would
+be a little slower to process, but results in very good frequency
+response.
+.PP
+Other options in DISPCOR include "ids_mode" which forces spectra
+from all apertures to a single output mapping (starting wavelength
+and pixel-to-pixel increment), and "cols_out" forces the output spectra
+to a specified length, zero-filling if necessary.
+.PP
+DISPCOR will correct two-dimensional data by applying the
+remapping to all lines in the image. If the input two-dimensional
+spectrum has only one line, the output spectrum will be written as
+a one-dimensional spectrum.
+.sp 1
+.SH
+EXTINCT
+.PP
+Extinction is currently only available as a script file which drives
+BSWITCH. This is possible by suppressing all options: weighting,
+ids_mode, statistics file, and setting the subset pair size to the
+number of instrument apertures.
+.sp 1
+.SH
+FLATDIV
+.PP
+This task divides the specified spectra by their flat field spectra.
+This is not much more than an "en mass" spectrum divider, with the
+exceptions that the header elements are used to key on the
+aperture number so that the appropriate flat field spectrum is used,
+and that the header processing flags are checked to prevent
+double divisions and subsequently set after the division. Also,
+division by zero is guarded by setting any zeroes in the flat field
+spectrum to 1.0 prior to the division.
+.sp 1
+.SH
+FLATFIT
+.PP
+Pixel-to-pixel variations in the detector response can be removed
+by dividing all observations by a flat field spectrum.
+Flat field spectra are generally obtained by observing a source
+having a continuous energy distribution, such as a tungsten filament
+lamp. This is sometimes called a "quartz" lamp when the enclosing
+glass bulb is made with quartz rather than silicon. The quartz
+enclosure transmits ultraviolet light much better than glass.
+.PP
+If the color temperature of the source is very low (or very high, though
+this is extremely unlikely), then a color term would be introduced
+into the data when the flat is divided into the data.
+Large scale variations in the system sensitivity also introduce a
+color term into the flat - the same variations that are introduced into
+any spectrum taken with the system. [Large scale variations are 
+evaluated by STANDARD and SENSFUNC, and removed by CALIBRATE.]
+This is not of any particular importance except that counting
+statistics are destroyed by the division.
+.PP
+To preserve the statistics, many find it desirable to divide by a flat
+field spectrum which has been filtered to remove any large scale variations
+but in which the pixel-to-pixel variations have been retained.
+A filtered flat can be obtained by fitting a low order polynomial
+through the spectrum and dividing the spectrum by the polynomial.
+The result is a spectrum normalized to 1.0 and having high frequency
+variations only. If one does not care to preserve the statistics,
+then this procedure is not required. In fact, for certain instruments
+(the IRS), the fitting and normalizing procedure is not recommended
+because some intermediate order curvature can be introduced.
+.PP
+The purpose of FLATFIT is to find the combination of parameters
+which produces a well flattened flat with a minimum of wiggles.
+The usual curve fitting package is used to fit a function (chebyshev,
+legendre, spline3, spline1) to the flats. Pixel rejection is
+user selectable by a choice of cutoff sigmas, both above and below
+the mean, and an optional growing region [A growing region is the number
+of pixels on either side of one rejected which will also be rejected - 
+Growing regions are not recommended for most spectral applications].
+Any number of iterations may be used to further reject discrepant
+pixels. The fitting may be performed interactively and controlled by cursor
+keystrokes to select the fitting order, and other fit parameters.
+.PP
+Prior to the fit, the specified spectra are read, optionally corrected
+for coincidence losses, and added to accumulators appropriate to
+their instrument apertures. Each aperture is treated independently,
+except that, the interactive fitting mode may be selected to operate
+on the first aperture only, and then apply the same fitting parameters
+to all other aperture accumulations. Or the interactive procedure
+may be selected to operate on all apertures or none.
+.PP
+After the fit has been done, the fit is divided into the accumulation
+and written as a new spectrum having a specified root name and a trailing
+index indicating the aperture.
+.sp 1
+.SH
+IDENTIFY
+.PP
+This task (written by Frank Valdes) is used to identify features
+in the comparison arcs to be used in the solution for a wavelength calibration.
+The solution is performed interactively for at least one spectrum
+and then optionally in a batch mode using REIDENTIFY.
+IDENTIFY writes to a database file which will contain the solutions
+generated from each input comparison spectrum. The database is
+later used by DISPCOR to correct spectra according to the solution.
+.sp 1
+.SH
+IIDS
+.PP
+This script file initializes several hidden parameters in a
+variety of tasks to values appropriate to the IIDS instrument.
+There is also a script for the IRS. There should probably be
+a script for resetting the parameters to a default instrument.
+These parameters are:
+.RS
+.IP 1.
+onedspec.calib_file - the package parameter indicating which file
+should be used for standard star calibration data and the atmospheric
+extinction table (=onedspec$iids.cl.)
+.IP 2.
+addsets.subset - the number of instrument apertures (=2).
+.IP 3.
+bswitch.ids_mode - assume and check for data taken in beam-switched
+quadruple mode (=yes).
+.IP 4.
+coincor.ccmode - coincidence correction model (=iids).
+.IP 5.
+coincor.deadtime - detector deadtime (=1.424e-3 seconds)
+.IP 6.
+dispcor.flex_par - the name of the parameter to be used as the
+guide to removing flexure during the observations (=ut).
+.IP 7.
+dispcor.time_wrap - the zero point to be adopted for the
+flexure parameter if it is a time-like variable having a discontinuity
+at 0/24 hours (=17).
+.IP 8.
+dispcor.idsmode - should data from all instrument apertures be dispersion
+corrected to a uniform wavelength scale? (=yes).
+.IP 9.
+dispcor.cols_out - the number of columns (row length of the spectrum)
+to which the output corrected spectrum should be forced during
+mapping (=1024).
+.IP 10.
+extinct.nr_aps - the number of instrument apertures (=2).
+.IP 11.
+flatfit.order - the order of the fit to be used when fitting to
+the flat field spectra (=6).
+.IP 12.
+flatfit.coincor - apply coincidence correction to the flat field
+spectra during accumulations (=yes).
+.IP 13.
+flatdiv.coincor - apply coincidence correction to all spectra during
+the flat field division process (=yes).
+.IP 14.
+identify.function - the fitting function to be used during the wavelength
+solution process (=chebyshev).
+.IP 15.
+identify.order - the order of the fit to be used during the wavelength
+solution process (=6).
+.RE
+.sp 1
+.SH
+IRS
+.PP
+This script file initializes several hidden parameters in a
+variety of tasks to values appropriate to the IRS instrument.
+These parameters are:
+.RS
+.IP 1.
+onedspec.calib_file - the package parameter indicating which file
+should be used for standard star calibration data and the atmospheric
+extinction table (=onedspec$irs.cl.)
+.IP 2.
+addsets.subset - the number of instrument apertures (=2).
+.IP 3.
+bswitch.ids_mode - assume and check for data taken in beam-switched
+quadruple mode (=yes).
+.IP 4.
+coincor.ccmode - coincidence correction model (=iids).
+.IP 5.
+coincor.deadtime - detector deadtime (=1.424e-3 seconds)
+.IP 6.
+dispcor.flex_par - the name of the parameter to be used as the
+guide to removing flexure during the observations (=ut).
+.IP 7.
+dispcor.time_wrap - the zero point to be adopted for the
+flexure parameter if it is a time-like variable having a discontinuity
+at 0/24 hours (=17).
+.IP 8.
+dispcor.idsmode - should data from all instrument apertures be dispersion
+corrected to a uniform wavelength scale? (=yes).
+.IP 9.
+dispcor.cols_out - the number of columns (row length of the spectrum)
+to which the output corrected spectrum should be forced during
+mapping (=1024).
+.IP 10.
+extinct.nr_aps - the number of instrument apertures (=2).
+.IP 11.
+flatfit.order - the order of the fit to be used when fitting to
+the flat field spectra. IRS users have frequently found that
+any curvature in the fit introduces wiggles in the resulting
+calibrations and a straight divide by the flat normalized to the
+mean works best (=1).
+.IP 12.
+flatfit.coincor - apply coincidence correction to the flat field
+spectra during accumulations (=no).
+.IP 13.
+flatdiv.coincor - apply coincidence correction to all spectra during
+the flat field division process (=no).
+.IP 14.
+identify.function - the fitting function to be used during the wavelength
+solution process (=chebyshev).
+.IP 15.
+identify.order - the order of the fit to be used during the wavelength
+solution process. The IRS has strong deviations from linearity
+in the dispersion and a fairly high order is required to correct
+the dispersion solution (=8).
+.RE
+.sp 1
+.SH
+ONEDUTIL
+.PP
+This is a group of utility operators for the ONEDSPEC package. They
+are documented separately after the ONEDSPEC operators. ONEDUTIL
+is a "pseudo-package" - it acts like a package under ONEDSPEC, but
+many of its logical tasks are physically a part of ONEDSPEC. This
+is done to minimize disk storage requirements, and to logically
+separate some of the functions from the main ONEDSPEC menu which
+was getting too large to visually handle.
+.sp 1
+.SH
+PROCESS
+.PP
+This task generally does not exist until the user executes the
+script task BATCHRED which creates PROCESS.CL, a secondary script
+file containing a CL command stream to batch process spectra.
+The task is defined so that the CL is aware of its potential
+existence. It is not declared as a hidden task so that the
+user is also aware of its existence and may execute PROCESS
+in the foreground or background.
+.sp 1
+.SH
+REIDENTIFY
+.PP
+This task (written b Frank Valdes) is intended to be used after
+IDENTIFY has been executed. Once a wavelength solution has been
+found for one comparison spectrum, it may be used as a starting point
+for subsequent spectra having similar wavelength characteristics.
+REIDENTIFY provides a batch-like means of performing wavelength solutions
+for many spectra. The output solution is directed to a database text file
+used by DISPCOR.
+.sp 1
+.SH
+SENSFUNC
+.PP
+This task solves for the system sensitivity function across
+the wavelength region of the spectra by comparison of observations
+of standard stars to their (assumed) known energy distribution.
+Each instrument aperture is treated completely independently
+with one exception discussed later. SENSFUNC is probably the
+largest task in the ONEDSPEC package due to heavy use of
+interactive graphics which represents more than half of the
+actual coding.
+.PP
+Input to SENFUNC is the "std" text file produced by STANDARD 
+containing the ratio of the count rate adjusted for atmospheric extinction 
+to the flux of the star in ergs/cm2/s/Angstrom. Both the count rates and
+fluxes are the average values in the pre-defined bandpasses tabulated
+in the calibration file (indicated by the parameter onedspec.calib_file).
+.PP
+Each entry is the "std" file may have an independent set of wavelength sampling
+points. After all entries have been loaded, a table containing all sampled
+wavelengths is built (a "composite" wavelength table) and all sensitivity
+values are reinterpolated onto this sampling grid. This allows the inclusion
+of standards in which the observational samples are not uniform.
+.PP
+When multiple measurements are available, one of two corrections may
+be applied to the data to account for either clouds or an additive extinction
+term. The effect of clouds is assumed to be grey. Each contributing
+observation is compared to the one producing the highest count rate ratio
+at each wavelength sample. The deviation averaged over all wavelengths
+for a given observation is derived and added back to
+each wavelength sample for that observation. This produces a shift
+(in magnitudes) which, on the average across the spectrum, accounts
+for an extinction due to clouds. This process is called "fudge"
+primarily for historical reasons (from the IPPS, R.I.P.) and also
+because there is questionable justification to apply this correction.
+One reason is so that one can better assess the errors
+in the data after a zero-point correction has been made.
+Another is that the sensitivity function is that closest to a cloud-free
+sky so that claibrations may approach a true flux system if one
+standard was observed during relatively clear conditions.
+Alsom there are claims that the "color solution" is improved by "fudging", but
+I admit that I don't fully understand this argument.
+.PP
+[Perhaps it goes as follows: 
+Although a grey scale correction is applied to each observation,
+a color term is introduced in the overall solution. Consider the
+case where 5 magnitudes of cloud extinction obscure one standard
+relative to another. This star generates a sensitivity curve which
+is a factor of 100 smaller. When averaged with the other curve,
+any variations are lost, and the net curve will be
+very similar to the first curve divided by 2. Now apply a "fudge"
+of 5 magnitudes to the second curve. On the average, both curves have
+similar amplitudes, so variations in the second now influence the
+average. The net curve then has color dependent variations not
+in the "un-fudged" net curve. If we assume that the variations in
+the individual observations are not systematic, then "fudge" will 
+improve the net color solution. Amazing, isn't it?
+End of hypothesis.]
+.PP
+The second form of correction is much more justifiable. In ONEDSPEC
+it is referred to as a "grey shift" and accounts for possible
+changes in the standard atmospheric extinction model due to
+a constant offset. SENSFUNC will optionally solve for this constant
+provided the observations sample a range of airmass values.
+The constant is computed in terms of magnitudes per airmass, so
+if the airmass range is small, then a large error is likely.
+To solve for this value, a list of pairs of delta magnitude (from the
+observation having the greatest sensitivity) as a function of
+delta airmass (relative to the same observation) is generated 
+for all observations. The list is fit using a least squares solution 
+of the form:
+.sp 1
+.DS L
+     delta_mag = delta_airmass * grey_shift
+.DE
+.sp 1
+Note that this is a restricted least-squares in the sense that there
+is no zero-point term. The standard curve fit package in IRAF
+does not support this option and the code to perform this is included
+in SENSFUNC.
+.PP
+Because the atmosphere is likely to be the same one for observations
+with each instrument aperture, it is not appropriate to limit
+the least-squares solution to the individual apertures, but rather
+to combine all the data to improve the solution. This would mean
+that the user could not view the effects of applying the grey term
+until all apertures had been analyzed. So, although each aperture is
+solved independently to derive a preliminary value, a final value is
+computed at the end when all data have been reviewed. This is the
+one exception to the independent aperture equals independent
+instrument philosophy.
+.PP
+When "fudging" is applied, the sensitivity function that is generated
+is altered to account for the shifts to the observations. But when
+the "grey shift" is computed, it cannot be directly applied to
+the sensitivity function because it must be modified by the
+observing airmass for each individual object. So the grey shift
+constant is written into the image headers of the generated
+sensitivity functions (which are IRAF images), and also placed
+into the task parameter "add_const" to be used later by BSWITCH.
+.PP
+SENSFUNC can be run in an interactive mode to allow editing
+of the sensitivity data. There are two phases of interaction:
+(1) a review of the individual observations in which every data
+element can be considered and edited, and (2) a review of the
+composite sensitivity table and the calculated fit to the table.
+In the interactive mode, both phases are executed for every instrument
+aperture.
+.PP
+At both phases of the interactive modes there will be a plot of the
+error in the input values for each wavelength. This is an RMS
+error. [The IPPS plotted standard error which is always a smaller number
+and represents the error in the mean; the RMS represents the error
+in the sample. I'm not sure which is better to use, but RMS is easier
+to understand. RMS is the same as the standard deviation.]
+During phase one, the rms is computed as the standard deviation of
+the sensitivity in magnitudes; but during phase two, it is computed
+as the standard deviation in raw numbers
+and then converted to a magnitude equivalent. The latter is more
+correct but both converge for small errors.
+.PP
+There is one option in SENSFUNC which has never been tried and it won't
+work - the option to enter a predefined table of sensitivities as
+a function of wavelength as a simple text file. This option may
+be useful a some time and should probably be fixed. I think the
+only problem with it is a lack of consistency in the units.
+.PP
+An additional option has been requested but it is not clear that it
+is a high priority item - the ability to compute the extinction
+function. There may be instances when the mean extinction table
+is not appropriate, or is not known. If sufficient data are
+available (many observations of high precision over a range of airmasses
+during a photometric night), then the extinction function is
+calculable. Presently SENSFUNC can only compute a constant offset to
+the extinction function, but the same algorithm used may be applied
+at each wavelength for which observations are made to compute a
+correction to an adopted extinction function (which may be zero),
+and the correction can then be written out to the revised extinction
+table file. This file will then be read by BSWITCH during the
+extinction correction process.
+So at each wavelength, pairs of delta magnitude as a function of
+delta airmass are tabulated and fit as above:
+.sp 1
+.DS L
+     delta_mag[lambda] = delta_airmass * delta_extinction[lambda]
+.DE
+.sp 1
+Because the data have been heavily subdivided into wavelength bins,
+there are only a few measurements available for solving this
+least-squares problem and the uncertainties are large unless many
+observations have been taken. Experience has shown that at least
+7-8 measurements are needed to come close, and 15 measurements are
+about the minimum to get a good solution. Unless the data are of
+high quality, the uncertainty in the solution is comparable to
+the error in assuming a constant offset to the mean extinction function.
+Nevertheless, the option should be installed at some time since
+some observers do obtain the necessary data. 
+.sp 1
+.SH
+SLIST
+.PP
+The spectrum specific header elements are listed in either a short
+or long form. See the discussion on headers (section 3) for an explanation
+of the terms. Values for airmass are printed if present in the header;
+otherwise, the value is given as the string "?????" to indicate no
+value present (even if one can be calculated from the telescope
+pointing information elsewhere in the header).
+.PP
+The short form header lists only the image name, whether it is
+an object or sky observation, the spectrum length, and the title.
+.sp 1
+.SH
+SPLOT
+.PP
+This is probably the second largest task in the ONEDSPEC package. It continues
+to grow as users provide suggestions for enhancement, although
+the growth rate appears to be slowing. SPLOT is an interactive
+plot program with spectroscopy in mind, although it can be used
+to plot two dimensional images as well.
+.PP
+SPLOT should still be considered a prototype - many of the algortihms
+used in the analysis functions are crude, provided as interim
+software to get results from the data until a more elaborate package
+is written. It would probably be best to create an analysis specific
+package - SPLOT is reasonably general, and to enhance it further
+would complicate the keystroke sequences.
+.PP
+Ideally it should be possible to do anything to a spectrum with
+a single keystroke. In reality, several keystrokes are required.
+And after 15 or 20 functions have been installed, the keystroke
+nomenclature becomes obscure - all the best keys are used up, and
+you have to resort to things like '(' which is rather less
+mneumonic than a letter. So some of the functionality in SPLOT
+has been assigned to the "function" submenu invoked by 'f' and
+exited by 'q' keystrokes. These include the arithmetic  operators:
+add, multiply by a constant, add, subtract, multiply, divide by
+a spectrum, and logarithms, square root, inverse, and absolute
+value of a spectrum.
+.PP
+Some of the analysis functions include: equivalent width, line centers,
+flux integration under a line, smoothing, spectrum flattening,
+and deblending of lines.
+.PP
+The deblender  has serious limitations but handles about half the
+cases that IIDS/IRS users are interested in. It fits only
+Gaussian models to the blends, and only a single width parameter.
+The fit is a non-linear least-squares problem, so starting values
+present some difficulties. All starting values are initialized to 1.0 -
+this includes the width, relative strengths of the lines, and deviation
+from intial marked centers. The iterative solution usually converges
+for high signal-to-noise data, but may go astray, resulting in
+a numerical abort for noisy data. If this occurs, it is often
+possible to find a solution by fitting to a single strong line
+to force a better approximation to the starting values, and then refit
+the blend of interest.
+.PP
+The non-linear least-squares routine is one obtained from an industrial
+source. The code is very poorly written and in FORTRAN. No one should
+attempt to understand it. The basic algorithm is an unconstrained simplex
+minization search combined with a parabolic linear least-squares approximation
+when in the region of a local minimum.
+A test was made comparing this to the algorithm in Bevington, and the
+Bevington algorithm appeared less likely to converge on noisy data.
+Only one test case was used, so this is hardly a fair benchmark.
+.PP
+The problem with non-convergence is that a floating point error is
+almost surely to arise. This is usually a floating point over/under
+flow while computing an exponential (as required for a Gaussian).
+In UNIX, there is apparently no easy way to discriminate from
+FORTRAN which floating point exception has occurred, and so there
+is no easy way to execute a fix up and continue. This is most
+unfortunate because the nature of these non-linear techniques is
+that given a chance, they will often recover from searching
+down the wrong alley. A VMS version of the same routines seems to
+survive the worst data because the error recovery is handled
+somewhat better. [The VMS version also seems to run much faster,
+presumably because the floating point library support is better
+optimized.]
+.PP
+The net result of all this, is that a weird undocumented subroutine
+is used which provides no error estimate. The Bevington routines
+do provide an error estimate which is why I wanted to use them.
+[In fact, there is no way to exactly compute the errors in the
+fit of a non-linear least-squares fit. One can however apply
+an approximation theory which assumes the hypersurface can be
+treated locally as a linear function.]
+.PP
+There are several methods for computing equivalent widths in SPLOT.
+The first method for measuring equivalent width is simply to integrate the
+flux above/under a user defined continuum level. Partial pixels
+are considered at the marked endpoints. A correction for the pixel size, 
+in Angstroms, is applied because the units of equivalent width are Angstroms.
+You will probably get a different answer when doing equivalent
+width measurements in channel mode ('$' keystroke) as compared to
+wavelength mode ('p').
+.PP
+Centering is performed as a weighted first moment of the region:
+.sp 1
+.DS L
+     int1 = integral [ (I-Ic) * sqrt (I-Ic) * w]
+     int2 = integral [ (I-Ic) * sqrt (I-Ic)    ]
+     xc = int1 / int2
+.DE
+.sp 1
+where I is the intensity at the pixel at wavelength w, and Ic is
+the estimated continuum intensity. The square root term provides
+the weighting assuming photon statistics [sigma = sqrt(I)], and xc
+is the derived center of the region.
+.PP
+An alternative method for equivalent widths was supplied by Caty
+Pilachowski and is described in some detail in the help file for
+SPLOT. This method is fast and insensitive to cursor settings, so
+the user can really zip through a spectrum quickly.
+.PP
+Smoothing is performed using a simple boxcar smooth of user specified
+size (in pixels). To handle edge effects, the boxcar size is
+dynamically reduced as the edge is approached, thereby reducing
+the smoothing size in those regions.
+.PP
+The flattening operator is a preliminary one, written before the
+curve fitting package was available in IRAF. This operator
+should probably be re-written to include the interactive
+style used in FLATFIT. Currently the flattening is done
+using classic polynomial least-squares with pixel rejection
+chosen to preferentially reject absorption lines and strong
+emission lines. The rejection process is repeated through
+a number of iterations specifiable as a hidden parameter to SPLOT.
+This is poorly done - the order of the fit and the number of
+iterations should be controllable while in SPLOT. However,
+experimentation has shown that for a given series of spectra,
+the combination of rejection criteria, order, and iteration count
+which works well on one spectrum will generally work well
+on the other spectra. Note that the flatten operator attempts to
+find a continuum level and normalize to that continuum, not to the
+average value of the spectrum.
+.PP
+There are also the usual host of support operators - expansion,
+overplotting, and so forth. There is also a pixel modifer mode
+which connects two cursor positions. This forces a replot of the entire
+spectrum after each pair of points has been entered. This should
+probably be changed to inhibit auto-replot.
+.PP
+Some users have requested that all two cursor operators allow
+an option to escape from the second setting in case the wrong
+key was typed. I think this is a good idea, and might be implemented
+using the "esc" key (although I could not seem to get this keystroke
+through the GIO interface).
+.PP
+Another user request is the option to overplot many spectra with
+autoscaling operational on the entire range. This is also a good
+idea. Yet another improvement could be made by allowing the user
+to specify the x and y range of the plot, rather than autoscaling.
+.PP
+There is one serious problem with respect to plotting spectra
+corrected to a logarithmic wavelength scale. It would be nice to
+plot these spectra using the logarithmic axis option, but this
+option in GIO requires that at least one entire decade of x axis
+be plotted. So for optical data, the x axis runs from 1000 Angstroms
+to 10,000 Angstroms. Imagine a high dispersion plot having only 100
+Angstroms of coverage - the plot will look like a delta function!
+The current version of SPLOT uses a linear axis but plots in
+the log10 of wavelength. Not very good, is it.
+.sp 1
+.SH
+STANDARD
+.PP
+This task computes the sensitivity factor of the instrument
+at each wavelength for which an a priori measured flux value is known
+and within the wavelength range of the observations.
+Sensitivity is defined as
+[average counts/sec/Angstrom]/[average ergs/cm2/sec/Angstrom]
+over the specified bandpass for which the star has been measured.
+Both numerator and denominator refer to quantities above the
+Earth's atmosphere and so the count rates must be corrected for
+extinction.
+The wavelengths of known measurements, the bandpasses, the
+fluxes (in magnitudes), and the mean extinction table
+are read from a calibration file whose name is specified
+by the calib_file parameter (see LCALIB for a description of this
+file). If a magnitude is exactly 0.0, it is assumed 
+that no magnitude is known for this star at the wavelength
+having a 0.0 magnitude. This allows entries having incomplete
+information.
+.PP
+As each observation is read, it is added into an accumulator for
+its aperture. Or subtracted if it is a sky measurement. After
+a pair of object and sky observations have been added, the
+difference is corrected for extinction (as in BSWITCH), converted
+to counts per second, and integrations performed over the bandpasses
+for which flux measures are known. The bandpasses must be completely
+contained within the spectrum - partial coverage of a bandpass
+disqualifies it from consideration. The integrations are compared
+with the known flux values and the ratio is written to a text
+file (the "std" file) along with the wavelength of the measurement
+and the total counts in the bandpass. The total counts value may
+be used by SENSFUNC for weighting the measurements during averaging.
+.PP
+Many users are surprised by the order of the spectral names
+printed out as STANDARD executes since the order is not necessarily
+ascending through the spectrum list. This is because the name
+printed is the name of the object spectrum most recently associated
+with an object-sky pair. So if a sky pair is several spectra down the
+list, an intervening object-sky pair taken through a different
+instrument aperture may be processed in the meantime.
+For example, say spectra 1-8 are taken so that object spectra
+numbers 1 and 7 and sky spectra 3 and 5 are taken through aperture 0, 
+object spectra 4 and 6  and sky spectra 2 and 8 are taken through
+aperture 1. [This is a very common pattern for IIDS/IRS users.]
+Then spectrum 1 and 3 will pair up and be processed first (spectrum
+name 1 will be printed). Then 4 and 2 (name 4 printed), then 
+7 and 5 (name 7 printed), and then 6 and 8 (name 6 printed).
+So the order of names printed will be 1,4,7,6.  Simple, isn't it?
+.PP
+If the input spectra are not taken in a beam-switched mode
+then the parameter "beam_switch" should be set to no.
+Then no sky subtraction will be attempted.
+.PP
+The user may enter sensitivity values directly into a file and use
+it as the "std" file for a correction.
+See the help file for STANDARD for a description of the entries in
+the file, and see a typical file.
+.PP
+STANDARD offers a limited interactive mode. The first sky subtracted
+spectrum is displayed and the bandpasses at which sensitivity
+measurements are made will be shown as boxes. This provides a means
+to see where the measurements are falling on the observational
+data and to assess whether a bandpass may be including some
+absorption edge which may be affecting the measurement. While it
+is true that the wavelengths of the reference measurements should
+fall in the same place, the effects of instrument resolution and
+inaccuracies in the wavelength calibration may shift the positions
+of the apparent bandpasses. The samples may then be biased.
+.PP
+The second purpose of the interactive mode is to allow the user
+to artificially create new bandpasses on the fly. By placing the
+cursor to bound a new wavelength region, STANDARD will interpolate
+in the magnitude table of the reference star to estimate the magnitude
+of the star at the bounded wavelength. The sensitivity will be calculated
+at that wavelength just as if the bandpass had come from the calibration
+file. This option should be exercised with care. Obviously, points
+should not be generated between reference wavelengths falling on
+strong absorption lines, or on a line either. This option is most useful
+when at a high dispersion and few samples happen to fall in the
+limited wavelength region. Sufficient space is allocated for 10
+artificial samples to be inserted. Once the artificial bandpasses
+have been designated, they are applied to the entire sequence of
+spectra for the current invocation of STANDARD. Once STANDARD
+completes, the added bandpasses are forgotten. This prevents
+an accidental usage of newly created bandpasses on stars of different
+spectral types where a bandpass may fall in a region of continuum
+for one star, but on an absorption line in another.
+.sp 1
+.SH
+SUBSETS
+.PP
+This is a simple task to subtract the second spectrum from the
+first in a series of spectra. So if spectra 1-10 are input,
+5 new spectra will be created from 1 minus 2, 3 minus 4, and so on.
+This is a straight subtraction, pixel for pixel, with no
+compensation for exposure time differences.
+The header from the first spectrum of the pair is applied to the
+output spectrum.
+.sp 1
+.SH
+The ONEDUTIL tasks
+.PP
+These utility tasks are logically separated from the ONEDSPEC
+package.
+.sp 1
+.SH
+COEFS
+.PP
+This task reads the header parameters contained in comparison arc spectra
+describing the wavelength solution generated by the mountain reduction
+program and re-writes the solution parameters into a database
+text file for use by DISPCOR. Otherwise those solutions would be
+lost. COEFS assumes that the coefficients represent a Legendre
+polynomial which is what the mountain reduction programs use.
+.sp 1
+.SH 
+COMBINE
+.PP
+When an object has been observed over a wide range of wavelength
+coverage by using more than one instrumental setup (such as
+a blue and a red setting) or with different instruments (such
+as IUE and the IRS), it is often desirable to combine the 
+spectra into a single spectrum. COMBINE will rebin a group of
+spectra to new spectra having a single dispersion and average the
+new spectra to create a single long spectrum.
+If there are gaps in the composite spectrum, zeroes are used
+as fillers. Ideally those pixels which have no known value
+should be considered blank pixels. IRAF does not currently
+support blank pixels, so zeroes are used for now. [One
+might suggest using INDEF, but then all other routines will
+have to check for this value.]
+A side effect of choosing 0.0 is that during the averaging
+of overlapping spectra, a true 0.0 will be ignored by COMBINE.
+The basic rebinning algorithms used in DISPCOR are used in COMBINE
+(and also REBIN).
+.PP
+The averaging can be weighted by exposure time, or by user assigned weights. 
+It would be better if each spectrum had an associated vector of
+weights (one weight at each wavelength) so that the weighted averaging
+could be done on a pixel basis. This is very expensive in terms
+of both storage and file access overhead since each spectrum would 
+require twice the storage and number of files. 
+[Actually weights could be small 4 bit integers and take up very little space.]
+.PP
+A less ideal alternative would be to place a small number 
+(about 16) of weight parameters
+in the header file which represent the approximate weights of that many
+regions of the spectrum, and then one could interpolate in these parameters
+for a weight appropriate to the pixel of interest.
+.PP
+A third solution (and even less ideal)
+is to place a single parameter in the header which
+represents an average weight of the entire spectrum. For the latter two cases,
+the header weights could be derived from the average counts per 
+wavelength region - the region being the entire spectrum in the last case.
+The weights must be entered into the header during the BSWITCH operation
+since that is the last time that true counts are seen. [An implicit
+assumption is that counts are proportional to photons. If data from
+two different instruments are to be averaged, then the weights should be
+expressed in photons because the ratio of counts to photons is highly
+instrument dependent.]
+.PP
+COMBINE suffers from a partial pixel problem at the end points.
+Interpolation at the ends can lead to an underestimate of the flux
+in the last pixels because the final pixel is not filled. When averaging
+in data from another spectrum or instrument, these pixels show up
+as sharp drops in the spectrum. The problem appears due to the
+rebinning algorithm and should be corrected someday (also in DISPCOR
+and REBIN).
+.sp 1
+.SH
+LCALIB
+.PP
+This utility provides a means of checking the calibration files
+containing the standard star fluxes and extinction table. 
+Any of the entries in the file may be listed out - the bandpasses,
+extinction, standard star names, standard star fluxes in either
+magnitudes, flambda, or fnu. For a description of the calibration
+file format, see the help documentation for LCALIB.
+.PP
+The primary uses for LCALIB are to verify that new entries in
+the tables are correct, to generate a list of standard star names
+in a calibration file, and to produce a table of fluxes for a given standard
+star. The table may then be used to generate a spectrum over a specified
+wavelength region using SINTERP and overplotted with observational
+data to check the accuracy of the reductions.
+.sp 1
+.SH
+MKSPEC
+.PP
+MKSPEC provides a way to generate a limited set of artificial
+spectra. Noise generation is not available. The current options
+are to generate a spectrum which is either a constant, a ramp,
+or a black body. The spectrum may be two dimensional, but
+all image lines will be the same.
+.sp 1
+.SH
+NAMES
+.PP
+This is the simplest task in the ONEDSPEC package. It
+generates the image file names which are implied by a
+root name and record string. The primary use for this
+task is to generate a list of image names to be used
+as input for some other program such as WFITS.
+The output from NAMES can be redirected to file
+and that file used with the "@file" notation for image
+name input. An optional parameter allows an additional
+string to be appended to the generated file name 
+to allow a subraster specification.
+.sp 1
+.SH
+REBIN
+.PP
+Spectra are rebinned to the wavelength parameters specified
+by either matching to a reference spectrum or by user input.
+The algorithms are those used by DISPCOR and the same options
+for the interpolation method are available. REBIN is useful
+when data are obtained with different instruments or setups
+producing roughly comparable wavelength ranges and possibly
+different dispersions, and the data are to be compared.
+REBIN may also be used as a shift operator by specifying a
+new starting wavelength. Or it may be used as a smoothing operator
+by specifying a course dispersion. It may also be used
+to convert between the two formats - linear in wavelength and 
+linear in the logarithm of wavelength. This latter option has
+not been thoroughly exercised - proceed with caution.
+.sp 1
+.SH
+RIDSMTN
+.PP
+This task was stolen from the DATAIO package to make the following
+modification: IIDS and IRS data are both written as 1024 pixel
+spectra at the mountain. But the detectors do not produce a full
+1024 pixels of acceptable data. In fact the IRS only has 936 pixels.
+The data are written this way to conform to the IIDS ideal spectrum
+which does have 1024 pixels, but the first few (about 6) are not usable.
+To signal the good pixels, the IIDS/IRS header words NP1 and NP2 are
+set to the beginning and ending good pixels. Actually NP1 points to
+the first good pixel minus one. [Really actually NP1 and NP2 may be reversed,
+but one is big and the other small so you can tell them apart.]
+.PP
+The version of RIDSMTN in ONEDUTIL keys off these parameters and writes
+images containing only good pixels which means that the images will be
+smaller than 1024 pixels. The user has the option of overriding the
+header values with the task parameters "np1" and "np2". These may be
+specified as 1 and 1024 to capture the entire set of pixels written to
+tape or any other subset. Beware that np1 and np2 as task parameters
+refer to the starting pixel and ending pixel respectively. None of this
+nonsense about possible role reversals or "first good minus one" is
+perpetuated.
+.sp 1
+.SH
+SINTERP
+.PP
+I think this is a handy little program. It provides a way to make
+an IRAF spectral image from a table of values in a text file.
+The table is interpolated out to any length and at any sampling
+rate. A user can create a table of corrections to be applied to
+a set of spectra, for example, use SINTERP to build a spectrum,
+and run CALIBRATE to multiply a group of spectra by the correction.
+.PP
+The original raison d'etre for SINTERP was to create spectra of
+standard stars from the listing of fluxes generated by LCALIB.
+Using SPLOT the created spectrum can be overplotted with calibrated
+observations to compare the true tabulated fluxes with the observed
+fluxes.
+.PP
+SINTERP grew out of the task INTERP in the UTILITIES package
+and works pretty much the same way. One major change is that
+the table containing the x-y pairs is now stored in a dynamically
+allocated array and can be as large as the user requests. The
+default size is 1024 pairs, but the parameter tbl_size can
+be set to a larger value. This then allows one to create a spectrum
+from its tabulated values of wavelength and flux even if the
+the table is several thousand elements long.
+Note that the option to route the output from INTERP to
+STDOUT has been retained if a new table is to be generated rather
+than an IRAF image.
+.PP
+Another major change from INTERP is the use of the IRAF curve fitting
+routines as an option. These were not originally available.
+The choices now include linear or curvey interpolators, Legendre
+or Chebyshev polynomial fits, and cubic or linear splines.
+.sp 1
+.SH
+WIDSTAPE
+.PP
+This task has vague origins in the DATAIO task WIDSOUT which writes
+a tape having the format of the IDSOUT package which ran on the
+CYBER (R.I.P.). For convenience to users this format has been
+maintained for spectra having lengths up to 1024 pixels.
+The version in DATAIO requires that the user enter all the header
+parameters as task parameters. For several hundred spectra, this
+approach is unwieldy. Because the ONEDSPEC package uses the header
+parameters heavily, it is able to read them directly and write the
+values to the tape file without user intervention.
+.PP
+The output tape (or diskfile) may be in either ASCII or EBCDIC format.
+Spectra shorter than 1024 are zero filled. Each invocation of
+the task write a new tape file followed by a tape mark (EOF).
+.LP
+.SH
+3. Image Header Parameters
+.PP
+The ONEDSPEC package uses the extended image header to extract
+information required to direct processing of spectra. If the
+header information were to be ignored, the user would need to
+enter observing parameters to the program at the risk of
+typographical errors, and with the burden of supplying the
+data. For more than a few spectra this is a tedious job,
+and the image header information provides the means to eliminate
+almost all the effort and streamline the processing.
+.PP
+However, this requires that the header information be present,
+correct, and in a recognizable format. To meet the goal of
+providing a functional package in May 1985, the first iteration
+of the header format was to simply adopt the IIDS/IRS headers.
+This allowed for processing of the data which would be first
+used heavily on the system, but would need to be augmented at
+a later date. The header elements may be present in any order,
+but must be in a FITS-like format and have the following names
+and formats for the value fields:
+.sp 1
+.TS
+l c l
+l l l.
+Parameter	Value Type	Definition
+
+HA	SX	Hour angle (+ for west, - for east)
+RA	SX	Right Ascension
+DEC	SX	Declination
+UT	SX	Universal time
+ST	SX	Sidereal time
+AIRMASS	R	Observing airmass  (effective)
+W0	R	Wavelength at center of pixel 1
+WPC	R	Pixel-to-pixel wavelength difference
+NP1	I	Index to first pixel containing good data (actually first-1)
+NP2	I	Index to last pixel containing good data (last really)
+EXPOSURE	I	Exposure time in seconds (ITIME is an accepted alias)
+BEAM-NUM	I	Instrument aperture used for this data (0-49)
+SMODE	I	Number of apertures in instrument minus one (IIDS only)
+OFLAG	I	Object or sky flag (0=sky, 1=object)
+DF-FLAG	I	Dispersion fit made on this spectrum (I=nr coefs in fit)
+SM-FLAG	I	Smoothing operation performed on this spectrum (I=box size)
+QF-FLAG	I	Flat field fit performed on this spectrum (0=yes)
+DC-FLAG	I	Spectrum has been dispersion corrected (0=linear, 1=logarithmic)
+QD-FLAG	I	Spectrum has been flat fielded (0=yes)
+EX-FLAG	I	Spectrum has been extinction corrected (0=yes)
+BS-FLAG	I	Spectrum is derived from a beam-switch operation (0=yes)
+CA-FLAG	I	Spectrum has been calibrated to a flux scale (0=yes)
+CO-FLAG	I	Spectrum has been coincidence corrected (0=yes)
+DF1	I	If DF-FLAG is set, then coefficients DF1-DFn (n <= 25) exist
+.TE
+.PP
+The values for the parameters follow the guidelines adopted for
+FITS format tapes. All keywords occupy 8 columns and contain
+trailing blanks. Column 9 is an "=" followed by a space. The value field
+begins in column 11. Comments to the parameter may follow a "/" after
+the value field.  The value type code is as follows:
+.RS
+.IP SX
+This is a sexigesimal string of the form '12:34:56   ' where the first
+quote appears in column 11 and the last in column 30.
+.IP R
+This is a floating point ("real") value beginning in column 11 and
+extending to column 30 with leading blanks.
+.IP I
+This is an integer value beginning in column 11 and extending to
+column 30 with leading blanks.
+.RE
+.sp 1
+.PP
+The parameters having FLAG designations all default to -1 to indicate
+that an operation has not been performed.
+The ONEDSPEC subroutines "load_ids_hdr" and "store_keywords" follow
+these rules when reading and writing spectral header fields.
+If not present in a header, load_ids_hdr will assume a value of zero
+except that all flags are set to -1, and the object flag parameter
+defaults to object.
+.PP
+When writing an image, only the above parameters are stored by store_keywords.
+Other header information is lost. This needs to be improved.
+.PP
+Not all programs need all the header elements. The following table
+indicates who needs what. Tasks not listed generally do not require
+any header information. Header elements not listed are not used.
+The task SLIST requires all the elements listed above.
+The task WIDTAPE requires almost all (except NP1 and NP2).
+The headings are abbreviated task names as follows:
+.sp 1
+.nr PS 8
+.ps 8
+.TS
+center;
+l l | l l | l l.
+ADD	addsets	COI	coincor	FIT	flatfit
+BSW	bswitch	COM	combine	REB	rebin
+CAL	calibrate	DIS	dispcor	SPL	splot
+COE	coefs	FDV	flatdiv	STA	standard
+.TE
+.sp 1
+.TS
+center, tab(/);
+l | l | l | l | l | l | l | l | l | l | l | l | l.
+Key/ADD/BSW/CAL/COE/COI/COM/DIS/FDV/FIT/REB/SPL/STA
+_
+HA// X////////// X/
+RA// X////////// X/
+DEC// X////////// X/
+ST// X////////// X/
+UT// X////////// X/
+AIRMASS// X////////// X/
+W0// X/ X/// X//// X/ X/ X/
+WPC// X/ X/// X//// X/ X/ X/
+NP1/////////// X///
+NP2/////////// X///
+EXPOSURE/ X/ X/// X/ X///// X///
+BEAM-NUM// X/ X//// X/ X/ X// X/ X//
+OFLAG// X////////// X/
+DF-FLAG//// X
+DC-FLAG// X//// X//// X/ X/ X/
+QD-FLAG//////// X/
+EX-FLAG// X/
+BS-FLAG// X/
+CA-FLAG/ X// X//////// X/
+CO-FLAG///// X//
+DFn//// X/
+.TE
+.nr PS 11
+.ps 11
+.bp
+.SH
+Headers From Other Instruments
+.PP
+The header elements listed above are currently created only when reading
+IIDS and IRS data from one of the specific readers: RIDSMTN and RIDSFILE.
+The time-like parameters, (RA, DEC, UT, ST, HA), are created in a
+compatible fashion by RCAMERA and RFITS (when the FITS tape is written
+by the KPNO CCD systems).
+.PP
+For any other header information, the ONEDSPEC package is at a loss
+unless the necessary information is edited into the headers with
+an editing task such as HEDIT. This is not an acceptable long term
+mode of operation, and the following suggestion is one approach to
+the header problem.
+.PP
+A translation table can be created as a text file which outlines
+the mapping of existing header elements to those required by the
+ONEDSPEC package. A mapping line is needed for each parameter
+and may take the form:
+.sp 1
+.RS
+.DC
+1D_param    default    hdr_param    key_start   value_start   type   conversion
+.DE
+.RE
+.sp 1
+where the elements of an entry have the following definitions:
+.sp 1
+.TS
+center, tab(	);
+l lw(5i).
+1D_param	T{
+The name of the parameter expected by the ONEDSPEC package,
+such as EXPOSURE, OFLAG, BEAM-NUM.  
+T}
+
+default	T{
+A value to be used if no entry is found for this parameter or if
+no mapping exists.
+T}
+
+hdr_param	T{
+The string actually present in the existing image header to be
+associated with the ONEDSPEC parameter. 
+T}
+
+key_start	T{
+The starting column number at which the string starts 
+in the header. 
+T}
+
+value_start	T{
+The starting column number at which the string describing the
+value of the parameter starts in the header. 
+T}
+
+type	T{
+The format type of the parameter: integer, real, string, boolean,
+sexigesimal. 
+T}
+
+conversion	T{
+If the format type is string, a further conversion may 
+optionally be made to one of the formats listed under type. 
+The conversion may requires some expression evaluation.
+T}
+.TE
+.sp 1
+.PP
+Consider the example where the starting wavelength of a
+spectrum is contained in a FITS-like comment and the object-
+sky flag in a similar fashion:
+.sp 1
+.DS
+     COMMENT = START-WAVE  4102.345   / Starting wavelength
+     COMMENT = OBJECT/SKY  'SKY      '/ Object or Sky observation
+.DE
+.sp 1
+The translation file entries for this would be:
+.sp 1
+.DS
+     W0  0.0  START-WAVE  12  24  R
+     OFLAG 0  OBJECT/SKY  12  25  S  SKY=0;OBJECT=1
+.DE
+.sp 1
+The first entry is fairly simple. The second requires an expression
+evaluation and second conversion.
+.PP
+A translation file can be built for each instrument and its
+special header format, and the file name can be associated with a
+ONEDSPEC package parameter. The two subroutines in ONEDSPEC dealing
+directly with the headers (load_ids_hdr and store_keywords)
+can be modified or replaced to access this file and
+translate the header elements.
diff --git a/noao/onedspec/doc/sys/onedv210.ms b/noao/onedspec/doc/sys/onedv210.ms
new file mode 100644
index 00000000..431c84f5
--- /dev/null
+++ b/noao/onedspec/doc/sys/onedv210.ms
@@ -0,0 +1,680 @@
+.nr PS 9
+.nr VS 11
+.de LS
+.RT
+.if \\n(1T .sp \\n(PDu
+.ne 1.1
+.if !\\n(IP .nr IP +1
+.if \\n(.$-1 .nr I\\n(IR \\$2n
+.in +\\n(I\\n(IRu
+.ta \\n(I\\n(IRu
+.if \\n(.$ \{\
+.ds HT \&\\$1
+.ti -\\n(I\\n(IRu
+\\*(HT
+.br
+..
+.ND
+.TL
+ONEDSPEC/IMRED Package Revisions Summary: IRAF Version 2.10
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+May 1992
+.NH
+Introduction
+.LP
+The IRAF NOAO spectroscopy software, except for the \fBlongslit\fR
+package, has undergone major revisions.  The revisions to the aperture
+extraction package, \fBapextract\fR, are described in a separate
+document.  This paper addresses the revisions in the \fBonedspec\fR
+package and the spectroscopic image reduction packages in the
+\fBimred\fR package.  In addition to the revisions summary given here
+there is a new help topic covering general aspects of the new
+\fBonedspec\fR package such as image formats, coordinate systems, and
+units.  This help topic is referenced under the name
+"onedspec.package".
+.LP
+There are a large number of revisions both minor and major.  To avoid
+obscuring the basic themes and the major revisions in a wealth of minor
+detail, this document is organized into sections of increasing detail.  The
+most important aspects of the revisions are described in a major highlight
+section followed by a minor highlight section.  Then a reorganization chart
+for the \fBonedspec\fR package is presented showing where various
+tasks have been moved, which have been deleted, and which are new.
+Finally, a summary of the revisions to each task is presented.
+.LP
+I hope that the many new capabilities, particularly as presented in the
+highlight section, will outweigh any disruption in accomodating to so
+many changes.
+.NH
+Major Highlights
+.LP
+The major highlights of the revisions to the NOAO spectroscopy software
+are listed and then discussed below.
+
+.DS
+\(bu Non-linear dispersion calibration
+\(bu Integration of dispersion coordinates with the core system 
+\(bu Sinc interpolation
+\(bu Plotting in user selected units including velocity
+\(bu Integration of long slit spectra and 1D formats
+\(bu New \fBimred\fR packages featuring streamlined reductions
+.DE
+
+Possibly the most significant revision is the generalization allowing
+non-linear dispersion calibration.  What this means is that spectra do
+not need to be interpolated to a uniform sampling in wavelength or
+logarithmic wavelength.  The dispersion functions determined from
+calibration arc lines by \fBidentify\fR, \fBreidentify\fR,
+\fBecidentify\fR, or \fBecreidentify\fR can be simply assigned to the
+spectra and used throughout the package.  It is also possible to assign
+a dispersion table or vector giving the wavelengths at some or all of
+the pixels.  Note, however, that it is still perfectly acceptible to
+resample spectra to a uniform linear or log-linear dispersion as was
+done previously.
+.LP
+For data which does not require geometric corrections, combining, or
+separate sky subtraction the observed sampling need never be changed
+from the original detector sampling, thus avoiding any concerns over
+interpolation errors.  In other cases it is possible to just
+interpolate one spectrum, say a sky spectrum, to the dispersion of
+another spectrum, say an object spectrum, before operating on the two
+spectra.  There are several new tasks that perform interpolations to a
+common dispersion, not necessarily linear, when operating on more than
+one spectrum.  In particular, the new task \fBsarith\fR and the older
+task \fBsplot\fR now do arithmetic on spectra in wavelength space.
+Thus, one no longer need be concerned about having all spectra
+interpolated to the same sampling before doing arithmetic operations as
+was the case  previously.
+.LP
+The trade-off in using non-linear dispersion functions is a more complex
+image header structure.  This will make it difficult to import to non-IRAF
+software or to pre-V2.10 IRAF systems.  However, one may resample to a
+linear coordinate system in those cases before transfering the spectra as
+FITS images having standard linear coordinate keywords.
+.LP
+On the subject of interpolation, another important addition is the
+implementation of sinc interpolation.  This is generally considered
+the best interpolation method for spectra, however, it must be used
+with care as described below.
+Sinc interpolation approximates applying a phase shift to the fourier
+transform of the spectrum.  Thus, repeated interpolations do not accumulate
+errors (or nearly so) and, in particular, a forward and reverse
+interpolation will recover the original spectrum much more closely than
+other interpolation methods.  However, for undersampled (where the fourier
+transform is no longer completely represented), strong features, such as
+cosmic rays or narrow emission or absorption lines, the ringing can be much
+more severe than the polynomial interpolations.  The ringing is especially
+a concern because it extends a long way from the feature causing the
+ringing; 30 pixels with the truncated algorithm that has been added.  Note
+that it is not the truncation of the interpolation function which is at
+fault but the undersampling of the narrow features!
+.LP
+Because of the problems seen with sinc interpolation it should be used with
+care.  Specifically, if there are no undersampled, narrow features it is a
+good choice but when there are such features the contamination of the
+spectrum by ringing is more severe, corrupting more of the spectrum,
+than with other interpolation types.
+.LP
+The dispersion coordinates are now interfaced through the IRAF WCS
+(world coordinate system) interface.  This is important to users for
+two reasons.  First, operations performed on spectral images by IRAF
+core system tasks and the IRAF image I/O system will have access to the
+dispersion coordinates and will properly modify them as necessary.  The
+most common such operation is applying an image section to a spectrum
+either during an image copy or as input to another task.  In this case
+the relation between the pixels in the image section and their
+wavelengths is preserved.  For example one may \fBsplot\fR a section of
+a large spectrum and get the correct wavelengths.  The second reason is
+to allow use of proper dispersion coordinates in such IRAF tasks as
+\fBlistpixels\fR, \fBimplot\fR, and \fBgraph\fR.
+.LP
+The new package supports a variety of spectral image formats.  The
+older formats are understood when reading them.  In particular the one
+dimensional "onedspec" and the two dimensional "multispec" format will
+still be acceptable as input.  Note that the image naming syntax for
+the "onedspec" format using record number extensions is a separate
+issue and is still provided but only in the \fBimred.iids\fR and
+\fBimred.irs\fR packages.  Any new spectra created are either a one
+dimensional format using relatively simple keywords and a two or three
+dimensional format which treats each line of the image as a separate
+spectrum and uses a more complex world coordinate system and keywords.
+For the sake of discussion the two formats are still called "onedspec"
+and "multispec" though they are not equivalent to the earlier formats.
+.LP
+In addition, the one dimensional spectral tasks may also now operate on
+two dimensional images directly.  This is done by using the DISPAXIS
+keyword in the image header or a package dispaxis parameter if the
+keyword is missing to define the dispersion axis.  In addition there is
+a summing parameter in the packages to allow summing a number of lines
+or columns.  If the spectra are wavelength calibrated long slit
+spectra, the product of the \fBlongslit.transform\fR task, the
+wavelength information will also be properly handled.  Thus, one may
+use \fBsplot\fR or \fBspecplot\fR for plotting such data without having
+to extract them to another format.  If one wants to extract one
+dimensional spectra by summing columns or lines, as opposed to using
+the more complex \fBapextract\fR package, then one can simply use
+\fBscopy\fR (this effectively replaces \fBproto.toonedspec\fR).
+.LP
+The tasks \fBsplot\fR and \fBspecplot\fR allow use of and changes
+between various dispersion units.  Spectra may be plotted in units all
+the way from Hertz to Mev.  The units may also be inverted to plot in
+wavenumbers, such as inverse centimeters, and the decimal log may be
+applied, to plot something like log wavelength or log frequency.  One
+special "unit" which is available is a velocity computed about a
+specified wavelength/frequency.  The multiple unit capability was one
+of the last major changes made before the V2.10 release so the complete
+generalization to arbitrary units has not been completed.  Dispersion
+calibration and image world coordinate system generally must still be
+done in Angstroms, particularly if flux calibration is to be done.  The
+generalization to other units throughout the package is planned for a
+later release.
+.LP
+The last of the changes catagorized as a major highlight is the
+addition of a number of special packages for generic or specific
+types of instruments and data in the \fBimred\fR package.  Most of these
+package include a highly streamlined reduction task that combines
+all of the reduction operations into a single task.  For example,
+the \fBspectred.doslit\fR task can extract object, standard star, and
+arc spectra from long slit images, apply a consistent dispersion
+function based on only a single interactively performed dispersion
+solution, compute a sensitivity function and end up with flux
+calibrated spectra.  Another example, is \fBhydra.dohydra\fR for
+extracting, flatfielding, dispersion calibrating, and sky subtracting
+spectra from the NOAO Hydra multifiber spectrograph.  There are user's
+guides for each of these new reduction tasks.
+.NH
+Minor Highlights
+.LP
+There are some further highlights which are also quite important
+but which are secondary to the previous highlights.  These are listed
+and discussed below.
+
+.DS
+\(bu Greater use of package parameters
+\(bu An observatory database
+\(bu A more flexible \fBidentify/reidentify\fR
+\(bu Only one \fBdispcor\fR
+\(bu Spatial interpolation of dispersion solutions
+\(bu Deblending of arbitrary number of gaussian components
+\(bu Manipulating spectral formats
+\(bu Improved fitting of the continuum and related features
+\(bu Various new tasks
+.DE
+
+There is an even greater use of package parameters than in the previous
+release.  Package parameters are those which are common to many of the
+the tasks in the package and which one usually wants to change in
+one place.  The new package parameters are the default observatory for
+the data if the observatory is not identified in the image header
+(discussed further below), the interpolation type used
+when spectra need to be resampled either for dispersion calibration
+or when operating on pairs of spectra with different wavelength
+calibration, and the default dispersion axis and summing parameters
+for long slit and general 2D images (as discussed in the last section).
+You will find these parameters not only in the \fBonedspec\fR package but in
+all the spectroscopic packages in the \fBimred\fR package.
+.LP
+A number of spectroscopic tasks require information about the location
+of the observation.  Typically this is the observatory latitude for
+computing air masses if not defined in the header.  Radial velocity
+tasks, and possible future tasks, may require additional information
+such as longitude and altitude.  The difficulty is that if such
+parameters are specified in parameter files the default may well be
+inappropriate and even if the users set then once, they may forget to
+update them in later reductions of data from a different observatory.
+In other words this approach is prone to error.
+.LP
+To address this concern observatory parameters are now obtained from an
+observatory database keyed by an observatory identifier.  If the image data
+contains an observatory keyword, OBSERVAT, the tasks will look up the
+required parameters from the observatory database.  Thus, if the images
+contain the observatory identifier, as does data from the NOAO
+observatories, they will always be correctly reduced regardless of the
+setting of any parameters.  Of course one has to deal with data from
+observatories which may not include the observatory identifier and may not
+have an entry in the observatory database.  There are provisions for sites
+and individual users to define local database files and to set the default
+observatory parameters.  This is all discussed in the help for the
+\fBobservatory\fR task.
+.LP
+The dispersion function fitting tasks \fBidentify\fR and
+\fBreidentify\fR have been improved in a number of important ways.
+These tasks now treat the input images as units.  So for long slit and
+multispectrum images one can move about the image with a few
+keystrokes, transfer solutions, and so on.  When transfering solutions
+between a multispectrum reference image and another multispectrum image
+with the same apertures using \fBreidentify\fR, the features and
+dispersion solutions are transfered aperture by aperture.  This avoids
+problems encountered by having to trace successively between apertures
+and having the apertures be in the same order.
+.LP
+On the subject of tracing in \fBreidentify\fR, in some cases it is
+desirable to use the same reference spectrum with all other sampled
+lines or columns in a long slit spectrum or apertures in a
+multispectrum image rather than propagating solutions across the
+image.  The latter method is necessary if there is a continuous and
+progress shift in the features.  But if this is not the situation then
+the loss of features when tracing can be a problem.  In this case the
+alternative of reidentifying against the same starting reference is now
+possible and there will not be the problem of an increasing loss of
+features.  On the other hand, the problem of lost features, whether
+tracing or not, can also be addressed using another new feature of
+\fBreidentify\fR, the ability to add features from a line list.  For
+both tracing and nontracing reidentifications, another useful new
+feature is automatic iterative rejection of poorly fitting lines in
+determining a new dispersion function noninteractively.
+.LP
+The nontracing reidentifications, the automatic addition of new lines, and
+the iterative rejection of poorly fitting lines in determining a new
+dispersion function are all responses to make the reidentification process
+work better without intervention.  However, as a last resort there is also
+a new interactive feature of \fBreidentify\fR.  By monitoring the log output of
+the reidentification process one can have a query be made after the
+automatic reidentification and function fitting to allow selectively
+entering the interactive feature identification and dispersion function
+fitting based on the logged output.  Thus if a fit has a particularly large
+RMS or a large number of features are not found one can chose to intervene
+in the reidentification process.
+.LP
+Dispersion calibration is now done exclusively by the task
+\fBdispcor\fR regardless of the spectrum format or dispersion solution
+type; i.e. solutions from \fBidentify\fR or \fBecidentify\fR.  In addition to
+allowing assignment of non-linear dispersion functions, as described
+earlier, \fBdispcor\fR has other new features.  One is that, in
+addition to interpolating dispersion solutions between two calibration
+images (usually weighted by time), it is now possible to interpolate
+zero point shifts spatially when multiple spectra taken simultaneously
+include arc spectra.  This is mostly intended for the new generation of
+multifiber spectrographs which include some fibers assigned to an arc
+lamp source.  However, it can be used for the classic photographic case
+of calibration spectra on the same plate.
+.LP
+The limitation to four lines on the number of gaussian components which
+can be deblended by the deblending option in \fBsplot\fR has been removed.
+A new feature is that line positions may be input from a line list as 
+well as the original cursor marking or terminal input.
+In addition an option to simultaneously determine a linear background
+has been added.  As a spinoff of the deblending option a new, noninteractive
+task, called FITPROFS, has been added.  This task takes a list of initial
+line positions and sigmas and simultaneously fits gaussians with a
+linear background.  One can constrain various combination of parameters
+and output various parameters of the fitting.  While it can be used to
+fit an entire spectrum it becomes prohibitively slow beyond a number like
+30.  A banded matrix approach is required in that case.
+.LP
+As mentioned earlier there is a new task called \fBscopy\fR for manipulating
+spectra.  It allows changing between various formats such as producing
+the separate, simple keyword structure, one dimensional images from multispec
+format images, combining multiple one dimensional spectra into the
+more compact multispec format, and extracting line or column averaged one
+dimensional spectra from two dimensional images.  It can also be
+used to select any subset of apertures from a multispec format,
+merge multiple multispec format spectra, and extract regions of spectra
+by wavelength.
+.LP
+The \fBcontinuum\fR task has been revised to allow independent
+continuum fits for each aperture, order, line, or column in images
+containing multiple spectra.  Instead of being based on the
+\fBimages.fit1d\fR task it is based on the new task \fBsfit\fR.
+\fBSfit\fR allows fitting the \fBicfit\fR functions to spectra and
+outputing the results in several ways such as the ratio (continuum
+normalization), difference (continuum subtraction), and the actual
+function fit.  In addition it allows outputing the input data with
+points found to be deviant by the iterative rejection algorithm of
+\fBicfit\fR replaced by the fitted value.  This is similar to
+\fBimages.lineclean\fR.  In all cases, this is may be done
+independently and interactively or noninteractively when there are
+multiple spectra in an image.
+.LP
+A number of useful new tasks have already been mentioned:
+\fBfitprofs\fR, \fBsarith\fR, \fBscombine\fR, \fBscopy\fR, and
+\fBsfit\fR.  There are two more new tasks of interest.  The task \fBdopcor\fR
+applies doppler shifts to spectra.  It applies the shift purely to the
+dispersion coordinates by adding a redshift factor which is applied by
+the coordinate system interface.  This eliminates reinterpolation and
+preserves both the shift applied and the original observed dispersion
+function (either linear or nonlinear).  The task can also modify the
+pixel values for various relativistic and geometric factors.  This task
+is primarily useful for shifting spectra at high redshifts to the local
+rest frame.  The second new task is called \fBderedden\fR.  It applies
+corrections for interstellar reddening given some measure of the
+extinction along the line of site.
+.NH
+ONEDSPEC Package Task Reorganization
+.LP
+The \fBonedspec\fR package dates back to the earliest versions of IRAF.  Some of
+its heritage is tied to the reduction of IRS and IIDS spectra.  One of
+the revisions made for this release has been to reorganize the various
+tasks and packages.  A few tasks have been obsoleted by new tasks or
+the functionality of the new dispersion coordinate system, a number
+of new tasks have been added, and a number of IRS and IIDS specific
+tasks have been moved to the \fBimred\fR packages for those instruments.
+While these packages are organized for those particular instruments they may
+also be used by data having similar characteristics of beam switching,
+coincidence corrections, and the requirement of sequential numeric
+extensions.
+.LP
+The table below provides the road map to the reorganization showing
+tasks which have disappeared, been moved, been replaced, or are new.
+
+.DS
+.TS
+center;
+r l l l r l l.
+V2.9	V2.10	ALTERNATIVE	V2.9	V2.10	ALTERNATIVE
+
+addsets		irs/iids	process		irs/iids
+batchred		irs/iids	rebin		scopy/dispcor
+bplot	bplot		refspectra	refspectra
+bswitch		irs/iids	reidentify	reidentify
+calibrate	calibrate		sapertures
+coincor		iids	sarith
+combine		scombine	scombine
+continuum	continuum		scopy
+	deredden		sensfunc	sensfunc
+dispcor	dispcor		setdisp		hedit
+	dopcor		sextract	scopy
+	fitprofs		sfit
+flatdiv		irs/iids	sflip		scopy/imcopy [-*,*]
+flatfit		irs/iids	shedit		hedit
+identify	identify		sinterp	sinterp
+lcalib	lcalib		slist	slist
+mkspec	mkspec		specplot	specplot
+names	names		splot	splot
+	ndprep		standard	standard
+observatory		noao	subsets		irs/iids
+powercor		iids	sums		irs/iids
+.TE
+.DE
+.NH
+IMRED Packages
+.LP
+Many of the \fBonedspec\fR tasks from the previous release have been
+moved to the \fBiids\fR and \fBirs\fR packages, as indicated above,
+since they were applicable only to these and similar instruments.
+.LP
+A number of new specialized spectroscopic instrument reduction packages
+have been added to the \fBimred\fR package.  Many of these have been in
+use in somewhat earlier forms in the IRAF external package called
+\fBnewimred\fR.  In addition the other spectroscopic package have been
+updated based on the revisions to the \fBonedspec\fR and
+\fBapextract\fR packages.  Below is a table showing the changes between
+the two version and describing the purpose of the spectroscopic
+packages.  Note that while many of these package are named for and
+specialized for various NOAO instruments these packages may be applied
+fairly straightforwardly to similar instruments from other
+observatories.  In addition the same tools for multifiber and slit
+spectra are collected in a generic package called \fBspecred\fR.
+
+.DS
+.TS
+center;
+r l l s
+r l l l.
+V2.9	V2.10	SPECTROSCOPY PACKAGE
+	argus	Fiber:	CTIO Argus Reductions
+specphot	ctioslit	Slit:	CTIO Slit Instruments
+echelle	echelle	Fiber Slit:	Generic Echelle
+	hydra	Fiber:	KPNO Hydra (and Nessie) Reductions
+iids	iids	Scanner:	KPNO IIDS Reductions
+irs	irs	Scanner:	KPNO IRS Reductions
+coude	kpnocoude	Fiber/Slit:	KPNO Coude (High Res.) Reductions
+	kpnoslit	Slit:	KPNO Slit Instruments
+msred	specred	Fiber/Slit:	Generic fiber and slit reductions
+observatory	-> noao
+setairmass
+.TE
+.DE
+.LP
+An important feature of most of the spectroscopic packages are specialized
+routines for combining and streamlining the different reduction operations
+for a particular instrument or type of instrument.  These tasks are:
+
+.DS
+.TS
+center;
+r r r.
+argus.doargus	ctioslit.doslit	echelle.doecslit
+echelle.dofoe	hydra.dohydra	iids.batchred
+irs.batchred	kpnocoude.do3fiber	kpnocoude.doslit
+kpnoslit.doslit	specred.dofibers	specred.doslit
+.TE
+.DE
+.NH
+ONEDSPEC Task Revisions in V2.10
+.LS ADDSETS 2
+Moved to the \fBiids/irs\fR packages.
+.LS BATCHRED
+Moved to the \fBiids/irs\fR packages.
+.LS BPLOT
+The APERTURES and BAND parameters been added to select 
+apertures from multiple spectra and long slit images, and bands
+from 3D images. Since the task is a script calling \fBsplot\fR, the
+many revisions to that task also apply. The version in the
+\fBiids/irs\fR packages selects spectra using the record number 
+extension syntax.
+.LS BSWITCH
+Moved to the \fBiids/irs\fR packages.
+.LS CALIBRATE
+This task was revised to operate on nonlinear dispersion 
+corrected spectra and 3D images (the \fBapextract\fR "extras"). The
+aperture selection parameter was eliminated (since the header
+structure does not allow mixing calibrated and uncalibrated
+spectra) and the latitude parameter was replaced by  the 
+observatory parameter. The observatory mechanism insures that
+if the observatory latitude is needed for computing an airmass
+and the observatory is specified in the image header the
+correct calibration will be applied. The record format syntax
+is available in the \fBiids/irs\fR packages. The output spectra are
+coerced to have real pixel datatype.
+.LS COINCOR
+Moved to the \fBiids\fR package.
+.LS COMBINE
+Replaced by \fBscombine\fR.
+.LS CONTINUUM
+This task was changed from a script based on \fBimages.fit1d\fR to a
+script based on \fBsfit\fR. This provides for individual independent
+continuum fitting in multiple spectra images and for additional
+flexibility and record keeping.  The parameters have been 
+largely changed.
+.LS DEREDDEN
+This task is new.
+.LS DISPCOR
+This is a new version with many differences. It replaces the
+previous three tasks \fBdispcor\fR, \fBecdispcor\fR and \fBmsdispcor\fR. It
+applies both one dimensional and echelle dispersion functions.
+The new parameter LINEARIZE selects whether to interpolate the
+spectra to a uniform linear dispersion (the only  option 
+available previously) or to assign a nonlinear dispersion 
+function to the image  without  any  interpolation.  The 
+interpolation function parameter has been eliminated and the
+package parameter INTERP is used to select the interpolation
+function. The new interpolation type "sinc" may be used but
+care should be exercised. The new task supports applying a
+secondary zero point shift spectrum to a master dispersion
+function and a spatial interpolation of the shifts  when 
+calibration spectra are taken at the same time on a different
+region of the same 2D image. The optional wavelength table may
+now also be an image to match dispersion parameters. The
+APERTURES and REBIN parameters have been eliminated.  If an
+input spectrum has been previously dispersion corrected it will
+be resampled as desired. Verbose and log file parameters have
+been added to log the dispersion operations as desired. The
+record format syntax is available in the \fBiids/irs\fR packages.
+.LS DOPCOR
+This task is new.
+.LS FITPROFS
+This task is new.
+.LS FLATDIV
+Moved to the \fBiids/irs\fR packages.
+.LS FLATFIT
+Moved to the \fBiids/irs\fR packages.
+.LS IDENTIFY
+The principle revision is to allow multiple aperture images and
+long slit spectra to be treated as a unit. New keystrokes
+allow jumping or scrolling within multiple spectra in a single
+image. For  aperture  spectra  the database entries are 
+referenced by image name and aperture number and not with image
+sections. Thus, \fBidentify\fR solutions are not tied to specific
+image lines in this case. There is a new autowrite parameter
+which may be set to eliminate the save to database query upon
+exiting. The new colon command "add" may be used to add
+features based on some other spectrum or arc type and then
+apply the fit to the combined set of features.
+.LS LCALIB
+This task has a more compact listing for the "stars" option and
+allows paging a list of stars when the star name query is not
+recognized.
+.LS MKSPEC
+This task is unchanged.
+.LS NAMES
+This task is unchanged.
+.LS NDPREP
+This task was moved from the \fBproto\fR package. It was originally
+written at CTIO for CTIO data. It's functionality is largely
+unchanged though it has been updated for changes in the 
+\fBonedspec\fR package.
+.LS OBSERVATORY
+New version of this task moved to \fBnoao\fR root package.
+.LS POWERCOR
+Moved to the \fBiids\fR package.
+.LS PROCESS
+Moved to the \fBiids/irs\fR package.
+.LS REBIN
+This task has been eliminated. Use \fBscopy\fR or \fBdispcor\fR.
+.LS REFSPECTRA
+A group parameter was added to allow restricting assignments by
+observing period; for example by night.  The record format
+option was removed and the record format syntax is available in
+the \fBiids/irs\fR packages.
+.LS REIDENTIFY
+This task is a new version with many new features.  The new
+features include  an  interactive  options  for reviewing 
+identifications, iterative rejection  of  features  during 
+fitting, automatic addition of new features from a line list,
+and the choice of tracing or using a single master reference
+when reidentifying features in other vectors of a reference
+spectrum. Reidentifications from a reference image to another
+image is done by matching apertures rather than tracing. New
+apertures not present in the reference image may be added.
+.LS SAPERTURES
+This task is new.
+.LS SARITH
+This task is new.
+.LS SCOMBINE
+This task is new.
+.LS SCOPY
+This task is new.
+.LS SENSFUNC
+The latitude parameter has been replaced by the observatory
+parameter. The 'i' flux calibrated graph type now shows flux
+in linear scaling while the new graph type 'l' shows flux in
+log scaling. A new colon command allows fixing the flux limits
+for the flux calibrated graphs.
+.LS SETDISP
+This task has been eliminated.  Use \fBhedit\fR or the package
+DISPAXIS parameter.
+.LS SEXTRACT
+Replaced by \fBscopy\fR.
+.LS SFIT
+This task is new.
+.LS SFLIP
+This task has been eliminated. Use image sections.
+.LS SHEDIT
+This task has been eliminated. Use \fBhedit\fR if needed.
+.LS SINTERP
+This task is unchanged.
+.LS SLIST
+This task was revised to be relevant for the current spectral
+image formats. The old version is still available in the
+\fBiids/irs\fR package.
+.LS SPECPLOT
+New parameters were added to select apertures and bands, plot
+additional dimensions (for example the additional output from
+the extras option in \fBapextract\fR), suppress the system ID banner,
+suppress the Y axis scale, output a logfile, and specify the
+plotting units.  The PTYPE parameter now allows negative 
+numbers to select histogram style lines.  Interactively, the
+plotting units may be changed and the 'v' key allows setting a
+velocity scale zero point with the cursor.  The new version
+supports the new spectral WCS features including nonlinear
+dispersion functions.
+.LS SPLOT
+This is a new version with a significant number of changes. In
+addition to the task changes the other general changes to the
+spectroscopy packages also apply. In particular, long slit
+spectra and spectra with nonlinear dispersion functions may be
+used with this task. The image header or package dispaxis and
+nsum parameters allow automatically extracting spectra from 2D
+image. The task parameters have been modified primarily to
+obtain the desired initial graph without needing to do it
+interactively. In particular, the new band parameter selects
+the band in 3D images, the units parameter selects the 
+dispersion units, and the new histogram, nosysid, and xydraw
+options select histogram line type, whether to include a system
+ID banner, and allow editing a spectrum using  different 
+endpoint criteria.
+.LS
+Because nearly every key is used there has been some shuffling,
+consolidating, or elimination of keys. One needs to check the
+run time '?' help or the help to determine the key changes.
+.LS
+Deblending may  now  use  any  number of components and 
+simultaneous fitting of a linear background. A new simplified
+version of gaussian fitting for a single line has been added in
+the 'k' key. The old 'k', 'h', and 'v' equivalent width
+commands are all part of the single 'h' command using a second
+key to select a specific option. The gaussian line model from
+these modes may now be subtracted from the spectrum in the same
+way as the gaussian fitting.  The one-sided options,  in 
+particular, are interesting in this regard as a new capability.
+.LS
+The arithmetic functions between two spectra are now done in
+wavelength with resampling to a  common  dispersion  done 
+automatically. The 't' key now provides for the full power of
+the ICFIT package to be used on a spectrum for continuum
+normalization, subtraction, or line and cosmic ray removal.
+The 'x' editing key may now use the nearest pixel values rather
+than only the y cursor position to replace regions by straight
+line segments. The mode is selected by the task option 
+parameter "xydraw".
+.LS
+Control over the graph window (plotting limits) is better
+integrated so that redrawing, zooming, shifting, and the \fBgtools\fR
+window commands all work well together. The new 'c' key resets
+the window to the full spectrum allowing the 'r' redraw key to
+redraw the current window to clean up overplots from the
+gaussian fits or spectrum editing.
+.LS
+The dispersion units may now be selected and changed to be from
+hertz to Mev and the log or inverse (for wave numbers) of units
+taken. As part of the units package the 'v' key or colon
+commands may be used to plot in velocity relative to some
+origin. The $ key now easily toggles between the dispersion
+units (whatever they may be) and pixels coordinates.
+.LS
+Selection of spectra has become more complex with multiaperture
+and long slit spectra. New keys allow selecting apertures,
+lines, columns, and bands as well as quickly scrolling through
+the lines in multiaperture spectra. Overplotting is also more
+general and consistent with other tasks by using the 'o' key to
+toggle the next plot to be overplotted. Overplots, including
+those of the gaussian line models, are now done in a different
+line type.
+.LS
+There are new colon commands to change the dispersion axis and
+summing parameters for 2D image, to toggle logging, and also to
+put comments into the log file.
+.LS STANDARD
+Giving an unrecognized standard star name will page a list of
+standard stars available in the calibration directory and then
+repeat the query.
+.LS SUBSETS
+Moved to the \fBiids/irs\fR packages.
+.LS SUMS
+Moved to the \fBiids/irs\fR packages.
diff --git a/noao/onedspec/doc/sys/revisions.v3.ms b/noao/onedspec/doc/sys/revisions.v3.ms
new file mode 100644
index 00000000..1c3da8be
--- /dev/null
+++ b/noao/onedspec/doc/sys/revisions.v3.ms
@@ -0,0 +1,382 @@
+.nr PS 9
+.nr VS 11
+.RP
+.ND
+.TL
+ONEDSPEC Package Revisions Summary: IRAF Version 2.10
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+July 1990
+.AB
+This paper summarizes the changes in Version 3 of the IRAF \fBonedspec\fR
+package which is part of IRAF Version 2.10.  The major new features and
+changes are:
+
+.IP \(bu
+\fBIdentify\fR and \fBreidentify\fR now treat multispec format spectra
+and two dimensional images as a unit.
+.IP \(bu
+\fBReidentify\fR supports both tracing (the old method) and always starting
+with the primary reference vector when reidentifying other vectors in a
+two dimensional reference image.
+.IP \(bu
+\fBReidentify\fR matches reference lines or apertures when reidentifying
+those vectors in different images rather than tracing.
+.IP \(bu
+\fBReidentify\fR has an interactive capability to review
+suspect reidentifications.
+.IP \(bu
+\fBReidentify\fR provides the capability to add new features.
+.IP \(bu
+The task \fBmsdispcor\fR provides for spatial interpolation of wavelength
+zero point shifts from simultaneous arc spectra.
+.IP \(bu
+The new task \fBscopy\fR copies subsets of apertures and does format
+conversions between the different spectrum formats.
+.IP \(bu
+The new task \fBsapertures\fR adds or modifies beam numbers and
+aperture titles for selected apertures based on an aperture
+identification file.
+.IP \(bu
+The new task \fBsfit\fR fits spectra and outputs the fits in various ways.
+Apertures in  multispec and echelle format are fit independently.
+.IP \(bu
+The task \fBcontinuum\fR now does independent fits for multispec and
+echelle format spectra.
+.IP \(bu
+\fBSplot\fR now allows deblending of any number of components and
+allows simultaneous fitting of a linear background.
+.IP \(bu
+The new task \fBfitprofs\fR fits 1D gaussian profiles in images.
+.AE
+.NH
+Introduction
+.PP
+Though  most of the ONEDSPEC package is unchanged there have been
+significant changes to a number of the commonly used tasks in IRAF
+Version 2.10.  The changes will be made available as part of an
+external package prior to the release of V2.10.  This paper summarizes
+the changes and new features.  The changes primarily apply to multispec
+or echelle format spectra.
+.PP
+Tables 1 and 2 summarize most of the major and minor changes in the package.
+
+.ce
+TABLE 1:  Summary of Major New Features and Changes
+
+.IP \(bu
+\fBIdentify\fR and \fBreidentify\fR now treat multispec format spectra
+and two dimensional images as a unit allowing easy movement between
+different image lines or columns.  The database is only updated upon
+exiting the image.
+.IP \(bu
+\fBReidentify\fR supports both tracing (the old method) and always starting
+with the primary reference vector when reidentifying other vectors in a
+two dimensional reference image.
+.IP \(bu
+\fBReidentify\fR matches reference lines or apertures when reidentifying
+those vectors in different images rather than tracing.
+.IP \(bu
+\fBReidentify\fR has an interactive capability to review
+suspect reidentifications.
+.IP \(bu
+\fBReidentify\fR provides the capability to add new features.
+.IP \(bu
+The task \fBmsdispcor\fR allows using
+auxilary reference spectra to provide a shift in the wavelength
+zero point to the primary dispersion functions.  This includes
+spatial interpolation of simultaneous arc spectra in multifiber
+spectrographs.
+.IP \(bu
+The new task \fBscopy\fR copies subsets of apertures and does format
+conversions between the different spectrum formats.
+.IP \(bu
+The new task \fBsapertures\fR adds or modifies beam numbers and
+aperture titles for selected apertures based on an aperture
+identification file.
+.IP \(bu
+The new task \fBsfit\fR fits spectra and outputs the fits in various ways.
+This includes a new feature to replace deviant points by the fit.
+Apertures in  multispec and echelle format are fit independently.
+.IP \(bu
+The task \fBcontinuum\fR now does independent fits for multispec and
+echelle format spectra.
+.IP \(bu
+\fBSplot\fR now allows deblending of any number of components and
+allows simultaneous fitting of a linear background.
+.IP \(bu
+The new task \fBfitprofs\fR fits 1D gaussian profiles to spectral lines or
+features in an image line or column.  This is done noniteractively and
+driven by an input list of feature positions.
+.bp
+.LP
+.ce
+TABLE 2:  Summary of Other New Features and Changes
+
+.IP \(bu
+The \fBidentify\fR database format uses aperture numbers rather than
+image sections for multispec format spectra.
+.IP \(bu
+The apertures in multispec format images need not be in the same order
+or even the same number of apertures as the reference image in
+\fBreidentify\fR or \fBmsdispcor\fR.
+.IP \(bu
+An automatic write parameter has been added to \fBidentify\fR.
+.IP \(bu
+The tasks \fBmsdispcor\fR and \fBspecplot\fR support the extra information
+in the third dimension of multispec format spectra which is optionally
+output by the \fBapextract\fR package.
+.IP \(bu
+\fBMsdispcor\fR and \fBspecplot\fR now include a logfile.
+.IP \(bu
+\fBSplot\fR selects spectra from multispec or echelle format by their
+aperture number.  Also a new keystroke was added to select a new
+line/aperture without having to enter the image name again.
+.IP \(bu
+The task \fBspecplot\fR may select apertures from a multispec or
+echelle format spectrum.
+.IP \(bu
+The aperture identification in multispec format is used, if present,
+for labeling in \fBsplot\fR, \fBspecplot\fR, and \fBstandard\fR.
+.NH
+IDENTIFY and REIDENTIFY
+.PP
+These tasks have been modified for greater flexibility when dealing with
+two dimensional images and multispec format spectra in particular.  These
+tasks were initially designed primarily to work on one dimensional images
+with provisions for two dimensional images through image sections and
+tracing to other parts of the image.  Now these tasks treat such images
+as a unit.
+.PP
+The task \fBidentify\fR has three added keystrokes, 'j', 'k', and 'o'.
+These provide for moving between lines and columns of a two dimensional
+image and different apertures in a multispec format spectrum.  When
+changing vectors the last set of features and fit are recalled, if they
+have been previously defined, or the last set of features and fit are
+inherited.  For efficiency and to minimize queries, the feature
+information from all the lines or apertures is not written to the
+database until you quit the image (or explicitly write it) rather than
+one at a time.  A new parameter was also added, \fIautowrite\fR, which
+may be set to automatically write the results to the database rather
+than querying as is currently done.
+.PP
+The format of the database entries have also been slightly modified in
+the case of multispec format images.  Instead of using image sections
+as part of the image name to define different vectors in the image
+(this is still the case for regular two dimensional images) the aperture
+number is recorded.  This decouples the solutions for an aperture from
+the specific image line allowing reference images to have a different
+aperture order and additional or missing apertures.
+.PP
+While the changes to \fBidentify\fR are minor as far as usage, the task
+\fBreidentify\fR is quite different and is essentially a new program.
+Much of the complexity in this task relates to two dimensional images.
+Two additions that apply to both one and two dimensional images is the
+capability to add features from a coordinate list and to interactively
+review the reidentifications using \fBidentify\fR.  The addition of new
+features may be useful in cases where the signal-to-noise varies or to
+compensate for lost features when tracing across an image.  The review
+capability first prints the statistical results and then ask the user if
+they want to examine the results interactively .  This allows
+basing the decision to interactively examine the features and fit based
+on this information.  Ideally, only a few of the worst cases need be
+examined interactively.
+.PP
+There are two phases of reidentifications which apply to two
+dimensional and multispec format images.  In the first phase, one needs
+to expand the identifications in the reference image from an initial,
+interactively defined line, column, or aperture to other parts of the
+reference image.  A very important change is that there are now two
+ways to transfer the features list; by successive steps (tracing) using
+the previous results as a starting point (the only method provided in
+the previous version) or always starting from the original reference
+list.  The first method is suitable for long slit spectra which have
+significant positional trends across the image.  If a feature is lost,
+however, the feature remains missing (barring automatic addition as
+mentioned above) for all following lines or columns.  The latter method
+is best if there are only small variations relative to the initial
+reference or in multispec format spectra where there is no inherent
+relation between apertures.
+.PP
+The second phase of reidentifications is between the reference image
+and other images.  In the previous version the primary reference vector
+was transferred to the new image and then tracing would be applied
+again.  This compounds the problem with losing features during tracing
+and prevents any possible reidentifications from multispec images in
+which the wavelength range may vary greatly.  In the new version there
+is a direct reidentification from the same line, column, or aperture in
+the reference to that of the next image.  In the case where different
+apertures may have significantly different wavelength coverage, as
+occurs with aperture masks, it will at least be possible to
+interactively identify features and coordinate functions for each
+aperture, using the scrolling capability in the new \fBidentify\fR, in
+just a single image and then correctly transfer the features to
+additional images.
+.PP
+For multispec format spectra the database information is organized by
+aperture number independent of image line number.  Thus, it is possible
+to reidentify features in multispec format spectra even if the aperture
+order is different.  If there is only a partial overlap in the aperture
+set only those apertures having an entry in the reference image will be
+done.
+.NH
+MSDISPCOR
+.PP
+The task \fBmsdispcor\fR dispersion corrects (rebins to a linear
+dispersion function) multispec format spectra.  It was introduced in
+V2.8 of IRAF in the prototype \fBimred.msred\fR package.  A number of
+changes have been made in this task as summarized here.
+.PP
+The most fundamental change is support for spatial interpolation of
+reference dispersion functions from a subset of apertures to other
+apertures originating at different positions in a two dimensional
+image.  This is primarily intended for the case of comparison arc
+spectra which are interspersed with object spectra in multifiber
+spectrographs.  It would also be useful in digitized photographic
+spectra having calibration spectra exposed next to the object
+spectrum.  While usable directly, this feature is intended for the
+processing scripts in the new \fBimred\fR fiber instrument packages.
+.PP
+The interpolation is only for a wavelength zero point shift, as determined
+by \fBreidentify\fR with \fIrefit\fR=no.  The full dispersion function
+is still provided by a calibration image covering all apertures.  Thus,
+the simultaneous arc apertures are used to monitor shifts in the
+detector relative to the full calibration which includes the relative
+differences between each aperture and the arc monitoring apertures.
+.PP
+The multispec spectra containing the apertures used for the spatial
+wavelength zero point corrections are specified in the image header
+using the keywords REFSHFT1 and REFSHFT2.  These are analogous to
+the REFSPEC keywords used to define the reference dispersion functions
+for the apertures.
+.PP
+As part of the general theme of multispec format support the
+multispec dispersion reference spectra may have additional spectra and
+need not be in the same order.  However, all aperture in the
+images being dispersion corrected must have dispersion relations
+in the database.  Multispec format spectra may include additional
+data in the 3rd image dimension produced by the new
+\fBapextract\fR package.  \fBMsdispcor\fR rebins this information
+in the same way as the spectra, thus, preserving the information
+but now in linear wavelength sampling.
+.PP
+A new parameter, \fIlogfile\fR, has been added to capture information
+about the dispersion correction process.
+.NH
+SCOPY and SAPERTURES
+.PP
+The task \fBscopy\fR is intended to bridge the gap between the various
+spectrum formats and provide a tool to flexibly manipulate multispec
+format spectra.  It replaces the more primitve tasks
+\fBmsred.msselect\fR and \fBechelle.ecselect\fR.  Basically, this task
+copies all or selected spectra from one format to a new image or images
+of the same or different format.  The typical uses are:
+
+.IP \(bu
+Extract selected spectra from a multispec format image.
+.IP \(bu
+Allow converting the voluminous onedspec format from previous reductions
+done before the multispec format was introduced into the more compact
+multispec format.
+.IP \(bu
+Splice selected apertures from different multispec images into a new
+multispec image.
+.IP \(bu
+Provide a quick way to convert lines or columns from two dimensional
+long slit images into one dimensional spectra.  This replaces
+the task \fBproto.toonedspec\fR.
+.PP
+Because \fBscopy\fR can easily change the number and order of apertures
+in the multispec image format it is important that the other tasks which
+use the multispec format have been modified to be insensitive to which
+line a spectrum is in and generally key off the aperture number.
+.PP
+The task \fBsapertures\fR is a simple way to set the aperture identifications,
+APID keyword, and beam number, second field of APNUM keyword, based on
+the aperture number and a simple text file.  The text file contains lines
+with aperture number, beam number, and (optional) title.  This file is
+used by the \fBapextract\fR package as well.  Its likely usage is
+to change image titles which might be wrong because of being inherited
+from an aperture reference image during extraction.
+.NH
+SFIT, CONTINUUM, and ECCONTINUUM
+.PP
+The original version of \fBcontinuum\fR was a simple script based on
+the task \fBfit1d\fR.  The problem is that \fBfit1d\fR is intended to
+process all the lines or columns in a two dimensional image
+noninteractively.  To do this it applies the same fitting parameters to
+every line or column.  The interactive step in this task is simply to
+adjust fitting parameters.  For spectra, particularly multispec and
+echelle format spectra, one often needs to fit each spectrum
+interactively and independently.  When this problem was encountered for
+the \fBechelle\fR package Rob Seaman wrote a nice program,
+\fBeccontinuum\fR, which allows fitting a set of orders and keeps track
+of which orders have been fit.
+.PP
+The general feature of the continuum fitting tasks is that they fit
+spectra using the \fBicfit\fR interactive function fitting interface.
+The results of the fit may be output as the fit itself, the difference
+or residuals, the ratio, or the input data with rejected points replaced
+by the fitted values.  The last feature is new an provides a useful
+spectrum cleaning option.  The general equivalent to \fBfit1d\fR is
+the new task \fBsfit\fR which provides the same independent fitting and
+image line selection capabilites as \fBeccontinuum\fR.  Note this task
+is line oriented and does not select by aperture or order number.  The
+revised version of \fBcontinuum\fR is now based on \fBsfit\fR and
+provides the independent continuum fitting capability for onedspec and
+multispec format spectra that \fBeccontinuum\fR provides for echelle
+format spectra.  Technically what has been done is that \fBsfit\fR,
+\fBcontinuum\fR, and \fBeccontinuum\fR are the same task; essentially
+the task written by Seaman for echelle data.  They differ in the
+default parameters with the continuum fitting task having default
+parameters providing continuum normalization (ratio) output and
+iterative rejection values for excluding lines.
+.NH
+SPLOT, FITPROFS, and SPECPLOT
+.PP
+\fBSplot\fR has been modified to better support multispec and echelle
+format images.  The line selection for multispec and echelle format
+spectra is now in terms of the aperture number rather than the image
+line.  The aperture title is used in place of the image title
+if present.
+.PP
+The restriction to a maximum of four lines in the gaussian fitting and
+deblending option of \fBsplot\fR has been lifted.  Any number of
+lines may be fit simultaneously, though execution time will become
+long for a large number.  In addition the fitting allows determining
+a simultaneous linear background as well as using the cursor defined
+points.  The positions of the lines to be fit may be marked with
+the cursor, typed in, or read from a file.  The last choice is a new
+feature.
+.PP
+In the past many people have used \fBsplot\fR for bulk, noninteractive
+gaussian fitting by going through the trouble of redirecting the cursor
+input, ukey input, text output, and graphics output.  The main reason
+this has been done is the lack of a one dimensional gaussian fitting
+task.  The task \fBfitprofs\fR has been added to provide simultaneous
+gaussian fitting.  This task takes a list of positions and optional
+sigmas and fits gaussians to a list of images or spectra.  The lines,
+columns, or apertures may be selected.  In addition a linear
+background may be specified or included in the fitting.  The output
+consists of any combination of text similiar to the \fBsplot\fR
+logfile, plots showing the data and fit, and image output of the fit or
+the difference.  This task is noninteractive; the interactive version
+is the deblend command of \fBsplot\fR.  The multiparameter, nonlinear
+fitting software is the same as used in \fBsplot\fR.
+.PP
+\fBFitprofs\fR complements the task \fBstsdas.fitting.ngaussfit\fR from
+the \fBstsdas\fR package (available from the Space Telescope Science
+Institute).  This task is similar in character to \fBfit1d\fR and has
+an interactive one dimensional nonlinear function fitting interface
+similar to \fBicfit\fR.
+.PP
+The task \fBspecplot\fR has a new parameter to select apertures to
+plot.  Previously there was no way to limit the apertures plotted other
+than with image sections.  All associated lines of a multispec
+spectrum (those in the third dimension) are also plotted for the
+selected apertures.  This extra information is a new option of the
+\fBapextract\fR package.
diff --git a/noao/onedspec/doc/sys/revisions.v31.ms b/noao/onedspec/doc/sys/revisions.v31.ms
new file mode 100644
index 00000000..f9d6c24f
--- /dev/null
+++ b/noao/onedspec/doc/sys/revisions.v31.ms
@@ -0,0 +1,329 @@
+.nr PS 10
+.nr VS 12
+.RP
+.ND
+.TL
+NOAO Spectroscopy Packages Revisions: IRAF Version 2.10.3
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+March 1993
+.AB
+This paper summarizes the changes in Version 3.1 of the IRAF/NOAO
+spectroscopy packages, \fBonedspec\fR, \fBlongslit\fR, \fBapextract\fR, and
+those in \fBimred\fR.  These changes are part of IRAF Version 2.10.3.  A
+list of the revisions is:
+
+.in +2
+.nf
+\(bu A simplified \fIequispec\fR image header format
+\(bu \fIEquispec\fR format allows a larger number of apertures in an image
+\(bu Extensions to allow tasks to work on 3D images
+\(bu New task \fBspecshift\fR for applying a zeropoint dispersion shift
+\(bu Revised \fBsapertures\fR to edit spectrum coordinate parameters
+\(bu Revised \fBdispcor\fR to easily apply multiple dispersion corrections
+\(bu Revised \fBscombine\fR weighting and scaling options
+\(bu Revised \fBscopy\fR to better handle bands in 3D images
+\(bu Revised \fBcalibrate, deredden, dopcor\fR, and \fBspecshift\fR to work on 2D/3D images
+\(bu Extended \fBidentify\fR and \fBreidentify\fR to work on 3D images
+\(bu New color graphics capabilities in \fBsplot, specplot, sensfunc\fR, and \fBidentify\fR
+\(bu All spectral tasks use a common package dispersion axis parameter
+\(bu A more complete suite of tasks in the \fBlongslit\fR package
+\(bu The \fBimred\fR reductions scripts can now be used with any image format
+\(bu A \fIdatamax\fR parameter in the \fBimred\fR reduction scripts for better cleaning
+\(bu Revised the \fBimred\fR reduction scripts to abort on non-CCD processed data
+\(bu Revised fiber reduction tasks to include a scattered light subtraction option
+\(bu Revised fiber reduction tasks to allow as many sky apertures as desired
+\(bu Revised \fBdoslit\fR to take the reference arc aperture from the first object
+\(bu Bug fixes
+.fi
+.in -2
+.AE
+.NH
+Spectral Image Formats and Dispersion World Coordinate Systems
+.LP
+As with the original release of V2.10 IRAF, the primary changes in the
+NOAO spectroscopy
+software in V2.10.3 are in the area of spectral image formats and dispersion
+world coordinate systems (WCS).  A great deal was learned from experience
+with the first release and the changes in this release attempt to
+address problems encountered by users.  The main revisions are:
+
+.in +2
+.nf
+\(bu A new WCS format called \fIequispec\fR.
+\(bu Extensions to allow use of 3D images with arbitrary dispersion axis.
+\(bu Elimination of limits on the number of apertures in an image under certain conditions.
+\(bu Improved tools for manipulating the spectral coordinate systems.
+\(bu Bug fixes and solutions to problems found in the previous release.
+.fi
+.in -2
+
+In the previous version all images with multiple spectra used a coordinate
+system called \fImultispec\fR.  This type of WCS is complex and difficult
+to manipulate by image header editing tools.  Only the case of a single
+linearized spectrum per image, sometimes called \fIonedspec\fR format,
+provided a simple header format.  However, the \fBapextract\fR package
+used the \fImultispec\fR format even in the case of extracting a single
+spectrum so to get to the simple format required use of \fBscopy\fR.
+.LP
+In many cases all the spectra in a multispectrum image have the same linear
+dispersion function.  The new \fIequispec\fR format uses a simple linear
+coordinate system for the entire image.  This format is produced by the
+spectral software whenever possible.  In addition to being simple and
+compatible with the standard FITS coordinate representation, the
+\fIequispec\fR format also avoids a limitation of the \fImultispec\fR WCS
+on the number of spectra in a single image.  This has specific application
+to multifiber spectrographs with more than 250 fibers.
+.LP
+For multiple spectrum data in which the spectra have differing
+dispersion functions (such as echelle orders) or when the spectra are
+not linearized but use nonlinear dispersion functions, the \fImultispec\fR
+format is still used.  It is the most general WCS representation.
+The difficulties with modifying this coordinate system, \fBhedit\fR
+cannot be used, are addressed by enhancing the \fBsapertures\fR task
+and by the new task \fBspecshift\fR which covers the common case of
+modifying the dispersion zeropoint.
+.LP
+A feature of the spectral tasks which operate on one dimensional spectra
+is that they can operate on two dimensional long slit spectra by
+specifying a dispersion axis and a summing factor.  This feature has
+been extended to three dimensional spectra such as occur with
+Fabry-Perot and multichannel radio synthesis instruments.  The
+dispersion axis may be along any axis as specified by the DISPAXIS
+image header keyword or by the \fIdispaxis\fR package parameter.  The
+summing factor parameter \fInsum\fR is now a string which may have
+one or two values to allow separate summing factors along two spatial
+axes.  Also, some additional tasks which previously did not support this
+feature are \fBcalibrate\fR, \fBderedden\fR, \fBdopcor\fR, and \fBspecshift\fR.
+.LP
+The gory details of the spectral image formats and world coordinate
+systems are laid out in the new help topic \fIspecwcs\fR (also
+available in a postscript version in the IRAF network documentation
+archive as iraf/docs/specwcs.ps.Z).
+.LP
+Some of the bug fixes and solutions to problems found in the previous
+release concerning the image formats and WCS are a problem with the WCS
+dimensionality (WCSDIM keyword) with 3D images and problems reading various
+imported nonstandard formats.  It is hoped that all such formats, including
+previous IRAF spectral formats will all be allowed by the software in the
+latest release.
+.NH
+DISPCOR
+.LP
+The previous versions of \fBdispcor\fR, the dispersion correction task, was
+designed to prevent accidental repeated application; it is incorrect to
+apply the dispersion function from the original data to a linearized
+spectrum.  However, it is valid to determine a new dispersion solution, say
+from a dispersion calibrated arc, and apply that as a second correction.
+\fBDispcor\fR would not use a new dispersion function, as specified by the
+REFSPEC keywords, if the dispersion calibration flag was set.  In order to
+override this the user needed to manually change this flag to indicate the
+spectrum was uncorrected.  The problem was that it was difficult to do this
+with \fImultispec\fR format spectra because the flag is part of the complex
+WCS attribute strings.
+.LP
+\fBDispcor\fR was revised to use a different logic to prevent accidental
+recalibration using an unintended dispersion function.  The logic is as
+follows.  Previously \fBdispcor\fR would simply change the dispersion
+calibration flag after correcting a spectrum while leaving the dispersion
+function reference spectrum keywords alone as a record.  The revised
+\fBdispcor\fR keeps this useful record but moves this it to a new keyword
+DCLOGn (where n is a sequential integer).  Because the REFSPEC keyword is
+removed after each application of \fBdispcor\fR it now takes an explicit
+act by the user to assign another dispersion function to a spectrum and so
+it is not possible to accidentally reapply the same dispersion function
+twice.  Thus this version will apply additional dispersion functions by
+simply adding new REFSPEC keywords.  If they are absent the task resamples
+the spectra based on the current dispersion relation as was the case
+before.
+.LP
+The new version can also tell whether the data was calibrated by the
+previous version.  In this case the check on the dispersion calibration
+flag is still used so that during the transition users are still protected
+against accidentally applying the same reference dispersion function
+twice.  The new task \fBsapertures\fR can now be used to change the
+dispersion calibration flag to override this checking more easily than was
+the case previously.
+.NH
+New Tasks
+.LP
+In this release there is only one completely new task and one task which
+was significantly redesigned.  The new task is \fBspecshift\fR.  It is
+relatively simple, it adds a zero point shift to the dispersion coordinates
+of spectra.  This was the most common request for manipulating the spectral
+world coordinate system.  In this regard there was a common confusion about
+the distinction between shifting the coordinate system and shifting the
+pixel data.  Generally what people want is to apply a shift such that
+features in the spectrum move to the desired wavelength.  One thought is to
+apply the tasks \fBimshift\fR or \fBshiftlines\fR.  The surprise is that
+this does not to work.  The pixels are actually shifted in the image array,
+but these tasks also apply the same shift to the coordinate system so that
+features in the spectrum remain at the same wavelength.  What is really
+required is to leave the pixel data alone and shift only the coordinate
+system.  That is what \fBspecshift\fR does.
+.LP
+While one hopefully does not need to directly manipulate the image header
+keywords describing the coordinate system or other aspects of the spectra,
+instead using such tasks as \fBspecshift\fR, there always seem to be cases
+where this is needed or desired.  In the V2.10 release of the spectral
+software this was difficult because the general \fImultispec\fR format was
+the norm and it has information encoded in the complex WCS attribute
+strings.  As mentioned previously several changes have been made reduce the
+complexity.  Now \fIequispec\fR format will generally be the rule and this
+format has keywords which are more easily manipulated with \fBhedit\fR and
+\fBwcsedit\fR.  However, the task \fBsapertures\fR was revised to provide
+an editing capability specifically for spectral images, in either
+\fImultispec\fR or \fIequispec\fR format, with options to change various
+parameters globally or aperture-by-aperture.
+.NH
+New Features
+.LP
+There were a number of miscellaneous minor revisions and bug fixes.  One of
+the major new capabilities available with V2.10.3 is support for color
+graphics if the graphics device supports it.  \fBXgterm\fR supports color
+on X-window systems with color monitors.  Several of the spectral tasks
+were modified to use different colors for marks and overplots.  These tasks
+include \fBsplot\fR, \fBspecplot\fR, \fBidentify\fR, and \fBsensfunc\fR.
+In the case of \fBsensfunc\fR the user controls the various color
+assignments with a task parameter or \fBgtools\fR colon command while in
+other cases the next available color is used.
+.LP
+There were several changes to \fBscombine\fR equivalent to those in
+\fBimcombine\fR.  The weighting, when selected, was changed from the square
+root of the exposure time or spectrum statistics to the value with no
+square root.  This corresponds to the more commonly used variance
+weighting.  Other options were added to specify the scaling and weighting
+factors.  These allow specifying an image header keyword or a file
+containing the scale or weighting factors.  A new parameter, "nkeep" has
+been added to allow controlling the maximum number of pixels rejected by the
+clipping algorithms.  Previously it was possible to reject all pixels even
+when some of the data was good though with a higher scatter than estimated;
+i.e. all pixels might be greater than 3 sigma from the mean without being
+cosmic rays or other bad values.  Finally a parameter \fIsnoise\fR was
+added to include a sensitivity or scale noise component to a Poisson noise
+model.
+.LP
+In \fBsplot\fR the 'p' and 'u' keys which assign and modify the dispersion
+coordinates now include options for applying a zero point shift or a
+doppler shift in addition to defining an absolute wavelength for a feature
+or starting and ending wavelengths.  There are also bug fixes to the
+equivalent width calculations, it did not handle flux calibrated data, and
+the scroll keys '(' and ')'.
+.LP
+There were several changes to make it easier to deal with with three
+dimensional \fImultispec\fR and \fIequispec\fR data; that is the additional
+data from the "extras" option in the \fBapextract\fR tasks.  One was to fix
+problems associated with an incorrect WCSDIM keyword.  This allows use of
+image sections or \fBimcopy\fR for extracting specific bands and
+apertures.  Another was to add a "bands" parameter in \fBscopy/sarith\fR to
+allow selection of bands.  Also the "onedspec" output format in \fBscopy\fR
+copies any selected bands to separate one dimensional images.
+.LP
+As mentioned earlier, many of the \fBonedspec\fR tasks have been extended
+to work on 2D and 3D spatial spectra.  Some tasks which now have this
+capability in this version and not the previous one are \fBcalibrate\fR and
+\fBdopcor\fR.  \fBIdentify\fR and \fBredentify\fR were extended to operate
+on 3D images.  This involved extending the syntax for the section parameter
+selecting the image vector and the parameter specifying any summing
+across the vector direction.
+.NH
+LONGSLIT
+.LP
+With the applicability of more \fBonedspec\fR tasks to long slit data
+the \fBlongslit\fR package was modified to add many new tasks.
+This required adding additional package parameters.  One new task
+to point out is \fBcalibrate\fR.  This task is now the preferred one
+to use for extinction and flux calibration of long slit spectra
+rather than the obsolete \fBextinction\fR and \fBfluxcalib\fR.
+The obsolete tasks are still present in this release.
+.NH
+APEXTRACT
+.LP
+The \fBapextract\fR package had a few, mostly transparent, changes.  In
+the previous version the output image header format was always \fImultispec\fR
+even when there was a single spectrum, either because only one aperture
+was defined or because the output format parameter was "onedspec".
+In this release the default WCS format is the simpler \fIequispec\fR.
+.LP
+In the \fBonedspec\fR and \fBimred\fR spectral reduction packages there is
+a dispersion axis package parameter which is used to defined the dispersion
+axis for images without a DISPAXIS keyword.  This applies to all tasks.
+However, the \fBapextract\fR tasks had the dispersion axis defined by their
+own task parameters resulting in some confusion.  To make things consistent
+the dispersion axis parameter in \fBapextract\fR has been moved from the
+tasks to a package parameter.  Now in the \fBimred\fR spectral reduction
+packages, there is just one dispaxis parameter in the package parameters
+which applies to all tasks in those packages, both those from
+\fBonedspec\fR and those from \fBapextract\fR.
+.LP
+Some hidden algorithm parameters were adjusted so that the cleaning and
+variance weighting options perform better in some problem cases without
+requiring a great deal of knowledge about things to tweak.
+.NH
+IMRED Spectroscopic Reduction Tasks
+.LP
+The various spectroscopic reductions tasks, those beginning with "do", have
+had some minor revisions and enhancements in addition to those which apply
+to the individual tasks which make up these scripts.  In the latter class
+is the output WCS format is \fBequispec\fR except for the echelle tasks and
+when dispersion linearization is not done.  Related to this is that the
+multifiber tasks can operate on data with more than 250 fibers which was a
+limitation of the \fBmultispec\fR format.
+.LP
+In the previous version only the OIF format images were allowed (the ".imh"
+extensions).  This has been generalized to allow selecting the image format
+by setting the environment parameter \fIimtype\fR.  Only images with the
+specified extension will be processed and created.
+.LP
+The dispersion axis parameter in the reduction tasks and in the other tasks
+in the \fBimred\fR spectroscopy packages, such as the \fBapextract\fR
+tasks, is now solely a package parameter.
+.LP
+All the scripts now check the input spectra for the presence of the CCDPROC
+keyword and abort if it is not found.  This keyword indicates that the data
+have been processed for basic CCD calibrations, though it does not check
+the operations themselves.  For data reduced using \fBccdproc\fR this
+keyword will be present.  If these tasks are used on data not processed by
+\fBccdproc\fR then it is a simple matter to add this keyword with
+\fBhedit\fR.  Obviously, the purpose of this change is to avoid
+inadvertently operating on raw data.
+.LP
+All the "do" tasks now have a parameter "datamax".  This minimizes the
+effects of very strong cosmic rays during the extraction of object spectra;
+it does not apply to flat field or arc spectra.  When there is a very large
+difference between data pixel values and cosmic ray pixel values,
+especially true for very weak spectra, the cosmic ray cleaning operation
+does not always work well.  If it is possible to specify a threshold value
+between the maximum real data value and cosmic rays then the cosmic ray
+cleaning can be significantly improved by immediately rejecting those
+pixels above the threshold.  Of course the user must be careful that real
+data does not exceed this value since such data will be excluded.
+.LP
+The fiber reduction tasks, \fBdoargus, dohydra, dofibers, dofoe\fR, and
+\fBdo3fiber\fR have a new processing option for subtracting scattered
+light.  This is particularly useful if there is significant scattered light
+in producing uniform sky spectra for sky subtraction since the fiber
+throughput calibration does not generally correct for this.
+.LP
+The fiber reduction tasks also had a limit on the number of sky fibers
+which could be used with the interactive sky editing.  This limit has
+been eliminated so that it is possible, for example, to have one object
+fiber and 99 sky fibers.
+.LP
+The slit reduction task \fBdoslit\fR previously required that the spectrum
+for the reference arc cover the middle of the input data images.  There
+were cases of instrument configurations  where this was not true requiring
+additional manipulation to use this task.  This requirement has been
+eliminated.  Instead when the reference arc needs to be extracted it uses
+the aperture definition from one of the input object spectra since
+definition of the object apertures occurs prior to setting up the
+dispersion calibration.
+.LP
+In addition the task \fBdoslit\fR and \fBdoecslit\fR had a bug in which
+the order of the arcs specified by the user was ignored and alphabetical
+order was used instead.  This has been fixes so that the first arc
+specified by the use is the reference arc.
diff --git a/noao/onedspec/doc/sys/revisions.v31.ms.bak b/noao/onedspec/doc/sys/revisions.v31.ms.bak
new file mode 100644
index 00000000..1c7c3b31
--- /dev/null
+++ b/noao/onedspec/doc/sys/revisions.v31.ms.bak
@@ -0,0 +1,307 @@
+.nr PS 9
+.nr VS 11
+.RP
+.ND
+.TL
+NOAO Spectroscopy Packages Revision Summary: IRAF Version 2.10.3
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+March 1993
+.AB
+This paper summarizes the changes in Version 3.1 of the IRAF/NOAO
+spectroscopy packages, \fBonedspec\fR, \fBlongslit\fR, \fBapextract\fR,
+and those in \fBimred\fR.  These changes are part of
+part of IRAF Version 2.10.3.  A list of the revisions is:
+
+.nf
+\(bu A simplified \fIequispec\fR image header format
+\(bu \fIEquispec\fR format allows a larger number of apertures in an image
+\(bu Extensions to allow tasks to work on 3D images
+\(bu New task \fBspecshift\fR for applying a zeropoint dispersion shift
+\(bu Revised \fBsapertures\fR to edit spectrum coordinate parameters
+\(bu Revised \fBdispcor\fR to easily apply multiple dispersion corrections
+\(bu Revised \fBscombine\fR weighting and scaling options
+\(bu Revised \fBscopy\fR to better handle bands in 3D images
+\(bu Revised \fBcalibrate, dopcor\fR, and \fBspecshift\fR to work on 2D/3D images
+\(bu New color graphics capabilities in \fBsplot, specplot, sensfunc\fR, and \fBidentify\fR
+\(bu All spectral tasks use a common package dispersion axis parameter
+\(bu A more complete suite of tasks in the \fBlongslit\fR package
+\(bu A \fIdatamax\fR parameter in the \fBimred\fR reduction scripts for better cleaning
+\(bu Revised the \fBimred\fR reduction scripts to abort on non-CCD processed data
+\(bu Revised fiber reduction tasks to include a scattered light subtraction option
+\(bu Revised \fBdoslit\fR to take the reference arc aperture from the first object
+\(bu Bug fixes
+.fi
+.AE
+.NH
+Spectral Image Formats and Dispersion World Coordinate Systems
+.LP
+As with the original release of V2.10 IRAF, the primary changes in the
+NOAO spectroscopy
+software in V2.10.3 are in the area of spectral image formats and dispersion
+world coordinate systems (WCS).  A great deal was learned from experience
+with the first release and the changes in this release attempt to
+address problems encountered by users.  The main revisions are:
+
+.in +4
+.nf
+\(bu A new WCS format called \fIequispec\fR.
+\(bu Extensions to allow use of 3D images with arbitrary dispersion axis.
+\(bu Elimination of limits on the number of apertures in an image under certain conditions.
+\(bu Improved tools for manipulating the spectral coordinate systems.
+\(bu Bug fixes and solutions to problems found in the previous release.
+.fi
+.in - 4
+
+In the previous version all images with multiple spectra used a coordinate
+system called \fImultispec\fR.  This type of WCS is complex and difficult
+to manipulate by image header editting tools.  Only the case of a single
+linearized spectrum per image, sometimes called \fIonedspec\fR format,
+provided a simple header format.  However, the \fBapextract\fR package
+used the \fImultispec\fR format even in the case of extracting a single
+spectrum so to get to the simple format required use of \fBscopy\fR.
+.LP
+In many cases all the spectra in a multispectrum image have the same linear
+dispersion function.  The new \fIequispec\fR format uses a simple linear
+coordinate system for the entire image.  This format is produced by the
+spectral software whenever possible.  In addition to being simple and
+compatible with the standard FITS coordinate representation, the
+\fIequispec\fR format also avoids a limitation of the \fImultispec\fR WCS
+on the number of spectra in a single image.  This has specific application
+to multifiber spectrographs with more than 250 fibers.
+.LP
+For multiple spectrum data in which the spectra have differing
+dispersion functions (such as echelle orders) or when the spectra are
+not linearized but use nonlinear dispersion functions, the \fImultispec\fR
+format is still used.  It is the most general WCS representation.
+The difficulties with modifying this coordinate system, \fBhedit\fR
+cannot be used, are addressed by enhancing the \fBsapertures\fR task
+and by the new task \fBspecshift\fR which covers the common case of
+modifying the dispersion zeropoint.
+.LP
+A feature of the spectral tasks which operate on one dimensional spectra
+is that they can operate on two dimensional long slit spectra by
+specifying a dispersion axis and a summing factor.  This feature has
+been extended to three dimensional spectra such as occur with
+Fabry-Perot and multichannel radio synthesis instruments.  The
+dispersion axis may be along any axis as specified by the DISPAXIS
+image header keyword or by the \fIdispaxis\fR package parameter.  The
+summing factor parameter \fInsum\fR is now a string which may have
+one or two values to allow separate summing factors along two spatial
+axes.  Also, some additional tasks which previously did not support this
+feature are \fBcalibrate\fR, \fBdopcor\fR, and \fBspecshift\fR.
+.LP
+The gory details of the spectral image formats and world coordinate
+systems are laid out in the new help topic \fIspecwcs\fR (also
+available in a postscript version in the IRAF network documentation
+archive as iraf/docs/specwcs.ps.Z).
+.LP
+Some of the bug fixes and solutions to problems found in the previous
+release concerning the image formats and WCS are a problem with the WCS
+dimensionality (WCSDIM keyword) with 3D images and problems reading various
+imported nonstandard formats.  It is hoped that all such formats, including
+previous IRAF spectral formats will all be allowed by the software in the
+latest release.
+.NH
+DISPCOR
+.LP
+The previous versions of \fBdispcor\fR, the dispersion correction task, was
+designed to prevent accidental repeated application; it is incorrect to
+apply the dispersion function from the original data to a linearized
+spectrum.  However, it is valid to determine a new dispersion solution, say
+from a dispersion calibrated arc, and apply that as a second correction.
+\fBDispcor\fR would not use a new dispersion function, as specified by the
+REFSPEC keywords, if the dispersion calibration flag was set.  In order to
+override this the user needed to manually change this flag to indicate the
+spectrum was uncorrected.  The problem was that it was difficult to do this
+with \fImultispec\fR format spectra because the flag is part of the complex
+WCS attribute strings.
+.LP
+\fBDispcor\fR was revised to use a different logic to prevent accidental
+recalibration using an unintended dispersion function.  The logic is as
+follows.  Previously \fBdispcor\fR would simply change the dispersion
+calibration flag after correcting a spectrum while leaving the dispersion
+function reference spectrum keywords alone as a record.  The revised
+\fBdispcor\fR keeps this useful record but moves this it to a new keyword
+DCLOGn (where n is a sequential integer).  Because the REFSPEC keyword is
+removed after each application of \fBdispcor\fR it now takes an explicit
+act by the user to assign another dispersion function to a spectrum and so
+it is not possible to accidentally reapply the same dispersion function
+twice.  Thus this version will apply additional dispersion functions by
+simply adding new REFSPEC keywords.  If they are absent the task resamples
+the spectra based on the current dispersion relation as was the case
+before.
+.LP
+The new version can also tell whether the data was calibrated by the
+previous version.  In this case the check on the dispersion calibration
+flag is still used so that during the transition users are still protected
+against accidentally applying the same reference dispersion function
+twice.  The new task \fBsapertures\fR can now be used to change the
+dispersion calibration flag to override this checking more easily than was
+the case previously.
+.NH
+New Tasks
+.LP
+In this release there is only one completely new task and one task which
+was significantly redesigned.  The new task is \fBspecshift\fR.  It is
+relatively simple, it adds a zero point shift to the dispersion coordinates
+of spectra.  This was the most common request for manipulating the spectral
+world coordinate system.  In this regard there was a common confusion about
+the distinction between shifting the coordinate system and shifting the
+pixel data.  Generally what people want is to apply a shift such that
+features in the spectrum move to the desired wavelength.  One thought is to
+apply the tasks \fBimshift\fR or \fBshiftlines\fR.  The surprise is that
+this does not to work.  The pixels are actually shifted in the image array,
+but these tasks also apply the same shift to the coordinate system so that
+features in the spectrum remain at the same wavelength.  What is really
+required is to leave the pixel data alone and shift only the coordinate
+system.  That is what \fBspecshift\fR does.
+.LP
+While one hopefully does not need to directly manipulate the image header
+keywords describing the coordinate system or other aspects of the spectra,
+instead using such tasks as \fBspecshift\fR, there always seem to be cases
+where this is needed or desired.  In the V2.10 release of the spectral
+software this was difficult because the general \fImultispec\fR format was
+the norm and it has information encoded in the complex WCS attribute
+strings.  As mentioned previously several changes have been made reduce the
+complexity.  Now \fIequispec\fR format will generally be the rule and this
+format has keywords which are more easily manipulated with \fBhedit\fR and
+\fBwcsedit\fR.  However, the task \fBsapertures\fR was revised to provide
+an editing cabability specifically for spectral images, in either
+\fImultispec\fR or \fIequispec\fR format, with options to change various
+parameters globally or aperture-by-aperture.
+.NH
+New Features
+.LP
+There were a number of miscellaneous minor revisions and bug fixes.  One of
+the major new capabilities available with V2.10.3 is support for color
+graphics if the graphics device supports it.  \fBXgterm\fR supports color
+on X-window systems with color monitors.  Several of the spectral tasks
+were modified to use different colors for marks and overplots.  These tasks
+include \fBsplot\fR, \fBspecplot\fR, \fBidentify\fR, and \fBsensfunc\fR.
+In the case of \fBsensfunc\fR the user controls the various color
+assignments with a task parameter or \fBgtools\fR colon command while in
+other cases the next available color is used.
+.LP
+There were several changes to \fBscombine\fR equivalent to those in
+\fBimcombine\fR.  The weighting, when selected, was changed from the square
+root of the exposure time or spectrum statistics to the value with no
+square root.  This corresponds to the more commonly used variance
+weighting.  Other options were added to specify the scaling and weighting
+factors.  These allow specifying an image header keyword or a file
+containing the scale or weighting factors.  A new parameter, "nkeep" has
+been added to allow controling the maximum number of pixels rejected by the
+clipping algorithms.  Previously it was possible to reject all pixels even
+when some of the data was good though with a higher scatter than estimated;
+i.e. all pixels might be greater than 3 sigma from the mean without being
+cosmic rays or other bad values.  Finally a parameter \fIsnoise\fR was
+added to include a sensitivity or scale noise component to a Poisson noise
+model.
+.LP
+In \fBsplot\fR the 'p' and 'u' keys which assign and modify the dispersion
+coordinates now include options for applying a zero point shift or a
+doppler shift in addition to defining an absolute wavelength for a feature
+or starting and ending wavelengths.  There are also bug fixes to the
+equivalent width calculations, it did not handle flux calibrated data, and
+the scroll keys '(' and ')'.
+.LP
+There were several changes to make it easier to deal with with three
+dimensional \fImultispec\fR and \fIequispec\fR data; that is the additional
+data from the "extras" option in the \fBapextract\fR tasks.  One was to fix
+problems associated with an incorrect WCSDIM keyword.  This allows use of
+image sections or \fBimcopy\fR for extracting specific bands and
+apertures.  Another was to add a "bands" parameter in \fBscopy/sarith\fR to
+allow selection of bands.  Also the "onedspec" output format in \fBscopy\fR
+copies any selected bands to separate one dimensional images.
+.LP
+As mentioned earlier, many of the \fBonedspec\fR tasks have been extended
+to work on 2D and 3D spatial spectra.  Some tasks which now have this
+capability in this version and not the previous one are \fBcalibrate\fR and
+\fBdopcor\fR.  \fBIdentify\fR and \fBredentify\fR were extended to operate
+on 3D images.
+.NH
+LONGSLIT
+.LP
+With the applicablity of more \fBonedspec\fR tasks to long slit data
+the \fBlongslit\fR package was modified to add many new tasks.
+This required adding additional package parameters.  One new task
+to point out is \fBcalibrate\fR.  This task is now the prefered one
+to use for extinction and flux calibration of long slit spectra
+rather than the obsolete \fBextinction\fR and \fBfluxcalib\fR.
+The obsolete tasks are still present in this release.
+.NH
+APEXTRACT
+.LP
+The \fBapextract\fR package had a few, mostly transparent, changes.  In
+the previous version the output image header format was always \fImultispec\fR
+even when there was a single spectrum, either because only one aperture
+was defined or because the output format parameter was "onedspec".
+In this release the default WCS format is the simpler \fIequispec\fR.
+.LP
+In the \fBonedspec\fR and \fBimred\fR spectral reduction packages there is
+a dispersion axis package parameter which is used to defined the dispersion
+axis for images without a DISPAXIS keyword.  This applies to all tasks.
+However, the \fBapextract\fR tasks had the dispersion axis defined by their
+own task parameters resulting in some confusion.  To make things consistent
+the dispersion axis parameter in \fBapextract\fR has been moved from the
+tasks to a package parameter.  Now in the \fBimred\fR spectral reduction
+packages, there is just one dispaxis parameter in the package parameters
+which applies to all tasks in those packages, both those from
+\fBonedspec\fR and those from \fBapextract\fR.
+.LP
+Some hidden algorithm parameters were adjusted so that the cleaning and
+variance weighting options perform better in some problem cases without
+requiring a great deal of knowledge about things to tweak.
+.NH
+IMRED Spectroscopic Reduction Tasks
+.LP
+The various spectroscopic reductions tasks, those beginning with "do", have
+had some minor revisions and enhancements in addition to those which apply
+to the individual tasks which make up these scripts.  In the latter class
+is the output WCS format is \fBequispec\fR except for the echelle tasks and
+when dispersion linearization is not done.  Related to this is that the
+multifiber tasks can operate on data with more than 250 fibers which was a
+limitation of the \fBmultispec\fR format.
+.LP
+The dispersion axis parameter in the reduction tasks and in the other tasks
+in the \fBimred\fR spectroscopy packages, such as the \fBapextract\fR
+tasks, is now solely a package parameter.
+.LP
+All the scripts now check the input spectra for the presence of the CCDPROC
+keyword and abort if it is not found.  This keyword indicates that the data
+have been processed for basic CCD calibrations, though it does not check
+the operations themselves.  For data reduced using \fBccdproc\fR this
+keyword will be present.  If these tasks are used on data not processed by
+\fBccdproc\fR then it is a simple matter to add this keyword with
+\fBhedit\fR.  Obviously, the purpose of this change is to avoid
+inadvertently operating on raw data.
+.LP
+All the "do" tasks now have a parameter "datamax".  This minimizes the
+effects of very strong cosmic rays during the extraction of object spectra;
+it does not apply to flat field or arc spectra.  When there is a very large
+difference between data pixel values and cosmic ray pixel values,
+especially true for very weak spectra, the cosmic ray cleanning operation
+does not always work well.  If it is possible to specify a threshold value
+between the maximum real data value and cosmic rays then the cosmic ray
+cleanning can be significantly improved by immediately rejecting those
+pixels above the threshold.  Of course the user must be careful that real
+data does not exceed this value since such data will be excluded.
+.LP
+The fiber reduction tasks, \fBdoargus, dohydra, dofibers, dofoe\fR, and
+\fBdo3fiber\fR have a new processing option for subtracting scattered
+light.  This is particularly useful if there is significant scattered light
+in producing uniform sky spectra for sky subtraction since the fiber
+throughput calibration does not generally correct for this.
+.LP
+The slit reduction task \fBdoslit\fR previously required that the spectrum
+for the reference arc cover the middle of the input data images.  There
+were cases of instrument configurations  where this was not true requiring
+additional manipulation to use this task.  This requirement has been
+eliminated.  Instead when the reference arc needs to be extracted it uses
+the aperture definition from one of the input object spectra since
+definition of the object apertures occurs prior to setting up the
+dispersion calibration.
diff --git a/noao/onedspec/doc/sys/rvidentify.ms b/noao/onedspec/doc/sys/rvidentify.ms
new file mode 100644
index 00000000..dadab882
--- /dev/null
+++ b/noao/onedspec/doc/sys/rvidentify.ms
@@ -0,0 +1,304 @@
+.RP
+.TL
+Radial Velocity Measurements with IDENTIFY
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+P.O. Box 26732, Tucson, Arizona 85726
+.AB
+The IRAF task \fBidentify\fR may be used to measure radial velocities.
+This is done using the classical method of determining the doppler shifted
+wavelengths of emission and absorption lines.  This paper covers many of
+the features and techniques available through this powerful and versatile
+task which are not immediately evident to a new user.
+.AE
+.NH
+Introduction
+.PP
+The task \fBidentify\fR is very powerful and versatile.  It can be used
+to measure wavelengths and wavelength shifts for doing radial velocity
+measurements from emission and absorption lines.  When combined with
+the CL's ability to redirect input and output both from the standard
+text streams and the cursor and graphics streams virtually anything may
+be accomplished either interactively or automatically.  This, of
+course, requires quite a bit of expertise and experience with
+\fBidentify\fR and with the CL which a new user is not expected to be
+aware of initially.  This paper attempts to convey some of the
+possibilities.  There are many variations on these methods which the
+user will learn through experience.
+.PP
+I want to make a caveat about the suggestions made in this paper.  I wrote
+the \fBidentify\fR task and so I am an expert in its use.  However, I am not
+a spectroscopist, I have not been directly involved in the science of
+measuring astronomical radial velocities, and I am not very familiar with
+the literature.  Thus, the suggestions contained in this paper are based
+on my understanding of the basic principles and the abilities of the
+\fBidentify\fR task.
+.PP
+The task \fBidentify\fR is used to measure radial velocities by
+determining the wavelengths of individual emission and absorption
+lines.  The user must compute the radial velocities separately by
+relating the observed wavelengths to the known rest wavelengths via the
+Doppler formula.  This is a good method when the lines are strong, when
+there are only one or two features, and when there are many, possibly,
+weaker lines.  The accuracy of this method is determined by the
+accuracy of the line centering algorithm.
+.PP
+The alternative method is to compare an observed
+spectrum to a template spectrum of known radial velocity.  This is done
+by correlation or fourier ratio methods.  These methods have the
+advantage of using all of the spectrum and are good when there are many
+very weak and possibly broad features.  Their disadvantages are
+confusion with telluric lines, they don't work well with just a few
+real features, and they require a fair amount of preliminary
+manipulation of the spectrum to remove continuum and interpolate the
+spectrum in logarithmic wavelength intervals.  IRAF tasks for
+correlation and fourier ratio methods are under development at this
+time.  Many people assume that these more abstract methods are inherently
+better than the classical method.  This is not true, it depends on the
+quality and type of data.
+.PP
+Wavelength measurements are best done on the original data rather than
+after linearizing the wavelength intervals.  This is because 1) it is
+not necessary as will be shown below and 2) the interpolation used to
+linearize the wavelength scale can change the shape of the lines,
+particularly strong, narrow emission lines which are the best ones for
+determining radial velocities.  A second reason is that
+\fBidentify\fR currently does not recognize the linear wavelength parameters
+produced during linearization.  This will be fixed soon but
+in the mean time the lines must be measured in pixels and converted
+later by the user.  Alternatively one can determine a linear dispersion solution
+with \fBidentify\fR but this is more work than needed.
+.PP
+This paper is specifically about \fBidentify\fR but one should be aware of the
+task \fBsplot\fR which also may be used to measure radial velocities.  It
+differs in several respects from \fBidentify\fR.  \fBSplot\fR works only on linearized
+data; the wavelength and pixel coordinates are related by a zero point and
+wavelength interval.  The line centering algorithms are different;
+the line centering is generally less robust (tolerant
+of error) and often less accurate.  It has many nice features but is
+not designed for the specific purpose of measuring positions of lines
+and, thus, is not as easy to use for this purpose.
+.PP
+There are a number of sources of additional information relating to the
+use of the task \fBidentify\fR.  The primary source is the manual pages for
+the task.  As with all manual pages it is available online with the
+\fBhelp\fR command and in the \fIIRAF User Handbook\fR.  The NOAO
+reduction guides or cookbooks for the echelle and IIDS/IRS include
+additional examples and discussion.  The line centering algorithm
+is the most critical factor in determining dispersion solutions and
+radial velocities.  It is described in more detail under the help
+topic \fBcenter1d\fR online or in the handbook.
+.NH
+Method 1
+.PP
+In this method arc calibration images are used to determine a wavelength
+scale.  The dispersion solution is then transferred to the object spectrum
+and the wavelengths of emission and absorption lines are measured and
+recorded.  This is relatively straightforward but some tricks will make
+this easier and more accurate.
+.NH 2
+Transferring Dispersion Solutions
+.PP
+There are several ways to transfer the dispersion solution from an arc
+spectrum to an object spectrum differing in the order in which things are
+done.
+.IP (1)
+One way is to determine the dispersion solution for all the arc images
+first.  To do this interactively specify all the arc images as the
+input to \fBidentify\fR.  After determining the dispersion solution for
+the first arc and quitting (\fIq\fR key) the next arc will be displayed
+with the previous dispersion solution and lines retained.  Then use the
+cursor commands \fIa\fR and \fIc\fR (all center) to recenter and
+recompute the dispersion solution, \fIs\fR to shift to the cursor
+position, recenter, and recompute the dispersion solution, or \fIx\fR
+to correlate features, shift, recenter, and recompute the dispersion
+solution.  These commands are relatively fast and simple.
+.IP
+A important reason for doing all the arc images first is that this same
+procedure can be done mostly noninteractively with the task
+\fBreidentify\fR.  After determining a dispersion solution for one arc
+image \fBreidentify\fR does the recenter (\fIa\fR and \fIc\fR), shift
+and recenter (\fIs\fR), or correlation features, shift, and recenter
+(\fIx\fR) to transfer the dispersion solutions between arcs.  This is
+usually done as a background task.
+.IP
+To transfer the solution to the object spectra specify the list of
+object spectra as input to \fBidentify\fR.  For each image begin by
+entering the colon command \fI:read arc\fR where arc is the name of the
+arc image whose dispersion solution is to be applied; normally the one
+taken at the same time and telescope position as the object.  This will
+read the dispersion solution and arc line positions.  Delete the arc
+line positions with the \fIa\fR and \fId\fR (all delete) cursor keys.
+You can now measure the wavelengths of lines in the spectrum.
+.IP (2)
+An alternative method is to interactively alternate between arc and
+object spectra either in the input image list or with the \fI:image
+name\fR colon command.
+.NH 2
+Measuring Wavelengths
+.PP
+.IP (1)
+To record the feature positions at any time use the \fI:features file\fR
+colon command where file is where the feature information will be written.
+Repeating this with the same file appends to the file.  Writing to 
+the database with the \fI:write\fR colon command also records this information.
+Without an argument the results are put in a file with the same name as the
+image and a prefix of "id".  You can use any name you like, however,
+with \fI:write name\fR.  The \fI:features\fR command is probably preferable
+because it only records the line information while the database format
+includes the dispersion solution and other information not needed for
+computing radial velocities.
+.IP (2)
+Remember that when shifting between emission and absorption lines the
+parameter \fIftype\fR must be changed.  This may be done interactively with
+the \fI:ftype emission\fR and \fI:ftype absorption\fR commands.  This parameter
+does not need to be set except when changing between types of lines.
+.IP (3)
+Since the centering of the emission or absorption line is the most
+critical factor one should experiment with the parameter \fIfwidth\fR.
+To change this parameter type \fI:fwidth value\fR.  The positions of the
+marked features are not changed until a center command (\fIc\fR) command
+is given.  \fIWarning: The all center (\fIa\fR and \fIc') command automatically
+refits the dispersion solution to the lines which will lose your
+arc dispersion solution.\fR
+.IP
+A narrow \fIfwidth\fR is less influenced by blends and wings but has a larger
+uncertainty.  A broad \fIfwidth\fR uses all of the line profile and is thus
+stable but may be systematically influenced by blending and wings.  One
+possible approach is to measure the positions at several values of
+\fIfwidth\fR and decide which value to use or use some weighting of the
+various measurements.  You can record each set of measurements with
+the \fI:fe file\fR command.
+.IP (4)
+For calibration of systematic effects from the centering one should obtain
+the spectrum of a similar object with a known radial velocity.  The systematic
+effect is due to the fact that the centering algorithm is measuring a
+weighted function of the line profile which may not be the true center of
+the line as tabulated in the laboratory or in a velocity standard.
+By using the same centering method on an object with the same line profiles
+and known velocity this effect can be eliminated.
+.IP (5)
+Since the arcs are not obtained at precisely the same time as the object
+exposures there may be a wavelength shift relative to the arc dispersion
+solution.  This may be calibrated from night sky lines in the object
+itself (the night sky lines are "good" in this case and should not be
+subtracted away).  There are generally not enough night sky lines to act
+as the primary dispersion calibrator but just one can determine a possible
+wavelength zero point shift.  Measure the night sky line positions at the same
+time the object lines are measured.  Determine a zero point shift from
+the night sky to be taken out of the object lines.
+.NH
+Method 2
+.PP
+This method is similar to the correlation method in that a template
+spectrum is used and the average shift relative to the template measures the
+radial velocity.  This has the advantage of not requiring the user to
+do a lot of calculations (the averaging of the line shifts is done by
+\fRidentify\fR) but is otherwise no better than method 1.
+The template spectrum must have the same features as the object spectrum.
+.IP (1)
+Determine a dispersion solution for the template spectrum either from 
+the lines in the spectrum or from an arc calibration.
+.IP (2)
+Mark the features to be correlated in the template spectrum.
+.IP (3)
+Transfer the template dispersion solution and line positions to an object
+spectrum using one of the methods described earlier.  Then for the
+current feature point the cursor near the same feature in the object
+spectrum and type \fIs\fR.  The mean shift in pixels, wavelength, and
+fractional wavelength (like a radial velocity without the factor of
+the speed of light) for the object is determined and printed.  A new
+dispersion solution is determined but you may ignore this.
+.IP (4)
+When doing additional object spectra remember to start over again with
+the template spectrum (using \fI:read template\fR) and not the solution
+from the last object spectrum.
+.IP (5)
+This procedure assumes that the dispersion solution between the template
+and object are the same.  Checks for zero point shifts with night sky
+lines, as discussed earlier, should be made if possible.  The systematic
+centering bias, however, is accounted for by using the same lines from
+the template radial velocity standard.
+.IP (6)
+One possible source of error is attempting to use very weak lines.  The
+recentering may find the wrong lines and affect the results.  The protections
+against this are the \fIthreshold\fR parameter (in Version 2.4 IRAF) and
+setting the centering error radius to be relatively small.
+.NH
+Method 3
+.PP
+This method uses only strong emission lines and works with linearized
+data without an \fBidentify\fR dispersion solution.  \fBIdentify\fR has
+a failing when used with linearized data; it does not know about the
+wavelength parameters in the image header.  This will eventually be
+fixed.  However, if you have already linearized your spectra and wish
+to use them instead of the nonlinear spectra the following method will
+work.  The recipe involves measuring the positions of emission lines in
+pixels which must then be converted to wavelength using the header
+information.  The strongest emission lines are found automatically
+using the \fIy\fR cursor key.  The number of emission lines to be
+identified is set by the \fImaxfeatures\fR parameter.  The emission
+line positions are then written to a data file using the \fI:features
+file\fR colon command.  This may be done interactively and takes only a
+few moments per spectrum.  If done interactively the images may be
+chained by specifying an image template.  The only trick required is
+than when proceeding to the next spectrum the previous features are
+deleted using the cursor key combination \fIa\fR and \fId\fR (all
+delete).
+.PP
+For a large number of images, on the order of hundreds, this may be automated
+as follows.  A file containing the cursor commands is prepared.
+The cursor command format consists of the x and y positions, the window
+(usually window 1), and the key stroke or colon command.  Because each new
+image form an image template does not restart the cursor command file the
+commands would have to be repeated for each image in the list.  Thus, a CL
+loop calling the
+task each time with only one image is preferable.  Besides redirecting
+the cursor input from a command file we must also redirect the standard
+input for the response to the database save query, the standard output
+to discard the status line information, and, possibly, the graphics
+to a metacode file which can then be reviewed later.  The following
+steps indicate what is to be done.
+.IP (1)
+Prepare a file containing the images to be measured (one per line).
+This can usually be done using the sections command to expand a template
+and directing the output into a file.
+.IP (2)
+Prepare the a cursor command file (let's call it cmdfile) containing the
+following two lines.
+.nf
+	1 1 1 y
+	1 1 1 :fe positions.dat
+.fi
+.IP (3)
+Enter the following commands.
+.nf
+	list="file"
+	while (fscan (list, s1) != EOF) {
+	print ("no") | identify (s1, maxfeatures=2, cursor="cmdfile",
+		>"dev$null", >G "plotfile")
+	}
+.fi
+.LP
+Note that these commands could be put in a CL script and executed using the
+command
+
+	on> cl <script.cl
+
+.PP
+The commands do the following.  The first command initializes the image list
+for the loop.  The second command is the loop to be run until the end of
+the image file is reached.  The command in the loop directs the string
+"no" to the standard input of identify which will be the response to the
+database save query.  The identify command uses the image name obtained
+from the list by the fscan procedure, sets the maximum number of features
+to be found to be 2 (this can be set using \fBeparam\fR instead), the cursor
+input is taken from the cursor command file, the standard output is
+discarded to the null device, and the STDGRAPH output is redirected to
+a plot file.  If the plot file redirection is not used then the graphs
+will appear on the specified graphics device (usually the graphics terminal).
+The plot file can then be disposed of using the \fBgkimosaic\fR task to either
+the graphics terminal or a hardcopy device.
diff --git a/noao/onedspec/doc/sys/sensfunc.ms b/noao/onedspec/doc/sys/sensfunc.ms
new file mode 100644
index 00000000..67b6532d
--- /dev/null
+++ b/noao/onedspec/doc/sys/sensfunc.ms
@@ -0,0 +1,83 @@
+.EQ
+delim	$$
+.EN
+.OM
+.TO
+IRAF ONEDSPEC Users
+.FR
+Frank Valdes
+.SU
+SENSFUNC Corrections
+.LP
+This memorandum describes the meaning of the corrections
+computed by the \fBonedspec\fR task \fBsensfunc\fR.
+The basic equation is
+
+.EQ (1)
+I( lambda )~=~I sub obs ( lambda )~10 sup {0.4~(s( lambda )~+
+~A~e( lambda )~+~roman {fudge~terms})}
+.EN
+
+where $I sub obs$ is the observed spectrum corrected to counts per second,
+$I$ is the flux calibrated spectrum, $s( lambda )$ is the sensitivity
+correction needed to produce
+flux calibrated intensities, $A$ is the air mass at the time of the
+observation, $e( lambda )$ is a standard extinction function, and,
+finally, additional terms appropriately called \fIfudge\fR terms.  Expressed
+as a magnitude correction this equation is
+
+.EQ (2)
+DELTA m( lambda )~=s( lambda )~+~A~e( lambda )~+~roman {fudge~terms}
+.EN
+
+In \fBsensfunc\fR the standard extinction function is applied so that ideally
+the $DELTA m$ curves (defining the sensitivity function) obtained from
+observations of different stars and at different air masses are identical.
+However, at times this is not the case because the observations were taken
+through non-constant or nonstandard extinction.
+
+There are two types of fudge terms used in \fBsensfunc\fR, called \fIfudge\fR
+and \fIgrey\fR.  The \fIfudge\fR correction is a separate constant,
+independent of wavelength or air mass, applied to each observation to shift
+the sensitivity curves to the same level on average.  This is done to
+determine the shape of the sensitivity curve only.
+The fudge correction for each observation is obtained by determining
+the average magnitude shift over all wavelenths relative to the observation
+with the smallest sensitivity correction.  A composite sensitivity curve
+is then determined from the average of all the fudged observations.
+The fudge terms are not incorporated in the sensitivity or extinction
+corrections applied to calibrate the spectra.  Thus, after applying the
+sensitivity and extinction corrections to the standard star spectra there
+will be absolute flux scale errors due to the observing conditions.
+
+If the observer believes that there is an actual calibratible error in
+the standard extinction then \fBsensfunc\fR can be used to determine a
+correction which is a linear function of the air mass.  This is done by
+relating the fudge values (the magnitude shifts needed to bring observations
+to the same sensitivity level) to the air mass of the observations.
+The \fIgrey\fR term is obtained by the least square fit to 
+
+.EQ (3)
+f sub i~=~G~DELTA A sub i~=~G~A sub i~+~C
+.EN
+
+where the $f sub i$ are the fudge values relative to the observation with
+the smallest sensitivity correction and the $DELTA A sub i$ are the
+air mass differences relative to this same observation.  The slope constant
+$G$ is what is refered to as the \fIgrey\fR term.  The constant term,
+related to the air mass of the reference observation to which the other
+spectra are shifted, is absorbed in the sensitivity function.
+The modified equation (2) is
+
+.EQ (4)
+DELTA m( lambda )~=~s ( lambda ) + A~(e( lambda )~+~G)
+.EN
+
+It is important to realize that equation (3) can lead to erroneous results
+if there is no real relation to the air mass or the air mass range is
+too small.  In other words applying the grey term correction will produce
+some number for $G$ but it may be worse than no correction.  A plot of
+the individual fudge constants, $f sub i$, and the air mass or
+air mass differences would be useful to evaluate the validity of the
+grey correction.  The actual magnitude of the correction is not $G$
+but $DELTA A~G$ where $DELTA A$ is the range of observed air mass.
diff --git a/noao/onedspec/doc/sys/specwcs.ms b/noao/onedspec/doc/sys/specwcs.ms
new file mode 100644
index 00000000..a9d90a41
--- /dev/null
+++ b/noao/onedspec/doc/sys/specwcs.ms
@@ -0,0 +1,612 @@
+.EQ
+delim $$
+gsize 10
+.EN
+.nr PS 11
+.nr VS 13
+.de V1
+.ft CW
+.ps -2
+.nf
+..
+.de V2
+.fi
+.ft R
+.ps +2
+..
+.ND March 1993
+.TL
+The IRAF/NOAO Spectral World Coordinate Systems
+.AU
+Francisco Valdes
+.AI
+IRAF Group - Central Computer Services
+.K2
+.DY
+
+.AB
+The image formats and world coordinate systems for dispersion calibrated
+spectra used in the IRAF/NOAO spectroscopy packages are described; in
+particular, the image header keywords defining the coordinates are given.
+These keywords appear both as part of the IRAF image structure and map
+directly to FITS format.  The types of spectra include multidimensional
+images with one or more spatial axes and a linear or log-linear dispersion
+axis and special \fIequispec\fR and \fImultispec\fR formats having multiple
+independent one dimensional spectra in a single multidimensional image.
+The \fImultispec\fR format also includes general nonlinear dispersion
+coordinate systems using polynomial, spline, sampled table, and look-up
+table functions.
+.AE
+
+.NH
+Types of Spectral Data
+.LP
+Spectra are stored as one, two, or three dimensional images with one axis
+being the dispersion axis.  A pixel value is the flux over
+some interval of wavelength and position.  The simplest example of a
+spectrum is a one dimensional image which has pixel values as a
+function of wavelength.
+.LP
+There are two types of higher dimensional spectral image formats.  One type
+has spatial axes for the other dimensions and the dispersion axis may be
+along any of the image axes.  Typically this type of format is used for
+long slit (two dimensional) and Fabry-Perot (three dimensional) spectra.
+This type of spectra is referred to as \fIspatial\fR spectra and the
+world coordinate system (WCS) format is called \fIndspec\fR.
+The details of the world coordinate systems are discussed later.
+.LP
+The second type of higher dimensional spectral image consists of multiple,
+independent, one dimensional spectra stored in the higher dimensions with
+the first image axis being the dispersion axis; i.e. each line is a
+spectrum.  This format allows associating many spectra and related
+parameters in a single data object.  This type of spectra is referred to
+as \fImultispec\fR and the there are two coordinate system formats,
+\fIequispec\fR and \fImultispec\fR.  The \fIequispec\fR format applies
+to the common case where all spectra have the same linear dispersion
+relation.  The \fImultispec\fR format applies to the general case of spectra
+with differing dispersion relations or non-linear dispersion functions.
+These multi-spectrum formats are important since maintaining large numbers
+of spectra as individual one dimensional images is very unwieldy for the
+user and inefficient for the software.
+.LP
+Examples of multispec spectral images are spectra extracted from a
+multi-fiber or multi-aperture spectrograph or orders from an echelle
+spectrum.  The second axis is some arbitrary indexing of the spectra,
+called \fIapertures\fR, and the third dimension is used for
+associated quantities.  The IRAF \fBapextract\fR package may produce
+multiple spectra from a CCD image in successive image lines with an
+optimally weighted spectrum, a simple aperture sum spectrum, a background
+spectrum, and sigma spectrum as the associated quantities along the third
+dimension of the image.
+.LP
+Many \fBonedspec\fR package tasks which are designed to operate on
+individual one dimensional spectra may operate on spatial spectra by
+summing a number of neighboring spectra across the dispersion axis.  This
+eliminates the need to "extract" one dimensional spectra from the natural
+format of this type of data in order to use tasks oriented towards the
+display and analysis of one dimensional spectra.  The dispersion axis is
+either given in the image header by the keyword DISPAXIS or the package
+\fIdispaxis\fR parameter.  The summing factors across the
+dispersion are specified by the \fInsum\fR package parameter.
+.LP
+One dimensional spectra, whether from multispec spatial spectra, have
+several associated quantities which may appear in the image header as part
+of the coordinate system description.  The primary identification of a
+spectrum is an integer aperture number.  This number must be unique within
+a single image.  There is also an integer beam number used for various
+purposes such as discriminating object, sky, and arc spectra in
+multi-fiber/multi-aperture data or to identifying the order number in
+echelle data.  For spectra summed from spatial spectra the aperture number
+is the central line, column, or band.  In 3D images the aperture index
+wraps around the lowest non-dispersion axis.  Since most one dimensional
+spectra are derived from an integration over one or more spatial axes, two
+additional aperture parameters record the aperture limits.  These limits
+refer to the original pixel limits along the spatial axis.  This
+information is primarily for record keeping but in some cases it is used
+for spatial interpolation during dispersion calibration.  These values are
+set either by the \fBapextract\fR tasks or when summing neighboring vectors
+in spatial spectra.
+.LP
+An important task to be aware of for manipulating spectra between image
+formats is \fBscopy\fR.  This task allows selecting spectra from multispec
+images and grouping them in various ways and also "extracts" apertures from
+long slit and 3D spectra simply and without resort to the more general
+\fBapextract\fR package.
+.NH
+World Coordinate Systems
+.LP
+IRAF images have three types of coordinate systems.  The pixel array
+coordinates of an image or image section, i.e. the lines and
+columns, are called the \fIlogical\fR coordinates.  The logical coordinates of
+individual pixels change as sections of the image are used or extracted.
+Pixel coordinates are tied to the data, i.e. are fixed to features
+in the image, are called \fIphysical\fR coordinates.  Initially the logical
+and physical coordinates are the equivalent but differ when image sections
+or other tasks which modify the sampling of the pixels are applied.
+.LP
+The last type of coordinate system is called the \fIworld\fR coordinate
+system.  Like the physical coordinates, the world coordinates are tied to
+the features in the image and remain unchanged when sections of the image
+are used or extracted.  If a world coordinate system is not defined for an
+image, the physical coordinate system is considered to be the world
+coordinate system.  In spectral images the world coordinate system includes
+dispersion coordinates such as wavelengths.  In many tasks outside the
+spectroscopy packages, for example the \fBplot\fR, \fBtv\fR and
+\fBimages\fR packages, one may select the type of coordinate system to be
+used.  To make plots and get coordinates in dispersion units for spectra
+with these tasks one selects the "world" system.  The spectral tasks always
+use world coordinates.
+.LP
+The coordinate systems are defined in the image headers using a set of
+reserved keywords which are set, changed, and updated by various tasks.
+Some of the keywords consist of simple single values following the FITS
+convention.  Others, the WAT keywords, encode long strings of information,
+one for each coordinate axis and one applying to all axes, into a set of
+sequential keywords.  The values of these keywords must then be pasted
+together to recover the string.  The long strings contain multiple pieces
+called WCS \fIattributes\fR.  In general the WCS keywords should be left to
+IRAF tasks to modify.  However, if one wants modify them directly some
+tasks which may be used are \fBhedit\fR, \fBhfix\fR, \fBwcsedit\fR,
+\fBwcsreset\fR, \fBspecshift\fR, \fBdopcor\fR, and \fBsapertures\fR.  The
+first two are useful for the simple keywords, the two  "wcs" tasks are
+useful for the linear ndspec and equispec formats, the next two are for the
+common cases of shifting the coordinate zero point or applying a doppler
+correction, and the last one is the one to use for the more complex
+multispec format attributes.
+.NH
+Physical Coordinate System
+.LP
+The physical coordinate system is used by the spectral tasks when there is
+no dispersion coordinate information (such as before dispersion
+calibration), to map the physical dispersion axis to the logical dispersion
+axis, and in the multispec world coordinate system dispersion functions
+which are defined in terms of physical coordinates.
+.LP
+The transformation between logical and physical coordinates is defined by
+the header keywords LTVi, LTMi_j (where i and j are axis numbers) through
+the vector equation
+
+.EQ I
+    l vec~=~|m| cdot p vec + v vec
+.EN
+
+where $l vec$ is a logical coordinate vector, $p vec$ is a physical
+coordinate vector, $v vec$ is the origin translation vector specified by
+the LTV keywords and $|m|$ is the scale/rotation matrix
+specified by the LTM keywords.  For spectra rotation terms (nondiagonal
+matrix elements) generally do not make sense (in fact many tasks will not
+work if there is a rotation) so the transformations along each axis are
+given by the linear equation
+
+.EQ I
+    l sub i~=~LTMi_i cdot p sub i + LTVi.
+.EN
+
+If all the LTM/LTV keywords are missing they are assumed to have zero
+values except that the diagonal matrix terms, LTMi_i, are assumed to be 1.
+Note that if some of the keywords are present then a missing LTMi_i will
+take the value zero which generally causes an arithmetic or matrix
+inversion error in the IRAF tasks.
+.LP
+The dimensional mapping between logical and physical axes is given by the
+keywords WCSDIM and WAXMAP01.  The WCSDIM keyword gives the dimensionality
+of the physical and world coordinate system.  There must be coordinate
+information for that many axes in the header (though some may be missing
+and take their default values).  If the WCSDIM keyword is missing it is
+assumed to be the same as the logical image dimensionality.
+.LP
+The syntax of the WAXMAP keyword are pairs of integer values,
+one for each physical axis.  The first number of each pair indicates which
+current \fIlogical\fR axis corresponds to the original \fIphysical\fR axis
+(in order) or zero if that axis is missing.   When the first number is zero
+the second number gives the offset to the element of the original axis
+which is missing.  As an example consider a three dimensional image in
+which the second plane is extracted (an IRAF image section of [*,2,*]).
+The keyword would then appear as WAXMAP01 = '1 0 0 1 2 0'.  If this keyword
+is missing the mapping is 1:1; i.e. the dimensionality and order of the
+axes are the same.
+.LP
+The dimensional mapping is important because the dispersion axis for
+the nspec spatial spectra as specified by the DISPAXIS keyword or task
+parameter, or the axis definitions for the equispec and or multispec
+formats are always in terms of the original physical axes.
+.NH
+Linear Spectral World Coordinate Systems
+.LP
+When there is a linear or logarithmic relation between pixels and
+dispersion coordinates which is the same for all spectra the WCS header
+format is simple and uses the FITS convention (with the CD matrix keywords
+proposed by Hanisch and Wells 1992) for the logical pixel to world
+coordinate transformation.  This format applies to one, two, and three
+dimensional data.  The higher dimensional data may have either linear
+spatial axes or the equispec format where each one dimensional spectrum
+stored along the lines of the image has the same dispersion.
+.LP
+The FITS image header keywords describing the spectral world coordinates
+are CTYPEi, CRPIXi, CRVALi, and CDi_j where i and j are axis numbers.  As
+with the physical coordinate transformation the nondiagonal or rotation
+terms are not expected in the spectral WCS and may cause problems if they
+are not zero.  The CTYPEi keywords will have the value LINEAR to identify
+the type of of coordinate system.  The transformation between dispersion
+coordinate, $w sub i$, and logical pixel coordinate, $l sub i$, along axis i is given by
+
+.EQ I
+    w sub i~=~CRVALi + CDi_i cdot (l sub i - CRPIXi)
+.EN
+
+If the keywords are missing then the values are assumed to be zero except
+for the diagonal elements of the scale/rotation matrix, the CDi_i, which
+are assumed to be 1.  If only some of the keywords are present then any
+missing CDi_i keywords will take the value 0 which will cause IRAF tasks to
+fail with arithmetic or matrix inversion errors.  If the CTYPEi keyword is
+missing it is assumed to be "LINEAR".
+.LP
+If the pixel sampling is logarithmic in the dispersion coordinate, as
+required for radial velocity cross-correlations, the WCS coordinate values
+are logarithmic and $w sub i$ (above) is the logarithm of the dispersion
+coordinate.  The spectral tasks (though not other tasks) will recognize
+this case and automatically apply the anti-log.  The two types of pixel
+sampling are identified by the value of the keyword DC-FLAG.  A value of 0
+defines a linear sampling of the dispersion and a value of 1 defines a
+logarithmic sampling of the dispersion.  Thus, in all cases the spectral
+tasks will display and analyze the spectra in the same dispersion units
+regardless of the pixel sampling.
+.LP
+Other keywords which may be present are DISPAXIS for 2 and 3 dimensional
+spatial spectra, and the WCS attributes "system", "wtype", "label", and
+"units".  The system attribute will usually have the value "world" for
+spatial spectra and "equispec" for equispec spectra.  The wtype attribute
+will have the value "linear".  Currently the label will be either "Pixel"
+or "Wavelength" and the units will be "Angstroms" for dispersion corrected
+spectra.  In the future there will be more generality in the units
+for dispersion calibrated spectra.
+.LP
+Figure 1 shows the WCS keywords for a two dimensional long slit spectrum.
+The coordinate system is defined to be a generic "world" system and the
+wtype attributes and CTYPE keywords define the axes to be linear.  The
+other attributes define a label and unit for the second axis, which is the
+dispersion axis as indicated by the DISPAXIS keyword.  The LTM/LTV keywords
+in this example show that a subsection of the original image has been
+extracted with a factor of 2 block averaging along the dispersion axis.
+The dispersion coordinates are given in terms of the \fIlogical\fR pixel
+coordinates by the FITS keywords as defined previously.
+
+.DS
+.ce
+Figure 1: Long Slit Spectrum
+
+.V1
+WAT0_001= 'system=world'
+WAT1_001= 'wtype=linear'
+WAT2_001= 'wtype=linear label=Wavelength units=Angstroms'
+WCSDIM  =                    2
+DISPAXIS=                    2
+DC-FLAG =                    0
+
+CTYPE1  = 'LINEAR  '
+LTV1    =                 -10.
+LTM1_1  =                   1.
+CRPIX1  =                  -9.
+CRVAL1  =     19.5743865966797
+CD1_1   =     1.01503419876099
+
+CTYPE2  = 'LINEAR  '
+LTV2    =                -49.5
+LTM2_2  =                  0.5
+CRPIX2  =                 -49.
+CRVAL2  =       4204.462890625
+CD2_2   =     12.3337936401367
+.V2
+.DE
+
+Figure 2 shows the WCS keywords for a three dimensional image where each
+line is an independent spectrum or associated data but where all spectra
+have the same linear dispersion.  This type of coordinate system has the
+system name "equispec".  The ancillary information about each aperture is
+found in the APNUM keywords.  These give the aperture number, beam number,
+and extraction limits.  In this example the LTM/LTV keywords have their
+default values; i.e. the logical and physical coordinates are the same.
+
+.DS
+.ce
+Figure 2: Equispec Spectrum
+
+.V1
+WAT0_001= 'system=equispec'
+WAT1_001= 'wtype=linear label=Wavelength units=Angstroms'
+WAT2_001= 'wtype=linear'
+WAT3_001= 'wtype=linear'
+WCSDIM  =                    3
+DC-FLAG =                    0
+APNUM1  = '41 3 7.37 13.48'
+APNUM2  = '15 1 28.04 34.15'
+APNUM3  = '33 2 43.20 49.32'
+
+CTYPE1  = 'LINEAR  '
+LTM1_1  =                   1.
+CRPIX1  =                   1.
+CRVAL1  =             4204.463
+CD1_1   =     6.16689700000001
+
+CTYPE2  = 'LINEAR  '
+LTM2_2  =                   1.
+CD2_2   =                   1.
+
+CTYPE3  = 'LINEAR  '
+LTM3_3  =                   1.
+CD3_3   =                   1.
+.V2
+.DE
+.NH
+Multispec Spectral World Coordinate System
+.LP
+The \fImultispec\fR spectral world coordinate system applies only to one
+dimensional spectra; i.e. there is no analog for the spatial type spectra.
+It is used either when there are multiple 1D spectra with differing
+dispersion functions in a single image or when the dispersion functions are
+nonlinear.
+.LP
+The multispec coordinate system is always two dimensional though there may
+be an independent third axis.  The two axes are coupled and they both have
+axis type "multispec".  When the image is one dimensional the physical line
+is given by the dimensional reduction keyword WAXMAP.  The second, line
+axis, has world coordinates of aperture number.  The aperture numbers are
+integer values and need not be in any particular order but do need to be
+unique.  This aspect of the WCS is not of particular user interest but
+applications use the inverse world to physical transformation to select a
+spectrum line given a specified aperture.
+.LP
+The dispersion functions are specified by attribute strings with the
+identifier \fIspecN\fR where N is the \fIphysical\fR image line.  The
+attribute strings contain a series of numeric fields.  The fields are
+indicated symbolically as follows.
+
+.EQ I
+         specN~=~ap~beam~dtype~w1~dw~nw~z~aplow~aphigh~[functions sub i ]
+.EN
+
+where there are zero or more functions having the following fields,
+
+.EQ I
+    function sub i~=~ wt sub i~w0 sub i~ftype sub i~[parameters]~[coefficients]
+.EN
+
+The first nine fields in the attribute are common to all the dispersion
+functions.  The first field of the WCS attribute is the aperture number,
+the second field is the beam number, and the third field is the dispersion
+type with the same function as DC-FLAG in the \fInspec\fR and
+\fIequispec\fR formats.  A value of -1 indicates the coordinates are not
+dispersion coordinates (the spectrum is not dispersion calibrated), a value
+of 0 indicates linear dispersion sampling, a value of 1 indicates
+log-linear dispersion sampling, and a value of 2 indicates a nonlinear
+dispersion.
+.LP
+The next two fields are the dispersion coordinate of the first
+\fIphysical\fR pixel and the average dispersion interval per \fIphysical\fR
+pixel.  For linear and log-linear dispersion types the dispersion
+parameters are exact while for the nonlinear dispersion functions they are
+approximate.  The next field is the number of valid pixels, hence it is
+possible to have spectra with varying lengths in the same image.  In that
+case the image is as big as the biggest spectrum and the number of pixels
+selects the actual data in each image line.  The next (seventh) field is a
+doppler factor.  This doppler factor is applied to all dispersion
+coordinates by multiplying by $1/(1+z)$ (assuming wavelength dispersion
+units).  Thus a value of 0 is no doppler correction.  The last two fields
+are extraction aperture limits as discussed previously.
+.LP
+Following these fields are zero or more function descriptions.  For linear
+or log-linear dispersion coordinate systems there are no function fields.
+For the nonlinear dispersion systems the function fields specify a weight,
+a zero point offset, the type of dispersion function, and the parameters
+and coefficients describing it.  The function type codes, $ftype sub i$,
+are 1 for a chebyshev polynomial, 2 for a legendre polynomial, 3 for a
+cubic spline, 4 for a linear spline, 5 for a pixel coordinate array, and 6
+for a sampled coordinate array.  The number of fields before the next
+function and the number of functions are determined from the parameters of
+the preceding function until the end of the attribute is reached.
+.LP
+The equation below shows how the final wavelength is computed based on
+the $nfunc$ individual dispersion functions $W sub i (p)$.  Note that this
+is completely general in that different function types may be combined.
+However, in practice when multiple functions are used they are generally of
+the same type and represent a calibration before and after the actual
+object observation with the weights based on the relative time difference
+between the calibration dispersion functions and the object observation.
+
+.EQ I
+w~=~sum from i=1 to nfunc {wt sub i cdot (w0 sub i + W sub i (p)) / (1 + z)}
+.EN
+
+The multispec coordinate systems define a transformation between physical
+pixel, $p$, and world coordinates, $w$.  Generally there is an intermediate
+coordinate system used.  The following equations define these coordinates.
+The first one shows the transformation between logical, $l$, and physical,
+$p$, coordinates based on the LTM/LTV keywords.  The polynomial functions
+are defined in terms of a normalized coordinate, $n$, as shown in the
+second equation.  The normalized coordinates run between -1 and 1 over the
+range of physical coordinates, $p sub min$ and $p sub max$ which are
+parameters of the function, upon which the coefficients were defined.  The
+spline functions map the physical range into an index over the number of
+evenly divided spline pieces, $npieces$, which is a parameter of the
+function.  This mapping is shown in the third and fourth equations where
+$s$ is the continuous spline coordinate and $j$ is the nearest integer less
+than or equal to $s$.
+
+.EQ I
+    p mark~=~(l - LTV1) / LTM1_1
+.EN
+.EQ I
+    n lineup~=~(p - p sub middle ) / (2 cdot p sub range )
+.EN
+.EQ I
+      lineup~=~(p - (p sub max + p sub min )/2) / (2 cdot (p sub max - p sub min ))
+.EN
+.EQ I
+    s lineup~=~(p - p sub min ) / (p sub max - p sub min ) cdot npieces
+.EN
+.EQ I
+    j lineup~=~roman "int" (s)
+.EN
+.NH 2
+Linear and Log Linear Dispersion Function
+.LP
+The linear and log-linear dispersion functions are described by a
+wavelength at the first \fIphysical\fR pixel and a wavelength increment per
+\fIphysical\fR pixel.  A doppler correction may also be applied.  The
+equations below show the two forms.  Note that the coordinates returned are
+always wavelength even though the pixel sampling and the dispersion
+parameters may be log-linear.
+
+.EQ I
+    w mark~=~(w1 + dw cdot (p - 1)) / (1 + z)
+.EN
+.EQ I
+    w lineup~=~10 sup {(w1 + dw cdot (p - 1)) / (1 + z)}
+.EN
+
+Figure 3 shows an example from a multispec image with
+independent linear dispersion coordinates.  This is a linearized echelle
+spectrum where each order (identified by the beam number) is stored as a
+separate image line.
+
+.DS
+.ce
+Figure 3: Echelle Spectrum with Linear Dispersion Function
+
+.V1
+WAT0_001= 'system=multispec'
+WAT1_001= 'wtype=multispec label=Wavelength units=Angstroms'
+WAT2_001= 'wtype=multispec spec1 = "1 113 0 4955.44287109375 0.05...
+WAT2_002= '5 256 0. 23.22 31.27" spec2 = "2 112 0 4999.0810546875...
+WAT2_003= '58854293 256 0. 46.09 58.44" spec3 = "3 111 0 5043.505...
+WAT2_004= '928358078002 256 0. 69.28 77.89"
+WCSDIM  =                    2
+
+CTYPE1  = 'MULTISPE'
+LTM1_1  =                   1.
+CD1_1   =                   1.
+
+CTYPE2  = 'MULTISPE'
+LTM2_2  =                   1.
+CD2_2   =                   1.
+.V2
+.DE
+.NH 2
+Chebyshev Polynomial Dispersion Function
+.LP
+The parameters for the chebyshev polynomial dispersion function are the
+$order$ (number of coefficients) and the normalizing range of physical
+coordinates, $p sub min$ and $p sub max$, over which the function is
+defined and which are used to compute $n$.  Following the parameters are
+the $order$ coefficients, $c sub i$.  The equation below shows how to
+evaluate the function using an iterative definition where $x sub 1 = 1$,
+$x sub 2 = n$, and $x sub i = 2 cdot n cdot x sub {i-1} - x sub {i-2}$.
+
+.EQ I
+    W~=~sum from i=1 to order {c sub i cdot x sub i}
+.EN
+.NH 2
+Legendre Polynomial Dispersion Function
+.LP
+The parameters for the legendre polynomial dispersion function are the
+order (number of coefficients) and the normalizing range of physical
+coordinates, pmin and pmax, over which the function is defined
+and which are used to compute n.  Following the parameters are the
+order coefficients, c sub i.  The equation below shows how to evaluate the
+function using an iterative definition where $x sub 1 = 1$, $x sub 2 = n$, and
+$x sub i = ((2i-3) cdot n cdot x sub {i-1} - (i-2) cdot x sub {i-2}) / (i-1)$.
+
+.EQ I
+    W~=~sum from i=1 to order {c sub i cdot x sub i}
+.EN
+.LP
+Figure 4 shows an example from a multispec image with independent nonlinear
+dispersion coordinates.  This is again from an echelle spectrum.  Note that
+the IRAF \fBechelle\fR package determines a two dimensional dispersion
+function, in this case a bidimensional legendre polynomial, with the
+independent variables being the order number and the extracted pixel
+coordinate.  To assign and store this function in the image is simply a
+matter of collapsing the two dimensional dispersion function by fixing the
+order number and combining all the terms with the same order.
+
+.DS
+.ce
+Figure 4: Echelle Spectrum with Legendre Polynomial Function
+
+.V1
+WAT0_001= 'system=multispec'
+WAT1_001= 'wtype=multispec label=Wavelength units=Angstroms'
+WAT2_001= 'wtype=multispec spec1 = "1 113 2 4955.442888635351 0.05...
+WAT2_002= '83 256 0. 23.22 31.27 1. 0. 2 4 1. 256. 4963.0163112090...
+WAT2_003= '976664 -0.3191636898579552 -0.8169352858733255" spec2 =...
+WAT2_004= '9.081188912082 0.06387049476832223 256 0. 46.09 58.44 1...
+WAT2_005= '56. 5007.401409453303 8.555959076467951 -0.176732458267...
+WAT2_006= '09935064388" spec3 = "3 111 2 5043.505764869474 0.07097...
+WAT2_007= '256 0. 69.28 77.89 1. 0. 2 4 1. 256. 5052.586239197408 ...
+WAT2_008= '271 -0.03173489817897474 -7.190562320405975E-4"
+WCSDIM  =                    2
+
+CTYPE1  = 'MULTISPE'
+LTM1_1  =                   1.
+CD1_1   =                   1.
+
+CTYPE2  = 'MULTISPE'
+LTM2_2  =                   1.
+CD2_2   =                   1.
+.V2
+.DE
+.NH 2
+Linear Spline Dispersion Function
+.LP
+The parameters for the linear spline dispersion function are the number of
+spline pieces, $npieces$, and the range of physical coordinates, $p sub min$
+and $p sub max$, over which the function is defined and which are used to
+compute the spline coordinate $s$.  Following the parameters are the
+$npieces+1$ coefficients, $c sub i$.  The two coefficients used in a linear
+combination are selected based on the spline coordinate, where $a$ and $b$
+are the fractions of the interval in the spline piece between the spline
+knots, $a=(j+1)-s$, $b=s-j$, and $x sub 0 =a$, and $x sub 1 =b$.
+
+.EQ I
+    W~=~sum from i=0 to 1 {c sub (i+j) cdot x sub i}
+.EN
+.NH 2
+Cubic Spline Dispersion Function
+.LP
+The parameters for the cubic spline dispersion function are the number of
+spline pieces, $npieces$, and the range of physical coordinates, $p sub min$
+and $p sub max$, over which the function is defined and which are used
+to compute the spline coordinate $s$.  Following the parameters are the
+$npieces+3$ coefficients, $c sub i$.  The four coefficients used are
+selected based on the spline coordinate.  The fractions of the interval
+between the integer spline knots are given by $a$ and $b$, $a=(j+1)-s$,
+b=$s-j$, and $x sub 0 =a sup 3$, $x sub 1 =(1+3 cdot a cdot (1+a cdot b))$,
+$x sub 2 =(1+3 cdot b cdot (1+a cdot b))$, and $x sub 3 =b sup 3$.
+
+.EQ I
+    W~=~sum from i=0 to 3 {c sub (i+j) cdot x sub i}
+.EN
+.NH 2
+Pixel Array Dispersion Function
+.LP
+The parameters for the pixel array dispersion function consists of just the
+number of coordinates $ncoords$.  Following this are the wavelengths at
+integer physical pixel coordinates starting with 1.  To evaluate a
+wavelength at some physical coordinate, not necessarily an integer, a
+linear interpolation is used between the nearest integer physical coordinates
+and the desired physical coordinate where $a$ and $b$ are the usual
+fractional intervals $k= roman "int" (p)$, $a=(k+1)-p$, $b=p-k$,
+and $x sub 0 =a$, and $x sub 1 =b$.
+
+.EQ I
+    W~=~sum from i=0 to 1 {c sub (i+j) cdot x sub i}
+.EN
+.NH 2
+Sampled Array Dispersion Function
+.LP
+The parameters for the sampled array dispersion function consists of
+the number of coordinate pairs, $ncoords$, and a dummy field.
+Following these are the physical coordinate and wavelength pairs
+which are in increasing order.  The nearest physical coordinates to the
+desired physical coordinate are located and a linear interpolation
+is computed between the two sample points.
diff --git a/noao/onedspec/doc/telluric.hlp b/noao/onedspec/doc/telluric.hlp
new file mode 100644
index 00000000..f0bfe597
--- /dev/null
+++ b/noao/onedspec/doc/telluric.hlp
@@ -0,0 +1,350 @@
+.help telluric Mar97 noao.onedspec
+.ih
+NAME
+telluric -- remove telluric features from 1D spectra
+.ih
+SUMMARY
+Telluric calibration spectra are shifted and scaled to best divide out
+telluric features from data spectra.  This may be done non-interactively to
+minimize the RMS in some region or regions of the data spectra and
+interactively with a graphically search.
+.ih
+USAGE
+telluric input output cal
+.ih
+PARAMETERS
+.ls input
+List of input data images containing one dimensional spectra to be
+corrected.  All spectra in each image are corrected. The spectra need not
+be wavelength calibrated.
+.le
+.ls output
+List of output corrected images.  The list must either match the input list
+or be an empty list.  If an empty list is specified the input spectra will
+be replaced by the corrected spectra.  The input spectra will also be
+replaced if the input and output image names are the same.  Any other image
+name must be for a new image otherwise a warning message will be given and
+the task will proceed to the next input image.
+.le
+.ls cal  
+List of telluric calibration images.  If a single image is specified it
+will apply to all the input images.  Otherwise the list of calibration
+images must match the list of input images.
+.le
+.ls ignoreaps = no
+Ignore aperture numbers between the input spectra and the calibration
+spectra?  If "no" then the calibration image must contain a spectrum
+with the same aperture number as each spectrum in the input image.
+Otherwise the first spectrum in the calibration image will be used
+for all spectra in the input image.
+.le
+.ls xcorr = yes
+Cross-correlate each input spectrum with the calibration spectrum to
+determine an shift for the calibration spectrum?  Only regions specified by
+the sample regions parameter will be used in the cross-correlation.
+.le
+.ls tweakrms = yes
+Search for the minimum RMS in the corrected spectrum by adjusting the
+shifts and scales between the input spectrum and the calibration spectrum?
+The RMS is minimized in the specified sample regions.
+.le
+.ls interactive = yes
+Enter an interactive graphical mode to search for the best shift
+and scale between the input spectra and calibration spectra?  This
+is done after the optional automatic cross-correlation and RMS minimization
+step.  A query is made for each input spectrum so that the interactive
+step may be skipped during the execution of the task.
+.le
+.ls sample = "*"
+Sample regions to use for cross-correlation, automatic RMS minimization,
+and RMS values.  The sample regions are specified by a list of comma
+separated ranges.  The ranges are colon separate coordinate values.
+For dispersion calibrated spectra the coordinate values are in the
+dispersion units otherwise they are in pixel coordinates.  The string "*"
+selects the entire spectrum.  The sample regions may be changed
+interactively either with the cursor or with a colon command.
+.le
+.ls threshold = 0.
+Since the calibration consists of division by the scaled calibration data
+it is possible for totally saturated lines to have zero or negative values.
+The task will quit if detects negative or zero calibration values.  The
+\fIthreshold\fR allows applying a minimum threshold to the calibration
+values so the task may continue.
+.le
+.ls lag = 10
+The cross-correlation lag to use when \fIxcorr\fR = yes.  The lag
+is given in pixels.   This is the distance to either side of the
+initial shift over which the cross-correlation profile is computed.
+If a value of zero is given then the cross-correlation step is not done.
+.le
+.ls shift = 0., dshift = 1.
+The initial shift and shift step in pixels.  This initializes the shift
+search parameters for the first spectrum.  If \fIdshift\fR is zero then
+there will be no search for a new shift and the 'x' interactive function is
+disabled.  These parameters may be changed interactively.  After the
+first spectrum subsequent spectra begin with the values from the last
+spectrum.
+.le
+.ls scale = 1., dscale = 0.2
+The initial scale and scale step.  This initializes the scale
+search parameters for the first spectrum.  If \fIdscale\fR is zero then
+there will be no search for a new scale and the 'y' interactive function is
+disabled.  These parameters may be changed interactively.  After the
+first spectrum subsequent spectra begin with the values from the last
+spectrum.
+.le
+.ls offset = 1.
+The interactive search displays three candidate corrected spectra which
+have been normalized to a mean of one.  The offset is added and subtracted
+to separate the three candidates.  The value may be changed interactively.
+.le
+.ls smooth = 1
+The displayed candidate corrected spectra are smoothed by a moving
+boxcar average with a box size specified by this parameter.  The smoothing
+only applies to the displayed spectra and does not affect the measured
+RMS or the output corrected spectra.  The value may be changed interactively.
+.le
+.ls cursor = ""
+Input cursor for the interactive graphics.  A null value selects the
+graphics cursor otherwise a file of cursor values may be specified.
+.le
+.ls airmass
+Query parameter for the airmass.  If the airmass is not in the image
+header under the keyword AIRMASS the user is queried for the airmass.
+This parameter should not be specified on the command line.
+.le
+.ls answer
+Query parameter for responding to the interactive question.  This parameter
+should not be specified on the command line.
+.le
+.ls interp = poly5
+The \fBpackage\fR parameter specifying the interpolation function for shifting
+the calibration spectra to match the input spectra.
+.le
+.ih
+DESCRIPTION
+Input one dimensional spectra are corrected to remove telluric features by
+dividing by shifted and scaled calibration spectra.  The calibration
+spectra are generally of hot, nearly featureless stars; hence this procedure
+is sometimes referred to as a B-star correction.  The shifting
+allows for possible small shifts or errors in the dispersion zeropoints.
+The intensity scaling allows for differences in the airmass and variations
+in the abundance of the telluric species.  The intensity scaling
+uses Beer's law which is the approximation that the change in absorption
+with abundance is an exponential relation.  
+
+The following describes the correction.  Let J(x_i) be the calibration
+spectrum at a set of pixels x_i.  An interpolation function is fit to this
+spectrum to give J(x).  The shifted and scaled calibration function
+is then
+
+.nf
+    (1)  J'(x) = max (threshold, J(x+dx)) ** (A / A_cal * scale)
+.fi
+
+where dx is the pixel shift parameter, A is the airmass of the input
+spectrum, A_cal is the airmass of the calibration spectrum, and
+scale is the scale parameter.  The operator "**" is exponentiation.
+The max operation limits the calibration spectrum to be greater
+than or equal to the specified threshold value.  If the calibration
+value is ever less than or equal to zero then the task will quit
+with a warning error.
+
+The output corrected spectrum is then computed as
+
+.nf
+    (2)  I'(x_i) = I(x_i) / (J'(x_i) / <J'>)
+.fi
+
+where I' is the corrected spectrum, I is the input spectrum, and <J'> is
+the mean of the shifted and scaled calibration spectrum to keep the output
+intensities comparable to the input spectrum.  The value of <J'> is
+printed in the output as the "normalization".  If the spectra are
+dispersion calibrated, possibly with different dispersion parameters, then
+the x values in (2) from the input spectrum are converted to matching
+pixels in the calibration spectrum using the dispersion functions of the
+two spectra.
+
+The purpose of this task is to determine the best values of the
+shift and scale parameters dx and scale.  There
+are automatic and interactive methods provided.  The automatic
+methods are cross-correlation of the calibration and input spectra
+to find a shift and an iterative search for the in both
+shift and scale that minimizes the RMS of I' in some region.
+The automatic methods are performed first, if selected, followed
+by the interactive, graphical step.  The following describes
+the steps in the order in which they occur.
+
+The initial values of the shift and scale are set by the parameters
+\fIshift\fR and \fIscale\fR for the first spectrum.  After that the values
+determined for the previous spectrum, those actually applied to correcting
+that spectrum, are used as the initial values for the next spectrum.  The
+search steps and sample regions are also initialized by task parameters but
+may be modified during the interactive step and the modified values apply
+to subsequent spectra.
+
+If the \fIxcorr\fR parameter is yes and the \fIlag\fR parameter is
+not zero the calibration spectrum is cross-correlated against the input
+spectrum.  Each spectrum is prepared as follows.  A large scale continuum
+is fit by a quadratic chebyshev using 5 iterations of sigma clipping with a
+clipping factor of 3 sigma below the fit and 1 sigma above the fit and
+rejecting the deviant points along with one pixel on either side.  This
+attempts to eliminate the effects of absorption lines.  The continuum fit
+is subtracted from the spectrum and the spectrum is extended and tapered by
+a cosine function of length given by the \fIlag\fR parameter.
+
+The prepared spectra are then cross-correlated by shifting the calibration
+spectrum plus and minus the specified \fIlag\fR amount about the current
+shift value.  Only the regions in the input spectrum specified by the
+sample regions parameter are used in the correlation.  This produces a
+correlation profile whose peak defines the relative shift between the two
+spectra.  The current shift value is updated.  This method assumes the
+common telluric features dominate within the specified sample regions.  The
+lag size should be roughly the profile widths of the telluric features.
+
+If the \fItweakrms\fR parameter is yes and \fIdshift\fR is greater than
+zero trial corrections at the current shift value and plus and minus one
+shift step with the scale value fixed at its current value are made and the
+RMS in the sample regions computed.  If the RMS is smallest at the current
+shift value the shift step is divided in half otherwise the current shift
+value is set to the shift with the lowest RMS.  The process is then
+repeated with the new shift and shift step values.  This continues until
+either the shift step is less than 0.01 pixels or the shift is more than
+two pixels from the initial shift.  In the latter case the final shift is
+reset to the original shift.
+
+The scale factor is then varied if \fIdscale\fR is greater than zero by the
+scale step at a fixed shift in the same way as above to search for a
+smaller RMS in the sample regions.  This search terminates when the scale
+step is less than 0.01 or if the scale value has departed by 100% of the
+initial value.  In the latter case the scale value is left unchanged.
+
+The search over the shifts and scales is repeated a second time after which
+the tweak algorithm terminates.
+
+After the optional cross-correlation and tweak steps the interactive search
+mode may be entered.  This occurs if \fIinteractive\fR = yes.  A query is
+asking whether to search interactively.  The answers may be "no", "yes",
+"NO", or "YES".  The lower case answers apply to the current spectrum and
+the upper case answers apply to all subsequent spectra.  This means that if
+an answer of "NO" or "YES" is given then there will be no further queries
+for the remaining input spectra.
+
+If the interactive step is selected a graph of three candidate corrections
+for the input spectrum is displayed.  There also may be a graph of the
+calibration or input spectrum shown for reference.  Initially the
+calibration spectrum is displayed.  The additional graph may be toggled off
+and on and between the input and calibration spectra with the 'c' and 'd'
+keys.  The three candidate corrected spectra will be with the current shift
+and scale in the middle and plus or minus one step in either the shift or
+scale.  Initially the spectra will be at different scale values.
+Information about the current shift and scale and the step used is given in
+the graph title.
+
+One may toggle between shift steps and scale steps with the 'x' (for shift)
+or 'y' (for scale) keys.  The RMS in the title is the RMS within the
+currently defined sample regions.  If one of the step values is zero then a
+display of different values of that parameter will not be selected.  The
+step size will need to be set with a colon command to search in that
+parameter.
+
+If 'x' is typed when the three spectra are at different shifts then the
+nearest spectrum to the y cursor at the x cursor position will be
+selected.  If the central spectrum is selected the step size is divided in
+half otherwise the current shift is changed and the  selected spectrum
+becomes the middle spectrum.  Three new spectra are then shown.  The same
+applies if 'y' is typed when the three spectra are at different scales.
+This allows an interactive search similar to the iterative tweakrms method
+described previously except the user can use whatever criteria is desired
+to search for the best scale and shift.
+
+There are additional keystrokes and colon commands to set or change sample
+regions, reset the current shift, scale, and step sizes, expand the step
+size in the current mode, adjust the offsets between the spectra, and
+get help.  The 'w' key and GTOOLS colon commands are available to window
+the graphs.  Any changes in the x limits apply to both graphs while y limit
+adjustments apply to the graph pointed to by the cursor.
+
+Two other commands require a short explanation.  The 'a' key may
+be used to run the tweakrms algorithm starting from the current
+shift, scale, and steps and the current sample regions.  This allows
+one to graphically set or reset the sample regions before doing
+the RMS minimization.  The ":smooth" command and associated
+\fIsmooth\fR task parameter allow the corrected spectra to be
+displayed with a boxcar smoothing to better see faint features in
+noise.  It is important to realize that the smoothing is only
+done on the displayed spectra.  The telluric correction and computed RMS
+are done in the unsmoothed data.
+
+After the interactive step is quit with 'q' or if the interactive
+step is not done then the final output spectrum is computed and
+written to the output image.  A brief log output is printed for
+each spectrum.
+.ih
+CURSOR KEYS AND COLON COMMANDS
+.nf
+? - print help
+a - automatic RMS minimization within sample regions
+c - toggle calibration spectrum display
+d - toggle data spectrum display
+e - expand (double) the step for the current selection
+q - quit
+r - redraw the graphs
+s - add or reset sample regions
+w - window commands (see :/help for additional information)
+x - graph and select from corrected shifted candidates
+y - graph and select from corrected scaled candidates
+
+:help           - print help
+:shift  [value] - print or reset the current shift
+:scale  [value] - print or reset the current scale
+:dshift [value] - print or reset the current shift step
+:dscale [value] - print or reset the current scale step
+:offset [value] - print or reset the current offset between spectra
+:sample [value] - print or reset the sample regions
+:smooth [value] - print or reset the smoothing box size
+.fi
+.ih
+EXAMPLES
+1.  To interactively search for a best correction with the default
+cross-correlation and tweak steps:
+
+.nf
+    cl> telluric spec001.ms telspec001.ms spec005.ms
+.fi
+
+2.  To search only for a scale factor:
+
+.nf
+    cl> telluric spec001.ms telspec001.ms spec005.ms xcorr- dshift=0.
+.fi
+
+3.  To processes a set of spectra non-interactively with the same calibration
+spectrum and to replace the input spectra with the corrected spectra and
+log the processing:
+
+.nf
+    cl> telluric spec* "" calspec inter- > log
+.fi
+
+4.  To apply the simplest scaling by the ratio of the airmasses alone:
+
+.nf
+    cl> telluric spec* tel//spec* calspec inter- xcorr- tweak- inter- \
+    >>> scale=1. shift=0.
+.fi
+.ih
+REVISIONS
+.ls TELLURIC V2.12.3
+The normalization is printed.
+.le
+.ls TELLURIC V2.11.2
+Threshold parameter added.
+.le
+.ls TELLURIC V2.11
+This task is new in this version.
+.le
+.ih
+SEE ALSO
+skytweak
+.endhelp
diff --git a/noao/onedspec/doc/telluric.key b/noao/onedspec/doc/telluric.key
new file mode 100644
index 00000000..11a42cc3
--- /dev/null
+++ b/noao/onedspec/doc/telluric.key
@@ -0,0 +1,35 @@
+		TELLURIC COMMAND SUMMARY
+
+? - print help
+a - automatic RMS minimization within sample regions
+c - toggle calibration spectrum display
+d - toggle data spectrum display
+e - expand (double) the step for the current selection
+q - quit
+r - redraw the graphs
+s - add or reset sample regions
+w - window commands (see :/help for additional information)
+x - graph and select from corrected shifted candidates
+y - graph and select from corrected scaled candidates
+
+:help           - print help
+:shift  [value] - print or reset the current shift
+:scale  [value] - print or reset the current scale
+:dshift [value] - print or reset the current shift step
+:dscale [value] - print or reset the current scale step
+:offset [value] - print or reset the current offset between spectra
+:sample [value] - print or reset the sample regions
+:smooth [value] - print or reset the smoothing box size
+
+
+The stacked display shows three corrected candidate spectra.  The center
+one is for the current shift and scale and the other two are one step
+higher or lower in the shift or scale.  The current values and the
+step is shown in the title.  Toggle between the shift and scale candidates
+with 'x' or 'y'.  Select the best spectrum with the cursor and typing
+'x' or 'y'.  Selecting the middle spectrum with 'x' in the shift display
+divides the shift step in half.  Selecting one of the other spectra
+changes the current shift.  Selecting the middle spectrum with 'y'
+in the scale display divides the scale step in half.  Selecting one of
+the other spectra changes the current scale.  When 'q' is typed the
+final shift and scale will be that of the middle spectrum.
diff --git a/noao/onedspec/doc/wspectext.hlp b/noao/onedspec/doc/wspectext.hlp
new file mode 100644
index 00000000..9840b7b4
--- /dev/null
+++ b/noao/onedspec/doc/wspectext.hlp
@@ -0,0 +1,96 @@
+.help wspectext Oct93 onedspec
+.ih
+NAME
+wspectext -- convert 1D image spectra to an ascii text spectra
+.ih
+USAGE
+wspectext input output
+.ih
+PARAMETERS
+.ls input
+Input list of 1D image spectra to be converted.  If the image is
+not one dimensional an warning will be given and the image will be skipped.
+.le
+.ls output
+Output list of ascii text spectra filenames.  The list must match the
+input list.
+.le
+.ls header = yes
+This parameter determines whether or not a descriptive header precedes the
+wavelength and flux values written to the text file.  When \fIheader =
+no\fR, only a two column list of wavelengths and fluxes is output.
+.le
+.ls wformat = ""
+The wavelength coordinate output format.  If it is undefined the formatting
+option stored with the WCS in the image header is used.  If the WCS
+formatting option is not defined then a free format is used.  See
+\fBlistpixels\fR for a description of the format syntax.
+.le
+.ih
+DESCRIPTION
+IRAF one dimensional spectra are converted to ascii text files.  The
+text files consist of an optional FITS type header followed by a two
+column list of wavelengths and flux values.  The format of the wavelengths
+can be set but the flux values are given in free format.  This task
+is a combination of \fBwtextimage\fR and \fBlistpixels\fR.  The output
+of this task may be converted back to an image spectrum with the
+task \fBrspectext\fR.
+
+Spectra which are not in 1D images such as multispec format or long slit
+may first be converted to 1D images using \fBscopy\fR with format="onedspec".
+.ih
+EXAMPLES
+1.  Write a text file with a header.
+
+.nf
+    cl> wspectext spec001 text001 header+ wformat="%0.2f"
+    cl> type text001
+    BITPIX  =                    8  /  8-bit ASCII characters
+    NAXIS   =                    1  /  Number of Image Dimensions
+    NAXIS1  =                  100  /  Length of axis
+    ORIGIN  = 'NOAO-IRAF: WTEXTIMAGE'  /
+    IRAF-MAX=                   0.  /  Max image pixel (out of date)
+    IRAF-MIN=                   0.  /  Min image pixel (out of date)
+    IRAF-B/P=                   32  /  Image bits per pixel
+    IRAFTYPE= 'REAL FLOATING     '  /  Image datatype
+    OBJECT  = 'TITLE             '  /
+    FILENAME= 'TEST              '  /  IRAF filename
+    FORMAT  = '5G14.7            '  /  Text line format
+    APNUM1  = '1 1     '
+    DC-FLAG =                    0
+    WCSDIM  =                    1
+    CTYPE1  = 'LINEAR  '
+    CRVAL1  =                4000.
+    CRPIX1  =                   1.
+    CDELT1  =     10.1010101010101
+    CD1_1   =     10.1010101010101
+    LTM1_1  =                   1.
+    WAT0_001= 'system=equispec                                 '
+    WAT1_001= 'wtype=linear label=Wavelength units=Angstroms   '
+    END
+										    
+    4000.00  1000.
+    4010.10  1005.54
+    4020.20  1011.05
+    ...
+.fi
+
+2.  Write a simple text file with two columns of wavelength and flux.
+
+.nf
+    cl> wspectext spec001 text002 header- wformat="%0.2f"
+    cl> type text002
+    4000.00  1000.
+    4010.10  1005.54
+    4020.20  1011.05
+    ...
+.fi
+.ih
+REVISIONS
+.ls WSPECTEXT V2.10.3
+This is a new task with this version.
+.le
+.ih
+SEE ALSO
+rspectext, wtextimage, listpixels, scopy, imspec
+.endhelp
diff --git a/noao/onedspec/dopcor.par b/noao/onedspec/dopcor.par
new file mode 100644
index 00000000..95f7bb1b
--- /dev/null
+++ b/noao/onedspec/dopcor.par
@@ -0,0 +1,10 @@
+input,s,a,,,,List of input spectra
+output,s,a,,,,List of output spectra
+redshift,s,a,,,,Redshift or velocity (Km/s)
+isvelocity,b,h,no,,,Is the redshift parameter a velocity?
+add,b,h,no,,,Add to previous dispersion correction?
+dispersion,b,h,yes,,,Apply dispersion correction?
+flux,b,h,no,,,Apply flux correction?
+factor,r,h,3.,,,Flux correction factor (power of 1+z)
+apertures,s,h,"",,,List of apertures to correct
+verbose,b,h,no,,,Print corrections performed?
diff --git a/noao/onedspec/ecidentify.par b/noao/onedspec/ecidentify.par
new file mode 100644
index 00000000..102fcfee
--- /dev/null
+++ b/noao/onedspec/ecidentify.par
@@ -0,0 +1,26 @@
+# Parameters for ECIDENTIFY task.
+
+images,s,a,,,,Images containing features to be identified
+database,f,h,database,,,Database in which to record feature data
+coordlist,f,h,linelists$thar.dat,,,User coordinate list
+units,s,h,"",,,Coordinate units
+match,r,h,1.,,,Coordinate list matching limit in user units
+maxfeatures,i,h,100,,,Maximum number of features for automatic identification
+zwidth,r,h,10.,,,Zoom graph width in user units
+
+ftype,s,h,"emission","emission|absorption",,Feature type
+fwidth,r,h,4.,,,Feature width in pixels
+cradius,r,h,5.,,,Centering radius in pixels
+threshold,r,h,10.,0.,,Feature threshold for centering
+minsep,r,h,2.,0.,,Minimum pixel separation
+
+function,s,h,"chebyshev","legendre|chebyshev",,Coordinate function
+xorder,i,h,2,1,,Order of coordinate function along dispersion
+yorder,i,h,2,1,,Order of coordinate function across dispersion
+niterate,i,h,0,0,,Rejection iterations
+lowreject,r,h,3.,0.,,Lower rejection sigma
+highreject,r,h,3.,0.,,Upper rejection sigma
+
+autowrite,b,h,no,,,Automatically write to database?
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/onedspec/ecidentify/eccenter.x b/noao/onedspec/ecidentify/eccenter.x
new file mode 100644
index 00000000..730ad2a8
--- /dev/null
+++ b/noao/onedspec/ecidentify/eccenter.x
@@ -0,0 +1,34 @@
+include	"ecidentify.h"
+
+# EC_CENTER -- Locate the center of a feature.
+
+double procedure ec_center (ec, x, width, type)
+
+pointer	ec				# EC pointer
+double	x				# Initial guess
+real	width				# Feature width
+int	type				# Feature type
+
+double	dvalue
+real	value
+
+real	center1d()
+double	smw_c1trand()
+
+begin
+	if (IS_INDEFD(x))
+	    return (x)
+
+	dvalue = smw_c1trand (EC_PL(ec), x)
+	if (IS_INDEFD(dvalue))
+	    return (dvalue)
+
+	value = dvalue
+ 	value = center1d (value, IMDATA(ec,1), EC_NPTS(ec), width,
+	    abs (type), EC_CRADIUS(ec), EC_THRESHOLD(ec))
+
+	if (IS_INDEF(value))
+	    return (INDEFD)
+	else
+	    return (smw_c1trand (EC_LP(ec), double(value)))
+end
diff --git a/noao/onedspec/ecidentify/eccolon.x b/noao/onedspec/ecidentify/eccolon.x
new file mode 100644
index 00000000..0fe22af5
--- /dev/null
+++ b/noao/onedspec/ecidentify/eccolon.x
@@ -0,0 +1,243 @@
+include	<gset.h>
+include	<error.h>
+include	<pkg/center1d.h>
+include	"ecidentify.h"
+
+# List of colon commands.
+define	CMDS "|show|features|image|database|read|write|coordlist|match|\
+	|maxfeatures|minsep|zwidth|labels|fwidth|ftype|cradius|threshold|"
+
+define	SHOW		1	# Show parameters
+define	FEATURES	2	# Show list of features
+define	IMAGE		3	# Set new image
+define	DATABASE	4	# Set new database
+define	READ		5	# Read database entry
+define	WRITE		6	# Write database entry
+define	COORDLIST	7	# Set new coordinate list
+define	MATCH		8	# Set coordinate list matching distance
+# newline		9
+define	MAXFEATURES	10	# Set maximum number of features for auto find
+define	MINSEP		11	# Set minimum separation distance
+define	ZWIDTH		12	# Set zoom window width
+define	LABEL		13	# Set label type
+define	WIDTH		14	# Set centering width
+define	TYPE		15	# Set centering type
+define	RADIUS		16	# Set centering radius
+define	THRESHOLD	17	# Set the centering threshold
+
+# EC_COLON -- Respond to colon command.
+
+procedure ec_colon (ec, cmdstr, newimage, prfeature)
+
+pointer	ec			# ID pointer
+char	cmdstr[ARB]		# Colon command
+char	newimage[ARB]		# New image name
+int	prfeature		# Print current feature on status line
+
+char	cmd[SZ_LINE]
+int	i, ncmd, ival
+real	rval[2]
+pointer	im
+
+int	nscan(), strdic(), ec_next()
+pointer	immap()
+errchk	immap, ec_dbread, ec_dbwrite, ec_log
+
+begin
+	# Scan the command string and get the first word.
+	call sscan (cmdstr)
+	call gargwrd (cmd, SZ_LINE)
+	ncmd = strdic (cmd, cmd, SZ_LINE, CMDS)
+
+	switch (ncmd) {
+	case SHOW: # :show - show values of parameters
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (EC_GP(ec), AW_CLEAR)
+	        call ec_show (ec, "STDOUT")
+		call greactivate (EC_GP(ec), AW_PAUSE)
+	    } else {
+		iferr (call ec_show (ec, cmd)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+	    }
+	case FEATURES: # :features - list features
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (EC_GP(ec), AW_CLEAR)
+	        call ec_log (ec, "STDOUT")
+		call greactivate (EC_GP(ec), AW_PAUSE)
+	    } else {
+		iferr (call ec_log (ec, cmd)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+	    }
+	case IMAGE: # :image - set image
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("image %s\n")
+		    call pargstr (Memc[EC_IMAGE(ec)])
+		prfeature = NO
+	    } else {
+		call strcpy (cmd, newimage, SZ_FNAME)
+		iferr {
+		    im = immap (newimage, READ_ONLY, 0)
+		    call imunmap (im)
+		} then {
+		    newimage[1] = EOS
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+	    }
+	case DATABASE: # :database - set database
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("database %s\n")
+		    call pargstr (Memc[EC_DATABASE(ec)])
+		prfeature = NO
+	    } else {
+	        call strcpy (cmd, Memc[EC_DATABASE(ec)], SZ_FNAME)
+		EC_NEWDBENTRY(ec) = YES
+	    }
+	case READ: # :read - read database entry
+	    prfeature = NO
+	    iferr {
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1)
+		    call ec_dbread (ec, Memc[EC_IMAGE(ec)], YES)
+	        else {
+		    call xt_stripwhite (cmd)
+		    if (cmd[1] == EOS)
+		        call ec_dbread (ec, Memc[EC_IMAGE(ec)], YES)
+		    else
+		        call ec_dbread (ec, cmd, YES)
+		}
+		EC_CURRENT(ec) = 0
+		i = ec_next (ec, EC_CURRENT(ec))
+	    } then
+		call erract (EA_WARN)
+	case WRITE: # :write - write database entry
+	    prfeature = NO
+	    iferr {
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1)
+		    call ec_dbwrite (ec, Memc[EC_IMAGE(ec)], YES)
+	        else {
+		    call xt_stripwhite (cmd)
+		    if (cmd[1] == EOS)
+		        call ec_dbwrite (ec, Memc[EC_IMAGE(ec)], YES)
+		    else
+		        call ec_dbwrite (ec, cmd, YES)
+		}
+	    } then
+		call erract (EA_WARN)
+	case COORDLIST: # :coordlist - set coordinate list
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("coordlist %s\n")
+		    call pargstr (Memc[EC_COORDLIST(ec)])
+		prfeature = NO
+	    } else {
+	        call strcpy (cmd, Memc[EC_COORDLIST(ec)], SZ_FNAME)
+		call ec_unmapll (ec)
+		call ec_mapll (ec)
+	    }
+	case MATCH: # :match - set matching distance for coordinate list
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+	        call printf ("match %g\n")
+		    call pargr (EC_MATCH(ec))
+		prfeature = NO
+	    } else
+		EC_MATCH(ec) = rval[1]
+	case MAXFEATURES: # :maxfeatures - set max num features for auto find
+	    call gargi (ival)
+	    if (nscan() == 1) {
+	        call printf ("maxfeatures %d\n")
+		    call pargi (EC_MAXFEATURES(ec))
+		prfeature = NO
+	    } else
+		EC_MAXFEATURES(ec) = ival
+	case MINSEP: # :minsep - set minimum feature separation allowed
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("minsep %g\n")
+		    call pargr (EC_MINSEP(ec))
+		prfeature = NO
+	    } else
+		EC_MINSEP(ec) = rval[1]
+	case ZWIDTH: # :zwidth - set zoom window width
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("zwidth %g\n")
+		    call pargr (EC_ZWIDTH(ec))
+		prfeature = NO
+	    } else {
+		EC_ZWIDTH(ec) = rval[1]
+		if (EC_GTYPE(ec) == 2)
+		    EC_NEWGRAPH(ec) = YES
+	    }
+	case LABEL: # :labels - set label type
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		switch (EC_LABELS(ec)) {
+		case 2:
+		    call printf ("labels index\n")
+		case 3:
+		    call printf ("labels pixel\n")
+		case 4:
+		    call printf ("labels user\n")
+		default:
+		    call printf ("labels none\n")
+		}
+	        prfeature = NO
+	    } else {
+	        EC_LABELS(ec) = strdic (cmd, cmd, SZ_LINE, LABELS)
+		do i = 1, EC_NFEATURES(ec) {
+		    if (APN(ec,i) == EC_AP(ec))
+		        call ec_mark (ec, i)
+		}
+	    }
+	case WIDTH: # :fwidth - set centering width
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+	        call printf ("fwidth %g\n")
+		    call pargr (EC_FWIDTH(ec))
+	        prfeature = NO
+	    } else
+		EC_FWIDTH(ec) = rval[1]
+	case TYPE:	# :ftype - set centering type
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		switch (EC_FTYPE(ec)) {
+		case EMISSION:
+		    call printf ("ftype emission\n")
+		case ABSORPTION:
+		    call printf ("ftype absorption\n")
+		}
+	        prfeature = NO
+	    } else
+	        EC_FTYPE(ec) = strdic (cmd, cmd, SZ_LINE, FTYPES)
+	case RADIUS: # :cradius - set centering radius
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("cradius %g\n")
+		    call pargr (EC_CRADIUS(ec))
+	        prfeature = NO
+	    } else
+		EC_CRADIUS(ec) = rval[1]
+	case THRESHOLD: # :threshold - set centering threshold
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("threshold %g\n")
+		    call pargr (EC_THRESHOLD(ec))
+	        prfeature = NO
+	    } else
+		EC_THRESHOLD(ec) = rval[1]
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	    prfeature = NO
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecdb.x b/noao/onedspec/ecidentify/ecdb.x
new file mode 100644
index 00000000..f6e02526
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecdb.x
@@ -0,0 +1,268 @@
+include <math/gsurfit.h>
+include <smw.h>
+include <units.h>
+include "ecidentify.h"
+
+# EC_DBREAD -- Read features data from the database.
+
+procedure ec_dbread (ec, name, verbose)
+
+pointer ec                              # ID pointer
+char    name[SZ_LINE]
+int     verbose
+
+pointer dt
+int     i, j, k, ncoeffs, rec, slope, offset, niterate
+double  shift, low, high
+pointer sp, coeffs, line, cluster, un
+
+int     ec_line()
+int     dtgeti(), dgsgeti(), dtlocate(), dtscan(), nscan()
+real    dtgetr()
+bool	un_compare()
+double  dgsgetd(), smw_c1trand()
+pointer dtmap1(), un_open()
+
+errchk  dtmap1, dtlocate, dtgeti, dtgad, un_open
+
+begin
+        call smark (sp)
+        call salloc (cluster, SZ_LINE, TY_CHAR)
+        call salloc (line, SZ_LINE, TY_CHAR)
+
+        call imgcluster (name, Memc[cluster], SZ_LINE)
+        call sprintf (Memc[line], SZ_LINE, "ec%s")
+            call pargstr (Memc[cluster])
+        dt = dtmap1 (Memc[EC_DATABASE(ec)], Memc[line], READ_ONLY)
+
+        call sprintf (Memc[line], SZ_LINE, "ecidentify %s")
+            call pargstr (Memc[cluster])
+
+        rec = dtlocate (dt, Memc[line])
+        if (rec == EOF)
+            call error (0, "Entry not found")
+
+        i = dtgeti (dt, rec, "features")
+
+        EC_NALLOC(ec) = i
+        call realloc (EC_APNUM(ec), i, TY_INT)
+        call realloc (EC_LINENUM(ec), i, TY_INT)
+        call realloc (EC_ORD(ec), i, TY_INT)
+        call realloc (EC_PIX(ec), i, TY_DOUBLE)
+        call realloc (EC_FIT(ec), i, TY_DOUBLE)
+        call realloc (EC_USER(ec), i, TY_DOUBLE)
+        call realloc (EC_FWIDTHS(ec), i, TY_REAL)
+        call realloc (EC_FTYPES(ec), i, TY_INT)
+
+        j = 1
+        do i = 1, EC_NALLOC(ec) {
+            k = dtscan (dt)
+            call gargi (APN(ec,j))
+            call gargi (ORDER(ec,j))
+            call gargd (PIX(ec,j))
+            call gargd (FIT(ec,j))
+            call gargd (USER(ec,j))
+            call gargr (FWIDTH(ec,j))
+            call gargi (FTYPE(ec,j))
+            call gargi (k)
+            if (nscan() == 8 && k == 0)
+                FTYPE(ec,j) = -FTYPE(ec,j)
+            iferr (LINE(ec,j) = ec_line (ec, APN(ec,j)))
+                next
+            shift = smw_c1trand (EC_PL(ec), PIX(ec,j))
+            low = 0.5
+            high = SN(SH(ec,LINE(ec,j))) + 0.5
+            if (shift < low || shift > high)
+                next
+            j = j + 1
+        }
+        EC_NFEATURES(ec) = j - 1
+
+        iferr (shift = dtgetr (dt, rec, "shift"))
+            shift = 0.
+        iferr (offset = dtgeti (dt, rec, "offset"))
+            offset = 0
+        iferr (slope = dtgeti (dt, rec, "slope"))
+            slope = 1
+        call ecf_setd ("shift", shift)
+        call ecf_seti ("offset", offset)
+        call ecf_seti ("slope", slope)
+
+        iferr {
+            ncoeffs = dtgeti (dt, rec, "coefficients")
+            call salloc (coeffs, ncoeffs, TY_DOUBLE)
+            call dtgad (dt, rec, "coefficients", Memd[coeffs], ncoeffs, ncoeffs)
+
+            if (EC_ECF(ec) != NULL)
+                call dgsfree (EC_ECF(ec))
+            call dgsrestore (EC_ECF(ec), Memd[coeffs])
+
+            call ecf_setd ("xmin", dgsgetd (EC_ECF(ec), GSXMIN))
+            call ecf_setd ("xmax", dgsgetd (EC_ECF(ec), GSXMAX))
+            call ecf_setd ("ymin", dgsgetd (EC_ECF(ec), GSYMIN))
+            call ecf_setd ("ymax", dgsgetd (EC_ECF(ec), GSYMAX))
+            call ecf_seti ("xorder", dgsgeti (EC_ECF(ec), GSXORDER))
+            call ecf_seti ("yorder", dgsgeti (EC_ECF(ec), GSYORDER))
+
+            switch (dgsgeti (EC_ECF(ec), GSTYPE)) {
+            case GS_LEGENDRE:
+                call ecf_sets ("function", "legendre")
+            case GS_CHEBYSHEV:
+                call ecf_sets ("function", "chebyshev")
+            }
+
+            ifnoerr (niterate = dtgeti (dt, rec, "niterate"))
+                call ecf_seti ("niterate", niterate)
+            ifnoerr (low = dtgetr (dt, rec, "lowreject"))
+                call ecf_setd ("low", low)
+            ifnoerr (high = dtgeti (dt, rec, "highreject"))
+                call ecf_setd ("high", high)
+
+            EC_NEWECF(ec) = YES
+            EC_CURRENT(ec) = min (1, EC_NFEATURES(ec))
+        } then
+                ;
+
+	ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) {
+	    if (EC_UN(ec) == NULL)
+		EC_UN(ec) = un_open (Memc[line])
+	    else {
+		un = un_open (Memc[line])
+		if (!un_compare (un, EC_UN(ec))) {
+		    call ec_unitsll (ec, Memc[line])
+		    call un_close (EC_UN(ec))
+		    EC_UN(ec) = un
+		} else
+		    call un_close (un)
+	    }
+	}
+
+        call dtunmap (dt)
+        call sfree (sp)
+
+        if (EC_NFEATURES(ec) > 0) {
+            EC_NEWGRAPH(ec) = YES
+            EC_NEWFEATURES(ec) = YES
+            EC_CURRENT(ec) = 1
+        } else
+            EC_CURRENT(ec) = 0
+
+        if (verbose == YES) {
+            call printf ("ecidentify %s\n")
+                call pargstr (Memc[cluster])
+        }
+end
+
+
+# EC_DBWRITE -- Write features data to the database.
+
+procedure ec_dbwrite (ec, name, verbose)
+
+pointer ec                              # ID pointer
+char    name[ARB]
+int     verbose
+
+int     i, ncoeffs
+pointer dt, sp, coeffs, root, cluster
+
+int     dgsgeti(), ecf_geti()
+double  ecf_getd()
+pointer dtmap1(), immap()
+
+errchk  dtmap1, immap
+
+begin
+        call smark (sp)
+        call salloc (cluster, SZ_FNAME, TY_CHAR)
+        call salloc (root, SZ_FNAME, TY_CHAR)
+
+        call imgcluster (name, Memc[cluster], SZ_FNAME)
+        call sprintf (Memc[root], SZ_FNAME, "ec%s")
+            call pargstr (Memc[cluster])
+        dt = dtmap1 (Memc[EC_DATABASE(ec)], Memc[root], APPEND)
+
+        call dtptime (dt)
+        call dtput (dt, "begin\tecidentify %s\n")
+            call pargstr (Memc[cluster])
+        call dtput (dt, "\tid\t%s\n")
+            call pargstr (Memc[cluster])
+        call dtput (dt, "\ttask\tecidentify\n")
+        call dtput (dt, "\timage\t%s\n")
+            call pargstr (Memc[EC_IMAGE(ec)])
+
+	if (EC_UN(ec) != NULL) {
+	    call dtput (dt, "\tunits\t%s\n")
+		call pargstr (UN_UNITS(EC_UN(ec)))
+	}
+        call dtput (dt, "\tfeatures\t%d\n")
+            call pargi (EC_NFEATURES(ec))
+        do i = 1, EC_NFEATURES(ec) {
+            call dtput (dt,
+                "\t\t%3d  %3d  %7.2f  %10.9g  %10.9g  %4.1f  %d  %d\n")
+                call pargi (APN(ec,i))
+                call pargi (ORDER(ec,i))
+                call pargd (PIX(ec,i))
+                call pargd (FIT(ec,i))
+                call pargd (USER(ec,i))
+                call pargr (FWIDTH(ec,i))
+                call pargi (abs (FTYPE(ec,i)))
+                if (FTYPE(ec,i) > 0)
+                    call pargi (1)
+                else
+                    call pargi (0)
+        }
+
+        if (ecf_getd ("shift") != 0.) {
+            call dtput (dt, "\tshift\t%g\n")
+                call pargd (ecf_getd ("shift"))
+        }
+        if (ecf_geti ("offset") != 0) {
+            call dtput (dt, "\toffset\t%d\n")
+                call pargi (ecf_geti ("offset"))
+        }
+        if (ecf_geti ("slope") != 1) {
+            call dtput (dt, "\tslope\t%d\n")
+                call pargi (ecf_geti ("slope"))
+        }
+
+        if (EC_ECF(ec) != NULL) {
+            call dtput (dt, "\tniterate %d\n")
+                call  pargi (ecf_geti ("niterate"))
+            call dtput (dt, "\tlowreject %g\n")
+                call  pargd (ecf_getd ("low"))
+            call dtput (dt, "\thighreject %g\n")
+                call  pargd (ecf_getd ("high"))
+
+            ncoeffs = dgsgeti (EC_ECF(ec), GSNSAVE)
+            call salloc (coeffs, ncoeffs, TY_DOUBLE)
+            call dgssave (EC_ECF(ec), Memd[coeffs])
+            call dtput (dt, "\tcoefficients\t%d\n")
+                call pargi (ncoeffs)
+            do i = 1, ncoeffs {
+                call dtput (dt, "\t\t%g\n")
+                    call pargd (Memd[coeffs+i-1])
+            }
+        }
+
+        call dtput (dt, "\n")
+        call dtunmap (dt)
+
+        EC_NEWFEATURES(ec) = NO
+        EC_NEWECF(ec) = NO
+        EC_NEWDBENTRY(ec) = NO
+
+        if (verbose == YES) {
+            call printf ("ecidentify %s\n")
+                call pargstr (Memc[cluster])
+        }
+
+        # Enter reference spectrum name in image header.
+        call imgcluster (Memc[EC_IMAGE(ec)], Memc[root], SZ_FNAME)
+        dt = immap (Memc[root], READ_WRITE, 0)
+        call imastr (dt, "REFSPEC1", Memc[cluster])
+        iferr (call imdelf (dt, "REFSPEC2"))
+            ;
+        call imunmap (dt)
+
+        call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecdelete.x b/noao/onedspec/ecidentify/ecdelete.x
new file mode 100644
index 00000000..b729d326
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecdelete.x
@@ -0,0 +1,28 @@
+include	"ecidentify.h"
+
+# EC_DELETE -- Delete a feature.
+
+procedure ec_delete (ec, feature)
+
+pointer	ec			# ID pointer
+int	feature			# Feature to be deleted
+
+int	i
+
+begin
+	if (feature == 0)
+	    return
+
+	do i = feature + 1, EC_NFEATURES(ec) {
+	    APN(ec,i-1) = APN(ec,i)
+	    LINE(ec,i-1) = LINE(ec,i)
+	    ORDER(ec,i-1) = ORDER(ec,i)
+	    PIX(ec,i-1) = PIX(ec,i)
+	    FIT(ec,i-1) = FIT(ec,i)
+	    USER(ec,i-1) = USER(ec,i)
+	    FWIDTH(ec,i-1) = FWIDTH(ec,i)
+	    FTYPE(ec,i-1) = FTYPE(ec,i)
+	}
+	EC_NFEATURES(ec) = EC_NFEATURES(ec) - 1
+	EC_NEWFEATURES(ec) = YES
+end
diff --git a/noao/onedspec/ecidentify/ecdofit.x b/noao/onedspec/ecidentify/ecdofit.x
new file mode 100644
index 00000000..14dcea54
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecdofit.x
@@ -0,0 +1,128 @@
+include	<smw.h>
+include	"ecidentify.h"
+
+# EC_DOFIT -- Fit an echelle function to the features.  Eliminate INDEF points.
+
+procedure ec_dofit (ec, interactive, fixedorder)
+
+pointer	ec			# EC pointer
+int	interactive		# Interactive fit?
+int	fixedorder		# Fixed order?
+
+int	i, j, k, nfit
+double	xmin, xmax, ymin, ymax
+pointer	gt1, ecf
+pointer	sp, x, y, z, w, gt_init()
+errchk	ecf_fit
+
+begin
+	# Count number of points and determine the order range.
+	j = ORDER(ec,1)
+	k = ORDER(ec,1)
+	nfit = 0
+	for (i=1; i<=EC_NFEATURES(ec); i=i+1) {
+	    if (IS_INDEFD (PIX(ec,i)) || IS_INDEFD (USER(ec,i)))
+		next
+	    j = min (j, ORDER(ec,i))
+	    k = max (k, ORDER(ec,i))
+	    nfit = nfit + 1
+	}
+
+	# Require at least 4 points and more than one order.
+	if (nfit < 4 || j == k) {
+	    if (EC_ECF(ec) != NULL) {
+	        call dgs_free (EC_ECF(ec))
+		call ecf_setd ("shift", 0.D0)
+	        EC_NEWGRAPH(ec) = YES
+	        EC_NEWECF(ec) = YES
+	    }
+	    return
+	}
+
+	# Allocate arrays for points to be fit and fill them in.
+	call smark (sp)
+	call salloc (x, nfit, TY_DOUBLE)
+	call salloc (y, nfit, TY_DOUBLE)
+	call salloc (z, nfit, TY_DOUBLE)
+	call salloc (w, nfit, TY_DOUBLE)
+
+	nfit = 0
+	do i = 1, EC_NFEATURES(ec) {
+	    if (IS_INDEFD (PIX(ec,i)) || IS_INDEFD (USER(ec,i)))
+		next
+	    Memd[x+nfit] = PIX(ec,i)
+	    Memd[y+nfit] = APN(ec,i)
+	    Memd[z+nfit] = USER(ec,i)
+	    Memd[w+nfit] = 1.
+	    nfit = nfit + 1
+	}
+
+	# Initialize fit limits.
+	ymin = APS(ec,1)
+	ymax = ymin
+	do i = 2, EC_NLINES(ec) {
+	    xmin = APS(ec,i)
+	    if (xmin < ymin)
+		ymin = xmin
+	    if (xmin > ymax)
+		ymax = xmin
+	}
+	xmin = 1
+	xmax = EC_NPTS(ec)
+
+	call ecf_setd ("xmin", xmin)
+	call ecf_setd ("xmax", xmax)
+	call ecf_setd ("ymin", ymin)
+	call ecf_setd ("ymax", ymax)
+
+	# Fit the echelle dispersion function.
+	ecf = EC_ECF(ec)
+	if (interactive == YES) {
+	    gt1 = gt_init()
+	    call ecf_fit (ecf, EC_GP(ec), gt1, Memd[x], Memd[y],
+		Memd[z], Memd[w], nfit, fixedorder)
+	    call gt_free (gt1)
+	} else
+	    call ecf_fit (ecf, NULL, NULL, Memd[x], Memd[y], Memd[z],
+		Memd[w], nfit, fixedorder)
+	EC_ECF(ec) = ecf
+
+	# Remove any deleted points.
+	j = 0
+	k = 0
+	do i = 1, EC_NFEATURES(ec) {
+	    if (IS_INDEFD (PIX(ec,i)) || IS_INDEFD (USER(ec,i))) {
+		j = j + 1
+    	        APN(ec,j) = APN(ec,i)
+    	        LINE(ec,j) = LINE(ec,i)
+    	        ORDER(ec,j) = ORDER(ec,i)
+    	        PIX(ec,j) = PIX(ec,i)
+    	        FIT(ec,j) = FIT(ec,i)
+    	        USER(ec,j) = USER(ec,i)
+    	        FWIDTH(ec,j) = FWIDTH(ec,i)
+    	        FTYPE(ec,j) = abs (FTYPE(ec,i))
+	    } else {
+		if (Memd[w+k] != 0.) {
+		    j = j + 1
+    	            APN(ec,j) = APN(ec,i)
+    	            LINE(ec,j) = LINE(ec,i)
+    	            ORDER(ec,j) = ORDER(ec,i)
+    	            PIX(ec,j) = PIX(ec,i)
+    	            FIT(ec,j) = FIT(ec,i)
+    	            USER(ec,j) = USER(ec,i)
+    	            FWIDTH(ec,j) = FWIDTH(ec,i)
+    	            FTYPE(ec,j) = abs (FTYPE(ec,i))
+		    if (Memd[w+k] < 0.)
+    	                FTYPE(ec,j) = -FTYPE(ec,j)
+		}
+		k = k + 1
+	    }
+	}
+	EC_NFEATURES(ec) = j
+
+	# Set flags.
+	EC_NEWECF(ec) = YES
+	EC_NEWGRAPH(ec) = YES
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecdoshift.x b/noao/onedspec/ecidentify/ecdoshift.x
new file mode 100644
index 00000000..1689bc92
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecdoshift.x
@@ -0,0 +1,44 @@
+include	"ecidentify.h"
+
+# EC_DOSHIFT -- Minimize residuals by constant shift.
+
+procedure ec_doshift (ec, interactive)
+
+pointer	ec			# ID pointer
+int	interactive		# Called interactively?
+
+int	i, j
+double	shft, delta, rms, ec_fitpt(), ecf_getd()
+
+begin
+	shft = 0.
+	rms = 0.
+	j = 0
+	for (i=1; i <= EC_NFEATURES(ec); i = i + 1) {
+	    if (IS_INDEFD (USER(ec,i)))
+		next
+	    delta = USER(ec,i) - ec_fitpt (ec, APN(ec,i), PIX(ec,i))
+	    delta = delta * ORDER(ec,i)
+	    shft = shft + delta
+	    rms = rms + delta * delta
+	    j = j + 1
+	}
+
+	if (j > 0) {
+	    shft = shft / j
+	    rms = rms / j
+	    if (interactive == YES) {
+		i = EC_ORDER(ec)
+	        call printf ("Coordinate shift=%5f, rms=%5f")
+		    call pargd (shft / i)
+		    if (j == 1)
+			call pargd (INDEFD)
+		    else
+		        call pargd (sqrt (rms - shft ** 2) / i)
+	    }
+	    shft = shft + ecf_getd ("shift")
+	    call ecf_setd ("shift", shft)
+	    EC_NEWECF(ec) = YES
+	    EC_NEWGRAPH(ec) = YES
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfcolon.x b/noao/onedspec/ecidentify/ecffit/ecfcolon.x
new file mode 100644
index 00000000..4307335b
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfcolon.x
@@ -0,0 +1,102 @@
+include	<error.h>
+include	<gset.h>
+
+# List of colon commands
+define	CMDS "|show|function|xorder|yorder|niterate|lowreject|highreject|"
+
+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	NITERATE	5	# Set or show rejection iterations
+define	LOW		6	# Set or show low rejection threshold
+define	HIGH		7	# Set or show high rejection threshold
+
+# ECF_COLON -- Processes colon commands.
+
+procedure ecf_colon (cmdstr, gp)
+
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+
+double	dval
+int	ncmd, ival
+int	nscan(), strdic()
+include	"ecffit.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 (ecfstr, SZ_LINE)
+	ncmd = strdic (ecfstr, ecfstr, SZ_LINE, CMDS)
+
+	switch (ncmd) {
+	case SHOW: # :show - Show the values of the fitting parameters.
+	    call gdeactivate (gp, AW_CLEAR)
+	    call printf ("function %s\nxorder %d\nyorder %d\n")
+		call pargstr (function)
+		call pargi (xorder)
+		call pargi (yorder)
+	    call printf ("niterate %d\nlowreject %g\nhighreject\nnreject %d\n")
+		call pargi (niterate)
+		call pargd (low)
+		call pargd (high)
+		call pargi (nreject)
+	    call printf ("slope %d\noffset %d\nshift %g\n")
+		call pargi (slope)
+		call pargi (offset)
+		call pargd (shift)
+	    call printf ("rms %g\n")
+		call pargd (rms)
+	    call greactivate (gp, AW_PAUSE)
+	case FUNCTION: # :function - List or set the fitting function.
+	    call gargwrd (ecfstr, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("function = %s\n")
+		    call pargstr (function)
+	    } else {
+		iferr (call ecf_sets ("function", ecfstr))
+		    call erract (EA_WARN)
+	    }
+	case XORDER: # xorder: List or set the function order.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("xorder %d\n")
+		    call pargi (xorder)
+	    } 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
+		yorder = ival
+	case NITERATE: # niterate: List or set rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("niterate %d\n")
+		    call pargi (niterate)
+	    } else
+		niterate = ival
+	case LOW: # low: List or set low rejection threshold.
+	    call gargd (dval)
+	    if (nscan() == 1) {
+		call printf ("lowreject %g\n")
+		    call pargd (low)
+	    } else
+		low = dval
+	case HIGH: # highreject: List or set high rejection threshold.
+	    call gargd (dval)
+	    if (nscan() == 1) {
+		call printf ("highreject %g\n")
+		    call pargd (high)
+	    } else
+		high = dval
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfeval.x b/noao/onedspec/ecidentify/ecffit/ecfeval.x
new file mode 100644
index 00000000..1901522f
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfeval.x
@@ -0,0 +1,68 @@
+# ECF_EVAL -- Evaluate wavelength at a given order and pixel position.
+
+double procedure ecf_eval (ecf, order, x)
+
+pointer	ecf			# GSURFIT pointer
+int	order			# Order
+double	x			# X point
+
+int	ecf_oeval()
+double	y, dgseval()
+include	"ecffit.com"
+
+begin
+	y = ecf_oeval (ecf, order)
+	if (ecf == NULL)
+	    return (x + shift / y)
+	else
+	    return ((dgseval (ecf, x, y) + shift) / y)
+end
+
+
+# ECF_VECTOR -- Evaluate echelle dispersion function for a vector of points of
+# the same order.
+
+procedure ecf_vector (ecf, order, x, fit, npts)
+
+pointer	ecf			# GSURFIT pointer
+int	order			# Order
+double	x[npts]			# X points
+double	fit[npts]		# Fitted points
+int	npts			# Number of points
+
+double	yval
+pointer	sp, y
+int	ecf_oeval()
+include	"ecffit.com"
+
+begin
+	call smark (sp)
+	call salloc (y, npts, TY_DOUBLE)
+
+	yval = ecf_oeval (ecf, order)
+	if (ecf == NULL)
+	    call amovd (x, fit, npts)
+	else {
+	    call amovkd (yval, Memd[y], npts)
+	    call dgsvector (ecf, x, Memd[y], fit, npts)
+	    call adivkd (fit, yval, fit, npts)
+	}
+	if (shift != 0.)
+	    call aaddkd (fit, shift / yval, fit, npts)
+
+	call sfree (sp)
+end
+
+
+# ECF_OEVAL -- Evaluate the fit order.
+
+int procedure ecf_oeval (ecf, order)
+
+pointer	ecf			# GSURFIT pointer
+int	order			# User order
+
+include	"ecffit.com"
+
+begin
+	return (slope * order + offset)
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecffit.com b/noao/onedspec/ecidentify/ecffit/ecffit.com
new file mode 100644
index 00000000..61f3104a
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecffit.com
@@ -0,0 +1,23 @@
+# Common parameters.
+
+char	function[SZ_FNAME]	# Fitting function
+char	ecfstr[SZ_LINE]		# Working char string
+int	gstype			# Surface function type
+int	xorder			# X order of surface function
+int	yorder			# Y order of surface function
+int	niterate		# Number of rejection iterations
+int	nreject			# Number of rejected points
+int	xtype			# X axis type
+int	ytype			# Y axis type
+int	slope			# Slope of order
+int	offset			# Order offset of fit
+double	low, high		# Low and high rejection thresholds
+double	xmin, xmax		# X range
+double	ymin, ymax		# Y range
+double	shift			# First order shift
+double	rms			# RMS of fit
+
+
+common	/ecfcom/ low, high, xmin, xmax, ymin, ymax, shift, rms, gstype,
+	xorder, yorder, niterate, nreject, xtype, ytype, slope, offset,
+	function, ecfstr
diff --git a/noao/onedspec/ecidentify/ecffit/ecffit.h b/noao/onedspec/ecidentify/ecffit/ecffit.h
new file mode 100644
index 00000000..20825c71
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecffit.h
@@ -0,0 +1,20 @@
+define	IGSPARAMS	7
+
+define	FEATURE	1
+define	X	2
+define	Y	3
+define	Z	4
+define	W	5
+define	S	6
+define	R	7
+
+define	IGS_FUNCTION	1
+define	IGS_XORDER	2
+define	IGS_YORDER	3
+define	IGS_XMIN	4
+define	IGS_XMAX	5
+define	IGS_YMIN	6
+define	IGS_YMAX	7
+define	IGS_OFFSET	8
+
+define	SFTYPES		"|chebyshev|legendre|"		# Surface types
diff --git a/noao/onedspec/ecidentify/ecffit/ecffit.key b/noao/onedspec/ecidentify/ecffit/ecffit.key
new file mode 100644
index 00000000..f24407b9
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecffit.key
@@ -0,0 +1,53 @@
+	    ECHELLE DISPERSION FUNCTION FITTING KEYS
+
+
+CURSOR KEY SUMMARY
+
+?  Help             c  Print coordinates             d  Delete point
+f  Fit dispersion   o  Fit with fixed order offset   q  Quit
+r  Redraw graph     u  Undelete point                w  Window graph
+x  Set ordinate     y  Set abscissa                  I  Interrupt
+
+
+COLON COMMAND SUMMARY
+
+:show               :function [value]   :highreject [value]   :lowreject [value]
+:niterate [value]   :xorder [value]     :yorder [value]
+
+
+CURSOR KEYS
+
+?  Print this list of cursor keys
+c  Print cursor coordinates
+d  Delete the nearest undeleted point to the cursor
+f  Fit dispersion function including determining the order offset
+o  Fit dispersion function with the order offset fixed
+q  Quit and return to the spectrum display
+r  Redraw the graph
+u  Undelete the nearest deleted point to the cursor (may be outside the window)
+w  Window the graph (type ? to the window prompt for more help)
+x  Set the quantity plotted along the ordinate (x axis)
+y  Set the quantity plotted along the abscissa (y axis)
+I  Interrupt the task immediately
+
+
+COLON COMMANDS
+
+:show		     Print current function and orders
+:function [value]    Print or set the function type (chebyshev|legendre)
+:highreject [value]  Print or set high rejection limit
+:lowreject [value]   Print or set high rejection limit
+:niterate [value]    Print or set number of rejection iterations
+:xorder	[value]	     Print or set the order for the dispersion dependence
+:yorder [value]      Print or set the order for the echelle order dependence
+
+
+The dispersion function fitted is given by a two dimensional function
+(either chebyshev or legendre) of the pixel position along the
+dispersion of an order (called x) and the order number (called y).  The
+order number is determined from the aperture number by an offset and
+direction of increasing order number.  The basic order dependence is
+separated from the surface function as given below.
+
+	y = offset +/- aperture
+	wavelength = f (x, y) / y
diff --git a/noao/onedspec/ecidentify/ecffit/ecffit.x b/noao/onedspec/ecidentify/ecffit/ecffit.x
new file mode 100644
index 00000000..408a1b77
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecffit.x
@@ -0,0 +1,193 @@
+include	<error.h>
+include	<pkg/gtools.h>
+
+define	HELP	"noao$onedspec/ecidentify/ecffit/ecffit.key"
+define	PROMPT	"fitcoords surface fitting options"
+
+# EC_FIT -- Echelle dispersion fitting.
+#
+#	X - Pixel coordinates along dispersion
+#	Y - Relative order number
+#	Z - Wavelength
+
+procedure ecf_fit (ecf, gp, gt, xd, yd, zd, wd, npts, fixedorder)
+
+pointer	ecf			# GSURFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+double	xd[npts]		# Pixel coordinates along dispersion
+double	yd[npts]		# Order number
+double	zd[npts]		# Wavelength
+double	wd[npts]		# Weights
+int	npts			# Number of points
+int	fixedorder		# Fixed order?
+
+real	wx, wy
+int	wcs, key
+int	i, newgraph
+pointer	sp, wd1, rd, xr, yr
+char	cmd[SZ_LINE]
+
+int	ecf_nearest()
+int	clgcur(), scan(), nscan()
+errchk	ecf_solve()
+include	"ecffit.com"
+
+begin
+	# Allocate residuals and weights with rejected points arrays
+	call smark (sp)
+	call salloc (wd1, npts, TY_DOUBLE)
+	call salloc (rd, npts, TY_DOUBLE)
+	call amovd (wd, Memd[wd1], npts)
+
+	# Compute a solution and return if not interactive.
+	if (gp == NULL) {
+	    call ecf_solve (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts,
+		fixedorder)
+	    call ecf_reject (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts,
+		fixedorder)
+	    do i = 1, npts
+		if (Memd[wd1+i-1] != wd[i])
+		    wd[i] = -1.
+	    call sfree (sp)
+	    return
+	}
+
+	# Allocate real graph vectors.
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+
+	# Read cursor commands.
+	key = 'f'
+	repeat {
+	    switch (key) {
+	    case 'o':
+		call printf ("Order offset (%d): ")
+		    call pargi (offset)
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargi (i)
+		    if (nscan() == 1)
+			offset = i
+		    call amovd (wd, Memd[wd1], npts)
+		    call ecf_solve (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts,
+			YES)
+		    call ecf_reject (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts,
+			YES)
+		    call ecf_gdata (ecf, xtype, xd, yd, zd, Memd[rd],
+			Memr[xr], npts)
+		    call ecf_gdata (ecf, ytype, xd, yd, zd, Memd[rd],
+			Memr[yr], npts)
+		    call ecf_title (gt)
+		    newgraph = YES
+		}
+
+	    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 ecf_colon (cmd, gp)
+
+	    case 'x': # Set ordinate
+		call printf ("Ordinate - ")
+		call printf (
+		    "(p)ixel, (o)rder, (w)avelength, (r)esidual, (v)elocity: ")
+		if (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+		    break
+
+		if (key != xtype) {
+		    if (key=='p'||key=='o'||key=='w'||key=='r'||key=='v') {
+			xtype = key
+		        call gt_setr (gt, GTXMIN, INDEF)
+		        call gt_setr (gt, GTXMAX, INDEF)
+		        call ecf_gdata (ecf, xtype, xd, yd, zd, Memd[rd],
+			    Memr[xr], npts)
+		        call ecf_title (gt)
+			newgraph = YES
+		    } else
+			call printf ("\007")
+		}
+
+	    case 'y': # Set abscissa
+		call printf ("Abscissa - ")
+		call printf (
+		    "(p)ixel, (o)rder, (w)avelength, (r)esidual, (v)elocity: ")
+		if(clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+		    break
+
+		if (key != ytype) {
+		    if (key=='p'||key=='o'||key=='w'||key=='r'||key=='v') {
+			ytype = key
+		        call gt_setr (gt, GTYMIN, INDEF)
+		        call gt_setr (gt, GTYMAX, INDEF)
+		        call ecf_gdata (ecf, ytype, xd, yd, zd, Memd[rd],
+			    Memr[yr], npts)
+		        call ecf_title (gt)
+			newgraph = YES
+		    } else
+			call printf ("\007")
+		}
+
+	    case 'r': # Redraw
+		newgraph = YES
+
+	    case 'c': # Cursor coordinates
+		i = ecf_nearest (gp, gt, wx, wy, wcs, key, Memr[xr], Memr[yr],
+		    wd, npts)
+		call printf ("%10.2g %d %10.8g\n")
+		    call pargd (xd[i])
+		    call pargd (yd[i])
+		    call pargd (zd[i])
+
+	    case 'd': # Delete
+		i = ecf_nearest (gp, gt, wx, wy, wcs, key, Memr[xr], Memr[yr],
+		    wd, npts)
+		if (i > 0)
+		    Memd[wd1+i-1] = wd[i]
+
+	    case 'u': # Undelete
+		i = ecf_nearest (gp, gt, wx, wy, wcs, key, Memr[xr], Memr[yr],
+		    wd, npts)
+		if (i > 0)
+		    Memd[wd1+i-1] = wd[i]
+
+	    case 'f': # Fit
+		call amovd (wd, Memd[wd1], npts)
+		call ecf_solve (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts,
+		    fixedorder)
+		call ecf_reject (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts,
+		    fixedorder)
+		call ecf_gdata (ecf, xtype, xd, yd, zd, Memd[rd],
+		    Memr[xr], npts)
+		call ecf_gdata (ecf, ytype, xd, yd, zd, Memd[rd],
+		    Memr[yr], npts)
+		call ecf_title (gt)
+		newgraph = YES
+
+	    case 'w': # Window graph
+		call gt_window (gt, gp, "cursor", newgraph)
+
+	    case 'q': # Quit
+		break
+
+	    case 'I': # Interrupt
+		call fatal (0, "Interrupt")
+
+	    default: # Ring the bell.
+		call printf ("\07\n")
+	    }
+
+	    if (newgraph == YES) {
+		call ecf_graph (gp, gt, Memr[xr], Memr[yr], wd, Memd[wd1], npts)
+		newgraph = NO
+	    }
+	} until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+
+	do i = 1, npts
+	    if (Memd[wd1+i-1] != wd[i])
+		wd[i] = -1.
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfgdata.x b/noao/onedspec/ecidentify/ecffit/ecfgdata.x
new file mode 100644
index 00000000..eebb34d6
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfgdata.x
@@ -0,0 +1,37 @@
+include	<pkg/gtools.h>
+
+# ECF_GDATA -- Get graph data for the specified axis type from the fitting data.
+
+procedure ecf_gdata (ecf, type, x, y, z, r, data, npts)
+
+pointer	ecf			# GSURFIT pointer
+int	type			# Axis type
+double	x[npts]			# X fit data
+double	y[npts]			# Y fit data
+double	z[npts]			# Z fit data
+double	r[npts]			# Residuals
+real	data[npts]		# Graph data
+int	npts			# Number of points
+
+pointer	sp, v
+include	"ecffit.com"
+
+begin
+	switch (type) {
+	case 'p':
+	    call achtdr (x, data, npts)
+	case 'o':
+	    call achtdr (y, data, npts)
+	case 'w':
+	    call achtdr (z, data, npts)
+	case 'r':
+	    call achtdr (r, data, npts)
+	case 'v':
+	    call smark (sp)
+	    call salloc (v, npts, TY_DOUBLE)
+	    call adivd (r, z, Memd[v], npts)
+	    call amulkd (Memd[v], 300000.D0, Memd[v], npts)
+	    call achtdr (Memd[v], data, npts)
+	    call sfree (sp)
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfget.x b/noao/onedspec/ecidentify/ecffit/ecfget.x
new file mode 100644
index 00000000..025059df
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfget.x
@@ -0,0 +1,84 @@
+# ECF_GETI -- Get the value of an integer parameter.
+
+int procedure ecf_geti (param)
+
+char	param[ARB]		# ECF parameter
+
+int	i, strdic()
+include	"ecffit.com"
+
+begin
+	i = strdic (param, ecfstr, SZ_LINE,
+	    "|slope|offset|xorder|yorder|niterate|")
+	switch (i) {
+	case 1:
+	    return (slope)
+	case 2:
+	    return (offset)
+	case 3:
+	    return (xorder)
+	case 4:
+	    return (yorder)
+	case 5:
+	    return (niterate)
+	default:
+	    call error (0, "ecf_geti: Unknown parameter")
+	}
+end
+
+
+# ECF_GETS -- Get the value of a string parameter.
+
+procedure ecf_gets (param, str, maxchar)
+
+char	param[ARB]		# ECF parameter
+char	str[maxchar]		# String
+int	maxchar			# Maximum number of characters
+
+int	i, strdic()
+include	"ecffit.com"
+
+begin
+	i = strdic (param, ecfstr, SZ_LINE, "|function|")
+	switch (i) {
+	case 1:
+	    call strcpy (function, str, maxchar)
+	default:
+	    call error (0, "ecf_gets: Unknown parameter")
+	}
+end
+
+
+# ECF_GETD -- Get the values of double valued fitting parameters.
+
+double procedure ecf_getd (param)
+
+char	param[ARB]		# ECF parameter
+
+int	i, strdic()
+include	"ecffit.com"
+
+begin
+	i = strdic (param, ecfstr, SZ_LINE,
+	    "|xmin|xmax|ymin|ymax|shift|rms|low|high|")
+	switch (i) {
+	case 1:
+	    return (xmin)
+	case 2:
+	    return (xmax)
+	case 3:
+	    return (ymin)
+	case 4:
+	    return (ymax)
+	case 5:
+	    return (shift)
+	case 6:
+	    return (rms)
+	case 7:
+	    return (low)
+	case 8:
+	    return (high)
+	default:
+	    call error (0, "ecf_gets: Unknown parameter")
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfgraph.x b/noao/onedspec/ecidentify/ecffit/ecfgraph.x
new file mode 100644
index 00000000..22749527
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfgraph.x
@@ -0,0 +1,50 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+# ECF_GRAPH -- Graph the fitted data.
+
+procedure ecf_graph (gp, gt, x, y, w, rej, npts)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+real	x[npts]			# X data
+real	y[npts]			# Y data
+double	w[npts]			# Weights
+double	rej[npts]		# Rejected points
+int	npts			# Number of pts points
+
+int	i
+real	xsize, ysize, ymin, ymax, gt_getr()
+
+begin
+	xsize = gt_getr (gt, GTXSIZE)
+	ysize = gt_getr (gt, GTYSIZE)
+
+	call gclear (gp)
+
+	ymin = MAX_REAL
+	ymax = -MAX_REAL
+	do i = 1, npts
+	    if (w[i] > 0.) {
+		ymin = min (ymin, y[i])
+		ymax = max (ymax, y[i])
+	    }
+
+	call gascale (gp, x, npts, 1)
+	call gswind (gp, INDEF, INDEF, ymin, ymax)
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+
+	do i = 1, npts {
+	    if (rej[i] == 0.) {
+		if (y[i] >= ymin && y[i] <= ymax) {
+		    if (w[i] == 0.)
+		        call gmark (gp, x[i], y[i], GM_CROSS, xsize, ysize)
+		    else
+		        call gmark (gp, x[i], y[i], GM_DIAMOND, xsize, ysize)
+		}
+	    } else
+		call gmark (gp, x[i], y[i], GM_PLUS, xsize, ysize)
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfnearest.x b/noao/onedspec/ecidentify/ecffit/ecfnearest.x
new file mode 100644
index 00000000..af1b1f78
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfnearest.x
@@ -0,0 +1,85 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+
+# ECF_NEAREST -- Find nearest point to the cursor.
+
+int procedure ecf_nearest (gp, gt, wx, wy, wcs, key, x, y, w, npts)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+real	wx, wy			# Cursor coordinates
+int	wcs			# WCS
+int	key			# Nearest key
+real	x[npts]			# Data points
+real	y[npts]			# Data points
+double	w[npts]			# Weight
+int	npts			# Number of data points
+
+int	i, j
+real	r2, r2min, x0, y0, xsize, ysize, gt_getr()
+
+begin
+	call gctran (gp, wx, wy, wx, wy, wcs, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	switch (key) {
+	case 'c':
+	    do i = 1, npts {
+	        call gctran (gp, x[i], y[i], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	    call gscur (gp, x[j], y[j])
+	case 'd':
+	    do i = 1, npts {
+		if (w[i] == 0.)
+		    next
+	        call gctran (gp, x[i], y[i], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	    if (j > 0) {
+		xsize = gt_getr (gt, GTXSIZE)
+		ysize = gt_getr (gt, GTYSIZE)
+
+		call gseti (gp, G_PMLTYPE, 0)
+		call gmark (gp, x[j], y[j], GM_PLUS, xsize, ysize)
+		call gseti (gp, G_PMLTYPE, 1)
+		call gmark (gp, x[j], y[j], GM_CROSS, xsize, ysize)
+		w[j] = 0.
+	        call gscur (gp, x[j], y[j])
+	    }
+	case 'u':
+	    do i = 1, npts {
+		if (w[i] != 0.)
+		    next
+	        call gctran (gp, x[i], y[i], x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+	    if (j > 0) {
+		xsize = gt_getr (gt, GTXSIZE)
+		ysize = gt_getr (gt, GTYSIZE)
+
+		call gseti (gp, G_PMLTYPE, 0)
+		call gmark (gp, x[j], y[j], GM_CROSS, xsize, ysize)
+		call gseti (gp, G_PMLTYPE, 1)
+		call gmark (gp, x[j], y[j], GM_PLUS, xsize, ysize)
+		w[j] = 1.
+	        call gscur (gp, x[j], y[j])
+	    }
+	}
+
+	return (j)
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfreject.x b/noao/onedspec/ecidentify/ecffit/ecfreject.x
new file mode 100644
index 00000000..a772069e
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfreject.x
@@ -0,0 +1,53 @@
+include	<mach.h>
+
+# ECF_REJECT -- Reject points with large residuals from the fit.
+
+procedure ecf_reject (ecf, x, y, z, w, r, npts, fixedorder)
+
+pointer	ecf			# GSURFIT pointer
+double	x[npts]			# X points
+double	y[npts]			# Y points
+double	z[npts]			# Z points
+double	w[npts]			# Weights
+double	r[npts]			# Residuals
+int	npts			# Number of points
+int	fixedorder		# Fixed order?
+
+int	i, j, newreject
+double	low_cut, high_cut
+include	"ecffit.com"
+
+begin
+	# Return if rejection is not desired.
+	nreject = 0
+	if (niterate == 0 || (low == 0. && high == 0.))
+	    return
+
+	# Reject points.
+	do i = 1, niterate {
+	    if (low > 0.)
+		low_cut = -low * rms
+	    else
+		low_cut = -MAX_REAL
+	    if (high > 0.)
+		high_cut = high * rms
+	    else
+		high_cut = MAX_REAL
+
+	    newreject = 0
+	    do j = 1, npts {
+		if (w[j] == 0.)
+		    next
+		if ((r[j] > high_cut) || (r[j] < low_cut)) {
+		    w[j] = 0.
+		    newreject = newreject + 1
+		}
+	    }
+
+	    if (newreject == 0)
+		break
+
+	    call ecf_solve (ecf, x, y, z, w, r, npts, fixedorder)
+	    nreject = nreject + newreject
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfrms.x b/noao/onedspec/ecidentify/ecffit/ecfrms.x
new file mode 100644
index 00000000..1140dc29
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfrms.x
@@ -0,0 +1,26 @@
+# ECF_RMS -- Compute the rms with deleted points ignored.
+
+double procedure ecf_rms (r, w, npts)
+
+double	r[npts]			# Residuals
+double	w[npts]			# Weights
+int	npts			# Number of points
+
+int	i, n
+double	rms
+
+begin
+	n = 0
+	rms = 0.
+	do i = 1, npts {
+	    if (w[i] == 0.)
+		next
+	    n = n + 1
+	    rms = rms + r[i] * r[i]
+	}
+	if (n > 0)
+	    rms = sqrt (rms / n)
+	else
+	    rms = INDEFD
+	return (rms)
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfset.x b/noao/onedspec/ecidentify/ecffit/ecfset.x
new file mode 100644
index 00000000..4b6402b1
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfset.x
@@ -0,0 +1,92 @@
+# ECF_SETS -- Set the values of string valued fitting parameters.
+
+procedure ecf_sets (param, str)
+
+char	param[ARB]		# Parameter to be set
+char	str[ARB]		# String value
+
+char	temp[10]
+int	i, strdic()
+include	"ecffit.com"
+
+begin
+	i = strdic (param, temp, 10, "|function|")
+	switch (i) {
+	case 1:
+	    i = strdic (str, str, SZ_FNAME, "|chebyshev|legendre|")
+	    if (i == 0)
+		call error (0, "Unknown function type")
+	    call strcpy (str, function, SZ_LINE)
+	    gstype = i
+	default:
+	    call error (0, "ecf_sets: Unknown parameter")
+	}
+end
+
+
+# ECF_SETI -- Set the values of integer valued fitting parameters.
+
+procedure ecf_seti (param, ival)
+
+char	param[ARB]		# Parameter to be set
+int	ival			# Integer value
+
+int	i, strdic()
+include	"ecffit.com"
+
+begin
+	i = strdic (param, ecfstr, SZ_LINE,
+	    "|slope|offset|xorder|yorder|xtype|ytype|niterate|")
+	switch (i) {
+	case 1:
+	    slope = ival
+	case 2:
+	    offset = ival
+	case 3:
+	    xorder = ival
+	case 4:
+	    yorder = ival
+	case 5:
+	    xtype = ival
+	case 6:
+	    ytype = ival
+	case 7:
+	    niterate = max (0, ival)
+	default:
+	    call error (0, "ecf_seti: Unknown parameter")
+	}
+end
+
+
+# ECF_SETD -- Set the values of double valued fitting parameters.
+
+procedure ecf_setd (param, dval)
+
+char	param[ARB]		# Parameter to be set
+double	dval			# Double value
+
+int	i, strdic()
+include	"ecffit.com"
+
+begin
+	i = strdic (param, ecfstr, SZ_LINE,
+	    "|xmin|xmax|ymin|ymax|shift|low|high|")
+	switch (i) {
+	case 1:
+	    xmin = dval
+	case 2:
+	    xmax = dval
+	case 3:
+	    ymin = dval
+	case 4:
+	    ymax = dval
+	case 5:
+	    shift = dval
+	case 6:
+	    low = max (0.D0, dval)
+	case 7:
+	    high = max (0.D0, dval)
+	default:
+	    call error (0, "ecf_setd: Unknown parameter")
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfshift.x b/noao/onedspec/ecidentify/ecffit/ecfshift.x
new file mode 100644
index 00000000..75655703
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfshift.x
@@ -0,0 +1,55 @@
+# ECF_GSHIFT -- Return the shift for the given order.
+
+double procedure ecf_gshift (ecf, order)
+
+pointer	ecf			# GSURFIT pointer
+int	order			# User order
+
+include	"ecffit.com"
+
+begin
+	return (shift / (slope * order + offset))
+end
+
+
+# ECF_PSHIFT -- Put the shift for the given order.
+
+procedure ecf_pshift (ecf, order, shft)
+
+pointer	ecf			# GSURFIT pointer
+int	order			# User order
+double	shft			# Shift at given order
+
+include	"ecffit.com"
+
+begin
+	shift = shft * (slope * order + offset)
+end
+
+
+procedure ecf_vector (ecf, order, x, fit, npts)
+
+pointer	ecf			# GSURFIT pointer
+int	order			# Order
+double	x[npts]			# X points
+double	fit[npts]		# Fitted points
+int	npts			# Number of points
+
+double	yval
+pointer	sp, y
+
+include	"ecffit.com"
+
+begin
+	call smark (sp)
+	call salloc (y, npts, TY_DOUBLE)
+
+	yval = slope * order + offset
+	call amovkd (yval, Memd[y], npts)
+	call dgsvector (ecf, x, Memd[y], fit, npts)
+	call adivkd (fit, yval, fit, npts)
+	if (shift != 0.)
+	    call aaddkd (fit, shift / yval, fit, npts)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecfsolve.x b/noao/onedspec/ecidentify/ecffit/ecfsolve.x
new file mode 100644
index 00000000..1c844e76
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecfsolve.x
@@ -0,0 +1,196 @@
+include	<mach.h>
+include	<math/gsurfit.h>
+
+define	ECFTYPES	"|chebyshev|legendre|"		# Fit types
+
+
+# ECF_SOLVE -- Fit
+#
+#	f(x, slope*y+offset) = (y+slope*offset)*z
+#
+# with offset minimizing the RMS.
+
+procedure ecf_solve (ecf, x, y, z, w, r, npts, fixedorder)
+
+pointer	ecf			# GSURFIT pointer
+double	x[npts]			# X points
+double	y[npts]			# Y points
+double	z[npts]			# Z points
+double	w[npts]			# Weights
+double	r[npts]			# Residuals
+int	npts			# Number of points
+int	fixedorder		# Fixed order?
+
+int	i, j, k, err
+double	ya, yb, newrms, ecf_rms()
+pointer	sp, y1, ecf1
+errchk	ecf_solve1
+include	"ecffit.com"
+define	fit_	99
+
+begin
+	if (fixedorder == YES) {
+	    call ecf_solve1 (ecf, x, y, z, w, r, npts)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (y1, npts, TY_DOUBLE)
+
+	# Determine if the orders are reversed.
+	j = 1
+	k = 1
+	do i = 1, npts {
+	    if (z[i] < z[j])
+		j = i
+	    if (z[i] > z[k])
+		k = i
+	}
+	if (y[j] >= y[k]) {
+	    slope = 1
+	    offset = max (offset, int(1. - ymin))
+	} else {
+	    slope = -1
+	    offset = max (offset, int(1. + ymax))
+	}
+
+	call dgsfree (ecf)
+	shift = 0.
+
+	rms = MAX_DOUBLE
+	j = 1
+	k = 0
+
+	for (i=offset;;i=i+j) {
+	    if (slope == 1) {
+		ya = i + ymin
+		yb = i + ymax
+	    } else {
+		ya = i - ymax
+		yb = i - ymin
+	    }
+	    if (ya < 1.)
+		break
+
+	    call altmd (y, Memd[y1], npts, double(slope), double(i))
+	    call amuld (Memd[y1], z, r, npts)
+
+fit_	    call dgsinit (ecf1, gstype, xorder, yorder, YES, xmin, xmax, ya, yb)
+	    call dgsfit (ecf1, x, Memd[y1], r, w, npts, WTS_USER, err)
+
+	    if (err != OK) {
+	        if (xorder > 2 || yorder > 2) {
+	            call dgsfree (ecf)
+	            xorder = max (2, xorder - 1)
+	            yorder = max (2, yorder - 1)
+	            goto fit_
+	        }
+
+	        switch (err) {
+	        case SINGULAR:
+		    call dgsfree (ecf)
+		    ecf = ecf1
+	            call eprintf ("Singular solution\n")
+	        case NO_DEG_FREEDOM:
+	            call sfree (sp)
+	            call error (0, "No degrees of freedom")
+	        }
+	    }
+
+	    call dgsvector (ecf1, x, Memd[y1], r, npts)
+	    call adivd (r, Memd[y1], r, npts)
+	    call asubd (z, r, r, npts)
+
+	    newrms = ecf_rms (r, w, npts)
+	    k = k + 1
+
+	    if (newrms / rms < 0.999) {
+	        call dgsfree (ecf)
+	        ecf = ecf1
+		offset = i
+		rms = newrms
+	    } else {
+	        call dgsfree (ecf1)
+		if (k > 2)
+		    break
+		i = offset
+		j = -j
+	    }
+	}
+
+	call altmd (y, Memd[y1], npts, double(slope), double(offset))
+	call dgsvector (ecf, x, Memd[y1], r, npts)
+	call adivd (r, Memd[y1], r, npts)
+	call asubd (z, r, r, npts)
+
+	call sfree (sp)
+
+end
+
+
+# ECF_SOLVE1 -- Fit f(x, y+offset) = (y+offset)*z with offset fixed.
+
+procedure ecf_solve1 (ecf, x, y, z, w, r, npts)
+
+pointer	ecf			# GSURFIT pointer
+double	x[npts]			# X points
+double	y[npts]			# Y points
+double	z[npts]			# Z points
+double	w[npts]			# Weights
+double	r[npts]			# Residuals
+int	npts			# Number of points
+
+int	err
+pointer	sp, y1
+double	ya, yb, ecf_rms()
+include	"ecffit.com"
+define	fit_	99
+
+begin
+	call smark (sp)
+	call salloc (y1, npts, TY_DOUBLE)
+
+	call dgsfree (ecf)
+	shift = 0.
+
+	if (slope == 1) {
+	    offset = max (offset, int(1. - ymin))
+	    ya = offset + ymin
+	    yb = offset + ymax
+	} else {
+	    offset = max (offset, int(1. + ymax))
+	    ya = offset - ymax
+	    yb = offset - ymin
+	}
+
+	call altmd (y, Memd[y1], npts, double (slope), double (offset))
+	call amuld (Memd[y1], z, r, npts)
+
+fit_	call dgsinit (ecf, gstype, xorder, yorder, YES, xmin, xmax,
+	    min (ya, yb), max (ya, yb))
+	call dgsfit (ecf, x, Memd[y1], r, w, npts, WTS_USER, err)
+
+	if (err != OK) {
+	    if (xorder > 2 || yorder > 2) {
+	        call dgsfree (ecf)
+	        xorder = max (2, xorder - 1)
+	        yorder = max (2, yorder - 1)
+	        goto fit_
+	    }
+
+	    switch (err) {
+	    case SINGULAR:
+	        call eprintf ("Singular solution\n")
+	    case NO_DEG_FREEDOM:
+	        call sfree (sp)
+	        call error (0, "No degrees of freedom")
+	    }
+	}
+
+	call dgsvector (ecf, x, Memd[y1], r, npts)
+	call adivd (r, Memd[y1], r, npts)
+	call asubd (z, r, r, npts)
+	rms = ecf_rms (r, w, npts)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecffit/ecftitle.x b/noao/onedspec/ecidentify/ecffit/ecftitle.x
new file mode 100644
index 00000000..3b754f31
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/ecftitle.x
@@ -0,0 +1,48 @@
+include	<pkg/gtools.h>
+
+# ECF_TITLE -- Set the GTOOLS parameter string.
+
+procedure ecf_title (gt)
+
+pointer	gt		# GTOOLS pointer
+
+include	"ecffit.com"
+
+begin
+	call sprintf (ecfstr, SZ_LINE,
+	    "Function=%s, xorder=%d, yorder=%d, slope=%d, offset=%d, rms=%6g")
+	    call pargstr (function)
+	    call pargi (xorder)
+	    call pargi (yorder)
+	    call pargi (slope)
+	    call pargi (offset)
+	    call pargd (rms)
+	call gt_sets (gt, GTPARAMS, ecfstr)
+	call gt_sets (gt, GTTITLE, "Echelle Dispersion Function Fitting")
+
+	switch (xtype) {
+	case 'p':
+	    call gt_sets (gt, GTXLABEL, "Pixel")
+	case 'o':
+	    call gt_sets (gt, GTXLABEL, "Order")
+	case 'w':
+	    call gt_sets (gt, GTXLABEL, "Wavelength")
+	case 'r':
+	    call gt_sets (gt, GTXLABEL, "Residual")
+	case 'v':
+	    call gt_sets (gt, GTXLABEL, "Velocity")
+	}
+
+	switch (ytype) {
+	case 'p':
+	    call gt_sets (gt, GTYLABEL, "Pixel")
+	case 'o':
+	    call gt_sets (gt, GTYLABEL, "Order")
+	case 'w':
+	    call gt_sets (gt, GTYLABEL, "Wavelength")
+	case 'r':
+	    call gt_sets (gt, GTYLABEL, "Residual")
+	case 'v':
+	    call gt_sets (gt, GTYLABEL, "Velocity")
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecffit/mkpkg b/noao/onedspec/ecidentify/ecffit/mkpkg
new file mode 100644
index 00000000..40324cb8
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecffit/mkpkg
@@ -0,0 +1,21 @@
+# Echelle Dispersion Fitting Package
+
+$checkout libpkg.a ../../
+$update	  libpkg.a
+$checkin  libpkg.a ../../
+$exit
+
+libpkg.a:
+	ecfcolon.x	ecffit.com <error.h> <gset.h>
+	ecfeval.x	ecffit.com
+	ecffit.x	ecffit.com <error.h> <pkg/gtools.h>
+	ecfgdata.x	ecffit.com <pkg/gtools.h>
+	ecfget.x	ecffit.com
+	ecfgraph.x	<gset.h> <mach.h> <pkg/gtools.h>
+	ecfnearest.x	<gset.h> <mach.h> <pkg/gtools.h>
+	ecfreject.x	ecffit.com <mach.h>
+	ecfrms.x	
+	ecfset.x	ecffit.com
+	ecfsolve.x	ecffit.com <mach.h> <math/gsurfit.h>
+	ecftitle.x	ecffit.com <pkg/gtools.h>
+	;
diff --git a/noao/onedspec/ecidentify/ecfitdata.x b/noao/onedspec/ecidentify/ecfitdata.x
new file mode 100644
index 00000000..998f5057
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecfitdata.x
@@ -0,0 +1,146 @@
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	"ecidentify.h"
+
+# EC_FITDATA -- Compute fit coordinates from pixel coordinates.
+
+procedure ec_fitdata (ec)
+
+pointer	ec				# ID pointer
+
+int	i, ecf_oeval()
+
+begin
+	call mfree (EC_FITDATA(ec), TY_DOUBLE)
+	call malloc (EC_FITDATA(ec), EC_NCOLS(ec)*EC_NLINES(ec), TY_DOUBLE)
+
+	do i = 1, EC_NLINES(ec) {
+	    call ec_gline (ec, i)
+	    if (EC_ECF(ec) == NULL) {
+		if (DC(EC_SH(ec)) != DCNO && EC_UN(ec) != NULL)
+		    iferr (call shdr_units (EC_SH(ec), UN_UNITS(EC_UN(ec))))
+			;
+	        call achtrd (Memr[SX(EC_SH(ec))],  FITDATA(ec,1), EC_NPTS(ec))
+	        call gt_sets (EC_GT(ec), GTXLABEL, LABEL(EC_SH(ec)))
+	        call gt_sets (EC_GT(ec), GTXUNITS, UNITS(EC_SH(ec)))
+	    } else {
+		ORDERS(ec,i) = ecf_oeval (EC_ECF(ec), APS(ec,i))
+	        call ecf_vector (EC_ECF(ec), APS(ec,i), PIXDATA(ec,1),
+		    FITDATA(ec,1), EC_NPTS(ec))
+	       if (EC_UN(ec) == NULL) {
+		   call gt_sets (EC_GT(ec), GTXLABEL, LABEL(EC_SH(ec)))
+		   call gt_sets (EC_GT(ec), GTXUNITS, UNITS(EC_SH(ec)))
+		} else {
+		   call gt_sets (EC_GT(ec), GTXLABEL, UN_LABEL(EC_UN(ec)))
+		   call gt_sets (EC_GT(ec), GTXUNITS, UN_UNITS(EC_UN(ec)))
+		}
+	    }
+	}
+
+	call ec_gline (ec, EC_LINE(ec))
+	EC_ORDER(ec) = ORDERS(ec,EC_LINE(ec))
+end
+
+
+# EC_FITFEATURES -- Compute fit coordinates for features.
+
+procedure ec_fitfeatures (ec)
+
+pointer	ec				# ID pointer
+
+int	i, ec_line()
+double	ec_fitpt()
+
+begin
+	if (EC_NFEATURES(ec) < 1)
+	    return
+
+	do i = 1, EC_NFEATURES(ec) {
+	    LINE(ec,i) = ec_line (ec, APN(ec,i))
+	    ORDER(ec,i) = ORDERS(ec,LINE(ec,i))
+	    FIT(ec,i) = ec_fitpt (ec, APN(ec,i), PIX(ec,i))
+	}
+end
+
+
+# EC_FITPT -- Compute fit coordinates from pixel coordinates.
+
+double procedure ec_fitpt (ec, order, pix)
+
+pointer	ec			# ID pointer
+int	order			# Order
+double	pix			# Pixel coordinate
+
+double	fit, ecf_eval(), smw_c1trand(), shdr_lw()
+
+begin
+	if (EC_ECF(ec) == NULL) {
+	    fit = smw_c1trand (EC_PL(ec), pix)
+	    fit = shdr_lw (EC_SH(ec), fit)
+	} else
+	    fit = ecf_eval (EC_ECF(ec), order, pix)
+
+	return (fit)
+end
+
+
+# EC_FITTOPIX -- Transform fit coordinate to pixel coordinate.
+
+define	DXMIN	.01
+
+double procedure ec_fittopix (ec, fitcoord)
+
+pointer	ec				# ID pointer
+double	fitcoord		# Fit coordinate to be transformed
+double	pixcoord		# Pixel coordinate returned
+
+int	i, n
+double	dx
+
+double	ec_fitpt(), smw_c1trand()
+
+begin
+	n = EC_NPTS(ec)
+	if (FITDATA(ec,1) < FITDATA(ec,n)) {
+	    if ((fitcoord<FITDATA(ec,1)) || (fitcoord>FITDATA(ec,n)))
+	        return (INDEFD)
+
+	    for (i = 1; fitcoord > FITDATA(ec,i); i = i + 1)
+	        ;
+
+	    if (FITDATA(ec,i) == fitcoord)
+	        return (double (i))
+
+	    pixcoord = smw_c1trand (EC_LP(ec), double(i-.5))
+	    dx = smw_c1trand (EC_LP(ec), double(i+.5)) - pixcoord
+	    while (dx > DXMIN) {
+	        dx = dx / 2
+	        if (ec_fitpt (ec, EC_AP(ec), pixcoord) < fitcoord)
+		    pixcoord = pixcoord + dx
+	        else
+		    pixcoord = pixcoord - dx
+	    }
+	} else {
+	    if ((fitcoord<FITDATA(ec,n)) || (fitcoord>FITDATA(ec,1)))
+	        return (INDEFD)
+
+	    for (i = 1; fitcoord < FITDATA(ec,i); i = i + 1)
+	        ;
+
+	    if (FITDATA(ec,i) == fitcoord)
+	        return (double (i))
+
+	    pixcoord = smw_c1trand (EC_LP(ec), double(i-.5))
+	    dx = smw_c1trand (EC_LP(ec), double(i+.5)) - pixcoord
+	    while (dx > DXMIN) {
+	        dx = dx / 2
+	        if (ec_fitpt (ec, EC_AP(ec), pixcoord) < fitcoord)
+		    pixcoord = pixcoord - dx
+	        else
+		    pixcoord = pixcoord + dx
+	    }
+	}
+
+	return (pixcoord)
+end
diff --git a/noao/onedspec/ecidentify/ecgdata.x b/noao/onedspec/ecidentify/ecgdata.x
new file mode 100644
index 00000000..1087d38c
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecgdata.x
@@ -0,0 +1,74 @@
+include	<imhdr.h>
+include	<imio.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	"ecidentify.h"
+
+# EC_GDATA -- Get image data.
+
+procedure ec_gdata (ec)
+
+pointer	ec				# ID pointer
+
+int	i, j
+pointer	im, mw, sh, sp, str1, str2
+
+double	smw_c1trand()
+pointer	immap(), smw_openim(), smw_sctran()
+errchk	immap, smw_openim, shdr_open
+
+begin
+	# Map the image.
+	im = immap (Memc[EC_IMAGE(ec)], READ_ONLY, 0)
+
+	# Free previous data
+	do i = 1, EC_NLINES(ec)
+	    call shdr_close (SH(ec,i))
+	call mfree (EC_SHS(ec), TY_POINTER)
+	call mfree (EC_PIXDATA(ec), TY_DOUBLE)
+
+	# Set MWCS
+	mw = smw_openim (im)
+	EC_LP(ec) = smw_sctran (mw, "logical", "physical", 1)
+	EC_PL(ec) = smw_sctran (mw, "physical", "logical", 1)
+
+	# Allocate new vectors.
+	EC_NCOLS(ec) = IM_LEN(im, 1)
+	EC_NLINES(ec) = IM_LEN(im, 2)
+	call calloc (EC_SHS(ec), EC_NLINES(ec), TY_POINTER)
+	call malloc (EC_PIXDATA(ec), EC_NCOLS(ec)*EC_NLINES(ec), TY_DOUBLE)
+
+	# Set the coordinates.
+	sh = NULL
+	do j = 1, EC_NLINES(ec) {
+	    call shdr_open (im, mw, j, 1, INDEFI, SHDATA, sh)
+	    if (EC_UN(ec) != NULL)
+		iferr (call shdr_units (sh, UN_UNITS(EC_UN(ec))))
+		    ;
+	    if (j != EC_NLINES(ec))
+		call shdr_copy (sh, SH(ec,j), NO)
+	    else
+		SH(ec,j) = sh
+	    call ec_gline (ec, j)
+	    do i = 1, EC_NPTS(ec)
+	        PIXDATA(ec,i) = smw_c1trand (EC_LP(ec), double(i))
+	}
+	EC_LINE(ec) = 1
+	call ec_gline (ec, EC_LINE(ec))
+	EC_AP(ec) = APS(ec,EC_LINE(ec))
+	EC_ORDER(ec) = ORDERS(ec,EC_LINE(ec))
+
+	# Set graph title.
+	call smark (sp)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[str1], SZ_LINE, "ecidentify %s: %s")
+	    call pargstr (Memc[EC_IMAGE(ec)])
+	    call pargstr (IM_TITLE(im))
+	call gt_sets (EC_GT(ec), GTTITLE, Memc[str1])
+
+	call imunmap (im)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecgetim.x b/noao/onedspec/ecidentify/ecgetim.x
new file mode 100644
index 00000000..cbcb244e
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecgetim.x
@@ -0,0 +1,17 @@
+# EC_GETIM -- Get next image name with standard image extensions removed.
+
+int procedure ec_getim (list, image, maxchar)
+
+int	list		# Image list
+char	image[maxchar]	# Image name
+int	maxchar		# Maximum number of chars in image name
+
+int	stat, imtgetim()
+
+begin
+	stat = imtgetim (list, image, maxchar)
+	if (stat != EOF)
+	    call xt_imroot (image, image, maxchar)
+
+  	return (stat)
+end
diff --git a/noao/onedspec/ecidentify/ecgline.x b/noao/onedspec/ecidentify/ecgline.x
new file mode 100644
index 00000000..7d3f9e16
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecgline.x
@@ -0,0 +1,20 @@
+include	<smw.h>
+include	"ecidentify.h"
+
+# EC_GLINE -- Get line of data.
+
+procedure ec_gline (ec, line)
+
+pointer	ec		# EC pointer
+int	line		# Image line
+
+begin
+	if (IS_INDEFI(line))
+	    return
+
+	EC_SH(ec) = SH(ec,line)
+	EC_NPTS(ec) = SN(EC_SH(ec))
+	EC_IMLINE(ec) = SY(EC_SH(ec))
+	EC_PIXLINE(ec) = EC_PIXDATA(ec) + (line - 1) * EC_NCOLS(ec)
+	EC_FITLINE(ec) = EC_FITDATA(ec) + (line - 1) * EC_NCOLS(ec)
+end
diff --git a/noao/onedspec/ecidentify/ecgraph.x b/noao/onedspec/ecidentify/ecgraph.x
new file mode 100644
index 00000000..9eaeaa5f
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecgraph.x
@@ -0,0 +1,155 @@
+include	<gset.h>
+include	<pkg/gtools.h>
+include	"ecidentify.h"
+
+# EC_GRAPH -- Graph image vector in which features are to be ecentified.
+
+procedure ec_graph (ec, gtype)
+
+pointer	ec		# ID pointer
+int	gtype		# Graph type
+
+begin
+	switch (gtype) {
+	case 1:
+	    if (IS_INDEFI (EC_AP(ec)))
+		call ec_graph3(ec)
+	    else
+	        call ec_graph1 (ec)
+	case 2:
+	    call ec_graph2 (ec)
+	default:
+	    call ec_graph1 (ec)
+	}
+end
+
+
+procedure ec_graph1 (ec)
+
+pointer	ec				# ID pointer
+
+int	i
+real	xmin, xmax, ymin, ymax, dy
+pointer	sp, str, x, y
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, EC_NPTS(ec), TY_REAL)
+	y = EC_IMLINE(ec)
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "Aperture %d, Image line %d, Order %d")
+	    call pargi (EC_AP(ec))
+	    call pargi (EC_LINE(ec))
+	    call pargi (EC_ORDER(ec))
+	call gt_sets (EC_GT(ec), GTPARAMS, Memc[str])
+	call achtdr (FITDATA(ec,1), Memr[x], EC_NPTS(ec))
+
+	call gclear (EC_GP(ec))
+	xmin = min (Memr[x], Memr[x+EC_NPTS(ec)-1])
+	xmax = max (Memr[x], Memr[x+EC_NPTS(ec)-1])
+	call alimr (Memr[y], EC_NPTS(ec), ymin, ymax)
+	dy = ymax - ymin
+	call gswind (EC_GP(ec), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy)
+	call gt_swind (EC_GP(ec), EC_GT(ec))
+	call gt_labax (EC_GP(ec), EC_GT(ec))
+	call gt_plot (EC_GP(ec), EC_GT(ec), Memr[x], Memr[y], EC_NPTS(ec))
+
+	do i = 1, EC_NFEATURES(ec)
+	    if (APN(ec,i) == EC_AP(ec))
+	        call ec_mark (ec, i)
+
+	call sfree (sp)
+end
+
+
+# EC_GRAPH2 -- Make review graph for current feature.
+
+procedure ec_graph2 (ec)
+
+pointer	ec				# ID pointer
+
+int	i, j, k
+real	xmin, xmax, ymin, ymax, dy
+pointer	sp, str, x, y
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, EC_NPTS(ec), TY_REAL)
+	y = EC_IMLINE(ec)
+
+	call sprintf (Memc[str], SZ_LINE, "Order %d")
+	    call pargi (EC_AP(ec))
+	call gt_sets (EC_GT(ec), GTPARAMS, Memc[str])
+	call achtdr (FITDATA(ec,1), Memr[x], EC_NPTS(ec))
+
+	xmin = real (FIT(ec,EC_CURRENT(ec))) - EC_ZWIDTH(ec) / 2.
+	xmax = real (FIT(ec,EC_CURRENT(ec))) + EC_ZWIDTH(ec) / 2.
+
+	i = 0
+	do k = 1, EC_NPTS(ec) {
+	    if ((Memr[x+k-1] < xmin) || (Memr[x+k-1] > xmax))
+		next
+	    if (i == 0)
+		i = k
+	    j = k
+	}
+	k = j - i + 1
+
+	call alimr (Memr[y+i-1], k, ymin, ymax)
+	dy = ymax - ymin
+
+	call gclear (EC_GP(ec))
+	call gswind (EC_GP(ec), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy)
+	call gt_labax (EC_GP(ec), EC_GT(ec))
+	call gt_plot (EC_GP(ec), EC_GT(ec), Memr[x], Memr[y], EC_NPTS(ec))
+
+	do i = 1, EC_NFEATURES(ec)
+	    if (APN(ec,i) == EC_AP(ec))
+	        call ec_mark (ec, i)
+
+	call sfree (sp)
+end
+
+
+procedure ec_graph3 (ec)
+
+pointer	ec				# ID pointer
+
+int	i, npts
+real	xmin, xmax, ymin, ymax, dy
+pointer	sp, str, x, y
+
+begin
+	npts = EC_NPTS(ec) * EC_NLINES(ec)
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, npts, TY_REAL)
+	y = EC_IMLINE(ec)
+
+	call sprintf (Memc[str], SZ_LINE, "All orders")
+	call gt_sets (EC_GT(ec), GTPARAMS, Memc[str])
+	call achtdr (Memd[EC_FITDATA(ec)], Memr[x], npts)
+
+	call gclear (EC_GP(ec))
+	xmin = min (Memr[x], Memr[x+npts-1])
+	xmax = max (Memr[x], Memr[x+npts-1])
+	call alimr (Memr[y], npts, ymin, ymax)
+	dy = ymax - ymin
+	call gswind (EC_GP(ec), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy)
+	call gt_swind (EC_GP(ec), EC_GT(ec))
+	call gt_labax (EC_GP(ec), EC_GT(ec))
+	do i = 1, EC_NLINES(ec) {
+	    call gt_plot (EC_GP(ec), EC_GT(ec), Memr[x], Memr[y], EC_NPTS(ec))
+	    x = x + EC_NPTS(ec)
+	    y = y + EC_NPTS(ec)
+	}
+
+	do i = 1, EC_NFEATURES(ec)
+	    call ec_mark (ec, i)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/ecidentify.h b/noao/onedspec/ecidentify/ecidentify.h
new file mode 100644
index 00000000..63e4c6bd
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecidentify.h
@@ -0,0 +1,94 @@
+# Task parameters
+
+define	LEN_EC		52		# Length ID structure
+
+define	EC_IMAGE	Memi[$1]	# Image name (pointer)
+define	EC_MAXFEATURES	Memi[$1+1]	# Maximum number of features
+define	EC_FTYPE	Memi[$1+2]	# Feature type
+define	EC_MINSEP	Memr[P2R($1+3)]	# Minimum pixel separation
+define	EC_MATCH	Memr[P2R($1+4)]	# Maximum matching separation
+define	EC_FWIDTH	Memr[P2R($1+5)]	# Feature width in pixels
+define	EC_CRADIUS	Memr[P2R($1+6)]	# Centering radius in pixels
+define	EC_THRESHOLD	Memr[P2R($1+7)]	# Centering threshold
+define	EC_ZWIDTH	Memr[P2R($1+8)]	# Zoom window width in fit units
+define	EC_DATABASE	Memi[$1+9]	# Name of database (pointer)
+define	EC_COORDLIST	Memi[$1+10]	# Name of coordinate list (pointer)
+define	EC_LABELS	Memi[$1+11]	# Type of feature labels
+define	EC_LOGFILES	Memi[$1+12]	# List of logfiles
+
+# Common image data
+
+define	EC_NCOLS	Memi[$1+13]	# Number of columns
+define	EC_NLINES	Memi[$1+14]	# Number of lines/apertures/orders
+define	EC_SHS		Memi[$1+15]	# Pointer to SHDR pointers
+define	EC_PIXDATA	Memi[$1+16]	# Pixel coordinates (pointer)
+define	EC_FITDATA	Memi[$1+17]	# Fit coordinates (pointer)
+
+define	EC_IMLINE	Memi[$1+18]	# Image data (pointer)
+define	EC_PIXLINE	Memi[$1+19]	# Pixel coordinates (pointer)
+define	EC_FITLINE	Memi[$1+20]	# Fit coordinates (pointer)
+define	EC_NPTS		Memi[$1+21]	# Number of points
+
+define	EC_SHIFT	Memd[P2D($1+22)]# Wavelength shift
+
+# Features
+
+define	EC_NFEATURES	Memi[$1+24]	# Number of features
+define	EC_NALLOC	Memi[$1+25]	# Length of allocated feature arrays
+define	EC_APNUM	Memi[$1+26]	# Aperture number (pointer)
+define	EC_LINENUM	Memi[$1+27]	# Image line number (pointer)
+define	EC_ORD		Memi[$1+28]	# Feature order number (pointer)
+define	EC_PIX		Memi[$1+29]	# Feature pixel coordinates (pointer)
+define	EC_FIT		Memi[$1+30]	# Feature fit coordinates (pointer)
+define	EC_USER		Memi[$1+31]	# Feature user coordinates (pointer)
+define	EC_FWIDTHS	Memi[$1+32]	# Feature width (pointer)
+define	EC_FTYPES	Memi[$1+33]	# Feature type (pointer)
+
+# Current status
+
+define	EC_CURRENT	Memi[$1+34]	# Current feature
+define	EC_SH		Memi[$1+35]	# Current SHDR pointer
+define	EC_AP		Memi[$1+36]	# Current aperture
+define	EC_LINE		Memi[$1+37]	# Current line
+define	EC_ORDER	Memi[$1+38]	# Current order
+
+# Pointers for other packages
+
+define	EC_LP		Memi[$1+39]	# Logical to physical transformation
+define	EC_PL		Memi[$1+40]	# Physical to logical transformation
+define	EC_LL		Memi[$1+41]	# Linelist pointer
+define	EC_ECF		Memi[$1+42]	# Curfit pointer
+define	EC_GP		Memi[$1+43]	# GIO pointer
+define	EC_GT		Memi[$1+44]	# Gtools pointer
+define	EC_UN		Memi[$1+45]	# Units pointer
+
+# Flags
+
+define	EC_NEWFEATURES	Memi[$1+46]	# Has feature list changed?
+define	EC_NEWECF	Memi[$1+47]	# Has fitting function changed?
+define	EC_NEWGRAPH	Memi[$1+48]	# Has graph changed?
+define	EC_NEWDBENTRY	Memi[$1+49]	# Has database entry changed?
+define	EC_REFIT	Memi[$1+50]	# Refit feature data?
+define	EC_GTYPE	Memi[$1+51]	# Graph type
+
+# End of structure ----------------------------------------------------------
+
+define	LABELS	"|none|index|pixel|user|"
+define	FTYPES	"|emission|absorption|"
+
+define	IMDATA		Memr[EC_IMLINE($1)+$2-1]
+define	PIXDATA		Memd[EC_PIXLINE($1)+$2-1]
+define	FITDATA		Memd[EC_FITLINE($1)+$2-1]
+
+define	SH		Memi[EC_SHS($1)+$2-1]
+define	APS		AP(SH($1,$2))
+define	ORDERS		BEAM(SH($1,$2))
+
+define	APN		Memi[EC_APNUM($1)+$2-1]
+define	LINE		Memi[EC_LINENUM($1)+$2-1]
+define	ORDER		Memi[EC_ORD($1)+$2-1]
+define	PIX		Memd[EC_PIX($1)+$2-1]
+define	FIT		Memd[EC_FIT($1)+$2-1]
+define	USER		Memd[EC_USER($1)+$2-1]
+define	FWIDTH		Memr[EC_FWIDTHS($1)+$2-1]
+define	FTYPE		Memi[EC_FTYPES($1)+$2-1]
diff --git a/noao/onedspec/ecidentify/ecidentify.key b/noao/onedspec/ecidentify/ecidentify.key
new file mode 100644
index 00000000..c19698ef
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecidentify.key
@@ -0,0 +1,76 @@
+1. ECIDENTIFY CURSOR KEY SUMMARY
+
+?  Help                   a  Affect all features     c  Center feature(s)
+d  Delete feature(s)      f  Fit dispersion          g  Fit zero point shift
+i  Initialize             j  Go to previous order    k  Go to next order
+l  Match coordinate list  m  Mark feature            n  Next feature
+o  Go to specified order  p  Pan graph               q  Quit
+r  Redraw graph           s  Shift feature           t  Reset position
+u  Enter user coordinate  w  Window graph            x  Crosscorrelate peaks
+y  Find peaks             z  Zoom graph              .  Nearest feature
++  Next feature           -  Previous feature        I  Interrupt
+
+
+2. ECIDENTIFY COLON COMMAND SUMMARY
+
+:show [file]              :features [file]           :coordlist [file]
+:cradius [value]          :threshold [value]         :database [file]
+:ftype [type]             :fwidth [value]            :image [image]
+:labels [type]            :match [value]             :maxfeatures [value]
+:minsep [value]           :read [image]              :write [image]
+:zwidth [value]
+
+
+3. ECIDENTIFY CURSOR KEYS
+
+?  Clear the screen and print menu of options
+a  Apply next (c)enter or (d)elete operation to (a)ll features
+c  (C)enter the feature nearest the cursor
+d  (D)elete the  feature nearest the cursor
+f  (F)it a function of pixel coordinate to the user coordinates
+g  Fit a zero point shift to the user coordinates
+i  (I)nitialize (delete features and coordinate fit)
+j  Go to the previous order
+k  Go to the next order
+l  Match coordinates in the coordinate (l)ist to features in the data
+m  (M)ark a new feature near the cursor
+n  Move the cursor or zoom to the (n)ext feature (same as +)
+o  Go to the specified (o)rder
+p  (P)an to user defined window after (z)ooming on a feature
+q  (Q)uit and continue with next image (also carriage return)
+r  (R)edraw the graph
+s  (S)hift the current feature to the position of the cursor
+t  Reset (move) the position of a feature without centering
+u  Enter a new (u)ser coordinate for the current feature
+w  (W)indow the graph.  Use '?' to window prompt for more help.
+x  Crosscorrelate features with the data peaks and reregister
+y  Automatically find "maxfeatures" strongest peaks and identify them
+z  (Z)oom on the feature nearest the cursor
+.  Move the cursor or zoom to the feature nearest the cursor (also space bar)
++  Move the cursor or zoom to the next feature
+-  Move the cursor or zoom to the previous feature
+I  Interrupt task immediately.  Database information is not saved.
+
+
+4. ECIDENTIFY COLON COMMANDS
+
+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.
+
+:show file		Show the values of all the parameters
+:features file		Write feature list to file (default is STDOUT)
+
+:coordlist file		Coordinate list file
+:cradius value		Centering radius in pixels
+:threshold value	Detection threshold for feature centering
+:database name		Database for recording feature records
+:ftype value		Feature type (emission or absorption)
+:fwidth value		Feature width in pixels
+:image imagename 	Set a new image or show the current image
+:labels value		Feature label type (none, index, pixel, or user)
+:match value		Coordinate list matching distance
+:maxfeatures value	Maximum number of features automatically found
+:minsep value		Minimum separation allowed between features
+:read name		Read a record from the database (name defaults to image)
+:write name		Write a record to the database (name defaults to image)
+:zwidth value		Zoom width in user units
diff --git a/noao/onedspec/ecidentify/ecidentify.x b/noao/onedspec/ecidentify/ecidentify.x
new file mode 100644
index 00000000..827568d1
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecidentify.x
@@ -0,0 +1,535 @@
+include	<error.h>
+include	<imhdr.h>
+include	<gset.h>
+include	<smw.h>
+include	"ecidentify.h"
+
+define	HELP		"noao$onedspec/ecidentify/ecidentify.key"
+define	PROMPT		"ecidentify options"
+
+define	PAN		1	# Pan graph
+define	ZOOM		2	# Zoom graph
+
+# EC_IDENTIFY -- Identify echelle features in an image.
+# This is the basic interactive loop.
+
+procedure ec_identify (ec)
+
+pointer	ec			# EC pointer
+
+real	wx, wy
+int	wcs, key
+char	cmd[SZ_LINE]
+
+char	newimage[SZ_FNAME]
+int	i, j, last, all, prfeature, nfeatures1, npeaks
+bool	answer
+double	pix, fit, user, shift, pix_shift, z_shift
+pointer	peaks
+
+bool	clgetb()
+int	clgcur(), scan(), nscan(), find_peaks(), ec_next(), ec_previous()
+int	ec_line()
+double	ec_center(), ec_fittopix(), ec_fitpt(), ec_shift(), ec_rms()
+double	ecf_getd()
+errchk	ec_gdata(), ec_graph(), ec_dbread(), xt_mk1d(), ec_line()
+
+define	newim_		10
+define	newkey_		20
+define	beep_		99
+
+begin
+newim_	# Start here for each new image.
+
+	# Get the image data.  Return if there is an error.
+	iferr (call ec_gdata (ec)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	# Look for a database entry for the image.
+	iferr {
+	    call ec_dbread (ec, Memc[EC_IMAGE(ec)], NO)
+	    EC_NEWDBENTRY(ec) = NO
+	} then
+	    if ((EC_NFEATURES(ec) > 0) || (EC_ECF(ec) != NULL))
+	        EC_NEWDBENTRY(ec) = YES
+
+	# Set the coordinate array and the feature data.
+	iferr (call ec_fitdata (ec))
+	    call erract (EA_WARN)
+	call ec_fitfeatures (ec)
+
+	# Begin with the first image line.
+	EC_LINE(ec) = 1
+	EC_AP(ec) = APS(ec,EC_LINE(ec))
+	EC_ORDER(ec) = ORDERS(ec,EC_LINE(ec))
+	call ec_gline (ec, EC_LINE(ec))
+
+	# Initialize.
+	EC_GTYPE(ec) = PAN
+	EC_REFIT(ec) = NO
+	EC_NEWFEATURES(ec) = NO
+	EC_NEWECF(ec) = NO
+	EC_CURRENT(ec) = 0
+	i = ec_next (ec, EC_CURRENT(ec))
+	last = EC_CURRENT(ec)
+	all = 0
+	newimage[1] = EOS
+	key = 'r'
+
+	repeat {
+	    prfeature = YES
+	    if (all != 0)
+		all = mod (all + 1, 3)
+
+	    switch (key) {
+	    case '?':	# Page help
+		call gpagefile (EC_GP(ec), HELP, PROMPT)
+	    case ':':	# Execute colon commands
+		if (cmd[1] == '/')
+		    call gt_colon (cmd, EC_GP(ec), EC_GT(ec), EC_NEWGRAPH(ec))
+		else
+		    call ec_colon (ec, cmd, newimage, prfeature)
+	    case ' ':	# Go to the current feature
+	    case '.':	# Go to the nearest feature
+		if (EC_NFEATURES(ec) == 0)
+		    goto beep_
+		call ec_nearest (ec, double (wx))
+	    case '-':	# Go to the previous feature
+		if (ec_previous (ec, EC_CURRENT(ec)) == EOF)
+		    goto beep_
+	    case '+', 'n':	# Go to the next feature
+		if (ec_next (ec, EC_CURRENT(ec)) == EOF)
+		    goto beep_
+	    case 'a':	# Set the all flag for the next key
+		all = 1
+	    case 'c':	# Center features on data
+		if (all != 0) {
+		    call eprintf ("Recentering features ...\n")
+		    for (i = 1; i <= EC_NFEATURES(ec); i = i + 1) {
+			call ec_gline (ec, LINE(ec,i))
+		        call gseti (EC_GP(ec), G_PLTYPE, 0)
+		        call ec_mark (ec, i)
+		        call gseti (EC_GP(ec), G_PLTYPE, 1)
+			FWIDTH(ec,i) = EC_FWIDTH(ec)
+		        PIX(ec,i) = ec_center (ec, PIX(ec,i), FWIDTH(ec,i),
+			    FTYPE(ec,i))
+		        if (!IS_INDEFD (PIX(ec,i))) {
+			    FIT(ec,i) = ec_fitpt (ec, APN(ec,i), PIX(ec,i))
+		            call ec_mark (ec, i)
+			} else {
+			    call ec_delete (ec, i)
+			    i = i - 1
+		        }
+		    }
+		    call ec_gline (ec, EC_LINE(ec))
+		    EC_NEWFEATURES(ec) = YES
+		} else {
+		    if (EC_NFEATURES(ec) == 0)
+		       goto beep_
+
+		    call ec_nearest (ec, double (wx))
+		    pix = PIX(ec,EC_CURRENT(ec))
+		    pix = ec_center (ec, pix, EC_FWIDTH(ec),
+			FTYPE(ec,EC_CURRENT(ec)))
+		    if (!IS_INDEFD (pix)) {
+		        call gseti (EC_GP(ec), G_PLTYPE, 0)
+		        call ec_mark (ec, EC_CURRENT(ec))
+			PIX(ec,EC_CURRENT(ec)) = pix
+		        FWIDTH(ec,EC_CURRENT(ec)) = EC_FWIDTH(ec)
+			FIT(ec,EC_CURRENT(ec)) =
+			    ec_fitpt (ec, APN(ec,EC_CURRENT(ec)), pix)
+		        call gseti (EC_GP(ec), G_PLTYPE, 1)
+			call ec_mark (ec, EC_CURRENT(ec))
+		        EC_NEWFEATURES(ec) = YES
+		    } else {
+			call eprintf ("Centering failed\n")
+			prfeature = NO
+		    }
+		}
+	    case 'd':	# Delete features
+		if (all != 0) {
+		    EC_NFEATURES(ec) = 0
+		    EC_CURRENT(ec) = 0
+		    EC_NEWFEATURES(ec) = YES
+		    EC_NEWGRAPH(ec) = YES
+		} else {
+		    if (EC_NFEATURES(ec) == 0)
+			goto beep_
+
+		    call ec_nearest (ec, double (wx))
+		    call gseti (EC_GP(ec), G_PLTYPE, 0)
+		    call ec_mark (ec, EC_CURRENT(ec))
+		    call gseti (EC_GP(ec), G_PLTYPE, 1)
+		    call ec_delete (ec, EC_CURRENT(ec))
+		    call ec_nearest (ec, double (wx))
+		    last = 0
+		}
+	    case 'f':	# Fit dispersion function
+		iferr (call ec_dofit (ec, YES, NO)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		    goto beep_
+		}
+	    case 'g':	# Fit shift
+		call ec_doshift (ec, YES)
+		prfeature = NO
+	    case 'i':	# Initialize
+	        call dgsfree (EC_ECF(ec))
+		call ecf_setd ("shift", 0.D0)
+	        EC_NEWECF(ec) = YES
+		EC_NFEATURES(ec) = 0
+		EC_CURRENT(ec) = 0
+		EC_NEWFEATURES(ec) = YES
+		EC_NEWGRAPH(ec) = YES
+	    case 'j':	# Go to the previous order
+		EC_LINE(ec) =
+		    mod (EC_LINE(ec)+EC_NLINES(ec)-2, EC_NLINES(ec)) + 1
+		EC_AP(ec) = APS(ec,EC_LINE(ec))
+		EC_ORDER(ec) = ORDERS(ec,EC_LINE(ec))
+		call ec_gline (ec, EC_LINE(ec))
+		EC_NEWGRAPH(ec) = YES
+		EC_CURRENT(ec) = 0
+		i = ec_next (ec, EC_CURRENT(ec))
+	    case 'k':	# Go to the next order
+		EC_LINE(ec) = mod (EC_LINE(ec), EC_NLINES(ec)) + 1
+		EC_AP(ec) = APS(ec,EC_LINE(ec))
+		EC_ORDER(ec) = ORDERS(ec,EC_LINE(ec))
+		call ec_gline (ec, EC_LINE(ec))
+		EC_NEWGRAPH(ec) = YES
+		EC_CURRENT(ec) = 0
+		i = ec_next (ec, EC_CURRENT(ec))
+	    case 'l':	# Find features using a line list
+		if (EC_ECF(ec) == NULL) {
+		    call eprintf ("Doing initial fit ...\n")
+		    iferr (call ec_dofit (ec, NO, NO)) {
+		        call erract (EA_WARN)
+		        prfeature = NO
+			goto beep_
+		    }
+		    if (EC_NEWECF(ec) == YES) {
+		        iferr (call ec_fitdata (ec)) {
+			    call erract (EA_WARN)
+			    prfeature = NO
+		        }
+		        call ec_fitfeatures (ec)
+		        EC_NEWECF(ec) = NO
+		    }
+		}
+
+		call eprintf ("Searching coordinate list ...\n")
+		call ec_linelist (ec)
+		EC_CURRENT(ec) = 0
+		i = ec_next (ec, EC_CURRENT(ec))
+		if (EC_NEWFEATURES(ec) == YES)
+		    EC_NEWGRAPH(ec) = YES
+	    case 'm':	# Mark a new feature
+		fit = wx
+		pix = ec_fittopix (ec, fit)
+		pix = ec_center (ec, pix, EC_FWIDTH(ec), EC_FTYPE(ec))
+		if (IS_INDEFD (pix))
+		    goto beep_
+		fit = ec_fitpt (ec, EC_AP(ec), pix)
+		user = fit
+		call ec_newfeature (ec, EC_AP(ec), pix, fit, user,
+		    EC_FWIDTH(ec), EC_FTYPE(ec))
+		USER(ec,EC_CURRENT(ec)) = INDEFD
+		call ec_match (ec, FIT(ec,EC_CURRENT(ec)),
+		    USER(ec,EC_CURRENT(ec)))
+		call ec_mark (ec, EC_CURRENT(ec))
+		call printf ("%3d %10.2f %10.8g (%10.8g): ")
+		    call pargi (APN(ec,EC_CURRENT(ec)))
+		    call pargd (PIX(ec,EC_CURRENT(ec)))
+		    call pargd (FIT(ec,EC_CURRENT(ec)))
+		    call pargd (USER(ec,EC_CURRENT(ec)))
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargd (user)
+		    if (nscan() == 1) {
+			USER(ec,EC_CURRENT(ec)) = user
+			call ec_match (ec, user, USER(ec,EC_CURRENT(ec)))
+		    }
+		}
+	    case 'o':	# Go to a specified order
+		call printf ("Aperture (%d): ")
+		    call pargi (EC_AP(ec))
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargi (j)
+		    if (nscan() == 1) {
+			if (j != EC_AP(ec)) {
+			    iferr {
+				i = ec_line (ec, j)
+				call ec_gline (ec, i)
+				EC_LINE(ec) = i
+				EC_AP(ec) = j
+				EC_ORDER(ec) = ORDERS(ec,i)
+				EC_NEWGRAPH(ec) = YES
+				EC_CURRENT(ec) = 0
+				i = ec_next (ec, EC_CURRENT(ec))
+			    } then
+				goto beep_
+			}
+		    }
+		}
+	    case 'p':	# Go to pan graph mode
+		if (EC_GTYPE(ec) == PAN)
+		    goto beep_
+
+		EC_GTYPE(ec) = PAN
+		EC_NEWGRAPH(ec) = YES
+	    case 'q':	# Quit
+		break
+	    case 'r':	# Redraw the current graph
+		EC_NEWGRAPH(ec) = YES
+	    case 's', 'x':	# Shift or cross correlate features
+		# Get coordinate shift.
+		switch (key) {
+		case 's':
+		    call printf ("User coordinate (%10.8g): ")
+		        call pargr (wx)
+		        call flush (STDOUT)
+		    if (scan() != EOF) {
+		        call gargd (user)
+		        if (nscan() == 1)
+			    shift = (wx - user) * EC_ORDER(ec)
+		    } else
+		        shift = 0.
+		case 'x':
+		    if (EC_NFEATURES(ec) > 5) {
+			call eprintf (
+			    "Cross correlating features with peaks ...\n")
+			shift = ec_shift (ec)
+		    } else
+			goto beep_
+		}
+
+		EC_NEWFEATURES(ec) = YES
+		EC_NEWECF(ec) = YES
+		EC_NEWGRAPH(ec) = YES
+		prfeature = NO
+
+		if (EC_NFEATURES(ec) < 1) {
+		    call printf ("User coordinate shift=%5f")
+			call pargd (shift / EC_ORDER(ec))
+		    call ecf_setd ("shift", ecf_getd ("shift") - shift)
+		    goto newkey_
+		}
+
+		# Recenter features.
+		call eprintf ("Recentering features ...\n")
+		pix_shift = 0.
+		z_shift = 0.
+		nfeatures1 = EC_NFEATURES(ec)
+
+		j = 0.
+		do i = 1, EC_NFEATURES(ec) {
+		    call ec_gline (ec, LINE(ec,i))
+		    pix = ec_fittopix (ec, FIT(ec,i) + shift/ORDER(ec,i))
+		    pix = ec_center (ec, pix, FWIDTH(ec,i), FTYPE(ec,i))
+		    if (IS_INDEFD (pix)) {
+			if (EC_CURRENT(ec) == i)
+			     EC_CURRENT(ec) = 0
+			next
+		    }
+		    fit = ec_fitpt (ec, APN(ec,i), pix)
+
+		    pix_shift = pix_shift + pix - PIX(ec,i)
+		    if (FIT(ec,i) != 0.)
+		        z_shift = z_shift + (fit - FIT(ec,i)) / FIT(ec,i)
+
+		    j = j + 1
+		    APN(ec,j) = APN(ec,i)
+		    LINE(ec,j) = LINE(ec,i)
+		    ORDER(ec,j) = ORDER(ec,i)
+		    PIX(ec,j) = pix
+		    FIT(ec,j) = FIT(ec,i)
+		    USER(ec,j) = USER(ec,i)
+		    FWIDTH(ec,j) = FWIDTH(ec,i)
+		    FTYPE(ec,j) = FTYPE(ec,i)
+		    if (EC_CURRENT(ec) == i)
+			EC_CURRENT(ec) = j
+		}
+		call ec_gline (ec, EC_LINE(ec))
+		EC_NFEATURES(ec) = j
+		if (EC_CURRENT(ec) == 0)
+		    i = ec_next (ec, EC_CURRENT(ec))
+
+		if (EC_NFEATURES(ec) < 1) {
+		    call printf ("User coordinate shift=%5f")
+			call pargd (shift / EC_ORDER(ec))
+		    call printf (", No features found during recentering")
+		    call ecf_setd ("shift", ecf_getd ("shift") - shift)
+		    goto newkey_
+		}
+
+		# Adjust shift.
+		pix = ecf_getd ("shift")
+		call ec_doshift (ec, NO)
+		call ec_fitfeatures (ec)
+
+		# Print results.
+		call printf ("Recentered=%d/%d")
+		    call pargi (EC_NFEATURES(ec))
+		    call pargi (nfeatures1)
+		call printf (
+		    ", pixel shift=%.2f, user shift=%5f, z=%7.3g, rms=%5g")
+		    call pargd (pix_shift / EC_NFEATURES(ec))
+		    call pargd ((pix - ecf_getd ("shift")) / EC_ORDER(ec))
+		    call pargd (z_shift / EC_NFEATURES(ec))
+		    call pargd (ec_rms(ec))
+	    case 't':	# Move current feature
+		if (EC_CURRENT(ec) == 0)
+		    goto beep_
+
+		call gseti (EC_GP(ec), G_PLTYPE, 0)
+		call ec_mark (ec, EC_CURRENT(ec))
+		pix = ec_fittopix (ec, double (wx))
+		PIX(ec,EC_CURRENT(ec)) = pix
+		FIT(ec,EC_CURRENT(ec)) =
+		    ec_fitpt (ec, APN(ec,EC_CURRENT(ec)), pix)
+		call gseti (EC_GP(ec), G_PLTYPE, 1)
+		call ec_mark (ec, EC_CURRENT(ec))
+		EC_NEWFEATURES(ec) = YES
+	    case 'u':	# Set uesr coordinate value
+		if (EC_NFEATURES(ec) == 0)
+		    goto beep_
+
+		call printf ("%3d %10.2f %10.8g (%10.8g): ")
+		    call pargi (APN(ec,EC_CURRENT(ec)))
+		    call pargd (PIX(ec,EC_CURRENT(ec)))
+		    call pargd (FIT(ec,EC_CURRENT(ec)))
+		    call pargd (USER(ec,EC_CURRENT(ec)))
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargd (user)
+		    if (nscan() == 1) {
+			USER(ec,EC_CURRENT(ec)) = user
+			EC_NEWFEATURES(ec) = YES
+		    }
+		}
+	    case 'w':	# Window graph
+		call gt_window (EC_GT(ec), EC_GP(ec), "cursor", EC_NEWGRAPH(ec))
+	    case 'y':	# Find peaks in order
+		call malloc (peaks, EC_NPTS(ec), TY_REAL)
+		npeaks = find_peaks (IMDATA(ec,1), Memr[peaks],
+		    EC_NPTS(ec), 0., int (EC_MINSEP(ec)), 0, EC_MAXFEATURES(ec),
+		    0., false)
+		for (j = 1; j <= EC_NFEATURES(ec); j = j + 1) {
+		    for (i = 1; i <= npeaks; i = i + 1) {
+			if (!IS_INDEF(pix)) {
+			    pix = Memr[peaks + i - 1]
+			    if (abs (pix - PIX(ec,j)) < EC_MINSEP(ec))
+			        Memr[peaks + i - 1] = INDEF
+			}
+		    }
+		}
+		for (i = 1; i <= npeaks; i = i + 1) {
+		    pix = Memr[peaks+i-1]
+		    pix = ec_center (ec, pix, EC_FWIDTH(ec), EC_FTYPE(ec))
+		    if (IS_INDEFD (pix))
+			next
+		    fit = ec_fitpt (ec, EC_AP(ec), pix)
+		    user = INDEFD
+		    call ec_match (ec, fit, user)
+		    call ec_newfeature (ec, EC_AP(ec), pix, fit, user,
+			EC_FWIDTH(ec), EC_FTYPE(ec))
+		    call ec_mark (ec, EC_CURRENT(ec))
+		}
+		call mfree (peaks, TY_REAL)
+	    case 'z':	# Go to zoom mode
+		if (EC_CURRENT(ec) == 0)
+		    goto beep_
+
+		if (EC_GTYPE(ec) == PAN)
+		    EC_NEWGRAPH(ec) = YES
+		EC_GTYPE(ec) = ZOOM
+		call ec_nearest (ec, double (wx))
+	    case 'I':	# Interrupt
+		call fatal (0, "Interrupt")
+	    default:	# Beep
+beep_		 call printf ("\007\n")
+	    }
+
+newkey_
+	    # Set database update flag if there has been a change.
+	    if ((EC_NEWFEATURES(ec) == YES) || (EC_NEWECF(ec) == YES))
+		EC_NEWDBENTRY(ec) = YES
+
+	    # Exit loop and then start new image.
+	    if (newimage[1] != EOS)
+		break
+
+	    # Refit the dispersion function if needed.
+	    if (EC_REFIT(ec) == YES) {
+		iferr (call ec_dofit (ec, NO, NO)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+		EC_REFIT(ec) = NO
+	    }
+
+	    # Recompute the coordinate information.
+	    if (EC_NEWECF(ec) == YES) {
+		iferr (call ec_fitdata (ec)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+		call ec_fitfeatures (ec)
+		EC_NEWECF(ec) = NO
+	    }
+
+	    # Redraw new feature in zoom mode.
+	    if ((EC_GTYPE(ec) == ZOOM) && (last != EC_CURRENT(ec)))
+		EC_NEWGRAPH(ec) = YES
+
+	    # Redraw graph.
+	    if (EC_NEWGRAPH(ec) == YES) {
+		call ec_graph (ec, EC_GTYPE(ec))
+	        EC_NEWGRAPH(ec) = NO
+	    }
+
+	    # Set cursor and print current feature on status (unless canceled).
+	    if (EC_CURRENT(ec) > 0) {
+		call gscur (EC_GP(ec), real (FIT(ec,EC_CURRENT(ec))), wy)
+		if (prfeature == YES) {
+	            call printf ("%d %10.2f %10.8g %10.8g\n")
+		        call pargi (APN(ec,EC_CURRENT(ec)))
+		        call pargd (PIX(ec,EC_CURRENT(ec)))
+		        call pargd (FIT(ec,EC_CURRENT(ec)))
+		        call pargd (USER(ec,EC_CURRENT(ec)))
+		}
+	    }
+
+	    last = EC_CURRENT(ec)
+	} until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+
+	# Warn user that feature data is newer than database entry.
+	if (EC_NEWDBENTRY(ec) == YES) {
+	    answer = true
+	    if (!clgetb ("autowrite")) {
+		call printf ("Write feature data to the database (yes)? ")
+		call flush (STDOUT)
+		if (scan() != EOF)
+		    call gargb (answer)
+	    }
+	    if (answer)
+	        call ec_dbwrite (ec, Memc[EC_IMAGE(ec)], NO)
+	}
+
+	call flush (STDOUT)
+
+	# Free image data and MWCS
+	call mfree (EC_PIXDATA(ec), TY_DOUBLE)
+	call mfree (EC_FITDATA(ec), TY_DOUBLE)
+	call smw_close (MW(EC_SH(ec)))
+	do i = 1, EC_NLINES(ec)
+	    MW(SH(ec,i)) = NULL
+
+	# If a new image was specified by a colon command don't return.
+	if (newimage[1] != EOS) {
+	    call strcpy (newimage, Memc[EC_IMAGE(ec)], SZ_FNAME)
+	    goto newim_
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecinit.x b/noao/onedspec/ecidentify/ecinit.x
new file mode 100644
index 00000000..8b3b7b62
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecinit.x
@@ -0,0 +1,64 @@
+include	<gset.h>
+include	"ecidentify.h"
+
+# EC_INIT -- Allocate and initialize the identify structure.
+
+procedure ec_init (ec)
+
+pointer	ec			# ID pointer
+
+begin
+	call calloc (ec, LEN_EC, TY_STRUCT)
+
+	EC_NALLOC(ec) = 20
+	EC_NFEATURES(ec) = 0
+	EC_CURRENT(ec) = 0
+	EC_NLINES(ec) = 0
+	EC_LL(ec) = NULL
+	EC_ECF(ec) = NULL
+	EC_LABELS(ec) = 1
+
+	call malloc (EC_IMAGE(ec), SZ_FNAME, TY_CHAR)
+	call malloc (EC_DATABASE(ec), SZ_FNAME, TY_CHAR)
+	call malloc (EC_COORDLIST(ec), SZ_FNAME, TY_CHAR)
+
+	call malloc (EC_APNUM(ec), EC_NALLOC(ec), TY_INT)
+	call malloc (EC_LINENUM(ec), EC_NALLOC(ec), TY_INT)
+	call malloc (EC_PIX(ec), EC_NALLOC(ec), TY_DOUBLE)
+	call malloc (EC_ORD(ec), EC_NALLOC(ec), TY_INT)
+	call malloc (EC_FIT(ec), EC_NALLOC(ec), TY_DOUBLE)
+	call malloc (EC_USER(ec), EC_NALLOC(ec), TY_DOUBLE)
+	call malloc (EC_FWIDTHS(ec), EC_NALLOC(ec), TY_REAL)
+	call malloc (EC_FTYPES(ec), EC_NALLOC(ec), TY_INT)
+end
+
+
+# EC_FREE -- Free identify structure.
+
+procedure ec_free (ec)
+
+pointer	ec				# ID pointer
+int	i
+
+begin
+	if (EC_UN(ec) != NULL)
+	    call un_close (EC_UN(ec))
+	do i = 1, EC_NLINES(ec)
+	    call shdr_close (SH(ec,i))
+	call mfree (EC_SHS(ec), TY_POINTER)
+
+	call mfree (EC_IMAGE(ec), TY_CHAR)
+	call mfree (EC_DATABASE(ec), TY_CHAR)
+	call mfree (EC_COORDLIST(ec), TY_CHAR)
+
+	call mfree (EC_APNUM(ec), TY_INT)
+	call mfree (EC_LINENUM(ec), TY_INT)
+	call mfree (EC_PIX(ec), TY_DOUBLE)
+	call mfree (EC_ORD(ec), TY_INT)
+	call mfree (EC_FIT(ec), TY_DOUBLE)
+	call mfree (EC_USER(ec), TY_DOUBLE)
+	call mfree (EC_FWIDTHS(ec), TY_REAL)
+	call mfree (EC_FTYPES(ec), TY_INT)
+
+	call mfree (ec, TY_STRUCT)
+end
diff --git a/noao/onedspec/ecidentify/ecline.x b/noao/onedspec/ecidentify/ecline.x
new file mode 100644
index 00000000..63e55072
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecline.x
@@ -0,0 +1,22 @@
+include	<smw.h>
+include	"ecidentify.h"
+
+# EC_LINE -- Get line corresponding to aperture.
+
+int procedure ec_line (ec, ap)
+
+pointer	ec		# EC pointer
+int	ap		# Aperture
+
+int	i
+
+begin
+	if (IS_INDEFI (ap))
+	    return (INDEFI)
+
+	do i = 1, EC_NLINES(ec)
+	    if (ap == APS(ec,i))
+		return (i)
+
+	call error (0, "Image line for aperture number not found")
+end
diff --git a/noao/onedspec/ecidentify/eclinelist.x b/noao/onedspec/ecidentify/eclinelist.x
new file mode 100644
index 00000000..6653dd4b
--- /dev/null
+++ b/noao/onedspec/ecidentify/eclinelist.x
@@ -0,0 +1,281 @@
+include	<error.h>
+include	<mach.h>
+include	<smw.h>
+include	<units.h>
+include	"ecidentify.h"
+
+# EC_MAPLL -- Read the line list into memory.
+
+procedure ec_mapll (ec)
+
+pointer	ec		# Echelle pointer
+
+int	fd, nalloc, nlines, open(), fscan(), nscan()
+double	value, lastval
+pointer	ec_ll
+pointer	sp, str, units, un_open()
+bool	streq()
+errchk	open, fscan, malloc, realloc, un_open
+
+begin
+	EC_LL(ec) = NULL
+
+	call xt_stripwhite (Memc[EC_COORDLIST(ec)])
+	if (Memc[EC_COORDLIST(ec)] == EOS)
+	    return
+	iferr (fd = open (Memc[EC_COORDLIST(ec)], READ_ONLY, TEXT_FILE))
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call strcpy ("Angstroms", Memc[units], SZ_LINE)
+
+	lastval = -MAX_DOUBLE
+	nalloc = 0
+	nlines = 0
+	while (fscan (fd) != EOF) {
+	    call gargwrd (Memc[str], SZ_LINE)
+	    if (nscan() != 1)
+		next
+	    if (Memc[str] == '#') {
+		call gargwrd (Memc[str], SZ_LINE)
+		call strlwr (Memc[str])
+		if (streq (Memc[str], "units")) {
+		    call gargstr (Memc[units], SZ_LINE)
+		    call xt_stripwhite (Memc[units])
+		}
+		next
+	    }
+	    call reset_scan ()
+
+	    call gargd (value)
+	    if (nscan() != 1)
+		next
+
+	    if (nalloc == 0) {
+		nalloc = 100
+		call malloc (ec_ll, nalloc, TY_DOUBLE)
+	    } else if (nlines == nalloc) {
+		nalloc = nalloc + 100
+		call realloc (ec_ll, nalloc, TY_DOUBLE)
+	    }
+
+	    if (value < lastval) {
+		call close (fd)
+		call mfree (ec_ll, TY_DOUBLE)
+		call error (0, "Line list not sorted in increasing order")
+	    }
+
+	    Memd[ec_ll+nlines] = value
+	    nlines = nlines + 1
+	}
+	call close (fd)
+
+	if (nlines > 0) {
+	    call realloc (ec_ll, nlines + 1, TY_DOUBLE)
+	    Memd[ec_ll+nlines] = INDEFD
+	    EC_LL(ec) = ec_ll
+
+	    if (EC_UN(ec) == NULL && Memc[units] != EOS)
+		EC_UN(ec) = un_open (Memc[units])
+	    call ec_unitsll (ec, Memc[units])
+	}
+
+	call sfree (sp)
+end
+
+
+# EC_UNMAPLL -- Unmap the linelist.
+
+procedure ec_unmapll (ec)
+
+pointer	ec		# Line list pointer
+
+begin
+	call mfree (EC_LL(ec), TY_DOUBLE)
+end
+
+
+# EC_UNITSLL -- Change the line list units from the input units to the
+# units given by EC_UN.  This may involve reversing the order of the list.
+
+procedure ec_unitsll (ec, units)
+
+pointer	ec			# Identify structure
+char	units[ARB]		# Input units
+
+int	i, nll
+double	value
+pointer	un, ll, llend, un_open()
+bool	un_compare()
+errchk	un_open
+
+begin
+	if (EC_LL(ec) == NULL)
+	    return
+	if (IS_INDEFD(Memd[EC_LL(ec)]))
+	    return
+	if (units[1] == EOS || EC_UN(ec) == NULL)
+	    return
+	if (UN_CLASS(EC_UN(ec)) == UN_UNKNOWN)
+	    return
+
+	un = un_open (units)
+	if (un_compare (un, EC_UN(ec))) {
+	    call un_close (un)
+	    return
+	}
+
+	ll = EC_LL(ec)
+	do i = 0, ARB
+	    if (IS_INDEFD(Memd[ll+i])) {
+		nll = i
+		break
+	    }
+	call un_ctrand (un, EC_UN(ec), Memd[ll], Memd[ll], nll)
+	call un_close (un)
+
+	if (Memd[ll] > Memd[ll+nll-1]) {
+	    llend = ll + nll - 1
+	    do i = 0, nll / 2 - 1 {
+		value = Memd[ll+i]
+		Memd[ll+i] = Memd[llend-i]
+		Memd[llend-i] = value
+	    }
+	}
+end
+
+
+
+# EC_MATCH -- Match current feature against a line list.
+
+procedure ec_match (ec, in, out)
+
+pointer	ec			# Echelle pointer
+double	in			# Coordinate to be matched
+double	out			# Matched coordinate
+
+double	match, alpha, delta, delta1, delta2, out1
+pointer	ll
+
+begin
+	if (EC_LL(ec) == NULL) {
+	    out = in
+	    return
+	}
+
+	match = EC_MATCH(ec)
+	alpha = 1.25
+	delta1 = MAX_REAL
+
+	# Find nearest match.
+	for (ll=EC_LL(ec); !IS_INDEFD(Memd[ll]); ll = ll + 1) {
+	    delta = abs (in - Memd[ll])
+	    if (delta < delta1) {
+	        delta2 = delta1
+		delta1 = delta
+	        if (delta1 <= match)
+		    out1 = Memd[ll]
+	    }
+	}
+
+	# Only return match if no other candidate is also possible.
+	if (delta1 > match)
+	    return
+	if (delta2 < alpha * delta1)
+	    return
+
+	out = out1
+end
+
+# EC_LINELIST -- Add features from a line list.
+
+procedure ec_linelist (ec)
+
+pointer	ec			# Echelle pointer
+
+int	i, line, ap, nfound, nextpix
+double	pix, fit, user, peak, minval, match, fit1, fit2
+pointer	sp, aps, pixes, fits, users, peaks, ll
+
+double	ec_center(), ec_fittopix(), ec_fitpt(), ec_peak()
+
+begin
+	if (EC_LL(ec) == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (aps, EC_MAXFEATURES(ec), TY_INT)
+	call salloc (pixes, EC_MAXFEATURES(ec), TY_DOUBLE)
+	call salloc (fits, EC_MAXFEATURES(ec), TY_DOUBLE)
+	call salloc (users, EC_MAXFEATURES(ec), TY_DOUBLE)
+	call salloc (peaks, EC_MAXFEATURES(ec), TY_DOUBLE)
+
+	nfound = 0
+	minval = MAX_REAL
+
+	do line = 1, EC_NLINES(ec) {
+	    call ec_gline (ec, line)
+	    ap = APS(ec,line)
+	    fit1 = min (FITDATA(ec,1), FITDATA(ec,EC_NPTS(ec)))
+	    fit2 = max (FITDATA(ec,1), FITDATA(ec,EC_NPTS(ec)))
+	    for (ll=EC_LL(ec); !IS_INDEFD(Memd[ll]); ll = ll + 1) {
+	        user = Memd[ll]
+	        if (user < fit1)
+		    next
+	        if (user > fit2)
+		    break
+
+	        pix = ec_center (ec, ec_fittopix (ec, user), EC_FWIDTH(ec),
+		    EC_FTYPE(ec))
+	        if (!IS_INDEFD(pix)) {
+		    fit = ec_fitpt (ec, ap, pix)
+		    match = abs (fit - user)
+		    if (match > EC_MATCH(ec))
+		        next
+			
+		    peak = abs (ec_peak (ec, pix))
+		    if (nfound < EC_MAXFEATURES(ec)) {
+		        nfound = nfound + 1
+		        if (peak < minval) {
+		    	    nextpix = nfound
+			    minval = peak
+		        }
+		        Memi[aps+nfound-1] = ap
+		        Memd[pixes+nfound-1] = pix
+		        Memd[fits+nfound-1] = fit
+		        Memd[users+nfound-1] = user
+		        Memd[peaks+nfound-1] = peak
+		    } else if (peak > minval) {
+		        Memi[aps+nextpix-1] = ap
+		        Memd[pixes+nextpix-1] = pix
+		        Memd[fits+nextpix-1] = fit
+		        Memd[users+nextpix-1] = user
+		        Memd[peaks+nextpix-1] = peak
+
+		        minval = MAX_REAL
+		        do i = 1, nfound {
+			    peak = Memd[peaks+i-1]
+			    if (peak < minval) {
+			        nextpix = i
+			        minval = peak
+			    }
+		        }
+		    }
+	        }
+	    }
+	}
+	call ec_gline (ec, EC_LINE(ec))
+
+	do i = 1, nfound {
+	    ap = Memi[aps+i-1]
+	    pix = Memd[pixes+i-1]
+	    fit = Memd[fits+i-1]
+	    user = Memd[users+i-1]
+	    call ec_newfeature (ec, ap, pix, fit, user, EC_FWIDTH(ec),
+		EC_FTYPE(ec))
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecidentify/eclog.x b/noao/onedspec/ecidentify/eclog.x
new file mode 100644
index 00000000..e2730ca0
--- /dev/null
+++ b/noao/onedspec/ecidentify/eclog.x
@@ -0,0 +1,77 @@
+include	<time.h>
+include	"ecidentify.h"
+
+# EC_LOG -- Write log
+
+procedure ec_log (ec, file)
+
+pointer	ec			# ID pointer
+char	file[ARB]		# Log file
+
+char	str[SZ_TIME]
+int	i, fd, nrms
+double	resid, rms
+
+int	open()
+long	clktime()
+errchk	open()
+
+begin
+	if (EC_NFEATURES(ec) == 0)
+	    return
+
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call cnvtime (clktime (0), str, SZ_TIME)
+	call fprintf (fd, "\n%s\n")
+	    call pargstr (str)
+	call fprintf (fd, "Features identified in image %s.\n")
+	    call pargstr (Memc[EC_IMAGE(ec)])
+
+	call fprintf (fd, "      %3s %4s %5s %8s %10s %10s %10s %6s %6d\n")
+	    call pargstr ("Ap")
+	    call pargstr ("Line")
+	    call pargstr ("Order")
+	    call pargstr ("Pixel")
+	    call pargstr ("Fit")
+	    call pargstr ("User")
+	    call pargstr ("Residual")
+	    call pargstr ("Fwidth")
+	    call pargstr ("Reject")
+
+	rms = 0.
+	nrms = 0
+	do i = 1, EC_NFEATURES(ec) {
+	    call fprintf (fd,
+		"%5d %3d %4d %5d %8.2f %10.8g %10.8g %10.8g %6.2f %6b\n")
+		call pargi (i)
+		call pargi (APN(ec,i))
+		call pargi (LINE(ec,i))
+		call pargi (ORDER(ec,i))
+		call pargd (PIX(ec,i))
+		call pargd (FIT(ec,i))
+		call pargd (USER(ec,i))
+		if (IS_INDEFD (USER(ec,i)))
+		    call pargd (USER(ec,i))
+		else {
+		    resid = FIT(ec,i) - USER(ec,i)
+		    call pargd (resid)
+		    if (FTYPE(ec,i) > 0) {
+			rms = rms + resid ** 2
+			nrms = nrms + 1
+		    }
+		}
+		call pargr (FWIDTH(ec,i))
+		if (FTYPE(ec,i) > 0)
+		    call pargb (false)
+		else
+		    call pargb (true)
+	}
+
+	if (nrms > 1) {
+	    call fprintf (fd, "RMS = %0.8g\n")
+		call pargd (sqrt (rms / nrms))
+	}
+
+	call close (fd)
+end
diff --git a/noao/onedspec/ecidentify/ecmark.x b/noao/onedspec/ecidentify/ecmark.x
new file mode 100644
index 00000000..58b02d0f
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecmark.x
@@ -0,0 +1,71 @@
+include	<gset.h>
+include	<pkg/center1d.h>
+include	"ecidentify.h"
+
+procedure ec_mark (ec, feature)
+
+pointer	ec				# ID pointer
+int	feature
+
+int	pix
+real	x, y
+real	mx, my, x1, x2, y1, y2, tick, gap
+pointer	sp, format, label
+double	smw_c1trand()
+
+define	TICK	.03	# Tick size in NDC
+define	GAP	.02	# Gap size in NDC
+
+begin
+	call ggwind (EC_GP(ec), x1, x2, y1, y2)
+
+	x = FIT(ec,feature)
+
+	if ((x < min (x1, x2)) || (x > max (x1, x2)))
+	    return
+
+	pix = smw_c1trand (EC_PL(ec), PIX(ec,feature))
+	pix = max (1, min (pix, EC_NPTS(ec) - 1))
+
+	call smark (sp)
+	call salloc (format, SZ_LINE, TY_CHAR)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	switch (EC_FTYPE(ec)) {
+	case EMISSION:
+	    y = max (IMDATA(ec,pix), IMDATA(ec,pix+1))
+	    tick = TICK
+	    gap = GAP
+	    call strcpy ("u=180;h=c;v=b;s=0.5", Memc[format], SZ_LINE)
+	case ABSORPTION:
+	    y = min (IMDATA(ec,pix), IMDATA(ec,pix+1))
+	    tick = -TICK
+	    gap = -GAP
+	    call strcpy ("u=0;h=c;v=t;s=0.5", Memc[format], SZ_LINE)
+	}
+
+	call gctran (EC_GP(ec), x, y, mx, my, 1, 0)
+	call gctran (EC_GP(ec), mx, my + gap, x1, y1, 0, 1)
+	call gctran (EC_GP(ec), mx, my + gap + tick, x1, y2, 0, 1)
+	call gline (EC_GP(ec), x1, y1, x1, y2)
+
+	call gctran (EC_GP(ec), mx, my + tick + 2 * gap, x1, y2, 0, 1)
+	switch (EC_LABELS(ec)) {
+	case 2:
+	    call sprintf (Memc[label], SZ_LINE, "%d")
+		call pargi (feature)
+	    call gtext (EC_GP(ec), x1, y2, Memc[label], Memc[format])
+	case 3:
+	    call sprintf (Memc[label], SZ_LINE, "%0.2f")
+		call pargd (PIX(ec,feature))
+	    call gtext (EC_GP(ec), x1, y2, Memc[label], Memc[format])
+	case 4:
+	    if (!IS_INDEFD (USER(ec,feature))) {
+	        call sprintf (Memc[label], SZ_LINE, "%0.4f")
+		    call pargd (USER(ec,feature))
+		call gtext (EC_GP(ec), x1, y2, Memc[label], Memc[format])
+	    }
+	}
+
+	call sfree (sp)
+	call gflush (EC_GP(ec))
+end
diff --git a/noao/onedspec/ecidentify/ecnearest.x b/noao/onedspec/ecidentify/ecnearest.x
new file mode 100644
index 00000000..7b061472
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecnearest.x
@@ -0,0 +1,26 @@
+include	<mach.h>
+include	"ecidentify.h"
+
+# EC_NEAREST -- Find the nearest feature to a given coordinate.
+
+procedure ec_nearest (ec, fitnear)
+
+pointer	ec			# ID pointer
+double	fitnear			# Coordinate to find nearest feature
+
+int	i, ec_next()
+double	delta, delta1
+
+begin
+	EC_CURRENT(ec) = 0
+
+	i = 0
+	delta = MAX_REAL
+	while (ec_next (ec, i) != EOF) {
+	    delta1 = abs (FIT(ec,i) - fitnear)
+	    if (delta1 < delta) {
+		EC_CURRENT(ec) = i
+		delta = delta1
+	    }
+	}
+end
diff --git a/noao/onedspec/ecidentify/ecnewfeature.x b/noao/onedspec/ecidentify/ecnewfeature.x
new file mode 100644
index 00000000..525c034a
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecnewfeature.x
@@ -0,0 +1,91 @@
+include	<mach.h>
+include	<smw.h>
+include	"ecidentify.h"
+
+# EC_NEWFEATURE -- Allocate and initialize memory for a new feature.
+
+procedure ec_newfeature (ec, ap, pix, fit, user, width, type)
+
+pointer	ec			# ID pointer
+int	ap			# Order
+double	pix			# Pixel coordinate
+double	fit			# Fit coordinate
+double	user			# User coordinate
+real	width			# Feature width
+int	type			# Feature type
+
+int	i, j, ec_line()
+double	delta
+
+define	NALLOC	20		# Length of additional allocations
+
+begin
+	if (IS_INDEFD (pix))
+	    return
+
+	delta = MAX_REAL
+	do i = 1, EC_NFEATURES(ec) {
+	    if (APN(ec,i) != ap)
+		next
+	    if (abs (pix - PIX(ec,i)) < delta) {
+		delta = abs (pix - PIX(ec,i))
+		j = i
+	    }
+	}
+
+	if (delta >= EC_MINSEP(ec)) {
+	    EC_NFEATURES(ec) = EC_NFEATURES(ec) + 1
+	    if (EC_NALLOC(ec) < EC_NFEATURES(ec)) {
+	        EC_NALLOC(ec) = EC_NALLOC(ec) + NALLOC
+	        call realloc (EC_APNUM(ec), EC_NALLOC(ec), TY_INT)
+	        call realloc (EC_LINENUM(ec), EC_NALLOC(ec), TY_INT)
+	        call realloc (EC_ORD(ec), EC_NALLOC(ec), TY_INT)
+	        call realloc (EC_PIX(ec), EC_NALLOC(ec), TY_DOUBLE)
+	        call realloc (EC_FIT(ec), EC_NALLOC(ec), TY_DOUBLE)
+	        call realloc (EC_USER(ec), EC_NALLOC(ec), TY_DOUBLE)
+	        call realloc (EC_FWIDTHS(ec), EC_NALLOC(ec), TY_REAL)
+	        call realloc (EC_FTYPES(ec), EC_NALLOC(ec), TY_INT)
+	    }
+	    for (j=EC_NFEATURES(ec); (j>1)&&(ap<APN(ec,j-1)); j=j-1) {
+		APN(ec,j) = APN(ec,j-1)
+		LINE(ec,j) = LINE(ec,j-1)
+	        ORDER(ec,j) = ORDER(ec,j-1)
+	        PIX(ec,j) = PIX(ec,j-1)
+	        FIT(ec,j) = FIT(ec,j-1)
+	        USER(ec,j) = USER(ec,j-1)
+	        FWIDTH(ec,j) = FWIDTH(ec,j-1)
+	        FTYPE(ec,j) = FTYPE(ec,j-1)
+	    }
+	    for (; (j>1)&&(ap==APN(ec,j-1))&&(pix<PIX(ec,j-1)); j=j-1) {
+		APN(ec,j) = APN(ec,j-1)
+		LINE(ec,j) = LINE(ec,j-1)
+	        ORDER(ec,j) = ORDER(ec,j-1)
+	        PIX(ec,j) = PIX(ec,j-1)
+	        FIT(ec,j) = FIT(ec,j-1)
+	        USER(ec,j) = USER(ec,j-1)
+	        FWIDTH(ec,j) = FWIDTH(ec,j-1)
+	        FTYPE(ec,j) = FTYPE(ec,j-1)
+	    }
+	    APN(ec,j) = ap
+	    LINE(ec,j) = ec_line (ec, ap)
+	    ORDER(ec,j) = ORDERS(ec,LINE(ec,j))
+	    PIX(ec,j) = pix
+	    FIT(ec,j) = fit
+	    USER(ec,j) = user
+	    FWIDTH(ec,j) = width
+	    FTYPE(ec,j) = type
+	    EC_NEWFEATURES(ec) = YES
+	} else if (abs (fit-user) < abs (FIT(ec,j)-USER(ec,j))) {
+	    APN(ec,j) = ap
+	    LINE(ec,j) = ec_line (ec, ap)
+	    ORDER(ec,j) = ORDERS(ec,LINE(ec,j))
+	    PIX(ec,j) = pix
+	    FIT(ec,j) = fit
+	    USER(ec,j) = user
+	    FWIDTH(ec,j) = width
+	    FTYPE(ec,j) = type
+	    EC_NEWFEATURES(ec) = YES
+	}
+
+	EC_CURRENT(ec) = j
+end
diff --git a/noao/onedspec/ecidentify/ecnext.x b/noao/onedspec/ecidentify/ecnext.x
new file mode 100644
index 00000000..1028371d
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecnext.x
@@ -0,0 +1,23 @@
+include	"ecidentify.h"
+
+# EC_NEXT -- Return the next feature.
+
+int procedure ec_next (ec, feature)
+
+pointer	ec		# ID pointer
+int	feature		# Starting feature (input), next feature (returned)
+
+int	i
+
+begin
+	for (i=feature+1; i<=EC_NFEATURES(ec); i=i+1)
+	    if (APN(ec,i) == EC_AP(ec))
+		break
+
+	if (i <= EC_NFEATURES(ec))
+	    feature = i
+	else
+	   i = EOF
+
+	return (i)
+end
diff --git a/noao/onedspec/ecidentify/ecpeak.x b/noao/onedspec/ecidentify/ecpeak.x
new file mode 100644
index 00000000..f797fbac
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecpeak.x
@@ -0,0 +1,24 @@
+include	"ecidentify.h"
+
+# EC_PEAK -- Find the peak value above continuum.
+
+double procedure ec_peak (ec, pix)
+
+pointer	ec			# ID pointer
+double	pix			# Pixel position
+double	peak			# Peak value
+
+int	c, l, u
+
+begin
+	if (IS_INDEFD(pix))
+	    return (INDEFD)
+
+	c = nint (pix)
+	l = max (1, nint (pix - EC_FWIDTH(ec)))
+	u = min (EC_NPTS(ec), nint (pix + EC_FWIDTH(ec)))
+	peak = IMDATA(ec,c) - (IMDATA(ec,l) +
+	    IMDATA(ec,u)) / 2.
+
+	return (peak)
+end
diff --git a/noao/onedspec/ecidentify/ecprevious.x b/noao/onedspec/ecidentify/ecprevious.x
new file mode 100644
index 00000000..4301b722
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecprevious.x
@@ -0,0 +1,23 @@
+include	"ecidentify.h"
+
+# EC_PREVIOUS -- Return the previous feature.
+
+int procedure ec_previous (ec, feature)
+
+pointer	ec		# ID pointer
+int	feature		# Starting feature (input), previous feature (returned)
+
+int	i
+
+begin
+	for (i=feature-1; i>0; i=i-1)
+	    if (APN(ec,i) == EC_AP(ec))
+		break
+
+	if (i > 0)
+	    feature = i
+	else
+	    i = EOF
+
+	return (i)
+end
diff --git a/noao/onedspec/ecidentify/ecrms.x b/noao/onedspec/ecidentify/ecrms.x
new file mode 100644
index 00000000..de84ae26
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecrms.x
@@ -0,0 +1,28 @@
+include	"ecidentify.h"
+
+# EC_RMS -- Compute RMS of fit about the user coordinates
+
+double procedure ec_rms (ec)
+
+pointer	ec			# ID pointer
+
+int	i, nrms
+double	rms
+
+begin
+	rms = 0.
+	nrms = 0
+	for (i=1; i<=EC_NFEATURES(ec); i=i+1) {
+	    if (!IS_INDEFD (USER(ec,i)) && FTYPE(ec,i) > 0) {
+		rms = rms + (FIT(ec,i) - USER(ec,i)) ** 2
+		nrms = nrms + 1
+	    }
+	}
+
+	if (nrms > 0)
+	    rms = sqrt (rms / nrms)
+	else
+	    rms = INDEFD
+
+	return (rms)
+end
diff --git a/noao/onedspec/ecidentify/ecshift.x b/noao/onedspec/ecidentify/ecshift.x
new file mode 100644
index 00000000..22b050a7
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecshift.x
@@ -0,0 +1,77 @@
+include	<smw.h>
+include	"ecidentify.h"
+
+define	NBIN	10	# Bin parameter for mode determination
+
+# EC_SHIFT -- Determine a shift by correlating feature user positions
+# with peaks in the image data.
+
+double procedure ec_shift (ec)
+
+pointer	ec			# EC pointer
+
+int	i, j, k, ap, order, nx, ndiff, find_peaks()
+real	d, dmin
+double	pix, ec_center(), ec_fitpt()
+pointer	x, y, diff
+errchk	malloc, realloc, find_peaks
+
+begin
+	ndiff = 0
+	call malloc (x, EC_NCOLS(ec), TY_REAL)
+	call malloc (y, EC_NCOLS(ec), TY_DOUBLE)
+	do k = 1, EC_NLINES(ec) {
+	    call ec_gline (ec, k)
+	    ap = APS(ec,k)
+	    order = ORDERS(ec,k)
+
+	    # Find the peaks in the image data.
+	    i = max (5, EC_MAXFEATURES(ec) / EC_NLINES(ec))
+	    nx = find_peaks (IMDATA(ec,1), Memr[x], EC_NPTS(ec), 0.,
+	        int (EC_MINSEP(ec)), 0, i, 0., false)
+
+	    # Center the peaks and convert to user coordinates.
+	    j = 0
+	    do i = 1, nx {
+		pix = Memr[x+i-1]
+	        pix = ec_center (ec, pix, EC_FWIDTH(ec), EC_FTYPE(ec))
+	        if (!IS_INDEFD (pix)) {
+	            Memd[y+j] = ec_fitpt (ec, ap, pix)
+		    j = j + 1
+	        }
+	    }
+	    nx = j
+
+	    # Compute differences with feature list.
+	    do i = 1, EC_NFEATURES(ec) {
+		if (APN(ec,i) != ap)
+		    next
+		if (ndiff == 0)
+		    call malloc (diff, nx, TY_REAL)
+		else 
+		    call realloc (diff, ndiff+nx, TY_REAL)
+		do j = 1, nx {
+		    Memr[diff+ndiff] = (Memd[y+j-1] - FIT(ec,i)) * order
+		    ndiff = ndiff + 1
+		}
+	    }
+	}
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_DOUBLE)
+
+	# Sort the differences and find the mode.
+	call asrtr (Memr[diff], Memr[diff], ndiff)
+
+	dmin = Memr[diff+ndiff-1] - Memr[diff]
+	do i = 0, ndiff-NBIN-1 {
+	    j = i + NBIN
+	    d = Memr[diff+j] - Memr[diff+i]
+	    if (d < dmin) {
+		dmin = d
+		pix = Memr[diff+i] + d / 2.
+	    }
+	}
+	call mfree (diff, TY_REAL)
+
+	return (pix)
+end
diff --git a/noao/onedspec/ecidentify/ecshow.x b/noao/onedspec/ecidentify/ecshow.x
new file mode 100644
index 00000000..e8fb5acc
--- /dev/null
+++ b/noao/onedspec/ecidentify/ecshow.x
@@ -0,0 +1,78 @@
+include	<pkg/center1d.h>
+include	"ecidentify.h"
+
+# EC_SHOW -- Show parameter information.
+
+procedure ec_show (ec, file)
+
+pointer	ec			# ID pointer
+char	file[ARB]		# File
+
+char	line[SZ_LINE]
+int	fd
+
+int	open(), ecf_geti()
+double	ecf_getd()
+errchk	open()
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call sysid (line, SZ_LINE)
+	call fprintf (fd, "%s\n")
+	call pargstr (line)
+
+	call fprintf (fd, "image %s\n")
+	    call pargstr (Memc[EC_IMAGE(ec)])
+	switch (EC_FTYPE(ec)) {
+	case EMISSION:
+	    call fprintf (fd, "ftype emission\n")
+	case ABSORPTION:
+	    call fprintf (fd, "ftype absorption\n")
+	}
+	switch (EC_LABELS(ec)) {
+	case 2:
+	    call fprintf (fd, "labels index\n")
+	case 3:
+	    call fprintf (fd, "labels pixel\n")
+	case 4:
+	    call fprintf (fd, "labels user\n")
+	default:
+	    call fprintf (fd, "labels none\n")
+	}
+	call fprintf (fd, "maxfeatures %d\n")
+	    call pargi (EC_MAXFEATURES(ec))
+	call fprintf (fd, "match %g\n")
+	    call pargr (EC_MATCH(ec))
+	call fprintf (fd, "zwidth %g\n")
+	    call pargr (EC_ZWIDTH(ec))
+	call fprintf (fd, "fwidth %g\n")
+	    call pargr (EC_FWIDTH(ec))
+	call fprintf (fd, "database %s\n")
+	    call pargstr (Memc[EC_DATABASE(ec)])
+	call fprintf (fd, "coordlist %s\n")
+	    call pargstr (Memc[EC_COORDLIST(ec)])
+	call fprintf (fd, "cradius %g\n")
+	    call pargr (EC_CRADIUS(ec))
+	call fprintf (fd, "threshold %g\n")
+	    call pargr (EC_THRESHOLD(ec))
+	call fprintf (fd, "minsep %g\n")
+	    call pargr (EC_MINSEP(ec))
+	if (EC_ECF(ec) != NULL) {
+	    call fprintf (fd, "function = %s\n")
+	        call ecf_gets ("function", line, SZ_LINE)
+		call pargstr (line)
+	    call fprintf (fd, "xorder = %d, yorder = %d\n")
+		call pargi (ecf_geti ("xorder"))
+		call pargi (ecf_geti ("yorder"))
+	    call fprintf (fd,
+		"niterate = %d, lowreject = %g, highreject = %g\n")
+		call pargi (ecf_geti ("niterate"))
+		call pargd (ecf_getd ("low"))
+		call pargd (ecf_getd ("high"))
+	    call fprintf (fd, "Fit at first pixel = %0.8g\n")
+		call pargd (Memd[EC_FITDATA(ec)])
+	}
+
+	call close (fd)
+end
diff --git a/noao/onedspec/ecidentify/mkpkg b/noao/onedspec/ecidentify/mkpkg
new file mode 100644
index 00000000..1c8664a7
--- /dev/null
+++ b/noao/onedspec/ecidentify/mkpkg
@@ -0,0 +1,39 @@
+# ECIDENTIFY Task
+
+$checkout libpkg.a ..
+$update   libpkg.a
+$checkin  libpkg.a ..
+$exit
+
+libpkg.a:
+	@ecffit
+
+	eccenter.x	ecidentify.h
+	eccolon.x	ecidentify.h <error.h> <gset.h> <pkg/center1d.h>
+	ecdb.x		ecidentify.h <math/gsurfit.h> <smw.h> <units.h>
+	ecdelete.x	ecidentify.h
+	ecdofit.x	ecidentify.h <smw.h>
+	ecdoshift.x	ecidentify.h
+	ecfitdata.x	ecidentify.h <pkg/gtools.h> <smw.h> <units.h>
+	ecgdata.x	ecidentify.h <imhdr.h> <imio.h> <pkg/gtools.h> <smw.h>\
+			<units.h>
+	ecgetim.x	
+	ecgline.x	ecidentify.h <smw.h>
+	ecgraph.x	ecidentify.h <gset.h> <pkg/gtools.h>
+	ecidentify.x	ecidentify.h <error.h> <gset.h> <imhdr.h> <smw.h>
+	ecinit.x	ecidentify.h <gset.h>
+	ecline.x	ecidentify.h <smw.h>
+	eclinelist.x	ecidentify.h <error.h> <mach.h> <smw.h> <units.h>
+	eclog.x		ecidentify.h <time.h>
+	ecmark.x	ecidentify.h <gset.h> <pkg/center1d.h>
+	ecnearest.x	ecidentify.h <mach.h>
+	ecnewfeature.x	ecidentify.h <mach.h> <smw.h>
+	ecnext.x	ecidentify.h
+	ecpeak.x	ecidentify.h
+	ecprevious.x	ecidentify.h
+	ecrms.x		ecidentify.h
+	ecshift.x	ecidentify.h <smw.h>
+	ecshow.x	ecidentify.h <pkg/center1d.h>
+	t_eciden.x	ecidentify.h <mach.h> <pkg/center1d.h> <pkg/gtools.h>
+	t_ecreid.x	ecidentify.h <error.h> <smw.h>
+	;
diff --git a/noao/onedspec/ecidentify/t_eciden.x b/noao/onedspec/ecidentify/t_eciden.x
new file mode 100644
index 00000000..7590dc17
--- /dev/null
+++ b/noao/onedspec/ecidentify/t_eciden.x
@@ -0,0 +1,68 @@
+include	<mach.h>
+include	<pkg/gtools.h>
+include	<pkg/center1d.h>
+include	"ecidentify.h"
+
+# T_ECIDENTIFY -- Identify features in echelle format data.
+#
+# The input data must be in the echelle format produced by APEXTRACT.
+
+procedure t_ecidentify ()
+
+int	images
+pointer	ec, gopen(), gt_init(), un_open()
+int	clgeti(), clgwrd(), imtopenp(), ec_getim()
+real	clgetr()
+double	clgetd()
+
+begin
+	# Allocate the basic data structure.
+	call ec_init (ec)
+
+	# Get task parameters.
+	images = imtopenp ("images")
+	EC_MAXFEATURES(ec) = clgeti ("maxfeatures")
+	EC_MINSEP(ec) = clgetr ("minsep")
+	EC_MATCH(ec) = clgetr ("match")
+	EC_ZWIDTH(ec) = clgetr ("zwidth")
+	EC_FTYPE(ec) = clgwrd ("ftype", Memc[EC_IMAGE(ec)], SZ_FNAME, FTYPES)
+	EC_FWIDTH(ec) = clgetr ("fwidth")
+	EC_CRADIUS(ec) = clgetr ("cradius")
+	EC_THRESHOLD(ec) = clgetr ("threshold")
+	call clgstr ("database", Memc[EC_DATABASE(ec)], SZ_FNAME)
+	call clgstr ("coordlist", Memc[EC_COORDLIST(ec)], SZ_FNAME)
+
+	# Get the line list.
+	call clgstr ("units", Memc[EC_IMAGE(ec)], SZ_FNAME)
+	call xt_stripwhite (Memc[EC_IMAGE(ec)])
+	if (Memc[EC_IMAGE(ec)] != EOS)
+	    EC_UN(ec) = un_open (Memc[EC_IMAGE(ec)])
+	call ec_mapll (ec)
+
+	# Initialize graphics and fitting.
+	call clgstr ("function", Memc[EC_IMAGE(ec)], SZ_FNAME)
+	call ecf_sets ("function", Memc[EC_IMAGE(ec)])
+	call ecf_seti ("xorder", clgeti ("xorder"))
+	call ecf_seti ("yorder", clgeti ("yorder"))
+	call ecf_seti ("niterate", clgeti ("niterate"))
+	call ecf_setd ("low", clgetd ("lowreject"))
+	call ecf_setd ("high", clgetd ("highreject"))
+	call ecf_seti ("xtype", 'p')
+	call ecf_seti ("ytype", 'r')
+	call clgstr ("graphics", Memc[EC_IMAGE(ec)], SZ_FNAME)
+	EC_GP(ec) = gopen (Memc[EC_IMAGE(ec)], NEW_FILE, STDGRAPH)
+	EC_GT(ec) = gt_init()
+	call gt_sets (EC_GT(ec), GTTYPE, "line")
+
+	# Identify features in each image.
+	while (ec_getim (images, Memc[EC_IMAGE(ec)], SZ_FNAME) != EOF)
+	    call ec_identify (ec)
+
+	# Finish up.
+	call gclose (EC_GP(ec))
+	call gt_free (EC_GT(ec))
+	call dgsfree (EC_ECF(ec))
+	call imtclose (images)
+	call ec_unmapll (ec)
+	call ec_free (ec)
+end
diff --git a/noao/onedspec/ecidentify/t_ecreid.x b/noao/onedspec/ecidentify/t_ecreid.x
new file mode 100644
index 00000000..5e9769ff
--- /dev/null
+++ b/noao/onedspec/ecidentify/t_ecreid.x
@@ -0,0 +1,181 @@
+include	<error.h>
+include <smw.h>
+include	"ecidentify.h"
+
+# T_ECREIDENTIFY -- Reidentify echelle features starting from reference.
+# If no initial shift is given then the procedure ec_shift computes a
+# shift between the reference features and the features in the image.
+# The purpose of the shift is to get the feature positions from the
+# reference image close enough to those of the image being identified
+# that the centering algorithm will determine the exact positions of the
+# features.  The recentered features are then fit with either a shift
+# of a full echelle function and written to database.
+
+procedure t_ecreidentify ()
+
+int	images			# List of images
+pointer	ref			# Reference image
+double	shift			# Initial shift
+
+int	i, j, fd, nfeatures1, nfeatures2
+double	shift1, pix, fit, pix_shift, fit_shift, z_shift
+pointer	sp, log, ec
+
+int	imtopenp(), ec_getim(), clpopnu(), clgfil(), open(), btoi()
+double	ec_fitpt(), ec_fittopix(), ec_shift(), ec_center(), ec_rms()
+double	clgetd()
+bool	clgetb()
+real	clgetr()
+errchk	ec_dbread(), ec_gdata(), ec_fitdata()
+
+begin
+	call smark (sp)
+	call salloc (ref, SZ_FNAME, TY_CHAR)
+	call salloc (log, SZ_FNAME, TY_CHAR)
+
+	# Allocate the basic data structure.
+	call ec_init (ec)
+
+	# Initialize fitting
+	call ecf_seti ("niterate", 0)
+	call ecf_setd ("low", 3.D0)
+	call ecf_setd ("high", 3.D0)
+
+	# Get task parameters.
+	images = imtopenp ("images")
+	call clgstr ("reference", Memc[ref], SZ_FNAME)
+	shift = clgetd ("shift")
+	call clgstr ("database", Memc[EC_DATABASE(ec)], SZ_FNAME)
+	EC_CRADIUS(ec) = clgetr ("cradius")
+	EC_THRESHOLD(ec) = clgetr ("threshold")
+	EC_LOGFILES(ec) = clpopnu ("logfiles")
+	EC_REFIT(ec) = btoi (clgetb ("refit"))
+
+	# Write logfile header.
+	while (clgfil (EC_LOGFILES(ec), Memc[log], SZ_FNAME) != EOF) {
+	    iferr (fd = open (Memc[log], APPEND, TEXT_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    call sysid (Memc[log], SZ_LINE)
+	    call fprintf (fd, "\nECREIDENTIFY: %s\n")
+		call pargstr (Memc[log])
+	    call fprintf (fd,
+		"  Reference image = %s, Refit = %b\n")
+		call pargstr (Memc[ref])
+		call pargb (EC_REFIT(ec) == YES)
+	    call fprintf (fd, "%20s  %7s %7s %9s  %10s  %7s  %7s\n")
+		call pargstr ("Image")
+		call pargstr ("Found")
+		call pargstr ("Fit")
+		call pargstr ("Pix Shift")
+		call pargstr ("User Shift")
+		call pargstr ("Z Shift")
+		call pargstr ("RMS")
+	    call close (fd)
+	}
+
+	# Reidentify features in each spectrum.
+	while (ec_getim (images, Memc[EC_IMAGE(ec)], SZ_FNAME) != EOF) {
+	    call ec_gdata (ec)
+	    call ec_dbread (ec, Memc[ref], NO)
+	    call ec_fitdata (ec)
+	    call ec_fitfeatures (ec)
+
+	    if (IS_INDEFD (shift)) {
+		EC_FWIDTH(ec) = FWIDTH(ec,1)
+		EC_FTYPE(ec) = abs (FTYPE(ec,1))
+		EC_MINSEP(ec) = 1.
+		EC_MAXFEATURES(ec) = 20
+	        shift1 = ec_shift (ec)
+	    } else
+	        shift1 = shift
+
+	    # Recenter features.
+	    pix_shift = 0.
+	    fit_shift = 0.
+	    z_shift = 0.
+	    nfeatures1 = EC_NFEATURES(ec)
+
+	    j = 0.
+	    do i = 1, EC_NFEATURES(ec) {
+	        call ec_gline (ec, LINE(ec,i))
+	        pix = ec_fittopix (ec, FIT(ec,i) + shift1/ORDER(ec,i))
+	        pix = ec_center (ec, pix, FWIDTH(ec,i), FTYPE(ec,i))
+	        if (IS_INDEFD (pix))
+		    next
+	        fit = ec_fitpt (ec, APN(ec,i), pix)
+
+	        pix_shift = pix_shift + pix - PIX(ec,i)
+		fit_shift = fit_shift + (fit - FIT(ec,i)) * ORDER(ec,i)
+	        if (FIT(ec,i) != 0.)
+	            z_shift = z_shift + (fit - FIT(ec,i)) / FIT(ec,i)
+
+	        j = j + 1
+	        APN(ec,j) = APN(ec,i)
+	        LINE(ec,j) = LINE(ec,i)
+	        ORDER(ec,j) = ORDER(ec,i)
+	        PIX(ec,j) = pix
+	        FIT(ec,j) = FIT(ec,i)
+	        USER(ec,j) = USER(ec,i)
+	        FWIDTH(ec,j) = FWIDTH(ec,i)
+	        FTYPE(ec,j) = abs (FTYPE(ec,i))
+	    }
+	    EC_NFEATURES(ec) = j
+
+	    # If refitting the coordinate function is requested and there
+	    # is more than one feature and there is a previously defined
+	    # coordinate function then refit.  Otherwise compute a coordinate
+	    # shift.
+
+	    if ((EC_REFIT(ec)==YES)&&(EC_NFEATURES(ec)>1)&&(EC_ECF(ec)!=NULL)) {
+	        iferr (call ec_dofit (ec, NO, YES)) {
+		    call erract (EA_WARN)
+		    next
+		}
+	    } else
+	        call ec_doshift (ec, NO)
+	    if (EC_NEWECF(ec) == YES)
+	        call ec_fitfeatures (ec)
+
+	    nfeatures2 = 0
+	    do i = 1, EC_NFEATURES(ec)
+		if (FTYPE(ec,i) > 0)
+		    nfeatures2 = nfeatures2 + 1
+
+	    # Write a database entry for the reidentified image.
+	    if (EC_NFEATURES(ec) > 0)
+	        call ec_dbwrite (ec, Memc[EC_IMAGE(ec)], NO)
+
+	    # Record log information if a log file descriptor is given.
+	    call clprew (EC_LOGFILES(ec))
+	    while (clgfil (EC_LOGFILES(ec), Memc[log], SZ_FNAME) != EOF) {
+	        iferr (fd = open (Memc[log], APPEND, TEXT_FILE)) {
+		    call erract (EA_WARN)
+		    next
+	        }
+	        call fprintf (fd,
+		    "%20s  %3d/%-3d %3d/%-3d %9.3g  %10.3g  %7.3g  %7.3g\n")
+		    call pargstr (Memc[EC_IMAGE(ec)])
+		    call pargi (EC_NFEATURES(ec))
+		    call pargi (nfeatures1)
+		    call pargi (nfeatures2)
+		    call pargi (EC_NFEATURES(ec))
+		    call pargd (pix_shift / max (1, EC_NFEATURES(ec)))
+		    call pargd (fit_shift / max (1, EC_NFEATURES(ec)))
+		    call pargd (z_shift / max (1, EC_NFEATURES(ec)))
+		    call pargd (ec_rms(ec))
+	        call close (fd)
+	    }
+
+	    call smw_close (MW(EC_SH(ec)))
+	    do i = 1, EC_NLINES(ec)
+		MW(SH(ec,i)) = NULL
+	}
+
+	call dgsfree (EC_ECF(ec))
+	call clpcls (EC_LOGFILES(ec))
+	call ec_free (ec)
+	call imtclose (images)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/ecreidentify.par b/noao/onedspec/ecreidentify.par
new file mode 100644
index 00000000..251675a7
--- /dev/null
+++ b/noao/onedspec/ecreidentify.par
@@ -0,0 +1,11 @@
+# Parameters for ECREIDENTIFY task.
+
+images,s,a,,,,Spectra to be reidentified
+reference,f,a,,,,Reference spectrum
+shift,r,h,0.,,,Shift to add to reference features
+cradius,r,h,5.,,,Centering radius
+threshold,r,h,10.,0.,,Feature threshold for centering
+refit,b,h,yes,,,Refit coordinate function?
+
+database,f,h,database,,,Database
+logfiles,s,h,"STDOUT,logfile",,,List of log files
diff --git a/noao/onedspec/fitprofs.par b/noao/onedspec/fitprofs.par
new file mode 100644
index 00000000..475996ef
--- /dev/null
+++ b/noao/onedspec/fitprofs.par
@@ -0,0 +1,29 @@
+input,s,a,,,,List of input images
+lines,s,h,"",,,List of lines/columns/apertures
+bands,s,h,"",,,Bands in 3D image
+dispaxis,i,h,)_.dispaxis,,,"Image axis for 2D images"
+nsum,s,h,)_.nsum,,,"Number of lines/columns to sum for 2D images
+"
+region,s,h,,,,Fitting region
+positions,f,h,,,,File of positions/sigmas
+background,s,h,"",,,Default background
+profile,s,h,"gaussian","gaussian|lorentzian|voigt",,Default profile type
+gfwhm,r,h,20.,,,Default Gaussian FWHM
+lfwhm,r,h,20.,,,Default Lorentzian FWHM
+fitbackground,b,h,yes,,,Fit background?
+fitpositions,s,h,"all","fixed|single|all",,Fit positions
+fitgfwhm,s,h,"all","fixed|single|all",,"Fit Gaussian FWHM"
+fitlfwhm,s,h,"all","fixed|single|all",,"Fit Lorentzian FWHM
+"
+nerrsample,i,h,0,0,,"Number of error samples (<10 for no errors)"
+sigma0,r,h,INDEF,,,"Constant gaussian noise term (INDEF for no errors)"
+invgain,r,h,INDEF,,,"Inverse gain term (INDEF for no errors)
+"
+components,s,h,"",,,Components to output
+verbose,b,h,yes,,,Standard output?
+logfile,f,h,"logfile",,,Logfile output
+plotfile,f,h,"",,,Plotfile output
+output,s,h,"",,,Image output (list)
+option,s,h,"fit","fit|difference",,Image output option
+clobber,b,h,no,,,Modify output images?
+merge,b,h,no,,,Merge with existing output images?
diff --git a/noao/onedspec/fortran/mkpkg b/noao/onedspec/fortran/mkpkg
new file mode 100644
index 00000000..91b19945
--- /dev/null
+++ b/noao/onedspec/fortran/mkpkg
@@ -0,0 +1,10 @@
+# Fortran subroutines for ONEDSPEC package.
+
+$checkout libpkg.a ../
+$update	  libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	polft1.f
+	;
diff --git a/noao/onedspec/fortran/nlcfit.f b/noao/onedspec/fortran/nlcfit.f
new file mode 100644
index 00000000..80aff616
--- /dev/null
+++ b/noao/onedspec/fortran/nlcfit.f
@@ -0,0 +1,400 @@
+      SUBROUTINE NLCFIT(IM,INN,IN,INTA,XEPSI,XV,XYD)
+C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+C     NONLINEAR LEAST SQUARES FITTING USING SIMPLEX
+C     METHOD AND QUADRATIC APPROXIMATION.
+C     WITH LINEAR PARAMETER ELIMINATION.
+C-------------------------------------------------------------
+      INTEGER IM,INN,IN,INTA
+      REAL XEPSI,XV(IM),XYD(IM)
+      COMMON /NLC/ EPSI,IFLAG,IL,IQ,INDEX,F(15,120),M,N
+      COMMON /NLC/ SOLD,Y(20),YVAL,XF(11),X(11,11),V(120),YD(120,10)
+      COMMON /NLC/ GG(11,11),GINV(11,11),EM(15,120),BB(5),NT
+      COMMON /NLC/ GA(120,5),NN
+	COMMON /NLCOUT/ FF(120),PARS(10),BPARS(10)
+      DIMENSION SUMC(11),XC(11),XE(11),XCO(11),XR(11)
+      REAL LERROR
+C-----
+C RESET ERROR HANDLER
+c...UNIX has general handler only!
+c	call trpfpe (0, 0d0)
+C-----
+C FLOAT OVERFLOW
+c	CALL ERRSET(72,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15)
+C FLOAT UNDERFLOW
+c	CALL ERRSET(74,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15)
+C EXP TOO SMALL
+c	CALL ERRSET(89,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15)
+C EXP TOO LRGE
+c	CALL ERRSET(88,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15)
+C-----
+      LERROR=1.E30
+	IFLAG=0
+C     COEFFICIENTS
+C-----
+C ASSIGN EXTERNAL PARAMETERS
+	M=IM
+	NN=INN
+	N=IN
+	NT=INTA
+	EPSI=XEPSI
+	DO 8100 I=1,M
+		V(I)=XV(I)
+		YD(I,1)=XYD(I)
+8100	CONTINUE
+C-----
+      T=1.0
+      A=1.0
+      B=0.5
+      G=2.0
+      ICOUNT=0
+      INDEX=1
+      IQ=3*N
+      DO 140 J=1,N
+140   X(1,J)=1.0
+160   DO 172 J=1,N
+172   XF(J)=X(1,J)
+      CALL FVAL
+      Y(1)=YVAL
+      SOLD=YVAL
+C---- CONSTRUCT SIMPLEX
+      EN=N
+      PN=(SQRT(EN+1.0)-1.0+EN)/(EN*SQRT(2.0))*T
+      QN=(SQRT(EN+1.0)-1.0)/(EN*SQRT(2.0))*T
+      NP1=N+1
+      DO 305 I=2,NP1
+      INDEX=I
+      DO 300 J=1,N
+      EJ=0.0
+      EI=0.0
+      IF(I-1.NE.J) EJ=1.0
+      IF(I-1.EQ.J) EI=1.0
+      X(I,J)=X(1,J)+EI*PN+EJ*QN
+300   XF(J)=X(I,J)
+      CALL FVAL
+305   Y(I)=YVAL
+C---- DETERMINE MAX XH
+310   IH=1
+      DO 350 J=1,NP1
+      IF(Y(IH).GE.Y(J)) GOTO 350
+      IH=J
+350   CONTINUE
+C---- DETERMINE SECOND MAX XS
+      IS=1
+      IF(IH.NE.1) GOTO 470
+      IS=2
+470   CONTINUE
+      DO 420 J=1,NP1
+      IF(J.EQ.IH) GOTO 420
+      IF(Y(IS).GE.Y(J)) GOTO 420
+      IS=J
+420   CONTINUE
+C---- DETERMINE MIN XL
+      IL=1
+      DO 480 J=1,NP1
+      IF(Y(IL).LE.Y(J)) GOTO 480
+      IL=J
+480   CONTINUE
+C---- COMPUTE CENTROID
+      DO 510 J=1,N
+510   SUMC(J)=0.0
+      EN=N
+      DO 570 J=1,N
+      DO 560 I=1,NP1
+      IF(I.EQ.IH) GOTO 560
+      SUMC(J)=SUMC(J)+X(I,J)
+560   CONTINUE
+570   XC(J)=1.0/EN*SUMC(J)
+      DO 573 J=1,N
+573   XF(J)=XC(J)
+      CALL FVAL
+      YBAR=YVAL
+      SUM=0.0
+      DO 577 I=1,NP1
+  577 SUM = SUM + ((Y(I)-YBAR)/YBAR)**2
+      ICOUNT=ICOUNT+1
+      ERROR=SQRT(SUM/EN)
+      IQ=IQ-1
+      IF(IQ.EQ.-1) CALL QADFIT
+      IF(IFLAG.EQ.1) GOTO 1990
+      IF(ERROR.LE.EPSI) GOTO 1990
+      IF(ABS(LERROR-ERROR).LT.EPSI) GO TO 1990
+      LERROR=ERROR
+C---- DO A REFLECTION
+      DO 600 J=1,N
+600   XR(J)=(1.0+A)*XC(J)-A*X(IH,J)
+      DO 610 J=1,N
+610   XF(J)=XR(J)
+      INDEX=N+2
+      CALL FVAL
+      YXR=YVAL
+      IF(YXR.GE.Y(IL)) GOTO 750
+C---- DO A EXPANSION
+      DO 660 J=1,N
+660   XE(J)=G*XR(J)+(1.0-G)*XC(J)
+      DO 680 J=1,N
+680   XF(J)=XE(J)
+      INDEX=N+3
+      CALL FVAL
+      YXE=YVAL
+      IF(YXE.GT.Y(IL)) GOTO 760
+      DO 730 J=1,N
+730   X(IH,J)=XE(J)
+      Y(IH)=YXE
+      NP3=N+3
+      DO 735 K=1,M
+735   F(IH,K)=F(NP3,K)
+      GOTO 310
+750   IF(YXR.GT.Y(IS)) GOTO 800
+760   DO 780 J=1,N
+780   X(IH,J)=XR(J)
+      Y(IH)=YXR
+      NP2=N+2
+      DO 785 K=1,M
+785   F(IH,K)=F(NP2,K)
+      GOTO 310
+800   IF(YXR.GT.Y(IH)) GOTO 830
+      DO 820 J=1,N
+820   X(IH,J)=XR(J)
+C---- DO A CONTRACTION
+830   DO 840 J=1,N
+840   XCO(J)=B*X(IH,J)+(1.0-B)*XC(J)
+      DO 860 J=1,N
+860   XF(J)=XCO(J)
+      INDEX=N+2
+      CALL FVAL
+      YXCO=YVAL
+      IF(YXCO.GT.Y(IH)) GOTO 930
+      DO 910 J=1,N
+910   X(IH,J)=XCO(J)
+      Y(IH)=YXCO
+      NP2=N+2
+      DO 915 K=1,M
+915   F(IH,K)=F(NP2,K)
+      GOTO 310
+930   DO 960 I=1,NP1
+      INDEX=I
+      DO 955 J=1,N
+950   X(I,J)=0.5*(X(I,J)+X(IL,J))
+955   XF(J)=X(I,J)
+      CALL FVAL
+960   Y(I)=YVAL
+C---- HAS A MIN BEEN REACHED?
+      GOTO 310
+1990  DO 1594 J=1,N
+	PARS(J)=X(IL,J)
+1594  XF(J)=X(IL,J)
+      CALL FVAL
+	DO 1595 I=1,NT
+1595	BPARS(I)=BB(I)
+      CALL INDEXD
+	RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE MATIN
+C---- DETERMINE INVERSE OF MATRIX
+      COMMON /NLC/ EPSI,IFLAG,IL,IQ,INDEX,F(15,120),M,N
+      COMMON /NLC/ SOLD,Y(20),YVAL,XF(11),X(11,11),V(120),YD(120,10)
+      COMMON /NLC/ GG(11,11),GINV(11,11),EM(15,120),BB(5),NT
+      COMMON /NLC/ GA(120,5),NN
+      DIMENSION E(15,120),EN(20),T(20),Z(11,11),YY(20)
+      EQUIVALENCE (EM(1,1),E(1,1))
+      DO 20 I=1,N
+      DO 20 J=1,N
+      IF(I.EQ.J) GOTO 10
+      Z(I,J)=0.0
+      GOTO 20
+10    Z(I,J)=1.0
+20    CONTINUE
+      DO 120 J0=1,N
+      I0=J0
+      DO 30 I=1,N
+30    YY(I)=GG(I,J0)
+      DO 40 I=1,N
+      EN(I) = 0.
+      T(I)=0.0
+      DO 40 J=1,N
+40    T(I)=T(I)+Z(I,J)*YY(J)
+      IF(T(J0).EQ.0.) GO TO 65
+      DO 60 J=1,N
+      IF(J.EQ.J0) GOTO 50
+      EN(J)=-T(J)/T(J0)
+      GOTO 60
+50    EN(J)=1./T(J0)
+60    CONTINUE
+   65 DO 80 I = 1,N
+      DO 80 J=1,N
+      IF (I.EQ.J) GOTO 70
+      E(I,J)=0.0
+      GOTO 80
+70    E(I,J)=1.0
+80    CONTINUE
+      DO 90 J=1,N
+90    E(J,J0)=EN(J)
+      DO 100 K=1,N
+      DO 100 I=1,N
+      GINV(K,I)=0.0
+      DO 100 J=1,N
+100   GINV(K,I)=GINV(K,I)+E(K,J)*Z(J,I)
+      DO 110 J=1,N
+      DO 110 I=1,N
+110   Z(I,J)=GINV(I,J)
+120   CONTINUE
+      RETURN
+      END
+C-------------------------------------------------------------------------
+      SUBROUTINE QADFIT
+      COMMON /NLC/ EPSI,IFLAG,IL,IQ,INDEX,F(15,120),M,N
+      COMMON /NLC/ SOLD,Y(20),YVAL,XF(11),X(11,11),V(120),YD(120,10)
+      COMMON /NLC/ GG(11,11),GINV(11,11),EM(15,120),BB(5),NT
+      COMMON /NLC/ GA(120,5),NN
+      DIMENSION A(11,11),DELX(20),E(20),F0(20)
+      NP1=N+1
+C---- QUADRATIC COEFFICIENTS
+      II=0
+      DO 30 K=1,M
+      II=0
+      DO 30 I=1,NP1
+      IF(I.EQ.IL) GOTO 30
+      II=II+1
+      EM(II,K)=F(I,K)-F(IL,K)
+30    CONTINUE
+      DO 50 I=1,N
+      F0(I)=0.0
+      DO 50 K=1,M
+50    F0(I)=F0(I)-F(IL,K)*EM(I,K)
+C---- ELEMENTS OF THE MATRIX GAMMA,G
+      DO 70 I=1,N
+      DO 70 J=1,N
+      GG(I,J)=0.0
+      DO 70 K=1,M
+70    GG(I,J)=GG(I,J)+EM(I,K)*EM(J,K)
+      CALL MATIN
+      DO 80 I=1,N
+      E(I)=0.0
+      DO 80 J=1,N
+80    E(I)=E(I)+GINV(I,J)*F0(J)
+C---- DEFINE THE SCALING MATRIX A
+      II=0
+      DO 101 I=1,NP1
+      IF(I.EQ.IL) GOTO 101
+      II=II+1
+      DO 100 J=1,N
+      A(II,J)=X(I,J)-X(IL,J)
+100   CONTINUE
+101   CONTINUE
+C---- DETERMINE DEL X
+      DO 110 I=1,N
+      DELX(I)=0.0
+      DO 110 J=1,N
+110   DELX(I)=DELX(I)+A(J,I)*E(J)
+      DO 120 J=1,N
+120   XF(J)=X(IL,J)+DELX(J)
+      INDEX=N+2
+      CALL FVAL
+      IF(Y(IL).LT.YVAL) GOTO 140
+      TEMP=ABS(1-SOLD/YVAL)
+      IF(TEMP.EQ.1) GOTO 150
+      IF(TEMP.LE.EPSI) GOTO 150
+      SOLD=YVAL
+      DO 130 J=1,N
+130   X(IL,J)=XF(J)
+      NP2=N+2
+      DO 135 K=1,M
+135   F(IL,K)=F(NP2,K)
+      IFLAG=2
+      IQ=(3*N)/2
+      GOTO 160
+140   IFLAG=2
+      IQ=3*N
+      GOTO 160
+150   IFLAG=1
+      DO 155 J=1,N
+155   X(IL,J)=XF(J)
+      Y(IL)=YVAL
+160   RETURN
+      END
+C----------------------------------------------------------------------
+      SUBROUTINE  INDEXD
+      COMMON /NLC/ EPSI,IFLAG,IL,IQ,INDEX,F(15,120),M,N
+      COMMON /NLC/ SOLD,Y(20),YVAL,XF(11),X(11,11),V(120),YD(120,10)
+      COMMON /NLC/ GG(11,11),GINV(11,11),EM(15,120),BB(5),NT
+      COMMON /NLC/ GA(120,5),NN
+	COMMON /NLCOUT/ FF(120),PARS(10),BPARS(10)
+      SUM=0.0
+      DO 200 I=1,M
+200   SUM=SUM+V(I)
+      XM=M
+      YBAR=SUM/XM
+      SST=0.0
+      DO 240 I=1,M
+240   SST=SST+(V(I)-YBAR)**2
+      SSR=0.0
+      DO 280 I=1,M
+      FF(I)=0.0
+      DO 260  J=1,NT
+260   FF(I)=BB(J)*GA(I,J)+FF(I)
+280   SSR=SSR+(FF(I)-V(I))**2
+      XINDX=1-SSR/SST
+      SIGMAR=SQRT(SSR/XM)
+      DO 300 I=1,M
+      DIFF=FF(I)-V(I)
+      IF(V(I).EQ.0.) GO TO 295
+      DIFF = DIFF*100./V(I)
+      GO TO 300
+295   DIFF=0.
+300   CONTINUE
+C
+C----  WRITE(1) (FF(I),I=1,M)
+C----  WRITE(1) (V(I),I=1,M)
+      RETURN
+      END
+C---------------------------------------------------------------------------
+      SUBROUTINE FVAL
+      COMMON /NLC/ EPSI,IFLAG,IL,IQ,INDEX,F(15,120),M,N
+      COMMON /NLC/ SOLD,Y(20),YVAL,XF(11),X(11,11),V(120),YD(120,10)
+      COMMON /NLC/ GG(11,11),GINV(11,11),EM(15,120),BB(5),NT
+      COMMON /NLC/ GA(120,5),NN
+      DIMENSION GTGA(11,11),GT(5,120),GGG(5,120),B(5)
+      DIMENSION G(120,5),A(11),TR(5),XP(11)
+      EQUIVALENCE (GG(1,1),GTGA(1,1)),(BB(1),B(1)),(XF(1),A(1)),
+     *(G(1,1),GA(1,1))
+      DO 200 I=1,M
+      DO 100 J=1,NN
+100   XP(J)=YD(I,J)
+C
+C---- LOCATION OF TRANSFORMS
+      CALL TRANS(TR,A,XP)
+C
+      DO 110 J=1,NT
+110   GA(I,J)=TR(J)
+200   CONTINUE
+      DO 230 J=1,NT
+      DO 230 I=1,M
+230   GT(J,I)=GA(I,J)
+      DO 280 K=1,NT
+      DO 280 I=1,NT
+      GTGA(K,I)=0.0
+      DO 280 J=1,M
+280   GTGA(K,I)=GTGA(K,I)+GT(K,J)*GA(J,I)
+      HOLD=N
+      N=NT
+      CALL MATIN
+      N=HOLD
+      DO 350 K=1,NT
+      DO 350 I=1,M
+      GGG(K,I)=0.0
+      DO 350 J=1,NT
+350   GGG(K,I)=GGG(K,I)+GINV(K,J)*GT(J,I)
+      DO 400 K=1,NT
+      B(K)=0.0
+      DO 400 J=1,M
+400   B(K)=B(K)+GGG(K,J)*V(J)
+      YVAL=0.0
+      DO 460 I=1,M
+      FF=0.0
+      DO 240 J=1,NT
+240   FF=B(J)*GA(I,J)+FF
+      F(INDEX,I)=V(I)-FF
+460   YVAL=(V(I)-FF)**2+YVAL
+      RETURN
+      END
diff --git a/noao/onedspec/fortran/polft1.f b/noao/onedspec/fortran/polft1.f
new file mode 100644
index 00000000..625b69c7
--- /dev/null
+++ b/noao/onedspec/fortran/polft1.f
@@ -0,0 +1,205 @@
+C+
+C
+C  SUBROUTINE POLFT1
+C
+C  PURPOSE
+C	MAKE A LEAST SQUARES FIT TO DATA WITH A POLYNOMIAL CURVE
+C	Y = A(1) + A(2)*X + A(3)*X**2 + ...
+C
+C  USAGE
+C	CALL POLFIT(X,Y,SIGMAY,NPTS,NTERMS,MODE,A,CHISQR,ARR,IER)
+C
+C  DESCRIPTION OF PARAMETERS
+C	Y	- ARRAY OF DATA POINTS FOR DEPENDENT VARIABLE
+C	SIGMAY	- ARRAY OF STANDARD DEVIATIONS FOR Y-DATA POINTS
+C		  (OR - IN CASE MODE = 4 - WEIGHTS FOR POINTS)
+C	NPTS	- NO. OF PAIRS OF DATA POINTS
+C	NTERMS	- NO. OF COEFFICIENTS (DEGREE OF POLYNOMIAL + 1)
+C	MODE	- DETERMINES METHOD OF WEIGHTING LEAST SQUARES FIT
+C		  4 (USER DEFINED) WEIGHT(I) = SIGMAY(I)
+C		  3 (INSTRUMENTAL) WEIGHT(I) = 1./SIGMAY(I)**2
+C		  2 (NO WEIGHTING) WEIGHT(I) = 1.
+C		  1 (STATISTICAL)  WEIGHT(I) = 1./Y(I)
+C	A	- ARRAY OF COEFFICIENTS OF POLYNOMIAL
+C	CHISQR	- REDUCED CHISQUARE FOR FIT
+C	ARR	- DOUBLE PRECISION WORK BUFFER; MUST BE AT LEAST
+C		  400 WORDS LONG IN THE CALLING ROUTINE
+C	IER	- ERROR PARAMETER
+C		  -1 DET=0
+C		   0 O.K.
+C		  +1 NOT ENOUGH POINTS
+C
+C  SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
+C	DET(ARR,NORD) - EVALUATES THE DETERMINANT OF A SYMMETRIC
+C			TWO DIMENSIONAL MATRIX OF ORDER NORD
+C
+C  COMMENTS
+C	DIMENSION STATEMENT VALID FOR NTERMS UP TO 10
+C	FOR DETAILS OF ALGORITHM SEE "DATA REDUCTION AND ERROR
+C	ANALYSIS FOR THE PHYSICAL SCIENCES" - PH. R. BEVINGTON
+C	MC GRAW-HILL BOOK COMPANY
+C
+C	IN THIS SPECIAL VERSION THE ELEMENTS OF COEFFICIENT MATRIX
+C	ARR ARE NORMALIZED WITH RESPECT TO A VALUE COMPUTED VIA
+C	LOGARITHMIC INTERPOLATION BETWEEN THE SMALLEST AND LARGEST
+C	MATRIX ELEMENT
+C
+C  MODIFICATIONS BY A. SCHERMANN - INST. FOR ASTRONOMY,
+C	UNIV. OF VIENNA, AUSTRIA
+C
+C Modified to assume x-variable is index of Y array
+C-
+	SUBROUTINE POLFT1(Y,SIGMAY,NPTS,NTERMS,MODE,A,CHISQR,ARR,IER)
+	DOUBLE PRECISION SUMX(19),SUMY(10),ARR(10,10),XTERM,YTERM,
+     1	CHISQ
+	DIMENSION Y(1),SIGMAY(1),A(1)
+	IER=0
+C
+C  CHECK DEGREE OF FREEDOM
+	FREE=NPTS-NTERMS
+	IF(FREE.GT.0.) GOTO 11
+	IER=1
+	GOTO 80
+C
+C  ACCUMULATE WEIGHTED SUMS
+11	NMAX=2*NTERMS-1
+	DO 13 N=1,NMAX
+13	SUMX(N)=0.
+	DO 15 J=1,NTERMS
+15	SUMY(J)=0.
+	CHISQ=0.
+21	DO 50 I=1,NPTS
+	XI=I
+	YI=Y(I)
+31	GOTO(32,37,38,39),MODE
+32	IF(YI)35,37,33
+33	WEIGHT=1./YI
+	GOTO 41
+35	WEIGHT=-1./YI
+	GOTO 41
+37	WEIGHT=1.
+	GOTO 41
+38	WEIGHT=1./SIGMAY(I)**2
+	GOTO 41
+39	WEIGHT=SIGMAY(I)
+41	XTERM=WEIGHT
+	DO 44 N=1,NMAX
+	SUMX(N)=SUMX(N)+XTERM
+44	XTERM=XTERM*XI
+45	YTERM=WEIGHT*YI
+	DO 48 N=1,NTERMS
+	SUMY(N)=SUMY(N)+YTERM
+48	YTERM=YTERM*XI
+49	CHISQ=CHISQ+WEIGHT*YI**2
+50	CONTINUE
+C
+C  GET LARGEST AND SMALLEST MATRIX ELEMENT (FOR NORMALIZATION)
+	XTERM=SUMX(1)
+	YTERM=XTERM
+	DO 100 I=2,NMAX
+	IF(SUMX(I).GT.XTERM) XTERM=SUMX(I)
+	IF(SUMX(I).LT.YTERM) YTERM=SUMX(I)
+100	CONTINUE
+	DO 110 I=1,NTERMS
+	IF(SUMY(I).GT.XTERM) XTERM=SUMY(I)
+	IF(SUMY(I).LT.YTERM) YTERM=SUMY(I)
+110	CONTINUE
+	IF(YTERM.LE.0.) YTERM=1.D0
+C
+C  LOGARITHMIC INTERPOLATION OF NORMALIZATION VALUE
+	XTERM=1.D1**((DLOG10(XTERM)+DLOG10(YTERM))/2.)
+C
+C  CONSTRUCT MATRICES AND CALCULATE COEFFICIENTS
+51	DO 54 J=1,NTERMS
+	DO 54 K=1,NTERMS
+	N=J+K-1
+54	ARR(J,K)=SUMX(N)/XTERM
+	DELTA=DET(ARR,NTERMS)
+	IF(DELTA.NE.0.) GOTO 61
+57	CHISQR=0.
+	DO 59 J=1,NTERMS
+59	A(J)=0.
+	IER=-1
+	GOTO 80
+61	DO 70 L=1,NTERMS
+62	DO 66 J=1,NTERMS
+	DO 65 K=1,NTERMS
+	N=J+K-1
+65	ARR(J,K)=SUMX(N)/XTERM
+66	ARR(J,L)=SUMY(J)/XTERM
+70	A(L)=DET(ARR,NTERMS)/DELTA
+C
+C  CALCULATE CHISQUARE
+71	DO 75 J=1,NTERMS
+	CHISQ=CHISQ-2.*A(J)*SUMY(J)
+	DO 75 K=1,NTERMS
+	N=J+K-1
+75	CHISQ=CHISQ+A(J)*A(K)*SUMX(N)
+77	CHISQR=CHISQ/FREE
+80	RETURN
+	END
+c-----------------------------------------------------------
+	FUNCTION POLYNO (COE,NPOL,IX)
+C
+C EVALUATE A POLYNOMIAL OF ORDER NPOL WITH COEFFICIENTS COE(1),...,
+C COE (NPOL+1)  FOR AN INDEX IX
+C
+	DIMENSION COE(*)
+C
+	IF(NPOL.GT.0) GO TO 10
+	POLYNO=COE(1)
+	RETURN
+C
+10	POLYNO=COE(NPOL+1)
+	DO 20 I=NPOL,1,-1
+20	    POLYNO=POLYNO*IX+COE(I)
+C
+	RETURN
+	END
+c-----------------------------------------------------------
+C+
+C
+C  FUNCTION DET
+C
+C  PURPOSE
+C	CALCULATE DETERMINANT OF A SQUARE MATRIX
+C
+C  USAGE
+C	DET = DET (ARR,NORDER)
+C
+C  DESCRIPTION OF PARAMETERS
+C	ARRAY	- MATRIX
+C	NORDER	- DEGREE OF MATRIX
+C
+C  SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
+C		NONE
+C
+C  COMMENTS
+C	THIS SUBPROGRAM DESTROYS THE INPUT MATRIX ARRAY
+C
+	FUNCTION DET(ARRAY,NORDER)
+	DOUBLE PRECISION ARRAY(10,10),SAVE
+	DET=1.
+	DO 90 K=1,NORDER
+C  INTERCHANGE COLUMNS, IF DIAGONAL ELEMENT IS ZERO
+	IF(ARRAY(K,K).NE.0.) GOTO 40
+	DO 10 J=K,NORDER
+	IF(ARRAY(K,J).NE.0.) GOTO 20
+10	CONTINUE
+	DET=0.
+	GOTO 100
+20	DO 30 I=K,NORDER
+	SAVE=ARRAY(I,J)
+	ARRAY(I,J)=ARRAY(I,K)
+30	ARRAY(I,K)=SAVE
+	DET=-DET
+C  SUBTRACT ROW K FROM LOWER ROWS TO GET DIAGONAL MATRIX
+40	DET=DET*ARRAY(K,K)
+	IF(K-NORDER.GE.0) GOTO 90
+	K1=K+1
+	DO 50 I=K1,NORDER
+	DO 50 J=K1,NORDER
+50	ARRAY(I,J)=ARRAY(I,J)-ARRAY(I,K)*ARRAY(K,J)/ARRAY(K,K)
+90	CONTINUE
+100	RETURN
+	END
diff --git a/noao/onedspec/fortran/trans.f b/noao/onedspec/fortran/trans.f
new file mode 100644
index 00000000..038384ba
--- /dev/null
+++ b/noao/onedspec/fortran/trans.f
@@ -0,0 +1,21 @@
+      SUBROUTINE TRANS(Y,A,X)
+      DIMENSION  Y(10), A(10), X(10)      
+	COMMON /NLCPAR/XC(10), N, FIXSEP
+	LOGICAL FIXSEP
+C----- TRANSOFRMATION FOR GAUSSIAN LINES
+C
+C----- 'N' GAUSSIAN LINES
+C
+	Y(1)=EXP(-0.5*((X(1)-XC(1)-A(2))/A(1))**2)
+	DO 1000 I=2,N
+		IF(FIXSEP) THEN
+			DELTA=A(2)
+		ELSE
+			DELTA=A(2*I)
+		ENDIF
+		Y(1)=Y(1)+ABS(A(2*I-1)*EXP(-0.5*((X(1)-XC(I)-DELTA)/
+     *                        A(1))**2))
+1000	CONTINUE
+C            
+      RETURN      
+      END      
diff --git a/noao/onedspec/gcurval.dat b/noao/onedspec/gcurval.dat
new file mode 100644
index 00000000..3e8ae075
--- /dev/null
+++ b/noao/onedspec/gcurval.dat
@@ -0,0 +1 @@
+0 0 1 q
diff --git a/noao/onedspec/getairm.x b/noao/onedspec/getairm.x
new file mode 100644
index 00000000..5226702d
--- /dev/null
+++ b/noao/onedspec/getairm.x
@@ -0,0 +1,54 @@
+# GET_AIRM -- Derive airmass value from telescope data if possible
+#             Otherwise return INDEF
+#
+# Note that HA must be negative to the East.
+# If HA is not reasonable, then ST-RA is used
+
+procedure get_airm (ra, dec, ha, st, latitude, airm)
+
+real	ra, dec, ha, st, latitude, airm
+
+begin
+	# Verify realistic value for HA
+
+	if (IS_INDEF (ha)) {
+	    if (IS_INDEF (st) || IS_INDEF (ra))
+		call error (0, "Can't determine airmass")
+
+	    ha = st - ra
+	}
+
+	# Now verify DEC
+	if (IS_INDEF (dec))
+	    call error (0, "Can't determine airmass")
+
+	# Everything should be just fine now
+	# Compute airmass using method of John Ball
+
+	call airmass (dec, ha, latitude, airm)
+end
+
+# AIRMASS -- Compute airmass from RA, DEC, and HA
+#
+# Airmass formulation from Allen "Astrophysical Quantities" 1973 p.125,133.
+# and John Ball's book on Algorithms for the HP-45
+
+procedure airmass (dec, ha, latitude, airm)
+
+real	dec, ha, latitude, airm
+
+real	scale, rads, cos_zd, sin_elev
+real	x
+
+data	rads /57.29577951/		# Degrees per radian
+data	scale/750.0      /		# Atmospheric scale height approx
+
+begin
+	cos_zd = sin (latitude/rads) * sin (dec/rads) +
+	    cos (latitude/rads) * cos (dec/rads) * cos (ha*15/rads)
+
+	sin_elev = cos_zd		# SIN of elev = cos of Zenith dist
+
+	x  = scale * sin_elev
+	airm = sqrt (x**2 + 2*scale + 1) - x
+end
diff --git a/noao/onedspec/getcalib.x b/noao/onedspec/getcalib.x
new file mode 100644
index 00000000..6d7d77c4
--- /dev/null
+++ b/noao/onedspec/getcalib.x
@@ -0,0 +1,415 @@
+include <ctype.h>
+include	<error.h>
+include	<mach.h>
+
+define	STD_TYPES	"|star|blackbody|"
+define	UNKNOWN		0	# Unknown calibration file type
+define	STAR		1	# Standard star calibration file
+define	BLACKBODY	2	# Blackbody calibration file
+
+define	NALLOC	128	# Allocation block size
+
+# GETCALIB -- Get flux data.
+# This is either for a blackbody of specified magnitude and type or
+# a specified standard star with calibration data in a database directory.
+
+procedure getcalib (waves, dwaves, mags, nwaves)
+
+pointer	waves			#O Pointer to calibration wavelengths
+pointer	dwaves			#O Pointer to calibration bandpasses
+pointer	mags			#O Pointer to calibration magnitudes
+int	nwaves			#O Number of calibration points
+
+real	weff, wave, mag, dwave, wave1, wave2
+int	i, j, fd, nalloc
+pointer	sp, dir, star, name, file, type, units, band, str
+pointer	un, unang
+
+bool	streq()
+int	open(), fscan(), nscan(), getline(), strdic()
+pointer	un_open()
+errchk	getbbcal, open, un_open, un_ctranr
+define	getstd_	10
+
+begin
+	call smark (sp)
+	call salloc (dir, SZ_FNAME, TY_CHAR)
+	call salloc (star, SZ_FNAME, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (file, SZ_LINE, TY_CHAR)
+	call salloc (type, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call salloc (band, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	Memc[str] = EOS
+
+	# Convert the star name to a file name and open the file.
+	# If an error occurs print a list of files.
+
+getstd_	call clgstr ("caldir", Memc[dir], SZ_FNAME)
+	call clgstr ("star_name", Memc[star], SZ_FNAME)
+
+	call strcpy (Memc[star], Memc[name], SZ_LINE)
+	call strlwr (Memc[name])
+	j = name
+	for (i=name; Memc[i]!=EOS; i=i+1) {
+	    if (IS_WHITE(Memc[i]) || Memc[i]=='+' || Memc[i]=='-')
+		next
+	    Memc[j] = Memc[i]
+	    j = j + 1
+	}
+	Memc[j] = EOS
+
+	# Check if this is an alternate name.
+	call sprintf (Memc[file], SZ_LINE, "%snames.men")
+	    call pargstr (Memc[dir])
+	ifnoerr (fd = open (Memc[file], READ_ONLY, TEXT_FILE)) {
+	    while (fscan (fd) != EOF) {
+		call gargwrd (Memc[file], SZ_LINE)
+		if (streq (Memc[file], Memc[name])) {
+		    call gargwrd (Memc[name], SZ_LINE)
+		    break
+		}
+	    }
+	}
+
+	call sprintf (Memc[file], SZ_LINE, "%s%s.dat")
+	    call pargstr (Memc[dir])
+	    call pargstr (Memc[name])
+
+	iferr (fd = open (Memc[file], READ_ONLY, TEXT_FILE)) {
+	    if (streq (Memc[file], Memc[str]))
+		call erract (EA_ERROR)
+	    call strcpy (Memc[file], Memc[str], SZ_LINE)
+	    call sprintf (Memc[file], SZ_LINE, "%sstandards.men")
+		call pargstr (Memc[dir])
+	    fd = open (Memc[file], READ_ONLY, TEXT_FILE)
+	    while (getline (fd, Memc[file]) != EOF)
+		call putline (STDERR, Memc[file]) 
+	    call close (fd)
+	    Memc[star] = EOS
+	    goto getstd_
+	}
+
+	# Read the calibration data.
+	type = STAR
+	call strcpy ("angstroms", Memc[units], SZ_LINE)
+	Memc[band] = EOS
+	weff = INDEFR
+
+	nalloc = 0
+	nwaves = 0
+	while (fscan (fd) != EOF) {
+
+	    # Check for comments and parameters.
+	    call gargwrd (Memc[str], SZ_LINE)
+	    if (nscan() != 1)
+		next
+	    if (Memc[str] == '#') {
+		call gargwrd (Memc[str], SZ_LINE)
+		call strlwr (Memc[str])
+		if (streq (Memc[str], "type")) {
+		    call gargwrd (Memc[str], SZ_LINE)
+		    type = strdic (Memc[str], Memc[str], SZ_LINE, STD_TYPES)
+		} else if (streq (Memc[str], "units"))
+		    call gargwrd (Memc[units], SZ_LINE)
+		else if (streq (Memc[str], "band"))
+		    call gargwrd (Memc[band], SZ_LINE)
+		else if (streq (Memc[str], "weff"))
+		    call gargr (weff)
+		next
+	    }
+	    call reset_scan ()
+
+	    # Read data.
+	    call gargr (wave)
+	    call gargr (mag)
+	    call gargr (dwave)
+	    if (nscan() != 3)
+		next
+
+	    if (nalloc == 0) {
+		nalloc = nalloc + NALLOC
+		call malloc (waves, nalloc, TY_REAL)
+		call malloc (mags, nalloc, TY_REAL)
+		call malloc (dwaves, nalloc, TY_REAL)
+	    } else if (nwaves == nalloc) {
+		nalloc = nalloc + NALLOC
+		call realloc (waves, nalloc, TY_REAL)
+		call realloc (mags, nalloc, TY_REAL)
+		call realloc (dwaves, nalloc, TY_REAL)
+	    }
+
+	    Memr[waves+nwaves] = wave
+	    Memr[mags+nwaves] = mag
+	    Memr[dwaves+nwaves] = dwave
+	    nwaves = nwaves + 1
+	}
+	call close (fd)
+
+	if (nwaves == 0)
+	    call error (1, "No calibration data found")
+
+	call realloc (waves, nwaves, TY_REAL)
+	call realloc (mags, nwaves, TY_REAL)
+	call realloc (dwaves, nwaves, TY_REAL)
+
+	# This routine returns wavelengths in Angstroms.
+	un = un_open (Memc[units])
+	unang = un_open ("Angstroms")
+	call un_ctranr (un, unang, weff, weff, 1)
+	do i = 1, nwaves {
+	    wave = Memr[waves+i-1]
+	    dwave = Memr[dwaves+i-1]
+	    wave1 = wave - dwave / 2
+	    wave2 = wave + dwave / 2
+	    call un_ctranr (un, unang, wave1, wave1, 1)
+	    call un_ctranr (un, unang, wave2, wave2, 1)
+	    wave = (wave1 + wave2) / 2.
+	    dwave = abs (wave1 - wave2)
+	    Memr[waves+i-1] = wave
+	    Memr[dwaves+i-1] = dwave
+	}
+	call un_close (un)
+	call un_close (unang)
+
+	switch (type) {
+	case UNKNOWN:
+	    call freecalib (waves, dwaves, mags)
+	    call error (1, "Unknown calibration type")
+	case BLACKBODY:
+	    call getbbcal (Memr[waves], Memr[mags], nwaves, Memc[band],
+		weff, Memc[dir])
+	}
+
+	call sfree (sp)
+end
+
+
+# GETBBCAL -- Get blackbody calibration data.
+
+procedure getbbcal (waves, mags, nwaves, band, weff, caldir)
+
+real	waves[nwaves]		#I Calibration wavelengths
+real	mags[nwaves]		#I Calibration magnitudes
+int	nwaves			#I Number of calibration points
+char	band[ARB]		#I Bandpass of data
+real	weff			#I Effective wavelength
+char	caldir[ARB]		#I Calibration directory
+
+int	i, j, col1, col2, fd
+real	mag, m1, m2, dm, teff, t, dt
+pointer	sp, bands, magband, sptype, default, fname, str
+
+bool	streq(), strne()
+int	clgwrd(), nowhite(), ctor(), strdic(), strncmp()
+int	open(), fscan(), nscan()
+real	clgetr()
+errchk	open
+
+begin
+	if (band [1] == EOS || IS_INDEFR(weff))
+	    call error (1,
+	    "Blackbody calibration file has no band or effective wavelength")
+
+	call smark (sp)
+	call salloc (bands, SZ_LINE, TY_CHAR)
+	call salloc (magband, SZ_LINE, TY_CHAR)
+	call salloc (sptype, SZ_LINE, TY_CHAR)
+	call salloc (default, SZ_LINE, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Create list of acceptable magnitudes.
+	call sprintf (Memc[bands], SZ_LINE, "|")
+	call sprintf (Memc[fname], SZ_FNAME, "%sparams.dat")
+	    call pargstr (caldir)
+	ifnoerr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE)) {
+	    while (fscan (fd) != EOF) {
+		call gargwrd (Memc[str], SZ_LINE)
+		if (Memc[str] != '#')
+		    next
+		call gargwrd (Memc[str], SZ_LINE)
+		if (strne (Memc[str], "Type"))
+		    next
+
+		call gargwrd (Memc[str], SZ_LINE)
+		j = nscan()
+		repeat {
+		    i = j
+		    call gargwrd (Memc[str], SZ_LINE)
+		    j = nscan()
+		    if (i == j)
+			break
+		    call strcat (Memc[str], Memc[bands], SZ_LINE)
+		    call strcat ("|", Memc[bands], SZ_LINE)
+		}
+		break
+	    }
+	    call close (fd)
+	}
+	col1 = strdic (band, Memc[str], SZ_LINE, Memc[bands]) + 2
+	if (col1 == 2) {
+	    call strcat (band, Memc[bands], SZ_LINE)
+	    call strcat ("|", Memc[bands], SZ_LINE)
+	}
+	col1 = strdic (band, Memc[str], SZ_LINE, Memc[bands]) + 2
+	call clpstr ("magband.p_min", Memc[bands])
+
+	# Get blackbody parameters.
+	mag = clgetr ("mag")
+	col2 = clgwrd ("magband", Memc[magband], SZ_LINE, Memc[bands]) + 2
+	call clgstr ("teff", Memc[sptype], SZ_LINE)
+	i = nowhite (Memc[sptype], Memc[sptype], SZ_LINE)
+
+	# Convert spectral type to effective temperature.
+	i = 1
+	if (ctor (Memc[sptype], i, teff) == 0) {
+	    teff = INDEFR
+	    call sprintf (Memc[fname], SZ_FNAME, "%sparams.dat")
+		call pargstr (caldir)
+	    fd = open (Memc[fname], READ_ONLY, TEXT_FILE)
+	    while (fscan (fd) != EOF) {
+		call gargwrd (Memc[str], SZ_FNAME)
+		if (strncmp (Memc[str], Memc[sptype], 2) != 0)
+		    next
+		call gargr (t)
+		if (nscan() < 2)
+		    next
+
+		call strcpy (Memc[str], Memc[default], SZ_LINE)
+		teff = t
+
+		if (streq (Memc[default], Memc[sptype]))
+		    break
+	    }
+	    call close (fd)
+
+	    if (IS_INDEFR(teff))
+		call error (1, "Failed to determine effective temperature")
+	    if (strne (Memc[default], Memc[sptype])) {
+		call eprintf ("WARNING: Effective temperature for %s not found")
+		    call pargstr (Memc[sptype])
+		call eprintf (" - using %s\n")
+		    call pargstr (Memc[default])
+		call strcpy (Memc[default], Memc[sptype], SZ_LINE)
+	    }
+	} else
+	    Memc[sptype] = EOS
+
+	# Transform the input magnitude from the input passband to the
+	# data passband if necessary.
+	if (strne (Memc[magband], band)) {
+	    
+	    # Get spectral type if necessary.
+	    if (Memc[sptype] == EOS) {
+		dt = MAX_REAL
+		call sprintf (Memc[fname], SZ_FNAME, "%sparams.dat")
+		    call pargstr (caldir)
+		fd = open (Memc[fname], READ_ONLY, TEXT_FILE)
+		while (fscan (fd) != EOF) {
+		    call gargwrd (Memc[str], SZ_FNAME)
+		    if (Memc[str+2] != 'V')
+			next
+		    call gargr (t)
+		    if (nscan() < 2)
+			next
+		    if (abs (t - teff) < dt) {
+			dt = abs (t - teff)
+			call strcpy (Memc[str], Memc[sptype], SZ_LINE)
+		    }
+		}
+		call close (fd)
+
+		if (Memc[sptype] == EOS)
+		    call error (1, "Failed to determine spectral type")
+		call eprintf ("WARNING: Assuming spectral type of %s\n")
+		    call pargstr (Memc[sptype])
+	    }
+
+	    # Get magnitude correction.
+	    dm = INDEFR
+	    call sprintf (Memc[fname], SZ_FNAME, "%sparams.dat")
+		call pargstr (caldir)
+	    fd = open (Memc[fname], READ_ONLY, TEXT_FILE)
+	    while (fscan (fd) != EOF) {
+		call gargwrd (Memc[str], SZ_LINE)
+		if (strncmp (Memc[str], Memc[sptype], 2) != 0)
+		    next
+
+		call gargr (t)
+
+		m1 = INDEFR
+		m2 = INDEFR
+		do i = 1, max (col1, col2) {
+		    call gargr (t)
+		    if (i == col1)
+			m1 = t
+		    if (i == col2)
+			m2 = t
+		}
+
+		if (!IS_INDEFR(m1) && !IS_INDEFR(m2)) {
+		    call strcpy (Memc[str], Memc[default], SZ_LINE)
+		    dm = m1 - m2
+		    if (streq (Memc[default], Memc[sptype]))
+			break
+		}
+	    }
+	    call close (fd)
+
+	    if (IS_INDEFR(dm)) {
+		call sprintf (Memc[str], SZ_LINE,
+		"No information in %s to convert %s mag to %s mag for %s star")
+		    call pargstr (Memc[fname])
+		    call pargstr (Memc[magband])
+		    call pargstr (band)
+		    call pargstr (Memc[sptype])
+		call error (1, Memc[str])
+	    }
+	    if (strne (Memc[default], Memc[sptype])) {
+		call eprintf (
+		"WARNING: Converting %s mag to %s mag using spectral type %s\n")
+		    call pargstr (Memc[magband])
+		    call pargstr (band)
+		    call pargstr (Memc[default])
+	    }
+
+	    mag = mag + dm
+
+	    call eprintf ("Blackbody: %s = %.2f, %s = %.2f, Teff = %d\n")
+		call pargstr (Memc[magband])
+		call pargr (mag - dm)
+		call pargstr (band)
+		call pargr (mag)
+		call pargr (teff)
+
+	} else {
+	    call eprintf ("Blackbody: %s = %.2f, Teff = %d\n")
+		call pargstr (band)
+		call pargr (mag)
+		call pargr (teff)
+	}
+
+	# Convert the calibration magnitudes to the specified magnitude and
+	# apply the blackbody function.
+	m1 = -2.5 * log10 (weff**3 * (exp(1.4387E8/(weff*teff)) - 1))
+	do i = 1, nwaves
+	    mags[i] = mags[i] + mag + m1 +
+		2.5 * log10 (waves[i]**3 * (exp(1.4387E8/(waves[i]*teff)) - 1))
+
+	call sfree (sp)
+end
+
+
+# FREECALIB -- Free calibration data arrays.
+
+procedure freecalib (waves, dwaves, mags)
+
+pointer	waves, dwaves, mags
+
+begin
+	call mfree (waves, TY_REAL)
+	call mfree (dwaves, TY_REAL)
+	call mfree (mags, TY_REAL)
+end
diff --git a/noao/onedspec/getextn.x b/noao/onedspec/getextn.x
new file mode 100644
index 00000000..82640152
--- /dev/null
+++ b/noao/onedspec/getextn.x
@@ -0,0 +1,209 @@
+include	<error.h>
+include	<syserr.h>
+
+define	EXTN_LOOKUP	10	# Interp index for de-extinction
+define	DEXTN_LOOKUP	11	# Interp index for differential extn table
+define	TEMP_SPACE	100	# Amount of temporary space to allocate
+
+# GET_EXTN -- Get extinction from calibration file and
+#             any update as indicated from the SENSITIVITY
+#             computation
+
+procedure get_extn (wave_tbl, extn_tbl, nwaves)
+
+pointer	wave_tbl, extn_tbl
+int	nwaves
+
+pointer	waves, extns
+
+begin
+	# Get standard extinction values
+	call ext_load (waves, extns, nwaves)
+
+	# Copy values to external pointer.
+	# Use of salloc is incorrect but this is a hack on old code. FV
+	call salloc (extn_tbl, nwaves, TY_REAL)
+	call salloc (wave_tbl, nwaves, TY_REAL)
+	call amovr (Memr[waves], Memr[wave_tbl], nwaves)
+	call amovr (Memr[extns], Memr[extn_tbl], nwaves)
+	call mfree (waves, TY_REAL)
+	call mfree (extns, TY_REAL)
+end
+
+
+# DE_EXT_SPEC -- Apply extinction correction to a spectrum
+
+procedure de_ext_spec (spec, airm, w0, wpc, wave_tbl, extn_tbl, nwaves, len)
+
+real	spec[ARB], wave_tbl[ARB], extn_tbl[ARB]
+real	airm, w0, wpc
+int	nwaves, len
+
+int	i, ierr
+real	wave, ext
+bool	lin_log
+
+begin
+	# Assume linear dispersion, but possibly in LOG10
+	if (w0 < 5.0 && wpc < 0.05)
+	    lin_log = true
+	else
+	    lin_log = false
+
+	# Initialize interpolator
+	call intrp0 (EXTN_LOOKUP)
+
+	do i = 1, len {
+	    wave = w0 + (i-1) * wpc
+	    if (lin_log)
+		wave = 10.0 ** wave
+
+	    # Table must be in wavelength, not log[]
+	    call intrp (EXTN_LOOKUP, wave_tbl, extn_tbl, nwaves, 
+		wave, ext, ierr)
+
+	    spec[i] = spec[i] * 10.0 ** (0.4 * airm * ext)
+	}
+end
+
+# SUM_SPEC -- Add up counts within a specified region of a spectrum
+#             denoted by a wavelength range.
+#             The summation is active only over those pixels which
+#             are completely within the range specification.
+#             Data referenced outside the spectrum is ignored.
+
+procedure sum_spec (spec, w1, w2, w0, wpc, counts, len)
+
+real	spec[ARB], w1, w2, w0, wpc, counts
+int	len
+
+int	i, pix1, pix2
+
+real	pix_index()
+
+begin
+	# Compute pixel numbers from w1 to w2
+	pix1 = max (int (pix_index (w0, wpc, w1) + 1.0), 1)
+	pix2 = max (int (pix_index (w0, wpc, w2)      ), pix1)
+	pix2 = min (pix2, len)
+
+	counts = 0.0
+
+	do i = pix1, pix2
+	    counts = counts + spec[i]
+
+	# Guarantee that there are no negative counts
+	if (counts < 0.0)
+	    counts = 0.0
+end
+
+# PIX_INDEX -- Returns the pixel index at wavelength for linearly
+#              dispersion corrected spectra
+#
+#              The "Guess" is made that if the start wavelength for the
+#              spectrum is less than 5.0 and the dispersion is less than
+#              0.05, the spectrum has been linearized in LOG10 space.
+#
+# Note that in IRAF, a pixel index effectively refers to the center of a pixel.
+# So a spectrum must actually extend from w0-0.5*wpc to w0+(len+0.5)*wpc
+
+real procedure pix_index (w0, wpc, w)
+
+real	w0, wpc, w
+real	xw
+
+begin
+	# Check for LOG10 dispersion
+
+	if (w0 < 5.0 && wpc < 0.05)
+	    xw = log10 (w)
+	else
+	    xw = w
+
+	pix_index = (xw - w0) / wpc + 1.0
+end
+
+
+define	NALLOC	128	# Allocation block size
+
+# EXT_LOAD -- Read extinction data from database directory.
+
+procedure ext_load (waves, extns, nwaves)
+
+pointer	waves, extns
+int	nwaves
+
+real	wave, extn
+int	fd, nalloc
+pointer	sp, file
+
+int	open(), fscan(), nscan(), errcode()
+
+begin
+	call smark (sp)
+	call salloc (file, SZ_FNAME, TY_CHAR)
+
+	# Get the extinction file and open it.
+	call clgstr ("extinction", Memc[file], SZ_FNAME)
+	iferr (fd = open (Memc[file], READ_ONLY, TEXT_FILE)) {
+	    switch (errcode()) {
+	    case SYS_FNOFNAME:
+		nwaves = 2
+		call malloc (waves, nwaves, TY_REAL)
+		call malloc (extns, nwaves, TY_REAL)
+		Memr[waves] = 1000.
+		Memr[extns] = 0.
+		Memr[waves+1] = 10000.
+		Memr[extns+1] = 0.
+		call eprintf ("No extinction correction applied\n")
+		return
+	    default:
+		call erract (EA_ERROR)
+	    }
+	}
+
+	# Read the extinction data.
+	nalloc = 0
+	nwaves = 0
+	while (fscan (fd) != EOF) {
+	    call gargr (wave)
+	    call gargr (extn)
+	    if (nscan() != 2)
+		next
+
+	    if (nalloc == 0) {
+		nalloc = nalloc + NALLOC
+		call malloc (waves, nalloc, TY_REAL)
+		call malloc (extns, nalloc, TY_REAL)
+	    } else if (nwaves == nalloc) {
+		nalloc = nalloc + NALLOC
+		call realloc (waves, nalloc, TY_REAL)
+		call realloc (extns, nalloc, TY_REAL)
+	    }
+
+	    Memr[waves+nwaves] = wave
+	    Memr[extns+nwaves] = extn
+	    nwaves = nwaves + 1
+	}
+	call close (fd)
+
+	if (nwaves == 0)
+	    call error (1, "No extinction data found")
+
+	call realloc (waves, nwaves, TY_REAL)
+	call realloc (extns, nwaves, TY_REAL)
+
+	call sfree (sp)
+end
+
+
+# EXT_FREE -- Free extinction data arrays.
+
+procedure ext_free (waves, extns)
+
+pointer	waves, extns
+
+begin
+	call mfree (waves, TY_REAL)
+	call mfree (extns, TY_REAL)
+end
diff --git a/noao/onedspec/hireswcal.cl b/noao/onedspec/hireswcal.cl
new file mode 100644
index 00000000..f4d41986
--- /dev/null
+++ b/noao/onedspec/hireswcal.cl
@@ -0,0 +1,68 @@
+# HIRESWCAL -- Apply HIRES wavelengths to flux data to produce an IRAF file.
+#
+# This script requires the onedspec, proto, and artdata packages be loaded.
+
+procedure hireswcal (input, waves, output)
+
+file	input		{prompt="Input hires data file"}
+file	waves		{prompt="Input matching hires wavelength file"}
+file	output		{prompt="Output IRAF file"}
+
+struct	*fd		# Required to loop through a list.
+
+begin
+	file	in, win, out
+	file	im, wim, out1, tmp
+	int	ap
+
+	# Set query parameters.
+	in = input
+	win = waves
+	out = output
+
+	# Check if output is already present.
+	if (imaccess(out))
+	    error (1, "Output already exists ("//out//")")
+
+	# Define a temporary file rootname.
+	tmp = mktemp ("tmp")
+
+	# Expand input into a list of spectra.
+	slist (in, apertures="", long-, > tmp)
+
+	# For each spectrum in the list create an IRAF 1D spectrum.
+	fd = tmp
+	while (fscan (fd, im, ap) != EOF) {
+
+	    # Form names for each spectrum.
+	    printf ("%s[*,%d]\n", in, ap) | scan (im)
+	    printf ("%s[*,%d]\n", win, ap) | scan (wim)
+	    printf ("%s_%d\n", tmp, ap) | scan (out1)
+
+	    # Dump the wavelengths and flux and put together into
+	    # a file for rspectext.
+
+	    listpix (wim, v-, > tmp//"waves")
+	    listpix (im, v-, > tmp//"flux")
+	    joinlines (tmp//"waves", tmp//"flux") |
+	        fields ("STDIN", "2,4", > tmp//"join")
+
+	    # Create the IRAF spectrum.
+	    rspectext (tmp//"join", out1, title="", flux-, dtype="interp")
+
+	    # Delete working files.
+	    delete (tmp//"[wfj]*", v-)
+	    print (out1, >> tmp//".list")
+	}
+	fd = ""; delete (tmp, v-)
+
+	# Put the 1D spectrum into a multispec file.
+	scopy ("@"//tmp//".list", out, format="multispec", renumber+)
+
+	# Add the input header for what its worth.
+	mkhead (out, in, append+, verbose-)
+
+	# Finish up.
+	imdelete ("@"//tmp//".list", v-)
+	delete (tmp//"*", v-)
+end
diff --git a/noao/onedspec/identify.par b/noao/onedspec/identify.par
new file mode 100644
index 00000000..04d76993
--- /dev/null
+++ b/noao/onedspec/identify.par
@@ -0,0 +1,33 @@
+# Parameters for identify task.
+
+images,s,a,,,,Images containing features to be identified
+section,s,h,"middle line",,,Section to apply to two dimensional images
+database,f,h,database,,,Database in which to record feature data
+coordlist,f,h,linelists$idhenear.dat,,,User coordinate list
+units,s,h,"",,,Coordinate units
+nsum,s,h,"10",,,Number of lines/columns/bands to sum in 2D images
+match,r,h,-3.,,,Coordinate list matching limit
+maxfeatures,i,h,50,,,Maximum number of features for automatic identification
+zwidth,r,h,100.,,,Zoom graph width in user units
+
+ftype,s,h,"emission","emission|absorption",,Feature type
+fwidth,r,h,4.,,,Feature width in pixels
+cradius,r,h,5.,,,Centering radius in pixels
+threshold,r,h,0.,0.,,Feature threshold for centering
+minsep,r,h,2.,0.,,Minimum pixel separation
+
+function,s,h,"spline3","legendre|chebyshev|spline1|spline3",,Coordinate function
+order,i,h,1,1,,Order of coordinate function
+sample,s,h,"*",,,Coordinate sample regions
+niterate,i,h,0,0,,Rejection iterations
+low_reject,r,h,3.,0.,,Lower rejection sigma
+high_reject,r,h,3.,0.,,Upper rejection sigma
+grow,r,h,0.,0.,,Rejection growing radius
+
+autowrite,b,h,no,,,"Automatically write to database"
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
+
+crval,s,q,,,,"Approximate coordinate (at reference pixel)"
+cdelt,s,q,,,,"Approximate dispersion"
+aidpars,pset,h,,,,"Automatic identification algorithm parameters"
diff --git a/noao/onedspec/identify/autoid/aidautoid.x b/noao/onedspec/identify/autoid/aidautoid.x
new file mode 100644
index 00000000..7c213b4a
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidautoid.x
@@ -0,0 +1,314 @@
+include	<mach.h>
+include	<gset.h>
+include	<math/iminterp.h>
+include	<smw.h>
+include	"../identify.h"
+include	"autoid.h"
+
+
+# List of debug key letters.
+# Debug a: Print candidate line assignments.
+# Debug b: Print search limits.
+# Debug c: Print list of line ratios.
+# Debug d: Graph dispersions.
+# Debug f: Print final result.
+# Debug i: Show ICFIT iterations.
+# Debug l: Graph lines and spectra.
+# Debug m: Print miscellaneous debug information
+# Debug n: Show non-linearity constraint
+# Debug r: Print list of reference lines.
+# Debug s: Print search iterations.
+# Debug t: Print list of target lines.
+# Debug v: Print vote array.
+# Debug w: Print wavelength bin limits.
+
+
+# AID_AUTOID -- Automatically identify spectral features.
+# This routine is main entry to the autoidentify algorithms.
+# The return value is true if the ID pointer contains a new solution
+# and false if the ID pointer is the original solution.
+
+bool procedure aid_autoid (id, aid)
+
+pointer	id		#I ID pointer
+pointer	aid		#U AID pointer
+
+bool	cdflip
+int	i, j, k, l, iev, nbins, bin, nbest
+double	best, dval1, dval2
+pointer	sp, str, idr, ev, evf, sid
+
+bool	streq(), strne()
+int	stridxs()
+double	dcveval(), aid_eval()
+pointer	gopen(), aid_evalloc(), id_getid()
+errchk	id_mapll, aid_reference, aid_target, aid_autoid1, aid_evalutate
+
+define	done_	10
+define	redo_	20
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Save original data.
+	call id_saveid (id, "autoidentify backup")
+
+	# Initialize.
+	AID_IDT(aid) = id
+	call ic_putr (AID_IC1(aid), "xmin", real (PIXDATA(id,1)))
+	call ic_putr (AID_IC1(aid), "xmax", real (PIXDATA(id,ID_NPTS(id))))
+	AID_IC2(aid) = ID_IC(id)
+
+	if (stridxs ("ild", AID_DEBUG(aid,1)) != 0 && ID_GP(id) == NULL) {
+	    call clgstr ("graphics", Memc[str], SZ_LINE)
+	    ID_GP(id) = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH)
+	} else if (AID_DEBUG(aid,1) != EOS && ID_GP(id) != NULL)
+	    call gdeactivate (ID_GP(id), 0)
+
+	idr = AID_IDR(aid)
+	if (idr == NULL) {
+	    call id_init (AID_IDR(aid))
+	    idr = AID_IDR(aid)
+	}
+
+	# Set reference coordinate list.
+	if (strne (AID_REFLIST(aid), ID_COORDLIST(idr)) ||
+	    streq (AID_REFLIST(aid), "FEATURES")) {
+	    call id_unmapll (idr)
+	    ID_COORDLIST(idr) = EOS
+
+	    if (streq (AID_REFLIST(aid), "FEATURES")) {
+		if (ID_NFEATURES(id) >= 10) {
+		    call strcpy (AID_REFLIST(aid), ID_COORDLIST(idr),
+			ID_LENSTRING)
+		    i = ID_NFEATURES(id)
+		    ID_NLL(idr) = i
+		    call calloc (ID_LL(idr), i+1, TY_DOUBLE)
+		    call calloc (ID_LLL(idr), i+1, TY_POINTER)
+		    call amovd (USER(id,1), Memd[ID_LL(idr)], i)
+		    Memd[ID_LL(idr)+i] = INDEFD
+		}
+	    } else if (AID_REFLIST(aid) != EOS) {
+		call strcpy (AID_REFLIST(aid), ID_COORDLIST(idr), ID_LENSTRING)
+		call id_mapll (idr)
+	    }
+	}
+
+	# Get reference spectrum.
+	if (AID_REFSPEC(aid) != EOS)
+	    call strcpy (AID_REFSPEC(aid), ID_COORDSPEC(idr), ID_LENSTRING)
+	else if (ID_COORDSPEC(idr) == EOS)
+	    call strcpy (ID_COORDSPEC(id), ID_COORDSPEC(idr), ID_LENSTRING)
+	if (strne (ID_COORDSPEC(idr), ID_IMAGE(idr))) {
+	    if (ID_SH(idr) != NULL) {
+		call smw_close (MW(ID_SH(idr)))
+		call imunmap (IM(ID_SH(idr)))
+		call shdr_close (ID_SH(idr))
+	    }
+	    call strcpy (ID_COORDSPEC(idr), ID_IMAGE(idr), ID_LENSTRING)
+	    ifnoerr (call id_map (idr))
+		call id_gdata(idr)
+	    else {
+		ID_COORDSPEC(idr) = EOS
+		ID_IMAGE(idr) = EOS
+	    }
+	}
+
+	ID_MAXFEATURES(idr) = AID_NRMAX(aid)
+	ID_MINSEP(idr) = ID_MINSEP(id)
+	ID_FTYPE(idr) = ID_FTYPE(id)
+	ID_FWIDTH(idr) = ID_FWIDTH(id)
+	ID_CRADIUS(idr) = ID_CRADIUS(id)
+	ID_THRESHOLD(idr) = ID_THRESHOLD(id)
+	ID_MATCH(idr) = ID_MATCH(id)
+
+	# Use faster, less accurate centering for the search.
+	call c1d_params (II_LINEAR, 0.02)
+
+	# Set target lines and dispersion limits.
+	call aid_target (aid)
+	cdflip = (AID_CDDIR(aid) == CDUNKNOWN ||
+	    (IS_INDEFD(AID_CDELT(aid)) && AID_CDDIR(aid) == CDSIGN))
+
+	# Now search for the dispersion function and line identifications.
+	# The reference spectrum is broken up into a varying number of
+	# pieces and each is searched.  The order in which the reference
+	# spectrum is divided is from the middle outward and overlapping
+	# bins are tried as a second pass.  The hope is to find a
+	# piece that is close enough to the target spectrum as quickly
+	# as possible.
+
+	AID_BEST(aid) = MAX_REAL
+	nbest = 0
+	iev = 0
+redo_
+	do i = 0, 1 {
+	    do j = 1, AID_NB(aid) {
+		if (j == 1)
+		    nbins = (AID_NB(aid) + 2) / 2
+		else if (mod (j, 2) == 0)
+		    nbins = (AID_NB(aid) + 2 - j) / 2
+		else
+		    nbins = (AID_NB(aid) + 1 + j) / 2
+		nbins = 2 * nbins - 1
+		do k = 1, nbins {
+		    if (k == 1)
+			bin = (nbins + 2) / 2
+		    else if (mod (k, 2) == 0)
+			bin = (nbins + 2 - k) / 2
+		    else
+			bin = (nbins + 1 + k) / 2
+		    if (mod ((nbins-1)/2, 2) == 0) {
+			if (mod (bin, 2) == i)
+			    next
+		    } else {
+			if (mod (bin, 2) != i)
+			    next
+		    }
+
+		    iferr {
+			iev = iev + 1
+			ev = aid_evalloc (aid, iev)
+			AID_BIN1(ev) = nbins
+			AID_BIN2(ev) = bin
+			call aid_reference (aid, ev, NO)
+			call aid_autoid1 (aid, ev)
+		    } then {
+			AID_ND(ev) = 0
+		    }
+		    if (cdflip) {
+			iferr {
+			    iev = iev + 1
+			    evf = aid_evalloc (aid, iev)
+			    AID_BIN1(evf) = nbins
+			    AID_BIN2(evf) = bin
+			    call aid_reference (aid, evf, YES)
+			    call aid_autoid1 (aid, evf)
+			} then {
+			    AID_ND(evf) = 0
+			}
+		    }
+
+		    # Search the candidates with the highest weights.
+		    # Terminate the search if the number of best fit values
+		    # less than 1. is equal to the specified number.
+		    do l = 1, 5 {
+			best = aid_eval (aid, ev, l)
+			if (!IS_INDEFD(best) && best < 1.) {
+			    nbest = nbest + 1
+			    if (nbest >= AID_NBEST(aid))
+				goto done_
+			}
+			if (cdflip) {
+			    best = aid_eval (aid, evf, l)
+			    if (!IS_INDEFD(best) && best < 1.) {
+				nbest = nbest + 1
+				if (nbest >= AID_NBEST(aid))
+				    goto done_
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	# Go back and evaluate candidates with lower weights.
+	# Terminate the search if the number of best fit values
+	# less than 1. is equal to the specified number.
+	do j = 6, AID_ND(ev) {
+	    do i = 1, iev {
+		ev = aid_evalloc (aid, i)
+		best = aid_eval (aid, ev, j)
+		if (!IS_INDEFD(best) && best < 1.) {
+		    nbest = nbest + 1
+		    if (nbest >= AID_NBEST(aid))
+			goto done_
+		}
+	    }
+	}
+
+	# Add other loops here.
+	if (AID_BEST(aid) > 1.) {
+	    if (AID_NP(aid) > 3) {
+	        AID_NP(aid) = AID_NP(aid) - 1
+		goto redo_
+	    }
+	}
+
+done_
+	do i = 1, iev
+	    call aid_evfree (aid, i)
+
+	# Evaluate the final solution with the full dispersion function.
+	# Save the final solution.  If the final solution has a merit
+	# greater than one restore the original solution.
+
+	sid = id_getid (id, "autoidentify")
+	if (sid != NULL) {
+	    call dcvfree (ID_CV(id))
+	    iferr (call aid_dofitf (aid, id))
+		;
+	    call id_sid (id, sid)
+	} else {
+	    ID_NFEATURES(id) = 0
+	    call dcvfree (ID_CV(id))
+	    call id_saveid (id, "autoidentify")
+	}
+
+	# Debug f: Print final result.
+	if (stridxs ("f", AID_DEBUG(aid,1)) != 0) {
+	    if (AID_BEST(aid) == MAX_REAL) {
+		call eprintf ("%s %8.5g %8.3g     No solution found\n")
+		    call pargstr (ID_IMAGE(id))
+		    call pargd (AID_CRVAL(aid))
+		    call pargd (AID_CDELT(aid))
+	    } else {
+		call eprintf (
+		    "%s %8.5g %8.3g %8.5g %8.3g %3d %3d %6.3f %5.2f\n")
+		    call pargstr (ID_IMAGE(id))
+		    call pargd (AID_CRVAL(aid))
+		    call pargd (AID_CDELT(aid))
+		    if (ID_CV(id) == NULL) {
+			dval1 = FITDATA(id,1)
+			dval2 = FITDATA(id,2) - FITDATA(id,1)
+		    } else  {
+			dval1 = dcveval (ID_CV(id), AID_CRPIX(aid)+1D0)
+			dval2 = dcveval (ID_CV(id), AID_CRPIX(aid)-1D0)
+			dval2 = (dval1 - dval2) / 2D0
+			dval1 = dcveval (ID_CV(id), AID_CRPIX(aid))
+		    }
+		    call pargd (dval1)
+		    call pargd (FITDATA(id,2) - FITDATA(id,1))
+		    call pargi (nint(100.*AID_FMATCH(aid)))
+		    call pargi (nint(100.*AID_FTMATCH(aid)))
+		    call pargr (AID_RMS(aid))
+		    call pargr (AID_BEST(aid))
+		call eprintf (
+		    "   dCRVAL = %.4g (%.3g),  dCDELT = %.4g (%.3g)\n")
+		    call pargd (dval1 - AID_CRVAL(aid))
+		    call pargd (abs((dval1-AID_CRVAL(aid))/
+		        (ID_NPTS(id)*AID_CDELT(aid))))
+		    call pargd (dval2 - AID_CDELT(aid))
+		    call pargd (abs((dval2-AID_CDELT(aid))/AID_CDELT(aid)))
+	    }
+	}
+
+	if (AID_BEST(aid) > 1.) { 
+	    ID_NFEATURES(id) = 0
+	    ID_CURRENT(id) = 0
+	    call dcvfree (ID_CV(id))
+	    sid = id_getid (id, "autoidentify backup")
+	    ID_NEWFEATURES(id) = NO
+	    ID_NEWCV(id) = NO
+	    ID_NEWGRAPH(id) = NO
+	}
+	call id_fitdata (id)
+
+	# Restore centering.
+	call c1d_params (II_SPLINE3, 0.001)
+
+	call sfree (sp)
+
+	return (AID_BEST(aid) <= 1.)
+end
diff --git a/noao/onedspec/identify/autoid/aidget.x b/noao/onedspec/identify/autoid/aidget.x
new file mode 100644
index 00000000..ba3c9342
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidget.x
@@ -0,0 +1,21 @@
+include	"autoid.h"
+
+define	AIDGET "|best|"
+
+
+# AID_GETR -- Get AID parameters by name.
+
+real procedure aid_getr (aid, param)
+
+pointer	aid		#I AID object
+char	param[ARB]	#I Parameter name
+
+char	temp[10]
+int	strdic()
+
+begin
+	switch (strdic (param, temp, 10, AIDGET)) {
+	case 1:
+	    return (AID_BEST(aid))
+	}
+end
diff --git a/noao/onedspec/identify/autoid/aidgraph.x b/noao/onedspec/identify/autoid/aidgraph.x
new file mode 100644
index 00000000..35494004
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidgraph.x
@@ -0,0 +1,240 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	"../identify.h"
+include	"autoid.h"
+
+
+# AID_LGRAPH -- Graph target and reference spectra and associated lines.
+# This is only used for debugging.
+
+procedure aid_lgraph (aid, x1, n1, x2, n2)
+
+pointer	aid		#I AID pointer
+double	x1[n1]		#I Reference lines
+int	n1		#I Number of reference lines
+double	x2[n2]		#I Target lines
+int	n2		#I Number of target lines
+
+int	i, wcs, key, nr, nt, redraw, clgcur(), stridxs()
+real	wx, wy, wz, a, b, c, d, dy, ytmin, ytmax
+pointer	sp, cmd, id, sht, shr, gp, gt, xr, yr, yt, y, gt_init()
+double	shdr_lw()
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	id = AID_IDT(aid)
+	sht = ID_SH(id)
+	shr = ID_SH(AID_IDR(aid))
+
+	gp = ID_GP(id)
+	if (gp == NULL)
+	    return
+	gt = gt_init()
+	call gt_sets (gt, GTTYPE, "line")
+	call gt_seti (gt, GTSYSID, NO)
+	if (DC(sht) == DCNO || WP(sht) * AID_CDSIGN(aid) < 0.) {
+	    call gt_setr (gt, GTXMIN, AID_W1(aid))
+	    call gt_setr (gt, GTXMAX, AID_W2(aid))
+	} else {
+	    call gt_setr (gt, GTXMIN, W0(sht))
+	    call gt_setr (gt, GTXMAX, W1(sht))
+	}
+
+	if (shr != NULL) {
+	    xr = SX(shr) + AID_X1R(aid) - 1
+	    yr = AID_SPECR(aid)
+	    nr = AID_X2R(aid) - AID_X1R(aid) + 1
+	}
+
+	nt = ID_NPTS(id)
+	yt = ID_IMDATA(id)
+	call alimr (Memr[yt], nt, ytmin, ytmax)
+
+	call malloc (y, max(nr,nt), TY_REAL)
+
+	key = 'r'
+	repeat {
+	    switch (key) {
+	    case ':':
+		call gt_colon (Memc[cmd], gp, gt, redraw)
+	    case 'Q':
+		i = stridxs ("l", AID_DEBUG(aid,1))
+		AID_DEBUG(aid,i) = ' '
+		break
+	    case 'q':
+		break
+	    case 'r':
+		redraw = YES
+	    case 'w':
+		call gt_window (gt, gp, "gcur", redraw)
+	    }
+
+	    if (redraw == YES) {
+		call gclear (gp)
+		call gseti (gp, G_YDRAWTICKS, NO)
+		if (shr != NULL) {
+		    call gascale (gp, Memr[xr], nr, 1)
+		    call gascale (gp, Memr[yr], nr, 2)
+		} else {
+		    call gswind (gp, real(x1[1]), real(x1[n1]), 0., 1.)
+		}
+		call gt_swind (gp, gt)
+		call ggwind (gp, a, b, c, d)
+		dy = 2 * (d - c)
+		call gswind (gp, a, b, c, c + dy)
+		call gt_labax(gp, gt)
+
+		if (shr != NULL) {
+		    call aminkr (Memr[yr], c + 0.44 * dy, Memr[y], nr)
+		    call gt_plot (gp, gt, Memr[xr], Memr[y], nr)
+		}
+
+		wy = c + 0.46 * dy
+		wz = c + 0.49 * dy
+		do i = 1, n1 {
+		    wx = x1[i]
+		    if (wx < min (a,b) || wx > max (a,b))
+			next
+		    call gline (gp, wx, wy, wx, wz)
+		}
+
+		call amapr (Memr[yt], Memr[y], nt,
+		    ytmin, ytmax, c+0.55*dy, c+0.99*dy)
+		wy = c + 0.50 * dy
+		wz = c + 0.53 * dy
+
+		if (DC(sht) == DCNO || WP(sht) * AID_CDSIGN(aid) < 0.) {
+		    call gvline (gp, Memr[y], nt, a, b)
+		    do i = 1, n2 {
+			wx = a + (x2[i] - 1) / (nt - 1) * (b - a) 
+			call gline (gp, wx, wy, wx, wz)
+		    }
+		} else {
+		    call gpline (gp, Memr[SX(sht)], Memr[y], nt)
+		    do i = 1, n2 {
+			wx = shdr_lw (sht, double (x2[i]))
+			call gline (gp, wx, wy, wx, wz)
+		    }
+		}
+
+		redraw = NO
+	    }
+	} until (clgcur ("gcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF)
+	    
+	call gdeactivate (gp, 0)
+	call mfree (y, TY_REAL)
+	call gt_free (gt)
+	call sfree (sp)
+end
+
+
+# AID_DGRAPH -- Graph candidate dispersions.
+# This routine is only used for debugging.
+
+procedure aid_dgraph (aid, x, y, n, w1, dw, nd)
+
+pointer	aid		#I AID pointer
+real	x[n]		#I Array of candidate reference coordinates (sorted)
+real	y[n]		#I Array of candidate target coordinates
+int	n		#I Number of candidate pairs
+real	w1[nd]		#I Dispersion origin
+real	dw[nd]		#I Dispersion slope
+int	nd		#I Number of dispersions
+
+int	i, ndplot, wcs, key, redraw, clgcur(), stridxs(), ctoi()
+real	wx, wy, a, b, c, d, dy, crpix, crval, cdelt
+pointer	sp, cmd, sh, gp, gt, gt_init()
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	sh = ID_SH(AID_IDT(aid))
+	gp = ID_GP(AID_IDT(aid))
+	if (gp == NULL)
+	    return
+	gt = gt_init()
+	call gt_seti (gt, GTSYSID, NO)
+	if (DC(sh) != DCNO) {
+	    call gt_setr (gt, GTXMIN, W0(sh))
+	    call gt_setr (gt, GTXMAX, W1(sh))
+	    call gt_setr (gt, GTYMIN, 1.)
+	    call gt_setr (gt, GTYMAX, real(SN(sh)))
+	}
+
+	ndplot = nd
+	key = 'r'
+	repeat {
+	    switch (key) {
+	    case ':':
+		if (Memc[cmd] == '/')
+		    call gt_colon (Memc[cmd], gp, gt, redraw)
+		else {
+		    i = 1
+		    if (ctoi (Memc[cmd], i, ndplot) == 0)
+			ndplot = nd
+		}
+	    case 'Q':
+		i = stridxs ("d", AID_DEBUG(aid,1))
+		AID_DEBUG(aid,i) = ' '
+		break
+	    case 'q':
+		break
+	    case 'r':
+		redraw = YES
+	    case 'w':
+		call gt_window (gt, gp, "gcur", redraw)
+	    }
+
+	    if (redraw == YES) {
+		call gclear (gp)
+		call gascale (gp, x, n, 1)
+		call gascale (gp, y, n, 2)
+		call gt_swind (gp, gt)
+		call gt_labax(gp, gt)
+
+		call gt_plot (gp, gt, x, y, n)
+
+		call ggwind (gp, a, b, c, d)
+		dy = (b - a) / 500.
+		do i = 1, ndplot {
+		    crval = w1[i]
+		    cdelt = dw[i]
+		    wy = c
+		    wx = crval + wy * cdelt
+		    call gamove (gp, wx, wy)
+		    for (wy=wy+dy; wy<d+dy; wy=wy+dy) {
+			wx = crval + wy * cdelt
+			call gadraw (gp, wx, wy)
+		    }
+		}
+
+		if (AID_CRMIN(aid) > -MAX_DOUBLE / 10. &&
+		    AID_CRMAX(aid) < MAX_DOUBLE / 10.) {
+		    crpix = AID_CRPIX(aid)
+		    crval = AID_CDSIGN(aid) * AID_CDMIN(aid)
+		    cdelt = AID_CDSIGN(aid) * AID_CDMAX(aid)
+		    for (wy=c; wy<d+dy; wy=wy+dy) {
+			wx = AID_CRMIN(aid) +
+			    min ((wy-crpix)*crval, (wy-crpix)*cdelt)
+			call gmark (gp, wx, wy, GM_POINT, 2, 2)
+		    }
+		    for (wy=c; wy<d+dy; wy=wy+dy) {
+			wx = AID_CRMAX(aid) +
+			    max ((wy-crpix)*crval, (wy-crpix)*cdelt)
+			call gmark (gp, wx, wy, GM_POINT, 2, 2)
+		    }
+		}
+
+		redraw = NO
+	    }
+	} until (clgcur ("gcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF)
+	    
+	call gdeactivate (gp, 0)
+	call gt_free (gt)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/identify/autoid/aidinit.x b/noao/onedspec/identify/autoid/aidinit.x
new file mode 100644
index 00000000..ac86b34d
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidinit.x
@@ -0,0 +1,93 @@
+include	<smw.h>
+include	"../identify.h"
+include	"autoid.h"
+
+
+# AID_INIT -- Create AID object and initialize algorithm parameters.
+
+procedure aid_init (aid, pset)
+
+pointer	aid		#O AID object
+char	pset[ARB]	#I Pset for parameters
+
+pointer	pp, clopset()
+int	clgpseti(), strdic()
+double	clgpsetd()
+
+begin
+	call calloc (aid, AID_LEN, TY_STRUCT)
+
+	# Set default parameters.  This can be overridden later by
+	# the application.
+
+	pp = clopset (pset)
+
+	#call clgpseta (pp, "crval", AID_CR(aid), AID_SZLINE) 
+	#call clgpseta (pp, "cdelt", AID_CD(aid), AID_SZLINE) 
+	call strcpy ("INDEF", AID_CR(aid), AID_SZLINE)
+	call strcpy ("INDEF", AID_CD(aid), AID_SZLINE)
+
+	call clgpseta (pp, "reflist", AID_REFLIST(aid), AID_SZLINE) 
+	call clgpseta (pp, "refspec", AID_REFSPEC(aid), AID_SZLINE) 
+	call clgpseta (pp, "crpix", AID_CP(aid), AID_SZLINE) 
+	call clgpseta (pp, "crquad", AID_CQ(aid), AID_SZLINE) 
+	call clgpseta (pp, "cddir", AID_DEBUG(aid,1), AID_SZLINE) 
+	AID_CDDIR(aid) = strdic (AID_DEBUG(aid,1), AID_DEBUG(aid,1),
+	    AID_SZLINE, CDDIR)
+	call clgpseta (pp, "crsearch", AID_CRS(aid), AID_SZLINE) 
+	call clgpseta (pp, "cdsearch", AID_CDS(aid), AID_SZLINE) 
+	AID_NTMAX(aid) = clgpseti (pp, "ntarget")
+	#AID_NRMAX(aid) = clgpseti (pp, "nreference")
+	AID_NRMAX(aid) = 2 * AID_NTMAX(aid)
+	AID_ORD(aid) = clgpseti (pp, "aidord")
+	AID_MAXNL(aid) = clgpsetd (pp, "maxnl")
+	AID_NB(aid) = clgpseti (pp, "nbins")
+	AID_NN(aid) = clgpseti (pp, "nneighbors")
+	AID_NP(aid) = clgpseti (pp, "npattern")
+	AID_SIG(aid) = clgpsetd (pp, "sigma")
+	AID_NFOUND(aid) = clgpseti (pp, "nfound")
+	AID_RMSG(aid) = clgpsetd (pp, "rms")
+	AID_FMATCHG(aid) = clgpsetd (pp, "fmatch")
+	AID_FTMATCHG(aid) = clgpsetd (pp, "fmatch")
+	AID_MINRATIO(aid) = clgpsetd (pp, "minratio")
+	AID_NDMAX(aid) = clgpseti (pp, "ndmax")
+	call clgpseta (pp, "debug", AID_DEBUG(aid,1), AID_SZLINE) 
+	AID_NBEST(aid) = 3
+	AID_WRMS(aid) = 0.34
+	AID_WFMATCH(aid) = 0.33
+	AID_WFTMATCH(aid) = 0.33
+	call clcpset (pp)
+
+	call ic_open (AID_IC1(aid))
+	call ic_pstr (AID_IC1(aid), "function", "chebyshev")
+	call ic_puti (AID_IC1(aid), "order", AID_ORD(aid))
+	call ic_puti (AID_IC1(aid), "niterate", 5)
+	call ic_putr (AID_IC1(aid), "low", 2.)
+	call ic_putr (AID_IC1(aid), "high", 2.)
+end
+
+
+# AID_FREE -- Free memory associated with the AID algorithms.
+
+procedure aid_free (aid)
+
+pointer	aid		#U AID object
+
+begin
+	if (AID_IDR(aid) != NULL) {
+	    if (ID_SH(AID_IDR(aid)) != NULL) {
+		call smw_close (MW(ID_SH(AID_IDR(aid))))
+		call imunmap (IM(ID_SH(AID_IDR(aid))))
+		call shdr_close (ID_SH(AID_IDR(aid)))
+	    }
+	}
+
+	call ic_closed (AID_IC1(aid))
+	call mfree (AID_SPECR(aid), TY_REAL)
+	call mfree (AID_XR(aid), TY_DOUBLE)
+	call mfree (AID_XT(aid), TY_DOUBLE)
+	call mfree (AID_XTF(aid), TY_DOUBLE)
+	call id_free (AID_IDR(aid))
+	call mfree (AID_EVS(aid), TY_POINTER)
+	call mfree (aid, TY_STRUCT)
+end
diff --git a/noao/onedspec/identify/autoid/aidlog.x b/noao/onedspec/identify/autoid/aidlog.x
new file mode 100644
index 00000000..b0247d00
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidlog.x
@@ -0,0 +1,57 @@
+include	"../identify.h"
+
+
+# AID_LOG -- Log final solution.
+
+procedure aid_log (id, fd, hdr)
+
+pointer	id		#I ID object
+int	fd		#I Log file descriptor
+int	hdr		#U Print header?
+
+double	wc, dw, id_fitpt(), id_rms()
+pointer	str
+bool	fp_equald()
+
+begin
+	if (fd == NULL)
+	    return
+
+	if (fd == STDOUT && ID_GP(id) != NULL)
+	    call gdeactivate (ID_GP(id), 0)
+
+	if (hdr == YES) {
+	    call malloc (str, SZ_LINE, TY_CHAR)
+	    call sysid (Memc[str], SZ_LINE)
+	    call fprintf (fd, "\nAUTOIDENTIFY: %s\n")
+		call pargstr (Memc[str])
+	    call mfree (str, TY_CHAR)
+
+	    call fprintf (fd, "  %-20s  %10s %10s %10s %10s\n")
+		call pargstr ("Spectrum")
+		call pargstr ("# Found")
+		call pargstr ("Midpoint")
+		call pargstr ("Dispersion")
+		call pargstr ("RMS")
+
+	    hdr = NO
+	}
+
+	call fprintf (fd, "  %s%s%24t ")
+	    call pargstr (ID_IMAGE(id))
+	    call pargstr (ID_SECTION(id))
+	if (ID_CV(id) == NULL)
+	    call fprintf (fd, " No solution found\n")
+	else {
+	    wc = id_fitpt (id, (ID_NPTS(id) + 1D0) / 2D0)
+	    dw = wc - id_fitpt (id, (ID_NPTS(id) - 1D0) / 2D0)
+	    if (!fp_equald (dw, 0D0)) {
+		call fprintf (fd, "%10d %10.*g %10.3g %10.3g\n")
+		    call pargi (ID_NFEATURES(id))
+		    call pargi (int (log10 (abs (wc / dw)) + 3))
+		    call pargd (wc)
+		    call pargd (dw)
+		    call pargd (id_rms(id))
+	    }
+	}
+end
diff --git a/noao/onedspec/identify/autoid/aidset.x b/noao/onedspec/identify/autoid/aidset.x
new file mode 100644
index 00000000..5905002b
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidset.x
@@ -0,0 +1,162 @@
+include	"autoid.h"
+
+define	AIDSET "|reflist|refspec|crval|cdelt|crpix|crquad|crsearch|cdsearch\
+		|cddir|ntarget|nreference|aidord|maxnl|nbins|nneighbors\
+		|npattern|sigma|nfound|rms|fmatch|ftmatch|minratio|ndmax\
+		|debug|nbest|wrms|wfmatch|wftmatch|"
+
+
+# AID_SETS -- Set AID parameters by name.
+# If the first word of the value field is "CL" or "ENV" then the second
+# word is the CL parameter name or environment variable name to use
+# for the value.
+
+procedure aid_sets (aid, param, value)
+
+pointer	aid		#I AID object
+char	param[ARB]	#I Parameter name
+char	value[ARB]	#I Value
+
+int	i, j, strdic(), strncmp(), envfind(), nowhite(), ctoi(), ctor(), ctod()
+pointer	sp, str
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	i = strdic (param, Memc[str], SZ_LINE, AIDSET)
+
+	if (strncmp ("CL ", value, 3) == 0)
+	    call clgstr (value[4], Memc[str], SZ_LINE)
+	else if (strncmp ("ENV ", value, 4) == 0) {
+	    if (envfind (value[5], Memc[str], SZ_LINE) <= 0)
+		Memc[str] = EOS
+	} else
+	    call strcpy (value, Memc[str], SZ_LINE)
+	j = nowhite (Memc[str], Memc[str], SZ_LINE)
+
+	j = 1
+	switch (i) {
+	case 1:
+	    call strcpy (Memc[str], AID_REFLIST(aid), AID_SZLINE)
+	case 2:
+	    call strcpy (Memc[str], AID_REFSPEC(aid), AID_SZLINE)
+	case 3:
+	    call strcpy (Memc[str], AID_CR(aid), AID_SZLINE)
+	case 4:
+	    call strcpy (Memc[str], AID_CD(aid), AID_SZLINE)
+	case 5:
+	    call strcpy (Memc[str], AID_CP(aid), AID_SZLINE)
+	case 6:
+	    i = ctod (Memc[str], j, AID_CRQUAD(aid))
+	case 7:
+	    call strcpy (Memc[str], AID_CRS(aid), AID_SZLINE)
+	case 8:
+	    call strcpy (Memc[str], AID_CDS(aid), AID_SZLINE)
+	case 9:
+	    AID_CDDIR(aid) = strdic (Memc[str], Memc[str], SZ_LINE, CDDIR)
+	    if (AID_CDDIR(aid) == 0)
+		AID_CDDIR(aid) = CDUNKNOWN
+	case 10:
+	    i = ctoi (Memc[str], j, AID_NTMAX(aid))
+	case 11:
+	    i = ctoi (Memc[str], j, AID_NRMAX(aid))
+	case 12:
+	    i = ctoi (Memc[str], j, AID_ORD(aid))
+	    call ic_puti (AID_IC1(aid), "order", AID_ORD(aid))
+	case 13:
+	    i = ctor (Memc[str], j, AID_MAXNL(aid))
+	case 14:
+	    i = ctoi (Memc[str], j, AID_NB(aid))
+	case 15:
+	    i = ctoi (Memc[str], j, AID_NN(aid))
+	case 16:
+	    i = ctoi (Memc[str], j, AID_NP(aid))
+	case 17:
+	    i = ctor (Memc[str], j, AID_SIG(aid))
+	case 18:
+	    i = ctoi (Memc[str], j, AID_NFOUND(aid))
+	case 19:
+	    i = ctor (Memc[str], j, AID_RMSG(aid))
+	case 20:
+	    i = ctor (Memc[str], j, AID_FMATCHG(aid))
+	case 21:
+	    i = ctor (Memc[str], j, AID_FTMATCHG(aid))
+	case 22:
+	    i = ctor (Memc[str], j, AID_MINRATIO(aid))
+	case 23:
+	    i = ctoi (Memc[str], j, AID_NDMAX(aid))
+	case 24:
+	    call strcpy (Memc[str], AID_DEBUG(aid,1), AID_SZLINE)
+	case 25:
+	    i = ctoi (Memc[str], j, AID_NBEST(aid))
+	case 26:
+	    i = ctor (Memc[str], j, AID_WRMS(aid))
+	case 27:
+	    i = ctor (Memc[str], j, AID_WFMATCH(aid))
+	case 28:
+	    i = ctor (Memc[str], j, AID_WFTMATCH(aid))
+	}
+
+	call sfree (sp)
+end
+
+
+# AID_SETI -- Set integer AID parameters.
+
+procedure aid_seti (aid, param, ival)
+
+pointer	aid		#I AID object
+char	param[ARB]	#I Parameter name
+int	ival		#I Value
+
+pointer	sp, str
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call sprintf (Memc[str], SZ_FNAME, "%d")
+	    call pargi (ival)
+	call aid_sets (aid, param, Memc[str])
+	call sfree (sp)
+end
+
+
+# AID_SETR -- Set real AID parameters.
+
+procedure aid_setr (aid, param, rval)
+
+pointer	aid		#I AID object
+char	param[ARB]	#I Parameter name
+real	rval		#I Value
+
+pointer	sp, str
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call sprintf (Memc[str], SZ_FNAME, "%g")
+	    call pargr (rval)
+	call aid_sets (aid, param, Memc[str])
+	call sfree (sp)
+end
+
+
+# AID_SETD -- Set double AID parameters.
+
+procedure aid_setd (aid, param, dval)
+
+pointer	aid		#I AID object
+char	param[ARB]	#I Parameter name
+double	dval		#I Value
+
+pointer	sp, str
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call sprintf (Memc[str], SZ_FNAME, "%g")
+	    call pargd (dval)
+	call aid_sets (aid, param, Memc[str])
+	call sfree (sp)
+end
diff --git a/noao/onedspec/identify/autoid/aidshift.x b/noao/onedspec/identify/autoid/aidshift.x
new file mode 100644
index 00000000..1b910338
--- /dev/null
+++ b/noao/onedspec/identify/autoid/aidshift.x
@@ -0,0 +1,67 @@
+include	"../identify.h"
+
+
+# AID_SHIFT -- Find a new shifted dispersion solution assuming (nearly) the
+# same dispersion per pixel and the same dispersion direction.  The shift is
+# assumed to be less than or equal to the dispersion range of the input
+# dispersion.  The input is an ID pointer have the previous dispersion
+# solution and features but with the new spectrum.  If there are more than 10
+# features then the list of user feature coordinates is used as the reference
+# list.  If there are not enough features or the previous search fails then
+# the the coordinate list is used as the reference.  The returned result is a
+# new ID pointer if the algorithm succeeds or the original ID pointer if it
+# fails along with an error status.
+
+procedure aid_shift (id, crsearch, cdsearch)
+
+pointer	id		#I ID object
+double	crsearch	#I Search range
+double	cdsearch	#I Search range
+
+pointer	aid
+bool	found, aid_autoid()
+double	crpix, crval, cdelt, id_fitpt()
+
+begin
+	# Set approximate dispersion from input dispersion solution.
+	crpix = ID_NPTS(id) / 2 + 1
+	crval = id_fitpt (id, crpix)
+	cdelt = (FITDATA(id,ID_NPTS(id)) - FITDATA(id,1)) /
+	    (ID_NPTS(id) - 1)
+
+	# Initialize AUTOID.
+	call aid_init (aid, "aidpars")
+	call aid_setd (aid, "crval", crval)
+	call aid_setd (aid, "cdelt", cdelt)
+	call aid_setd (aid, "crpix", crpix)
+	call aid_sets (aid, "cddir", "sign")
+	call aid_setd (aid, "crsearch", crsearch)
+	call aid_setd (aid, "cdsearch", cdsearch)
+	call aid_seti (aid, "nbest", 5)
+
+	found = false
+	if (ID_NFEATURES(id) > 10) {
+	    # Try shift using features.
+	    call aid_seti (aid, "ntarget", ID_NFEATURES(id))
+	    call aid_seti (aid, "nreference", ID_NFEATURES(id))
+	    call aid_setr (aid, "wrms", 0.5)
+	    call aid_setr (aid, "wfmatch", 0.5)
+	    call aid_setr (aid, "wftmatch", 0.)
+	    call aid_sets (aid, "refspec", "FEATURES")
+	    found = aid_autoid (id, aid)
+	}
+	if (!found) {
+	    # Try shift using coordinate list.
+	    call aid_seti (aid, "ntarget", max (ID_NFEATURES(id),20))
+	    call aid_seti (aid, "nreference", max (ID_NFEATURES(id),40))
+	    call aid_setr (aid, "wrms", 0.5)
+	    call aid_setr (aid, "wfmatch", 0.25)
+	    call aid_setr (aid, "wftmatch", 0.25)
+	    call aid_sets (aid, "refspec", "COORDLIST")
+	    found = aid_autoid (id, aid)
+	}
+
+	call aid_free (aid)
+	if (!found)
+	    call error (1, "No solution not found")
+end
diff --git a/noao/onedspec/identify/autoid/autoid.h b/noao/onedspec/identify/autoid/autoid.h
new file mode 100644
index 00000000..304d675a
--- /dev/null
+++ b/noao/onedspec/identify/autoid/autoid.h
@@ -0,0 +1,90 @@
+# AUTOIDENTIFY data structure.
+
+define	AID_SZLINE	99
+define	AID_LEN		512
+
+# Algorithm input parameters.
+define	AID_REFLIST	Memc[P2C($1)]	  # Reference coordinate list
+define	AID_REFSPEC	Memc[P2C($1+50)]  # Reference spectrum
+define	AID_CR		Memc[P2C($1+100)] # Coordinate reference value
+define	AID_CD		Memc[P2C($1+150)] # Coordinate reference value
+define	AID_CP		Memc[P2C($1+200)] # Coordinate reference value
+define	AID_CQ		Memc[P2C($1+250)] # Coordinate quad distortion
+define	AID_CRS		Memc[P2C($1+300)] # Coordinate reference value
+define	AID_CDS		Memc[P2C($1+350)] # Coordinate reference value
+define	AID_DEBUG	Memc[P2C($1+400)+ 2-1]  # Debug flags (19 chars)
+define	AID_CDDIR	Memi[$1+450]	  # Coordinate direction
+define	AID_NTMAX	Memi[$1+451]	  # Maximum number of target lines
+define	AID_NRMAX	Memi[$1+452]	  # Maximum number of reference lines
+define	AID_ORD		Memi[$1+453]	  # Maximum fitting order
+define	AID_MAXNL	Memr[P2R($1+454)] # Maximum non-linearity
+define	AID_NB		Memi[$1+455]	  # Number of sub-bins
+define	AID_NN		Memi[$1+456]	  # Number of neighbor lines
+define	AID_NP		Memi[$1+457]	  # Number of lines in pattern
+define	AID_SIG		Memr[P2R($1+458)] # Target line centering sigma
+define	AID_NFOUND	Memi[$1+459]	  # Minimum number to be found
+define	AID_RMSG	Memr[P2R($1+460)] # Pixel RMS (goal)
+define	AID_FMATCHG	Memr[P2R($1+461)] # Frac of unmatched lines (goal)
+define	AID_FTMATCHG	Memr[P2R($1+462)] # Frac of unmatched target lines (goal)
+
+define	AID_IDT		Memi[$1+463]	  # Target ID pointer
+define	AID_IDR		Memi[$1+464]	  # Reference ID pointer
+define	AID_IC1		Memi[$1+465]	  # ICFIT pointer
+define	AID_IC2		Memi[$1+466]	  # ICFIT pointer
+
+define	AID_XR		Memi[$1+467]	  # Reference lines (ptr)
+define	AID_NR		Memi[$1+468]	  # Number of reference lines
+define	AID_XTF		Memi[$1+469]	  # Full target lines sorted by peak
+define	AID_NTF		Memi[$1+470]	  # Full number of target lines
+define	AID_XT		Memi[$1+471]	  # Target lines to use sorted by pix
+define	AID_XTL		Memi[$1+472]	  # Linearized target lines sort by pix
+define	AID_NT		Memi[$1+473]	  # Number of target lines to use
+
+define	AID_CDSIGN	Memi[$1+474]	  # Sign of coordinate interval
+define	AID_CRVAL	Memd[P2D($1+476)] # Reference coordinate value
+define	AID_CDELT	Memd[P2D($1+478)] # Coordinate interval per pixel
+define	AID_CRPIX	Memd[P2D($1+480)] # Reference pixel
+define	AID_CRQUAD	Memd[P2D($1+482)] # Quadratic distortion
+define	AID_CRSEARCH	Memd[P2D($1+484)] # Search radius for ref value
+define	AID_CDSEARCH	Memd[P2D($1+486)] # Search radius for coord int
+define	AID_CRMIN	Memd[P2D($1+488)] # Min for central coordinate
+define	AID_CRMAX	Memd[P2D($1+490)] # Max for central coordinate
+define	AID_CDMIN	Memd[P2D($1+492)] # Min for coordinate interval
+define	AID_CDMAX	Memd[P2D($1+494)] # Max for coordinate interval
+
+define	AID_MINRATIO	Memr[P2R($1+496)] # Minimum ratio
+define	AID_NDMAX	Memi[$1+497]	  # Max number of dispersions to check
+define	AID_RMS		Memr[P2R($1+498)] # Pixel RMS (best)
+define	AID_FMATCH	Memr[P2R($1+499)] # Fraction of unmatched linelist lines
+define	AID_FTMATCH	Memr[P2R($1+500)] # Fraction of unmatched target lines
+define	AID_WRMS	Memr[P2R($1+501)] # Weight for RMS
+define	AID_WFMATCH	Memr[P2R($1+502)] # Weight for FMATCH
+define	AID_WFTMATCH	Memr[P2R($1+503)] # Weight for FTMATCH
+define	AID_NBEST	Memi[$1+504]	  # Number of best values < 1 to check
+define	AID_BEST	Memr[P2R($1+505)] # Best fit parameter
+define	AID_EVS		Memi[$1+506]	  # Evaluate structure
+
+define	AID_SPECR	Memi[$1+507]	  # Reference spectrum (ptr)
+define	AID_X1R		Memi[$1+508]	  # First pixel of full ref spectrum
+define	AID_X2R		Memi[$1+509]	  # Last pixel of full ref spectrum
+define	AID_W1		Memr[P2R($1+510)] # Tentative wavelength of first pixel
+define	AID_W2		Memr[P2R($1+511)] # Tentative wavelength of last pixel
+
+
+# Evaluation structure.
+define	AID_EVLEN	8
+define	AID_BIN1	Memi[$1]	  # Reference sample bin
+define	AID_BIN2	Memi[$1+1]	  # Reference sample bin
+define	AID_X		Memi[$1+2]	  # Pixel coordinates
+define	AID_Y		Memi[$1+3]	  # Dispersion coordinates
+define	AID_N		Memi[$1+4]	  # Number of coordinate pairs
+define	AID_A		Memi[$1+5]	  # Trial dispersion start
+define	AID_B		Memi[$1+6]	  # Trial dispersion step
+define	AID_ND		Memi[$1+7]	  # Number of trial dispersions
+
+# Dispersion direction options.
+define	CDDIR	"|sign|increasing|decreasing|unknown|"
+define	CDSIGN		1
+define	CDINC		2
+define	CDDEC		3
+define	CDUNKNOWN	4
diff --git a/noao/onedspec/identify/autoid/autoid.x b/noao/onedspec/identify/autoid/autoid.x
new file mode 100644
index 00000000..3f169ca7
--- /dev/null
+++ b/noao/onedspec/identify/autoid/autoid.x
@@ -0,0 +1,1600 @@
+include	<mach.h>
+include	<error.h>
+include	<smw.h>
+include	"../identify.h"
+include	"autoid.h"
+
+
+# AID_TARGET -- Select target lines and the dispersion limits to be searched.
+# The dispersion limits may be based on header parameters.
+
+procedure aid_target (aid)
+
+pointer	aid		#I AID pointer
+
+int	i, j, l, nt, n
+double	dw, dwmin, dwmax, pix, aid_imgd(), id_center()
+pointer	sp, x, y, idt, idr, im, xt, xtl
+int	id_upeaks(), stridxs()
+errchk	id_upeaks, id_center
+
+begin
+        call smark (sp)
+        call salloc (x, ID_NPTS(AID_IDT(aid)), TY_REAL)
+
+	idt = AID_IDT(aid)
+	idr = AID_IDR(aid)
+	im = IM(ID_SH(idt))
+	nt = ID_NPTS(idt)
+
+	# Set the approximate coordinate information.
+	AID_CRVAL(aid) = aid_imgd (im, AID_CR(aid))
+	AID_CDELT(aid) = aid_imgd (im, AID_CD(aid))
+	AID_CRPIX(aid) = aid_imgd (im, AID_CP(aid))
+	AID_CRQUAD(aid) = aid_imgd (im, AID_CQ(aid))
+	AID_CRSEARCH(aid) = aid_imgd (im, AID_CRS(aid))
+	AID_CDSEARCH(aid) = aid_imgd (im, AID_CDS(aid))
+
+	if (IS_INDEFD(AID_CRPIX(aid)))
+	    AID_CRPIX(aid) = (nt+1) / 2.
+
+	if (IS_INDEFD(AID_CRQUAD(aid)))
+	    AID_CRQUAD(aid) = 0D0
+
+	if (!IS_INDEFD(AID_CRVAL(aid)) && !IS_INDEFD(AID_CDELT(aid))) {
+	    dw = nt * AID_CDELT(aid)
+	    if (IS_INDEFD(AID_CRSEARCH(aid)))
+		AID_CRSEARCH(aid) = abs (0.1 * dw)
+	    else if (AID_CRSEARCH(aid) < 0.)
+		AID_CRSEARCH(aid) = abs (AID_CRSEARCH(aid) * dw)
+	    if (IS_INDEFD(AID_CDSEARCH(aid)))
+		AID_CDSEARCH(aid) = abs (0.1 * AID_CDELT(aid))
+	    else if (AID_CDSEARCH(aid) < 0.)
+		AID_CDSEARCH(aid) = abs (AID_CDSEARCH(aid) * AID_CDELT(aid))
+	    AID_CRSEARCH(aid) = max (abs (0.0001 * dw),
+		AID_CRSEARCH(aid))
+	    AID_CDSEARCH(aid) = max (abs (0.0001 * AID_CDELT(aid)),
+		AID_CDSEARCH(aid))
+	    dwmax = 2 * AID_CRSEARCH(aid) + (nt - 1) *
+		(abs (AID_CDELT(aid)) + AID_CDSEARCH(aid))
+	    dwmin = (abs (AID_CDELT(aid)) - AID_CDSEARCH(aid)) * (nt - 1)
+	    dwmin = max (1.0D-1, dwmin / dwmax)
+	    AID_NB(aid) = nint (1. / dwmin)
+	}
+
+        # Find the peaks in the target spectrum.
+	if (ID_FTYPE(idt) == ABSORPTION) {
+	    call anegr (IMDATA(idt,1), IMDATA(idt,1), nt)
+	    n = id_upeaks (idt, IMDATA(idt,1), Memr[x], nt, INDEF,
+		int (ID_MINSEP(idt)), 0, AID_NTMAX(aid), 5, INDEF, false)
+	    call anegr (IMDATA(idt,1), IMDATA(idt,1), nt)
+	} else {
+	    n = id_upeaks (idt, IMDATA(idt,1), Memr[x], nt, INDEF,
+		int (ID_MINSEP(idt)), 0, AID_NTMAX(aid), 5, INDEF, false)
+	}
+	call salloc (y, n, TY_REAL)
+	do i = 1, n
+	    Memr[y+i-1] = -IMDATA(idt,nint(Memr[x+i-1]))
+	call xt_sort2 (Memr[y], Memr[x], n)
+
+        # Center and sort the lines.
+        if (AID_XTF(aid) == NULL)
+            call malloc (AID_XTF(aid), n, TY_DOUBLE)
+        else
+            call realloc (AID_XTF(aid), n, TY_DOUBLE)
+        xt = AID_XTF(aid)
+
+        j = 0
+        do i = 1, n {
+	    pix = Memr[x+i-1]
+            pix = id_center (idt, pix, ID_FWIDTH(idt), ID_FTYPE(idt))
+            if (IS_INDEFD(pix))
+                next
+	    if (IS_INDEFD(pix))
+		next
+	    do l = 1, j {
+	        if (abs (pix-Memd[xt+l-1]) < 1.)
+		    break
+	    }
+	    if (l <= j)
+		next
+	    Memd[xt+j] = pix
+            j = j + 1
+        }
+        AID_NTF(aid) = j
+
+        # Sort the lines.
+        if (AID_XT(aid) == NULL)
+            call malloc (AID_XT(aid), j, TY_DOUBLE)
+        else
+            call realloc (AID_XT(aid), j, TY_DOUBLE)
+        xt = AID_XT(aid)
+        if (j > 0)
+            call asrtd (Memd[AID_XTF(aid)], Memd[xt], j)
+        else {
+            call salloc (x, SZ_LINE, TY_CHAR)
+            call sprintf (Memc[x], SZ_LINE, "No target lines found in `%s'")
+                call pargstr (ID_IMAGE(idt))
+            call error (1, Memc[x])
+        }
+
+	# Linearize the lines.
+        if (AID_XTL(aid) == NULL)
+            call malloc (AID_XTL(aid), j, TY_DOUBLE)
+        else
+            call realloc (AID_XTL(aid), j, TY_DOUBLE)
+	xt = AID_XT(aid)
+	xtl = AID_XTL(aid)
+	do i = 1, j
+	    Memd[xtl+i-1] = Memd[xt+i-1] +
+	         AID_CRQUAD(aid) * (Memd[xt+i-1]-AID_CRPIX(aid))**2
+
+        # Debug t: Print list of target lines.
+	if (stridxs ("t", AID_DEBUG(aid,1)) != 0) {
+	    call eprintf ("# Selected target lines:\n")
+	    call eprintf ("#%10s %11s\n")
+	        call pargstr ("Measured")
+		call pargstr ("Undistorted")
+            do i = 1, j {
+                call eprintf ("%11.6g %11.6g\n")
+                    call pargd (Memd[xt+i-1])
+                    call pargd (Memd[xtl+i-1])
+            }
+	    call eprintf ("\n")
+        }
+
+	call sfree (sp)
+end
+
+
+# AID_REFERENCE -- Set reference lines from spectrum or line list.  
+
+procedure aid_reference (aid, ev, flip)
+
+pointer	aid		#I AID pointer
+pointer	ev		#I EV pointer
+int	flip		#I Flip dispersion?
+
+int	i, j, i1, i2, npts, nr, nt, nll, id_peaks(), stridxs()
+double	w, w0, w1, wp, cdelt, wa, wb
+real	sig, wt, center1d()
+pointer	sp, x, idt, idr, specr, xr, sh, label, ll
+double	shdr_wl(), shdr_lw()
+errchk	id_peaks, center1d
+
+begin
+	call smark (sp)
+
+	idr = AID_IDR(aid)
+	npts = ID_NPTS(idr)
+	sh = ID_SH(idr)
+	specr = AID_SPECR(aid)
+	idt = AID_IDT(aid)
+	nt = ID_NPTS(idt)
+
+	# Set reference parameters.
+	if (sh != NULL) {
+	    w0 = min (W0(sh), W1(sh))
+	    w1 = max (W0(sh), W1(sh))
+	    wp = abs (WP(sh))
+	} else {
+	    ll = ID_LL(idr)
+	    nll = ID_NLL(idr)
+	    if (ll == NULL) {
+		ll = ID_LL(idt)
+		nll = ID_NLL(idt)
+	    }
+	    x = ll
+	    w0 = Memd[x]
+	    w1 = Memd[x+nll-1]
+	    wp = INDEFD
+	}
+
+	# Set limits for reference coordinate and dispersion values.
+	AID_CRMIN(aid) = -MAX_DOUBLE
+	AID_CRMAX(aid) = MAX_DOUBLE
+	AID_CDMIN(aid) = 0D0
+	AID_CDMAX(aid) = MAX_DOUBLE
+	if (IS_INDEFD(AID_CDELT(aid))) {
+	    switch (AID_CDDIR(aid)) {
+	    case CDINC:
+		AID_CDSIGN(aid) = 1
+	    case CDDEC:
+		AID_CDSIGN(aid) = -1
+	    default:
+		if (flip == YES)
+		    AID_CDSIGN(aid) = -1
+		else
+		    AID_CDSIGN(aid) = 1
+	    }
+
+	    if (!IS_INDEFD(AID_CRVAL(aid))) {
+		AID_CRMIN(aid) = AID_CRVAL(aid) - AID_CRSEARCH(aid)
+		AID_CRMAX(aid) = AID_CRVAL(aid) + AID_CRSEARCH(aid)
+	    }
+
+	    if (sh != NULL) {
+		i1 = 1
+		i2 = npts
+		sig = 0.
+	    } else {
+		wa = -MAX_DOUBLE
+		wb = MAX_DOUBLE
+	    }
+
+	    AID_W1(aid) = INDEF
+	    AID_W2(aid) = INDEF
+	} else if (IS_INDEFD(AID_CRVAL(aid))) {
+	    switch (AID_CDDIR(aid)) {
+	    case CDINC:
+		cdelt = abs (AID_CDELT(aid))
+		AID_CDSIGN(aid) = 1
+	    case CDDEC:
+		cdelt = -abs (AID_CDELT(aid))
+		AID_CDSIGN(aid) = -1
+	    default:
+		if (flip == YES)
+		    cdelt = -AID_CDELT(aid)
+		else
+		    cdelt = AID_CDELT(aid)
+		if (cdelt < 0.)
+		    AID_CDSIGN(aid) = -1
+		else
+		    AID_CDSIGN(aid) = 1
+	    }
+
+	    AID_CDMIN(aid) = abs (cdelt) - AID_CDSEARCH(aid)
+	    AID_CDMAX(aid) = abs (cdelt) + AID_CDSEARCH(aid)
+
+	    if (sh != NULL) {
+		i1 = 1
+		i2 = npts
+		sig = abs (AID_CDELT(aid)) / wp
+	    } else {
+		wa = -MAX_DOUBLE
+		wb = MAX_DOUBLE
+	    }
+
+	    AID_W1(aid) = INDEF
+	    AID_W2(aid) = INDEF
+	} else {
+	    switch (AID_CDDIR(aid)) {
+	    case CDINC:
+		cdelt = abs (AID_CDELT(aid))
+		AID_CDSIGN(aid) = 1
+	    case CDDEC:
+		cdelt = -abs (AID_CDELT(aid))
+		AID_CDSIGN(aid) = -1
+	    default:
+		if (flip == YES)
+		    cdelt = -AID_CDELT(aid)
+		else
+		    cdelt = AID_CDELT(aid)
+		if (cdelt < 0.)
+		    AID_CDSIGN(aid) = -1
+		else
+		    AID_CDSIGN(aid) = 1
+	    }
+
+	    AID_CRMIN(aid) = AID_CRVAL(aid) - AID_CRSEARCH(aid)
+	    AID_CRMAX(aid) = AID_CRVAL(aid) + AID_CRSEARCH(aid)
+	    AID_CDMIN(aid) = abs (cdelt) - AID_CDSEARCH(aid)
+	    AID_CDMAX(aid) = abs (cdelt) + AID_CDSEARCH(aid)
+
+	    if (cdelt > 0.) {
+		wa = AID_CRMIN(aid) + (cdelt + AID_CDSEARCH(aid)) *
+		    (1 - AID_CRPIX(aid))
+		wb = AID_CRMAX(aid) + (cdelt + AID_CDSEARCH(aid)) *
+		    (nt - AID_CRPIX(aid))
+	    } else {
+		wa = AID_CRMIN(aid) + (cdelt - AID_CDSEARCH(aid)) *
+		    (nt - AID_CRPIX(aid))
+		wb = AID_CRMAX(aid) + (cdelt - AID_CDSEARCH(aid)) *
+		    (1 - AID_CRPIX(aid))
+	    }
+
+	    if (stridxs ("m", AID_DEBUG(aid,1)) != 0) {
+		call eprintf ("wa=%g wb=%g\n")
+		    call pargd (wa)
+		    call pargd (wb)
+	    }
+
+	    if (sh != NULL) {
+		i1 = max (1, min (npts, nint (shdr_wl (sh, wa))))
+		i2 = max (1, min (npts, nint (shdr_wl (sh, wb))))
+		sig = abs (AID_CDELT(aid)) / wp
+	    }
+
+	    AID_W1(aid) = AID_CRVAL(aid) + (1-AID_CRPIX(aid)) * cdelt
+	    AID_W2(aid) = AID_CRVAL(aid) + (nt-AID_CRPIX(aid)) * cdelt
+	}
+
+	# Select lines from line list.
+	if (ID_IMAGE(idr) == EOS) {
+	    ll = ID_LL(idr)
+	    if (ll == NULL)
+		ll = ID_LL(idt)
+	    x = ll
+	    npts = 0
+	    while (!IS_INDEFD(Memd[x])) {
+		if (Memd[x] > wb)
+		    break
+		if (Memd[x] >= wa)
+		    npts = npts + 1
+		x = x + 1
+	    }
+	    x = x - npts
+	    if (npts == 0) {
+		call salloc (x, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[x], SZ_LINE, "No reference lines found")
+		call error (1, Memc[x])
+	    }
+
+	    wa = Memd[x]
+	    wb = Memd[x+npts-1] - Memd[x]
+	    wb = wb / ((AID_BIN1(ev) + 1) / 2)
+	    wa = wa + wb / 2 * (AID_BIN2(ev) - 1)
+	    wb = wa + wb
+
+	    x = ll
+	    npts = 0
+	    while (!IS_INDEFD(Memd[x])) {
+		if (Memd[x] > wb)
+		    break
+		if (Memd[x] >= wa)
+		    npts = npts + 1
+		x = x + 1
+	    }
+	    x = x - npts
+	    if (npts == 0) {
+		call salloc (x, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[x], SZ_LINE, "No reference lines found")
+		call error (1, Memc[x])
+	    }
+
+	    AID_NRMAX(aid) = npts
+	    nr = AID_NRMAX(aid)
+	    AID_NR(aid) = nr
+	    if (AID_XR(aid) == NULL)
+		call malloc (AID_XR(aid), nr, TY_DOUBLE)
+	    else
+		call realloc (AID_XR(aid), nr, TY_DOUBLE)
+	    xr = AID_XR(aid)
+
+	    if (nr < npts) {
+		w = real (npts) / nr
+		do i = 0, nr {
+		    j = i * w
+		    Memd[xr+i] = Memd[x+j]
+		}
+	    } else {
+		do i = 0, nr-1
+		    Memd[xr+i] = Memd[x+i]
+	    }
+
+	# Select lines using reference spectrum.
+	} else {
+	    wb = (i2 - i1) / ((AID_BIN1(ev) + 1) / 2)
+	    i1 = max (i1, nint (i1 + wb / 2 * (AID_BIN2(ev) - 1)))
+	    i2 = min (i2, nint (i1 + wb))
+
+	    if (i2 - i1 + 1 < 100) {
+		i1 = 1
+		i2 = npts
+	    }
+	    npts = i2 - i1 + 1
+
+	    if (specr == NULL)
+		call malloc (specr, npts, TY_REAL)
+	    else
+		call realloc (specr, npts, TY_REAL)
+	    AID_SPECR(aid) = specr
+	    AID_X1R(aid) = i1
+	    AID_X2R(aid) = i2
+	    wa = Memr[SX(sh)+i1-1]
+	    wb = Memr[SX(sh)+i2-1]
+	    call amovr (IMDATA(idr,i1), Memr[specr], npts)
+
+	    if (sig > 1.) {
+		ID_MINSEP(idr) = sig * ID_MINSEP(idt)
+		ID_FWIDTH(idr) = sig * ID_FWIDTH(idt)
+		sig = sig / 1.1774
+		j = nint (3 * sig)
+		call malloc (x, npts, TY_REAL)
+		call malloc (xr, npts+2*j+1, TY_REAL)
+		xr = xr + j
+		call amovr (Memr[specr], Memr[xr], npts)
+		do i = 1, j {
+		    wt = exp (-0.5 * (i / sig) ** 2)
+		    call amulkr (Memr[specr], wt, Memr[x], npts)
+		    call aaddr (Memr[x], Memr[xr+i], Memr[xr+i], npts)
+		    call aaddr (Memr[x], Memr[xr-i], Memr[xr-i], npts)
+		}
+		call amovr (Memr[xr], Memr[specr], npts)
+		call mfree (x, TY_REAL)
+		call mfree (xr-j, TY_REAL)
+	    }
+
+	    call salloc (x, npts, TY_REAL)
+
+	    # Find the peaks in the reference spectrum.
+	    AID_NRMAX(aid) = 2 * AID_NTF(aid)
+	    if (ID_FTYPE(idr) == ABSORPTION) {
+		call anegr (Memr[specr], Memr[specr], nt)
+		nr = id_peaks (idr, Memr[specr], Memr[x], npts, INDEF,
+		    int (ID_MINSEP(idr)), 0, AID_NRMAX(aid), INDEF, false)
+		call anegr (Memr[specr], Memr[specr], nt)
+	    } else {
+		nr = id_peaks (idr, Memr[specr], Memr[x], npts, INDEF,
+		    int (ID_MINSEP(idr)), 0, AID_NRMAX(aid), INDEF, false)
+	    }
+
+	    # Center and sort the lines.
+	    if (AID_XR(aid) == NULL)
+		call malloc (AID_XR(aid), nr, TY_DOUBLE)
+	    else
+		call realloc (AID_XR(aid), nr, TY_DOUBLE)
+	    xr = AID_XR(aid)
+
+	    j = 0
+	    label = NULL
+	    do i = 1, nr {
+		wt = center1d (Memr[x+i-1], Memr[specr], npts, ID_FWIDTH(idr),
+		    ID_FTYPE(idr), ID_CRADIUS(idt), 0.)
+		if (IS_INDEF(wt))
+		    next
+		w = shdr_lw (sh, double(wt+i1-1))
+		Memd[xr+j] = w
+		call id_match (idt, w, Memd[xr+j], label, -2.)
+		if (IS_INDEFD(Memd[xr+j]) || (j>0 && Memd[xr+j]==Memd[xr+j-1]))
+		    next
+		j = j + 1
+	    }
+	    call mfree (label, TY_CHAR)
+	    nr = j
+	    AID_NR(aid) = nr
+
+	    # Sort the lines.
+	    if (j > 0)
+		call asrtd (Memd[xr], Memd[xr], nr)
+	    else {
+		call salloc (x, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[x], SZ_LINE,
+		    "No reference lines found in `%s'")
+		    call pargstr (ID_IMAGE(idr))
+		call error (1, Memc[x])
+	    }
+	}
+
+	#AID_NT(aid) = min (2 * AID_NR(aid), AID_NTF(aid))
+	AID_NT(aid) = AID_NTF(aid)
+	call asrtd (Memd[AID_XTF(aid)], Memd[AID_XT(aid)], AID_NT(aid))
+
+	# Debug w: Print wavelength bin limits.
+	if (stridxs ("w", AID_DEBUG(aid,1)) != 0) {
+	    call eprintf ("%2d/%-2d %g %g\n")
+		call pargi (AID_BIN1(ev))
+		call pargi (AID_BIN2(ev))
+		call pargd (wa)
+		call pargd (wb)
+	}
+
+	# Debug b: Print search limits.
+	if (stridxs ("b", AID_DEBUG(aid,1)) != 0) {
+	    if (ev == AID_EVS(aid)) {
+		call eprintf ("Search: CRVAL = %.8g - %.8g,  CDELT = %.5g - %.5g\n\n")
+		    call pargd (AID_CRMIN(aid))
+		    call pargd (AID_CRMAX(aid))
+		    call pargd (AID_CDMIN(aid))
+		    call pargd (AID_CDMAX(aid))
+	    }
+	}
+
+	# Debug r: Print list of reference lines.
+	if (stridxs ("r", AID_DEBUG(aid,1)) != 0) {
+	    call eprintf ("# Selected reference lines:\n")
+	    do i = 1, nr {
+		call eprintf ("%10.6g\n")
+		    call pargd (Memd[xr+i-1])
+	    }
+	    call eprintf ("\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# AID_AUTOID1 -- Automatically identify lines.
+# This routine takes preset target and reference line lists and tries to
+# find correspondences.  It returns lists of possible correspondences
+# and dispersions.
+
+procedure aid_autoid1 (aid, ev)
+
+pointer	aid		#I AID pointer
+pointer	ev		#I EV pointer
+
+int	i, nn, n1, n2, nr1, nr2, n, nd
+pointer	sp, idt, x1, x2, x3, r1, s1, r2, s2, votes, svotes
+pointer	x, y, w, w1, dw, nw, nv
+
+int	aid_rsort(), aid_vsort(), stridxs()
+extern	aid_rsort, aid_vsort
+errchk	aid_select, aid_disp
+
+begin
+	call smark (sp)
+
+	idt = AID_IDT(aid)
+	nn = AID_NN(aid)
+	x1 = AID_XR(aid)
+	n1 = AID_NR(aid)
+	x2 = AID_XTL(aid)
+	x3 = AID_XT(aid)
+	n2 = AID_NT(aid)
+
+        # Debug l: Graph lines and spectra.
+	if (stridxs ("l", AID_DEBUG(aid,1)) != 0)
+	    call aid_lgraph (aid, Memd[x1], n1, Memd[x2], n2)
+
+	# Make ratio lists.
+	i = min (nn, n1-1)
+	nr1 = (n1-i) * i * (i - 1) / 2 + i * (i - 1) * (i - 2) / 6
+	call salloc (r1, nr1, TY_REAL)
+	call aid_ratios (aid, Memd[x1], n1, 1, Memr[r1], nr1, 1)
+	call salloc (s1, nr1, TY_INT)
+	do i = 1, nr1
+	    Memi[s1+i-1] = i
+	call gqsort (Memi[s1], nr1, aid_rsort, r1)
+
+	i = min (nn, n2-1)
+	nr2 = (n2-i) * i * (i - 1) / 2 + i * (i - 1) * (i - 2) / 6
+	call salloc (r2, 2*nr2, TY_REAL)
+	call aid_ratios (aid, Memd[x2], n2, AID_CDSIGN(aid), Memr[r2], nr2, 2)
+	call salloc (s2, nr2, TY_INT)
+	do i = 1, nr2
+	    Memi[s2+i-1] = i
+	call gqsort (Memi[s2], nr2, aid_rsort, r2)
+
+	call salloc (votes, n1 * n2, TY_INT)
+	call aid_votes (aid, Memr[r1], Memi[s1], nr1, Memr[r2], Memi[s2],
+	    nr2, Memd[x1], Memd[x2], Memi[votes], n1, n2)
+
+	call salloc (svotes, n1 * n2, TY_INT)
+	do i = 1, n1 * n2
+	    Memi[svotes+i-1] = i
+	call gqsort (Memi[svotes], n1*n2, aid_vsort, votes)
+
+	do n = 1, n1 * n2
+	    if (Memi[votes+Memi[svotes+n-1]-1] < 1)
+	        break
+	n = max (3 * n2, n-1)
+
+	call malloc (x, n, TY_REAL)
+	call malloc (y, n, TY_REAL)
+	call salloc (w, n, TY_REAL)
+	iferr (call aid_select (aid, Memd[x1], Memd[x2], Memd[x3], Memi[votes],
+	    Memi[svotes], n1, n2, Memr[x], Memr[y], Memr[w], n)) {
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+
+	nd = AID_NDMAX(aid)
+	call malloc (w1, nd, TY_REAL)
+	call malloc (dw, nd, TY_REAL)
+	call salloc (nw, nd, TY_INT)
+	call salloc (nv, nd, TY_INT)
+	call aid_disp (aid, Memr[y], Memr[x], Memr[w], n, Memr[w1], Memr[dw],
+	    Memi[nw], Memi[nv], nd)
+
+	AID_X(ev) = x
+	AID_Y(ev) = y
+	AID_N(ev) = n
+	AID_A(ev) = w1
+	AID_B(ev) = dw
+	AID_ND(ev) = nd
+
+	call sfree (sp)
+end
+
+
+# AID_RATIOS -- Generate list of spacing ratios from list of lines.
+
+procedure aid_ratios (aid, x, n, cdsign, r, nr, nv)
+
+pointer	aid		#I AID pointer
+double	x[n]		#I Line positions (sorted)
+int	n		#I Number of lines
+int	cdsign		#I Sign of dispersion
+real	r[nr,nv]	#O Ratios
+int	nr		#O Number of ratios
+int	nv		#I Number of values
+
+int	i, j, k, l, nn, stridxs()
+real	minr, maxr, xi, xj, xk, xij, xjk, sig, ratio, err
+
+begin
+	nn = AID_NN(aid)
+	sig = AID_SIG(aid)
+	minr = AID_MINRATIO(aid)
+	maxr = 1 / AID_MINRATIO(aid)
+
+	# Compute ratios.
+	l = 0
+	if (cdsign == 1) {
+	    do i = 1, n-2 {
+		xi = x[i]
+		do j = i+1, min (i+nn-1, n-1) {
+		    xj = x[j]
+		    xij = xj - xi
+		    do k = j+1, min (i+nn, n) {
+			xk = x[k]
+			xjk = xk - xj
+			ratio = xij / xjk
+
+			l = l + 1
+			if (nv == 1) {
+			    if (ratio < minr || ratio > maxr)
+				r[l,1] = 1000.
+			    else
+				r[l,1] = ratio
+			} else {
+			    if (ratio < minr || ratio > maxr) {
+				r[l,1] = 1000.
+				r[l,2] = 1000.
+			    } else {
+				err = sig * sqrt (2*(1+ratio+ratio**2)) / xjk
+				r[l,1] = ratio - err
+				r[l,2] = ratio + err
+			    }
+			}
+		    }
+		}
+	    }
+	} else {
+	    do i = n, 3, -1 {
+		xi = x[i]
+		do j = i-1, max (i-nn+1, 2), -1 {
+		    xj = x[j]
+		    xij = xi - xj
+		    do k = j-1, max (i-nn, 1), -1 {
+			xk = x[k]
+			xjk = xj - xk
+			ratio = xij / xjk
+
+			l = l + 1
+			if (nv == 1) {
+			    if (ratio < minr || ratio > maxr)
+				r[l,1] = 1000.
+			    else
+				r[l,1] = ratio
+			} else {
+			    if (ratio < minr || ratio > maxr) {
+				r[l,1] = 1000.
+				r[l,2] = 1000.
+			    } else {
+				err = sig * sqrt (2*(1+ratio+ratio**2)) / xjk
+				r[l,1] = ratio - err
+				r[l,2] = ratio + err
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	nr = l
+
+	# Debug c: Print list of line ratios.
+	if (stridxs ("c", AID_DEBUG(aid,1)) != 0) {
+	    do l = 1, nr {
+		call aid_lines (l, n, nn, i, j, k)
+		if (nv == 1)
+		    call printf ("%2d %2d %2d %8.2f %8.2f %8.2f %6.4f\n")
+		else
+		    call printf ("%2d %2d %2d %8.2f %8.2f %8.2f %6.4f %6.4f\n")
+		    call pargi (i)
+		    call pargi (j)
+		    call pargi (k)
+		    if (cdsign == 1) {
+			call pargd (x[i])
+			call pargd (x[j])
+			call pargd (x[k])
+		    } else {
+			call pargd (x[n-i+1])
+			call pargd (x[n-j+1])
+			call pargd (x[n-k+1])
+		    }
+		    call pargr (r[l,1])
+		    if (nv == 2)
+			call pargr (r[l,2])
+	    }
+	}
+end
+
+
+# AID_LINES --  Convert ratio index to line indices.
+
+procedure aid_lines (s, n, nn, i, j, k)
+
+int	s		# Index into ratio array
+int	n		# Number of lines
+int	nn		# Number of neigbhors
+int	i		#O Index of first line
+int	j		#O Index of second line
+int	k		#O Index of third line
+
+int	l
+
+begin
+	k = s
+	for (i=1;;i=i+1) {
+	    l = min (nn, n-i)
+	    l = l * (l-1) / 2
+	    if (k <= l)
+		break
+	    k = k - l
+	}
+	for (j=i+1;;j=j+1) {
+	    l = min (nn-1, n-j)
+	    if (k <= l)
+		break
+	    k = k - l
+	}
+	k = k + j
+end
+
+
+# AID_RSORT -- Compare ratio array with smallest first.
+
+int procedure aid_rsort (ptr, i, j)
+
+pointer	ptr		#I Pointer to array to be sorted.
+int	i		#I Index 1
+int	j		#I Index 2
+
+real	a, b
+
+begin
+	a = Memr[ptr+i-1]
+	b = Memr[ptr+j-1]
+
+	if (a < b)
+	    return (-1)
+	else if (b < a)
+	    return (1)
+	else
+	    return (0)
+end
+
+
+# AID_VSORT -- Compare vote array with biggest first.
+
+int procedure aid_vsort (ptr, i, j)
+
+pointer	ptr		#I Pointer to array to be sorted.
+int	i		#I Index 1
+int	j		#I Index 2
+
+int	a, b
+
+begin
+	a = Memi[ptr+i-1]
+	b = Memi[ptr+j-1]
+
+	if (a < b)
+	    return (1)
+	else if (b < a)
+	    return (-1)
+	else
+	    return (0)
+end
+
+
+# AID_VOTES -- Find ratio matches and increment the vote array.
+
+procedure aid_votes (aid, r1, s1, nr1, r2, s2, nr2, x1, x2, votes, n1, n2)
+
+pointer	aid		#I AID pointer
+real	r1[nr1]		#I Ratio array (reference)
+int	s1[nr1]		#I Sort array
+int	nr1		#I Number of ratios
+real	r2[nr2,2]	#I Ratio array (target)
+int	s2[nr2]		#I Sort array
+int	nr2		#I Number of ratios
+double	x1[n1]		#I Reference lines
+double	x2[n2]		#I Target lines
+int	votes[n1,n2]	#O Votes
+int	n1, n2		#I Size of votes array
+
+int	i, j, nn, np, start, stridxs()
+real	maxr, ra, rb1, rb2
+pointer	sp, a, b
+
+begin
+	nn = AID_NN(aid)
+	np = max (3, min (AID_NP(aid), n1 - 5))
+	maxr = 1. / AID_MINRATIO(aid)
+
+	call smark (sp)
+	call salloc (a, np, TY_INT)
+	call salloc (b, np, TY_INT)
+
+	call aclri (votes, n1*n2)
+
+	start = 1
+	do j = 1, nr2 {
+	    rb1 = r2[s2[j],1]
+	    if (rb1 > maxr)
+		break
+	    rb2 = r2[s2[j],2]
+	    do i = start, nr1 {
+		ra = r1[s1[i]]
+		if (ra > rb2)
+		    break
+		if (ra < rb1) {
+		    start = i + 1
+		    next
+		}
+		call aid_lines (s1[i], n1, nn, Memi[a], Memi[a+1], Memi[a+2])
+		call aid_lines (s2[j], n2, nn, Memi[b], Memi[b+1], Memi[b+2])
+		call aid_addlines (aid, r1, nr1, s1[i], r2, nr2, s2[j], nn,
+		    Memi[a], Memi[b], np, votes, n1, n2)
+	    }
+	}
+
+        # Debug v: Print vote array.
+	if (stridxs ("v", AID_DEBUG(aid,1)) != 0) {
+	    call printf ("%4w")
+	    do i = 1, n2 {
+		call printf (" %3d")
+		    call pargi (nint (x2[i]))
+	    }
+	    call printf ("\n")
+	    do i = 1, n1 {
+		call printf ("%4d")
+		    call pargi (nint (x1[i]))
+		do j = 1, n2 {
+		    call printf (" %3d")
+			call pargi (votes[i,j])
+		}
+		call printf ("\n")
+	    }
+	    call printf ("\n")
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# AID_ADDLINES -- Starting with a matching triplets add more lines.
+# The lines are added recursively.  To avoid recursive calls this
+# routine is repeated to a maximum depth.  The indentation is intentionally
+# non-standard.
+
+procedure aid_addlines (aid, r1, nr1, s1, r2, nr2, s2, nn, a, b, npattern,
+	votes, n1, n2)
+
+pointer	aid		#I AID pointer
+real	r1[nr1]		#I Reference ratios
+int	nr1		#I Number of ratios
+int	s1		#I Ratio index
+real	r2[nr2,2]	#I Target ratios
+int	nr2		#I Number of ratios
+int	s2		#I Ratio index
+int	nn		#I Number of neighbors
+int	a[npattern]	#I Reference lines (indices)
+int	b[npattern]	#I Target lines (indices)
+int	npattern	#I Number of lines in pattern
+int	votes[n1,n2]	#O Vote array
+int	n1, n2		#O Number of reference and target lines
+
+int	i, j, i1, j1, na, nb
+
+begin
+	na = min (a[1] + nn, n1)
+	nb = min (b[1] + nn, n2)
+	i1 = s1 - a[3]
+	j1 = s2 - b[3]
+
+	if (npattern > 3) {
+	    for (a[4]=a[3]+1; a[4]<=na; a[4]=a[4]+1) {
+		for (b[4]=b[3]+1; b[4]<=nb; b[4]=b[4]+1) {
+		    i = i1 + a[4]
+		    j = j1 + b[4]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+	if (npattern > 4) {
+	    for (a[5]=a[4]+1; a[5]<=na; a[5]=a[5]+1) {
+		for (b[5]=b[4]+1; b[5]<=nb; b[5]=b[5]+1) {
+		    i = i1 + a[5]
+		    j = j1 + b[5]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+	if (npattern > 5) {
+	    for (a[6]=a[5]+1; a[6]<=na; a[6]=a[6]+1) {
+		for (b[6]=b[5]+1; b[6]<=nb; b[6]=b[6]+1) {
+		    i = i1 + a[6]
+		    j = j1 + b[6]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+	if (npattern > 6) {
+	    for (a[7]=a[6]+1; a[7]<=na; a[7]=a[7]+1) {
+		for (b[7]=b[6]+1; b[7]<=nb; b[7]=b[7]+1) {
+		    i = i1 + a[7]
+		    j = j1 + b[7]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+	if (npattern > 7) {
+	    for (a[8]=a[7]+1; a[8]<=na; a[8]=a[8]+1) {
+		for (b[8]=b[7]+1; b[8]<=nb; b[8]=b[8]+1) {
+		    i = i1 + a[8]
+		    j = j1 + b[8]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+	if (npattern > 8) {
+	    for (a[9]=a[8]+1; a[9]<=na; a[9]=a[9]+1) {
+		for (b[9]=b[8]+1; b[9]<=nb; b[9]=b[9]+1) {
+		    i = i1 + a[9]
+		    j = j1 + b[9]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+	if (npattern > 9) {
+	    for (a[10]=a[9]+1; a[10]<=na; a[10]=a[10]+1) {
+		for (b[10]=b[9]+1; b[10]<=nb; b[10]=b[10]+1) {
+		    i = i1 + a[10]
+		    j = j1 + b[10]
+		    if (r1[i] < r2[j,1] || r1[i] > r2[j,2])
+			next
+		    call aid_vote (aid, a, b, 10, votes, n1, n2)
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+	}
+	}
+	} else {
+	    call aid_vote (aid, a, b, npattern, votes, n1, n2)
+	}
+end
+
+
+# AID_VOTE -- Add votes for the lines in the pattern to the vote array.
+
+procedure aid_vote (aid, a, b, npattern, votes, n1, n2)
+
+pointer	aid		#I AID pointer
+int	a[npattern]	#I Reference lines (indices)
+int	b[npattern]	#I Target lines (indices)
+int	npattern	#I Number of lines in pattern
+int	votes[n1,n2]	#O Vote array
+int	n1, n2		#O Number of reference and target lines
+
+int	i, stridxs()
+pointer	xr, xt
+
+begin
+	if (AID_CDSIGN(aid) == 1) {
+	    do i = 1, npattern
+		votes[a[i],b[i]] = votes[a[i],b[i]] + 1
+	} else {
+	    do i = 1, npattern
+		votes[a[i],n2-b[i]+1] = votes[a[i],n2-b[i]+1] + 1
+	}
+
+        # Debug a: Print line assignments.
+	if (stridxs ("a", AID_DEBUG(aid,1)) != 0) {
+	    xr = AID_XR(aid)-1
+	    xt = AID_XT(aid)-1
+	    if (AID_CDSIGN(aid) == 1) {
+		do i = 1, npattern {
+		    call eprintf (" %6g %6g %5d")
+			call pargd (Memd[xr+a[i]])
+			call pargd (Memd[xt+b[i]])
+			call pargi (b[i])
+		}
+	    } else {
+		xt = xt+n2+1
+		do i = 1, npattern {
+		    call eprintf (" %6g %6g %5d")
+			call pargd (Memd[xr+a[i]])
+			call pargd (Memd[xt-b[i]])
+			call pargi (n2-b[i]+1)
+		}
+	    }
+	    call eprintf ("\n")
+	}
+end
+
+
+# AID_SELECT -- Select top vote getters.
+
+procedure aid_select (aid, x1, x2, x3, votes, svotes, n1, n2, x, y, w, ns)
+
+pointer	aid		#I AID pointer
+double	x1[n1]		#I Reference lines
+double	x2[n2]		#I Linearized target lines
+double	x3[n2]		#I Target lines
+int	votes[n1,n2]	#I Vote array
+int	svotes[ARB]	#I Sort indices for vote array
+int	n1, n2		#I Number of lines
+real	x[ns]		#O Selected target coordinates
+real	y[ns]		#O Selected reference coordinates
+real	w[ns]		#O Weight (votes)
+int	ns		#U Maximum number on input, number selected on output
+
+int	i, j, k, n
+double	a, b
+bool	check
+
+begin
+	check = (AID_CRMIN(aid) > -MAX_DOUBLE / 10. &&
+	    AID_CRMAX(aid) < MAX_DOUBLE / 10.)
+
+	# Select the highest votes.
+	n = 0
+	for (k=1; k<=n1*n2 && n<ns; k=k+1) {
+	    i = mod (svotes[k]-1, n1) + 1 
+	    j = (svotes[k]-1) / n1 + 1 
+	    if (votes[i,j] < 1)
+		break
+	    if (check) {
+		a = (x2[j] - AID_CRPIX(aid)) * AID_CDSIGN(aid) * AID_CDMIN(aid)
+		b = (x2[j] - AID_CRPIX(aid)) * AID_CDSIGN(aid) * AID_CDMAX(aid)
+		if (x1[i] < AID_CRMIN(aid) + min (a,b))
+		    next
+		if (x1[i] > AID_CRMAX(aid) + max (a,b))
+		    next
+	    }
+	    n = n + 1
+	    x[n] = x3[j]
+	    y[n] = x1[i]
+	    w[n] = votes[i,j]
+	}
+	ns = n
+
+	if (ns < 1)
+	    call error (1, "No matches found")
+end
+
+
+# AID_DISP -- Given a set of candidate identifications (pixel, wavelength)
+# find all linear dispersions between two or more identifications which
+# satisfy the dispersion constraints.  The list of ranked dispersions with
+# higher rankings for higher number of points the dispersion goes through
+# higher total votes for the points.  Hopefully the true dispersion will be
+# in the highest ranked dispersions.
+
+procedure aid_disp (aid, x, y, v, n, w1, dw, nw, nv, nd)
+
+pointer	aid		#I AID pointer
+real	x[n]		#I Array of candidate reference coordinates
+real	y[n]		#I Array of candidate target coordinates
+real	v[n]		#I Votes
+int	n		#I Number of candidate pairs
+real	w1[nd]		#O Dispersion origin
+real	dw[nd]		#O Dispersion slope
+int	nw[nd]		#O Number of points
+int	nv[nd]		#O Sum of votes
+int	nd		#U Number of dispersions
+
+bool	debug, skip
+int	i, j, k, l, m, ii, sumn, sumv, stridxs()
+double	aw, bw, cw, sumx, sumy, sumyy, sumxy
+pointer	iii
+
+begin
+	# Sort the candidates by reference coordinate.
+	call xt_sort2 (x, y, n)
+
+	debug = (stridxs ("m", AID_DEBUG(aid,1)) != 0)
+	if (debug) {
+	    call eprintf ("# Selected pairs with votes.\n")
+	    do i = 1, n {
+		call eprintf ("%4d %8.6g %8.6g %d\n")
+		call pargi (i)
+		call pargr (x[i])
+		call pargr (y[i])
+		call pargr (v[i])
+	    }
+	    call eprintf ("# Dispersions to check up to %d.\n")
+	        call pargi (nd)
+	}
+
+	m = 0
+	ii = 0
+	call malloc (iii, nd, TY_INT)
+	do i = 1, n-2 {
+	    do j = i+1, n-1 {
+		if (x[j] == x[i] || y[j] == y[i])
+		    next
+
+		bw = (x[j] - x[i]) / (y[j] - y[i])
+		aw = x[i] - bw * y[i]
+		cw = aw + bw * AID_CRPIX(aid)
+
+		# Check dispersion ranges.
+		skip = false
+		if (abs (bw) < AID_CDMIN(aid) || abs (bw) > AID_CDMAX(aid))
+		    skip = true
+		else if (cw < AID_CRMIN(aid) || cw > AID_CRMAX(aid))
+		    skip = true
+		if (AID_CDSIGN(aid) * bw < 0.)
+		    skip = true
+		if (skip)
+		    next
+
+		sumn = 2
+		sumv = v[i] + v[j]
+		sumx = x[i] + x[j]
+		sumy = y[i] + y[j]
+		sumyy = y[i]*y[i] + y[j]*y[j]
+		sumxy = x[i]*y[i] + x[j]*y[j]
+
+		do k = j+1, n {
+		    if (abs ((x[k] - aw - bw * y[k]) / bw) > 2.) 
+			next
+
+		    sumn = sumn + 1
+		    sumv = sumv + v[k]
+		    sumx = sumx + x[k]
+		    sumy = sumy + y[k]
+		    sumyy = sumyy + y[k]*y[k]
+		    sumxy = sumxy + x[k]*y[k]
+		}
+
+		aw = (sumx*sumyy - sumy*sumxy) / (sumn * sumyy - sumy * sumy)
+		bw = (sumn*sumxy - sumx*sumy) / (sumn * sumyy - sumy * sumy)
+		cw = aw + bw * AID_CRPIX(aid)
+		ii = ii + 1
+
+		if (debug) {
+		    call eprintf ("     %4d %4d %4d %8.5g  %8.3g  %8d %8d")
+		    call pargi (ii)
+		    call pargi (i)
+		    call pargi (j)
+		    call pargd (aw+bw*(ID_NPTS(AID_IDT(aid))/2.+1))
+		    call pargd (bw)
+		    call pargi (sumn)
+		    call pargi (sumv)
+		}
+
+		# Check if already found.
+		for (k = 1; k <= m; k = k + 1)
+		    if (abs ((x[1]-aw)/bw - (x[1]-w1[k])/dw[k]) < 2. &&
+		        abs ((x[n]-aw)/bw - (x[n]-w1[k])/dw[k]) < 2.)
+			break
+		if (k <= m) {
+		    if (sumn > nw[k] || (sumn == nw[k] && sumv > nv[k])) {
+			for (l = k; l > 1; l = l - 1) {
+			    if (sumn<nw[l-1] || (sumn==nw[l-1] && sumv<nv[l-1]))
+				break
+			    w1[l] = w1[l-1]
+			    dw[l] = dw[l-1]
+			    nw[l] = nw[l-1]
+			    nv[l] = nv[l-1]
+			    Memi[iii+l-1] = Memi[iii+l-2]
+			}
+			if (debug) {
+			    call eprintf (" replace %4d\n")
+			    call pargi (Memi[iii+l-1])
+			}
+			w1[l] = aw
+			dw[l] = bw
+			nw[l] = sumn
+			nv[l] = sumv
+			Memi[iii+l-1] = ii
+		    } else if (debug) {
+			call eprintf (" use %4d\n")
+			call pargi (Memi[iii+k-1])
+		    }
+		    next
+		}
+
+		# Check dispersion ranges.
+		if (abs (bw) < AID_CDMIN(aid) || abs (bw) > AID_CDMAX(aid))
+		    skip = true
+		else if (cw < AID_CRMIN(aid) || cw > AID_CRMAX(aid))
+		    skip = true
+		if (AID_CDSIGN(aid) * bw < 0.)
+		    skip = true
+		if (skip) {
+		    if (debug)
+			call eprintf (" out of range\n")
+		    next
+		}
+
+		# Add to ordered list.
+		for (k = 1; k <= m; k = k + 1)
+		    if (sumn > nw[k] || (sumn == nw[k] && sumv > nv[k]))
+			break
+		if (k <= nd) {
+		    if (m < nd) {
+			m = m + 1
+			if (debug)
+			    call eprintf (" add\n")
+		    } else if (debug) {
+			call eprintf (" bump %4d\n")
+			    call pargi (Memi[iii+m-1])
+		    }
+		    for (l = m; l > k; l = l - 1) {
+			w1[l] = w1[l-1]
+			dw[l] = dw[l-1]
+			nw[l] = nw[l-1]
+			nv[l] = nv[l-1]
+			Memi[iii+l-1] = Memi[iii+l-2]
+		    }
+		    w1[k] = aw
+		    dw[k] = bw
+		    nw[k] = sumn
+		    nv[k] = sumv
+		    Memi[iii+k-1] = ii
+		} else if (debug)
+		    call eprintf (" failed\n")
+	    }
+	}
+
+	nd = m
+
+	if (debug) {
+	    call eprintf ("# Final ordered dispersions to try.\n")
+	    do i = 1, nd {
+		call eprintf ("     %4d %8.5g  %8.3g  %8d %8d\n")
+		call pargi (Memi[iii+i-1])
+		call pargr (w1[i]+dw[i]*(ID_NPTS(AID_IDT(aid))/2.+1))
+		call pargr (dw[i])
+		call pargi (nw[i])
+		call pargi (nv[i])
+	    }
+	}
+	call mfree (iii, TY_INT)
+
+        # Debug d: Graph dispersions.
+	if (stridxs ("d", AID_DEBUG(aid,1)) != 0)
+	    call aid_dgraph (aid, x, y, n, w1, dw, nd)
+end
+
+
+# AID_EVAL -- Evaluate possible solutions.
+
+double procedure aid_eval (aid, ev, nd)
+
+pointer	aid		#I AID pointer
+pointer	ev		#I EV pointer
+int	nd		#I Dispersion candidate to evaluate
+double	best		#O Best statistic
+
+int	i, n
+pointer	idt, x, y
+double	a, b, c, d, rms, fmatch, ftmatch
+int	stridxs()
+
+int	ncandidate, nmatch1, nmatch2
+common	/llstat/ ncandidate, nmatch1, nmatch2
+
+define	done_	90
+
+begin
+	best = INDEFD
+	if (nd > AID_ND(ev))
+	    return (best)
+
+	idt = AID_IDT(aid)
+	x = AID_X(ev) - 1
+	y = AID_Y(ev) - 1
+	n = AID_N(ev)
+
+	a = Memr[AID_A(ev)+nd-1]
+	b = Memr[AID_B(ev)+nd-1]
+	c = ID_NPTS(AID_IDT(aid)) / 2. + 1
+	if (IS_INDEFD(AID_CDELT(aid)))
+	    d = b
+	else
+	    d = AID_CDELT(aid)
+
+	ID_IC(idt) = AID_IC1(aid)
+	ID_NFEATURES(idt) = 0
+	do i = 1, n {
+	    if (abs ((Memr[y+i] - a - b * Memr[x+i]) / b) < 2.)
+		call id_newfeature (idt, double(Memr[x+i]), double(Memr[x+i]),
+		    double(Memr[y+i]), 1.0D0, ID_FWIDTH(idt), ID_FTYPE(idt),
+		    NULL)
+	}
+	if (ID_NFEATURES(idt) <= 1)
+	    goto done_
+
+	call dcvfree (ID_CV(idt))
+	iferr (call aid_dofit (aid, idt, d, rms, fmatch, ftmatch, best))
+	    goto done_
+
+	# Debug s: Print search iterations.
+	if (stridxs ("s", AID_DEBUG(aid,1)) != 0) {
+	    call eprintf (
+	"%2d/%-2d %8.2f %8.3f %3d %3d/%-3d %3d/%-3d %3d %3d %6.3f %5.2f\n")
+		call pargi (AID_BIN1(ev))
+		call pargi (AID_BIN2(ev))
+		call pargd (a+c*b)
+		call pargd (b)
+		call pargi (ID_NFEATURES(idt))
+		call pargi (nmatch2)
+		call pargi (ncandidate)
+		call pargi (nint(min (ncandidate, AID_NT(aid))*(1-ftmatch)))
+		call pargi (min (ncandidate, AID_NT(aid)))
+		call pargi (nint(100.*fmatch))
+		call pargi (nint(100.*ftmatch))
+		call pargd (rms)
+		call pargd (best)
+	}
+
+	if (best < AID_BEST(aid)) {
+	    AID_FMATCH(aid) = fmatch
+	    AID_FTMATCH(aid) = ftmatch
+	    AID_RMS(aid) = rms
+	    AID_BEST(aid) = best
+	    ID_IC(idt) = AID_IC2(aid)
+	    call id_saveid (idt, "autoidentify")
+	}
+
+done_
+	ID_IC(idt) = AID_IC2(aid)
+	return (best)
+end
+
+
+# AID_DOFIT -- From a set of candidate identifications fit and evaluate
+# a dispersion solution.
+
+procedure aid_dofit (aid, id, cdelt, rms, fmatch, ftmatch, best)
+
+pointer	aid		#I AID pointer
+pointer	id		#I ID pointer
+double	cdelt		#I Dispersion to use in pixel rms conversion
+double	rms		#O Final RMS in pixels
+double	fmatch		#O Line list non-matching fraction
+double	ftmatch		#O Target line non-matching fraction
+double	best		#O Best fit parameter
+
+int	i, j, k, l, nmin, nfound, nt, ntmatch, maxfeatures, stridxs()
+double	fit, user, dcveval(), id_fitpt()
+pointer	cv, xt, label
+
+int	ncandidate, nmatch1, nmatch2
+common	/llstat/ ncandidate, nmatch1, nmatch2
+
+errchk	id_dofit, id_fitdata, id_fitfeatures, id_linelist, id_match
+
+begin
+	maxfeatures = ID_MAXFEATURES(id)
+	ID_MAXFEATURES(id) = 1000
+	iferr {
+	    do k = 1, 3 {
+		if (ID_NFEATURES(id) < 2)
+		    call error (0, "aid_dofit: not enough features")
+		if (k > 1)
+		    call id_linelist (id)
+
+		if (stridxs ("i", AID_DEBUG(aid,1)) != 0)
+		    call id_dofit (id, YES)
+		else
+		    call id_dofit (id, NO)
+		do l = AID_ORD(aid)-1, 2, -1 {
+		    cv = ID_CV(id)
+		    user = dcveval (cv, 1D0)
+		    fit = (dcveval (cv, double (ID_NPTS(id)/2)) - user) /
+			(dcveval (cv, double (ID_NPTS(id))) - user)
+		    if (abs (fit - 0.5) <= AID_MAXNL(aid))
+		        break
+		    if (stridxs ("n", AID_DEBUG(aid,1)) != 0) {
+			call eprintf (
+			    "order %d: non-linearity of %.1f%% > %.1f%%\n")
+			call pargi (l+1)
+			call pargd (100*abs(fit-0.5))
+			call pargr (100*AID_MAXNL(aid))
+		    }
+		    call ic_puti (ID_IC(id), "order", l)
+		    if (stridxs ("i", AID_DEBUG(aid,1)) != 0)
+			call id_dofit (id, YES)
+		    else
+			call id_dofit (id, NO)
+		    call ic_puti (ID_IC(id), "order", AID_ORD(aid))
+		}
+		call id_fitdata (id)
+		call id_fitfeatures (id)
+		
+		j = 0
+		do i = 1, ID_NFEATURES(id) {
+		    if (IS_INDEFD(USER(id,i)) || WTS(id,i) != 0.) {
+			j = j + 1
+			PIX(id,j) = PIX(id,i)
+			FIT(id,j) = FIT(id,i)
+			USER(id,j) = USER(id,i)
+			WTS(id,j) = WTS(id,i)
+			FWIDTH(id,j) = FWIDTH(id,i)
+			FTYPE(id,j) = FTYPE(id,i)
+		    }
+		}
+		ID_NFEATURES(id) = j
+	    }
+	    ID_MAXFEATURES(id) = maxfeatures
+	} then {
+	    ID_MAXFEATURES(id) = maxfeatures
+	    call erract (EA_ERROR)
+	}
+	if (IS_INDEFD(cdelt))
+	    return
+
+	nmin = 2
+        nfound = AID_NFOUND(aid)
+	if (ID_NFEATURES(id) < nfound)
+	    call error (0, "aid_dofit: not enough features")
+
+	# Compute fwidth rms.
+	rms = 0.
+	for (i=1; i<=ID_NFEATURES(id); i=i+1)
+	    rms = rms + (FIT(id,i) - USER(id,i)) ** 2
+	rms = sqrt (rms/ max (1, ID_NFEATURES(id)-nmin)) / abs (cdelt)
+	rms = rms / ID_FWIDTH(id)
+
+	# Compute line list matching fraction.
+	ncandidate = max (nfound, (ncandidate-(nmatch1-nmatch2)))
+	fmatch = 1 - real (nmatch2) / ncandidate
+
+	# Compute target line matching fraction.
+	xt = AID_XT(aid)
+	nt = AID_NT(aid)
+	label = NULL
+	ntmatch = 0
+	do i = 1, nt {
+	    fit = id_fitpt (id, Memd[xt+i-1])
+	    user = INDEFD
+	    call id_match (id, fit, user, label, ID_MATCH(id))
+	    if (!IS_INDEFD(user))
+		ntmatch = ntmatch + 1
+	}
+	ftmatch = 1 - real (ntmatch) / min (nt, ncandidate)
+	call mfree (label, TY_CHAR)
+
+	if (AID_RMSG(aid) > 0. && AID_FMATCHG(aid) > 0.) {
+	    best = AID_WRMS(aid) *  rms / AID_RMSG(aid)
+	    best = best + AID_WFMATCH(aid) * fmatch / AID_FMATCHG(aid)
+	    best = best + AID_WFTMATCH(aid) * ftmatch / AID_FMATCHG(aid)
+	} else
+	    best = MAX_DOUBLE
+end
+
+
+# AID_DOFITF -- From a set of candidate identifications fit and evaluate
+# a final dispersion solution.
+
+procedure aid_dofitf (aid, id)
+
+pointer	aid		#I AID pointer
+pointer	id		#I ID pointer
+
+int	i, j, k, maxfeatures
+
+errchk	id_dofit, id_fitdata, id_fitfeatures, id_linelist
+
+begin
+	maxfeatures = ID_MAXFEATURES(id)
+	ID_MAXFEATURES(id) = 1000
+	iferr {
+	    do k = 1, 3 {
+		if (ID_NFEATURES(id) < 2)
+		    call error (0, "aid_dofit: not enough features")
+		if (k > 1)
+		    call id_linelist (id)
+
+		call id_dofit (id, NO)
+		call id_fitdata (id)
+		call id_fitfeatures (id)
+		if (k < 3) {
+		    j = 0
+		    do i = 1, ID_NFEATURES(id) {
+			if (IS_INDEFD(USER(id,i)) || WTS(id,i) != 0.) {
+			    j = j + 1
+			    PIX(id,j) = PIX(id,i)
+			    FIT(id,j) = FIT(id,i)
+			    USER(id,j) = USER(id,i)
+			    WTS(id,j) = WTS(id,i)
+			    FWIDTH(id,j) = FWIDTH(id,i)
+			    FTYPE(id,j) = FTYPE(id,i)
+			}
+		    }
+		    ID_NFEATURES(id) = j
+		}
+	    }
+	    ID_MAXFEATURES(id) = maxfeatures
+	} then {
+	    ID_MAXFEATURES(id) = maxfeatures
+	    call erract (EA_ERROR)
+	}
+end
+
+
+# AID_EVALLOC -- Allocate memory to save the candidate identifications
+# and dispersions to be evaluated.
+
+pointer procedure aid_evalloc (aid, index)
+
+pointer	aid		#I AID pointer
+int	index		#I Reference sample index
+
+begin
+	if (AID_EVS(aid) == NULL)
+	    call calloc (AID_EVS(aid), (index+49)*AID_EVLEN, TY_POINTER)
+	else if (index > 1 && mod (index-1, 50) == 0) {
+	    call realloc (AID_EVS(aid), (index+49)*AID_EVLEN, TY_POINTER)
+	    call aclri (Memi[AID_EVS(aid)+(index-1)*AID_EVLEN], 50*AID_EVLEN)
+	}
+	return (AID_EVS(aid)+(index-1)*AID_EVLEN)
+end
+
+
+# AID_EVFREE -- Free memory from the evaluation step.
+
+procedure aid_evfree (aid, index)
+
+pointer	aid		#I AID pointer
+int	index		#I Reference sample index
+
+pointer	ev, aid_evalloc()
+
+begin
+	ev = aid_evalloc (aid, index)
+	call mfree (AID_X(ev), TY_REAL)
+	call mfree (AID_Y(ev), TY_REAL)
+	call mfree (AID_A(ev), TY_REAL)
+	call mfree (AID_B(ev), TY_REAL)
+end
+
+
+# AID_IMGD -- Get value from image header or parameter string.
+
+double procedure aid_imgd (im, param)
+
+pointer	im			#I IMIO pointer
+char	param[ARB]		#I Parameter
+
+int	i, ctod()
+double	dval, imgetd()
+
+begin
+	if (param[1] == '!') {
+	    iferr (dval = imgetd (im, param[2]))
+		dval = INDEFD
+	} else {
+	    iferr (dval = imgetd (im, param)) {
+		i = 1
+		if (ctod (param, i, dval) == 0)
+		    dval = INDEFD
+	    }
+	}
+	return (dval)
+end
diff --git a/noao/onedspec/identify/autoid/mkpkg b/noao/onedspec/identify/autoid/mkpkg
new file mode 100644
index 00000000..7d46d183
--- /dev/null
+++ b/noao/onedspec/identify/autoid/mkpkg
@@ -0,0 +1,17 @@
+$checkout libpkg.a ../../
+$update   libpkg.a
+$checkin  libpkg.a ../../
+$exit
+
+libpkg.a:
+	aidautoid.x	autoid.h <gset.h> ../identify.h <mach.h>\
+			<math/iminterp.h> <smw.h>
+	aidget.x	autoid.h
+	aidgraph.x	autoid.h <gset.h> ../identify.h <mach.h> <pkg/gtools.h>\
+			<smw.h>
+	aidinit.x	autoid.h ../identify.h <smw.h>
+	aidlog.x	../identify.h
+	aidset.x	autoid.h
+	aidshift.x	../identify.h
+	autoid.x	autoid.h <error.h> ../identify.h <mach.h> <smw.h>
+	;
diff --git a/noao/onedspec/identify/idcenter.x b/noao/onedspec/identify/idcenter.x
new file mode 100644
index 00000000..6b6dba06
--- /dev/null
+++ b/noao/onedspec/identify/idcenter.x
@@ -0,0 +1,37 @@
+include	<smw.h>
+include	"identify.h"
+
+# ID_CENTER -- Locate the center of a feature.
+
+double procedure id_center (id, x, width, type)
+
+pointer	id				# ID pointer
+double	x				# Initial guess
+real	width				# Feature width
+int	type				# Feature type
+
+int	np1
+real	value
+double	dvalue
+
+real	center1d()
+double	smw_c1trand()
+
+begin
+	if (IS_INDEFD(x))
+	    return (x)
+
+	dvalue = smw_c1trand (ID_PL(id), x)
+	if (IS_INDEFD(dvalue))
+	    return (dvalue)
+
+	np1 = NP1(ID_SH(id)) - 1
+	value = dvalue - np1
+ 	value = center1d (value, IMDATA(id,1), ID_NPTS(id),
+	    width, type, ID_CRADIUS(id), ID_THRESHOLD(id))
+
+	if (IS_INDEF(value))
+	    return (INDEFD)
+	else
+	    return (smw_c1trand (ID_LP(id), double(value+np1)))
+end
diff --git a/noao/onedspec/identify/idcolon.x b/noao/onedspec/identify/idcolon.x
new file mode 100644
index 00000000..0bd68042
--- /dev/null
+++ b/noao/onedspec/identify/idcolon.x
@@ -0,0 +1,284 @@
+include	<gset.h>
+include	<error.h>
+include	<smw.h>
+include	"identify.h"
+
+# List of colon commands.
+define	CMDS "|show|features|image|nsum|database|read|write|add|coordlist|match\
+	|maxfeatures|minsep|zwidth|labels|fwidth|ftype|cradius|threshold|"
+
+define	SHOW		1	# Show parameters
+define	FEATURES	2	# Show list of features
+define	IMAGE		3	# Set new image
+define	NSUM		4	# Set the number of lines or columns to sum
+define	DATABASE	5	# Set new database
+define	READ		6	# Read database entry
+define	WRITE		7	# Write database entry
+define	ADD		8	# Add features from database
+define	COORDLIST	9	# Set new coordinate list
+define	MATCH		10	# Set coordinate list matching distance
+define	MAXFEATURES	11	# Set maximum number of features for auto find
+define	MINSEP		12	# Set minimum separation distance
+define	ZWIDTH		13	# Set zoom window width
+define	LABEL		14	# Set label type
+define	WIDTH		15	# Set centering width
+define	TYPE		16	# Set centering type
+define	RADIUS		17	# Set centering radius
+define	THRESHOLD	18	# Set the centering threshold
+
+# ID_COLON -- Respond to colon command.
+
+procedure id_colon (id, cmdstr, newimage, prfeature)
+
+pointer	id			# ID pointer
+char	cmdstr[ARB]		# Colon command
+char	newimage[ARB]		# New image name
+int	prfeature		# Print current feature on status line
+
+char	cmd[SZ_LINE]
+int	i, ncmd, ival[2]
+real	rval[2]
+pointer	im
+
+int	nscan(), strdic()
+pointer	immap()
+errchk	immap, id_dbread, id_dbwrite, id_log
+
+begin
+	# Scan the command string and get the first word.
+	call sscan (cmdstr)
+	call gargwrd (cmd, SZ_LINE)
+	ncmd = strdic (cmd, cmd, SZ_LINE, CMDS)
+
+	switch (ncmd) {
+	case SHOW: # :show - show values of parameters
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (ID_GP(id), AW_CLEAR)
+	        call id_show (id, "STDOUT")
+		call greactivate (ID_GP(id), AW_PAUSE)
+	    } else {
+		iferr (call id_show (id, cmd)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+	    }
+	case FEATURES: # :features - list features
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (ID_GP(id), AW_CLEAR)
+	        call id_log (id, "STDOUT")
+		call greactivate (ID_GP(id), AW_PAUSE)
+	    } else {
+		iferr (call id_log (id, cmd)) {
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+	    }
+	case IMAGE: # :image - set image to identify
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("image %s\n")
+		    call pargstr (ID_IMAGE(id))
+		prfeature = NO
+	    } else {
+		call strcpy (cmd, newimage, SZ_FNAME)
+		iferr {
+		    im = immap (newimage, READ_ONLY, 0)
+		    call imunmap (im)
+		} then {
+		    newimage[1] = EOS
+		    call erract (EA_WARN)
+		    prfeature = NO
+		}
+	    }
+	case NSUM: # :nsum - set number of lines or columns to sum in image
+	    call gargi (ival[1])
+	    if (nscan() == 1) {
+	        call printf ("nsum %d %d\n")
+		    call pargi (ID_NSUM(id,1))
+		    call pargi (ID_NSUM(id,2))
+		prfeature = NO
+	    } else {
+		ID_NSUM(id,1) = ival[1]
+		call gargi (ival[2])
+		if (nscan() == 3)
+		    ID_NSUM(id,2) = ival[2]
+		call smw_daxis (NULL, NULL, SMW_PAXIS(MW(ID_SH(id)),1),
+		    ID_NSUM(id,1), ID_NSUM(id,2))
+	    }
+	case DATABASE: # :database - set database
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("database %s\n")
+		    call pargstr (ID_DATABASE(id))
+		prfeature = NO
+	    } else {
+	        call strcpy (cmd, ID_DATABASE(id), ID_LENSTRING)
+		ID_NEWDBENTRY(id) = YES
+	    }
+	case READ: # :read - read database entry
+	    prfeature = NO
+	    iferr {
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1)
+		    call id_dbread (id, ID_IMAGE(id), ID_AP(id,1),
+			NO, YES)
+	        else {
+		    call gargi (ival[1])
+		    if (nscan() < 3)
+			ival[1] = ID_AP(id,1)
+		    call gargi (ival[2])
+		    if (nscan() < 4)
+			ival[2] = ID_AP(id,2)
+		    call id_dbread (id, cmd, ival, NO, YES)
+		}
+	    } then
+		call erract (EA_WARN)
+	case WRITE: # :write - write database entry
+	    prfeature = NO
+	    iferr {
+		ival[1] = ID_AP(id,1)
+		ival[2] = ID_AP(id,2)
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1)
+		    call id_dbwrite (id, ID_IMAGE(id), ival, YES)
+	        else {
+		    call gargi (ival[1])
+		    if (nscan() < 3)
+			ival[1] = ID_AP(id,1)
+		    call gargi (ival[2])
+		    if (nscan() < 4)
+			ival[2] = ID_AP(id,2)
+		    call id_dbwrite (id, cmd, ival, YES)
+		}
+	    } then
+		call erract (EA_WARN)
+	case ADD: # :add - add features from database entry
+	    prfeature = NO
+	    iferr {
+	        call gargwrd (cmd, SZ_LINE)
+	        if (nscan() == 1)
+		    call id_dbread (id, ID_IMAGE(id), ID_AP(id,1),
+			YES, YES)
+	        else {
+		    call gargi (ival[1])
+		    if (nscan() < 3)
+			ival[1] = ID_AP(id,1)
+		    call gargi (ival[2])
+		    if (nscan() < 4)
+			ival[2] = ID_AP(id,2)
+		    call id_dbread (id, cmd, ival, YES, YES)
+		}
+	    } then
+		call erract (EA_WARN)
+	case COORDLIST: # :coordlist - set coordinate list
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		call printf ("coordlist %s\n")
+		    call pargstr (ID_COORDLIST(id))
+		prfeature = NO
+	    } else {
+	        call strcpy (cmd, ID_COORDLIST(id), ID_LENSTRING)
+		call id_unmapll (id)
+		call id_mapll (id)
+	    }
+	case MATCH: # :match - set matching distance for coordinate list
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+	        call printf ("match %g\n")
+		    call pargr (ID_MATCH(id))
+		prfeature = NO
+	    } else
+		ID_MATCH(id) = rval[1]
+	case MAXFEATURES: # :maxfeatures - set max num features for auto find
+	    call gargi (ival[1])
+	    if (nscan() == 1) {
+	        call printf ("maxfeatures %d\n")
+		    call pargi (ID_MAXFEATURES(id))
+		prfeature = NO
+	    } else
+		ID_MAXFEATURES(id) = ival[1]
+	case MINSEP: # :minsep - set minimum feature separation allowed
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("minsep %g\n")
+		    call pargr (ID_MINSEP(id))
+		prfeature = NO
+	    } else
+		ID_MINSEP(id) = rval[1]
+	case ZWIDTH: # :zwidth - set zoom window width
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("zwidth %g\n")
+		    call pargr (ID_ZWIDTH(id))
+		prfeature = NO
+	    } else {
+		ID_ZWIDTH(id) = rval[1]
+		if (ID_GTYPE(id) == 2)
+		    ID_NEWGRAPH(id) = YES
+	    }
+	case LABEL: # :labels - set label type
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		switch (ID_LABELS(id)) {
+		case 2:
+		    call printf ("labels index\n")
+		case 3:
+		    call printf ("labels pixel\n")
+		case 4:
+		    call printf ("labels coord\n")
+		case 5:
+		    call printf ("labels user\n")
+		case 6:
+		    call printf ("labels both\n")
+		default:
+		    call printf ("labels none\n")
+		}
+	        prfeature = NO
+	    } else {
+	        ID_LABELS(id) = strdic (cmd, cmd, SZ_LINE, LABELS)
+		do i = 1, ID_NFEATURES(id)
+		    call id_mark (id, i)
+	    }
+	case WIDTH: # :fwidth - set centering width
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+	        call printf ("fwidth %g\n")
+		    call pargr (ID_FWIDTH(id))
+	        prfeature = NO
+	    } else
+		ID_FWIDTH(id) = rval[1]
+	case TYPE:	# :ftype - set centering type
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 1) {
+		switch (ID_FTYPE(id)) {
+		case EMISSION:
+		    call printf ("ftype emission\n")
+		case ABSORPTION:
+		    call printf ("ftype absorption\n")
+		}
+	        prfeature = NO
+	    } else
+	        ID_FTYPE(id) = strdic (cmd, cmd, SZ_LINE, FTYPES)
+	case RADIUS: # :cradius - set centering radius
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("cradius %g\n")
+		    call pargr (ID_CRADIUS(id))
+	        prfeature = NO
+	    } else
+		ID_CRADIUS(id) = rval[1]
+	case THRESHOLD: # :threshold - set centering threshold
+	    call gargr (rval[1])
+	    if (nscan() == 1) {
+		call printf ("threshold %g\n")
+		    call pargr (ID_THRESHOLD(id))
+	        prfeature = NO
+	    } else
+		ID_THRESHOLD(id) = rval[1]
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	    prfeature = NO
+	}
+end
diff --git a/noao/onedspec/identify/iddb.x b/noao/onedspec/identify/iddb.x
new file mode 100644
index 00000000..e354d1c4
--- /dev/null
+++ b/noao/onedspec/identify/iddb.x
@@ -0,0 +1,515 @@
+include	<imset.h>
+include	<math/curfit.h>
+include	<smw.h>
+include	<units.h>
+include	"identify.h"
+include	<pkg/dttext.h>
+
+
+# ID_DBREAD -- Read features data from the database.
+
+procedure id_dbread (id, name, ap, add, verbose)
+
+pointer	id				# ID pointer
+char	name[SZ_LINE]			# Image name
+int	ap[2]				# Aperture number
+int	add				# Add features?
+int	verbose				# Verbose flag
+
+int	rec, dtlocate()
+pointer	sp, line, str
+errchk	dtremap, dtlocate, id_dbread_rec
+
+begin
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	call strcpy ("id", Memc[line], SZ_LINE)
+	call imgcluster (name, Memc[line+2], SZ_LINE)
+	call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], READ_ONLY)
+
+	call id_dbsection (id, name, ap, ID_SECTION(id), ID_LENSTRING)
+	call sprintf (Memc[line], SZ_LINE, "identify %s%s")
+	    call pargstr (name)
+	    call pargstr (ID_SECTION(id))
+
+	iferr (rec = dtlocate (ID_DT(Id), Memc[line])) {
+	    call salloc (str, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[str], SZ_LINE, "Entry not found: %s")
+		call pargstr (Memc[line])
+	    call error (0, Memc[str])
+	}
+
+	call id_dbread_rec (id, rec, add)
+
+	if (ID_NFEATURES(id) > 0) {
+	    ID_NEWGRAPH(id) = YES
+	    ID_NEWFEATURES(id) = YES
+	    ID_CURRENT(id) = 1
+	} else
+	    ID_CURRENT(id) = 0
+
+	if (verbose == YES) {
+	    call printf ("identify %s%s\n")
+		call pargstr (name)
+		call pargstr (ID_SECTION(id))
+	}
+
+	call sfree (sp)
+end
+
+
+# ID_DBSAVE -- Read all entries from a database and save.
+
+procedure id_dbsave (id, name)
+
+pointer	id				# ID pointer
+char	name[SZ_LINE]			# Image name
+
+int	rec, dtgeti()
+pointer	sp, line, dt
+errchk	dtremap, dtgeti, id_dbread_rec, id_saveap
+
+begin
+	call smark (sp)
+	call salloc (line, SZ_FNAME, TY_CHAR)
+
+	call strcpy ("id", Memc[line], SZ_FNAME)
+	call imgcluster (name, Memc[line+2], SZ_FNAME)
+	call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], READ_ONLY)
+
+	dt = ID_DT(id)
+	do rec = 1, DT_NRECS(dt) {
+	    ID_AP(id,1) = dtgeti (dt, rec, "aperture")
+	    ID_AP(id,2) = 1
+	    call id_dbread_rec (id, rec, NO)
+	    call id_saveap (id)
+	}
+
+	call sfree (sp)
+end
+
+
+# ID_DBREAD_REC -- Read specified record from the database.
+
+procedure id_dbread_rec (id, rec, add)
+
+pointer	id				# ID pointer
+int	rec				# Database record
+int	add				# Add features?
+
+double	pix
+int	i, j, k, ncoeffs
+pointer	dt, sh, un, sp, line, coeffs
+
+int	dtgeti(), dcvstati(), dtscan(), nscan()
+real	dtgetr()
+double	dcvstatd()
+bool	un_compare()
+pointer	un_open()
+errchk	un_open, dtgeti(), dtgad()
+
+begin
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	dt = ID_DT(id)
+	sh = ID_SH(id)
+
+	if (add == YES) {
+	    j = dtgeti (dt, rec, "features")
+	    k = j + ID_NFEATURES(id)
+	    ID_NALLOC(id) = k
+
+	    call realloc (ID_PIX(id), k, TY_DOUBLE)
+	    call realloc (ID_FIT(id), k, TY_DOUBLE)
+	    call realloc (ID_USER(id), k, TY_DOUBLE)
+	    call realloc (ID_WTS(id), k, TY_DOUBLE)
+	    call realloc (ID_FWIDTHS(id), k, TY_REAL)
+	    call realloc (ID_FTYPES(id), k, TY_INT)
+	    call realloc (ID_LABEL(id), k, TY_POINTER)
+
+	    do i = 1, j {
+		k = dtscan (dt)
+		call gargd (pix)
+
+		ID_NFEATURES(id) = ID_NFEATURES(id) + 1
+		for (k=ID_NFEATURES(id); (k>1)&&(pix<PIX(id,k-1)); k=k-1) {
+		    PIX(id,k) = PIX(id,k-1)
+		    FIT(id,k) = FIT(id,k-1)
+		    USER(id,k) = USER(id,k-1)
+		    WTS(id,k) = WTS(id,k-1)
+		    FWIDTH(id,k) = FWIDTH(id,k-1)
+		    FTYPE(id,k) = FTYPE(id,k-1)
+		    Memi[ID_LABEL(id)+k-1] = Memi[ID_LABEL(id)+k-2]
+		}
+		PIX(id,k) = pix
+		call gargd (FIT(id,k))
+		call gargd (USER(id,k))
+		call gargr (FWIDTH(id,k))
+		call gargi (FTYPE(id,k))
+		call gargd (WTS(id,k))
+		call gargstr (Memc[line], SZ_LINE)
+		Memi[ID_LABEL(id)+k-1] = NULL
+		call id_label (Memc[line], Memi[ID_LABEL(id)+k-1])
+
+		# The following initialization is for backwards compatibility.
+		if (nscan() < 5) {
+		    FWIDTH(id,k) = ID_FWIDTH(id)
+		    FTYPE(id,k) = ID_FTYPE(id)
+		} else if (nscan() < 6)
+		    WTS(id,k) = 1.
+	    }
+
+	    if (ID_UN(id) != NULL) {
+		ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) {
+		    un = un_open (Memc[line])
+		    if (!un_compare (un, ID_UN(id)) && j > 0) {
+			k = ID_NFEATURES(id) - j
+			call un_ctrand (un, ID_UN(id), FIT(id,k), FIT(id,k), j)
+			call un_ctrand (un, ID_UN(id), USER(id,k), USER(id,k),j)
+		    }
+		    call un_close (un)
+		}
+	    }
+
+	} else {
+	    if (sh != NULL) {
+		if (SMW_FORMAT(MW(sh))==SMW_ES || SMW_FORMAT(MW(sh))==SMW_MS) {
+		    iferr (APLOW(sh,1) = dtgetr (dt, rec, "aplow"))
+			APLOW(sh,1) = INDEF
+		    iferr (APHIGH(sh,1) = dtgetr (dt, rec, "aphigh"))
+			APHIGH(sh,1) = INDEF
+		}
+	    }
+
+	    do i = 1, ID_NFEATURES(id)
+		call mfree (Memi[ID_LABEL(id)+i-1], TY_CHAR)
+
+	    k = dtgeti (dt, rec, "features")
+	    ID_NFEATURES(id) = k
+	    ID_NALLOC(id) = k
+	    call realloc (ID_PIX(id), k, TY_DOUBLE)
+	    call realloc (ID_FIT(id), k, TY_DOUBLE)
+	    call realloc (ID_USER(id), k, TY_DOUBLE)
+	    call realloc (ID_WTS(id), k, TY_DOUBLE)
+	    call realloc (ID_FWIDTHS(id), k, TY_REAL)
+	    call realloc (ID_FTYPES(id), k, TY_INT)
+	    call realloc (ID_LABEL(id), k, TY_POINTER)
+
+	    do i = 1, ID_NFEATURES(id) {
+		k = dtscan (dt)
+		call gargd (PIX(id,i))
+		call gargd (FIT(id,i))
+		call gargd (USER(id,i))
+		call gargr (FWIDTH(id,i))
+		call gargi (FTYPE(id,i))
+		call gargd (WTS(id,i))
+		call gargstr (Memc[line], SZ_LINE)
+		Memi[ID_LABEL(id)+i-1] = NULL
+		call id_label (Memc[line], Memi[ID_LABEL(id)+i-1])
+
+		# The following initialization is for backwards compatibility.
+		if (nscan() < 5) {
+		    FWIDTH(id,i) = ID_FWIDTH(id)
+		    FTYPE(id,i) = ID_FTYPE(id)
+		} else if (nscan() < 6)
+		    WTS(id,i) = 1.
+	    }
+
+	    iferr (ID_SHIFT(id) = dtgetr (dt, rec, "shift"))
+		ID_SHIFT(id) = 0.
+
+	    iferr {
+		ncoeffs = dtgeti (dt, rec, "coefficients")
+		call salloc (coeffs, ncoeffs, TY_DOUBLE)
+		call dtgad (dt, rec, "coefficients", Memd[coeffs], ncoeffs,
+		    ncoeffs)
+
+		if (ID_CV(id) != NULL)
+		    call dcvfree (ID_CV(id))
+		call dcvrestore (ID_CV(id), Memd[coeffs])
+
+		call ic_putr (ID_IC(id), "xmin", real (dcvstatd(ID_CV(id),
+		    CVXMIN)))
+		call ic_putr (ID_IC(id), "xmax", real (dcvstatd(ID_CV(id),
+		    CVXMAX)))
+		ifnoerr (call dtgstr (dt,rec,"function",Memc[line],SZ_LINE)) {
+		    call ic_pstr (ID_IC(id), "function", Memc[line])
+		    call ic_puti (ID_IC(id), "order", dtgeti (dt, rec, "order"))
+		    call dtgstr (dt, rec, "sample", Memc[line], SZ_LINE)
+		    call ic_pstr (ID_IC(id), "sample", Memc[line])
+		    call ic_puti (ID_IC(id), "naverage",
+			dtgeti (dt, rec, "naverage"))
+		    call ic_puti (ID_IC(id), "niterate",
+			dtgeti (dt, rec, "niterate"))
+		    call ic_putr (ID_IC(id), "low",
+			dtgetr (dt, rec, "low_reject"))
+		    call ic_putr (ID_IC(id), "high",
+			dtgetr (dt, rec, "high_reject"))
+		    call ic_putr (ID_IC(id), "grow", dtgetr (dt, rec, "grow"))
+		} else {
+		    call ic_puti (ID_IC(id), "order", dcvstati (ID_CV(id),
+			CVORDER))
+		    switch (dcvstati (ID_CV(id), CVTYPE)) {
+		    case LEGENDRE:
+			call ic_pstr (ID_IC(id), "function", "legendre")
+		    case CHEBYSHEV:
+			call ic_pstr (ID_IC(id), "function", "chebyshev")
+		    case SPLINE1:
+			call ic_pstr (ID_IC(id), "function", "spline1")
+		    case SPLINE3:
+			call ic_pstr (ID_IC(id), "function", "spline3")
+		    }
+		}
+
+		ID_NEWCV(id) = YES
+		ID_CURRENT(id) = min (1, ID_NFEATURES(id))
+	    } then
+		;
+
+	    ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) {
+		if (ID_UN(id) == NULL)
+		    ID_UN(id) = un_open (Memc[line])
+		else {
+		    un = un_open (Memc[line])
+		    if (!un_compare (un, ID_UN(id))) {
+			call id_unitsll (id, Memc[line])
+			call un_close (ID_UN(id))
+			ID_UN(id) = un
+		    } else
+			call un_close (un)
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# ID_DBWRITE -- Write features data to the database.
+
+procedure id_dbwrite (id, name, ap, verbose)
+
+pointer	id				# ID pointer
+char	name[ARB]			# Image name
+int	ap[2]				# Aperture number
+int	verbose				# Verbose flag
+
+int	i, ncoeffs
+pointer	dt, sp, coeffs, root, sh, im
+
+int	dcvstati(), ic_geti()
+real	ic_getr()
+
+errchk	dtremap
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+
+	call strcpy ("id", Memc[root], SZ_FNAME)
+	call imgcluster (name, Memc[root+2], SZ_FNAME)
+	call dtremap (ID_DT(id), ID_DATABASE(id), Memc[root], APPEND)
+
+	call id_dbsection (id, name, ap, ID_SECTION(id), ID_LENSTRING)
+
+	sh = ID_SH(id)
+	dt = ID_DT(id)
+	call dtptime (dt)
+	call dtput (dt, "begin\tidentify %s%s\n")
+	    call pargstr (name)
+	    call pargstr (ID_SECTION(id))
+	call dtput (dt, "\tid\t%s\n")
+	    call pargstr (name)
+	call dtput (dt, "\ttask\tidentify\n")
+	call dtput (dt, "\timage\t%s%s\n")
+	    call pargstr (ID_IMAGE(id))
+	    call pargstr (ID_SECTION(id))
+	if (SMW_FORMAT(MW(sh)) == SMW_ES || SMW_FORMAT(MW(sh)) == SMW_MS) {
+	    call dtput (dt, "\taperture\t%d\n")
+		call pargi (ID_AP(id,1))
+	    call dtput (dt, "\taplow\t%g\n")
+		call pargr (APLOW(sh,1))
+	    call dtput (dt, "\taphigh\t%g\n")
+		call pargr (APHIGH(sh,1))
+	}
+
+	if (ID_UN(id) != NULL) {
+	    call dtput (dt, "\tunits\t%s\n")
+		call pargstr (UN_USER(ID_UN(id)))
+	}
+	call dtput (dt, "\tfeatures\t%d\n")
+	    call pargi (ID_NFEATURES(id))
+	do i = 1, ID_NFEATURES(id) {
+	    call dtput (dt, "\t    %10.2f %10.9g %10.9g %5.1f %d %d %s\n")
+		call pargd (PIX(id,i))
+		call pargd (FIT(id,i))
+		call pargd (USER(id,i))
+		call pargr (FWIDTH(id,i))
+		call pargi (FTYPE(id,i))
+		call pargd (WTS(id,i))
+		if (Memi[ID_LABEL(id)+i-1] != NULL)
+		    call pargstr (Memc[Memi[ID_LABEL(id)+i-1]])
+		else
+		    call pargstr ("")
+	}
+
+	if (ID_SHIFT(id) != 0.) {
+	    call dtput (dt, "\tshift\t%g\n")
+		call pargd (ID_SHIFT(id))
+	}
+
+	if (ID_CV(id) != NULL) {
+	    call dtput (dt, "\tfunction %s\n")
+		call ic_gstr (ID_IC(id), "function", Memc[root], SZ_FNAME)
+		call pargstr (Memc[root])
+	    call dtput (dt, "\torder %d\n")
+		call pargi (ic_geti (ID_IC(id), "order"))
+	    call dtput (dt, "\tsample %s\n")
+		call ic_gstr (ID_IC(id), "sample", Memc[root], SZ_FNAME)
+		call pargstr (Memc[root])
+	    call dtput (dt, "\tnaverage %d\n")
+		call  pargi (ic_geti (ID_IC(id), "naverage"))
+	    call dtput (dt, "\tniterate %d\n")
+		call  pargi (ic_geti (ID_IC(id), "niterate"))
+	    call dtput (dt, "\tlow_reject %g\n")
+		call  pargr (ic_getr (ID_IC(id), "low"))
+	    call dtput (dt, "\thigh_reject %g\n")
+		call  pargr (ic_getr (ID_IC(id), "high"))
+	    call dtput (dt, "\tgrow %g\n")
+		call  pargr (ic_getr (ID_IC(id), "grow"))
+
+	    ncoeffs = dcvstati (ID_CV(id), CVNSAVE)
+	    call salloc (coeffs, ncoeffs, TY_DOUBLE)
+	    call dcvsave (ID_CV(id), Memd[coeffs])
+	    call dtput (dt, "\tcoefficients\t%d\n")
+		call pargi (ncoeffs)
+	    do i = 1, ncoeffs {
+		call dtput (dt, "\t\t%g\n")
+		    call pargd (Memd[coeffs+i-1])
+	    }
+	}
+
+	call dtput (dt, "\n")
+
+	ID_NEWFEATURES(id) = NO
+	ID_NEWCV(id) = NO
+	ID_NEWDBENTRY(id) = NO
+
+	if (verbose == YES) {
+	    call printf ("identify %s%s\n")
+		call pargstr (name)
+	        call pargstr (ID_SECTION(id))
+	}
+
+	# Enter reference spectrum name in image header.
+	im = IM(sh)
+	call imseti (im, IM_WHEADER, YES)
+	call imastr (im, "REFSPEC1", ID_IMAGE(id))
+	iferr (call imdelf (im, "REFSPEC2"))
+	    ;
+ 
+	call sfree (sp)
+end
+
+
+# ID_DBCHECK -- Check if there is an entry in the database.
+# This does not actually read the database entry.  It also assumes that
+# if a database is already open it is for the same image (the image
+# names are not checked) and the database has been scanned.
+
+int procedure id_dbcheck (id, name, ap)
+
+pointer	id				# ID pointer
+char	name[SZ_LINE]			# Image name
+int	ap[2]				# Aperture number
+
+int	rec, stat
+pointer	sp, line, sec
+
+int	dtlocate()
+
+errchk	dtremap(), dtlocate()
+
+begin
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+	call salloc (sec, SZ_LINE, TY_CHAR)
+
+	if (ID_DT(id) == NULL) {
+	    call strcpy ("id", Memc[line], SZ_LINE)
+	    call imgcluster (name, Memc[line+2], SZ_LINE)
+	    iferr (call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line],
+		READ_ONLY)) {
+		call sfree (sp)
+		return (NO)
+	    }
+	}
+
+	call id_dbsection (id, name, ap, Memc[sec], SZ_LINE)
+	call sprintf (Memc[line], SZ_LINE, "identify %s%s")
+	    call pargstr (name)
+	    call pargstr (Memc[sec])
+
+	iferr (rec = dtlocate (ID_DT(id), Memc[line]))
+	    stat = NO
+	else
+	    stat = YES
+
+	call sfree (sp)
+	return (stat)
+end
+
+
+# ID_DBSECTION -- Make the IDENTIFY section.
+
+procedure id_dbsection (id, name, ap, section, sz_section)
+
+pointer	id				#I ID pointer
+char	name[SZ_LINE]			#I Image name
+int	ap[2]				#I Aperture number
+char	section[sz_section]		#O IDENTIFY section
+int	sz_section			#I Size of section string
+
+pointer	sh, smw
+bool	streq()
+
+begin
+	sh = ID_SH(id)
+	smw = MW(sh)
+
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    section[1] = EOS
+	    if (streq (name, ID_IMAGE(id))) {
+		switch (SMW_LDIM(smw)) {
+		case 2:
+		    switch (SMW_LAXIS(smw,1)) {
+		    case 1:
+			call sprintf (section, sz_section, "[*,%d]")
+		    case 2:
+			call sprintf (section, sz_section, "[%d,*]")
+		    }
+		    #call pargi (LINDEX(sh,1))
+		    call pargi (ap[1])
+		case 3:
+		    switch (SMW_LAXIS(smw,1)) {
+		    case 1:
+			call sprintf (section, sz_section, "[*,%d,%d]")
+		    case 2:
+			call sprintf (section, sz_section, "[%d,*,%d]")
+		    case 3:
+			call sprintf (section, sz_section, "[%d,%d,*]")
+		    }
+		    #call pargi (LINDEX(sh,1))
+		    #call pargi (LINDEX(sh,2))
+		    call pargi (ap[1])
+		    call pargi (ap[2])
+		}
+	    }
+	case SMW_ES, SMW_MS:
+	    call sprintf (section, sz_section, " - Ap %d")
+		call pargi (ap[1])
+	}
+end
diff --git a/noao/onedspec/identify/iddelete.x b/noao/onedspec/identify/iddelete.x
new file mode 100644
index 00000000..cd96abb1
--- /dev/null
+++ b/noao/onedspec/identify/iddelete.x
@@ -0,0 +1,26 @@
+include	"identify.h"
+
+# ID_DELETE -- Delete a feature.
+
+procedure id_delete (id, feature)
+
+pointer	id			# ID pointer
+int	feature			# Feature to be deleted
+
+int	i
+
+begin
+	call mfree (Memi[ID_LABEL(id)+feature-1], TY_CHAR)
+	do i = feature + 1, ID_NFEATURES(id) {
+	    PIX(id,i-1) = PIX(id,i)
+	    FIT(id,i-1) = FIT(id,i)
+	    USER(id,i-1) = USER(id,i)
+	    WTS(id,i-1) = WTS(id,i)
+	    FWIDTH(id,i-1) = FWIDTH(id,i)
+	    FTYPE(id,i-1) = FTYPE(id,i)
+	    Memi[ID_LABEL(id)+i-2] = Memi[ID_LABEL(id)+i-1]
+	}
+	Memi[ID_LABEL(id)+ID_NFEATURES(id)-1] = NULL
+	ID_NFEATURES(id) = ID_NFEATURES(id) - 1
+	ID_NEWFEATURES(id) = YES
+end
diff --git a/noao/onedspec/identify/iddofit.x b/noao/onedspec/identify/iddofit.x
new file mode 100644
index 00000000..8e6558e9
--- /dev/null
+++ b/noao/onedspec/identify/iddofit.x
@@ -0,0 +1,108 @@
+include	<units.h>
+include	"identify.h"
+
+# ID_DOFIT -- Fit a function to the features.  Eliminate INDEF points.
+
+procedure id_dofit (id, interactive)
+
+pointer	id			# ID pointer
+int	interactive		# Interactive fit?
+
+int	i, j, k, nfit, ic_geti()
+pointer	gt1, sp, x, y, wts, rejpts, str, gt_init()
+
+begin
+	if (ID_NFEATURES(id) == 0) {
+	    if (ID_CV(id) != NULL) {
+	        call dcvfree (ID_CV(id))
+		ID_SHIFT(id) = 0.
+	        ID_NEWGRAPH(id) = YES
+	        ID_NEWCV(id) = YES
+	    }
+	    return
+	}
+	    
+	call smark (sp)
+	call salloc (x, ID_NFEATURES(id), TY_DOUBLE)
+	call salloc (y, ID_NFEATURES(id), TY_DOUBLE)
+	call salloc (wts, ID_NFEATURES(id), TY_DOUBLE)
+
+	nfit = 0
+	do i = 1, ID_NFEATURES(id) {
+	    if (IS_INDEFD (PIX(id,i)) || IS_INDEFD (USER(id,i)))
+		next
+	    Memd[x+nfit] = PIX(id,i)
+	    Memd[y+nfit] = USER(id,i)
+	    Memd[wts+nfit] = max (1D0, WTS(id,i))
+	    nfit = nfit + 1
+	}
+
+	if (nfit > 1) {
+	    if (ID_UN(id) != NULL) {
+		call ic_pstr (ID_IC(id), "ylabel", UN_LABEL(ID_UN(id)))
+		call ic_pstr (ID_IC(id), "yunits", UN_UNITS(ID_UN(id)))
+	    }
+	    if (interactive == YES) {
+		call salloc (str, SZ_LINE, TY_CHAR)
+		gt1 = gt_init()
+		call icg_fitd (ID_IC(id), ID_GP(id), "cursor", gt1, ID_CV(id),
+		    Memd[x], Memd[y], Memd[wts], nfit)
+		call gt_free (gt1)
+	    } else
+		call ic_fitd (ID_IC(id), ID_CV(id), Memd[x], Memd[y], Memd[wts],
+		    nfit, YES, YES, YES, YES)
+
+	    if (ic_geti (ID_IC(id), "nreject") > 0 &&
+		ic_geti (ID_IC(id), "nfit") == nfit)
+		rejpts = ic_geti (ID_IC(id), "rejpts")
+	    else
+		rejpts = NULL
+
+	    j = 0
+	    k = 0
+	    do i = 1, ID_NFEATURES(id) {
+	    	if (IS_INDEFD (PIX(id,i)) || IS_INDEFD (USER(id,i))) {
+		    j = j + 1
+	    	    PIX(id,j) = PIX(id,i)
+	    	    FIT(id,j) = FIT(id,i)
+	    	    USER(id,j) = USER(id,i)
+	    	    WTS(id,j) = WTS(id,i)
+	    	    FWIDTH(id,j) = FWIDTH(id,i)
+	    	    FTYPE(id,j) = FTYPE(id,i)
+		    call mfree (Memi[ID_LABEL(id)+j-1], TY_CHAR)
+		    Memi[ID_LABEL(id)+j-1] = Memi[ID_LABEL(id)+i-1]
+		} else {
+		    if (Memd[wts+k] != 0.) {
+		        j = j + 1
+	    	        PIX(id,j) = Memd[x+k]
+	    	        FIT(id,j) = FIT(id,i)
+	    	        USER(id,j) = Memd[y+k]
+	    	        WTS(id,j) = Memd[wts+k]
+		        if (rejpts != NULL)
+			    if (Memi[rejpts+k] == YES)
+			        WTS(id,j) = 0.
+	    	        FWIDTH(id,j) = FWIDTH(id,i)
+	    	        FTYPE(id,j) = FTYPE(id,i)
+			Memi[ID_LABEL(id)+j-1] = Memi[ID_LABEL(id)+i-1]
+		    }
+		    k = k + 1
+		}
+	    }
+	    do i = j+1, ID_NFEATURES(id)
+		Memi[ID_LABEL(id)+i-1] = NULL
+	    ID_NFEATURES(id) = j
+
+	    ID_SHIFT(id) = 0.
+	    ID_NEWCV(id) = YES
+	    ID_NEWGRAPH(id) = YES
+	} else {
+	    if (ID_CV(id) != NULL) {
+	        call dcvfree (ID_CV(id))
+		ID_SHIFT(id) = 0.
+	        ID_NEWCV(id) = YES
+	        ID_NEWGRAPH(id) = YES
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/identify/iddoshift.x b/noao/onedspec/identify/iddoshift.x
new file mode 100644
index 00000000..2dfdff74
--- /dev/null
+++ b/noao/onedspec/identify/iddoshift.x
@@ -0,0 +1,41 @@
+include	"identify.h"
+
+# ID_DOSHIFT -- Minimize residuals by constant shift.
+
+procedure id_doshift (id, interactive)
+
+pointer	id			# ID pointer
+int	interactive		# Called interactively?
+
+int	i, j
+double	shft, delta, rms, id_fitpt()
+
+begin
+	shft = 0.
+	rms = 0.
+	j = 0
+	for (i=1; i <= ID_NFEATURES(id); i = i + 1) {
+	    if (IS_INDEFD (USER(id,i)) || WTS(id,i) == 0.)
+		next
+	    delta = USER(id,i) - id_fitpt (id, PIX(id,i))
+	    shft = shft + delta
+	    rms = rms + delta * delta
+	    j = j + 1
+	}
+
+	if (j > 0) {
+	    shft = shft / j
+	    rms = rms / j
+	    if (interactive == YES) {
+	        call printf ("%s%s: Coordinate shift=%5f, rms=%5f, npts=%3d\n")
+		    call pargstr (ID_IMAGE(id))
+		    call pargstr (ID_SECTION(id))
+		    call pargd (shft)
+		    call pargd (sqrt (rms - shft ** 2))
+		    call pargi (j)
+	    }
+	    ID_SHIFT(id) = ID_SHIFT(id) + shft
+	    ID_NEWCV(id) = YES
+	    ID_NEWGRAPH(id) = YES
+	}
+end
diff --git a/noao/onedspec/identify/identify.h b/noao/onedspec/identify/identify.h
new file mode 100644
index 00000000..0af2d58b
--- /dev/null
+++ b/noao/onedspec/identify/identify.h
@@ -0,0 +1,90 @@
+# Task parameters
+
+define	ID_LENSTRING	99		# Length of strings in ID structure
+define	ID_LENSTRUCT	354		# Length ID structure
+
+define	ID_IMAGE	Memc[P2C($1)]	  # Image
+define	ID_SECTION	Memc[P2C($1+50)]  # Section for 2D and 3D images
+define	ID_DATABASE	Memc[P2C($1+100)] # Name of database
+define	ID_COORDLIST	Memc[P2C($1+150)] # Name of coordinate list
+define	ID_COORDSPEC	Memc[P2C($1+200)] # Name of coordinate spectrum
+define	ID_SAVEID	Memc[P2C($1+250)] # ID for save structure
+define	ID_LINE		Memi[$1+$2+299]	  # Image line or column [2]
+define	ID_MAXLINE	Memi[$1+$2+301]	  # Maximum line or column [2]
+define	ID_AP		Memi[$1+$2+303]	  # Aperture if appropriate [2]
+define	ID_APS		Memi[$1+306]	  # Array of apertures (pointer)
+define	ID_NSUM		Memi[$1+$2+306]	  # Number of lines to sum [2]
+define	ID_MAXFEATURES	Memi[$1+309]	  # Maximum number of features
+define	ID_FTYPE	Memi[$1+310]	  # Feature type
+define	ID_MINSEP	Memr[P2R($1+311)] # Minimum pixel separation
+define	ID_MATCH	Memr[P2R($1+312)] # Maximum matching separation
+define	ID_FWIDTH	Memr[P2R($1+313)] # Feature width in pixels
+define	ID_CRADIUS	Memr[P2R($1+314)] # Centering radius in pixels
+define	ID_THRESHOLD	Memr[P2R($1+315)] # Centering threshold
+define	ID_ZWIDTH	Memr[P2R($1+316)] # Zoom window width in fit units
+define	ID_LL		Memi[$1+317]	  # Pointer to coordinate list lines
+define	ID_LLL		Memi[$1+318]	  # Pointer to coordinate list labels
+define	ID_NLL		Memi[$1+319]	  # Number of coordinate list lines
+define	ID_LABELS	Memi[$1+320]	  # Type of feature labels
+define	ID_LOGFILES	Memi[$1+321]	  # List of logfiles
+
+# Common image data
+
+define	ID_SHIFT	Memd[P2D($1+322)]# Wavelength shift
+define	ID_IMDATA	Memi[$1+324]	# Image data (pointer)
+define	ID_PIXDATA	Memi[$1+325]	# Pixel coordinates (pointer)
+define	ID_FITDATA	Memi[$1+326]	# Fit coordinates (pointer)
+define	ID_NPTS		Memi[$1+327]	# Number of points
+
+# Features
+
+define	ID_NFEATURES	Memi[$1+328]	# Number of features
+define	ID_NALLOC	Memi[$1+329]	# Length of allocated feature arrays
+define	ID_PIX		Memi[$1+330]	# Feature pixel coordinates (pointer)
+define	ID_FIT		Memi[$1+331]	# Feature fit coordinates (pointer)
+define	ID_USER		Memi[$1+332]	# Feature user coordinates (pointer)
+define	ID_WTS		Memi[$1+333]	# Feature weights (pointer)
+define	ID_FWIDTHS	Memi[$1+334]	# Feature width (pointer)
+define	ID_FTYPES	Memi[$1+335]	# Feature type (pointer)
+define	ID_LABEL	Memi[$1+336]	# Feature label (pointer)
+define	ID_CURRENT	Memi[$1+337]	# Current feature
+
+# Pointers for other packages and to save data
+
+define	ID_SH		Memi[$1+338]	# SHDR pointer
+define	ID_LP		Memi[$1+339]	# Logical to physical transformation
+define	ID_PL		Memi[$1+340]	# Physical to logical transformation
+define	ID_IC		Memi[$1+341]	# ICFIT pointer
+define	ID_CV		Memi[$1+342]	# Curfit pointer
+define	ID_GP		Memi[$1+343]	# GIO pointer
+define	ID_GT		Memi[$1+344]	# Gtools pointer
+define	ID_STP		Memi[$1+345]	# Symbol table of saved data
+define	ID_DT		Memi[$1+346]	# Database pointer
+define	ID_UN		Memi[$1+347]	# Units pointer
+
+# Flags
+
+define	ID_NEWFEATURES	Memi[$1+348]	# Has feature list changed?
+define	ID_NEWCV	Memi[$1+349]	# Has fitting function changed?
+define	ID_NEWGRAPH	Memi[$1+350]	# Has graph changed?
+define	ID_NEWDBENTRY	Memi[$1+351]	# Has database entry changed?
+define	ID_REFIT	Memi[$1+352]	# Refit feature data?
+define	ID_GTYPE	Memi[$1+353]	# Graph type
+
+# End of structure ----------------------------------------------------------
+
+define	LABELS	"|none|index|pixel|coord|user|both|"
+define	FTYPES	"|emission|absorption|"
+define	EMISSION	1		# Emission feature
+define	ABSORPTION	2		# Absorption feature
+
+define	IMDATA		Memr[ID_IMDATA($1)+$2-1]
+define	PIXDATA		Memd[ID_PIXDATA($1)+$2-1]
+define	FITDATA		Memd[ID_FITDATA($1)+$2-1]
+
+define	PIX		Memd[ID_PIX($1)+$2-1]
+define	FIT		Memd[ID_FIT($1)+$2-1]
+define	USER		Memd[ID_USER($1)+$2-1]
+define	WTS		Memd[ID_WTS($1)+$2-1]
+define	FWIDTH		Memr[ID_FWIDTHS($1)+$2-1]
+define	FTYPE		Memi[ID_FTYPES($1)+$2-1]
diff --git a/noao/onedspec/identify/identify.key b/noao/onedspec/identify/identify.key
new file mode 100644
index 00000000..95b44c32
--- /dev/null
+++ b/noao/onedspec/identify/identify.key
@@ -0,0 +1,90 @@
+1. IDENTIFY CURSOR KEY SUMMARY
+
+?  Help                   k  Next line              u  Enter coordinate
+a  Affect all features    l  Match list (refit)     v  Weight
+b  Auto identification    m  Mark feature           w  Window graph
+c  Center feature(s)      n  Next feature           x  Find shift
+d  Delete feature(s)      o  Go to line             y  Find peaks
+e  Add lines (no refit)   p  Pan graph              z  Zoom graph
+f  Fit positions          q  Quit                   .  Nearest feature
+g  Fit zero point shift   r  Redraw graph           +  Next feature
+i  Initialize             s  Shift feature          -  Previous feature
+j  Preceding line         t  Reset position         I  Interrupt
+
+2. IDENTIFY COLON COMMAND SUMMARY
+
+:add [image [ap]]         :fwidth [value]           :read [image [ap]]
+:coordlist [file]         :image [image]            :show [file]
+:cradius [value]          :labels [type]            :threshold [value]
+:database [file]          :match [value]            :write [image [ap]]
+:features [file]          :maxfeatures [value]      :zwidth [value]
+:ftype [type]             :minsep [value]           
+
+3. IDENTIFY CURSOR KEYS
+
+?  Clear the screen and print menu of options
+a  Apply next (c)enter or (d)elete operation to (a)ll features
+b  Automatic line identifications: queries for approx. coordinate and dispersion
+c  (C)enter the feature nearest the cursor
+d  (D)elete the  feature nearest the cursor
+e  Add features from coordinate list with no automatic refit
+f  (F)it a function of pixel coordinate to the user coordinates
+g  Fit a zero point shift to the user coordinates
+i  (I)nitialize (delete features and coordinate fit)
+j  Go to the preceding image line or column in a 2D or multispec image
+k  Go to the next image line or column in a 2D or multispec image
+l  Add features from coordinate (l)ist with  automatic refit
+m  (M)ark a new feature near the cursor and enter coordinate and label
+n  Move the cursor or zoom to the (n)ext feature (same as +)
+o  Go to the specified image line or column in a 2D or multispec image
+p  (P)an to user defined window after (z)ooming on a feature
+q  (Q)uit and continue with next image (also carriage return)
+r  (R)edraw the graph
+s  (S)hift the current feature to the position of the cursor
+t  Reset the position of a feature without centering
+u  Enter a new (u)ser coordinate and label for the current feature
+v  Modify weight of line in fitting
+w  (W)indow the graph.  Use '?' to window prompt for more help.
+x  Find zero point shift by matching lines with peaks
+y  Automatically find "maxfeatures" strongest peaks and identify them
+z  (Z)oom on the feature nearest the cursor
+.  Move the cursor or zoom to the feature nearest the cursor
++  Move the cursor or zoom to the next feature
+-  Move the cursor or zoom to the previous feature
+I  Interrupt task and exit immediately.  Database information is not saved.
+
+
+4. IDENTIFY COLON COMMANDS
+
+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.
+
+:show file		Show the values of all the parameters
+:features file		Write feature list to file (default is STDOUT)
+
+:coordlist file		Coordinate list file
+:cradius value		Centering radius in pixels
+:threshold value	Detection threshold for feature centering
+:database name		Database for recording feature records
+:ftype value		Feature type (emission or absorption)
+:fwidth value		Feature width in pixels
+:image imagename 	Set a new image or show the current image
+:labels value		Feature label type (none|index|pixel|coord|user|both)
+:match value		Coordinate list matching distance
+:maxfeatures value	Maximum number of features automatically found
+:minsep value		Minimum separation allowed between features
+:read name ap		Read a record from the database
+			(name and ap default to the current spectrum)
+:write name ap		Write a record to the database
+			(name and ap default to the current spectrum)
+:add name ap		Add features from the database
+			(name and ap default to the current spectrum)
+:zwidth value		Zoom width in user units
+
+Labels:
+      none - No labels
+     index - Sequential numbers in order of increasing pixel position
+     pixel - Pixel coordinates
+     coord - User coordinates such as wavelength
+      user - User labels
+      both - Combination of coord and user
diff --git a/noao/onedspec/identify/idfitdata.x b/noao/onedspec/identify/idfitdata.x
new file mode 100644
index 00000000..2d86163c
--- /dev/null
+++ b/noao/onedspec/identify/idfitdata.x
@@ -0,0 +1,177 @@
+include <math/curfit.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	"identify.h"
+
+# ID_FITDATA -- Compute fit coordinates from pixel coordinates.
+
+procedure id_fitdata (id)
+
+pointer	id				# ID pointer
+int	i
+
+begin
+	if (ID_SH(id) == NULL || ID_PIXDATA(id) == NULL)
+	    return
+
+	call mfree (ID_FITDATA(id), TY_DOUBLE)
+	call malloc (ID_FITDATA(id), ID_NPTS(id), TY_DOUBLE)
+
+	if (ID_CV(id) == NULL) {
+	    if (DC(ID_SH(id)) != DCNO && ID_UN(id) != NULL)
+		iferr (call shdr_units (ID_SH(id), UN_UNITS(ID_UN(id))))
+		    ;
+	    call achtrd (Memr[SX(ID_SH(id))], FITDATA(id,1), ID_NPTS(id))
+	    call gt_sets (ID_GT(id), GTXLABEL, LABEL(ID_SH(id)))
+	    call gt_sets (ID_GT(id), GTXUNITS, UNITS(ID_SH(id)))
+	} else {
+	    call dcvvector (ID_CV(id), PIXDATA(id,1), FITDATA(id,1),
+		ID_NPTS(id))
+	    if (FITDATA(id,2) > FITDATA(id,1)) {
+	        do i = 3, ID_NPTS(id)
+		    if (FITDATA(id,i) < FITDATA(id,i-1))
+			call error (1, "Coordinate solution is not monotonic")
+	    } else {
+	        do i = 3, ID_NPTS(id)
+		    if (FITDATA(id,i) > FITDATA(id,i-1))
+			call error (1, "Coordinate solution is not monotonic")
+	    }
+	    if (ID_UN(id) == NULL) {
+		call gt_sets (ID_GT(id), GTXLABEL, LABEL(ID_SH(id)))
+		call gt_sets (ID_GT(id), GTXUNITS, UNITS(ID_SH(id)))
+	    } else {
+		call gt_sets (ID_GT(id), GTXLABEL, UN_LABEL(ID_UN(id)))
+		call gt_sets (ID_GT(id), GTXUNITS, UN_UNITS(ID_UN(id)))
+	    }
+	}
+	if (ID_SHIFT(id) != 0.)
+	    call aaddkd (FITDATA(id,1), ID_SHIFT(id), FITDATA(id,1),ID_NPTS(id))
+
+end
+
+
+# ID_FITFEATURES -- Compute fit coordinates for features.
+
+procedure id_fitfeatures (id)
+
+pointer	id				# ID pointer
+int	i
+
+double	id_fitpt()
+
+begin
+	if (ID_NFEATURES(id) < 1)
+	    return
+
+	if (ID_CV(id) == NULL)
+	    do i = 1, ID_NFEATURES(id)
+		FIT(id,i) = id_fitpt (id, PIX(id,i))
+	else {
+	    call dcvvector (ID_CV(id), PIX(id,1), FIT(id,1), ID_NFEATURES(id))
+	    if (ID_SHIFT(id) != 0.)
+	        call aaddkd (FIT(id,1), ID_SHIFT(id), FIT(id,1), ID_NFEATURES(id))
+	}
+end
+
+
+# ID_FITPT -- Compute fit coordinates from pixel coordinates.
+
+double procedure id_fitpt (id, pix)
+
+pointer	id			# ID pointer
+double	pix			# Pixel coordinate
+
+double	fit
+
+double	smw_c1trand(), shdr_lw(), dcveval()
+
+begin
+	if (ID_CV(id) == NULL) {
+	    fit = smw_c1trand (ID_PL(id), pix)
+	    fit = shdr_lw (ID_SH(id), fit)
+	} else
+	    fit = dcveval (ID_CV(id), pix)
+	fit = fit + ID_SHIFT(id)
+
+	return (fit)
+end
+
+
+# FIT_TO_PIX -- Transform fit coordinate to pixel coordinate.
+
+define	DXMIN	.01
+
+double procedure fit_to_pix (id, fitcoord)
+
+pointer	id				# ID pointer
+double	fitcoord		# Fit coordinate to be transformed
+double	pixcoord		# Pixel coordinate returned
+
+int	i, np1
+double	dx
+
+int	dcvstati()
+double	shdr_wl(), smw_c1trand(), id_fitpt()
+
+begin
+	if (ID_CV(id) == NULL) {
+	    pixcoord = fitcoord - ID_SHIFT(id)
+	    pixcoord = shdr_wl (ID_SH(id), pixcoord)
+	    pixcoord = smw_c1trand (ID_LP(id), pixcoord)
+	    return (pixcoord)
+	}
+
+	np1 = NP1(ID_SH(id)) - 1
+	if (dcvstati (ID_CV(id), CVORDER) == 2) {
+	    i = dcvstati (ID_CV(id), CVTYPE)
+	    if (i == LEGENDRE || i == CHEBYSHEV) {
+		dx = FITDATA(id,1)
+		pixcoord = (fitcoord - dx) / (FITDATA(id,2) - dx) + 1 + np1
+		pixcoord = smw_c1trand (ID_LP(id), pixcoord)
+		return (pixcoord)
+	    }
+	}
+
+	if (FITDATA(id,1) < FITDATA(id,ID_NPTS(id))) {
+	    if ((fitcoord<FITDATA(id,1)) || (fitcoord>FITDATA(id,ID_NPTS(id))))
+	        return (INDEFD)
+
+	    for (i = 1; fitcoord > FITDATA(id,i); i = i + 1)
+	        ;
+
+	    if (FITDATA(id,i) == fitcoord)
+	        return (PIXDATA(id,i))
+
+	    pixcoord = smw_c1trand (ID_LP(id), double(i+np1-.5))
+	    dx = smw_c1trand (ID_LP(id), double(i+np1+.5)) - pixcoord
+	    while (dx > DXMIN) {
+	        dx = dx / 2
+	        if (id_fitpt (id, pixcoord) < fitcoord)
+		    pixcoord = pixcoord + dx
+	        else
+		    pixcoord = pixcoord - dx
+	    }
+	} else {
+	    if ((fitcoord<FITDATA(id,ID_NPTS(id))) || (fitcoord>FITDATA(id,1)))
+	        return (INDEFD)
+
+	    for (i = 1; fitcoord < FITDATA(id,i); i = i + 1)
+	        ;
+
+	    if (FITDATA(id,i) == fitcoord)
+	        return (PIXDATA(id,i))
+
+	    pixcoord = smw_c1trand (ID_LP(id), double(i+np1-.5))
+	    dx = smw_c1trand (ID_LP(id), double(i+np1+.5)) - pixcoord
+	    while (dx > DXMIN) {
+	        dx = dx / 2
+	        if (id_fitpt (id, pixcoord) < fitcoord)
+		    pixcoord = pixcoord - dx
+	        else
+		    pixcoord = pixcoord + dx
+	    }
+	}
+
+	return (pixcoord)
+end
diff --git a/noao/onedspec/identify/idgdata.x b/noao/onedspec/identify/idgdata.x
new file mode 100644
index 00000000..92bd65eb
--- /dev/null
+++ b/noao/onedspec/identify/idgdata.x
@@ -0,0 +1,67 @@
+include	<imhdr.h>
+include	<imio.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	"identify.h"
+
+define	SZ_TITLE	320	# Size of long string for title.
+
+# ID_GDATA -- Get image data.
+
+procedure id_gdata (id)
+
+pointer	id				# ID pointer
+
+int	i, np1
+pointer	sp, str, im, mw, sh
+
+double	smw_c1trand() 
+errchk	shdr_open
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_TITLE, TY_CHAR)
+
+	sh = ID_SH(id)
+	im = IM(sh)
+	mw = MW(sh)
+
+	# If format is multispec then header info depends on line.
+	if (SMW_FORMAT(mw) == SMW_ES || SMW_FORMAT(mw) == SMW_MS)
+	    ID_LINE(id,2) = 1
+	call shdr_open (im, mw, ID_LINE(id,1), ID_LINE(id,2),
+	    INDEFI, SHDATA, sh)
+	if (ID_UN(id) != NULL) {
+	    iferr (call shdr_units (sh, UN_UNITS(ID_UN(id))))
+		;
+	}
+	ID_AP(id,1) = AP(sh)
+	ID_AP(id,2) = ID_LINE(id,2)
+	ID_NPTS(id) = SN(sh)
+	call id_dbsection (id, ID_IMAGE(id), ID_AP(id,1),
+	     ID_SECTION(id), ID_LENSTRING)
+	call sprintf (Memc[str], SZ_TITLE, "identify %s%s\n%s")
+	    call pargstr (ID_IMAGE(id))
+	    call pargstr (ID_SECTION(id))
+		call pargstr (TITLE(sh))
+	call gt_sets (ID_GT(id), GTTITLE, Memc[str])
+
+	# Free previous vectors and allocate new vectors.
+	call mfree (ID_PIXDATA(id), TY_DOUBLE)
+
+	call malloc (ID_PIXDATA(id), ID_NPTS(id), TY_DOUBLE)
+
+	# Set the physical coordinates.
+	np1 = NP1(sh) - 1
+	do i = 1, ID_NPTS(id)
+	    PIXDATA(id,i) = smw_c1trand (ID_LP(id), double(i+np1))
+
+	# Set the image data
+	ID_IMDATA(id) = SY(sh)
+
+	ID_NEWGRAPH(id) = YES
+	ID_NEWCV(id) = YES
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/identify/idgraph.x b/noao/onedspec/identify/idgraph.x
new file mode 100644
index 00000000..2c38efb4
--- /dev/null
+++ b/noao/onedspec/identify/idgraph.x
@@ -0,0 +1,111 @@
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	"identify.h"
+
+# ID_GRAPH -- Graph image vector in which features are to be identified.
+
+procedure id_graph (id, gtype)
+
+pointer	id		# ID pointer
+int	gtype		# Graph type
+
+begin
+	switch (gtype) {
+	case 1:
+	    call id_graph1 (id)
+	case 2:
+	    call id_graph2 (id)
+	default:
+	    call id_graph1 (id)
+	}
+end
+
+
+procedure id_graph1 (id)
+
+pointer	id				# ID pointer
+
+int	i, n
+real	xmin, xmax, ymin, ymax, dy, gt_getr()
+pointer	sh, x, y
+
+begin
+	sh = ID_SH(id)
+	call malloc (x, SN(sh), TY_REAL)
+	y = SY(sh)
+	n = SN(sh)
+
+	call achtdr (FITDATA(id,1), Memr[x], n)
+
+	call gclear (ID_GP(id))
+	xmin = min (Memr[x], Memr[x+n-1])
+	xmax = max (Memr[x], Memr[x+n-1])
+	ymin = gt_getr (ID_GT(id), GTXMIN)
+	ymax = gt_getr (ID_GT(id), GTXMAX)
+	if ((!IS_INDEF(ymin) && xmax<ymin) || (!IS_INDEF(ymax) && xmin>ymax)) {
+	    call gt_setr (ID_GT(id), GTXMIN, INDEF)
+	    call gt_setr (ID_GT(id), GTXMAX, INDEF)
+	}
+	call alimr (Memr[y], n, ymin, ymax)
+	dy = ymax - ymin
+	call gswind (ID_GP(id), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy)
+	call gt_swind (ID_GP(id), ID_GT(id))
+	call gt_labax (ID_GP(id), ID_GT(id))
+	call gt_plot (ID_GP(id), ID_GT(id), Memr[x], Memr[y], n)
+
+	do i = 1, ID_NFEATURES(id)
+	    call id_mark (id, i)
+
+	call mfree (x, TY_REAL)
+end
+
+
+# ID_GRAPH2 -- Make review graph for current feature.
+
+procedure id_graph2 (id)
+
+pointer	id				# ID pointer
+
+int	i, j, k, n
+real	xmin, xmax, ymin, ymax, dy
+pointer	sh, x, y
+
+begin
+	sh = ID_SH(id)
+	call malloc (x, SN(sh), TY_REAL)
+	y = SY(sh)
+	n = SN(sh)
+
+	call achtdr (FITDATA(id,1), Memr[x], n)
+
+	xmin = real (FIT(id,ID_CURRENT(id))) - ID_ZWIDTH(id) / 2.
+	xmax = real (FIT(id,ID_CURRENT(id))) + ID_ZWIDTH(id) / 2.
+
+	i = 0
+	do k = 1, n {
+	    if ((Memr[x+k-1] < xmin) || (Memr[x+k-1] > xmax))
+		next
+	    if (i == 0)
+		i = k
+	    j = k
+	}
+	k = j - i + 1
+
+	call alimr (Memr[y+i-1], k, ymin, ymax)
+	dy = ymax - ymin
+
+	call gclear (ID_GP(id))
+	call gswind (ID_GP(id), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy)
+#	if (ID_GT(id) != NULL) {
+#	    call gseti (ID_GP(id), G_XTRAN, GT_XTRAN(ID_GT(id)))
+#	    call gseti (ID_GP(id), G_YTRAN, GT_YTRAN(ID_GT(id)))
+#	}
+	call gt_labax (ID_GP(id), ID_GT(id))
+	call gt_plot (ID_GP(id), ID_GT(id), Memr[x], Memr[y], n)
+
+	do i = 1, ID_NFEATURES(id)
+	    call id_mark (id, i)
+
+	call mfree (x, TY_REAL)
+end
diff --git a/noao/onedspec/identify/ididentify.x b/noao/onedspec/identify/ididentify.x
new file mode 100644
index 00000000..1b13643c
--- /dev/null
+++ b/noao/onedspec/identify/ididentify.x
@@ -0,0 +1,631 @@
+include	<error.h>
+include	<imhdr.h>
+include	<gset.h>
+include	<smw.h>
+include	"identify.h"
+
+define	HELP		"noao$onedspec/identify/identify.key"
+define	ICFITHELP	"noao$lib/scr/idicgfit.key"
+define	PROMPT		"identify options"
+
+define	PAN		1	# Pan graph
+define	ZOOM		2	# Zoom graph
+
+# ID_IDENTIFY -- Identify features in an image.
+# This is the main interactive loop.
+
+procedure id_identify (id)
+
+pointer	id			# ID pointer
+
+real	wx, wy
+int	wcs, key
+char	cmd[SZ_LINE]
+
+char	newimage[SZ_FNAME]
+int	i, j, last, all, prfeature, nfeatures1, npeaks, newline[2]
+bool	answer
+double	pix, fit, user, shift, pix_shift, z_shift
+pointer	peaks, label, aid, stp, sid
+
+bool	clgetb(), aid_autoid()
+pointer	gopen(), id_getap(), sthead(), stnext()
+int	clgcur(), scan(), nscan(), id_peaks(), errcode(), strncmp
+double	id_center(), fit_to_pix(), id_fitpt(), id_shift(), id_rms()
+errchk	id_gdata(), id_graph(), id_dbread(), xt_mk1d()
+
+define	newim_		10
+define	newkey_		20
+define	beep_		99
+
+begin
+newim_
+	# Open the image and return if there is an error.
+	iferr (call id_map (id)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	# Get the image data and return if there is an error.
+	iferr (call id_gdata (id)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	# Get the database entry for the image if it exists.
+	iferr {
+	    call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), NO, YES)
+	    ID_NEWDBENTRY(id) = NO
+	} then
+	    if ((ID_NFEATURES(id) > 0) || (ID_CV(id) != NULL))
+	        ID_NEWDBENTRY(id) = YES
+
+	# Set the coordinate information.
+	iferr (call id_fitdata (id))
+	    ;
+
+	# Set fitting limits.
+	call ic_putr (ID_IC(id), "xmin", real (PIXDATA(id,1)))
+	call ic_putr (ID_IC(id), "xmax", real (PIXDATA(id,ID_NPTS(id))))
+	call ic_pstr (ID_IC(id), "help", ICFITHELP)
+
+	# Open graphics.
+	call clgstr ("graphics", newimage, SZ_FNAME)
+	ID_GP(id) = gopen (newimage, NEW_FILE, STDGRAPH)
+
+	# Initialize.
+	ID_GTYPE(id) = PAN
+	all = 0
+	last = ID_CURRENT(id)
+	newimage[1] = EOS
+	newline[1] = ID_LINE(id,1)
+	newline[2] = ID_LINE(id,2)
+	ID_REFIT(id) = NO
+	ID_NEWFEATURES(id) = NO
+	ID_NEWCV(id) = NO
+	wy = INDEF
+	key = 'r'
+
+	repeat {
+	    prfeature = YES
+	    if (all != 0)
+		all = mod (all + 1, 3)
+
+	    switch (key) {
+	    case '?':	# Print help
+		call gpagefile (ID_GP(id), HELP, PROMPT)
+	    case ':':	# Process colon commands
+		if (cmd[1] == '/')
+		    call gt_colon (cmd, ID_GP(id), ID_GT(id), ID_NEWGRAPH(id))
+		else
+		    call id_colon (id, cmd, newimage, prfeature)
+	    case ' ':	# Go to current feature
+	    case '.':	# Go to nearest feature
+		if (ID_NFEATURES(id) == 0)
+		    goto beep_
+		call id_nearest (id, double (wx))
+	    case '-':	# Go to previous feature
+		if (ID_CURRENT(id) == 1)
+		    goto beep_
+		ID_CURRENT(id) = ID_CURRENT(id) - 1
+	    case '+', 'n':	# Go to next feature
+		if (ID_CURRENT(id) == ID_NFEATURES(id))
+		    goto beep_
+		ID_CURRENT(id) = ID_CURRENT(id) + 1
+	    case 'a':	# Set all flag for next key
+		all = 1
+	    case 'b':	# Autoidentify
+		call aid_init (aid, "aidpars")
+		call aid_sets (aid, "crval", "CL crval")
+		call aid_sets (aid, "cdelt", "CL cdelt")
+		if (aid_autoid (id, aid)) {
+		    ID_NEWCV(id) = YES
+		    ID_NEWFEATURES(id) = YES
+		    ID_NEWGRAPH(id) = YES
+		} else {
+		    prfeature = 0
+		    call printf ("No solution found\n")
+		}
+		call aid_free (aid)
+	    case 'c':	# Recenter features
+		if (all != 0) {
+		    for (i = 1; i <= ID_NFEATURES(id); i = i + 1) {
+		        call gseti (ID_GP(id), G_PLTYPE, 0)
+		        call id_mark (id, i)
+		        call gseti (ID_GP(id), G_PLTYPE, 1)
+			FWIDTH(id,i) = ID_FWIDTH(id)
+		        PIX(id,i) = id_center (id, PIX(id,i), FWIDTH(id,i),
+			    FTYPE(id,i))
+		        if (!IS_INDEFD (PIX(id,i))) {
+			    FIT(id,i) = id_fitpt (id, PIX(id,i))
+		            call id_mark (id, i)
+			} else {
+			    call id_delete (id, i)
+			    i = i - 1
+		        }
+		    }
+		    ID_NEWFEATURES(id) = YES
+		} else {
+		    if (ID_NFEATURES(id) < 1)
+			goto beep_
+		    call id_nearest (id, double (wx))
+		    pix = PIX(id,ID_CURRENT(id))
+		    pix = id_center (id, pix, ID_FWIDTH(id),
+			FTYPE(id,ID_CURRENT(id)))
+		    if (!IS_INDEFD (pix)) {
+		        call gseti (ID_GP(id), G_PLTYPE, 0)
+		        call id_mark (id, ID_CURRENT(id))
+			PIX(id,ID_CURRENT(id)) = pix
+		        FWIDTH(id,ID_CURRENT(id)) = ID_FWIDTH(id)
+			FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix)
+		        call gseti (ID_GP(id), G_PLTYPE, 1)
+			call id_mark (id, ID_CURRENT(id))
+		        ID_NEWFEATURES(id) = YES
+		    } else {
+			call printf ("Centering failed\n")
+			prfeature = NO
+		    }
+		}
+	    case 'd':	# Delete features
+		if (all != 0) {
+		    ID_NFEATURES(id) = 0
+		    ID_CURRENT(id) = 0
+		    ID_NEWFEATURES(id) = YES
+		    ID_NEWGRAPH(id) = YES
+		} else {
+		    if (ID_NFEATURES(id) < 1)
+			goto beep_
+		    call id_nearest (id, double (wx))
+		    call gseti (ID_GP(id), G_PLTYPE, 0)
+		    call id_mark (id, ID_CURRENT(id))
+		    call gseti (ID_GP(id), G_PLTYPE, 1)
+		    call id_delete (id, ID_CURRENT(id))
+		    ID_CURRENT(id) = min (ID_NFEATURES(id), ID_CURRENT(id))
+		    last = 0
+		}
+	    case 'e':	# Find features from line list with no fitting
+		call id_linelist (id)
+		if (ID_NEWFEATURES(id) == YES)
+		    ID_NEWGRAPH(id) = YES
+	    case 'f':	# Fit dispersion function
+		call id_dofit (id, YES)
+	    case 'g':	# Fit shift
+		call id_doshift (id, YES)
+		prfeature = NO
+	    case 'i':	# Initialize
+	        call dcvfree (ID_CV(id))
+		ID_SHIFT(id) = 0.
+	        ID_NEWCV(id) = YES
+		ID_NFEATURES(id) = 0
+		ID_CURRENT(id) = 0
+		ID_NEWFEATURES(id) = YES
+		ID_NEWGRAPH(id) = YES
+	    case 'j':	# Go to previous line
+		newline[1] = ID_LINE(id,1) - ID_NSUM(id,1)
+		if (newline[1] < 1) {
+		    newline[1] = newline[1] + ID_MAXLINE(id,1)
+		    newline[2] = ID_LINE(id,2) - ID_NSUM(id,2)
+		    if (newline[2] < 1)
+			newline[2] = newline[2] + ID_MAXLINE(id,2)
+		}
+	    case 'k':	# Go to next line
+		newline[1] = ID_LINE(id,1) + ID_NSUM(id,1)
+		if (newline[1] > ID_MAXLINE(id,1)) {
+		    newline[1] = newline[1] - ID_MAXLINE(id,1)
+		    newline[2] = ID_LINE(id,2) + ID_NSUM(id,2)
+		    if (newline[2] > ID_MAXLINE(id,2))
+			newline[2] = newline[2] - ID_MAXLINE(id,2)
+		}
+	    case 'l':	# Find features from line list
+		if (ID_NFEATURES(id) >= 2)
+		    call id_dofit (id, NO)
+		if (ID_NEWCV(id) == YES) {
+		    iferr (call id_fitdata(id))
+			;
+		    call id_fitfeatures(id)
+		    ID_NEWCV(id) = NO
+		}
+		call id_linelist (id)
+		if (ID_NEWFEATURES(id) == YES)
+		    ID_REFIT(id) = YES
+	    case 'm':	# Mark new feature
+		fit = wx
+		pix = fit_to_pix (id, fit)
+		pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id))
+		if (IS_INDEFD (pix)) {
+		    prfeature = NO
+		    call printf ("Center not found: check cursor position")
+		    if (ID_THRESHOLD(id) > 0.)
+			call printf (" and threshold value")
+		    goto beep_
+		}
+		fit = id_fitpt (id, pix)
+		user = fit
+		call id_newfeature (id, pix, fit, user, 1.0D0, ID_FWIDTH(id),
+		    ID_FTYPE(id), NULL)
+		USER(id,ID_CURRENT(id)) = INDEFD
+		call id_match (id, FIT(id,ID_CURRENT(id)),
+		    USER(id,ID_CURRENT(id)),
+		    Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id))
+		call id_mark (id, ID_CURRENT(id))
+		call printf ("%10.2f %10.8g (%10.8g %s): ")
+		    call pargd (PIX(id,ID_CURRENT(id)))
+		    call pargd (FIT(id,ID_CURRENT(id)))
+		    call pargd (USER(id,ID_CURRENT(id)))
+		    label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1]
+		    if (label != NULL)
+			call pargstr (Memc[label])
+		    else
+			call pargstr ("")
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargd (user)
+		    call gargwrd (cmd, SZ_LINE)
+		    i = nscan()
+		    if (i > 0) {
+			USER(id,ID_CURRENT(id)) = user
+			call id_match (id, user, USER(id,ID_CURRENT(id)),
+			    Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id))
+		    }
+		    if (i > 1) {
+			call reset_scan ()
+			call gargd (user)
+			call gargstr (cmd, SZ_LINE)
+			call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1])
+		    }
+		}
+	    case 'o':	# Go to a specified line
+		call printf ("Line/Column/Band (%d %d): ")
+		    call pargi (ID_LINE(id,1))
+		    call pargi (ID_LINE(id,2))
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargi (j)
+		    if (nscan() == 1) {
+			if (j < 1 || j > ID_MAXLINE(id,1))
+			    goto beep_
+			newline[1] = j
+			call gargi (j)
+			if (nscan() == 2) {
+			    if (j < 1 || j > ID_MAXLINE(id,2))
+				goto beep_
+			    newline[2] = j
+			}
+		    }
+		}
+	    case 'p':	# Switch to pan mode
+		if (ID_GTYPE(id) != PAN) {
+		    ID_GTYPE(id) = PAN
+		    ID_NEWGRAPH(id) = YES
+		}
+	    case 'q':	# Exit loop
+		break
+	    case 'r':	# Redraw the graph
+		ID_NEWGRAPH(id) = YES
+	    case 's', 'x':	# Shift or correlate features
+		# Get coordinate shift.
+		switch (key) {
+		case 's':
+		    call printf ("User coordinate (%10.8g): ")
+		        call pargr (wx)
+		        call flush (STDOUT)
+		    if (scan() != EOF) {
+		        call gargd (user)
+		        if (nscan() == 1)
+			    shift = wx - user
+		    } else
+		        shift = 0.
+		case 'x':
+		    shift = id_shift (id, -1D0, -0.05D0)
+		    if (IS_INDEFD(shift)) {
+			call printf ("No solution found\n")
+			goto beep_
+		    }
+		}
+
+		ID_NEWFEATURES(id) = YES
+		ID_NEWCV(id) = YES
+		ID_NEWGRAPH(id) = YES
+		prfeature = NO
+
+		if (ID_NFEATURES(id) < 1) {
+		    call printf ("User coordinate shift=%5f\n")
+			call pargd (shift)
+		    ID_SHIFT(id) = ID_SHIFT(id) + shift
+		    goto newkey_
+		}
+
+		# Recenter features.
+		pix_shift = 0.
+		z_shift = 0.
+		nfeatures1 = ID_NFEATURES(id)
+
+		j = 0.
+		do i = 1, ID_NFEATURES(id) {
+		    pix = fit_to_pix (id, FIT(id,i) + shift)
+		    pix = id_center (id, pix, FWIDTH(id,i), FTYPE(id,i))
+		    if (IS_INDEFD (pix)) {
+			if (ID_CURRENT(id) == i)
+			    ID_CURRENT(id) = i + 1
+			next
+		    }
+		    fit = id_fitpt (id, pix)
+
+		    pix_shift = pix_shift + pix - PIX(id,i)
+		    if (FIT(id,i) != 0.)
+		        z_shift = z_shift + (fit - FIT(id,i)) / FIT(id,i)
+
+		    j = j + 1
+		    PIX(id,j) = pix
+		    FIT(id,j) = FIT(id,i)
+		    USER(id,j) = USER(id,i)
+		    WTS(id,j) = WTS(id,i)
+		    FWIDTH(id,j) = FWIDTH(id,i)
+		    FTYPE(id,j) = FTYPE(id,i)
+		    if (ID_CURRENT(id) == i)
+			ID_CURRENT(id) = j
+		}
+		if (j != ID_NFEATURES(id)) {
+		    ID_NFEATURES(id) = j
+		    ID_CURRENT(id) = min (ID_CURRENT(id), ID_NFEATURES(id))
+		}
+
+		if (ID_NFEATURES(id) < 1) {
+		    call printf ("User coordinate shift=%5f")
+			call pargd (shift)
+		    call printf (", No features found during recentering\n")
+		    ID_SHIFT(id) = ID_SHIFT(id) + shift
+		    goto newkey_
+		}
+
+		# Adjust shift.
+		pix = ID_SHIFT(id)
+		call id_doshift (id, NO)
+		call id_fitfeatures (id)
+
+		# Print results.
+		call printf ("Recentered=%d/%d")
+		    call pargi (ID_NFEATURES(id))
+		    call pargi (nfeatures1)
+		call printf (
+		    ", pixel shift=%.2f, user shift=%5f, z=%7.3g, rms=%5g\n")
+		    call pargd (pix_shift / ID_NFEATURES(id))
+		    call pargd (pix - ID_SHIFT(id))
+		    call pargd (z_shift / ID_NFEATURES(id))
+		    call pargd (id_rms(id))
+	    case 't':	# Move the current feature
+		if (ID_CURRENT(id) < 1)
+		    goto beep_
+		pix = fit_to_pix (id, double (wx))
+		call gseti (ID_GP(id), G_PLTYPE, 0)
+		call id_mark (id, ID_CURRENT(id))
+		PIX(id,ID_CURRENT(id)) = pix
+		FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix)
+		call gseti (ID_GP(id), G_PLTYPE, 1)
+		call id_mark (id, ID_CURRENT(id))
+		ID_NEWFEATURES(id) = YES
+	    case 'u':	# Set user coordinate
+		if (ID_NFEATURES(id) < 1)
+		    goto beep_
+		call printf ("%10.2f %10.8g (%10.8g %s): ")
+		    call pargd (PIX(id,ID_CURRENT(id)))
+		    call pargd (FIT(id,ID_CURRENT(id)))
+		    call pargd (USER(id,ID_CURRENT(id)))
+		    label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1]
+		    if (label != NULL)
+			call pargstr (Memc[label])
+		    else
+			call pargstr ("")
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargd (user)
+		    call gargwrd (cmd, SZ_LINE)
+		    i = nscan()
+		    if (i > 0) {
+			USER(id,ID_CURRENT(id)) = user
+			ID_NEWFEATURES(id) = YES
+		    }
+		    if (i > 1) {
+			call reset_scan ()
+			call gargd (user)
+			call gargstr (cmd, SZ_LINE)
+			call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1])
+		    }
+		}
+	    case 'v':	# Modify weight
+		if (ID_NFEATURES(id) < 1)
+		    goto beep_
+		call printf ("Weight (%d): ")
+		    call pargd (WTS(id,ID_CURRENT(id)))
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargi (i)
+		    if (nscan() > 0) {
+			WTS(id,ID_CURRENT(id)) = i
+			ID_NEWFEATURES(id) = YES
+		    }
+		}
+	    case 'w':	# Window graph
+		call gt_window (ID_GT(id), ID_GP(id), "cursor", ID_NEWGRAPH(id))
+	    case 'y':	# Find peaks
+		call malloc (peaks, ID_NPTS(id), TY_REAL)
+		npeaks = id_peaks (id, IMDATA(id,1), Memr[peaks], ID_NPTS(id),
+		    0., int (ID_MINSEP(id)), 0, ID_MAXFEATURES(id), 0., false)
+		for (j = 1; j <= ID_NFEATURES(id); j = j + 1) {
+		    for (i = 1; i <= npeaks; i = i + 1) {
+			if (!IS_INDEF (Memr[peaks+i-1])) {
+			    pix = Memr[peaks+i-1]
+			    if (abs (pix - PIX(id,j)) < ID_MINSEP(id))
+			        Memr[peaks+i-1] = INDEF
+			}
+		    }
+		}
+		for (i = 1; i <= npeaks; i = i + 1) {
+		    if (IS_INDEF(Memr[peaks+i-1]))
+			next
+		    pix = Memr[peaks+i-1]
+		    pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id))
+		    if (IS_INDEFD (pix))
+			next
+		    fit = id_fitpt (id, pix)
+		    user = INDEFD
+		    call id_match (id, fit, user, label, ID_MATCH(id))
+		    call id_newfeature (id, pix, fit, user, 1.0D0,
+			ID_FWIDTH(id), ID_FTYPE(id), label)
+		    call id_mark (id, ID_CURRENT(id))
+		}
+		call mfree (peaks, TY_REAL)
+	    case 'z':	# Go to zoom mode
+		if (ID_NFEATURES(id) < 1)
+		    goto beep_
+		if (ID_GTYPE(id) == PAN)
+		    ID_NEWGRAPH(id) = YES
+		ID_GTYPE(id) = ZOOM
+		call id_nearest (id, double (wx))
+	    case 'I':
+		call fatal (0, "Interrupt")
+	    default:
+beep_		call printf ("\007")
+	    }
+
+newkey_
+	    # Set update flag if anything has changed.
+	    if ((ID_NEWFEATURES(id) == YES) || (ID_NEWCV(id) == YES))
+		ID_NEWDBENTRY(id) = YES
+
+	    # If a new image exit loop, update database, and start over.
+	    if (newimage[1] != EOS)
+		break
+
+	    # If a new line, save features and set new line.
+	    if (newline[1] != ID_LINE(id,1) || newline[2] != ID_LINE(id,2)) {
+		call id_saveap (id)
+		ID_LINE(id,1) = newline[1]
+		ID_LINE(id,2) = newline[2]
+		call id_gdata (id)
+		if (id_getap (id) == NULL) {
+		    iferr {
+		        call id_dbread (id, ID_IMAGE(id), ID_AP(id,1),
+			    NO, NO)
+		        ID_NEWDBENTRY(id) = NO
+			ID_NEWFEATURES(id) = NO
+		    } then
+		        if ((ID_NFEATURES(id) > 0) || (ID_CV(id) != NULL))
+		            ID_NEWDBENTRY(id) = YES
+		}
+		ID_NEWCV(id) = YES
+		ID_NEWGRAPH(id) = YES
+		wy = INDEF
+	    }
+
+	    # Refit dispersion function
+	    if (ID_REFIT(id) == YES) {
+		call id_dofit (id, NO)
+		ID_REFIT(id) = NO
+	    }
+
+	    # If there is a new dispersion solution evaluate the coordinates
+	    if (ID_NEWCV(id) == YES) {
+		iferr (call id_fitdata (id))
+		    ;
+		call id_fitfeatures (id)
+		ID_NEWCV(id) = NO
+	    }
+
+	    # Draw new graph in zoom mode if current feature has changed.
+	    if ((ID_GTYPE(id) == ZOOM) && (last != ID_CURRENT(id)))
+		ID_NEWGRAPH(id) = YES
+
+	    # Draw new graph.
+	    if (ID_NEWGRAPH(id) == YES) {
+		call id_graph (id, ID_GTYPE(id))
+	        ID_NEWGRAPH(id) = NO
+	    }
+
+	    # Set cursor and print status of current feature (unless canceled).
+	    if (ID_CURRENT(id) > 0) {
+		if (IS_INDEF (wy)) {
+		    i = max (1, min (ID_NPTS(id), int (PIX(id,ID_CURRENT(id)))))
+		    wy = IMDATA(id,i)
+		}
+		    
+		call gscur (ID_GP(id), real (FIT(id,ID_CURRENT(id))), wy)
+		if (errcode() == OK && prfeature == YES) {
+	            call printf ("%10.2f %10.8g %10.8g %s\n")
+		        call pargd (PIX(id,ID_CURRENT(id)))
+		        call pargd (FIT(id,ID_CURRENT(id)))
+		        call pargd (USER(id,ID_CURRENT(id)))
+			if (Memi[ID_LABEL(id)+ID_CURRENT(id)-1] != NULL)
+			    call pargstr (
+				Memc[Memi[ID_LABEL(id)+ID_CURRENT(id)-1]])
+			else
+			    call pargstr ("")
+		}
+	    }
+
+	    # Print delayed error message
+	    if (errcode() != OK)
+		call erract (EA_WARN)
+
+	    last = ID_CURRENT(id)
+	} until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+	call gclose (ID_GP(id))
+
+	# Warn user that feature data is newer than database entry.
+	if (ID_NEWDBENTRY(id) == YES)
+	    answer = true
+	else {
+	    answer = false
+	    stp = ID_STP(id)
+	    for (sid=sthead(stp); sid!=NULL; sid=stnext(stp,sid)) {
+		if (strncmp (ID_SAVEID(sid), "aperture", 8) != 0)
+		    next
+		if (ID_NEWDBENTRY(sid) == YES) {
+		    answer = true
+		    break
+		}
+	    }
+	}
+	if (answer) {
+	    if (!clgetb ("autowrite")) {
+	        call printf ("Write feature data to the database (yes)? ")
+	        call flush (STDOUT)
+	        if (scan() != EOF)
+	            call gargb (answer)
+	    }
+	    if (answer) {
+		newline[1] = ID_LINE(id,1)
+		newline[2] = ID_LINE(id,2)
+		if (ID_NEWDBENTRY(id) == YES)
+	            call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		stp = ID_STP(id)
+		for (sid=sthead(stp); sid!=NULL; sid=stnext(stp, sid)) {
+		    if (strncmp (ID_SAVEID(sid), "aperture", 8) != 0)
+			next
+	    	    if (ID_NEWDBENTRY(sid) == YES &&
+			(ID_LINE(sid,1) != newline[1] ||
+			 ID_LINE(sid,2) != newline[2])) {
+			call id_gid (id, sid)
+	            	call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		    }
+		}
+	    }
+	}
+
+	call flush (STDOUT)
+
+	# Free image data.
+	call mfree (ID_PIXDATA(id), TY_DOUBLE)
+	call mfree (ID_FITDATA(id), TY_DOUBLE)
+	call id_free1 (id)
+
+	call smw_close (MW(ID_SH(id)))
+	call imunmap (IM(ID_SH(id)))
+	call shdr_close (ID_SH(id))
+
+	# If a new image was requested with colon command start over.
+	if (newimage[1] != EOS) {
+	    call strcpy (newimage, ID_IMAGE(id), ID_LENSTRING)
+	    goto newim_
+	}
+end
diff --git a/noao/onedspec/identify/idinit.x b/noao/onedspec/identify/idinit.x
new file mode 100644
index 00000000..128f0cc0
--- /dev/null
+++ b/noao/onedspec/identify/idinit.x
@@ -0,0 +1,368 @@
+include	<gset.h>
+include	<math/curfit.h>
+include	"identify.h"
+
+# ID_INIT -- Allocate identify structure
+
+procedure id_init (id)
+
+pointer	id			#O ID pointer
+
+pointer	stopen()
+errchk	stopen
+
+begin
+	call calloc (id, ID_LENSTRUCT, TY_STRUCT)
+
+	ID_NALLOC(id) = 20
+	ID_NFEATURES(id) = 0
+	ID_CURRENT(id) = 0
+	ID_DT(id) = NULL
+	ID_STP(id) = stopen ("identify", 100, 10*ID_LENSTRUCT, 10*SZ_LINE)
+
+	if (ID_NALLOC(id) > 0) {
+	    call malloc (ID_PIX(id), ID_NALLOC(id), TY_DOUBLE)
+	    call malloc (ID_FIT(id), ID_NALLOC(id), TY_DOUBLE)
+	    call malloc (ID_USER(id), ID_NALLOC(id), TY_DOUBLE)
+	    call malloc (ID_WTS(id), ID_NALLOC(id), TY_DOUBLE)
+	    call malloc (ID_FWIDTHS(id), ID_NALLOC(id), TY_REAL)
+	    call malloc (ID_FTYPES(id), ID_NALLOC(id), TY_INT)
+	    call calloc (ID_LABEL(id), ID_NALLOC(id), TY_POINTER)
+	}
+end
+
+
+# ID_FREE -- Free identify structure.
+
+procedure id_free (id)
+
+pointer	id			#I ID pointer
+
+int	i
+pointer	ptr
+
+begin
+	if (id == NULL)
+	    return
+
+	call id_free1 (id)
+
+	call mfree (ID_APS(id), TY_INT)
+
+	ptr = ID_LABEL(id)
+	do i = 1, ID_NFEATURES(id) {
+	    call mfree (Memi[ptr], TY_CHAR)
+	    ptr = ptr + 1
+	}
+
+	call mfree (ID_PIX(id), TY_DOUBLE)
+	call mfree (ID_FIT(id), TY_DOUBLE)
+	call mfree (ID_USER(id), TY_DOUBLE)
+	call mfree (ID_WTS(id), TY_DOUBLE)
+	call mfree (ID_FWIDTHS(id), TY_REAL)
+	call mfree (ID_FTYPES(id), TY_INT)
+	call mfree (ID_LABEL(id), TY_POINTER)
+
+	if (ID_DT(id) != NULL)
+	    call dtunmap (ID_DT(id))
+	call id_unmapll (id)
+	call stclose (ID_STP(id))
+	call gt_free (ID_GT(id))
+	call dcvfree (ID_CV(id))
+	call ic_closed (ID_IC(id))
+	if (ID_UN(id) != NULL)
+	    call un_close (ID_UN(id))
+
+	call mfree (id, TY_STRUCT)
+end
+
+
+# ID_FREE1 -- Free saved identify structures.
+
+procedure id_free1 (id)
+
+pointer	id				# ID pointer
+
+int	i
+pointer	stp, sid, ptr, sthead(), stnext(), stopen()
+
+begin
+	stp = ID_STP(id)
+	for (sid = sthead(stp); sid != NULL; sid = stnext (stp, sid)) {
+	    ptr = ID_LABEL(sid)
+	    do i = 1, ID_NFEATURES(sid) {
+		call mfree (Memi[ptr], TY_CHAR)
+		ptr = ptr + 1
+	    }
+
+	    call mfree (ID_PIX(sid), TY_DOUBLE)
+	    call mfree (ID_FIT(sid), TY_DOUBLE)
+	    call mfree (ID_USER(sid), TY_DOUBLE)
+	    call mfree (ID_WTS(sid), TY_DOUBLE)
+	    call mfree (ID_FWIDTHS(sid), TY_REAL)
+	    call mfree (ID_FTYPES(sid), TY_INT)
+	    call mfree (ID_LABEL(sid), TY_POINTER)
+	    if (ID_CV(sid) != NULL)
+	        call dcvfree (ID_CV(sid))
+	    if (ID_IC(sid) != NULL)
+	        call ic_closed (ID_IC(sid))
+	}
+	if (sthead(stp) != NULL) {
+	    call stclose (stp)
+	    ID_STP(id) = stopen ("identify", 100, 10*ID_LENSTRUCT, 10*SZ_LINE)
+	}
+end
+
+
+# ID_SAVEID -- Save identify information by key.
+
+procedure id_saveid (id, key)
+
+pointer	id		#I IDENTIFY structure
+char	key[ARB]	#I Key to use in saving information
+
+pointer	sid, stfind(), stenter()
+
+begin
+	sid = stfind (ID_STP(id), key)
+	if (sid == NULL) {
+	    sid = stenter (ID_STP(id), key, ID_LENSTRUCT)
+	    call aclri (Memi[sid], ID_LENSTRUCT)
+	}
+	call strcpy (key, ID_SAVEID(id), ID_LENSTRING)
+	call id_sid (id, sid)
+end
+
+
+# ID_GETID -- Get saved identify information by key.
+# Return NULL if not found.
+
+pointer procedure id_getid (id, key)
+
+pointer	id		#I IDENTIFY structure
+char	key[ARB]	#I Key to use in saving information
+
+int	sid, stfind()
+
+begin
+	sid = stfind (ID_STP(id), key)
+	if (sid != NULL)
+	    call id_gid (id, sid)
+
+	return (sid)
+end
+
+
+# ID_SAVEAP -- Save identify information by aperture.
+
+procedure id_saveap (id)
+
+pointer	id		# IDENTIFY structure
+
+begin
+	call sprintf (ID_SAVEID(id), ID_LENSTRING, "aperture %d %d")
+	    call pargi (ID_AP(id,1))
+	    call pargi (ID_AP(id,2))
+	call id_saveid (id, ID_SAVEID(id))
+end
+
+
+# ID_GETAP -- Get saved identify information by aperture.
+# Return NULL if not found.
+
+pointer procedure id_getap (id)
+
+pointer	id		# IDENTIFY structure
+
+int	sid, stfind()
+
+begin
+	call sprintf (ID_SAVEID(id), ID_LENSTRING, "aperture %d %d")
+	    call pargi (ID_AP(id,1))
+	    call pargi (ID_AP(id,2))
+
+	# Check if saved.
+	sid = stfind (ID_STP(id), ID_SAVEID(id))
+	if (sid != NULL)
+	    call id_gid (id, sid)
+
+	return (sid)
+end
+
+
+# ID_SID -- Save parts of IDENTIFY structure.
+
+procedure id_sid (id, sid)
+
+pointer	id		#I IDENTIFY structure
+pointer	sid		#I IDENTIFY save structure
+
+int	i, j, dcvstati(), strlen()
+pointer	sp, coeffs, ptr1, ptr2
+
+begin
+	if (sid == NULL)
+	    return
+
+	# Allocate or reallocate memory for features and copy them.
+	if (ID_NFEATURES(id) > 0) {
+	    if (ID_NALLOC(sid) == 0) {
+	        call malloc (ID_PIX(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call malloc (ID_FIT(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call malloc (ID_USER(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call malloc (ID_WTS(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call malloc (ID_FWIDTHS(sid), ID_NFEATURES(id), TY_REAL)
+	        call malloc (ID_FTYPES(sid), ID_NFEATURES(id), TY_INT)
+	        call calloc (ID_LABEL(sid), ID_NFEATURES(id), TY_POINTER)
+	    } else if (ID_NALLOC(sid) != ID_NFEATURES(id)) {
+	        call realloc (ID_PIX(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call realloc (ID_FIT(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call realloc (ID_USER(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call realloc (ID_WTS(sid), ID_NFEATURES(id), TY_DOUBLE)
+	        call realloc (ID_FWIDTHS(sid), ID_NFEATURES(id), TY_REAL)
+	        call realloc (ID_FTYPES(sid), ID_NFEATURES(id), TY_INT)
+	        call realloc (ID_LABEL(sid), ID_NFEATURES(id), TY_POINTER)
+
+		j = ID_NALLOC(sid)
+		i = ID_NFEATURES(id) - j
+		if (i > 0)
+		    call aclri (Memi[ID_LABEL(sid)+j], i)
+	    }
+	    call amovd (PIX(id,1), PIX(sid,1), ID_NFEATURES(id))
+	    call amovd (FIT(id,1), FIT(sid,1), ID_NFEATURES(id))
+	    call amovd (USER(id,1), USER(sid,1), ID_NFEATURES(id))
+	    call amovd (WTS(id,1), WTS(sid,1), ID_NFEATURES(id))
+	    call amovr (FWIDTH(id,1), FWIDTH(sid,1), ID_NFEATURES(id))
+	    call amovi (FTYPE(id,1), FTYPE(sid,1), ID_NFEATURES(id))
+
+	    ptr1 = ID_LABEL(id) 
+	    ptr2 = ID_LABEL(sid) 
+	    do i = 1, ID_NFEATURES(id) {
+		call mfree (Memi[ptr2], TY_CHAR)
+		if (Memi[ptr1] != NULL) {
+		    j = strlen (Memc[Memi[ptr1]])
+		    call malloc (Memi[ptr2], j, TY_CHAR)
+		    call strcpy (Memc[Memi[ptr1]], Memc[Memi[ptr2]], j)
+		}
+		ptr1 = ptr1 + 1
+		ptr2 = ptr2 + 1
+	    }
+
+	    ID_NALLOC(sid) = ID_NFEATURES(id)
+	}
+
+	# Use a SAVE and RESTORE to copy the CURFIT data.
+	if (ID_CV(sid) != NULL)
+	    call dcvfree (ID_CV(sid))
+	if (ID_CV(id) != NULL) {
+	    call smark (sp)
+	    i = dcvstati (ID_CV(id), CVNSAVE)
+	    call salloc (coeffs, i, TY_DOUBLE)
+	    call dcvsave (ID_CV(id), Memd[coeffs])
+	    call dcvrestore (ID_CV(sid), Memd[coeffs])
+	    call sfree (sp)
+
+	    if (ID_IC(sid) == NULL)
+		call ic_open (ID_IC(sid))
+	    call ic_copy (ID_IC(id), ID_IC(sid))
+	}
+
+	call strcpy (ID_SAVEID(id), ID_SAVEID(sid), ID_LENSTRING)
+        ID_LINE(sid,1) = ID_LINE(id,1)
+        ID_LINE(sid,2) = ID_LINE(id,2)
+        ID_AP(sid,1) = ID_AP(id,1)
+        ID_AP(sid,2) = ID_AP(id,2)
+        ID_NFEATURES(sid) = ID_NFEATURES(id)
+        ID_SHIFT(sid) = ID_SHIFT(id)
+        ID_CURRENT(sid) = ID_CURRENT(id)
+
+        ID_NEWFEATURES(sid) = ID_NEWFEATURES(id)
+        ID_NEWCV(sid) = ID_NEWCV(id)
+        ID_NEWDBENTRY(sid) = ID_NEWDBENTRY(id)
+end
+
+
+# ID_GID -- Restore saved identify information.
+
+procedure id_gid (id, sid)
+
+pointer	id		#I IDENTIFY structure
+int	sid		#I IDENTIFY save structure
+
+int	i, j, dcvstati(), strlen()
+pointer	sp, coeffs, ptr1, ptr2
+
+begin
+	if (sid == NULL)
+	    return
+
+	# Reallocate memory for features and copy them.
+	if (ID_NFEATURES(sid) > 0) {
+	    if (ID_NALLOC(sid) != ID_NALLOC(id)) {
+	        call realloc (ID_PIX(id), ID_NALLOC(sid), TY_DOUBLE)
+	        call realloc (ID_FIT(id), ID_NALLOC(sid), TY_DOUBLE)
+	        call realloc (ID_USER(id), ID_NALLOC(sid), TY_DOUBLE)
+	        call realloc (ID_WTS(id), ID_NALLOC(sid), TY_DOUBLE)
+	        call realloc (ID_FWIDTHS(id), ID_NALLOC(sid), TY_REAL)
+	        call realloc (ID_FTYPES(id), ID_NALLOC(sid), TY_INT)
+	        call realloc (ID_LABEL(id), ID_NALLOC(sid), TY_POINTER)
+
+		j = ID_NALLOC(id)
+		i = ID_NALLOC(sid) - j
+		if (i > 0)
+		    call aclri (Memi[ID_LABEL(id)+j], i)
+	    }
+	    call amovd (PIX(sid,1), PIX(id,1), ID_NFEATURES(sid))
+	    call amovd (FIT(sid,1), FIT(id,1), ID_NFEATURES(sid))
+	    call amovd (USER(sid,1), USER(id,1), ID_NFEATURES(sid))
+	    call amovd (WTS(sid,1), WTS(id,1), ID_NFEATURES(sid))
+	    call amovr (FWIDTH(sid,1), FWIDTH(id,1), ID_NFEATURES(sid))
+	    call amovi (FTYPE(sid,1), FTYPE(id,1), ID_NFEATURES(sid))
+
+	    ptr1 = ID_LABEL(sid) 
+	    ptr2 = ID_LABEL(id) 
+	    do i = 1, ID_NFEATURES(sid) {
+		call mfree (Memi[ptr2], TY_CHAR)
+		if (Memi[ptr1] != NULL) {
+		    j = strlen (Memc[Memi[ptr1]])
+		    call malloc (Memi[ptr2], j, TY_CHAR)
+		    call strcpy (Memc[Memi[ptr1]], Memc[Memi[ptr2]], j)
+		}
+		ptr1 = ptr1 + 1
+		ptr2 = ptr2 + 1
+	    }
+
+	    ID_NALLOC(id) = ID_NALLOC(sid)
+	    ID_NFEATURES(id) = ID_NFEATURES(sid)
+	    ID_NEWFEATURES(id) = ID_NEWFEATURES(sid)
+	    ID_CURRENT(id) = ID_CURRENT(sid)
+	    ID_NEWDBENTRY(id) = ID_NEWDBENTRY(sid)
+	}
+
+	# Use a SAVE and RESTORE to copy the CURFIT data.
+	ID_SHIFT(id) = ID_SHIFT(sid)
+	if (ID_CV(sid) != NULL) {
+	    if (ID_CV(id) != NULL)
+	        call dcvfree (ID_CV(id))
+	    call smark (sp)
+	    i = dcvstati (ID_CV(sid), CVNSAVE)
+	    call salloc (coeffs, i, TY_DOUBLE)
+	    call dcvsave (ID_CV(sid), Memd[coeffs])
+	    call dcvrestore (ID_CV(id), Memd[coeffs])
+	    call sfree (sp)
+
+	    call ic_copy (ID_IC(sid), ID_IC(id))
+
+	    ID_NEWCV(id) = ID_NEWCV(sid)
+	    ID_NEWDBENTRY(id) = ID_NEWDBENTRY(sid)
+
+	    call id_fitdata (id)
+	    call id_fitfeatures (id)
+	}
+
+	call strcpy (ID_SAVEID(sid), ID_SAVEID(id), ID_LENSTRING)
+	ID_LINE(id,1) = ID_LINE(sid,1)
+	ID_LINE(id,2) = ID_LINE(sid,2)
+	ID_AP(id,1) = ID_AP(sid,1)
+	ID_AP(id,2) = ID_AP(sid,2)
+end
diff --git a/noao/onedspec/identify/idlabel.x b/noao/onedspec/identify/idlabel.x
new file mode 100644
index 00000000..cb5fa439
--- /dev/null
+++ b/noao/onedspec/identify/idlabel.x
@@ -0,0 +1,30 @@
+define	SKIP	($1==' '||$1=='\t'||$1=='"'||$1=='\'')
+
+# ID_LABEL -- Set label
+
+procedure id_label (str, label)
+
+char	str[ARB]		# String to be set
+pointer	label			# Label pointer to be set
+
+int	i, j, strlen()
+pointer	cp
+
+begin
+	call mfree (label, TY_CHAR)
+
+	for (i=1; str[i]!=EOS && SKIP(str[i]); i=i+1)
+	    ;
+	for (j=strlen(str); j>=i && SKIP(str[j]); j=j-1) 
+	    ;
+
+	if (i <= j) {
+	    call malloc (label, j-i+1, TY_CHAR)
+	    cp = label
+	    for (; i<=j; i=i+1) {
+		Memc[cp] = str[i]
+		cp = cp + 1
+	    }
+	    Memc[cp] = EOS
+	}
+end
diff --git a/noao/onedspec/identify/idlinelist.x b/noao/onedspec/identify/idlinelist.x
new file mode 100644
index 00000000..d7772a40
--- /dev/null
+++ b/noao/onedspec/identify/idlinelist.x
@@ -0,0 +1,385 @@
+include	<error.h>
+include	<mach.h>
+include	<units.h>
+include	"identify.h"
+
+# ID_MAPLL -- Read the line list into memory.
+# Convert to desired units.
+
+procedure id_mapll (id)
+
+pointer	id		# Identify structure
+
+int	i, j, fd, nalloc, nlines
+pointer	ll, lll, ill
+pointer	sp, str, units
+double	value
+
+bool	streq(), fp_equald()
+int	open(), fscan(), nscan(), nowhite(), id_compare()
+pointer	un_open()
+errchk	open, fscan, malloc, realloc, un_open
+extern	id_compare()
+
+begin
+	call id_unmapll (id)
+
+	if (nowhite (ID_COORDLIST(id), ID_COORDLIST(id), ID_LENSTRING) == 0)
+	    return
+	iferr (fd = open (ID_COORDLIST(id), READ_ONLY, TEXT_FILE)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	ID_COORDSPEC(id) = EOS
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call strcpy ("Angstroms", Memc[units], SZ_LINE)
+	nalloc = 0
+	nlines = 0
+	while (fscan (fd) != EOF) {
+	    call gargwrd (Memc[str], SZ_LINE)
+	    if (nscan() != 1)
+		next
+	    if (Memc[str] == '#') {
+		call gargwrd (Memc[str], SZ_LINE)
+		call strlwr (Memc[str])
+		if (streq (Memc[str], "spectrum"))
+		    call gargwrd (ID_COORDSPEC(id), ID_LENSTRING)
+		if (streq (Memc[str], "units")) {
+		    call gargstr (Memc[units], SZ_LINE)
+		    call xt_stripwhite (Memc[units])
+		}
+		next
+	    }
+	    call reset_scan ()
+
+	    call gargd (value)
+	    if (nscan() != 1)
+		next
+
+	    if (nalloc == 0) {
+		nalloc = 100
+		call malloc (ll, nalloc, TY_DOUBLE)
+		call calloc (lll, nalloc, TY_POINTER)
+	    } else if (nlines == nalloc) {
+		nalloc = nalloc + 100
+		call realloc (ll, nalloc, TY_DOUBLE)
+		call realloc (lll, nalloc, TY_POINTER)
+		call aclri (Memi[lll+nalloc-100], 100)
+	    }
+
+	    Memd[ll+nlines] = value
+	    call gargstr (Memc[str], SZ_LINE)
+	    call id_label (Memc[str], Memi[lll+nlines])
+
+	    nlines = nlines + 1
+	}
+	call close (fd)
+
+	# Sort the lines, eliminate identical lines, and convert units.
+	if (nlines > 0) {
+	    call malloc (ID_LL(id), nlines + 1, TY_DOUBLE)
+	    call malloc (ID_LLL(id), nlines + 1, TY_POINTER)
+
+	    call malloc (ill, nlines, TY_INT)
+	    do i = 0, nlines-1
+		Memi[ill+i] = i
+	    call gqsort (Memi[ill], nlines, id_compare, ll)
+
+	    Memd[ID_LL(id)] = Memd[ll+Memi[ill]]
+	    Memi[ID_LLL(id)] = Memi[lll+Memi[ill]]
+	    j = 1
+	    do i = 1, nlines-1 {
+		if (fp_equald (Memd[ll+Memi[ill+i]], Memd[ID_LL(id)+j-1]))
+		    next
+		Memd[ID_LL(id)+j] = Memd[ll+Memi[ill+i]]
+		Memi[ID_LLL(id)+j] = Memi[lll+Memi[ill+i]]
+		j = j + 1
+	    }
+	    Memd[ID_LL(id)+j] = INDEFD
+	    ID_NLL(id) = j
+
+	    call mfree (ll, TY_DOUBLE)
+	    call mfree (lll, TY_POINTER)
+	    call mfree (ill, TY_INT)
+
+	    if (ID_UN(id) == NULL && Memc[units] != EOS)
+		ID_UN(id) = un_open (Memc[units])
+	    call id_unitsll (id, Memc[units])
+	}
+
+	call sfree (sp)
+end
+
+
+# ID_UNMAPLL -- Unmap the linelist.
+
+procedure id_unmapll (id)
+
+pointer	id		# Identify structure
+
+pointer	lll
+
+begin
+	if (ID_LL(id) == NULL)
+	    return
+
+	do lll = ID_LLL(id), ID_LLL(id)+ID_NLL(id)-1
+	    call mfree (Memi[lll], TY_CHAR)
+
+	call mfree (ID_LL(id), TY_DOUBLE)
+	call mfree (ID_LLL(id), TY_POINTER)
+end
+
+
+# ID_UNITSLL -- Change the line list units from the input units to the
+# units given by ID_UN.  This may involve reversing the order of the list.
+
+procedure id_unitsll (id, units)
+
+pointer	id			# Identify structure
+char	units[ARB]		# Input units
+
+int	i, nll
+double	value
+pointer	un, ll, lll, llend, lllend, un_open()
+bool	un_compare()
+errchk	un_open
+
+begin
+	if (ID_LL(id) == NULL)
+	    return
+	if (ID_NLL(id) < 1)
+	    return
+	if (units[1] == EOS || ID_UN(id) == NULL)
+	    return
+	if (UN_CLASS(ID_UN(id)) == UN_UNKNOWN)
+	    return
+
+	un = un_open (units)
+	if (un_compare (un, ID_UN(id))) {
+	    call un_close (un)
+	    return
+	}
+
+	ll = ID_LL(id)
+	lll = ID_LLL(id)
+	nll = ID_NLL(id)
+	call un_ctrand (un, ID_UN(id), Memd[ll], Memd[ll], nll)
+	call un_close (un)
+
+	if (Memd[ll] > Memd[ll+nll-1]) {
+	    llend = ll + nll - 1
+	    lllend = lll + nll - 1
+	    do i = 0, nll / 2 - 1 {
+		value = Memd[ll+i]
+		Memd[ll+i] = Memd[llend-i]
+		Memd[llend-i] = value
+		un = Memi[lll+i]
+		Memi[lll+i] = Memi[lllend-i]
+		Memi[lllend-i] = un
+	    }
+	}
+end
+
+
+
+# ID_MATCH -- Match current feature against a line list.
+#
+# This is extremely inefficient.  It can be greatly improved.
+
+procedure id_match (id, in, out, label, diff)
+
+pointer	id			# Identify structure
+double	in			# Coordinate to be matched
+double	out			# Matched coordinate
+pointer	label			# Pointer to label
+real	diff			# Maximum difference
+
+int	i, j, nll
+double	delta
+pointer	ll
+int	strlen()
+
+begin
+	call mfree (label, TY_CHAR)
+
+	if (ID_LL(id) == NULL) {
+	    out = in
+	    return
+	}
+
+	if (diff < 0.)
+	    delta = abs (diff * (FITDATA(id,1) - FITDATA(id,ID_NPTS(id))) /
+		(ID_NPTS(id) - 1))
+	else
+	    delta = diff
+
+	ll = ID_LL(id)
+	nll = ID_NLL(id)
+	j = max (1, nint (sqrt (real (nll))))
+	for (i = 0; i < nll && in > Memd[ll+i]; i = i + j)
+	    ;
+	for (i = max (0, min (i-1, nll-1)); i > 0 && in < Memd[ll+i]; i = i - 1)
+	    ;
+
+	ll = ll + i
+	if (i < nll-1) {
+	    if (abs (in - Memd[ll]) > abs (in - Memd[ll+1])) {
+		i = i + 1
+		ll = ll + 1
+	    }
+	}
+
+	if (abs (in - Memd[ll]) <= delta) {
+	    out = Memd[ll]
+	    ll = Memi[ID_LLL(id)+i]
+	    if (ll != NULL) {
+		call malloc (label, strlen (Memc[ll]), TY_CHAR)
+		call strcpy (Memc[ll], Memc[label], ARB)
+	    }
+	}
+end
+
+# ID_LINELIST -- Add features from a line list.
+
+procedure id_linelist (id)
+
+pointer	id			# Identify structure
+
+int	i, nfound, nextpix, lastpix, cursave
+double	cd, pix, fit, fit1, fit2, user, peak, minval, diff, diff1
+pointer	sp, pixes, fits, users, labels, ll, lll, label
+
+double	id_center(), fit_to_pix(), id_fitpt(), id_peak(), smw_c1trand()
+
+int	ncandidate, nmatch1, nmatch2
+common	/llstat/ ncandidate, nmatch1, nmatch2
+
+begin
+	if (ID_LL(id) == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (pixes, ID_MAXFEATURES(id), TY_DOUBLE)
+	call salloc (fits, ID_MAXFEATURES(id), TY_DOUBLE)
+	call salloc (users, ID_MAXFEATURES(id), TY_DOUBLE)
+	call salloc (labels, ID_MAXFEATURES(id), TY_POINTER)
+
+	ncandidate = 0
+	nmatch1 = 0
+	nmatch2 = 0
+	nfound = 0
+	lastpix = 0
+	minval = MAX_REAL
+
+	if (ID_MATCH(id) < 0.)
+	    cd = (FITDATA(id,1) - FITDATA(id,ID_NPTS(id))) / (ID_NPTS(id) - 1)
+	else
+	    cd = 1
+
+	fit1 = min (FITDATA(id,1), FITDATA(id,ID_NPTS(id)))
+	fit2 = max (FITDATA(id,1), FITDATA(id,ID_NPTS(id)))
+	ll = ID_LL(id)
+	lll = ID_LLL(id)
+	while (!IS_INDEFD(Memd[ll])) {
+	    user = Memd[ll]
+	    label = Memi[lll]
+	    ll = ll + 1
+	    lll = lll + 1
+	    if (user < fit1)
+		next
+	    if (user > fit2)
+		break
+	
+	    ncandidate = ncandidate + 1
+	    pix = id_center (id, fit_to_pix (id, user), ID_FWIDTH(id),
+		ID_FTYPE(id))
+	    if (!IS_INDEFD(pix)) {
+		fit = id_fitpt (id, pix)
+		diff = abs ((fit - user) / cd)
+		if (diff > abs (ID_MATCH(id)))
+		    next
+
+		nmatch1 = nmatch1 + 1
+		if (lastpix > 0) {
+		    if (abs (pix - Memd[pixes+lastpix-1]) < 0.01) {
+			diff1 = abs (Memd[fits+lastpix-1]-Memd[users+lastpix-1])
+			if (diff < diff1) {
+			    Memd[pixes+lastpix-1] = pix
+			    Memd[fits+lastpix-1] = fit
+			    Memd[users+lastpix-1] = user
+			    Memi[labels+lastpix-1] = label
+			}
+			next
+		    }
+		}
+
+		nmatch2 = nmatch2 + 1
+		peak = abs (id_peak (id, smw_c1trand (ID_PL(id), pix)))
+		if (nfound < ID_MAXFEATURES(id)) {
+		    nfound = nfound + 1
+		    if (peak < minval) {
+		    	nextpix = nfound
+			minval = peak
+		    }
+		    Memd[pixes+nfound-1] = pix
+		    Memd[fits+nfound-1] = fit
+		    Memd[users+nfound-1] = user
+		    Memi[labels+nfound-1] = label
+		    lastpix = nfound
+		} else if (peak > minval) {
+		    Memd[pixes+nextpix-1] = pix
+		    Memd[fits+nextpix-1] = fit
+		    Memd[users+nextpix-1] = user
+		    Memi[labels+nextpix-1] = label
+		    lastpix = nextpix
+
+		    minval = MAX_REAL
+		    do i = 1, nfound {
+			pix = Memd[pixes+i-1]
+			peak = abs (id_peak (id, smw_c1trand (ID_PL(id), pix)))
+			peak = abs (id_peak (id, pix))
+			if (peak < minval) {
+			    nextpix = i
+			    minval = peak
+			}
+		    }
+		}
+	    }
+	}
+
+	do i = 1, nfound {
+	    pix = Memd[pixes+i-1]
+	    fit = Memd[fits+i-1]
+	    user = Memd[users+i-1]
+	    label = Memi[labels+i-1]
+	    call id_newfeature (id, pix, fit, user, 1.0D0, ID_FWIDTH(id),
+		ID_FTYPE(id), label)
+	    if (i == 1)
+		cursave = ID_CURRENT(id)
+	}
+	ID_CURRENT(id) = cursave
+
+	call sfree (sp)
+end
+
+
+# ID_COMPARE - Routine to compare line list coordinates for sorting.
+# Zero indexing is used.
+
+int procedure id_compare (ll, x1, x2)
+
+pointer	ll		#I Pointer to array of line list coordinates
+int	x1, x2		#I Indices to array of line list coordinates
+
+begin
+	if (Memd[ll+x1] < Memd[ll+x2])
+	    return (-1)
+	else if (Memd[ll+x1] > Memd[ll+x2])
+	    return (1)
+	else
+	    return (0)
+end
diff --git a/noao/onedspec/identify/idlog.x b/noao/onedspec/identify/idlog.x
new file mode 100644
index 00000000..d893f671
--- /dev/null
+++ b/noao/onedspec/identify/idlog.x
@@ -0,0 +1,72 @@
+include	<time.h>
+include	"identify.h"
+
+# ID_LOG -- Write log
+
+procedure id_log (id, file)
+
+pointer	id			# ID pointer
+char	file[ARB]		# Log file
+
+char	str[SZ_TIME]
+int	i, fd, nrms
+double	resid, rms
+
+int	open()
+long	clktime()
+errchk	open()
+
+begin
+	if (ID_NFEATURES(id) == 0)
+	    return
+
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call cnvtime (clktime (0), str, SZ_TIME)
+	call fprintf (fd, "\n%s\n")
+	    call pargstr (str)
+	call fprintf (fd, "Features identified in image %s.\n")
+	    call pargstr (ID_IMAGE(id))
+
+	call fprintf (fd, "   %8s %10s %10s %10s %6s %2s %s\n")
+	    call pargstr ("Pixel")
+	    call pargstr ("Fit")
+	    call pargstr ("User")
+	    call pargstr ("Residual")
+	    call pargstr ("Fwidth")
+	    call pargstr ("Wt")
+	    call pargstr ("Label")
+
+	rms = 0.
+	nrms = 0
+	do i = 1, ID_NFEATURES(id) {
+	    call fprintf (fd, "%2d %8.2f %10.8g %10.8g %10.8g %6.2f %2d %s\n")
+		call pargi (i)
+		call pargd (PIX(id,i))
+		call pargd (FIT(id,i))
+		call pargd (USER(id,i))
+		if (IS_INDEFD (USER(id,i)))
+		    call pargd (USER(id,i))
+		else {
+		    resid = FIT(id,i) - USER(id,i)
+		    call pargd (resid)
+		    if (WTS(id,i) > 0.) {
+		        rms = rms + resid ** 2
+		        nrms = nrms + 1
+		    }
+		}
+		call pargr (FWIDTH(id,i))
+		call pargd (WTS(id,i))
+		if (Memi[ID_LABEL(id)+i-1] != NULL)
+		    call pargstr (Memc[Memi[ID_LABEL(id)+i-1]])
+		else
+		    call pargstr ("")
+	}
+
+	if (nrms > 1) {
+	    call fprintf (fd, "RMS = %0.8g\n")
+		call pargd (sqrt (rms / nrms))
+	}
+
+	call close (fd)
+end
diff --git a/noao/onedspec/identify/idmap.x b/noao/onedspec/identify/idmap.x
new file mode 100644
index 00000000..c5f113ff
--- /dev/null
+++ b/noao/onedspec/identify/idmap.x
@@ -0,0 +1,375 @@
+include	<ctype.h>
+include	<imhdr.h>
+include	<smw.h>
+include	<units.h>
+include	"identify.h"
+
+# Sepcial section words.
+define	SPECIAL "|first|middle|x|y|z|last|column|line|band|"
+define	FIRST	1
+define	MIDDLE	2
+define	X	3
+define	Y	4
+define	Z	5
+define	LAST	6
+define	COLUMN	7
+define	LINE	8
+define	BAND	9
+
+# ID_MAP -- Map an image for IDENTIFY/REIDENTIFY
+# The image must 1, 2, or 3 dimensional.  An image section may be given with
+# the image name or with the CL parameter "section".  The CL parameter can
+# have one of the following formats:
+#	1. An IMIO image section
+#	2. [line|column|x|y|z] [#|middle|last] [#|middle|last]
+#	3. [#|middle|last] [#|middle|last] [line|column|x|y|z]
+# where # is a line or column number.  The strings may be abbreviated.
+# The task returns and error if it cannot map the image or determine
+# the 1D line or column desired.
+
+procedure id_map (id)
+
+pointer	id			# IDENTIFY data structure pointer
+
+int	i, j, k, l, a, b, c, x1[3], x2[3], xs[3]
+pointer	sp, wrd1, wrd2, wrd3, im
+
+int	imaccess(), strdic(), ctoi(), nscan()
+pointer	immap()
+errchk	immap, id_maphdr
+
+begin
+	# Separate the image name and image section and map the full image.
+	call imgsection (ID_IMAGE(id), ID_SECTION(id), ID_LENSTRING)
+	call imgimage (ID_IMAGE(id), ID_IMAGE(id), ID_LENSTRING)
+	im = immap (ID_IMAGE(id), READ_ONLY, 0)
+
+	# If no image section is found use the "section" parameter.
+	if (ID_SECTION(id) == EOS && IM_NDIM(im) > 1) {
+	    call clgstr ("section", ID_SECTION(id), ID_LENSTRING)
+	    call xt_stripwhite (ID_SECTION(id))
+
+	    # If not an image section construct one.
+	    if (ID_SECTION(id) != '[') {
+	        call smark (sp)
+	        call salloc (wrd1, SZ_FNAME, TY_CHAR)
+	        call salloc (wrd2, SZ_FNAME, TY_CHAR)
+	        call salloc (wrd3, SZ_FNAME, TY_CHAR)
+
+		call sscan (ID_SECTION(id))
+
+		# Parse axis and elements.
+		call gargwrd (Memc[wrd1], SZ_FNAME)
+		call gargwrd (Memc[wrd2], SZ_FNAME)
+		call gargwrd (Memc[wrd3], SZ_FNAME)
+		switch (nscan()) {
+		case 0:
+		    a = X
+		    b = MIDDLE
+		    c = MIDDLE
+		case 1:
+		    a = strdic (Memc[wrd1], Memc[wrd1], SZ_FNAME, SPECIAL)
+		    b = MIDDLE
+		    c = MIDDLE
+		case 2:
+		    a = strdic (Memc[wrd1], Memc[wrd1], SZ_FNAME, SPECIAL)
+		    if (a >= X)
+			b = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL)
+		    else {
+			b = a
+			a = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL)
+			call strcpy (Memc[wrd1], Memc[wrd2], SZ_FNAME)
+		    }
+		    c = MIDDLE
+		    call strcpy (Memc[wrd2], Memc[wrd3], SZ_FNAME)
+		case 3:
+		    a = strdic (Memc[wrd1], Memc[wrd1], SZ_FNAME, SPECIAL)
+		    if (a >= X) {
+			b = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL)
+			c = strdic (Memc[wrd3], Memc[wrd3], SZ_FNAME, SPECIAL)
+		    } else {
+			b = a
+			a = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL)
+			if (a >= X) {
+			    c = strdic (Memc[wrd3], Memc[wrd3],SZ_FNAME,SPECIAL)
+			    call strcpy (Memc[wrd1], Memc[wrd2], SZ_FNAME)
+			} else {
+			    c = b
+			    b = a
+			    a = strdic (Memc[wrd3], Memc[wrd3],SZ_FNAME,SPECIAL)
+			    call strcpy (Memc[wrd2], Memc[wrd3], SZ_FNAME)
+			    call strcpy (Memc[wrd1], Memc[wrd2], SZ_FNAME)
+			}
+		    }
+		}
+
+		switch (a) {
+		case X, LINE:
+		    i = 1
+		    j = 2
+		    k = 3
+		case Y, COLUMN:
+		    i = 2
+		    j = 1
+		    k = 3
+		case Z, BAND:
+		    i = 3
+		    j = 1
+		    k = 2
+		default:
+		    call imunmap (im)
+		    call error (1,
+		    "Error in section specification or non-unique abbreviation")
+		}
+
+		switch (b) {
+		case FIRST:
+		    ID_LINE(id,1) = 1
+		case MIDDLE:
+		    ID_LINE(id,1) = (1 + IM_LEN(im,j)) / 2
+		case LAST:
+		    ID_LINE(id,1) = IM_LEN(im,j)
+		default:
+		    l = 1
+		    if (ctoi (Memc[wrd2], l, ID_LINE(id,1)) == 0)
+			call error (1, "Error in section specification")
+		}
+
+		switch (c) {
+		case FIRST:
+		    ID_LINE(id,2) = 1
+		case MIDDLE:
+		    ID_LINE(id,2) = (1 + IM_LEN(im,k)) / 2
+		case LAST:
+		    ID_LINE(id,2) = IM_LEN(im,k)
+		default:
+		    l = 1
+		    if (ctoi (Memc[wrd3], l, ID_LINE(id,2)) == 0)
+			call error (1, "Error in section specification")
+		}
+
+		# Format section.
+		switch (IM_NDIM(im)) {
+		case 2:
+		    switch (i) {
+		    case 1:
+		        call sprintf (ID_SECTION(id), ID_LENSTRING, "[*,%d]")
+		    case 2:
+		        call sprintf (ID_SECTION(id), ID_LENSTRING, "[%d,*]")
+		    default:
+			call error (1, "Error in section specification")
+		    }
+		    call pargi (ID_LINE(id,1))
+		case 3:
+		    switch (i) {
+		    case 1:
+		        call sprintf (ID_SECTION(id), ID_LENSTRING, "[*,%d,%d]")
+		    case 2:
+		        call sprintf (ID_SECTION(id), ID_LENSTRING, "[%d,*,%d]")
+		    case 3:
+		        call sprintf (ID_SECTION(id), ID_LENSTRING, "[%d,%d,*]")
+		    }
+		    call pargi (ID_LINE(id,1))
+		    call pargi (ID_LINE(id,2))
+		case 4:
+		    call error (1, "Image dimension greater than 3 not allowed")
+		}
+	    }
+	}
+
+	# Parse the image section.
+	x1[1] = 1; x2[1] = IM_LEN(im,1); xs[1] = 1
+	x1[2] = 1; x2[2] = IM_LEN(im,2); xs[2] = 1
+	x1[3] = 1; x2[3] = IM_LEN(im,3); xs[3] = 1
+	call id_section (ID_SECTION(id), x1, x2, xs, 3)
+
+	# Set the axes.  The axis to be identified is the longest one.
+	i = 1
+	if (IM_NDIM(im) > 1 && abs (x1[2]-x2[2]) >= abs (x1[i]-x2[i]))
+	    i = 2
+	if (IM_NDIM(im) > 2 && abs (x1[3]-x2[3]) >= abs (x1[i]-x2[i]))
+	    i = 3
+	if (IM_NDIM(im) > 3)
+	    call error (1, "Image dimension greater than 3 not allowed")
+
+	switch (i) {
+	case 1:
+	    j = 2
+	    k = 3
+	case 2:
+	    j = 1
+	    k = 3
+	case 3:
+	    j = 1
+	    k = 2
+	}
+
+	ID_LINE(id,1) = (x1[j] + x2[j]) / 2
+	ID_LINE(id,2) = (x1[k] + x2[k]) / 2
+	ID_MAXLINE(id,1) = IM_LEN(im, j)
+	ID_MAXLINE(id,2) = IM_LEN(im, k)
+	ID_NSUM(id,1) = min (ID_MAXLINE(id,1), ID_NSUM(id,1))
+	ID_NSUM(id,2) = min (ID_MAXLINE(id,2), ID_NSUM(id,2))
+	call smw_daxis (NULL, NULL, i, ID_NSUM(id,1), ID_NSUM(id,2))
+
+	call id_maphdr (id, im)
+
+	# Open the image READ_WRITE if possible in order to add REFSPEC.
+	# This is not done earlier to avoid updating of the WCS.
+
+	call imunmap (im)
+	if (imaccess (ID_IMAGE(id), READ_WRITE) == YES)
+	    im = immap (ID_IMAGE(id), READ_WRITE, 0)
+	else
+	    im = immap (ID_IMAGE(id), READ_ONLY, 0)
+	call id_noextn (ID_IMAGE(id))
+	IM(ID_SH(id)) = im
+end
+
+
+# ID_MAPHDR -- Map image header.
+
+procedure id_maphdr (id, im)
+
+pointer	id				# ID pointer
+pointer	im				# IMIO pointer
+
+int	i
+pointer	mw, sh, smw_openim(), smw_sctran()
+errchk	smw_openim(), shdr_open(), smw_sctran
+
+begin
+	mw = smw_openim (im)
+	if (SMW_TRANS(mw) == YES) {
+	    if (SMW_PAXIS(mw,1) == 1)
+		call smw_daxis (mw, im, 2, INDEFI, INDEFI)
+	    else
+		call smw_daxis (mw, im, 1, INDEFI, INDEFI)
+	    call smw_saxes (mw, NULL, im)
+	}
+	call shdr_open (im, mw, ID_LINE(id,1), ID_LINE(id,2),
+	    INDEFI, SHHDR, ID_SH(id))
+	if (ID_UN(id) != NULL)
+	    iferr (call shdr_units (ID_SH(id), UN_UNITS(ID_UN(id))))
+		;
+	sh = ID_SH(id)
+
+	if (SMW_FORMAT(mw) == SMW_MS || SMW_FORMAT(mw) == SMW_ES) {
+	    ID_MAXLINE(id,1) = IM_LEN(im,2)
+	    ID_MAXLINE(id,2) = IM_LEN(im,3)
+	    ID_NSUM(id,1) = 1
+	    ID_NSUM(id,2) = 1
+	    ID_LINE(id,1) = max (1, min (ID_MAXLINE(id,1), ID_LINE(id,1)))
+	    ID_LINE(id,2) = 1
+	    call mfree (ID_APS(id), TY_INT)
+	    call malloc (ID_APS(id), ID_MAXLINE(id,1), TY_INT)
+	    do i = 1, ID_MAXLINE(id,1) {
+		call shdr_open (im, mw, i, 1, INDEFI, SHHDR, sh)
+		Memi[ID_APS(id)+i-1] = AP(sh)
+	    }
+	    ID_AP(id,1) = Memi[ID_APS(id)+ID_LINE(id,1)-1]
+	    ID_AP(id,2) = 1
+	} else {
+	    call mfree (ID_APS(id), TY_INT)
+	    ID_AP(id,1) = ID_LINE(id,1)
+	    ID_AP(id,2) = ID_LINE(id,2)
+	}
+	ID_NPTS(id) = IM_LEN(im, SMW_LAXIS(mw,1))
+
+	# Set logical / physical transformations
+	i = 2 ** (SMW_PAXIS(mw,1) - 1)
+	ID_LP(id) = smw_sctran (mw, "logical", "physical", i)
+	ID_PL(id) = smw_sctran (mw, "physical", "logical", i)
+end
+
+
+# ID_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 id_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/onedspec/identify/idmark.x b/noao/onedspec/identify/idmark.x
new file mode 100644
index 00000000..ac888c91
--- /dev/null
+++ b/noao/onedspec/identify/idmark.x
@@ -0,0 +1,98 @@
+include	<gset.h>
+include <smw.h>
+include	"identify.h"
+
+procedure id_mark (id, feature)
+
+pointer	id				# ID pointer
+int	feature
+
+int	pix, color, markcolor, gstati()
+real	x, y
+real	mx, my, x1, x2, y1, y2, tick, gap
+pointer	sp, format, label, ptr
+double	smw_c1trand()
+
+define	TICK	.03	# Tick size in NDC
+define	GAP	.02	# Gap size in NDC
+
+begin
+	call ggwind (ID_GP(id), x1, x2, y1, y2)
+
+	x = FIT(id,feature)
+
+	if ((x < min (x1, x2)) || (x > max (x1, x2)))
+	    return
+
+	pix = smw_c1trand (ID_PL(id),  PIX(id,feature)) - NP1(ID_SH(id)) + 1
+	pix = max (1, min (pix, ID_NPTS(id)-1))
+
+	call smark (sp)
+	call salloc (format, SZ_LINE, TY_CHAR)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	switch (FTYPE(id,feature)) {
+	case EMISSION:
+	    y = max (IMDATA(id,pix), IMDATA(id,pix+1))
+	    tick = TICK
+	    gap = GAP
+	    call strcpy ("u=180;h=c;v=b;s=0.5", Memc[format], SZ_LINE)
+	case ABSORPTION:
+	    y = min (IMDATA(id,pix), IMDATA(id,pix+1))
+	    tick = -TICK
+	    gap = -GAP
+	    call strcpy ("u=0;h=c;v=t;s=0.5", Memc[format], SZ_LINE)
+	}
+
+	call gctran (ID_GP(id), x, y, mx, my, 1, 0)
+	call gctran (ID_GP(id), mx, my + gap, x1, y1, 0, 1)
+	call gctran (ID_GP(id), mx, my + gap + tick, x1, y2, 0, 1)
+	color = gstati (ID_GP(id), G_PLCOLOR)
+	markcolor = gstati (ID_GP(id), G_TICKLABELCOLOR)
+	call gseti (ID_GP(id), G_PLCOLOR, markcolor)
+	call gline (ID_GP(id), x1, y1, x1, y2)
+	call gseti (ID_GP(id), G_PLCOLOR, color)
+
+	call gctran (ID_GP(id), mx, my + tick + 2 * gap, x1, y2, 0, 1)
+	color = gstati (ID_GP(id), G_TXCOLOR)
+	call gseti (ID_GP(id), G_TXCOLOR, markcolor)
+	switch (ID_LABELS(id)) {
+	case 2:
+	    call sprintf (Memc[label], SZ_LINE, "%d")
+		call pargi (feature)
+	    call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format])
+	case 3:
+	    call sprintf (Memc[label], SZ_LINE, "%0.2f")
+		call pargd (PIX(id,feature))
+	    call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format])
+	case 4:
+	    if (!IS_INDEFD (USER(id,feature))) {
+	        call sprintf (Memc[label], SZ_LINE, "%0.4f")
+		    call pargd (USER(id,feature))
+		call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format])
+	    }
+	case 5:
+	    label = Memi[ID_LABEL(id)+feature-1]
+	    if (label != NULL)
+		call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format])
+	case 6:
+	    Memc[label] = EOS
+	    ptr = Memi[ID_LABEL(id)+feature-1]
+	    if (!IS_INDEFD (USER(id,feature))) {
+		if (ptr != NULL) {
+		    call sprintf (Memc[label], SZ_LINE, "%0.4f %s")
+			call pargd (USER(id,feature))
+			call pargstr (Memc[ptr])
+		} else {
+		    call sprintf (Memc[label], SZ_LINE, "%0.4f")
+			call pargd (USER(id,feature))
+		}
+	    } else if (ptr != NULL)
+		call strcpy (Memc[ptr], Memc[label], SZ_LINE)
+	    if (Memc[label] != EOS)
+		call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format])
+	}
+	call gseti (ID_GP(id), G_TXCOLOR, color)
+
+	call sfree (sp)
+	call gflush (ID_GP(id))
+end
diff --git a/noao/onedspec/identify/idnearest.x b/noao/onedspec/identify/idnearest.x
new file mode 100644
index 00000000..41aa4c61
--- /dev/null
+++ b/noao/onedspec/identify/idnearest.x
@@ -0,0 +1,29 @@
+include	"identify.h"
+
+# ID_NEAREST -- Find the nearest feature to a given coordinate.
+
+procedure id_nearest (id, fitnear)
+
+pointer	id			# ID pointer
+double	fitnear			# Coordinate to find nearest feature
+
+int	i
+double	delta, delta1
+
+begin
+	if (ID_NFEATURES(id) < 1) {
+	    ID_CURRENT(id) = 0
+	    return
+	}
+
+	ID_CURRENT(id) = 1
+	delta = abs (FIT(id,1) - fitnear)
+
+	do i = 2, ID_NFEATURES(id) {
+	    delta1 = abs (FIT(id,i) - fitnear)
+	    if (delta1 < delta) {
+		ID_CURRENT(id) = i
+		delta = delta1
+	    }
+	}
+end
diff --git a/noao/onedspec/identify/idnewfeature.x b/noao/onedspec/identify/idnewfeature.x
new file mode 100644
index 00000000..efa489b4
--- /dev/null
+++ b/noao/onedspec/identify/idnewfeature.x
@@ -0,0 +1,87 @@
+include	<mach.h>
+include	"identify.h"
+
+# ID_NEWFEATURE -- Allocate and initialize memory for a new feature.
+
+procedure id_newfeature (id, pix, fit, user, wt, width, type, label)
+
+pointer	id			# ID pointer
+double	pix			# Pixel coordinate
+double	fit			# Fit coordinate
+double	user			# User coordinate
+double	wt			# Feature weight
+real	width			# Feature width
+int	type			# Feature type
+pointer	label			# Pointer to feature label
+
+int	i, current, strlen()
+double	delta
+
+define	NALLOC	20		# Length of additional allocations
+
+begin
+	if (IS_INDEFD (pix))
+	    return
+
+	delta = MAX_REAL
+	do i = 1, ID_NFEATURES(id) {
+	    if (abs (pix - PIX(id,i)) < delta) {
+		delta = abs (pix - PIX(id,i))
+		current = i
+	    }
+	}
+
+	if (delta >= ID_MINSEP(id)) {
+	    ID_NFEATURES(id) = ID_NFEATURES(id) + 1
+	    if (ID_NALLOC(id) < ID_NFEATURES(id)) {
+	        ID_NALLOC(id) = ID_NALLOC(id) + NALLOC
+	        call realloc (ID_PIX(id), ID_NALLOC(id), TY_DOUBLE)
+	        call realloc (ID_FIT(id), ID_NALLOC(id), TY_DOUBLE)
+	        call realloc (ID_USER(id), ID_NALLOC(id), TY_DOUBLE)
+	        call realloc (ID_WTS(id), ID_NALLOC(id), TY_DOUBLE)
+	        call realloc (ID_FWIDTHS(id), ID_NALLOC(id), TY_REAL)
+	        call realloc (ID_FTYPES(id), ID_NALLOC(id), TY_INT)
+	        call realloc (ID_LABEL(id), ID_NALLOC(id), TY_POINTER)
+		call aclri (Memi[ID_LABEL(id)+ID_NALLOC(id)-NALLOC], NALLOC)
+	    }
+	    for (current=ID_NFEATURES(id); (current>1)&&(pix<PIX(id,current-1));
+		    current=current-1) {
+	        PIX(id,current) = PIX(id,current-1)
+	        FIT(id,current) = FIT(id,current-1)
+	        USER(id,current) = USER(id,current-1)
+	        WTS(id,current) = WTS(id,current-1)
+	        FWIDTH(id,current) = FWIDTH(id,current-1)
+	        FTYPE(id,current) = FTYPE(id,current-1)
+		Memi[ID_LABEL(id)+current-1] = Memi[ID_LABEL(id)+current-2]
+	    }
+	    PIX(id,current) = pix
+	    FIT(id,current) = fit
+	    USER(id,current) = user
+	    WTS(id,current) = wt
+	    FWIDTH(id,current) = width
+	    FTYPE(id,current) = type
+	    if (label != NULL) {
+		i = strlen (Memc[label])
+		call malloc (Memi[ID_LABEL(id)+current-1], i, TY_CHAR)
+		call strcpy (Memc[label], Memc[Memi[ID_LABEL(id)+current-1]], i)
+	    } else
+		Memi[ID_LABEL(id)+current-1] = NULL
+	    ID_NEWFEATURES(id) = YES
+	} else if (abs (fit-user) < abs (FIT(id,current)-USER(id,current))) {
+	    PIX(id,current) = pix
+	    FIT(id,current) = fit
+	    USER(id,current) = user
+	    WTS(id,current) = wt
+	    FWIDTH(id,current) = width
+	    FTYPE(id,current) = type
+	    if (label != NULL) {
+		i = strlen (Memc[label])
+		call malloc (Memi[ID_LABEL(id)+current-1], i, TY_CHAR)
+		call strcpy (Memc[label], Memc[Memi[ID_LABEL(id)+current-1]], i)
+	    } else
+		Memi[ID_LABEL(id)+current-1] = NULL
+	    ID_NEWFEATURES(id) = YES
+	}
+
+	ID_CURRENT(id) = current
+end
diff --git a/noao/onedspec/identify/idnoextn.x b/noao/onedspec/identify/idnoextn.x
new file mode 100644
index 00000000..6c82d778
--- /dev/null
+++ b/noao/onedspec/identify/idnoextn.x
@@ -0,0 +1,11 @@
+# ID_NOEXTN -- Remove standard image extensions.
+
+procedure id_noextn (image)
+
+char	image[ARB]	# Image name
+
+int	strlen()
+
+begin
+	call xt_imroot (image, image, strlen (image))
+end
diff --git a/noao/onedspec/identify/idpeak.x b/noao/onedspec/identify/idpeak.x
new file mode 100644
index 00000000..c3e7559d
--- /dev/null
+++ b/noao/onedspec/identify/idpeak.x
@@ -0,0 +1,95 @@
+include	<smw.h>
+include	"identify.h"
+
+# ID_PEAK -- Find the peak value above continuum.
+
+double procedure id_peak (id, pix)
+
+pointer	id			# ID pointer
+double	pix			# Pixel position
+double	peak			# Peak value
+
+int	c, l, u
+
+begin
+	if (IS_INDEFD(pix))
+	    return (INDEFD)
+
+	c = nint (pix)
+	l = max (1, nint (pix - ID_FWIDTH(id)))
+	u = min (ID_NPTS(id), nint (pix + ID_FWIDTH(id)))
+	peak = IMDATA(id,c) - (IMDATA(id,l) + IMDATA(id,u)) / 2.
+
+	return (peak)
+end
+
+
+# ID_PEAKS -- Find peaks in the data.  This just calls find_peaks but does
+# the logical to physical pixel conversion.
+
+int procedure id_peaks (id, data, x, npoints, contrast, separation, edge, nmax,
+    threshold, debug)
+
+pointer	id		#I Identify pointer
+real	data[npoints]	#I Input data array
+real	x[npoints]	#O Output peak position array
+int	npoints		#I Number of data points
+real	contrast	#I Maximum contrast between strongest and weakest
+int	separation	#I Minimum separation between peaks
+int	edge		#I Minimum distance from the edge
+int	nmax		#I Maximum number of peaks to be returned
+real	threshold	#I Minimum threshold level for peaks
+bool	debug		#I Print diagnostic information?
+
+int	i, n, np1, find_peaks()
+double	smw_c1trand()
+errchk	find_peaks
+
+begin
+	# Find the peaks in logical coordinates.
+	n = find_peaks (data, x, npoints, contrast, separation, edge,
+	    nmax, threshold, debug)
+
+	# Convert to physical coordinates.
+	np1 = NP1(ID_SH(id)) - 1
+	do i = 1, n
+	    x[i] = smw_c1trand (ID_LP(id), double (x[i]+np1))
+
+	return (n)
+end
+
+
+# ID_UPEAKS -- Find uniformly distributed peaks in the data.  This just calls
+# find_upeaks but does the logical to physical pixel conversion.
+
+int procedure id_upeaks (id, data, x, npoints, contrast, separation, edge,
+	nmax, nbins, threshold, debug)
+
+pointer	id		#I Identify pointer
+real	data[npoints]	#I Input data array
+real	x[npoints]	#O Output peak position array
+int	npoints		#I Number of data points
+real	contrast	#I Maximum contrast between strongest and weakest
+int	separation	#I Minimum separation between peaks
+int	edge		#I Minimum distance from the edge
+int	nmax		#I Maximum number of peaks to be returned
+int	nbins		#I Number of bins across the data array
+real	threshold	#I Minimum threshold level for peaks
+bool	debug		#I Print diagnostic information?
+
+int	i, n, np1, find_upeaks()
+double	smw_c1trand()
+errchk	find_upeaks
+
+begin
+	# Find the peaks in logical coordinates.
+	n = find_upeaks (data, x, npoints, contrast, separation, edge,
+	    nmax, nbins, threshold, debug)
+
+	# Convert to physical coordinates.
+	np1 = NP1(ID_SH(id)) - 1
+	do i = 1, n
+	    x[i] = smw_c1trand (ID_LP(id), double (x[i]+np1))
+
+	return (n)
+end
diff --git a/noao/onedspec/identify/idrms.x b/noao/onedspec/identify/idrms.x
new file mode 100644
index 00000000..82916f1a
--- /dev/null
+++ b/noao/onedspec/identify/idrms.x
@@ -0,0 +1,28 @@
+include	"identify.h"
+
+# ID_RMS -- Compute RMS of fit about the user coordinates
+
+double procedure id_rms (id)
+
+pointer	id			# ID pointer
+
+int	i, nrms
+double	rms
+
+begin
+	rms = 0.
+	nrms = 0
+	for (i=1; i<=ID_NFEATURES(id); i=i+1) {
+	    if (!IS_INDEFD (USER(id,i)) && WTS(id,i) != 0.) {
+		rms = rms + (FIT(id,i) - USER(id,i)) ** 2
+		nrms = nrms + 1
+	    }
+	}
+
+	if (nrms > 0)
+	    rms = sqrt (rms / nrms)
+	else
+	    rms = INDEFD
+
+	return (rms)
+end
diff --git a/noao/onedspec/identify/idshift.x b/noao/onedspec/identify/idshift.x
new file mode 100644
index 00000000..1aedad69
--- /dev/null
+++ b/noao/onedspec/identify/idshift.x
@@ -0,0 +1,106 @@
+include	"identify.h"
+
+define	NBIN	10	# Bin parameter for mode determination
+
+# ID_SHIFT1 -- Determine a shift by correlating feature user positions
+# with peaks in the image data.
+
+double procedure id_shift1 (id)
+
+pointer	id			# ID pointer
+
+int	i, j, npeaks, ndiff, id_peaks()
+real	d, dmin
+double	pix, id_center(), id_fitpt()
+pointer	x, y, diff
+errchk	malloc, id_peaks
+
+begin
+	# Find the peaks in the image data and center.
+	call malloc (x, ID_NPTS(id), TY_REAL)
+	npeaks = id_peaks (id, IMDATA(id,1), Memr[x], ID_NPTS(id), 0.,
+	    int (ID_MINSEP(id)), 0, ID_MAXFEATURES(id), 0., false)
+
+	# Center the peaks and convert to user coordinates.
+	call malloc (y, npeaks, TY_DOUBLE)
+	j = 0
+	do i = 1, npeaks {
+	    pix = id_center (id, double(Memr[x+i-1]), ID_FWIDTH(id),
+		ID_FTYPE(id))
+	    if (!IS_INDEFD (pix)) {
+	        Memd[y+j] = id_fitpt (id, pix)
+		j = j + 1
+	    }
+	}
+	npeaks = j
+
+	# Compute differences with feature list.
+	ndiff = npeaks * ID_NFEATURES(id)
+	call malloc (diff, ndiff, TY_REAL)
+	ndiff = 0
+	do i = 1, ID_NFEATURES(id) {
+	    do j = 1, npeaks {
+		Memr[diff+ndiff] = Memd[y+j-1] - FIT(id,i)
+		ndiff = ndiff + 1
+	    }
+	}
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_DOUBLE)
+
+	# Sort the differences and find the mode.
+	call asrtr (Memr[diff], Memr[diff], ndiff)
+
+	dmin = Memr[diff+ndiff-1] - Memr[diff]
+	do i = 0, ndiff-NBIN-1 {
+	    j = i + NBIN
+	    d = Memr[diff+j] - Memr[diff+i]
+	    if (d < dmin) {
+		dmin = d
+		pix = Memr[diff+i] + d / 2.
+	    }
+	}
+	call mfree (diff, TY_REAL)
+
+	return (pix)
+end
+
+
+# ID_SHIFT -- Determine a shift using the AID_SHIFT algorithm.  This
+# differs from AID_SHIFT in that the input ID pointer is unchanged
+# (same dispersion function and features) but a shift is computed and
+# returned.
+
+double procedure id_shift (id, crsearch cdsearch)
+
+pointer	id		#I ID pointer
+double	crsearch	#I Search range
+double	cdsearch	#I Search range
+
+int	marker
+double	shift, asumd()
+pointer	new, id_getid()
+errchk	aid_shift
+
+begin
+	call stmark (ID_STP(id), marker)
+	call id_saveid (id, "backup")
+
+	# Find the shift.
+	shift = INDEFD
+	iferr {
+	    call aid_shift (id, crsearch, cdsearch)
+	    call malloc (new, ID_NPTS(id), TY_DOUBLE)
+	    call amovd (FITDATA(id,1), Memd[new], ID_NPTS(id))
+	    if (id_getid (id, "backup") == NULL)
+		call error (1, "Error getting saved record")
+	    call asubd (FITDATA(id,1), Memd[new], Memd[new], ID_NPTS(id))
+	    shift = asumd (Memd[new], ID_NPTS(id)) / ID_NPTS(id)
+	    call mfree (new, TY_DOUBLE)
+	} then {
+	    if (id_getid (id, "backup") == NULL)
+		call error (1, "Error getting saved record")
+	}
+
+	call stfree (ID_STP(id), marker)
+	return (shift)
+end
diff --git a/noao/onedspec/identify/idshow.x b/noao/onedspec/identify/idshow.x
new file mode 100644
index 00000000..16f4d9df
--- /dev/null
+++ b/noao/onedspec/identify/idshow.x
@@ -0,0 +1,79 @@
+include	"identify.h"
+
+# ID_SHOW -- Show parameter information.
+
+procedure id_show (id, file)
+
+pointer	id			# ID pointer
+char	file[ARB]		# File
+
+char	line[SZ_LINE]
+int	fd
+
+int	open(), ic_geti()
+errchk	open()
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call sysid (line, SZ_LINE)
+	call fprintf (fd, "%s\n")
+	call pargstr (line)
+
+	call fprintf (fd, "image %s\n")
+	    call pargstr (ID_IMAGE(id))
+	call fprintf (fd, "nsum %d\n")
+	    call pargi (ID_NSUM(id,1))
+	switch (ID_FTYPE(id)) {
+	case EMISSION:
+	    call fprintf (fd, "ftype emission\n")
+	case ABSORPTION:
+	    call fprintf (fd, "ftype absorption\n")
+	}
+	switch (ID_LABELS(id)) {
+	case 2:
+	    call fprintf (fd, "labels index\n")
+	case 3:
+	    call fprintf (fd, "labels pixel\n")
+	case 4:
+	    call fprintf (fd, "labels coords\n")
+	case 5:
+	    call fprintf (fd, "labels user\n")
+	case 6:
+	    call fprintf (fd, "labels both\n")
+	default:
+	    call fprintf (fd, "labels none\n")
+	}
+	call fprintf (fd, "maxfeatures %d\n")
+	    call pargi (ID_MAXFEATURES(id))
+	call fprintf (fd, "match %g\n")
+	    call pargr (ID_MATCH(id))
+	call fprintf (fd, "zwidth %g\n")
+	    call pargr (ID_ZWIDTH(id))
+	call fprintf (fd, "fwidth %g\n")
+	    call pargr (ID_FWIDTH(id))
+	call fprintf (fd, "database %s\n")
+	    call pargstr (ID_DATABASE(id))
+	call fprintf (fd, "coordlist %s\n")
+	    call pargstr (ID_COORDLIST(id))
+	call fprintf (fd, "cradius %g\n")
+	    call pargr (ID_CRADIUS(id))
+	call fprintf (fd, "threshold %g\n")
+	    call pargr (ID_THRESHOLD(id))
+	call fprintf (fd, "minsep %g\n")
+	    call pargr (ID_MINSEP(id))
+	if (ID_CV(id) != NULL) {
+	    call fprintf (fd, "function = %s\n")
+	        call ic_gstr (ID_IC(id), "function", line, SZ_LINE)
+		call pargstr (line)
+	    call fprintf (fd, "order = %d\n")
+		call pargi (ic_geti (ID_IC(id), "order"))
+	    call fprintf (fd, "Fit at first pixel = %0.8g\n")
+		call pargd (FITDATA(id,1))
+	    call fprintf (fd, "Average fit interval = %0.8g\n")
+		call pargd ((FITDATA(id,ID_NPTS(id))-FITDATA(id,1))/
+		    (ID_NPTS(id)-1))
+	}
+
+	call close (fd)
+end
diff --git a/noao/onedspec/identify/mkpkg b/noao/onedspec/identify/mkpkg
new file mode 100644
index 00000000..7b568269
--- /dev/null
+++ b/noao/onedspec/identify/mkpkg
@@ -0,0 +1,48 @@
+# IDENTIFY Task
+
+$checkout libpkg.a ..
+$update   libpkg.a
+$checkin  libpkg.a ..
+$exit
+
+libpkg.a:
+	@autoid
+
+	$ifeq (USE_GENERIC, yes)
+	    $ifolder (peaks.x, peaks.gx)
+		$generic -k peaks.gx -o peaks.x $endif $endif
+
+	idcenter.x	identify.h <smw.h>
+	idcolon.x	identify.h <error.h> <gset.h> <smw.h>
+	iddb.x		identify.h <imset.h> <math/curfit.h> <pkg/dttext.h>\
+			<smw.h> <units.h>
+	iddelete.x	identify.h
+	iddofit.x	identify.h <units.h>
+	iddoshift.x	identify.h
+	idfitdata.x	identify.h <pkg/gtools.h> <smw.h> <units.h>\
+			<math/curfit.h>
+	idgdata.x	identify.h <imhdr.h> <imio.h> <pkg/gtools.h> <smw.h>\
+			<units.h>
+	idgraph.x	identify.h <gset.h> <pkg/gtools.h> <smw.h>
+	ididentify.x	identify.h <error.h> <gset.h> <imhdr.h> <smw.h>
+	idinit.x	identify.h <gset.h> <math/curfit.h>
+	idlabel.x	
+	idlinelist.x	identify.h <error.h> <mach.h> <units.h>
+	idlog.x		identify.h <time.h>
+	idmap.x		identify.h <ctype.h> <imhdr.h> <smw.h> <units.h>
+	idmark.x	identify.h <gset.h> <smw.h>
+	idnearest.x	identify.h
+	idnewfeature.x	identify.h <mach.h>
+	idnoextn.x	
+	idpeak.x	identify.h <smw.h>
+	idrms.x		identify.h
+	idshift.x	identify.h
+	idshow.x	identify.h
+	peaks.x	
+	reidentify.x	identify.h <error.h> <gset.h> <imhdr.h>
+	t_autoid.x	identify.h <error.h> <fset.h> <gset.h> <pkg/gtools.h>\
+			<smw.h>
+	t_identify.x	identify.h <mach.h> <pkg/gtools.h>
+	t_reidentify.x	identify.h <error.h> <fset.h> <gset.h> <pkg/gtools.h>\
+			 <smw.h>
+	;
diff --git a/noao/onedspec/identify/peaks.gx b/noao/onedspec/identify/peaks.gx
new file mode 100644
index 00000000..571948c6
--- /dev/null
+++ b/noao/onedspec/identify/peaks.gx
@@ -0,0 +1,578 @@
+# PEAKS -- The following procedures are general numerical functions
+# dealing with finding peaks in a data array.
+#
+# FIND_PEAKS		Find the NMAX peaks in the data array.
+# FIND_UPEAKS		Find the uniformly distrib. peaks in the data array.
+# FIND_IPEAKS		Find all the isolated 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.
+# FIND_UNMAX		Select up to the nmax ranked peaks in bins.
+# COMPARE		Compare procedure for sort used in FIND_PEAKS.
+
+
+# FIND_PEAKS -- Find the NMAX 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.
+
+$for (r)
+int procedure find_peaks (data, x, npoints, contrast, separation, edge, nmax,
+    threshold, debug)
+
+# Procedure parameters:
+PIXEL	data[npoints]		# Input data array
+PIXEL	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	nrank, npeaks, find_nmax()
+pointer	rank
+
+begin
+	# Find all isolated peaks and their rank.
+	call find_ipeaks (data, x, npoints, contrast, separation, edge,
+    	    threshold, rank, nrank, debug)
+
+	# Select the strongest nmax peaks.
+	npeaks = find_nmax (data, x, Memi[rank], nrank, nmax, debug)
+
+	call mfree (rank, TY_INT)
+	return (npeaks)
+end
+
+
+# FIND_UPEAKS -- Find the uniformly distrib. 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 uniformly distributed peaks.
+#
+# Indefinite points are ignored.  The peak positions are returned in the
+# array x.
+
+int procedure find_upeaks (data, x, npoints, contrast, separation, edge,
+	nmax, nbins, threshold, debug)
+
+# Procedure parameters:
+PIXEL	data[npoints]		# Input data array
+PIXEL	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
+int	nbins			# Number of bins across the data array
+real	threshold		# Minimum threshold level for peaks
+bool	debug			# Print diagnostic information?
+
+int	npts, nrank, npeaks, find_unmax()
+pointer	rank
+
+begin
+	npts = npoints
+
+	# Find all isolated peaks and their rank.
+	call find_ipeaks (data, x, npoints, contrast, separation, edge,
+    	    threshold, rank, nrank, debug)
+
+	# Select the peaks.
+	npeaks = find_unmax (data, npts, x, Memi[rank], nrank, nmax, nbins,
+	    debug)
+
+	call mfree (rank, TY_INT)
+	return (npeaks)
+end
+
+
+# FIND_IPEAKS -- Find the all the isolated 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.  Return a rank array
+#
+# Indefinite points are ignored.  The peak positions are returned in the
+# array x.
+
+procedure find_ipeaks (data, x, npoints, contrast, separation, edge, threshold,
+	rank, nrank, debug)
+
+# Procedure parameters:
+PIXEL	data[npoints]		# Input data array
+PIXEL	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
+real	threshold		# Minimum threshold level for peaks
+pointer	rank			# Rank array
+int	nrank			# Size of rank array
+bool	debug			# Print diagnostic information?
+
+int	i, j
+int	nlmax, nisolated
+pointer	sp, y
+
+int	find_local_maxima(), find_threshold(), find_isolated()
+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_PIXEL)
+
+	# Reject the local maxima which do not satisfy the thresholds.
+	# The array y is set to the peak values of the remaining peaks.
+	nrank = find_threshold (data, x, Mem$t[y], nlmax,
+	    contrast, threshold, debug)
+
+	# Rank the peaks by peak value.
+	call malloc (rank, nrank, TY_INT)
+	do i = 1, nrank
+	    Memi[rank + i - 1] = i
+	call qsort (Memi[rank], nrank, compare)
+
+	# Reject the weaker peaks within sep of a stronger peak.
+	nisolated = find_isolated (x, Memi[rank], nrank, separation, debug)
+
+	call sfree (sp)
+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)
+
+PIXEL	data[npoints]			# Input data array
+PIXEL	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
+PIXEL	data[npoints]		# Data values
+int	npoints			# Number of points in the data vector
+
+int	i, j, nright, nleft
+
+begin
+	# INDEF points cannot be local maxima.
+	if (IS_INDEF (data[index]))
+	    return (FALSE)
+
+	# Find the left and right indices where data values change and the
+	# number of points with the same value.  Ignore INDEF points.
+	nleft = 0
+	for (i = index - 1; i >= 1; i = i - 1) {
+	    if (!IS_INDEF (data[i])) {
+		if (data[i] != data[index])
+		    break
+		nleft = nleft + 1
+	    }
+	}
+	nright = 0
+	for (j = index + 1; j <= npoints; j = j + 1) {
+	    if (!IS_INDEF (data[j])) {
+		if (data[j] != data[index])
+		    break
+		nright = nright + 1
+	    }
+	}
+
+	# Test for failure to be a local maxima
+	if ((i == 0) && (j == npoints+1)) {
+	    return (FALSE)		# Data is constant
+	} else if (i == 0) {
+	    if (data[j] > data[index])
+	        return (FALSE)		# Data increases to right
+	} else if (j == npoints+1) {
+	    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)
+
+PIXEL	data[ARB]			# Input data values
+PIXEL	x[npoints]			# Input/Output peak positions
+PIXEL	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
+PIXEL	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 alim$t (y, npoints, minval, maxval)
+
+	# Set the threshold based on the max of the absolute threshold and the
+	# contrast.  Use arlt to set peaks below threshold to INDEF.
+	if (!IS_INDEFR(threshold) || !IS_INDEFR(contrast)) {
+	    if (IS_INDEFR(threshold))
+		lcut = PIXEL (contrast * maxval)
+	    else if (IS_INDEFR(contrast))
+		lcut = PIXEL (threshold)
+	    else
+		lcut = max (PIXEL (threshold), PIXEL (contrast * maxval))
+	    call arlt$t (y, npoints, lcut, INDEFR)
+	}
+
+	if (debug) {
+	    call printf ("  Highest peak value = %g.\n")
+		call parg$t (maxval)
+	    call printf ("  Peak cutoff threshold = %g.\n")
+		call parg$t (lcut)
+	    do i = 1, npoints {
+		if (IS_INDEF (y[i])) {
+		    j = x[i]
+		    call printf (
+			"  Peak at column %d with value %g below threshold.\n")
+			call pargi (j)
+			call parg$t (data[j])
+		}
+	    }
+	}
+
+	# Determine the number of acceptable peaks & resort the x and y arrays.
+	nthreshold = 0
+	do i = 1, npoints {
+	    if (IS_INDEF (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 INDEF.  The number of
+# unflaged peaks is returned.
+
+int procedure find_isolated (x, rank, npoints, separation, debug)
+
+# Procedure parameters:
+PIXEL	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 INDEF.
+	nisolated = 0
+	do i = 1, npoints {
+	    if (IS_INDEF (x[rank[i]]))
+		next
+	    nisolated = nisolated + 1
+	    do j = i + 1, npoints {
+		if (IS_INDEF (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]] = INDEF
+		}
+	    }
+	}
+
+	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 INDEF.
+# 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 INDEF.
+# 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)
+
+PIXEL	data[ARB]			# Input data values
+PIXEL	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_INDEF (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 parg$t (data[j])
+		    }
+	            x[rank[i]] = INDEF
+	        }
+	    }
+	}
+
+	# Eliminate INDEF points and determine the number of spectra found.
+	npeaks = 0
+	do i = 1, npoints {
+	    if (IS_INDEF (x[i]))
+		next
+	    npeaks = npeaks + 1
+	    x[npeaks] = x[i]
+	}
+
+	return (npeaks)
+end
+
+
+# FIND_UNMAX -- Select up to the nmax highest ranked peaks in bins.
+#
+# 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 INDEF.
+# 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 INDEF.
+# Then the remaining peaks are resorted to contain only the unflaged
+# peaks and the number of such peaks is returned.
+
+int procedure find_unmax (data, npts, x, rank, npoints, nmax, nbins, debug)
+
+PIXEL	data[npts]			# Input data values
+int	npts				# Number of input data points
+PIXEL	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
+int	nbins				# Number of sample bins
+bool	debug				# Print debugging information?
+
+int	i, j, npeaks, width, x1, x2
+PIXEL	a
+
+begin
+	# Only mark peaks to reject if the number peaks is greater than nmax.
+	if (nmax < npoints) {
+
+	    # Set up circular bins and select highest peak in each bin
+	    # until the desired number of peaks is selected.
+
+	    width = min (npts-1, nint ((npts-1) / (nbins-.5)))
+	    x2 = 1
+	    npeaks = 0
+	    repeat {
+		x1 = x2
+		x2 = mod (x1 + width, npts) + 1
+		j = 0
+		do i = 1, npoints {
+		    a = x[rank[i]]
+		    if (IS_INDEF (a) || a < 0) {
+			j = j + 1
+			next
+		    }
+		    if (x1 < x2) {
+			if (a >= x1 && a <= x2) {
+			    x[rank[i]] = -a
+			    npeaks = npeaks + 1
+			    break
+			}
+		    } else {
+			if (a <= x2 || a >= x1) {
+			    x[rank[i]] = -a
+			    npeaks = npeaks + 1
+			    break
+			}
+		    }
+		}
+	    } until (npeaks >= nmax || j == npoints)
+
+	    # Now eliminate all unused peaks and reset the selected peaks.
+	    do i = 1, npoints {
+		if (!IS_INDEF (x[i]) && x[i] < 1)
+		    x[i] = -x[i]
+		else
+		    x[i] = INDEF
+	    }
+	}
+
+	# Eliminate INDEF points and determine the number of peaks found.
+	npeaks = 0
+	do i = 1, npoints {
+	    if (IS_INDEF (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.  INDEF 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
+	# INDEF points are considered to be smallest possible values.
+	if (IS_INDEF (Mem$t[y - 1 + index1]))
+	    return (1)
+	else if (IS_INDEF (Mem$t[y - 1 + index2]))
+	    return (-1)
+	else if (Mem$t[y - 1 + index1] < Mem$t[y - 1 + index2])
+	    return (1)
+	else if (Mem$t[y - 1 + index1] > Mem$t[y - 1 + index2])
+	    return (-1)
+	else
+	    return (0)
+end
+$endfor
diff --git a/noao/onedspec/identify/peaks.x b/noao/onedspec/identify/peaks.x
new file mode 100644
index 00000000..0ebda9f7
--- /dev/null
+++ b/noao/onedspec/identify/peaks.x
@@ -0,0 +1,578 @@
+# PEAKS -- The following procedures are general numerical functions
+# dealing with finding peaks in a data array.
+#
+# FIND_PEAKS		Find the NMAX peaks in the data array.
+# FIND_UPEAKS		Find the uniformly distrib. peaks in the data array.
+# FIND_IPEAKS		Find all the isolated 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.
+# FIND_UNMAX		Select up to the nmax ranked peaks in bins.
+# COMPARE		Compare procedure for sort used in FIND_PEAKS.
+
+
+# FIND_PEAKS -- Find the NMAX 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	nrank, npeaks, find_nmax()
+pointer	rank
+
+begin
+	# Find all isolated peaks and their rank.
+	call find_ipeaks (data, x, npoints, contrast, separation, edge,
+    	    threshold, rank, nrank, debug)
+
+	# Select the strongest nmax peaks.
+	npeaks = find_nmax (data, x, Memi[rank], nrank, nmax, debug)
+
+	call mfree (rank, TY_INT)
+	return (npeaks)
+end
+
+
+# FIND_UPEAKS -- Find the uniformly distrib. 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 uniformly distributed peaks.
+#
+# Indefinite points are ignored.  The peak positions are returned in the
+# array x.
+
+int procedure find_upeaks (data, x, npoints, contrast, separation, edge,
+	nmax, nbins, 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
+int	nbins			# Number of bins across the data array
+real	threshold		# Minimum threshold level for peaks
+bool	debug			# Print diagnostic information?
+
+int	npts, nrank, npeaks, find_unmax()
+pointer	rank
+
+begin
+	npts = npoints
+
+	# Find all isolated peaks and their rank.
+	call find_ipeaks (data, x, npoints, contrast, separation, edge,
+    	    threshold, rank, nrank, debug)
+
+	# Select the peaks.
+	npeaks = find_unmax (data, npts, x, Memi[rank], nrank, nmax, nbins,
+	    debug)
+
+	call mfree (rank, TY_INT)
+	return (npeaks)
+end
+
+
+# FIND_IPEAKS -- Find the all the isolated 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.  Return a rank array
+#
+# Indefinite points are ignored.  The peak positions are returned in the
+# array x.
+
+procedure find_ipeaks (data, x, npoints, contrast, separation, edge, threshold,
+	rank, nrank, 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
+real	threshold		# Minimum threshold level for peaks
+pointer	rank			# Rank array
+int	nrank			# Size of rank array
+bool	debug			# Print diagnostic information?
+
+int	i, j
+int	nlmax, nisolated
+pointer	sp, y
+
+int	find_local_maxima(), find_threshold(), find_isolated()
+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.
+	nrank = find_threshold (data, x, Memr[y], nlmax,
+	    contrast, threshold, debug)
+
+	# Rank the peaks by peak value.
+	call malloc (rank, nrank, TY_INT)
+	do i = 1, nrank
+	    Memi[rank + i - 1] = i
+	call qsort (Memi[rank], nrank, compare)
+
+	# Reject the weaker peaks within sep of a stronger peak.
+	nisolated = find_isolated (x, Memi[rank], nrank, separation, debug)
+
+	call sfree (sp)
+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
+	# INDEF 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 INDEF 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; j <= 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+1)) {
+	    return (FALSE)		# Data is constant
+	} else if (i == 0) {
+	    if (data[j] > data[index])
+	        return (FALSE)		# Data increases to right
+	} else if (j == npoints+1) {
+	    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 arlt to set peaks below threshold to INDEF.
+	if (!IS_INDEFR(threshold) || !IS_INDEFR(contrast)) {
+	    if (IS_INDEFR(threshold))
+		lcut = real (contrast * maxval)
+	    else if (IS_INDEFR(contrast))
+		lcut = real (threshold)
+	    else
+		lcut = max (real (threshold), real (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 INDEF.  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 INDEF.
+	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 INDEF.
+# 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 INDEF.
+# 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 INDEF 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
+
+
+# FIND_UNMAX -- Select up to the nmax highest ranked peaks in bins.
+#
+# 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 INDEF.
+# 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 INDEF.
+# Then the remaining peaks are resorted to contain only the unflaged
+# peaks and the number of such peaks is returned.
+
+int procedure find_unmax (data, npts, x, rank, npoints, nmax, nbins, debug)
+
+real	data[npts]			# Input data values
+int	npts				# Number of input data points
+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
+int	nbins				# Number of sample bins
+bool	debug				# Print debugging information?
+
+int	i, j, npeaks, width, x1, x2
+real	a
+
+begin
+	# Only mark peaks to reject if the number peaks is greater than nmax.
+	if (nmax < npoints) {
+
+	    # Set up circular bins and select highest peak in each bin
+	    # until the desired number of peaks is selected.
+
+	    width = min (npts-1, nint ((npts-1) / (nbins-.5)))
+	    x2 = 1
+	    npeaks = 0
+	    repeat {
+		x1 = x2
+		x2 = mod (x1 + width, npts) + 1
+		j = 0
+		do i = 1, npoints {
+		    a = x[rank[i]]
+		    if (IS_INDEFR (a) || a < 0) {
+			j = j + 1
+			next
+		    }
+		    if (x1 < x2) {
+			if (a >= x1 && a <= x2) {
+			    x[rank[i]] = -a
+			    npeaks = npeaks + 1
+			    break
+			}
+		    } else {
+			if (a <= x2 || a >= x1) {
+			    x[rank[i]] = -a
+			    npeaks = npeaks + 1
+			    break
+			}
+		    }
+		}
+	    } until (npeaks >= nmax || j == npoints)
+
+	    # Now eliminate all unused peaks and reset the selected peaks.
+	    do i = 1, npoints {
+		if (!IS_INDEFR (x[i]) && x[i] < 1)
+		    x[i] = -x[i]
+		else
+		    x[i] = INDEFR
+	    }
+	}
+
+	# Eliminate INDEF points and determine the number of peaks 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.  INDEF 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
+	# INDEF 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/onedspec/identify/reidentify.x b/noao/onedspec/identify/reidentify.x
new file mode 100644
index 00000000..e29fa163
--- /dev/null
+++ b/noao/onedspec/identify/reidentify.x
@@ -0,0 +1,482 @@
+include	<error.h>
+include	<imhdr.h>
+include	<gset.h>
+include	"identify.h"
+
+define	HELP		"noao$onedspec/identify/identify.key"
+define	ICFITHELP	"noao$lib/scr/idicgfit.key"
+define	PROMPT		"identify options"
+
+define	PAN		1	# Pan graph
+define	ZOOM		2	# Zoom graph
+
+# REIDENTIFY -- Reidentify features in an image.
+
+procedure reidentify (id)
+
+pointer	id			# ID pointer
+
+real	wx, wy
+int	wcs, key
+char	cmd[SZ_LINE]
+
+char	newimage[SZ_FNAME]
+int	i, j, last, all, prfeature, nfeatures1, npeaks
+double	pix, fit, user, shift, pix_shift, z_shift
+pointer	peaks, label, aid
+
+bool	aid_autoid()
+int	clgcur(), scan(), nscan(), id_peaks(), errcode()
+double	id_center(), fit_to_pix(), id_fitpt(), id_shift(), id_rms()
+errchk	id_graph()
+
+define	newim_		10
+define	newkey_		20
+define	beep_		99
+
+begin
+	# Initialize.
+	if (ID_GP(id) == NULL)
+	    return
+	ID_GTYPE(id) = PAN
+	all = 0
+	last = ID_CURRENT(id)
+	newimage[1] = EOS
+	ID_REFIT(id) = NO
+	wy = INDEF
+	key = 'r'
+
+	repeat {
+	    prfeature = YES
+	    if (all != 0)
+		all = mod (all + 1, 3)
+
+	    switch (key) {
+	    case '?':	# Print help
+		call gpagefile (ID_GP(id), HELP, PROMPT)
+	    case ':':	# Process colon commands
+		if (cmd[1] == '/')
+		    call gt_colon (cmd, ID_GP(id), ID_GT(id), ID_NEWGRAPH(id))
+		else
+		    call id_colon (id, cmd, newimage, prfeature)
+	    case ' ':	# Go to current feature
+	    case '.':	# Go to nearest feature
+		if (ID_NFEATURES(id) == 0)
+		    goto beep_
+		call id_nearest (id, double (wx))
+	    case '-':	# Go to previous feature
+		if (ID_CURRENT(id) == 1)
+		    goto beep_
+		ID_CURRENT(id) = ID_CURRENT(id) - 1
+	    case '+', 'n':	# Go to next feature
+		if (ID_CURRENT(id) == ID_NFEATURES(id))
+		    goto beep_
+		ID_CURRENT(id) = ID_CURRENT(id) + 1
+	    case 'a':	# Set all flag for next key
+		all = 1
+	    case 'b':	# Autoidentify
+		call aid_init (aid, "aidpars")
+		call aid_sets (aid, "crval", "CL crval")
+		call aid_sets (aid, "cdelt", "CL cdelt")
+		if (aid_autoid (id, aid)) {
+		    ID_NEWCV(id) = YES
+		    ID_NEWFEATURES(id) = YES
+		    ID_NEWGRAPH(id) = YES
+		} else {
+		    prfeature = 0
+		    call printf ("No solution found\n")
+		}
+		call aid_free (aid)
+	    case 'c':	# Recenter features
+		if (all != 0) {
+		    for (i = 1; i <= ID_NFEATURES(id); i = i + 1) {
+		        call gseti (ID_GP(id), G_PLTYPE, 0)
+		        call id_mark (id, i)
+		        call gseti (ID_GP(id), G_PLTYPE, 1)
+			FWIDTH(id,i) = ID_FWIDTH(id)
+		        PIX(id,i) = id_center (id, PIX(id,i), FWIDTH(id,i),
+			    FTYPE(id,i))
+		        if (!IS_INDEFD (PIX(id,i))) {
+			    FIT(id,i) = id_fitpt (id, PIX(id,i))
+		            call id_mark (id, i)
+			} else {
+			    call id_delete (id, i)
+			    i = i - 1
+		        }
+		    }
+		    ID_NEWFEATURES(id) = YES
+		} else {
+		    if (ID_NFEATURES(id) < 1)
+			goto beep_
+		    call id_nearest (id, double (wx))
+		    pix = PIX(id,ID_CURRENT(id))
+		    pix = id_center (id, pix, ID_FWIDTH(id),
+			FTYPE(id,ID_CURRENT(id)))
+		    if (!IS_INDEFD (pix)) {
+		        call gseti (ID_GP(id), G_PLTYPE, 0)
+		        call id_mark (id, ID_CURRENT(id))
+			PIX(id,ID_CURRENT(id)) = pix
+		        FWIDTH(id,ID_CURRENT(id)) = ID_FWIDTH(id)
+			FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix)
+		        call gseti (ID_GP(id), G_PLTYPE, 1)
+			call id_mark (id, ID_CURRENT(id))
+		        ID_NEWFEATURES(id) = YES
+		    } else {
+			call printf ("Centering failed\n")
+			prfeature = NO
+		    }
+		}
+	    case 'd':	# Delete features
+		if (all != 0) {
+		    ID_NFEATURES(id) = 0
+		    ID_CURRENT(id) = 0
+		    ID_NEWFEATURES(id) = YES
+		    ID_NEWGRAPH(id) = YES
+		} else {
+		    if (ID_NFEATURES(id) < 1)
+			goto beep_
+		    call id_nearest (id, double (wx))
+		    call gseti (ID_GP(id), G_PLTYPE, 0)
+		    call id_mark (id, ID_CURRENT(id))
+		    call gseti (ID_GP(id), G_PLTYPE, 1)
+		    call id_delete (id, ID_CURRENT(id))
+		    ID_CURRENT(id) = min (ID_NFEATURES(id), ID_CURRENT(id))
+		    last = 0
+		}
+	    case 'e':	# Find features from line list with no fitting
+		call id_linelist (id)
+		if (ID_NEWFEATURES(id) == YES)
+		    ID_NEWGRAPH(id) = YES
+	    case 'f':	# Fit dispersion function
+		call id_dofit (id, YES)
+	    case 'g':	# Fit shift
+		call id_doshift (id, YES)
+		prfeature = NO
+	    case 'i':	# Initialize
+	        call dcvfree (ID_CV(id))
+		ID_SHIFT(id) = 0.
+	        ID_NEWCV(id) = YES
+		ID_NFEATURES(id) = 0
+		ID_CURRENT(id) = 0
+		ID_NEWFEATURES(id) = YES
+		ID_NEWGRAPH(id) = YES
+	    case 'j', 'k', 'o':
+		call printf ("Command not available in REIDENTIFY")
+		prfeature = NO
+	    case 'l':	# Find features from line list
+		if (ID_NFEATURES(id) >= 2)
+		    call id_dofit (id, NO)
+		if (ID_NEWCV(id) == YES) {
+		    iferr (call id_fitdata(id))
+			;
+		    call id_fitfeatures(id)
+		    ID_NEWCV(id) = NO
+		}
+		call id_linelist (id)
+		if (ID_NEWFEATURES(id) == YES)
+		    ID_REFIT(id) = YES
+	    case 'm':	# Mark new feature
+		fit = wx
+		pix = fit_to_pix (id, fit)
+		pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id))
+		if (IS_INDEFD (pix)) {
+		    prfeature = NO
+		    call printf ("Center not found: check cursor position")
+		    if (ID_THRESHOLD(id) > 0.)
+			call printf (" and threshold value")
+		    goto beep_
+		}
+		fit = id_fitpt (id, pix)
+		user = fit
+		call id_newfeature (id, pix, fit, user, 1.0D0, ID_FWIDTH(id),
+		    ID_FTYPE(id), NULL)
+		USER(id,ID_CURRENT(id)) = INDEFD
+		call id_match (id, FIT(id,ID_CURRENT(id)),
+		    USER(id,ID_CURRENT(id)),
+		    Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id))
+		call id_mark (id, ID_CURRENT(id))
+		call printf ("%10.2f %10.8g (%10.8g %s): ")
+		    call pargd (PIX(id,ID_CURRENT(id)))
+		    call pargd (FIT(id,ID_CURRENT(id)))
+		    call pargd (USER(id,ID_CURRENT(id)))
+		    label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1]
+		    if (label != NULL)
+			call pargstr (Memc[label])
+		    else
+			call pargstr ("")
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargd (user)
+		    call gargwrd (cmd, SZ_LINE)
+		    i = nscan()
+		    if (i > 0) {
+			USER(id,ID_CURRENT(id)) = user
+			call id_match (id, user, USER(id,ID_CURRENT(id)),
+			    Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id))
+		    }
+		    if (i > 1) {
+			call reset_scan ()
+			call gargd (user)
+			call gargstr (cmd, SZ_LINE)
+			call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1])
+		    }
+		}
+	    case 'p':	# Switch to pan mode
+		if (ID_GTYPE(id) != PAN) {
+		    ID_GTYPE(id) = PAN
+		    ID_NEWGRAPH(id) = YES
+		}
+	    case 'q':	# Exit loop
+		break
+	    case 'r':	# Redraw the graph
+		ID_NEWGRAPH(id) = YES
+	    case 's', 'x':	# Shift or correlate features
+		# Get coordinate shift.
+		switch (key) {
+		case 's':
+		    call printf ("User coordinate (%10.8g): ")
+		        call pargr (wx)
+		        call flush (STDOUT)
+		    if (scan() != EOF) {
+		        call gargd (user)
+		        if (nscan() == 1)
+			    shift = wx - user
+		    } else
+		        shift = 0.
+		case 'x':
+		    shift = id_shift (id, -1D0, -0.05D0)
+		    if (IS_INDEFD(shift)) {
+			call printf ("No solution found\n")
+			goto beep_
+		    }
+		}
+
+		ID_NEWFEATURES(id) = YES
+		ID_NEWCV(id) = YES
+		ID_NEWGRAPH(id) = YES
+		prfeature = NO
+
+		if (ID_NFEATURES(id) < 1) {
+		    call printf ("User coordinate shift=%5f\n")
+			call pargd (shift)
+		    ID_SHIFT(id) = ID_SHIFT(id) + shift
+		    goto newkey_
+		}
+
+		# Recenter features.
+		pix_shift = 0.
+		z_shift = 0.
+		nfeatures1 = ID_NFEATURES(id)
+
+		j = 0.
+		do i = 1, ID_NFEATURES(id) {
+		    pix = fit_to_pix (id, FIT(id,i) + shift)
+		    pix = id_center (id, pix, FWIDTH(id,i), FTYPE(id,i))
+		    if (IS_INDEFD (pix)) {
+			if (ID_CURRENT(id) == i)
+			    ID_CURRENT(id) = i + 1
+			next
+		    }
+		    fit = id_fitpt (id, pix)
+
+		    pix_shift = pix_shift + pix - PIX(id,i)
+		    if (FIT(id,i) != 0.)
+		        z_shift = z_shift + (fit - FIT(id,i)) / FIT(id,i)
+
+		    j = j + 1
+		    PIX(id,j) = pix
+		    FIT(id,j) = FIT(id,i)
+		    USER(id,j) = USER(id,i)
+		    WTS(id,j) = WTS(id,i)
+		    FWIDTH(id,j) = FWIDTH(id,i)
+		    FTYPE(id,j) = FTYPE(id,i)
+		    if (ID_CURRENT(id) == i)
+			ID_CURRENT(id) = j
+		}
+		if (j != ID_NFEATURES(id)) {
+		    ID_NFEATURES(id) = j
+		    ID_CURRENT(id) = min (ID_CURRENT(id), ID_NFEATURES(id))
+		}
+
+		if (ID_NFEATURES(id) < 1) {
+		    call printf ("User coordinate shift=%5f")
+			call pargd (shift)
+		    call printf (", No features found during recentering\n")
+		    ID_SHIFT(id) = ID_SHIFT(id) + shift
+		    goto newkey_
+		}
+
+		# Adjust shift.
+		pix = ID_SHIFT(id)
+		call id_doshift (id, NO)
+		call id_fitfeatures (id)
+
+		# Print results.
+		call printf ("Recentered=%d/%d")
+		    call pargi (ID_NFEATURES(id))
+		    call pargi (nfeatures1)
+		call printf (
+		    ", pixel shift=%.2f, user shift=%5f, z=%7.3g, rms=%5g\n")
+		    call pargd (pix_shift / ID_NFEATURES(id))
+		    call pargd (pix - ID_SHIFT(id))
+		    call pargd (z_shift / ID_NFEATURES(id))
+		    call pargd (id_rms(id))
+	    case 't':	# Move the current feature
+		if (ID_CURRENT(id) < 1)
+		    goto beep_
+		pix = fit_to_pix (id, double (wx))
+		call gseti (ID_GP(id), G_PLTYPE, 0)
+		call id_mark (id, ID_CURRENT(id))
+		PIX(id,ID_CURRENT(id)) = pix
+		FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix)
+		call gseti (ID_GP(id), G_PLTYPE, 1)
+		call id_mark (id, ID_CURRENT(id))
+		ID_NEWFEATURES(id) = YES
+	    case 'u':	# Set user coordinate
+		if (ID_NFEATURES(id) < 1)
+		    goto beep_
+		call printf ("%10.2f %10.8g (%10.8g %s): ")
+		    call pargd (PIX(id,ID_CURRENT(id)))
+		    call pargd (FIT(id,ID_CURRENT(id)))
+		    call pargd (USER(id,ID_CURRENT(id)))
+		    label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1]
+		    if (label != NULL)
+			call pargstr (Memc[label])
+		    else
+			call pargstr ("")
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargd (user)
+		    call gargwrd (cmd, SZ_LINE)
+		    i = nscan()
+		    if (i > 0) {
+			USER(id,ID_CURRENT(id)) = user
+			ID_NEWFEATURES(id) = YES
+		    }
+		    if (i > 1) {
+			call reset_scan ()
+			call gargd (user)
+			call gargstr (cmd, SZ_LINE)
+			call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1])
+		    }
+		}
+	    case 'v':	# Modify weight
+		if (ID_NFEATURES(id) < 1)
+		    goto beep_
+		call printf ("Weight (%d): ")
+		    call pargd (WTS(id,ID_CURRENT(id)))
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargi (i)
+		    if (nscan() > 0) {
+			WTS(id,ID_CURRENT(id)) = i
+			ID_NEWFEATURES(id) = YES
+		    }
+		}
+	    case 'w':	# Window graph
+		call gt_window (ID_GT(id), ID_GP(id), "cursor", ID_NEWGRAPH(id))
+	    case 'y':	# Find peaks
+		call malloc (peaks, ID_NPTS(id), TY_REAL)
+		npeaks = id_peaks (id, IMDATA(id,1), Memr[peaks], ID_NPTS(id),
+		    0., int (ID_MINSEP(id)), 0, ID_MAXFEATURES(id), 0., false)
+		for (j = 1; j <= ID_NFEATURES(id); j = j + 1) {
+		    for (i = 1; i <= npeaks; i = i + 1) {
+			if (!IS_INDEF (Memr[peaks+i-1])) {
+			    pix = Memr[peaks+i-1]
+			    if (abs (pix - PIX(id,j)) < ID_MINSEP(id))
+			        Memr[peaks+i-1] = INDEF
+			}
+		    }
+		}
+		for (i = 1; i <= npeaks; i = i + 1) {
+		    if (IS_INDEF(Memr[peaks+i-1]))
+			next
+		    pix = Memr[peaks+i-1]
+		    pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id))
+		    if (IS_INDEFD (pix))
+			next
+		    fit = id_fitpt (id, pix)
+		    user = INDEFD
+		    call id_match (id, fit, user, label, ID_MATCH(id))
+		    call id_newfeature (id, pix, fit, user, 1.0D0,
+			ID_FWIDTH(id), ID_FTYPE(id), label)
+		    call id_mark (id, ID_CURRENT(id))
+		}
+		call mfree (peaks, TY_REAL)
+	    case 'z':	# Go to zoom mode
+		if (ID_NFEATURES(id) < 1)
+		    goto beep_
+		if (ID_GTYPE(id) == PAN)
+		    ID_NEWGRAPH(id) = YES
+		ID_GTYPE(id) = ZOOM
+		call id_nearest (id, double (wx))
+	    case 'I':
+		call fatal (0, "Interrupt")
+	    default:
+beep_		call printf ("\007")
+	    }
+
+newkey_
+	    # Set update flag if anything has changed.
+	    if ((ID_NEWFEATURES(id) == YES) || (ID_NEWCV(id) == YES))
+		ID_NEWDBENTRY(id) = YES
+
+	    # If a new image exit loop, update database, and start over.
+	    if (newimage[1] != EOS) {
+		call printf ("Can't change image in REIDENTIFY")
+		newimage[1] = EOS
+		prfeature = NO
+	    }
+
+	    # Refit dispersion function
+	    if (ID_REFIT(id) == YES) {
+		call id_dofit (id, NO)
+		ID_REFIT(id) = NO
+	    }
+
+	    # If there is a new dispersion solution evaluate the coordinates
+	    if (ID_NEWCV(id) == YES) {
+		iferr (call id_fitdata (id))
+		    ;
+		call id_fitfeatures (id)
+		ID_NEWCV(id) = NO
+	    }
+
+	    # Draw new graph in zoom mode if current feature has changed.
+	    if ((ID_GTYPE(id) == ZOOM) && (last != ID_CURRENT(id)))
+		ID_NEWGRAPH(id) = YES
+
+	    # Draw new graph.
+	    if (ID_NEWGRAPH(id) == YES) {
+		call id_graph (id, ID_GTYPE(id))
+	        ID_NEWGRAPH(id) = NO
+	    }
+
+	    # Set cursor and print status of current feature (unless canceled).
+	    if (ID_CURRENT(id) > 0) {
+		if (IS_INDEF (wy)) {
+		    i = max (1, min (ID_NPTS(id), int (PIX(id,ID_CURRENT(id)))))
+		    wy = IMDATA(id,i)
+		}
+		    
+		call gscur (ID_GP(id), real (FIT(id,ID_CURRENT(id))), wy)
+		if (errcode() == OK && prfeature == YES) {
+	            call printf ("%10.2f %10.8g %10.8g %s\n")
+		        call pargd (PIX(id,ID_CURRENT(id)))
+		        call pargd (FIT(id,ID_CURRENT(id)))
+		        call pargd (USER(id,ID_CURRENT(id)))
+			if (Memi[ID_LABEL(id)+ID_CURRENT(id)-1] != NULL)
+			    call pargstr (
+				Memc[Memi[ID_LABEL(id)+ID_CURRENT(id)-1]])
+			else
+			    call pargstr ("")
+		}
+	    }
+
+	    # Print delayed error message
+	    if (errcode() != OK)
+		call erract (EA_WARN)
+
+	    last = ID_CURRENT(id)
+	} until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF)
+end
diff --git a/noao/onedspec/identify/t_autoid.x b/noao/onedspec/identify/t_autoid.x
new file mode 100644
index 00000000..fbdaa0cd
--- /dev/null
+++ b/noao/onedspec/identify/t_autoid.x
@@ -0,0 +1,252 @@
+include	<error.h>
+include	<fset.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	"identify.h"
+
+define	ICFITHELP	"noao$lib/scr/idicgfit.key"
+
+
+# T_AUTOIDENTIFY -- Automatically identify spectral features.
+
+procedure t_autoidentify ()
+
+int	list			# List of images
+int	interactive		# Examine identifications interactively?
+int	dbwrite			# Write database results?
+
+int	i, fd, hdr, hdr1
+pointer	sp, str, aid, id
+
+int	clgeti(), clgwrd(), nscan(), open(), nowhite()
+int	imtopenp(), imtgetim(), id_dbcheck()
+bool	clgetb(), aid_autoid()
+real	clgetr()
+pointer	gopen(), gt_init(), un_open()
+errchk	open, id_mapll, aid_autoid, aid_init, reidentify
+
+define	done_	10
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Initialize data structures.  Note the AID structure is initialized
+	# with CL queries to the AIDPARS pset.
+
+	aid = NULL
+	call aid_init (aid, "aidpars")
+	call id_init (id)
+
+	# Get query parameters.
+	list = imtopenp ("images")
+	call aid_sets (aid, "crval", "CL crval")
+	call aid_sets (aid, "cdelt", "CL cdelt")
+
+	# Get other parameters and IDENITFY set data structures.
+	ID_NSUM(id,1) = clgeti ("nsum")
+	call gargi (ID_NSUM(id,2))
+	if (nscan() != 2)
+	    ID_NSUM(id,2) = ID_NSUM(id,1)
+	ID_NSUM(id,1) = max (1, ID_NSUM(id,1))
+	ID_NSUM(id,2) = max (1, ID_NSUM(id,2))
+	ID_MAXFEATURES(id) = clgetr ("aidpars.ntarget")
+	ID_MINSEP(id) = clgetr ("minsep")
+	ID_FTYPE(id) = clgwrd ("ftype", Memc[str], SZ_LINE, FTYPES)
+	ID_FWIDTH(id) = clgetr ("fwidth")
+	ID_CRADIUS(id) = clgetr ("cradius")
+	ID_THRESHOLD(id) = clgetr ("threshold")
+	ID_MATCH(id) = clgetr ("match")
+	ID_ZWIDTH(id) = clgetr ("identify.zwidth")
+	ID_LABELS(id) = 1
+
+	call clgstr ("database", ID_DATABASE(id), ID_LENSTRING)
+	dbwrite = clgwrd ("dbwrite", Memc[str], SZ_FNAME, "|no|yes|NO|YES|")
+	if (dbwrite == 1)
+	    dbwrite = 3
+
+	call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING)
+	if (nowhite (ID_COORDLIST(id), ID_COORDLIST(id), ID_LENSTRING) == 0) {
+	    call clgstr ("coordlist.p_prompt", Memc[str], SZ_LINE)
+	    call printf (Memc[str])
+	    call flush (STDOUT)
+	    call clgstr ("query", ID_COORDLIST(id), ID_LENSTRING)
+	}
+	call clgstr ("units", Memc[str], SZ_LINE)
+	call xt_stripwhite (Memc[str])
+	if (Memc[str] != EOS)
+	    ID_UN(id) = un_open (Memc[str])
+	call id_mapll (id)
+	if (ID_LL(id) == NULL)
+	    call error (0, "Required coordinate line list not found")
+
+	# Dispersion fitting parameters.
+        call ic_open (ID_IC(id))
+        call clgstr ("function", Memc[str], SZ_LINE)
+        call ic_pstr (ID_IC(id), "function", Memc[str])
+        call ic_puti (ID_IC(id), "order", clgeti ("order"))
+        call clgstr ("sample", Memc[str], SZ_LINE)
+        call ic_pstr (ID_IC(id), "sample", Memc[str])
+        call ic_puti (ID_IC(id), "naverage", 1)
+        call ic_puti (ID_IC(id), "niterate", clgeti ("niterate"))
+        call ic_putr (ID_IC(id), "low", clgetr ("low_reject"))
+        call ic_putr (ID_IC(id), "high", clgetr ("high_reject"))
+        call ic_putr (ID_IC(id), "grow", clgetr ("grow"))
+
+        call ic_pstr (ID_IC(id), "xlabel", "Feature positions")
+        call ic_pstr (ID_IC(id), "xunits", "pixels")
+        call ic_pstr (ID_IC(id), "ylabel", "")
+        call ic_pkey (ID_IC(id), 1, 'y', 'x')
+        call ic_pkey (ID_IC(id), 2, 'y', 'v')
+        call ic_pkey (ID_IC(id), 3, 'y', 'r')
+        call ic_pkey (ID_IC(id), 4, 'y', 'd')
+        call ic_pkey (ID_IC(id), 5, 'y', 'n')
+        call ic_puti (ID_IC(id), "key", 5)
+	call ic_pstr (ID_IC(id), "help", ICFITHELP)
+
+	# Interactive, graphics, and output parameters.
+	interactive = clgwrd ("interactive", Memc[str], SZ_FNAME,
+	    "|no|yes|NO|YES|")
+	switch (interactive) {
+	case 1, 3:
+	    ID_GP(id) = NULL
+	    interactive = 3
+	case 2, 4:
+	    # Open graphics
+	    call clgstr ("graphics", Memc[str], SZ_LINE)
+	    ID_GP(id) = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH)
+	}
+
+	ID_GT(id) = gt_init()
+	call gt_sets (ID_GT(id), GTTYPE, "line")
+	call fseti (STDOUT, F_FLUSHNL, YES)
+	hdr = YES
+	hdr1 = YES
+
+	# Log and plot files.
+	call calloc (ID_LOGFILES(id), 4, TY_INT)
+	if (clgetb ("verbose"))
+	    Memi[ID_LOGFILES(id)] = STDOUT
+	call clgstr ("logfile", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) {
+	    fd = open (Memc[str], APPEND, TEXT_FILE)
+	    Memi[ID_LOGFILES(id)+1] = fd
+	}
+	call clgstr ("plotfile", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) {
+	    fd = open (Memc[str], APPEND, BINARY_FILE)
+	    Memi[ID_LOGFILES(id)+2] = fd
+	}
+
+	# Expand the image template and identify features.
+	while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF) {
+	    # Initialize.
+	    iferr (call id_map(id)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    if (!clgetb ("overwrite")) {
+		if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) {
+		    if (Memi[ID_LOGFILES(id)] != NULL) {
+			if (ID_GP(id) != NULL)
+			    call gdeactivate (ID_GP(id), 0)
+			call fprintf (Memi[ID_LOGFILES(id)],
+			    "  %s%s%24t Database entry already exists\n")
+			    call pargstr (ID_IMAGE(id))
+			    call pargstr (ID_SECTION(id))
+		    }
+		    goto done_
+		}
+	    }
+
+	    call id_gdata(id)
+	    call id_fitdata(id)
+	    call ic_putr (ID_IC(id), "xmin", real (PIXDATA(id,1)))
+	    call ic_putr (ID_IC(id), "xmax", real (PIXDATA(id,ID_NPTS(id))))
+
+	    call dcvfree (ID_CV(id))
+	    ID_SHIFT(id) = 0.
+	    ID_NFEATURES(id) = 0
+
+	    # Automatically identify the features.
+	    if (aid_autoid (id, aid))
+		ID_NEWDBENTRY(id) = YES
+	    else if (Memi[ID_LOGFILES(id)] == NULL)
+		call aid_log (id, STDOUT, NO)
+	    call aid_log (id, Memi[ID_LOGFILES(id)], hdr)
+	    call aid_log (id, Memi[ID_LOGFILES(id)+1], hdr1)
+
+	    # Enter interactive identification mode if desired.
+	    if (interactive != 3) {
+		if (interactive != 4) {
+		    repeat {
+			call clgstr ("interactive.p_prompt", Memc[str],
+			    SZ_FNAME)
+			call printf ("%s%s: %s")
+			    call pargstr (ID_IMAGE(id))
+			    call pargstr (ID_SECTION(id))
+			    call pargstr (Memc[str])
+			call flush (STDOUT)
+			if (interactive == 1)
+			    call clpstr ("query", "no")
+			else
+			    call clpstr ("query", "yes")
+			ifnoerr (interactive = clgwrd ("query", Memc[str],
+			    SZ_FNAME, "|no|yes|NO|YES|"))
+			break
+		    }
+		}
+		if (interactive == 2 || interactive == 4) {
+		    call reidentify (id)
+		    call gdeactivate (ID_GP(id), 0)
+		}
+	    }
+
+	    # Write results to the database.
+	    if (ID_NEWDBENTRY(id) == YES) {
+		if (dbwrite == 1 || dbwrite == 2) {
+		    repeat {
+			call clgstr ("dbwrite.p_prompt", Memc[str], SZ_FNAME)
+			call printf ("%s%s: %s")
+			    call pargstr (ID_IMAGE(id))
+			    call pargstr (ID_SECTION(id))
+			    call pargstr (Memc[str])
+			call flush (STDOUT)
+			if (dbwrite == 1)
+			    call clpstr ("query", "no")
+			else
+			    call clpstr ("query", "yes")
+			ifnoerr (dbwrite = clgwrd ("query", Memc[str],
+			    SZ_FNAME, "|no|yes|NO|YES|"))
+			    break
+		    }
+		}
+		if (dbwrite == 2 || dbwrite == 4)
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+	    }
+
+done_	    # Close the database, image, and spectrum data structures.
+	    if (ID_DT(id) != NULL)
+		call dtunmap (ID_DT(id))
+	    call smw_close (MW(ID_SH(id)))
+	    call imunmap (IM(ID_SH(id)))
+	    call shdr_close (ID_SH(id))
+	}
+
+	# Finish up.
+	do i = 1, 3 {
+	    fd = Memi[ID_LOGFILES(id)+i-1]
+	    if (fd != NULL)
+		call close (fd)
+	}
+	call mfree (ID_LOGFILES(id), TY_INT)
+	if (ID_GP(id) != NULL)
+	    call gclose (ID_GP(id))
+	call smw_daxis (NULL, NULL, 0, 0, 0)
+	call imtclose (list)
+	if (aid != NULL)
+	    call aid_free (aid)
+	call id_free (id)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/identify/t_identify.x b/noao/onedspec/identify/t_identify.x
new file mode 100644
index 00000000..96e5034e
--- /dev/null
+++ b/noao/onedspec/identify/t_identify.x
@@ -0,0 +1,89 @@
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"identify.h"
+
+# T_IDENTIFY -- Identify features
+
+procedure t_identify ()
+
+int	list, clscan(), clgeti(), clgwrd(), nscan(), imtopenp(), imtgetim()
+real	clgetr()
+pointer	sp, str, id, gt_init(), un_open()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Allocate the basic data structure.
+	call id_init (id)
+
+	# Get task parameters.
+	list = imtopenp ("images")
+	if (clscan ("nsum") != EOF) {
+	    call gargi (ID_NSUM(id,1))
+	    call gargi (ID_NSUM(id,2))
+	    if (nscan() == 0)
+		call error (1, "Error in 'nsum' parameter")
+	    if (nscan() == 1)
+		ID_NSUM(id,2) = ID_NSUM(id,1)
+	    ID_NSUM(id,1) = max (1, ID_NSUM(id,1))
+	    ID_NSUM(id,2) = max (1, ID_NSUM(id,2))
+	}
+	ID_MAXFEATURES(id) = clgeti ("maxfeatures")
+	ID_MINSEP(id) = clgetr ("minsep")
+	ID_MATCH(id) = clgetr ("match")
+	ID_ZWIDTH(id) = clgetr ("zwidth")
+	ID_FTYPE(id) = clgwrd ("ftype", Memc[str], SZ_LINE, FTYPES)
+	ID_FWIDTH(id) = clgetr ("fwidth")
+	ID_CRADIUS(id) = clgetr ("cradius")
+	ID_THRESHOLD(id) = clgetr ("threshold")
+	call clgstr ("database", ID_DATABASE(id), ID_LENSTRING)
+	call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING)
+	call clgstr ("units", Memc[str], SZ_LINE)
+	call xt_stripwhite (Memc[str])
+	if (Memc[str] != EOS)
+	    ID_UN(id) = un_open (Memc[str])
+	ID_LABELS(id) = 1
+
+	# Initialize features data structure.
+	ID_GT(id) = gt_init()
+	call gt_sets (ID_GT(id), GTTYPE, "line")
+	ID_CV(id) = NULL
+	ID_CURRENT(id) = 0
+	ID_SHIFT(id) = 0.
+
+	# Initialize ICFIT
+	call ic_open (ID_IC(id))
+	call clgstr ("function", Memc[str], SZ_LINE)
+	call ic_pstr (ID_IC(id), "function", Memc[str])
+	call ic_puti (ID_IC(id), "order", clgeti ("order"))
+	call clgstr ("sample", Memc[str], SZ_LINE)
+	call ic_pstr (ID_IC(id), "sample", Memc[str])
+	call ic_puti (ID_IC(id), "naverage", 1)
+	call ic_puti (ID_IC(id), "niterate", clgeti ("niterate"))
+	call ic_putr (ID_IC(id), "low", clgetr ("low_reject"))
+	call ic_putr (ID_IC(id), "high", clgetr ("high_reject"))
+	call ic_putr (ID_IC(id), "grow", clgetr ("grow"))
+	call ic_pstr (ID_IC(id), "xlabel", "Feature positions")
+	call ic_pstr (ID_IC(id), "xunits", "pixels")
+	call ic_pstr (ID_IC(id), "ylabel", "")
+	call ic_pkey (ID_IC(id), 1, 'y', 'x')
+	call ic_pkey (ID_IC(id), 2, 'y', 'v')
+	call ic_pkey (ID_IC(id), 3, 'y', 'r')
+	call ic_pkey (ID_IC(id), 4, 'y', 'd')
+	call ic_pkey (ID_IC(id), 5, 'y', 'n')
+	call ic_puti (ID_IC(id), "key", 3)
+
+	# Get the line list.
+	call id_mapll (id)
+
+	# Expand the image template and identify features in each image.
+	while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF)
+	    call id_identify (id)
+
+	# Finish up.
+	call smw_daxis (NULL, NULL, 0, 0, 0)
+	call id_free (id)
+	call imtclose (list)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/identify/t_reidentify.x b/noao/onedspec/identify/t_reidentify.x
new file mode 100644
index 00000000..e82951ee
--- /dev/null
+++ b/noao/onedspec/identify/t_reidentify.x
@@ -0,0 +1,1083 @@
+include	<error.h>
+include	<fset.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	"identify.h"
+
+define	ICFITHELP	"noao$lib/scr/idicgfit.key"
+
+# T_REIDENTIFY -- Reidentify features starting from reference features.
+# A reference spectrum is specified and the same features are identified
+# in other images.  Some lines may be lost due to bad centering.  Additional
+# lines may be excluded from a new fit to the dispersion function.  Instead
+# of refitting the dispersion function the user may elect to determine only
+# a shift in the reference dispersion function.  Additional features may
+# be added given a coordinate list.
+#
+# In 2D images a starting line or column is selected.  A number of lines
+# or columns may be averaged before identifying features.  If a positive step
+# size is given then additional lines or columns may be reidentified in
+# the reference image.  This may be done either by tracing or by reidentifying
+# starting from the same reference features.  Reidentification between images
+# is done by taking the same line or column from the reference image.
+# The step and summing are ignored for multispec images.
+# 
+# Multispec format images are matched by aperture number and the spectra
+# need not be in the same order in each image.
+
+procedure t_reidentify ()
+
+pointer	reference		# Reference image
+int	list			# List of images
+char	ans[3]			# Interactive?
+double	crsearch		# Search radius
+
+int	i, fd, nlogfd
+pointer	sp, logfile, str, id, logfd, pd
+
+int	clscan(), clgeti(), clpopnu(), clgfil(), clgwrd()
+int	nscan(), open(), btoi(), nowhite(), imtopenp(), imtgetim()
+bool	clgetb(), strne()
+double	clgetd()
+pointer	gopen(), gt_init()
+
+begin
+	call smark (sp)
+	call salloc (reference, SZ_FNAME, TY_CHAR)
+	call salloc (logfile, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Allocate the basic data structures.
+	call id_init (id)
+	call ic_open (ID_IC(id))
+
+	# Get task parameters.
+	call clgstr ("reference", Memc[reference], SZ_FNAME)
+	list = imtopenp ("images")
+	i = nowhite (Memc[reference], Memc[reference], SZ_FNAME)
+
+	crsearch = clgetd ("search")
+	ID_REFIT(id) = btoi (clgetb ("refit"))
+
+	if (clscan ("nsum") != EOF) {
+	    call gargi (ID_NSUM(id,1))
+	    call gargi (ID_NSUM(id,2))
+	    if (nscan() == 0)
+		call error (1, "Error in 'nsum' parameter")
+	    if (nscan() == 1)
+		ID_NSUM(id,2) = ID_NSUM(id,1)
+	    ID_NSUM(id,1) = max (1, ID_NSUM(id,1))
+	    ID_NSUM(id,2) = max (1, ID_NSUM(id,2))
+	}
+	ID_MAXFEATURES(id) = clgeti ("maxfeatures")
+	ID_MINSEP(id) = clgetd ("minsep")
+	ID_MATCH(id) = clgetd ("match")
+	ID_ZWIDTH(id) = clgetd ("identify.zwidth")
+	ID_FTYPE(id) = clgwrd ("identify.ftype", Memc[str], SZ_LINE, FTYPES)
+	ID_FWIDTH(id) = clgetd ("identify.fwidth")
+	ID_CRADIUS(id) = clgetd ("cradius")
+	ID_THRESHOLD(id) = clgetd ("threshold")
+	call clgstr ("database", ID_DATABASE(id), ID_LENSTRING)
+	call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING)
+	ID_LABELS(id) = 1
+
+	call id_mapll (id)
+	ID_LOGFILES(id) = clpopnu ("logfiles")
+
+	switch (clgwrd ("interactive", ans, SZ_FNAME, "|no|yes|NO|YES|")) {
+	case 1, 3:
+	    call strcpy ("NO", ans, 3)
+	    ID_GP(id) = NULL
+	case 2, 4:
+	    # Open graphics
+	    call clgstr ("graphics", Memc[logfile], SZ_FNAME)
+	    ID_GP(id) = gopen (Memc[logfile], NEW_FILE+AW_DEFER, STDGRAPH)
+	    call ic_pstr (ID_IC(id), "help", ICFITHELP)
+	    call ic_pstr (ID_IC(id), "xlabel", "Feature positions")
+	    call ic_pstr (ID_IC(id), "xunits", "pixels")
+	    call ic_pstr (ID_IC(id), "ylabel", "")
+	    call ic_pkey (ID_IC(id), 1, 'y', 'x')
+	    call ic_pkey (ID_IC(id), 2, 'y', 'v')
+	    call ic_pkey (ID_IC(id), 3, 'y', 'r')
+	    call ic_pkey (ID_IC(id), 4, 'y', 'd')
+	    call ic_pkey (ID_IC(id), 5, 'y', 'n')
+	    call ic_puti (ID_IC(id), "key", 3)
+	}
+
+	# Open log and plot files.
+	nlogfd = 0
+	if (clgetb ("verbose")) {
+	    nlogfd = 1
+	    call malloc (logfd, nlogfd, TY_INT)
+	    Memi[logfd] = STDOUT
+	}
+	while (clgfil (ID_LOGFILES(id), Memc[logfile], SZ_FNAME) != EOF) {
+	    fd = open (Memc[logfile], APPEND, TEXT_FILE)
+	    call fseti (fd, F_FLUSHNL, YES)
+	    nlogfd = nlogfd + 1
+	    if (nlogfd == 1)
+		call malloc (logfd, nlogfd, TY_INT)
+	    else
+		call realloc (logfd, nlogfd, TY_INT)
+	    Memi[logfd+nlogfd-1] = fd
+	}
+	call ri_loghdr (id, Memc[reference], Memi[logfd], nlogfd, 1)
+
+	call clgstr ("plotfile", Memc[logfile], SZ_FNAME)
+	if (nowhite (Memc[logfile], Memc[logfile], SZ_FNAME) > 0) {
+	    fd = open (Memc[logfile], APPEND, BINARY_FILE)
+	    pd = gopen ("stdvdm", NEW_FILE, fd)
+	} else
+	    pd = NULL
+
+	ID_GT(id) = gt_init()
+	call gt_sets (ID_GT(id), GTTYPE, "line")
+
+	# Get and trace the reference solutions.
+	call ri_reference (id, Memc[reference], crsearch, ans, Memi[logfd],
+	    nlogfd, pd)
+
+	# Expand the image template and reidentify features.
+	while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF)
+	    if (strne (Memc[reference], ID_IMAGE(id)))
+		call ri_image (id, Memc[reference], ID_IMAGE(id), crsearch, ans,
+		    Memi[logfd], nlogfd, pd)
+
+	# Finish up.
+	if (nlogfd > 0) {
+	    do i = 1, nlogfd
+	        call close (Memi[logfd+i-1])
+	    call mfree (logfd, TY_INT)
+	}
+
+	if (ID_GP(id) != NULL)
+	    call gclose (ID_GP(id))
+	if (pd != NULL) {
+	    call gclose (pd)
+	    call close (fd)
+	}
+	call clpcls (ID_LOGFILES(id))
+	call imtclose (list)
+	call id_free (id)
+	call smw_daxis (NULL, NULL, 0, 0, 0)
+	call sfree (sp)
+end
+
+
+# RI_REFERENCE -- Set reference features.  Trace if needed.
+
+procedure ri_reference (id, reference, crsearch, ans, logfd, nlogfd, pd)
+
+pointer	id			# ID pointer
+char	reference[ARB]		# Reference image
+double	crsearch		# Search radius
+char	ans[3]			# Interactive?
+int	logfd[ARB]		# Logfiles
+int	nlogfd			# Number of logfiles
+pointer	pd			# Plot file pointer
+
+int	step[2]
+double	shift[2]
+int	nreid
+bool	override
+bool	trace
+
+int	i, apstart[2], start[2], line[2], loghdr
+double	fit_shift[2]
+pointer	ic, ic1
+bool	clgetb()
+int	clscan(), clgeti(), nscan(), id_dbcheck()
+pointer	id_getap()
+errchk	id_dbread
+
+begin
+	# Open the image and return if there is an error.
+	call strcpy (reference, ID_IMAGE(id), ID_LENSTRING)
+	iferr (call id_map (id)) {
+	    call erract (EA_WARN)
+	    iferr (call id_dbsave (id, ID_IMAGE(id)))
+		call erract (EA_WARN)
+	    return
+	}
+
+	# Get and save the reference database entry.
+	call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), NO, NO)
+	call id_saveap (id)
+
+	# Set parameters
+	start[1] = ID_LINE(id,1)
+	start[2] = ID_LINE(id,2)
+	apstart[1] = ID_AP(id,1)
+	apstart[2] = ID_AP(id,2)
+
+	if (clscan ("step") == EOF)
+	    call error (1, "Error in 'step' parameter")
+	call gargi (step[1])
+	call gargi (step[2])
+	if (nscan() == 0)
+	    call error (1, "Error in 'step' parameter")
+	if (nscan() == 1)
+	    step[2] = step[1]
+	if (SMW_FORMAT(MW(ID_SH(id))) != SMW_ND) {
+	    step[1] = min (step[1], 1)
+	    step[2] = min (step[2], 1)
+	}
+	if (step[1] == 0)
+	    step[1] = ID_MAXLINE(id,1)
+	if (step[2] == 0)
+	    step[2] = ID_MAXLINE(id,2)
+
+	if (clscan ("shift") != EOF) {
+	    call gargd (shift[1])
+	    call gargd (shift[2])
+	    if (nscan() == 0)
+		call error (1, "Error in 'shift' parameter")
+	    if (nscan() == 1)
+		shift[2] = shift[1]
+	}
+
+	nreid = max (1, ID_NFEATURES(id) - clgeti ("nlost"))
+	override = clgetb ("override")
+	trace = clgetb ("trace")
+
+	# Get and save other entries.
+	if (!override) {
+	    for (line[2]=start[2]; line[2]>0; line[2]=line[2]-step[2]) {
+		ID_LINE(id,2) = line[2]
+		ID_AP(id,2) = line[2]
+		for (line[1]=start[1]; line[1]>0; line[1]=line[1]-step[1]) {
+		    if (line[1]==start[1] && line[2]==start[2])
+			next
+		    ID_LINE(id,1) = line[1]
+		    ID_AP(id,1) = line[1]
+		    if (ID_APS(id) != NULL)
+			ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		    ifnoerr (
+			call id_dbread (id, ID_IMAGE(id), ID_AP(id,1),
+			    NO, NO)) {
+			call id_saveap (id)
+		    }
+		}
+		for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1);
+		    line[1]=line[1]+step[1]) {
+		    ID_LINE(id,1) = line[1]
+		    ID_AP(id,1) = line[1]
+		    if (ID_APS(id) != NULL)
+			ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		    ifnoerr (call id_dbread (id, ID_IMAGE(id),
+			ID_AP(id,1), NO, NO)) {
+			call id_saveap (id)
+		    }
+		}
+	    }
+	    for (line[2]=start[2]+step[2]; line[2]<=ID_MAXLINE(id,2);
+		line[2]=line[2]+step[2]) {
+		ID_LINE(id,2) = line[2]
+		ID_AP(id,2) = line[2]
+		for (line[1]=start[1]-step[1]; line[1]>0;
+		    line[1]=line[1]-step[1]) {
+		    ID_LINE(id,1) = line[1]
+		    ID_AP(id,1) = line[1]
+		    if (ID_APS(id) != NULL)
+			ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		    ifnoerr (
+			call id_dbread (id, ID_IMAGE(id), ID_AP(id,1),
+			    NO, NO)) {
+			call id_saveap (id)
+		    }
+		}
+		for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1);
+		    line[1]=line[1]+step[1]) {
+		    ID_LINE(id,1) = line[1]
+		    ID_AP(id,1) = line[1]
+		    if (ID_APS(id) != NULL)
+			ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		    ifnoerr (call id_dbread (id, ID_IMAGE(id),
+			ID_AP(id,1), NO, NO)) {
+			call id_saveap (id)
+		    }
+		}
+	    }
+	}
+
+	# Reidentify.
+	loghdr = 2
+	ic = ID_IC(id)
+	if (ans[1] == 'N')
+	    ic1 = ic
+	else {
+	    call ic_open (ic1)
+	    call ic_copy (ic, ic1)
+	}
+
+	fit_shift[2] = shift[2]
+	for (line[2]=start[2]; line[2]>0; line[2]=line[2]-step[2]) {
+	    ID_LINE(id,2) = line[2]
+	    ID_AP(id,2) = line[2]
+	    ID_IC(id) = ic
+
+	    if (IS_INDEFD(shift[2]))
+		fit_shift[2] = INDEFD
+	    else {
+		if (!trace)
+		    fit_shift[2] = fit_shift[2] - shift[2]
+		else
+		    fit_shift[2] = -shift[2]
+	    }
+
+	    fit_shift[1] = fit_shift[2]
+	    for (line[1]=start[1]; line[1]>0; line[1]=line[1]-step[1]) {
+		if (line[1]==start[1] && line[2]==start[2])
+		    next
+		ID_LINE(id,1) = line[1]
+		ID_AP(id,1) = line[1]
+		ID_IC(id) = ic
+		if (ID_APS(id) != NULL)
+		    ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		if (!override)
+		    if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES)
+			next
+
+		if (!trace) {
+		    ID_NFEATURES(id) = 0
+		    ID_AP(id,1) = apstart[1]
+		    ID_AP(id,2) = apstart[2]
+		    i = id_getap (id)
+		    ID_LINE(id,1) = line[1]
+		    ID_LINE(id,2) = line[2]
+		}
+
+		if (IS_INDEFD(shift[1]))
+		    fit_shift[1] = INDEFD
+		else {
+		    if (!trace)
+			fit_shift[1] = fit_shift[1] - shift[1]
+		    else
+			fit_shift[1] = -shift[1]
+		}
+
+		ID_IC(id) = ic1
+		call id_gdata (id)
+		iferr (call id_fitdata (id))
+		    ;
+
+		call ri_loghdr (id, reference, logfd, nlogfd, loghdr)
+		loghdr = 0
+		call ri_reidentify (id, fit_shift, crsearch, ans, logfd,
+		    nlogfd, pd)
+
+		if (ID_NFEATURES(id) < nreid) {
+		    call ri_loghdr (id, reference, logfd, nlogfd, 3)
+		    ID_NFEATURES(id) = 0
+		    if (trace)
+			break
+		}
+
+		if (ID_NFEATURES(id) > 0) {
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		    call id_saveap (id)
+		}
+	    }
+
+	    ID_IC(id) = ic
+	    ID_NFEATURES(id) = 0
+	    ID_AP(id,1) = apstart[1]
+	    ID_AP(id,2) = apstart[2]
+	    i = id_getap (id)
+	    fit_shift[1] = fit_shift[2]
+	    for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1);
+		line[1]=line[1]+step[1]) {
+		ID_LINE(id,1) = line[1]
+		ID_AP(id,1) = line[1]
+		ID_IC(id) = ic
+		if (ID_APS(id) != NULL)
+		    ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		if (!override)
+		    if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES)
+			next
+
+		if (!trace) {
+		    ID_NFEATURES(id) = 0
+		    ID_AP(id,1) = apstart[1]
+		    ID_AP(id,2) = apstart[2]
+		    i = id_getap (id)
+		    ID_LINE(id,1) = line[1]
+		    ID_LINE(id,2) = line[2]
+		}
+
+		if (IS_INDEFD(shift[1]))
+		    fit_shift[1] = INDEFD
+		else {
+		    if (!trace)
+			fit_shift[1] = fit_shift[1] + shift[1]
+		    else
+			fit_shift[1] = shift[1]
+		}
+
+		ID_IC(id) = ic1
+		call id_gdata (id)
+		iferr (call id_fitdata (id))
+		    ;
+
+		call ri_loghdr (id, reference, logfd, nlogfd, loghdr)
+		loghdr = 0
+		call ri_reidentify (id, fit_shift, crsearch, ans, logfd,
+		    nlogfd, pd)
+
+		if (ID_NFEATURES(id) < nreid) {
+		    call ri_loghdr (id, reference, logfd, nlogfd, 3)
+		    ID_NFEATURES(id) = 0
+		    if (trace)
+			break
+		}
+
+		if (ID_NFEATURES(id) > 0) {
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		    call id_saveap (id)
+		}
+	    }
+	}
+
+
+	fit_shift[2] = 0.
+	for (line[2]=start[2]+step[2]; line[2]<=ID_MAXLINE(id,2);
+	    line[2]=line[2]+step[2]) {
+	    ID_LINE(id,2) = line[2]
+	    ID_AP(id,2) = line[2]
+	    ID_IC(id) = ic
+
+	    if (IS_INDEFD(shift[2]))
+		fit_shift[2] = INDEFD
+	    else {
+		if (!trace)
+		    fit_shift[2] = fit_shift[2] + shift[2]
+		else
+		    fit_shift[2] = shift[2]
+	    }
+
+	    fit_shift[1] = fit_shift[2]
+	    for (line[1]=start[1]; line[1]>0; line[1]=line[1]-step[1]) {
+		ID_LINE(id,1) = line[1]
+		ID_AP(id,1) = line[1]
+		ID_IC(id) = ic
+		if (ID_APS(id) != NULL)
+		    ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		if (!override)
+		    if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES)
+			next
+
+		if (!trace) {
+		    ID_NFEATURES(id) = 0
+		    ID_AP(id,1) = apstart[1]
+		    ID_AP(id,2) = apstart[2]
+		    i = id_getap (id)
+		    ID_LINE(id,1) = line[1]
+		    ID_LINE(id,2) = line[2]
+		}
+
+		if (IS_INDEFD(shift[1]))
+		    fit_shift[1] = INDEFD
+		else {
+		    if (!trace)
+			fit_shift[1] = fit_shift[1] - shift[1]
+		    else
+			fit_shift[1] = -shift[1]
+		}
+
+		ID_IC(id) = ic1
+		call id_gdata (id)
+		iferr (call id_fitdata (id))
+		    ;
+
+		call ri_loghdr (id, reference, logfd, nlogfd, loghdr)
+		loghdr = 0
+		call ri_reidentify (id, fit_shift, crsearch, ans, logfd,
+		    nlogfd, pd)
+
+		if (ID_NFEATURES(id) < nreid) {
+		    call ri_loghdr (id, reference, logfd, nlogfd, 3)
+		    ID_NFEATURES(id) = 0
+		    if (trace)
+			break
+		}
+
+		if (ID_NFEATURES(id) > 0) {
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		    call id_saveap (id)
+		}
+	    }
+
+	    ID_IC(id) = ic
+	    ID_NFEATURES(id) = 0
+	    ID_AP(id,1) = apstart[1]
+	    ID_AP(id,2) = apstart[2]
+	    i = id_getap (id)
+	    fit_shift[1] = fit_shift[2]
+	    for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1);
+		line[1]=line[1]+step[1]) {
+		ID_LINE(id,1) = line[1]
+		ID_AP(id,1) = line[1]
+		ID_IC(id) = ic
+		if (ID_APS(id) != NULL)
+		    ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1]
+		if (!override)
+		    if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES)
+			next
+
+		if (!trace) {
+		    ID_NFEATURES(id) = 0
+		    ID_AP(id,1) = apstart[1]
+		    ID_AP(id,2) = apstart[2]
+		    i = id_getap (id)
+		    ID_LINE(id,1) = line[1]
+		    ID_LINE(id,2) = line[2]
+		}
+
+		if (IS_INDEFD(shift[1]))
+		    fit_shift[1] = INDEFD
+		else {
+		    if (!trace)
+			fit_shift[1] = fit_shift[1] + shift[1]
+		    else
+			fit_shift[1] = shift[1]
+		}
+
+		ID_IC(id) = ic1
+		call id_gdata (id)
+		iferr (call id_fitdata (id))
+		    ;
+
+		call ri_loghdr (id, reference, logfd, nlogfd, loghdr)
+		loghdr = 0
+		call ri_reidentify (id, fit_shift, crsearch, ans, logfd,
+		    nlogfd, pd)
+
+		if (ID_NFEATURES(id) < nreid) {
+		    call ri_loghdr (id, reference, logfd, nlogfd, 3)
+		    ID_NFEATURES(id) = 0
+		    if (trace)
+			break
+		}
+
+		if (ID_NFEATURES(id) > 0) {
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		    call id_saveap (id)
+		}
+	    }
+	}
+
+	ID_IC(id) = ic
+	if (ic != ic1)
+	    call ic_closed (ic1)
+
+	call smw_close (MW(ID_SH(id)))
+	call imunmap (IM(ID_SH(id)))
+	call shdr_close (ID_SH(id))
+end
+
+
+# RI_IMAGE -- Reidentify an image.
+
+procedure ri_image (id, reference, image, crsearch, ans, logfd, nlogfd, pd)
+
+pointer	id			# ID pointer
+char	reference[ARB]		# Reference image
+char	image[ARB]		# Image to be reidentified
+double	crsearch		# Search radius
+char	ans[3]			# Interactive?
+int	logfd[ARB]		# Logfiles
+int	nlogfd			# Number of logfiles
+pointer	pd			# Plot file pointer
+
+bool	newaps			# Add new apertures not in reference?
+bool	override		# Override previous identifications?
+bool	verbose			# Verbose output?
+
+int	i, loghdr, id_dbcheck()
+double	shift, fit_shift, clgetd()
+pointer	sp, key, ic, ic1, stp, sid, stpmark
+pointer	sthead(), stnext(), stname(), stfind(), id_getap()
+bool	clgetb()
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_LINE, TY_CHAR)
+
+	# Open the image and return if there is an error.
+	call strcpy (image, ID_IMAGE(id), ID_LENSTRING)
+	iferr (call id_map (id)) {
+	    call erract (EA_WARN)
+	    return
+	}
+	if (ID_DT(id) != NULL)
+	    call dtunmap (ID_DT(id))
+
+	newaps = clgetb ("newaps")
+	override = clgetb ("override")
+	verbose = clgetb ("verbose")
+
+	ic = ID_IC(id)
+	if (ans[1] == 'N')
+	    ic1 = ic
+	else {
+	    call ic_open (ic1)
+	    call ic_copy (ic, ic1)
+	}
+
+	loghdr = 2
+	shift = clgetd ("shift")
+
+	# For MULTISPEC search the reference list of each aperture.  If
+	# a reference of the same aperture is not found and the newaps
+	# flag is set use the initial reference and then add the
+	# reidentification to the reference list.
+	# For NDSPEC apply each reference to the image.
+
+	stp = ID_STP(id)
+	call stmark (stp, stpmark)
+	if (SMW_FORMAT(MW(ID_SH(id))) == SMW_ES ||
+	    SMW_FORMAT(MW(ID_SH(id))) == SMW_MS) {
+	    for (i=1; i<=ID_MAXLINE(id,1); i=i+1) {
+		ID_AP(id,1) = Memi[ID_APS(id)+i-1]
+		ID_AP(id,2) = 1
+		sid = id_getap (id)
+		if (sid == NULL) {
+		    if (!newaps) {
+			if (verbose) {
+			    call printf (
+				"%s: Reference for aperture %d not found\n")
+				call pargstr (image)
+				call pargi (ID_AP(id,1))
+			}
+			next
+		    }
+		    if (crsearch != 0.)
+			ID_NFEATURES(id) = 0
+		}
+		ID_LINE(id,1) = i
+
+		if (i == 1 && ic != ic1)
+		    call ic_copy (ic, ic1)
+
+		if (!override)
+		    if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES)
+			next
+		
+		ID_IC(id) = ic1
+		call id_gdata (id)
+		iferr (call id_fitdata (id))
+		    ;
+
+		call ri_loghdr (id, reference, logfd, nlogfd, loghdr)
+		loghdr = 0
+
+		fit_shift = shift
+		call ri_reidentify (id, fit_shift, crsearch, ans, logfd,
+		    nlogfd, pd)
+
+		if (ID_NFEATURES(id) > 0) {
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		    if (sid == NULL && newaps) {
+			call id_saveap (id)
+			if (verbose) {
+			    call printf (
+				"%s: New reference for aperture %d\n")
+				call pargstr (image)
+				call pargi (ID_AP(id,1))
+			} 
+		    }
+		}
+		ID_IC(id) = ic
+	    }
+
+	} else {
+
+	    # Go through the stored reference solutions.
+	    # Because the symbol table might be changed in ri_reidentify
+	    # save the key to restore the symbol pointer.
+
+	    for (sid=sthead(stp); sid!=NULL; sid=stnext(stp,sid)) {
+		call strcpy (Memc[stname(stp,sid)], Memc[key], SZ_LINE)
+		call id_gid (id, sid)
+		if (i == 1 && ic != ic1)
+		    call ic_copy (ic, ic1)
+
+		if (!override)
+		    if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES)
+			next
+		
+		ID_IC(id) = ic1
+		call id_gdata (id)
+		iferr (call id_fitdata (id))
+		    ;
+
+		call ri_loghdr (id, reference, logfd, nlogfd, loghdr)
+		loghdr = 0
+
+		fit_shift = shift
+		call ri_reidentify (id, fit_shift, crsearch, ans, logfd,
+		    nlogfd, pd)
+
+		if (ID_NFEATURES(id) > 0)
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+		ID_IC(id) = ic
+		sid = stfind (stp, Memc[key])
+	    }
+	    if (sid == NULL)
+		ID_NFEATURES(id) = 0
+	}
+
+	ID_IC(id) = ic
+	if (ic != ic1)
+	    call ic_closed (ic1)
+	call stfree (stp, stpmark)
+	call smw_close (MW(ID_SH(id)))
+	call imunmap (IM(ID_SH(id)))
+	call shdr_close (ID_SH(id))
+	call sfree (sp)
+end
+
+
+# RI_REIDENTIFY -- Reidentify features using a reference image database entry.
+
+procedure ri_reidentify (id, fit_shift, crsearch, ans, logfd, nlogfd, pd)
+
+pointer	id			# ID pointer
+double	fit_shift		# Shift in fit coords (input and output)
+double	crsearch		# Search radius
+char	ans[3]			# Interactive?
+int	logfd[ARB]		# Logfiles
+int	nlogfd			# Number of logfiles
+pointer	pd			# Plot file pointer
+
+int	i, j, nfeatures1, nfeatures2, nfit, iden, mono, clgwrd()
+double	shift, pix_shift, z_shift
+double	clgetd(), id_fitpt(), fit_to_pix()
+double	id_shift(), id_shift1(), id_center(), id_rms()
+pointer	sp, str, pix, fit
+bool	clgetb()
+errchk	id_shift, id_shift1
+
+begin
+	call smark (sp)
+
+	# Add features or determine a shift.
+	nfeatures1 = ID_NFEATURES(id)
+	if (nfeatures1 == 0) {
+	    call salloc (str, SZ_LINE, TY_CHAR)
+	    ID_FTYPE(id) =
+		clgwrd ("identify.ftype", Memc[str], SZ_LINE, FTYPES)
+	    ID_FWIDTH(id) = clgetd ("identify.fwidth")
+	    if (crsearch != 0.)
+		shift = id_shift (id, crsearch, -0.05D0)
+	    else if (clgetb ("addfeatures")) {
+		call id_linelist (id)
+		shift = 0.
+	    }
+	} else if (IS_INDEFD(fit_shift)) {
+	    ID_FWIDTH(id) = FWIDTH(id,1)
+	    ID_FTYPE(id) = FTYPE(id,1)
+	    if (IS_INDEFD(crsearch))
+		shift = id_shift1 (id)
+	    else if (crsearch != 0.)
+		shift = id_shift (id, crsearch, -0.02D0)
+	    else
+		shift = 0.
+	} else
+	    shift = fit_shift
+
+	nfeatures1 = ID_NFEATURES(id)
+	if (nfeatures1 == 0)
+	    call error (0, "No features in reference")
+	call salloc (pix, nfeatures1, TY_DOUBLE)
+	call salloc (fit, nfeatures1, TY_DOUBLE)
+	call amovd (PIX(id,1), Memd[pix], nfeatures1)
+	call amovd (FIT(id,1), Memd[fit], nfeatures1)
+
+	# For each reference feature a shift is added to bring the pixel
+	# position near that for the image being identified and then the
+	# centering algorithm is used.  If the centering algorithm fails
+	# the feature is discarded.  A mean shift is computed for the
+	# features which have been reidentified.
+
+	do i = 1, ID_NFEATURES(id) {
+	    PIX(id,i) = fit_to_pix (id, FIT(id,i) + shift)
+	    PIX(id,i) = id_center (id, PIX(id,i), FWIDTH(id,i), FTYPE(id,i))
+	    if (!IS_INDEFD(PIX(id,i)))
+	        FIT(id,i) = id_fitpt (id, PIX(id,i))
+	}
+	for (i=1; i<ID_NFEATURES(id); i=i+1) {
+	    if (IS_INDEFD(PIX(id,i)))
+		next
+	    for (j=i+1; j<=ID_NFEATURES(id); j=j+1) {
+	        if (IS_INDEFD(PIX(id,j)))
+		    next
+		if (abs (PIX(id,i)-PIX(id,j)) < ID_MINSEP(id)) {
+		    if (abs (FIT(id,i)-USER(id,i)) < abs (FIT(id,j)-USER(id,j)))
+			PIX(id,j) = INDEFD
+		    else {
+			PIX(id,i) = INDEFD
+			break
+		    }
+		}
+	    }
+	}
+
+	pix_shift = 0.
+	fit_shift = 0.
+	z_shift = 0.
+	j = 0
+	do i = 1, ID_NFEATURES(id) {
+	    if (IS_INDEFD(PIX(id,i)))
+		next
+
+	    pix_shift = pix_shift + PIX(id,i) - Memd[pix+i-1]
+	    fit_shift = fit_shift + FIT(id,i) - Memd[fit+i-1]
+	    if (Memd[fit+i-1] != 0.)
+	        z_shift = z_shift + (FIT(id,i) - Memd[fit+i-1]) / Memd[fit+i-1]
+
+	    j = j + 1
+	    PIX(id,j) = PIX(id,i)
+	    FIT(id,j) = FIT(id,i)
+	    USER(id,j) = USER(id,i)
+	    WTS(id,j) = WTS(id,i)
+	    FWIDTH(id,j) = FWIDTH(id,i)
+	    FTYPE(id,j) = FTYPE(id,i)
+	}
+	ID_NFEATURES(id) = j
+		    
+	nfeatures2 = j
+	pix_shift = pix_shift / max (1, ID_NFEATURES(id))
+	fit_shift = fit_shift / max (1, ID_NFEATURES(id))
+	z_shift = z_shift / max (1, ID_NFEATURES(id))
+
+	# If refitting the coordinate function is requested and there is
+	# more than one feature and there is a previously defined
+	# coordinate function then refit.  Otherwise compute a coordinate
+	# shift.
+
+	mono = YES
+	if (ID_REFIT(id)==YES && ID_CV(id)!=NULL && ID_NFEATURES(id)>1) {
+	    if (clgetb("addfeatures") && abs(pix_shift) > 0.1*ID_NPTS(id)) {
+		call id_doshift (id, NO)
+		ID_NEWFEATURES(id) = YES
+	    } else
+		call id_dofit (id, NO)
+	} else
+	    call id_doshift (id, NO)
+	if (ID_NEWCV(id) == YES) {
+	    iferr (call id_fitdata (id))
+		mono = NO
+	    call id_fitfeatures (id)
+	}
+
+	if (clgetb ("addfeatures")) {
+	    ID_FWIDTH(id) = FWIDTH(id,1)
+	    ID_FTYPE(id) = FTYPE(id,1)
+	    call id_linelist (id)
+	    if (ID_NEWFEATURES(id) == YES) {
+		if (ID_REFIT(id) == YES && ID_CV(id) != NULL)
+	    	    call id_dofit (id, NO)
+		else
+		    call id_doshift (id, NO)
+		if (ID_NEWCV(id) == YES) {
+	    	    iferr (call id_fitdata (id))
+			mono = NO
+		    call id_fitfeatures (id)
+		}
+	    }
+	}
+
+	# Enter fitting interactively.
+	iden = NO
+	if ((ID_NFEATURES(id)>1) && (ID_CV(id)!=NULL)) {
+	    if (ans[1] != 'N') {
+	        if (ans[1] != 'Y') {
+		    nfit = 0
+		    for (j=1; j<=ID_NFEATURES(id); j=j+1)
+		        if (WTS(id,j) > 0.)
+			    nfit = nfit + 1
+	            call printf (
+		    "%s%s%23t%3d/%-3d %3d/%-3d %9.3g  %10.3g  %7.3g  %7.3g\n")
+			call pargstr (ID_IMAGE(id))
+			call pargstr (ID_SECTION(id))
+			call pargi (nfeatures2)
+			call pargi (nfeatures1)
+			call pargi (nfit)
+			call pargi (ID_NFEATURES(id))
+			call pargd (pix_shift)
+			call pargd (fit_shift)
+			call pargd (z_shift)
+			call pargd (id_rms(id))
+	            call flush (STDOUT)
+		    repeat {
+	                ifnoerr (i = clgwrd ("answer", ans, SZ_FNAME,
+			    "|no|yes|NO|YES|"))
+			    break
+		    }
+		    call clpstr ("answer", ans)
+		}
+	        switch (ans[1]) {
+	        case 'y', 'Y':
+		    mono = YES
+		    i = ID_REFIT(id)
+		    call reidentify (id)
+		    ID_REFIT(id) = i
+		    iden = YES
+		}
+		if (ans[1] != 'Y')
+		    call gdeactivate (ID_GP(id), 0)
+	    }
+	}
+
+	# Record log information if a log file descriptor is given.
+	for (i = 1; i <= nlogfd; i = i + 1) {
+	    if (ans[1] == 'n' && logfd[i] == STDOUT)
+		    next
+	    nfit = 0
+	    for (j=1; j<=ID_NFEATURES(id); j=j+1)
+		if (WTS(id,j) > 0.)
+		    nfit = nfit + 1
+	        call fprintf (logfd[i],
+		    "%s%s%23t%3d/%-3d %3d/%-3d %9.3g  %10.3g  %7.3g  %7.3g\n")
+		    call pargstr (ID_IMAGE(id))
+		    call pargstr (ID_SECTION(id))
+		    call pargi (nfeatures2)
+		    call pargi (nfeatures1)
+		    call pargi (nfit)
+		    call pargi (ID_NFEATURES(id))
+		    call pargd (pix_shift)
+		    call pargd (fit_shift)
+		    call pargd (z_shift)
+		    call pargd (id_rms(id))
+	    if (mono == NO)
+		call fprintf (logfd[i], "Non-monotonic dispersion function")
+	    call flush (logfd[i])
+	    if (logfd[i] == STDOUT)
+		iden = NO
+	}
+	# Print log if STDOUT is not used but if the IDENTIFY is done.
+	if (iden == YES) {
+	    call printf (
+		"%s%s%23t%3d/%-3d %3d/%-3d %9.3g  %10.3g  %7.3g  %7.3g\n")
+		call pargstr (ID_IMAGE(id))
+		call pargstr (ID_SECTION(id))
+		call pargi (nfeatures2)
+		call pargi (nfeatures1)
+		call pargi (nfit)
+		call pargi (ID_NFEATURES(id))
+		call pargd (pix_shift)
+		call pargd (fit_shift)
+		call pargd (z_shift)
+		call pargd (id_rms(id))
+	    if (mono == NO)
+		call printf ("Non-monotonic dispersion function")
+	    call flush (STDOUT)
+	}
+		
+	# Make log plot.
+	call ri_plot (id, pd)
+
+	call sfree (sp)
+end
+
+
+# RI_LOGHDR -- Print a log header in the log files.
+
+procedure ri_loghdr (id, reference, logfd, nlogfd, flag)
+
+pointer	id		# Identify structure
+char	reference[ARB]	# Reference image
+int	logfd[ARB]	# Log file descriptors
+int	nlogfd		# Number of log files
+int	flag		# Header type flag (1=banner, 2=Column labels, 3=Error)
+
+int	i
+pointer	str
+
+begin
+	for (i = 1; i <= nlogfd; i = i + 1) {
+	    switch (flag) {
+	    case 1:	# Print ID
+		call malloc (str, SZ_LINE, TY_CHAR)
+	        call sysid (Memc[str], SZ_LINE)
+	        call fprintf (logfd[i], "\nREIDENTIFY: %s\n")
+		    call pargstr (Memc[str])
+		call mfree (str, TY_CHAR)
+	    case 2:	# Print labels
+	        call fprintf (logfd[i],
+		    "  Reference image = %s, New image = %s, Refit = %b\n")
+		    call pargstr (reference)
+		    call pargstr (ID_IMAGE(id))
+		    call pargb (ID_REFIT(id) == YES)
+		call fprintf (logfd[i],
+		    "%20s  %7s %7s %9s  %10s  %7s  %7s\n")
+		    call pargstr ("Image Data")
+		    call pargstr ("Found")
+		    call pargstr ("Fit")
+		    call pargstr ("Pix Shift")
+		    call pargstr ("User Shift")
+		    call pargstr ("Z Shift")
+		    call pargstr ("RMS")
+	    case 3:	# Error
+		call fprintf (logfd[i], "    ** Too many features lost **\n")
+	    }
+	}
+end
+
+
+# RI_PLOT -- Plot residual graph of reidentified lines.
+
+procedure ri_plot (id, pd)
+
+pointer	id				# ID pointer
+pointer	pd				# GIO pointer
+
+int	i, j
+pointer	sp, str, x, y, gt, gt_init()
+
+begin
+	# Check if there is anything to plot.
+	if (pd == NULL || ID_NFEATURES(id) == 0)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (x, ID_NFEATURES(id), TY_REAL)
+	call salloc (y, ID_NFEATURES(id), TY_REAL)
+
+	# Set plot points.
+	j = 0
+	do i = 1, ID_NFEATURES(id) {
+	    if (IS_INDEFD(USER(id,i)))
+		break
+
+	    Memr[x+j] = USER(id,i)
+	    Memr[y+j] = FIT(id,i) - USER(id,i)
+	    j = j + 1
+	}
+
+	if (j == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Make the plot.
+	call sprintf (Memc[str], SZ_LINE, "Reidentify: %s")
+	    call pargstr (ID_IMAGE(id))
+	gt = gt_init ()
+	call gt_sets (gt, GTTYPE, "mark")
+	call gt_sets (gt, GTXLABEL, "user coordinates")
+	call gt_sets (gt, GTYLABEL, "residuals (fit - user)")
+	call gt_sets (gt, GTTITLE, Memc[str])
+	call gclear (pd)
+	call gascale (pd, Memr[x], j, 1)
+	call gascale (pd, Memr[y], j, 2)
+	call gt_swind (pd, gt)
+	call gt_labax (pd, gt)
+	call gt_plot (pd, gt, Memr[x], Memr[y], j)
+	call gt_free (gt)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/irsiids/addsets.par b/noao/onedspec/irsiids/addsets.par
new file mode 100644
index 00000000..1ad84e8b
--- /dev/null
+++ b/noao/onedspec/irsiids/addsets.par
@@ -0,0 +1,8 @@
+# ADDSETS parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
+subset,i,h,2,1,,Number of spectra to add together within string
+weighting,b,h,yes,,,Apply integration time weighting to calibrated data
diff --git a/noao/onedspec/irsiids/batchred.cl b/noao/onedspec/irsiids/batchred.cl
new file mode 100644
index 00000000..1bd5a3a3
--- /dev/null
+++ b/noao/onedspec/irsiids/batchred.cl
@@ -0,0 +1,168 @@
+#{ BATCHRED -- Script file to generate another script file
+#  which runs several ONEDSPEC tasks in an automated fashion.
+#
+#  Currently the following procedures are automated:
+#    1. STANDARD
+#    2. SENSFUNC
+#    3. BSWITCH
+#    4. CALIBRATE
+#    5. ADDSETS
+#
+
+{
+# Say hello to the guy on the other side of the screen and check batch file.
+print ("\n----B A T C H   I I D S / I R S   F I L E   G E N E R A T O R----\n")
+
+s2 = "process.cl"			# Batch file to be created.
+if (access (s2)) {
+    print ("A batch file already exists - ")
+    if (query)
+        delete (s2, verify=no)
+}
+
+# Initialize
+rt = input				# Root name for spectra
+ot = output				# Output root name
+ttl = ">>&'" + ttylog + "')\n"		# Log file for tty output
+
+out = rt
+s1 = ""
+st = ""
+sns = ""
+stat = ""
+print ("i = ", start_rec, >>s2)
+
+if (standard) {				# STANDARD?
+    print ("\n#---STANDARD---\n")
+    print ("\n#---STANDARD---\n", >>s2)
+
+    st = std				# STD file
+    if (access (st)) {
+	print (st, " - already exists")
+	if (query)
+            delete (st, verify=no)
+    }
+
+    # Loop over all stars
+    b1 = yes
+    while (b1) {
+        # Check that the last entry was different - otherwise end input
+	records = ""
+    	s3 = records
+    	if (s3 == "")
+    	    b1 = no
+        else {
+    	    print ("standard (input='",rt,"',output='",st,"',",>>s2)
+    	    print ("\trecords='",s3,"',",>>s2)
+    	    print ("\tstar_name='",star_name,"',beam_switch=yes,",>>s2)
+	    print ("\tsamestar=yes,apertures='',bandwidth=INDEF,",>>s2)
+	    print ("\tbandsep=INDEF,interact=no,",ttl,>>s2)
+        }
+    }
+
+    print ("")
+}
+
+
+if (sensfunc) {				# SENSFUNC?
+    print ("\n#---SENSFUNC---\n")
+    print ("\n#---SENSFUNC---\n", >>s2)
+
+    if (st == "")
+	st = std			# STD file
+    sns = sensitivity			# Sensitivity image
+    stat = stats			# Statistics file
+
+    print ("\nsensfunc (standards='",st,"',sensitivity='",sns,"',",>>s2)
+    print ("\tlogfile='",stat,"',apertures='',ignoreaps=no,",>>s2)
+    print ("\tfunction='",function,"',order=",order,",",>>s2)
+    print ("\tinteract=no,",ttl,>>s2)
+
+    print ("")
+}
+
+
+if (bswitch) {				# BSWITCH?
+    print ("\n#---BSWITCH---\n")
+    print ("\n#---BSWITCH---\n", >>s2)
+
+    # Save starting output record number
+    in = out
+    out = "b" // ot
+    wt = weight				# Weighting?
+    if (stat == "")
+	stat = stats			# Statistics file
+
+    # Accumulate records
+    print ("next_rec = i", >>s2)
+    b1 = yes
+    while (b1) {
+	records = ""
+        s3 = records
+        if (s3 == "")
+    	    b1 = no
+        else {
+	    print ("j = next_rec", >> s2)
+    	    print ("bswitch (input='",in,"',output='",out,"',",>>s2)
+    	    print ("\trecords='",s3,"',stats='",stat,"',",>>s2)
+    	    print ("\tweighting=",wt,",subset=",subset,",",>>s2)
+	    print ("\tstart_rec=j,",>>s2)
+    	    print ("\twave1=",wave1,",wave2=",wave2,",",ttl,>>s2)
+        }
+    }
+
+    # Output records
+    print ("j = next_rec", >>s2)
+    s1 = "str (i) // '-' // str(j-1)"
+    print ("s1 = ", s1, >>s2)
+
+    print ("")
+}
+
+if (calibrate) {			# CALIBRATE?
+    print ("\n#---CALIBRATE---\n")
+    print ("\n#---CALIBRATE---\n", >>s2)
+
+    in = out
+    out = "c" // ot
+    if (sns == "")
+        sns = sensitivity		# Sensivity file name
+
+    if (s1 == "") {
+	records = ""
+	s1 = records
+        print ("s1 = '", s1, "'", >>s2)
+    }
+
+    print ("calibrate (input='",in,"',output='",out,"',records=s1,",>>s2)
+    print ("\tignoreaps=no,",>>s2)
+    print ("\textinct=no,flux=yes,",>>s2)
+    print ("\tsensitivity='",sns,"',fnu=",fnu,",",ttl,>>s2)
+
+    print ("")
+}
+
+if (addsets) {				# ADDSETS?
+    print ("\n#---ADDSETS---\n")
+    print ("\n#---ADDSETS---\n", >>s2)
+
+    in = out
+    out = "a" // ot
+    if (s1 == "") {
+	records = ""
+	s1 = records
+        print ("s1 = '", s1, "'", >>s2)
+    }
+
+    print ("addsets (input='",in,"',output='",out,"',records=s1,",>>s2)
+    print ("\tstart_rec=i,subset=2,",ttl,>>s2)
+}
+
+# All done with generator.  Ask whether to execute it.
+print ("File generation complete - filename=",s2)
+if (proceed == no)			# Execute batch file?
+    bye
+}
+
+# Execute generated batch file
+process &
diff --git a/noao/onedspec/irsiids/batchred.par b/noao/onedspec/irsiids/batchred.par
new file mode 100644
index 00000000..dbb61b8c
--- /dev/null
+++ b/noao/onedspec/irsiids/batchred.par
@@ -0,0 +1,38 @@
+# BATCHRED -- Parameter file for batch reduction prep task
+
+input,s,a,,,,Input root name for spectra
+output,s,a,,,,Output root name for spectra
+start_rec,i,a,,0,9999,Starting record for output spectra
+ttylog,s,a,"ttylog",,,File name to contain a log of terminal output
+standard,b,a,yes,,,Generate commands for STANDARD
+sensfunc,b,a,yes,,,Generate commands for SENSFUNC
+bswitch,b,a,yes,,,Generate commands for BSWITCH
+calibrate,b,a,yes,,,Generate commands for CALIBRATE
+addsets,b,a,yes,,,Generate commands for ADDSETS
+
+std,s,a,"std",,,STANDARD and SENSFUNC standard star file
+star_name,s,q,,,,STANDARD star name
+stats,s,a,"stats",,,SENSFUNC and BSWITCH statistics file
+sensitivity,s,a,sens,,,SENSFUNC and CALIBRATE sensitivity spectra
+weight,b,a,no,,,BSWITCH weighted averages?
+function,s,h,"chebyshev",,,SENSFUNC fitting function
+order,i,h,7,1,,SENSFUNC fitting order
+
+records,s,q,,,,Record string to process
+proceed,b,q,yes,,,Begin batch processing
+query,b,q,no,,,Delete files(s)?
+
+fnu,b,h,no
+wave1,r,h,0.0
+wave2,r,h,0.0
+subset,i,h,32767
+
+rt,s,h
+ot,s,h
+in,s,h
+out,s,h
+stat,s,h
+sns,s,h
+st,s,h
+wt,b,h
+ttl,s,h
diff --git a/noao/onedspec/irsiids/bplot.cl b/noao/onedspec/irsiids/bplot.cl
new file mode 100644
index 00000000..53ce4cfc
--- /dev/null
+++ b/noao/onedspec/irsiids/bplot.cl
@@ -0,0 +1,35 @@
+# BPLOT -- Batch plotting of spectra with SPLOT
+
+procedure bplot (images, records)
+
+string	images				{prompt="List of images to plot"}
+string	records = ""			{prompt="List of records to plot"}
+string	graphics = "stdgraph"		{prompt="Graphics output device"}
+string	cursor   = "onedspec$gcurval.dat"	{prompt="Cursor file(s)\n"}
+
+struct	*ilist, *clist
+
+begin
+	int	line, ap
+	file	ifile, cfile, cur, image
+
+	ifile = mktemp ("bplot")
+	cfile = mktemp ("bplot")
+
+	names (images, records, >& ifile)
+	files (cursor, > cfile) 
+	cur = ""
+
+	ilist = ifile; clist = cfile
+	while (fscan (ilist, image) != EOF) {
+	    if ((cursor != "") && (fscan (clist, cur) == EOF)) {
+		clist = cfile
+		line = fscan (clist, cur)
+	    }
+	    splot (image, graphics=graphics, cursor=cur)
+	}
+	clist = ""; ilist = ""
+
+	delete (ifile, verify=no)
+	delete (cfile, verify=no)
+end
diff --git a/noao/onedspec/irsiids/bswitch.par b/noao/onedspec/irsiids/bswitch.par
new file mode 100644
index 00000000..3a8b7e8f
--- /dev/null
+++ b/noao/onedspec/irsiids/bswitch.par
@@ -0,0 +1,15 @@
+# BSWITCH parameter file
+
+input,s,a,,,,Input spectra file root name
+records,s,a,,,,Ranges of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
+stats,s,a,"stats",,,File to contain statistics summary
+ids_mode,b,h,yes,,,Are data in quadruples
+extinct,b,h,yes,,,Apply de-extinction correction
+weighting,b,h,no,,,Apply statistical weights during addition
+subset,i,h,32767,1,,Generate sums at subset intervals
+wave1,r,h,0.0,,,Starting wavelength to accumulate stats
+wave2,r,h,0.0,,,Ending wavelength to accumulate stats
+observatory,s,h,"kpno",,,Observatory of data
+extinction,s,h,)_.extinction,,,Extinction file
diff --git a/noao/onedspec/irsiids/coefs.par b/noao/onedspec/irsiids/coefs.par
new file mode 100644
index 00000000..dbabec65
--- /dev/null
+++ b/noao/onedspec/irsiids/coefs.par
@@ -0,0 +1,3 @@
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+database,s,h,"database",,,IDENTIFY database
diff --git a/noao/onedspec/irsiids/coincor.par b/noao/onedspec/irsiids/coincor.par
new file mode 100644
index 00000000..a0f2e0bb
--- /dev/null
+++ b/noao/onedspec/irsiids/coincor.par
@@ -0,0 +1,9 @@
+# COINCOR parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
+ccmode,s,h,)_.ccmode,,,Correction mode (photo|iids)
+deadtime,r,h,)_.deadtime,,,Deadtime in seconds
+power,r,h,)_.power,,,IIDS power law coefficient
diff --git a/noao/onedspec/irsiids/coincor.x b/noao/onedspec/irsiids/coincor.x
new file mode 100644
index 00000000..df572c02
--- /dev/null
+++ b/noao/onedspec/irsiids/coincor.x
@@ -0,0 +1,123 @@
+# Coincidence correction options
+define	CC_PHOTO_MODE	1	# Photometer style correction
+define	CC_IIDS_MODE	2	# IIDS style
+define	CC_POWER_MODE	3	# Power law correction
+define	CC_USER_MODE	4	# User supplies a function
+
+
+# COINCOR -- Coincidence correction for detector deadtime
+
+procedure coincor (input, output, npts, expo, coflag, dt, power, mode)
+
+real	input[npts]
+real	output[npts]
+real	expo
+int	coflag
+real	dt
+real	power
+int	mode, npts
+
+begin
+	# Check that exposure time is legit
+	if (expo <= 0.0)
+	    return
+
+	# Select the method by which the correction is performed
+	switch (mode) {
+	    case CC_PHOTO_MODE:
+	    	# Photoelectric photometer
+		call ccphoto (input, output, npts, expo, coflag, dt)
+
+	    case CC_IIDS_MODE:
+		# IIDS style correction
+		if (coflag == -1) {
+		    call cciids (input, output, npts, expo, coflag, dt)
+		    if (power != 1.0)
+		        call ccpower (output, output, npts, expo, coflag,
+			    power)
+		} else if ((coflag == 0) && (power != 1.0))
+		    call ccpower (input, output, npts, expo, coflag, power)
+		else
+		    call amovr (input, output, npts)
+
+	    case CC_USER_MODE:
+		# Provided by the user
+		call ccuser (input, output, npts, expo, coflag, dt)
+	}
+end
+
+# CCPHOTO -- Photoelectric photometer coincidence correction
+
+procedure ccphoto (input, output, npts, expo, coflag, dt)
+
+real	input[npts], output[npts], expo, dt
+int	coflag
+int	npts
+
+int	i
+
+begin
+	do i = 1, npts
+	    output[i] = input[i] * exp (input[i] * dt / expo)
+	coflag = 2
+end
+
+# CCUSER -- User supplied correction scheme
+
+procedure ccuser (input, output, npts, expo, coflag, dt)
+
+real	input[npts], output[npts], expo, dt
+int	coflag
+int	npts
+
+begin
+	coflag = 3
+end
+
+# CCIIDS -- IIDS style correction scheme
+# From Instrumentation for Astronomy III (SPIE Vol 172) p.88 by Larry Goad
+#
+# Note that only the "Detect" mode of observation is supported.
+
+procedure cciids (input, output, npts, expo, coflag, dt)
+
+real	input[npts], output[npts], expo, dt
+int	npts, coflag
+
+int	i
+real	tsweep, value
+
+begin
+	# Allow tsweep to be the deadtime so that a different value
+	# may be entered for other instruments.
+	# For the IIDS, tsweep = 1.424e-3 sec
+	tsweep = dt
+
+	do i = 1, npts {
+	    value = 1 - input[i] / expo * tsweep
+	    if ((value < 0.) || (value > 1.))
+		output[i] = input[i]
+	    else
+	        output[i] = -expo * log (value)/ tsweep
+	}
+	coflag = 0
+end
+
+# CCPOWER -- Power law correction
+# Power law correction from Massey and De Veny, NOAO Newsletter #6.
+
+procedure ccpower (input, output, npts, expo, coflag, power)
+
+real	input[npts], output[npts], expo, power
+int	npts, coflag
+
+int	i
+
+begin
+	do i = 1, npts
+	    if (input[i] > 0.)
+	        output[i] = expo * (input[i] / expo) ** power
+	    else
+		output[i] = input[i]
+	coflag = 1
+end
diff --git a/noao/onedspec/irsiids/conversion.x b/noao/onedspec/irsiids/conversion.x
new file mode 100644
index 00000000..9d0b8c15
--- /dev/null
+++ b/noao/onedspec/irsiids/conversion.x
@@ -0,0 +1,213 @@
+define	MAX_CHARS	256
+
+
+# ASCII_TO_EBCDIC --  Vector procedure to convert ASCII characters to EBCDIC
+# characters using the lookup table atoe.
+
+procedure ascii_to_ebcdic (inbuffer, outbuffer, nchars)
+
+char	inbuffer[ARB]
+short	outbuffer[ARB], atoe[MAX_CHARS]
+int	l, nchars
+
+data (atoe[l], l = 1, 8)      / 0b,   1b,   2b,   3b, '7' , '-' , '.' , '/'  / 
+data (atoe[l], l = 9, 16)     /26b,   5b, '%' ,  13b,  14b,  15b,  16b,  17b /
+data (atoe[l], l = 17, 24)    /20b,  21b,  22b,  23b, '<' , '=' , '2' , '&'  / 
+data (atoe[l], l = 25, 32)    /30b,  31b, '?' , '\'',  34b,  35b,  36b,  37b / 
+data (atoe[l], l = 33, 40)    /'@' , 'O' , 177b, '{' , '[' , 'l' , 'P' , '}' / 
+data (atoe[l], l = 41, 48)    /'M' , ']' , '\\' , 'N' , 'k' , '`' , 'K' , 'a'/ 
+data (atoe[l], l = 49, 56)    /360b, 361b, 362b, 363b, 364b, 365b, 366b, 367b/ 
+data (atoe[l], l = 57, 64)    /370b, 371b, 'z' , '^' , 'L' , '~' , 'n' , 'o' / 
+data (atoe[l], l = 65, 72)    /'|' , 301b, 302b, 303b, 304b, 305b, 306b, 307b/ 
+data (atoe[l], l = 73, 80)    /310b, 311b, 321b, 322b, 323b, 324b, 325b, 326b/ 
+data (atoe[l], l = 81, 88)    /327b, 330b, 331b, 342b, 343b, 344b, 345b, 346b/ 
+data (atoe[l], l = 89, 96)    /347b, 350b, 351b, 'J' , 340b, 'Z' , '_' , 'm' / 
+data (atoe[l], l = 97, 104)   /'y' , 201b, 202b, 203b, 204b, 205b, 206b, 207b/ 
+data (atoe[l], l = 105, 112)  /210b, 211b, 221b, 222b, 223b, 224b, 225b, 226b/ 
+data (atoe[l], l = 113, 120)  /227b, 230b, 231b, 242b, 243b, 244b, 245b, 246b/ 
+data (atoe[l], l = 121, 128)  /247b, 250b, 251b, 300b, 'j' , 320b, 241b,   7b/ 
+data (atoe[l], l = 129, 136)  /' ' , '!' , '"' , '#' , '$' ,  25b,   6b,  27b/ 
+data (atoe[l], l = 137, 144)  /'(' , ')' , '*' , '+' , ',' ,  11b,  12b,  33b/ 
+data (atoe[l], l = 145, 152)  /'0' , '1' ,  32b, '3' , '4' , '5' , '6' ,  10b/ 
+data (atoe[l], l = 153, 160)  /'8' , '9' , ':' , ';' ,   4b,  24b, '>' , 341b/ 
+data (atoe[l], l = 161, 168)  /'A' , 'B' , 'C' , 'D' , 'E' , 'F' , 'G' , 'H' / 
+data (atoe[l], l = 169, 176)  /'I' , 'Q' , 'R' , 'S' , 'T' , 'U' , 'V' , 'W' / 
+data (atoe[l], l = 177, 184)  /'X' , 'Y' , 'b' , 'c' , 'd' , 'e' , 'f' , 'g' / 
+data (atoe[l], l = 185, 192)  /'h' , 'i' , 'p' , 'q' , 'r' , 's' , 't' , 'u' / 
+data (atoe[l], l = 193, 200)  /'v' , 'w' , 'x' , 200b, 212b, 213b, 214b, 215b/ 
+data (atoe[l], l = 201, 208)  /216b, 217b, 220b, 232b, 233b, 234b, 235b, 236b/ 
+data (atoe[l], l = 209, 216)  /237b, 240b, 252b, 253b, 254b, 255b, 256b, 257b/ 
+data (atoe[l], l = 217, 224)  /260b, 261b, 262b, 263b, 264b, 265b, 266b, 267b/ 
+data (atoe[l], l = 225, 232)  /270b, 271b, 272b, 273b, 274b, 275b, 276b, 277b/ 
+data (atoe[l], l = 233, 240)  /312b, 313b, 314b, 315b, 316b, 317b, 332b, 333b/ 
+data (atoe[l], l = 241, 248)  /334b, 335b, 336b, 337b, 352b, 353b, 354b, 355b/ 
+data (atoe[l], l = 249, 256)  /356b, 357b, 372b, 373b, 374b, 375b, 376b, 377b/
+
+begin
+	call alutcs (inbuffer, outbuffer, nchars, atoe)
+end
+
+# EBCDIC_TO_ASCII -- Vector procedure to convert EBCDIC characters to ASCII
+# characters.
+
+procedure ebcdic_to_ascii (inbuffer, outbuffer, nchars)
+
+char	outbuffer[ARB]
+short	inbuffer[ARB], etoa[MAX_CHARS]
+int	l, nchars
+
+data (etoa[l], l = 1, 8)      / 0b,   1b,   2b,   3b, 234b,  11b, 206b, 177b / 
+data (etoa[l], l = 9, 16)     /227b, 215b, 216b,  13b,  14b,  15b,  16b,  17b/ 
+data (etoa[l], l = 17, 24)    /20b,  21b,  22b,  23b, 235b, 205b,  10b, 207b / 
+data (etoa[l], l = 25, 32)    /30b,  31b, 222b, 217b,  34b,  35b,  36b,  37b / 
+data (etoa[l], l = 33, 40)    /200b, 201b, 202b, 203b, 204b,  12b,  27b,  33b/ 
+data (etoa[l], l = 41, 48)    /210b, 211b, 212b, 213b, 214b,   5b,   6b,   7b/ 
+data (etoa[l], l = 49, 56)    /220b, 221b,  26b, 223b, 224b, 225b, 226b,   4b/ 
+data (etoa[l], l = 57, 64)    /230b, 231b, 232b, 233b,  24b,  25b, 236b,  32b/ 
+data (etoa[l], l = 65, 72)    /' ' , 240b, 241b, 242b, 243b, 244b, 245b, 246b/ 
+data (etoa[l], l = 73, 80)    /247b, 250b, '[' , '.' , '<' , '(' , '+' , '!' / 
+data (etoa[l], l = 81, 88)    /'&' , 251b, 252b, 253b, 254b, 255b, 256b, 257b/ 
+data (etoa[l], l = 89, 96)    /260b, 261b, ']' , '$' , '*' , ')' , ';' , '^' / 
+data (etoa[l], l = 97, 104)   /'-' , '/' , 262b, 263b, 264b, 265b, 266b, 267b/ 
+data (etoa[l], l = 105, 112)  /270b, 271b, '|' , ',' , '%' , '_' , '>' , '?' / 
+data (etoa[l], l = 113, 120)  /272b, 273b, 274b, 275b, 276b, 277b, 300b, 301b/ 
+data (etoa[l], l = 121, 128)  /302b, '`' , ':' , '#' , '@' , '\'' , '=' , '"'/ 
+data (etoa[l], l = 129, 136)  /303b, 'a' , 'b' , 'c' , 'd' , 'e' , 'f' , 'g' / 
+data (etoa[l], l = 137, 144)  /'h' , 'i' , 304b, 305b, 306b, 307b, 310b, 311b/ 
+data (etoa[l], l = 145, 152)  /312b, 'j' , 'k' , 'l' , 'm' , 'n' , 'o' , 'p' / 
+data (etoa[l], l = 153, 160)  /'q' , 'r' , 313b, 314b, 315b, 316b, 317b, 320b/ 
+data (etoa[l], l = 161, 168)  /321b, '~' , 's' , 't' , 'u' , 'v' , 'w' , 'x' / 
+data (etoa[l], l = 169, 176)  /'y' , 'z' , 322b, 323b, 324b, 325b, 326b, 327b/ 
+data (etoa[l], l = 177, 184)  /330b, 331b, 332b, 333b, 334b, 335b, 336b, 337b/ 
+data (etoa[l], l = 185, 192)  /340b, 341b, 342b, 343b, 344b, 345b, 346b, 347b/ 
+data (etoa[l], l = 193, 200)  /'{' , 'A' , 'B' , 'C' , 'D' , 'E' , 'F' , 'G' / 
+data (etoa[l], l = 201, 208)  /'H' , 'I' , 350b, 351b, 352b, 353b, 354b, 355b/ 
+data (etoa[l], l = 209, 216)  /'}' , 'J' , 'K' , 'L' , 'M' , 'N' , 'O' , 'P' / 
+data (etoa[l], l = 217, 224)  /'Q' , 'R' , 356b, 357b, 360b, 361b, 362b, 363b/ 
+data (etoa[l], l = 225, 232)  /'\\', 237b, 'S' , 'T' , 'U' , 'V' , 'W' , 'X' / 
+data (etoa[l], l = 233, 240)  /'Y' , 'Z' , 364b, 365b, 366b, 367b, 370b, 371b/ 
+data (etoa[l], l = 241, 248)  /'0' , '1' , '2' , '3' , '4' , '5' , '6' , '7' / 
+data (etoa[l], l = 249, 256)  /'8' , '9' , 372b, 373b, 374b, 375b, 376b, 377b/
+
+begin
+	call alutsc (inbuffer, outbuffer, nchars, etoa)
+end
+
+# IBM_TO_ASCII -- Vector procedure for converting IBM characters to ASCII
+# characters.
+
+procedure ibm_to_ascii (inbuffer, outbuffer, nchars)
+
+char	outbuffer[ARB]
+short	inbuffer[ARB], ibmtoa[MAX_CHARS]
+int	l, nchars
+
+data (ibmtoa[l], l = 1, 8)     /0b,   1b,   2b,   3b, 234b,  11b, 206b, 177b  /
+data (ibmtoa[l], l = 9, 16)    /1227b, 215b, 216b,  13b,  14b,  15b,  16b, 17b/ 
+data (ibmtoa[l], l = 17, 24)   /20b,  21b,  22b,  23b, 235b, 205b,  10b, 207b / 
+data (ibmtoa[l], l = 25, 32)   /30b,  31b, 222b, 217b,  34b,  35b,  36b,  37b / 
+data (ibmtoa[l], l = 33, 40)   /200b, 201b, 202b, 203b, 204b,  12b,  27b,  33b/ 
+data (ibmtoa[l], l = 41, 48)   /210b, 211b, 212b, 213b, 214b,   5b,   6b,   7b/ 
+data (ibmtoa[l], l = 49, 56)   /220b, 221b,  26b, 223b, 224b, 225b, 226b,   4b/ 
+data (ibmtoa[l], l = 57, 64)   /230b, 231b, 232b, 233b,  24b,  25b, 236b,  32b/ 
+data (ibmtoa[l], l = 65, 72)   /' ' , 240b, 241b, 242b, 243b, 244b, 245b, 246b/ 
+data (ibmtoa[l], l = 73, 80)   /247b, 250b,   0b, '.' , '<' , '(' , '+' , '|' / 
+data (ibmtoa[l], l = 81, 88)   /'&' , 251b, 252b, 253b, 254b, 255b, 256b, 257b/ 
+data (ibmtoa[l], l = 89, 96)   /260b, 261b, '!' , '$' , '*' , ')' , ';' , '^' / 
+data (ibmtoa[l], l = 97, 104)  /'-' , '/' , 262b, 263b, 264b, 265b, 266b, 267b/ 
+data (ibmtoa[l], l = 105,112)  /270b, 271b,   0b, ',' , '%' , '_' , '>' , '?' / 
+data (ibmtoa[l], l = 113, 120) /272b, 273b, 274b, 275b, 276b, 277b, 300b, 301b/ 
+data (ibmtoa[l], l = 121, 128) /302b, '`' , ':' , '#' , '@' , '\'' , '=' , '"'/ 
+data (ibmtoa[l], l = 129, 136) /303b, 'a' , 'b' , 'c' , 'd' , 'e' , 'f' , 'g' / 
+data (ibmtoa[l], l = 137, 144) /'h' , 'i' , 304b, 305b, 306b, 307b, 310b, 311b/ 
+data (ibmtoa[l], l = 145, 152) /312b, 'j' , 'k' , 'l' , 'm' , 'n' , 'o' , 'p' / 
+data (ibmtoa[l], l = 153, 160) /'q' , 'r' , 313b, 314b, 315b, 316b, 317b, 320b/ 
+data (ibmtoa[l], l = 161, 168) /321b, '~' , 's' , 't' , 'u' , 'v' , 'w' , 'x' / 
+data (ibmtoa[l], l = 169, 176) /'y' , 'z' , 322b, 323b, 324b, 325b, 326b, 327b/ 
+data (ibmtoa[l], l = 177, 184) /330b, 331b, 332b, 333b, 334b, 335b, 336b, 337b/ 
+data (ibmtoa[l], l = 185, 192) /340b, 341b, 342b, 343b, 344b, 345b, 346b, 347b/ 
+data (ibmtoa[l], l = 193, 200) /'{' , 'A' , 'B' , 'C' , 'D' , 'E' , 'F' , 'G' / 
+data (ibmtoa[l], l = 201, 208) /'H' , 'I' , 350b, 351b, 352b, 353b, 354b, 355b/ 
+data (ibmtoa[l], l = 209, 216) /'}' , 'J' , 'K' , 'L' , 'M' , 'N' , 'O' , 'P' / 
+data (ibmtoa[l], l = 217, 224) /'Q' , 'R' , 356b, 357b, 360b, 361b, 362b, 363b/ 
+data (ibmtoa[l], l = 225, 232) /'\\', 237b, 'S' , 'T' , 'U' , 'V' , 'W' , 'X' / 
+data (ibmtoa[l], l = 233, 240) /'Y' , 'Z' , 364b, 365b, 366b, 367b, 370b, 371b/ 
+data (ibmtoa[l], l = 241, 248) /'0' , '1' , '2' , '3' , '4' , '5' , '6' , '7' / 
+data (ibmtoa[l], l = 249, 256) /'8' , '9' , 372b, 373b, 374b, 375b, 376b, 377b /
+
+begin
+	call alutsc (inbuffer, outbuffer, nchars, ibmtoa)
+end
+
+# Vector procedure to convert ASCII characters to ibm characters
+
+procedure ascii_to_ibm (inbuffer, outbuffer, nchars)
+
+char	inbuffer[ARB]
+short	outbuffer[ARB], atoibm[MAX_CHARS]
+int	l, nchars
+
+data (atoibm[l], l = 1, 8)     /0b,   1b,   2b,   3b, '7' , '-' , '.' , '/'   / 
+data (atoibm[l], l = 9, 16)    /26b,   5b, '%' ,  13b,  14b,  15b,  16b,  17b / 
+data (atoibm[l], l = 17, 24)   /20b,  21b,  22b,  23b, '<' , '=' , '2' , '&'  / 
+data (atoibm[l], l = 25, 32)   /30b,  31b, '?' , '\'',  34b,  35b,  36b,  37b / 
+data (atoibm[l], l = 33, 40)   /'@' , 'Z' , 177b, '{' , '[' , 'l' , 'P' , '}' / 
+data (atoibm[l], l = 41, 48)   /'M' , ']' , '\\', 'N' , 'k' , '`' , 'K' , 'a' / 
+data (atoibm[l], l = 49, 56)   /360b, 361b, 362b, 363b, 364b, 365b, 366b, 367b/ 
+data (atoibm[l], l = 57, 64)   /370b, 371b, 'z' , '^' , 'L' , '~' , 'n' , 'o' / 
+data (atoibm[l], l = 65, 72)   /'|' , 301b, 302b, 303b, 304b, 305b, 306b, 307b/ 
+data (atoibm[l], l = 73, 80)   /310b, 311b, 321b, 322b, 323b, 324b, 325b, 326b/ 
+data (atoibm[l], l = 81, 88)   /327b, 330b, 331b, 342b, 343b, 344b, 345b, 346b/ 
+data (atoibm[l], l = 89, 96)   /347b, 350b, 351b, 255b, 340b, 275b, '_' , 'm' / 
+data (atoibm[l], l = 97, 104)  /'y' , 201b, 202b, 203b, 204b, 205b, 206b, 207b/ 
+data (atoibm[l], l = 105, 112) /210b, 211b, 221b, 222b, 223b, 224b, 225b, 226b/ 
+data (atoibm[l], l = 113, 120) /227b, 230b, 231b, 242b, 243b, 244b, 245b, 246b/ 
+data (atoibm[l], l = 121, 128) /247b, 250b, 251b, 300b, 'O' , 320b, 241b,   7b/ 
+data (atoibm[l], l = 129, 136) /' ' , '!' , '"' , '#' , '$' ,  25b,   6b,  27b/ 
+data (atoibm[l], l = 137, 144) /'(' , ')' , '*' , '+' , ',' ,  11b,  12b,  33b/ 
+data (atoibm[l], l = 145, 152) /'0' , '1' ,  32b, '3' , '4' , '5' , '6' ,  10b/ 
+data (atoibm[l], l = 153, 160) /'8' , '9' , ':' , ';' ,   4b,  24b, '>' , 341b/ 
+data (atoibm[l], l = 161, 168) /'A' , 'B' , 'C' , 'D' , 'E' , 'F' , 'G' , 'H' / 
+data (atoibm[l], l = 169, 176) /'I' , 'Q' , 'R' , 'S' , 'T' , 'U' , 'V' , 'W' / 
+data (atoibm[l], l = 177, 184) /'X' , 'Y' , 'b' , 'c' , 'd' , 'e' , 'f' , 'g' / 
+data (atoibm[l], l = 185, 192) /'h' , 'i' , 'p' , 'q' , 'r' , 's' , 't' , 'u' / 
+data (atoibm[l], l = 193, 200) /'v' , 'w' , 'x' , 200b, 212b, 213b, 214b, 215b/ 
+data (atoibm[l], l = 201, 208) /216b, 217b, 220b, 232b, 233b, 234b, 235b, 236b/ 
+data (atoibm[l], l = 209, 216) /237b, 240b, 252b, 253b, 254b, 255b, 256b, 257b/ 
+data (atoibm[l], l = 217, 224) /260b, 261b, 262b, 263b, 264b, 265b, 266b, 267b/ 
+data (atoibm[l], l = 225, 232) /270b, 271b, 272b, 273b, 274b, 275b, 276b, 277b/ 
+data (atoibm[l], l = 233, 240) /312b, 313b, 314b, 315b, 316b, 317b, 332b, 333b/ 
+data (atoibm[l], l = 241, 248) /334b, 335b, 336b, 337b, 352b, 353b, 354b, 355b/ 
+data (atoibm[l], l = 249, 256) /356b, 357b, 372b, 373b, 374b, 375b, 376b, 377b/
+
+begin
+	call alutcs (inbuffer, outbuffer, nchars, atoibm)
+end
+
+# ALUTSC -- Vector operator to map one set of characters to another using a
+# lookup table.
+
+procedure alutsc (a, b, nchars, lut)
+
+char	b[nchars]
+int	nchars, i
+short	a[nchars], lut[ARB]
+
+begin
+	do i = 1, nchars, 1
+	    b[i] = lut[a[i] + 1]
+end
+
+# ALUTCS -- Vector operator to map one set of characters to another using
+# a lookup table.
+
+procedure alutcs (a, b, nchars, lut)
+
+char	a[nchars]
+int	nchars, i
+short	b[nchars], lut[ARB]
+
+begin
+	do i = nchars, 1, -1
+	    b[i] = lut[a[i] + 1]
+end
diff --git a/noao/onedspec/irsiids/doc/addsets.hlp b/noao/onedspec/irsiids/doc/addsets.hlp
new file mode 100644
index 00000000..6ce49122
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/addsets.hlp
@@ -0,0 +1,66 @@
+.help addsets Feb85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+addsets - Add subsets of a string of spectra
+.ih
+USAGE
+addsets input records
+.ih
+PARAMETERS
+.ls input
+The root file name for the input spectra in the string.
+.le
+.ls records
+The range of spectra indicating the elements of the string.
+The names of the spectra will be formed by appending the range
+elements to the input root name.
+.le
+.ls output
+This is the root file name for the names of the spectra which will
+be created by the addset operation.
+.le
+.ls start_rec = 1
+The starting record number to be appended to the root name of the
+created spectra.
+.le
+.ls subset = 2
+The length of the substring of spectra which will be added together.
+For IIDS/IRS data which has been processed through BSWITCH, this
+parameter should be 2. This implies that spectra will be taken 
+2 at a time, added, and the sum written as a new spectrum.
+.le
+.ls weighting = yes
+If set to yes, an average of the substring of spectra is generated
+(if flux calibrated) weighted by the integration times of the
+individual spectra. If set to no, a simple average is generated.
+If not flux calibrated, this parameter has no effect - a simple
+sum is generated.
+.le
+.ih
+DESCRIPTION
+Every "subset" group of spectra will be accumulated and the sum will be
+written as a new spectrum. For example, if the input string contains
+100 spectra, and subset=2, then 50 new spectra will be created. Each
+new spectrum will be the sum of the consecutive pairs in the original string.
+
+If there are insufficient spectra to complete a subset accumulation,
+the sum is written out anyway and a warning printed. For example,
+if the input string contains 23 spectra, and subset=4, there will be
+6 new spectra created, but the last one will be based on only 3 spectra.
+
+Subset may be set to 1 to allow a copy operation although this is not
+a very efficient way to do so.
+.ih
+EXAMPLES
+The following three examples are those described above.
+
+.nf
+	cl> addsets nite1 2001-2100
+	cl> addsets nite1 2001-2023 subset=4
+	cl> addsets nite1 2001-2010 subset=1 output=nite2 \
+	>>> start_rec=2001
+.fi
+.ih
+SEE ALSO
+bswitch
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/batchred.hlp b/noao/onedspec/irsiids/doc/batchred.hlp
new file mode 100644
index 00000000..9301f8b0
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/batchred.hlp
@@ -0,0 +1,145 @@
+.help batchred Feb85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+batchred - Automated processing of IIDS/IRS spectra
+.ih
+USAGE
+batchred
+.ih
+PARAMETERS
+This script task has many parameters, but most are used as
+variables internal to the task and are not user parameters.
+There are 5 parameters having similar purposes: standard,
+sensfunc, bswitch, calibrate, and addsets. Each corresponds
+to the ONEDSPEC task of the same name and BATCHRED will generate
+the commands necessary to invoke those tasks if the associated
+parameter is set to yes (the default in all cases).
+
+.ls standard = yes
+.le
+.ls sensfunc = yes
+.le
+.ls bswitch = yes
+.le
+.ls calibrate = yes
+.le
+.ls addsets = yes
+.le
+.ls fnu = no
+This parameter is identical to the fnu parameter for CALIBRATE.
+.le
+.ls wave1 = 0.0
+This parameter is identical to the wave1 parameter for BSWITCH.
+.le
+.ls wave2 = 0.0
+This parameter is identical to the wave2 parameter for BSWITCH.
+.le
+.ls subset = 32767
+This parameter is identical to the subset parameter for BSWITCH.
+.le
+.ih
+DESCRIPTION
+Through a question and answer session, a series of commands to
+ONEDSPEC is generated which are then processed as a batch job
+to reduce "typical" spectra from the IIDS and IRS spectrographs.
+
+By setting the appropriate hidden parameters, the user may
+"turn off" command generation for any of the possible tasks.
+
+A script task is generated having the name "process.cl" which is
+submitted to the CL as the final command of BATCHRED.
+All terminal output which would normally appear during the course
+of running each of the individual tasks is redirected to a log file
+(default=ttylog).
+
+After the script has been generated, the user may suppress running
+the processing task. The script file remains on disk so that subsequent
+cases may be appended, such as when
+several independent runs of data are to be processed in one
+stream (e.g. several nights of data, each to be reduced separately).
+
+The questions which are asked are described below:
+
+"Root name for spectra file names:" This is the input root file name
+for all spectra which will be run through STANDARD and BSWITCH.
+
+"Root name for spectra to be created:" This is the output root file
+name which all newly created spectra will use. It is also the
+input file name for tasks CALIBRATE and ADDSETS since these tasks
+operate on spectra created by BSWITCH.
+
+"Starting record number for spectra to be created:" All created spectra
+will have a suffix number starting with this value and incremented
+by one for each new spectrum created.
+
+"File name to contain statistics information:" This file will contain
+informative output from SENSFUNC and BSWITCH. (default=stats)
+
+"File name to contain a log of terminal output:" All tasks talk back
+to let you know how things are proceding. The backtalk is saved
+in this file. (default=ttylog)
+
+"File name for output from STANDARD and input to SENSFUNC:" Just
+what it says. (default=std)
+
+"Record string to process:" The spectra are assumed to be representable
+by strings (try "help ranges" for details on the formats allowed).
+Both STANDARD and BSWITCH expect ranges of spectral record numbers
+which are appended to the root given in answer to the first question
+above. This question is asked repeatedly so that you can enter as
+many strings of spectra as you like and is ended by hitting return
+without entering a value. There is a short delay after entering
+each string of records while a check is made to verify that all
+your spectra actually exist.
+
+"Standard star name:" For each record string STANDARD expects
+the name of the standard star observed, but it must be given in
+a manner acceptable to STANDARD. (see STANDARD and LCALIB for
+more details).
+
+"Use weighted averages:" If answered yes, then SENSFUNC and BSWITCH
+will use their weighted averaging schemes.
+
+"Apply magnitude fudging:" If answered yes, then SENSFUNC will 
+use its "fudge" option. (see SENSFUNC)
+
+"Solve for grey additive extinction constant:" If answered yes, then
+SENSFUNC will solve for this value.
+
+"File name for sensitivity image file:" This will be the root name
+for the output sensitivity spectra from SENSFUNC.
+
+At anytime during the processing phase, you can inquire about the
+progress by listing the latest contents of the file "ttylog"
+either by "type ttylog" or by "tail ttylog". The latter command
+lists the last 12 lines of the file.
+
+Be sure to have all your record strings, standard star names,
+and options well planned and written down so that you can enter
+the answers correctly. The batch reductions are not overly
+tolerant of incorrect entries although some preliminary checks
+are performed during the entry process.
+
+.ih
+EXAMPLES
+
+The following invokes the batch reductions using all task options;
+
+	cl> batchred
+
+The following inhibits the STANDARD and SENSFUNC tasks which must have
+been run previously. This is equivalent to the IPPS "autoreduce":
+
+	cl> batchred standard- sensfunc-
+.ih
+BUGS
+If you make an error while entering the requested information, there
+is no way to effect repairs other than to (1) start all over, or (2) edit
+the generated script file "process.cl" using the system editor.
+
+If a task encounters an irrecoverable error, the background job
+hangs until you kill it using "kill N" where N is the job number.
+.ih
+SEE ALSO
+mkscript, standard, sensfunc, bswitch, calibrate, addsets
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/bswitch.hlp b/noao/onedspec/irsiids/doc/bswitch.hlp
new file mode 100644
index 00000000..a50647b4
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/bswitch.hlp
@@ -0,0 +1,228 @@
+.help bswitch Sep87 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+bswitch - generate sky-subtracted accumulated spectra
+.ih
+USAGE
+bswitch input records
+.ih
+PARAMETERS
+.ls input
+The root name for the input spectra to be beam-switched.
+.le
+.ls records
+The range of spectra to be included in the beam-switch operation.
+Each range item will be appended to the root name to form an image
+name. For example, if "input" is "nite1" and records is "1011-1018",
+then spectra nite1.1011, nite.1012 ... nite1.1018 will be included.
+.le
+.ls output
+New spectra are created by the beam-switch operation. This parameter
+specifies the root name to be used for the created spectra.
+.le
+.ls start_rec = 1
+Each new spectrum created has "output" as its root name and a trailing
+number appended. The number begins with start_rec and is incremented
+for each new spectrum. For example, if "output" is given as "nite1b"
+and start_rec is given as 1001, then new spectra will be created as
+nite1b.1001, nite1b.1002 ...
+.le
+.ls stats = "stats"
+A file by this name will have statistical data appended to it, or created
+if necessary. If a null file name is given (""), no statistical output
+is given. For each aperture, a listing of countrates for each
+observation is given relative to the observation with the highest rate.
+.le
+.ls ids_mode = yes
+If the data are taken under the usual IIDS "beam-switch" mode, this
+parameter should be set to yes so that accumulations will be performed
+in pairs. But if the data are taken where there is no sky observation
+or different numbers of sky observations, ids_mode should be set to no.
+If weighting is in effect, ids_mode=yes implies weighting of the
+object-sky sum; if ids_mode=no, then weighting is applied to the
+object and sky independently because then there is no guarantee that
+an object and sky observation are related.
+.le
+.ls extinct = yes
+If set to yes, a correction for atmospheric extinction is applied.
+The image header must have either a valid entry for AIRMASS or
+for hour angle (or right ascension and sidereal time) and declination.
+.le
+.ls weighting = no
+If set to yes, the entire spectrum or a specified region will be used
+to obtain a countrate indicative of the statistical weight to be
+applied to the spectrum during the accumulations.
+.le
+.ls subset = 32767
+A subset value larger than the number of independent spectra to be
+added indicates that the operation is to produce a single spectrum
+for each aperture regardless of how many input spectra are entered.
+If subset is a smaller number, say 4, then the accumulations
+are written out after every 4 spectra and then re-initialized to zero
+for the next 4.
+.le
+.ls wave1 = 0.0
+If weighting=yes, this parameter indicates the starting point in the
+spectrum for the countrate to be assessed. For emission-line objects,
+this is particularly useful because the regime of information is then
+confined to a narrow spectral region rather than the entire spectrum.
+Defaults to the beginning of the spectrum.
+.le
+.ls wave2 = 0.0
+This provides the ending wavelength for the countrate determination.
+Defaults to the endpoint of the spectrum.
+.le
+.ls observatory = "observatory"
+Observatory at which the spectra were obtained if
+not specified in the image header by the keyword OBSERVAT.  The
+observatory may be one of the observatories in the observatory
+database, "observatory" to select the observatory defined by the
+environment variable "observatory" or the task \fBobservatory\fR, or
+"obspars" to select the current parameters set in the \fBobservatory\fR
+task.  See help for \fBobservatory\fR for additional information.
+.le
+.ls extinction = ")_.extinction"
+The the name of the file containing extinction values.
+Required if extinct=yes.
+.le
+.ih
+DESCRIPTION
+Data from multiaperture spectrographs are summed according to
+aperture number and sky subtracted if sky observations are available.
+Data for up to 50 apertures may be simultaneously accumulated.
+The accumulated spectra are written to new images. 
+
+The exposure times for each observation may be different. All
+internal computations are performed in terms of count rates,
+and converted back to counts (for statistical analysis) prior to writing
+the new image. Therefore, the time on the sky and object may
+be different as well. When these extensions to the normal
+mode are required, the flag ids_mode must be set to no.
+Then object and sky accumulations are performed totally
+independently and a difference is derived at the conclusion
+of the operation.
+
+If ids_mode is set to yes, then the usual IIDS/IRS "beam-switch"
+observing mode is assumed. This implies that an equal number of
+sky and object spectra are obtained through each aperture
+after 2N spectra have been accumulated, where N is the number
+of instrument apertures (2 for the IIDS/IRS). It is also assumed
+that the object and sky exposure times are equal for each aperture.
+Note that the "nebular" mode (where all instrument apertures
+point at an extended object simultaneously, and then all apertures
+point at sky simultaneously) is an acceptable form for
+beam-switched data in ids_mode.
+
+The accumulations are optionally weighted by the countrate
+over a region of the spectrum to improve the statistics during
+variable conditions. The user may specify the region of spectrum
+by wavelength. In ids_mode, the statistics are obtained from
+object-sky differences; otherwise, the statistics are performed
+on object+sky and sky spectra separately.
+
+The spectra may be extinction corrected if this has not already
+been performed.
+In order to perform either the extinction correction or the
+weighting process, the spectra must have been placed on a linear
+wavelength scale (or linear in the base 10 logarithm).
+
+Strings of spectra are  accumulated to produce a single
+summed spectrum for each observing aperture. But in some cases
+it is desirable to produce summed spectra from subsets of the
+entire string to evaluate the presence of variations either due
+to observing conditions or due to the physical nature of the
+object. A subset parameter may be set to the frequency at which
+spectra are to be summed.
+
+In order that the processing occur with minimal user interaction,
+elements from the extended image header are used to direct the
+flow of operation and to obtain key observing parameters.
+The required parameters are: object/sky flag (OFLAG=1/0), exposure
+time in seconds (ITM), beam (that is, aperture) number (BEAM-NUM), airmass (AIRMASS)
+or alternatively hour angle (HA) and declination (DEC), or
+right ascension (RA), sidereal time (ST), declination (DEC), and the
+observatory (OBSERVAT),
+starting wavelength (W0), and wavelength increment per channel (WPC),
+where the names in parenthesis are the expected keywords in the
+header.  If the observatory is not specified in the image the
+observatory parameter is used.  See \fBobservatory\fR for further
+details on the observatory database.
+
+The following header flags are used as well: DC_FLAG
+for dispersion corrected data (must=0), BS_FLAG for beam-switching
+(must not be 1 which indicates the operation was already done),
+EX_FLAG for extinction correction (if = 0 extinction is assumed already
+done).  
+
+The headers may be listed with the IMHEADER task, setting
+the parameter "long" = yes. The values for the parameters follow 
+the rules used for IIDS and IRS data.
+
+After the beam-switch operation, the newly created spectra will
+have header elements taken from the last object spectrum.
+A few parameters will be updated to reflect the operation
+(e.g. integration time, processing flags).
+
+.ih
+EXAMPLES
+The following example will accumulate a series of 16 spectra obtained
+in the normal beam-switched mode and create two new extinction corrected
+spectra having names nite1bs.1 and nite1bs.2:
+
+	cl> bswitch nite1 1011-1026 nite1bs 1
+
+The following example performs the same functions but accumulates the data
+to produce 8 new spectra representing the individual object-sky pairs:
+
+	cl> bswitch nite1 1011-1026 nite1bs 1 subset=4
+
+The following example produces an extinction corrected spectrum for every
+input spectrum. Note that ids_mode is set to off to generate separate object and
+sky sums, and subset is set to 2 so that every pair of spectra (one object and
+one sky) are written out as two new spectra:
+
+	cl> bswitch nite1 1011-1026 nite1bs 1 subset=2 ids_mode-
+
+The next example produces a pair of spectra for each of 3 independent
+objects observed, provided that each was observed for the same number
+of observations (16 in this case).
+
+.nf
+	cl> bswitch nite1 1011-1026,1051-1066,1081-1096 nite1bs 1 \
+	>>> subset=16
+.fi
+
+The next example shows how to use the weighting parameters where
+the indicative flux is derived from the region around the emission-line
+of 5007A.
+
+.nf
+	cl> bswitch nite1 1011-1026 nite1bs 1 weighting- \
+	>>> wave1=4990, wave2=5020
+.fi
+.ih
+TIME REQUIREMENTS
+The principle time expenditure goes toward extinction correcting the
+data. For IIDS type spectra (length=1024 pixels), approximately 30 cpu
+seconds are required to beam-switch a series of 16 spectra.
+.ih
+BUGS
+The number of apertures is restricted to 50 and must be labeled
+between 0 and 49 in the image header (the IIDS uses 0 and 1).
+
+Until an image header editor is available, BSWITCH 
+can be applied only to data with properly prepared headers
+such as IIDS/IRS data read by RIDSMTN, RIDSFILE and some data via RFITS.
+
+When used to perform the function of extinction correction only (the
+third example above), the statistics file fails to note the output
+image name for the sky spectrum.
+
+The data must be on a linear wavelength scale.
+The starting wavelength, W0, and a wavelength
+per channel, WPC, are required header information, and the DC_FLAG
+must be set to 0.
+.ih
+SEE ALSO
+observatory, sensfunc, imheader, lcalib, ridsmtn, ridsfile, rfits
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/coefs.hlp b/noao/onedspec/irsiids/doc/coefs.hlp
new file mode 100644
index 00000000..777933bc
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/coefs.hlp
@@ -0,0 +1,57 @@
+.help coefs May85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+coefs -- Extract dispersion coefs from mtn HeNeAr headers
+.ih
+USAGE
+coefs input records database
+.ih
+PARAMETERS
+.ls input
+The input image root name for the spectral images containing the
+dispersion coefficients.
+.le
+.ls records
+The range of records for which the root name applies.
+.le
+.ls database
+The database file name which will contain the coefficients.
+.le
+.ih
+DESCRIPTION
+The spectra specified by the combination of the root name
+and the records are scanned for the presence of dispersion
+coefficients. If present, the coefficients and necessary
+information are written to the file indicated by the database
+parameter. This file an then be used by the linearization
+program DISPCOR to correct any spectra for which the
+database is appropriate.
+
+Each invocation of COEFS appends to the database file, or
+creates a new file if necessary.
+
+The following assumptions are made concerning the coefficients,
+which are always correct for IIDS and IRS mountain reduced
+data at Kitt Peak.
+.ls  5 (1)
+The coefficients represent Legendre polynomials.
+.le
+.ls (2)
+The coefficients apply to pixels 1 through 1024 in the original data.
+.le
+.ih
+EXAMPLES
+The following example reads the coefficients from the headers
+for nite1 arc spectra taken near the beginning and end of the
+night and creates a database file called nite1.db:
+
+	cl> coefs nite1 3-4,201-202 nite1.db
+
+.ih
+TIME REQUIREMENTS
+Approximately 1 second per spectrum is required. This is primarily
+overhead due to file access.
+.ih
+SEE ALSO
+dispcor, identify
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/coincor.hlp b/noao/onedspec/irsiids/doc/coincor.hlp
new file mode 100644
index 00000000..74e002f3
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/coincor.hlp
@@ -0,0 +1,101 @@
+.help coincor Feb87 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+coincor -- Correct detector count rates
+.ih
+USAGE
+coincor input records
+.ih
+PARAMETERS
+.ls input
+The root file name of the input spectra.
+.le
+.ls records
+The range of spectra.
+The names of the spectra will be formed by appending the range
+elements to the input root name.
+.le
+.ls output
+This is the root file name for the corrected spectra.  If no root name
+is specified (specified with the null string "") then the operation
+is done in place.
+.le
+.ls start_rec = 1
+The starting record number to be appended to the root name of the
+created spectra.
+.le
+.ls ccmode = )_.ccmode
+The mode used to model the detector count rate corrections.
+In the following C(obs) is the observed count rate and C(cor) is the
+corrected count rate.
+.ls "photo"
+Photoelectric photometer with discriminator mode.  The count rate
+correction is
+
+    C(cor) = C(obs) * exp (C(obs) * deadtime)
+    
+where the parameter \fIdeadtime\fR is the representative deadtime in seconds.
+.le
+.ls "iids"
+IIDS correction given by
+
+    C(cor) = (-ln(1-C(obs)*deadtime)/deadtime)**power
+
+where \fBdeadtime\fR is a parameter related to the sweep time used to
+correct for coincidence losses and \fBpower\fR is a power law coefficient.
+.le
+.le
+.ls deadtime = )_.deadtime
+For the "photo" mode this parameter is the period, in seconds, during
+which no counts can be registered by the detector.  Note that this is
+based on a per pixel basis.  So if the discriminator dead period is of
+order 50 nanoseconds and 2000 pixels are observed per readout, the
+effective deadtime is about 10E-4 seconds.  For the "iids" mode this
+parameter defines the sweep time correction and has a value of 1.424E-3
+seconds.
+.le
+.ls power = )_.power
+The IIDS power law coefficient.  The standard value is 0.975.
+.le
+.ih
+DESCRIPTION
+The input spectra are corrected for detector count rate errors.  If no
+output root name is given then the operation is done in place.  The type
+of correction is specified by the parameter \fIccmode\fR.  The available
+modes are for a general photomultiplier with discriminator coincidence
+correction, and the NOAO IIDS.  The parameters for these modes are
+\fIdeadtime\fR and \fIpower\fR.  The exposure time, in seconds, is a
+required image header parameter (keyword = EXPOSURE).
+
+The default mode is for the NOAO IIDS.  The IIDS correction includes a
+power law correction for a nonlinear effect in the IIDS image tube chain
+which is not included by the mountain reduction software at the telescope.
+If the spectra have been coincidence corrected at the telescope
+then only the nonlinear power law correction is applied.
+
+The coincidence correction flag may take the values -1 for no correction,
+0 for the IIDS correction with \fIpower\fR = 1 (the correction
+applied by the mountain reduction software), 1 for the full IIDS
+correction, and 2 for the photomuliplier mode correction.
+.ih
+EXAMPLES
+The following example corrects a series of IIDS spectra:
+
+	cl> coincor nite1 1-250 output=nite1cc start_rec=1
+
+The following example corrects a series of spectra from the
+Lick ITS:
+
+.nf
+	cl> coincor its 1-250 output=itscc start=1 ccmode=photo \
+	>>> deadtime=2.4E-4 power=1
+.fi
+.ih
+TIME REQUIREMENTS
+\fBCoincor\fR requires approximately 1 second per spectrum of length 1024.
+.ih
+SEE ALSO
+.nf
+The \fBimred.iids\fR package is designed for reducing NOAO IIDS spectra.
+.fi
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/extinct.hlp b/noao/onedspec/irsiids/doc/extinct.hlp
new file mode 100644
index 00000000..66aca3d6
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/extinct.hlp
@@ -0,0 +1,49 @@
+.help extinct Apr85 noao.onedspec
+.ih
+NAME
+extinct -- Correct spectra for atmospheric extinction
+.ih
+USAGE
+extinct root records output
+.ih
+PARAMETERS
+.ls root
+The root name for the input spectra to be corrected.
+.le
+.ls records
+The range of spectra to be included in the extinction operation.
+.le
+.ls output
+The root name for the output corrected spectra
+.le
+.ls start_rec
+The starting record number for the output corrected spectra.
+.le
+.ls nr_aps = 2
+The number of instrument apertures for this data set.
+.le
+.ih
+DESCRIPTION
+The input spectra are corrected for atmospheric extinction. 
+EXTINCT redirects the spectra through the task BSWITCH so all
+procedures are identical to those described for that task.
+
+Because BSWITCH attempts to perform a beam-switch operation
+unless the subset parameter is equal to the number of
+instrument apertures (in which case beam-switching degenerates
+to a copy operation), the hidden parameter nr_aps should be set
+appropriately to the instrument. For IIDS and IRS data, this
+is 2.
+.ih
+EXAMPLES
+
+	cl> extinct  nite1 1001-1032 nite1ex
+.ih
+BUGS
+The input string of spectra must be ordered so that only
+one spectrum from each aperture is present among substrings
+of length nr_aps.
+.ih
+SEE ALSO
+bswitch
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/flatdiv.hlp b/noao/onedspec/irsiids/doc/flatdiv.hlp
new file mode 100644
index 00000000..e6e8c22e
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/flatdiv.hlp
@@ -0,0 +1,94 @@
+.help flatdiv Dec86 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+flatdiv -- Divide spectra by flat field spectra
+.ih
+USAGE
+flatdiv input records
+.ih
+PARAMETERS
+.ls input
+The root file name for the input records to be divided.
+.le
+.ls records
+The range of spectra to be included in the divide operation.
+Each range item will be appended to the root name to form an
+image file name.
+.le
+.ls output
+New spectra are created by the flatdiv operation. This parameter
+specifies the root name to be used for the created spectra.
+.le
+.ls start_rec
+Each new spectrum created as "output" has its root name and a 
+trailing number appended starting with "start_rec". Subsequent
+output images will have an incremented trailing number.
+Note that even if an output image is not created because the input
+image has already been flattened or the input image is not found the
+output record number is still incremented.
+.le
+.ls flat_file
+The root name for the sensitivity spectra as produced by FLATFIT.
+Normally with multi-aperture instruments, FLATFIT will produce a
+spectrum appropriate to each aperture and the file name will have
+"flat_file" as the file name root and the aperture number appended.
+.le
+.ls coincor = )_.coincor
+If set to yes, coincidence correction is applied to the data during
+the division, and the following three parameters are required.
+For more about this correction see \fBcoincor\fR.
+.ls ccmode = )_.ccmode
+The mode by which the coincidence correction is to be performed.
+This may be "iids" or "photo".
+.le
+.ls deadtime = )_.deadtime
+The detector deadtime in seconds.
+.le
+.ls power = )_.power
+Power law IIDS non-linear correction exponent.
+.le
+.le
+.ih
+DESCRIPTION
+The input spectra are divided by the flat fields which are
+represented by spectra produced by FLATFIT.
+
+To avoid possible division by zero, any zeroes in the flat field
+spectra generated by FLATFIT are replaced by 1.0.
+
+The input spectra may optionally be corrected for coincidence losses.
+
+If the input and output spectra (after appending the record numbers) are
+the same then the division is performed in-place; i.e. the flattened spectra
+replace the original input spectra.
+Note that even if an output image is not created because the input
+image has already been flattened or the input image is not found the
+output record number is still incremented.  This is to insure that if
+in-place division is desired that the input and output names remain
+matched.
+.ih
+EXAMPLES
+The following example divides a series of spectra to produce 20 new
+spectra having names nite1.1221 ... nite1.1240.
+
+	cl> flatdiv nite1 1201-1220 nite1 1221
+
+The same spectra as above are simultaneously corrected for
+coincidence losses.
+
+	cl> flatdiv nite1 1201-1220 nite1 1221 coincor=yes
+
+The flattened spectra replace the unflattened spectra.
+
+	cl> flatdiv nite1 1201-1220 nite1 1201
+
+Note that the input record numbers must be contiguous and the starting
+output record number must be the same as the first input record number.
+.ih
+TIME REQUIREMENTS
+Approximately 1 second is required to correct a spectrum of length
+1024 points.
+.ih
+SEE ALSO
+coincor, flatfit
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/flatfit.hlp b/noao/onedspec/irsiids/doc/flatfit.hlp
new file mode 100644
index 00000000..af84cb3c
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/flatfit.hlp
@@ -0,0 +1,188 @@
+.help flatfit Dec86 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+flatfit -- Sum and normalize flat field spectra
+.ih
+USAGE
+flatfit root records
+.ih
+PARAMETERS
+.ls root
+The root file name for the input names of the flat field
+spectra to be accumulated and fit for normalization.
+.le
+.ls records
+The range of spectra indicating the elements of the string.
+The names of the spectra will be formed by appending the range
+elements to the input root name.
+.le
+.ls output
+This is the root file name for the names of the spectra which will
+be created during normalization. The aperture number for the observation
+will be appended to the root in form "root.nnnn" where nnnn is the aperture
+number with leading 0's.
+.le
+.ls function = "chebyshev"
+The accumulated spectra are fit by this function type - either
+chebyshev or legendre polynomials, or spline3 or spline1 interpolators.
+.le
+.ls order = 4
+The order of the fit using the above function. This should generally be
+a low order fit to avoid introduction of high spatial frequency wiggles.
+.le
+.ls niter = 1
+The number of iterations to reject discrepant pixels upon initial
+startup of the solution.
+.le
+.ls lower = 2.0
+The number of sigmas for which data values less than this cutoff are
+rejected.
+.le
+.ls upper = 2.0
+The number of sigmas for which data values greater than this cutoff are
+rejected.
+.le
+.ls ngrow = 0
+The number of pixels on either side of a rejected pixel to also be rejected.
+.le
+.ls div_min = 1.0
+During the normalization process, a division by zero will produce
+this value as a result.
+.le
+.ls interact = yes
+If set to yes, graphical interaction with the normalization process
+is provided for at least the first aperture for which sums are available.
+If set to no, no interaction is provided.
+.le
+.ls all_interact = no
+If set to yes, then interaction will be provided for all apertures
+for which sums have been accumulated. If set to no then the parameter interact
+will determine if the first aperture data is to be interactive.
+.le
+.ls coincor = )_.coincor
+If set to yes, coincidence correction is applied to the data during
+the summation process, and the following three parameters are required.
+See \fBcoincor\fR for more about this correction.
+.ls ccmode = )_.ccmode
+The mode by which the coincidence correction is to be performed.
+This may be "iids" or "photo".
+.le
+.ls deadtime = )_.deadtime
+The detector deadtime in seconds.
+.le
+.ls power = )_.power
+Power law IIDS non-linear correction exponent.
+.le
+.le
+.ls cursor = ""
+Graphics cursor input.  When null the standard cursor is used otherwise
+the specified file is used.
+.le
+.ih
+DESCRIPTION
+The specified spectra are added by aperture number to produce
+summations which are then fit by a specified fitting function.
+The fitting function is then divided into the sum to produce a
+normalized (to 1.0) sum in which the low frequency spatial
+response has been removed.
+
+The resultant normalized images may then be divided into all other
+data to remove the pixel-to-pixel variations without introducing
+any color terms. The spectra may be used directly if they happen
+to be object spectra in which the low frequency response is to be
+removed.
+
+During the accumulation process the spectra may be corrected for
+coincidence losses if the detector is subject to the phenomenon.
+
+After accumulating all input spectra, the pixels in each sum are
+fit according to
+the specified function. If the interactive switches are set, then
+graphical interaction is made available. If only the interact parameter
+is set to yes, then only the data from the first aperture will
+be available for interaction. Data from subsequent apertures will
+be fit using the same parameters and number of iterations as the
+first. If the all_interact parameter is also
+set, then data from each aperture will be presented for interaction.
+
+At each step in the fit, pixels which are discrepant by more than
+"upper" sigmas above the fit, or "lower" sigmas below the fit, are
+rejected. The rejection process may be applied many times (iterations)
+to continue rejecting pixels. If the upper and lower sigmas are
+not equal, the resulting fit will be biased slightly above the mean
+(for lower < upper) or below the mean (upper < lower). This is useful
+when the spectrum being fit is that of a star having either absorption
+or emission lines.
+ 
+A display is presented of the sum and the fit through the data.
+A status line is printed containing the fit type, the order of
+the fit, the rms residual from the fit, and the number of data
+points in the fit after one iteration of rejection.
+
+The following cursor keystrokes are then active:
+.ls ?
+Clear the screen and display the active keystrokes
+.le
+.ls /
+Indicate active keystrokes on the status line
+.le
+.ls e
+Change plot mode to an error plot. This display is defined
+as the deviation from the fit divided by the data values [ (data - fit)/ data]
+at each pixel
+.le
+.ls f
+Change plot mode back to the fit through the data display
+.le
+.ls o
+Change the order of the fit.
+.le
+.ls l
+Change the lower rejection criterion (in units of sigma).
+.le
+.ls u
+Change the upper rejection criterion.
+.le
+.ls s
+Change both rejection criteria to the same value.
+.le
+.ls r
+Reinstate rejected pixels.
+.le
+.ls i
+Iterate one more time.
+.le
+.ls n
+Iterate several more times - the user is prompted for the count.
+.le
+.ls q
+Quit and accept the solution
+.le
+.ls <CR>
+RETURN is the same as 'q' but a confirmation request to exit must be
+answered as yes.
+.le
+
+All keystrokes but ?,/,e,f, and q force another iteration which will
+reject additional pixels. To fully inhibit pixel rejection, the sigmas
+should be set to a large value (e.g. 100).
+.ih
+EXAMPLES
+The following example will accumulate 8 spectra and fit the first
+aperture data interactively but not the second, and apply coincidence
+corrections to the sums. The upper and lower rejection criteria
+have been altered to bias the seventh order fit to a higher level.
+
+	cl> flatfit nite1 1-4,201-204 coin+ low=1.4 up=3 order=7
+.ih
+BUGS
+For some reason, the error plot is supposed to have a zero level line
+drawn, but none appears.
+
+As in most of the IRAF software, the order of a fit refers to the number
+of terms in the fit, so that a fit of order 1 implies a constant and order
+2 implies a linear fit.
+.ih
+SEE ALSO
+coincor, flatdiv
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/powercor.hlp b/noao/onedspec/irsiids/doc/powercor.hlp
new file mode 100644
index 00000000..e1f9c70e
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/powercor.hlp
@@ -0,0 +1,62 @@
+.help powercor Oct86 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+powercor -- Apply power law correction to mountain reduced spectra
+.ih
+USAGE
+powercor input records
+.ih
+PARAMETERS
+.ls input
+The root file name of the input spectra.
+.le
+.ls records
+The range of spectra.
+The names of the spectra will be formed by appending the range
+elements to the input root name.
+.le
+.ls output
+This is the root file name for the corrected spectra.
+.le
+.ls start_rec = 1
+The starting record number to be appended to the root name of the
+created spectra.
+.le
+.ls power = )iids.power
+The power law coefficient.
+.le
+.ih
+DESCRIPTION
+A power law correction to the IIDS count rates is applied to the input
+spectra.  The mountain reduction software applies a coincidence correction
+to the observed IIDS count rates but does not correct for a nonlinear effect
+in the image tube chain.  This second correction takes the form of a
+power law
+
+	C(out) = C(in) ** power
+
+where C(in) is the input, coincidence corrected, count rate and C(out)
+is the corrected count rate.  The power is a parameter of the task
+which defaults to the \fBiids\fR package parameter set to the appropriate
+value for the IIDS.  The exposure time, in seconds, is a required
+image header parameter (keyword = EXPOSURE) used to convert the
+total counts to count rates.
+
+Note that if the original raw spectra are being reduced then the either
+\fBcoincor\fR or \fBpowercor\fR may be used to apply both the coincidence
+correction and the power law correction at the same time.  In other words,
+the tasks apply the coincidence correction if the coincidence flag (CO-FLAG) is
+-1 (uncorrected) and the power law correction alone if the flag is zero
+(coincidence corrected only).  The flag is 1 when both the coincidence and
+nonlinear correction have been applied.
+
+This task is a script calling \fBcoincor\fR with \fIccmode\fR = "iids".
+.ih
+EXAMPLES
+The following example corrects a series of IIDS spectra:
+
+	cl> powercor nite1 1-250 output=nite1cc start_rec=1
+.ih
+SEE ALSO
+coincor
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/process.hlp b/noao/onedspec/irsiids/doc/process.hlp
new file mode 100644
index 00000000..5cedcde3
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/process.hlp
@@ -0,0 +1,20 @@
+.help process Oct85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+process	-- A task generated by BATCHRED
+.ih
+USAGE
+process
+.ih
+DESCRIPTION
+The task \fBbatchred\fR creates a script called process.cl for batch
+reductions.  \fBBatchred\fR also has an option to automatically run
+this script.
+.ih
+EXAMPLES
+The task \fBbatchred\fR is run to setup a set of beam switching operations.
+It creates the script \fBprocess.cl\fR which the user runs as a background
+process as follows:
+
+	cl> process&
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/slist1d.hlp b/noao/onedspec/irsiids/doc/slist1d.hlp
new file mode 100644
index 00000000..6c7d2702
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/slist1d.hlp
@@ -0,0 +1,59 @@
+.help slist1d Jan92 noao.imred.irs/iids
+.ih
+NAME
+slist1d -- List spectral header information
+.ih
+USAGE
+slist1d input records
+.ih
+PARAMETERS
+.ls input
+The image root name for the spectra to be listed.
+.le
+.ls records
+The record string for the spectra to be listed. The records will be appended
+to the root name to form image names of the type "root.xxxx".
+.le
+.ls long_header = no
+If set to yes, then a complete listing of the header elements
+is given. If set to no, then a single line per spectrum is given which lists
+in the following order: the image name, object or sky spectrum, exposure
+time, spectrum length, and image title.
+.le
+.ih
+DESCRIPTION
+Each spectrum in the list implied by the root name and the record string
+is opened and the header is read. The pixel file is not accessed in order
+to save time. The header listing is directed to STDOUT and may be
+redirected for printing.
+
+A warning message is issued if
+a requested image is not found, but otherwise proceeds.
+.ih
+EXAMPLES
+The following example lists 8 spectral headers in long form on the printer:
+
+.nf
+	cl> slist1d nite1 1001-1008 | lprint
+.fi
+
+The next example lists the same spectral headers but in short form
+on the terminal
+
+.nf
+	cl> slist1d nite1 1001-1008 long-
+.fi
+.ih
+REVISIONS
+.ls SLIST1D V2.10
+This task is the same as V2.9 \fBslist\fR and applies only to the older
+IRS/IIDS record extension spectra.  In V2.10 \fBslist\fR
+has been revised for multiaperture spectra.
+.le
+.ih
+BUGS
+SLIST1D does not inform the user if the pixel file can or cannot be read.
+.ih
+SEE ALSO
+slist, imheader
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/subsets.hlp b/noao/onedspec/irsiids/doc/subsets.hlp
new file mode 100644
index 00000000..a9f0ae68
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/subsets.hlp
@@ -0,0 +1,49 @@
+.help subsets May85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+subsets - Subtract pairs of spectra in a string
+.ih
+USAGE
+subsets input records
+.ih
+PARAMETERS
+.ls input
+The root file name for the input spectra in the string.
+.le
+.ls records
+The range of spectra indicating the elements of the string.
+The names of the spectra will be formed by appending the range
+elements to the input root name.
+.le
+.ls output
+This is the root file name for the names of the spectra which will
+be created by the subtraction operation.
+.le
+.ls start_rec
+The starting record number to be appended to the root name of the
+created spectra.
+.le
+.ih
+DESCRIPTION
+Pairs of spectra are formed from the input string in the order that
+the record numbers would suggest. 
+The first spectrum in the pair is assumed to be the
+principle spectrum and the second spectrum in the pair is subtracted
+from the first. The result is written out as a new spectrum.
+
+No compensation is made for exposure time during the subtraction.
+The header from the principle spectrum is assigned to the output
+spectrum.
+
+.ih
+EXAMPLES
+The following example forms 50 new spectra from nite1.2001-nite1.2002,
+nite1.2003-nite1.2004, ...
+
+	cl> subsets nite1 2001-2100
+
+The following example creates new spectra from the pairs nite2.2001-nite2.2002,
+nite2.2003-nite2.2004 in spite of the order of the record numbers entered.
+
+	cl> subsets nite2 2001,2003,2002,2004
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/sums.hlp b/noao/onedspec/irsiids/doc/sums.hlp
new file mode 100644
index 00000000..0d8b27e9
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/sums.hlp
@@ -0,0 +1,44 @@
+.help sums Jul85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+sums -- Generate sums of the sky and object spectra for each aperture
+.ih
+USAGE
+sums input records
+.ih
+PARAMETERS
+.ls input
+The root file name for the input spectra in the string.
+.le
+.ls records
+The range of spectra indicating the elements of the string.
+The names of the spectra will be formed by appending the range
+elements to the input root name.
+.le
+.ls output
+This is the root file name for the names of the spectra which will
+be created by the summation operation.
+.le
+.ls start_rec
+The starting record number to be appended to the root name of the
+created spectra.
+.le
+.ih
+DESCRIPTION
+All the object spectra for each aperture are summed, and the
+sky spectra are also summed to produce two new spectra for
+each observing aperture. Exposure times are accumulated.
+No tests are made to check whether the object is consistent
+among the specified spectra. This could be accomplished by
+checking the titles or telescope positions, but it isn't.
+
+The header parameters OFLAG and BEAM-NUM must be properly
+set in the headers.
+.ih
+EXAMPLES
+The following example forms 4 new spectra from nite1.2001-nite1.2002,
+nite1.2003-nite1.2004, ... assuming this string is derived from
+IIDS spectra.
+
+	cl> sums nite1 2001-2100
+.endhelp
diff --git a/noao/onedspec/irsiids/doc/widstape.hlp b/noao/onedspec/irsiids/doc/widstape.hlp
new file mode 100644
index 00000000..855f223d
--- /dev/null
+++ b/noao/onedspec/irsiids/doc/widstape.hlp
@@ -0,0 +1,90 @@
+.help widstape Mar85 noao.imred.iids/noao.imred.irs
+.ih
+NAME
+widstape -- Write a Cyber style IDSOUT tape
+.ih
+USAGE
+widstape idsout input records
+.ih
+PARAMETERS
+.ls idsout
+The output file name to receive the card-image data. This may be a
+magtape specification (e.g. mta, mtb) or disk file name.
+.le
+.ls input
+The input root file name for the spectra to be written
+.le
+.ls records
+The record string to be appended to the root name to create the image
+names of the spectra to be written.
+.le
+.ls new_tape = no
+If set to yes, the tape is rewound and output begins at BOT. If no,
+output begins at EOT unless an explicit file specification is given
+as part of the magtape file name for parameter "idsout" (e.g. mta[2]).
+If idsout contains a file specification of [1], then writing begins
+at BOT regardless of the value for new_tape.
+.le
+.ls block_size = 3200
+The tape block size in bytes. This must be an integral factor of 80.
+.le
+.ls ebcdic = no
+The default character code is ASCII, but if this parameter is set to yes,
+the output character will be in EBCDIC.
+.le
+.ih
+DESCRIPTION
+The specified spectra are copied to the output file in a card-image format
+defined in the IPPS-IIDS/IRS Reduction Manual. Values from the extended
+image header are used to fill in the observational parameters.
+
+The basic format consists of 4 - 80 byte header cards, 128 data cards
+having 8 data elements per card in 1PE10.3 FORTRAN equivalent format,
+and a trailing blank card for a total of 133 cards. 
+Thus spectra up to 1024 points may be contained in the IDSOUT format. 
+The format is outlined below:
+
+.nf
+ Line	Column	Type
+    1	   1-5	Integer	  Record number within IDSOUT text file
+	  6-10	Integer	  Integration time
+	 11-25	Real	  Wavelength of first bin
+	 26-40	Real	  Dispersion
+	 41-45	Integer	  0 (Index of first pixel)
+	 46-50  Integer	  Line length - 1 (Index of last pixel)
+	 71-80	Integer	  UT time
+    2	  1-10	Real	  Siderial time
+	 11-25	Real	  Right Ascension
+	 26-40	Real	  Declination
+    3	 21-35	Real	  Hour Angle
+	 36-50	Real	  Air mass
+	 51-58	Integer	  UT date
+	 60-76	String	  Image title
+	 78-80	String	  END
+    4	  1-64	String	  Record label
+	 78-80	String	  END
+5-132		Real	  1024 pixel values, 8 per line
+  133			  Blank line
+.fi
+
+The data of type real are in exponent format; i.e FORTRAN 'E' format (1.234e3).
+
+There are no special marks between spectral images, 
+and when multiple spectra are written with a single command, the first card
+of a subsequent spectrum may be within the same physical tape block
+as the last card of the previous spectrum. This assures that all tape
+blocks (except the very last one in the tape file) are all the same
+length.  A double end-of-mark is written after the last spectrum.
+.ih
+EXAMPLES
+The following example writes an IDSOUT format tape starting at the
+beginning of the tape.
+
+	cl> widstape mta nite1 1001-1200 new_tape+
+.ih
+TIME REQUIREMENTS: UNIX/VAX 11/750
+Each spectrum of 1024 points requires about 2 second.
+.ih
+SEE ALSO
+rcardimage, ridsout
+.endhelp
diff --git a/noao/onedspec/irsiids/extinct.cl b/noao/onedspec/irsiids/extinct.cl
new file mode 100644
index 00000000..68c5a2de
--- /dev/null
+++ b/noao/onedspec/irsiids/extinct.cl
@@ -0,0 +1,22 @@
+#{ EXTINCT -- Use the BSWITCH task to perform the correction for
+#            atmospheric extinction.
+
+{
+# Root name
+rt = root
+
+# Records
+rec = records
+
+# Output root
+out = output
+
+# Output starting record
+strt = start_rec
+
+# Do operation
+# Inhibit weighting and statisitic file generation
+
+bswitch  (input=rt, records=rec, output=out, start_rec=strt, subset=nr_aps,
+         weighting=no, ids_mode=no, stats="")
+}
diff --git a/noao/onedspec/irsiids/extinct.par b/noao/onedspec/irsiids/extinct.par
new file mode 100644
index 00000000..a605dae0
--- /dev/null
+++ b/noao/onedspec/irsiids/extinct.par
@@ -0,0 +1,11 @@
+# EXINCT
+
+root,s,a,,,,Root name for spectra file names
+records,s,a,,,,Record string to process
+output,s,a,,,,Root name for spectra to be created
+start_rec,i,a,1,0,9999,Next starting spectral record
+nr_aps,i,h,2
+strt,i,h
+rt,s,h
+out,s,h
+rec,s,h
diff --git a/noao/onedspec/irsiids/flatdiv.par b/noao/onedspec/irsiids/flatdiv.par
new file mode 100644
index 00000000..84de42d4
--- /dev/null
+++ b/noao/onedspec/irsiids/flatdiv.par
@@ -0,0 +1,12 @@
+
+# FLATDIV parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
+flat_file,s,a,,,,Image root name for output flat field spectra
+coincor,b,h,)_.coincor,,,Apply coincidence correction to spectra
+ccmode,s,h,)_.ccmode,,,Correction mode (photo|iids)
+deadtime,r,h,)_.deadtime,,,Deadtime in seconds
+power,r,h,)_.power,,,IIDS power law coefficient
diff --git a/noao/onedspec/irsiids/flatfit.par b/noao/onedspec/irsiids/flatfit.par
new file mode 100644
index 00000000..3167697d
--- /dev/null
+++ b/noao/onedspec/irsiids/flatfit.par
@@ -0,0 +1,24 @@
+# FLATFIT parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+function,s,h,"chebyshev",,,Function to fit (chebyshev|legendre|spline3|spline1)
+order,i,h,6,1,,Fitting order (number of terms)
+niter,i,h,1,1,,Number of rejection iterations
+lower,r,h,2,0,,Lower rejection criterion in sigmas
+upper,r,h,2,0,,Upper rejection criterion in sigmas
+ngrow,i,h,0,,,Growing region
+div_min,r,h,1.0,,,Value to use if division by zero occurs
+interact,b,h,yes,,,Interact with the first accumulation?
+all_interact,b,h,no,,,Interact with all accumulations?
+coincor,b,h,)_.coincor,,,Apply coincidence correction to flats
+ccmode,s,h,)_.ccmode,,,Correction mode (photo|iids)
+deadtime,r,h,)_.deadtime,,,Deadtime in seconds
+power,r,h,)_.power,,,IIDS power law coefficient
+new_order,i,a,4,1,,enter order
+new_lower,r,a,,,,enter nr sigma
+new_upper,r,a,,,,enter nr sigma
+new_niter,i,a,,,,enter nr of iterations
+confirm,b,a,,,,Exit and save solution?
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/onedspec/irsiids/getnimage.x b/noao/onedspec/irsiids/getnimage.x
new file mode 100644
index 00000000..c232a85c
--- /dev/null
+++ b/noao/onedspec/irsiids/getnimage.x
@@ -0,0 +1,133 @@
+include	<mach.h>
+
+
+# GET_NEXT_IMAGE -- Use root filename and ranges string (if any) to
+#                  generate the next image filename. Return EOF
+#                  when image list is exhausted.
+
+int procedure get_next_image (infile, records, nrecs, image, sz_name)
+
+int	infile, records[ARB], nrecs, sz_name
+char	image[sz_name]
+
+int	next_num, stat
+int	flag1, flag2, flag3
+char	image_0[SZ_FNAME]
+
+int	clgfil(), get_next_entry(), strlen()
+
+common	/gnicom/ flag1, flag2
+
+data	flag3/YES/
+
+begin
+	# Reset initializer, record counter, and get root name
+	if ((flag1 == YES) || (flag3 == YES)) {
+	    next_num  = -1
+	    call rst_get_entry ()
+	}
+
+	# If no ranges specified, act like template expander
+	if (nrecs == MAX_INT) {
+	    stat = clgfil (infile, image, sz_name)
+
+	# Otherwise append record numbers to first template expansion
+	} else {
+	    if (flag1 == YES) {
+		stat = clgfil (infile, image_0, sz_name)
+		if (stat == EOF)
+		    return (stat)
+	    }
+
+	    stat = get_next_entry (records, next_num)
+	    if (stat != EOF) {
+	 	call strcpy (image_0, image, sz_name)
+		call sprintf (image[strlen(image)+1], sz_name, ".%04d")
+		call pargi (next_num)
+	    }
+	}
+
+	flag1 = NO
+	flag3 = NO
+	return (stat)
+end
+
+
+# Reset the initialization parameter to TRUE
+
+procedure reset_next_image ()
+
+int	flag1, flag2
+common	/gnicom/ flag1, flag2
+
+begin
+	flag1 = YES
+end
+
+
+# GET_NEXT_ENTRY -- Given a list of ranges and the current file number,
+# find and return the next file number in order of entry.  
+# EOF is returned at the end of the list.
+
+int procedure get_next_entry (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+int	flag1, flag2, flag3
+
+common	/gnicom/ flag1, flag2
+
+data	flag3/YES/
+
+begin
+	number = number + 1
+	next_number = MAX_INT
+	if ((flag2 == YES) || (flag3 == YES)) {
+	    ip = 1
+	    flag2 = NO
+	    flag3 = NO
+	}
+
+	first = min (ranges[ip], ranges[ip+1])
+	last = max (ranges[ip], 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
+		go to 10
+
+	} else if (first > number)
+	    next_number = min (next_number, first)
+
+	else {
+10	    ip = ip + 3
+	    if (ranges[ip] != -1 && ranges[ip+1] !=0 && ranges[ip+2] !=0)
+		next_number = min (ranges[ip], ranges[ip+1])
+	}
+
+	if (next_number == MAX_INT) {
+	    ip = 1
+	    flag2 = YES
+	    return (EOF)
+
+	} else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+procedure rst_get_entry ()
+
+int	first, flag2
+common	/gnicom/ first, flag2
+
+begin
+	flag2 = YES
+end
diff --git a/noao/onedspec/irsiids/idsmtn.h b/noao/onedspec/irsiids/idsmtn.h
new file mode 100644
index 00000000..5fa3c73e
--- /dev/null
+++ b/noao/onedspec/irsiids/idsmtn.h
@@ -0,0 +1,101 @@
+# Definitions for the Mountain format IDS tape reader:
+
+define	MAX_RANGES	100
+define	DUMMY		3	# Value returned if DUMMY IDS record is read
+
+define	NBITS_CHAR		(SZB_CHAR * NBITS_BYTE)
+define	SZ_IDS_RECORD		(2108 * 16 / NBITS_CHAR)
+define	NPIX_IDS_REC		1024
+define	LEN_USER_AREA		2880
+define	SZ_IDS_ID		64
+define	NBITS_VN_3WRD_FP	48
+define	NBITS_VN_2WRD_FP	32
+define	NBITS_VN_LONG_INT	32
+define	NBITS_VN_INT		16
+define	NBITS_FORTH_CHAR	8
+define	DATA_BYTE		9			# First byte of data
+define	NBYTES_DATA	(1024 * 32 / NBITS_BYTE)	# Number of data bytes
+define	NBYTES_INT	(NBITS_INT / NBITS_BYTE)
+define	NBYTES_VN_3WRD_FP	6
+define	NBYTES_VN_2WRD_FP	4
+define	NBITS_2WRD_HIGH		8
+define	WRD2_EXP_OFFSET		25
+define	NBITS_2WRD_EXP		6
+define	WRD2_MANT_SIGN		24
+define	WRD2_EXP_SIGN		31
+define	NSIG_VN_BITS		15
+define	VN_LONG_SIGN		31
+define	WRD3_MANT_SIGN		31
+define	WRD3_EXP_SIGN		47
+define	MAX_NCOEFF		25
+
+
+# The control parameter structure is defined below:
+
+define	LEN_CP		10 + SZ_FNAME + 1
+
+define	IS_REDUCED	Memi[$1]
+define	LONG_HEADER	Memi[$1+1]
+define	PRINT_PIXELS	Memi[$1+2]
+define	MAKE_IMAGE	Memi[$1+3]
+define	OFFSET		Memi[$1+4]
+define	DATA_TYPE	Memi[$1+5]
+define	IRAF_FILE	Memc[P2C($1+10)]
+
+
+# The header structure is defined below:
+
+define	LEN_IDS			40 + SZ_IDS_ID + 1
+
+define	HA			Memr[P2R($1)]
+define	AIRMASS			Memr[P2R($1+1)]
+define	RA			Memr[P2R($1+2)]
+define	DEC			Memr[P2R($1+3)]
+define	W0			Memr[P2R($1+4)]
+define	WPC			Memr[P2R($1+5)]
+define	LINE			Memi[$1+6]
+define	NP1			Memi[$1+7]
+define	NP2			Memi[$1+8]
+define	ITM			Memr[P2R($1+9)]
+define	BEAM			Memi[$1+10]
+define	W			Memi[$1+11]
+define	UT			Memr[P2R($1+13)]
+define	ST			Memr[P2R($1+14)]
+define	DF_FLAG			Memi[$1+15]
+define	SM_FLAG			Memi[$1+16]
+define	QF_FLAG			Memi[$1+17]
+define	DC_FLAG			Memi[$1+18]
+define	QD_FLAG			Memi[$1+19]
+define	EX_FLAG			Memi[$1+20]
+define	BS_FLAG			Memi[$1+21]
+define	CA_FLAG			Memi[$1+22]
+define	CO_FLAG			Memi[$1+23]
+define	OFLAG			Memi[$1+24]
+define	POINT			Memi[$1+25]	
+define	DRA			Memi[$1+26]
+define	DDEC			Memi[$1+27]
+define	ALPHA_ID		Memc[P2C($1+35)]
+define	LABEL			Memc[P2C($1+40)]
+
+
+# Bit offsets to various IDS header words are defined below:
+
+define	NREC_OFFSET	((0 * 16) + 1)
+define	RFLAGS_OFFSET	((1 * 16) + 1)
+define	ITM_OFFSET	((2 * 16) + 1)
+define	DATA_OFFSET	((4 * 16) + 1)
+define	W0_OFFSET	((2052 * 16) + 1)
+define	WPC_OFFSET	((2055 * 16) + 1)
+define	NP1_OFFSET	((2058 * 16) + 1)
+define	NP2_OFFSET	((2059 * 16) + 1)
+define	OFLAG_OFFSET	((2060 * 16) + 1)
+define	SMODE_OFFSET	((2061 * 16) + 1)
+define	UT_OFFSET	((2062 * 16) + 1)
+define	ST_OFFSET	((2064 * 16) + 1)
+define	BEAM_OFFSET	((2066 * 16) + 1)
+define	HA_OFFSET	((2067 * 16) + 1)
+define	RA_OFFSET	((2070 * 16) + 1)
+define	DEC_OFFSET	((2073 * 16) + 1)
+define	DRA_OFFSET	((2076 * 16) + 1)
+define	DDEC_OFFSET	((2077 * 16) + 1)
+define	LABEL_OFFSET	((2078 * 16) + 1)
diff --git a/noao/onedspec/irsiids/irsiids.hd b/noao/onedspec/irsiids/irsiids.hd
new file mode 100644
index 00000000..d0a20d98
--- /dev/null
+++ b/noao/onedspec/irsiids/irsiids.hd
@@ -0,0 +1,18 @@
+# Help directory for the IRS/IIDS tasks.
+
+$doc		= "./doc/"
+
+addsets		hlp=doc$addsets.hlp,		src=t_addsets.x
+batchred	hlp=doc$batchred.hlp,		src=batchred.cl
+bswitch		hlp=doc$bswitch.hlp,		src=t_bswitch.x
+coefs		hlp=doc$coefs.hlp,		src=t_coefs.x
+coincor		hlp=doc$coincor.hlp,		src=t_coincor.x
+extinct		hlp=doc$extinct.hlp,		src=extinct.cl
+flatdiv		hlp=doc$flatdiv.hlp,		src=t_flatdiv.x
+flatfit		hlp=doc$flatfit.hlp,		src=t_flatfit.x
+powercor	hlp=doc$powercor.hlp,		src=powercor.cl
+process		hlp=doc$process.hlp,		src=process.cl
+slist1d		hlp=doc$slist1d.hlp,		src=t_slist1d.x
+subsets		hlp=doc$subsets.hlp,		src=t_subsets.x
+sums		hlp=doc$sums.hlp,		src=t_sums.x
+widstape	hlp=doc$widstape.hlp,		src=x_widstape.x
diff --git a/noao/onedspec/irsiids/mkpkg b/noao/onedspec/irsiids/mkpkg
new file mode 100644
index 00000000..01ee3403
--- /dev/null
+++ b/noao/onedspec/irsiids/mkpkg
@@ -0,0 +1,22 @@
+# IRS/IIDS Tasks
+
+$checkout libpkg.a ..
+$update   libpkg.a
+$checkin  libpkg.a ..
+$exit
+
+libpkg.a:
+	coincor.x	
+	conversion.x	
+	getnimage.x	<mach.h>
+	t_addsets.x	<error.h> <imhdr.h>
+	t_bswitch.x	<smw.h> <error.h> <imhdr.h> <mach.h> <time.h>
+	t_coefs.x	<error.h>
+	t_coincor.x	<error.h> <imhdr.h>
+	t_flatdiv.x	<error.h> <imhdr.h>
+	t_flatfit.x	<gset.h> <imhdr.h> <math/curfit.h>
+	t_slist1d.x	<error.h> <fset.h> <imhdr.h> <smw.h>
+	t_subsets.x	<error.h> <imhdr.h>
+	t_sums.x	<error.h> <imhdr.h>
+	t_widstape.x	<error.h> <imhdr.h> <mach.h> <smw.h>
+	;
diff --git a/noao/onedspec/irsiids/powercor.cl b/noao/onedspec/irsiids/powercor.cl
new file mode 100644
index 00000000..a89e2478
--- /dev/null
+++ b/noao/onedspec/irsiids/powercor.cl
@@ -0,0 +1,4 @@
+#{ Apply nonlinear IIDS correction
+
+coincor (input, records, output, start_rec=start_rec, ccmode="iids",
+	power=power)
diff --git a/noao/onedspec/irsiids/powercor.par b/noao/onedspec/irsiids/powercor.par
new file mode 100644
index 00000000..e4e8bb90
--- /dev/null
+++ b/noao/onedspec/irsiids/powercor.par
@@ -0,0 +1,7 @@
+# POWERCOR parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
+power,r,h,)_.power,,,Power law coefficient
diff --git a/noao/onedspec/irsiids/slist1d.par b/noao/onedspec/irsiids/slist1d.par
new file mode 100644
index 00000000..ae091a20
--- /dev/null
+++ b/noao/onedspec/irsiids/slist1d.par
@@ -0,0 +1,3 @@
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+long_header,b,h,no,,,List header in long format
diff --git a/noao/onedspec/irsiids/subsets.par b/noao/onedspec/irsiids/subsets.par
new file mode 100644
index 00000000..5368ca06
--- /dev/null
+++ b/noao/onedspec/irsiids/subsets.par
@@ -0,0 +1,6 @@
+# SUBSETS parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
diff --git a/noao/onedspec/irsiids/sums.par b/noao/onedspec/irsiids/sums.par
new file mode 100644
index 00000000..bbeab466
--- /dev/null
+++ b/noao/onedspec/irsiids/sums.par
@@ -0,0 +1,8 @@
+
+# SUMS parameter file
+
+input,s,a,,,,Input image root file name
+records,s,a,,,,Range of spectral records
+output,s,a,,,,Output file root name for new spectra
+start_rec,i,a,1,0,9999,Next starting spectral record
+newoutput,s,q,,,,New output file root name
diff --git a/noao/onedspec/irsiids/t_addsets.x b/noao/onedspec/irsiids/t_addsets.x
new file mode 100644
index 00000000..cd145b4a
--- /dev/null
+++ b/noao/onedspec/irsiids/t_addsets.x
@@ -0,0 +1,195 @@
+include	<error.h>
+include	<imhdr.h>
+
+
+# T_ADDSETS -- Add a series of spectra by subsets. A single spectrum
+#  is produced for every "subset" number of input spectra. The input
+#  list is accumulated until "subset" number of spectra have been
+#  encountered. The result is then written out.
+#
+#  If the input data are calibrated (CA_FLAG = 0) then the result
+#  is an average over the subset size, but the header exposure
+#  time is updated.
+#
+#  If the data is uncalibrated then the resulting spectrum is a sum
+#  of the total counts.
+
+procedure t_addsets ()
+
+pointer	image
+pointer	recstr, ofile
+int	root, start_rec, subset
+int	nrecs
+int	nrem, ifile, ca_flag
+real	itm, expo, wt, wtsum
+bool	weight
+pointer	sp, recs, im, cur_pix, sp_sum
+
+real	imgetr()
+int	clpopni(), clgeti(), imgeti()
+int	get_next_image(), decode_ranges()
+bool	clgetb()
+pointer	immap(), imgl1r()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (recstr, SZ_LINE, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+
+	# Open input file name template
+	root   = clpopni ("input")
+
+	# Get range specification if any
+	call clgstr ("records", Memc[recstr], SZ_LINE)
+	if (decode_ranges (Memc[recstr], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	# Get rootname for output files and starting record
+	call clgstr ("output", Memc[ofile], SZ_FNAME)
+	start_rec = clgeti ("start_rec")
+
+	# Get subset size
+	subset = clgeti ("subset")
+
+	# Apply integration time weighting?
+	weight = clgetb ("weighting")
+
+	# Initialize range decoder
+	call reset_next_image ()
+
+	#Initialize file counter
+	ifile = 0
+	wtsum = 0.0
+
+	# Loop over all input images by subsets
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image], 
+	    SZ_FNAME) != EOF) {
+
+	    # Open image
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Allocate space for current subset
+	    if (mod (ifile, subset) == 0) {
+		call calloc (sp_sum, IM_LEN (im,1), TY_REAL)
+
+		# Zero exposure counter
+		expo = 0.0
+	    }
+
+	    # Add in current spectrum
+	    iferr (itm = imgetr (im, "EXPOSURE"))
+		iferr (itm = imgetr (im, "ITIME"))
+		    iferr (itm = imgetr (im, "EXPTIME"))
+			itm = 1
+	    iferr (ca_flag = imgeti (im, "CA-FLAG"))
+		ca_flag = -1
+	    cur_pix = imgl1r (im)
+
+	    # Apply integration time weighting
+	    if (weight)
+		wt = itm
+	    else
+		wt = 1.0
+
+	    if (ca_flag != 0)
+		wt = 1.0
+
+	    wtsum = wtsum + wt
+	    call amulkr (Memr[cur_pix], wt, Memr[cur_pix], IM_LEN(im,1))
+	    call aaddr (Memr[cur_pix], Memr[sp_sum], Memr[sp_sum], IM_LEN(im,1))
+	    expo = expo + itm
+
+	    # Issue status report
+	    call printf ("[%s] added\n")
+		call pargstr (Memc[image])
+
+	    ifile = ifile + 1
+	    if (mod (ifile, subset) == 0) {
+		call wrt_set (Memr[sp_sum], subset, im, Memc[ofile], start_rec,
+		    expo, wtsum, ca_flag)
+		wtsum = 0.0
+		call mfree (sp_sum, TY_REAL)
+	    } else
+		call imunmap (im)
+
+	}
+	# Check that there are no remaining spectra in an unfulfilled subset
+	nrem = mod (ifile, subset)
+	if (nrem != 0) {
+	    call wrt_set (Memr[sp_sum], nrem, im, Memc[ofile], start_rec, 
+		expo, wtsum, ca_flag)
+	    wtsum = 0.0
+	    call mfree (sp_sum, TY_REAL)
+
+	    call eprintf ("Unfulfilled subset accumulation written - ")
+	    call eprintf ("missing %d spectra\n")
+		call pargi (subset - nrem)
+	}
+
+	# Update record number
+	call clputi ("next_rec", start_rec)
+
+	# Free space
+	call sfree (sp)
+	call clpcls (root)
+end
+
+# WRT_SET -- Write spectra ccumulated from the set
+
+procedure wrt_set (sp_sum, subset, im, ofile, start_rec, expo, wtsum, ca_flag)
+
+real	sp_sum[ARB]
+int	subset, start_rec, ca_flag
+pointer	im
+char	ofile[SZ_FNAME]
+real	expo, wtsum
+
+char	newfile[SZ_FNAME]
+pointer imnew, newpix
+
+pointer	impl1r(), immap()
+int	strlen()
+
+begin
+	# Create new spectrum - first make up a name
+	call strcpy (ofile, newfile, SZ_FNAME)
+	call sprintf (newfile[strlen (newfile) + 1], SZ_FNAME, ".%04d")
+	    call pargi (start_rec)
+
+	imnew = immap (newfile, NEW_COPY, im)
+
+	IM_NDIM (imnew) = 1
+	IM_LEN (imnew,1) = IM_LEN (im,1)
+	IM_PIXTYPE (imnew) = TY_REAL
+	call strcpy (IM_TITLE(im), IM_TITLE(imnew), SZ_LINE)
+
+	call imunmap (im)
+
+	newpix = impl1r (imnew)
+
+	# If this spectrum is calibrated, perform an average
+	# weighted by integration time and copy new pixels into image
+	if (ca_flag == 0)
+	    call adivkr (sp_sum, real (wtsum), Memr[newpix], IM_LEN(imnew,1))
+	else
+	    call amovr (sp_sum, Memr[newpix], IM_LEN(imnew,1))
+
+	# Update keyword
+	call imaddr (imnew, "EXPOSURE", expo)
+
+	# Send user report
+	call printf ("writing [%s]: %s\n")
+	    call pargstr (newfile)
+	    call pargstr (IM_TITLE(imnew))
+	call flush (STDOUT)
+
+	call imunmap (imnew)
+
+	# Update record counter
+	start_rec = start_rec + 1
+end
diff --git a/noao/onedspec/irsiids/t_bswitch.x b/noao/onedspec/irsiids/t_bswitch.x
new file mode 100644
index 00000000..0c7b71a5
--- /dev/null
+++ b/noao/onedspec/irsiids/t_bswitch.x
@@ -0,0 +1,924 @@
+include	<error.h>
+include	<imhdr.h>
+include	<mach.h>
+include	<time.h>
+include	<smw.h>
+
+define	MAX_NR_BEAMS	100	# Max number of instrument apertures
+define	MIN_RANGES	100	# Minimum spectra per beam if not given
+
+# T_BSWITCH -- Beam switch a series of spectra to produce a single
+#	     sky subtracted spectrum.
+#
+# The spectra may be extinction corrected if not already done.
+#
+# The summation may include an optional statistical weighting
+# based on the total countrate summed over a user definable
+# piece of the spectrum. If the countrate is <= 0, the
+# spectrum is given zero weight.
+#
+# The data may be organized as data from the IIDS/IRS are usually
+# obtained - where the telescope is beam-switched so that the
+# object is first in one aperture while sky is observed in the other,
+# and then the process is reversed.
+#
+# If the instrument offers many apertures, "nebular" mode can be used
+# to obtain the same effect. Here all apertures observe the object(s)
+# at one time; then the telescope is moved so all apertures are observing
+# sky.
+#
+# Both these methods are considered "idsmode". But if there are a different
+# number of sky observations than object, an imbalance exists. 
+# To account for this possibility, all summations are performed by computing
+# an average countrate over all observations. Sky countrates can then be
+# subtracted from the object. Later the differential countrate is returned
+# to an "equivalent" count by multiplying by the exposure time.
+#
+# Spectra must be dispersion corrected to employ either
+# weighting or extinction correction.
+#
+# The series of spectra may be accumulated in subsets rather than
+# over the entire series by specifying a subset rate. (E.g. for
+# IIDS data a subset rate of 4 would produce a summed pair for
+# every quadruple.)
+
+# Revisions made for WCS support and change from idsmtn.h structure to shdr.h
+# structure.  Because this program is an awful mess the changes were made a
+# small as possible without altering the structure.  (5/1/91, Valdes)
+
+procedure t_bswitch ()
+
+char	image[SZ_FNAME,MAX_NR_BEAMS+1]
+char	rec_numbers[SZ_LINE], title[SZ_LINE,MAX_NR_BEAMS]
+char	ofile[SZ_FNAME], stat_fil[SZ_FNAME]
+int	sfd, nrecsx
+int	i, infile, nrecs, def_beam, start_rec, nimage, sub_rate
+int	records[300], beam_stat[MAX_NR_BEAMS], ncols[MAX_NR_BEAMS]
+bool	idsmode, extinct, stat, weight, eof_test
+pointer	ids[MAX_NR_BEAMS+1] 
+pointer	imnames[MAX_NR_BEAMS]	# Hold pointers to pointers of image names
+pointer	imin, sp, obs
+
+# The following arrays are suffixed by either 'o' for object or 's' for sky
+
+int	ico   [MAX_NR_BEAMS],   ics   [MAX_NR_BEAMS]	# nr obs in beam
+real	expo  [MAX_NR_BEAMS],   exps  [MAX_NR_BEAMS]	# exposure times
+pointer	accumo[MAX_NR_BEAMS+1], accums[MAX_NR_BEAMS+1]	# beam accumulators
+pointer	counto[MAX_NR_BEAMS],   counts[MAX_NR_BEAMS]	# counts in each obs
+
+int	clpopni(), clgeti(), get_next_image(), decode_ranges()
+int	open(), mod()
+pointer	immap()
+bool	clgetb(), streq()
+
+begin
+	call smark (sp)
+	call aclri (ids, MAX_NR_BEAMS+1)
+
+	# Open input filename template
+	infile = clpopni ("input")
+
+	# Get range specification
+	call clgstr ("records", rec_numbers, SZ_LINE)
+	if (decode_ranges (rec_numbers, records, 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	# If no ranges is given, filename expansion will occur, so
+	# we must will need some indication of the number of spectra.
+	if (nrecs == MAX_INT)
+	    nrecsx = MIN_RANGES
+	else
+	    nrecsx = nrecs
+
+	# Get root name for new records and starting record number
+	call clgstr ("output", ofile, SZ_FNAME)
+	start_rec = clgeti ("start_rec")
+
+	# Get filename for statistics
+	call clgstr ("stats", stat_fil, SZ_FNAME)
+
+	# Assume spectra are in quadruples?
+	idsmode = clgetb ("ids_mode")
+
+	# Perform de-extinction?
+	extinct = clgetb ("extinct")
+
+	# Use weighting?
+	weight = clgetb ("weighting")
+
+	# Accumulate by subsets? - A very large number implies no subsetting
+	sub_rate = clgeti ("subset")
+
+	# Open statistics file if any
+	if (streq (stat_fil, "")) {
+	    sfd = NULL
+	    stat = false
+	} else {
+	    stat = true
+	    sfd = open (stat_fil, APPEND, TEXT_FILE)
+	}
+
+	# Initialize beam-switch status
+	obs = NULL
+	call init_file (extinct, def_beam, ico, ics, beam_stat)
+
+
+	# Begin cycling through all images - accumulate if possible
+	# by beam number
+
+	# Initialize range decoder
+	call reset_next_image ()
+
+	# Set up for subsets
+	nimage = 0
+	eof_test = false
+
+	repeat {
+
+	while (get_next_image (infile, records, nrecs, image[1,def_beam],
+	    SZ_FNAME) != EOF) {
+
+	    # Attempt to open image with extended header -
+	    iferr (imin = immap (image[1,def_beam], READ_ONLY, 0)) {
+		call eprintf ("[%s]")
+		    call pargstr (image[1,def_beam])
+		call error (0, "Image not found or header info not available")
+	    }
+
+	    # Add in to accumlators
+	    call accum_image (imin, ids, accumo, accums, counto, counts, 
+		ico, ics, expo, exps, image, beam_stat, idsmode, extinct, 
+		weight, nrecsx, ncols, title, imnames, sfd, obs)
+
+	    call printf ("[%s] added\n")
+		call pargstr (image[1,def_beam])
+	    call flush (STDOUT)
+
+	    # Close current image
+	    call imunmap (imin)
+
+	    # Test for subsets
+	    nimage = nimage + 1
+	    if (mod (nimage, sub_rate) == 0)
+		go to 10
+	}
+
+	# Get here by running out of data
+	eof_test = true
+
+	# Must be careful not to write out the last sums if subsets are
+	# in effect because the subset check would already have done so
+	# We can check because "nimage" will not have been bumped
+	# if EOF was encountered.
+
+	if (mod (nimage, sub_rate) != 0) {
+	
+	    # All data has been summed - generate spectra of the accumlations
+10	    call wrt_accum (ids, image, title, accumo, accums, ico, ics, 
+		counto, counts, expo, exps, ncols, beam_stat, idsmode, weight, 
+		extinct, ofile, start_rec, sub_rate)
+
+	    # Generate statistics output for this beam
+	    if (stat)
+		call wrt_stats (sfd, accumo, accums, ico, ics, counto, counts, 
+		    expo, exps, image, beam_stat, title, imnames, weight)
+
+	    # Clear counters and accumulators
+	    call reset_beams (accumo, accums, expo, exps, ico, ics, beam_stat, 
+		ncols)
+	}
+
+	} until (eof_test)
+
+	# Put current record counter back into the parameter file for
+	# subsequent invocations
+	call clputi ("next_rec", start_rec)
+
+	# Close out inputs, outputs, and space
+	do i = 1, MAX_NR_BEAMS+1
+	    call shdr_close (ids[i])
+	if (obs != NULL)
+	    call obsclose (obs)
+	call clpcls (infile)
+	call close (sfd)
+	call sfree (sp)
+end
+
+# ACCUM_IMAGE -- Opens current pixel file, loads header elements,
+#                adds current spectrum to accumulator array(s),
+#                and updates the accumulator status array.
+#		 If not in IDSMODE, then returns both object and
+#		 sky sums for further consideration.
+#		 IDSMODE requires an equal number of each, object and sky,  in
+#		 a sequence of OSSO-OSSO or OSSO-SOOS groups.
+
+procedure accum_image (imin, ids, accumo, accums, counto, counts, ico, ics,
+                expo, exps, image, beam_stat, idsmode, extinct, weight, nrecs,
+		ncols, title, imnames, sfd, obs)
+
+pointer	imin, ids[ARB]
+pointer	imnames[ARB]			# Saved image names for stat printout
+pointer	sfd				# Statistics file
+pointer	obs				# Observatory
+
+pointer	accumo[ARB], accums[ARB]	# Object and sky accumlators
+pointer	counto[ARB], counts[ARB]	#                counting stats
+real	expo  [ARB], exps  [ARB]	#                total exposure times
+int	ico   [ARB], ics   [ARB]	#                number of observations
+
+char	image[SZ_FNAME, MAX_NR_BEAMS+1], title[SZ_LINE,MAX_NR_BEAMS]
+char	observatory[SZ_FNAME]
+int	beam_stat[ARB], ncols[ARB]
+int	dum_beam
+bool	idsmode, extinct, weight, exflag, newobs, obshead
+real	latitude
+
+int	last_len[MAX_NR_BEAMS], name_nr[MAX_NR_BEAMS]
+int	ifile, nr_beams, i, j, def_beam, beam_nr
+int	nwaves, ic, nrecs
+real	airm, wave1, wave2, wt
+pointer	wave_tbl, extn_tbl, ipacc, ipc, mw
+
+real	clgetr(), obsgetr()
+pointer	smw_openim()
+errchk	smw_openim, shdr_open, obsimopen
+
+begin
+	# Bump image file counter
+	ifile = ifile + 1
+
+	# Load header area
+	mw = smw_openim (imin)
+	call shdr_open (imin, mw, 1, 1, INDEFI, SHDATA, ids[def_beam])
+	call smw_close (MW(ids[def_beam]))
+
+	accumo[def_beam] = SY(ids[def_beam])
+
+	# Check for proper flags
+	call flag_chk (ids[def_beam], exflag)
+
+	if (ifile == 1) {
+
+	    # Get region for statistics to operate over -
+	    # Currently only one set of wavelengths is available, but
+	    # at some point, it may be desirable to extend this to
+	    # provide a start and ending wavelength for each aperture
+	    # since an aperture must be considered as an independent
+	    # instrument.
+
+	    # Insert defaults --> entire spectrum
+	    # Now ask user for start and end - if =0.0, use defaults
+	    wave1 = clgetr ("wave1")
+	    wave2 = clgetr ("wave2")
+
+	    if (wave1 == 0.0)
+		wave1 = W0(ids[def_beam])
+	    if (wave2 == 0.0)
+		wave2 = W0(ids[def_beam]) + (IM_LEN(imin,1)-1) * 
+		    WP(ids[def_beam])
+
+	}
+
+	# Determine beam number and add/sub in pixels
+	# Remember that IIDS/IRS "beams" are 0-indexed
+
+	beam_nr = BEAM(ids[def_beam]) + 1
+	if (beam_nr > MAX_NR_BEAMS || beam_nr < 1)
+	    call error (0, "Illegal beam number")
+
+	# Allocate space for this aperture if not already done
+	# Space must be allocated for 2 lines of spectra for
+	# each aperture - Line 1 is used to sum up the most
+	# recent object-sky spectra to maintain the local
+	# statistics. Line 2 is used for the net accumulation
+	# over the entire sequence. The statistics from Line 1
+	# may be used to weigh the observations as they are
+	# added into the Line 2 accumulation.
+	#
+	# For non-IDSMODE the two lines are used for separate
+	# object and sky sums
+
+	if (IS_INDEFI (beam_stat[beam_nr])) {
+	    beam_stat[beam_nr] = 0
+
+	    # Allocate space for the accumulators for this beam nr
+	    call salloc (accumo[beam_nr], IM_LEN(imin,1), TY_REAL)
+	    call salloc (accums[beam_nr], IM_LEN(imin,1), TY_REAL)
+
+	    # Zero object and sky accumulators
+	    call amovkr (0.0, Memr[accumo[beam_nr]], IM_LEN(imin,1))
+	    call amovkr (0.0, Memr[accums[beam_nr]], IM_LEN(imin,1))
+
+
+	    # Allocate space for statistics array - For each beam,
+	    # a series of up to 'nrecs' spectra may be read, and we
+	    # want to keep track of the stats (=countrates) for each
+	    # observation. For non-idsmode, need sky rates too.
+	    call salloc (counto[beam_nr], nrecs, TY_REAL)
+	    if (!idsmode)
+		call salloc (counts[beam_nr], nrecs, TY_REAL)
+
+	    # Allocate space for the image names
+	    call salloc (imnames[beam_nr], nrecs, TY_INT)
+	    name_nr[beam_nr] = 1
+	    do j = 1, nrecs
+		call salloc (Memi[imnames[beam_nr]+j-1], SZ_LINE, TY_CHAR)
+
+	    # Save number of points for checking purposes
+	    last_len[beam_nr] = IM_LEN(imin,1)
+	    ncols[beam_nr] = last_len[beam_nr]
+
+	    # Initialize exposure time
+	    expo[beam_nr] = 0.0
+	    exps[beam_nr] = 0.0
+
+	    nr_beams = nr_beams + 1
+	}
+
+	# If this is an object observation, save the image name
+	if (OFLAG(ids[def_beam]) == 1) {
+	    call strcpy (image[1,def_beam], Memc[Memi[imnames[beam_nr]+
+		name_nr[beam_nr]-1]], SZ_LINE)
+	    name_nr[beam_nr] = name_nr[beam_nr] + 1
+	}
+
+	# If an object observation, save the header elements --
+	# NOTE that if we get >1 objects before getting a sky, only
+	# the last  observation header is saved!
+
+	# The pixel data will be the sum of all objects until the
+	# |object-sky| count = 0 -- Thus, beam switching does not
+	# necessarily accumulate by pairs, but depends on how the
+	# sequence of observations are presented to the program.
+
+	# The following test has been deleted so that headers
+	# will be saved for sky frames as well. This is necessary
+	# if BSWITCH is to perform the function of EXTINCTION
+	# only when sky frames are to be written out as well.
+
+	if (OFLAG(ids[def_beam]) == 1 || !idsmode) {
+	    # Save headers - could probably be done faster by AMOV
+	    call shdr_copy (ids[def_beam], ids[beam_nr], NO)
+
+	    # Fix airmass if necessary
+	    if (extinct && IS_INDEF (AM(ids[beam_nr]))) {
+		call clgstr ("observatory", observatory, SZ_FNAME)
+		call obsimopen (obs, imin, observatory, NO, newobs, obshead)
+		if (newobs) {
+		    call obslog (obs, "BSWITCH", "latitude", STDOUT)
+		    if (sfd != NULL)
+			call obslog (obs, "BSWITCH", "latitude", sfd)
+		}
+		latitude = obsgetr (obs, "latitude")
+		call get_airm (RA(ids[beam_nr]), DEC(ids[beam_nr]),
+		    HA(ids[beam_nr]), ST(ids[beam_nr]), latitude,
+		    AM(ids[beam_nr]))
+	    }
+
+	    call strcpy (image[1,def_beam], image[1,beam_nr], SZ_FNAME)
+
+	    # Save length - Each beam may be independent sizes
+	    ncols[beam_nr] = IM_LEN(imin,1)
+
+	    # Save title, too for same reason
+	    call strcpy (IM_TITLE(imin), title[1,beam_nr], SZ_LINE)
+	}
+
+	# Verify length
+	if (last_len[beam_nr] != ncols[beam_nr]) {
+	    call eprintf ("[%s] -- Length not consistent %d\n")
+		call pargstr (image[1,beam_nr])
+		call pargi   (ncols[beam_nr])
+	    ncols[beam_nr] = min (ncols[beam_nr], last_len[beam_nr])
+	}
+	last_len[beam_nr] = ncols[beam_nr]
+
+
+	# Check to see if a pair is obtained - then perform statistics
+	# and add into global accumulator
+
+	if (idsmode) {
+
+	    # Add spectrum to local accumulation buffer --> Use SKY buffer
+	    # At this point of deriving a sequentially local sum, weighting
+	    # is not used. 
+
+	    call add_spec (Memr[accumo[def_beam]], Memr[accums[beam_nr]],
+		beam_stat[beam_nr], OFLAG(ids[def_beam]), last_len[beam_nr])
+
+	    # IDSMODE requires that every 2N observations produce an
+	    # OBJECT-SKY pair
+	    if (mod (ifile, 2*nr_beams) == 0)
+
+		# Review all beams in use for non-zero pairings
+		do i = 1, MAX_NR_BEAMS
+		    if (!IS_INDEFI (beam_stat[i]) && beam_stat[i] != 0)
+			call error (0, "Spectra are not in quadruples")
+
+
+	    # Object and sky exposure times must be equal.
+	    if (OFLAG(ids[def_beam]) == 1) {
+		expo[beam_nr] = expo[beam_nr] + IT(ids[def_beam])
+
+		# Increment number of object observations for this beam
+		ico[beam_nr] = ico[beam_nr] + 1
+	    }
+
+
+	    if (beam_stat[beam_nr] == 0) {
+		# Add up all counts within a region for statistics of objects
+		# This must be kept separately for each beam number and for
+		# each observation
+
+		# First convert to counts per second (CPS)
+		call adivkr (Memr[accums[beam_nr]], IT(ids[def_beam]),
+		    Memr[accums[beam_nr]], last_len[beam_nr])
+
+		# Sum CPS in statistics region
+		call sum_spec (Memr[accums[beam_nr]], wave1, wave2, 
+		    W0(ids[def_beam]), WP(ids[def_beam]), Memr[counto[beam_nr]+
+		    ico[beam_nr]-1], last_len[beam_nr])
+
+		# De-extinct spectrum
+		if (extinct && !exflag) {
+		    airm = AM(ids[beam_nr])
+		    call de_ext_spec (Memr[accums[beam_nr]], airm, 
+			W0(ids[def_beam]), WP(ids[def_beam]), Memr[wave_tbl], 
+			Memr[extn_tbl], nwaves, last_len[beam_nr])
+		}
+
+		# Add to global accumulator
+		# Use weights which are proportional to countrate, if desired
+		if (weight) {
+		    wt = Memr[counto[beam_nr]+ico[beam_nr]-1]
+		    call amulkr (Memr[accums[beam_nr]], wt,
+			Memr[accums[beam_nr]], last_len[beam_nr])
+		}
+
+		# And add into global sum
+		call aaddr (Memr[accums[beam_nr]], Memr[accumo[beam_nr]],
+		    Memr[accumo[beam_nr]], last_len[beam_nr])
+	    }
+
+	} else {
+	    # Non IDSMODE -accumulate separate object and sky CPS sums
+
+	    # Set pointers and update obj-sky parameters
+	    if (OFLAG(ids[def_beam]) == 1) {
+		beam_stat[beam_nr] = beam_stat[beam_nr] + 1
+		ipacc = accumo[beam_nr]
+		ipc   = counto[beam_nr]
+		ico[beam_nr] = ico[beam_nr] + 1
+		ic = ico[beam_nr]
+		expo[beam_nr] = expo[beam_nr] + IT(ids[def_beam])
+	    } else {
+		beam_stat[beam_nr] = beam_stat[beam_nr] - 1
+		ipacc = accums[beam_nr]
+		ipc   = counts[beam_nr]
+		ics[beam_nr] = ics[beam_nr] + 1
+		ic = ics[beam_nr]
+		exps[beam_nr] = exps[beam_nr] + IT(ids[def_beam])
+	    }
+
+	    # First convert to counts per second (CPS)
+	    call adivkr (Memr[accumo[def_beam]], IT(ids[def_beam]),
+		    Memr[accumo[def_beam]], last_len[beam_nr])
+
+	    # Get counting stats
+	    call sum_spec (Memr[accumo[def_beam]], wave1, wave2, 
+		W0(ids[def_beam]), WP(ids[def_beam]), Memr[ipc+ic-1], 
+		last_len[beam_nr])
+
+	    # De-extinct spectrum
+	    if (extinct && !exflag) {
+		airm = AM(ids[beam_nr])
+		call de_ext_spec (Memr[accumo[def_beam]], airm, 
+		    W0(ids[def_beam]), WP(ids[def_beam]), Memr[wave_tbl], 
+		    Memr[extn_tbl], nwaves, last_len[beam_nr])
+	    }
+
+	    if (weight) {
+		wt = Memr[ipc+ic-1]
+		call amulkr (Memr[accumo[def_beam]], wt, Memr[accumo[def_beam]],
+		    last_len[beam_nr])
+	    }
+
+	    # Add into appropriate accumulator
+	    call aaddr (Memr[accumo[def_beam]], Memr[ipacc], Memr[ipacc],
+		last_len[beam_nr])
+	}
+	
+	return
+
+# INIT_FILE -- Zero the file initializer, the beam counter, beam stats
+#	       and read the extinction data if necessary
+
+entry init_file (extinct, dum_beam, ico, ics, beam_stat)
+
+	ifile = 0
+	nr_beams = 0
+	def_beam = MAX_NR_BEAMS + 1
+	dum_beam = def_beam
+
+	do i = 1, MAX_NR_BEAMS {
+	    beam_stat[i] = INDEFI
+	    ico[i] = 0
+	    ics[i] = 0
+	}
+
+	# If extinction required, read in extinction file, and sensitivity file
+	if (extinct)
+	    call get_extn (wave_tbl, extn_tbl, nwaves)
+
+	return
+
+# INIT_NAME -- Reset name index counter for a beam number
+
+entry init_name (dum_beam)
+
+	name_nr[dum_beam] = 1
+	return
+end
+
+# ACCUM_OUT -- Checks accumulator flags and writes out a new summed
+#              image if the count is zero
+
+procedure accum_out (accum, image, ncols, title, root, rec, beam_nr,
+	bsflag, itm, exflag)
+
+real	accum[ARB], itm
+char	image[SZ_FNAME], title[SZ_LINE], root[SZ_FNAME]
+int	ncols, rec, beam_nr
+int	bsflag, exflag
+
+pointer	imin, imout, spec
+char	bs_image[SZ_FNAME]
+
+pointer	immap(), impl1r()
+
+begin
+	# Create new image with user area
+	# Use ROOT for spectrum name and increment starting record number
+
+	call sprintf (bs_image, SZ_FNAME, "%s.%04d")
+	    call pargstr (root)
+	    call pargi (rec)
+
+	rec = rec + 1
+
+	# Provide user info
+	call printf ("writing: [%s] %s\n")
+	    call pargstr (bs_image)
+	    call pargstr (title)
+	call flush (STDOUT)
+
+	imin = immap (image, READ_ONLY, 0)
+	imout = immap (bs_image, NEW_COPY, imin)
+
+	# Add standard image header
+	IM_NDIM(imout) = 1
+	IM_LEN(imout,1) = ncols
+	IM_PIXTYPE(imout) = TY_REAL
+	call strcpy (title, IM_TITLE(imout), SZ_LINE)
+
+	# Write out pixels
+	spec = impl1r (imout)
+	call amovr (accum, Memr[spec], ncols)
+
+	# Update changed parameters
+	if(bsflag == 1)
+	    call imaddi (imout, "BS-FLAG", bsflag)
+	call imaddr (imout, "EXPTIME", itm)
+	call imaddi (imout, "EX-FLAG", exflag)
+
+	call imunmap (imin)
+	call imunmap (imout)
+
+	# Store new image name back into image
+	call strcpy (bs_image, image, SZ_FNAME)
+end
+
+# ACCUM_NORM - Normalize weighted rate and convert to counts
+
+procedure accum_norm (accum, nr, counts, exp, ncols, weight)
+
+real	accum[ARB], counts[ARB], exp
+int	nr, ncols
+bool	weight
+
+real	sum_wt
+int	i
+
+begin
+	# The accumulation is an array weighted by non-normalized weights
+	# Normalize to total weight to produce a true weighted average
+	# and multiply by the total exposure to produce
+	# an equivalent sum
+
+	# Add up all weighting factors
+	if (weight) {
+	    sum_wt = 0.0
+	    do i = 1, nr
+		sum_wt = sum_wt + counts[i]
+	} else
+	    sum_wt = real (nr)
+
+	if (sum_wt == 0.0)
+	    sum_wt = 1.0
+
+	# Correct for exposure time
+	sum_wt = exp / sum_wt
+
+	call amulkr (accum, sum_wt, accum, ncols)
+end
+
+# WRT_ACCUM -- Write out accumulations as spectra
+
+procedure wrt_accum (ids, image, title, accumo, accums, ico, ics, 
+	counto, counts, expo, exps, ncols, beam_stat, idsmode, weight, 
+	extinct, ofile, start_rec, sub_rate)
+
+pointer	ids[ARB]
+char	image[SZ_FNAME,MAX_NR_BEAMS+1], title[SZ_LINE,MAX_NR_BEAMS]
+
+pointer	accumo[ARB], accums[ARB]
+pointer	counto[ARB], counts[ARB]
+int	ico   [ARB], ics   [ARB]
+real	expo  [ARB], exps  [ARB]
+int	ncols[ARB]
+int	beam_stat[ARB]
+bool	idsmode, weight, extinct
+char	ofile[SZ_FNAME]
+int	start_rec, sub_rate, bsflag
+
+int	i, nr_beams
+real	exp_ratio
+
+begin
+	# First compute number of beams
+	nr_beams = 0
+	do i = 1, MAX_NR_BEAMS
+	    if (!IS_INDEFI (beam_stat[i]) && ((ico[i] > 0) || (ics[i] > 0)))
+		nr_beams = nr_beams + 1
+
+	# For all present apertures, write out a spectrum
+	do i = 1, MAX_NR_BEAMS {
+
+	    if (!IS_INDEFI (beam_stat[i]) && ((ico[i] > 0) || (ics[i] > 0))) {
+		if (beam_stat[i] != 0 && idsmode) {
+		    call eprintf ("Non-equal number of obj-sky observations")
+		    call eprintf (" beam: %d - residual: %d\n")
+			call pargi (i-1)
+		        call pargi (beam_stat[i])
+
+		    # Reset to 0 and force output
+		    beam_stat[i] = 0
+		}
+
+		# The accumulator has a total CPS using non-normalized
+		# weights - apply normalization and exposure time to
+		# generate an equivalent COUNT sum.
+		call accum_norm (Memr[accumo[i]], ico[i], Memr[counto[i]], 
+			expo[i], ncols[i], weight)
+
+		if (!idsmode) {
+		    # Separate object and sky sums require sky info
+		    call accum_norm (Memr[accums[i]], ics[i], Memr[counts[i]],
+			exps[i], ncols[i], weight)
+
+		    # Then normalize sky exposure time to that of object
+		    if (exps[i] != 0.0)
+			exp_ratio = expo[i]/exps[i]
+		    else
+			exp_ratio = 1.0
+
+		    # Check that some object observtion was made
+		    # If not, then we only have sky data so multiply by -1
+		    # so that the subsequent subtraction will produce a
+		    # positive sky
+		    if (expo[i] == 0.0)
+			exp_ratio = -1.0
+
+		    if (exp_ratio != 1.0)
+			call amulkr (Memr[accums[i]], exp_ratio,
+			    Memr[accums[i]], ncols[i])
+
+		    # Finally subtract sky from object equivalent counts
+		    call asubr (Memr[accumo[i]], Memr[accums[i]], 
+			Memr[accumo[i]], ncols[i])
+
+		}
+		# Set header flags
+		# BS flag is not set if the subset rate equals the
+		# number of apertures since each record in is copied out
+		if (sub_rate > nr_beams)
+		    bsflag = 1
+		else
+		    bsflag = -1
+
+		if (OFLAG(ids[i]) == 1)
+		    IT(ids[i]) = expo[i]
+		else
+		    IT(ids[i]) = exps[i]
+
+		if (extinct)
+		    EC(ids[i]) = 0
+
+		# And write out spectrum, at last
+		call accum_out (Memr[accumo[i]], image[1,i], 
+		    ncols[i], title[1,i], ofile, start_rec, i,
+		    bsflag, IT(ids[i]), EC(ids[i]))
+
+		# Reset name entry counter
+		call init_name (i)
+	    }
+
+	}
+end
+
+# RESET_BEAMS -- Zeroes the counters and accumulators for additional
+#                cases
+
+procedure reset_beams (accumo, accums, expo, exps, ico, ics, beam_stat, ncols)
+
+pointer	accumo[ARB], accums[ARB]
+real	expo  [ARB], exps  [ARB]
+int	ico   [ARB], ics   [ARB]
+int	beam_stat[ARB], ncols[ARB]
+
+int	i
+
+begin
+	do i = 1, MAX_NR_BEAMS
+	    if (!IS_INDEFI (beam_stat[i])) {
+
+		expo[i] = 0.0
+		exps[i] = 0.0
+		ico[i]  = 0
+		ics[i]  = 0
+		call amovkr (0.0, Memr[accumo[i]], ncols[i])
+		call amovkr (0.0, Memr[accums[i]], ncols[i])
+	    }
+end
+
+# WRT_STATS -- Write out statistics file
+
+procedure wrt_stats (fd, accumo, accums, ico, ics, counto, counts,
+     expo, exps, image, beam_stat, title, imnames, weight)
+
+int	fd
+pointer	accumo[ARB], accums[ARB], counto[ARB], counts[ARB]
+real	expo[ARB], exps[ARB]
+int	ico[ARB], ics[ARB], beam_stat[ARB]
+char	image[SZ_FNAME,MAX_NR_BEAMS+1]
+char	title[ARB]
+pointer	imnames[ARB]
+bool	weight
+
+int	i, j
+real	cmaxo, cmaxs
+char	ctime[SZ_TIME]
+
+long	clktime()
+
+begin
+	# Issue time stamp
+	call cnvtime (clktime (long(0)), ctime, SZ_TIME)
+	call fprintf (fd, "%s\n\n")
+	    call pargstr (ctime)
+
+	# Issue message if weighted sums in effect
+	if (weight)
+	    call fprintf (fd, "--> Using weighted averages <--\n\n")
+
+	# Cycle over beams
+	do i = 1, MAX_NR_BEAMS {
+	    if (!IS_INDEFI (beam_stat[i])) {
+
+		# Write out Object stats if any
+		if (ico[i] > 0) {
+		    call fprintf (fd, "Object statistics for beam %d -->[%s]\n")
+			call pargi (i-1)
+			call pargstr (image[1,i])
+		    call fprintf (fd, "Title: %s\n")
+			call pargstr (title)
+
+		    # Find maximum count value for this beam
+		    cmaxo = Memr[counto[i]]
+
+		    do j = 1, ico[i]
+		        cmaxo = max (cmaxo, Memr[counto[i]+j-1])
+
+		    call fprintf (fd,
+			"Obs  Relative CPS   Image%12wPeak CPS = %10.3g\n")
+			call pargr (cmaxo)
+
+		    if (cmaxo == 0.0)
+			cmaxo = 1.0
+
+		    do j = 1, ico[i] {
+			call fprintf (fd, "%3d    %8.2f    [%s]\n")
+			    call pargi (j)
+			    call pargr (Memr[counto[i]+j-1] / cmaxo)
+			    call pargstr (Memc[Memi[imnames[i]+j-1]])
+		    }
+		}
+
+		# Write out sky stats if any
+		if (ics[i] > 0) {
+		    call fprintf (fd, "Sky statistics for beam %d\n")
+			call pargi (i-1)
+
+		    cmaxs = Memr[counts[i]]
+
+		    do j = 1, ics[i]
+		        cmaxs = max (cmaxs, Memr[counts[i]+j-1])
+
+		    call fprintf (fd, "Obs  Relative CPS   Peak CPS = %10.3g\n")
+			call pargr (cmaxs)
+
+		    if (cmaxs == 0.0)
+			cmaxs = 1.0
+
+		    do j = 1, ics[i] {
+			call fprintf (fd, "%3d    %8.2f\n")
+			    call pargi (j)
+			    call pargr (Memr[counts[i]+j-1] / cmaxs)
+		    }
+		}
+
+		call fprintf (fd, "\n\n")
+	    }
+	}
+end
+
+
+# ADD_SPEC -- Accumulate spectrum into array - either add or subtract
+#             Returns status = net number of object - sky apectra
+#                            = 0 for equal numbers to indicate further
+#                              processing may take place
+
+procedure add_spec (inspec, accum, stat, flag, len)
+
+real	inspec[ARB], accum[ARB]
+int	stat, flag, len
+
+int	i, add_sub
+
+begin
+	add_sub = 0
+
+	# Is this an Object or Sky?
+	# If flag is neither 0 or 1, spectrum is ignored
+	if (flag == 0)
+	    add_sub = -1
+	if (flag == 1)
+	    add_sub = +1
+
+	if (add_sub == 0) {
+	    stat = INDEFI
+	    return
+	}
+
+	# Is accumulator to be cleared?
+	if (IS_INDEFI (stat) || stat == 0) {
+	    call amulkr (inspec, real (add_sub), accum, len)
+	    stat = add_sub
+
+	} else {
+	    # Add into accumulator
+	    do i = 1, len
+		accum[i] = accum[i] + add_sub * inspec[i]
+
+	    stat = stat + add_sub
+	}
+end
+
+# FLAG_CHK -- Check header flags prior to beam switching
+
+procedure flag_chk (ids, exflag)
+
+pointer	ids
+bool	exflag
+
+int	bsflag, imgeti()
+
+begin
+	# BS requires 
+	# 1. dispersion corrected spectra
+	# 2. non-beam switched
+	# 3. may be either extinction corrected or not
+
+	if (DC(ids) != DCLINEAR)
+	    call error (0, "Spectrum not dispersion corrected")
+
+	iferr (bsflag = imgeti (IM(ids), "BS-FLAG"))
+	    bsflag = -1
+	if (bsflag == 1)
+	    call error (0, "Spectrum already beam-switched")
+
+	if (EC(ids) == ECYES)
+	    exflag = true
+	else
+	    exflag = false
+end
diff --git a/noao/onedspec/irsiids/t_coefs.x b/noao/onedspec/irsiids/t_coefs.x
new file mode 100644
index 00000000..656e777d
--- /dev/null
+++ b/noao/onedspec/irsiids/t_coefs.x
@@ -0,0 +1,88 @@
+include	<error.h>
+
+# COEFS --  Convert IIDS/IRS coeffients to IDENTIFY database entry.
+
+procedure t_coefs ()
+
+int	root			# List of input root names
+pointer	database		# Output database directory
+
+int	i, nrecs, ncoefs
+real	coef
+pointer	sp, image, dtname, recs, im, dt
+
+real	imgetr()
+int	clpopni(), imgeti(), get_next_image(), decode_ranges()
+pointer	immap(), dtmap1()
+errchk	imgetr, dtmap1
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_LINE, TY_CHAR)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call salloc (dtname, SZ_FNAME, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+
+	root   = clpopni ("input")
+	call clgstr ("records", Memc[image], SZ_LINE)
+	call clgstr ("database", Memc[database], SZ_LINE)
+
+	if (decode_ranges (Memc[image], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	# Loop over all input images - print name on STDOUT
+	call reset_next_image ()
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image],
+	    SZ_LINE) != EOF) {
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    iferr (ncoefs = imgeti (im, "DF-FLAG"))
+		ncoefs = -1
+	    if (ncoefs > 1) {
+		call strcpy ("id", Memc[dtname], SZ_FNAME)
+		call imgcluster (Memc[image], Memc[dtname+2], SZ_FNAME)
+		dt = dtmap1 (Memc[database], Memc[dtname], APPEND)
+
+		call dtptime (dt)
+		call dtput (dt, "begin\tidentify %s\n")
+		    call pargstr (Memc[image])
+		call dtput (dt, "\tid\t%s\n")
+		    call pargstr (Memc[image])
+		call dtput (dt, "\ttask\tidentify\n")
+		call dtput (dt, "\timage\t%s\n")
+		    call pargstr (Memc[image])
+
+		# Convert coefficients
+		call dtput (dt, "\tcoefficients\t%d\n")
+		    call pargi (ncoefs+4)
+		call dtput (dt, "\t\t2\n")
+		call dtput (dt, "\t\t%1d\n")
+		    call pargi (ncoefs)
+		call dtput (dt, "\t\t1\n")
+		call dtput (dt, "\t\t1024\n")
+
+		do i = 1, ncoefs {
+		    call sprintf (Memc[dtname], SZ_FNAME, "DF%d")
+			call pargi (i)
+		    coef = imgetr (im, Memc[dtname])
+		    call dtput (dt, "\t\t%10.4f\n")
+			call pargr (coef)
+		}
+
+		call dtput (dt, "\n")
+		call dtunmap (dt)
+	    }
+
+	    call printf ("[%s] %d coefficients written\n")
+		call pargstr (Memc[image])
+		call pargi (max (0, ncoefs))
+	    call flush (STDOUT)
+	    call imunmap (im)
+	}
+
+	call clpcls (root)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/irsiids/t_coincor.x b/noao/onedspec/irsiids/t_coincor.x
new file mode 100644
index 00000000..ad2d8bd4
--- /dev/null
+++ b/noao/onedspec/irsiids/t_coincor.x
@@ -0,0 +1,102 @@
+include	<error.h>
+include	<imhdr.h>
+
+
+# T_COINCOR -- Apply coincidence corrections to spectra
+
+procedure t_coincor ()
+
+int	root, start_rec, ccmode, npts, nrecs, coflag
+real	dtime, power, expo
+pointer	sp, image, ofile, str, recs, imin, imout, pixin, pixout
+
+int	clpopni(), clgeti(), clgwrd(), imgeti()
+int	get_next_image(), decode_ranges()
+real	clgetr(), imgetr()
+pointer	immap(), imgl1r(), impl1r()
+errchk	coincor
+
+begin
+	# Allocate memory
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+
+	# Get parameters
+	root   = clpopni ("input")
+	call clgstr ("output", Memc[ofile], SZ_FNAME)
+	if (Memc[ofile] != EOS)
+	    start_rec = clgeti ("start_rec")
+	ccmode = clgwrd ("ccmode", Memc[str], SZ_LINE, ",photo,iids,")
+	dtime = clgetr ("deadtime")
+	power = clgetr ("power")
+	call clgstr ("records", Memc[str], SZ_LINE)
+
+	# Initialize
+	if (decode_ranges (Memc[str], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+	call reset_next_image ()
+
+	# Loop over all input images by subsets
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image],
+	    SZ_FNAME) != EOF) {
+
+	    # Open input image and check coincidence flag
+	    iferr (imin = immap (Memc[image], READ_WRITE, 0)) {
+		call erract (EA_WARN)
+	        start_rec = start_rec + 1
+		next
+	    }
+	    iferr (coflag = imgeti (imin, "CO-FLAG"))
+		coflag = -1
+	    if (coflag > 0) {
+		call printf ("[%s] already coincidence corrected\n")
+		    call pargstr (IM_HDRFILE(imin))
+		call flush (STDOUT)
+		call imunmap (imin)
+		next
+	    }
+
+	    # Open output image
+	    if (Memc[ofile] != EOS) {
+		call sprintf (Memc[str], SZ_LINE, "%s.%04d")
+		    call pargstr (Memc[ofile])
+		    call pargi (start_rec)
+		start_rec = start_rec + 1
+
+		imout = immap (Memc[str], NEW_COPY, imin)
+		IM_PIXTYPE (imout) = TY_REAL
+	    } else
+		imout = imin
+
+	    # Apply coincidence correction
+	    pixin = imgl1r (imin)
+	    pixout = impl1r (imout)
+	    npts = IM_LEN (imin, 1)
+	    iferr (expo = imgetr (imin, "EXPOSURE"))
+		iferr (expo = imgetr (imin, "ITIME"))
+		    iferr (expo = imgetr (imin, "EXPTIME"))
+			expo = 1
+	    call coincor (Memr[pixin], Memr[pixout], npts, expo, coflag,
+		dtime, power, ccmode)
+
+	    # Update flag and write status
+	    call imaddi (imout, "CO-FLAG", coflag)
+	    call printf ("[%s] --> [%s] %s\n")
+		call pargstr (IM_HDRFILE(imin))
+		call pargstr (IM_HDRFILE(imout))
+		call pargstr (IM_TITLE(imout))
+	    call flush (STDOUT)
+
+	    # Close images
+	    if (imout != imin)
+		call imunmap (imout)
+	    call imunmap (imin)
+	}
+
+	call clputi ("next_rec", start_rec)
+	call clpcls (root)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/irsiids/t_flatdiv.x b/noao/onedspec/irsiids/t_flatdiv.x
new file mode 100644
index 00000000..37186878
--- /dev/null
+++ b/noao/onedspec/irsiids/t_flatdiv.x
@@ -0,0 +1,276 @@
+include	<imhdr.h>
+include	<error.h>
+
+define	MAX_NR_BEAMS	100	# Max number of instrument apertures
+
+# T_FLATDIV -- Divide by a flat field spectrum. This is basically
+#  a simple division of two vectors but with the following
+#  additional functions:
+#
+#	1. Check the processing flag of the input spectra to avoid
+#	   double processing, and set the flag if the processing is
+#	   performed.
+#	2. Trap division by zero errors
+#	3. Optionally apply coincidence corrections
+
+procedure t_flatdiv ()
+
+int	root, start_rec
+int	nrecs
+int	len_flat
+int	ccmode, qd_flag
+real	dtime
+real	power
+bool	coincidence
+pointer	sp, image, str, ofile, flat, recs, bstat, flatsp, im
+
+int	clpopni(), clgeti(), clgwrd(), imgeti()
+int	get_next_image(), decode_ranges()
+real	clgetr()
+bool	clgetb()
+pointer	immap()
+errchk	get_flatsp
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (flat, SZ_FNAME, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+	call salloc (bstat, MAX_NR_BEAMS, TY_INT)
+
+	# Open input file name template
+	root   = clpopni ("input")
+
+	# Get range specification if any
+	call clgstr ("records", Memc[str], SZ_LINE)
+	if (decode_ranges (Memc[str], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	# Get rootname for output files and starting record
+	# Subtract 1 from start_rec because 1 will be added later.
+	call clgstr ("output", Memc[ofile], SZ_FNAME)
+	start_rec = clgeti ("start_rec") - 1
+
+	# Get flat field spectrum root name
+	call clgstr ("flat_file", Memc[flat], SZ_FNAME)
+
+	# Apply coincidence corrections?
+	coincidence = clgetb ("coincor")
+	if (coincidence) {
+	    ccmode = clgwrd ("ccmode", Memc[str], SZ_LINE, ",photo,iids,")
+	    dtime  = clgetr ("deadtime")
+	    power = clgetr ("power")
+	}
+
+	# Initialize beam number status
+	call init_bs (Memi[bstat])
+
+	# Initialize range decoder
+	call reset_next_image ()
+
+	# Loop over all input images - divide and make new image.
+	# The output record number is incremented in all cases.
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image],
+	    SZ_FNAME) != EOF) {
+	    start_rec = start_rec + 1
+
+	    # Open image
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Get header
+	    iferr (qd_flag = imgeti (im, "QD-FLAG"))
+		qd_flag = -1
+	    
+	    # Verify divide flag
+	    if (qd_flag != 0) {
+
+		# Get flat field spectrum if needed
+		call get_flatsp (im, flatsp, Memc[flat], Memi[bstat], len_flat)
+
+		# Calibrate the current spectrum and make a calibrated version
+		call divide (im, flatsp, len_flat, Memc[image], Memc[ofile],
+		    start_rec, coincidence, ccmode, dtime, power)
+
+	    } else {
+		call eprintf ("[%s] already divided - ignored\n")
+		    call pargstr (Memc[image])
+	    }
+	}
+
+	# Update record number
+	call clputi ("next_rec", start_rec)
+
+	# Free space
+	call sfree (sp)
+	call clpcls (root)
+end
+
+# GET_FLATSP -- Load flat field spectrum for the current beam number
+
+procedure get_flatsp (im, sp, flat_file, beam_stat, len_flat)
+
+pointer	im, sp
+char	flat_file[SZ_FNAME]
+int	beam_stat[ARB], len_flat
+
+int	i
+int	beam, len[MAX_NR_BEAMS]
+char	sfname[SZ_FNAME]
+pointer	flatsp[MAX_NR_BEAMS], imflat
+
+int	strlen(), imgeti()
+pointer	imgl1r(), immap()
+errchk	immap
+
+begin
+	# Determine beam number.
+
+	iferr (beam = imgeti (im, "BEAM-NUM"))
+	    beam = 0
+	beam = beam + 1
+
+	# Validate beam number
+	if (beam < 1 || beam > MAX_NR_BEAMS) {
+	    call eprintf (" Beam number out of range: %d - using 0\n")
+		call pargi (beam)
+	    beam = 1
+	}
+
+	# Has this beam already been loaded?
+	if (IS_INDEFI (beam_stat[beam])) {
+
+	    # Create file name
+	    call strcpy (flat_file, sfname, SZ_FNAME)
+
+	    # Flat field file names have beam number appended
+	    call sprintf (sfname[strlen(sfname)+1], SZ_FNAME, ".%04d")
+		call pargi (beam-1)
+
+	    # Open spectrum
+	    imflat = immap (sfname, READ_ONLY, 0)
+
+	    # Allocate space for this beam's sensitivity spectrum
+	    call salloc (flatsp[beam], IM_LEN(imflat,1), TY_REAL)
+
+	    # Copy pixels into space
+	    call amovr (Memr[imgl1r(imflat)], Memr[flatsp[beam]],
+		IM_LEN(imflat,1))
+
+	    # Must be careful that no division by zero occurs.
+	    do i = 1, IM_LEN(imflat,1) {
+		if (Memr[flatsp[beam]+i-1] == 0.0)
+		    Memr[flatsp[beam]+i-1] = 1.0
+	    }
+
+	    # Mark this beam accounted for
+	    beam_stat[beam] = 1
+	    len[beam] = IM_LEN(imflat,1)
+
+	    call imunmap (imflat)
+	}
+
+	# Point to the spectrum
+	sp = flatsp[beam]
+	len_flat = len[beam]
+
+end
+
+# DIVIDE -- Perform the division and create new spectrum
+
+procedure divide (im, flat, len_flat, ifile, ofile, rec, 
+	coincidence, ccmode, dtime, power)
+
+pointer	im, flat
+int	len_flat, rec, ccmode
+real	dtime, power
+char	ifile[ARB], ofile[ARB]
+bool	coincidence
+
+real	itm, imgetr()
+int	i, co_flag, imgeti()
+int	ncols, nlines
+char	calfname[SZ_FNAME], original[SZ_FNAME]
+pointer	imcal, rawpix, calpix
+
+pointer	immap(), impl2r(), imgl2r()
+
+begin
+	# Find smallest length of the two possible spectra
+	ncols = min (IM_LEN (im, 1), len_flat)
+
+	# Create new spectrum.  Make up a name
+	call sprintf (calfname, SZ_FNAME, "%s.%04d")
+	    call pargstr (ofile)
+	    call pargi (rec)
+
+	call xt_mkimtemp (ifile, calfname, original, SZ_FNAME)
+	imcal = immap (calfname, NEW_COPY, im)
+
+	IM_NDIM(imcal) = IM_NDIM(im)
+	IM_LEN (imcal,1) = ncols
+	IM_PIXTYPE(imcal) = TY_REAL
+
+	# Check for 2D spectrum
+	if (IM_NDIM(im) > 1)
+	    nlines = IM_LEN(im,2)
+	else
+	    nlines = 1
+
+	# Copy across the image title
+	call strcpy (IM_TITLE(im), IM_TITLE(imcal), SZ_LINE)
+
+	# Operate on the pixels
+	do i = 1, nlines {
+	    rawpix = imgl2r (im,i)
+	    calpix = impl2r (imcal,i)
+
+	    # Apply coincidence correction if needed
+	    co_flag = -1
+	    if (coincidence) {
+		iferr (co_flag = imgeti (im, "CO-FLAG"))
+		    ;
+	        if (co_flag < 1) {
+		    iferr (itm = imgetr (im, "EXPOSURE"))
+			iferr (itm = imgetr (im, "ITIME"))
+			    iferr (itm = imgetr (im, "EXPTIME"))
+				itm = 1.
+		    call coincor (Memr[rawpix], Memr[rawpix], ncols,
+			itm, co_flag, dtime, power, ccmode)
+		}
+	    }
+
+	    call adivr (Memr[rawpix], Memr[flat], Memr[calpix], ncols)
+	}
+
+	call imaddi (imcal, "QD-FLAG", 0)
+	if (co_flag != -1)
+	    call imaddi (imcal, "CO-FLAG", co_flag)
+
+	# Send user report
+	call printf ("writing [%s]: %s\n")
+	    call pargstr (original)
+	    call pargstr (IM_TITLE(imcal))
+	call flush (STDOUT)
+
+	call imunmap (im)
+	call imunmap (imcal)
+	call xt_delimtemp (calfname, original)
+end
+
+# INIT_BS -- Initialize beam status flags
+
+procedure init_bs (beam_stat)
+
+int	beam_stat[ARB]
+
+int	i
+
+begin
+	do i = 1, MAX_NR_BEAMS
+	    beam_stat[i] = INDEFI
+end
diff --git a/noao/onedspec/irsiids/t_flatfit.x b/noao/onedspec/irsiids/t_flatfit.x
new file mode 100644
index 00000000..c3558afc
--- /dev/null
+++ b/noao/onedspec/irsiids/t_flatfit.x
@@ -0,0 +1,740 @@
+include	<imhdr.h>
+include	<math/curfit.h>
+include	<gset.h>
+
+define	MAX_NR_BEAMS	100	# Max number of instrument apertures
+
+define	KEY		"noao$lib/scr/flatfit.key"
+define	PROMPT		"flatfit cursor options"
+
+# Definitions for Plotting modes
+define	PLT_FIT	1		# Plot the direct fit
+define	PLT_ERR	2		# Plot the errors in the fit
+define	PLT_LIN	3		# Plot the fit minus the linear part
+
+# T_FLATFIT -- Accumulate a series of flat field spectra to produce
+#  a grand sum and fit a function to the sum to produce a normalized
+#  flat containing the pixel-to-pixel variations.
+#  User interaction via the graphics cursor is provided. The following
+#  cursor commands are recognized:
+#
+#	? - Screen help
+#	/ - Status line help
+#	e - Plot in residual error mode
+#	f - Plot in fit to the data mode
+#	o - Change order of fit
+#	l - Change lower rejection sigma
+#	u - Change upper rejection sigma
+#	r - Reset fit to include rejected pixels
+#	s - Change upper and lower sigmas to same value
+#	i - Iterate again
+#	n - Iterate N times
+#	q - Quit and accept current solution (also RETURN)
+#
+
+procedure t_flatfit ()
+
+pointer	image					# Image name to be fit
+pointer	images					# Image name to be fit
+pointer	ofile					# Output image file name
+int	function				# Fitting function
+int	order					# Order of fitting function
+int	recs					# Spectral record numbers
+int	root, nrecs				# CL and ranges flags
+real	expo					# Exposure time
+real	dtime					# Deadtime
+real	power					# Power law coin. correction
+real	lower					# Lower rejection sigma
+real	upper					# Upper threshold sigma
+int	ngrow					# Rejection radius
+real	div_min					# Division min for option RESP
+bool	coincidence, all			# Apply coincidence correction
+bool	interact				# Interactive levels
+pointer	bstat					# Status of each aperture
+pointer	npts					# Length of spectrum
+pointer	esum					# Accumulated exposure time
+pointer	accum					# Pointers to beam accumulators
+pointer	title
+int	ccmode, beam
+int	niter
+
+int	i
+pointer	sp, str, im
+
+int	clgeti(), clgwrd(), clpopni(), imgeti()
+int	get_next_image(), decode_ranges()
+real	clgetr(), imgetr()
+bool	clgetb()
+pointer	immap()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (images, MAX_NR_BEAMS, TY_POINTER)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+	call salloc (bstat, MAX_NR_BEAMS, TY_INT)
+	call salloc (npts, MAX_NR_BEAMS, TY_INT)
+	call salloc (esum, MAX_NR_BEAMS, TY_REAL)
+	call salloc (accum, MAX_NR_BEAMS, TY_POINTER)
+	call salloc (title, MAX_NR_BEAMS, TY_POINTER)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call amovki (NULL, Memi[images], MAX_NR_BEAMS)
+
+	# Get task parameters.
+	root = clpopni ("input")
+
+	# Get input record numbers
+	call clgstr ("records", Memc[str], SZ_LINE)
+	if (decode_ranges (Memc[str], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	call clgstr ("output", Memc[ofile], SZ_LINE)
+
+	call clgcurfit ("function", "order", function, order)
+
+	lower = clgetr ("lower")
+	upper = clgetr ("upper")
+	ngrow = clgeti ("ngrow")
+	div_min = clgetr ("div_min")
+
+	# Determine desired level of activity
+	interact = clgetb ("interact")
+	all      = clgetb ("all_interact")
+
+	niter = clgeti ("niter")
+
+	# Is coincidence correction to be performed?
+	coincidence = clgetb ("coincor")
+
+	if (coincidence) {
+	    ccmode = clgwrd ("ccmode", Memc[str], SZ_LINE, ",photo,iids,")
+	    dtime  = clgetr ("deadtime")
+	    power = clgetr ("power")
+	}
+
+	call reset_next_image ()
+
+	# Clear all beam status flags
+	call amovki (INDEFI, Memi[bstat], MAX_NR_BEAMS)
+	call aclrr (Memr[esum], MAX_NR_BEAMS)
+
+	call printf ("Accumulating spectra --\n")
+	call flush (STDOUT)
+
+10	while (get_next_image (root, Memi[recs], nrecs, Memc[image],
+	    SZ_FNAME) != EOF) {
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call eprintf ("Header info not available for [%s]\n")
+		    call pargstr (Memc[image])
+		goto 10
+	    }
+
+	    iferr (beam = imgeti (im, "BEAM-NUM"))
+		beam = 0
+	    if (beam < 0  || beam > MAX_NR_BEAMS-1)
+		call error (0, "Invalid aperture number")
+
+	    iferr (expo = imgetr (im, "EXPOSURE"))
+		iferr (expo = imgetr (im, "ITIME"))
+		    iferr (expo = imgetr (im, "EXPTIME"))
+			expo = 1
+
+	    # Add spectrum into accumulator
+	    if (IS_INDEFI (Memi[bstat+beam])) {
+	        Memi[npts+beam] = IM_LEN (im,1)
+	        call salloc (Memi[accum+beam], Memi[npts+beam], TY_REAL)
+	        call aclrr (Memr[Memi[accum+beam]], Memi[npts+beam])
+	        Memi[bstat+beam] = 0
+
+	        call salloc (Memi[title+beam], SZ_LINE, TY_CHAR)
+	        call strcpy (IM_TITLE(im), Memc[Memi[title+beam]], SZ_LINE)
+	    }
+
+	    call ff_accum_spec (im, Memi[npts], expo, Memi[bstat], beam+1,
+		Memi[accum], Memr[esum], coincidence, ccmode, dtime, power,
+		Memi[title])
+
+	    call printf ("[%s] added to aperture %1d\n")
+		call pargstr (Memc[image])
+		call pargi (beam)
+	    call flush (STDOUT)
+	    if (Memi[images+beam] == NULL)
+		call salloc (Memi[images+beam], SZ_FNAME, TY_CHAR)
+	    call strcpy (Memc[image], Memc[Memi[images+beam]], SZ_FNAME)
+
+	    call imunmap (im)
+	}
+
+	# Review all apertures containing data and perform fits.
+	# Act interactively if desired
+	do i = 0, MAX_NR_BEAMS-1 {
+	    if (!IS_INDEFI (Memi[bstat+i])) {
+		call fit_spec (Memr[Memi[accum+i]], Memi[npts+i], Memr[esum+i],
+		    interact, function, order, niter, lower, upper, ngrow,
+		    div_min, i)
+		if (interact & !all)
+		    interact = false
+		call wrt_fit_spec (Memc[Memi[images+i]], Memr[Memi[accum+i]],
+		    Memr[esum+i], Memc[ofile], i, Memc[Memi[title+i]],
+		    Memi[npts+i], order)
+	    }
+	}
+
+	call sfree (sp)
+	call clpcls (root)
+end
+
+# ACCUM_SPEC -- Accumulate spectra by beams
+
+procedure ff_accum_spec (im, len, expo, beam_stat, beam, accum, expo_sum,
+	coincidence, ccmode, dtime, power, title)
+
+pointer	im, accum[ARB], title[ARB]
+real	expo, expo_sum[ARB]
+int	beam_stat[ARB], beam, len[ARB]
+bool	coincidence
+int	ccmode
+real	dtime, power
+
+int	npts, co_flag, imgeti()
+pointer	pix
+
+pointer	imgl1r()
+
+begin
+	npts = IM_LEN (im, 1)
+
+	# Map pixels and optionally correct for coincidence
+	pix = imgl1r (im)
+	if (coincidence) {
+	    iferr (co_flag = imgeti (im, "CO-FLAG"))
+		co_flag = -1
+	    if (co_flag < 1) {
+		call coincor (Memr[pix], Memr[pix], npts, expo, co_flag,
+		    dtime, power, ccmode)
+	    }
+	}
+
+	# Add in the current data
+	npts = min (npts, len[beam])
+
+	call aaddr (Memr[pix], Memr[accum[beam]], Memr[accum[beam]], npts)
+
+	beam_stat[beam] = beam_stat[beam] + 1
+	expo_sum [beam] = expo_sum [beam] + expo
+end
+
+# WRT_FIT_SPEC -- Write out normalized spectrum
+
+procedure wrt_fit_spec (image, accum, expo_sum, ofile, beam, title, npts, order)
+
+char	image[SZ_FNAME]
+real	accum[ARB], expo_sum
+int	beam, npts, order
+char	ofile[SZ_FNAME]
+char	title[SZ_LINE]
+
+char	output[SZ_FNAME], temp[SZ_LINE]
+pointer	im, imnew, newpix
+
+pointer	immap(), impl1r()
+int	strlen()
+
+begin
+	im = immap (image, READ_ONLY, 0)
+10	call strcpy (ofile, output, SZ_FNAME)
+	call sprintf (output[strlen (output) + 1], SZ_FNAME, ".%04d")
+	    call pargi (beam)
+
+	# Create new image with a user area
+	# If an error occurs, ask user for another name to try
+	# since many open errors result from trying to overwrite an
+	# existing image.
+
+	iferr (imnew = immap (output, NEW_COPY, im)) {
+	    call eprintf ("Cannot create [%s] -- Already exists??\07\n")
+		call pargstr (output)
+	    call clgstr ("output", ofile, SZ_FNAME)
+	    go to 10
+	}
+
+	call strcpy ("Normalized flat:", temp, SZ_LINE)
+	call sprintf (temp[strlen (temp) + 1], SZ_LINE, "%s")
+	    call pargstr (title)
+	call strcpy (temp, IM_TITLE (imnew), SZ_LINE)
+	IM_PIXTYPE (imnew) = TY_REAL
+
+	newpix = impl1r (imnew)
+	call amovr (accum, Memr[newpix], npts)
+
+	call imaddr (imnew, "EXPOSURE", expo_sum)
+	call imaddi (imnew, "QF-FLAG", order)
+	call imunmap (im)
+	call imunmap (imnew)
+
+	call printf ("Fit for aperture %1d --> [%s]\n")
+	    call pargi (beam)
+	    call pargstr (output)
+	call flush (STDOUT)
+end
+
+# FIT_SPEC -- Fit a line through the spectrum with user interaction
+
+procedure fit_spec (accum, npts, expo_sum, interact, function, 
+	order, niter, lower, upper, ngrow, div_min, beam)
+
+real	accum[ARB], expo_sum
+bool	interact
+int	function, order, niter, ngrow, npts, beam
+real	lower, upper, div_min
+
+int	cc, key, gp, plt_mode
+int	i, initer, sum_niter, newgraph
+real	x1, y1, sigma, temp
+pointer	sp, wts, x, y, cv
+bool	first
+char	gtitle[SZ_LINE], command[SZ_FNAME]
+
+int	clgcur(), clgeti()
+pointer	gopen()
+real	clgetr(), cveval()
+
+data	plt_mode/PLT_FIT/
+
+begin
+	# Perform initial fit
+	call smark (sp)
+	call salloc (wts, npts, TY_REAL)
+	call salloc (x  , npts, TY_REAL)
+	call salloc (y  , npts, TY_REAL)
+
+	first = true
+	if (!interact) {
+	    sum_niter = 0
+	    do i = 1, niter
+		call linefit (accum, npts, function, order, lower, upper, 
+		    ngrow, cv, first, Memr[wts], Memr[x])
+	    sum_niter = niter
+
+	} else {
+	    gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	    call sprintf (gtitle, SZ_LINE, "Flat Field Sum - %f seconds ap:%1d")
+		call pargr (expo_sum)
+		call pargi (beam)
+
+	    key = 'r'
+	    repeat {
+		switch (key) {
+		    case 'e': # Plot errors
+			plt_mode = PLT_ERR
+			newgraph = YES
+
+		    case 'f': # Plot fit
+			plt_mode = PLT_FIT
+			newgraph = YES
+
+		    case 'o': # Change order
+			order = clgeti ("new_order")
+			# Reinstate all pixels
+			first = true
+			newgraph = YES
+
+		    case 'l': # Change lower sigma
+			lower = clgetr ("new_lower")
+			newgraph = YES
+
+		    case 'u': # Change upper sigma
+			upper = clgetr ("new_upper")
+			newgraph = YES
+
+		    case 'r': # Reset fit parameters
+			first = true
+			newgraph = YES
+
+		    case 's': # Change both rejection sigmas
+			lower = clgetr ("new_lower")
+			upper = lower
+			call clputr ("new_upper", upper)
+			newgraph = YES
+
+		    case 'i': # Iterate again - Drop thru
+			initer = 1
+			newgraph = YES
+
+		    case 'n': # Iterate n times
+			initer = clgeti ("new_niter")
+			newgraph = YES
+
+		    case 'q': # Quit
+			break
+
+		    case '?': # Clear and help
+			call gpagefile (gp, KEY, PROMPT)
+
+		    case '/': # Status line help
+			call ff_sts_help
+
+		    case 'I': # Interrupt
+			call fatal (0, "Interrupt")
+
+		    default:
+			call printf ("\07\n")
+		}
+
+		if (newgraph == YES) {
+		    # Suppress an iteration if plot mode change requested
+		    if (key != 'e' && key != 'f') {
+		        if (first) {
+			    sum_niter = 0
+			    initer = niter
+			    call cvfree (cv)
+		        }
+		        do i = 1, initer
+			    call linefit (accum, npts, function, order, lower, 
+			        upper, ngrow, cv, first, Memr[wts], Memr[x])
+		        sum_niter = sum_niter + initer
+		    }
+
+		    switch (plt_mode) {
+		    case PLT_FIT:
+		        call plot_fit (gp, accum, cv, function, order, npts, 
+			    gtitle, Memr[wts], Memr[x], Memr[y], sigma)
+		    case PLT_ERR:
+		        call plot_fit_er (gp, accum, cv, function, order, npts,
+			    gtitle, Memr[wts], Memr[x], Memr[y], sigma)
+		    }
+
+		    newgraph = NO
+	        }
+	    } until (clgcur ("cursor",x1,y1,cc,key,command,SZ_FNAME) == EOF)
+	    call gclose (gp)
+	}
+
+	# Replace original data with the data/fit
+	do i = 1, npts {
+	    temp = cveval (cv, real (i))
+	    if (temp == 0.0)
+		temp = max (temp, div_min)
+	    accum[i] = accum[i] / temp
+	}
+
+	call cvfree (cv)
+	call sfree (sp)
+
+	# Save iteration count for next time
+	niter = sum_niter
+end
+
+# LINEFIT -- Fit desired function thru data
+
+procedure linefit (pix, npts, function, order, lower, upper, ngrow, cv,
+	    first, wts, x)
+
+real	pix[ARB]			# Data array to fit
+int	npts				# Elements in array
+int	function			# Type of fitting function
+int	order				# Order of fitting function
+real	lower				# Lower rejection threshold
+real	upper				# Upper rejection threshold
+int	ngrow				# Rejection growing radius
+pointer	cv
+real	wts[ARB]			# Array weights
+real	x[ARB]
+bool	first
+
+int	ier, i, nreject
+
+int	reject()
+
+begin
+10	if (first) {
+	    do i = 1, npts {
+		x[i] = i
+		wts[i] = 1.0
+	    }
+
+	    # Initialize curve fitting.
+	    call cvinit (cv, function, order, 1., real (npts))
+	    call cvfit (cv, x, pix, wts, npts, WTS_USER, ier)
+	    nreject = 0
+	    first = false
+	}
+
+	# Do pixel rejection if desired.
+	if ((lower > 0.) || (upper > 0.))
+	        nreject = reject (cv, x, pix, wts, npts, lower, upper, ngrow)
+	else
+		nreject = 0
+
+	if (nreject == ERR) {
+	    call eprintf ("Cannot fit data -- too many points rejected??\n")
+	    call cvfree (cv)
+	    first = true
+	    go to 10
+	}
+end
+
+# REJECT -- Reject points with large residuals from the fit.
+#
+# The sigma of the input to the fit is calculated.  The rejection thresholds
+# are set at -lower*sigma and upper*sigma.  Points outside the rejection
+# thresholds are rejected from the fit and flaged by setting their
+# weights to zero.  Finally, the remaining points are refit and a new
+# fit line evaluated.  The number of points rejected is returned.
+
+int procedure reject (cv, x, y, w, npoints, lower, upper, ngrow)
+
+pointer	cv				# Curve descriptor
+real	x[ARB]				# Input ordinates
+real	y[ARB]				# Input data values
+real	w[ARB]				# Weights
+int	npoints				# Number of input points
+real	lower				# Lower rejection sigma
+real	upper				# Upper rejection sigma
+int	ngrow				# Rejection radius
+
+int	i, j, n, i_min, i_max, nreject
+real	sigma, residual, resid_min, resid_max
+
+real	cveval()
+
+begin
+	# Determine sigma of fit and set rejection limits.
+	sigma = 0.
+	n = 0
+	do i = 1, npoints {
+	    if (w[i] == 0.)
+		next
+	    sigma = sigma + (y[i] - cveval (cv, x[i])) ** 2
+	    n = n + 1
+	}
+
+	sigma = sqrt (sigma / (n - 1))
+	resid_min = -lower * sigma
+	resid_max = upper * sigma
+
+	# Reject the residuals exceeding the rejection limits.
+	nreject = 0
+	for (i = 1; i <= npoints; i = i + 1) {
+	    if (w[i] == 0.)
+		next
+	    residual = y[i] - cveval (cv, x[i])
+	    if ((residual < resid_min) || (residual > resid_max)) {
+		i_min = max (1, i - ngrow)
+		i_max = min (npoints, i + ngrow)
+
+		# Reject points from the fit and flag them with zero weight.
+		do j = i_min, i_max {
+		    call cvrject (cv, x[j], y[j], w[j])
+		    w[j] = 0.
+		    nreject = nreject + 1
+		}
+		i = i_max
+	    }
+	}
+
+	# Refit if points have been rejected.
+	if (nreject > 0) {
+	    call cvsolve (cv, i)
+	    if (i != OK)
+		return (ERR)
+	}
+
+	return (nreject)
+end
+
+# PLOT_FIT -- Plot the fit to the image line and data
+
+procedure plot_fit (gp, pix, cv, function, order, npts, gtitle, wts, xfit,
+	yfit, sigma)
+
+int	gp, npts, function, order
+real	pix[ARB], wts[ARB],  xfit[ARB], yfit[ARB]
+pointer	cv
+real	sigma
+char	gtitle[SZ_LINE]
+
+real	x1, x2
+int	i
+
+begin
+	# Set up plot
+	x1 = 1.0
+	x2 = npts
+
+	call gseti (gp, G_NMINOR, 0)
+	call gclear (gp)
+	call gsview (gp, 0.15, 0.95, 0.20, 0.9)
+	call gploto (gp, pix, npts, x1, x2, gtitle)
+
+	# Now plot the fit
+	do i = 1, npts
+	    xfit[i] = i
+
+	call cvvector (cv, xfit, yfit, npts)
+	call gvline (gp, yfit, npts, x1, x2)
+
+	# Compute sigma and write it out
+	call get_sigma (pix, yfit, wts, npts, sigma)
+	call show_status (function, order, sigma, npts, wts)
+end
+
+# PLOT_FIT_ER -- Plot the error in the fit to the image line and data
+
+procedure plot_fit_er (gp, pix, cv, function, order, npts, gtitle, wts, xfit,
+	yfit, sigma)
+
+int	gp, npts, function, order
+real	pix[ARB], wts[ARB], xfit[ARB], yfit[ARB]
+pointer	cv
+real	sigma
+char	gtitle[SZ_LINE]
+
+real	x1, x2, y[2]
+int	i
+
+begin
+	# Set up plot
+	x1 = 1.0
+	x2 = npts
+	y[1] = -0.0001
+	y[2] = +0.0001
+
+	call cvvector (cv, xfit, yfit, npts)
+
+	# Compute percentage errors
+	do i = 1, npts
+	    if (pix[i] != 0.0)
+		yfit[i] = (pix[i] - yfit[i]) / pix[i]
+	    else
+		yfit[i] = 0.0
+
+	call gseti (gp, G_NMINOR, 0)
+	call gclear (gp)
+	call gsview (gp, 0.15, 0.95, 0.20, 0.9)
+
+	call gploto (gp, yfit, npts, x1, x2, 
+	   "Flat field fractional error in fit")
+
+	# Draw a zero error line
+	call gline (gp, x1, y[1], x2, y[2])
+
+	# Compute sigma
+	call get_sigma0 (yfit, wts, npts, sigma)
+	call show_status (function, order, sigma, npts, wts)
+end
+
+# SHOW_STATUS -- Show the fit status on status line
+
+procedure show_status (function, order, sigma, npts, wts)
+
+int	function, order, npts
+real 	sigma, wts[ARB]
+
+int	i, nvals
+
+begin
+	# Count non-rejected points
+	nvals = 0
+	do i = 1, npts
+	    if (wts[i] != 0.0)
+		nvals = nvals + 1
+
+	call printf ("Fit type: %s    order: %2d    rms: %6.3f")
+	switch (function) {
+	    case LEGENDRE:
+		call pargstr ("Legendre")
+	    case CHEBYSHEV:
+		call pargstr ("Chebyshev")
+	    case SPLINE3:
+		call pargstr ("Spline3")
+	    case SPLINE1:
+		call pargstr ("Spline1")
+	    default:
+		call pargstr ("???")
+	}
+
+	    call pargi (order)
+	    call pargr (sigma)
+
+	call printf ("   points: %d out of %d")
+	    call pargi (nvals)
+	    call pargi (npts)
+
+	call flush (STDOUT)
+end
+
+# GET_SIGMA -- Compute rms error between two vectors whose average difference
+#              is zero.
+
+procedure get_sigma (y1, y2, wts, n, sigma)
+
+real	y1[ARB], y2[ARB], wts[ARB], sigma
+int	n
+
+int	i, nval
+real	sum
+
+begin
+	sum = 0.0
+	nval = 0
+	do i = 1, n
+	    if (wts[i] != 0.0) {
+		sum = sum + (y1[i] - y2[i]) ** 2
+		nval = nval + 1
+	    }
+
+	sigma = sqrt (sum / (nval-1))
+	return
+end
+
+# GET_SIGMA0 -- Compute rms error of a vector
+
+procedure get_sigma0 (y1, wts, n, sigma)
+
+real	y1[ARB], wts[ARB], sigma
+int	n
+
+int	i, nval
+real	sum
+
+begin
+	sum = 0.0
+	nval = 0
+	do i = 1, n
+	    if (wts[i] != 0.0) {
+		sum = sum + y1[i]**2
+		nval = nval + 1
+	    }
+
+	sigma = sqrt (sum / (nval-1))
+	return
+end
+
+# FF_STS_HELP -- Status line help for Flat Fit
+
+procedure ff_sts_help ()
+
+int	linenr, maxline
+
+data	linenr/1/
+data	maxline/2/
+
+begin
+	switch (linenr) {
+	    case 1:
+	    call printf ("e=err plot  f=data plot  o=order  l=lower sigma  ")
+	    call printf ("u=upper sigma  s=both sigmas")
+
+	    case 2:
+	    call printf ("r=incl reject  i=iterate  n=niterate  q=quit  ")
+	    call printf ("?=help  /=linehelp  <CR>=quit")
+	}
+
+	call flush (STDOUT)
+
+	linenr = linenr + 1
+	if (linenr > maxline)
+	    linenr = 1
+end
diff --git a/noao/onedspec/irsiids/t_slist1d.x b/noao/onedspec/irsiids/t_slist1d.x
new file mode 100644
index 00000000..75837d50
--- /dev/null
+++ b/noao/onedspec/irsiids/t_slist1d.x
@@ -0,0 +1,163 @@
+include	<error.h>
+include	<imhdr.h>
+include	<fset.h>
+include <smw.h>
+
+
+# SLIST1D --  Lists header information from IIDS/IRS format header
+# This is the original T_SLIST.
+
+procedure t_slist1d ()
+
+int	root
+int	long_header
+pointer	sp, image, im, mw, sh, ptr
+int	i, nl, df, sm, qf, qd, bs, co
+
+int	btoi(), imtgetim(), imgeti()
+bool	clgetb()
+pointer	imtopenp(), immap(), smw_openim()
+errchk	immap, smw_openim, shdr_open
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_LINE, TY_CHAR)
+
+	# Parameters
+	root = imtopenp ("input")
+	call clgstr ("records", Memc[image], SZ_LINE)
+	call odr_openp (root, Memc[image])
+	long_header = btoi (clgetb ("long_header"))
+
+	# Initialize
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Loop over all input images by subsets
+	while (imtgetim (root, Memc[image], SZ_FNAME) != EOF) {
+
+	    # Open image
+	    iferr {
+		im = NULL
+		mw = NULL
+		ptr = immap (Memc[image], READ_ONLY, 0); im = ptr
+		ptr = smw_openim (im); mw = ptr
+		call shdr_open (im, mw, 1, 1, INDEFI, SHHDR, sh)
+	    } then {
+		if (mw != NULL) {
+		    call smw_close (mw)
+		    if (sh != NULL)
+			MW(sh) = NULL
+		}
+		if (im != NULL)
+		    call imunmap (im)
+		call erract (EA_WARN)
+		next
+	    }
+
+	    nl = IM_LEN(im,2)
+	    do i = 1, nl {
+		call shdr_open (im, mw, i, 1, INDEFI, SHHDR, sh)
+
+		if (long_header == YES) {
+		    call printf ("[%s] %4dpts %s\n")
+			call pargstr (IMNAME(sh))
+			call pargi (SN(sh))
+			call pargstr (TITLE(sh))
+
+		    if (OFLAG(sh) == 1) {
+			call printf ("oflag = OBJECT, beam_number = %d")
+			    call pargi (BEAM(sh))
+		    } else if (OFLAG (sh) == 0) {
+			call printf ("oflag = SKY,    beam_number = %d")
+			    call pargi (BEAM(sh))
+		    }
+		    call printf (",\n")
+
+		    iferr (df = imgeti (im, "DF-FLAG"))
+			df = -1
+		    iferr (sm = imgeti (im, "SM-FLAG"))
+			sm = -1
+		    iferr (qf = imgeti (im, "QF-FLAG"))
+			qf = -1
+		    iferr (qd = imgeti (im, "QD-FLAG"))
+			qd = -1
+		    iferr (bs = imgeti (im, "BS-FLAG"))
+			bs = -1
+		    iferr (co = imgeti (im, "CO-FLAG"))
+			co = -1
+
+		    # Airmass may not be in header. It could be computed if
+		    # if the observatory latitude were available.
+
+		    call printf ("airmass = %5.3f,%25tW0 = %0.3f,")
+			call pargr (AM(sh))
+			call pargr (W0(sh))
+		    call printf ("   WPC = %0.5g,      ITM = %.2f,\n")
+			call pargr (WP(sh))
+			call pargr (IT(sh))
+		    call printf ("NP1 = %d, NP2 = %d,")
+			call pargi (NP1(sh))
+			call pargi (NP2(sh))
+		    call printf ("    UT = %0.1h,   ST = %0.1h,\n")
+			call pargr (UT(sh))
+			call pargr (ST(sh))
+		    call printf ("HA = %0.2h,")
+			call pargr (HA(sh))
+		    call printf ("        RA = %0.2h,   DEC = %0.1h,\n")
+			call pargr (RA(sh))
+			call pargr (DEC(sh))
+		    call printf (
+			"df = %d, sm = %d, qf = %d, dc = %d, qd = %d, ") 
+			call pargi (df)
+			call pargi (sm)
+			call pargi (qf)
+			call pargi (DC(sh))
+			call pargi (qd)
+		    call printf ("ex = %d, bs = %d, ca = %d, co = %d")
+			call pargi (EC(sh))
+			call pargi (bs)
+			call pargi (FC(sh))
+			call pargi (co)
+
+		    call printf ("\n\n")
+		} else {
+		    if (nl == 1) {
+			call printf ("[%s]:%s %4ds %4dpts   %s\n")
+			    call pargstr (IMNAME(sh))
+			    if (OFLAG(sh) == 1)
+				call pargstr ("o")
+			    else
+				call pargstr ("s")
+			    call pargr (IT(sh))
+			    call pargi (SN(sh))
+			    call pargstr (TITLE(sh))
+		    } else {
+			call printf ("[%s]:%s %6.2fs %4dpts %dspectra   %s\n")
+			    call pargstr (IMNAME(sh))
+			    if (OFLAG(sh) == 1)
+				call pargstr ("o")
+			    else
+				call pargstr ("s")
+			    call pargr (IT(sh))
+			    call pargi (SN(sh))
+			    call pargi (nl)
+			    call pargstr (TITLE(sh))
+		    }
+		    break
+		}
+	    }
+
+	    call smw_close (mw)
+	    if (sh != NULL)
+		MW(sh) = NULL
+	    call imunmap (im)
+	}
+
+	# Null out record string to avoid learn mode
+	call clpstr ("records", "")
+
+	# Free space
+	call shdr_close (sh)
+	call imtclose (root)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/irsiids/t_subsets.x b/noao/onedspec/irsiids/t_subsets.x
new file mode 100644
index 00000000..6a2a61bf
--- /dev/null
+++ b/noao/onedspec/irsiids/t_subsets.x
@@ -0,0 +1,121 @@
+include	<error.h>
+include	<imhdr.h>
+
+
+# T_SUBSETS -- Sub a series of spectra by pairs. A single spectrum
+#  is produced for every pair.
+#
+
+procedure t_subsets ()
+
+pointer	image
+pointer	recstr, ofile
+int	root, start_rec, subset
+int	nrecs
+int	npts, nrem, ifile, tog
+real	expo, wtsum
+pointer	sp, recs, im[2], cur_pix, sp_sum
+
+real	imgetr()
+int	clpopni(), clgeti()
+int	get_next_image(), decode_ranges()
+pointer	immap(), imgl1r()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (recstr, SZ_LINE, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+
+	# Open input file name template
+	root   = clpopni ("input")
+
+	# Get range specification if any
+	call clgstr ("records", Memc[recstr], SZ_LINE)
+	if (decode_ranges (Memc[recstr], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	# Get rootname for output files and starting record
+	call clgstr ("output", Memc[ofile], SZ_FNAME)
+	start_rec = clgeti ("start_rec")
+
+	# Initialize range decoder
+	call reset_next_image ()
+
+	#Initialize file counter
+	ifile = 0
+
+	# Set weighting value needed by spectrum writer
+	wtsum = 1.0
+
+	# Define subset of operation is a pair
+	subset = 2
+
+	# Loop over all input images by subsets
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image], 
+	    SZ_FNAME) != EOF) {
+
+	    # Get toggle value
+	    tog = mod (ifile, 2) + 1
+
+	    # Open image
+	    iferr (im[tog] = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Load data
+	    cur_pix = imgl1r (im[tog])
+
+	    # Allocate space for the sum
+	    if (mod (ifile,2) == 0) {
+		npts = IM_LEN (im[tog],1)
+		call calloc (sp_sum, npts, TY_REAL)
+
+		# Zero exposure counter
+		expo = 0.0
+
+		# Add first spectrum
+	        call amovr (Memr[cur_pix], Memr[sp_sum], npts)
+
+		iferr (expo = imgetr (im[tog], "EXPOSURE"))
+		    iferr (expo = imgetr (im[tog], "ITIME"))
+			iferr (expo = imgetr (im[tog], "EXPTIME"))
+			    expo = 1
+
+	        call printf ("[%s] added\n")
+		    call pargstr (Memc[image])
+		call flush (STDOUT)
+
+	    } else {
+		# Subtract second spectrum
+		call asubr (Memr[sp_sum], Memr[cur_pix], Memr[sp_sum], 
+		    min (npts, IM_LEN(im[tog],1)))
+		call printf ("[%s] subtracted\n")
+		    call pargstr (Memc[image])
+		call flush (STDOUT)
+		call imunmap (im[2])
+
+		call wrt_set (Memr[sp_sum], subset, im[1], Memc[ofile],
+		    start_rec, expo, wtsum, -1)
+		call mfree (sp_sum, TY_REAL)
+	    }
+
+	    ifile = ifile + 1
+	}
+	# Check that there are no remaining spectra in an unfulfilled subset
+	nrem = mod (ifile, 2)
+	if (nrem != 0) {
+	    call mfree (sp_sum, TY_REAL)
+
+	    call eprintf ("Unfulfilled pair ignored\n")
+	}
+
+	# Update record number
+	call clputi ("next_rec", start_rec)
+
+	# Free space
+	call sfree (sp)
+	call clpcls (root)
+end
diff --git a/noao/onedspec/irsiids/t_sums.x b/noao/onedspec/irsiids/t_sums.x
new file mode 100644
index 00000000..e28ebb35
--- /dev/null
+++ b/noao/onedspec/irsiids/t_sums.x
@@ -0,0 +1,239 @@
+include	<error.h>
+include	<imhdr.h>
+
+define	MAX_NR_BEAMS	100	# Max number of instrument apertures
+
+# T_SUMS -- Compute sums of strings of spectra according to
+#	    Aperture number and object/sky flag. So for IIDS/IRS
+#           type spectra, 4 sums will be generated.
+#           In general, there will be 2N sums where N is the number
+#           apertures.
+
+procedure t_sums ()
+
+pointer	image					# Image name to be added
+pointer	images					# Image name to be added
+pointer	ofile					# Output image file name
+pointer	recstr					# Record number string
+int	recs					# Spectral record numbers
+int	root, nrecs				# CL and ranges flags
+real	expo					# Exposure time
+pointer	bstat[2]				# Status of each aperture
+pointer	npts[2]					# Length of spectrum
+pointer	esum[2]					# Accumulated exposure time
+pointer	accum[2]				# Pointers to beam accumulators
+pointer	title[2]
+int	beam, object
+int	start_rec
+
+int	i, j
+pointer	sp, work, im
+
+real	imgetr()
+int	clgeti(), clpopni(), imgeti()
+int	get_next_image(), decode_ranges()
+pointer	immap()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (images, MAX_NR_BEAMS, TY_POINTER)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (recstr, SZ_LINE, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+	call salloc (accum, MAX_NR_BEAMS, TY_POINTER)
+	call salloc (title, MAX_NR_BEAMS, TY_POINTER)
+	call amovki (NULL, Memi[images], MAX_NR_BEAMS)
+	call salloc (work, 2*5*MAX_NR_BEAMS, TY_STRUCT)
+	bstat[1] = work
+	bstat[2] = work + MAX_NR_BEAMS
+	npts[1] = work + 2 * MAX_NR_BEAMS
+	npts[2] = work + 3 * MAX_NR_BEAMS
+	esum[1] = work + 4 * MAX_NR_BEAMS
+	esum[2] = work + 5 * MAX_NR_BEAMS
+	accum[1] = work + 6 * MAX_NR_BEAMS
+	accum[2] = work + 7 * MAX_NR_BEAMS
+	title[1] = work + 8 * MAX_NR_BEAMS
+	title[2] = work + 9 * MAX_NR_BEAMS
+
+	# Get task parameters.
+	root = clpopni ("input")
+
+	# Get input record numbers
+	call clgstr ("records", Memc[recstr], SZ_LINE)
+	if (decode_ranges (Memc[recstr], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	call clgstr ("output", Memc[ofile], SZ_LINE)
+
+	start_rec = clgeti ("start_rec")
+
+	call reset_next_image ()
+
+	# Clear all beam status flags
+	call amovki (INDEFI, Memi[bstat[1]], MAX_NR_BEAMS*2)
+	call aclrr (Memr[esum[1]], MAX_NR_BEAMS*2)
+
+	call printf ("Accumulating spectra --\n")
+	call flush (STDOUT)
+
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image],
+	    SZ_FNAME) != EOF) {
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Load header
+	    iferr (beam = imgeti (im, "BEAM-NUM"))
+		beam = 0
+	    if (beam < 0  || beam > MAX_NR_BEAMS-1)
+		call error (0, "Invalid aperture number")
+
+	    # Select array: Object = array 2; sky = array 1
+	    iferr (object = imgeti (im, "OFLAG"))
+		object = 1
+	    if (object == 1)
+		object = 2
+	    else
+		object = 1
+
+	    iferr (expo = imgetr (im, "EXPOSURE"))
+		iferr (expo = imgetr (im, "ITIME"))
+		    iferr (expo = imgetr (im, "EXPTIME"))
+			expo = 1
+
+	    # Add spectrum into accumulator
+	    if (IS_INDEFI (Memi[bstat[object]+beam])) {
+	        Memi[npts[object]+beam] = IM_LEN (im,1)
+	        call salloc (Memi[accum[object]+beam], IM_LEN(im,1), TY_REAL)
+	        call aclrr (Memr[Memi[accum[object]+beam]], IM_LEN(im,1))
+	        Memi[bstat[object]+beam] = 0
+
+	        call salloc (Memi[title[object]+beam], SZ_LINE, TY_CHAR)
+	        call strcpy (IM_TITLE(im), Memc[Memi[title[object]+beam]],
+		    SZ_LINE)
+	    }
+
+	    call su_accum_spec (im, Memi[npts[1]], expo, Memi[bstat[1]],
+		beam+1, Memi[accum[1]], Memr[esum[1]], Memi[title[1]], object)
+
+	    call printf ("[%s] %s spectrum added to aperture %1d\n")
+		call pargstr (Memc[image])
+		if (object == 2)
+		    call pargstr ("object")
+		else
+		    call pargstr ("sky   ")
+		call pargi (beam)
+	    call flush (STDOUT)
+
+	    if (Memi[images+beam] == NULL)
+		call salloc (Memi[images+beam], SZ_FNAME, TY_CHAR)
+	    call strcpy (Memc[image], Memc[Memi[images+beam]], SZ_FNAME)
+	    call imunmap (im)
+	}
+
+	# Review all apertures containing data and write sums
+	do i = 0, MAX_NR_BEAMS-1
+	    do j = 1, 2
+	    if (!IS_INDEFI (Memi[bstat[j]+i])) {
+		call wrt_spec (Memc[Memi[images+i]], Memr[Memi[accum[j]+i]],
+		    Memr[esum[j]+i], Memc[ofile], start_rec,
+		    Memc[Memi[title[j]+i]], Memi[npts[j]+i], i, j)
+
+		start_rec = start_rec + 1
+	    }
+
+	call clputi ("next_rec", start_rec)
+	call sfree (sp)
+	call clpcls (root)
+end
+
+# ACCUM_SPEC -- Accumulate spectra by beams
+
+procedure su_accum_spec (im, len, expo, beam_stat, beam, accum, expo_sum,
+	title, object)
+
+pointer	im, accum[MAX_NR_BEAMS,2], title[MAX_NR_BEAMS,2]
+real	expo, expo_sum[MAX_NR_BEAMS,2]
+int	beam_stat[MAX_NR_BEAMS,2], beam, len[MAX_NR_BEAMS,2]
+int	object
+
+int	npts
+pointer	pix
+
+pointer	imgl1r()
+
+begin
+	npts = IM_LEN (im, 1)
+
+	# Map pixels and optionally correct for coincidence
+	pix = imgl1r (im)
+
+	# Add in the current data
+	npts = min (npts, len[beam, object])
+
+	call aaddr (Memr[pix], Memr[accum[beam, object]], 
+	    Memr[accum[beam, object]], npts)
+
+	beam_stat[beam, object] = beam_stat[beam, object] + 1
+	expo_sum [beam, object] = expo_sum [beam, object] + expo
+end
+
+# WRT_SPEC -- Write out normalized spectrum
+
+procedure wrt_spec (image, accum, expo_sum, ofile, start, title, npts, object,
+	beam)
+
+char	image[SZ_FNAME]
+real	accum[ARB], expo_sum
+int	start, npts
+char	ofile[SZ_FNAME]
+char	title[SZ_LINE]
+int	object, beam
+
+char	output[SZ_FNAME], temp[SZ_LINE]
+pointer	im, imnew, newpix
+
+pointer	immap(), impl1r()
+int	strlen()
+
+begin
+	im = immap (image, READ_ONLY, 0)
+10	call strcpy (ofile, output, SZ_FNAME)
+	call sprintf (output[strlen (output) + 1], SZ_FNAME, ".%04d")
+	    call pargi (start)
+
+	# Create new image with a user area
+	# If an error occurs, ask user for another name to try
+	# since many open errors result from trying to overwrite an
+	# existing image.
+
+	iferr (imnew = immap (output, NEW_COPY, im)) {
+	    call eprintf ("Cannot create [%s] -- Already exists??\07\n")
+		call pargstr (output)
+	    call clgstr ("newoutput", ofile, SZ_FNAME)
+	    go to 10
+	}
+
+	call strcpy ("Summation:", temp, SZ_LINE)
+	call sprintf (temp[strlen (temp) + 1], SZ_LINE, "%s")
+	    call pargstr (title)
+	call strcpy (temp, IM_TITLE (imnew), SZ_LINE)
+
+	newpix = impl1r (imnew)
+	call amovr (accum, Memr[newpix], npts)
+
+	call imaddr (imnew, "EXPOSURE", expo_sum)
+	call imunmap (im)
+	call imunmap (imnew)
+
+	call printf ("%s sum for aperture %1d --> [%s]\n")
+	    if (object == 1)
+		call pargstr ("Object")
+	    else
+		call pargstr ("Sky   ")
+	    call pargi (beam)
+	    call pargstr (output)
+	call flush (STDOUT)
+end
diff --git a/noao/onedspec/irsiids/t_widstape.x b/noao/onedspec/irsiids/t_widstape.x
new file mode 100644
index 00000000..1f96d146
--- /dev/null
+++ b/noao/onedspec/irsiids/t_widstape.x
@@ -0,0 +1,343 @@
+include	<mach.h>
+include	<error.h>
+include	<imhdr.h>
+include <smw.h>
+
+define	SZ_IDSTITLE	64		# Length of IDSOUT title
+define	SZ_CARD		80		# Columns on a card
+
+# T_WIDSTAPE -- Convert each line of an IRAF image to IDSOUT text format.
+# Each image line is treated as a one dimensional spectrum.
+# A maximum IDSOUT length of 1024 points is enforced silently.
+#
+# There are two types of output:
+#    single   -- All image lines are appended to a single IDSOUT file.
+#    multiple -- Each image line is appended to a different IDSOUT file.
+
+procedure t_widstape ()
+
+pointer	image			# Image to be converted
+pointer	recs			# Record numbers
+pointer	idsout			# IDSOUT file or root name to be written
+int	block_size		# Block size
+bool	ebcdic			# ASCII or EBCDIC
+
+int	i, mfd, root, nrecs
+pointer	sp, im, mw, sh, ptr
+
+int	open(), mtopen(), clgeti(), clpopni()
+int	get_next_image(), decode_ranges(), mtfile(), mtneedfileno()
+bool	clgetb()
+pointer	immap(), smw_openim()
+errchk	immap, smw_openim, shdr_open, wrt_ids_rec
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_LINE, TY_CHAR)
+	call salloc (idsout, SZ_FNAME, TY_CHAR)
+	call salloc (recs, 300, TY_INT)
+
+	# Parameters
+	root   = clpopni ("input")
+	call clgstr ("records", Memc[image], SZ_LINE)
+	call clgstr ("idsout", Memc[idsout], SZ_FNAME)
+	block_size = clgeti ("block_size")
+	ebcdic = clgetb ("ebcdic")
+
+	# Set record numbers
+	if (decode_ranges (Memc[image], Memi[recs], 100, nrecs) == ERR)
+	    call error (0, "Bad range specification")
+
+	# Check that a realistic block size was requested
+	if (mod (block_size, SZ_CARD) == 0)
+	    block_size = block_size / SZB_CHAR
+	else
+	    call error (0, "Blocks not integral number of cards")
+
+	# Open output tape file
+	# First determine if a file number was specified
+	if (mtfile (Memc[idsout]) == YES) {
+
+	    # If no file, check if new_tape was specified and if so,
+	    # force file=1; otherwise force file=EOT
+
+	    if (mtneedfileno (Memc[idsout]) == YES) {
+		if (!clgetb("new_tape"))
+		    call mtfname (Memc[idsout], EOT, Memc[idsout], SZ_FNAME)
+
+		else
+		    call mtfname (Memc[idsout], 1, Memc[idsout], SZ_FNAME)
+	    }
+	    mfd = mtopen (Memc[idsout], WRITE_ONLY, block_size)
+	} else
+	    mfd = open (Memc[idsout], NEW_FILE, BINARY_FILE)
+
+	# Loop over all files
+	call reset_next_image ()
+	while (get_next_image (root, Memi[recs], nrecs, Memc[image],
+	    SZ_LINE) != EOF) {
+	    iferr {
+		im = NULL
+		mw = NULL
+		ptr = immap (Memc[image], READ_ONLY, 0); im = ptr
+		ptr = smw_openim (im); mw = ptr
+
+		# Write out a spectrum for each line in the image
+		do i = 1, IM_LEN (im,2) {
+		    call shdr_open (im, mw, i, 1, INDEFI, SHDATA, sh)
+		    call wrt_ids_rec (mfd, sh, Memc[image], ebcdic)
+		}
+
+		call printf ("copied - [%s]: %s\n")
+		call pargstr (IMNAME(sh))
+		call pargstr (TITLE(sh))
+		call flush (STDOUT)
+	    } then
+		call erract (EA_WARN)
+
+	    if (mw != NULL)
+		call smw_close (mw)
+	    if (im != NULL)
+		call imunmap (im)
+	}
+
+	call shdr_close (sh)
+	call close (mfd)
+	call sfree (sp)
+end
+
+
+# WRT_IDS_REC -- Write one IIDS/IRS format record in IDSOUT form
+
+procedure wrt_ids_rec (mfd, sh, image, ebcdic)
+
+int	mfd
+pointer	sh
+char	image[SZ_FNAME]
+bool	ebcdic
+
+# IDSOUT header parameters
+char	label[SZ_IDSTITLE]		# Record label
+int	record				# Record number
+int	uttime				# UT time in seconds
+int	st				# Siderial time in seconds
+real	ra				# Right Ascension in hours
+real	dec				# Declination in degrees
+real	ha				# Hour angle in hours
+real	airmass				# Air mass
+int	itime				# Integration time
+real	wavelen1			# Wavelength of first pixel
+real	dispersion			# Dispersion per pixel
+
+int     i, rec_no, df, sm, qf, qd, bs, co
+pointer	sp, padline, bufline
+
+int	strmatch(), imgeti()
+
+begin
+	call smark (sp)
+	call salloc (padline, SZ_LINE, TY_CHAR)
+	call salloc (bufline, SZ_LINE, TY_CHAR)
+
+	# Fill in header parameters.
+
+	call strcpy (TITLE(sh), label, SZ_IDSTITLE)
+
+	# The following two calculations were causing floating overflows
+	# when the header values were indefinite.  SEH 7-23-86
+	if (IS_INDEF(UT(sh)))
+	    uttime = INDEFI
+	else
+	    uttime = UT(sh) * 3600.
+
+	if (IS_INDEF(ST(sh)))
+	    st = INDEFI
+	else
+	    st     = ST(sh) * 3600.
+
+	ra         = RA(sh)
+	dec        = DEC(sh)
+	ha         = HA(sh)
+	airmass    = AM(sh)
+	itime      = IT(sh)
+	wavelen1   = W0(sh)
+	dispersion = WP(sh)
+
+	iferr (df = imgeti (IM(sh), "DF-FLAG"))
+	    df = -1
+	iferr (sm = imgeti (IM(sh), "SM-FLAG"))
+	    sm = -1
+	iferr (qf = imgeti (IM(sh), "QF-FLAG"))
+	    qf = -1
+	iferr (qd = imgeti (IM(sh), "QD-FLAG"))
+	    qd = -1
+	iferr (bs = imgeti (IM(sh), "BS-FLAG"))
+	    bs = -1
+	iferr (co = imgeti (IM(sh), "CO-FLAG"))
+	    co = -1
+
+	# Create a padding line to fill the IDSOUT block to 1024 points.
+
+	call sprintf (Memc[padline], SZ_LINE,
+	    "%10.4e%10.4e%10.4e%10.4e%10.4e%10.4e%10.4e%10.4e\n")
+	do i = 1, 8
+	    call pargr (0.)
+
+	# Line 1 -- Record number, etc.
+	rec_no = strmatch (image, ".")
+	call sscan (image[rec_no])
+	    call gargi (record)
+
+	    call sprintf (Memc[bufline], SZ_LINE, 
+		"%5d%5d%15.7e%15.7e%5d%5d%5d%5d%5d%5d%10d")
+		call pargi (record)
+		call pargi (itime)
+		call pargr (wavelen1)
+		call pargr (dispersion)
+		call pargi (0)
+		call pargi (SN(sh))
+		call pargi (BEAM(sh))
+		call pargi (-1)
+		call pargi (-1)
+		call pargi (0)
+		call pargi (uttime)
+
+	    call putcard (mfd, Memc[bufline], ebcdic)
+
+	    # Line 2 -- Siderial time, RA, and Dec.
+
+	    call sprintf (Memc[bufline], SZ_LINE, 
+		"%10d%15.7e%15.7e%5d%5d%5d%5d%5d%5d%5d%5d")
+		call pargi (st)
+		call pargr (ra)
+		call pargr (dec)
+		call pargi (0)
+		call pargi (df)
+		call pargi (sm)
+		call pargi (qf)
+		call pargi (DC(sh))
+		call pargi (qd)
+		call pargi (EC(sh))
+		call pargi (bs)
+
+	    call putcard (mfd, Memc[bufline], ebcdic)
+
+	    # Line 3 -- Hour angle, air mass, UT date, and exposure title.
+
+	    call sprintf (Memc[bufline], SZ_LINE, 
+		"%5d%5d%2w%-3.3s%5d%15.7e%15.7e%27wEND")
+		call pargi (FC(sh))
+		call pargi (co)
+		call pargstr ("IRF")
+		call pargi (OFLAG(sh))
+		call pargr (ha)
+		call pargr (airmass)
+
+	    call putcard (mfd, Memc[bufline], ebcdic)
+
+	    # Line 4 -- Record label.
+	    call sprintf (Memc[bufline], SZ_LINE, "%-77sEND")
+		call pargstr (TITLE(sh))
+
+	    call putcard (mfd, Memc[bufline], ebcdic)
+
+	    # Lines 5 to 132
+
+	    call putdata (mfd, Memr[SY(sh)], SN(sh), Memc[padline],
+		Memc[bufline], ebcdic)
+
+	    # Line 133 -- Blank line
+
+	    call sprintf (Memc[bufline], SZ_LINE, "%80w")
+	    call putcard (mfd, Memc[bufline], ebcdic)
+end
+
+
+# PUTDATA -- Format and output extraction data to IDSOUT length of 1024 points.
+# Special effort is made to make the zero padding efficient.
+
+procedure putdata (mfd, data, npts, padline, bufline, ebcdic)
+
+int	mfd				# IDSOUT file descriptor
+real	data[npts]			# Data
+int	npts				# Number of data points
+char	padline[ARB]			# Padding string
+char	bufline[ARB]			# Output buffer string
+bool	ebcdic				# Convert to ebcdic
+
+int	i, j, k, l, n
+int	index
+double	ddata
+
+int	dtoc3()
+
+begin
+	j = min (1024, npts)	# Maximum number of data points
+	k = j / 8 * 8		# Index of last data point in last complete line
+	if (k < j)
+	   l = k + 8		# Index of last point in last line with data
+	else
+	   l = k
+
+	# Write all complete data lines.
+
+	index = 1
+	do i = 1, k {
+	    ddata = double (data[i])
+	    n = dtoc3 (ddata, bufline[index], 10, 4, 'e', 10)
+	    while (n < 10) {
+		bufline[index+n] = ' '
+		n = n + 1
+	    }
+	    index = index + 10
+	    if (mod (i, 8) == 0) {
+	        call putcard (mfd, bufline, ebcdic)
+		index = 1
+	    }
+	}
+
+	# Write partial data line.
+
+	index = 1
+	do i = k + 1, l {
+	    if (i <= j) {
+		ddata = double (data[i])
+	        n = dtoc3 (ddata, bufline[index], 11, 5, 'e', 10)
+	    } else
+	        n = dtoc3 (0.D0, bufline[index], 11, 5, 'e', 10)
+	    while (n < 10) {
+		bufline[index+n] = ' '
+		n = n + 1
+	    }
+	    index = index + 10
+	    if (mod (i, 8) == 0) {
+	        call putcard (mfd, bufline, ebcdic)
+		index = 1
+	    }
+	}
+
+	# Write remaining padding lines.
+
+	do i = l + 1, 1024, 8
+	    call putcard (mfd, padline, ebcdic)
+end
+
+# PUTCARD -- Convert to ebcdic if desired and write out card
+
+procedure putcard (mfd, bufline, ebcdic)
+
+int	mfd
+char	bufline[ARB]
+bool	ebcdic
+
+char	packline[SZ_LINE]
+
+begin
+	if (ebcdic) {
+	    call ascii_to_ebcdic (bufline, packline, SZ_CARD)
+	    call achtsb (packline, packline, SZ_CARD)
+	} else
+	    call chrpak (bufline, 1, packline, 1, SZ_CARD)
+
+	call write (mfd, packline, SZ_CARD/SZB_CHAR)
+end
diff --git a/noao/onedspec/irsiids/widstape.par b/noao/onedspec/irsiids/widstape.par
new file mode 100644
index 00000000..33dee906
--- /dev/null
+++ b/noao/onedspec/irsiids/widstape.par
@@ -0,0 +1,8 @@
+# IDSOUT parameter file -- write a CYBER style IDSOUT tape
+
+idsout,s,a,,,,Output file or magtape
+input,s,a,,,,Image root name to write
+records,s,a,,,,Records to write
+block_size,i,h,3200,80,10640,Tape block size in bytes
+new_tape,b,h,no,,,Is this a new (blank) tape
+ebcdic,b,h,no,,,Convert character code to ebcdic
diff --git a/noao/onedspec/lcalib.par b/noao/onedspec/lcalib.par
new file mode 100644
index 00000000..cb7fc931
--- /dev/null
+++ b/noao/onedspec/lcalib.par
@@ -0,0 +1,10 @@
+# CALIBLIST parameter file
+
+option,s,a,,,,"List option (bands, ext, mags, fnu, flam, stars)"
+star_name,s,a,,,,Star name in calibration list
+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
+extinction,s,h,,,,Extinction file
+caldir,s,h,,,,Directory containing calibration data
+fnuzero,r,h,3.68e-20,,,Absolute flux zero point
diff --git a/noao/onedspec/mkpkg b/noao/onedspec/mkpkg
new file mode 100644
index 00000000..0c2e260c
--- /dev/null
+++ b/noao/onedspec/mkpkg
@@ -0,0 +1,72 @@
+# ONEDSPEC package.
+
+$call	relink
+$exit
+
+update:
+	$call	update@scombine
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$omake	x_onedspec.x
+	$link	x_onedspec.o libpkg.a -lsmw\
+		-lxtools -lcurfit -lgsurfit -liminterp -lllsq -o xx_onedspec.e
+	;
+
+install:
+	$move	xx_onedspec.e noaobin$x_onedspec.e
+	;
+
+smw:
+	$checkout libsmw.a noaolib$
+	$update libsmw.a
+	$checkin libsmw.a noaolib$
+	;
+
+libsmw.a:
+	@smw
+	;
+
+libpkg.a:
+	@dispcor
+	@ecidentify
+	@fortran
+	@identify
+	@irsiids
+	@odcombine
+	@sensfunc
+	@splot
+
+	getairm.x	
+	getcalib.x	<error.h> <ctype.h> <mach.h>
+	getextn.x	<error.h>
+	odropenp.x	<ctype.h>
+	t_calibrate.x	<error.h> <imhdr.h> <imset.h> <math/iminterp.h> <smw.h>
+	t_deredden.x	<error.h> <imhdr.h> <smw.h>
+	t_dopcor.x	<error.h> <imhdr.h> <smw.h>
+	t_fitprofs.x	<ctotok.h> <error.h> <gset.h> <imhdr.h> <smw.h> <time.h>
+	t_lcalib.x	<ctype.h>
+	t_mkspec.x	<imhdr.h>
+	t_names.x	
+	t_rstext.x	
+	t_sapertures.x	<error.h> <imhdr.h> <smw.h>
+	t_sarith.x	<error.h> <imhdr.h> <mach.h> <smw.h>
+	t_sbands.x	<error.h> <smw.h>
+	t_scoords.x	<error.h> <imhdr.h>
+	t_sfit.x	<error.h> <imhdr.h> <smw.h> <math/curfit.h>\
+			<pkg/gtools.h> <pkg/rg.h>
+	t_sflip.x	<error.h> <imhdr.h> <smw.h>
+	t_sinterp.x	<imhdr.h> <math/curfit.h>
+	t_slist.x	<error.h> <fset.h> <imhdr.h> <smw.h>
+	t_specplot.x	specplot.h <ctype.h> <error.h> <gset.h> <imhdr.h>\
+			<mach.h> <pkg/gtools.h> <smw.h> <units.h>
+	t_specshift.x	<error.h> <smw.h>
+	t_standard.x	<error.h> <gset.h> <imhdr.h> <imset.h> <mach.h>\
+			<pkg/gtools.h> <smw.h>
+	t_tweak.x	<error.h> <gset.h> <imhdr.h> <imset.h> <math.h>\
+			<math/iminterp.h> <pkg/gtools.h> <pkg/xtanswer.h>\
+			<smw.h> <units.h>
+	;
diff --git a/noao/onedspec/mkspec.par b/noao/onedspec/mkspec.par
new file mode 100644
index 00000000..d836b8ad
--- /dev/null
+++ b/noao/onedspec/mkspec.par
@@ -0,0 +1,11 @@
+image_name,s,a,,,,Name of image file to be created
+image_title,s,a,,,,Title of image
+ncols,i,a,,,,Length of image
+nlines,i,a,,,,Number of lines (rows) in the image
+function,i,a,1,1,3,Function type (1=flat;2=ramp;3=Black body)
+constant,r,a,0.0,,,Flat image level
+start_level,r,a,,,,Ramp image first value
+end_level,r,a,,,,Ramp image last value
+start_wave,r,a,,0.0,,Starting wavelength for BB - Angstroms
+end_wave,r,a,,0.0,,Ending wavelength
+temperature,r,a,,0.0,,Black body temperature - Deg.K
diff --git a/noao/onedspec/names.par b/noao/onedspec/names.par
new file mode 100644
index 00000000..57341508
--- /dev/null
+++ b/noao/onedspec/names.par
@@ -0,0 +1,7 @@
+
+# NAMES parameter file
+
+input,s,a,,,,List of root file names
+records,s,a,,,,Range of spectral records
+append,s,h,"",,,String to append to generated image names
+check,b,h,no,,,Verify that image header exists
diff --git a/noao/onedspec/ndprep.cl b/noao/onedspec/ndprep.cl
new file mode 100644
index 00000000..8031a2a8
--- /dev/null
+++ b/noao/onedspec/ndprep.cl
@@ -0,0 +1,65 @@
+# NDPREP -- Generate an ND filter correction image for use over a specified 
+# wavelength range from a filter file. The output correction image may
+# be 1D or 2D.
+
+procedure ndprep (filter_curve, output)
+
+file	filter_curve		{prompt="Input ND filter curve"}
+file	output			{prompt="Output calibration image"}
+real	w0			{prompt="Starting wavelength (Angstroms)"}
+real	dw			{prompt="Wavelength increment (Angstroms)"}
+int	nw			{prompt="Number of wavelength points"}
+int	nspace=0		{prompt="Number of spatial points (0 for 1D)"}
+bool	logarithm=no		{prompt="Use logarithmic wavelengths?"}
+bool	flux=yes		{prompt="Conserve flux when log rebinning?"}
+int	dispaxis=2		{prompt="Dispersion axis"}
+file	directory="onedstds$ctio/"	{prompt="ND filter directory"}
+
+begin
+	file	in, out, temp
+	bool	log
+
+	# Page list of filters if '?'.
+	in = filter_curve
+	if (in == "?") {
+	    page (directory // "ndfilters.men")
+	    in = filter_curve
+	    if (in == "?")
+		return
+	}
+
+	# Check if filter curve exists.
+	in = directory // in
+	if (!access (in))
+	    error (0, "Filter curve "// in // " not found")
+
+	# Convert the filter curve to a 1D image.
+	out = output
+	sinterp (in, "", out, w0, dx=dw, npts=nw, make_image=yes,
+	    interp_mode="curve")
+	hedit (out, "dc-flag", 0, add=yes, show=no, verify=no)
+
+	# Convert to log if desired.
+	if (logarithm == yes) {
+	    temp = mktemp ("tmp")
+	    dispcor (out, temp, linearize=yes, table="", w1=INDEF,
+		w2=INDEF, dw=INDEF, nw=INDEF, log=yes, flux=flux,
+		confirm=no, listonly=no, verbose=no, logfile="")
+	    imdelete (out, verify=no)
+	    imrename (temp, out, verbose=no)
+	}
+
+	# Convert to a 2D image if the number of spacial points is > 0.
+	if (nspace > 0) {
+	    temp = mktemp ("tmp")
+	    imstack (out, temp)
+	    imdelete (out, verify=no)
+	    imrename (temp, out, verbose=no)
+	    if (dispaxis == 1) {
+		blkrep (out, out, 1, nspace)
+	    } else {
+		imtranspose (out, out)
+		blkrep (out, out, nspace, 1)
+	    }
+	}
+end
diff --git a/noao/onedspec/odcombine.par b/noao/onedspec/odcombine.par
new file mode 100644
index 00000000..c2506352
--- /dev/null
+++ b/noao/onedspec/odcombine.par
@@ -0,0 +1,54 @@
+# SCOMBINE -- Spectrum combine parameters
+
+input,s,a,,,,List of images to combine
+output,s,a,,,,List of output images
+headers,s,h,"",,,List of header files (optional)
+bpmasks,s,h,"",,,List of bad pixel masks (optional)
+rejmasks,s,h,"",,,List of rejection masks (optional)
+nrejmasks,s,h,"",,,List of number rejected masks (optional)
+expmasks,s,h,"",,,List of exposure masks (optional)
+sigmas,s,h,"",,,List of sigma images (optional)
+logfile,s,h,"STDOUT",,,"Log file
+"
+apertures,s,h,"",,,Apertures to combine
+group,s,h,"apertures","all|images|apertures",,Grouping option
+first,b,h,no,,,Use first spectrum for dispersion?
+w1,r,h,INDEF,,,Starting wavelength of output spectra
+w2,r,h,INDEF,,,Ending wavelength of output spectra
+dw,r,h,INDEF,,,Wavelength increment of output spectra
+nw,i,h,INDEF,,,Length of output spectra
+log,b,h,no,,,"Logarithmic increments?
+"
+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
+outtype,s,h,"real","short|ushort|integer|long|real|double",,Output image pixel datatype
+outlimits,s,h,"",,,Output limits (x1 x2 y1 y2 ...)
+smaskformat,s,h,"bpmspectrum","bpmpixel|bpmspectrum",,Mask format
+smasktype,s,h,"none","none|goodvalue|badvalue|goodbits|badbits",,Mask type
+smaskvalue,r,h,0,,,Mask value
+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 for neighbor rejection
+"
+offsets,f,h,"physical","physical"
+masktype,s,h,"none"
+maskvalue,r,h,0
diff --git a/noao/onedspec/odcombine/mkpkg b/noao/onedspec/odcombine/mkpkg
new file mode 100644
index 00000000..d0b76b89
--- /dev/null
+++ b/noao/onedspec/odcombine/mkpkg
@@ -0,0 +1,18 @@
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+standalone:
+	$set LIBS1 = "-lsmw -liminterp -lxtools"
+	$update	libpkg.a
+	$omake	x_odcombine.x
+	$link	x_odcombine.o libpkg.a $(LIBS1) -o xx_odcombine.e
+	;
+
+libpkg.a:
+	@src
+
+	t_odcombine.x	src/icombine.h src/icombine.com <imhdr.h> <error.h> \
+			<mach.h> <mwset.h> <smw.h>
+	;
diff --git a/noao/onedspec/odcombine/odcombine.par b/noao/onedspec/odcombine/odcombine.par
new file mode 100644
index 00000000..b7b6e856
--- /dev/null
+++ b/noao/onedspec/odcombine/odcombine.par
@@ -0,0 +1,54 @@
+# SCOMBINE -- Spectrum combine parameters
+
+input,s,a,,,,List of images to combine
+output,s,a,,,,List of output images
+headers,s,h,"",,,List of header files (optional)
+bpmasks,s,h,"",,,List of bad pixel masks (optional)
+rejmasks,s,h,"",,,List of rejection masks (optional)
+nrejmasks,s,h,"",,,List of number rejected masks (optional)
+expmasks,s,h,"",,,List of exposure masks (optional)
+sigmas,s,h,"",,,List of sigma images (optional)
+logfile,s,h,"STDOUT",,,"Log file
+"
+apertures,s,h,"",,,Apertures to combine
+group,s,h,"apertures","all|images|apertures",,Grouping option
+first,b,h,no,,,Use first spectrum for dispersion?
+w1,r,h,INDEF,,,Starting wavelength of output spectra
+w2,r,h,INDEF,,,Ending wavelength of output spectra
+dw,r,h,INDEF,,,Wavelength increment of output spectra
+nw,i,h,INDEF,,,Length of output spectra
+log,b,h,no,,,"Logarithmic increments?
+"
+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
+outtype,s,h,"real","short|ushort|integer|long|real|double",,Output image pixel datatype
+outlimits,s,h,"",,,Output limits (x1 x2 y1 y2 ...)
+smaskformat,s,h,"bpmspectrum","bpmpixel|bpmspectrum",,Mask format
+smasktype,s,h,"none","none|goodvalue|badvalue|goodbits|badbits",,Mask type
+smaskvalue,r,h,0,,,Mask value
+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,"physical","physical"
+masktype,s,h,"none"
+maskvalue,r,h,0
diff --git a/noao/onedspec/odcombine/src/generic/icaclip.x b/noao/onedspec/odcombine/src/generic/icaclip.x
new file mode 100644
index 00000000..97c12346
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icaverage.x b/noao/onedspec/odcombine/src/generic/icaverage.x
new file mode 100644
index 00000000..fc9f16da
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/iccclip.x b/noao/onedspec/odcombine/src/generic/iccclip.x
new file mode 100644
index 00000000..bf655477
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icgdata.x b/noao/onedspec/odcombine/src/generic/icgdata.x
new file mode 100644
index 00000000..5cefcf5a
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icgrow.x b/noao/onedspec/odcombine/src/generic/icgrow.x
new file mode 100644
index 00000000..1ccb7885
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icmedian.x b/noao/onedspec/odcombine/src/generic/icmedian.x
new file mode 100644
index 00000000..1a2ed72d
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icmm.x b/noao/onedspec/odcombine/src/generic/icmm.x
new file mode 100644
index 00000000..5b2b13bf
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icomb.x b/noao/onedspec/odcombine/src/generic/icomb.x
new file mode 100644
index 00000000..96138646
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icpclip.x b/noao/onedspec/odcombine/src/generic/icpclip.x
new file mode 100644
index 00000000..237d9686
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icsclip.x b/noao/onedspec/odcombine/src/generic/icsclip.x
new file mode 100644
index 00000000..a0188d72
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icsigma.x b/noao/onedspec/odcombine/src/generic/icsigma.x
new file mode 100644
index 00000000..b9c9a781
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icsort.x b/noao/onedspec/odcombine/src/generic/icsort.x
new file mode 100644
index 00000000..3ec1d27e
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/icstat.x b/noao/onedspec/odcombine/src/generic/icstat.x
new file mode 100644
index 00000000..3a0ed49c
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/mkpkg b/noao/onedspec/odcombine/src/generic/mkpkg
new file mode 100644
index 00000000..b05b48a6
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/generic/xtimmap.x b/noao/onedspec/odcombine/src/generic/xtimmap.x
new file mode 100644
index 00000000..9e86e44d
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icaclip.gx b/noao/onedspec/odcombine/src/icaclip.gx
new file mode 100644
index 00000000..696402b2
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icaverage.gx b/noao/onedspec/odcombine/src/icaverage.gx
new file mode 100644
index 00000000..a95b7673
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/iccclip.gx b/noao/onedspec/odcombine/src/iccclip.gx
new file mode 100644
index 00000000..609b3448
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icemask.x b/noao/onedspec/odcombine/src/icemask.x
new file mode 100644
index 00000000..e60b8ab7
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icgdata.gx b/noao/onedspec/odcombine/src/icgdata.gx
new file mode 100644
index 00000000..27f51ec5
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icgrow.gx b/noao/onedspec/odcombine/src/icgrow.gx
new file mode 100644
index 00000000..caf7dd29
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icgscale.x b/noao/onedspec/odcombine/src/icgscale.x
new file mode 100644
index 00000000..570697ad
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/ichdr.x b/noao/onedspec/odcombine/src/ichdr.x
new file mode 100644
index 00000000..2d19c5bd
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icimstack.x b/noao/onedspec/odcombine/src/icimstack.x
new file mode 100644
index 00000000..d5628694
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/iclog.x b/noao/onedspec/odcombine/src/iclog.x
new file mode 100644
index 00000000..43ab37ab
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icmask.com b/noao/onedspec/odcombine/src/icmask.com
new file mode 100644
index 00000000..baba6f6a
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icmask.h b/noao/onedspec/odcombine/src/icmask.h
new file mode 100644
index 00000000..533c601d
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icmask.x b/noao/onedspec/odcombine/src/icmask.x
new file mode 100644
index 00000000..9242405d
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icmedian.gx b/noao/onedspec/odcombine/src/icmedian.gx
new file mode 100644
index 00000000..4ac51ae6
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icmm.gx b/noao/onedspec/odcombine/src/icmm.gx
new file mode 100644
index 00000000..16505588
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icomb.gx b/noao/onedspec/odcombine/src/icomb.gx
new file mode 100644
index 00000000..6c6e56c9
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icombine.com b/noao/onedspec/odcombine/src/icombine.com
new file mode 100644
index 00000000..7fa34287
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icombine.h b/noao/onedspec/odcombine/src/icombine.h
new file mode 100644
index 00000000..016172de
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icombine.x b/noao/onedspec/odcombine/src/icombine.x
new file mode 100644
index 00000000..d7b1d1e7
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icpclip.gx b/noao/onedspec/odcombine/src/icpclip.gx
new file mode 100644
index 00000000..f0c76369
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icpmmap.x b/noao/onedspec/odcombine/src/icpmmap.x
new file mode 100644
index 00000000..1afeedd7
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icrmasks.x b/noao/onedspec/odcombine/src/icrmasks.x
new file mode 100644
index 00000000..8b9a0c3d
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icscale.x b/noao/onedspec/odcombine/src/icscale.x
new file mode 100644
index 00000000..42d62f8d
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icsclip.gx b/noao/onedspec/odcombine/src/icsclip.gx
new file mode 100644
index 00000000..1b1c5de9
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icsection.x b/noao/onedspec/odcombine/src/icsection.x
new file mode 100644
index 00000000..746c1f51
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icsetout.x b/noao/onedspec/odcombine/src/icsetout.x
new file mode 100644
index 00000000..51e1fe90
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icsigma.gx b/noao/onedspec/odcombine/src/icsigma.gx
new file mode 100644
index 00000000..1304d940
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icsort.gx b/noao/onedspec/odcombine/src/icsort.gx
new file mode 100644
index 00000000..e124da15
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/icstat.gx b/noao/onedspec/odcombine/src/icstat.gx
new file mode 100644
index 00000000..c594182b
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/mkpkg b/noao/onedspec/odcombine/src/mkpkg
new file mode 100644
index 00000000..2ed3d8cb
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/tymax.x b/noao/onedspec/odcombine/src/tymax.x
new file mode 100644
index 00000000..a7f4f469
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/xtimmap.com b/noao/onedspec/odcombine/src/xtimmap.com
new file mode 100644
index 00000000..61bf314a
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/xtimmap.gx b/noao/onedspec/odcombine/src/xtimmap.gx
new file mode 100644
index 00000000..c0ae26a6
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/src/xtprocid.x b/noao/onedspec/odcombine/src/xtprocid.x
new file mode 100644
index 00000000..0a82d81b
--- /dev/null
+++ b/noao/onedspec/odcombine/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/onedspec/odcombine/srcwt/generic/icaclip.x b/noao/onedspec/odcombine/srcwt/generic/icaclip.x
new file mode 100644
index 00000000..97c12346
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icaverage.x b/noao/onedspec/odcombine/srcwt/generic/icaverage.x
new file mode 100644
index 00000000..4b464e91
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/generic/icaverage.x
@@ -0,0 +1,522 @@
+# 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, w, 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
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = Mems[d[1]+k] * wt
+			    sumwt = wt
+			    do j = 2, n[i] {
+				wt = Memr[w[Memi[m[j]+k]]+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, w, 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
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = Memi[d[1]+k] * wt
+			    sumwt = wt
+			    do j = 2, n[i] {
+				wt = Memr[w[Memi[m[j]+k]]+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, w, 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
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = Memr[d[1]+k] * wt
+			    sumwt = wt
+			    do j = 2, n[i] {
+				wt = Memr[w[Memi[m[j]+k]]+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, w, 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
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = Memd[d[1]+k] * wt
+			    sumwt = wt
+			    do j = 2, n[i] {
+				wt = Memr[w[Memi[m[j]+k]]+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/onedspec/odcombine/srcwt/generic/iccclip.x b/noao/onedspec/odcombine/srcwt/generic/iccclip.x
new file mode 100644
index 00000000..bf655477
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icgdata.x b/noao/onedspec/odcombine/srcwt/generic/icgdata.x
new file mode 100644
index 00000000..1350ad21
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/generic/icgdata.x
@@ -0,0 +1,1558 @@
+# 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, wtp, wbuf, w, 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	wtp[nimages]		# Weight images
+pointer	wbuf[nimages]		# Weight buffers
+pointer	w[nimages]		# Weight 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()
+int	xt_imgnlr()
+long	v3[IM_MAXDIM]
+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)
+		    call xt_cpix (nimages+i)
+		}
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2)) {
+			call xt_cpix (i)
+			call xt_cpix (nimages+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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2])
+		}
+		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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2])
+		    call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix)
+		    w[i] = wbuf[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
+		    }
+		    if (wtype == S_SIGMAP) {
+			dp = w[i]
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a
+			    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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i]
+			    do j = 1, npts {
+				Memr[dp] = Memr[dp] / a
+				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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i] + n1 - 1
+			    mp = m[i] + n1 - 1
+			    do j = n1, n2 {
+				if (Memi[mp] == 0)
+				    Memr[dp] = Memr[dp] / a
+				dp = dp + 1
+				mp = mp + 1
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	# Compute weights from sigmas.
+	if (wtype == S_SIGMAP) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = w[i]
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a > 0.)
+			    Memr[dp] = 1. / (a**2)
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    if (lflag[i] == D_ALL) {
+			dp = w[i]
+			do j = 1, npts {
+			    a = Memr[dp]
+			    if (a > 0.)
+				Memr[dp] = 1. / (a**2)
+			    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 = w[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0) {
+				a = Memr[dp]
+				if (a > 0.)
+				    Memr[dp] = 1. / (a**2)
+			    }
+			    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, wtp, wbuf, w, 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	wtp[nimages]		# Weight images
+pointer	wbuf[nimages]		# Weight buffers
+pointer	w[nimages]		# Weight 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()
+int	xt_imgnlr()
+long	v3[IM_MAXDIM]
+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)
+		    call xt_cpix (nimages+i)
+		}
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2)) {
+			call xt_cpix (i)
+			call xt_cpix (nimages+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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2])
+		}
+		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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2])
+		    call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix)
+		    w[i] = wbuf[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
+		    }
+		    if (wtype == S_SIGMAP) {
+			dp = w[i]
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a
+			    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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i]
+			    do j = 1, npts {
+				Memr[dp] = Memr[dp] / a
+				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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i] + n1 - 1
+			    mp = m[i] + n1 - 1
+			    do j = n1, n2 {
+				if (Memi[mp] == 0)
+				    Memr[dp] = Memr[dp] / a
+				dp = dp + 1
+				mp = mp + 1
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	# Compute weights from sigmas.
+	if (wtype == S_SIGMAP) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = w[i]
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a > 0.)
+			    Memr[dp] = 1. / (a**2)
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    if (lflag[i] == D_ALL) {
+			dp = w[i]
+			do j = 1, npts {
+			    a = Memr[dp]
+			    if (a > 0.)
+				Memr[dp] = 1. / (a**2)
+			    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 = w[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0) {
+				a = Memr[dp]
+				if (a > 0.)
+				    Memr[dp] = 1. / (a**2)
+			    }
+			    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, wtp, wbuf, w, 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	wtp[nimages]		# Weight images
+pointer	wbuf[nimages]		# Weight buffers
+pointer	w[nimages]		# Weight 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()
+long	v3[IM_MAXDIM]
+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)
+		    call xt_cpix (nimages+i)
+		}
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2)) {
+			call xt_cpix (i)
+			call xt_cpix (nimages+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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2])
+		}
+		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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2])
+		    call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix)
+		    w[i] = wbuf[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
+		    }
+		    if (wtype == S_SIGMAP) {
+			dp = w[i]
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a
+			    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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i]
+			    do j = 1, npts {
+				Memr[dp] = Memr[dp] / a
+				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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i] + n1 - 1
+			    mp = m[i] + n1 - 1
+			    do j = n1, n2 {
+				if (Memi[mp] == 0)
+				    Memr[dp] = Memr[dp] / a
+				dp = dp + 1
+				mp = mp + 1
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	# Compute weights from sigmas.
+	if (wtype == S_SIGMAP) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = w[i]
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a > 0.)
+			    Memr[dp] = 1. / (a**2)
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    if (lflag[i] == D_ALL) {
+			dp = w[i]
+			do j = 1, npts {
+			    a = Memr[dp]
+			    if (a > 0.)
+				Memr[dp] = 1. / (a**2)
+			    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 = w[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0) {
+				a = Memr[dp]
+				if (a > 0.)
+				    Memr[dp] = 1. / (a**2)
+			    }
+			    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, wtp, wbuf, w, 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	wtp[nimages]		# Weight images
+pointer	wbuf[nimages]		# Weight buffers
+pointer	w[nimages]		# Weight 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()
+int	xt_imgnlr()
+long	v3[IM_MAXDIM]
+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)
+		    call xt_cpix (nimages+i)
+		}
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2)) {
+			call xt_cpix (i)
+			call xt_cpix (nimages+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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2])
+		}
+		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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2])
+		    call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix)
+		    w[i] = wbuf[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
+		    }
+		    if (wtype == S_SIGMAP) {
+			dp = w[i]
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a
+			    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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i]
+			    do j = 1, npts {
+				Memr[dp] = Memr[dp] / a
+				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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i] + n1 - 1
+			    mp = m[i] + n1 - 1
+			    do j = n1, n2 {
+				if (Memi[mp] == 0)
+				    Memr[dp] = Memr[dp] / a
+				dp = dp + 1
+				mp = mp + 1
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	# Compute weights from sigmas.
+	if (wtype == S_SIGMAP) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = w[i]
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a > 0.)
+			    Memr[dp] = 1. / (a**2)
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    if (lflag[i] == D_ALL) {
+			dp = w[i]
+			do j = 1, npts {
+			    a = Memr[dp]
+			    if (a > 0.)
+				Memr[dp] = 1. / (a**2)
+			    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 = w[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0) {
+				a = Memr[dp]
+				if (a > 0.)
+				    Memr[dp] = 1. / (a**2)
+			    }
+			    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/onedspec/odcombine/srcwt/generic/icgrow.x b/noao/onedspec/odcombine/srcwt/generic/icgrow.x
new file mode 100644
index 00000000..1ccb7885
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icmedian.x b/noao/onedspec/odcombine/srcwt/generic/icmedian.x
new file mode 100644
index 00000000..1a2ed72d
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icmm.x b/noao/onedspec/odcombine/srcwt/generic/icmm.x
new file mode 100644
index 00000000..5b2b13bf
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icomb.x b/noao/onedspec/odcombine/srcwt/generic/icomb.x
new file mode 100644
index 00000000..df4290b8
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/generic/icomb.x
@@ -0,0 +1,2054 @@
+# 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, wtp, 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
+pointer	wtp[nimages]		# Weight image pointers
+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, w, id, n, m, lflag, v, dbuf, wbuf
+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 (wbuf, nimages, TY_POINTER)
+	call salloc (w, 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 (NULL, Memi[dbuf], nimages)
+	call amovki (NULL, Memi[d], nimages)
+	call amovki (NULL, Memi[wbuf], nimages)
+	call amovki (NULL, Memi[w], nimages)
+	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, 0)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_SHORT)
+	    }
+	}
+
+	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,
+	    wtp, Memi[wbuf], Memi[w], nimages, npts)
+
+	call sfree (sp)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combines (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, wtp, wbuf, w, 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
+pointer	wtp[nimages]		# Combining weight image pointers
+pointer	wbuf[nimages]		# Weight buffers for nonaligned images
+pointer	w[nimages]		# Weight pointers
+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(), xt_opix()
+pointer	impnlr(), imgnlr()
+errchk	immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks
+errchk	ic_grows, 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, wtp, nimages, npts)
+
+	# Allocate weight buffers if needed.
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    if (!aligned) {
+		do i = 1, nimages
+		    call salloc (wbuf[i], npts, TY_REAL)
+	    } else {
+		do i = 1, nimages {
+		    if (wtp[i] != xt_opix (wtp[i], nimages+i, 0))
+			call salloc (wbuf[i], npts, TY_REAL)
+		}
+	    }
+	}
+
+	# 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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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)
+	}
+
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    do i = 1, nimages
+		call xt_imunmap (wtp[i], nimages+i)
+	}
+	call sfree (sp)
+end
+
+procedure icombinei (in, out, scales, zeros, wts, wtp, 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
+pointer	wtp[nimages]		# Weight image pointers
+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, w, id, n, m, lflag, v, dbuf, wbuf
+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 (wbuf, nimages, TY_POINTER)
+	call salloc (w, 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 (NULL, Memi[dbuf], nimages)
+	call amovki (NULL, Memi[d], nimages)
+	call amovki (NULL, Memi[wbuf], nimages)
+	call amovki (NULL, Memi[w], nimages)
+	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, 0)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_INT)
+	    }
+	}
+
+	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,
+	    wtp, Memi[wbuf], Memi[w], nimages, npts)
+
+	call sfree (sp)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combinei (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, wtp, wbuf, w, 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
+pointer	wtp[nimages]		# Combining weight image pointers
+pointer	wbuf[nimages]		# Weight buffers for nonaligned images
+pointer	w[nimages]		# Weight pointers
+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(), xt_opix()
+pointer	impnlr(), imgnlr()
+errchk	immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks
+errchk	ic_growi, 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, wtp, nimages, npts)
+
+	# Allocate weight buffers if needed.
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    if (!aligned) {
+		do i = 1, nimages
+		    call salloc (wbuf[i], npts, TY_REAL)
+	    } else {
+		do i = 1, nimages {
+		    if (wtp[i] != xt_opix (wtp[i], nimages+i, 0))
+			call salloc (wbuf[i], npts, TY_REAL)
+		}
+	    }
+	}
+
+	# 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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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)
+	}
+
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    do i = 1, nimages
+		call xt_imunmap (wtp[i], nimages+i)
+	}
+	call sfree (sp)
+end
+
+procedure icombiner (in, out, scales, zeros, wts, wtp, 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
+pointer	wtp[nimages]		# Weight image pointers
+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, w, id, n, m, lflag, v, dbuf, wbuf
+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 (wbuf, nimages, TY_POINTER)
+	call salloc (w, 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 (NULL, Memi[dbuf], nimages)
+	call amovki (NULL, Memi[d], nimages)
+	call amovki (NULL, Memi[wbuf], nimages)
+	call amovki (NULL, Memi[w], nimages)
+	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, 0)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_REAL)
+	    }
+	}
+
+	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,
+	    wtp, Memi[wbuf], Memi[w], nimages, npts)
+
+	call sfree (sp)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combiner (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, wtp, wbuf, w, 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
+pointer	wtp[nimages]		# Combining weight image pointers
+pointer	wbuf[nimages]		# Weight buffers for nonaligned images
+pointer	w[nimages]		# Weight pointers
+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(), xt_opix()
+pointer	impnlr(), imgnlr
+errchk	immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks
+errchk	ic_growr, 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, wtp, nimages, npts)
+
+	# Allocate weight buffers if needed.
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    if (!aligned) {
+		do i = 1, nimages
+		    call salloc (wbuf[i], npts, TY_REAL)
+	    } else {
+		do i = 1, nimages {
+		    if (wtp[i] != xt_opix (wtp[i], nimages+i, 0))
+			call salloc (wbuf[i], npts, TY_REAL)
+		}
+	    }
+	}
+
+	# 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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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)
+	}
+
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    do i = 1, nimages
+		call xt_imunmap (wtp[i], nimages+i)
+	}
+	call sfree (sp)
+end
+
+procedure icombined (in, out, scales, zeros, wts, wtp, 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
+pointer	wtp[nimages]		# Weight image pointers
+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, w, id, n, m, lflag, v, dbuf, wbuf
+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 (wbuf, nimages, TY_POINTER)
+	call salloc (w, 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 (NULL, Memi[dbuf], nimages)
+	call amovki (NULL, Memi[d], nimages)
+	call amovki (NULL, Memi[wbuf], nimages)
+	call amovki (NULL, Memi[w], nimages)
+	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, 0)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE)
+	    }
+	}
+
+	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,
+	    wtp, Memi[wbuf], Memi[w], nimages, npts)
+
+	call sfree (sp)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combined (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, wtp, wbuf, w, 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
+pointer	wtp[nimages]		# Combining weight image pointers
+pointer	wbuf[nimages]		# Weight buffers for nonaligned images
+pointer	w[nimages]		# Weight pointers
+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(), xt_opix()
+pointer	impnld(), imgnld
+errchk	immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks
+errchk	ic_growd, 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, wtp, nimages, npts)
+
+	# Allocate weight buffers if needed.
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    if (!aligned) {
+		do i = 1, nimages
+		    call salloc (wbuf[i], npts, TY_REAL)
+	    } else {
+		do i = 1, nimages {
+		    if (wtp[i] != xt_opix (wtp[i], nimages+i, 0))
+			call salloc (wbuf[i], npts, TY_REAL)
+		}
+	    }
+	}
+
+	# 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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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)
+	}
+
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    do i = 1, nimages
+		call xt_imunmap (wtp[i], nimages+i)
+	}
+	call sfree (sp)
+end
+
diff --git a/noao/onedspec/odcombine/srcwt/generic/icpclip.x b/noao/onedspec/odcombine/srcwt/generic/icpclip.x
new file mode 100644
index 00000000..237d9686
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icsclip.x b/noao/onedspec/odcombine/srcwt/generic/icsclip.x
new file mode 100644
index 00000000..a0188d72
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icsigma.x b/noao/onedspec/odcombine/srcwt/generic/icsigma.x
new file mode 100644
index 00000000..c66faba9
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/generic/icsigma.x
@@ -0,0 +1,562 @@
+# 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, w, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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 = real (n1) / real (n1 -1)
+			    else
+				sigcor = 1
+			    a = average[i]
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = (Mems[d[1]+k] - a) ** 2 * wt
+			    sumwt = wt
+			    do j = 2, n1 {
+				wt = Memr[w[Memi[m[j]+k]]+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, w, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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 = real (n1) / real (n1 -1)
+			    else
+				sigcor = 1
+			    a = average[i]
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = (Memi[d[1]+k] - a) ** 2 * wt
+			    sumwt = wt
+			    do j = 2, n1 {
+				wt = Memr[w[Memi[m[j]+k]]+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, w, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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 = real (n1) / real (n1 -1)
+			    else
+				sigcor = 1
+			    a = average[i]
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = (Memr[d[1]+k] - a) ** 2 * wt
+			    sumwt = wt
+			    do j = 2, n1 {
+				wt = Memr[w[Memi[m[j]+k]]+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, w, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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 = real (n1) / real (n1 -1)
+			    else
+				sigcor = 1
+			    a = average[i]
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = (Memd[d[1]+k] - a) ** 2 * wt
+			    sumwt = wt
+			    do j = 2, n1 {
+				wt = Memr[w[Memi[m[j]+k]]+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/onedspec/odcombine/srcwt/generic/icsort.x b/noao/onedspec/odcombine/srcwt/generic/icsort.x
new file mode 100644
index 00000000..3ec1d27e
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/icstat.x b/noao/onedspec/odcombine/srcwt/generic/icstat.x
new file mode 100644
index 00000000..3a0ed49c
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/mkpkg b/noao/onedspec/odcombine/srcwt/generic/mkpkg
new file mode 100644
index 00000000..632b61c8
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/generic/xtimmap.x b/noao/onedspec/odcombine/srcwt/generic/xtimmap.x
new file mode 100644
index 00000000..1ab72c6f
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/generic/xtimmap.x
@@ -0,0 +1,1079 @@
+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)
+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/onedspec/odcombine/srcwt/icaclip.gx b/noao/onedspec/odcombine/srcwt/icaclip.gx
new file mode 100644
index 00000000..696402b2
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icaverage.gx b/noao/onedspec/odcombine/srcwt/icaverage.gx
new file mode 100644
index 00000000..26ebd3a4
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icaverage.gx
@@ -0,0 +1,143 @@
+# 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, w, 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
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = Mem$t[d[1]+k] * wt
+			    sumwt = wt
+			    do j = 2, n[i] {
+				wt = Memr[w[Memi[m[j]+k]]+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/onedspec/odcombine/srcwt/iccclip.gx b/noao/onedspec/odcombine/srcwt/iccclip.gx
new file mode 100644
index 00000000..609b3448
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icemask.x b/noao/onedspec/odcombine/srcwt/icemask.x
new file mode 100644
index 00000000..37b19636
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icemask.x
@@ -0,0 +1,128 @@
+# 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, w, 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
+pointer	w[npts]			#I Weight data pointers
+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)
+	if (w[1] == NULL) {
+	    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
+	    }
+	} else {
+	    do i = 1, npts {
+		exp = 0.
+		do j = 1, n[i] {
+		    k = Memi[id[j]+i-1]
+		    if (Memr[w[id[j]+i-1]+i-1] > 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/onedspec/odcombine/srcwt/icgdata.gx b/noao/onedspec/odcombine/srcwt/icgdata.gx
new file mode 100644
index 00000000..d4273e13
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icgdata.gx
@@ -0,0 +1,397 @@
+# 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, wtp, wbuf, w, 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	wtp[nimages]		# Weight images
+pointer	wbuf[nimages]		# Weight buffers
+pointer	w[nimages]		# Weight 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()
+$if (datatype != r)
+int	xt_imgnlr()
+$endif
+long	v3[IM_MAXDIM]
+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)
+		    call xt_cpix (nimages+i)
+		}
+		if (ndim > 1) {
+		    j = v1[2] - offsets[i,2]
+		    if (j < 1 || j > IM_LEN(in[i],2)) {
+			call xt_cpix (i)
+			call xt_cpix (nimages+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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2])
+		}
+		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
+		if (wtp[i] != NULL) {
+		    call amovl (v2, v3, IM_MAXDIM)
+		    l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2])
+		    call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix)
+		    w[i] = wbuf[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
+		    }
+		    if (wtype == S_SIGMAP) {
+			dp = w[i]
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a
+			    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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i]
+			    do j = 1, npts {
+				Memr[dp] = Memr[dp] / a
+				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
+			}
+			if (wtype == S_SIGMAP) {
+			    dp = w[i] + n1 - 1
+			    mp = m[i] + n1 - 1
+			    do j = n1, n2 {
+				if (Memi[mp] == 0)
+				    Memr[dp] = Memr[dp] / a
+				dp = dp + 1
+				mp = mp + 1
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	# Compute weights from sigmas.
+	if (wtype == S_SIGMAP) {
+	    if (dflag == D_ALL) {
+		do i = 1, nimages {
+		    dp = w[i]
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a > 0.)
+			    Memr[dp] = 1. / (a**2)
+			dp = dp + 1
+		    }
+		}
+	    } else if (dflag == D_MIX) {
+		do i = 1, nimages {
+		    if (lflag[i] == D_ALL) {
+			dp = w[i]
+			do j = 1, npts {
+			    a = Memr[dp]
+			    if (a > 0.)
+				Memr[dp] = 1. / (a**2)
+			    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 = w[i] + n1 - 1
+			mp = m[i] + n1 - 1
+			do j = n1, n2 {
+			    if (Memi[mp] == 0) {
+				a = Memr[dp]
+				if (a > 0.)
+				    Memr[dp] = 1. / (a**2)
+			    }
+			    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/onedspec/odcombine/srcwt/icgdata.gxBAK b/noao/onedspec/odcombine/srcwt/icgdata.gxBAK
new file mode 100644
index 00000000..27f51ec5
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icgdata.gxBAK
@@ -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/onedspec/odcombine/srcwt/icgrow.gx b/noao/onedspec/odcombine/srcwt/icgrow.gx
new file mode 100644
index 00000000..caf7dd29
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icgscale.x b/noao/onedspec/odcombine/srcwt/icgscale.x
new file mode 100644
index 00000000..afcc8fd0
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icgscale.x
@@ -0,0 +1,92 @@
+# 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(), strncmp()
+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 (strncmp (name, "wtmap!", 6) == 0) {
+	    type = S_WTMAP
+	} else if (strncmp (name, "sigmap!", 7) == 0) {
+	    type = S_SIGMAP
+	} 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/onedspec/odcombine/srcwt/ichdr.x b/noao/onedspec/odcombine/srcwt/ichdr.x
new file mode 100644
index 00000000..2d19c5bd
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icimstack.x b/noao/onedspec/odcombine/srcwt/icimstack.x
new file mode 100644
index 00000000..d5628694
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/iclog.x b/noao/onedspec/odcombine/srcwt/iclog.x
new file mode 100644
index 00000000..43ab37ab
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icmask.com b/noao/onedspec/odcombine/srcwt/icmask.com
new file mode 100644
index 00000000..baba6f6a
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icmask.h b/noao/onedspec/odcombine/srcwt/icmask.h
new file mode 100644
index 00000000..533c601d
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icmask.x b/noao/onedspec/odcombine/srcwt/icmask.x
new file mode 100644
index 00000000..9242405d
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icmedian.gx b/noao/onedspec/odcombine/srcwt/icmedian.gx
new file mode 100644
index 00000000..4ac51ae6
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icmedian.gx
@@ -0,0 +1,231 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+$for (sird)
+# IC_MEDIAN -- Median of lines
+
+procedure ic_median$t (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+$if (datatype == silx)
+real	val1, val2, val3
+$else
+PIXEL	val1, val2, val3
+$endif
+PIXEL	temp, wtemp
+$if (datatype == x)
+real	abs_temp
+$endif
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Mem$t[d[j1]+k]
+			val2 = Mem$t[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Mem$t[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Mem$t[d[j1]+k]
+			    val2 = Mem$t[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Mem$t[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Mem$t[d[j]+k];  lo1 = lo;  up1 = up
+		    $if (datatype == x)
+		    abs_temp = abs (temp)
+		    $endif
+
+		    repeat {
+			$if (datatype == x)
+			while (abs (Mem$t[d[lo1]+k]) < abs_temp)
+			$else
+			while (Mem$t[d[lo1]+k] < temp)
+			$endif
+			    lo1 = lo1 + 1
+			$if (datatype == x)
+			while (abs_temp < abs (Mem$t[d[up1]+k]))
+			$else
+			while (temp < Mem$t[d[up1]+k])
+			$endif
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Mem$t[d[lo1]+k]
+			    Mem$t[d[lo1]+k] = Mem$t[d[up1]+k]
+			    Mem$t[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Mem$t[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Mem$t[d[j]+k];  lo1 = lo;  up1 = up
+			$if (datatype == x)
+			abs_temp = abs (temp)
+			$endif
+
+			repeat {
+			    $if (datatype == x)
+			    while (abs (Mem$t[d[lo1]+k]) < abs_temp)
+			    $else
+			    while (Mem$t[d[lo1]+k] < temp)
+			    $endif
+				lo1 = lo1 + 1
+			    $if (datatype == x)
+			    while (abs_temp < abs (Mem$t[d[up1]+k]))
+			    $else
+			    while (temp < Mem$t[d[up1]+k])
+			    $endif
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Mem$t[d[lo1]+k]
+				Mem$t[d[lo1]+k] = Mem$t[d[up1]+k]
+				Mem$t[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Mem$t[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else if (n1 == 3) {
+		$if (datatype == x)
+	        val1 = abs (Mem$t[d[1]+k])
+	        val2 = abs (Mem$t[d[2]+k])
+	        val3 = abs (Mem$t[d[3]+k])
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = Mem$t[d[2]+k]
+		    else if (val1 < val3)	# acb
+		        median[i] = Mem$t[d[3]+k]
+		    else			# cab
+		        median[i] = Mem$t[d[1]+k]
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = Mem$t[d[2]+k]
+		    else if (val1 > val3)	# bca
+		        median[i] = Mem$t[d[3]+k]
+		    else			# bac
+		        median[i] = Mem$t[d[1]+k]
+	        }
+		$else
+	        val1 = Mem$t[d[1]+k]
+	        val2 = Mem$t[d[2]+k]
+	        val3 = Mem$t[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+		$endif
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Mem$t[d[1]+k]
+		val2 = Mem$t[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Mem$t[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+$endfor
diff --git a/noao/onedspec/odcombine/srcwt/icmm.gx b/noao/onedspec/odcombine/srcwt/icmm.gx
new file mode 100644
index 00000000..16505588
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icomb.gx b/noao/onedspec/odcombine/srcwt/icomb.gx
new file mode 100644
index 00000000..ad572761
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icomb.gx
@@ -0,0 +1,711 @@
+# 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, wtp, 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
+pointer	wtp[nimages]		# Weight image pointers
+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, w, id, n, m, lflag, v, dbuf, wbuf
+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 (wbuf, nimages, TY_POINTER)
+	call salloc (w, 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 (NULL, Memi[dbuf], nimages)
+	call amovki (NULL, Memi[d], nimages)
+	call amovki (NULL, Memi[wbuf], nimages)
+	call amovki (NULL, Memi[w], nimages)
+	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, 0)
+		if (im != in[i])
+		    call salloc (Memi[dbuf+i-1], npts, TY_PIXEL)
+	    }
+	}
+
+	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,
+	    wtp, Memi[wbuf], Memi[w], nimages, npts)
+
+	call sfree (sp)
+end
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combine$t (in, out, dbuf, d, id, n, m, lflag, offsets,
+	scales, zeros, wts, wtp, wbuf, w, 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
+pointer	wtp[nimages]		# Combining weight image pointers
+pointer	wbuf[nimages]		# Weight buffers for nonaligned images
+pointer	w[nimages]		# Weight pointers
+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(), xt_opix()
+$if (datatype == sil)
+pointer	impnlr(), imgnlr()
+$else
+pointer	impnl$t(), imgnl$t
+$endif
+errchk	immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks
+errchk	ic_grow$t, 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, wtp, nimages, npts)
+
+	# Allocate weight buffers if needed.
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    if (!aligned) {
+		do i = 1, nimages
+		    call salloc (wbuf[i], npts, TY_REAL)
+	    } else {
+		do i = 1, nimages {
+		    if (wtp[i] != xt_opix (wtp[i], nimages+i, 0))
+			call salloc (wbuf[i], npts, TY_REAL)
+		}
+	    }
+	}
+
+	# 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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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, wtp, wbuf, w, 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, w, 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, w, 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, w, 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, w,
+			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)
+	}
+
+	if (wtype == S_WTMAP || wtype == S_SIGMAP) {
+	    do i = 1, nimages
+		call xt_imunmap (wtp[i], nimages+i)
+	}
+	call sfree (sp)
+end
+$endfor
diff --git a/noao/onedspec/odcombine/srcwt/icombine.com b/noao/onedspec/odcombine/srcwt/icombine.com
new file mode 100644
index 00000000..42ba4224
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icombine.com
@@ -0,0 +1,46 @@
+# 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)
+int	wtype			# Weight type
+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, wtype, sigscale,
+		 project, mclip, aligned, doscale, doscale1, dothresh,
+		 dowts, keepids, docombine, sort, verbose, icm
diff --git a/noao/onedspec/odcombine/srcwt/icombine.h b/noao/onedspec/odcombine/srcwt/icombine.h
new file mode 100644
index 00000000..277c79de
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icombine.h
@@ -0,0 +1,56 @@
+# 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_WTMAP		8
+define	S_SIGMAP	9
+
+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/onedspec/odcombine/srcwt/icombine.x b/noao/onedspec/odcombine/srcwt/icombine.x
new file mode 100644
index 00000000..19add027
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icombine.x
@@ -0,0 +1,488 @@
+# 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, wtp, 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 salloc (wtp, nimages, TY_POINTER)
+		call amovki (out[1], Memi[in], nimages)
+		call amovki (NULL, Memi[wtp], nimages)
+	    } else {
+		call salloc (in, imtlen(list), TY_POINTER)
+		call salloc (wtp, imtlen(list), TY_POINTER)
+		call amovki (NULL, Memi[in], imtlen(list))
+		call amovki (NULL, Memi[wtp], 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"))
+		;
+	    iferr (call imdelf (out, "ICBPM"))
+		;
+
+	    # 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[wtp], Memi[offsets], nimages, bufsize)
+	    case TY_USHORT, TY_INT, TY_LONG:
+		call icombinei (Memi[in], out, scales, zeros,
+		    wts, Memi[wtp], Memi[offsets], nimages, bufsize)
+	    case TY_DOUBLE:
+		call icombined (Memi[in], out, scales, zeros,
+		    wts, Memi[wtp], Memi[offsets], nimages, bufsize)
+	    case TY_COMPLEX:
+		call error (1, "Complex images not allowed")
+	    default:
+		call icombiner (Memi[in], out, scales, zeros,
+		    wts, Memi[wtp], 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 (wtype == S_WTMAP || wtype == S_SIGMAP) {
+		do j = 1, nimages {
+		    if (Memi[wtp+j-1] != NULL)
+			call xt_imunmap (Memi[wtp+j-1], nimages+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/onedspec/odcombine/srcwt/icpclip.gx b/noao/onedspec/odcombine/srcwt/icpclip.gx
new file mode 100644
index 00000000..f0c76369
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icpmmap.x b/noao/onedspec/odcombine/srcwt/icpmmap.x
new file mode 100644
index 00000000..1afeedd7
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icrmasks.x b/noao/onedspec/odcombine/srcwt/icrmasks.x
new file mode 100644
index 00000000..8b9a0c3d
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icscale.x b/noao/onedspec/odcombine/srcwt/icscale.x
new file mode 100644
index 00000000..e38fc3fd
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icscale.x
@@ -0,0 +1,391 @@
+# 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, wtp nimages, npts)
+
+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
+pointer	wtp[nimages]		# Weight image pointers
+int	nimages			# Number of images
+int	npts			# Number of points per output line
+
+int	stype, ztype
+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_immap(), xt_opix()
+errchk	ic_gscale, xt_immap, 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)
+
+	# Check for syntax error.
+	if (stype == S_WTMAP || stype == S_SIGMAP ||
+	    ztype == S_WTMAP || ztype == S_SIGMAP)
+	    call error (1, "Unknown scale or zero type")
+
+	# Open maps if needed.
+	if (wtype == S_WTMAP) {
+	    do i = 1, nimages {
+	        call imgstr (in[i], Memc[wname+6], Memc[str], SZ_LINE)
+		wtp[i] = xt_immap (Memc[str], READ_ONLY, 0, nimages+i)
+	    }
+	} else if (wtype == S_SIGMAP) {
+	    do i = 1, nimages {
+	        call imgstr (in[i], Memc[wname+7], Memc[str], SZ_LINE)
+		wtp[i] = xt_immap (Memc[str], READ_ONLY, 0, nimages+i)
+	    }
+	}
+	if (wtp[1] != NULL) {
+	    # Check maps match the input images.
+	    iferr {
+		do i = 1, nimages {
+		    k = IM_NDIM(in[i])
+		    if (IM_NDIM(wtp[i]) != k)
+			call error (1, "Weight maps don't match images")
+		    do j = 1, k {
+			if (IM_LEN(in[i],j) != IM_LEN(wtp[i],j))
+			    call error (1, "Weight maps don't match images")
+		    }
+		}
+	    } then {
+		do i = 1, nimages
+		    call xt_imunmap (wtp[i], nimages+i)
+		call error (1, "Weight maps don't match images")
+	    }
+	}
+	    
+
+	# 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 || wtype == S_WTMAP || wtype == S_SIGMAP)) {
+	    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)
+	dowts = (dowts || (wtype == S_WTMAP) || (wtype == S_SIGMAP))
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/odcombine/srcwt/icsclip.gx b/noao/onedspec/odcombine/srcwt/icsclip.gx
new file mode 100644
index 00000000..1b1c5de9
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icsection.x b/noao/onedspec/odcombine/srcwt/icsection.x
new file mode 100644
index 00000000..746c1f51
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icsetout.x b/noao/onedspec/odcombine/srcwt/icsetout.x
new file mode 100644
index 00000000..51e1fe90
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icsigma.gx b/noao/onedspec/odcombine/srcwt/icsigma.gx
new file mode 100644
index 00000000..b664fd24
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icsigma.gx
@@ -0,0 +1,154 @@
+# 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, w, npts, average, sigma)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image ID pointers
+int	n[npts]			# Number of points
+real	wts[ARB]		# Weights
+pointer	w[ARB]			# Weight data pointers
+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 && w[1] == NULL) {
+	    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) {
+		if (w[1] == NULL) {
+		    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 = real (n1) / real (n1 -1)
+			    else
+				sigcor = 1
+			    a = average[i]
+			    wt = Memr[w[Memi[m[1]+k]]+k]
+			    sum = (Mem$t[d[1]+k] - a) ** 2 * wt
+			    sumwt = wt
+			    do j = 2, n1 {
+				wt = Memr[w[Memi[m[j]+k]]+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/onedspec/odcombine/srcwt/icsort.gx b/noao/onedspec/odcombine/srcwt/icsort.gx
new file mode 100644
index 00000000..e124da15
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/icstat.gx b/noao/onedspec/odcombine/srcwt/icstat.gx
new file mode 100644
index 00000000..c594182b
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/mkpkg b/noao/onedspec/odcombine/srcwt/mkpkg
new file mode 100644
index 00000000..2ed3d8cb
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/tymax.x b/noao/onedspec/odcombine/srcwt/tymax.x
new file mode 100644
index 00000000..a7f4f469
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/xtimmap.com b/noao/onedspec/odcombine/srcwt/xtimmap.com
new file mode 100644
index 00000000..61bf314a
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/xtimmap.gx b/noao/onedspec/odcombine/srcwt/xtimmap.gx
new file mode 100644
index 00000000..c0ae26a6
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/srcwt/xtprocid.x b/noao/onedspec/odcombine/srcwt/xtprocid.x
new file mode 100644
index 00000000..0a82d81b
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/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/onedspec/odcombine/t_odcombine.x b/noao/onedspec/odcombine/t_odcombine.x
new file mode 100644
index 00000000..9f5a58d8
--- /dev/null
+++ b/noao/onedspec/odcombine/t_odcombine.x
@@ -0,0 +1,1071 @@
+include	<imhdr.h>
+include	<error.h>
+include	<mach.h>
+include	<mwset.h>
+include	<smw.h>
+include	"src/icombine.h"
+
+# Grouping options
+define	GROUP	"|all|images|apertures|"
+define	GRP_ALL		1
+define	GRP_IMAGES	2
+define	GRP_APERTURES	3
+
+# Mask formats
+define	MASKFORMATS	"|bpmpixel|bpmspectrum|"
+define	BPMPIX		1
+define	BPMSPEC		2
+
+# Spectrum data structure
+define	NS	Memi[$1+$2-1]			# Number of spec of given ap
+define	SH	Memi[Memi[$1+$2-1]+$3-1]	# Spectrum header structure
+
+
+# T_ODCOMBINE - Combine spectra matched in world coordinates.
+# 
+# The input spectra are combined by medianing, averaging or summing with
+# optional rejection, scaling and weighting.  The combining algorithms and
+# other features are the same as those in IMCOMBINE.
+# 
+# The main difference with IMCOMBINE is that the spectra are first resampled
+# to a common grid of pixels in dispersion.  To do this each spectrum
+# is resampled to a temporary file which are then combined and deleted.
+# When bad pixels are used they are also resampled in the same way.
+# 
+# Since there can be multiple spectra per file (each with different
+# aperture numbers) there are three ways to group the spectra for combining.
+# One is by image where all spectra in the file are combined.  The second
+# is by aperture where the same aperture across multple files are combine.
+# The third is to combine all spectra independent of aperture or file.
+# 
+# The structure of the program is to first internally collect all the
+# spectra from each input file.  When combining by image this is done file
+# by file otherwise all the files are collected together.  The reason for
+# this is to avoid opening, search, reading, and closing the same file
+# for each aperture Then the spectra for one output are rebinned to a
+# common dispersion and written to temporary files.  The same is done for
+# bad pixel masks if used.  The spectra in the files are then combined.
+# Finally the temporary files are deleted.  The rebinning and combine are
+# repeated for each output spectrum.
+
+procedure t_odcombine()
+
+pointer	aps			# aperture ranges
+int	group			# grouping option
+
+int	mformat, mtype, mvalue
+int	i, j, index, naps
+pointer	im, mw, refim, shout
+pointer	sp, input, output, headers, bmask, rmask, nrmask, emask, sigma, logfile
+pointer	tmp, str, s, b, ns
+int	ilist1, ilist2, ilist, olist, hlist, blist, rlist, slist, nrlist, elist
+
+bool	clgetb()
+int	clgeti(), clgwrd()
+int	imtopen(), imtopenp(), imtgetim(), imtlen()
+real	clgetr()
+pointer	rng_open()
+errchk	shdr_open, odc_gspec, odc_rebin, odc_output, odc_combine
+
+include	"src/icombine.com"
+
+begin
+	# Allocate stack memory.  Note some of the variables are declared in
+	# the icombine common block but still need to be allocated here.
+
+	call smark (sp)
+	call salloc (input, 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 (logfile, SZ_FNAME, TY_CHAR)
+	call salloc (tmp, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, 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)
+
+	# Set the IMCOMBINE parameters.
+
+	call strcpy ("ODCOMBINE", 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 = false
+	combine = clgwrd ("combine", Memc[str], SZ_LINE, COMBINE)
+	reject = clgwrd ("reject", Memc[str], SZ_LINE, 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")
+
+	# 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
+	}
+
+	# Get ODCOMBINE specific parameters.
+
+	call clgstr ("apertures", Memc[str], SZ_LINE)
+	group = clgwrd ("group", Memc[input], SZ_FNAME, GROUP)
+
+	# Expand aperture list.
+	iferr (aps = rng_open (Memc[str], INDEF, INDEF, INDEF))
+	    call error (1, "Error in aperture list")
+
+	# We need to know about the mask in order to resample them.
+	# This does not support specifying a mask by name or keyword.
+
+	mformat = clgwrd ("smaskformat", Memc[str], SZ_LINE, MASKFORMATS)
+	mtype = clgwrd ("smasktype", Memc[str], SZ_LINE, MASKTYPES)
+	if (mtype == 0)
+	    call error (1, "Unsupported masktype")
+	mvalue = clgeti ("smaskvalue")
+	if (mtype == M_BADBITS && mvalue == 0) 
+	    mtype = M_NONE
+	if (mtype == M_NONE)
+	    call clpstr ("masktype", "none")
+	else
+	    call clpstr ("masktype", "goodvalue")
+	call clputi ("maskvalue", 0)
+
+	# Check lists.
+	i = imtlen (ilist)
+	if (i == 0)
+	    call error (1, "No input images to combine")
+	switch (group) {
+	case GRP_ALL, GRP_APERTURES:
+	    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")
+	case GRP_IMAGES:
+	    if (imtlen (olist) != i)
+		call error (1, "Wrong number of output images")
+	    if (imtlen (hlist) > 0 && imtlen (hlist) != i)
+		call error (1, "Wrong number of header files")
+	    if (imtlen (blist) > 0 && imtlen (blist) != i)
+		call error (1, "Wrong number of bad pixel masks")
+	    if (imtlen (rlist) > 0 && imtlen (rlist) != i)
+		call error (1, "Wrong number of rejection masks")
+	    if (imtlen (nrlist) > 0 && imtlen (nrlist) != i)
+		call error (1, "Wrong number of number rejected masks")
+	    if (imtlen (elist) > 0 && imtlen (elist) != i)
+		call error (1, "Wrong number of exposure masks")
+	    if (imtlen (slist) > 1 && imtlen (slist) != i)
+		call error (1, "Wrong number of sigma images")
+	}
+
+	# Set temporary output rootname.
+	call mktemp ("tmp", Memc[tmp], SZ_FNAME)
+
+	# Loop through input images.
+	index = 0
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+
+	    # Get all requested apertures from an image.  When not grouping
+	    # by image go through all images and exhaust the input list.
+
+	    naps = 0
+	    repeat {
+		iferr (call odc_gspec (Memc[input], aps, group, mtype, mformat,
+		    s, b, ns, naps)) {
+		    if (group == GRP_IMAGES) {
+			call erract (EA_WARN)
+			next
+		    } else {
+			call erract (EA_ERROR)
+		    }
+		}
+		if (group == GRP_IMAGES)
+		    break
+	    } until (imtgetim (ilist, Memc[input], SZ_FNAME) == EOF)
+
+	    if (naps < 1) {
+		call eprintf ("No input spectra to combine\n")
+		next
+	    }
+
+	    # Create each output spectrum.  This involves rebinning to
+	    # temporary files, combining, and cleaning up.  The files are
+	    # deleted in the odc_combine routine.
+
+	    do i = 1, naps {
+
+		# Set the output dispersion in a temporary template image.
+		call odc_output (SH(s,i,1), NS(ns,i), Memc[tmp], im, mw, refim)
+		call shdr_open (im, mw, i, 1, INDEFI, SHDATA, shout)
+
+		# Rebin the spectra.
+		call odc_rebin (im, shout, SH(s,i,1), SH(b,i,1), NS(ns,i),
+		    mformat, mtype, mvalue, Memc[tmp])
+
+		# Close and delete the template image.
+		call shdr_close (shout)
+		call smw_close (mw)
+		call imunmap (im)
+		call imunmap (refim)
+		iferr (call imdelete (Memc[tmp]))
+		    ;
+
+		# Set lists to be combined.
+		call sprintf (Memc[str], SZ_LINE, "%s.*\\[^x]")
+		    call pargstr (Memc[tmp])
+		ilist1 = imtopen (Memc[str])
+		if (mtype != NONE) {
+		    call sprintf (Memc[str], SZ_LINE, "%sbpm.*\\[^x]")
+			call pargstr (Memc[tmp])
+		    ilist2 = imtopen (Memc[str])
+		} else
+		    ilist2 = imtopen ("")
+
+		# Set output names.
+		switch (group) {
+		case GRP_ALL:
+		    index = 1
+		    j = INDEFI
+		case GRP_IMAGES:
+		    index = index + 1
+		    j = INDEFI
+		case GRP_APERTURES:
+		    index = 1
+		    j = AP(SH(s,i,1))
+		}
+		call odc_imtgetim (olist, index, j, Memc[output], SZ_FNAME)
+		call odc_imtgetim (hlist, index, j, Memc[headers], SZ_FNAME)
+		call odc_imtgetim (blist, index, j, Memc[bmask], SZ_FNAME)
+		call odc_imtgetim (rlist, index, j, Memc[rmask], SZ_FNAME)
+		call odc_imtgetim (nrlist, index, j, Memc[nrmask], SZ_FNAME)
+		call odc_imtgetim (elist, index, j, Memc[emask], SZ_FNAME)
+		call odc_imtgetim (slist, index, j, Memc[sigma], SZ_FNAME)
+
+		# Combine and delete the lists.
+		iferr (call odc_combine (ilist1, ilist2, Memc[output],
+		    Memc[headers], Memc[bmask], Memc[rmask], Memc[nrmask],
+		    Memc[emask], Memc[sigma], Memc[logfile], YES))
+		    call erract (EA_WARN)
+
+		call imtclose (ilist1)
+		call imtclose (ilist2)
+	    }
+
+	    # Free all the spectrum data structures.
+	    call odc_fspec (s, b, ns, naps)
+	}
+
+	# Finish up.
+	call rng_close (aps)
+	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
+
+
+# ODC_GSPEC -- Get spectra from an input image.
+#
+# This allocates and sets arrays of spectrum structures.  There is an array
+# for each "output" aperture and the number of elements is given by another
+# array (ns).  The number of output apertures is given by naps.  Note that each
+# call to this accumulates new spectra.
+
+procedure odc_gspec (input, aps, group, mtype, mformat, s, b, ns, naps)
+
+char	input[ARB]		#I Input spectrum file
+pointer	aps			#I Apertures to select
+int	group			#I Grouping for combining
+int	mtype			#I Mask type
+int	mformat			#I Mask format
+pointer	s			#U Spectra data structure
+pointer	b			#U Spectra data structure for pixel masks
+int	ns			#U Number of spectra per group
+int	naps			#U Number of output apertures
+
+int	i, j, k, n
+pointer	im, mw, sh, sh1, bpm, err
+
+bool	rng_elementi()
+pointer	immap(), smw_openim()
+errchk	immap, smw_openim, shdr_open
+
+begin
+	# Map the input spectrum file. Check format.
+	im = immap (input, READ_ONLY, 0)
+	mw = smw_openim (im)
+	if (SMW_FORMAT(mw) != SMW_ES && SMW_FORMAT(mw) != SMW_MS) {
+	    call smw_close (mw)
+	    call imunmap (im)
+	    call salloc (err, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[err], SZ_LINE,
+	       "Unsupported spectral format (%s)")
+	       call pargstr (input)
+	    call error (1, Memc[err])
+	}
+	sh = NULL
+
+	# Get the associated mask if requested.  It is not an error if there
+	# is mask.
+
+	if (mtype == M_NONE)
+	    bpm = NULL
+	else {
+	    switch (mformat) {
+	    case BPMPIX, BPMSPEC:
+		call malloc (bpm, SZ_FNAME, TY_CHAR)
+		iferr (call imgstr (im, "BPM", Memc[bpm], SZ_FNAME))
+		    call mfree (bpm, TY_CHAR)
+	    default:
+	        bpm = NULL
+	    }
+	}
+
+	# Select the requested apertures and group by output aperture.
+	do i = 1, SMW_NSPEC(mw) {
+	    call shdr_open (im, mw, i, 1, INDEFI, SHDATA, sh)
+	    if (!rng_elementi (aps, AP(sh)))
+		next
+
+	    if (group == GRP_APERTURES) {
+		for (j=1; j<=naps; j=j+1)
+		    if (AP(sh) == AP(SH(s,j,1)))
+			break
+		n = 10
+	    } else {
+		j = 1
+		n = 1
+	    }
+
+	    if (naps == 0) {
+		call calloc (s, n, TY_POINTER)
+		call calloc (b, n, TY_POINTER)
+		call calloc (ns, n, TY_INT)
+	    } else if (j > naps && mod (naps, n) == 0) {
+		call realloc (s, naps+n, TY_POINTER)
+		call realloc (b, naps+n, TY_POINTER)
+		call realloc (ns, naps+n, TY_INT)
+		call aclri (Memi[s+naps], n)
+		call aclri (Memi[b+naps], n)
+		call aclri (Memi[ns+naps], n)
+	    }
+	    if (j > naps)
+		naps = naps + 1
+	    n = NS(ns,j)
+	    if (n == 0) {
+		call malloc (Memi[s+j-1], 10, TY_POINTER)
+		call malloc (Memi[b+j-1], 10, TY_POINTER)
+	    } else if (mod (n, 10) == 0) {
+		call realloc (Memi[s+j-1], n+10, TY_POINTER)
+		call realloc (Memi[b+j-1], n+10, TY_POINTER)
+	    }
+
+	    n = n + 1
+	    SH(s,j,n) = NULL
+	    SH(b,j,n) = NULL
+	    call shdr_copy (sh, SH(s,j,n), NO)
+	    NS(ns,j) = n
+	}
+
+	call imunmap (IM(sh))
+	MW(sh) = NULL
+	call shdr_close (sh)
+
+	# Get BPMs if defined.
+	if (bpm != NULL) {
+	    im = immap (Memc[bpm], READ_ONLY, 0)
+	    mw = smw_openim (im)
+	    sh = NULL
+
+	    switch (mformat) {
+	    case BPMPIX:
+		do j = 1, naps {
+		    n = NS(ns,j)
+		    sh1 = SH(s,j,n)
+		    if (sh1 == NULL)
+			next
+		    k = LINDEX(sh1,1)
+		    call shdr_open (im, mw, k, 1, INDEFI, SHDATA, sh)
+		    if (LINDEX(sh,1) != k)
+			next
+		    call shdr_copy (sh1, SH(b,j,n), YES)
+		    sh1 = SH(b,j,n)
+		    call strcpy (IMNAME(sh), IMNAME(sh1), LEN_SHDRS)
+		    call strcpy (IMSEC(sh), IMSEC(sh1), LEN_SHDRS)
+		    call strcpy (TITLE(sh), TITLE(sh1), LEN_SHDRS)
+		    call amovi (LINDEX(sh,1), LINDEX(sh1,1), 2)
+		    call amovi (PINDEX(sh,1), PINDEX(sh1,1), 2)
+		    APINDEX(sh) = APINDEX(sh1)
+		    call amovr (Memr[SY(sh)], Memr[SY(sh1)],
+			min (SN(sh), SN(sh1)))
+		}
+		call smw_close (mw)
+	    case BPMSPEC:
+		do j = 1, naps {
+		    n = NS(ns,j)
+		    sh1 = SH(s,j,n)
+		    if (sh1 == NULL)
+			next
+		    k = AP(sh1)
+		    call shdr_open (im, mw, 1, 1, k, SHDATA, sh)
+		    if (AP(sh) != k)
+			next
+		    call shdr_copy (sh, SH(b,j,n), NO)
+		}
+	    }
+
+	    call imunmap (IM(sh))
+	    MW(sh) = NULL
+	    call shdr_close (sh)
+	    call mfree (bpm, TY_CHAR)
+	}
+end
+
+
+
+# ODC_FSPEC -- Free spectrum data structures.
+
+procedure odc_fspec (s, b, ns, naps)
+
+pointer	s		#U Spectrum data structures
+pointer	b		#U BPM data structures
+pointer	ns		#U Number of spectra per output aperture
+int	naps		#I Number of output apertures
+
+int	i, j, k, l
+pointer	sh, mw
+
+begin
+	# Find all the distinct SMW pointers and free them.
+	# Then free all the spectrum data pointers.
+
+	do j = 1, naps {
+	    do i = 1, NS(ns,j) {
+		sh = SH(s,j,i)
+		if (sh == NULL)
+		    next
+		mw = MW(sh)
+		if (mw != NULL) {
+		    do k = 1, naps  {
+			do l = 1, NS(ns,k) {
+			    sh = SH(s,k,l)
+			    if (sh == NULL)
+				next
+			    if (MW(sh) == mw)
+				MW(sh) = NULL
+			}
+		    }
+		    call smw_close (mw)
+		}
+	    }
+	}
+	do j = 1, naps {
+	    do i = 1, NS(ns,j) {
+		sh = SH(s,j,i)
+		if (sh == NULL)
+		    next
+		call shdr_close (sh)
+	    }
+	    call mfree (Memi[s+j-1], TY_POINTER)
+	}
+	call mfree (s, TY_POINTER)
+
+	do j = 1, naps {
+	    do i = 1, NS(ns,j) {
+		sh = SH(b,j,i)
+		if (sh == NULL)
+		    next
+		mw = MW(sh)
+		if (mw != NULL) {
+		    do k = 1, naps  {
+			do l = 1, NS(ns,k) {
+			    sh = SH(b,k,l)
+			    if (sh == NULL)
+				next
+			    if (MW(sh) == mw)
+				MW(sh) = NULL
+			}
+		    }
+		    call smw_close (mw)
+		}
+	    }
+	}
+	do j = 1, naps {
+	    do i = 1, NS(ns,j) {
+		sh = SH(b,j,i)
+		if (sh == NULL)
+		    next
+		call shdr_close (sh)
+	    }
+	    call mfree (Memi[b+j-1], TY_POINTER)
+	}
+	call mfree (b, TY_POINTER)
+
+	call mfree (ns, TY_INT)
+end
+
+
+# ODC_REBIN -- Rebin spectra and masks.
+
+procedure odc_rebin (refim, shout, s, b, n, mformat, mtype, mvalue, output)
+
+pointer	refim			#I Output reference image
+pointer	shout			#I Output spectrum structure
+pointer	s[ARB]			#I Array of spectrum structures
+pointer	b[ARB]			#I Array of BPM spectrum structures
+int	n			#I Number of spectra
+int	mformat			#I Mask format
+int	mtype			#I Mask type
+int	mvalue			#I Mask value
+char	output[ARB]		#I Output rootname
+
+int	i, j, k, p1, p2, npts
+double	c[3], d[3,3]
+pointer	sh, bpm, im, mw
+pointer	sp, str
+
+int	mw_stati()
+double	shdr_lw(), shdr_wl()
+pointer	immap(), mw_openim(), impl1r()
+errchk	immap, mw_openim, impl1r
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	j = 0
+	do i = 1, n {
+	    sh = s[i]
+	    bpm = b[i]
+
+	    # Determine limits of input spectrum relative to the output
+	    # spectrum.
+
+	    c[1] = shdr_wl (shout, shdr_lw (sh, double(0.5)))
+	    c[2] = shdr_wl (shout, shdr_lw (sh, double(SN(sh)+0.5)))
+	    p1 = max (1, nint (min (c[1], c[2]) + 0.01))
+	    p2 = min (SN(shout), nint (max (c[1], c[2]) - 0.01))
+	    npts = p2 - p1 + 1
+	    if (npts < 1)
+		next
+	    p1 = 1 - p1
+
+	    # Rebin the spectra and masks.
+	    call shdr_rebin (sh, shout)
+	    call odc_bpm (bpm, shout, mtype, mvalue)
+
+	    # Write the results.  We only write the part of the output
+	    # contained by the input spectrum and then let the combining deal
+	    # with the origin offsets.  This is done by setting the physical
+	    # pixel coordinate system to match the desired output system.
+	    # The main reason for this it to make the output of bounds
+	    # pixel implicitly bad or excluded.
+
+	    j = j + 1
+	    call sprintf (Memc[str], SZ_LINE, "%s.%04d")
+		call pargstr (output)
+		call pargi (j)
+	    im = immap (Memc[str], NEW_COPY, refim)
+	    call sprintf (Memc[str], SZ_LINE, "%s%s(%s)")
+		call pargstr (IMNAME(sh))
+		call pargstr (IMSEC(sh))
+		call pargi (AP(sh))
+	    call imastr (im, "ICFNAME", Memc[str])
+	    IM_LEN(im,1) = npts
+	    if (p1 != 0) {
+		mw = mw_openim (im)
+		k = mw_stati (mw, MW_NPHYSDIM)
+		call mw_gltermd (mw, d, c, k)
+		c[1] = c[1] + p1
+		call mw_sltermd (mw, d, c, k)
+		call mw_saveim (mw, im)
+	    }
+	    call amovr (Memr[SY(sh)-p1], Memr[impl1r(im)], npts)
+	    if (bpm != NULL) {
+		switch (mformat) {
+		case BPMPIX:
+		    call sprintf (Memc[str], SZ_LINE, "%s%s")
+			call pargstr (IMNAME(bpm))
+			call pargstr (IMSEC(bpm))
+		case BPMSPEC:
+		    call sprintf (Memc[str], SZ_LINE, "%s%s(%s)")
+			call pargstr (IMNAME(bpm))
+			call pargstr (IMSEC(bpm))
+			call pargi (AP(bpm))
+		}
+		call imastr (im, "ICBPM", Memc[str])
+		call sprintf (Memc[str], SZ_LINE, "%sbpm.%04d")
+		    call pargstr (output)
+		    call pargi (j)
+		call imastr (im, "BPM", Memc[str])
+	    } else iferr (call imdelf (im, "BPM"))
+		;
+	    call imunmap (im)
+
+	    if (bpm == NULL)
+		next
+
+	    im = immap (Memc[str], NEW_COPY, refim)
+	    IM_PIXTYPE(im) = TY_INT
+	    IM_LEN(im,1) = npts
+	    if (p1 != 0) {
+		mw = mw_openim (im)
+		k = mw_stati (mw, MW_NPHYSDIM)
+		call mw_gltermd (mw, d, c, k)
+		c[1] = c[1] + p1
+		call mw_sltermd (mw, d, c, k)
+		call mw_saveim (mw, im)
+	    }
+	    call amovr (Memr[SY(bpm)-p1], Memr[impl1r(im)], npts)
+	    iferr (call imdelf (im, "BPM"))
+	         ;
+	    call imunmap (im)
+	}
+
+	call sfree (sp)
+end
+
+
+# ODC_BPM -- Rebin the bad pixel masks.
+#
+# Even though the input mask can be specified by good or bad values or bits
+# the rebinned mask is created as a boolean mask.  Note that the rebinning
+# is done by setting a large mask value and then values computed from good
+# and bad pixels will have some intermediate value which we then threshold
+# to define good and bad.
+
+procedure odc_bpm (sh, shout, mtype, mvalue)
+
+pointer	sh		#I SHDR pointer for mask spectrum
+pointer	shout		#I SHDR pointer for template output spectrum
+int	mtype		#I Mask type
+int	mvalue		#I Mask value
+
+int	i, n, val, and()
+pointer	ptr
+
+begin
+	if (sh == NULL)
+	    return
+
+	n = SN(sh)
+	ptr = SY(sh)
+	switch (mtype) {
+	case M_GOODVAL:
+	    do i = 1, n {
+	        val = nint (Memr[ptr])
+	        if (val == mvalue)
+		    Memr[ptr] = 0
+		else
+		    Memr[ptr] = 1000
+		ptr = ptr + 1
+	    }
+	case M_BADVAL:
+	    do i = 1, n {
+	        val = nint (Memr[ptr])
+	        if (val != mvalue)
+		    Memr[ptr] = 0
+		else
+		    Memr[ptr] = 1000
+		ptr = ptr + 1
+	    }
+	case M_GOODBITS:
+	    do i = 1, n {
+	        val = nint (Memr[ptr])
+	        if (and (val, mvalue) != 0)
+		    Memr[ptr] = 0
+		else
+		    Memr[ptr] = 1000
+		ptr = ptr + 1
+	    }
+	case M_BADBITS:
+	    do i = 1, n {
+	        val = nint (Memr[ptr])
+	        if (and (val, mvalue) == 0)
+		    Memr[ptr] = 0
+		else
+		    Memr[ptr] = 1000
+		ptr = ptr + 1
+	    }
+	}
+
+	call shdr_rebin (sh, shout)
+
+	n = SN(sh)
+	ptr = SY(sh)
+	do i = 1, n {
+	    val = nint (Memr[ptr])
+	    if (val < 10)
+		Memr[ptr] = 0
+	    else
+		Memr[ptr] = 1
+	    ptr = ptr + 1
+	}
+end
+
+
+# ODC_OUTPUT - Set the output spectrum.
+
+procedure odc_output (sh, ns, output, im, mw, refim)
+
+pointer	sh[ARB]			# spectra structures
+int	ns			# number of spectra
+char	output[SZ_FNAME]	# output spectrum name
+pointer	im			# output IMIO pointer
+pointer	mw			# output MWCS pointer
+pointer	refim			# reference image for output image
+
+int	ap, beam, dtype, nw, axis[2]
+double	w1, dw, z
+real	aplow[2], aphigh[2]
+pointer	coeff
+pointer	immap(), mw_open(), smw_openim()
+errchk	immap, smw_openim
+data	axis/1,2/
+
+begin
+	coeff = NULL
+
+	# Create output image using the first input image as a reference
+	refim = immap (IMNAME(sh[1]), READ_ONLY, 0)
+	im = immap (output, NEW_COPY, refim)
+
+	# Use smw_openim to clean up old keywords(?).
+	mw = smw_openim (im)
+	call smw_close (mw)
+
+	IM_NDIM(im) = 1
+	call imaddi (im, "SMW_NDIM", IM_NDIM(im))
+	if (IM_PIXTYPE(im) != TY_DOUBLE)
+	    IM_PIXTYPE(im) = TY_REAL
+
+	# Set new header.
+	mw = mw_open (NULL, 2)
+	call mw_newsystem (mw, "multispec", 2)
+	call mw_swtype (mw, axis, 2, "multispec",
+	    "label=Wavelength units=Angstroms")
+	call smw_open (mw, NULL, im)
+
+	call smw_gwattrs (MW(sh[1]), APINDEX(sh[1]), 1, ap, beam, dtype,
+	    w1, dw, nw, z, aplow, aphigh, coeff)
+	call odc_default (sh, ns, dtype, w1, dw, nw, z, Memc[coeff])
+	call smw_swattrs (mw, 1, 1, ap, beam, dtype,
+	    w1, dw, nw, z, aplow, aphigh, Memc[coeff])
+	call smw_sapid (mw, 1, 1, TITLE(sh[1]))
+
+	IM_LEN(im,1) = nw
+
+	# Set MWCS header.
+	call smw_saveim (mw, im)
+	call smw_close (mw)
+	mw = smw_openim (im)
+
+	call mfree (coeff, TY_CHAR)
+end
+
+
+# ODC_DEFAULT - Set default values for the starting wavelength, ending
+# wavelength, wavelength increment and spectrum length for the output
+# spectrum.
+
+procedure odc_default (shdr, ns, dtype, w1, dw, nw, z, coeff)
+
+pointer	shdr[ARB]		# spectra structures
+int	ns			# number of spectra
+int	dtype			# dispersion type
+double	w1			# starting wavelength
+double	dw			# wavelength increment
+int	nw			# spectrum length
+double	z			# redshift
+char	coeff[ARB]		# nonlinear coefficient array
+
+bool	clgetb()
+int	i, nwa, clgeti()
+double	w2, aux, w1a, w2a, dwa, clgetd()
+pointer	sh
+
+begin
+	if (clgetb ("first")) {
+	    # For now we don't allow non-linear dispersions because the
+	    # generic combine routines don't understand multispec.
+	    if (dtype == DCFUNC) {
+	        dtype = DCLINEAR
+		coeff[1] = EOS
+		z = 0.
+	    }
+
+	    return
+	}
+
+	w1a = clgetd ("w1")
+	w2a = clgetd ("w2")
+	dwa = clgetd ("dw")
+	nwa = clgeti ("nw")
+	if (clgetb ("log"))
+	    dtype = DCLOG
+	else
+	    dtype = DCLINEAR
+	z = 0.
+	coeff[1] = EOS
+
+
+	# Dispersion type
+	if (dtype == DCLINEAR) {
+	    do i = 1, ns {
+		if (DC(shdr[i]) == DCNO) {
+		    dtype = DCNO
+		    break
+		}
+	    }
+	}
+
+	w1 = w1a
+	w2 = w2a
+	dw = dwa
+	nw = nwa
+
+	# Starting wavelength
+	if (IS_INDEFD (w1)) {
+	    if (IS_INDEFD (dw) || dw > 0.) {
+		w1 = MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W0(sh)
+		    else
+			aux = W1(sh)
+		    if (aux < w1)
+			w1 = aux
+		}
+	    } else {
+		w1 = -MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W1(sh)
+		    else
+			aux = W0(sh)
+		    if (aux > w1)
+			w1 = aux
+		}
+	    }
+	}
+
+	# Ending wavelength
+	if (IS_INDEFD (w2)) {
+	    if (IS_INDEFD (dw) || dw > 0.) {
+		w2 = -MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W1(sh)
+		    else
+			aux = W0(sh)
+		    if (aux > w2)
+			w2 = aux
+		}
+	    } else {
+		w2 = MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W0(sh)
+		    else
+			aux = W1(sh)
+		    if (aux < w2)
+			w2 = aux
+		}
+	    }
+	}
+
+	# Wavelength increment
+	if (IS_INDEFD (dw)) {
+	    dw = MAX_REAL
+	    do i = 1, ns {
+		aux = abs (WP(shdr[i]))
+		if (aux < dw)
+		    dw = aux
+	    }
+	}
+	if ((w2 - w1) / dw < 0.)
+	    dw = -dw
+
+	# Spectrum length
+	if (IS_INDEFI (nw))
+	    nw = int ((w2 - w1) / dw + 0.5) + 1
+
+	# Adjust the values.
+	if (IS_INDEFD (dwa))
+	    dw = (w2 - w1) / (nw - 1)
+	else if (IS_INDEFD (w2a))
+	    w2 = w1 + (nw - 1) * dw
+	else if (IS_INDEFD (w1a))
+	    w1 = w2 - (nw - 1) * dw
+	else {
+	    nw = int ((w2 - w1) / dw + 0.5) + 1
+	    w2 = w1 + (nw - 1) * dw
+	}
+end
+
+
+# ODC_IMTGETIM -- Set output image from an list of root names.
+
+procedure odc_imtgetim (list, index, aperture, image, maxch)
+
+int	list			#I List of images
+int	index			#I List index
+int	aperture		#I Aperture
+char	image[maxch]		#O Image name
+int	maxch			#I Maximum character for image
+
+pointer	sp, root, extn
+
+int	imtrgetim()
+
+begin
+	if (imtrgetim (list, index, image, maxch) == EOF) {
+	    image[1] = EOS
+	    return
+	}
+
+	if (aperture == INDEFI)
+	    return
+
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	call iki_init()
+	call iki_parse (image, Memc[root], Memc[extn])
+	if (Memc[extn] == EOS) {
+	    call sprintf (image, maxch, "%s.%04d")
+		call pargstr (Memc[root])
+		call pargi (aperture)
+	} else {
+	    call sprintf (image, maxch, "%s.%04d.%s")
+		call pargstr (Memc[root])
+		call pargi (aperture)
+		call pargstr (Memc[extn])
+	}
+
+	call sfree (sp)
+end
+
+
+# ODC_COMBINE -- Combine the spectra by calling the IMCOMBINE source.
+
+procedure odc_combine (slist, blist, output, headers, bmask, rmask, nrmask,
+	emask, sigma, logfile, delete)
+
+int	slist			#I List of 1D spectra to combine
+int	blist			#I List of 1D bad pixel spectra
+char	output[ARB]		#I Output combined spectrum
+char	headers[ARB]		#I Output headers
+char	bmask[ARB]		#I Output bad pixel mask
+char	rmask[ARB]		#I Output rejection mask
+char	nrmask[ARB]		#I Output number rejected mask
+char	emask[ARB]		#I Ouput exposure time mask
+char	sigma[ARB]		#I Output sigma
+char	logfile[ARB]		#I Logfile
+int	delete			#I Delete input spectra?
+
+int	n
+pointer	sp, fname, scales, zeros, wts
+
+int	imtlen(), imtgetim()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Allocate and initialize scaling factors.
+	n = imtlen (slist)
+	call salloc (scales, 3*n, TY_REAL)
+	zeros = scales + n
+	wts = scales + 2 * n
+	call amovkr (INDEFR, Memr[scales], 3*n)
+
+	# Combine.
+	iferr (call icombine (slist, output, headers, bmask, rmask,
+	    nrmask, emask, sigma, logfile, Memr[scales], Memr[zeros],
+	    Memr[wts], NO, NO))
+	    call erract (EA_WARN)
+
+	# Delete the files.
+	if (delete == YES) {
+	    call imtrew (slist)
+	    while (imtgetim (slist, Memc[fname], SZ_FNAME) != EOF)
+		call imdelete (Memc[fname])
+	    call imtrew (blist)
+	    while (imtgetim (blist, Memc[fname], SZ_FNAME) != EOF)
+		call imdelete (Memc[fname])
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/odcombine/x_odcombine.x b/noao/onedspec/odcombine/x_odcombine.x
new file mode 100644
index 00000000..33943271
--- /dev/null
+++ b/noao/onedspec/odcombine/x_odcombine.x
@@ -0,0 +1 @@
+task	scombine = t_scombine
diff --git a/noao/onedspec/odropenp.x b/noao/onedspec/odropenp.x
new file mode 100644
index 00000000..509cc75a
--- /dev/null
+++ b/noao/onedspec/odropenp.x
@@ -0,0 +1,92 @@
+include	<ctype.h>
+
+define	NALLOC	512	# Allocation increment
+define	MAXRECS	1000	#  Maximum number of records
+
+
+# ODR_OPENP -- Open onedspec record image pattern
+
+procedure odr_openp (list, records)
+
+int	list			# Image list
+char	records[ARB]		# Record string
+
+int	i, n, nalloc, rec
+int	decode_ranges(), imtgetim(), strlen(), get_next_number()
+pointer	sp, fname, image, recs, images, imtopen()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_LINE, TY_CHAR)
+	call salloc (image, SZ_LINE, TY_CHAR)
+
+	# Check for empty string.
+	for (i=1; IS_WHITE(records[i]); i=i+1)
+	    ;
+	if (records[i] == EOS) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Decode record string.
+	call salloc (recs, 300, TY_INT)
+	if (decode_ranges (records, Memi[recs], 100, i) == ERR)
+	    call error (1, "Bad record specification")
+	if (i > MAXRECS)
+	    call error (1, "Too many records")
+
+	n = 0
+	nalloc = NALLOC
+	call malloc (images, nalloc, TY_CHAR)
+	Memc[images] = EOS
+
+	rec = -1
+	repeat {
+	    repeat {
+		if (rec < 0) {
+		    i = imtgetim (list, Memc[fname], SZ_LINE)
+		    if (i == EOF)
+			break
+
+		    # Strip sections and extensions
+		    call imgimage (Memc[fname], Memc[fname], SZ_LINE)
+		    i = strlen (Memc[fname])
+		    switch (Memc[fname+i-1]) {
+		    case 'h':
+			if (i > 3 && Memc[fname+i-4] == '.')
+			    Memc[fname+i-4] = EOS
+		    case 'l':
+			if (i > 2 && Memc[fname+i-3] == '.')
+			    Memc[fname+i-3] = EOS
+		    }
+		}
+
+		i = get_next_number (Memi[recs], rec)
+		if (i != EOF) {
+		    call sprintf (Memc[image], SZ_LINE, "%s.%04d")
+			call pargstr (Memc[fname])
+			call pargi (rec)
+		    break
+		}
+		rec = -1
+	    }
+
+	    if (i == EOF)
+		break
+
+	    n = n + strlen (Memc[image]) + 1
+	    if (n > nalloc) {
+		nalloc = n + NALLOC
+		call realloc (images, nalloc, TY_CHAR)
+	    }
+	    if (Memc[images] != EOS)
+		call strcat (",", Memc[images], nalloc)
+	    call strcat (Memc[image], Memc[images], nalloc)
+	}
+
+	call imtclose (list)
+	list = imtopen (Memc[images])
+
+	call mfree (images, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/onedspec.cl b/noao/onedspec/onedspec.cl
new file mode 100644
index 00000000..835905c2
--- /dev/null
+++ b/noao/onedspec/onedspec.cl
@@ -0,0 +1,57 @@
+#{ Package script task for the ONEDSPEC package.
+
+# Define necessary paths
+
+package onedspec
+
+task	autoidentify,
+	calibrate,
+	continuum,
+	deredden,
+	dispcor,
+	disptrans,
+	dopcor,
+	fitprofs,
+	identify,
+	lcalib,
+	mkspec,
+	names,
+	refspectra,
+	reidentify,
+	rstext,
+	sapertures,
+	sarith,
+	sbands,
+	odcombine,
+	scoords,
+	sensfunc,
+	sfit,
+	sflip,
+	sinterp,
+	skytweak,
+	slist,
+	specplot,
+	specshift,
+	splot,
+	standard,
+	telluric	= onedspec$x_onedspec.e
+
+task	scombine	= "onedspec$scombine/x_scombine.e"
+
+task	setairmass,
+	setjd		= astutil$x_astutil.e
+
+# Scripts and Psets
+
+task	aidpars		= onedspec$aidpars.par
+task	bplot		= onedspec$bplot.cl
+task	ndprep		= onedspec$ndprep.cl
+task	scopy		= onedspec$scopy.cl
+task	rspectext	= onedspec$rspectext.cl
+task	wspectext	= onedspec$wspectext.cl
+
+task	$process	= process.cl		# Used by BATCHRED
+task	dispcor1	= onedspec$dispcor1.par	# Used by DISPCOR
+hidetask dispcor1,process,rstext
+
+clbye
diff --git a/noao/onedspec/onedspec.hd b/noao/onedspec/onedspec.hd
new file mode 100644
index 00000000..92f8face
--- /dev/null
+++ b/noao/onedspec/onedspec.hd
@@ -0,0 +1,58 @@
+# Help directory for the ONEDSPEC package.
+
+$dispcor	= "./dispcor/
+$doc		= "./doc/"
+$identify	= "./identify/
+$irsiids	= "./irsiids/"
+$sensfunc	= "./sensfunc/
+$splot		= "./splot/
+$linelists	= "noao$lib/linelists/"
+$onedstds	= "noao$lib/onedstds/"
+
+revisions	sys=Revisions
+
+aidpars		hlp=doc$aidpars.hlp,		src=aidpars.par
+autoidentify	hlp=doc$autoidentify.hlp,	src=identify$t_autoid.x
+bplot		hlp=doc$bplot.hlp,		src=bplot.cl
+calibrate	hlp=doc$calibrate.hlp,		src=t_calibrate.x
+continuum	hlp=doc$continuum.hlp,		src=t_sfit.x
+deredden	hlp=doc$deredden.hlp,		src=t_deredden.x
+dispaxis	hlp=doc$dispaxis.hlp,		src=dispaxis.par
+dispcor		hlp=doc$dispcor.hlp,		src=dispcor$dispcor.x
+disptrans	hlp=doc$disptrans.hlp,		src=dispcor$disptrans.x
+dopcor		hlp=doc$dopcor.hlp,		src=t_dopcor.x
+fitprofs	hlp=doc$fitprofs.hlp,		src=t_fitprofs.x
+identify	hlp=doc$identify.hlp,		src=identify$t_identify.x
+lcalib		hlp=doc$lcalib.hlp,		src=t_lcalib.x
+mkspec		hlp=doc$mkspec.hlp,		src=x_mkspec.x
+names		hlp=doc$names.hlp,		src=t_names.x
+ndprep		hlp=doc$ndprep.hlp,		src=ndprep.cl
+odcombine	hlp=doc$odcombine.hlp
+refspectra	hlp=doc$refspectra.hlp,		src=dispcor$refspectra.x
+reidentify	hlp=doc$reidentify.hlp,		src=identify$t_reidentify.x
+rspectext	hlp=doc$rspectext.hlp,		src=rspectext.cl
+sapertures	hlp=doc$sapertures.hlp,		src=t_sapertures.x
+sbands		hlp=doc$sbands.hlp,		src=t_sbands.x
+sarith		hlp=doc$sarith.hlp,		src=t_sarith.x
+scombine	hlp=doc$scombine.hlp
+scoords		hlp=doc$scoords.hlp,		src=t_scoords.x
+scopy		hlp=doc$scopy.hlp,		src=scopy.cl
+sensfunc	hlp=doc$sensfunc.hlp,		src=sensfunc$t_sensfunc.x
+sfit		hlp=doc$sfit.hlp,		src=t_sfit.x
+sflip		hlp=doc$sflip.hlp,		src=t_sflip.x
+sinterp		hlp=doc$sinterp.hlp,		src=t_sinterp.x
+skytweak	hlp=doc$skytweak.hlp,		src=t_tweak.x
+slist		hlp=doc$slist.hlp,		src=t_slist.x
+specplot	hlp=doc$specplot.hlp,		src=t_specplot.x
+specshift	hlp=doc$specshift.hlp,		src=t_specshift.x
+splot		hlp=doc$splot.hlp,		src=splot$splot.x
+standard	hlp=doc$standard.hlp,		src=t_standard.x
+telluric	hlp=doc$telluric.hlp,		src=t_tweak.x
+wspectext	hlp=doc$wspectext.hlp,		src=wspectext.cl
+
+package		hlp=doc$onedspec.hlp,		src=onedspec.cl
+specwcs		hlp=doc$specwcs.hlp
+linelists	hlp=linelists$README
+onedstds	hlp=onedstds$README
+
+irsiids		pkg=irsiids$irsiids.hd
diff --git a/noao/onedspec/onedspec.men b/noao/onedspec/onedspec.men
new file mode 100644
index 00000000..7285e75a
--- /dev/null
+++ b/noao/onedspec/onedspec.men
@@ -0,0 +1,51 @@
+        aidpars - Automatic line identification parameters and algorithm
+   autoidentify - Automatically identify lines and fit dispersion
+          bplot - Batch plots of spectra
+      calibrate - Apply extinction and flux calibrations to spectra
+      continuum - Fit the continuum in spectra
+       deredden - Apply interstellar extinction correction
+        dispcor - Dispersion correct and resample spectra
+      disptrans - Transform dispersion units and apply air correction
+         dopcor - Apply doppler corrections
+       fitprofs - Fit gaussian profiles
+       identify - Identify features in spectrum for dispersion solution
+         lcalib - List calibration file data
+         mkspec - Generate an artificial spectrum (obsolete)
+          names - Generate a list of image names from a string
+	 ndprep - Make neutral density filter calibration image
+      odcombine - Combine spectra having different wavelength ranges (new)
+     refspectra - Assign wavelength reference spectra to other spectra
+     reidentify - Automatically identify features in spectra
+      rspectext - Convert ascii text spectra to image spectra
+     sapertures - Set or change aperture header information
+         sarith - Spectrum arithmetic
+	 sbands - Bandpass spectrophotometry of spectra
+       scombine - Combine spectra having different wavelength ranges
+        scoords - Set spectral coordinates as a pixel array (1D spectra only)
+          scopy - Select and copy apertures in different spectral formats
+       sensfunc - Create sensitivity function
+     setairmass - Compute effective airmass and middle UT for an exposure
+          setjd - Compute and set Julian dates in images
+           sfit - Fit spectra and output fit, ratio, or difference
+          sflip - Flip data and/or dispersion coordinates in spectra
+        sinterp - Interpolate a table of x,y pairs to create a spectrum
+       skytweak - Sky subtract 1D spectra after tweaking sky spectra
+          slist - List spectrum header parameters
+       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
+       telluric - Remove telluric features from 1D spectra
+      wspectext - Convert 1D image spectra to ascii text spectra
+
+                      ADDITIONAL HELP TOPICS
+
+        package - Discussion and overview of package including sections on:
+		    package parameters, units, and interpolation
+	specwcs - Discussion and description of the spectral image formats
+		    and the dispersion world coordinate system
+      linelists - Description of the spectral line list library in
+		    the directory linelists$.
+       onedstds - Description of the spectral calibration library in the
+		    directory onedstds$: extinction, flux standards, etc.
+
diff --git a/noao/onedspec/onedspec.par b/noao/onedspec/onedspec.par
new file mode 100644
index 00000000..2264fe2c
--- /dev/null
+++ b/noao/onedspec/onedspec.par
@@ -0,0 +1,10 @@
+# Package parameter file for the ONEDSPEC package.
+
+observatory,s,h,"observatory",,,"Observatory for data"
+caldir,s,h,,,,"Standard star calibration directory"
+interp,s,h,"poly5","nearest|linear|poly3|poly5|spline3|sinc",,Interpolation type
+dispaxis,i,h,1,1,3,"Image axis for 2D/3D images"
+nsum,s,h,"1",,,"Number of lines/columns to sum for 2D/3D images"
+records,s,h,"",,,"Record number extensions
+"
+version,s,h,"ONEDSPEC: January 1996"
diff --git a/noao/onedspec/refspectra.par b/noao/onedspec/refspectra.par
new file mode 100644
index 00000000..51e613ee
--- /dev/null
+++ b/noao/onedspec/refspectra.par
@@ -0,0 +1,16 @@
+input,s,a,,,,"List of input spectra"
+references,s,h,"*.imh",,,"List of reference spectra"
+apertures,s,h,"",,,"Input aperture selection list"
+refaps,s,h,"",,,"Reference aperture selection list"
+ignoreaps,b,h,yes,,,Ignore input and reference apertures?
+select,s,h,"interp","match|nearest|preceding|following|interp|average",,"Selection method for reference spectra"
+sort,s,h,"jd",,,"Sort key"
+group,s,h,"ljd",,,"Group key"
+time,b,h,no,,,"Is sort key a time?"
+timewrap,r,h,17.,0.,24.,"Time wrap point for time sorting"
+override,b,h,no,,,"Override previous assignments?"
+confirm,b,h,yes,,,"Confirm reference spectrum assignments?"
+assign,b,h,yes,,,"Assign the reference spectra to the input spectrum?"
+logfiles,s,h,"STDOUT,logfile",,,"List of logfiles"
+verbose,b,h,no,,,"Verbose log output?"
+answer,s,q,,"no|yes|YES",,"Accept assignment?"
diff --git a/noao/onedspec/reidentify.par b/noao/onedspec/reidentify.par
new file mode 100644
index 00000000..de97bcd1
--- /dev/null
+++ b/noao/onedspec/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,no,,,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/onedspec/rspectext.cl b/noao/onedspec/rspectext.cl
new file mode 100644
index 00000000..328ab59e
--- /dev/null
+++ b/noao/onedspec/rspectext.cl
@@ -0,0 +1,115 @@
+# RSPECTEXT -- Read a 1D ascii text spectrum into an image spectrum
+# The image is created from an optional header and the flux values
+# using RTEXTIMAGE.  If there is no header the title, dispersion,
+# and flux calibration may be set.  The dispersion can be defined
+# as linear, log linear, or from the wavelengths.  The latter may be
+# used as a lookup table in the image header or used to interpolate
+# the spectrum to a linear wavelength dispersion.
+
+procedure rspectext (input, output)
+
+string	input			{prompt="Input list of text spectra"}
+string	output			{prompt="Output list of image spectra"}
+
+string	title = ""		{prompt="Spectrum title"}
+bool	flux = no		{prompt="Flux calibrated?"}
+string	dtype = "linear"	{prompt="Dispersion type",
+				 enum="none|linear|log|nonlinear|interp"}
+real	crval1 = 1.		{prompt="Coordinate of first pixel"}
+real	cdelt1 = 1.		{prompt="Coordinate interval per pixel"}
+
+struct	*fd1, *fd2
+
+begin
+    int		dim
+    string	specin, specout, spec, temp1, temp2, temp3, temp4
+    bool	header=no
+    bool	log=no
+
+    specin = mktemp ("tmp$iraf")
+    specout = mktemp ("tmp$iraf")
+    spec = mktemp ("tmp$iraf")
+    temp1 = mktemp ("tmp$iraf")
+    temp3 = mktemp ("iraf")
+    temp2 = "tmp$id"//temp3
+
+    # Expand the input and output lists.
+    files (input, sort=no, > specin)
+    files (output, sort=no, > specout)
+    join (specin, specout, output=spec, delim=" ", shortest=yes, verbose=yes)
+    delete (specin, verify-)
+    delete (specout, verify-)
+
+    # Go through each input and check for an existing output.
+    fd2 = spec
+    while (fscan (fd2, specin, specout) != EOF) {
+	if (access(specout)||access(specout//".imh")||access(specout//".hhh")) {
+	    print ("Image "//specout//" already exists")
+	    next
+	}
+
+	# Separate the header and flux values for RTEXTIMAGE and the
+	# wavelengths for later use.
+
+	rstext (specin, temp1, temp2, header=header) | scan (header, dim)
+
+	# Create the image from the header and flux values.
+	rtextimage (temp1, specout, otype="real", header=header, pixels=yes,
+	    nskip=0, dim=dim)
+	fd1 = ""; delete (temp1, verify-)
+
+	# If there is no header setup the title, dispersion and flux.
+	# The dispersion may require using DISPCOR for nonlinear or
+	# resampled dispersion functions.
+
+	if (!header) {
+	    hedit (specout, "title", title,
+		add+, addonly-, del-, update+, verify-, show-)
+	    if (dtype == "linear") {
+		hedit (specout, "dc-flag", 0,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "crpix1", 1.,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "crval1", crval1,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "cdelt1", cdelt1,
+		    add+, addonly-, del-, update+, verify-, show-)
+	    } else if (dtype == "log") {
+		hedit (specout, "dc-flag", 1,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "crpix1", 1.,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "crval1", crval1,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "cdelt1", cdelt1,
+		    add+, addonly-, del-, update+, verify-, show-)
+	    } else if (dtype == "nonlinear") {
+		hedit (specout, "refspec1", temp3,
+		    add+, addonly-, del-, update+, verify-, show-)
+		dispcor (specout, "", linearize=no, database="tmp$",
+		    table="", w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF, log=log,
+		    flux=no, samedisp=no, global=no, ignoreaps=no, confirm=no,
+		    listonly=no, verbose=no, logfile="")
+		hedit (specout, "dclog1",
+		    add-, addonly-, del+, update+, verify-, show-)
+	    } else if (dtype == "interp") {
+		hedit (specout, "refspec1", temp3,
+		    add+, addonly-, del-, update+, verify-, show-)
+		dispcor (specout, "", linearize=yes, database="tmp$",
+		    table="", w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF, log=log,
+		    flux=no, samedisp=no, global=no, ignoreaps=no, confirm=no,
+		    listonly=no, verbose=no, logfile="")
+		hedit (specout, "dclog1",
+		    add-, addonly-, del+, update+, verify-, show-)
+	    }
+	    if (flux) {
+		hedit (specout, "ca-flag", 0,
+		    add+, addonly-, del-, update+, verify-, show-)
+		hedit (specout, "ex-flag", 0,
+		    add+, addonly-, del-, update+, verify-, show-)
+	    }
+	}
+	delete (temp2, verify-)
+    }
+    fd2=""; delete (spec, verify-)
+end
diff --git a/noao/onedspec/rstext.par b/noao/onedspec/rstext.par
new file mode 100644
index 00000000..07d78e31
--- /dev/null
+++ b/noao/onedspec/rstext.par
@@ -0,0 +1,4 @@
+input,f,a,,,,Input RSPECTEXT text file
+output1,f,a,,,,Output file for RTEXTIMAGE
+output2,f,a,,,,Output file for DISPCOR
+header,b,h,yes,,,Pass header?
diff --git a/noao/onedspec/sapertures.par b/noao/onedspec/sapertures.par
new file mode 100644
index 00000000..b14f1137
--- /dev/null
+++ b/noao/onedspec/sapertures.par
@@ -0,0 +1,16 @@
+input,s,a,,,,List of spectra
+apertures,s,h,"",,,List of apertures to change
+apidtable,s,h,"",,,Table of individual aperture values
+wcsreset,s,h,no,,,Reset WCS to pixels and ignore apidtable?
+verbose,b,h,no,,,"Print verbose information?
+
+# Defaults for apertures not in table
+# INDEF leaves value unchanged"
+beam,i,h,INDEF,,,Beam number
+dtype,i,h,INDEF,,,"Dispersion type (-1|0|1)"
+w1,r,h,INDEF,,,Coordinate of first physical pixel
+dw,r,h,INDEF,,,Coordinate step per physical pixel
+z,r,h,INDEF,,,Redshift factor
+aplow,r,h,INDEF,,,Lower extraction aperture position
+aphigh,r,h,INDEF,,,Upper extraction aperture position
+title,s,h,"INDEF",,,Spectrum title or ID
diff --git a/noao/onedspec/sarith.par b/noao/onedspec/sarith.par
new file mode 100644
index 00000000..bcb7b575
--- /dev/null
+++ b/noao/onedspec/sarith.par
@@ -0,0 +1,22 @@
+input1,s,a,,,,"List of input spectra"
+op,s,a,,"abs|copy|dex|exp|flam|fnu|inv|ln|log|lum|mag|sqrt|sextract|replace|+|-|*|/|^",,"Operation"
+input2,s,a,,,,"List of input spectra or constants"
+output,s,a,,,,"List of output spectra"
+w1,r,h,INDEF,,,"Starting wavelength"
+w2,r,h,INDEF,,,"Ending wavelength"
+apertures,s,h,"",,,"List of input apertures or columns/lines"
+bands,s,h,"",,,"List of input bands or lines/bands"
+beams,s,h,"",,,"List of input beams or echelle orders"
+apmodulus,i,h,0,,,"Input aperture modulus (0=none)
+"
+reverse,b,h,no,,,"Reverse order of operands in binary operation?"
+ignoreaps,b,h,no,,,"Ignore second operand aperture numbers?
+"
+format,s,h,"multispec","multispec|onedspec",,"Output spectral format"
+renumber,b,h,no,,,"Renumber output apertures?"
+offset,i,h,0,,,"Output aperture number offset"
+clobber,b,h,no,,,"Modify existing output images?"
+merge,b,h,no,,,"Merge with existing output images?"
+rebin,b,h,yes,,,"Rebin to exact wavelength region?"
+errval,r,h,0.,,,"Arithmetic error replacement value"
+verbose,b,h,no,,,"Print operations?"
diff --git a/noao/onedspec/sbands.par b/noao/onedspec/sbands.par
new file mode 100644
index 00000000..24fb01c0
--- /dev/null
+++ b/noao/onedspec/sbands.par
@@ -0,0 +1,8 @@
+input,s,a,"",,,Input list of spectra 
+output,s,a,"",,,Output file name
+bands,s,a,"",,,Bandpass file
+apertures,s,h,"",,,Apertures
+normalize,b,h,yes,,,Normalize the bandpass response?
+mag,b,h,no,,,Output results in magnitudes?
+magzero,r,h,0.,,,Magnitude zero point
+verbose,b,h,yes,,,Verbose header?
diff --git a/noao/onedspec/scombine/README b/noao/onedspec/scombine/README
new file mode 100644
index 00000000..e4031e6a
--- /dev/null
+++ b/noao/onedspec/scombine/README
@@ -0,0 +1,17 @@
+SCOMBINE -- Combine spectra
+
+This routine is based in large part on IMCOMBINE.  The routines in the
+generic directory are identical to those in that task except that they
+only contain routines for real data.  The ic routines in this directory
+are similar though modified from IMCOMBINE.
+
+The iscombine files are for an interactive combine task based on work
+by CTIO.  Because it is limited currently to linear spectra and is not
+organized to take advantage of the IMCOMBINE options it is not installed.
+A version of this may someday be added based on the current software.
+
+
+=======
+
+This version was renamed to OSCOMBINE.  It is obsolete and may be removed
+at some future time.  (4/14/04, Valdes)
diff --git a/noao/onedspec/scombine/generic/icaclip.x b/noao/onedspec/scombine/generic/icaclip.x
new file mode 100644
index 00000000..41432dd7
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icaclip.x
@@ -0,0 +1,555 @@
+# 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_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
+	    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 > 0)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			if (grow > 0) {
+			    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
+
diff --git a/noao/onedspec/scombine/generic/icaverage.x b/noao/onedspec/scombine/generic/icaverage.x
new file mode 100644
index 00000000..6c5c870b
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icaverage.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../icombine.h"
+
+
+# IC_AVERAGE -- Compute the average image line.
+# Options include a weight average.
+
+procedure ic_averager (d, m, n, wts, npts, 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
+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 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 to the blank value.
+
+	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]
+		    average[i] = sum / n[i]
+		}
+	    }
+	} else if (dflag == D_NONE) {
+	    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
+			}
+			average[i] = sum / sumwt
+		    } else
+			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]
+			average[i] = sum / n[i]
+		    } else
+			average[i] = blank
+		}
+	    }
+	}
+end
diff --git a/noao/onedspec/scombine/generic/iccclip.x b/noao/onedspec/scombine/generic/iccclip.x
new file mode 100644
index 00000000..26b17ba2
--- /dev/null
+++ b/noao/onedspec/scombine/generic/iccclip.x
@@ -0,0 +1,453 @@
+# 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_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 > 0)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			if (grow > 0) {
+			    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
+
diff --git a/noao/onedspec/scombine/generic/icgrow.x b/noao/onedspec/scombine/generic/icgrow.x
new file mode 100644
index 00000000..074bd8c3
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icgrow.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+
+# IC_GROW --  Reject neigbors of rejected pixels.
+# The rejected pixels are marked by having nonzero ids beyond the number
+# of included pixels.  The pixels rejected here are given zero ids
+# to avoid growing of the pixels rejected here.  The unweighted average
+# can be updated but any rejected pixels requires the median to be
+# recomputed.  When the number of pixels at a grow point reaches nkeep 
+# no further pixels are rejected.  Note that the rejection order is not
+# based on the magnitude of the residuals and so a grow from a weakly
+# rejected image pixel may take precedence over a grow from a strongly
+# rejected image pixel.
+
+procedure ic_growr (d, m, n, nimages, npts, average)
+
+pointer	d[ARB]			# Data pointers
+pointer	m[ARB]			# Image id pointers
+int	n[npts]			# Number of good pixels
+int	nimages			# Number of images
+int	npts			# Number of output points per line
+real	average[npts]		# Average
+
+int	i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep
+pointer	mp1, mp2
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE)
+	    return
+
+	do i1 = 1, npts {
+	    k1 = i1 - 1
+	    is = max (1, i1 - grow)
+	    ie = min (npts, i1 + grow)
+	    do j1 = n[i1]+1, nimages {
+		l = Memi[m[j1]+k1]
+		if (l == 0)
+		    next
+		if (combine == MEDIAN)
+		    docombine = true
+
+		do i2 = is, ie {
+		    if (i2 == i1)
+			next
+		    k2 = i2 - 1
+		    n2 = n[i2]
+		    if (nkeep < 0)
+			maxkeep = max (0, n2 + nkeep)
+		    else
+			maxkeep = min (n2, nkeep)
+		    if (n2 <= maxkeep)
+			next
+		    do j2 = 1, n2 {
+			mp1 = m[j2] + k2
+			if (Memi[mp1] == l) {
+			    if (!docombine && n2 > 1)
+				average[i2] =
+				    (n2*average[i2] - Memr[d[j2]+k2]) / (n2-1)
+			    mp2 = m[n2] + k2
+			    if (j2 < n2) {
+				Memr[d[j2]+k2] = Memr[d[n2]+k2]
+				Memi[mp1] = Memi[mp2]
+			    }
+			    Memi[mp2] = 0
+			    n[i2] = n2 - 1
+			    break
+			}
+		    }
+		}
+	    }
+	}
+end
diff --git a/noao/onedspec/scombine/generic/icmedian.x b/noao/onedspec/scombine/generic/icmedian.x
new file mode 100644
index 00000000..e7607340
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icmedian.x
@@ -0,0 +1,139 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+
+# IC_MEDIAN -- Median of lines
+
+procedure ic_medianr (d, n, npts, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+real	median[npts]		# Median
+
+int	i, j1, j2, j3, k, n1
+bool	even
+real	val1, val2, val3
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE) {
+	    do i = 1, npts
+		median[i]= blank
+	    return
+	}
+
+	# Check for previous sorting
+	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
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Repeatedly exchange the extreme values until there are three
+	# or fewer pixels.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    while (n1 > 3) {
+		j1 = 1
+		j2 = 1
+	        val1 = Memr[d[j1]+k]
+	        val2 = val1
+	        do j3 = 2, n1 {
+		    val3 = Memr[d[j3]+k]
+	            if (val3 > val1) {
+		        j1 = j3
+		        val1 = val3
+		    } else if (val3 < val2) {
+		        j2 = j3
+		        val2 = val3
+		    }
+	        }
+		j3 = n1 - 1
+		if (j1 < j3 && j2 < j3) {
+		    Memr[d[j1]+k] = val3
+		    Memr[d[j2]+k] = Memr[d[j3]+k]
+		    Memr[d[j3]+k] = val1
+		    Memr[d[n1]+k] = val2
+		} else if (j1 < j3) {
+		    if (j2 == j3) {
+			Memr[d[j1]+k] = val3
+			Memr[d[n1]+k] = val1
+		    } else {
+			Memr[d[j1]+k] = Memr[d[j3]+k]
+			Memr[d[j3]+k] = val1
+		    }
+		} else if (j2 < j3) {
+		    if (j1 == j3) {
+			Memr[d[j2]+k] = val3
+			Memr[d[n1]+k] = val2
+		    } else {
+			Memr[d[j2]+k] = Memr[d[j3]+k]
+			Memr[d[j3]+k] = val2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    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
+	        }
+	    } else if (n1 == 2) {
+		val1 = Memr[d[1]+k]
+		val2 = Memr[d[2]+k]
+		median[i] = (val1 + val2) / 2
+	    } else if (n1 == 1)
+		median[i] = Memr[d[1]+k]
+	    else
+		median[i] = blank
+	}
+end
diff --git a/noao/onedspec/scombine/generic/icmm.x b/noao/onedspec/scombine/generic/icmm.x
new file mode 100644
index 00000000..1c314241
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icmm.x
@@ -0,0 +1,152 @@
+# 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_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
+			    Memi[m[jmax]+i1] = Memi[m[j]+i1]
+			} else {
+			    Memr[kmax] = d1
+			    Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+			}
+		    }
+		    if (jmin < j) {
+			if (jmax != n1) {
+			    Memr[kmin] = d1
+			    Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+			} else {
+			    Memr[kmin] = d2
+			    Memi[m[jmin]+i1] = Memi[m[j]+i1]
+			}
+		    }
+		} 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
+			Memi[m[jmin]+i1] = Memi[m[n1]+i1]
+		    }
+		} 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
+			Memi[m[jmax]+i1] = Memi[m[n1]+i1]
+		    }
+		} 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
diff --git a/noao/onedspec/scombine/generic/icpclip.x b/noao/onedspec/scombine/generic/icpclip.x
new file mode 100644
index 00000000..d9028a93
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icpclip.x
@@ -0,0 +1,224 @@
+# 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_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 > 0)) {
+		k = max (nl, n4 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+j] = Memr[d[k]+j]
+			if (grow > 0) {
+			    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
diff --git a/noao/onedspec/scombine/generic/icsclip.x b/noao/onedspec/scombine/generic/icsclip.x
new file mode 100644
index 00000000..e38f7935
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icsclip.x
@@ -0,0 +1,486 @@
+# 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_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 > 0)) {
+		j = max (nl, n1 + 1)
+		if (keepids) {
+		    do l = 1, min (n1, nl-1) {
+			Memr[d[l]+k] = Memr[d[j]+k]
+			if (grow > 0) {
+			    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
+
diff --git a/noao/onedspec/scombine/generic/icsort.x b/noao/onedspec/scombine/generic/icsort.x
new file mode 100644
index 00000000..f3d2fb21
--- /dev/null
+++ b/noao/onedspec/scombine/generic/icsort.x
@@ -0,0 +1,275 @@
+# 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_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]
+			    }
+			} 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
diff --git a/noao/onedspec/scombine/generic/mkpkg b/noao/onedspec/scombine/generic/mkpkg
new file mode 100644
index 00000000..4d371363
--- /dev/null
+++ b/noao/onedspec/scombine/generic/mkpkg
@@ -0,0 +1,16 @@
+$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
+	icgrow.x	../icombine.com ../icombine.h
+	icmedian.x	../icombine.com ../icombine.h
+	icmm.x		../icombine.com ../icombine.h
+	icpclip.x	../icombine.com ../icombine.h
+	icsclip.x	../icombine.com ../icombine.h
+	icsort.x	
+	;
diff --git a/noao/onedspec/scombine/icgdata.x b/noao/onedspec/scombine/icgdata.x
new file mode 100644
index 00000000..907adc5e
--- /dev/null
+++ b/noao/onedspec/scombine/icgdata.x
@@ -0,0 +1,199 @@
+include	<smw.h>
+include "icombine.h"
+
+
+# IC_GDATAR - Apply threshold, scaling, and masking
+
+procedure ic_gdatar (sh, d, id, n, m, lflag, scales, zeros, nimages, npts)
+
+pointer	sh[nimages]		# Input spectra structures
+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
+real	scales[nimages]		# Scale factors
+real	zeros[nimages]		# Zero offset factors
+int	nimages			# Number of spectra
+int	npts			# NUmber of output points
+
+int	i, j, k, l, nused
+real	a, b
+pointer	dp, ip, mp
+
+include	"icombine.com"
+	
+begin
+	# Set data vectors
+	do i = 1, nimages {
+	    d[i] = SY(sh[i])
+	    m[i] = SX(sh[i])
+	}
+
+	# Apply threshold if needed
+	if (dothresh) {
+	    do i = 1, nimages {
+		dp = d[i]
+		if (lflag[i] == D_ALL) {
+		    do j = 1, npts {
+			a = Memr[dp]
+			if (a < lthresh || a > hthresh) {
+			    Memr[m[i]+j-1] = 1
+			    lflag[i] = D_MIX
+			    dflag = D_MIX
+			}
+			dp = dp + 1
+		    }
+		} else if (lflag[i] == D_MIX) {
+		    mp = m[i]
+		    do j = 1, npts {
+			if (Memr[mp] == 0) {
+			    a = Memr[dp]
+			    if (a < lthresh || a > hthresh) {
+				Memr[m[i]+j-1] = 1
+				dflag = D_MIX
+			    }
+			}
+			dp = dp + 1
+			mp = mp + 1
+		    }
+		}
+
+		# Check for completely empty lines
+		if (lflag[i] == D_MIX) {
+		    lflag[i] = D_NONE
+		    mp = m[i]
+		    do j = 1, npts {
+			if (Memr[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 {
+		    dp = d[i]
+		    a = scales[i]
+		    b = -zeros[i]
+		    if (lflag[i] == D_ALL) {
+			do j = 1, npts {
+			    Memr[dp] = Memr[dp] / a + b
+			    dp = dp + 1
+			}
+		    } else if (lflag[i] == D_MIX) {
+			mp = m[i]
+			do j = 1, npts {
+			    if (Memr[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]
+		    dp = d[i]
+		    ip = id[i]
+		    mp = m[i]
+		    do j = 1, npts {
+			if (Memr[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 > 0) {
+		    do j = 0, npts-1 {
+			do i = n[i]+1, nimages
+			    Memi[id[i]+j] = 0
+		    }
+		}
+	    } else {
+		do i = 1, nused {
+		    dp = d[i]
+		    mp = m[i]
+		    do j = 1, npts {
+			if (Memr[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
diff --git a/noao/onedspec/scombine/iclog.x b/noao/onedspec/scombine/iclog.x
new file mode 100644
index 00000000..29002c0f
--- /dev/null
+++ b/noao/onedspec/scombine/iclog.x
@@ -0,0 +1,301 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<smw.h>
+include	"icombine.h"
+
+# IC_LOG -- Output log information is a log file has been specfied.
+
+procedure ic_log (sh, shout, ncombine, exptime, sname, zname, wname,
+	mode, median, mean, scales, zeros, wts, nimages,
+	dozero, nout, expname, exposure)
+
+pointer	sh[nimages]		# Input spectra
+pointer	shout			# Output spectrum
+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	nimages			# Number of images
+bool	dozero			# Zero flag
+int	nout			# Number of images combined in output
+char	expname[ARB]		# Exposure name
+real	exposure		# Output exposure
+
+int	i, j, ctor()
+real	rval
+long	clktime()
+bool	prncombine, prexptime, prmode, prmedian, prmean
+bool	prrdn, prgain, prsn, prscale, przero, prwts, strne()
+pointer	sp, fname
+
+include	"icombine.com"
+
+begin
+	if (logfd == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (fname, SZ_LINE, TY_CHAR)
+
+	# Time stamp the log and print parameter information.
+
+	call cnvdate (clktime(0), Memc[fname], SZ_LINE)
+	call fprintf (logfd, "\n%s: SCOMBINE\n")
+	    call pargstr (Memc[fname])
+	switch (combine) {
+	case AVERAGE:
+	    call fprintf (logfd, "  combine = average,")
+	case MEDIAN:
+	    call fprintf (logfd, "  combine = median,")
+	case SUM:
+	    call fprintf (logfd, "  combine = sum\n")
+	}
+	if (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 > 0) {
+	    call fprintf (logfd, "  grow = %d\n")
+		call pargi (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)
+	call clgstr ("sample", Memc[fname], SZ_LINE)
+	if (Memc[fname] != EOS) {
+	    call fprintf (logfd, "  sample = %s\n")
+		call pargstr (Memc[fname])
+	}
+
+	# 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 = (expname[1] != EOS)
+	prscale = (doscale || strne (sname, "none"))
+	przero = (dozero || strne (zname, "none"))
+	prwts = (dowts || strne (wname, "none"))
+	prmode = false
+	prmedian = false
+	prmean = 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 (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 (prscale) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Scale")
+	}
+	if (przero) {
+	    call fprintf (logfd, " %7s")
+		call pargstr ("Zero")
+	}
+	if (prwts) {
+	    call fprintf (logfd, " %6s")
+		call pargstr ("Weight")
+	}
+	call fprintf (logfd, "\n")
+
+	do i = 1, nimages {
+	    call fprintf (logfd, "  %16s[%3d]")
+		call pargstr (IMNAME(sh[i]))
+		call pargi (AP(sh[i]))
+	    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) {
+		call fprintf (logfd, " %7g")
+		    call pargr (RA(sh[i]))
+	    }
+	    if (prgain) {
+		call fprintf (logfd, " %6g")
+		    call pargr (DEC(sh[i]))
+	    }
+	    if (prsn) {
+		call fprintf (logfd, " %6g")
+		    call pargr (UT(sh[i]))
+	    }
+	    if (prscale) {
+		call fprintf (logfd, " %6.3f")
+		    call pargr (1./scales[i])
+	    }
+	    if (przero) {
+		call fprintf (logfd, " %7.5g")
+		    call pargr (-zeros[i])
+	    }
+	    if (prwts) {
+		call fprintf (logfd, " %6.3f")
+		    call pargr (wts[i])
+	    }
+	    call fprintf (logfd, "\n")
+	}
+
+	# Log information about the output images.
+	call fprintf (logfd, "\n  Output image = %s, ncombine = %d")
+	    call pargstr (IMNAME(shout))
+	    call pargi (nout)
+	if (expname[1] != EOS) {
+	    call fprintf (logfd, ", %s = %g")
+		call pargstr (expname)
+		call pargr (exposure)
+	}
+	call fprintf (logfd, "\n")
+	call fprintf (logfd,
+	    "  w1 = %g, w2 = %g, dw = %g, nw = %g, dtype = %d\n")
+	    call pargr (W0(shout))
+	    call pargr (W1(shout))
+	    call pargr (WP(shout))
+	    call pargi (SN(shout))
+	    call pargi (DC(shout))
+
+	call flush (logfd)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/scombine/icombine.com b/noao/onedspec/scombine/icombine.com
new file mode 100644
index 00000000..771ada77
--- /dev/null
+++ b/noao/onedspec/scombine/icombine.com
@@ -0,0 +1,36 @@
+# SCOMBINE Common
+
+int	combine			# Combine algorithm
+int	reject			# Rejection algorithm
+real	blank			# Blank value
+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
+int	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	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?
+
+common	/scbcom/ combine, reject, blank, rdnoise, gain, snoise, lsigma, hsigma,
+		 lthresh, hthresh, nkeep, pclip, flow, fhigh, grow, logfd,
+		 dflag, sigscale, mclip, doscale, doscale1,
+		 dothresh, dowts, keepids, docombine, sort
diff --git a/noao/onedspec/scombine/icombine.h b/noao/onedspec/scombine/icombine.h
new file mode 100644
index 00000000..8a45a673
--- /dev/null
+++ b/noao/onedspec/scombine/icombine.h
@@ -0,0 +1,74 @@
+# SCOMBINE Definitions
+
+# Grouping options
+define	GROUP	"|all|images|apertures|"
+define	GRP_ALL		1
+define	GRP_IMAGES	2
+define	GRP_APERTURES	3
+
+# Sorting options
+define	SORT		"|none|increasing|decreasing|"
+define	SORT_NONE	1
+define	SORT_INC	2
+define	SORT_DEC	3
+
+# Combining modes in interactive mode
+define	CMB_AGAIN	0
+define	CMB_ALL		1
+define	CMB_FIRST	2
+define	CMB_NEXT	3
+define	CMB_SKIP	4
+
+# 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
+
+# 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
+
+# Spectrum data structure
+define	NS	Memi[$1+$2-1]			# Number of spec of given ap
+define	SH	Memi[Memi[$1+$2-1]+$3-1]	# Spectrum header structure
+
+# Combining options
+#define	COMBINE		"|average|sum|"
+#define	CMB_AVERAGE	1
+#define	CMB_SUM		2
+
+# Weighting options
+#define	WT_TYPE		"|none|expo|user|"
+#define	WT_NONE		1
+#define	WT_EXPO		2
+#define	WT_USER		3
diff --git a/noao/onedspec/scombine/icombine.x b/noao/onedspec/scombine/icombine.x
new file mode 100644
index 00000000..5650d3ab
--- /dev/null
+++ b/noao/onedspec/scombine/icombine.x
@@ -0,0 +1,174 @@
+include	<mach.h>
+include	<smw.h>
+include "icombine.h"
+
+
+# IC_COMBINE -- Combine images.
+
+procedure ic_combiner (sh, shout, d, id, n, m, lflag, scales, zeros, wts,
+	nimages, npts)
+
+pointer	sh[nimages]		# Input spectra
+pointer	shout			# Output spectrum
+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
+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, ctor()
+real	r
+pointer	sp, nm
+errchk	ic_scale
+
+include	"icombine.com"
+
+begin
+	call smark (sp)
+
+	# Rebin spectra and set mask arrays
+	call scb_rebin (sh, shout, lflag, nimages, npts)
+
+	# Set scale and weights and log
+	call ic_scale (sh, shout, lflag, scales, zeros, wts, nimages)
+
+	# Set combine parameters
+	switch (combine) {
+	case AVERAGE:
+	    if (dowts)
+		keepids = true
+	    else
+		keepids = false
+	case MEDIAN:
+	    dowts = false
+	    keepids = false
+	case SUM:
+	    keepids = false
+	    reject = NONE
+	    grow = 0
+	}
+	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)] = RA(sh[i])
+	    }
+	    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)] = (Memr[nm+3*(i-1)] / r) ** 2
+		}
+	    } else {
+		do i = 1, nimages {
+		    r = DEC(sh[i])
+		    Memr[nm+3*(i-1)+1] = r
+		    Memr[nm+3*(i-1)] = (Memr[nm+3*(i-1)] / r) ** 2
+		}
+	    }
+	    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 = UT(sh[i])
+		    Memr[nm+3*(i-1)+2] = r
+		}
+	    }
+	    if (!keepids) {
+		if (doscale1 || grow > 0)
+		    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
+	    if (grow > 0)
+		keepids = true
+	case PCLIP:
+	    mclip = true
+	    if (grow > 0)
+		keepids = true
+	case AVSIGCLIP, SIGCLIP:
+	    if (doscale1 || grow > 0)
+		keepids = true
+	case NONE:
+	    mclip = false
+	    grow = 0
+	}
+
+	if (keepids) {
+	    do i = 1, nimages
+		call salloc (id[i], npts, TY_INT)
+	}
+
+	call ic_gdatar (sh, d, id, n, m, lflag, scales, zeros, nimages, npts)
+
+	switch (reject) {
+	case CCDCLIP, CRREJECT:
+	    if (mclip)
+		call ic_mccdclipr (d, id, n, scales, zeros, Memr[nm],
+		    nimages, npts, Memr[SY(shout)])
+	    else
+		call ic_accdclipr (d, id, n, scales, zeros, Memr[nm],
+		    nimages, npts, Memr[SY(shout)])
+	case MINMAX:
+	    call ic_mmr (d, id, n, npts)
+	case PCLIP:
+	    call ic_pclipr (d, id, n, nimages, npts, Memr[SY(shout)])
+	case SIGCLIP:
+	    if (mclip)
+		call ic_msigclipr (d, id, n, scales, zeros, nimages, npts,
+		    Memr[SY(shout)])
+	    else
+		call ic_asigclipr (d, id, n, scales, zeros, nimages, npts,
+		    Memr[SY(shout)])
+	case AVSIGCLIP:
+	    if (mclip)
+		call ic_mavsigclipr (d, id, n, scales, zeros, nimages,
+		    npts, Memr[SY(shout)])
+	    else
+		call ic_aavsigclipr (d, id, n, scales, zeros, nimages,
+		    npts, Memr[SY(shout)])
+	}
+
+	if (grow > 0)
+	    call ic_growr (d, id, n, nimages, npts, Memr[SY(shout)])
+
+	if (docombine) {
+	    switch (combine) {
+	    case AVERAGE:
+		call ic_averager (d, id, n, wts, npts, Memr[SY(shout)])
+	    case MEDIAN:
+		call ic_medianr (d, n, npts, Memr[SY(shout)])
+	    case SUM:
+		call ic_sumr (d, n, npts, Memr[SY(shout)])
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/scombine/icscale.x b/noao/onedspec/scombine/icscale.x
new file mode 100644
index 00000000..009b30c3
--- /dev/null
+++ b/noao/onedspec/scombine/icscale.x
@@ -0,0 +1,463 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<error.h>
+include	<ctype.h>
+include	<smw.h>
+include	"icombine.h"
+
+# IC_SCALE -- Get the scale factors for the spectra.
+# 1. This procedure does CLIO to determine the type of scaling desired.
+# 2. The output header parameters for exposure time and NCOMBINE are set.
+
+procedure ic_scale (sh, shout, lflags, scales, zeros, wts, nimages)
+
+pointer	sh[nimages]		# Input spectra
+pointer	shout			# Output spectrum
+int	lflags[nimages]		# Data flags
+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, nout
+real	mode, median, mean, exposure, zmean
+pointer	sp, ncombine, exptime, modes, medians, means, expname
+pointer	str, sname, zname, wname, rg
+bool	domode, domedian, domean, dozero
+
+int	ic_gscale()
+real	asumr(), asumi()
+pointer	ic_wranges()
+errchk	ic_gscale, 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 (expname, SZ_FNAME, 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)
+
+	# Set the defaults.
+	call amovki (1, Memi[ncombine], nimages)
+	call amovkr (0., Memr[exptime], nimages)
+	call amovkr (INDEF, Memr[modes], nimages)
+	call amovkr (INDEF, Memr[medians], nimages)
+	call amovkr (INDEF, Memr[means], nimages)
+	call amovkr (1., scales, nimages)
+	call amovkr (0., zeros, nimages)
+	call amovkr (1., wts, nimages)
+
+	# Set scaling factors.
+	if (combine == SUM) {
+	    stype = S_NONE
+	    ztype = S_NONE
+	    wtype = S_NONE
+	    do i = 1, nimages
+		Memr[exptime+i-1] = IT(sh[i])
+	} else {
+	    stype = ic_gscale ("scale", Memc[sname], STYPES, sh, Memr[exptime],
+		scales, nimages)
+	    ztype = ic_gscale ("zero", Memc[zname], ZTYPES, sh, Memr[exptime],
+		zeros, nimages)
+	    wtype = ic_gscale ("weight", Memc[wname], WTYPES, sh, Memr[exptime],
+		wts, nimages)
+	}
+
+	Memc[expname] = EOS
+	if (combine == SUM || stype == S_EXPOSURE || wtype == S_EXPOSURE) {
+	    call strcpy ("exptime", Memc[expname], SZ_FNAME)
+	    do i = 1, nimages
+		if (IS_INDEFR(Memr[exptime+i-1]))
+		    Memc[expname] = EOS
+	}
+
+	# Get image statistics only if needed.
+	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))
+	if (domode || domedian || domean) {
+	    call clgstr ("sample", Memc[str], SZ_LINE)
+	    rg = ic_wranges (Memc[str])
+	    do i = 1, nimages {
+		call ic_statr (sh[i], lflags[i], rg, domode, domedian, domean,
+		    mode, median, mean)
+		if (domode) {
+		    Memr[modes+i-1] = mode
+		    if (stype == S_MODE)
+			scales[i] = mode
+		    if (ztype == S_MODE)
+			zeros[i] = mode
+		    if (wtype == S_MODE)
+			wts[i] = mode
+		}
+		if (domedian) {
+		    Memr[medians+i-1] = median
+		    if (stype == S_MEDIAN)
+			scales[i] = median
+		    if (ztype == S_MEDIAN)
+			zeros[i] = median
+		    if (wtype == S_MEDIAN)
+			wts[i] = median
+		}
+		if (domean) {
+		    Memr[means+i-1] = mean
+		    if (stype == S_MEAN)
+			scales[i] = mean
+		    if (ztype == S_MEAN)
+			zeros[i] = mean
+		    if (wtype == S_MEAN)
+			wts[i] = mean
+		}
+	    }
+	    call mfree (rg, TY_REAL)
+	}
+
+	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 relative factors.
+	mean = asumr (scales, nimages) / nimages
+	call adivkr (scales, mean, scales, nimages)
+	call adivr (zeros, scales, zeros, nimages)
+	zmean = asumr (zeros, nimages) / 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)
+	            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] * zmean / zeros[i]
+		}
+	    }
+	}
+
+	call asubkr (zeros, zmean, zeros, nimages)
+	mean = asumr (wts, nimages)
+	call adivkr (wts, mean, wts, nimages)
+
+	# 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.
+
+	for (i=2; (i<=nimages)&&(zeros[i]==zeros[1]); i=i+1)
+	    ;
+	if (i > nimages)
+	    call aclrr (zeros, nimages)
+
+	# 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 (scales[i] != scales[1])
+		doscale = true
+	    if (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
+		}
+	    }
+	    if (!doscale1 && zmean > 0.) {
+		do i = 1, nimages {
+		    if (abs (zeros[i] / zmean) > sigscale) {
+			doscale1 = true
+			break
+		    }
+		}
+	    }
+	}
+		    
+	# Set the output header parameters.
+	nout = asumi (Memi[ncombine], nimages)
+	call imaddi (IM(shout), "ncombine", nout)
+	if (Memc[expname] != EOS) {
+	    exposure = 0.
+	    if (combine == SUM) {
+		do i = 1, nimages
+		    exposure = exposure + Memr[exptime+i-1]
+	    } else {
+		do i = 1, nimages
+		    exposure = exposure + wts[i] * Memr[exptime+i-1] / scales[i]
+	    }
+	    call imaddr (IM(shout), Memc[expname], exposure)
+	} else
+	    exposure = INDEF
+
+	# Start the log here since much of the info is only available here.
+	call ic_log (sh, shout, Memi[ncombine], Memr[exptime], Memc[sname],
+	    Memc[zname], Memc[wname], Memr[modes], Memr[medians], Memr[means],
+	    scales, zeros, wts, nimages, dozero, nout, Memc[expname], exposure)
+
+	doscale = (doscale || dozero)
+
+	call sfree (sp)
+end
+
+
+# IC_GSCALE -- Get scale values as directed by CL parameter
+# 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, sh, exptime, values, nimages)
+
+char	param[ARB]		#I CL parameter name
+char	name[SZ_FNAME]		#O Parameter value
+char	dic[ARB]		#I Dictionary string
+pointer	sh[nimages]		#I SHDR 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
+pointer	errstr
+errchk	open
+
+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
+	    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
+		values[i] = rval
+	    }
+	    call close (fd)
+	    if (i < nimages) {
+		call salloc (errstr, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[errstr], SZ_FNAME,
+		    "Insufficient %s values in %s")
+		    call pargstr (param)
+		    call pargstr (name[2])
+		call error (1, Memc[errstr])
+	    }
+	} else if (name[1] == '!') {
+	    type = S_KEYWORD
+	    do i = 1, nimages {
+		switch (param[1]) {
+		case 's':
+		    values[i] = ST(sh[i])
+		case 'z':
+		    values[i] = HA(sh[i])
+		case 'w':
+		    values[i] = AM(sh[i])
+		}
+	    }
+	} 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_INDEF(IT(sh[i])))
+			call error (1, "Exposure time not defined")
+		    exptime[i] = IT(sh[i])
+		    values[i] = max (0.001, exptime[i])
+		}
+	    }
+	}
+
+	return (type)
+end
+
+
+# IC_WRANGES -- Parse wavelength range string.
+# A wavelength range string  consists of colon delimited ranges with
+# multiple ranges separated by comma and/or whitespace.
+
+pointer procedure ic_wranges (rstr)
+
+char	rstr[ARB]		# Range string
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+pointer	sp, str, ptr
+errchk	open, ic_wadd
+
+begin
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, 1, TY_REAL)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    iferr {
+		if (Memc[str] == '@') {
+		    fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		    while (getline (fd, Memc[str]) != EOF) {
+			iferr (call ic_wadd (rg, Memc[str]))
+			    call erract (EA_WARN)
+		    }
+		    call close (fd)
+		} else
+		    call ic_wadd (rg, Memc[str])
+	    } then
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+
+	# Set final structure
+	i = Memr[rg]
+	if (i == 0)
+	    call mfree (rg, TY_REAL)
+	else
+	    call realloc (rg, 1 + 2 * i, TY_REAL)
+	return (rg)
+end
+
+
+# IC_WADD -- Add a range
+
+procedure ic_wadd (rg, rstr)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+
+int	i, j, n, strlen(), ctor()
+real	w1, w2
+pointer	sp, str, ptr
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	n = Memr[rg]
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':')
+		    Memc[ptr] = ' '
+		else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call error (1, "Cannot nest @files")
+	    else {
+		# Get range
+		j = 1
+		if (ctor (Memc[str], j, w1) == 0)
+		    call error (1, "Range syntax error")
+		if (ctor (Memc[str], j, w2) == 0)
+		    call error (1, "Range syntax error")
+	    }
+
+	    if (mod (n, 10) == 0)
+		call realloc (rg, 1+2*(n+10), TY_REAL)
+	    n = n + 1
+	    Memr[rg+2*n-1] = min (w1, w2)
+	    Memr[rg+2*n] = max (w1, w2)
+	}
+	Memr[rg] = n
+
+	call sfree (sp)
+end
+
+
+# IC_WISINRANGE -- Is wavelength in range?
+
+bool procedure ic_wisinrange (rg, w)
+
+pointer	rg		# Wavelength range array
+real	w		# Wavelength
+
+int	i, n
+
+begin
+	if (rg == NULL)
+	    return (true)
+
+	n = nint (Memr[rg])
+	do i = 1, 2*n, 2
+	    if (w >= Memr[rg+i] && w <= Memr[rg+i+1])
+		return (true)
+	return (false)
+end
diff --git a/noao/onedspec/scombine/icstat.x b/noao/onedspec/scombine/icstat.x
new file mode 100644
index 00000000..3fce4165
--- /dev/null
+++ b/noao/onedspec/scombine/icstat.x
@@ -0,0 +1,160 @@
+include	<smw.h>
+include	"icombine.h"
+
+
+# IC_STATR -- Compute image statistics within spectrum.
+
+procedure ic_statr (sh, lflag, rg, domode, domedian, domean, mode, median, mean)
+
+pointer	sh			 # Spectrum structure
+int	lflag			 # Data flag
+pointer	rg			 # Wavelength ranges
+bool	domode, domedian, domean # Statistics to compute
+real	mode, median, mean	 # Statistics
+
+int	i, n, npts
+real	a, w
+pointer	sp, data, dp, lp, mp
+real	ic_moder(), asumr()
+bool	ic_wisinrange()
+double	shdr_lw()
+
+include	"icombine.com"
+
+begin
+	mp = SX(sh)
+	lp = SY(sh)
+	npts = SN(sh)
+
+	call smark (sp)
+	call salloc (data, npts, TY_REAL)
+
+	dp = data
+	if (lflag == D_ALL && rg == NULL) {
+	    if (dothresh) {
+		do i = 1, npts {
+		    a = Memr[lp]
+		    if (a >= lthresh && a <= hthresh) {
+			Memr[dp] = a
+			dp = dp + 1
+		    }
+		    lp = lp + 1
+		}
+	    } else {
+		do i = 1, npts {
+		    Memr[dp] = Memr[lp]
+		    dp = dp + 1
+		    lp = lp + 1
+		}
+	    }
+	} else if (lflag == D_MIX || rg != NULL) {
+	    if (dothresh) {
+		do i = 1, npts {
+		    if (Memr[mp] == 0) {
+			a = Memr[lp]
+			if (a >= lthresh && a <= hthresh) {
+			    w = shdr_lw (sh, double (i))
+			    if (ic_wisinrange (rg, w)) {
+				Memr[dp] = a
+				dp = dp + 1
+			    }
+			}
+		    }
+		    mp = mp + 1
+		    lp = lp + 1
+		}
+	    } else {
+		do i = 1, npts {
+		    if (Memr[mp] == 0) {
+			w = shdr_lw (sh, double (i))
+			if (ic_wisinrange (rg, w)) {
+			    Memr[dp] = Memr[lp]
+			    dp = dp + 1
+			}
+		    }
+		    mp = mp + 1
+		    lp = lp + 1
+		}
+	    }
+	}
+
+	n = dp - data
+	if (n > 0) {
+	    # 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
+	} else {
+	    mode = INDEF
+	    median = INDEF
+	    mean = INDEF
+	}
+
+	call sfree (sp)
+end
+
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZRANGE	0.8	# 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
diff --git a/noao/onedspec/scombine/icsum.x b/noao/onedspec/scombine/icsum.x
new file mode 100644
index 00000000..f038b37b
--- /dev/null
+++ b/noao/onedspec/scombine/icsum.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icombine.h"
+
+
+# IC_SUM -- Compute the summed image line.
+
+procedure ic_sumr (d, n, npts, sum)
+
+pointer	d[ARB]			# Data pointers
+int	n[npts]			# Number of points
+int	npts			# Number of output points per line
+real	sum[npts]		# Average (returned)
+
+int	i, j, k
+real	s
+
+include	"icombine.com"
+
+begin
+	# If no data has been excluded do the sum without checking the
+	# number of points.  If all the data has been excluded set the
+	# sum to the blank value.
+
+	if (dflag == D_ALL) {
+	    do i = 1, npts {
+		k = i - 1
+		s = Memr[d[1]+k]
+		do j = 2, n[i]
+		    s = s + Memr[d[j]+k]
+		sum[i] = s
+	    }
+	} else if (dflag == D_NONE) {
+	    do i = 1, npts
+		sum[i] = blank
+	} else {
+	    do i = 1, npts {
+		if (n[i] > 0) {
+		    k = i - 1
+		    s = Memr[d[1]+k]
+		    do j = 2, n[i]
+			s = s + Memr[d[j]+k]
+		    sum[i] = s
+		} else
+		    sum[i] = blank
+	    }
+	}
+end
diff --git a/noao/onedspec/scombine/iscombine.key b/noao/onedspec/scombine/iscombine.key
new file mode 100644
index 00000000..91d7876b
--- /dev/null
+++ b/noao/onedspec/scombine/iscombine.key
@@ -0,0 +1,23 @@
+		SCOMBINE CURSOR KEYS
+
+a - Mark scaling ranges in overlap region for 'v' key
+b - Cancel scaling ranges
+c - Print cursor position
+d - Replace range of pixels by straight cursor line
+e - Replace range of pixels by linear interpolation from the endpoint pixels
+f - Start over from the first spectrum
+j - Fudge a point to vertical cursor value
+n - Go on to next spectrum
+o - Reset data for current spectrum to initial values
+p - Don't include current spectrum in combined image and go on to next spectrum
+q - Quit and combine remaining spectra noninteractively (no|yes|YES)
+s - Mark accumulation ranges in current spectrum
+t - Cancel accumulation ranges
+v - Shift overlap average of spectrum vertically to accumulated spectrum
+w - Window the graph using gtools commands
+x - Shift spectrum horizontally to cursor position
+y - Shift spectrum vertically to cursor position
+z - Shift spectrum vertically to accumulated spectrum
++ - Set additive scaling for 'v' key
+* - Set multiplicative scaling 
+? - This help page
diff --git a/noao/onedspec/scombine/iscombine.par b/noao/onedspec/scombine/iscombine.par
new file mode 100644
index 00000000..a9d8846e
--- /dev/null
+++ b/noao/onedspec/scombine/iscombine.par
@@ -0,0 +1,18 @@
+input,s,a,"",,,List of input spectra
+output,s,a,"",,,List of output spectra
+woutput,s,h,"",,,List of output weight spectra
+apertures,s,h,"",,,Apertures to combine
+group,s,h,"apertures","all|images|apertures",,Grouping option
+combine,s,h,"average","average|sum",,Combining option
+scale,s,h,"",,,Header keyword for scaling
+weight,s,h,"","",,"Header keyword for weighting
+"
+w1,r,h,INDEF,,,Starting wavelength of output spectra
+w2,r,h,INDEF,,,Ending wavelength of output spectra
+dw,r,h,INDEF,,,Wavelength increment of output spectra
+nw,i,h,INDEF,,,Length of output spectra
+log,b,h,no,,,"Logarithmic increments?
+"
+interactive,b,h,no,,,Adjust spectra interactively?
+sort,s,h,"none","none|increasing|decreasing",,Interactive combining order
+cursor,*gcur,h,"",,,Graphics cursor input
diff --git a/noao/onedspec/scombine/mkpkg b/noao/onedspec/scombine/mkpkg
new file mode 100644
index 00000000..ab60e45b
--- /dev/null
+++ b/noao/onedspec/scombine/mkpkg
@@ -0,0 +1,35 @@
+# SCOMBINE
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$omake	x_scombine.x
+	$link	x_scombine.o libpkg.a -lsmw -lxtools -liminterp \
+	    -o xx_scombine.e
+	;
+
+install:
+	$move	xx_scombine.e noaobin$x_scombine.e
+	;
+
+
+libpkg.a:
+	@generic
+
+	icgdata.x	<smw.h> icombine.com icombine.h
+	iclog.x		<smw.h> icombine.com icombine.h <mach.h>
+	icombine.x	<smw.h> icombine.com <mach.h> icombine.h
+	icscale.x	<smw.h> icombine.com icombine.h <ctype.h> <error.h>\
+			<imhdr.h> <imset.h>
+	icstat.x	<smw.h> icombine.com icombine.h
+	icsum.x		icombine.com icombine.h
+	t_scombine.x	<smw.h> icombine.h icombine.com <error.h> <imhdr.h>\
+			<mach.h>
+	;
diff --git a/noao/onedspec/scombine/scombine.par b/noao/onedspec/scombine/scombine.par
new file mode 100644
index 00000000..932e6e31
--- /dev/null
+++ b/noao/onedspec/scombine/scombine.par
@@ -0,0 +1,37 @@
+input,s,a,"",,,List of input spectra
+output,s,a,"",,,List of output spectra
+noutput,s,h,"",,,List of output number combined spectra
+logfile,s,h,"STDOUT",,,"Log file
+"
+apertures,s,h,"",,,Apertures to combine
+group,s,h,"apertures","all|images|apertures",,"Grouping option"
+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
+"
+first,b,h,no,,,Use first spectrum for dispersion?
+w1,r,h,INDEF,,,Starting wavelength of output spectra
+w2,r,h,INDEF,,,Ending wavelength of output spectra
+dw,r,h,INDEF,,,Wavelength increment of output spectra
+nw,i,h,INDEF,,,Length of output spectra
+log,b,h,no,,,"Logarithmic increments?
+"
+scale,s,h,"none",,,Image scaling
+zero,s,h,"none",,,Image zero point offset
+weight,s,h,"none",,,Image weights
+sample,s,h,"",,,"Wavelength sample regions for statistics
+"
+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,i,h,0,,,Radius (pixels) for 1D neighbor rejection
+blank,r,h,0.,,,Value if there are no pixels
diff --git a/noao/onedspec/scombine/t_scombine.x b/noao/onedspec/scombine/t_scombine.x
new file mode 100644
index 00000000..774a5f87
--- /dev/null
+++ b/noao/onedspec/scombine/t_scombine.x
@@ -0,0 +1,630 @@
+include	<imhdr.h>
+include	<error.h>
+include	<mach.h>
+include	<smw.h>
+include "icombine.h"
+
+
+# T_SCOMBINE - Combine spectra
+# The input spectra are combined by medianing, averaging or summing
+# with optional rejection, scaling and weighting.  The input may be
+# grouped by aperture or by image.  The combining algorithms are
+# similar to those in IMCOMBINE.
+
+procedure t_scombine()
+
+int	ilist			# list of input images
+int	olist			# list of output images
+pointer	nlist			# image name for number combined
+pointer	aps			# aperture ranges
+int	group			# grouping option
+
+int	reject1
+real	flow1, fhigh1, pclip1, nkeep1
+
+real	rval
+bool	grdn, ggain, gsn
+int	i, j, k, l, n, naps, npts
+pointer	im, mw, nout, refim, shin, shout
+pointer	sp, input, output, noutput, scale, zero, weight, str, logfile, sh, ns
+pointer	sp1, d, id, nc, m, lflag, scales, zeros, wts
+
+real	clgetr(), imgetr()
+bool	clgetb(), rng_elementi()
+int	clgeti(), clgwrd(), ctor()
+int	imtopenp(), imtgetim(), open(), nowhite()
+pointer	rng_open(), immap(), smw_openim(), impl2i(), impl2r()
+errchk	open, immap, smw_openim, shdr_open, imgetr
+errchk	scb_output, scb_combine, ic_combiner
+
+include	"icombine.com"
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (noutput, SZ_FNAME, TY_CHAR)
+	call salloc (scale, SZ_FNAME, TY_CHAR)
+	call salloc (zero, SZ_FNAME, TY_CHAR)
+	call salloc (weight, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (gain, SZ_FNAME, TY_CHAR)
+	call salloc (snoise, SZ_FNAME, TY_CHAR)
+	call salloc (rdnoise, SZ_FNAME, TY_CHAR)
+	call salloc (logfile, SZ_FNAME, TY_CHAR)
+
+	# Get parameters
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	nlist = imtopenp ("noutput")
+	call clgstr ("apertures", Memc[str], SZ_LINE)
+	group = clgwrd ("group", Memc[input], SZ_FNAME, GROUP)
+
+	# IMCOMBINE parameters
+	call clgstr ("logfile", Memc[logfile], SZ_FNAME)
+	combine = clgwrd ("combine", Memc[input], SZ_FNAME, COMBINE)
+	reject1 = clgwrd ("reject", Memc[input], SZ_FNAME, REJECT)
+	blank = clgetr ("blank")
+	call clgstr ("scale", Memc[scale], SZ_FNAME)
+	call clgstr ("zero", Memc[zero], SZ_FNAME)
+	call clgstr ("weight", Memc[weight], 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")
+	pclip1 = clgetr ("pclip")
+	flow1 = clgetr ("nlow")
+	fhigh1 = clgetr ("nhigh")
+	nkeep1 = clgeti ("nkeep")
+	grow = clgeti ("grow")
+	mclip = clgetb ("mclip")
+	sigscale = clgetr ("sigscale")
+
+	i = nowhite (Memc[scale], Memc[scale], SZ_FNAME)
+	i = nowhite (Memc[zero], Memc[zero], SZ_FNAME)
+	i = nowhite (Memc[weight], Memc[weight], SZ_FNAME)
+
+	# Check parameters, map INDEFs, and set threshold flag
+	if (combine == SUM)
+	    reject1 = NONE
+	if (pclip1 == 0. && reject1 == 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 (pclip1))
+	    pclip1 = -0.5
+	if (IS_INDEFI (nkeep1))
+	    nkeep1 = 0
+	if (IS_INDEFR (flow1))
+	    flow1 = 0
+	if (IS_INDEFR (fhigh))
+	    fhigh = 0
+	if (IS_INDEFI (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
+	}
+
+	# Get read noise and gain?
+	grdn = false
+	ggain = false
+	gsn = false
+	if (reject1 == CCDCLIP || reject1 == CRREJECT) {
+	    i = 1
+	    if (ctor (Memc[rdnoise], i, rval) == 0)
+		grdn = true
+	    i = 1
+	    if (ctor (Memc[gain], i, rval) == 0)
+		ggain = true
+	    i = 1
+	    if (ctor (Memc[snoise], i, rval) == 0)
+		gsn = true
+	}
+
+	# Open the log file.
+	logfd = NULL
+	if (Memc[logfile] != EOS) {
+	    iferr (logfd = open (Memc[logfile], APPEND, TEXT_FILE)) {
+	        logfd = NULL
+	        call erract (EA_WARN)
+	    }
+	}
+
+	iferr (aps = rng_open (Memc[str], INDEF, INDEF, INDEF))
+	    call error (1, "Error in aperture list")
+
+	# Loop through input images.
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF) {
+		call eprintf ("No output image\n")
+		break
+	    }
+	    if (imtgetim (nlist, Memc[noutput], SZ_FNAME) == EOF)
+		Memc[noutput] = EOS
+
+	    # Get spectra to combine.
+	    # Because the input images are unmapped we must get all the
+	    # data we need for combining into the spectrum data structures.
+	    # In particular any header keyword parameters that will be
+	    # used.  We save the header values in unused elements of
+	    # the spectrum data structure.
+
+	    naps = 0
+	    repeat {
+		iferr (im = immap (Memc[input], READ_ONLY, 0)) {
+		    if (group == GRP_IMAGES) {
+			call erract (EA_WARN)
+			next
+		    } else {
+			call erract (EA_ERROR)
+		    }
+		}
+		mw = smw_openim (im)
+		shin = NULL
+
+		do i = 1, SMW_NSPEC(mw) {
+		    call shdr_open (im, mw, i, 1, INDEFI, SHDATA, shin)
+		    if (Memc[scale] == '!')
+			ST(shin) = imgetr (im, Memc[scale+1])
+		    if (Memc[zero] == '!')
+			HA(shin) = imgetr (im, Memc[zero+1])
+		    if (Memc[weight] == '!')
+			AM(shin) = imgetr (im, Memc[weight+1])
+		    if (grdn)
+			RA(shin) = imgetr (im, Memc[rdnoise])
+		    if (ggain)
+			DEC(shin) = imgetr (im, Memc[gain])
+		    if (gsn)
+			UT(shin) = imgetr (im, Memc[snoise])
+		    if (!rng_elementi (aps, AP(shin)))
+			next
+		    if (group == GRP_APERTURES) {
+			for (j=1; j<=naps; j=j+1)
+			    if (AP(shin) == AP(SH(sh,j,1)))
+				break
+			n = 10
+		    } else {
+			j = 1
+			n = 1
+		    }
+
+		    if (naps == 0) {
+			call calloc (sh, n, TY_POINTER)
+			call calloc (ns, n, TY_INT)
+		    } else if (j > naps && mod (naps, n) == 0) {
+			call realloc (sh, naps+n, TY_POINTER)
+			call realloc (ns, naps+n, TY_INT)
+			call aclri (Memi[sh+naps], n)
+			call aclri (Memi[ns+naps], n)
+		    }
+		    if (j > naps)
+			naps = naps + 1
+		    n = NS(ns,j)
+		    if (n == 0)
+			call malloc (Memi[sh+j-1], 10, TY_POINTER)
+		    else if (mod (n, 10) == 0)
+			call realloc (Memi[sh+j-1], n+10, TY_POINTER)
+
+		    n = n + 1
+		    SH(sh,j,n) = NULL
+		    NS(ns,j) = n
+		    call shdr_copy (shin, SH(sh,j,n), NO)
+		}
+
+		call imunmap (IM(shin))
+		MW(shin) = NULL
+		call shdr_close (shin)
+
+		if (group == GRP_IMAGES)
+		    break
+	    } until (imtgetim (ilist, Memc[input], SZ_FNAME) == EOF)
+
+	    if (naps < 1) {
+		call eprintf ("No input spectra to combine\n")
+		next
+	    }
+
+	    # Set the output and combine the spectra.
+	    call scb_output (sh, ns, naps, Memc[output], Memc[noutput],
+		im, mw, nout, refim)
+
+	    do j = 1, naps {
+		call shdr_open (im, mw, j, 1, INDEFI, SHHDR, shout)
+		npts = SN(shout)
+		n = NS(ns,j)
+
+		# Allocate additional memory
+		call smark (sp1)
+		call salloc (d, n, TY_POINTER)
+		call salloc (id, n, TY_POINTER)
+		call salloc (nc, npts, TY_INT)
+		call salloc (m, n, TY_POINTER)
+		call salloc (lflag, n, TY_INT)
+		call salloc (scales, n, TY_REAL)
+		call salloc (zeros, n, TY_REAL)
+		call salloc (wts, n, TY_REAL)
+		call calloc (SX(shout), npts, TY_REAL)
+		call calloc (SY(shout), npts, TY_REAL)
+		call amovki (D_ALL, Memi[lflag], n)
+
+		# 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.
+
+		reject = reject1
+		nkeep = nkeep1
+		if (nkeep < 0)
+		    nkeep = n + nkeep
+		if (reject == PCLIP) {
+		    pclip = pclip1
+		    i = (n - 1) / 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) {
+		    flow = flow1
+		    fhigh = fhigh1
+		    if (flow >= 1)
+			flow = flow / n
+		    if (fhigh >= 1)
+			fhigh = fhigh / n
+		    i = flow * n + fhigh * n
+		    if (i == 0)
+			reject = NONE
+		    else if (i >= n) {
+			call eprintf ("Bad minmax rejection parameters\n")
+			call eprintf ("Using no rejection\n")
+			reject = NONE
+		    }
+		}
+
+		# Combine spectra
+		call ic_combiner (SH(sh,j,1), shout, Memi[d], Memi[id],
+		    Memi[nc], Memi[m], Memi[lflag], Memr[scales], Memr[zeros],
+		    Memr[wts], n, npts)
+
+		# Write the results
+		call amovr (Memr[SY(shout)], Memr[impl2r(im,j)], npts)
+		if (nout != NULL)
+		    call amovi (Memi[nc], Memi[impl2i(nout,j)], npts)
+		call sfree (sp1)
+	    }
+
+	    # Finish up
+	    call shdr_close (shout)
+	    call smw_close (mw)
+	    call imunmap (im)
+	    call imunmap (refim)
+	    if (nout != NULL)
+		call imunmap (nout)
+
+	    # Find all the distinct SMW pointers and free them.
+	    do j = 1, naps {
+		do i = 1, NS(ns,j) {
+		    mw = MW(SH(sh,j,i))
+		    if (mw != NULL) {
+			do k = 1, naps  {
+			    do l = 1, NS(ns,k) {
+				shin = SH(sh,k,l)
+				if (MW(shin) == mw)
+				    MW(shin) = NULL
+			    }
+			}
+			call smw_close (mw)
+		    }
+		}
+	    }
+	    do j = 1, naps {
+		do i = 1, NS(ns,j)
+		    call shdr_close (SH(sh,j,i))
+		call mfree (Memi[sh+j-1], TY_POINTER)
+	    }
+	    call mfree (sh, TY_POINTER)
+	    call mfree (ns, TY_INT)
+	}
+
+	call rng_close (aps)
+	call imtclose (ilist)
+	call imtclose (olist)
+	call imtclose (nlist)
+
+	call sfree (sp)
+end
+
+
+# SCB_REBIN - Rebin input spectra to output dispersion
+# Use the SX array as mask.  If less than 1% of an input
+# pixel contributes to an output pixel then flag it as missing data.
+
+procedure scb_rebin (sh, shout, lflag, ns, npts)
+
+pointer	sh[ns]			# Input spectra structures
+pointer	shout			# Output spectrum structure
+int	lflag[ns]		# Empty mask flags
+int	ns			# Number of spectra
+int	npts			# NUmber of output points
+
+int	i, j
+real	a, b, c
+pointer	shin
+double	shdr_wl(), shdr_lw()
+
+include	"icombine.com"
+	
+begin
+	# Rebin to common dispersion
+	# Determine overlap with output and set mask arrays
+
+	do i = 1, ns {
+	    shin = sh[i]
+	    c = shdr_wl (shout, shdr_lw (shin, double(0.5)))
+	    b = shdr_wl (shout, shdr_lw (shin, double(SN(shin)+0.5)))
+	    a = max (1, nint (min (b, c) + 0.01))
+	    b = min (npts, nint (max (b, c) - 0.01))
+	    j = b - a + 1
+	    if (j < 1) {
+		lflag[i] = D_NONE
+		next
+	    }
+	    else if (j < npts)
+		lflag[i] = D_MIX
+	    else
+		lflag[i] = D_ALL
+
+	    call shdr_rebin (shin, shout)
+	    call aclrr (Memr[SX(shin)], SN(shin))
+	    j = a - 1
+	    if (j > 0)
+		call amovkr (1.0, Memr[SX(shin)], j)
+	    j = SN(shin) - b
+	    if (j > 0)
+		call amovkr (1.0, Memr[SX(shin)+SN(shin)-j], j)
+	}
+
+	dflag = lflag[1]
+	do i = 2, ns {
+	    if (dflag != lflag[i]) {
+		dflag = D_MIX
+		break
+	    }
+	}
+end
+
+
+# SCB_OUTPUT - Set the output spectrum
+
+procedure scb_output (sh, ns, naps, output, noutput, im, mw, nout, refim)
+
+pointer	sh			# spectra structures
+int	ns			# number of spectra
+int	naps			# number of apertures
+char	output[SZ_FNAME]	# output spectrum name
+char	noutput[SZ_FNAME]	# output number combined image name
+pointer	im			# output IMIO pointer
+pointer	mw			# output MWCS pointer
+pointer	nout			# output number combined IMIO pointer
+pointer	refim			# reference image for output image
+
+int	i, ap, beam, dtype, nw, nmax, axis[2]
+double	w1, dw, z
+real	aplow[2], aphigh[2]
+pointer	sp, key, coeff, sh1
+pointer	immap(), mw_open(), smw_openim()
+errchk	immap, smw_openim
+data	axis/1,2/
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	coeff = NULL
+
+	# Create output image using the first input image as a reference
+	refim = immap (IMNAME(SH(sh,1,1)), READ_ONLY, 0)
+	im = immap (output, NEW_COPY, refim)
+
+	# Use smw_openim to clean up old keywords(?).
+	mw = smw_openim (im)
+	call smw_close (mw)
+
+	if (naps == 1)
+	    IM_NDIM(im) = 1
+	else
+	    IM_NDIM(im) = 2
+	call imaddi (im, "SMW_NDIM", IM_NDIM(im))
+	IM_LEN(im,2) = naps
+	if (IM_PIXTYPE(im) != TY_DOUBLE)
+	    IM_PIXTYPE(im) = TY_REAL
+
+	# Set new header.
+	mw = mw_open (NULL, 2)
+	call mw_newsystem (mw, "multispec", 2)
+	call mw_swtype (mw, axis, 2, "multispec",
+	    "label=Wavelength units=Angstroms")
+	call smw_open (mw, NULL, im)
+
+	nmax = 0
+	do i = 1, naps {
+	    sh1 = SH(sh,i,1)
+	    call smw_gwattrs (MW(sh1), APINDEX(sh1), 1, ap, beam, dtype,
+		w1, dw, nw, z, aplow, aphigh, coeff)
+	    call scb_default (SH(sh,i,1), NS(ns,i),
+		dtype, w1, dw, nw, z, Memc[coeff])
+	    call smw_swattrs (mw, i, 1, ap, beam, dtype,
+		w1, dw, nw, z, aplow, aphigh, Memc[coeff])
+	    call smw_sapid (mw, i, 1, TITLE(sh1))
+	    nmax = max (nmax, nw)
+	}
+
+	IM_LEN(im,1) = nmax
+
+	# Set MWCS header.
+	call smw_saveim (mw, im)
+	call smw_close (mw)
+	mw = smw_openim (im)
+
+	# Create number combined image
+	if (noutput[1] != EOS) {
+	    nout = immap (noutput, NEW_COPY, im)
+	    IM_PIXTYPE(nout) = TY_INT
+	    call sprintf (IM_TITLE(nout), SZ_LINE, "Number combined for %s")
+		call pargstr (output)
+	}
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# SCB_DEFAULT - Set default values for the starting wavelength, ending
+# wavelength, wavelength increment and spectrum length for the output
+# spectrum.
+
+procedure scb_default (shdr, ns, dtype, w1, dw, nw, z, coeff)
+
+pointer	shdr[ARB]		# spectra structures
+int	ns			# number of spectra
+int	dtype			# dispersion type
+double	w1			# starting wavelength
+double	dw			# wavelength increment
+int	nw			# spectrum length
+double	z			# redshift
+char	coeff[ARB]		# nonlinear coefficient array
+
+bool	clgetb()
+int	i, nwa, clgeti()
+double	w2, aux, w1a, w2a, dwa, clgetd()
+pointer	sh
+
+begin
+	if (clgetb ("first"))
+	    return
+
+	w1a = clgetd ("w1")
+	w2a = clgetd ("w2")
+	dwa = clgetd ("dw")
+	nwa = clgeti ("nw")
+	if (clgetb ("log"))
+	    dtype = DCLOG
+	else
+	    dtype = DCLINEAR
+	z = 0.
+	coeff[1] = EOS
+
+	# Dispersion type
+	if (dtype == DCLINEAR) {
+	    do i = 1, ns {
+		if (DC(shdr[i]) == DCNO) {
+		    dtype = DCNO
+		    break
+		}
+	    }
+	}
+
+	w1 = w1a
+	w2 = w2a
+	dw = dwa
+	nw = nwa
+
+	# Starting wavelength
+	if (IS_INDEFD (w1)) {
+	    if (IS_INDEFD (dw) || dw > 0.) {
+		w1 = MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W0(sh)
+		    else
+			aux = W1(sh)
+		    if (aux < w1)
+			w1 = aux
+		}
+	    } else {
+		w1 = -MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W1(sh)
+		    else
+			aux = W0(sh)
+		    if (aux > w1)
+			w1 = aux
+		}
+	    }
+	}
+
+	# Ending wavelength
+	if (IS_INDEFD (w2)) {
+	    if (IS_INDEFD (dw) || dw > 0.) {
+		w2 = -MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W1(sh)
+		    else
+			aux = W0(sh)
+		    if (aux > w2)
+			w2 = aux
+		}
+	    } else {
+		w2 = MAX_REAL
+		do i = 1, ns {
+		    sh = shdr[i]
+		    if (WP(sh) > 0.)
+			aux = W0(sh)
+		    else
+			aux = W1(sh)
+		    if (aux < w2)
+			w2 = aux
+		}
+	    }
+	}
+
+	# Wavelength increment
+	if (IS_INDEFD (dw)) {
+	    dw = MAX_REAL
+	    do i = 1, ns {
+		aux = abs (WP(shdr[i]))
+		if (aux < dw)
+		    dw = aux
+	    }
+	}
+	if ((w2 - w1) / dw < 0.)
+	    dw = -dw
+
+	# Spectrum length
+	if (IS_INDEFI (nw))
+	    nw = int ((w2 - w1) / dw + 0.5) + 1
+
+	# Adjust the values.
+	if (IS_INDEFD (dwa))
+	    dw = (w2 - w1) / (nw - 1)
+	else if (IS_INDEFD (w2a))
+	    w2 = w1 + (nw - 1) * dw
+	else if (IS_INDEFD (w1a))
+	    w1 = w2 - (nw - 1) * dw
+	else {
+	    nw = int ((w2 - w1) / dw + 0.5) + 1
+	    w2 = w1 + (nw - 1) * dw
+	}
+end
diff --git a/noao/onedspec/scombine/x_scombine.x b/noao/onedspec/scombine/x_scombine.x
new file mode 100644
index 00000000..33943271
--- /dev/null
+++ b/noao/onedspec/scombine/x_scombine.x
@@ -0,0 +1 @@
+task	scombine = t_scombine
diff --git a/noao/onedspec/scoords.par b/noao/onedspec/scoords.par
new file mode 100644
index 00000000..320d4d54
--- /dev/null
+++ b/noao/onedspec/scoords.par
@@ -0,0 +1,5 @@
+images,f,a,,,,List of spectrum image names
+coords,f,a,,,,List of coordinate file names
+label,s,h,"",,,Coordinate axis label
+units,s,h,"",,,Coordinate axis units
+verbose,b,h,yes,,,Verbose output?
diff --git a/noao/onedspec/scopy.cl b/noao/onedspec/scopy.cl
new file mode 100644
index 00000000..5ac09c94
--- /dev/null
+++ b/noao/onedspec/scopy.cl
@@ -0,0 +1,30 @@
+# SCOPY -- Copy spectra
+
+procedure scopy (input, output)
+
+string	input			{prompt="List of input spectra"}
+string	output			{prompt="List of output spectra"}
+
+real	w1 = INDEF		{prompt="Starting wavelength"}
+real	w2 = INDEF		{prompt="Ending wavelength"}
+string	apertures = ""		{prompt="List of apertures or columns/lines"}
+string	bands = ""		{prompt="List of bands or lines/bands"}
+string	beams = ""		{prompt="List of beams or echelle orders"}
+int	apmodulus = 0		{prompt="Input aperture modulus (0=none)\n"}
+
+string	format = "multispec"	{prompt="Output spectra format",
+				 enum="multispec|onedspec"}
+bool	renumber = no		{prompt="Renumber output apertures?"}
+int	offset = 0		{prompt="Output aperture number offset"}
+bool	clobber = no		{prompt="Modify existing output images?"}
+bool	merge = no		{prompt="Merge with existing output images?"}
+bool	rebin = yes		{prompt="Rebin to exact wavelength region?"}
+bool	verbose = no		{prompt="Print operations?"}
+
+begin
+	sarith (input, "copy", "", output, w1=w1, w2=w2, apertures=apertures,
+	    bands=bands, beams=beams, apmodulus=apmodulus, reverse=no,
+	    ignoreaps=no, format=format, renumber=renumber, offset=offset,
+	    clobber=clobber, merge=merge, rebin=rebin, errval=0.,
+	    verbose=verbose)
+end
diff --git a/noao/onedspec/scopy.par b/noao/onedspec/scopy.par
new file mode 100644
index 00000000..6caffa44
--- /dev/null
+++ b/noao/onedspec/scopy.par
@@ -0,0 +1,17 @@
+input,s,a,,,,"List of input spectra"
+output,s,a,,,,"List of output spectra"
+w1,r,h,INDEF,,,"Starting wavelength"
+w2,r,h,INDEF,,,"Ending wavelength"
+apertures,s,h,"",,,"List of input apertures or columns/lines"
+bands,s,h,"",,,"List of input bands or lines/bands"
+beams,s,h,"",,,"List of beams or echelle orders"
+apmodulus,i,h,0,,,"Input aperture modulus (0=none)
+"
+format,s,h,"multispec",multispec|onedspec,,"Output spectra format"
+renumber,b,h,no,,,"Renumber output apertures?"
+offset,i,h,0,,,"Output aperture number offset"
+clobber,b,h,no,,,"Modify existing output images?"
+merge,b,h,no,,,"Merge with existing output images?"
+rebin,b,h,yes,,,"Rebin to exact wavelength region?"
+verbose,b,h,no,,,"Print operations?"
+mode,s,h,"ql",,,
diff --git a/noao/onedspec/sensfunc.par b/noao/onedspec/sensfunc.par
new file mode 100644
index 00000000..6ff6930c
--- /dev/null
+++ b/noao/onedspec/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,no,,,Ignore apertures and make one sensitivity function?
+logfile,f,h,"logfile",,,Output log for statistics information
+extinction,f,h,,,,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/onedspec/sensfunc/mkpkg b/noao/onedspec/sensfunc/mkpkg
new file mode 100644
index 00000000..4fdd11c0
--- /dev/null
+++ b/noao/onedspec/sensfunc/mkpkg
@@ -0,0 +1,38 @@
+# SENSFUNC
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	sfadd.x		sensfunc.h <gset.h>
+	sfapertures.x	sensfunc.h
+	sfcgraph.x	sensfunc.h <gset.h>
+	sfcolon.x	sensfunc.h <error.h> <gset.h>
+	sfcolors.x	sensfunc.h <gset.h>
+	sfcomposite.x	sensfunc.h
+	sfdata.x	sensfunc.h
+	sfdelete.x	sensfunc.h <gset.h>
+	sfeout.x	<ctype.h> <error.h> <mach.h> <math/curfit.h>
+	sfextinct.x	sensfunc.h <pkg/gtools.h>
+	sffit.x		sensfunc.h <math/curfit.h>
+	sfginit.x	sensfunc.h <gset.h>
+	sfgraph.x	sensfunc.h <error.h> <gset.h> <math/curfit.h>
+	sfimage.x	sensfunc.h <smw.h> <gset.h> <math/curfit.h>
+	sfmarks.x	sensfunc.h <gset.h>
+	sfmove.x	sensfunc.h <gset.h>
+	sfnearest.x	sensfunc.h <gset.h> <mach.h>
+	sfoutput.x	sensfunc.h <imhdr.h> <mach.h>
+	sfreset.x	sensfunc.h
+	sfrms.x		sensfunc.h
+	sfsensfunc.x	sensfunc.h <error.h> <gset.h> <mach.h>
+	sfshift.x	sensfunc.h
+	sfstats.x	sensfunc.h
+	sfstds.x	sensfunc.h
+	sftitle.x	sensfunc.h
+	sfundelete.x	sensfunc.h <gset.h>
+	sfvstats.x	sensfunc.h
+	sfweights.x	sensfunc.h
+	t_sensfunc.x	sensfunc.h
+	;
diff --git a/noao/onedspec/sensfunc/sensfunc.h b/noao/onedspec/sensfunc/sensfunc.h
new file mode 100644
index 00000000..9e3afb77
--- /dev/null
+++ b/noao/onedspec/sensfunc/sensfunc.h
@@ -0,0 +1,64 @@
+# SENSFUNC definitions.
+
+define	SF_NGRAPHS	4		# Number of graphs per frame
+define	SF_INCLUDE	1		# Include observation
+define	SF_EXCLUDE	2		# Exclude observation
+define	SF_DELETE	3		# Delete observation
+
+# SENSFUNC Standard Star Data Structure.
+
+define	SZ_STDIMAGE	63		# Length of standard image name
+define	SZ_STDTITLE	63		# Length of standard title
+
+define	LEN_STD		115		# Length of standard obs. structure
+
+define	STD_IMAGE	Memc[P2C($1)]	# Standard image name
+define	STD_SKY		Memc[P2C($1+32)] # Standard image sky
+define	STD_TITLE	Memc[P2C($1+64)] # Standard title
+define	STD_FLAG	Memi[$1+96]	# Flag
+define	STD_BEAM	Memi[$1+97]	# Beam number of spectrum
+define	STD_NPTS	Memi[$1+98]	# Number of points in spectrum
+define	STD_EXPTIME	Memr[P2R($1+99)]  # Exposure time
+define	STD_AIRMASS	Memr[P2R($1+100)] # Airmass of spectrum
+define	STD_WSTART	Memr[P2R($1+101)] # Starting wavelength of spectrum
+define	STD_WEND	Memr[P2R($1+102)] # Ending wavelength of spectrum
+define	STD_SHIFT	Memr[P2R($1+103)] # Added shift
+define	STD_NWAVES	Memi[$1+104]	# Number of calibration wavelengths
+define	STD_WAVES	Memi[$1+105]	# Pointer to wavelengths
+define	STD_FLUXES	Memi[$1+106]	# Pointer to standard flux values
+define	STD_DWAVES	Memi[$1+107]	# Pointer to flux bandwidths
+define	STD_COUNTS	Memi[$1+108]	# Pointer to counts
+define	STD_SENS	Memi[$1+109]	# Pointer to sensitivities
+define	STD_FIT		Memi[$1+110]	# Pointer to fitted sensitivities
+define	STD_WTS		Memi[$1+111]	# Pointer to weights
+define	STD_IWTS	Memi[$1+112]	# Pointer to weights
+define	STD_X		Memi[$1+114]	# Pointer to plotted x values
+define	STD_Y		Memi[$1+115]	# Pointer to plotted y values
+
+# Graphics structure
+
+define	GP_SZTITLE	79			# Size of title string
+
+define	LEN_GP		75			# Length of structure
+
+define	GP_GIO		Memi[$1]		# GIO pointer
+define	GP_TITLE	Memc[P2C($1+1)]		# General title
+define	GP_GRAPHS	Memc[P2C($1+41)+$2-1]	# Graphs
+define	GP_IMAGES	Memi[$1+44+$2-1]	# Pointer to image names
+define	GP_SKYS		Memi[$1+48+$2-1]	# Pointer to sky names
+define	GP_MARK		Memi[$1+52]		# Mark type
+define	GP_SZMARK	Memr[P2R($1+53)]	# Mark size
+define	GP_CMARK	Memi[$1+54]		# Mark color
+define	GP_MDEL		Memi[$1+55]		# Deleted mark
+define	GP_SZMDEL	Memr[P2R($1+56)]	# Size of deleted mark
+define	GP_CDEL		Memi[$1+57]		# Color of deleted mark
+define	GP_MADD		Memi[$1+58]		# Mark type
+define	GP_CADD		Memi[$1+59]		# Mark color
+define	GP_PLCOLOR	Memi[$1+60]		# Line color
+define  GP_WSTART       Memr[P2R($1+61)]        # Starting wavelength for plots
+define  GP_WEND         Memr[P2R($1+62)]        # Ending wavelength for plots
+define	GP_LOG		Memi[$1+63]		# Log flux plots?
+define	GP_FMIN		Memr[P2R($1+64)]	# Minimum flux plot limit
+define	GP_FMAX		Memr[P2R($1+65)]	# Maximum flux plot limit
+define	GP_SHDR		Memi[$1+65+$2]		# SHDR pointer
+define	GP_AIRMASS	Memr[P2R($1+69+$2)]	# Airmass range of plots
diff --git a/noao/onedspec/sensfunc/sensfunc.key b/noao/onedspec/sensfunc/sensfunc.key
new file mode 100644
index 00000000..5f09739f
--- /dev/null
+++ b/noao/onedspec/sensfunc/sensfunc.key
@@ -0,0 +1,81 @@
+		SENSFUNC: Determine Sensitivity Function
+
+SUMMARY:
+
+? Help            a Add data         c Composite data      d Delete data
+e Extinction      f Fit (overplot)   g Fit (redraw)        i Info 
+m Move data       o Original data    q Quit                r Redraw
+s Shift data      u Undelete data    w Change weights      I Interrupt
+
+:function [type]    :graphs [types]     :images [images]   :marks [types]
+:order [value]      :skys [images]      :stats [file]      :vstats [file]
+:colors [colors]
+
+Graph types: a=(resid,airmass), c=(composite,lambda), e=(extinction,lambda)
+	     i=(Fluxed image,lambda), l=(Log of fluxed image, lambda),
+	     r=(resid, lambda), s=(Sensitivity,lambda)
+
+
+CURSOR KEYS:
+
+?	Print help
+a	Add a point at the cursor position
+c	Toggle composite points
+d	Delete point, star, or wavelength nearest the cursor
+e	Toggle residual extinction correction
+f	Fit data with a sensitivity function and overplot the fit
+g	Fit data with a sensitivity function and redraw the graphs
+i	Print information about point nearest the cursor
+m	Move point, star, wavelength nearest the cursor to new sensitivity
+o	Reset to original data
+q	Quit and write sensitivity function for current aperture
+r	Redraw graph(s)
+s	Toggle shift of standard stars to eliminate mean deviations
+u	Undelete point, star, or wavelength nearest the cursor
+w	Change weights of point, star, or wavelength nearest the cursor
+I	Interrupt task immediately
+
+
+COLON COMMANDS AND ARGUMENTS:
+
+:flux [min] [max]  Limits for flux calibrated graphs (INDEF for autoscale)
+:function [type]   Function to be fit to sensitivity data.  The types are:
+			chebyshev - Chebyshev polynomial
+			legendre  - Legendre polynomial
+			spline1   - Linear spline
+			spline3   - Cubic spline
+:graphs [types]    Graphs to be displayed (up to four).  The types are:
+			a - Residual sensitivity vs airmass
+			c - Composite residuals and error bars vs wavelength
+			e - Extinction (and revised extinction) vs wavelength
+			i - Flux calibrated image vs wavelength
+			l - Log of flux calibrated image vs wavelength
+			r - Residual sensitivity vs wavelength
+			s - Sensitivity vs wavelength
+:images [images]   Images to flux calibrate and plot (up to four images)
+:colors [colors]   Line and mark colors to use for line and included, deleted,
+			and added points.  The colors are specified as four
+			whitespace separated integers between 1 and 9.
+:marks [marks]     Mark types to use for included, deleted, and added points:
+			point, box, plus, cross, diamond, hline, vline,
+			hebar, vebar, circle
+:order [order]     Order of function (polynomial terms or spline pieces)
+:skys [images]     Sky images for flux calibration (optional, up to four images)
+:stats [file]      Statistics about standard stars and sensitivity fit
+:vstats [file]     Verbose statistics about standard stars and sensitivity fit
+
+
+EXAMPLES:
+
+:func spline3		Select cubic spline function
+:g srae			Graph sensitivity, residuals, airmass, and extinction
+:g sii			Graph sensitivity and two images
+:i n1.0004 n1.0008	Set first two images to graph (the defaults are
+			    taken from the standard star list)
+:skys n1.0005		Subtract this sky image from first image for calibration
+:colors 2		Change only the line color to 2
+:colors	2 5 4 3		Change the line and mark colors
+:m plus			Change the mark type for included points and don't
+			    change the deleted or added point mark type
+:stats			Print statistics to terminal
+:vstats stdstats	Print verbose statistics to file
diff --git a/noao/onedspec/sensfunc/sfadd.x b/noao/onedspec/sensfunc/sfadd.x
new file mode 100644
index 00000000..c77694d7
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfadd.x
@@ -0,0 +1,105 @@
+include	<gset.h>
+include	"sensfunc.h"
+
+# SF_ADD -- Add a point to the added point observation structure.
+# The added star is the next to last of the standard stars.
+
+procedure sf_add (gp, stds, nstds, cv, wx, wy, wc)
+
+pointer	gp			# Graphics structure
+pointer	stds[nstds]		# Standard star structures
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity function curve
+real	wx			# Cursor X value
+real	wy			# Cursor Y value
+int	wc			# Cursor WCS
+
+int	nwaves
+real	wave, sen, fit, cveval()
+pointer	std, waves, sens, fits, wts, iwts, x, y
+errchk	malloc, realloc
+
+begin
+	# Convert from particular WCS to wavelength and sensitivity.  In
+	# order to add a point the graph must be either sensitivity or
+	# residual verses wavelength.  If not then return without adding
+	# a point.
+
+	switch (GP_GRAPHS(gp,wc)) {
+	case 's':
+	    wave = wx
+	    fit = cveval (cv, wx)
+	    sen = wy
+	case 'r':
+	    wave = wx
+	    fit = cveval (cv, wx)
+	    sen = wy + fit
+	default:
+	    return
+	}
+
+	# Add the point to the next to last standard star.  Allocate
+	# or reallocate memory as needed.  Turn the added star on by
+	# setting INCLUDE flag.
+
+	std = stds[nstds-1]
+	nwaves = STD_NWAVES(std) + 1
+	waves = STD_WAVES(std)
+	if (waves == NULL) {
+	    call malloc (waves, nwaves, TY_REAL)
+	    call malloc (sens, nwaves, TY_REAL)
+	    call malloc (fits, nwaves, TY_REAL)
+	    call malloc (wts, nwaves, TY_REAL)
+	    call malloc (iwts, nwaves, TY_REAL)
+	    call malloc (x, nwaves, TY_REAL)
+	    call malloc (y, nwaves, TY_REAL)
+	} else {
+	    sens = STD_SENS(std)
+	    fits = STD_FIT(std)
+	    wts = STD_WTS(std)
+	    iwts = STD_IWTS(std)
+	    x = STD_X(std)
+	    y = STD_Y(std)
+	    call realloc (waves, nwaves, TY_REAL)
+	    call realloc (sens, nwaves, TY_REAL)
+	    call realloc (fits, nwaves, TY_REAL)
+	    call realloc (wts, nwaves, TY_REAL)
+	    call realloc (iwts, nwaves, TY_REAL)
+	    call realloc (x, nwaves, TY_REAL)
+	    call realloc (y, nwaves, TY_REAL)
+	}
+	STD_FLAG(std) = SF_INCLUDE
+	STD_NWAVES(std) = nwaves
+	STD_WAVES(std) = waves
+	STD_SENS(std) = sens
+	STD_FIT(std) = fits
+	STD_WTS(std) = wts
+	STD_IWTS(std) = iwts
+	STD_X(std) = x
+	STD_Y(std) = y
+
+	Memr[waves+nwaves-1] = wave
+	Memr[sens+nwaves-1] = sen
+	Memr[fits+nwaves-1] = fit
+	Memr[wts+nwaves-1] = 1
+	Memr[iwts+nwaves-1] = 1
+
+	# Mark the added point on all graphs.
+	for (wc = 1; GP_GRAPHS(gp,wc) != EOS; wc=wc+1) {
+	    call gseti (GP_GIO(gp), G_WCS, wc)
+	    call gseti (GP_GIO(gp), G_PLCOLOR, GP_CADD(gp))
+	    switch (GP_GRAPHS(gp,wc)) {
+	    case 's':
+ 		call gmark (GP_GIO(gp), wave, sen, GP_MADD(gp), GP_SZMARK(gp),
+		    GP_SZMARK(gp))
+	    case 'r':
+		wy = sen - cveval (cv, wave)
+ 		call gmark (GP_GIO(gp), wave, wy, GP_MADD(gp), GP_SZMARK(gp),
+		    GP_SZMARK(gp))
+	    case 'a':
+		wy = sen - cveval (cv, wave)
+ 		call gmark (GP_GIO(gp), STD_AIRMASS(std), wy, GP_MADD(gp),
+		    GP_SZMARK(gp), GP_SZMARK(gp))
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfapertures.x b/noao/onedspec/sensfunc/sfapertures.x
new file mode 100644
index 00000000..7eb2b6f8
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfapertures.x
@@ -0,0 +1,27 @@
+include "sensfunc.h"
+
+# SF_APERTURES -- Determine the apertures in use.
+
+procedure sf_apertures (stds, nstds, apertures, napertures)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+pointer	apertures		# Pointer to apertures (returned)
+int	napertures		# Number of apertures (returned)
+
+int	i, j, aperture
+
+errchk	malloc, realloc
+
+begin
+	call malloc (apertures, nstds, TY_INT)
+	napertures = 0
+	do i = 1, nstds {
+	    aperture = STD_BEAM(stds[i])
+	    for (j=1; (j<=napertures)&&(aperture!=Memi[apertures+j-1]); j=j+1)
+		;
+	    napertures = max (napertures, j)
+	    Memi[apertures+j-1] = aperture
+	}
+	call realloc (apertures, napertures, TY_INT)
+end
diff --git a/noao/onedspec/sensfunc/sfcgraph.x b/noao/onedspec/sensfunc/sfcgraph.x
new file mode 100644
index 00000000..2f689d47
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfcgraph.x
@@ -0,0 +1,104 @@
+include	<gset.h>
+include	"sensfunc.h"
+
+# SF_CGRAPH -- Graph of composite points and errors
+
+procedure sf_cgraph (gp, stds, nstds, cv)
+
+pointer	gp		# Graphics structure
+pointer	stds[nstds]	# Standard star data
+int	nstds		# Number of standard stars
+pointer	cv		# Sensitivity function curve
+
+int	i, j, n, nwaves
+real	w, s, ymin, ymax, cveval()
+double	sum, sum2
+pointer	sp, waves, sens, errors, xp, yp, zp, gio
+
+begin
+	nwaves = 0
+	do i = 1, nstds-2
+	    if (STD_FLAG(stds[i]) != SF_EXCLUDE)
+	        nwaves = nwaves + STD_NWAVES(stds[i])
+
+	call smark (sp)
+	call salloc (waves, nwaves, TY_REAL)
+	call salloc (sens, nwaves, TY_REAL)
+	call salloc (errors, nwaves, TY_REAL)
+	    
+	nwaves = 0
+	do i = 1, nstds-2 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    xp = STD_WAVES(stds[i])
+	    yp = STD_SENS(stds[i])
+	    zp = STD_WTS(stds[i])
+	    do j = 1, n {
+		if (Memr[zp] != 0.) {
+		    Memr[waves+nwaves] = Memr[xp]
+		    Memr[sens+nwaves] = Memr[yp]
+		    nwaves = nwaves + 1
+		}
+		xp = xp + 1
+		yp = yp + 1
+		zp = zp + 1
+	    }
+	}
+	call xt_sort2 (Memr[waves], Memr[sens], nwaves)
+
+	n = 0
+	sum = 0.
+	sum2 = 0.
+	ymin = 0.
+	ymax = 0.
+	j = 0
+	do i = 1, nwaves {
+	    w = Memr[waves+i-1]
+	    s = Memr[sens+i-1]
+	    n = n + 1
+	    sum = sum + s
+	    sum2 = sum2 + s * s
+
+	    if ((i < nwaves) && (w == Memr[waves+i]))
+		next
+
+	    if (n > 2) {
+	        sum = sum / n
+	        sum2 = sum2 / n - sum * sum
+	        if (sum2 > 0)
+	            sum2 = sqrt (sum2 / n)
+	        else
+		    sum2 = 0.
+	        sum = sum - cveval (cv, w)
+
+		Memr[waves+j] = w
+		Memr[sens+j] = sum
+		Memr[errors+j] = sum2
+		j = j + 1
+
+		if (sum + sum2 > ymax)
+		    ymax = sum + sum2
+		if (sum - sum2 < ymin)
+		    ymin = sum - sum2
+	    }
+	    n = 0
+	    sum = 0.
+	    sum2 = 0.
+	}
+	nwaves = j
+
+	if (j == 0) {
+	    call printf ("No wavelength overlap for composite points")
+	} else {
+	    gio = GP_GIO(gp)
+	    call gswind (gio, GP_WSTART(gp), GP_WEND(gp), ymin, ymax)
+	    call glabax (gio, "Composite Points vs Wavelength", "", "")
+	    call gseti (gio, G_PLCOLOR, GP_CMARK(gp))
+	    do i = 0, nwaves-1
+	        call gmark (gio, Memr[waves+i], Memr[sens+i], GM_VEBAR,
+		    1., -Memr[errors+i])
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sfcolon.x b/noao/onedspec/sensfunc/sfcolon.x
new file mode 100644
index 00000000..43a056e7
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfcolon.x
@@ -0,0 +1,193 @@
+include	<error.h>
+include	<gset.h>
+include	"sensfunc.h"
+
+# SENSFUNC colon commands
+define	CMDS	"|stats|vstats|function|order|graphs|images|skys|marks\
+		 |fluxlimits|colors|"
+define	STATS		1	# Show results
+define	VSTATS		2	# Show verbose results
+define	FUNCTION	3	# Sensitivity function type
+define	ORDER		4	# Function order
+define	GRAPHS		5	# Select graphs
+define	IMAGES		6	# Select images
+define	SKYS		7	# Select skys
+define	MARKS		8	# Set graph mark types
+define	FLIMITS		9	# Flux graph limits
+define	COLORS		10	# Flux graph limits
+
+# SF_COLON -- Process SENSFUNC colon commands.
+# This procedure has so many arguments because of the STATS option.
+
+procedure sf_colon (cmd, gp, stds, nstds, cv, wextn, extn, nextn, ecv, function,
+    order, npts, rms, newfit, newgraph)
+
+char	cmd[ARB]		# Colon command
+pointer	gp			# Graphics structure
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity function curve
+real	wextn[nextn]		# Extinction table wavelengths
+real	extn[nextn]		# Extinction table values
+int	nextn			# Number of extinction table values
+pointer	ecv			# Residual extinction curve
+char	function[ARB]		# Function type
+int	order			# Function order
+int	npts			# Number of points in fit
+real	rms			# RMS in fit
+int	newfit			# New function?
+int	newgraph		# New graphs?
+
+int	i, j, ncmd, ival, fd, nscan(), strdic(), open(), stridx()
+real	rval1, rval2
+bool	streq()
+pointer	sp, str
+errchk	open
+
+begin
+	# Match the command against a dictionary.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sscan (cmd)
+	call gargwrd (Memc[str], SZ_LINE)
+	ncmd = strdic (Memc[str], Memc[str], SZ_LINE, CMDS)
+
+	# Switch on the command.
+	switch (ncmd) {
+	case STATS:
+	    call gargwrd (Memc[str], SZ_LINE)
+	    iferr {
+		# If no argument write to STDOUT otherwise append to file.
+	        if (nscan() == 1) {
+		    call gdeactivate (GP_GIO(gp), AW_CLEAR)
+		    call sf_stats (STDOUT, stds, nstds, function, order, npts,
+			rms)
+		    call greactivate (GP_GIO(gp), AW_PAUSE)
+	        } else {
+		    fd = open (Memc[str], APPEND, TEXT_FILE)
+		    call sf_stats (fd, stds, nstds, function, order, npts, rms)
+		    call close (fd)
+	        }
+	    } then
+		call erract (EA_WARN)
+	case VSTATS:
+	    call gargwrd (Memc[str], SZ_LINE)
+	    iferr {
+	        if (nscan() == 1) {
+		    # If no argument page on STDOUT otherwise append to file.
+		    # A temp file is used in order to page output.
+
+		    call mktemp ("tmp$sf", Memc[str], SZ_LINE)
+		    fd = open (Memc[str], NEW_FILE, TEXT_FILE)
+		    call sf_stats (fd, stds, nstds, function, order, npts, rms)
+		    call sf_vstats (fd, stds, nstds, cv, wextn, extn, nextn,
+			ecv)
+		    call close (fd)
+		    call gpagefile (GP_GIO(gp), Memc[str], "sensfunc")
+		    call delete (Memc[str])
+	        } else {
+		    fd = open (Memc[str], APPEND, TEXT_FILE)
+		    call sf_stats (fd, stds, nstds, function, order, npts, rms)
+		    call sf_vstats (fd, stds, nstds, cv, wextn, extn, nextn,
+			ecv)
+		    call close (fd)
+		}
+	    } then
+		call erract (EA_WARN)
+	case FUNCTION:
+	    call gargwrd (Memc[str], SZ_LINE)
+	    if (nscan() == 2) {
+	        call strcpy (Memc[str], function, SZ_FNAME)
+		newfit = NO
+	    } else {
+		call printf ("function %s")
+		    call pargstr (function)
+	    }
+	case ORDER:
+	    call gargi (ival)
+	    if (nscan() == 2) {
+		order = ival
+		newfit = NO
+	    } else {
+		call printf ("order %d")
+		    call pargi (order)
+	    }
+	case GRAPHS:
+	    call gargstr (Memc[str], SZ_LINE)
+	    j = str
+	    for (i=str; Memc[i] != EOS; i=i+1) {
+		switch (Memc[i]) {
+		case 'a','c','e','i','l','r','s':
+		    Memc[j] = Memc[i]
+		    j = j + 1
+		}
+	    }
+	    Memc[j] = EOS
+	    if (Memc[str] != EOS) {
+		call strcpy (Memc[str], GP_GRAPHS(gp,1), SF_NGRAPHS)
+		newgraph = YES
+	    } else {
+		call printf ("graphs %s")
+		    call pargstr (GP_GRAPHS(gp,1))
+	    }
+	case IMAGES:
+	    # Note that changing the image automatically clears the sky.
+	    do i = 1, SF_NGRAPHS {
+	        call gargwrd (Memc[str], SZ_LINE)
+		if (nscan() == i + 1) {
+		    call strcpy (Memc[str], Memc[GP_IMAGES(gp,i)], SZ_FNAME)
+		    Memc[GP_SKYS(gp,i)] = EOS
+		    do j = 1, nstds
+	    		if (streq (Memc[str], STD_IMAGE(stds[j])))
+			    call strcpy (STD_SKY(stds[j]), Memc[GP_SKYS(gp,i)],
+				SZ_FNAME)
+		} else
+		    break
+	    }
+	    if (nscan() == 1) {
+	        call printf ("images %s %s %s %s")
+		    call pargstr (Memc[GP_IMAGES(gp,1)])
+		    call pargstr (Memc[GP_IMAGES(gp,2)])
+		    call pargstr (Memc[GP_IMAGES(gp,3)])
+		    call pargstr (Memc[GP_IMAGES(gp,4)])
+	    }
+	case SKYS:
+	    do i = 1, SF_NGRAPHS {
+	        call gargwrd (Memc[str], SZ_LINE)
+		if (nscan() == i + 1)
+		    call strcpy (Memc[str], Memc[GP_SKYS(gp,i)], SZ_FNAME)
+		else
+		    break
+	    }
+	    if (nscan() == 1) {
+	        call printf ("skys %s %s %s %s")
+		    call pargstr (Memc[GP_SKYS(gp,1)])
+		    call pargstr (Memc[GP_SKYS(gp,2)])
+		    call pargstr (Memc[GP_SKYS(gp,3)])
+		    call pargstr (Memc[GP_SKYS(gp,4)])
+	    }
+	case MARKS:
+	    call gargstr (Memc[str], SZ_LINE)
+	    call sf_marks (gp, Memc[str])
+	case FLIMITS:
+	    call gargr (rval1)
+	    call gargr (rval2)
+	    if (nscan() == 3) {
+		GP_FMIN(gp) = rval1
+		GP_FMAX(gp) = rval2
+		if (stridx (GP_GRAPHS(gp,1), "il") != 0)
+		    newgraph = YES
+	    } else {
+		call printf ("fluxlimits %g %g")
+		    call pargr (GP_FMIN(gp))
+		    call pargr (GP_FMAX(gp))
+	    }
+	case COLORS:
+	    call gargstr (Memc[str], SZ_LINE)
+	    call sf_colors (gp, Memc[str])
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sfcolors.x b/noao/onedspec/sensfunc/sfcolors.x
new file mode 100644
index 00000000..db3f69af
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfcolors.x
@@ -0,0 +1,28 @@
+include	<gset.h>
+include	"sensfunc.h"
+
+
+# SF_COLORS -- Set colors.
+
+procedure sf_colors (gp, colors)
+
+pointer	gp
+char	colors[ARB]
+
+int	i, nscan()
+
+begin
+	call sscan (colors)
+	call gargi (i)
+	if (nscan() == 1)
+	    GP_PLCOLOR(gp) = i
+	call gargi (i)
+	if (nscan() == 2)
+	    GP_CMARK(gp) = i
+	call gargi (i)
+	if (nscan() == 3)
+	    GP_CDEL(gp) = i
+	call gargi (i)
+	if (nscan() == 4)
+	    GP_CADD(gp) = i
+end
diff --git a/noao/onedspec/sensfunc/sfcomposite.x b/noao/onedspec/sensfunc/sfcomposite.x
new file mode 100644
index 00000000..506416e3
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfcomposite.x
@@ -0,0 +1,147 @@
+include	"sensfunc.h"
+
+# SF_COMPOSITE -- Create a composite standard structure.
+# The composite star is the last of the standard stars.
+# When the composite star is created the other stars are turned off.
+# The function toggles.
+
+procedure sf_composite (stds, nstds, cv)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity pointer
+
+int	i, j, k, n, nwaves
+pointer	std, waves, sens, fit, wts, iwts, x, y, z
+errchk	malloc, realloc, xt_sort3
+
+begin
+	# If data is already composite toggle back to original data.
+	# Delete data points if composite point is deleted.
+	std = stds[nstds]
+	if (STD_FLAG(std) == SF_INCLUDE) {
+            do i = 1, nstds - 2 {
+	        if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		    next
+	        STD_FLAG(stds[i]) = SF_INCLUDE
+	    }
+	    STD_FLAG(std) = SF_EXCLUDE
+
+	    n = STD_NWAVES(std)
+	    x = STD_WAVES(std)
+	    z = STD_WTS(std)
+	    do i = 1, n {
+		if (Memr[z] == 0.) {
+		    do j = 1, nstds - 2 {
+		        if (STD_FLAG(stds[j]) == SF_EXCLUDE)
+			    next
+		        nwaves = STD_NWAVES(stds[j])
+			waves = STD_WAVES(stds[j])
+		        wts = STD_WTS(stds[j])
+			do k = 1, nwaves {
+			    if (Memr[waves] == Memr[x])
+		                Memr[wts] = 0.
+			    waves = waves + 1
+			    wts = wts + 1
+			}
+		    }
+		}
+		x = x + 1
+		z = z + 1
+	    }
+	    call printf ("Individual star data")
+	    return
+	}
+
+	# Initialize
+	if (STD_WAVES(std) != NULL) {
+	    call mfree (STD_WAVES(std), TY_REAL)
+	    call mfree (STD_SENS(std), TY_REAL)
+	    call mfree (STD_WTS(std), TY_REAL)
+	    call mfree (STD_IWTS(std), TY_REAL)
+	    call mfree (STD_X(std), TY_REAL)
+	    call mfree (STD_Y(std), TY_REAL)
+	}
+
+	# To bin the data we collect all the data and then sort by wavelength.
+	nwaves = 0
+	do i = 1, nstds - 2
+	    if (STD_FLAG(stds[i]) == SF_INCLUDE)
+	        nwaves = nwaves + STD_NWAVES(stds[i])
+
+	call malloc (waves, nwaves, TY_REAL)
+	call malloc (sens, nwaves, TY_REAL)
+	call malloc (wts, nwaves, TY_REAL)
+	    
+	nwaves = 0
+	do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    x = STD_WAVES(stds[i])
+	    y = STD_SENS(stds[i])
+	    z = STD_WTS(stds[i])
+	    do j = 1, n {
+		if (Memr[z] != 0.) {
+		    Memr[waves+nwaves] = Memr[x]
+		    Memr[sens+nwaves] = Memr[y]
+		    Memr[wts+nwaves] = Memr[z]
+		    nwaves = nwaves + 1
+		}
+		x = x + 1
+		y = y + 1
+		z = z + 1
+	    }
+	    STD_FLAG(stds[i]) = SF_DELETE
+	    STD_BEAM(std) = STD_BEAM(stds[i])
+	    STD_WSTART(std) = STD_WSTART(stds[i])
+	    STD_WEND(std) = STD_WEND(stds[i])
+	}
+#	STD_NWAVES(stds[nstds-1]) = 0
+
+	call xt_sort3 (Memr[waves], Memr[sens], Memr[wts], nwaves)
+
+	# Go through the wavelength sorted data and composite all points
+	# with the same wavelength.
+
+	n = 0
+	Memr[sens] = Memr[wts] * Memr[sens]
+	do i = 1, nwaves-1 {
+	    if (Memr[waves+i] == Memr[waves+n]) {
+		Memr[sens+n] = Memr[sens+n] + Memr[wts+i] * Memr[sens+i]
+		Memr[wts+n] = Memr[wts+n] + Memr[wts+i]
+	    } else {
+		n = n + 1
+		Memr[waves+n] = Memr[waves+i]
+		Memr[sens+n] = Memr[wts+i] * Memr[sens+i]
+		Memr[wts+n] = Memr[wts+i]
+	    }
+	}
+
+	nwaves = n + 1
+	do i = 0, nwaves-1
+	    Memr[sens+i] = Memr[sens+i] / Memr[wts+i]
+
+	# Store the composite data in the standard star structure.
+	call realloc (waves, nwaves, TY_REAL)
+	call realloc (sens, nwaves, TY_REAL)
+	call realloc (wts, nwaves, TY_REAL)
+	call malloc (iwts, nwaves, TY_REAL)
+	call malloc (fit, nwaves, TY_REAL)
+	call malloc (x, nwaves, TY_REAL)
+	call malloc (y, nwaves, TY_REAL)
+	call amovr (Memr[wts], Memr[iwts], nwaves)
+	call cvvector (cv, Memr[waves], Memr[fit], nwaves)
+
+	STD_FLAG(std) = SF_INCLUDE
+	STD_NWAVES(std) = nwaves
+	STD_WAVES(std) = waves
+	STD_SENS(std) = sens
+	STD_FIT(std) = fit
+	STD_WTS(std) = wts
+	STD_IWTS(std) = iwts
+	STD_X(std) = x
+	STD_Y(std) = y
+
+	call printf ("Composite star data")
+end
diff --git a/noao/onedspec/sensfunc/sfdata.x b/noao/onedspec/sensfunc/sfdata.x
new file mode 100644
index 00000000..94140049
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfdata.x
@@ -0,0 +1,59 @@
+include	"sensfunc.h"
+
+# SF_DATA -- Compute the X and Y values for the particular graph.
+
+procedure sf_data (stds, nstds, graph)
+
+pointer	stds[nstds]		# Standard star structures
+int	nstds			# Number of standard stars
+char	graph			# Graph type
+
+real	a
+int	i, n
+pointer	wp, sp, fp, xp, yp
+
+begin
+	switch (graph) {
+	case 's':	# Sensitivity vs. Wavelength
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+		n = STD_NWAVES(stds[i])
+		a = STD_AIRMASS(stds[i])
+		wp = STD_WAVES(stds[i])
+		sp = STD_SENS(stds[i])
+		xp = STD_X(stds[i])
+		yp = STD_Y(stds[i])
+		call amovr (Memr[wp], Memr[xp], n)
+		call amovr (Memr[sp], Memr[yp], n)
+	    }
+	case 'a':	# Residuals vs. Airmass
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+		n = STD_NWAVES(stds[i])
+		a = STD_AIRMASS(stds[i])
+		wp = STD_WAVES(stds[i])
+		sp = STD_SENS(stds[i])
+		fp = STD_FIT(stds[i])
+		xp = STD_X(stds[i])
+		yp = STD_Y(stds[i])
+		call amovkr (a, Memr[xp], n)
+		call asubr (Memr[sp], Memr[fp], Memr[yp], n)
+	    }
+	case 'r':	# Residuals vs. Wavelength
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+		n = STD_NWAVES(stds[i])
+		a = STD_AIRMASS(stds[i])
+		wp = STD_WAVES(stds[i])
+		sp = STD_SENS(stds[i])
+		fp = STD_FIT(stds[i])
+		xp = STD_X(stds[i])
+		yp = STD_Y(stds[i])
+		call amovr (Memr[wp], Memr[xp], n)
+		call asubr (Memr[sp], Memr[fp], Memr[yp], n)
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfdelete.x b/noao/onedspec/sensfunc/sfdelete.x
new file mode 100644
index 00000000..ff2d267c
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfdelete.x
@@ -0,0 +1,127 @@
+include	<gset.h>
+include "sensfunc.h"
+
+# SF_DELETE -- Delete point, star, or wavelength identified by the
+# star index and index within the array of values.
+
+procedure sf_delete (gp, stds, nstds, key, istd, ipt)
+
+pointer	gp			# GIO pointer
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+int	key			# Delete point, star, or wavelength
+int	istd			# Index of standard star
+int	ipt			# Index of point
+
+int	i, j, n, wcs, mark, mdel, cdel, stridx()
+real	wave, szmark, szmdel
+pointer	x, y, z, w, gio
+
+begin
+	gio = GP_GIO(gp)
+	mdel = GP_MDEL(gp)
+	cdel = GP_CDEL(gp)
+	szmdel = GP_SZMDEL(gp)
+	szmark = GP_SZMARK(gp)
+
+	# Delete the point or points from each displayed graph.
+	# When deleting multiple points check if point already deleted.
+	for (wcs = 1; GP_GRAPHS(gp,wcs) != EOS; wcs = wcs + 1) {
+	    if (stridx (GP_GRAPHS(gp,wcs), "ars") == 0)
+	        next
+
+	    call gseti (gio, G_WCS, wcs)
+	    call sf_data (stds, nstds, GP_GRAPHS(gp,wcs))
+	    switch (key) {
+	    case 'p':
+		if (istd != nstds-1)
+		    mark = GP_MARK(gp)
+		else
+		    mark = GP_MADD(gp)
+	        x = STD_X(stds[istd])+ipt-1
+	        y = STD_Y(stds[istd],1)+ipt-1
+		call gseti (gio, G_PMLTYPE, 0)
+	        call gmark (gio, Memr[x], Memr[y], mark, szmark, szmark)
+		call gseti (gio, G_PMLTYPE, 1)
+		call gseti (gio, G_PLCOLOR, cdel)
+	        call gmark (gio, Memr[x], Memr[y], mdel, szmdel, szmdel)
+	    case 's':
+		if (istd != nstds-1)
+		    mark = GP_MARK(gp)
+		else
+		    mark = GP_MADD(gp)
+	        n = STD_NWAVES(stds[istd])
+	        x = STD_X(stds[istd])
+	        y = STD_Y(stds[istd])
+	        w = STD_WTS(stds[istd])
+		do i = 1, n {
+		    if (Memr[w] != 0.) {
+		        call gseti (gio, G_PMLTYPE, 0)
+	                call gmark (gio, Memr[x], Memr[y], mark, szmark, szmark)
+		        call gseti (gio, G_PMLTYPE, 1)
+			call gseti (gio, G_PLCOLOR, cdel)
+	                call gmark (gio, Memr[x], Memr[y], mdel, szmdel, szmdel)
+		    }
+		    x = x + 1
+		    y = y + 1
+		    w = w + 1
+		}
+	    case 'w':
+	        wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	        do i = 1, nstds {
+	            if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		        next
+		    if (i != nstds-1)
+			mark = GP_MARK(gp)
+		    else
+			mark = GP_MADD(gp)
+	            n = STD_NWAVES(stds[i])
+	            x = STD_X(stds[i])
+	            y = STD_Y(stds[i])
+		    z = STD_WAVES(stds[i])
+	            w = STD_WTS(stds[i])
+		    do j = 1, n {
+		        if ((Memr[z] == wave) && (Memr[w] != 0.)) {
+		            call gseti (gio, G_PMLTYPE, 0)
+	                    call gmark (gio, Memr[x], Memr[y], mark, szmark,
+				    szmark)
+		            call gseti (gio, G_PMLTYPE, 1)
+			    call gseti (gio, G_PLCOLOR, cdel)
+	                    call gmark (gio, Memr[x], Memr[y], mdel, szmdel,
+				szmdel)
+		        }
+			x = x + 1
+			y = y + 1
+			z = z + 1
+			w = w + 1
+		    }
+	        }
+	    }
+	}
+
+	# Mark the points as deleted by setting their weights to zero.
+	switch (key) {
+	case 'p':
+	    w = STD_WTS(stds[istd])+ipt-1
+	    Memr[w] = 0.
+	case 's':
+	    n = STD_NWAVES(stds[istd])
+	    w = STD_WTS(stds[istd])
+	    call aclrr (Memr[w], n)
+	case 'w':
+	    wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+	        n = STD_NWAVES(stds[i])
+		z = STD_WAVES(stds[i])
+	        w = STD_WTS(stds[i])
+		do j = 1, n {
+		    if (Memr[z] == wave)
+	                Memr[w] = 0.
+		    w = w + 1
+		    z = z + 1
+		}
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfeout.x b/noao/onedspec/sensfunc/sfeout.x
new file mode 100644
index 00000000..8dae6301
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfeout.x
@@ -0,0 +1,114 @@
+include	<error.h>
+include	<ctype.h>
+include	<mach.h>
+include	<math/curfit.h>
+
+define	NEPOINTS	100		# Number of points in extinction table
+
+# SF_EOUT -- Output a revised extinction table.  This is only done if there
+# is at least one residual extinction curve.  No assumption is made about
+# overlapping extinction curves.  In the overlap the extinction corrections
+# are averaged.
+
+procedure sf_eout (wextn, extn, nextn, ecvs, necvs)
+
+real	wextn[nextn]		# Standard extinction wavelengths
+real	extn[nextn]		# Standard extinction values
+int	nextn			# Number of standard extinction points
+pointer	ecvs[necvs]		# Residual extinction curves (one for each beam)
+int	necvs			# Number of residual extinction curves
+
+int	i, j, fd, open(), scan(), nscan()
+real	w, ext, wmin, wmax, dw, xmin, xmax, cvstatr(), cveval()
+pointer	sp, fname, waves, extns, navg, cv
+
+define	newfile_  99
+
+begin
+	# If there are no residual extinction values then do nothing.
+	for (i=1; (i<=necvs) && (ecvs[i]==NULL); i=i+1)
+	    ;
+	if (i > necvs)
+	    return
+
+	# The output table consists of NEPOINTS.
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (waves, NEPOINTS, TY_REAL)
+	call salloc (extns, NEPOINTS, TY_REAL)
+	call salloc (navg, NEPOINTS, TY_INT)
+	call aclrr (Memr[extns], NEPOINTS)
+	call aclri (Memi[navg], NEPOINTS)
+
+	# Open the extinction table.  If it fails allow the user to
+	# enter a new name.
+
+	call clgstr ("newextinction", Memc[fname], SZ_FNAME)
+	for (i=fname; (Memc[i]!=EOS) && IS_WHITE(Memc[i]); i=i+1)
+	if (Memc[i] == EOS) {
+	    call sfree (sp)
+	    return
+	}
+
+newfile_
+	iferr (fd = open (Memc[i], NEW_FILE, TEXT_FILE)) {
+	    call printf ("Cannot create %s -- Enter new extinction filename: ")
+		call pargstr (Memc[fname])
+	    call flush (STDOUT)
+	    if (scan() != EOF) {
+	        call gargwrd (Memc[fname], SZ_FNAME)
+	        if (nscan() == 1)
+	    	    goto newfile_
+	    }
+	    call sfree (sp)
+	    call printf ("No revised extinction file created\n")
+	    return
+	}
+
+	# Determine the range of the extinction table.
+	wmin = MAX_REAL
+	wmax = -MAX_REAL
+	do i = 1, necvs {
+	    if (ecvs[i] == NULL)
+		next
+	    wmin = min (wmin, cvstatr (ecvs[i], CVXMIN))
+	    wmax = max (wmax, cvstatr (ecvs[i], CVXMAX))
+	}
+	dw = (wmax - wmin) / (NEPOINTS - 1)
+	do i = 1, NEPOINTS
+	    Memr[waves+i-1] = wmin + (i - 1) * dw
+
+	# Average the residual extinctions and add the original extinction.
+	do j = 1, necvs {
+	    if (ecvs[j] == NULL)
+		next
+	    cv = ecvs[j]
+	    xmin = cvstatr (cv, CVXMIN)
+	    xmax = cvstatr (cv, CVXMAX)
+	    do i = 1, NEPOINTS {
+		w = Memr[waves+i-1]
+		if ((w < xmin) || (w > xmax))
+		    next
+		Memr[extns+i-1] = Memr[extns+i-1] + cveval (cv, w)
+		Memi[navg+i-1] = Memi[navg+i-1] + 1
+	    }
+	}
+	do i = 1, NEPOINTS {
+	    if (Memi[navg+i-1] > 0)
+		Memr[extns+i-1] = Memr[extns+i-1] / Memi[navg+i-1]
+	    w = Memr[waves+i-1]
+	    call intrp (1, wextn, extn, nextn, w, ext, j)
+	    Memr[extns+i-1] = Memr[extns+i-1] + ext
+	}
+
+	# Output extinction table.
+	call fprintf (fd, "# Revised extinction table.\n")
+	do i = 1, NEPOINTS {
+	    call fprintf (fd, "%7.2f  %6.3f\n")
+		call pargr (Memr[waves+i-1])
+		call pargr (Memr[extns+i-1])
+	}
+	call close (fd)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sfextinct.x b/noao/onedspec/sensfunc/sfextinct.x
new file mode 100644
index 00000000..f7b95326
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfextinct.x
@@ -0,0 +1,226 @@
+include	<pkg/gtools.h>
+include	"sensfunc.h"
+
+define	RANGE_AIRMASS	0.1	# Minimum airmass range
+define	SIGMA_AIRMASS	0.05	# Minimum sigma in airmass
+
+# SF_EXINCT -- Determine a residual extinction curve.  At each wavelength
+# for which there are multiple observations or neighboring wavelengths
+# such that there is a sufficient airmass range determine the slope
+# of the sensitivity vs airmass.  Residual sensitivity is used to minimize
+# wavelength scatter when multiple wavelengths are needed because of
+# nonoverlapping standard star data.  Each such slope is a measure of the
+# residual extinction at that wavelength.  To make the residual extinction
+# curve fit the extinction vs. wavelength using ICFIT.
+
+procedure sf_extinct (gp, stds, nstds, cv, ecv, function, order)
+
+pointer	gp			# Graphics structure
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity function curve
+pointer	ecv			# Residual extinction curve
+char	function[ARB]		# Fitting function
+int	order			# Function order
+
+bool	ans
+int	i, j, n, nwaves, sum, npts, scan()
+real	a, amin, amax, rms, rms1, r2, sig, cveval()
+double	x, y, z, sumx, sumy, sumz, sumx2, sumxy
+pointer	sp, waves, sens, airm, xp, yp, fp, wp, ic
+pointer	gt, gt_init()
+errchk	salloc, xt_sort3, icg_fit, ic_open
+
+define	cancel_	99
+
+begin
+	# Cancel previous extinction if defined.
+	if (ecv != NULL)
+	    goto cancel_
+	
+	# Check for minimum airmass range and determine number of points.
+	# Ignore added objects and composite data.
+	amin = 100.
+	amax = 0.
+	nwaves = 0
+	do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    nwaves = nwaves + STD_NWAVES(stds[i])
+	    a = STD_AIRMASS(stds[i])
+	    amin = min (amin, a)
+	    amax = max (amax, a)
+	}
+	if (amax - amin < RANGE_AIRMASS) {
+	    call printf (
+		"Insufficient airmass coverage for extinction determination")
+	    return
+	}
+
+	# Extract data to be used and sort by wavelength.
+	# The data is wavelength, airmass, and residual sensitivity.
+	call smark (sp)
+	call salloc (waves, nwaves, TY_REAL)
+	call salloc (sens, nwaves, TY_REAL)
+	call salloc (airm, nwaves, TY_REAL)
+	    
+	nwaves = 0
+	do i = 1, nstds-2 {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    a = STD_AIRMASS(stds[i])
+	    xp = STD_WAVES(stds[i])
+	    yp = STD_SENS(stds[i])
+	    fp = STD_FIT(stds[i])
+	    wp = STD_WTS(stds[i])
+	    do j = 1, n {
+		if (Memr[wp] != 0.) {
+		    Memr[airm+nwaves] = a
+		    Memr[waves+nwaves] = Memr[xp]
+		    Memr[sens+nwaves] = Memr[yp] - Memr[fp]
+		    nwaves = nwaves + 1
+		}
+		xp = xp + 1
+		yp = yp + 1
+		fp = fp + 1
+		wp = wp + 1
+	    }
+	}
+
+	call xt_sort3 (Memr[waves], Memr[sens], Memr[airm], nwaves)
+
+	# Bin points with common wavelengths or at least two points.
+	sum = 0
+	sumx = 0.
+	sumy = 0.
+	sumz = 0.
+	sumx2 = 0.
+	sumxy = 0.
+	n = 0
+	do i = 0, nwaves-2 {
+	    x = Memr[airm+i]
+	    y = Memr[sens+i]
+	    z = Memr[waves+i]
+	    sum = sum + 1
+	    sumx = sumx + x
+	    sumy = sumy + y
+	    sumx2 = sumx2 + x * x
+	    sumxy = sumxy + x * y
+	    sumz = sumz + z
+
+	    if ((z == Memr[waves+i+1]) || (sum < 2))
+		next
+
+	    x = sumx2 - sumx * sumx / sum
+	    if (x > SIGMA_AIRMASS) {
+	        Memr[waves+n] = sumz / sum
+	        Memr[sens+n] = (sumx * sumy / sum - sumxy) / x
+	        Memr[airm+n] = 1.
+	        n = n + 1
+		sum = 0
+		sumx = 0.
+		sumy = 0.
+		sumz = 0.
+		sumx2 = 0.
+		sumxy = 0.
+	    }
+	}
+	if (sum > 1) {
+	    x = sumx2 - sumx * sumx / sum
+	    if (x > SIGMA_AIRMASS) {
+	        Memr[waves+n] = sumz / sum
+	        Memr[sens+n] = (sumx * sumy / sum - sumxy) / x
+	        Memr[airm+n] = 1.
+		n = n + 1
+	    }
+	}
+
+	if (n < 2) {
+	    call printf ("Cannot determine residual extinction")
+	    call sfree (sp)
+	    return
+	}
+
+	# Fit residual extinction curve using ICFIT.
+	gt = gt_init()
+	call gt_sets (gt, GTTYPE, "mark")
+	call gt_seti (gt, GTCOLOR, GP_PLCOLOR(gp))
+	call ic_open (ic)
+	call ic_putr (ic, "xmin", min (STD_WSTART(stds[1]), STD_WEND(stds[1])))
+	call ic_putr (ic, "xmax", max (STD_WSTART(stds[1]), STD_WEND(stds[1])))
+	call ic_pstr (ic, "function", "chebyshev")
+	call ic_puti (ic, "order", 1)
+	call ic_pstr (ic, "xlabel", "wavelength")
+	call ic_pstr (ic, "ylabel", "residual extinction")
+	call ic_pstr (ic, "yunits", "mag")
+	call icg_fit (ic, GP_GIO(gp), "cursor", gt, ecv, Memr[waves],
+	    Memr[sens], Memr[airm], n)
+	call ic_closer (ic)
+	call gt_free (gt)
+
+	# Determine significance of the fit.
+	call sf_fit (stds, nstds, cv, function, order,
+	    min (GP_WSTART(gp), GP_WEND(gp)), max (GP_WSTART(gp), GP_WEND(gp)))
+	call sf_rms (stds, nstds, rms1, npts)
+	do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    a = STD_AIRMASS(stds[i])
+	    xp = STD_WAVES(stds[i])
+	    yp = STD_SENS(stds[i])
+	    call cvvector (ecv, Memr[xp], Memr[sens], n)
+	    call amulkr (Memr[sens], a, Memr[sens], n)
+	    call aaddr (Memr[yp], Memr[sens], Memr[yp], n)
+	}
+	call sf_fit (stds, nstds, cv, function, order,
+	    min (GP_WSTART(gp), GP_WEND(gp)), max (GP_WSTART(gp), GP_WEND(gp)))
+	call sf_rms (stds, nstds, rms, npts)
+	do i = 1, SF_NGRAPHS
+	    if (GP_SHDR(gp,i) != NULL)
+		call shdr_close (GP_SHDR(gp,i))
+
+	r2 = 1 - rms ** 2 / rms1 ** 2
+	sig = r2 * (nwaves - 2) / max (0.01, 1. - r2)
+	if (sig <= 0.0)
+	    sig = 0.
+	else
+	    sig = sqrt (sig)
+
+	# Apply to data if desired.
+	call printf (
+	"Significance = %4.1f sigma:  Apply residual extinction correction? ")
+	    call pargr (sig)
+	call flush (STDOUT)
+
+	ans = false
+	if (scan() != EOF)
+	    call gargb (ans)
+
+	# Undo last fit if not applying correction.
+	if (!ans)
+	    goto cancel_
+
+	call printf ("Residual extinction correction applied")
+	call sfree (sp)
+	return
+
+cancel_
+	do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    a = STD_AIRMASS(stds[i])
+	    xp = STD_WAVES(stds[i])
+	    yp = STD_SENS(stds[i])
+	    do j = 1, n {
+		Memr[yp] = Memr[yp] - a * cveval (ecv, Memr[xp])
+		xp = xp + 1
+		yp = yp + 1
+	    }
+	}
+	call cvfree (ecv)
+	call printf ("Residual extinction correction canceled")
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sffit.x b/noao/onedspec/sensfunc/sffit.x
new file mode 100644
index 00000000..3be306ad
--- /dev/null
+++ b/noao/onedspec/sensfunc/sffit.x
@@ -0,0 +1,78 @@
+include	<math/curfit.h>
+include	"sensfunc.h"
+
+define	FUNCTIONS	"|chebyshev|legendre|spline3|spline1|"
+
+procedure sf_fit (stds, nstds, cv, function, order, xmin, xmax)
+
+pointer	stds[nstds]
+int	nstds
+pointer	cv
+char	function[ARB]
+int	order
+real	xmin
+real	xmax
+
+int	i, n, func, ord, strdic()
+pointer	x, y, w
+
+int	functions[4]
+data	functions/CHEBYSHEV,LEGENDRE,SPLINE3,SPLINE1/
+
+begin
+	func = strdic (function, function, SZ_FNAME, FUNCTIONS)
+	func = functions[max (1, func)]
+	ord = order
+
+	while (ord > 0) {
+	    call cvfree (cv)
+	    call cvinit (cv, func, ord, xmin, xmax)
+	    do i = 1, nstds {
+		if (STD_FLAG(stds[i]) == SF_INCLUDE) {
+	            n = STD_NWAVES(stds[i])
+	            x = STD_WAVES(stds[i])
+	            y = STD_SENS(stds[i])
+	            w = STD_WTS(stds[i])
+	            call cvacpts (cv, Memr[x], Memr[y], Memr[w], n, WTS_USER)
+		}
+	    }
+	    call cvsolve (cv, i)
+	    if (i == OK)
+		break
+
+	    switch (func) {
+	    case CHEBYSHEV, LEGENDRE:
+		ord = ord - 1
+	    case SPLINE3:
+		ord = ord - 1
+		if (ord == 0) {
+		    func = CHEBYSHEV
+		    ord = 2
+		}
+	    case SPLINE1:
+		ord = ord - 1
+		if (ord == 0) {
+		    func = CHEBYSHEV
+		    ord = 1
+		}
+	    }
+	}
+
+	switch (i) {
+	case SINGULAR:
+	    call error (0, "Singular solution")
+	case NO_DEG_FREEDOM:
+	    call error (0, "No degrees of freedom")
+	}
+
+	# Set fitted values
+	do i = 1, nstds
+	    if (STD_FLAG(stds[i]) != SF_EXCLUDE) {
+	        n = STD_NWAVES(stds[i])
+		if (n < 1)
+		    next
+	        x = STD_WAVES(stds[i])
+		y = STD_FIT(stds[i])
+		call cvvector (cv, Memr[x], Memr[y], n)
+	    }
+end
diff --git a/noao/onedspec/sensfunc/sfginit.x b/noao/onedspec/sensfunc/sfginit.x
new file mode 100644
index 00000000..0214c7a7
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfginit.x
@@ -0,0 +1,89 @@
+include	<gset.h>
+include	"sensfunc.h"
+
+# SF_GINIT -- Initialize graphics structure and open the graphics device.
+# This includes CL requests for the starting graphs (default is "sr"),
+# the mark types (default is "plus box"), and graphics device.
+
+procedure sf_ginit (gp)
+
+pointer	gp		# Graphics structure (returned)
+
+int	i, j
+pointer	sp, str, gopen()
+errchk	malloc, gopen
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	call calloc (gp, LEN_GP, TY_STRUCT)
+	do i = 1, SF_NGRAPHS {
+	    call malloc (GP_IMAGES(gp,i), SZ_FNAME, TY_CHAR)
+	    Memc[GP_IMAGES(gp,i)] = EOS
+	    call malloc (GP_SKYS(gp,i), SZ_FNAME, TY_CHAR)
+	    Memc[GP_SKYS(gp,i)] = EOS
+	}
+
+	# Set the starting graph types.
+	call clgstr ("graphs", Memc[str], SZ_FNAME)
+	j = str
+	for (i=str; Memc[i] != EOS; i=i+1) {
+	    switch (Memc[i]) {
+	    case 'a','c','e','i','l','r','s':
+		Memc[j] = Memc[i]
+		j = j + 1
+	    }
+	}
+	Memc[j] = EOS
+	if (Memc[str] != EOS)
+	    call strcpy (Memc[str], GP_GRAPHS(gp,1), SF_NGRAPHS)
+	else
+	    call strcpy ("sr", GP_GRAPHS(gp,1), SF_NGRAPHS)
+
+	# Set the starting mark types and colors.
+	GP_MARK(gp) = GM_PLUS
+	GP_MDEL(gp) = GM_CROSS
+	GP_MADD(gp) = GM_BOX
+	GP_PLCOLOR(gp) = 2
+	GP_CMARK(gp) = 1
+	GP_CDEL(gp) = 3
+	GP_CADD(gp) = 4
+	call clgstr ("marks", Memc[str], SZ_FNAME)
+	call sf_marks (gp, Memc[str])
+	call clgstr ("colors", Memc[str], SZ_FNAME)
+	call sf_colors (gp, Memc[str])
+
+	# Set flux limits
+	GP_FMIN(gp) = INDEF
+	GP_FMAX(gp) = INDEF
+
+	# Open the graphics device.
+	call clgstr ("device", Memc[str], SZ_FNAME)
+	GP_GIO(gp) = gopen (Memc[str], NEW_FILE, STDGRAPH)
+
+	call sfree (sp)
+end
+
+
+# SF_GFREE -- Free the graphics structure and close the graphics device.
+
+procedure sf_gfree (gp)
+
+pointer	gp		# Graphics structure
+
+int	i
+
+begin
+	if (gp == NULL)
+	    return
+
+	call gclose (GP_GIO(gp))
+	do i = 1, SF_NGRAPHS {
+	    call mfree (GP_IMAGES(gp,i), TY_CHAR)
+	    call mfree (GP_SKYS(gp,i), TY_CHAR)
+	    if (GP_SHDR(gp,i) != NULL)
+		call shdr_close (GP_SHDR(gp,i))
+	}
+	call mfree (gp, TY_STRUCT)
+end
diff --git a/noao/onedspec/sensfunc/sfgraph.x b/noao/onedspec/sensfunc/sfgraph.x
new file mode 100644
index 00000000..bb6fb26f
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfgraph.x
@@ -0,0 +1,289 @@
+include	<gset.h>
+include	<error.h>
+include	<math/curfit.h>
+include	"sensfunc.h"
+
+define	NCURVE		50		# Number of vectors in curve
+
+
+# SF_GRAPH -- Graph the desired data on the output graphics device.
+# This entry procedure determines the graph types, sets the device viewports
+# for each graph, and calls a procedure to make the graph.
+
+procedure sf_graph (gp, stds, nstds, cv, wextn, extn, nextn, ecv)
+
+pointer	gp			# Graphics structure
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity function curve
+real	wextn[nextn]		# Extinction table wavelengths
+real	extn[nextn]		# Extinction table values
+int	nextn			# Number of values in extinction table
+pointer	ecv			# Residual extinction curve.
+
+int	i, image, ngraphs, strlen()
+real	fa[8]
+pointer	sp, id, gio
+
+data	fa/0.,1.,1.,0.,0.,0.,1.,1./
+
+begin
+	# Clear the graphs, write the title, and set the viewports based on
+	# the number of graphs.
+
+	call smark (sp)
+	call salloc (id, SZ_LINE, TY_CHAR)
+	call sysid (Memc[id], SZ_LINE)
+
+	gio = GP_GIO(gp)
+	call gclear (gio)
+	call gseti (gio, G_FACOLOR, 0)
+	call gseti (gio, G_NMINOR, 0)
+	ngraphs = strlen (GP_GRAPHS(gp,1))
+	switch (ngraphs) {
+	case 1:
+	    call gseti (gio, G_WCS, 1)
+	    call gsview (gio, .10, .97, .1, .9) 
+	    GP_SZMARK(gp) = 2.
+	    GP_SZMDEL(gp) = 2.
+	case 2:
+	    call gseti (gio, G_WCS, 1)
+	    call gsview (gio, .10, .97, .55, .9) 
+	    call gseti (gio, G_WCS, 2)
+	    call gsview (gio, .10, .97, .10, .45) 
+	    GP_SZMARK(gp) = 2.
+	    GP_SZMDEL(gp) = 2.
+	case 3:
+	    call gseti (gio, G_WCS, 1)
+	    call gsview (gio, .10, .97, .55, .9) 
+	    call gseti (gio, G_WCS, 2)
+	    call gsview (gio, .10, .50, .1, .45) 
+	    call gseti (gio, G_WCS, 3)
+	    call gsview (gio, .57, .97, .1, .45) 
+	    GP_SZMARK(gp) = 2.
+	    GP_SZMDEL(gp) = 2.
+	default:
+	    call gseti (gio, G_WCS, 1)
+	    call gsview (gio, .10, .50, .55, .9) 
+	    call gseti (gio, G_WCS, 2)
+	    call gsview (gio, .57, .97, .55, .9) 
+	    call gseti (gio, G_WCS, 3)
+	    call gsview (gio, .10, .50, .1, .45) 
+	    call gseti (gio, G_WCS, 4)
+	    call gsview (gio, .57, .97, .1, .45) 
+	    GP_SZMARK(gp) = .01
+	    GP_SZMDEL(gp) = .01
+	}
+
+	# For each graph select the viewport and call a procedure to make
+	# the graph.
+
+	image = 0
+	for (i = 1; GP_GRAPHS(gp,i) != EOS; i = i + 1) {
+	    call gseti (gio, G_WCS, i)
+	    if (i > 1)
+		call gfill (gio, fa, fa[5], 4, GF_SOLID)
+	    switch (GP_GRAPHS(gp,i)) {
+	    case 'a', 's', 'r':
+		call sf_data (stds, nstds, GP_GRAPHS(gp,i))
+		call sf_graph1 (gp, stds, nstds, GP_GRAPHS(gp,i))
+	    case 'e':
+		call sf_egraph (gp, wextn, extn, nextn, ecv)
+	    case 'c':
+		call sf_cgraph (gp, stds, nstds, cv)
+	    case 'i', 'l':
+		if (GP_GRAPHS(gp,i) == 'i')
+		    GP_LOG(gp) = NO
+		else
+		    GP_LOG(gp) = YES
+		image = image + 1
+		iferr (call sf_image (gp, image, stds, nstds, cv, wextn, extn,
+		    nextn, ecv))
+		    call erract (EA_WARN)
+	    }
+	}
+
+	call gseti (gio, G_WCS, 0)
+	call gtext (gio, 0.5, 1., Memc[id], "h=c,v=t,f=b")
+	call gtext (gio, 0.5, 0.97, GP_TITLE(gp), "h=c,v=t,f=b")
+
+	call sfree (sp)
+end
+
+
+# SF_GRAPH1 -- Make graph of sensitivity or residual sensitivity vs wavelength.
+
+procedure sf_graph1 (gp, stds, nstds, graph)
+
+pointer	gp			# Graphics structure
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+char	graph			# Graph type
+
+int	i, j, n, mark, mdel, cdel, color
+real	szmark, szmdel, ymin, ymax, y1, y2
+pointer	x, y, w, gio
+
+begin
+	gio = GP_GIO(gp)
+
+	# Autoscale the included data in Y and set wavelength range.
+	j = 0
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    j = j + 1
+	    n = STD_NWAVES(stds[i])
+	    x = STD_X(stds[i])
+	    y = STD_Y(stds[i])
+	    if (j == 1)
+		call alimr (Memr[y], n, ymin, ymax)
+	    else {
+		call alimr (Memr[y], n, y1, y2)
+		ymin = min (ymin, y1)
+		ymax = max (ymax, y2)
+	    }
+	}
+	y1 = 0.05 * (ymax - ymin)
+	ymin = ymin - y1
+	ymax = ymax + y1
+
+	# Draw axes and title based on type of graph.
+	switch (graph) {
+	case 'a':
+	    call gswind (gio, GP_AIRMASS(gp,1), GP_AIRMASS(gp,2), ymin, ymax)
+	    call glabax (gio, "Sensitivity Residuals vs Airmass", "", "")
+	case 's':
+	    call gswind (gio, GP_WSTART(gp), GP_WEND(gp), ymin, ymax)
+	    call glabax (gio, "Sensitivity vs Wavelength", "", "")
+	case 'r':
+	    call gswind (gio, GP_WSTART(gp), GP_WEND(gp), ymin, ymax)
+	    call glabax (gio, "Sensitivity Residuals vs Wavelength", "", "")
+	}
+
+	# Plot the data with appropriate mark types and sizes.
+	mdel = GP_MDEL(gp)
+	cdel = GP_CDEL(gp)
+	szmdel = GP_SZMDEL(gp)
+	szmark = GP_SZMARK(gp)
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    if (i != nstds-1) {
+		mark = GP_MARK(gp)
+		color = GP_CMARK(gp)
+	    } else {
+		mark = GP_MADD(gp)
+		color = GP_CADD(gp)
+	    }
+	    n = STD_NWAVES(stds[i])
+	    x = STD_X(stds[i]) - 1
+	    y = STD_Y(stds[i]) - 1
+	    w = STD_WTS(stds[i]) - 1
+	    do j = 1, n {
+		if (Memr[w+j] == 0.) {
+		    call gseti (gio, G_PLCOLOR, cdel)
+		    call gmark (gio, Memr[x+j], Memr[y+j], mdel, szmdel, szmdel)
+		} else {
+		    call gseti (gio, G_PLCOLOR, color)
+	            call gmark (gio, Memr[x+j], Memr[y+j], mark, szmark, szmark)
+		}
+	    }
+	}
+end
+
+
+# SF_EGRAPH -- Graph extinction curves with and without residual extinction
+# correction.
+
+procedure sf_egraph (gp, wextn, extn, nextn, ecv)
+
+pointer	gp			# Graphics structure
+real	wextn[nextn]		# Extinction table wavelengths
+real	extn[nextn]		# Extinction table values
+int	nextn			# Number of extinction table values
+pointer	ecv			# Residual extinction curve
+
+int	i, j
+real	xmin, xmax, dx, x, cveval()
+pointer	sp, ext, extnew, gio
+
+begin
+	call smark (sp)
+	call salloc (ext, NCURVE, TY_REAL)
+
+	# Interpolate extinction table to a grid of wavelengths within
+	# the range of the sensitivity data.
+
+	gio = GP_GIO(gp)
+	xmin = GP_WSTART(gp)
+	xmax = GP_WEND(gp)
+	dx = (xmax - xmin) / (NCURVE - 1)
+	x = xmin
+	do i = 0, NCURVE-1 {
+	    call intrp (1, wextn, extn, nextn, x, Memr[ext+i], j)
+	    x = x + dx
+	}
+	call gswind (gio, xmin, xmax, INDEF, INDEF)
+	call gascale (gio, Memr[ext], NCURVE, 2)
+
+	# If there is a residual extinction curve determine a new extinction
+	# curve.
+
+	if (ecv != NULL) {
+	    call salloc (extnew, NCURVE, TY_REAL)
+	    call amovr (Memr[ext], Memr[extnew], NCURVE)
+	    x = xmin
+	    do i = 0, NCURVE-1 {
+	        Memr[extnew+i] = Memr[extnew+i] + cveval (ecv, x)
+		x = x + dx
+	    }
+	    call grscale (gio, Memr[extnew], NCURVE, 2)
+	}
+
+	# Draw the axes and title and extinction curves.
+	call glabax (gio, "Extinction vs Wavelength", "", "")
+	call gseti (gio, G_PLCOLOR, GP_PLCOLOR(gp))
+	call gvline (gio, Memr[ext], NCURVE, xmin, xmax)
+	if (ecv != NULL) {
+	    call gseti (gio, G_PLTYPE, 2)
+	    call gseti (gio, G_PLCOLOR, GP_PLCOLOR(gp)+1)
+	    call gvline (gio, Memr[extnew], NCURVE, xmin, xmax)
+	    call gseti (gio, G_PLTYPE, 1)
+	}
+
+	call sfree (sp)
+end
+
+
+# SF_FITGRAPH -- Overplot the fitted sensitivity curve.
+
+procedure sf_fitgraph (gp, cv)
+
+pointer	gp			# Graphics structure
+pointer	cv			# Sensitivity function curve
+
+int	i, j
+real	x1, x2, y1, y2, cveval()
+pointer	gio
+
+begin
+	gio = GP_GIO(gp)
+	call gseti (gio, G_PLCOLOR, GP_PLCOLOR(gp))
+
+	# Only plot on sensitivity curve graph types.
+	for (j = 1; GP_GRAPHS(gp,j) != EOS; j = j + 1) {
+	    if (GP_GRAPHS(gp,j) != 's')
+		next
+	    call gseti (gio, G_WCS, j)
+	    call ggwind (gio, x1, x2, y1, y2)
+	    x2 = (x2 - x1) / NCURVE
+	    y1 = cveval (cv, x1)
+	    call gamove (gio, x1, y1)
+	    do i = 1, NCURVE {
+	        x1 = x1 + x2
+	        y1 = cveval (cv, x1)
+	        call gadraw (gio, x1, y1)
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfimage.x b/noao/onedspec/sensfunc/sfimage.x
new file mode 100644
index 00000000..71edc213
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfimage.x
@@ -0,0 +1,234 @@
+include	<gset.h>
+include	<math/curfit.h>
+include	"sensfunc.h"
+include	<smw.h>
+
+
+# SF_IMAGE -- Graph fluxed image data and possible standard flux points.
+# For efficiency the IMIO pointer, buffer, and associated data are kept
+# since a redraw is a common occurence and generating the data is slow.
+
+procedure sf_image (gp, wc, stds, nstds, cv, wextn, extn, nextn, ecv)
+
+pointer	gp			# Graphics structure
+int	wc			# WC of graph
+pointer	stds[nstds]		# Standard star data for flux points
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity function curve
+real	wextn[nextn]		# Extinction table wavelengths
+real	extn[nextn]		# Extinction table values
+int	nextn			# Number of extinction table values
+pointer	ecv			# Residual extinction curve
+
+int	scale[SF_NGRAPHS], log[SF_NGRAPHS]
+
+bool	newobs, obshead
+int	i, j, n, err
+real	a, t, w, dw, e, sens, latitude, smin, smax, xmin, xmax
+pointer	im, mw, sh, skyim, skymw, skysh, std, gio, sp, str, x, y, z, obs
+pointer	immap(), smw_openim()
+real	cveval(), obsgetr(), cvstatr()
+double	shdr_lw()
+bool	streq(), strne()
+errchk	immap, smw_openim, obsimopen
+
+define	plot_	99
+
+begin
+	# Return if no image name.
+	if (Memc[GP_IMAGES(gp,wc)] == EOS)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Get the spectrum and sky subtract if necessary.
+	sh = GP_SHDR(gp,wc)
+	if (sh != NULL) {
+	    if (streq (Memc[GP_IMAGES(gp,wc)], IMNAME(sh))) {
+		if (GP_LOG(gp) == log[wc])
+		    goto plot_
+		else
+		    call shdr_close (sh)
+	    }
+	}
+
+	# Determine a valid standard star to get aperture number.
+	do i = 1, nstds
+	    if (STD_FLAG(stds[i]) != SF_EXCLUDE) {
+		std = stds[i]
+		break
+	    }
+
+	im = immap (Memc[GP_IMAGES(gp,wc)], READ_ONLY, 0)
+	mw = smw_openim (im)
+	call shdr_open (im, mw, 1, 1, STD_BEAM(std), SHDATA, sh)
+
+	# Check for dispersion correction
+	if (DC(sh) == DCNO) {
+	    call shdr_close (sh)
+	    call smw_close (mw)
+	    call imunmap (im)
+	    GP_SHDR(gp,wc) = NULL
+	    call sfree (sp)
+	    call printf ("-%s must be dispersion corrected-")
+		call pargstr (Memc[GP_IMAGES(gp,wc)])
+	    return
+	}
+
+	# Sky subtract if necessary
+	if (Memc[GP_SKYS(gp,wc)] != EOS) {
+	    skyim = immap (Memc[GP_SKYS(gp,wc)], READ_ONLY, 0)
+	    skymw = smw_openim (skyim)
+	    call shdr_open (skyim, skymw, 1, 1, STD_BEAM(std), SHDATA, skysh)
+	    call shdr_rebin (skysh, sh)
+	    call asubr (Memr[SY(sh)], Memr[SY(skysh)], Memr[SY(sh)], SN(sh))
+	    call shdr_close (skysh)
+	    call smw_close (skymw)
+	    call imunmap (skyim)
+	}
+
+	# Set airmass and exposure time
+	if (IS_INDEF (AM(sh))) {
+	    obs = NULL
+	    call clgstr ("observatory", Memc[str], SZ_LINE)
+	    call obsimopen (obs, im, Memc[str], NO, newobs, obshead)
+	    latitude = obsgetr (obs, "latitude")
+	    call obsclose (obs)
+	    call get_airm (RA(sh), DEC(sh), HA(sh), ST(sh), latitude,
+		AM(sh))
+	}
+	a = AM(sh)
+	if (IS_INDEF (IT(sh)))
+	    t = 1.
+	else
+	    t = IT(sh)
+
+	# Apply extinction correction if needed
+	if (EC(sh) == ECNO) {
+	    if (ecv != NULL) {
+	        xmin = cvstatr (ecv, CVXMIN)
+	        xmax = cvstatr (ecv, CVXMAX)
+	    }
+	    do i = 1, SN(sh) {
+		w = Memr[SX(sh)+i-1]
+	        call intrp (1, wextn, extn, nextn, w, e, err)
+	        if (ecv != NULL)
+		    e = e + cveval (ecv, min (xmax, max (w, xmin)))
+	        Memr[SY(sh)+i-1] = Memr[SY(sh)+i-1] * 10. ** (0.4 * a * e)
+	    }
+	} else {
+	    call printf ("-%s already extinction corrected-")
+	       call pargstr (Memc[GP_IMAGES(gp,wc)])
+	}
+
+	# Apply flux calibration if needed
+	if (FC(sh) == FCNO) {
+	    do i = 1, SN(sh) {
+	        w = Memr[SX(sh)+i-1]
+		dw = abs (shdr_lw (sh, double (i+0.5)) -
+		    shdr_lw (sh, double (i-0.5)))
+	        sens = cveval (cv, w)
+	        Memr[SY(sh)+i-1] = Memr[SY(sh)+i-1] / t / dw / 10.**(0.4*sens)
+	    }
+	} else {
+	    call printf ("-%s already flux calibrated-")
+		call pargstr (Memc[GP_IMAGES(gp,wc)])
+	}
+
+	# Set flux scaling
+	call alimr (Memr[SY(sh)], SN(sh), smin, smax)
+	if (smax < 0.)
+	    scale[wc] = 0.
+	else if (GP_LOG(gp) == NO) {
+	    scale[wc] = -log10 (smax) + 1
+	    w = 10. ** scale[wc]
+	    call amulkr (Memr[SY(sh)], w, Memr[SY(sh)], SN(sh))
+	} else {
+	    scale[wc] = INDEFI
+	    smin = smax / 1000.
+	    w = smax
+	    y = SY(sh)
+	    do i = 1, SN(sh) {
+		if (Memr[y] > smin)
+		    w = min (w, Memr[y])
+		y = y + 1
+	    }
+	    y = SY(sh)
+	    do i = 1, SN(sh) {
+		Memr[y] = log10 (max (Memr[y], w))
+		y = y + 1
+	    }
+	}
+	log[wc] = GP_LOG(gp)
+
+	# Save the spectrum for future redraw.
+	call smw_close (MW(sh))
+	call imunmap (im)
+	GP_SHDR(gp,wc) = sh
+
+plot_
+	# Plot scaled graph.
+	smin = GP_FMIN(gp)
+	smax = GP_FMAX(gp)
+	if (IS_INDEFI(scale[wc])) {
+	    call sprintf (Memc[str], SZ_LINE, "%s: Log Flux")
+	        call pargstr (Memc[GP_IMAGES(gp,wc)])
+	    if (!IS_INDEF(smin)) {
+		if (smin > 0.)
+		    smin = log10 (smin)
+		else
+		    smin = INDEF
+	    }
+	    if (!IS_INDEF(smax)) {
+		if (smax > 0.)
+		    smax = log10 (smax)
+		else
+		    smax = INDEF
+	    }
+	} else if (scale[wc] != 0) {
+	    call sprintf (Memc[str], SZ_LINE, "%s: Flux x 1E%d")
+	        call pargstr (Memc[GP_IMAGES(gp,wc)])
+	        call pargi (scale[wc])
+	    w = 10. ** scale[wc]
+	    if (!IS_INDEF(smin))
+		smin = w * smin
+	    if (!IS_INDEF(smax))
+		smax = w * smax
+	} else {
+	    call sprintf (Memc[str], SZ_LINE, "%s: Flux")
+	        call pargstr (Memc[GP_IMAGES(gp,wc)])
+	    w = 1.
+	}
+
+	gio = GP_GIO(gp)
+	call gascale (gio, Memr[SX(sh)], SN(sh), 1)
+	call gascale (gio, Memr[SY(sh)], SN(sh), 2)
+	call gswind (gio, INDEF, INDEF, smin, smax)
+	call glabax (gio, Memc[str], "", "")
+	call gseti (gio, G_PLCOLOR, GP_PLCOLOR(gp))
+	call gpline (gio, Memr[SX(sh)], Memr[SY(sh)], SN(sh))
+
+	call sfree (sp)
+
+	# Check if image is one of the standard stars and plot flux points.
+	do i = 1, nstds {
+	    if (strne (Memc[GP_IMAGES(gp,wc)], STD_IMAGE(stds[i])))
+		next
+	    n = STD_NWAVES(stds[i])
+	    x = STD_WAVES(stds[i])
+	    y = STD_FLUXES(stds[i])
+	    z = STD_DWAVES(stds[i])
+	    call gseti (gio, G_PMLTYPE, 1)
+	    call gseti (gio, G_PLCOLOR, GP_CMARK(gp))
+	    if (IS_INDEFI(scale[wc])) {
+	        do j = 0, n-1
+		    call gmark (gio, Memr[x+j], log10 (Memr[y+j]), GM_HEBAR,
+			-Memr[z+j], 1.)
+	    } else {
+	        do j = 0, n-1
+		    call gmark (gio, Memr[x+j], w * Memr[y+j], GM_HEBAR,
+			-Memr[z+j], 1.)
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfmarks.x b/noao/onedspec/sensfunc/sfmarks.x
new file mode 100644
index 00000000..39d85af6
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfmarks.x
@@ -0,0 +1,46 @@
+include	<gset.h>
+include	"sensfunc.h"
+
+define	GMTYPES	"|point|box|plus|cross|diamond|hline|vline|hebar|vebar|circle|"
+
+
+# SF_MARKS -- Decode user mark types into GIO mark types.  The input string
+# consists of two whitespace separated mark types.
+
+procedure sf_marks (gp, marks)
+
+pointer	gp
+char	marks[ARB]
+
+int	i, nscan(), strdic()
+pointer	sp, str
+
+int	gmtypes[10]
+data	gmtypes /GM_POINT,GM_BOX,GM_PLUS,GM_CROSS,GM_DIAMOND,GM_HLINE,GM_VLINE,
+		GM_HEBAR,GM_VEBAR,GM_CIRCLE/
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sscan (marks)
+	call gargwrd (Memc[str], SZ_LINE)
+	if (nscan() == 1) {
+	    i = strdic (Memc[str], Memc[str], SZ_LINE, GMTYPES)
+	    if (i != 0)
+		GP_MARK(gp) = gmtypes[i]
+	}
+	call gargwrd (Memc[str], SZ_LINE)
+	if (nscan() == 2) {
+	    i = strdic (Memc[str], Memc[str], SZ_LINE, GMTYPES)
+	    if (i != 0)
+		GP_MDEL(gp) = gmtypes[i]
+	}
+	call gargwrd (Memc[str], SZ_LINE)
+	if (nscan() == 3) {
+	    i = strdic (Memc[str], Memc[str], SZ_LINE, GMTYPES)
+	    if (i != 0)
+		GP_MADD(gp) = gmtypes[i]
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sfmove.x b/noao/onedspec/sensfunc/sfmove.x
new file mode 100644
index 00000000..4451938e
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfmove.x
@@ -0,0 +1,166 @@
+include	<gset.h>
+include "sensfunc.h"
+
+
+# SF_MOVE -- Move point, star, or wavelength.
+
+procedure sf_move (gp, stds, nstds, key, istd, ipt, shift)
+
+pointer	gp			# GIO pointer
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+int	key			# Delete point, star, or wavelength
+int	istd			# Index of standard star
+int	ipt			# Index of point
+real	shift
+
+int	i, j, n, wcs, mark, mdel, cdel, color, stridx()
+real	wave, szmark, szmdel
+pointer	x, y, z, w, gio
+
+begin
+	gio = GP_GIO(gp)
+	mdel = GP_MDEL(gp)
+	cdel = GP_CDEL(gp)
+	szmdel = GP_SZMDEL(gp)
+	szmark = GP_SZMARK(gp)
+
+	# Move points in each displayed graph.
+	for (wcs = 1; GP_GRAPHS(gp,wcs) != EOS; wcs = wcs + 1) {
+	    if (stridx (GP_GRAPHS(gp,wcs), "ars") == 0)
+	        next
+
+	    call gseti (gio, G_WCS, wcs)
+	    call sf_data (stds, nstds, GP_GRAPHS(gp,wcs))
+	    switch (key) {
+	    case 'p':
+		if (istd != nstds-1) {
+		    mark = GP_MARK(gp)
+		    color = GP_CMARK(gp)
+		} else {
+		    mark = GP_MADD(gp)
+		    color = GP_CADD(gp)
+		}
+	        x = STD_X(stds[istd])+ipt-1
+	        y = STD_Y(stds[istd],1)+ipt-1
+	        w = STD_WTS(stds[istd])+ipt-1
+		if (Memr[w] != 0.) {
+		    call gseti (gio, G_PMLTYPE, 0)
+	            call gmark (gio, Memr[x], Memr[y], mark, szmark, szmark)
+		    call gseti (gio, G_PMLTYPE, 1)
+		    call gseti (gio, G_PLCOLOR, color)
+	            call gmark (gio, Memr[x], Memr[y]+shift, mark, szmark,
+			szmark)
+		} else {
+		    call gseti (gio, G_PMLTYPE, 0)
+	            call gmark (gio, Memr[x], Memr[y], mdel, szmdel, szmdel)
+		    call gseti (gio, G_PMLTYPE, 1)
+		    call gseti (gio, G_PLCOLOR, cdel)
+	            call gmark (gio, Memr[x], Memr[y]+shift, mdel, szmdel,
+			szmdel)
+		}
+	    case 's':
+		if (istd != nstds-1) {
+		    mark = GP_MARK(gp)
+		    color = GP_CMARK(gp)
+		} else {
+		    mark = GP_MADD(gp)
+		    color = GP_CADD(gp)
+		}
+	        n = STD_NWAVES(stds[istd])
+	        x = STD_X(stds[istd])
+	        y = STD_Y(stds[istd])
+	        w = STD_WTS(stds[istd])
+		do i = 1, n {
+		    if (Memr[w] != 0.) {
+		        call gseti (gio, G_PMLTYPE, 0)
+	                call gmark (gio, Memr[x], Memr[y], mark, szmark, szmark)
+		        call gseti (gio, G_PMLTYPE, 1)
+		        call gseti (gio, G_PLCOLOR, color)
+	                call gmark (gio, Memr[x], Memr[y]+shift, mark, szmark,
+			    szmark)
+		    } else {
+		        call gseti (gio, G_PMLTYPE, 0)
+	                call gmark (gio, Memr[x], Memr[y], mdel, szmdel, szmdel)
+		        call gseti (gio, G_PMLTYPE, 1)
+		        call gseti (gio, G_PLCOLOR, cdel)
+	                call gmark (gio, Memr[x], Memr[y]+shift, mdel, szmdel,
+			    szmdel)
+		    }
+		    x = x + 1
+		    y = y + 1
+		    w = w + 1
+		}
+	    case 'w':
+	        wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	        do i = 1, nstds {
+	            if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		        next
+		    if (i != nstds-1) {
+			mark = GP_MARK(gp)
+			color = GP_CMARK(gp)
+		    } else {
+			mark = GP_MADD(gp)
+			color = GP_CADD(gp)
+		    }
+	            n = STD_NWAVES(stds[i])
+	            x = STD_X(stds[i])
+	            y = STD_Y(stds[i])
+		    z = STD_WAVES(stds[i])
+	            w = STD_WTS(stds[i])
+		    do j = 1, n {
+		        if (Memr[z] == wave) {
+			    if (Memr[w] != 0.) {
+		                call gseti (gio, G_PMLTYPE, 0)
+	                        call gmark (gio, Memr[x], Memr[y], mark, szmark,
+				    szmark)
+		                call gseti (gio, G_PMLTYPE, 1)
+		                call gseti (gio, G_PLCOLOR, color)
+	                        call gmark (gio, Memr[x], Memr[y]+shift, mark,
+				    szmark, szmark)
+			    } else {
+		                call gseti (gio, G_PMLTYPE, 0)
+	                        call gmark (gio, Memr[x], Memr[y], mdel, szmdel,
+				    szmdel)
+		                call gseti (gio, G_PMLTYPE, 1)
+		                call gseti (gio, G_PLCOLOR, cdel)
+	                        call gmark (gio, Memr[x], Memr[y]+shift, mdel,
+				    szmdel, szmdel)
+			    }
+		        }
+			x = x + 1
+			y = y + 1
+			z = z + 1
+			w = w + 1
+		    }
+	        }
+	    }
+	}
+
+	# Now add the shift to the data.
+	switch (key) {
+	case 'p':
+	    y = STD_SENS(stds[istd])+ipt-1
+	    Memr[y] = Memr[y] + shift
+	case 's':
+	    n = STD_NWAVES(stds[istd])
+	    y = STD_SENS(stds[istd])
+	    call aaddkr (Memr[y], shift, Memr[y], n)
+	    STD_SHIFT(stds[istd]) = STD_SHIFT(stds[istd]) + shift
+	case 'w':
+	    wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+	        n = STD_NWAVES(stds[i])
+		z = STD_WAVES(stds[i])
+	        y = STD_SENS(stds[i])
+		do j = 1, n {
+		    if (Memr[z] == wave)
+	                Memr[y] = Memr[y] + shift
+		    w = w + 1
+		    y = y + 1
+		}
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfnearest.x b/noao/onedspec/sensfunc/sfnearest.x
new file mode 100644
index 00000000..540faad2
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfnearest.x
@@ -0,0 +1,69 @@
+include	<gset.h>
+include	<mach.h>
+include "sensfunc.h"
+
+# SF_NEAREST -- Find the nearest point to the cursor.  Return the standard
+# star index and the wavelength point index.  The metric is in NDC.
+# The cursor is moved to the nearest point selected.  Return zero for
+# the standard star index if valid point not found.
+
+procedure sf_nearest (gp, stds, nstds, wx, wy, wcs, type, istd, ipt)
+
+pointer	gp			# Graphics pointer
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+real	wx, wy			# Cursor position
+int	wcs			# WCS
+int	type			# Type of points (0=not del, 1=del, 2=both)
+int	istd			# Index of standard star (returned)
+int	ipt			# Index of point (returned)
+
+int	i, j, n, stridx()
+real	x0, y0, x1, y1, x2, y2, r2, r2min
+pointer	x, y, w, gio
+
+begin
+	# Check for valid wc.
+	istd = 0
+	if (stridx (GP_GRAPHS(gp,wcs), "ars") == 0)
+	    return
+
+	# Transform world cursor coordinates to NDC.
+	gio = GP_GIO(gp)
+	call gctran (gio, wx, wy, wx, wy, wcs, 0)
+
+	# Search for nearest point.
+	r2min = MAX_REAL
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    x = STD_X(stds[i]) - 1
+	    y = STD_Y(stds[i]) - 1
+	    w = STD_WTS(stds[i]) - 1
+	    do j = 1, n {
+		if (type == 0) {
+		    if (Memr[w+j] == 0.)
+			next
+		} else if (type == 1) {
+		    if (Memr[w+j] != 0.)
+			next
+		}
+		x1 = Memr[x+j]
+		y1 = Memr[y+j]
+	        call gctran (gio, x1, y1, x0, y0, wcs, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    istd = i
+		    ipt = j
+		    x2 = x1
+		    y2 = y1
+	        }
+	    }
+	}
+
+	# Move the cursor to the selected point.
+	call gseti (gio, G_WCS, wcs)
+	call gscur (gio, x2, y2)
+end
diff --git a/noao/onedspec/sensfunc/sfoutput.x b/noao/onedspec/sensfunc/sfoutput.x
new file mode 100644
index 00000000..e21df280
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfoutput.x
@@ -0,0 +1,114 @@
+include	<mach.h>
+include	<imhdr.h>
+include	"sensfunc.h"
+
+
+# SF_OUTPUT -- Write the sensitivity function image.
+
+procedure sf_output (stds, nstds, cv, output, ignoreaps)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+pointer	cv			# Sensitivity function curve
+char	output[SZ_FNAME]	# Output root image name (must be SZ_FNAME)
+bool	ignoreaps		# Ignore apertures?
+
+int	i, ap, nw, scan(), nscan()
+real	w1, w2, dw, dw1, aplow[2], aphigh[2], cveval()
+pointer	sp, fname, std, im, mw, buf, immap(), mw_open(), impl1r()
+errchk	imaddi, imaddr
+
+define	makeim_	99
+
+begin
+	# Return if no output root sensitivity imagename is specified.
+	if (output[1] == EOS)
+	    return
+
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Determine wavelength range and reference standard star.
+	w1 = MAX_REAL
+	w2 = -MAX_REAL
+	dw = MAX_REAL
+	do i = 1, nstds-2 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    std = stds[i]
+	    dw1 = abs ((STD_WEND(std) - STD_WSTART(std)) / (STD_NPTS(std) - 1))
+	    w1 = min (w1, STD_WSTART(std), STD_WEND(std))
+	    w2 = max (w2, STD_WSTART(std), STD_WEND(std))
+	    dw = min (dw, dw1)
+	}
+	nw = (w2 - w1) / dw + 1.5
+
+	# Make output image name with aperture number appended.  If the
+	# image exists allow the user to change root name.
+makeim_
+	if (ignoreaps) {
+	    call strcpy (output, Memc[fname], SZ_FNAME)
+	} else {
+	    call sprintf (Memc[fname], SZ_FNAME, "%s.%04d")
+		call pargstr (output)
+		call pargi (STD_BEAM(std))
+	}
+
+	iferr (im = immap (Memc[fname], NEW_IMAGE, 0)) {
+	    call printf ("Cannot create %s --  Enter new name: ")
+		call pargstr (Memc[fname])
+	    call flush (STDOUT)
+	    if (scan() != EOF) {
+	        call gargwrd (Memc[fname], SZ_FNAME)
+	        if (nscan() == 1) {
+	    	    call strcpy (Memc[fname], output, SZ_FNAME)
+	    	    goto makeim_
+		}
+	    }
+	    call printf ("No sensitivity function created for aperture %2d\n")
+	        call pargi (STD_BEAM(std))
+	    call flush (STDOUT)
+	    return
+	}
+
+	# Define the image header.
+	IM_NDIM(im) = 1
+	IM_LEN(im,1) = nw
+	IM_PIXTYPE(im) = TY_REAL
+	if (ignoreaps) {
+	    call sprintf (IM_TITLE(im), SZ_FNAME,
+		"Sensitivity function for all apertures")
+	} else {
+	    call sprintf (IM_TITLE(im), SZ_FNAME,
+		"Sensitivity function for aperture %d")
+		call pargi (STD_BEAM(std))
+	}
+
+	mw = mw_open (NULL, 1)
+	call mw_newsystem (mw, "equispec", 1)
+	call mw_swtype (mw, 1, 1, "linear", "label=Wavelength units=Angstroms")
+	call smw_open (mw, NULL, im)
+	ap = STD_BEAM(std)
+	aplow[1] = INDEF
+	aphigh[1] = INDEF
+	aplow[2] = INDEF
+	aphigh[2] = INDEF
+	call smw_swattrs (mw, 1, 1, ap, STD_BEAM(std), 0,
+	    double(w1), double(dw), nw, 0D0, aplow, aphigh, "")
+	call smw_saveim (mw, im)
+	call smw_close (mw)
+
+	# Write sensitivity data.
+	buf = impl1r (im)
+	do i = 0, nw-1
+	    Memr[buf+i] = cveval (cv, w1 + i * dw)
+
+	# Notify user.
+	call printf ("%s --> %s\n")
+		call pargstr (IM_TITLE(im))
+		call pargstr (Memc[fname])
+	call flush (STDOUT)
+
+	call imunmap (im)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sfreset.x b/noao/onedspec/sensfunc/sfreset.x
new file mode 100644
index 00000000..fc4d974e
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfreset.x
@@ -0,0 +1,62 @@
+include	"sensfunc.h"
+
+# SF_RESET -- Reset the standard star data to the original input.
+# This is called cancel changes and start over.
+
+procedure sf_reset (stds, nstds, wextn, extn, nextn, ecv, shift)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+real	wextn[nextn]		# Extinction table wavelengths
+real	extn[nextn]		# Extinction table values
+int	nextn			# Number of extinction values
+pointer	ecv			# Residual extinction curve
+int	shift			# Shift flag
+
+int	i, j, n, err
+real	exptime, airmass, ext
+pointer	waves, fluxes, dwaves, counts, sens, iwts, wts
+
+begin
+	# Reset the flags, sensitivity, and weight values.
+	shift = NO
+        do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    STD_FLAG(stds[i]) = SF_INCLUDE
+	    STD_SHIFT(stds[i]) = 0.
+	    n = STD_NWAVES(stds[i])
+	    exptime = STD_EXPTIME(stds[i])
+	    airmass = STD_AIRMASS(stds[i])
+	    waves = STD_WAVES(stds[i])
+	    fluxes = STD_FLUXES(stds[i])
+	    dwaves = STD_DWAVES(stds[i])
+	    counts = STD_COUNTS(stds[i])
+	    sens = STD_SENS(stds[i])
+	    iwts = STD_IWTS(stds[i])
+	    wts = STD_WTS(stds[i])
+	    do j = 1, n {
+	        call intrp (1, wextn, extn, nextn, Memr[waves], ext, err)
+		Memr[sens] = Memr[counts] /
+		    (Memr[fluxes] * Memr[dwaves] * exptime)
+		Memr[sens] = 2.5 * log10 (Memr[sens]) + airmass * ext
+		Memr[wts] = Memr[iwts]
+
+		waves = waves + 1
+		fluxes = fluxes + 1
+		dwaves = dwaves + 1
+		counts = counts + 1
+		sens = sens + 1
+		iwts = iwts + 1
+		wts = wts + 1
+	    }
+	}
+
+	# Reset the added and composite stars.
+	STD_NWAVES(stds[nstds-1]) = 0
+	STD_FLAG(stds[nstds-1]) = SF_DELETE
+	STD_FLAG(stds[nstds]) = SF_EXCLUDE
+
+	# Clear the residual extinction curve.
+	call cvfree (ecv)
+end
diff --git a/noao/onedspec/sensfunc/sfrms.x b/noao/onedspec/sensfunc/sfrms.x
new file mode 100644
index 00000000..72b8ea98
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfrms.x
@@ -0,0 +1,43 @@
+include	"sensfunc.h"
+
+
+# SF_RMS -- Compute the RMS of the sensitivity function fit.
+
+procedure sf_rms (stds, nstds, rms, npts)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+real	rms			# RMS about fit (returned)
+int	npts			# Number of points in fit (excluding zero wts.)
+
+int	i, j, f, n
+pointer	x, y, w
+
+begin
+	npts = 0
+	rms = 0.
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    x = STD_WAVES(stds[i])
+	    y = STD_SENS(stds[i])
+	    f = STD_FIT(stds[i])
+	    w = STD_WTS(stds[i])
+	    do j = 1, n {
+		if (Memr[w] != 0.) {
+		    rms = rms + (Memr[y] - Memr[f]) ** 2
+		    npts = npts + 1
+		}
+		x = x + 1
+		y = y + 1
+		f = f + 1
+		w = w + 1
+	    }
+	}
+
+	if (npts > 1)
+	    rms = sqrt (rms / (npts - 1))
+	else
+	    rms = INDEF
+end
diff --git a/noao/onedspec/sensfunc/sfsensfunc.x b/noao/onedspec/sensfunc/sfsensfunc.x
new file mode 100644
index 00000000..ee2f1b2a
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfsensfunc.x
@@ -0,0 +1,255 @@
+include	<error.h>
+include	<gset.h>
+include	<mach.h>
+include	"sensfunc.h"
+
+define	KEY		"noao$onedspec/sensfunc/sensfunc.key"
+define	PROMPT		"sensfunc options"
+
+
+# SF_SENSFUNC -- Interactive sensitivity function determination.
+
+procedure sf_sensfunc (gp, stds, nstds, wextn, extn, nextn, sensimage, logfile,
+    ecv, function, order, ignoreaps, interactive)
+
+pointer	gp			# Graphics structure
+pointer	stds[nstds]		# Pointer to standard observations
+int	nstds			# Number of standards
+real	wextn[nextn]		# Extinction table wavelengths
+real	extn[nextn]		# Extinction table values
+int	nextn			# Number of extinction table values
+char	sensimage[ARB]		# Output rootname
+char	logfile[ARB]		# Statistics filename
+pointer	ecv			# Residual extinction curve
+char	function[ARB]		# Fitting function type
+int	order			# Function order
+bool	ignoreaps		# Ignore apertures?
+int	interactive		# Interactive?
+
+char	cmd[SZ_FNAME]
+int	wc, key, newgraph, newfit
+real	wx, wy
+
+int	i, j, aperture, shift, npts, fd, open()
+real	xmin, xmax, rms, delta
+pointer	cv
+
+int	clgcur(), scan(), nscan(), clgwrd()
+errchk	open
+
+define	output_	99
+
+begin
+	# Initialize data and do the initial fit.
+	call sf_reset (stds, nstds, wextn, extn, nextn, ecv, shift)
+
+	xmin = MAX_REAL
+	xmax = -MAX_REAL
+	do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    aperture = STD_BEAM(stds[i])
+	    xmin = min (xmin, STD_WSTART(stds[i]), STD_WEND(stds[i]))
+	    xmax = max (xmax, STD_WSTART(stds[i]), STD_WEND(stds[i]))
+	}
+	cv = NULL
+	call sf_fit (stds, nstds, cv, function, order, xmin, xmax)
+	call sf_rms (stds, nstds, rms, npts)
+
+	# If not interactive go to the output.
+	if (interactive == 3)
+	    goto output_
+	if (interactive != 4) {
+	    call printf ("Fit aperture %d interactively? ")
+		call pargi (aperture)
+	    interactive = clgwrd ("answer", cmd, SZ_FNAME, "|no|yes|NO|YES")
+	    switch (interactive) {
+	    case 1:
+		goto output_
+	    case 3:
+		call sf_gfree (gp)
+		goto output_
+	    }
+	}
+
+	# Initialize graphics structure parameters: airmass and wavelength
+	# limits and default images to plot.
+
+	if (gp == NULL)
+	    call sf_ginit (gp)
+	GP_AIRMASS(gp,1) = MAX_REAL
+	GP_AIRMASS(gp,2) = -MAX_REAL
+	j = 0
+	do i = 1, nstds - 2 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    GP_AIRMASS(gp,1) = min (GP_AIRMASS(gp,1), STD_AIRMASS(stds[i]))
+	    GP_AIRMASS(gp,2) = max (GP_AIRMASS(gp,2), STD_AIRMASS(stds[i]))
+	    if (j < SF_NGRAPHS) {
+		j = j + 1
+	        call strcpy (STD_IMAGE(stds[i]), Memc[GP_IMAGES(gp,j)],
+		    SZ_FNAME)
+	        call strcpy (STD_SKY(stds[i]), Memc[GP_SKYS(gp,j)], SZ_FNAME)
+	    }
+	}
+	delta = GP_AIRMASS(gp,2) - GP_AIRMASS(gp,1)
+	GP_AIRMASS(gp,1) = GP_AIRMASS(gp,1) - 0.05 * delta
+	GP_AIRMASS(gp,2) = GP_AIRMASS(gp,2) + 0.05 * delta
+	GP_WSTART(gp) = xmin
+	GP_WEND(gp) = xmax
+	call sf_title (gp, aperture, function, order, npts, rms)
+
+	# Enter cursor loop by drawing the graphs.
+	key = 'r'
+	repeat {
+	    switch (key) {
+	    case '?':
+		call gpagefile (GP_GIO(gp), KEY, PROMPT)
+	    case ':':
+		call sf_colon (cmd, gp, stds, nstds, cv, wextn, extn, nextn,
+		    ecv, function, order, npts, rms, newfit, newgraph)
+	    case 'a':
+		call sf_add (gp, stds, nstds, cv, wx, wy, wc)
+	    case 'c':
+		call sf_composite (stds, nstds, cv)
+		newfit = YES
+		newgraph = YES
+	    case 'd':
+		call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
+		call sf_nearest (gp, stds, nstds, wx, wy, wc, 0, i, j)
+		if (i > 0) {
+		    call printf (
+		        "%s - Delete p(oint), s(tar), or w(avelength):")
+		        call pargstr (STD_IMAGE(stds[i]))
+		    if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
+		        break
+		    call printf ("\n")
+		    call sf_delete (gp, stds, nstds, key, i, j)
+		}
+	    case 'e':
+		call sf_extinct (gp, stds, nstds, cv, ecv, function, order)
+		newfit = YES
+		newgraph = YES
+	    case 'f':
+		newfit = YES
+	    case 'g':
+		newgraph = YES
+		newfit = YES
+	    case 'i':
+		call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
+		call sf_nearest (gp, stds, nstds, wx, wy, wc, 2, i, j)
+		if (i > 0) {
+		    call printf (
+	    "%s: airmass=%6.3f wavelen=%6.3f sens=%6.3f fit=%6.3f weight=%3f")
+		        call pargstr (STD_IMAGE(stds[i]))
+			call pargr (STD_AIRMASS(stds[i]))
+		        call pargr (Memr[STD_WAVES(stds[i])+j-1])
+		        call pargr (Memr[STD_SENS(stds[i])+j-1])
+		        call pargr (Memr[STD_FIT(stds[i])+j-1])
+		        call pargr (Memr[STD_WTS(stds[i])+j-1])
+		}
+	    case 'm':
+		call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
+		call sf_nearest (gp, stds, nstds, wx, wy, wc, 2, i, j)
+		if (i > 0) {
+		    call printf (
+		   "%s - Move p(oint), s(tar), or w(avelength) to cursor:")
+		        call pargstr (STD_IMAGE(stds[i]))
+		    if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
+		        break
+		    call printf ("\n")
+		    delta = wy - Memr[STD_Y(stds[i])+j-1]
+		    call sf_move (gp, stds, nstds, key, i, j, delta)
+		}
+	    case 'o':
+		call sf_reset (stds, nstds, wextn, extn, nextn, ecv, shift)
+		newfit = YES
+		newgraph = YES
+	    case 'q':
+		break
+	    case 'I':
+		call fatal (0, "Interrupt")
+	    case 'r':
+		newgraph = YES
+	    case 's':
+		call sf_shift (stds, nstds, shift)
+		newfit=YES
+		newgraph=YES
+	    case 'u':
+		call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
+		call sf_nearest (gp, stds, nstds, wx, wy, wc, 1, i, j)
+		if (i > 0) {
+		    call printf (
+		        "%s - Undelete p(oint), s(tar), or w(avelength):")
+		        call pargstr (STD_IMAGE(stds[i]))
+		    if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
+		        break
+		    call printf ("\n")
+		    call sf_undelete (gp, stds, nstds, key, i, j)
+		}
+	    case 'w':
+		call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
+		call sf_nearest (gp, stds, nstds, wx, wy, wc, 0, i, j)
+		if (i > 0) {
+		    call printf (
+		        "%s - Reweight p(oint), s(tar), or w(avelength):")
+		        call pargstr (STD_IMAGE(stds[i]))
+		    if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
+		        break
+		    call printf ("New weight (%g):")
+			call pargr (Memr[STD_IWTS(stds[i])+j-1])
+		    call flush (STDOUT)
+		    if (scan() != EOF) {
+			call gargr (delta)
+			if (nscan() == 1)
+		    	    call sf_weights (stds, nstds, key, i, j, delta)
+		    }
+		    call printf ("\n")
+		}
+	    default:
+		call printf ("\007")
+	    }
+
+	    # Do a new fit and recompute the RMS, and title string.
+	    if (newfit == YES) {
+		call sf_fit (stds, nstds, cv, function, order, xmin, xmax)
+		call sf_rms (stds, nstds, rms, npts)
+		call sf_title (gp, aperture, function, order, npts, rms)
+		do i = 1, SF_NGRAPHS
+		    if (GP_SHDR(gp,i) != NULL)
+			call shdr_close (GP_SHDR(gp,i))
+	    }
+
+	    # Draw new graphs.
+	    if (newgraph == YES) {
+		call sf_graph (gp, stds, nstds, cv, wextn, extn, nextn, ecv)
+		newgraph = NO
+		newfit = YES
+	    }
+
+	    # Overplot new fit.
+	    if (newfit == YES) {
+		call sf_fitgraph (gp, cv)
+		newfit = NO
+	    }
+	} until (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME) == EOF)
+
+	# Close any open images.
+	do i = 1, SF_NGRAPHS
+	    if (GP_SHDR(gp,i) != NULL)
+	        call shdr_close (GP_SHDR(gp,i))
+
+output_
+	# Output the sensitivity function and logfile statistics.
+	call sf_output (stds, nstds, cv, sensimage, ignoreaps)
+	if (logfile[1] != EOS) {
+	    iferr {
+	        fd = open (logfile, APPEND, TEXT_FILE)
+	        call sf_stats (fd, stds, nstds, function, order, npts, rms)
+	        call sf_vstats (fd, stds, nstds, cv, wextn, extn, nextn, ecv)
+	        call close (fd)
+	    } then
+		call erract (EA_WARN)
+	}
+	call cvfree (cv)
+end
diff --git a/noao/onedspec/sensfunc/sfshift.x b/noao/onedspec/sensfunc/sfshift.x
new file mode 100644
index 00000000..07b204f3
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfshift.x
@@ -0,0 +1,81 @@
+include	"sensfunc.h"
+
+
+# SF_SHIFT -- Shift or unshift all standard stars to have zero mean residual.
+
+procedure sf_shift (stds, nstds, flag)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+int	flag			# Shift flag
+
+pointer	x, y, w, f
+int	i, j, n, nshift
+real	shift, shift1, minshift
+
+begin
+	# If flag is YES then unshift the data.
+	if (flag == YES) {
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		    next
+	        n = STD_NWAVES(stds[i])
+	        if (n == 0)
+		    next
+	        y = STD_SENS(stds[i])
+	        call asubkr (Memr[y], STD_SHIFT(stds[i]), Memr[y], n)
+	        STD_SHIFT(stds[i]) = 0.
+	    }
+	    flag = NO
+	    call printf ("Data unshifted")
+	    return
+	}
+
+	# Determine the shifts needed to make the mean residual zero.
+	# Also determine the minimum shift.
+
+	minshift = 0.
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    if (n == 0)
+		next
+	    x = STD_WAVES(stds[i])
+	    y = STD_SENS(stds[i])
+	    w = STD_WTS(stds[i])
+	    f = STD_FIT(stds[i])
+	    nshift = 0
+	    shift = 0.
+	    shift1 = 0.
+	    do j = 1, n {
+		shift1 = shift1 + Memr[f+j-1] - Memr[y+j-1]
+		if (Memr[w+j-1] > 0.) {
+		    shift = shift + Memr[f+j-1] - Memr[y+j-1]
+		    nshift = nshift + 1
+		}
+	    }
+	    if (nshift > 0) {
+		shift = STD_SHIFT(stds[i]) + shift / nshift
+		if (shift < minshift)
+		    minshift = shift
+	    } else
+		shift = STD_SHIFT(stds[i]) + shift1 / n
+	    STD_SHIFT(stds[i]) = shift
+	}
+
+	# Adjust the shifts to be upwards.
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    if (n == 0)
+		next
+	    y = STD_SENS(stds[i])
+	    shift = STD_SHIFT(stds[i]) - minshift
+	    call aaddkr (Memr[y], shift, Memr[y], n)
+	    STD_SHIFT(stds[i]) = shift
+	}
+	flag = YES
+	call printf ("Data shifted")
+end
diff --git a/noao/onedspec/sensfunc/sfstats.x b/noao/onedspec/sensfunc/sfstats.x
new file mode 100644
index 00000000..a94691a4
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfstats.x
@@ -0,0 +1,152 @@
+include	"sensfunc.h"
+
+
+# SF_STATS -- Print basic statistics about the stars and the fit.
+
+procedure sf_stats (fd, stds, nstds, function, order, npts, rms)
+
+int	fd			# Output file descriptor (may be STDOUT)
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+char	function[ARB]		# Fitted function
+int	order			# Order of function
+int	npts			# Number of points in fit
+real	rms			# RMS of fit
+
+int	i, j, n
+real	rms1, dev1, dev2, dev3
+pointer	sp, str, wts
+
+begin
+	# Start with system ID.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sysid (Memc[str], SZ_LINE)
+
+	# Determine beam from first standard star not excluded.
+	for (i=1; (i<nstds) && (STD_FLAG(stds[i])==SF_EXCLUDE); i=i+1)
+	    ;
+	call fprintf (fd, "%s\n")
+	    call pargstr (Memc[str])
+	call fprintf (fd, "Sensitivity function for aperture %d:\n")
+	    call pargi (STD_BEAM(stds[i]))
+	call fprintf (fd,
+        "Fitting function is %s of order %d with %d points and RMS of %6.4f.\n")
+	    call pargstr (function)
+	    call pargi (order)
+	    call pargi (npts)
+	    call pargr (rms)
+
+	call fprintf (fd, "%12s %7s %7s %7s %7s %7s %7s %7s\n")
+	    call pargstr ("Image")
+	    call pargstr ("Airmass")
+	    call pargstr ("Points")
+	    call pargstr ("Shift")
+	    call pargstr ("RMS Fit")
+	    call pargstr ("Dev 1")
+	    call pargstr ("Dev 2")
+	    call pargstr ("Dev 3")
+
+	do i = 1, nstds {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+
+	    n = 0
+	    wts = STD_WTS(stds[i]) - 1
+	    for (j=1; j<=STD_NWAVES(stds[i]); j=j+1)
+		if (Memr[wts+j] != 0.)
+		    n = n + 1
+	    if ((i == nstds-1) && (n == 0))
+		next
+
+	    call sf_devs (stds[i], rms1, dev1, dev2, dev3)
+
+	    call fprintf (fd, "%12s %7.3f %7d %7.4f %7.4f %7.4f %7.4f %7.4f")
+		call pargstr (STD_IMAGE(stds[i]))
+		call pargr (STD_AIRMASS(stds[i]))
+		call pargi (n)
+		call pargr (STD_SHIFT(stds[i]))
+		call pargr (rms1)
+		call pargr (dev1)
+		call pargr (dev2)
+		call pargr (dev3)
+
+	    if (n == 0) {
+	        call fprintf (fd, "%s")
+		    call pargstr (" <-- deleted")
+	    }
+	    call fprintf (fd, "\n")
+	}
+
+	# Trailing spacer
+	call fprintf (fd, "\n")
+end
+
+
+# SF_DEVS - Compute rms and mean deviations from the fit.
+# The deviations are computed in three segments.
+
+procedure  sf_devs (std, rms, dev1, dev2, dev3)
+
+pointer	std		# Standard star data
+real	rms		# RMS about fit
+real	dev1		# Average deviation in first third of data
+real	dev2		# Average deviation in second third of data
+real	dev3		# Average deviation in last third of data
+
+int	i, ndev1, ndev2, ndev3, nrms, nbin, nwaves
+real	dev
+pointer	sens, fit, wts
+
+begin
+	# Get elements froms standard star structure.
+	nwaves = STD_NWAVES(std)
+	sens = STD_SENS(std)
+	fit = STD_FIT(std)
+	wts = STD_WTS(std)
+
+	# Divide into thirds.
+	rms = 0.
+	ndev1 = 0
+	dev1 = 0.
+	nbin = nwaves / 3
+	for (i=1; i<= nbin; i=i+1)
+	    if (Memr[wts+i-1] != 0.) {
+		dev = Memr[sens+i-1] - Memr[fit+i-1]
+		dev1 = dev1 + dev
+		rms = rms + dev ** 2
+		ndev1 = ndev1 + 1
+	    }
+	if (ndev1 > 0)
+	    dev1 = dev1 / ndev1
+
+	ndev2 = 0
+	dev2 = 0.
+	nbin = 2 * nwaves / 3
+	for (; i<=nbin; i=i+1)
+	    if (Memr[wts+i-1] != 0.) {
+		dev = Memr[sens+i-1] - Memr[fit+i-1]
+		dev2 = dev2 + dev
+		rms = rms + dev ** 2
+		ndev2 = ndev2 + 1
+	    }
+	if (ndev2 > 0)
+	    dev2 = dev2 / ndev2
+
+	ndev3 = 0
+	dev3 = 0.
+	nbin = nwaves
+	for (; i<=nbin; i=i+1)
+	    if (Memr[wts+i-1] != 0.) {
+		dev = Memr[sens+i-1] - Memr[fit+i-1]
+		dev3 = dev3 + dev
+		rms = rms + dev ** 2
+		ndev3 = ndev3 + 1
+	    }
+	if (ndev3 > 0)
+	    dev3 = dev3 / ndev3
+
+	nrms = ndev1 + ndev2 + ndev3
+	if (nrms > 0)
+	    rms = sqrt (rms / nrms)
+end
diff --git a/noao/onedspec/sensfunc/sfstds.x b/noao/onedspec/sensfunc/sfstds.x
new file mode 100644
index 00000000..07219729
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfstds.x
@@ -0,0 +1,266 @@
+include "sensfunc.h"
+
+
+# SF_STDS -- Get the standard observations for the specified apertures.
+# If ignoring aperture set all apertures to 1.
+# This routine knows the output of the task STANDARD.
+
+procedure sf_stds (standards, aps, ignoreaps, stds, nstds)
+
+char	standards	# Standard star data file
+pointer	aps		# Aperture list
+bool	ignoreaps	# Ignore apertures?
+pointer	stds		# Pointer to standard observations (returned)
+int	nstds		# Number of standard observations (returned)
+
+int	i, j, fd, beam, npts, nwaves, nalloc
+real	exptime, airmass, wstart, wend
+real	wavelength, flux, dwave, count
+pointer	sp, image, title, std
+pointer	waves, fluxes, dwaves, counts, sens, fit, wts, iwts, x, y
+
+bool	rng_elementi()
+int	open(), fscan(), nscan(), stridxs()
+errchk	open, malloc, realloc
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_STDIMAGE, TY_CHAR)
+	call salloc (title, SZ_STDTITLE, TY_CHAR)
+
+	# Open the standard observation data file.
+	fd = open (standards, READ_ONLY, TEXT_FILE)
+
+	# Read the standard observations and create a structure for each one.
+	# The beginning of a new star is found by a line whose first word
+	# begins with the character '['.  Otherwise the line is interpreted
+	# as a data line.  All unrecognized formats are skipped.
+
+	nwaves = 0
+	nstds = 0
+	while (fscan (fd) != EOF) {
+	    call gargwrd (Memc[image], SZ_STDIMAGE)
+	    if (Memc[image] == '[') {
+	        call gargi (beam)
+	        call gargi (npts)
+		call gargr (exptime)
+	        call gargr (airmass)
+	        call gargr (wstart)
+	        call gargr (wend)
+	        call gargstr (Memc[title], SZ_STDTITLE)
+	        if (nscan() < 7)
+		    next
+		if (!rng_elementi (aps, beam))
+		    next
+		if (IS_INDEF (exptime) || exptime <= 0.) {
+		    call eprintf (
+		"%s: Warning - exposure time missing or zero, using 1 second\n")
+			call pargstr (Memc[image])
+		    exptime = 1.
+		}
+
+		# For the first one create the pointer to the array of
+		# structures.  For the following stars increase the size
+		# of the pointer array and finish up the previous standard
+		# star.
+
+	        if (nstds == 0) {
+		    nstds = nstds + 1
+		    call calloc (stds, nstds, TY_INT)
+		    call calloc (std, LEN_STD, TY_STRUCT)
+		    Memi[stds+nstds-1] = std
+	        } else {
+	    	    if (nwaves > 0) {
+			call realloc (waves, nwaves, TY_REAL)
+			call realloc (fluxes, nwaves, TY_REAL)
+			call realloc (dwaves, nwaves, TY_REAL)
+			call realloc (counts, nwaves, TY_REAL)
+			call realloc (wts, nwaves, TY_REAL)
+			call malloc (sens, nwaves, TY_REAL)
+			call malloc (fit, nwaves, TY_REAL)
+			call malloc (iwts, nwaves, TY_REAL)
+			call malloc (x, nwaves, TY_REAL)
+			call malloc (y, nwaves, TY_REAL)
+			call amovr (Memr[wts], Memr[iwts], nwaves)
+			STD_NWAVES(std) = nwaves
+			STD_WAVES(std) = waves
+			STD_FLUXES(std) = fluxes
+			STD_DWAVES(std) = dwaves
+			STD_COUNTS(std) = counts
+			STD_SENS(std) = sens
+			STD_FIT(std) = fit
+			STD_WTS(std) = wts
+			STD_IWTS(std) = iwts
+			STD_X(std) = x
+			STD_Y(std) = y
+
+			nstds = nstds + 1
+			call realloc (stds, nstds, TY_INT)
+			call calloc (std, LEN_STD, TY_STRUCT)
+			Memi[stds+nstds-1] = std
+		    }
+	        }
+
+		# Start a new standard star.
+	        std = Memi[stds+nstds-1]
+		if (ignoreaps)
+	            STD_BEAM(std) = 1
+		else
+	            STD_BEAM(std) = beam
+		STD_NPTS(std) = npts
+	        STD_EXPTIME(std) = exptime
+	        STD_AIRMASS(std) = airmass
+		STD_WSTART(std) = wstart
+		STD_WEND(std) = wend
+		STD_SHIFT(std) = 0.
+		STD_NWAVES(std) = 0
+
+		# Decode the image and sky strings.
+	        call strcpy (Memc[title], STD_TITLE(std), SZ_STDTITLE)
+		i = stridxs ("]", Memc[image])
+		if (Memc[image+i] == ']')
+		    i = i + 1
+		Memc[image+i-1] = EOS
+	        call strcpy (Memc[image+1], STD_IMAGE(std), SZ_STDIMAGE)
+		if (Memc[image+i] == '-') {
+		    i = i + 2
+		    j = stridxs ("]", Memc[image+i]) + i
+		    Memc[image+j-1] = EOS
+	            call strcpy (Memc[image+i], STD_SKY(std), SZ_STDIMAGE)
+		} else
+		    STD_SKY(std) = EOS
+	        nwaves = 0
+
+	    # Interprete the line as standard star wavelength point.
+	    } else if (nstds > 0) {
+		call reset_scan()
+		call gargr (wavelength)
+		call gargr (flux)
+		call gargr (dwave)
+		call gargr (count)
+		if (nscan() < 3)
+		    next
+		if (wavelength < min (wstart, wend) ||
+		    wavelength > max (wstart, wend) ||
+		    flux<=0. || dwave<=0. || count<=0.)
+		    next
+		if (!rng_elementi (aps, beam))
+		    next
+		nwaves = nwaves + 1
+
+		# Allocate in blocks to minimize the number of reallocations.
+		if (nwaves == 1) {
+		    nalloc = 100
+		    call malloc (waves, nalloc, TY_REAL)
+		    call malloc (fluxes, nalloc, TY_REAL)
+		    call malloc (dwaves, nalloc, TY_REAL)
+		    call malloc (counts, nalloc, TY_REAL)
+		    call malloc (wts, nalloc, TY_REAL)
+		} else if (nwaves > nalloc) {
+		    nalloc = nalloc + 100
+		    call realloc (waves, nalloc, TY_REAL)
+		    call realloc (fluxes, nalloc, TY_REAL)
+		    call realloc (dwaves, nalloc, TY_REAL)
+		    call realloc (counts, nalloc, TY_REAL)
+		    call realloc (wts, nalloc, TY_REAL)
+		}
+
+		# Record the data and compute the sensitivity.
+		Memr[waves+nwaves-1] = wavelength
+		Memr[fluxes+nwaves-1] = flux
+		Memr[dwaves+nwaves-1] = dwave
+		Memr[counts+nwaves-1] = count
+		Memr[wts+nwaves-1] = 1.
+	    }
+	}
+
+	# Finish up the last standard star and close the file.
+	if (nstds > 0) {
+	    STD_NWAVES(std) = nwaves
+    	    if (nwaves > 0) {
+		call realloc (waves, nwaves, TY_REAL)
+		call realloc (fluxes, nwaves, TY_REAL)
+		call realloc (dwaves, nwaves, TY_REAL)
+		call realloc (counts, nwaves, TY_REAL)
+		call realloc (wts, nwaves, TY_REAL)
+		call malloc (sens, nwaves, TY_REAL)
+		call malloc (fit, nwaves, TY_REAL)
+		call malloc (iwts, nwaves, TY_REAL)
+		call malloc (x, nwaves, TY_REAL)
+		call malloc (y, nwaves, TY_REAL)
+		call amovr (Memr[wts], Memr[iwts], nwaves)
+		STD_WAVES(std) = waves
+		STD_FLUXES(std) = fluxes
+		STD_DWAVES(std) = dwaves
+		STD_COUNTS(std) = counts
+		STD_SENS(std) = sens
+		STD_FIT(std) = fit
+		STD_WTS(std) = wts
+		STD_IWTS(std) = iwts
+		STD_X(std) = x
+		STD_Y(std) = y
+	    }
+	}
+	call close (fd)
+	call sfree (sp)
+
+	# Add standard stars for any added points and composite points.
+	nstds = nstds + 2
+	call realloc (stds, nstds, TY_INT)
+	call calloc (std, LEN_STD, TY_STRUCT)
+	Memi[stds+nstds-2] = std
+	call strcpy ("Added", STD_IMAGE(std), SZ_STDIMAGE)
+	STD_BEAM(std) = STD_BEAM(Memi[stds])
+	STD_NPTS(std) = STD_NPTS(Memi[stds])
+	STD_EXPTIME(std) = 1.
+	STD_AIRMASS(std) = 1.
+	STD_WSTART(std) = STD_WSTART(Memi[stds])
+	STD_WEND(std) = STD_WEND(Memi[stds])
+	STD_SHIFT(std) = 0.
+	STD_NWAVES(std) = 0
+	call calloc (std, LEN_STD, TY_STRUCT)
+	Memi[stds+nstds-1] = std
+	call strcpy ("Composite", STD_IMAGE(std), SZ_STDIMAGE)
+	STD_BEAM(std) = STD_BEAM(Memi[stds])
+	STD_NPTS(std) = STD_NPTS(Memi[stds])
+	STD_EXPTIME(std) = 1.
+	STD_AIRMASS(std) = 1.
+	STD_WSTART(std) = STD_WSTART(Memi[stds])
+	STD_WEND(std) = STD_WEND(Memi[stds])
+	STD_SHIFT(std) = 0.
+	STD_NWAVES(std) = 0
+end
+
+
+# SF_FREE -- Free the standard observations and aperture array.
+
+procedure sf_free (stds, nstds, apertures, napertures)
+
+pointer	stds		# Pointer to standard observations
+int	nstds		# Number of standard observations
+pointer	apertures	# Pointer to apertures array
+int	napertures	# Number of apertures
+
+int	i
+pointer	std
+
+begin
+	do i = 1, nstds {
+	    std = Memi[stds+i-1]
+	    if (STD_NWAVES(std) > 0) {
+		call mfree (STD_WAVES(std), TY_REAL)
+		call mfree (STD_FLUXES(std), TY_REAL)
+		call mfree (STD_DWAVES(std), TY_REAL)
+		call mfree (STD_COUNTS(std), TY_REAL)
+		call mfree (STD_SENS(std), TY_REAL)
+		call mfree (STD_FIT(std), TY_REAL)
+		call mfree (STD_WTS(std), TY_REAL)
+		call mfree (STD_IWTS(std), TY_REAL)
+		call mfree (STD_X(std), TY_REAL)
+		call mfree (STD_Y(std), TY_REAL)
+	    }
+	    call mfree (std, TY_STRUCT)
+	}
+	call mfree (stds, TY_INT)
+	call mfree (apertures, TY_INT)
+end
diff --git a/noao/onedspec/sensfunc/sftitle.x b/noao/onedspec/sensfunc/sftitle.x
new file mode 100644
index 00000000..50cece9a
--- /dev/null
+++ b/noao/onedspec/sensfunc/sftitle.x
@@ -0,0 +1,23 @@
+include	"sensfunc.h"
+
+
+# SF_TITLE -- Make title string for graphs.
+
+procedure sf_title (gp, aperture, function, order, npts, rms)
+
+pointer	gp
+int	aperture
+char	function[ARB]
+int	order
+int	npts
+real	rms
+
+begin
+	call sprintf (GP_TITLE(gp), GP_SZTITLE,
+	    "Aperture=%d  Function=%s  Order=%d  Points=%d  RMS=%6.4f")
+	    call pargi (aperture)
+	    call pargstr (function)
+	    call pargi (order)
+	    call pargi (npts)
+	    call pargr (rms)
+end
diff --git a/noao/onedspec/sensfunc/sfundelete.x b/noao/onedspec/sensfunc/sfundelete.x
new file mode 100644
index 00000000..25161cc3
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfundelete.x
@@ -0,0 +1,141 @@
+include	<gset.h>
+include "sensfunc.h"
+
+
+# SF_UNDELETE -- Unelete point, star, or wavelength.
+
+procedure sf_undelete (gp, stds, nstds, key, istd, ipt)
+
+pointer	gp			# GIO pointer
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+int	key			# Delete point, star, or wavelength
+int	istd			# Index of standard star
+int	ipt			# Index of point
+
+int	i, j, n, wcs, mark, mdel, color, stridx()
+real	wave, szmark, szmdel
+pointer	x, y, z, w, w1, gio
+
+begin
+	gio = GP_GIO(gp)
+	mdel = GP_MDEL(gp)
+	szmdel = GP_SZMDEL(gp)
+	szmark = GP_SZMARK(gp)
+
+	# Undelete points from each displayed graph.
+	for (wcs = 1; GP_GRAPHS(gp,wcs) != EOS; wcs = wcs + 1) {
+	    if (stridx (GP_GRAPHS(gp,wcs), "ars") == 0)
+	        next
+
+	    call gseti (gio, G_WCS, wcs)
+	    call gseti (gio, G_PMLTYPE, 0)
+	    call sf_data (stds, nstds, GP_GRAPHS(gp,wcs))
+	    switch (key) {
+	    case 'p':
+		if (istd != nstds-1) {
+		    mark = GP_MARK(gp)
+		    color = GP_CMARK(gp)
+		} else {
+		    mark = GP_MADD(gp)
+		    color = GP_CADD(gp)
+		}
+	        x = STD_X(stds[istd])+ipt-1
+	        y = STD_Y(stds[istd])+ipt-1
+	        w = STD_WTS(stds[istd])+ipt-1
+	        w1 = STD_IWTS(stds[istd])+ipt-1
+		call gseti (gio, G_PMLTYPE, 0)
+	        call gmark (gio, Memr[x], Memr[y], mdel, szmdel, szmdel)
+		call gseti (gio, G_PMLTYPE, 1)
+		call gseti (gio, G_PLCOLOR, color)
+	        call gmark (gio, Memr[x], Memr[y], mark, szmark , szmark)
+	    case 's':
+		if (istd != nstds-1) {
+		    mark = GP_MARK(gp)
+		    color = GP_CMARK(gp)
+		} else {
+		    mark = GP_MADD(gp)
+		    color = GP_CADD(gp)
+		}
+	        n = STD_NWAVES(stds[istd])
+	        x = STD_X(stds[istd])
+	        y = STD_Y(stds[istd])
+	        w = STD_WTS(stds[istd])
+		do j = 1, n {
+		    if (Memr[w] == 0.) {
+			call gseti (gio, G_PMLTYPE, 0)
+	        	call gmark (gio, Memr[x], Memr[y], mdel, szmdel, szmdel)
+			call gseti (gio, G_PMLTYPE, 1)
+			call gseti (gio, G_PLCOLOR, color)
+	        	call gmark (gio, Memr[x], Memr[y], mark, szmark, szmark)
+		    }
+		    x = x + 1
+		    y = y + 1
+		    w = w + 1
+	        }
+	    case 'w':
+	        wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	        do i = 1, nstds {
+	            if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		        next
+		    if (i != nstds-1) {
+			mark = GP_MARK(gp)
+			color = GP_CMARK(gp)
+		    } else {
+			mark = GP_MADD(gp)
+			color = GP_CADD(gp)
+		    }
+	            n = STD_NWAVES(stds[i])
+	            x = STD_X(stds[i])
+	            y = STD_Y(stds[i])
+		    z = STD_WAVES(stds[i])
+	            w = STD_WTS(stds[i])
+		    do j = 1, n {
+		        if ((Memr[z] == wave) && (Memr[w] == 0.)) {
+			    call gseti (gio, G_PMLTYPE, 0)
+	    		    call gmark (gio, Memr[x], Memr[y], mdel, szmdel,
+				szmdel)
+			    call gseti (gio, G_PMLTYPE, 1)
+			    call gseti (gio, G_PLCOLOR, color)
+	    		    call gmark (gio, Memr[x], Memr[y], mark, szmark,
+				szmark)
+		        }
+			x = x + 1
+			y = y + 1
+			z = z + 1
+			w = w + 1
+		    }
+	        }
+	    }
+	}
+
+	# Now actually undelete the points by resetting the weights.
+	switch (key) {
+	case 'p':
+	    w = STD_WTS(stds[istd])+ipt-1
+	    w1 = STD_IWTS(stds[istd])+ipt-1
+	    Memr[w] = Memr[w1]
+	case 's':
+	    n = STD_NWAVES(stds[istd])
+	    w = STD_WTS(stds[istd])
+	    w1 = STD_IWTS(stds[istd])
+	    call amovr (Memr[w1], Memr[w], n)
+	case 'w':
+	    wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+	        n = STD_NWAVES(stds[i])
+		z = STD_WAVES(stds[i])
+	        w = STD_WTS(stds[i])
+	        w1 = STD_IWTS(stds[i])
+		do j = 1, n {
+		    if (Memr[z] == wave)
+			Memr[w] = Memr[w1]
+		    z = z + 1
+		    w = w + 1
+		    w1 = w1 + 1
+		}
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/sfvstats.x b/noao/onedspec/sensfunc/sfvstats.x
new file mode 100644
index 00000000..add49da7
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfvstats.x
@@ -0,0 +1,104 @@
+include	"sensfunc.h"
+
+# SF_VSTATS -- Verbose statistics output.
+
+procedure sf_vstats (fd, stds, nstds, cv, wextn, extn, nextn, ecv)
+
+int	fd		# Output file descriptor (may be STDOUT)
+pointer	stds[nstds]	# Standard star data
+int	nstds		# Number of standard stars
+pointer	cv		# Sensitivity function curve
+real	wextn[nextn]	# Extinction table wavelength
+real	extn[nextn]	# Extinction table values
+int	nextn		# Number of extinction table values
+pointer	ecv		# Residual extinction curve
+
+int	i, j, n, nwaves
+real	w, fit, ext, dext, cveval()
+double	sum, sum2, s
+pointer	sp, waves, sens, xp, yp, zp
+
+begin
+	nwaves = 0
+	do i = 1, nstds-1
+	    if (STD_FLAG(stds[i]) != SF_EXCLUDE)
+	        nwaves = nwaves + STD_NWAVES(stds[i])
+
+	call smark (sp)
+	call salloc (waves, nwaves, TY_REAL)
+	call salloc (sens, nwaves, TY_REAL)
+	    
+	nwaves = 0
+	do i = 1, nstds-1 {
+	    if (STD_FLAG(stds[i]) == SF_EXCLUDE)
+		next
+	    n = STD_NWAVES(stds[i])
+	    xp = STD_WAVES(stds[i])
+	    yp = STD_SENS(stds[i])
+	    zp = STD_WTS(stds[i])
+	    do j = 1, n {
+		if (Memr[zp] != 0.) {
+		    Memr[waves+nwaves] = Memr[xp]
+		    Memr[sens+nwaves] = Memr[yp]
+		    nwaves = nwaves + 1
+		}
+		xp = xp + 1
+		yp = yp + 1
+		zp = zp + 1
+	    }
+	}
+	call xt_sort2 (Memr[waves], Memr[sens], nwaves)
+
+	call fprintf (fd, "%8s %7s %7s %7s %7s %5s %7s %7s\n")
+	    call pargstr ("Lambda")
+	    call pargstr ("Fit")
+	    call pargstr ("Avg")
+	    call pargstr ("Resid")
+	    call pargstr ("SD Avg")
+	    call pargstr ("N")
+	    call pargstr ("Ext")
+	    call pargstr ("Dext")
+
+	dext = 0.
+	n = 0
+	sum = 0.
+	sum2 = 0.
+	do i = 0, nwaves-1 {
+	    w = Memr[waves+i]
+	    s = Memr[sens+i]
+	    n = n + 1
+	    sum = sum + s
+	    sum2 = sum2 + s * s
+
+	    if ((i < nwaves-1) && (w == Memr[waves+i+1]))
+		next
+
+	    sum = sum / n
+	    sum2 = sum2 / n - sum * sum
+	    if (sum2 > 0)
+	        sum2 = sqrt (sum2 / n)
+	    else
+		sum2 = 0.
+	    fit = cveval (cv, w)
+	    call intrp (1, wextn, extn, nextn, w, ext, j)
+	    if (ecv != NULL)
+	        dext = cveval (ecv, w)
+	    call fprintf (fd, "%8.2f %7.3f %7.3f %7.4f %7.4f %5d %7.4f %7.4f\n")
+		call pargr (w)
+		call pargr (fit)
+		call pargd (sum)
+		call pargd (sum - fit)
+		call pargd (sum2)
+		call pargi (n)
+		call pargr (ext)
+		call pargr (dext)
+	    n = 0
+	    sum = 0.
+	    sum2 = 0.
+	}
+
+	# Trailing spacer
+	call fprintf (fd, "\n")
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/sensfunc/sfweights.x b/noao/onedspec/sensfunc/sfweights.x
new file mode 100644
index 00000000..2ce24b1a
--- /dev/null
+++ b/noao/onedspec/sensfunc/sfweights.x
@@ -0,0 +1,51 @@
+include "sensfunc.h"
+
+
+# SF_WEIGHTS -- Change weights for point, star, or wavelength.
+# The original input weight is permanently lost.
+
+procedure sf_weights (stds, nstds, key, istd, ipt, weight)
+
+pointer	stds[nstds]		# Standard star data
+int	nstds			# Number of standard stars
+int	key			# Delete point, star, or wavelength
+int	istd			# Index of standard star
+int	ipt			# Index of point
+real	weight			# New weight
+
+int	i, j, n
+real	wave
+pointer	z, w, iw
+
+begin
+	switch (key) {
+	case 'p':
+	    Memr[STD_WTS(stds[istd])+ipt-1] = weight
+	    Memr[STD_IWTS(stds[istd])+ipt-1] = weight
+	case 's':
+	    n = STD_NWAVES(stds[istd])
+	    w = STD_WTS(stds[istd])
+	    iw = STD_IWTS(stds[istd])
+	    call amovkr (weight, Memr[w], n)
+	    call amovkr (weight, Memr[iw], n)
+	case 'w':
+	    wave = Memr[STD_WAVES(stds[istd])+ipt-1]
+	    do i = 1, nstds {
+	        if (STD_FLAG(stds[i]) != SF_INCLUDE)
+		    next
+	        n = STD_NWAVES(stds[i])
+		z = STD_WAVES(stds[i])
+	        w = STD_WTS(stds[i])
+	        iw = STD_IWTS(stds[i])
+		do j = 1, n {
+		    if (Memr[z] == wave) {
+	                Memr[w] = weight
+	                Memr[iw] = weight
+		    }
+		    w = w + 1
+		    iw = iw + 1
+		    z = z + 1
+		}
+	    }
+	}
+end
diff --git a/noao/onedspec/sensfunc/t_sensfunc.x b/noao/onedspec/sensfunc/t_sensfunc.x
new file mode 100644
index 00000000..82f18678
--- /dev/null
+++ b/noao/onedspec/sensfunc/t_sensfunc.x
@@ -0,0 +1,99 @@
+include	"sensfunc.h"
+
+
+# T_SENSFUNC -- Determine sensitivities and residual extinctions.
+# The input is a file of standard star produced by the task STANDARD.
+# The input data is read into an array of structures, one per standard
+# star.  The stars common to the aperture to be fit are flagged
+# and then the data is passed to the main routine SF_SENSFUNC.
+# This routine determines a sensitivity curve for the aperture which
+# is output by the procedure as well as some optional statistical
+# information.  It returns an optional residual extinction curve
+# for each aperture.  The residual extinctions curves are finally combined
+# and output as a revised extinction table.
+
+procedure t_sensfunc ()
+
+pointer	standards		# Input standard star data filename
+pointer	sensitivity		# Output root sensitivity function imagename
+pointer	aps			# Aperture list
+bool	ignoreaps		# Ignore apertures?	
+pointer	logfile			# Output log for statistics
+pointer	function		# Sensitivity function type
+int	order			# Order of sensitivity function
+int	interactive		# Interactive?
+
+int	i, j, aperture, nstds, napertures, nextn, clgeti()
+pointer	sp, str, stds, apertures, wextn, extn, ecvs, gp
+bool	clgetb()
+pointer	rng_open()
+errchk	sf_sensfunc
+
+begin
+	call smark (sp)
+	call salloc (standards, SZ_FNAME, TY_CHAR)
+	call salloc (sensitivity, SZ_FNAME, TY_CHAR) 
+	call salloc (str, SZ_LINE, TY_CHAR) 
+	call salloc (logfile, SZ_FNAME, TY_CHAR) 
+	call salloc (function, SZ_FNAME, TY_CHAR)
+
+	# CL parameter input.
+	call clgstr ("standards", Memc[standards], SZ_FNAME)
+	call clgstr ("sensitivity", Memc[sensitivity], SZ_FNAME) 
+	call clgstr ("apertures", Memc[str], SZ_LINE)
+	ignoreaps = clgetb ("ignoreaps")
+	call clgstr ("logfile", Memc[logfile], SZ_FNAME) 
+	call clgstr ("function", Memc[function], SZ_FNAME)
+	order = clgeti ("order")
+	if (clgetb ("interactive"))
+	    interactive = 2
+	else
+	    interactive = 3
+
+	# Decode aperture list.
+	iferr (aps = rng_open (Memc[str], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture list")
+
+	# Get the standard star data, the aperture array, and the
+	# extinction table, and allocate and initialize an array of
+	# residual extinction curves for each aperture.
+
+	call sf_stds (Memc[standards], aps, ignoreaps, stds, nstds)
+	if (nstds == 0) {
+	    call sfree (sp)
+	    return
+	}
+	call sf_apertures (Memi[stds], nstds, apertures, napertures)
+	call ext_load (wextn, extn, nextn)
+	call salloc (ecvs, napertures, TY_INT)
+	call amovki (NULL, Memi[ecvs], napertures)
+
+	# For each aperture flag standard stars to be used and call sf_sensfunc.
+	gp = NULL
+	do j = 1, napertures {
+	    aperture = Memi[apertures+j-1]
+	    do i = 1, nstds - 2
+		if (STD_BEAM(Memi[stds+i-1]) == aperture)
+		    STD_FLAG(Memi[stds+i-1]) = SF_INCLUDE
+		else
+		    STD_FLAG(Memi[stds+i-1]) = SF_EXCLUDE
+	    call sf_sensfunc (gp, Memi[stds], nstds, Memr[wextn], Memr[extn],
+		nextn, Memc[sensitivity], Memc[logfile], Memi[ecvs+j-1],
+		Memc[function], order, ignoreaps, interactive)
+	}
+	call sf_gfree (gp)
+
+	# Output a revised extinction table by combining the residual
+	# extinction curves for the apertures.  The table name is obtained
+	# by this proceudre.
+
+	call sf_eout (Memr[wextn], Memr[extn], nextn, Memi[ecvs], napertures)
+
+	# Finish up.
+	call sf_free (stds, nstds, apertures, napertures)
+	call ext_free (wextn, extn)
+	do j = 1, napertures
+	    call cvfree (Memi[ecvs+j-1])
+	call rng_close (aps)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/setdisp.par b/noao/onedspec/setdisp.par
new file mode 100644
index 00000000..80777884
--- /dev/null
+++ b/noao/onedspec/setdisp.par
@@ -0,0 +1,6 @@
+# Parameter file for SETDISP
+
+images,s,a,,,,List of images to be set
+dispaxis,i,h,1,1,7,Dispersion axis
+disptype,s,h,"lambda",,,Dispersion type
+dispunit,s,h,"angstroms",,,Dispersion units
diff --git a/noao/onedspec/sfit.par b/noao/onedspec/sfit.par
new file mode 100644
index 00000000..e168a079
--- /dev/null
+++ b/noao/onedspec/sfit.par
@@ -0,0 +1,25 @@
+input,s,a,,,,Input images
+output,s,a,,,,Output images
+lines,s,h,"*",,,Image lines to be fit
+bands,s,h,"1",,,Image bands to be fit
+type,s,h,"fit","data|fit|difference|ratio",,Type of output
+replace,b,h,no,,,Replace rejected points by fit?
+wavescale,b,h,yes,,,Scale the X axis with wavelength?
+logscale,b,h,no,,,Take the log (base 10) of both axes?
+override,b,h,no,,,Override previously fit lines?
+listonly,b,h,no,,,List fit but don't modify any images?
+logfiles,s,h,"logfile",,,List of log files
+interactive,b,h,yes,,,Set fitting parameters interactively?
+sample,s,h,"*",,,Sample 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,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,1.,0.,,Rejection growing radius
+markrej,b,h,yes,,,Mark rejected points?
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Graphics cursor input
+ask,s,q,"yes","yes|no|skip|YES|NO|SKIP",,"                                     "
+mode,s,h,"ql"
diff --git a/noao/onedspec/sflip.par b/noao/onedspec/sflip.par
new file mode 100644
index 00000000..2e9dc8c2
--- /dev/null
+++ b/noao/onedspec/sflip.par
@@ -0,0 +1,6 @@
+# SFLIP parameter file
+
+input,s,a,,,,Input spectra to flip
+output,s,a,,,,Output flipped spectra
+coord_flip,b,h,no,,,Flip coordinate system?
+data_flip,b,h,yes,,,Flip data?
diff --git a/noao/onedspec/sinterp.par b/noao/onedspec/sinterp.par
new file mode 100644
index 00000000..e9935b92
--- /dev/null
+++ b/noao/onedspec/sinterp.par
@@ -0,0 +1,14 @@
+# SINTERP parameter file
+
+tbl_file,f,a,,,,File containing table of x-y pairs
+input,f,a,STDIN,,,input for x-interpolant values
+image,s,a,,,,Image name to create
+order,i,h,5,1,,Order of fit
+x1,r,a,0.0,,,First point in range of generated curve
+x2,r,h,0.0,,,Last point in range of generated curve
+dx,r,h,0.0,,,Interval between generated points
+npts,i,h,0,,,Number of points to generate
+curve_gen,b,h,no,,,Generate a curve between specified limits
+make_image,b,h,no,,,Create IRAF spectral image
+tbl_size,i,h,1024,200,,Maximum space to allocate for table
+interp_mode,s,h,"chebyshev",,,By (line|curve|legen|cheby|spline3|spline1)
diff --git a/noao/onedspec/skytweak.par b/noao/onedspec/skytweak.par
new file mode 100644
index 00000000..9ffd0f0a
--- /dev/null
+++ b/noao/onedspec/skytweak.par
@@ -0,0 +1,19 @@
+# SKYTWEAK
+
+input,s,a,,,,List of input spectra to correct
+output,s,a,,,,List of output corrected spectra
+cal,s,a,,,,List of sky calibration spectra
+ignoreaps,b,h,no,,,Ignore aperture numbers in calibration spectra?
+xcorr,b,h,yes,,,Cross correlate for shift?
+tweakrms,b,h,yes,,,Tweak to minimize RMS?
+interactive,b,h,yes,,,Interactive tweaking?
+sample,s,h,"*",,,Sample ranges
+lag,i,h,10,0,,Cross correlation lag (pixels)
+shift,r,h,0.,,,Initial shift of calibration spectrum (pixels)
+scale,r,h,1.,1e-10,,Initial scale factor
+dshift,r,h,0.1,0.,,Initial shift search step
+dscale,r,h,0.1,0.,0.99,Initial scale factor search step
+offset,r,h,1.,0.,,Initial offset for graphs
+smooth,i,h,1,1,,Smoothing box for graphs
+cursor,*gcur,h,"",,,Cursor input
+answer,s,q,"yes","no|yes|NO|YES",,Search interactively?
diff --git a/noao/onedspec/slist.par b/noao/onedspec/slist.par
new file mode 100644
index 00000000..224d79f0
--- /dev/null
+++ b/noao/onedspec/slist.par
@@ -0,0 +1,3 @@
+images,s,a,,,,List of images
+apertures,s,h,"",,,Apertures to list
+long_header,b,h,no,,,List in long format?
diff --git a/noao/onedspec/smw/README b/noao/onedspec/smw/README
new file mode 100644
index 00000000..2f2c27b0
--- /dev/null
+++ b/noao/onedspec/smw/README
@@ -0,0 +1,6 @@
+This directory contains interface routines for the spectral world
+coordinate systems.  The interface has two functions.  The first is to
+convert various input formats, including old formats, to one of the WCS
+formats used by the ONEDSPEC package.  These are MULTISPEC, EQUISPEC, and
+NDSPEC.  The second is to split large numbers of spectra which exceed the
+limits of the MWCS for a single WCS into a number of smaller WCS.
diff --git a/noao/onedspec/smw/funits.x b/noao/onedspec/smw/funits.x
new file mode 100644
index 00000000..e3c8ddf5
--- /dev/null
+++ b/noao/onedspec/smw/funits.x
@@ -0,0 +1,445 @@
+include	<ctype.h>
+include	<error.h>
+include	<funits.h>
+
+
+# FUN_OPEN -- Open funits package
+# It is allowed to open an unknown funit type
+
+pointer procedure fun_open (funits)
+
+char	funits[ARB]		# Units string
+pointer	fun			# Units pointer returned
+
+begin
+	call calloc (fun, FUN_LEN, TY_STRUCT)
+	iferr (call fun_decode (fun, funits)) {
+	    call fun_close (fun)
+	    call erract (EA_ERROR)
+	}
+	return (fun)
+end
+
+
+# FUN_CLOSE -- Close funits package
+
+procedure fun_close (fun)
+
+pointer	fun			# Units pointer
+
+begin
+	call mfree (fun, TY_STRUCT)
+end
+
+
+# FUN_COPY -- Copy funits pointer
+
+procedure fun_copy (fun1, fun2)
+
+pointer	fun1, fun2		# Units pointers
+
+begin
+	if (fun2 == NULL)
+	    call malloc (fun2, FUN_LEN, TY_STRUCT)
+	call amovi (Memi[fun1], Memi[fun2], FUN_LEN)
+end
+
+
+# FUN_DECODE -- Decode funits string and set up funits structure.
+# The main work is done in FUN_DECODE1 so that the funits string may
+# be recursive; i.e. the funits string may contain other funits strings.
+
+procedure fun_decode (fun, funits)
+
+pointer	fun			# Units pointer
+char	funits[ARB]		# Units string
+
+bool	streq()
+pointer	sp, funits1, temp
+errchk	fun_decode1, fun_ctranr
+
+begin
+	if (streq (funits, FUN_USER(fun)))
+	    return
+
+	call smark (sp)
+	call salloc (funits1, SZ_LINE, TY_CHAR)
+	call salloc (temp, FUN_LEN, TY_STRUCT)
+
+	# Save a copy to restore in case of an error.
+	call fun_copy (fun, temp)
+
+	iferr (call fun_decode1 (fun, funits, Memc[funits1], SZ_LINE)) {
+	    call fun_copy (temp, fun)
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+
+	call sfree (sp)
+end
+
+
+# FUN_DECODE1 -- Decode funits string and set up funits structure.
+# Unknown funit strings are allowed.
+
+procedure fun_decode1 (fun, funits, funits1, sz_funits1)
+
+pointer	fun			# Units pointer
+char	funits[ARB]		# Units string
+char	funits1[sz_funits1]	# Secondary funits string to return
+int	sz_funits1		# Size of secondary funits string
+
+int	funmod, funtype
+int	i, j, k, nscan(), strdic(), strlen()
+real	funscale
+pointer	sp, str
+
+int	class[FUN_NUNITS]
+real	scale[FUN_NUNITS]
+data	class /FUN_FREQ,FUN_FREQ,FUN_FREQ,FUN_WAVE/
+data	scale /FUN_J,FUN_FU,FUN_CGSH,FUN_CGSA/
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	call strcpy (funits, Memc[str], SZ_FNAME)
+	call strlwr (Memc[str])
+	call sscan (Memc[str])
+	funtype = 0
+	funmod = 0
+	do i = 1, 2 {
+	    call gargwrd (Memc[str], SZ_FNAME)
+	    if (nscan() != i)
+		break
+
+	    j = strdic (Memc[str], Memc[str], SZ_FNAME, FUN_DIC)
+	    for (k=strlen(Memc[str]); k>0 &&
+		(IS_WHITE(Memc[str+k-1]) || Memc[str+k-1]=='\n'); k=k-1)
+		Memc[str+k-1] = EOS
+
+	    if (j > FUN_NUNITS) {
+		if (funmod != 0)
+		    break
+		funmod = j - FUN_NUNITS
+	    } else {
+		funtype = j
+		break
+	    }
+	}
+	i = nscan()
+	call gargr (funscale)
+	if (nscan() != i+1)
+	    funscale = 1
+
+	if (funtype == 0) {
+	    FUN_TYPE(fun) = 0
+	    FUN_CLASS(fun) = FUN_UNKNOWN
+	    FUN_LABEL(fun) = EOS
+	    call strcpy (funits, FUN_UNITS(fun), SZ_UNITS)
+	} else {
+	    FUN_TYPE(fun) = funtype
+	    FUN_CLASS(fun) = class[funtype]
+	    FUN_MOD(fun) = funmod
+	    FUN_SCALE(fun) = scale[funtype] * funscale
+	    FUN_LABEL(fun) = EOS
+	    FUN_UNITS(fun) = EOS
+	    call strcpy (funits, FUN_USER(fun), SZ_UNITS)
+	    switch (funmod) {
+	    case FUN_LOG:
+		call strcat ("Log ", FUN_LABEL(fun), SZ_UNITS)
+	    case FUN_MAG:
+		call strcat ("Mag ", FUN_LABEL(fun), SZ_UNITS)
+	    }
+	    call strcat ("Flux", FUN_LABEL(fun), SZ_UNITS)
+	    if (funscale != 1) {
+		call sprintf (FUN_UNITS(fun), SZ_UNITS, "%sx%.1g")
+		    call pargstr (Memc[str])
+		    call pargr (funscale)
+	    } else {
+		call sprintf (FUN_UNITS(fun), SZ_UNITS, "%s")
+		    call pargstr (Memc[str])
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# FUN_COMPARE -- Compare two funits
+
+bool procedure fun_compare (fun1, fun2)
+
+pointer	fun1, fun2		# Units pointers to compare
+bool	strne()
+
+begin
+	if (strne (FUN_UNITS(fun1), FUN_UNITS(fun2)))
+	    return (false)
+	if (strne (FUN_LABEL(fun1), FUN_LABEL(fun2)))
+	    return (false)
+	return (true)
+end
+
+
+# FUN_CTRANR -- Transform funits
+# Error is returned if the transform cannot be made
+
+procedure fun_ctranr (fun1, fun2, dun, dval, fval1, fval2, nvals)
+
+pointer	fun1			# Input funits pointer
+pointer	fun2			# Output funits pointer
+pointer	dun			# Input units pointer
+real	dval[nvals]		# Input dispersion values
+real	fval1[nvals]		# Input flux values
+real	fval2[nvals]		# Output flux values
+int	nvals			# Number of values
+
+int	i
+real	s, lambda
+pointer	ang, un_open()
+bool	fun_compare()
+errchk	un_open, un_ctranr
+
+begin
+	if (fun_compare (fun1, fun2)) {
+	    call amovr (fval1, fval2, nvals)
+	    return
+	}
+
+	if (FUN_CLASS(fun1) == FUN_UNKNOWN || FUN_CLASS(fun2) == FUN_UNKNOWN)
+	    call error (1, "Cannot convert between selected funits")
+
+	call amovr (fval1, fval2, nvals)
+
+	s = FUN_SCALE(fun1)
+	switch (FUN_MOD(fun1)) {
+	case FUN_LOG:
+	    do i = 1, nvals
+		fval2[i] = 10. ** fval2[i]
+	case FUN_MAG:
+	    do i = 1, nvals
+		fval2[i] = 10. ** (-0.4 * fval2[i])
+	}
+	switch (FUN_CLASS(fun1)) {
+	case FUN_FREQ:
+	    do i = 1, nvals
+		fval2[i] = fval2[i] / s
+	case FUN_WAVE:
+	    if (FUN_CLASS(fun2) != FUN_WAVE) {
+		s = s * FUN_VLIGHT
+		ang = un_open ("angstroms")
+		do i = 1, nvals {
+		    call un_ctranr (dun, ang, dval[i], lambda, 1)
+		    fval2[i] = fval2[i] / s * lambda**2
+		}
+		call un_close (ang)
+	    } else {
+		do i = 1, nvals
+		    fval2[i] = fval2[i] / s
+	    }
+	}
+
+	s = FUN_SCALE(fun2)
+	switch (FUN_CLASS(fun2)) {
+	case FUN_FREQ:
+	    do i = 1, nvals
+		fval2[i] = fval2[i] * s
+	case FUN_WAVE:
+	    if (FUN_CLASS(fun1) != FUN_WAVE) {
+		s = s * FUN_VLIGHT
+		ang = un_open ("angstroms")
+		do i = 1, nvals {
+		    call un_ctranr (dun, ang, dval[i], lambda, 1)
+		    fval2[i] = fval2[i] * s / lambda**2
+		}
+		call un_close (ang)
+	    } else {
+		do i = 1, nvals
+		    fval2[i] = fval2[i] * s
+	    }
+	}
+	switch (FUN_MOD(fun2)) {
+	case FUN_LOG:
+	    do i = 1, nvals
+		fval2[i] = log10 (fval2[i])
+	case FUN_MAG:
+	    do i = 1, nvals
+		fval2[i] = -2.5 * log10 (fval2[i])
+	}
+end
+
+
+# FUN_CHANGER -- Change funits
+# Error is returned if the conversion cannot be made
+
+procedure fun_changer (fun, funits, dun, dvals, fvals, nvals, update)
+
+pointer	fun			# Units pointer (may be changed)
+char	funits[ARB]		# Desired funits
+pointer	dun			# Dispersion units pointer
+real	dvals[nvals]		# Dispersion values
+real	fvals[nvals]		# Flux Values
+int	nvals			# Number of values
+int	update			# Update funits pointer?
+
+bool	streq(), fun_compare()
+pointer	fun1, fun_open()
+errchk	fun_open, fun_ctranr
+
+begin
+
+	# Check for same funit string
+	if (streq (funits, FUN_USER(fun)))
+	    return
+
+	# Check for error in funits string, or the same funits.
+	fun1 = fun_open (funits)
+	if (fun_compare (fun1, fun)) {
+	    call strcpy (funits, FUN_USER(fun), SZ_UNITS)
+	    call fun_close (fun1)
+	    return
+	}
+
+	iferr {
+	    call fun_ctranr (fun, fun1, dun, dvals, fvals, fvals, nvals)
+	    if (update == YES)
+		call fun_copy (fun1, fun)
+	    call fun_close(fun1)
+	} then {
+	    call fun_close(fun1)
+	    call erract (EA_ERROR)
+	}
+end
+
+
+# FUN_CTRAND -- Transform funits
+# Error is returned if the transform cannot be made
+
+procedure fun_ctrand (fun1, fun2, dun, dval, fval1, fval2, nvals)
+
+pointer	fun1			# Input funits pointer
+pointer	fun2			# Output funits pointer
+pointer	dun			# Input dispersion units pointer
+double	dval[nvals]		# Input dispersion values
+double	fval1[nvals]		# Input flux values
+double	fval2[nvals]		# Output flux values
+int	nvals			# Number of values
+
+int	i
+double	s, lambda
+pointer	ang, un_open()
+bool	fun_compare()
+errchk	un_open, un_ctrand
+
+begin
+	if (fun_compare (fun1, fun2)) {
+	    call amovd (fval1, fval2, nvals)
+	    return
+	}
+
+	if (FUN_CLASS(fun1) == FUN_UNKNOWN || FUN_CLASS(fun2) == FUN_UNKNOWN)
+	    call error (1, "Cannot convert between selected funits")
+
+	call amovd (fval1, fval2, nvals)
+
+	s = FUN_SCALE(fun1)
+	switch (FUN_MOD(fun1)) {
+	case FUN_LOG:
+	    do i = 1, nvals
+		fval2[i] = 10. ** fval2[i]
+	case FUN_MAG:
+	    do i = 1, nvals
+		fval2[i] = 10. ** (-0.4 * fval2[i])
+	}
+	switch (FUN_CLASS(fun1)) {
+	case FUN_FREQ:
+	    do i = 1, nvals
+		fval2[i] = fval2[i] / s
+	case FUN_WAVE:
+	    if (FUN_CLASS(fun2) != FUN_WAVE) {
+		s = s * FUN_VLIGHT
+		ang = un_open ("angstroms")
+		do i = 1, nvals {
+		    call un_ctrand (dun, ang, dval[i], lambda, 1)
+		    fval2[i] = fval2[i] / s * lambda**2
+		}
+		call un_close (ang)
+	    } else {
+		do i = 1, nvals
+		    fval2[i] = fval2[i] / s
+	    }
+	}
+
+	s = FUN_SCALE(fun2)
+	switch (FUN_CLASS(fun2)) {
+	case FUN_FREQ:
+	    do i = 1, nvals
+		fval2[i] = fval2[i] * s
+	case FUN_WAVE:
+	    if (FUN_CLASS(fun1) != FUN_WAVE) {
+		s = s * FUN_VLIGHT
+		ang = un_open ("angstroms")
+		do i = 1, nvals {
+		    call un_ctrand (dun, ang, dval[i], lambda, 1)
+		    fval2[i] = fval2[i] * s / lambda**2
+		}
+		call un_close (ang)
+	    } else {
+		do i = 1, nvals
+		    fval2[i] = fval2[i] * s
+	    }
+	}
+	switch (FUN_MOD(fun2)) {
+	case FUN_LOG:
+	    do i = 1, nvals
+		fval2[i] = log10 (fval2[i])
+	case FUN_MAG:
+	    do i = 1, nvals
+		fval2[i] = -2.5 * log10 (fval2[i])
+	}
+
+end
+
+
+# FUN_CHANGED -- Change funits
+# Error is returned if the conversion cannot be made
+
+procedure fun_changed (fun, funits, dun, dvals, fvals, nvals, update)
+
+pointer	fun			# Units pointer (may be changed)
+char	funits[ARB]		# Desired funits
+pointer	dun			# Input dispersion pointer
+double	dvals[nvals]		# Input dispersion values
+double	fvals[nvals]		# Flux values
+int	nvals			# Number of values
+int	update			# Update funits pointer?
+
+bool	streq(), fun_compare()
+pointer	fun1, fun_open()
+errchk	fun_open, fun_ctrand
+
+begin
+
+	# Check for same funit string
+	if (streq (funits, FUN_USER(fun)))
+	    return
+
+	# Check for error in funits string, or the same funits.
+	fun1 = fun_open (funits)
+	if (fun_compare (fun1, fun)) {
+	    call strcpy (funits, FUN_USER(fun), SZ_UNITS)
+	    call fun_close (fun1)
+	    return
+	}
+
+	iferr {
+	    call fun_ctrand (fun, fun1, dun, dvals, fvals, fvals, nvals)
+	    if (update == YES)
+		call fun_copy (fun1, fun)
+	    call fun_close(fun1)
+	} then {
+	    call fun_close(fun1)
+	    call erract (EA_ERROR)
+	}
+end
diff --git a/noao/onedspec/smw/mkpkg b/noao/onedspec/smw/mkpkg
new file mode 100644
index 00000000..64326969
--- /dev/null
+++ b/noao/onedspec/smw/mkpkg
@@ -0,0 +1,48 @@
+# SMW/SHDR Interface
+
+update:
+	$checkout libsmw.a noaolib$
+	$update   libsmw.a
+	$checkin  libsmw.a noaolib$
+	;
+
+generic:
+	$set	GEN = "$$generic -k"
+
+	$ifolder (smwctran.x, smwctran.gx)
+	    $(GEN) smwctran.gx -o smwctran.x $endif
+	;
+
+libsmw.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	funits.x	<ctype.h> <error.h> <funits.h>
+	shdr.x		<error.h> <funits.h> <imset.h> <math/iminterp.h>\
+			<smw.h> <units.h> <imhdr.h>
+	smwclose.x	<smw.h>
+	smwct.x	<smw.h>
+	smwctfree.x	<smw.h>
+	smwctran.x	<smw.h>
+	smwdaxis.x	<smw.h>
+	smwequispec.x	<mwset.h> <smw.h> <imhdr.h>
+	smwesms.x	<mwset.h> <smw.h>
+	smwgapid.x	<smw.h>
+	smwgwattrs.x	<error.h> <smw.h>
+	smwmerge.x	<mwset.h> <smw.h>
+	smwmultispec.x	<smw.h>
+	smwmw.x		<smw.h>
+	smwnd.x		<imhdr.h> <smw.h>
+	smwndes.x	<imhdr.h> <smw.h>
+	smwnewcopy.x	<smw.h>
+	smwoldms.x	<mwset.h> <smw.h>
+	smwonedspec.x	<smw.h> <imhdr.h>
+	smwopen.x	<smw.h>
+	smwopenim.x	<imio.h> <mwset.h> <imhdr.h>
+	smwsapid.x	<smw.h>
+	smwsaveim.x	<imio.h> <smw.h> <imhdr.h>
+	smwsaxes.x	<imhdr.h> <mwset.h> <smw.h>
+	smwsctran.x	<smw.h>
+	smwsmw.x	<smw.h>
+	smwswattrs.x	<error.h> <smw.h>
+	units.x		<ctype.h> <error.h> <units.h>
+	;
diff --git a/noao/onedspec/smw/shdr.x b/noao/onedspec/smw/shdr.x
new file mode 100644
index 00000000..bdcc4b95
--- /dev/null
+++ b/noao/onedspec/smw/shdr.x
@@ -0,0 +1,1269 @@
+include	<error.h>
+include <imhdr.h>
+include	<imset.h>
+include	<smw.h>
+include	<units.h>
+include	<funits.h>
+include	<math/iminterp.h>
+
+
+# SHDR_OPEN    -- Open the SHDR spectrum header structure.
+# SHDR_TYPE    -- Determine spectrum type.
+# SHDR_GTYPE   -- Get the selected spectrum type.
+# SHDR_CLOSE   -- Close and free the SHDR structure.
+# SHDR_COPY    -- Make a copy of an SHDR structure.
+# SHDR_SYSTEM  -- Set or change the WCS system.
+# SHDR_UNITS   -- Set or change user units.
+# SHDR_LW      -- Logical to world coordinate transformation.
+# SHDR_WL      -- World to logical coordinate transformation.
+# SHDR_REBIN   -- Rebin spectrum to dispersion of reference spectrum.
+# SHDR_LINEAR  -- Rebin spectrum to linear dispersion.
+# SHDR_EXTRACT -- Extract a specific wavelength region.
+# SHDR_GI      -- Load an integer value from the header.
+# SHDR_GR      -- Load a real value from the header.
+
+
+# SHDR_OPEN -- Open SHDR spectrum header structure.
+#
+# This routine sets header information, WCS transformations, and extracts the
+# spectrum from EQUISPEC, MULTISPEC, and NDSPEC format images.  The spectrum
+# from a 2D/3D format is specified by a logical line and band number.
+# Optionally an EQUISPEC or MULTISPEC spectrum may be selected by it's
+# aperture number.  The access modes are header only or header and data.
+# Special checks are made to avoid repeated setting of the header and WCS
+# information common to all spectra in an image provided the previously set
+# structure is input.  Note that the logical to world and world to logical
+# transformations require that the MWCS pointer not be closed.
+
+procedure shdr_open (im, smw, index1, index2, ap, mode, sh)
+
+pointer	im			# IMIO pointer
+pointer	smw			# SMW pointer
+int	index1			# Image index desired
+int	index2			# Image index desired
+int	ap			# Aperture number desired
+int	mode			# Access mode
+pointer	sh			# SHDR pointer
+
+int	i, j, k, l, n, np, np1, np2, aplow[2], aphigh[2], strncmp()
+real	smw_c1tranr(), asumr()
+double	dval, shdr_lw()
+bool	newim, streq()
+pointer	sp, key, str, coeff, mw, ct, buf
+pointer	smw_sctran(), imgs3r(), un_open(), fun_open()
+errchk	smw_sctran, imgstr, imgeti, imgetr, smw_gwattrs
+errchk	un_open, fun_open, fun_ctranr, imgs3r, shdr_gtype
+
+define	data_	90
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Allocate basic structure or check if the same spectrum is requested.
+	if (sh == NULL) {
+	    call calloc (sh, LEN_SHDR, TY_STRUCT)
+	    call calloc (SID(sh,1), LEN_SHDRS, TY_CHAR)
+	    newim = true
+	} else {
+	    call imstats (im, IM_IMAGENAME, Memc[str], SZ_LINE)
+	    newim = !streq (Memc[str], IMNAME(sh))
+	    if (!newim) {
+		if (LINDEX(sh,1)==index1 && LINDEX(sh,2)==index2) {
+		    if (IS_INDEFI(ap) || AP(sh)==ap) {
+			np1 = NP1(sh)
+			np2 = NP2(sh)
+			np = np2 - np1 + 1
+			if (CTLW(sh) == NULL || CTWL(sh) == NULL)
+			    goto data_
+			if (mode == SHHDR) {
+			    do i = 1, SH_NTYPES
+				call mfree (SPEC(sh,i), TY_REAL)
+			} else {
+			    switch (SMW_FORMAT(smw)) {
+			    case SMW_ND:
+				if (mode == SHDATA && SPEC(sh,mode) == NULL)
+				    goto data_
+			    case SMW_ES, SMW_MS:
+				if (SPEC(sh,mode) == NULL)
+				    goto data_
+			    }
+			}
+			call sfree (sp)
+			return
+		    }
+		}
+	    }
+	}
+
+	# Set parameters common to an entire image.
+	if (newim) {
+	    call imstats (im, IM_IMAGENAME, IMNAME(sh), LEN_SHDRS)
+	    IM(sh) = im
+	    MW(sh) = smw
+
+	    # Get standard parameters.
+	    call shdr_gi (im, "OFLAG", OBJECT, OFLAG(sh))
+	    call shdr_gr (im, "EXPOSURE", INDEF, IT(sh))
+	    call shdr_gr (im, "ITIME", IT(sh), IT(sh))
+	    call shdr_gr (im, "EXPTIME", IT(sh), IT(sh))
+	    call shdr_gr (im, "RA", INDEF, RA(sh))
+	    call shdr_gr (im, "DEC", INDEF, DEC(sh))
+	    call shdr_gr (im, "UT", INDEF, UT(sh))
+	    call shdr_gr (im, "ST", INDEF, ST(sh))
+	    call shdr_gr (im, "HA", INDEF, HA(sh))
+	    call shdr_gr (im, "AIRMASS", INDEF, AM(sh))
+	    call shdr_gi (im, "DC-FLAG", DCNO, DC(sh))
+	    call shdr_gi (im, "EX-FLAG", ECNO, EC(sh))
+	    call shdr_gi (im, "CA-FLAG", FCNO, FC(sh))
+	    iferr (call imgstr (im, "DEREDDEN", RC(sh), LEN_SHDRS))
+		RC(sh) = EOS
+
+	    # Flag bad airmass value; i.e. 0.
+	    if (!IS_INDEF (AM(sh)) && AM(sh) < 1.)
+		AM(sh) = INDEF
+
+	    # Set the SMW information.
+	    if (SMW_FORMAT(smw) == SMW_MS)
+		i = 3B
+	    else
+		i = 2 ** (SMW_PAXIS(smw,1) - 1)
+	    CTLW1(sh) = smw_sctran (smw, "logical", "world", i)
+	    CTWL1(sh) = smw_sctran (smw, "world", "logical", i)
+
+	    # Set the units.
+	    mw = SMW_MW(smw,0)
+	    i = SMW_PAXIS(smw,1)
+	    iferr (call mw_gwattrs (mw, i, "label", LABEL(sh),LEN_SHDRS))
+		call strcpy ("", LABEL(sh), LEN_SHDRS)
+	    if (streq (LABEL(sh), "equispec") || streq (LABEL(sh), "multispe"))
+		call strcpy ("", LABEL(sh), LEN_SHDRS)
+	    iferr (call mw_gwattrs (mw, i, "units", UNITS(sh),LEN_SHDRS)) {
+		call sprintf (Memc[key], SZ_FNAME, "cunit%d")
+		    call pargi (i)
+		iferr (call imgstr (im, Memc[key], UNITS(sh), LEN_SHDRS)) {
+		    call strlwr (LABEL(sh))
+		    if (LABEL(sh) == EOS)
+			call strcpy ("", UNITS(sh), LEN_SHDRS)
+		    else if (streq (LABEL(sh), "lambda"))
+			call strcpy ("angstroms", UNITS(sh), LEN_SHDRS)
+		    else if (streq (LABEL(sh), "freq"))
+			call strcpy ("hertz", UNITS(sh), LEN_SHDRS)
+		    else if (strncmp (LABEL(sh), "velo", 4) == 0)
+			call strcpy ("m/s", UNITS(sh), LEN_SHDRS)
+		    else if (streq (LABEL(sh), "waveleng"))
+			call strcpy ("angstroms", UNITS(sh), LEN_SHDRS)
+		    else
+			call strcpy ("", UNITS(sh), LEN_SHDRS)
+		}
+		if (strncmp (LABEL(sh), "velo", 4) == 0)
+		    call strcat (" 21 centimeters", UNITS(sh), LEN_SHDRS)
+	    }
+	    if (UNITS(sh) == EOS && DC(sh) != DCNO)
+		call strcpy ("Angstroms", UNITS(sh), LEN_SHDRS)
+	    MWUN(sh) = un_open (UNITS(sh))
+	    call un_copy (MWUN(sh), UN(sh))
+
+	    iferr (call imgstr (im, "bunit", Memc[str], SZ_LINE))
+		call strcpy ("", Memc[str], SZ_LINE)
+	    FUNIM(sh) = fun_open (Memc[str])
+	    if (FUN_CLASS(FUNIM(sh)) != FUN_UNKNOWN)
+		FC(sh) = FCYES
+
+	    call fun_copy (FUNIM(sh), FUN(sh))
+	    call strcpy (FUN_LABEL(FUN(sh)), FLABEL(sh), LEN_SHDRS)
+	    call strcpy (FUN_UNITS(FUN(sh)), FUNITS(sh), LEN_SHDRS)
+	}
+
+	# Set WCS parameters for spectrum type.
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    # Set physical and logical indices.
+	    if (!IS_INDEFI (ap)) {
+		i = max (1, min (SMW_NSPEC(smw), ap))
+		j = 1
+	    } else {
+		i = max (1, index1)
+		j = max (1, index2)
+	    }
+	    call smw_mw (smw, i, j, mw, k, l)
+
+	    LINDEX(sh,1) = max (1, min (SMW_LLEN(smw,2), k))
+	    LINDEX(sh,2) = max (1, min (SMW_LLEN(smw,3), l))
+	    PINDEX(sh,1) = LINDEX(sh,1)
+	    PINDEX(sh,2) = LINDEX(sh,2)
+	    APINDEX(sh) = LINDEX(sh,1)
+
+	    # Set aperture information.  Note the use of the logical index.
+	    np1 = 1
+	    call smw_gwattrs (smw, i, j, AP(sh), BEAM(sh), DC(sh),
+		dval, dval, np2, dval, APLOW(sh,1), APHIGH(sh,1), coeff) 
+
+	    call smw_gapid (smw, i, j, TITLE(sh), LEN_SHDRS)
+	    Memc[SID(sh,1)] = EOS
+
+	    switch (SMW_LDIM(smw)) {
+	    case 1:
+		IMSEC(sh) = EOS
+	    case 2:
+		if (APLOW(sh,1) == APHIGH(sh,1)) {
+		    if (SMW_LAXIS(smw,1) == 1)
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d]")
+		    else
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d,*]")
+		    call pargi (nint (APLOW(sh,1)))
+		} else {
+		    if (SMW_LAXIS(smw,1) == 1)
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d:%d]")
+		    else
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d:%d,*]")
+		    call pargi (nint (APLOW(sh,1)))
+		    call pargi (nint (APHIGH(sh,1)))
+		}
+	    case 3:
+		if (APLOW(sh,1)==APHIGH(sh,1) && APLOW(sh,2)==APHIGH(sh,2)) {
+		    switch (SMW_LAXIS(smw,1)) {
+		    case 1:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d,%d]")
+		    case 2:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d,*,%d]")
+		    case 3:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d,%d,*]")
+		    }
+		    call pargi (nint (APLOW(sh,1)))
+		    call pargi (nint (APLOW(sh,2)))
+		} else if (APLOW(sh,1) == APHIGH(sh,1)) {
+		    switch (SMW_LAXIS(smw,1)) {
+		    case 1:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d,%d:%d]")
+		    case 2:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d,*,%d:%d]")
+		    case 3:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d,%d:%d,*]")
+		    }
+		    call pargi (nint (APLOW(sh,1)))
+		    call pargi (nint (APLOW(sh,2)))
+		    call pargi (nint (APHIGH(sh,2)))
+		} else if (APLOW(sh,2) == APHIGH(sh,2)) {
+		    switch (SMW_LAXIS(smw,1)) {
+		    case 1:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d:%d,%d]")
+		    case 2:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d:%d,*,%d]")
+		    case 3:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d:%d,%d,*]")
+		    }
+		    call pargi (nint (APLOW(sh,1)))
+		    call pargi (nint (APHIGH(sh,1)))
+		    call pargi (nint (APLOW(sh,2)))
+		} else {
+		    switch (SMW_LAXIS(smw,1)) {
+		    case 1:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d:%d,%d:%d]")
+		    case 2:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d:%d,*,%d:%d]")
+		    case 3:
+			call sprintf (IMSEC(sh), LEN_SHDRS, "[%d:%d,%d:%d,*]")
+		    }
+		    call pargi (nint (APLOW(sh,1)))
+		    call pargi (nint (APHIGH(sh,1)))
+		    call pargi (nint (APLOW(sh,2)))
+		    call pargi (nint (APHIGH(sh,2)))
+		}
+	    }
+
+	case SMW_ES, SMW_MS:
+	    # Set the image and aperture indices.
+	    if (SMW_PAXIS(smw,2) != 3) {
+		PINDEX(sh,1) = max (1, min (SMW_LLEN(smw,2), index1))
+		PINDEX(sh,2) = max (1, min (SMW_LLEN(smw,3), index2))
+		LINDEX(sh,1) = PINDEX(sh,1)
+		LINDEX(sh,2) = PINDEX(sh,2)
+		APINDEX(sh) = LINDEX(sh,1)
+	    } else {
+		PINDEX(sh,1) = 1
+		PINDEX(sh,2) = max (1, min (SMW_LLEN(smw,2), index2))
+		LINDEX(sh,1) = PINDEX(sh,2)
+		LINDEX(sh,2) = 1
+		APINDEX(sh) = 1
+	    }
+
+	    # If an aperture is specified first try and find it.
+	    # If it is not specified or found then use the physical index.
+
+	    coeff = NULL
+	    AP(sh) = 0
+	    if (!IS_INDEFI(ap)) {
+		do i = 1, SMW_NSPEC(smw) {
+		    call smw_gwattrs (smw, i, 1, AP(sh), BEAM(sh), DC(sh),
+			dval, dval, np2, dval, APLOW(sh,1), APHIGH(sh,1), coeff)
+		    if (AP(sh) == ap && SMW_PAXIS(smw,2) != 3) {
+			PINDEX(sh,1) = i
+			LINDEX(sh,1) = i
+			APINDEX(sh) = i
+			break
+		    }
+		}
+	    }
+	    if (AP(sh) != ap)
+		call smw_gwattrs (smw, APINDEX(sh), 1, AP(sh), BEAM(sh), DC(sh),
+		    dval, dval, np2, dval, APLOW(sh,1), APHIGH(sh,1), coeff) 
+	    call mfree (coeff, TY_CHAR)
+
+	    np1 = 1
+	    if (SMW_PDIM(smw) > 1) {
+		ct = smw_sctran (smw, "logical", "physical", 2)
+		PINDEX(sh,1) = nint (smw_c1tranr (ct, real(PINDEX(sh,1))))
+		call smw_ctfree (ct)
+	    }
+	    if (SMW_PDIM(smw) > 2) {
+		ct = smw_sctran (smw, "logical", "physical", 4)
+		PINDEX(sh,2) = nint (smw_c1tranr (ct, real(PINDEX(sh,2))))
+		call smw_ctfree (ct)
+	    }
+
+	    call smw_gapid (smw, APINDEX(sh), 1, TITLE(sh), LEN_SHDRS)
+	    call shdr_type (sh, 1, PINDEX(sh,2))
+
+	    switch (SMW_LDIM(smw)) {
+	    case 1:
+		IMSEC(sh) = EOS
+	    case 2:
+		call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d]")
+		call pargi (APINDEX(sh))
+	    case 3:
+		call sprintf (IMSEC(sh), LEN_SHDRS, "[*,%d,%d]")
+		call pargi (APINDEX(sh))
+		call pargi (LINDEX(sh,2))
+	    }
+	}
+	
+	# Set NP1 and NP2 in logical coordinates.
+	i = 2 ** (SMW_PAXIS(smw,1) - 1)
+	ct = smw_sctran (smw, "physical", "logical", i)
+	i = max (1, min (int (smw_c1tranr (ct, real (np1))), SMW_LLEN(smw,1)))
+	j = max (1, min (int (smw_c1tranr (ct, real (np2))), SMW_LLEN(smw,1)))
+	call smw_ctfree (ct)
+	np1 = min (i, j)
+	np2 = max (i, j)
+	np = np2 - np1 + 1
+
+	NP1(sh) = np1
+	NP2(sh) = np2
+	SN(sh) = np
+
+
+data_	# Set the coordinate and data arrays if desired otherwise free them.
+	CTLW(sh) = CTLW1(sh)
+	CTWL(sh) = CTWL1(sh)
+
+	# Set linear dispersion terms.
+	W0(sh) = shdr_lw (sh, double(1))
+	W1(sh) = shdr_lw (sh, double(np))
+	WP(sh) = (W1(sh) - W0(sh)) / (np - 1)
+	SN(sh) = np
+
+	if (mode == SHHDR) {
+	    do i = 1, SH_NTYPES
+		call mfree (SPEC(sh,i), TY_REAL)
+	    call sfree (sp)
+	    return
+	}
+
+	# Set WCS array
+	if (SX(sh) == NULL)
+	    call malloc (SX(sh), np, TY_REAL)
+	else
+	    call realloc (SX(sh), np, TY_REAL)
+	do i = 1, np
+	    Memr[SX(sh)+i-1] = shdr_lw (sh, double(i))
+
+	# Set spectrum array in most efficient way.
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    if (mode == SHDATA || SY(sh) == NULL) {
+		if (SY(sh) == NULL)
+		    call malloc (SY(sh), np, TY_REAL)
+		else
+		    call realloc (SY(sh), np, TY_REAL)
+		call aclrr (Memr[SY(sh)], np)
+		if (IS_INDEF(APLOW(sh,1)))
+		    aplow[1] = 1
+		else
+		    aplow[1] = nint (APLOW(sh,1))
+		if (IS_INDEF(APHIGH(sh,1)))
+		    aphigh[1] = 1
+		else
+		    aphigh[1] = nint (APHIGH(sh,1))
+		if (IS_INDEF(APLOW(sh,2)))
+		    aplow[2] = 1
+		else
+		    aplow[2] = nint (APLOW(sh,2))
+		if (IS_INDEF(APHIGH(sh,2)))
+		    aphigh[2] = 1
+		else
+		    aphigh[2] = nint (APHIGH(sh,2))
+		k = aplow[1]
+		l = aphigh[1]
+		n = aphigh[1] - aplow[1] + 1
+		if (SMW_LAXIS(smw,1) == 1) {
+		    do j = aplow[2], aphigh[2] {
+			do i = aplow[1], aphigh[1] {
+			    buf = imgs3r (im, np1, np2, i, i, j, j)
+			    call aaddr (Memr[buf], Memr[SY(sh)],
+				 Memr[SY(sh)], np)
+			}
+		    }
+		} else if (SMW_LAXIS(smw,1) == 2) {
+		    do j = aplow[2], aphigh[2] {
+			do i = np1, np2 {
+			    buf = imgs3r (im, k, l, i, i, j, j)
+			    Memr[SY(sh)+i-np1] = Memr[SY(sh)+i-np1] +
+				asumr (Memr[buf], n)
+			}
+		    }
+		} else {
+		    do i = np1, np2 {
+			do j = aplow[2], aphigh[2] {
+			    buf = imgs3r (im, k, l, j, j, i, i)
+			    Memr[SY(sh)+i-np1] = Memr[SY(sh)+i-np1] +
+				asumr (Memr[buf], n)
+			}
+		    }
+		}
+	    }
+	case SMW_ES, SMW_MS:
+	    if (mode == SHDATA || SY(sh) == NULL) {
+		if (SY(sh) == NULL)
+		    call malloc (SY(sh), np, TY_REAL)
+		else
+		    call realloc (SY(sh), np, TY_REAL)
+		i = LINDEX(sh,1)
+		j = LINDEX(sh,2)
+		buf = imgs3r (im, np1, np2, i, i, j, j)
+		call amovr (Memr[buf], Memr[SY(sh)], np)
+	    }
+
+	    if (mode > SHDATA)
+		call shdr_gtype (sh, mode)
+	}
+
+	# Guess flux scale if necessary.
+	if (FC(sh) == FCYES && FUN_CLASS(FUNIM(sh)) == FUN_UNKNOWN) {
+	    if (Memr[SY(sh)+np/2] < 1e-18)
+		call strcpy ("erg/cm2/s/Hz", Memc[str], SZ_LINE)
+	    else if (Memr[SY(sh)+np/2] < 1e-5)
+		call strcpy ("erg/cm2/s/A", Memc[str], SZ_LINE)
+	    call fun_close (FUNIM(sh))
+	    FUNIM(sh) = fun_open (Memc[str])
+	    if (FUN_CLASS(FUN(sh)) == FUN_UNKNOWN) {
+		call fun_copy (FUNIM(sh), FUN(sh))
+		call strcpy (FUN_LABEL(FUN(sh)), FLABEL(sh), LEN_SHDRS)
+		call strcpy (FUN_UNITS(FUN(sh)), FUNITS(sh), LEN_SHDRS)
+	    }
+	}
+	if (SPEC(sh,mode) != 0)
+	    iferr (call fun_ctranr (FUNIM(sh), FUN(sh), UN(sh), Memr[SX(sh)],
+		Memr[SPEC(sh,mode)], Memr[SPEC(sh,mode)], SN(sh)))
+		;
+
+	call sfree (sp)
+end
+
+
+# SHDR_GTYPE -- Get the selected spectrum type.
+# Currently this only works for multispec data.
+
+procedure shdr_gtype (sh, type)
+
+pointer	sh			#I SHDR pointer
+int	type			#I Spectrum type
+
+int	i, j, ctowrd(), strdic()
+pointer	sp, key, str, im, smw, ct, buf, smw_sctran(), imgs3r()
+real	smw_c1tranr()
+
+begin
+	im = IM(sh)
+	smw = MW(sh)
+
+	if (SMW_FORMAT(smw) == SMW_ND)
+	    return
+	if (SMW_PDIM(smw) < 3) {
+	    if (type != SHDATA && type != SHRAW) {
+		if (SID(sh,type) != NULL)
+		    call mfree (SID(sh,type), TY_CHAR)
+		if (SPEC(sh,type) != NULL)
+		    call mfree (SPEC(sh,type), TY_REAL)
+	    }
+	    return
+	}
+
+	# Find the band.
+	call smark (sp)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	do i = 1, 5 {
+	    call sprintf (Memc[key], SZ_LINE, "BANDID%d")
+		call pargi (i)
+	    ifnoerr (call imgstr (im, Memc[key], Memc[str], SZ_LINE)) {
+		j = 1
+		if (ctowrd (Memc[str], j, Memc[key], SZ_LINE) == 0)
+		    next
+		if (strdic (Memc[key], Memc[key], SZ_LINE, STYPES) != type)
+		    next
+		if (SID(sh,type) == NULL)
+		    call malloc (SID(sh,type), LEN_SHDRS, TY_CHAR)
+		call strcpy (Memc[str], Memc[SID(sh,type)], LEN_SHDRS)
+		STYPE(sh,type) = type
+		break
+	    }
+	}
+	call sfree (sp)
+	if (i == 6) {
+	    if (SID(sh,type) != NULL)
+		call mfree (SID(sh,type), TY_CHAR)
+	    if (SPEC(sh,type) != NULL)
+		call mfree (SPEC(sh,type), TY_REAL)
+	    return
+	}
+
+	# Map the physical band to logical vector.
+	ct = smw_sctran (smw, "physical", "logical", 4)
+	i = nint (smw_c1tranr (ct, real(i)))
+	call smw_ctfree (ct)
+	if (SMW_PAXIS(smw,2) != 3) {
+	    if (i > SMW_LLEN(smw,3))
+		return
+	    j = i
+	    i = LINDEX(sh,1)
+	} else {
+	    if (i > SMW_LLEN(smw,2))
+		return
+	    j = 1
+	}
+
+	# Get the spectrum.
+	if (SPEC(sh,type) == NULL)
+	    call malloc (SPEC(sh,type), SN(sh), TY_REAL)
+	else
+	    call realloc (SPEC(sh,type), SN(sh), TY_REAL)
+	buf = imgs3r (im, NP1(sh), NP2(sh), i, i, j, j)
+	call amovr (Memr[buf], Memr[SPEC(sh,type)], SN(sh))
+end
+
+
+# SHDR_TYPE -- Determine the spectrum type.
+# Currently this only works for multispec data.
+
+procedure shdr_type (sh, index, band)
+
+pointer	sh			#I SHDR pointer
+int	index			#I Index
+int	band			#I Physical band
+
+int	i, ctowrd(), strdic()
+pointer	sp, key
+
+begin
+	if (SMW_FORMAT(MW(sh)) == SMW_ND)
+	    return
+
+	call smark (sp)
+	call salloc (key, SZ_LINE, TY_CHAR)
+
+	if (SID(sh,index) == NULL)
+	    call malloc (SID(sh,index), LEN_SHDRS, TY_CHAR)
+
+	call sprintf (Memc[key], SZ_FNAME, "BANDID%d")
+	    call pargi (band)
+	 iferr (call imgstr (IM(sh), Memc[key], Memc[SID(sh,index)], LEN_SHDRS))
+	    Memc[SID(sh,index)] = EOS
+
+	i = 1
+	if (ctowrd (Memc[SID(sh,index)], i, Memc[key], SZ_LINE) > 0)
+	    STYPE(sh,index) = strdic (Memc[key], Memc[key], SZ_LINE, STYPES)
+	else
+	    STYPE(sh,index) = 0
+
+	call sfree (sp)
+end
+
+
+# SHDR_CLOSE -- Close and free the SHDR structure.
+
+procedure shdr_close (sh)
+
+pointer	sh			# SHDR structure
+int	i
+
+begin
+	if (sh == NULL)
+	    return
+	do i = 1, SH_NTYPES {
+	    call mfree (SPEC(sh,i), TY_REAL)
+	    call mfree (SID(sh,i), TY_CHAR)
+	}
+	call un_close (UN(sh))
+	call un_close (MWUN(sh))
+	call fun_close (FUN(sh))
+	call fun_close (FUNIM(sh))
+	if (MW(sh) != NULL) {
+	    call smw_ctfree (CTLW1(sh))
+	    call smw_ctfree (CTWL1(sh))
+	}
+	call mfree (sh, TY_STRUCT)
+end
+
+
+# SHDR_COPY -- Make a copy of an SHDR structure.
+# The image pointer is not copied and the MWCS pointer and transform pointers
+# may or may not be copied .  The uncopied pointers mean that they will be
+# shared by multiple spectrum structures but it also means that when they are
+# closed the structures will have invalid pointers.  The advantage of not
+# copying is that many spectra may come from the same image and the overhead
+# of having copies of the IMIO and MWCS pointers can be avoided.
+
+procedure shdr_copy (sh1, sh2, wcs)
+
+pointer	sh1		# SHDR structure to copy
+pointer	sh2		# SHDR structure copy
+int	wcs		# Make copy of wcs?
+
+int	i
+pointer	un, mwun, fun, funim, spec[SH_NTYPES], sid[SH_NTYPES], smw_newcopy()
+errchk	shdr_system
+
+begin
+	if (sh2 == NULL) {
+	    call calloc (sh2, LEN_SHDR, TY_STRUCT)
+	    call calloc (SID(sh2,1), LEN_SHDRS, TY_CHAR)
+	}
+
+	un = UN(sh2)
+	mwun = MWUN(sh2)
+	fun = FUN(sh2)
+	funim = FUNIM(sh2)
+	call amovi (SPEC(sh2,1), spec, SH_NTYPES)
+	call amovi (SID(sh2,1), sid, SH_NTYPES)
+	call amovi (Memi[sh1], Memi[sh2], LEN_SHDR)
+	call amovi (spec, SPEC(sh2,1), SH_NTYPES)
+	call amovi (sid, SID(sh2,1), SH_NTYPES)
+	UN(sh2) = un
+	MWUN(sh2) = mwun
+	FUN(sh2) = fun
+	FUNIM(sh2) = funim
+	call un_copy (UN(sh1), UN(sh2))
+	call un_copy (MWUN(sh1), MWUN(sh2))
+	call fun_copy (FUN(sh1), FUN(sh2))
+	call fun_copy (FUNIM(sh1), FUNIM(sh2))
+	do i = 1, SH_NTYPES {
+	    if (SPEC(sh1,i) != NULL) {
+		if (SPEC(sh2,i) == NULL)
+		    call malloc (SPEC(sh2,i), SN(sh1), TY_REAL)
+		else
+		    call realloc (SPEC(sh2,i), SN(sh1), TY_REAL)
+		call amovr (Memr[SPEC(sh1,i)], Memr[SPEC(sh2,i)], SN(sh1))
+	    }
+	}
+
+	if (wcs == YES && MW(sh1) != NULL) {
+	    MW(sh2) = smw_newcopy (MW(sh1))
+	    CTLW1(sh2) = NULL
+	    CTWL1(sh2) = NULL
+	    call shdr_system (sh2, "world")
+	}
+end
+
+
+# SHDR_SYSTEM -- Set or change the WCS system.
+
+procedure shdr_system (sh, system)
+
+pointer	sh			# SHDR pointer
+char	system[ARB]		# System
+
+int	i, sn
+bool	streq()
+double	shdr_lw()
+pointer	smw, mw, smw_sctran(), un_open()
+errchk	smw_sctran, un_open
+
+begin
+	smw = MW(sh)
+	if (smw == NULL)
+	    call error (1, "shdr_system: MWCS not defined")
+
+	call smw_ctfree (CTLW1(sh))
+	call smw_ctfree (CTWL1(sh))
+
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND, SMW_ES:
+	    i = 2 ** (SMW_PAXIS(smw,1) - 1)
+	    CTLW1(sh) = smw_sctran (smw, "logical", system, i)
+	    CTWL1(sh) = smw_sctran (smw, system, "logical", i)
+	case SMW_MS:
+	    CTLW1(sh) = smw_sctran (smw, "logical", system, 3B)
+	    CTWL1(sh) = smw_sctran (smw, system, "logical", 3B)
+	}
+	CTLW(sh) = CTLW1(sh)
+	CTWL(sh) = CTWL1(sh)
+
+	# Set labels and units
+	call un_close (MWUN(sh))
+	if (streq (system, "physical")) {
+	    call strcpy ("Pixel", LABEL(sh), LEN_SHDRS)
+	    call strcpy ("", UNITS(sh), LEN_SHDRS)
+	    MWUN(sh) = un_open (UNITS(sh))
+	} else {
+	    call smw_mw (smw, 1, 1, mw, i, i)
+	    iferr (call mw_gwattrs (mw, SMW_PAXIS(smw,1), "label", LABEL(sh),
+		LEN_SHDRS))
+		call strcpy ("", LABEL(sh), LEN_SHDRS)
+	    if (streq (LABEL(sh), "equispec") || streq (LABEL(sh), "multispe"))
+		call strcpy ("", LABEL(sh), LEN_SHDRS)
+	    iferr (call mw_gwattrs (mw, SMW_PAXIS(smw,1), "units", UNITS(sh),
+		LEN_SHDRS))
+		call strcpy ("", UNITS(sh), LEN_SHDRS)
+	    MWUN(sh) = un_open (UNITS(sh))
+	    call strcpy (UN_LABEL(UN(sh)), LABEL(sh), LEN_SHDRS)
+	    call strcpy (UN_UNITS(UN(sh)), UNITS(sh), LEN_SHDRS)
+	}
+
+	sn = SN(sh)
+	W0(sh) = shdr_lw (sh, double(1))
+	W1(sh) = shdr_lw (sh, double(sn))
+	WP(sh) = (W1(sh) - W0(sh)) / (sn - 1)
+	if (SX(sh) != NULL)
+	    do i = 1, sn
+		Memr[SX(sh)+i-1] = shdr_lw (sh, double(i))
+end
+
+
+# SHDR_UNITS -- Set or change the WCS system.
+# This changes W0, W1, WP, and SX.
+
+procedure shdr_units (sh, units)
+
+pointer	sh			# SHDR pointer
+char	units[ARB]		# Units
+
+int	i, sn
+bool	streq()
+double	shdr_lw()
+pointer	str, un, un_open()
+errchk	un_open
+
+begin
+	# Check for unknown units.
+	if (streq (units, "display")) {
+	    call malloc (str, SZ_LINE, TY_CHAR)
+	    iferr (call mw_gwattrs (SMW_MW(MW(sh),0), SMW_PAXIS(MW(sh),1),
+		"units_display", Memc[str], SZ_LINE)) {
+		un = NULL
+		call un_copy (MWUN(sh), un)
+	    } else
+		un = un_open (Memc[str])
+	    call mfree (str, TY_CHAR)
+	} else if (streq (units, "default")) {
+	    un = NULL
+	    call un_copy (MWUN(sh), un)
+	} else
+	    un = un_open (units)
+	if (UN_CLASS(un) == UN_UNKNOWN || UN_CLASS(MWUN(sh)) == UN_UNKNOWN) {
+	    call un_close (un)
+	    call error (1, "Cannot convert to specified units")
+	}
+
+	# Update the coordinates.
+	call un_close (UN(sh))
+	UN(sh) = un
+
+	call strcpy (UN_LABEL(UN(sh)), LABEL(sh), LEN_SHDRS)
+	call strcpy (UN_UNITS(UN(sh)), UNITS(sh), LEN_SHDRS)
+
+	sn = SN(sh)
+	W0(sh) = shdr_lw (sh, double(1))
+	W1(sh) = shdr_lw (sh, double(sn))
+	WP(sh) = (W1(sh) - W0(sh)) / (sn - 1)
+	if (SX(sh) != NULL)
+	    do i = 1, sn
+		Memr[SX(sh)+i-1] = shdr_lw (sh, double(i))
+end
+
+
+# SHDR_LW -- Logical to world coordinate transformation.
+# The transformation pointer is generally NULL only after SHDR_LINEAR
+
+double procedure shdr_lw (sh, l)
+
+pointer	sh			# SHDR pointer
+double	l			# Logical coordinate
+double	w			# World coordinate
+
+double	l0, l1, l2, w1, smw_c1trand()
+
+begin
+	l0 = l + NP1(sh) - 1
+	if (CTLW(sh) != NULL) {
+	    switch (SMW_FORMAT(MW(sh))) {
+	    case SMW_ND, SMW_ES:
+		w = smw_c1trand (CTLW(sh), l0)
+	    case SMW_MS:
+		call smw_c2trand (CTLW(sh), l0, double (APINDEX(sh)), w, w1)
+	    }
+	} else {
+	    switch (DC(sh)) {
+	    case DCLOG:
+		w = W0(sh) * 10. ** (log10(W1(sh)/W0(sh)) * (l0-1) / (SN(sh)-1))
+	    case DCFUNC:
+		w = W0(sh)
+		call smw_c2trand (CTWL1(sh), w, double (AP(sh)), l1, w1)
+		w = W1(sh)
+		call smw_c2trand (CTWL1(sh), w, double (AP(sh)), l2, w1)
+		if (SN(sh) > 1)
+		    l1 = (l2 - l1) / (SN(sh) - 1) * (l0 - 1) + l1
+		else
+		    l1 = l0 - 1 + l1
+		call smw_c2trand (CTLW1(sh), l1, double (APINDEX(sh)), w, w1)
+	    default:
+		w = W0(sh) + (l0 - 1) * WP(sh)
+	    }
+	}
+
+	iferr (call un_ctrand (MWUN(sh), UN(sh), w, w, 1))
+	    ;
+	return (w)
+end
+
+
+# SHDR_WL -- World to logical coordinate transformation.
+# The transformation pointer is generally NULL only after SHDR_LINEAR
+
+double procedure shdr_wl (sh, w)
+
+pointer	sh			# SHDR pointer
+double	w			# World coordinate
+double	l			# Logical coordinate
+
+double	w1, l1, l2, smw_c1trand()
+
+begin
+	iferr (call un_ctrand (UN(sh), MWUN(sh), w, w1, 1))
+	    w1 = w
+
+	if (CTWL(sh) != NULL) {
+	    switch (SMW_FORMAT(MW(sh))) {
+	    case SMW_ND, SMW_ES:
+		l = smw_c1trand (CTWL(sh), w1)
+	    case SMW_MS:
+		call smw_c2trand (CTWL(sh), w1, double (AP(sh)),l,l1)
+	    }
+	} else {
+	    switch (DC(sh)) {
+	    case DCLOG:
+		l = log10(w1/W0(sh)) / log10(W1(sh)/W0(sh)) * (SN(sh)-1) + 1
+	    case DCFUNC:
+		call smw_c2trand (CTWL1(sh), w1, double (AP(sh)), l, l1)
+
+		w1 = W0(sh)
+		call smw_c2trand (CTWL1(sh), w1, double (AP(sh)), l1, w1)
+		w1 = W1(sh)
+		call smw_c2trand (CTWL1(sh), w1, double (AP(sh)), l2, w1)
+		if (l1 != l2)
+		    l = (SN(sh) - 1) / (l2 - l1) * (l - l1) + 1
+		else
+		    l = l - l1 + 1
+	    default:
+		l = (w1 - W0(sh)) / WP(sh) + 1
+	    }
+	}
+
+	return (l-NP1(sh)+1)
+end
+
+
+# SHDR_REBIN -- Rebin spectrum to dispersion of reference spectrum.
+# The interpolation function is set by ONEDINTERP.
+
+procedure shdr_rebin (sh, shref)
+
+pointer	sh		# Spectrum to be rebinned
+pointer	shref		# Reference spectrum
+
+char	interp[10]
+int	i, j, type, ia, ib, n, clgwrd()
+real	a, b, sum, asieval(), asigrl()
+double	x, w, xmin, xmax, shdr_lw(), shdr_wl()
+pointer	unref, unsave, asi, spec
+bool	fp_equalr()
+
+begin
+	# Check if rebinning is needed
+	if (DC(sh) == DC(shref) && DC(sh) != DCFUNC &&
+	    fp_equalr (W0(sh), W0(shref)) && fp_equalr(WP(sh), WP(shref)) &&
+	    SN(sh) == SN(shref))
+	    return
+
+	# Do everything in units of reference WCS.
+	unref = UN(shref)
+	unsave = UN(sh)
+	UN(SH) = unref
+
+	call asiinit (asi, clgwrd ("interp", interp, 10, II_FUNCTIONS))
+	do type = 1, SH_NTYPES {
+	    if (SPEC(sh,type) == NULL)
+		next
+
+	    # Fit the interpolation function to the spectrum.
+	    # Extend the interpolation by one pixel at each end.
+
+	    n = SN(sh)
+	    call malloc (spec, n+2, TY_REAL)
+	    call amovr (Memr[SPEC(sh,type)], Memr[spec+1], n)
+	    Memr[spec] = Memr[SPEC(sh,type)]
+	    Memr[spec+n+1] = Memr[SPEC(sh,type)+n-1]
+	    call asifit (asi, Memr[spec], n+2)
+	    call mfree (spec, TY_REAL)
+
+	    xmin = 0.5
+	    xmax = n + 0.5
+
+	    # Reallocate data array
+	    if (n != SN(shref)) {
+		n = SN(shref)
+		call realloc (SPEC(sh,type), n, TY_REAL)
+		call aclrr (Memr[SPEC(sh,type)], n)
+	    }
+	    spec = SPEC(sh,type)
+
+	    # Compute the average flux in each output pixel.
+
+	    x = 0.5
+	    w = shdr_lw (shref, x)
+	    x = shdr_wl (sh, w)
+	    b = max (xmin, min (xmax, x)) + 1
+	    do i = 1, n {
+		x = i + 0.5
+		w = shdr_lw (shref, x)
+		x = shdr_wl (sh, w)
+		a = b
+		b = max (xmin, min (xmax, x)) + 1
+		if (a <= b) {
+		    ia = nint (a + 0.5)
+		    ib = nint (b - 0.5)
+		    if (abs (a+0.5-ia) < .00001 && abs (b-0.5-ib) < .00001) {
+			sum = 0.
+			do j = ia, ib
+			    sum = sum + asieval (asi, real(j))
+			if (ib - ia > 0)
+			    sum = sum / (ib - ia)
+		    } else {
+			sum = asigrl (asi, a, b)
+			if (b - a > 0.)
+			    sum = sum / (b - a)
+		    }
+		} else {
+		    ib = nint (b + 0.5)
+		    ia = nint (a - 0.5)
+		    if (abs (a-0.5-ia) < .00001 && abs (b+0.5-ib) < .00001) {
+			sum = 0.
+			do j = ib, ia
+			    sum = sum + asieval (asi, real(j))
+			if (ia - ib > 0)
+			    sum = sum / (ia - ib)
+		    } else {
+			sum = asigrl (asi, b, a)
+			if (a - b > 0.)
+			    sum = sum / (a - b)
+		    }
+		}
+
+		Memr[spec] = sum
+		spec = spec + 1
+	    }
+	}
+	call asifree (asi)
+
+	# Set the rest of the header.  The coordinate transformations are
+	# canceled to indicate they are not valid for the data.  They
+	# are not freed because the same pointer may be used in other
+	# spectra from the same image.
+
+	if (SN(sh) != n)
+	    call realloc (SX(sh), n, TY_REAL)
+	call amovr (Memr[SX(shref)], Memr[SX(sh)], n)
+	DC(sh) = DC(shref)
+	W0(sh) = W0(shref)
+	W1(sh) = W1(shref)
+	WP(sh) = WP(shref)
+	SN(sh) = SN(shref)
+
+	CTLW(sh) = NULL
+	CTWL(sh) = NULL
+
+	# Restore original units
+	UN(sh) = unsave
+	iferr (call un_ctranr (unref, UN(sh), Memr[SX(sh)], Memr[SX(sh)],
+	    SN(sh)))
+	    ;
+end
+
+
+# SHDR_LINEAR -- Rebin spectrum to linear dispersion.
+# The interpolation function is set by ONEDINTERP
+
+procedure shdr_linear (sh, w0, w1, sn, dc)
+
+pointer	sh		# Spectrum to be rebinned
+real	w0		# Wavelength of first logical pixel
+real	w1		# Wavelength of last logical pixel
+int	sn		# Number of pixels
+int	dc		# Dispersion type (DCLINEAR | DCLOG)
+
+char	interp[10]
+int	i, j, type, ia, ib, n, clgwrd()
+real	w0mw, w1mw, a, b, sum, asieval(), asigrl()
+double	x, w, w0l, wp, xmin, xmax, shdr_wl()
+pointer	unsave, asi, spec
+bool	fp_equalr()
+
+begin
+	# Check if rebinning is needed
+	if (DC(sh) == dc && fp_equalr (W0(sh), w0) &&
+	    fp_equalr (W1(sh), w1) && SN(sh) == sn)
+	    return
+
+	# Do everything in units of MWCS.
+	call un_ctranr (UN(sh), MWUN(sh), w0, w0mw, 1)
+	call un_ctranr (UN(sh), MWUN(sh), w1, w1mw, 1)
+	unsave = UN(sh)
+	UN(SH) = MWUN(sh)
+
+	call asiinit (asi, clgwrd ("interp", interp, 10, II_FUNCTIONS))
+	do type = 1, SH_NTYPES {
+	    if (SPEC(sh,type) == NULL)
+		next
+
+	    # Fit the interpolation function to the spectrum.
+	    # Extend the interpolation by one pixel at each end.
+
+	    n = SN(sh)
+	    call malloc (spec, n+2, TY_REAL)
+	    call amovr (Memr[SPEC(sh,type)], Memr[spec+1], n)
+	    Memr[spec] = Memr[SPEC(sh,type)]
+	    Memr[spec+n+1] = Memr[SPEC(sh,type)+n-1]
+	    call asifit (asi, Memr[spec], n+2)
+	    call mfree (spec, TY_REAL)
+
+	    xmin = 0.5
+	    xmax = n + 0.5
+
+	    # Reallocate spectrum data array
+	    if (n != sn) {
+		n = sn
+		call realloc (SPEC(sh,type), n, TY_REAL)
+	    }
+	    spec = SPEC(sh,type)
+
+	    # Integrate across pixels using ASIGRL.
+
+	    x = 0.5
+	    if (dc == DCLOG) {
+		w0l = log10 (w0mw)
+		wp = (log10 (w1mw) - log10(w0mw)) / (n - 1)
+		w = 10. ** (w0l+(x-1)*wp)
+	    } else {
+		wp = (w1mw - w0mw) / (n - 1)
+		w = w0mw + (x - 1) * wp
+	    }
+	    x = shdr_wl (sh, w)
+	    b = max (xmin, min (xmax, x)) + 1
+	    do i = 1, n {
+		x = i + 0.5
+		if (dc == DCLOG)
+		    w = 10. ** (w0l + (x - 1) * wp)
+		else
+		    w = w0mw + (x - 1) * wp
+		x = shdr_wl (sh, w)
+		a = b
+		b = max (xmin, min (xmax, x)) + 1
+		if (a <= b) {
+		    ia = nint (a + 0.5)
+		    ib = nint (b - 0.5)
+		    if (abs (a+0.5-ia) < .00001 && abs (b-0.5-ib) < .00001) {
+			sum = 0.
+			do j = ia, ib
+			    sum = sum + asieval (asi, real(j))
+			if (ib - ia > 0)
+			    sum = sum / (ib - ia)
+		    } else {
+			sum = asigrl (asi, a, b)
+			if (b - a > 0.)
+			    sum = sum / (b - a)
+		    }
+		} else {
+		    ib = nint (b + 0.5)
+		    ia = nint (a - 0.5)
+		    if (abs (a-0.5-ia) < .00001 && abs (b+0.5-ib) < .00001) {
+			sum = 0.
+			do j = ib, ia
+			    sum = sum + asieval (asi, real(j))
+			if (ia - ib > 0)
+			    sum = sum / (ia - ib)
+		    } else {
+			sum = asigrl (asi, b, a)
+			if (a - b > 0.)
+			    sum = sum / (a - b)
+		    }
+		}
+		Memr[spec] = sum
+		spec = spec + 1
+	    }
+	}
+	call asifree (asi)
+
+	# Set the rest of the header.  The coordinate transformations are
+	# canceled to indicate they are not valid for the data.  They
+	# are not freed because the same pointer may be used in other
+	# spectra from the same image.
+
+	if (SN(sh) != n)
+	    call realloc (SX(sh), n, TY_REAL)
+	do i = 0, n-1 {
+	    if (dc == DCLOG)
+		w = 10. ** (w0l + i * wp)
+	    else
+		w = w0mw + i * wp
+	    Memr[SX(sh)+i] = w
+	}
+	W0(sh) = w0
+	W1(sh) = w1
+	WP(sh) = (w1 - w0) / (sn - 1)
+	SN(sh) = sn
+	NP1(sh) = 1
+	NP2(sh) = sn
+	DC(sh) = dc
+
+	CTLW(sh) = NULL
+	CTWL(sh) = NULL
+
+	# Restore original units
+	UN(sh) = unsave
+	iferr (call un_ctranr (MWUN(sh), UN(sh), Memr[SX(sh)], Memr[SX(sh)],
+	    sn))
+	    ;
+end
+
+
+# SHDR_EXTRACT -- Extract a specific wavelength region.
+
+procedure shdr_extract (sh, w1, w2, rebin)
+
+pointer	sh			# SHDR structure
+real	w1			# Starting wavelength
+real	w2			# Ending wavelength
+bool	rebin			# Rebin wavelength region?
+
+int	i, j, i1, i2, n
+double	l1, l2
+pointer	buf
+bool	fp_equald()
+double	shdr_wl(), shdr_lw()
+errchk	shdr_linear, shdr_lw, shdr_wl
+
+begin
+	l1 = shdr_wl (sh, double (w1))
+	l2 = shdr_wl (sh, double (w2))
+	if (fp_equald(l1,l2) || max(l1,l2) < 1 || min (l1,l2) > SN(sh))
+	    call error (1, "No pixels to extract")
+	l1 = max (1D0, min (double (SN(sh)), l1))
+	l2 = max (1D0, min (double (SN(sh)), l2))
+	i1 = nint (l1)
+	i2 = nint (l2)
+	n = abs (i2 - i1) + 1
+
+	if (rebin) {
+	    l1 = shdr_lw (sh, l1)
+	    l2 = shdr_lw (sh, l2)
+	    if (DC(sh) == DCFUNC)
+		call shdr_linear (sh, real (l1), real (l2), n, DCLINEAR)
+	    else
+		call shdr_linear (sh, real (l1), real (l2), n, DC(sh))
+	} else {
+	    if (i1 == 1 && i2 == SN(sh))
+		return
+
+	    if (i1 <= i2) {
+		do j = 1, SH_NTYPES
+		    if (SPEC(sh,j) != NULL)
+			call amovr (Memr[SPEC(sh,j)+i1-1], Memr[SPEC(sh,j)], n)
+	    } else {
+		call malloc (buf, n, TY_REAL)
+		do j = 1, SH_NTYPES {
+		    if (SPEC(sh,j) != NULL) {
+			do i = i1, i2, -1
+			    Memr[buf+i1-i] = Memr[SPEC(sh,j)+i-1]
+			call amovr (Memr[buf], Memr[SPEC(sh,j)], n)
+		    }
+		}
+		call mfree (buf, TY_REAL)
+	    }
+	    W0(sh) = Memr[SX(sh)]
+	    W1(sh) = Memr[SX(sh)+n-1]
+	    SN(sh) = n
+	    NP1(sh) = 1
+	    NP2(sh) = n
+	    if (n > 1)
+		WP(sh) = (W1(sh) - W0(sh)) / (SN(sh) - 1)
+	    CTLW(sh) = NULL
+	    CTWL(sh) = NULL
+	}
+end
+
+
+# SHDR_GI -- Load an integer value from the header.
+
+procedure shdr_gi (im, field, default, ival)
+
+pointer	im
+char	field[ARB]
+int	default
+int	ival
+
+int	dummy, imaccf(), imgeti()
+
+begin
+	ival = default
+	if (imaccf (im, field) == YES) {
+	    iferr (dummy = imgeti (im, field))
+		call erract (EA_WARN)
+	    else
+		ival = dummy
+	}
+end
+
+
+# SHDR_GR -- Load a real value from the header.
+
+procedure shdr_gr (im, field, default, rval)
+
+pointer	im
+char	field[ARB]
+real	default
+real	rval
+
+int	imaccf()
+real	dummy, imgetr()
+
+begin
+	rval = default
+	if (imaccf (im, field) == YES) {
+	    iferr (dummy = imgetr (im, field))
+		call erract (EA_WARN)
+	    else
+		rval = dummy
+	}
+end
diff --git a/noao/onedspec/smw/smwclose.x b/noao/onedspec/smw/smwclose.x
new file mode 100644
index 00000000..339ebd98
--- /dev/null
+++ b/noao/onedspec/smw/smwclose.x
@@ -0,0 +1,46 @@
+include	<smw.h>
+
+
+# SMW_CLOSE -- Close the SMW data structure.
+# This includes closing the MWCS pointers.
+
+procedure smw_close (smw)
+
+pointer	smw		# SMW pointer
+
+int	i
+pointer	apids
+
+begin
+	if (smw == NULL)
+	    return
+
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    call mfree (SMW_APID(smw), TY_CHAR)
+	    call mw_close (SMW_MW(smw,0))
+	case SMW_ES:
+	    call mfree (SMW_APS(smw), TY_INT)
+	    call mfree (SMW_BEAMS(smw), TY_INT)
+	    call mfree (SMW_APLOW(smw), TY_REAL)
+	    call mfree (SMW_APHIGH(smw), TY_REAL)
+	    call mfree (SMW_APID(smw), TY_CHAR)
+	    apids = SMW_APIDS(smw) - 1
+	    do i = 1, SMW_NSPEC(smw)
+		call mfree (Memi[apids+i], TY_CHAR)
+	    call mfree (SMW_APIDS(smw), TY_POINTER)
+	    call mw_close (SMW_MW(smw,0))
+	case SMW_MS:
+	    call mfree (SMW_APS(smw), TY_INT)
+	    call mfree (SMW_BEAMS(smw), TY_INT)
+	    call mfree (SMW_APLOW(smw), TY_REAL)
+	    call mfree (SMW_APHIGH(smw), TY_REAL)
+	    call mfree (SMW_APID(smw), TY_CHAR)
+	    apids = SMW_APIDS(smw) - 1
+	    do i = 1, SMW_NSPEC(smw)
+		call mfree (Memi[apids+i], TY_CHAR)
+	    do i = 0, SMW_NMW(smw)-1
+		call mw_close (SMW_MW(smw,i))
+	}
+	call mfree (smw, TY_STRUCT)
+end
diff --git a/noao/onedspec/smw/smwct.x b/noao/onedspec/smw/smwct.x
new file mode 100644
index 00000000..b568f759
--- /dev/null
+++ b/noao/onedspec/smw/smwct.x
@@ -0,0 +1,19 @@
+include	<smw.h>
+
+
+# SMW_CT -- Get MCWS CT pointer for the specified physical line.
+
+pointer procedure smw_ct (sct, line)
+
+pointer	sct		#I SMW pointer
+int	line		#I Physical line
+
+begin
+	if (SMW_NCT(sct) == 1)
+	    return (SMW_CT(sct,0))
+
+	if (line < 1 || line > SMW_NSPEC(SMW_SMW(sct)))
+	    call error (1, "smw_ct: aperture not found")
+
+	return (SMW_CT(sct,(line-1)/SMW_NSPLIT))
+end
diff --git a/noao/onedspec/smw/smwctfree.x b/noao/onedspec/smw/smwctfree.x
new file mode 100644
index 00000000..90a506d7
--- /dev/null
+++ b/noao/onedspec/smw/smwctfree.x
@@ -0,0 +1,19 @@
+include	<smw.h>
+
+
+# SMW_CTFREE -- Free a spectral SMW coordinate transform pointer.
+
+procedure smw_ctfree (ct)
+
+pointer	ct		# SMW CT pointer
+int	i
+
+begin
+	if (ct == NULL)
+	    return
+
+	do i = 0, SMW_NCT(ct)-1
+	    call mw_ctfree (SMW_CT(ct,i))
+	call mw_ctfree (SMW_CTL(ct))
+	call mfree (ct, TY_STRUCT)
+end
diff --git a/noao/onedspec/smw/smwctran.gx b/noao/onedspec/smw/smwctran.gx
new file mode 100644
index 00000000..4029aaab
--- /dev/null
+++ b/noao/onedspec/smw/smwctran.gx
@@ -0,0 +1,166 @@
+include	<smw.h>
+
+
+# Evaluate SMW coordinate transform.  These procedures call the
+# MWCS procedures unless the WCS is a split MULTISPEC WCS.  In that
+# case the appropriate piece needs to be determined and the physical
+# line numbers manipulated.  For log sampled spectra conversions
+# must be made for EQUISPEC/NDSPEC.  The convention is that coordinates
+# are always input and output and linear.  Note that the MULTISPEC
+# function driver already takes care of this.
+#
+# SMW_CTRANR -- N dimensional real coordinate transformation.
+# SMW_CTRAND -- N dimensional double coordinate transformation.
+# SMW_C1TRANR -- One dimensional real coordinate transformation.
+# SMW_C1TRAND -- One dimensional double coordinate transformation.
+# SMW_C2TRANR -- Two dimensional real coordinate transformation.
+# SMW_C2TRAND -- Two dimensional double coordinate transformation.
+
+
+$for (rd)
+# SMW_CTRAN -- N dimensional coordinate transformation.
+
+procedure smw_ctran$t (ct, p1, p2, ndim)
+
+pointer	ct		#I SMW CT pointer
+PIXEL	p1[ndim]	#I Input coordinate
+PIXEL	p2[ndim]	#O Output coordinate
+int	ndim		#I Dimensionality
+
+int	i, j, format, daxis, aaxis, dtype, naps
+pointer	smw, aps
+errchk	mw_ctran$t
+
+begin
+	if (SMW_NCT(ct) != 1)
+	    call error (1, "SMW_CTRAN: Wrong WCS type")
+
+	call amov$t (p1, p2, ndim)
+
+	smw = SMW_SMW(ct)
+	format = SMW_FORMAT(smw)
+	daxis = SMW_DAXIS(ct)
+	aaxis = SMW_AAXIS(ct)
+	dtype = SMW_DTYPE(smw)
+	naps = SMW_NSPEC(smw)
+	aps = SMW_APS(smw)
+	switch (format) {
+	case SMW_ND, SMW_ES:
+	    switch (SMW_CTTYPE(ct)) {
+	    case SMW_LW, SMW_PW:
+		call mw_ctran$t (SMW_CT(ct,0), p2, p2, ndim)
+		if (daxis > 0 && dtype == DCLOG)
+		    p2[daxis] = 10. ** max (-20$F, min (20$F, p2[daxis]))
+		if (aaxis > 0 && format == SMW_ES) {
+		    i = max (1, min (naps, nint (p2[aaxis])))
+		    p2[aaxis] = Memi[aps+i-1]
+		}
+	    case SMW_WL, SMW_WP:
+		if (daxis > 0 && dtype == DCLOG)
+		    p2[daxis] = log10 (p2[daxis])
+		if (aaxis > 0 && format == SMW_ES) {
+		    j = nint (p2[aaxis])
+		    p2[aaxis] = 1
+		    do i = 1, naps {
+			if (j == Memi[aps+i-1]) {
+			    p2[aaxis] = i
+			    break
+			}
+		    }
+		}
+		call mw_ctran$t (SMW_CT(ct,0), p2, p2, ndim)
+	    default:
+		call mw_ctran$t (SMW_CT(ct,0), p2, p2, ndim)
+	    }
+	case SMW_MS:
+	    call mw_ctran$t (SMW_CT(ct,0), p1, p2, ndim)
+	}
+end
+
+
+# SMW_C1TRAN -- One dimensional coordinate transformation.
+
+PIXEL procedure smw_c1tran$t (ct, x1)
+
+pointer	ct		#I SMW CT pointer
+PIXEL	x1		#I Input coordinate
+PIXEL	x2		#O Output coordinate
+
+errchk	mw_ctran$t
+
+begin
+	call smw_ctran$t (ct, x1, x2, 1)
+	return (x2)
+end
+
+
+# SMW_C2TRAN -- Two dimensional coordinate transformation.
+
+procedure smw_c2tran$t (ct, x1, y1, x2, y2)
+
+pointer	ct		#I SMW CT pointer
+PIXEL	x1, y1		#I Input coordinates
+PIXEL	x2, y2		#O Output coordinates
+
+PIXEL	p1[2], p2[2]
+int	i, j, naps
+PIXEL	xp, yp
+pointer	aps, smw_ct()
+errchk	smw_ct, mw_c2tran$t
+
+begin
+	# Unsplit WCS.
+	if (SMW_NCT(ct) == 1) {
+	    p1[1] = x1
+	    p1[2] = y1
+	    call smw_ctran$t (ct, p1, p2, 2)
+	    x2 = p2[1]
+	    y2 = p2[2]
+	    return
+	}
+
+	# If we get here then we are dealing with a split MULTISPEC WCS.
+	# Depending on the systems being transformed there may need to
+	# transformation made on the physical coordinate system.
+
+	switch (SMW_CTTYPE(ct)) {
+	case SMW_LW:
+	    call mw_c2tran$t (SMW_CTL(ct), x1, y1, xp, yp)
+	    i = nint (yp)
+	    yp = mod (i-1, SMW_NSPLIT) + 1
+	    call mw_c2tran$t (smw_ct(ct,i), xp, yp, x2, y2)
+	case SMW_PW:
+	    i = nint (y1)
+	    yp = mod (i-1, SMW_NSPLIT) + 1
+	    call mw_c2tran$t (smw_ct(ct,i), x1, yp, x2, y2)
+	case SMW_WL:
+	    aps = SMW_APS(SMW_SMW(ct))
+	    naps = SMW_NSPEC(SMW_SMW(ct))
+	    j = nint (y1)
+	    do i = 1, naps {
+		if (Memi[aps+i-1] == j) {
+		    call mw_c2tran$t (smw_ct(ct,i), x1, y1, xp, yp)
+		    yp = i
+		    call mw_c2tran$t (SMW_CTL(ct), xp, yp, x2, y2)
+		    return
+		}
+	    }
+	    call error (1, "Aperture not found")
+	case SMW_WP:
+	    aps = SMW_APS(SMW_SMW(ct))
+	    naps = SMW_NSPEC(SMW_SMW(ct))
+	    j = nint (y1)
+	    do i = 1, naps {
+		if (Memi[aps+i-1] == j) {
+		    call mw_c2tran$t (smw_ct(ct,i), x1, y1, x2, y2)
+		    y2 = i
+		    return
+		}
+	    }
+	    call error (1, "Aperture not found")
+	default:
+	    x2 = x1
+	    y2 = y1
+	}
+end
+$endfor
diff --git a/noao/onedspec/smw/smwctran.x b/noao/onedspec/smw/smwctran.x
new file mode 100644
index 00000000..38967be2
--- /dev/null
+++ b/noao/onedspec/smw/smwctran.x
@@ -0,0 +1,312 @@
+include	<smw.h>
+
+
+# Evaluate SMW coordinate transform.  These procedures call the
+# MWCS procedures unless the WCS is a split MULTISPEC WCS.  In that
+# case the appropriate piece needs to be determined and the physical
+# line numbers manipulated.  For log sampled spectra conversions
+# must be made for EQUISPEC/NDSPEC.  The convention is that coordinates
+# are always input and output and linear.  Note that the MULTISPEC
+# function driver already takes care of this.
+#
+# SMW_CTRANR -- N dimensional real coordinate transformation.
+# SMW_CTRAND -- N dimensional double coordinate transformation.
+# SMW_C1TRANR -- One dimensional real coordinate transformation.
+# SMW_C1TRAND -- One dimensional double coordinate transformation.
+# SMW_C2TRANR -- Two dimensional real coordinate transformation.
+# SMW_C2TRAND -- Two dimensional double coordinate transformation.
+
+
+
+# SMW_CTRAN -- N dimensional coordinate transformation.
+
+procedure smw_ctranr (ct, p1, p2, ndim)
+
+pointer	ct		#I SMW CT pointer
+real	p1[ndim]	#I Input coordinate
+real	p2[ndim]	#O Output coordinate
+int	ndim		#I Dimensionality
+
+int	i, j, format, daxis, aaxis, dtype, naps
+pointer	smw, aps
+errchk	mw_ctranr
+
+begin
+	if (SMW_NCT(ct) != 1)
+	    call error (1, "SMW_CTRAN: Wrong WCS type")
+
+	call amovr (p1, p2, ndim)
+
+	smw = SMW_SMW(ct)
+	format = SMW_FORMAT(smw)
+	daxis = SMW_DAXIS(ct)
+	aaxis = SMW_AAXIS(ct)
+	dtype = SMW_DTYPE(smw)
+	naps = SMW_NSPEC(smw)
+	aps = SMW_APS(smw)
+	switch (format) {
+	case SMW_ND, SMW_ES:
+	    switch (SMW_CTTYPE(ct)) {
+	    case SMW_LW, SMW_PW:
+		call mw_ctranr (SMW_CT(ct,0), p2, p2, ndim)
+		if (daxis > 0 && dtype == DCLOG)
+		    p2[daxis] = 10. ** max (-20.0, min (20.0, p2[daxis]))
+		if (aaxis > 0 && format == SMW_ES) {
+		    i = max (1, min (naps, nint (p2[aaxis])))
+		    p2[aaxis] = Memi[aps+i-1]
+		}
+	    case SMW_WL, SMW_WP:
+		if (daxis > 0 && dtype == DCLOG)
+		    p2[daxis] = log10 (p2[daxis])
+		if (aaxis > 0 && format == SMW_ES) {
+		    j = nint (p2[aaxis])
+		    p2[aaxis] = 1
+		    do i = 1, naps {
+			if (j == Memi[aps+i-1]) {
+			    p2[aaxis] = i
+			    break
+			}
+		    }
+		}
+		call mw_ctranr (SMW_CT(ct,0), p2, p2, ndim)
+	    default:
+		call mw_ctranr (SMW_CT(ct,0), p2, p2, ndim)
+	    }
+	case SMW_MS:
+	    call mw_ctranr (SMW_CT(ct,0), p1, p2, ndim)
+	}
+end
+
+
+# SMW_C1TRAN -- One dimensional coordinate transformation.
+
+real procedure smw_c1tranr (ct, x1)
+
+pointer	ct		#I SMW CT pointer
+real	x1		#I Input coordinate
+real	x2		#O Output coordinate
+
+errchk	mw_ctranr
+
+begin
+	call smw_ctranr (ct, x1, x2, 1)
+	return (x2)
+end
+
+
+# SMW_C2TRAN -- Two dimensional coordinate transformation.
+
+procedure smw_c2tranr (ct, x1, y1, x2, y2)
+
+pointer	ct		#I SMW CT pointer
+real	x1, y1		#I Input coordinates
+real	x2, y2		#O Output coordinates
+
+real	p1[2], p2[2]
+int	i, j, naps
+real	xp, yp
+pointer	aps, smw_ct()
+errchk	smw_ct, mw_c2tranr
+
+begin
+	# Unsplit WCS.
+	if (SMW_NCT(ct) == 1) {
+	    p1[1] = x1
+	    p1[2] = y1
+	    call smw_ctranr (ct, p1, p2, 2)
+	    x2 = p2[1]
+	    y2 = p2[2]
+	    return
+	}
+
+	# If we get here then we are dealing with a split MULTISPEC WCS.
+	# Depending on the systems being transformed there may need to
+	# transformation made on the physical coordinate system.
+
+	switch (SMW_CTTYPE(ct)) {
+	case SMW_LW:
+	    call mw_c2tranr (SMW_CTL(ct), x1, y1, xp, yp)
+	    i = nint (yp)
+	    yp = mod (i-1, SMW_NSPLIT) + 1
+	    call mw_c2tranr (smw_ct(ct,i), xp, yp, x2, y2)
+	case SMW_PW:
+	    i = nint (y1)
+	    yp = mod (i-1, SMW_NSPLIT) + 1
+	    call mw_c2tranr (smw_ct(ct,i), x1, yp, x2, y2)
+	case SMW_WL:
+	    aps = SMW_APS(SMW_SMW(ct))
+	    naps = SMW_NSPEC(SMW_SMW(ct))
+	    j = nint (y1)
+	    do i = 1, naps {
+		if (Memi[aps+i-1] == j) {
+		    call mw_c2tranr (smw_ct(ct,i), x1, y1, xp, yp)
+		    yp = i
+		    call mw_c2tranr (SMW_CTL(ct), xp, yp, x2, y2)
+		    return
+		}
+	    }
+	    call error (1, "Aperture not found")
+	case SMW_WP:
+	    aps = SMW_APS(SMW_SMW(ct))
+	    naps = SMW_NSPEC(SMW_SMW(ct))
+	    j = nint (y1)
+	    do i = 1, naps {
+		if (Memi[aps+i-1] == j) {
+		    call mw_c2tranr (smw_ct(ct,i), x1, y1, x2, y2)
+		    y2 = i
+		    return
+		}
+	    }
+	    call error (1, "Aperture not found")
+	default:
+	    x2 = x1
+	    y2 = y1
+	}
+end
+
+# SMW_CTRAN -- N dimensional coordinate transformation.
+
+procedure smw_ctrand (ct, p1, p2, ndim)
+
+pointer	ct		#I SMW CT pointer
+double	p1[ndim]	#I Input coordinate
+double	p2[ndim]	#O Output coordinate
+int	ndim		#I Dimensionality
+
+int	i, j, format, daxis, aaxis, dtype, naps
+pointer	smw, aps
+errchk	mw_ctrand
+
+begin
+	if (SMW_NCT(ct) != 1)
+	    call error (1, "SMW_CTRAN: Wrong WCS type")
+
+	call amovd (p1, p2, ndim)
+
+	smw = SMW_SMW(ct)
+	format = SMW_FORMAT(smw)
+	daxis = SMW_DAXIS(ct)
+	aaxis = SMW_AAXIS(ct)
+	dtype = SMW_DTYPE(smw)
+	naps = SMW_NSPEC(smw)
+	aps = SMW_APS(smw)
+	switch (format) {
+	case SMW_ND, SMW_ES:
+	    switch (SMW_CTTYPE(ct)) {
+	    case SMW_LW, SMW_PW:
+		call mw_ctrand (SMW_CT(ct,0), p2, p2, ndim)
+		if (daxis > 0 && dtype == DCLOG)
+		    p2[daxis] = 10. ** max (-20.0D0, min (20.0D0, p2[daxis]))
+		if (aaxis > 0 && format == SMW_ES) {
+		    i = max (1, min (naps, nint (p2[aaxis])))
+		    p2[aaxis] = Memi[aps+i-1]
+		}
+	    case SMW_WL, SMW_WP:
+		if (daxis > 0 && dtype == DCLOG)
+		    p2[daxis] = log10 (p2[daxis])
+		if (aaxis > 0 && format == SMW_ES) {
+		    j = nint (p2[aaxis])
+		    p2[aaxis] = 1
+		    do i = 1, naps {
+			if (j == Memi[aps+i-1]) {
+			    p2[aaxis] = i
+			    break
+			}
+		    }
+		}
+		call mw_ctrand (SMW_CT(ct,0), p2, p2, ndim)
+	    default:
+		call mw_ctrand (SMW_CT(ct,0), p2, p2, ndim)
+	    }
+	case SMW_MS:
+	    call mw_ctrand (SMW_CT(ct,0), p1, p2, ndim)
+	}
+end
+
+
+# SMW_C1TRAN -- One dimensional coordinate transformation.
+
+double procedure smw_c1trand (ct, x1)
+
+pointer	ct		#I SMW CT pointer
+double	x1		#I Input coordinate
+double	x2		#O Output coordinate
+
+errchk	mw_ctrand
+
+begin
+	call smw_ctrand (ct, x1, x2, 1)
+	return (x2)
+end
+
+
+# SMW_C2TRAN -- Two dimensional coordinate transformation.
+
+procedure smw_c2trand (ct, x1, y1, x2, y2)
+
+pointer	ct		#I SMW CT pointer
+double	x1, y1		#I Input coordinates
+double	x2, y2		#O Output coordinates
+
+double	p1[2], p2[2]
+int	i, j, naps
+double	xp, yp
+pointer	aps, smw_ct()
+errchk	smw_ct, mw_c2trand
+
+begin
+	# Unsplit WCS.
+	if (SMW_NCT(ct) == 1) {
+	    p1[1] = x1
+	    p1[2] = y1
+	    call smw_ctrand (ct, p1, p2, 2)
+	    x2 = p2[1]
+	    y2 = p2[2]
+	    return
+	}
+
+	# If we get here then we are dealing with a split MULTISPEC WCS.
+	# Depending on the systems being transformed there may need to
+	# transformation made on the physical coordinate system.
+
+	switch (SMW_CTTYPE(ct)) {
+	case SMW_LW:
+	    call mw_c2trand (SMW_CTL(ct), x1, y1, xp, yp)
+	    i = nint (yp)
+	    yp = mod (i-1, SMW_NSPLIT) + 1
+	    call mw_c2trand (smw_ct(ct,i), xp, yp, x2, y2)
+	case SMW_PW:
+	    i = nint (y1)
+	    yp = mod (i-1, SMW_NSPLIT) + 1
+	    call mw_c2trand (smw_ct(ct,i), x1, yp, x2, y2)
+	case SMW_WL:
+	    aps = SMW_APS(SMW_SMW(ct))
+	    naps = SMW_NSPEC(SMW_SMW(ct))
+	    j = nint (y1)
+	    do i = 1, naps {
+		if (Memi[aps+i-1] == j) {
+		    call mw_c2trand (smw_ct(ct,i), x1, y1, xp, yp)
+		    yp = i
+		    call mw_c2trand (SMW_CTL(ct), xp, yp, x2, y2)
+		    return
+		}
+	    }
+	    call error (1, "Aperture not found")
+	case SMW_WP:
+	    aps = SMW_APS(SMW_SMW(ct))
+	    naps = SMW_NSPEC(SMW_SMW(ct))
+	    j = nint (y1)
+	    do i = 1, naps {
+		if (Memi[aps+i-1] == j) {
+		    call mw_c2trand (smw_ct(ct,i), x1, y1, x2, y2)
+		    y2 = i
+		    return
+		}
+	    }
+	    call error (1, "Aperture not found")
+	default:
+	    x2 = x1
+	    y2 = y1
+	}
+end
+
diff --git a/noao/onedspec/smw/smwdaxis.x b/noao/onedspec/smw/smwdaxis.x
new file mode 100644
index 00000000..0bea9375
--- /dev/null
+++ b/noao/onedspec/smw/smwdaxis.x
@@ -0,0 +1,109 @@
+include	<smw.h>
+
+define	CTYPES	"|LAMBDA|FREQ|WAVELENGTH|VELO|VELO-LSR|VELO-HEL|VELO-OBS|"
+
+# SMW_DAXIS -- Set physical dispersion axis and summing factors.
+# A default value of zero for the dispersion axis will cause the dispersion
+# axis to be sought in the image header and, if not found, from the CL
+# "dispaxis" parameter.  A default value of zero for the summing factors will
+# cause them to be queried from the CL "nsum" parameter.  A default value of
+# INDEFI in either parameter will leave the current default unchanged.
+#
+# When this procedure is called with an SMW and IMIO pointer the SMW
+# pointer is updated to desired default dispersion axis and summing
+# parameters.
+
+procedure smw_daxis (smw, im, daxisp, nsum1, nsum2)
+
+pointer	smw			#I SMW pointer
+pointer	im			#I IMIO pointer
+int	daxisp			#I Default dispersion axis
+int	nsum1, nsum2		#I Default summing factors
+
+int	i, da, ns[2]
+int	imgeti(), clgeti(), clscan(), nscan(), nowhite(), strdic()
+pointer	sp, key, val
+data	da/0/, ns/0,0/
+errchk	clgeti
+
+begin
+	# Set defaults.
+	# A value of 0 will use the image DISPAXIS or query the CL and
+	# a value of INDEFI will leave the current default unchanged.
+
+	if (!IS_INDEFI (daxisp))
+	    da = daxisp
+	if (!IS_INDEFI (nsum1))
+	    ns[1] = nsum1
+	if (!IS_INDEFI (nsum2))
+	    ns[2] = nsum2
+
+	if (smw == NULL)
+	    return
+
+	# This procedure is specific to the NDSPEC format.
+	if (SMW_FORMAT(smw) != SMW_ND)
+	    return
+
+	# Set dispersion axis.
+	if (da == 0) {
+	    if (im == NULL)
+		SMW_PAXIS(smw,1) = clgeti ("dispaxis")
+	    else {
+		iferr (SMW_PAXIS(smw,1) = imgeti (im, "DISPAXIS")) {
+		    SMW_PAXIS(smw,1) = clgeti ("dispaxis")
+		    call smark (sp)
+		    call salloc (key, 8, TY_CHAR)
+		    call salloc (val, SZ_FNAME, TY_CHAR)
+		    do i = 1, 7 {
+			call sprintf (Memc[key], 8, "CTYPE%d")
+			    call pargi (i)
+			iferr (call imgstr (im, Memc[key], Memc[val], SZ_FNAME))
+			    break
+			if (nowhite (Memc[val], Memc[val], SZ_FNAME) > 0) {
+			    call strupr (Memc[val])
+			    if (strdic(Memc[val],Memc[val],SZ_FNAME,CTYPES)>0) {
+				SMW_PAXIS(smw,1) = i
+				break
+			    }
+			}
+		    }
+		    call sfree (sp)
+		}
+		if (SMW_PAXIS(smw,1) < 1 || SMW_PAXIS(smw,1) > 7) {
+		    i = SMW_PAXIS(smw,1)
+		    SMW_PAXIS(smw,1) = clgeti ("dispaxis")
+		    call eprintf (
+	"WARNING: Image header dispersion axis %d invalid. Using axis %d.\n")
+			call pargi (i)
+			call pargi (SMW_PAXIS(smw,1))
+		}
+	    }
+	} else
+	    SMW_PAXIS(smw,1) = da
+
+	# Set summing parameters.
+	if (ns[1] == 0 || ns[2] == 0) {
+	    if (clscan("nsum") == EOF)
+		call error (1, "smw_daxis: Error in 'nsum' parameter") 
+	    call gargi (i)
+	    if (ns[1] == 0) {
+		if (nscan() == 1)
+		    SMW_NSUM(smw,1) = max (1, i)
+		else
+		    call error (1, "smw_daxis: Error in 'nsum' parameter")
+	    } else
+		SMW_NSUM(smw,1) = ns[1]
+	    call gargi (i)
+	    if (ns[2] == 0) {
+		if (nscan() == 2)
+		    SMW_NSUM(smw,2) = max (1, i)
+		else
+		    SMW_NSUM(smw,2) = SMW_NSUM(smw,1)
+	    } else
+		SMW_NSUM(smw,2) = ns[2]
+	} else {
+	    SMW_NSUM(smw,1) = ns[1]
+	    SMW_NSUM(smw,2) = ns[2]
+	}
+end
diff --git a/noao/onedspec/smw/smwequispec.x b/noao/onedspec/smw/smwequispec.x
new file mode 100644
index 00000000..5cda57c0
--- /dev/null
+++ b/noao/onedspec/smw/smwequispec.x
@@ -0,0 +1,86 @@
+include <imhdr.h>
+include	<mwset.h>
+include	<smw.h>
+
+
+# SMW_EQUISPEC -- Setup the EQUISPEC SMW parameters.
+# The aperture information is in the APNUM and APID keywords and the
+# WCS information is in the linear MWCS.
+
+procedure smw_equispec (im, smw)
+
+pointer	im			#I IMIO pointer
+pointer	smw			#U MWCS pointer input SMW pointer output
+
+int	i, j, k, nchar, ap, beam, dtype, nw
+double	w1, dw, z
+real	aplow[2], aphigh[2], mw_c1tranr()
+pointer	sp, key, val, wterm, mw, ct, mw_sctran()
+int	imgeti(), mw_stati(), ctoi(), ctor()
+errchk	imgstr, mw_gwtermd, mw_sctran
+errchk	smw_open, smw_saxes, smw_swattrs, smw_sapid
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+
+	# Determine the dispersion parameters
+	mw = smw
+	i = mw_stati (mw, MW_NDIM)
+	call salloc (wterm, 2*i+i*i, TY_DOUBLE)
+	call mw_gwtermd (mw, Memd[wterm], Memd[wterm+i], Memd[wterm+2*i], i)
+	w1 = Memd[wterm+i]
+	dw = Memd[wterm+2*i]
+
+	# Determine the number of physical pixels.
+	ct = mw_sctran (mw, "logical", "physical", 1)
+	nw = max (mw_c1tranr (ct, 1.), mw_c1tranr (ct, real(IM_LEN(im,1))))
+	call mw_ctfree (ct)
+
+	# Determine the dispersion type.
+	iferr (dtype = imgeti (im, "DC-FLAG"))
+	    dtype = DCNO
+	if (dtype==DCLOG) {
+	    if (abs(w1)>20. || abs(w1+(nw-1)*dw)>20.)
+		dtype = DCLINEAR
+	    else {
+		w1 = 10D0 ** w1
+		dw = w1 * (10D0 ** ((nw-1)*dw) - 1) / (nw - 1)
+	    }
+	}
+
+	# Set the SMW data structure.
+	call smw_open (smw, NULL, im)
+	do i = 1, SMW_NSPEC(smw) {
+	    call smw_mw (smw, i, 1, mw, j, k)
+	    if (j < 1000)
+		call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
+	    else
+		call sprintf (Memc[key], SZ_FNAME, "AP%d")
+		call pargi (j)
+	    call imgstr (im, Memc[key], Memc[val], SZ_LINE)
+	    k = 1
+	    nchar = ctoi (Memc[val], k, ap)
+	    nchar = ctoi (Memc[val], k, beam)
+	    if (ctor (Memc[val], k, aplow[1]) == 0)
+		aplow[1] = INDEF
+	    if (ctor (Memc[val], k, aphigh[1]) == 0)
+		aphigh[1] = INDEF
+	    if (ctor (Memc[val], k, aplow[2]) == 0)
+		aplow[2] = INDEF
+	    if (ctor (Memc[val], k, aphigh[2]) == 0)
+		aphigh[2] = INDEF
+	    z = 0.
+
+	    call smw_swattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, "")
+
+	    call sprintf (Memc[key], SZ_FNAME, "APID%d")
+		call pargi (j)
+	    ifnoerr (call imgstr (im, Memc[key], Memc[val], SZ_LINE))
+		call smw_sapid (smw, i, 1, Memc[val])
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwesms.x b/noao/onedspec/smw/smwesms.x
new file mode 100644
index 00000000..d1b8a368
--- /dev/null
+++ b/noao/onedspec/smw/smwesms.x
@@ -0,0 +1,96 @@
+include	<mwset.h>
+include	<smw.h>
+
+
+# SMW_ESMS -- Convert EQUISPEC WCS into MULTISPEC WCS.
+# This is called by SMW_SWATTRS when the equal linear coordinate system
+# requirement of the EQUISPEC WCS is violated.
+
+procedure smw_esms (smw)
+
+pointer	smw			#U SMW pointer
+
+int	i, j, k, pdim1, pdim2, ap, beam, dtype, nw, axes[2]
+double	w1, dw, z
+real	aplow, aphigh
+pointer	sp, key, str, lterm, mw, mw1, mw2, apid, mw_open()
+data	axes/1,2/
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (lterm, 12, TY_DOUBLE)
+
+	# Set the basic MWCS
+	mw1 = SMW_MW(smw,0)
+	pdim1 = SMW_PDIM(smw)
+	pdim2 = max (2, pdim1)
+	mw2 = mw_open (NULL, pdim2)
+	call mw_newsystem (mw2, "multispec", pdim2)
+	call mw_swtype (mw2, axes, 2, "multispec", "")
+	if (pdim2 > 2)
+	    call mw_swtype (mw2, 3, 1, "linear", "")
+	call mw_gltermd (mw1, Memd[lterm+pdim2], Memd[lterm], pdim1)
+	if (pdim1 == 1) {
+	    Memd[lterm+1] = 0.
+	    Memd[lterm+3] = 0.
+	    Memd[lterm+4] = 0.
+	    Memd[lterm+5] = 1.
+	}
+	call mw_sltermd (mw2, Memd[lterm+pdim2], Memd[lterm], pdim2)
+	ifnoerr (call mw_gwattrs (mw1, 1, "label", Memc[str], SZ_LINE))
+	    call mw_swattrs (mw2, 1, "label", Memc[str])
+	ifnoerr (call mw_gwattrs (mw1, 1, "units", Memc[str], SZ_LINE))
+	    call mw_swattrs (mw2, 1, "units", Memc[str])
+	ifnoerr (call mw_gwattrs (mw1, 1, "units_display", Memc[str], SZ_LINE))
+	    call mw_swattrs (mw2, 1, "units_display", Memc[str])
+
+	 # Write the MULTISPEC WCS
+	dtype = SMW_DTYPE(smw)
+	w1 = SMW_W1(smw)
+	dw = SMW_DW(smw)
+	nw = SMW_NW(smw)
+	z = SMW_Z(smw)
+	if (dtype == DCLOG) {
+	    dw = log10 ((w1+(nw-1)*dw)/w1)/(nw-1)
+	    w1 = log10 (w1)
+	}
+
+         call smw_open (mw2, smw, 0)
+         do i = 1, SMW_NSPEC(smw) {
+	    ap = Memi[SMW_APS(smw)+i-1]
+	    beam = Memi[SMW_BEAMS(smw)+i-1]
+	    aplow = Memr[SMW_APLOW(smw)+2*i-2]
+	    aphigh = Memr[SMW_APHIGH(smw)+2*i-2]
+	    apid = Memi[SMW_APIDS(smw)+i-1]
+	    
+	    call smw_mw (mw2, i, 1, mw, j, k)
+	    call sprintf (Memc[key], SZ_FNAME, "spec%d")
+		call pargi (j)
+	    call sprintf (Memc[str], SZ_LINE,
+		"%d %d %d %.14g %.14g %d %.14g %.2f %.2f")
+		call pargi (ap)
+		call pargi (beam)
+		call pargi (dtype)
+		call pargd (w1)
+		call pargd (dw)
+		call pargi (nw)
+		call pargd (z)
+		call pargr (aplow)
+		call pargr (aphigh)
+	    call mw_swattrs (mw, 2, Memc[key], Memc[str])
+
+	    if (apid != NULL)
+		call smw_sapid (mw2, i, 1, Memc[apid])
+
+	    # This is used if there is a split MULTISPEC WCS.
+	    if (SMW_APS(mw2) != NULL)
+		Memi[SMW_APS(mw2)+i-1] = ap
+	}
+
+	call smw_close (smw)
+	smw = mw2
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwgapid.x b/noao/onedspec/smw/smwgapid.x
new file mode 100644
index 00000000..214be533
--- /dev/null
+++ b/noao/onedspec/smw/smwgapid.x
@@ -0,0 +1,30 @@
+include	<smw.h>
+
+
+# SMW_GAPID -- Get aperture id.
+
+procedure smw_gapid (smw, index1, index2, apid, maxchar)
+
+pointer	smw				#I SMW pointer
+int	index1				#I Spectrum index
+int	index2				#I Spectrum index
+char	apid[maxchar]			#O Aperture id
+int	maxchar				#I Maximum number of characters
+
+pointer	ptr
+
+begin
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    call strcpy (Memc[SMW_APID(smw)], apid, maxchar)
+	case SMW_ES, SMW_MS:
+	    if (index1 < 0 || index1 > SMW_NSPEC(smw))
+		call error (1, "smw_gapid: index out of bounds")
+
+	    ptr = Memi[SMW_APIDS(smw)+index1-1]
+	    if (index1 == 0 || ptr == NULL)
+		call strcpy (Memc[SMW_APID(smw)], apid, maxchar)
+	    else
+		call strcpy (Memc[ptr], apid, maxchar)
+	}
+end
diff --git a/noao/onedspec/smw/smwgwattrs.x b/noao/onedspec/smw/smwgwattrs.x
new file mode 100644
index 00000000..4084fd4c
--- /dev/null
+++ b/noao/onedspec/smw/smwgwattrs.x
@@ -0,0 +1,134 @@
+include	<error.h>
+include	<smw.h>
+
+
+# SMW_GWATTRS -- Get spectrum attribute parameters.
+# BE CAREFUL OF OUTPUT VARIABLES BEING THE SAME MEMORY ADDRESS!
+
+procedure smw_gwattrs (smw, index1, index2, ap, beam, dtype, w1, dw, nw, z,
+	aplow, aphigh, coeff)
+
+pointer	smw				# SMW pointer
+int	index1				# Spectrum index
+int	index2				# Spectrum index
+int	ap				# Aperture number
+int	beam				# Beam number
+int	dtype				# Dispersion type
+double	w1				# Starting coordinate
+double	dw				# Coordinate interval
+int	nw				# Number of valid pixels
+double	z				# Redshift factor
+real	aplow[2], aphigh[2]		# Aperture limits
+pointer	coeff				# Nonlinear coeff string (input/output)
+
+int	i, j, n, ip, sz_coeff, strlen(), ctoi(), ctor(), ctod()
+double	a, b
+pointer	sp, key, mw
+errchk	smw_mw, mw_gwattrs
+
+data	sz_coeff /SZ_LINE/
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	if (coeff == NULL)
+	    call malloc (coeff, sz_coeff, TY_CHAR)
+	else
+	    call realloc (coeff, sz_coeff, TY_CHAR)
+
+	# Determine parameters based on the SMW format.
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    call smw_mw (smw, index1, index2, mw, i, j)
+
+	    dtype = SMW_DTYPE(smw)
+	    nw = SMW_NW(smw)
+	    w1 = SMW_W1(smw)
+	    dw = SMW_DW(smw)
+	    z = SMW_Z(smw)
+
+	    ap = index1
+	    beam = 0
+	    aplow[1] = 1
+	    aphigh[1] = 1
+	    aplow[2] = 1
+	    aphigh[2] = 1
+	    if (SMW_LDIM(smw) > 1) {
+		aplow[1] = i - (SMW_NSUM(smw,1)-1) / 2
+		aphigh[1] = nint (aplow[1]) + SMW_NSUM(smw,1) - 1
+		aplow[1] = max (1, nint (aplow[1]))
+		aphigh[1] = min (SMW_LLEN(smw,2), nint (aphigh[1]))
+	    }
+	    if (SMW_LDIM(smw) > 2) {
+		aplow[2] = j - (SMW_NSUM(smw,2)-1) / 2
+		aphigh[2] = nint (aplow[2]) + SMW_NSUM(smw,2) - 1
+		aplow[2] = max (1, nint (aplow[2]))
+		aphigh[2] = min (SMW_LLEN(smw,3), nint (aphigh[2]))
+	    }
+
+	    Memc[coeff] = EOS
+	case SMW_ES:
+	    call smw_mw (smw, index1, index2, mw, i, j)
+
+	    dtype = SMW_DTYPE(smw)
+	    nw = SMW_NW(smw)
+	    w1 = SMW_W1(smw)
+	    dw = SMW_DW(smw)
+	    z = SMW_Z(smw)
+
+	    ap = Memi[SMW_APS(smw)+index1-1]
+	    beam = Memi[SMW_BEAMS(smw)+index1-1]
+	    aplow[1] = Memr[SMW_APLOW(smw)+2*index1-2]
+	    aphigh[1] = Memr[SMW_APHIGH(smw)+2*index1-2]
+	    aplow[2] = Memr[SMW_APLOW(smw)+2*index1-1]
+	    aphigh[2] = Memr[SMW_APHIGH(smw)+2*index1-1]
+
+	    Memc[coeff] = EOS
+	case SMW_MS:
+	    call smw_mw (smw, index1, index2, mw, i, j)
+
+	    call sprintf (Memc[key], SZ_FNAME, "spec%d")
+		call pargi (i)
+
+	    call mw_gwattrs (mw, 2, Memc[key], Memc[coeff], sz_coeff)
+	    while (strlen (Memc[coeff]) == sz_coeff) {
+		sz_coeff = 2 * sz_coeff
+		call realloc (coeff, sz_coeff, TY_CHAR)
+		call mw_gwattrs (mw, 2, Memc[key], Memc[coeff], sz_coeff)
+	    }
+
+	    ip = 1
+	    i = ctoi (Memc[coeff], ip, ap)
+	    i = ctoi (Memc[coeff], ip, beam)
+	    i = ctoi (Memc[coeff], ip, j)
+	    i = ctod (Memc[coeff], ip, a)
+	    i = ctod (Memc[coeff], ip, b)
+	    i = ctoi (Memc[coeff], ip, n)
+	    i = ctod (Memc[coeff], ip, z)
+	    i = ctor (Memc[coeff], ip, aplow[1])
+	    i = ctor (Memc[coeff], ip, aphigh[1])
+	    aplow[2] = INDEF
+	    aphigh[2] = INDEF
+	    if (Memc[coeff+ip-1] != EOS)
+		call strcpy (Memc[coeff+ip], Memc[coeff], sz_coeff)
+	    else
+		Memc[coeff] = EOS
+
+	    if (j==DCLOG) {
+		if (abs(a)>20. || abs(a+(n-1)*b)>20.)
+		    j = DCLINEAR
+		else {
+		    a = 10D0 ** a
+		    b = a * (10D0 ** ((n-1)*b) - 1) / (n - 1)
+		}
+	    }
+
+	    dtype = j
+	    w1 = a
+	    dw = b
+	    nw = n
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwmerge.x b/noao/onedspec/smw/smwmerge.x
new file mode 100644
index 00000000..d3e09bd1
--- /dev/null
+++ b/noao/onedspec/smw/smwmerge.x
@@ -0,0 +1,102 @@
+include	<mwset.h>
+include	<smw.h>
+
+
+# SMW_MERGE -- Merge split MWCS array to a single MWCS.
+
+procedure smw_merge (smw)
+
+pointer	smw			#U Input split WCS, output single WCS
+
+int	i, pdim, naps, format, beam, dtype, dtype1, nw, nw1
+int	ap, axes[3]
+double	w1, dw, z, w11, dw1, z1
+real	aplow[2], aphigh[2]
+pointer	sp, key, val, term, coeff, mw, mw1, mw_open()
+data	axes/1,2,3/
+
+begin
+	if (SMW_NMW(smw) == 1)
+	    return
+
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (term, 15, TY_DOUBLE)
+	coeff = NULL
+
+	pdim = SMW_PDIM(smw)
+	naps = SMW_NSPEC(smw)
+	mw1 = SMW_MW(smw,0)
+
+	# Determine output WCS format.
+	format = SMW_ES
+	do i = 1, naps {
+	    call smw_gwattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, coeff)
+	    if (i == 1) {
+		dtype1 = dtype
+		w11 = w1
+		dw1 = dw
+		z1 = z
+		nw1 = nw
+	    }
+	    if (dtype>1||dtype!=dtype1||w1!=w11||dw!=dw1||nw!=nw1||z!=z1) {
+		format = SMW_MS
+		break
+	    }
+	}
+
+	# Setup WCS.
+	switch (format) {
+	case SMW_ES:
+	    mw = mw_open (NULL, pdim)
+	    call mw_newsystem (mw, "equispec", pdim)
+	    call mw_swtype (mw, axes, pdim, "linear", "")
+
+	case SMW_MS:
+	    mw = mw_open (NULL, pdim)
+	    call mw_newsystem (mw, "multispec", pdim)
+	    call mw_swtype (mw, axes, pdim, "multispec", "")
+	    if (pdim > 2)
+		call mw_swtype (mw, 3, 1, "linear", "")
+	}
+
+	ifnoerr (call mw_gwattrs (mw1, 1, "label", Memc[val], SZ_LINE))
+	    call mw_swattrs (mw, 1, "label", Memc[val])
+	ifnoerr (call mw_gwattrs (mw1, 1, "units", Memc[val], SZ_LINE))
+	    call mw_swattrs (mw, 1, "units", Memc[val])
+	ifnoerr (call mw_gwattrs (mw1, 1, "units_display", Memc[val], SZ_LINE))
+	    call mw_swattrs (mw, 1, "units_display", Memc[val])
+	call mw_gltermd (mw1, Memd[term+pdim], Memd[term], pdim)
+	call mw_sltermd (mw, Memd[term+pdim], Memd[term], pdim)
+	call mw_gwtermd (mw1, Memd[term], Memd[term+pdim],
+	    Memd[term+2*pdim], pdim)
+	Memd[term] = 1.
+	Memd[term+pdim] = w1 / (1 + z)
+	Memd[term+2*pdim] = dw / (1 + z)
+	call mw_swtermd (mw, Memd[term], Memd[term+pdim],
+	    Memd[term+2*pdim], pdim)
+
+	# Set the SMW structure.
+	call smw_open (mw, smw, NULL)
+	if (format == SMW_MS) {
+	    do i = 1, SMW_NMW(mw) - 1
+		call mw_close (SMW_MW(mw,i))
+	    SMW_NMW(mw) = 1
+	}
+	do i = 1, naps {
+	    call smw_gwattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, coeff)
+	    call smw_swattrs (mw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, Memc[coeff])
+	    call smw_gapid (smw, i, 1, Memc[val], SZ_LINE)
+	    call smw_sapid (mw, i, 1, Memc[val])
+	}
+
+	call smw_close (smw)
+	smw = mw
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwmultispec.x b/noao/onedspec/smw/smwmultispec.x
new file mode 100644
index 00000000..18e2dbd0
--- /dev/null
+++ b/noao/onedspec/smw/smwmultispec.x
@@ -0,0 +1,30 @@
+include	<smw.h>
+
+
+# SMW_MULTISPEC -- Setup the MULTISPEC SMW parameters.
+
+procedure smw_multispec (im, smw)
+
+pointer	im			#I IMIO pointer
+pointer	smw			#U MWCS pointer input SMW pointer output
+
+int	i, j, k
+pointer	sp, key, val, mw
+errchk	smw_open, smw_saxes, smw_sapid
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+
+	call smw_open (smw, NULL, im)
+	do i = 1, SMW_NSPEC(smw) {
+	    call smw_mw (smw, i, 1, mw, j, k)
+	    call sprintf (Memc[key], SZ_FNAME, "APID%d")
+		call pargi (j)
+	    ifnoerr (call imgstr (im, Memc[key], Memc[val], SZ_LINE))
+		call smw_sapid (smw, i, 1, Memc[val])
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwmw.x b/noao/onedspec/smw/smwmw.x
new file mode 100644
index 00000000..a79aaf98
--- /dev/null
+++ b/noao/onedspec/smw/smwmw.x
@@ -0,0 +1,38 @@
+include	<smw.h>
+
+
+# SMW_MW -- Get MWCS pointer and coordinates from spectrum line and band
+
+procedure smw_mw (smw, line, band, mw, x, y)
+
+pointer	smw		#I SMW pointer
+int	line		#I Spectrum line
+int	band		#I Spectrum band
+pointer	mw		#O MWCS pointer
+int	x, y		#O MWCS coordinates
+
+real	mw_c1tranr()
+
+begin
+	if (line < 1 || line > SMW_NSPEC(smw))
+	    call error (1, "smw_mw: spectrum not found")
+
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    mw = SMW_MW(smw,0)
+	    x = mod (line - 1, SMW_LLEN(smw,2)) + 1
+	    y = (line - 1) / SMW_LLEN(smw,2) + band
+	default:
+	    if (SMW_NMW(smw) == 1) {
+		mw = SMW_MW(smw,0)
+		x = line
+		y = band
+		if (SMW_CTLP(smw) != NULL)
+		    x = nint (mw_c1tranr (SMW_CTLP(smw), real(line)))
+	    } else {
+		mw = SMW_MW(smw,(line-1)/SMW_NSPLIT)
+		x = mod (line - 1, SMW_NSPLIT) + 1
+		y = band
+	    }
+	}
+end
diff --git a/noao/onedspec/smw/smwnd.x b/noao/onedspec/smw/smwnd.x
new file mode 100644
index 00000000..10b48079
--- /dev/null
+++ b/noao/onedspec/smw/smwnd.x
@@ -0,0 +1,19 @@
+include	<imhdr.h>
+include	<smw.h>
+
+
+# SMW_ND -- Setup the NDSPEC SMW.
+# If there is only one spectrum convert it to EQUISPEC if possible.
+
+procedure smw_nd (im, smw)
+
+pointer	im			#I IMIO pointer
+pointer	smw			#U MWCS pointer input SMW pointer output
+
+errchk	smw_open, smw_daxis, smw_ndes
+
+begin
+	call smw_open (smw, NULL, im)
+	if (SMW_NSPEC(smw) == 1)
+	    call smw_ndes (im, smw)
+end
diff --git a/noao/onedspec/smw/smwndes.x b/noao/onedspec/smw/smwndes.x
new file mode 100644
index 00000000..9d35ca6d
--- /dev/null
+++ b/noao/onedspec/smw/smwndes.x
@@ -0,0 +1,82 @@
+include	<imhdr.h>
+include	<smw.h>
+
+
+# SMW_NDES -- Convert NDSPEC WCS into EQUISPEC WCS.
+# This requires that the logical dispersion axis be 1.
+
+procedure smw_ndes (im, smw)
+
+pointer	im			#I IMIO pointer
+pointer	smw			#U Input NDSPEC SMW, output EQUISPEC SMW
+
+int	i, pdim1, pdim2, daxis, ap, beam, dtype, nw, axes[2]
+real	aplow[2], aphigh[2]
+double	w1, dw, z
+pointer	sp, key, str, lterm1, lterm2, coeff, mw1, mw2, mw_open()
+errchk	mw_open, mw_gltermd, mw_gwtermd, smw_open, smw_saxes, smw_gwattrs
+data	axes/1,2/, coeff/NULL/
+
+begin
+	# Require the dispersion to be along the first logical axis.
+	if (SMW_LAXIS(smw,1) != 1)
+	    return
+
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (lterm1, 15, TY_DOUBLE)
+	call salloc (lterm2, 15, TY_DOUBLE)
+
+	# Set the MWCS.  Only the logical and world transformations along
+	# the dispersion axis are transfered.
+
+	pdim1 = SMW_PDIM(smw)
+	pdim2 = IM_NDIM(im)
+	daxis = SMW_PAXIS(smw,1)
+	mw1 = SMW_MW(smw,0)
+
+	mw2 = mw_open (NULL, pdim2)
+	call mw_newsystem (mw2, "equispec", pdim2)
+	call mw_swtype (mw2, axes, pdim2, "linear", "")
+	ifnoerr (call mw_gwattrs (mw1, daxis, "label", Memc[str], SZ_LINE))
+	    call mw_swattrs (mw2, 1, "label", Memc[str])
+	ifnoerr (call mw_gwattrs (mw1, daxis, "units", Memc[str], SZ_LINE))
+	    call mw_swattrs (mw2, 1, "units", Memc[str])
+	ifnoerr (call mw_gwattrs (mw1, daxis, "units_display", Memc[str],
+	    SZ_LINE))
+	    call mw_swattrs (mw2, 1, "units_display", Memc[str])
+
+	call mw_gltermd (mw1, Memd[lterm1+pdim1], Memd[lterm1], pdim1)
+	call mw_gltermd (mw2, Memd[lterm2+pdim2], Memd[lterm2], pdim2)
+	Memd[lterm2] = Memd[lterm1+daxis-1]
+	Memd[lterm2+pdim2] = Memd[lterm1+pdim1+(pdim1+1)*(daxis-1)]
+	call mw_sltermd (mw2, Memd[lterm2+pdim2], Memd[lterm2], pdim2)
+
+	call mw_gwtermd (mw1, Memd[lterm1], Memd[lterm1+pdim1],
+	     Memd[lterm1+2*pdim1], pdim1)
+	call mw_gwtermd (mw2, Memd[lterm2], Memd[lterm2+pdim2],
+	     Memd[lterm2+2*pdim2], pdim2)
+	Memd[lterm2] = Memd[lterm1+daxis-1]
+	Memd[lterm2+pdim2] = Memd[lterm1+pdim1+daxis-1]
+	Memd[lterm2+2*pdim2] = Memd[lterm1+2*pdim1+(pdim1+1)*(daxis-1)]
+	call mw_swtermd (mw2, Memd[lterm2], Memd[lterm2+pdim2],
+	     Memd[lterm2+2*pdim2], pdim2)
+
+	# Set the EQUISPEC SMW.
+	IM_LEN(im,2) = SMW_NSPEC(smw)
+	IM_LEN(im,3) = SMW_NBANDS(smw)
+	call smw_open (mw2, NULL, im)
+	do i = 1, SMW_NSPEC(smw) {
+	    call smw_gwattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, coeff)
+	    call smw_swattrs (mw2, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, Memc[coeff])
+	}
+	call mfree (coeff, TY_CHAR)
+
+	call smw_close (smw)
+	smw = mw2
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwnewcopy.x b/noao/onedspec/smw/smwnewcopy.x
new file mode 100644
index 00000000..230ed205
--- /dev/null
+++ b/noao/onedspec/smw/smwnewcopy.x
@@ -0,0 +1,58 @@
+include <smw.h>
+
+
+# SMW_NEWCOPY -- Make a new copy of an SMW structure.
+
+pointer procedure smw_newcopy (smw)
+
+pointer smw             #I SMW pointer to copy
+pointer new 	        #O SMW copy
+
+int     i, nspec
+pointer mw_newcopy(), mw_sctran()
+
+begin
+	call calloc (new, SMW_LEN(SMW_NMW(smw)), TY_STRUCT)
+	call amovi (Memi[smw], Memi[new], SMW_LEN(SMW_NMW(smw)))
+
+	if (SMW_APID(smw) != NULL) {
+	    call malloc (SMW_APID(new), SZ_LINE, TY_CHAR)
+	    call strcpy (Memc[SMW_APID(smw)], Memc[SMW_APID(new)], SZ_LINE)
+	}
+
+	nspec = SMW_NSPEC(smw)
+	if (SMW_APS(smw) != NULL) {
+	    call malloc (SMW_APS(new), nspec, TY_INT)
+	    call amovi (Memi[SMW_APS(smw)], Memi[SMW_APS(new)], nspec)
+	}
+	if (SMW_BEAMS(smw) != NULL) {
+	    call malloc (SMW_BEAMS(new), nspec, TY_INT)
+	    call amovi (Memi[SMW_BEAMS(smw)], Memi[SMW_BEAMS(new)], nspec)
+	}
+	if (SMW_APLOW(smw) != NULL) {
+	    call malloc (SMW_APLOW(new), 2*nspec, TY_REAL)
+	    call amovr (Memr[SMW_APLOW(smw)], Memr[SMW_APLOW(new)], 2*nspec)
+	}
+	if (SMW_APHIGH(smw) != NULL) {
+	    call malloc (SMW_APHIGH(new), 2*nspec, TY_REAL)
+	    call amovr (Memr[SMW_APHIGH(smw)], Memr[SMW_APHIGH(new)], 2*nspec)
+	}
+	if (SMW_APIDS(smw) != NULL) {
+	    call calloc (SMW_APIDS(new), nspec, TY_POINTER)
+	    do i = 0, nspec-1 {
+		if (Memi[SMW_APIDS(smw)+i] != NULL) {
+		    call malloc (Memi[SMW_APIDS(new)+i], SZ_LINE, TY_CHAR)
+		    call strcpy (Memc[Memi[SMW_APIDS(smw)+i]],
+			Memc[Memi[SMW_APIDS(new)+i]], SZ_LINE)
+		}
+	    }
+	}
+
+        do i = 0, SMW_NMW(smw)-1
+            SMW_MW(new,i) = mw_newcopy (SMW_MW(smw,i))
+
+	if (SMW_PDIM(smw) > 1)
+	    SMW_CTLP(new) = mw_sctran (SMW_MW(new,0), "logical", "physical", 2)
+
+	return (new)
+end
diff --git a/noao/onedspec/smw/smwoldms.x b/noao/onedspec/smw/smwoldms.x
new file mode 100644
index 00000000..6640641f
--- /dev/null
+++ b/noao/onedspec/smw/smwoldms.x
@@ -0,0 +1,101 @@
+include	<mwset.h>
+include	<smw.h>
+
+
+# SMW_OLDMS -- Convert old multispec format into MULTISPEC SMW.
+
+procedure smw_oldms (im, smw)
+
+pointer	im			#I IMIO pointer
+pointer	smw			#U Input MWCS pointer, output SMW pointer
+
+int	i, j, k, nchar, ap, beam, dtype, nw, axes[2]
+double	w1, dw, z
+real	aplow[2], aphigh[2]
+pointer	sp, key, val, lterm, mw, mw_open()
+int	imgeti(), mw_stati(), ctoi(), ctor(), ctod(), imofnlu(), imgnfn()
+errchk	imgstr, mw_gltermd, mw_sltermd
+data	axes/1,2/
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (lterm, 12, TY_DOUBLE)
+
+	# Set the basic multispec MWCS
+	i = mw_stati (smw, MW_NDIM)
+	j = max (2, i)
+	mw = mw_open (NULL, j)
+	call mw_newsystem (mw, "multispec", j)
+	call mw_swtype (mw, axes, 2, "multispec", "")
+	if (j > 2)
+	    call mw_swtype (mw, 3, 1, "linear", "")
+	call mw_gltermd (smw, Memd[lterm+j], Memd[lterm], i)
+	if (i == 1) {
+	    Memd[lterm+1] = 0.
+	    Memd[lterm+3] = 0.
+	    Memd[lterm+4] = 0.
+	    Memd[lterm+5] = 1.
+	}
+	call mw_sltermd (mw, Memd[lterm+j], Memd[lterm], j)
+
+	iferr (dtype = imgeti (im, "DC-FLAG"))
+	    dtype = -1
+	else {
+	    call mw_swattrs (mw, 1, "label", "Wavelength")
+	    call mw_swattrs (mw, 1, "units", "Angstroms")
+	}
+
+	call mw_close (smw)
+	smw = mw
+
+	# Set the SMW data structure.
+	call smw_open (smw, NULL, im)
+	do i = 1, SMW_NSPEC(smw) {
+	    call smw_mw (smw, i, 1, mw, j, k)
+	    call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
+		call pargi (j)
+	    call imgstr (im, Memc[key], Memc[val], SZ_LINE)
+	    call imdelf (im, Memc[key])
+
+	    k = 1
+	    nchar = ctoi (Memc[val], k, ap)
+	    nchar = ctoi (Memc[val], k, beam)
+	    nchar = ctod (Memc[val], k, w1)
+	    nchar = ctod (Memc[val], k, dw)
+	    nchar = ctoi (Memc[val], k, nw)
+	    if (ctor (Memc[val], k, aplow[1]) == 0)
+		aplow[1] = INDEF
+	    if (ctor (Memc[val], k, aphigh[1]) == 0)
+		aphigh[1] = INDEF
+	    z = 0.
+
+	    k = dtype
+	    if (k==1 && (abs(w1)>20. || abs(w1+(nw-1)*dw)>20.))
+		k = 0
+	    call smw_swattrs (smw, i, 1, ap, beam, k, w1, dw, nw, z,
+		aplow, aphigh, "")
+
+	    call sprintf (Memc[key], SZ_FNAME, "APID%d")
+		call pargi (j)
+	    ifnoerr (call imgstr (im, Memc[key], Memc[val], SZ_LINE)) {
+		call smw_sapid (smw, i, 1, Memc[val])
+		call imdelf (im, Memc[key])
+	    }
+	}
+
+	# Delete old parameters
+	i = imofnlu (im,
+	    "DISPAXIS,APFORMAT,BEAM-NUM,DC-FLAG,W0,WPC,NP1,NP2")
+	while (imgnfn (i, Memc[key], SZ_FNAME) != EOF) {
+	    iferr (call imdelf (im, Memc[key]))
+		;
+	}
+	call imcfnl (i)
+
+	# Update MWCS
+	call smw_saveim (smw, im)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwonedspec.x b/noao/onedspec/smw/smwonedspec.x
new file mode 100644
index 00000000..b7d2fa6a
--- /dev/null
+++ b/noao/onedspec/smw/smwonedspec.x
@@ -0,0 +1,109 @@
+include <imhdr.h>
+include	<smw.h>
+
+
+# SMW_ONEDSPEC -- Convert old "onedspec" format to EQUISPEC.
+
+procedure smw_onedspec (im, smw)
+
+pointer	im			#I IMIO pointer
+pointer	smw			#U MWCS pointer input SMW pointer output
+
+int	i, dtype, ap, beam, nw, imgeti(), imofnlu(), imgnfn()
+real	aplow[2], aphigh[2], imgetr(), mw_c1tranr()
+double	ltm, ltv, r, w, dw, z, imgetd()
+pointer	sp, key, mw, ct, mw_openim(), mw_sctran()
+bool	fp_equald()
+errchk	smw_open, smw_saxes, mw_gwtermd, mw_sctran
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	# Convert old W0/WPC keywords if needed.
+	mw = smw
+	iferr (w = imgetd (im, "CRVAL1")) {
+	    ifnoerr (w = imgetd (im, "W0")) {
+		dw = imgetd (im, "WPC")
+		iferr (ltm = imgetd (im, "LTM1_1"))
+		    ltm = 1
+		iferr (ltv = imgetd (im, "LTV1"))
+		    ltv = 0
+		r = ltm + ltv
+		dw = dw / ltm
+		call imaddd (im, "CRPIX1", r)
+		call imaddd (im, "CRVAL1", w)
+		call imaddd (im, "CD1_1", dw)
+		call imaddd (im, "CDELT1", dw)
+		call mw_close(mw)
+		mw = mw_openim (im)
+	    }
+	}
+
+	# Get dispersion and determine number of valid pixels.
+	call mw_gwtermd (mw, r, w, dw, 1)
+	w = w - (r - 1) * dw
+	r = 1
+	call mw_swtermd (mw, r, w, dw, 1)
+	ct = mw_sctran (mw, "logical", "physical", 1)
+	nw = max (mw_c1tranr (ct, 1.), mw_c1tranr (ct, real (IM_LEN(im,1))))
+	call mw_ctfree (ct)
+
+	iferr (dtype = imgeti (im, "DC-FLAG")) {
+	    if (fp_equald (1D0, w) || fp_equald (1D0, dw))
+		dtype = DCNO
+	    else
+		dtype = DCLINEAR
+	}
+	if (dtype==DCLOG) {
+	    if (abs(w)>20. || abs(w+(nw-1)*dw)>20.)
+		dtype = DCLINEAR
+	    else {
+		w = 10D0 ** w
+		dw = w * (10D0 ** ((nw-1)*dw) - 1) / (nw - 1)
+	    }
+	}
+
+	# Convert to EQUISPEC system.
+	call mw_swattrs (mw, 0, "system", "equispec")
+	if (dtype != DCNO) {
+	    iferr (call mw_gwattrs (mw, 1, "label", Memc[key], SZ_FNAME)) {
+		iferr (call mw_gwattrs (mw, 1, "units", Memc[key], SZ_FNAME)) {
+		    call mw_swattrs (mw, 1, "units", "angstroms")
+		    call mw_swattrs (mw, 1, "label", "Wavelength")
+		}
+	    }
+	}
+
+	# Set the SMW data structure.
+	call smw_open (smw, NULL, im)
+
+	# Determine the aperture parameters.
+	iferr (beam = imgeti (im, "BEAM-NUM"))
+	    beam = 1
+	iferr (ap = imgeti (im, "APNUM"))
+	    ap = beam
+	iferr (aplow[1] = imgetr (im, "APLOW"))
+	    aplow[1] = INDEF
+	iferr (aphigh[1] = imgetr (im, "APHIGH"))
+	    aphigh[1] = INDEF
+	iferr (z = imgetd (im, "DOPCOR"))
+	    z = 0.
+
+	call smw_swattrs (smw, 1, 1, ap, beam, dtype, w, dw, nw, z,
+	    aplow, aphigh, "")
+
+        # Delete old parameters
+        i = imofnlu (im,
+            "BEAM-NUM,APNUM,APLOW,APHIGH,DOPCOR,DC-FLAG,W0,WPC,NP1,NP2")
+        while (imgnfn (i, Memc[key], SZ_FNAME) != EOF) {
+            iferr (call imdelf (im, Memc[key]))
+		;
+	}
+	call imcfnl (i)
+
+        # Update MWCS
+        call smw_saveim (smw, im)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwopen.x b/noao/onedspec/smw/smwopen.x
new file mode 100644
index 00000000..782c8749
--- /dev/null
+++ b/noao/onedspec/smw/smwopen.x
@@ -0,0 +1,70 @@
+include	<smw.h>
+
+
+# SMW_OPEN -- Open SMW structure.
+# The basic MWCS pointer and a template SMW pointer or image is input
+# and the SMW pointer is returned in its place.
+
+procedure smw_open (mw, smw1, im)
+
+pointer	mw		#U MWCS pointer input and SMW pointer output
+pointer	smw1		#I Template SMW pointer
+pointer	im		#I Template IMIO pointer
+
+int	i, nspec, nmw, format, strdic()
+pointer	sp, sys, smw, mw_sctran(), mw_newcopy()
+errchk	smw_daxis, smw_saxes, mw_sctran
+
+begin
+	call smark (sp)
+	call salloc (sys, SZ_FNAME, TY_CHAR)
+
+	call mw_gwattrs (mw, 0, "system", Memc[sys], SZ_FNAME)
+	format = strdic (Memc[sys], Memc[sys], SZ_FNAME, SMW_FORMATS)
+
+	call calloc (smw, SMW_LEN(1), TY_STRUCT)
+	call malloc (SMW_APID(smw), SZ_LINE, TY_CHAR)
+	SMW_FORMAT(smw) = format
+	SMW_DTYPE(smw) = INDEFI
+	SMW_NMW(smw) = 1
+	SMW_MW(smw,0) = mw
+
+	switch (format) {
+	case SMW_ND:
+	    call smw_daxis (smw, im, INDEFI, INDEFI, INDEFI)
+	    call smw_saxes (smw, smw1, im)
+
+	case SMW_ES:
+	    call smw_saxes (smw, smw1, im)
+
+	    nspec = SMW_NSPEC(smw)
+	    call calloc (SMW_APS(smw), nspec, TY_INT)
+	    call calloc (SMW_BEAMS(smw), nspec, TY_INT)
+	    call calloc (SMW_APLOW(smw), 2*nspec, TY_REAL)
+	    call calloc (SMW_APHIGH(smw), 2*nspec, TY_REAL)
+	    call calloc (SMW_APIDS(smw), nspec, TY_POINTER)
+	    if (SMW_PDIM(smw) > 1)
+		SMW_CTLP(smw) = mw_sctran (mw, "logical", "physical", 2)
+
+	case SMW_MS:
+	    call smw_saxes (smw, smw1, im)
+
+	    nspec = SMW_NSPEC(smw)
+	    call calloc (SMW_APIDS(smw), nspec, TY_POINTER)
+	    if (SMW_PDIM(smw) > 1)
+		SMW_CTLP(smw) = mw_sctran (mw, "logical", "physical", 2)
+
+	    nmw = 1 + (nspec - 1) / SMW_NSPLIT
+	    if (nmw > 1) {
+		call realloc (smw, SMW_LEN(nmw), TY_STRUCT)
+		call calloc (SMW_APS(smw), nspec, TY_INT)
+	    }
+	    do i = 1, nmw-1
+		SMW_MW(smw,i) = mw_newcopy (mw)
+	    SMW_NMW(smw) = nmw
+	}
+
+	mw = smw
+	    
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwopenim.x b/noao/onedspec/smw/smwopenim.x
new file mode 100644
index 00000000..468f09a7
--- /dev/null
+++ b/noao/onedspec/smw/smwopenim.x
@@ -0,0 +1,69 @@
+include <imhdr.h>
+include	<imio.h>
+include	<mwset.h>
+
+define	SYSTEMS	"|equispec|multispec|physical|image|world|linear|"
+
+
+# SMW_OPENIM -- Open the spectral MWCS for various input formats.
+
+pointer procedure smw_openim (im)
+
+pointer	im		#I Image pointer
+pointer	mw		#O MWCS pointer
+
+pointer	sp, system, mw_openim()
+bool	streq()
+int	i, wcsdim, sys, strdic(), mw_stati()
+errchk	mw_openim, smw_oldms, smw_linear
+
+begin
+	call smark (sp)
+	call salloc (system, SZ_FNAME, TY_CHAR)
+
+	# Workaround for truncation of header during image header copy.
+	IM_HDRLEN(im) = IM_LENHDRMEM(im)
+
+	# Force higher dimensions to length 1.
+	do i = IM_NDIM(im) + 1, 3
+	    IM_LEN(im,i) = 1
+
+	mw = mw_openim (im)
+	call mw_seti (mw, MW_USEAXMAP, NO)
+	wcsdim = mw_stati (mw, MW_NDIM)
+	call mw_gwattrs (mw, 0, "system", Memc[system], SZ_FNAME)
+	sys = strdic (Memc[system], Memc[system], SZ_FNAME, SYSTEMS)
+
+	# Set various input systems.
+	switch (sys) {
+	case 1:
+	    call smw_equispec (im, mw)
+	case 2:
+	    call smw_multispec (im, mw)
+	default:
+	    if (sys == 0) {
+	        call eprintf (
+	    "WARNING: Unknown coordinate system `%s' - assuming `linear'.\n")
+		    call pargstr (Memc[system])
+	    } else if (sys == 3)
+		call mw_newsystem (mw, "image", wcsdim)
+
+	    # Old "multispec" format.
+	    ifnoerr (call imgstr (im, "APFORMAT", Memc[system], SZ_FNAME)) {
+		if (streq (Memc[system], "onedspec"))
+		    call smw_onedspec (im, mw)
+		else
+		    call smw_oldms (im, mw)
+
+	    # Old "onedspec" format or other 1D image.
+	    } else if (wcsdim == 1) {
+		call smw_onedspec (im, mw)
+
+	    # N-dimensional image.
+	    } else
+		call smw_nd (im, mw)
+	}
+
+	call sfree (sp)
+	return (mw)
+end
diff --git a/noao/onedspec/smw/smwsapid.x b/noao/onedspec/smw/smwsapid.x
new file mode 100644
index 00000000..1bdf30a8
--- /dev/null
+++ b/noao/onedspec/smw/smwsapid.x
@@ -0,0 +1,40 @@
+include	<smw.h>
+
+
+# SMW_SAPID -- Set aperture id.
+
+procedure smw_sapid (smw, index1, index2, apid)
+
+pointer	smw				#I SMW pointer
+int	index1				#I Spectrum index
+int	index2				#I Spectrum index
+char	apid[ARB]			#I Aperture id
+
+pointer	ptr
+bool	streq()
+errchk	malloc
+
+begin
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    call strcpy (apid, Memc[SMW_APID(smw)], SZ_LINE)
+	case SMW_ES, SMW_MS:
+	    if (index1 < 0 || index1 > SMW_NSPEC(smw))
+		call error (1, "smw_sapid: index out of bounds")
+
+	    if (index1 == 0)
+		call strcpy (apid, Memc[SMW_APID(smw)], SZ_LINE)
+
+	    else {
+		ptr = Memi[SMW_APIDS(smw)+index1-1]
+		if (streq (apid, Memc[SMW_APID(smw)]))
+		    call mfree (ptr, TY_CHAR) 
+		else {
+		    if (ptr == NULL)
+			call malloc (ptr, SZ_LINE, TY_CHAR)
+		    call strcpy (apid, Memc[ptr], SZ_LINE)
+		}
+		Memi[SMW_APIDS(smw)+index1-1] = ptr
+	    }
+	}
+end
diff --git a/noao/onedspec/smw/smwsaveim.x b/noao/onedspec/smw/smwsaveim.x
new file mode 100644
index 00000000..892a3319
--- /dev/null
+++ b/noao/onedspec/smw/smwsaveim.x
@@ -0,0 +1,251 @@
+include <imhdr.h>
+include	<imio.h>
+include	<smw.h>
+
+
+# SMW_SAVEIM -- Save spectral WCS in image header.
+# The input and output formats are EQUISPEC and MULTISPEC.  A split input
+# MULTISPEC WCS is first merged to a single EQUISPEC or MULTISPEC WCS.
+# An input MULTISPEC WCS is converted to EQUISPEC output if possible.
+
+procedure smw_saveim (smw, im)
+
+pointer	smw			# SMW pointer
+pointer	im			# Image pointer
+
+int	i, j, format, nl, pdim, pdim1, beam, dtype, dtype1, nw, nw1
+int	ap, axes[3]
+real	aplow[2], aphigh[2]
+double	v, m, w1, dw, z, w11, dw1, z1
+pointer	sp, key, str1, str2, axmap, lterm, coeff, mw, mw1
+
+bool	strne(), fp_equald()
+int	imaccf(), imgeti()
+pointer	mw_open()
+errchk	smw_merge, imdelf
+data	axes/1,2,3/
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+	call salloc (axmap, 6, TY_INT)
+	call salloc (lterm, 15, TY_DOUBLE)
+	coeff = NULL
+
+	# Merge split WCS into a single WCS.
+	call smw_merge (smw)
+
+	mw = SMW_MW(smw,0)
+	pdim = SMW_PDIM(smw)
+	format = SMW_FORMAT(smw)
+	if (IM_NDIM(im) == 1)
+	    nl = 1
+	else
+	    nl = IM_LEN(im,2)
+
+	# If writing to an existing image we must follow IM_NPHYSDIM
+	# but in a NEW_COPY header we may really want a lower dimension.
+	# Since IM_NPHYSDIM is outside the interface we only violate
+	# it here and use a temporary keyword to communicate from the
+	# routine setting up the WCS.
+
+	pdim1 = max (IM_NDIM(im), IM_NPHYSDIM(im))
+	ifnoerr (i = imgeti (im, "SMW_NDIM")) {
+	    pdim1 = i
+	    call imdelf (im, "SMW_NDIM")
+	}
+
+	# Check if MULTISPEC WCS can be converted to EQUISPEC.
+	if (format == SMW_MS) {
+	    format = SMW_ES
+	    do i = 1, nl {
+		call smw_gwattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		    aplow, aphigh, coeff)
+		if (i == 1) {
+		    dtype1 = dtype
+		    w11 = w1
+		    dw1 = dw
+		    z1 = z
+		    nw1 = nw
+		}
+		if (dtype>1||dtype!=dtype1||!fp_equald(w1,w11)||
+		    !fp_equald(dw,dw1)||nw!=nw1||!fp_equald(z,z1)) {
+		    format = SMW_MS
+		    break
+		}
+	    }
+	}
+
+	# Save WCS in desired format.
+	switch (format) {
+	case SMW_ND:
+	    if (SMW_DTYPE(smw) != -1)
+		call imaddi (im, "DC-FLAG", SMW_DTYPE(smw))
+	    else if (imaccf (im, "DC-FLAG") == YES)
+		call imdelf (im, "DC-FLAG")
+	    if (imaccf (im, "DISPAXIS") == YES)
+		call imaddi (im, "DISPAXIS", SMW_PAXIS(smw,1))
+
+	    call smw_gapid (smw, 1, 1, IM_TITLE(im), SZ_IMTITLE)
+	    call mw_saveim (mw, im)
+
+	case SMW_ES:
+	    # Save aperture information.
+	    do i = 1, nl {
+		call smw_gwattrs (smw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		    aplow, aphigh, coeff)
+		if (i < 1000)
+		    call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
+		else
+		    call sprintf (Memc[key], SZ_FNAME, "AP%d")
+		    call pargi (i)
+		call sprintf (Memc[str1], SZ_LINE, "%d %d")
+		    call pargi (ap)
+		    call pargi (beam)
+		if (!IS_INDEF(aplow[1]) || !IS_INDEF(aphigh[1])) {
+		    call sprintf (Memc[str2], SZ_LINE, " %.2f %.2f")
+			call pargr (aplow[1])
+			call pargr (aphigh[1])
+		    call strcat (Memc[str2], Memc[str1], SZ_LINE)
+		    if (!IS_INDEF(aplow[2]) || !IS_INDEF(aphigh[2])) {
+			call sprintf (Memc[str2], SZ_LINE, " %.2f %.2f")
+			    call pargr (aplow[2])
+			    call pargr (aphigh[2])
+			call strcat (Memc[str2], Memc[str1], SZ_LINE)
+		    }
+		}
+		call imastr (im, Memc[key], Memc[str1])
+		if (i == 1) {
+		    iferr (call imdelf (im, "APID1"))
+			;
+		}
+		call smw_gapid (smw, i, 1, Memc[str1], SZ_LINE)
+		if (Memc[str1] != EOS) {
+		    if (strne (Memc[str1], IM_TITLE(im))) {
+			if (nl == 1) {
+			    call imastr (im, "MSTITLE", IM_TITLE(im))
+			    call strcpy (Memc[str1], IM_TITLE(im), SZ_IMTITLE)
+			} else {
+			    call sprintf (Memc[key], SZ_FNAME, "APID%d")
+				call pargi (i)
+			    call imastr (im, Memc[key], Memc[str1])
+			}
+		    }
+		}
+	    }
+
+	    # Delete unnecessary aperture information.
+	    do i = nl+1, ARB {
+		if (i < 1000)
+		    call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
+		else
+		    call sprintf (Memc[key], SZ_FNAME, "AP%d")
+		    call pargi (i)
+		iferr (call imdelf (im, Memc[key]))
+		    break
+		call sprintf (Memc[key], SZ_FNAME, "APID%d")
+		    call pargi (i)
+		iferr (call imdelf (im, Memc[key]))
+		    ;
+	    }
+
+	    # Add dispersion parameters to image.
+	    if (dtype != -1)
+		call imaddi (im, "DC-FLAG", dtype)
+	    else if (imaccf (im, "DC-FLAG") == YES)
+		call imdelf (im, "DC-FLAG")
+	    if (nw < IM_LEN(im,1))
+		call imaddi (im, "NP2", nw)
+	    else if (imaccf (im, "NP2") == YES)
+		call imdelf (im, "NP2")
+
+	    # Setup EQUISPEC WCS.
+
+	    mw1 = mw_open (NULL, pdim1)
+	    call mw_newsystem (mw1, "equispec", pdim1)
+	    call mw_swtype (mw1, axes, pdim1, "linear", "")
+	    ifnoerr (call mw_gwattrs (mw, 1, "label", Memc[str1], SZ_LINE))
+		call mw_swattrs (mw1, 1, "label", Memc[str1])
+	    ifnoerr (call mw_gwattrs (mw, 1, "units", Memc[str1], SZ_LINE))
+		call mw_swattrs (mw1, 1, "units", Memc[str1])
+	    ifnoerr (call mw_gwattrs (mw, 1, "units_display", Memc[str1],
+		SZ_LINE))
+		call mw_swattrs (mw1, 1, "units_display", Memc[str1])
+	    call mw_gltermd (mw, Memd[lterm+pdim], Memd[lterm], pdim)
+	    v = Memd[lterm]
+	    m = Memd[lterm+pdim]
+	    call mw_gltermd (mw1, Memd[lterm+pdim1], Memd[lterm], pdim1)
+	    Memd[lterm] = v
+	    Memd[lterm+pdim1] = m
+	    call mw_sltermd (mw1, Memd[lterm+pdim1], Memd[lterm], pdim1)
+	    call mw_gwtermd (mw1, Memd[lterm], Memd[lterm+pdim1],
+		Memd[lterm+2*pdim1], pdim1)
+	    Memd[lterm] = 1.
+	    w1 = w1 / (1 + z)
+	    dw = dw / (1 + z)
+	    if (dtype == DCLOG) {
+		dw = log10 ((w1 + (nw - 1) * dw) / w1) / (nw - 1)
+		w1 = log10 (w1)
+	    }
+	    Memd[lterm+pdim1] = w1
+	    Memd[lterm+2*pdim1] = dw
+	    call mw_swtermd (mw1, Memd[lterm], Memd[lterm+pdim1],
+		Memd[lterm+2*pdim1], pdim1)
+	    call mw_saveim (mw1, im)
+	    call mw_close (mw1)
+
+	case SMW_MS:
+	    # Delete any APNUM keywords.  If there is only one spectrum
+	    # define the axis mapping.
+
+	    do j = 1, ARB {
+		if (j < 1000)
+		    call sprintf (Memc[key], SZ_FNAME, "APNUM%d")
+		else
+		    call sprintf (Memc[key], SZ_FNAME, "AP%d")
+		    call pargi (j)
+		iferr (call imdelf (im, Memc[key]))
+		    break
+	    }
+	    if (IM_NDIM(im) == 1) {
+		call aclri (Memi[axmap], 2*pdim)
+		Memi[axmap] = 1
+		call mw_saxmap (mw, Memi[axmap], Memi[axmap+pdim], pdim)
+	    }
+
+	    # Set aperture ids.
+	    do i = 1, nl {
+		if (i == 1) {
+		    iferr (call imdelf (im, "APID1"))
+			;
+		}
+		call smw_gapid (smw, i, 1, Memc[str1], SZ_LINE)
+		if (Memc[str1] != EOS) {
+		    if (strne (Memc[str1], IM_TITLE(im))) {
+			if (nl == 1) {
+			    call imastr (im, "MSTITLE", IM_TITLE(im))
+			    call strcpy (Memc[str1], IM_TITLE(im), SZ_IMTITLE)
+			} else {
+			    call sprintf (Memc[key], SZ_FNAME, "APID%d")
+				call pargi (i)
+			    call imastr (im, Memc[key], Memc[str1])
+			}
+		    }
+		}
+	    }
+
+	    do i = nl+1, ARB {
+		call sprintf (Memc[key], SZ_FNAME, "APID%d")
+		    call pargi (i)
+		iferr (call imdelf (im, Memc[key]))
+		    break
+	    }
+
+	    call mw_saveim (mw, im)
+	}
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwsaxes.x b/noao/onedspec/smw/smwsaxes.x
new file mode 100644
index 00000000..f5e31b63
--- /dev/null
+++ b/noao/onedspec/smw/smwsaxes.x
@@ -0,0 +1,247 @@
+include	<imhdr.h>
+include	<mwset.h>
+include	<smw.h>
+
+
+# SMW_SAXES -- Set axes parameters based on previously set dispersion axis.
+# If the dispersion axis has been excluded for NDSPEC allow another axis to
+# be chosen with a warning.  For EQUISPEC and MULTISPEC require the dispersion
+# to be 1 and also to be present.
+
+procedure smw_saxes (smw, smw1, im)
+
+pointer	smw			#I SMW pointer
+pointer	smw1			#I Template SMW pointer
+pointer	im			#I Template IMIO pointer
+
+int	i, pdim, ldim, paxis, laxis, nw, dtype, nspec
+real	smw_c1tranr()
+double	w1, dw
+pointer	sp, str, axno, axval, r, w, cd, mw, ct, smw_sctran()
+int	mw_stati(), imgeti()
+bool	streq(), fp_equald()
+errchk	smw_sctran
+
+begin
+	# If a template SMW pointer is specified just copy the axes parameters.
+	if (smw1 != NULL) {
+	    call strcpy (Memc[SMW_APID(smw1)], Memc[SMW_APID(smw)], SZ_LINE)
+	    SMW_NSPEC(smw) = SMW_NSPEC(smw1)
+	    SMW_NBANDS(smw) = SMW_NBANDS(smw1)
+	    SMW_TRANS(smw) = SMW_TRANS(smw1)
+	    call amovi (SMW_PAXIS(smw1,1), SMW_PAXIS(smw,1), 3)
+	    SMW_LDIM(smw) = SMW_LDIM(smw1)
+	    call amovi (SMW_LAXIS(smw1,1), SMW_LAXIS(smw,1), 3)
+	    call amovi (SMW_LLEN(smw1,1), SMW_LLEN(smw,1), 3)
+	    call amovi (SMW_NSUM(smw1,1), SMW_NSUM(smw,1), 2)
+
+	    mw = SMW_MW(smw,0)
+	    SMW_PDIM(smw) = mw_stati (mw, MW_NDIM)
+	    if (SMW_PDIM(smw) > SMW_PDIM(smw1))
+	       do i = SMW_PDIM(smw1)+1, SMW_PDIM(smw)
+		   SMW_PAXIS(smw,i) = i
+
+	    return
+	}
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (axno, 3, TY_INT)
+	call salloc (axval, 3, TY_INT)
+	call aclri (Memi[axno], 3)
+
+	# Determine the dimensions.
+	mw = SMW_MW(smw,0)
+	pdim = mw_stati (mw, MW_NDIM)
+	ldim = IM_NDIM(im)
+	call mw_gaxmap (mw, Memi[axno], Memi[axval], pdim)
+
+	# Set the physical dispersion axis.
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    call salloc (r, pdim, TY_DOUBLE)
+	    call salloc (w, pdim, TY_DOUBLE)
+	    call salloc (cd, pdim*pdim, TY_DOUBLE)
+
+	    # Check for a transposed or rotated 2D image.
+	    SMW_TRANS(smw) = NO
+	    if (pdim == 2) {
+		call mw_gltermd (mw, Memd[cd], Memd[w], pdim)
+		if (Memd[cd] == 0D0 && Memd[cd+3] == 0D0) {
+		    Memd[cd] = Memd[cd+1]
+		    Memd[cd+1] = 0.
+		    Memd[cd+3] = Memd[cd+2]
+		    Memd[cd+2] = 0.
+		    call mw_sltermd (mw, Memd[cd], Memd[w], pdim)
+		    paxis = SMW_PAXIS(smw,1)
+		    if (paxis == 1)
+			SMW_PAXIS(smw,1) = 2
+		    else
+			SMW_PAXIS(smw,1) = 1
+		    SMW_TRANS(smw) = YES
+		} else if (Memd[cd+1] != 0D0 || Memd[cd+2] != 0D0) {
+		    Memd[w] = 0
+		    Memd[w+1] = 0
+		    Memd[cd] = 1
+		    Memd[cd+1] = 0
+		    Memd[cd+2] = 0
+		    Memd[cd+3] = 1
+		    call mw_sltermd (mw, Memd[cd], Memd[w], pdim)
+		}
+	    }
+
+	    # If the dispersion axis is of length 1 or has been excluded find
+	    # the first longer axis and print a warning.
+
+	    paxis = SMW_PAXIS(smw,1)
+	    i = max (1, min (pdim, paxis))
+	    laxis = max (1, Memi[axno+i-1])
+	    if (IM_LEN(im,laxis) == 1)
+		do laxis = 1, ldim
+		    if (IM_LEN(im,laxis) != 1)
+			break
+
+	    # Determine the number of spectra.
+	    nspec = 1
+	    do i = 1, ldim
+		if (i != laxis)
+		    nspec = nspec * IM_LEN(im,i)
+	    SMW_NSPEC(smw) = nspec
+	    SMW_NBANDS(smw) = 1
+
+	    i = paxis
+	    do paxis = 1, pdim
+		if (Memi[axno+paxis-1] == laxis)
+		    break
+
+	    if (i != paxis && nspec > 1) {
+		call eprintf (
+		    "WARNING: Dispersion axis %d not found. Using axis %d.\n")
+		call pargi (i)
+		call pargi (paxis)
+	    }
+
+	    # Set the dispersion system.
+	    call mw_gwtermd (mw, Memd[r], Memd[w], Memd[cd], pdim)
+	    if (SMW_TRANS(smw) == YES) {
+		Memd[cd] = Memd[cd+1]
+		Memd[cd+1] = 0.
+		Memd[cd+3] = Memd[cd+2]
+		Memd[cd+2] = 0.
+	    }
+	    if (pdim == 2 && (Memd[cd+1] != 0D0 || Memd[cd+2] != 0D0)) {
+		iferr (dtype = imgeti (im, "DC-FLAG"))
+		    dtype = DCNO
+		if (dtype != DCNO) {
+		    call sfree (sp)
+		    call error (1,
+		    "Rotated, dispersion calibrated spectra are not allowed")
+		}
+		Memd[r] = 0
+		Memd[r+1] = 0
+		Memd[w] = 0
+		Memd[w+1] = 0
+		Memd[cd] = 1
+		Memd[cd+1] = 0
+		Memd[cd+2] = 0
+		Memd[cd+3] = 1
+	    }
+	    do i = 0, pdim-1 {
+		dw = Memd[cd+i*(pdim+1)]
+		if (dw == 0D0)
+		    Memd[cd+i*(pdim+1)] = 1D0
+	    }
+	    call mw_swtermd (mw, Memd[r], Memd[w], Memd[cd], pdim)
+
+	    dw = Memd[cd+(paxis-1)*(pdim+1)]
+	    w1 = Memd[w+paxis-1] - (Memd[r+paxis-1] - 1) * dw
+	    nw = IM_LEN(im,laxis)
+
+	    i = 2 ** (paxis - 1)
+	    ct = smw_sctran (smw, "logical", "physical", i)
+	    nw = max (smw_c1tranr (ct, 0.5), smw_c1tranr (ct, nw+0.5))
+	    call smw_ctfree (ct)
+
+	    iferr (dtype = imgeti (im, "DC-FLAG")) {
+		iferr (call mw_gwattrs (mw,paxis,"axtype",Memc[str],SZ_LINE))
+		    Memc[str] = EOS
+		if (streq (Memc[str], "ra") || streq (Memc[str], "dec"))
+		    dtype = DCNO
+		else if (fp_equald (1D0, w1) || fp_equald (1D0, dw))
+		    dtype = DCNO
+		else
+		    dtype = DCLINEAR
+	    }
+	    if (dtype==DCLOG) {
+		if (abs(w1)>20. || abs(w1+(nw-1)*dw)>20.)
+		    dtype = DCLINEAR
+		else {
+		    w1 = 10D0 ** w1
+		    dw = w1 * (10D0 ** ((nw-1)*dw) - 1) / (nw - 1)
+		}
+	    }
+
+	    if (dtype != DCNO) {
+		
+		
+		iferr (call mw_gwattrs (mw,paxis,"label",Memc[str],SZ_LINE)) {
+		iferr (call mw_gwattrs(mw,paxis,"units",Memc[str],SZ_LINE)) {
+			call mw_swattrs (mw, paxis, "units", "angstroms")
+			call mw_swattrs (mw, paxis, "label", "Wavelength")
+		    }
+		}
+	    }
+
+	    SMW_DTYPE(smw) = INDEFI
+	    call smw_swattrs (smw, 1, 1, INDEFI, INDEFI,
+		dtype, w1, dw, nw, 0D0, INDEFR, INDEFR, "")
+	case SMW_ES, SMW_MS:
+	    paxis = 1
+	    i = Memi[axno+1]
+	    if (i == 0)
+		SMW_NSPEC(smw) = 1
+	    else
+		SMW_NSPEC(smw) = IM_LEN(im,i)
+	    i = Memi[axno+2]
+	    if (i == 0)
+		SMW_NBANDS(smw) = 1
+	    else
+		SMW_NBANDS(smw) = IM_LEN(im,i)
+	}
+
+	# Check and set the physical and logical dispersion axes.
+	laxis = Memi[axno+paxis-1]
+	if (laxis == 0) {
+	    if (Memi[axval+paxis-1] == 0)
+		laxis = paxis
+	    else
+		call error (1, "No dispersion axis")
+	}
+
+	SMW_PDIM(smw) = pdim
+	SMW_LDIM(smw) = ldim
+	SMW_PAXIS(smw,1) = paxis
+	SMW_LAXIS(smw,1) = laxis
+	SMW_LLEN(smw,1) = IM_LEN(im,laxis)
+	SMW_LLEN(smw,2) = 1
+	SMW_LLEN(smw,3) = 1
+
+	# Set the spatial axes.
+	i = 2
+	do laxis = 1, ldim {
+	    if (laxis != SMW_LAXIS(smw,1)) {
+		do paxis = 1, pdim
+		    if (Memi[axno+paxis-1] == laxis)
+			break
+		SMW_PAXIS(smw,i) = paxis
+		SMW_LAXIS(smw,i) = laxis
+		SMW_LLEN(smw,i) = IM_LEN(im,laxis)
+		i = i + 1
+	    }
+	}
+
+	# Set the default title.
+	call smw_sapid (smw, 0, 1, IM_TITLE(im))
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/smwsctran.x b/noao/onedspec/smw/smwsctran.x
new file mode 100644
index 00000000..06f240db
--- /dev/null
+++ b/noao/onedspec/smw/smwsctran.x
@@ -0,0 +1,96 @@
+include	<error.h>
+include	<smw.h>
+
+
+# SMW_SCTRAN -- Set the SMW coordinate system transformation.
+# This routine sets up the SMW_CT structure which may consist of multiple
+# pointers if the MWCS is split.  If the MWCS is not split then the MWCS
+# transformation routine is used directly.  However if the MWCS is split then
+# there may need to be an intermediate mapping from the input coordinate to
+# the physical coordinate in which the split MWCS is defined as well as a
+# transformation for each WCS piece.
+
+pointer procedure smw_sctran (smw, system1, system2, axbits)
+
+pointer	smw		#I SMW pointer
+char	system1[ARB]	#I Input coordinate system
+char	system2[ARB]	#I Output coordinate system
+int	axbits		#I Bitmap defining axes to be transformed
+pointer	ct		#O SMW CT pointer
+
+int	i, cttype, nct, axes[3], naxes, strdic()
+pointer	mw_sctran()
+errchk	mw_sctran
+
+begin
+	# Determine the coordinate transformation type and setup the structure.
+	cttype = 10 * (strdic (system1, system1, ARB, SMW_CTTYPES) + 1) +
+	    strdic (system2, system2, ARB, SMW_CTTYPES) + 1
+
+	nct = SMW_NMW(smw)
+	if (cttype == SMW_LP || cttype == SMW_PL)
+	    nct = 1
+
+	call calloc (ct, SMW_CTLEN(nct), TY_STRUCT)
+	SMW_SMW(ct) = smw
+	SMW_CTTYPE(ct) = cttype
+	SMW_NCT(ct) = nct
+
+	# Determine dispersion and aperture axes.
+	call mw_gaxlist (SMW_MW(smw,0), axbits, axes, naxes)
+	do i = 1, naxes {
+	    if (axes[i] == SMW_PAXIS(smw,1))
+		SMW_DAXIS(ct) = i
+	    if (axes[i] == SMW_PAXIS(smw,2))
+		SMW_AAXIS(ct) = i
+	}
+
+	# If the MWCS is not split use the MWCS transformation directly.
+	if (nct == 1) {
+	    iferr (SMW_CT(ct,0) = mw_sctran (SMW_MW(smw,0), system1, system2,
+		axbits)) {
+		switch (cttype) {
+		case SMW_WL, SMW_WP:
+	            SMW_CT(ct,0) = mw_sctran (SMW_MW(smw,0), "physical",
+			system2, axbits)
+		case SMW_LW, SMW_PW:
+	            SMW_CT(ct,0) = mw_sctran (SMW_MW(smw,0), system1,
+			"physical", axbits)
+		default:
+		    call erract (EA_ERROR)
+		}
+	    }
+	    return(ct)
+	}
+
+	# If there is a split MWCS then setup the intermediary transformation.
+	switch (cttype) {
+	case SMW_LW:
+	    SMW_CTL(ct) = mw_sctran (SMW_MW(smw,0), system1, "physical",
+		axbits)
+	    do i = 0, nct-1 {
+		iferr (SMW_CT(ct,i) = mw_sctran (SMW_MW(smw,i), "physical",
+		    system2, axbits))
+		    SMW_CT(ct,i) = mw_sctran (SMW_MW(smw,i), "physical",
+			"physical", axbits)
+	    }
+	case SMW_WL:
+	    do i = 0, nct-1 {
+		iferr (SMW_CT(ct,i) = mw_sctran (SMW_MW(smw,i), system1,
+		    "physical", axbits))
+		    SMW_CT(ct,i) = mw_sctran (SMW_MW(smw,i), "physical",
+			"physical", axbits)
+	    }
+	    SMW_CTL(ct) = mw_sctran (SMW_MW(smw,0), "physical", system2,
+		axbits)
+	case SMW_PW, SMW_WP:
+	    do i = 0, nct-1 {
+		iferr (SMW_CT(ct,i) = mw_sctran (SMW_MW(smw,i), system1,
+		    system2, axbits))
+		    SMW_CT(ct,i) = mw_sctran (SMW_MW(smw,i), "physical",
+			system2, axbits)
+	    }
+	}
+
+	return (ct)
+end
diff --git a/noao/onedspec/smw/smwsmw.x b/noao/onedspec/smw/smwsmw.x
new file mode 100644
index 00000000..c3870c4a
--- /dev/null
+++ b/noao/onedspec/smw/smwsmw.x
@@ -0,0 +1,21 @@
+include	<smw.h>
+
+
+# SMW_SMW -- Set MCWS pointer
+
+procedure smw_smw (smw, line, mw)
+
+pointer	smw		#I SMW pointer
+int	line		#I Physical line
+pointer	mw		#I MWCS pointer
+
+begin
+	if (SMW_NMW(smw) == 1)
+	    SMW_MW(smw,0) = mw
+
+	else {
+	    if (line < 1 || line > SMW_NSPEC(smw))
+		call error (1, "smw_smw: aperture not found")
+	    SMW_MW(smw,(line-1)/SMW_NSPLIT) = mw
+	}
+end
diff --git a/noao/onedspec/smw/smwswattrs.x b/noao/onedspec/smw/smwswattrs.x
new file mode 100644
index 00000000..ff859cfc
--- /dev/null
+++ b/noao/onedspec/smw/smwswattrs.x
@@ -0,0 +1,162 @@
+include	<error.h>
+include	<smw.h>
+
+
+# SMW_SWATTRS -- Set spectrum attribute parameters
+# This routine has the feature that if the coordinate system of a single
+# spectrum in an EQUISPEC WCS is changed then the image WCS is changed
+# to a MULTISPEC WCS.
+
+procedure smw_swattrs (smw, index1, index2, ap, beam, dtype, w1, dw, nw, z,
+	aplow, aphigh, coeff)
+
+pointer	smw				# SMW pointer
+int	index1				# Spectrum index
+int	index2				# Spectrum index
+int	ap				# Aperture number
+int	beam				# Beam number
+int	dtype				# Dispersion type
+double	w1				# Starting coordinate
+double	dw				# Coordinate interval
+int	nw				# Number of valid pixels
+double	z				# Redshift factor
+real	aplow[2], aphigh[2]		# Aperture limits
+char	coeff[ARB]			# Nonlinear coeff string
+
+bool	fp_equald()
+int	i, j, sz_val, strlen()
+double	a, b
+pointer	sp, str, val, mw
+errchk	smw_mw
+
+define	start_	10
+
+begin
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+start_
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    if (!IS_INDEFI(SMW_DTYPE(smw)) && (!fp_equald(w1,SMW_W1(smw)) ||
+		!fp_equald(dw,SMW_DW(smw)) || !fp_equald(z,SMW_Z(smw)))) {
+		call malloc (val, 15, TY_DOUBLE)
+		mw = SMW_MW(smw,0)
+		i = SMW_PDIM(smw)
+		j = SMW_PAXIS(smw,1)
+		call mw_gwtermd (mw, Memd[val], Memd[val+i], Memd[val+2*i], i)
+		Memd[val+j-1] = 1.
+		switch (dtype) {
+		case DCNO, DCLINEAR:
+		    a = w1 / (1 + z)
+		    b = dw / (1 + z)
+		case DCLOG:
+		    a = log10 (w1 / (1 + z))
+		    b = log10 ((w1 + (nw - 1) * dw) / w1) / (nw - 1)
+		case DCFUNC:
+		    call error (1,
+		       "Nonlinear functions not allowed for NSPEC format")
+		}
+		Memd[val+i+j-1] = a
+		Memd[val+2*i+(i+1)*(j-1)] = b
+		call mw_swtermd (mw, Memd[val], Memd[val+i], Memd[val+2*i], i)
+		call mfree (val, TY_DOUBLE)
+	    }
+	    SMW_DTYPE(smw) = dtype
+	    SMW_NW(smw) = nw
+	    SMW_W1(smw) = w1
+	    SMW_DW(smw) = dw
+	    SMW_Z(smw) = z
+
+	case SMW_ES:
+	    # Check for any changes to the dispersion system.
+	    if (dtype == DCFUNC) {
+		call smw_esms(smw)
+		goto start_
+	    }
+	    if (!IS_INDEFI(SMW_DTYPE(smw)) && (dtype != SMW_DTYPE(smw) ||
+		nw != SMW_NW(smw) || !fp_equald(w1,SMW_W1(smw)) ||
+		!fp_equald(dw,SMW_DW(smw)) || !fp_equald(z,SMW_Z(smw)))) {
+		if (SMW_NSPEC(smw) > 1 && index1 > 0) {
+		    call smw_esms(smw)
+		    goto start_
+		}
+		if (!fp_equald(w1,SMW_W1(smw)) || !fp_equald(dw,SMW_DW(smw)) ||
+		    !fp_equald(z,SMW_Z(smw))) {
+		    call malloc (val, 15, TY_DOUBLE)
+		    mw = SMW_MW(smw,0)
+		    i = SMW_PDIM(smw)
+		    j = SMW_PAXIS(smw,1)
+		    call mw_gwtermd (mw, Memd[val], Memd[val+i],
+			Memd[val+2*i], i)
+		    Memd[val+j-1] = 1.
+		    switch (dtype) {
+		    case DCNO, DCLINEAR:
+			a = w1 / (1 + z)
+			b = dw / (1 + z)
+		    case DCLOG:
+			a = log10 (w1 / (1 + z))
+			b = log10 ((w1 + (nw - 1) * dw) / w1) / (nw - 1)
+		    }
+		    Memd[val+i+j-1] = a
+		    Memd[val+2*i+(i+1)*(j-1)] = b
+		    call mw_swtermd (mw, Memd[val], Memd[val+i],
+			Memd[val+2*i], i)
+		    call mfree (val, TY_DOUBLE)
+		}
+	    }
+
+	    SMW_DTYPE(smw) = dtype
+	    SMW_NW(smw) = nw
+	    SMW_W1(smw) = w1
+	    SMW_DW(smw) = dw
+	    SMW_Z(smw) = z
+
+	    if (index1 > 0) {
+		Memi[SMW_APS(smw)+index1-1] = ap
+		Memi[SMW_BEAMS(smw)+index1-1] = beam
+		Memr[SMW_APLOW(smw)+2*index1-2] = aplow[1]
+		Memr[SMW_APHIGH(smw)+2*index1-2] = aphigh[1]
+		Memr[SMW_APLOW(smw)+2*index1-1] = aplow[2]
+		Memr[SMW_APHIGH(smw)+2*index1-1] = aphigh[2]
+	    }
+
+	case SMW_MS:
+	    # We can't use SPRINTF for the whole string because it can only
+	    # handle a limited length and trucates long coefficient strings.
+	    # Use STRCAT instead.
+
+	    call smw_mw (smw, index1, index2, mw, i, j)
+	    sz_val = strlen (coeff) + SZ_LINE
+	    call salloc (val, sz_val, TY_CHAR)
+	    call sprintf (Memc[str], SZ_LINE, "spec%d")
+		call pargi (i)
+	    call sprintf (Memc[val], sz_val,
+		"%d %d %d %.14g %.14g %d %.14g %.2f %.2f")
+		call pargi (ap)
+		call pargi (beam)
+		call pargi (dtype)
+		if (dtype == DCLOG) {
+		    call pargd (log10 (w1))
+		    call pargd (log10 ((w1+(nw-1)*dw)/w1)/(nw-1))
+		} else {
+		    call pargd (w1)
+		    call pargd (dw)
+		}
+		call pargi (nw)
+		call pargd (z)
+		call pargr (aplow[1])
+		call pargr (aphigh[1])
+	    if (coeff[1] != EOS) {
+		call strcat (" ", Memc[val], sz_val)
+		call strcat (coeff, Memc[val], sz_val)
+	    }
+	    call mw_swattrs (mw, 2, Memc[str], Memc[val])
+
+	    if (SMW_APS(smw) != NULL)
+		Memi[SMW_APS(smw)+index1-1] = ap
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/smw/units.x b/noao/onedspec/smw/units.x
new file mode 100644
index 00000000..f44abb57
--- /dev/null
+++ b/noao/onedspec/smw/units.x
@@ -0,0 +1,529 @@
+include	<ctype.h>
+include	<error.h>
+include	<units.h>
+
+
+# UN_OPEN -- Open units package
+# It is allowed to open an unknown unit type
+
+pointer procedure un_open (units)
+
+char	units[ARB]		# Units string
+pointer	un			# Units pointer returned
+
+begin
+	call calloc (un, UN_LEN, TY_STRUCT)
+	iferr (call un_decode (un, units)) {
+	    call un_close (un)
+	    call erract (EA_ERROR)
+	}
+	return (un)
+end
+
+
+# UN_CLOSE -- Close units package
+
+procedure un_close (un)
+
+pointer	un			# Units pointer
+
+begin
+	call mfree (un, TY_STRUCT)
+end
+
+
+# UN_COPY -- Copy units pointer
+
+procedure un_copy (un1, un2)
+
+pointer	un1, un2		# Units pointers
+
+begin
+	if (un2 == NULL)
+	    call malloc (un2, UN_LEN, TY_STRUCT)
+	call amovi (Memi[un1], Memi[un2], UN_LEN)
+end
+
+
+# UN_DECODE -- Decode units string and set up units structure.
+# The main work is done in UN_DECODE1 so that the units string may
+# be recursive; i.e. the units string may contain other units strings.
+# In particular, this is required for the velocity units to specify
+# a reference wavelength.
+
+procedure un_decode (un, units)
+
+pointer	un			# Units pointer
+char	units[ARB]		# Units string
+
+bool	streq()
+pointer	sp, units1, temp, un1, un2
+errchk	un_decode1, un_ctranr
+
+begin
+	if (streq (units, UN_USER(un)))
+	    return
+
+	call smark (sp)
+	call salloc (units1, SZ_LINE, TY_CHAR)
+	call salloc (temp, UN_LEN, TY_STRUCT)
+
+	# Save a copy to restore in case of an error.
+	call un_copy (un, temp)
+
+	iferr {
+	    # Decode the primary units
+	    call un_decode1 (un, units, Memc[units1], SZ_LINE)
+
+	    # Decode velocity reference wavelength if necessary.
+	    if (UN_CLASS(un) == UN_VEL || UN_CLASS(un) == UN_DOP) {
+		call salloc (un1, UN_LEN, TY_STRUCT)
+		call un_decode1 (un1, Memc[units1], Memc[units1], SZ_LINE)
+		if (UN_CLASS(un1) == UN_VEL || UN_CLASS(un1) == UN_DOP)
+		    call error (1,
+			"Velocity reference units may not be velocity")
+		call salloc (un2, UN_LEN, TY_STRUCT)
+		call un_decode1 (un2, "angstroms", Memc[units1], SZ_LINE)
+		call un_ctranr (un1, un2, UN_VREF(un), UN_VREF(un), 1)
+	    }
+	} then {
+	    call un_copy (temp, un)
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+
+	call sfree (sp)
+end
+
+
+# UN_DECODE1 -- Decode units string and set up units structure.
+# Return any secondary units string.  Unknown unit strings are allowed.
+
+procedure un_decode1 (un, units, units1, sz_units1)
+
+pointer	un			# Units pointer
+char	units[ARB]		# Units string
+char	units1[sz_units1]	# Secondary units string to return
+int	sz_units1		# Size of secondary units string
+
+int	unlog, uninv, untype
+int	i, j, k, nscan(), strdic(), strlen()
+pointer	sp, str
+pointer	stp, sym, stfind(), strefsbuf()
+
+int	class[UN_NUNITS]
+real	scale[UN_NUNITS]
+data	stp/NULL/
+data	class /UN_WAVE,UN_WAVE,UN_WAVE,UN_WAVE,UN_WAVE,UN_WAVE,UN_WAVE,
+		UN_FREQ,UN_FREQ,UN_FREQ,UN_FREQ,UN_VEL,UN_VEL,
+		UN_ENERGY,UN_ENERGY,UN_ENERGY,UN_DOP/
+data	scale /UN_ANG,UN_NM,UN_MMIC,UN_MIC,UN_MM,UN_CM,UN_M,UN_HZ,UN_KHZ,
+		UN_MHZ,UN_GHZ,UN_MPS,UN_KPS,UN_EV,UN_KEV,UN_MEV,UN_Z/
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	iferr (call un_abbr (stp))
+	    ;
+
+	call strcpy (units, Memc[str], SZ_FNAME)
+	if (stp != NULL) {
+	    sym = stfind (stp, Memc[str])
+	    if (sym != NULL)
+		call strcpy (Memc[strefsbuf(stp,Memi[sym])],
+		    Memc[str], SZ_FNAME)
+	}
+	call strlwr (Memc[str])
+	call sscan (Memc[str])
+	untype = 0
+	unlog = NO
+	uninv = NO
+	do i = 1, 3 {
+	    call gargwrd (Memc[str], SZ_FNAME)
+	    if (nscan() != i)
+		break
+
+	    j = strdic (Memc[str], Memc[str], SZ_FNAME, UN_DIC)
+	    for (k=strlen(Memc[str]); k>0 &&
+		(IS_WHITE(Memc[str+k-1]) || Memc[str+k-1]=='\n'); k=k-1)
+		Memc[str+k-1] = EOS
+
+	    if (j > UN_NUNITS) {
+	        j = j - UN_NUNITS
+	        if (j == 1) {
+		    if (unlog == YES)
+			break
+		    unlog = YES
+		} else if (j == 2) {
+		    if (uninv == YES)
+			break
+		    uninv = YES
+		}
+	    } else {
+		if (class[j] == UN_VEL || class[j] == UN_DOP) {
+		    call gargr (UN_VREF(un))
+		    call gargstr (units1, sz_units1)
+		    if (nscan() != i+2)
+			call error (1, "Error in velocity reference wavelength")
+		} else
+		    UN_VREF(un) = 0.
+		untype = j
+		break
+	    }
+	}
+
+	if (untype == 0) {
+	    UN_TYPE(un) = 0
+	    UN_CLASS(un) = UN_UNKNOWN
+	    UN_LABEL(un) = EOS
+	    call strcpy (units, UN_UNITS(un), SZ_UNITS)
+	} else {
+	    UN_TYPE(un) = untype
+	    UN_CLASS(un) = class[untype]
+	    UN_LOG(un) = unlog
+	    UN_INV(un) = uninv
+	    UN_SCALE(un) = scale[untype]
+	    UN_LABEL(un) = EOS
+	    UN_UNITS(un) = EOS
+	    call strcpy (units, UN_USER(un), SZ_UNITS)
+
+	    if (unlog == YES)
+		call strcat ("Log ", UN_LABEL(un), SZ_UNITS)
+	    if (uninv == YES)
+		call strcat ("inverse ", UN_UNITS(un), SZ_UNITS)
+	    call strcat (Memc[str], UN_UNITS(un), SZ_UNITS)
+	    switch (class[j]) {
+	    case UN_WAVE:
+		if (uninv == NO)
+		    call strcat ("Wavelength", UN_LABEL(un), SZ_UNITS)
+		else
+		    call strcat ("Wavenumber", UN_LABEL(un), SZ_UNITS)
+	    case UN_FREQ:
+		call strcat ("Frequency", UN_LABEL(un), SZ_UNITS)
+	    case UN_VEL:
+		call strcat ("Velocity", UN_LABEL(un), SZ_UNITS)
+	    case UN_ENERGY:
+		call strcat ("Energy", UN_LABEL(un), SZ_UNITS)
+	    case UN_DOP:
+		call strcat ("Redshift", UN_LABEL(un), SZ_UNITS)
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# UN_COMPARE -- Compare two units
+
+bool procedure un_compare (un1, un2)
+
+pointer	un1, un2		# Units pointers to compare
+bool	strne()
+
+begin
+	if (strne (UN_UNITS(un1), UN_UNITS(un2)))
+	    return (false)
+	if (strne (UN_LABEL(un1), UN_LABEL(un2)))
+	    return (false)
+	if (UN_VREF(un1) != UN_VREF(un2))
+	    return (false)
+	return (true)
+end
+
+
+# UN_CTRANR -- Transform units
+# Error is returned if the transform cannot be made
+
+procedure un_ctranr (un1, un2, val1, val2, nvals)
+
+pointer	un1			# Input units pointer
+pointer	un2			# Output units pointer
+real	val1[nvals]		# Input values
+real	val2[nvals]		# Output values
+int	nvals			# Number of values
+
+int	i
+real	s, v, z
+bool	un_compare()
+
+begin
+	if (un_compare (un1, un2)) {
+	    call amovr (val1, val2, nvals)
+	    return
+	}
+
+	if (UN_CLASS(un1) == UN_UNKNOWN || UN_CLASS(un2) == UN_UNKNOWN)
+	    call error (1, "Cannot convert between selected units")
+
+	call amovr (val1, val2, nvals)
+
+	s = UN_SCALE(un1)
+	if (UN_LOG(un1) == YES)
+	    do i = 1, nvals
+		val2[i] = 10. ** val2[i]
+	if (UN_INV(un1) == YES)
+	    do i = 1, nvals
+		val2[i] = 1. / val2[i]
+	switch (UN_CLASS(un1)) {
+	case UN_WAVE:
+	    do i = 1, nvals
+		val2[i] = val2[i] / s
+	case UN_FREQ:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_VEL:
+	    v = UN_VREF(un1)
+	    do i = 1, nvals {
+		z = val2[i] / s
+		val2[i] = sqrt ((1 + z) / (1 - z)) * v
+	    }
+	case UN_ENERGY:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_DOP:
+	    v = UN_VREF(un1)
+	    do i = 1, nvals
+		val2[i] = (val2[i] / s + 1) * v
+	}
+
+	s = UN_SCALE(un2)
+	switch (UN_CLASS(un2)) {
+	case UN_WAVE:
+	    do i = 1, nvals
+		val2[i] = val2[i] * s
+	case UN_FREQ:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_VEL:
+	    v = UN_VREF(un2)
+	    do i = 1, nvals {
+		z = (val2[i] / v) ** 2
+		val2[i] = (z - 1) / (z + 1) * s
+	    }
+	case UN_ENERGY:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_DOP:
+	    v = UN_VREF(un2)
+	    do i = 1, nvals
+		val2[i] = (val2[i] / v - 1) * s
+	}
+	if (UN_INV(un2) == YES)
+	    do i = 1, nvals
+		val2[i] = 1. / val2[i]
+	if (UN_LOG(un2) == YES)
+	    do i = 1, nvals
+		val2[i] = log10 (val2[i])
+end
+
+
+# UN_CHANGER -- Change units
+# Error is returned if the conversion cannot be made
+
+procedure un_changer (un, units, vals, nvals, update)
+
+pointer	un			# Units pointer (may be changed)
+char	units[ARB]		# Desired units
+real	vals[nvals]		# Values
+int	nvals			# Number of values
+int	update			# Update units pointer?
+
+bool	streq(), un_compare()
+pointer	un1, un_open()
+errchk	un_open, un_ctranr
+
+begin
+
+	# Check for same unit string
+	if (streq (units, UN_USER(un)))
+	    return
+
+	# Check for error in units string, or the same units.
+	un1 = un_open (units)
+	if (un_compare (un1, un)) {
+	    call strcpy (units, UN_USER(un), SZ_UNITS)
+	    call un_close (un1)
+	    return
+	}
+
+	iferr {
+	    call un_ctranr (un, un1, vals, vals, nvals)
+	    if (update == YES)
+		call un_copy (un1, un)
+	    call un_close(un1)
+	} then {
+	    call un_close(un1)
+	    call erract (EA_ERROR)
+	}
+end
+
+
+# UN_CTRAND -- Transform units
+# Error is returned if the transform cannot be made
+
+procedure un_ctrand (un1, un2, val1, val2, nvals)
+
+pointer	un1			# Input units pointer
+pointer	un2			# Output units pointer
+double	val1[nvals]		# Input values
+double	val2[nvals]		# Output values
+int	nvals			# Number of values
+
+int	i
+double	s, v, z
+bool	un_compare()
+
+begin
+	if (un_compare (un1, un2)) {
+	    call amovd (val1, val2, nvals)
+	    return
+	}
+
+	if (UN_CLASS(un1) == UN_UNKNOWN || UN_CLASS(un2) == UN_UNKNOWN)
+	    call error (1, "Cannot convert between selected units")
+
+	call amovd (val1, val2, nvals)
+
+	s = UN_SCALE(un1)
+	if (UN_LOG(un1) == YES)
+	    do i = 1, nvals
+		val2[i] = 10. ** val2[i]
+	if (UN_INV(un1) == YES)
+	    do i = 1, nvals
+		val2[i] = 1. / val2[i]
+	switch (UN_CLASS(un1)) {
+	case UN_WAVE:
+	    do i = 1, nvals
+		val2[i] = val2[i] / s
+	case UN_FREQ:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_VEL:
+	    v = UN_VREF(un1)
+	    do i = 1, nvals {
+		z = val2[i] / s
+		val2[i] = sqrt ((1 + z) / (1 - z)) * v
+	    }
+	case UN_ENERGY:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_DOP:
+	    v = UN_VREF(un1)
+	    do i = 1, nvals
+		val2[i] = (val2[i] / s + 1) * v
+	}
+
+	s = UN_SCALE(un2)
+	switch (UN_CLASS(un2)) {
+	case UN_WAVE:
+	    do i = 1, nvals
+		val2[i] = val2[i] * s
+	case UN_FREQ:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_VEL:
+	    v = UN_VREF(un2)
+	    do i = 1, nvals {
+		z = (val2[i] / v) ** 2
+		val2[i] = (z - 1) / (z + 1) * s
+	    }
+	case UN_ENERGY:
+	    do i = 1, nvals
+		val2[i] = s / val2[i]
+	case UN_DOP:
+	    v = UN_VREF(un2)
+	    do i = 1, nvals
+		val2[i] = (val2[i] / v - 1) * s
+	}
+	if (UN_INV(un2) == YES)
+	    do i = 1, nvals
+		val2[i] = 1. / val2[i]
+	if (UN_LOG(un2) == YES)
+	    do i = 1, nvals
+		val2[i] = log10 (val2[i])
+end
+
+
+# UN_CHANGED -- Change units
+# Error is returned if the conversion cannot be made
+
+procedure un_changed (un, units, vals, nvals, update)
+
+pointer	un			# Units pointer (may be changed)
+char	units[ARB]		# Desired units
+double	vals[nvals]		# Values
+int	nvals			# Number of values
+int	update			# Update units pointer?
+
+bool	streq(), un_compare()
+pointer	un1, un_open()
+errchk	un_open, un_ctrand
+
+begin
+
+	# Check for same unit string
+	if (streq (units, UN_USER(un)))
+	    return
+
+	# Check for error in units string, or the same units.
+	un1 = un_open (units)
+	if (un_compare (un1, un)) {
+	    call strcpy (units, UN_USER(un), SZ_UNITS)
+	    call un_close (un1)
+	    return
+	}
+
+	iferr {
+	    call un_ctrand (un, un1, vals, vals, nvals)
+	    if (update == YES)
+		call un_copy (un1, un)
+	    call un_close(un1)
+	} then {
+	    call un_close(un1)
+	    call erract (EA_ERROR)
+	}
+end
+
+
+# UN_ABBR -- Load abbreviations into a symbol table.
+
+procedure un_abbr (stp)
+
+pointer	stp		#U Symbol table
+
+int	fd, open(), fscan(), nscan(), stpstr()
+pointer	sp, key, val
+pointer	sym, stopen(), stfind(), stenter(), strefsbuf()
+errchk	open
+
+begin
+	if (stp != NULL)
+	    return
+
+	fd = open (ABBREVIATIONS, READ_ONLY, TEXT_FILE)
+	stp = stopen ("unabbr", 20, 20, 40*SZ_LINE)
+
+	call smark (sp)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+
+	while (fscan (fd) != EOF) {
+	    call gargwrd (Memc[key], SZ_LINE)
+	    call gargwrd (Memc[val], SZ_LINE)
+	    if (nscan() != 2)
+		next
+	    if (Memc[key] == '#')
+		next
+
+	    sym = stfind (stp, Memc[key])
+	    if (sym == NULL) {
+		sym = stenter (stp, Memc[key], 1)
+		Memi[sym] = stpstr (stp, Memc[val], SZ_LINE)
+	    } else
+		call strcpy (Memc[val], Memc[strefsbuf(stp,Memi[sym])], SZ_LINE)
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/specplot.h b/noao/onedspec/specplot.h
new file mode 100644
index 00000000..f4f62ff4
--- /dev/null
+++ b/noao/onedspec/specplot.h
@@ -0,0 +1,49 @@
+# Data structure for each spectrum
+
+define	SP_SZNAME	99			# Length of image name
+define	SP_SZTITLE	99			# Length of title
+define	SP_SZPTYPE	9			# Length of plot type
+define	SP_SZULABEL	99			# Length of user label
+define	SP_SZLABEL	99			# Length of label
+define	SP_LEN		225			# Length of SP structure
+
+define	SP_INDEX	Memi[$1]		# Index
+define	SP_SH		Memi[$1+1]		# Spectrum header
+define	SP_NPTS		Memi[$1+2]		# Number of data points
+define	SP_W0		Memr[P2R($1+3)]		# Starting wavelength
+define	SP_WPC		Memr[P2R($1+4)]		# Wavelength per pix
+define	SP_OMEAN	Memr[P2R($1+5)]		# Original mean intensity
+define	SP_OMIN		Memr[P2R($1+6)]		# Original minimum intensity
+define	SP_OMAX		Memr[P2R($1+7)]		# Original maximum intensity
+
+define	SP_XSCALE	Memr[P2R($1+8)]		# Wavelength scale
+define	SP_XOFFSET	Memr[P2R($1+9)]		# Wavelength offset
+define	SP_SCALE	Memr[P2R($1+10)]	# Intensity scale
+define	SP_OFFSET	Memr[P2R($1+11)]	# Intensity offset
+define	SP_MEAN		Memr[P2R($1+12)]	# Mean intensity
+define	SP_MIN		Memr[P2R($1+13)]	# Minimum intensity
+define	SP_MAX		Memr[P2R($1+14)]	# Maximum intensity
+define	SP_PX		Memi[$1+15]		# Pointer to wavelengths
+define	SP_PY		Memi[$1+16]		# Pointer to intensities
+define	SP_XLPOS	Memr[P2R($1+17)]	# X label position
+define	SP_YLPOS	Memr[P2R($1+18)]	# Y label position
+define	SP_COLOR	Memi[$1+19]		# Color
+define	SP_IMNAME	Memc[P2C($1+20)]	# Image name
+define	SP_IMTITLE	Memc[P2C($1+70)]	# Title
+define	SP_PTYPE	Memc[P2C($1+120)]	# Plot type
+define	SP_ULABEL	Memc[P2C($1+125)]	# Label
+define	SP_LABEL	Memc[P2C($1+175)]	# Label
+
+define	SP_X		Memr[SP_PX($1)]		# Wavelengths
+define	SP_Y		Memr[SP_PY($1)]		# Intensities
+
+define	LABELS		"|none|imname|imtitle|index|user|"
+define	LABEL_NONE	1	# No labels
+define	LABEL_IMNAME	2	# Image name
+define	LABEL_IMTITLE	3	# Image title
+define	LABEL_INDEX	4	# Index
+define	LABEL_USER	5	# No labels
+
+define	TRANSFORMS	"|none|log|"
+define	TRANS_NONE	1	# No transform
+define	TRANS_LOG	2	# Log transform
diff --git a/noao/onedspec/specplot.key b/noao/onedspec/specplot.key
new file mode 100644
index 00000000..acb61487
--- /dev/null
+++ b/noao/onedspec/specplot.key
@@ -0,0 +1,134 @@
+			SPECPLOT COMMAND OPTIONS
+
+				SUMMARY
+
+? Help                    o Reorder                 v Velocity plot
+a Append spectrum         p Position label          w Window
+d Delete spectrum         q Quit                    x No scaling
+e Undelete spectrum       r Redraw                  y Offset layout
+f Toggle world/pixel      s Shift                   z Scale layout
+i Insert spectrum         t Set X scale             
+l Label                   u Set wavelength          
+
+:/title <val>              :move[#] <to_index>        :ulabel[#|*] <val>
+:/xlabel <val>             :offset[#|*] <val>         :units[#|*] <val>
+:/xwindow <min max>        :ptype[#|*] <val>          :velocity[#|*] <val>
+:/ylabel <val>             :redshift[#|*] <val>       :vshow <file>
+:/ywindow <min max>        :scale[#|*] <val>          :w0[#|*] <val>
+:color[#|*] <val>          :shift[#|*] <val>          :wpc[#|*] <val>
+:fraction <val>            :show <file>               :xlpos[#|*] <val>
+:label <val>               :step <val>                :ylpos[#|*] <val>
+
+				CURSOR COMMANDS
+
+The indicated spectrum is the one with a point closest to the cursor position.
+
+? - Print help summary
+a - Append a new spectrum following the indicated spectrum
+d - Delete the indicated spectrum
+e - Insert last deleted spectrum before indicated spectrum
+f - Toggle between world coordinates and logical pixel coordinates
+i - Insert a new spectrum before the indicated spectrum
+l - Define the user label at the indicated position
+o - Reorder the spectra to eliminate gaps
+p - Define the label position at the indicated position
+q - Quit
+r - Redraw the plot
+s - Repeatedly shift the indicated spectrum position with the cursor
+     q - Quit shift                      x - Shift horizontally in velocity
+     s - Shift vertically in scale       y - Shift vertically in offset
+     t - Shift horizontally in velocity  z - Shift horizontally in velocity
+         and vertically in scale             and vertically in offset
+t - Set a wavelength scale using the cursor
+u - Set a wavelength point using the cursor
+v - Set velocity plot with zero point at cursor
+w - Window the plot
+x - Cancel all scales and offsets
+y - Automatically layout the spectra with offsets to common mean
+z - Automatically layout the spectra scaled to common mean
+
+
+			COLON COMMANDS
+
+A command without a value generally shows the current value of the
+parameter while with a value it sets the value of the parameter.  The
+show commands print to the terminal unless a file is given.  For the
+spectrum parameters the index specification, "[#]", is optional.  If
+absent the nearest spectrum to the cursor when the command is given is
+selected except that for the "units" command all spectra are selected.
+The index is either a number or the character *.  The latter
+applies the command to all the spectra.
+
+:show <file>			Show spectrum parameters (file optional)
+:vshow <file>			Show verbose parameters (file optional)
+:step <val>			Set or show step
+:fraction <val>			Set or show autolayout fraction
+:label <val>			Set or show label type
+				  (none|imtitle|imname|index|user)
+
+:move[#] <to_index>		Move spectrum to new index position
+:shift[#|*] <val>		Shift spectra by adding to index
+:w0[#|*] <val>			Set or show zero point wavelength
+:wpc[#|*] <val>			Set or show wavelength per channel
+:velocity[#|*] <val>		Set or show radial velocity (km/s)
+:redshift[#|*] <val>		Set or show redshift
+:offset[#|*] <val>		Set or show intensity offset
+:scale[#|*] <val>		Set or show intensity scale
+:xlpos[#|*] <val>		Set or show X label position
+:ylpos[#|*] <val>		Set or show Y label position
+:ptype[#|*] <val>		Set or show plotting type
+:color[#|*] <val>		Set or show color (1-9)
+:ulabel[#|*] <val>		Set or show user labels
+:units[#|*] <val>		Change coordinate units (see below)
+
+:/title <val>			Set the title of the graph
+:/xlabel <val>			Set the X label of the graph
+:/ylabel <val>			Set the Y label of the graph
+:/xwindow <min max>		Set the X graph range
+				  (use INDEF for autoscaling)
+:/ywindow <min max>		Set the X graph range
+				  (use INDEF for autoscaling)
+ 
+
+Examples:
+    w0		  Print value of wavelength zero point
+    w0 4010	  Set wavelength zero point of spectrum nearest the cursor
+    w0[3] 4010	  Set wavelength zero point of spectrum with index 3
+    w0[*] 4010	  Set wavelength zero point of all spectra
+
+
+				UNITS
+
+The units are specified by strings having a unit type from the list
+below along with the possible modifiers, "inverse", to select
+the inverse of the unit and "log" to select logarithmic units.
+The various identifiers may be abbreviated as words but the syntax
+is not sophisticated enough to recognized standard scientific abbreviations
+such as mm for millimeter.
+
+	   angstroms - Wavelength in Angstroms
+	  nanometers - Wavelength in nanometers
+	millimicrons - Wavelength in millimicrons
+	     microns - Wavelength in microns
+	 millimeters - Wavelength in millimeters
+	  centimeter - Wavelength in centimeters
+	      meters - Wavelength in meters
+	       hertz - Frequency in hertz (cycles per second)
+	   kilohertz - Frequency in kilohertz
+	   megahertz - Frequency in megahertz
+	    gigahertz - Frequency in gigahertz
+	         m/s - Velocity in meters per second
+	        km/s - Velocity in kilometers per second
+	          ev - Energy in electron volts
+	         kev - Energy in kilo electron volts
+	         mev - Energy in mega electron volts
+		   z - Redshift
+
+The velocity and redshift units require a trailing value and unit defining the
+velocity zero point.  For example to plot velocity relative to
+a wavelength of 1 micron the unit string would be:
+
+	km/s 1 micron
+
+The syntax :units[#] km/s <value> <unit> is available to plot different
+(or the same) spectrum with different features at zero velocity.
diff --git a/noao/onedspec/specplot.par b/noao/onedspec/specplot.par
new file mode 100644
index 00000000..c7b7cbce
--- /dev/null
+++ b/noao/onedspec/specplot.par
@@ -0,0 +1,28 @@
+spectra,s,a,,,,List of spectra to plot
+apertures,s,h,"",,,Apertures to plot
+bands,s,h,"1",,,Bands of 3D images to plot
+autolayout,b,h,yes,,,Use automatic layout algorithm?
+autoscale,b,h,yes,,,Scale to common mean for automatic layout?
+fraction,r,h,1.0,,,Fraction of automatic minimum separation step
+units,s,h,"",,,Coordinate units
+transform,s,h,"none","none|log",,Flux transformation
+scale,s,h,1.,,,"Intensity scale (value, @file, keyword)"
+offset,s,h,0.,,,"Intensity offset (value, @file, keyword)"
+step,r,h,0.,,,Default separation step
+ptype,s,h,"1",,,Plotting type
+labels,s,h,"user","none|imname|imtitle|index|user",,Type of labels
+ulabels,s,h,"",,,User labels (file)
+xlpos,r,h,1.02,,,X label position (fraction of range)
+ylpos,r,h,0.0,,,Y label position (fraction of mean)
+sysid,b,h,yes,,,Include system banner and step value?
+yscale,b,h,no,,,Draw Y axis scale?
+title,s,h,"",,,Plot title
+xlabel,s,h,"",,,X axis label
+ylabel,s,h,"",,,Y axis label
+xmin,r,h,INDEF,,,X axis left limit
+xmax,r,h,INDEF,,,X axis right limit
+ymin,r,h,INDEF,,,Y axis bottom limit
+ymax,r,h,INDEF,,,Y axis top limit
+logfile,f,h,"",,,Logfile
+graphics,s,h,"stdgraph",,,Graphics output device
+cursor,*gcur,h,"",,,Cursor input
diff --git a/noao/onedspec/specshift.par b/noao/onedspec/specshift.par
new file mode 100644
index 00000000..65cc9e3c
--- /dev/null
+++ b/noao/onedspec/specshift.par
@@ -0,0 +1,4 @@
+spectra,s,a,,,,List of spectra
+shift,r,a,0.,,,Shift to add to dispersion coordinates
+apertures,s,h,"",,,List of apertures to shift
+verbose,b,h,no,,,Print verbose information?
diff --git a/noao/onedspec/splot.par b/noao/onedspec/splot.par
new file mode 100644
index 00000000..a40589f7
--- /dev/null
+++ b/noao/onedspec/splot.par
@@ -0,0 +1,52 @@
+# SPLOT -- Parameter file for spectral plot package
+
+images,s,a,,,,"List of images to plot"
+line,i,q,1,0,,"Image line/aperture to plot"
+band,i,q,1,1,,"Image band to plot"
+
+units,s,h,"",,,"Plotting units"
+options,s,h,"auto wreset",,,"Combination of plotting options:
+auto, zero, xydraw, histogram,
+nosysid, wreset, flip, overplot"
+xmin,r,h,INDEF,,,"Minimum X value of initial graph"
+xmax,r,h,INDEF,,,"Maximum X value of initial graph"
+ymin,r,h,INDEF,,,"Minimum Y value of initial graph"
+ymax,r,h,INDEF,,,"Maximum Y value of initial graph"
+save_file,s,h,"splot.log",,,"File to contain answers"
+graphics,s,h,"stdgraph",,,"Output graphics device"
+cursor,*gcur,h,"",,,"Graphics cursor input
+
+# PARAMETERS FOR ERROR ANALYSIS"
+nerrsample,i,h,0,0,,"Number of error samples (<10 for no errors)"
+sigma0,r,h,INDEF,,,"Constant gaussian noise term (INDEF for no errors)"
+invgain,r,h,INDEF,,,"Inverse gain term (INDEF for no errors)
+
+# PARAMETERS FOR CONTINUUM FITTING"
+function,s,h,"spline3","spline3|legendre|chebyshev|spline1",,"Fitting function"
+order,i,h,1,1,,"Order of fitting function"
+low_reject,r,h,2.,0.,,"Low rejection in sigma of fit"
+high_reject,r,h,4.,0.,,"High rejection in sigma of fit"
+niterate,i,h,10,0,,"Number of rejection iterations"
+grow,r,h,1.,0.,,"Rejection growing radius"
+markrej,b,h,yes,,,"Mark rejected points?
+
+# PARAMETERS FOR OVERPLOTTING STANDARD STAR FLUXES"
+star_name,s,q,,,,"Standard star name"
+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"
+caldir,s,h,)_.caldir,,,"Directory containing calibration data"
+fnuzero,r,h,3.68e-20,,,"Absolute flux zero point
+
+# PARAMETERS USED IN INTERACTIVE QUERIES"
+next_image,s,q,,,,"Next image to plot"
+new_image,s,q,,,,"Image to create"
+overwrite,b,q,,,,"Overwrite image?"
+spec2,s,q,,,,"Spectrum"
+constant,r,q,,,,"Constant to be applied"
+wavelength,r,q,,,,"Dispersion coordinate:"
+linelist,f,q,,,,"File"
+wstart,r,q,,,,"Starting wavelength"
+wend,r,q,,,,"Ending wavelength"
+dw,r,q,,,,"Wavelength per pixel"
+boxsize,i,q,,1,,"Smoothing box size (odd number)"
diff --git a/noao/onedspec/splot/anshdr.x b/noao/onedspec/splot/anshdr.x
new file mode 100644
index 00000000..e314454b
--- /dev/null
+++ b/noao/onedspec/splot/anshdr.x
@@ -0,0 +1,84 @@
+include	<time.h>
+include	<fset.h>
+include	<smw.h>
+
+# ANS_HDR -- Add answer header in answer file
+
+procedure ans_hdr (sh, newimage, key, fname1, fname2, fd1, fd2)
+
+pointer	sh
+int	newimage
+int	key
+char	fname1[SZ_FNAME]
+char	fname2[SZ_FNAME]
+int	fd1, fd2
+
+pointer	sp, time
+long	clktime()
+int	key1, open()
+errchk	open
+data	key1/0/
+
+begin
+	# Check for valid file name
+	if (fd1 == NULL && fname1[1] != EOS) {
+	    fd1 = open (fname1, APPEND, TEXT_FILE)
+	    call fseti (fd1, F_FLUSHNL, YES)
+	}
+	if (fd2 == NULL && fname2[1] != EOS) {
+	    fd2 = open (fname2, APPEND, TEXT_FILE)
+	    call fseti (fd2, F_FLUSHNL, YES)
+	}
+
+	# Print image name.
+	if (newimage == YES) {
+	    call smark (sp)
+	    call salloc (time, SZ_DATE, TY_CHAR)
+	    call cnvdate (clktime(0), Memc[time], SZ_DATE)
+
+	    if (fd1 != NULL) {
+		call fprintf (fd1, "\n%s [%s%s]: %s\n")
+		    call pargstr (Memc[time])
+		    call pargstr (IMNAME(sh))
+		    call pargstr (IMSEC(sh))
+		    call pargstr (TITLE(sh))
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2, "\n%s [%s%s]: %s\n")
+		    call pargstr (Memc[time])
+		    call pargstr (IMNAME(sh))
+		    call pargstr (IMSEC(sh))
+		    call pargstr (TITLE(sh))
+	    }
+	    call sfree (sp)
+	}
+
+	# Print key dependent header.
+	if (key != key1) {
+	    if (key != 'm') {
+		if (fd1 != NULL) {
+		    call fprintf (fd1, "%10s%10s%10s%10s%10s%10s%10s\n")
+			call pargstr ("center")
+			call pargstr ("cont")
+			call pargstr ("flux")
+			call pargstr ("eqw")
+			call pargstr ("core")
+			call pargstr ("gfwhm")
+			call pargstr ("lfwhm")
+		    call flush (fd1)
+		}
+		if (fd2 != NULL) {
+		    call fprintf (fd2, "%10s%10s%10s%10s%10s%10s%10s\n")
+			call pargstr ("center")
+			call pargstr ("cont")
+			call pargstr ("flux")
+			call pargstr ("eqw")
+			call pargstr ("core")
+			call pargstr ("gfwhm")
+			call pargstr ("lfwhm")
+		    call flush (fd2)
+		}
+	    }
+	    key1 = key
+	}
+end
diff --git a/noao/onedspec/splot/autoexp.x b/noao/onedspec/splot/autoexp.x
new file mode 100644
index 00000000..c36f6a8b
--- /dev/null
+++ b/noao/onedspec/splot/autoexp.x
@@ -0,0 +1,79 @@
+include	<mach.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+
+# AUTO_EXP -- Auto expand around the marked region
+
+procedure auto_exp (gp, gt, key, wx1, x, y, n)
+
+pointer	gp		# GIO pointer
+pointer	gt		# GTOOLS pointer
+int	key		# Key
+real	wx1		# Cursor position
+real	x[n]		# Pixel coordinates
+real	y[n]		# Pixel data for Y scaling
+int	n		# Number of pixels
+
+char	cmd[1]
+int	i, wcs
+real	x1, x2, y1, y2, wx2, wy, dx, xmin, xmax, ymin, ymax
+
+int	clgcur()
+
+begin
+	# Get the current window.
+	call ggwind (gp, x1, x2, y1, y2)
+
+	# Compute the new window in x.
+	dx = x2 - x1
+	switch (key) {
+	case 'a':	# Expand
+	    call printf ("again:\n")
+	    i = clgcur ("cursor", wx2, wy, wcs, key, cmd, SZ_LINE)
+	    x1 = wx1
+	    x2 = wx2
+	case ',':	# Shift left
+	    x1 = x1 - 0.85 * dx
+	    x2 = x2 - 0.85 * dx
+	case '.':	# Shift right
+	    x1 = x1 + 0.85 * dx
+	    x2 = x2 + 0.85 * dx
+	case 'z':	# Zoom x axis
+	    x1 = x1 + 0.25 * dx
+	    x2 = x2 - 0.25 * dx
+	}
+
+	if (x1 == x2) {
+	    # Autoscale.
+	    x1 = INDEF
+	    x2 = INDEF
+	    ymin = INDEF
+	    ymax = INDEF
+	} else {
+	    # Determine the y limits for pixels between x1 and x2.
+	    xmin = min (x1, x2)
+	    xmax = max (x1, x2)
+	    ymin = MAX_REAL
+	    ymax = -MAX_REAL
+	    do i = 1, n {
+		if (x[i] < xmin || x[i] > xmax)
+		    next
+		ymin = min (y[i], ymin)
+		ymax = max (y[i], ymax)
+	    }
+	    if (ymin > ymax) {
+		ymin = y1
+		ymax = y2
+	    } else if (y1 > y2) {
+		y1 = ymin
+		ymin = ymax
+		ymax = y1
+	    }
+	}
+
+	call gt_setr (gt, GTXMIN, x1)
+	call gt_setr (gt, GTXMAX, x2)
+	call gt_setr (gt, GTYMIN, ymin)
+	call gt_setr (gt, GTYMAX, ymax)
+	call replot (gp, gt, x, y, n, YES)
+end
diff --git a/noao/onedspec/splot/avgsnr.x b/noao/onedspec/splot/avgsnr.x
new file mode 100644
index 00000000..a4ad9ceb
--- /dev/null
+++ b/noao/onedspec/splot/avgsnr.x
@@ -0,0 +1,72 @@
+# AVGSNR -- Compute average value and signal-to-noise in region
+
+procedure avgsnr (sh, wx1, wy1, y, n, fd1, fd2)
+
+pointer	sh
+real	wx1, wy1
+real	y[n]
+int	n
+int	fd1, fd2
+
+char	command[SZ_FNAME]
+real	wx2, wy2
+real	avg, snr, rms
+int	i, i1, i2, nsum
+int	wc, key
+
+int	clgcur()
+
+begin
+	# Get second position
+	call printf ("m again:")
+	call flush (STDOUT)
+	i = clgcur ("cursor", wx2, wy2, wc, key, command, SZ_FNAME)
+
+	# Fix pixel indices
+	call fixx (sh, wx1, wx2, wy1, wy2, i1, i2)
+	if (i1 == i2) {
+	    call printf ("Cannot determine SNR - move cursor")
+	    return
+	}
+
+	# Compute avg, rms, snr
+	nsum = i2 - i1 + 1
+	avg = 0.
+	rms = 0.
+	snr = 0.
+
+	if (nsum > 0) {
+	    do i = i1, i2
+		avg = avg + y[i]
+	    avg = avg / nsum
+	}
+
+	if (nsum > 1) {
+	    call alimr (y[i1], nsum, wy1, wy2)
+	    wy1 = wy2 - wy1
+	    if (wy1 > 0.) {
+	        do i = i1, i2
+		    rms = rms + ((y[i] - avg) / wy1) ** 2
+	        rms = wy1 * sqrt (rms / (nsum-1))
+	        snr = avg / rms
+	    }
+	}
+
+	# Print out
+	call printf ("avg: %10.4g  rms: %10.4g   snr: %8.2f\n")
+	    call pargr (avg)
+	    call pargr (rms)
+	    call pargr (snr)
+	if (fd1 != NULL) {
+	    call fprintf (fd1, "avg: %10.4g  rms: %10.4g   snr: %8.2f\n")
+		call pargr (avg)
+		call pargr (rms)
+		call pargr (snr)
+	}
+	if (fd2 != NULL) {
+	    call fprintf (fd2, "avg: %10.4g  rms: %10.4g   snr: %8.2f\n")
+		call pargr (avg)
+		call pargr (rms)
+		call pargr (snr)
+	}
+end
diff --git a/noao/onedspec/splot/conflam.x b/noao/onedspec/splot/conflam.x
new file mode 100644
index 00000000..c322d566
--- /dev/null
+++ b/noao/onedspec/splot/conflam.x
@@ -0,0 +1,28 @@
+include	<error.h>
+include	<smw.h>
+
+define	VLIGHT		2.997925e18
+
+# CONFLAM -- Convert to FLAMBDA from FNU
+
+procedure conflam (sh)
+
+pointer	sh			# SHDR pointer
+
+int	i
+real	lambda
+pointer	ang, un_open()
+errchk	un_open, un_ctranr
+
+begin
+	ang = un_open ("angstroms")
+	iferr {
+	    do i = 0, SN(sh)-1 {
+		call un_ctranr (UN(sh), ang, Memr[SX(sh)+i], lambda, 1)
+		Memr[SY(sh)+i] = Memr[SY(sh)+i] * VLIGHT / lambda**2
+	    }
+	} then
+	    call erract (EA_WARN)
+
+	call un_close (ang)
+end
diff --git a/noao/onedspec/splot/confnu.x b/noao/onedspec/splot/confnu.x
new file mode 100644
index 00000000..228cea6f
--- /dev/null
+++ b/noao/onedspec/splot/confnu.x
@@ -0,0 +1,28 @@
+include	<error.h>
+include	<smw.h>
+
+define	VLIGHT		2.997925e18
+
+# CONFNU -- Convert to FNU from FLAMBDA
+
+procedure confnu (sh)
+
+pointer	sh			# SHDR pointer
+
+int	i
+real	lambda
+pointer	ang, un_open()
+errchk	un_open, un_ctranr
+
+begin
+	ang = un_open ("angstroms")
+	iferr {
+	    do i = 0, SN(sh)-1 {
+		call un_ctranr (UN(sh), ang, Memr[SX(sh)+i], lambda, 1)
+		Memr[SY(sh)+i] = Memr[SY(sh)+i] * lambda**2 / VLIGHT
+	    }
+	} then
+	    call erract (EA_WARN)
+
+	call un_close (ang)
+end
diff --git a/noao/onedspec/splot/deblend.x b/noao/onedspec/splot/deblend.x
new file mode 100644
index 00000000..d43a9d52
--- /dev/null
+++ b/noao/onedspec/splot/deblend.x
@@ -0,0 +1,627 @@
+include	<math.h>
+include	<mach.h>
+
+# Profile types.
+define	GAUSS		1	# Gaussian profile
+define	LORENTZ		2	# Lorentzian profile
+define	VOIGT		3	# Voigt profile
+
+# Elements of fit array.
+define	BKG		1	# Background
+define	POS		2	# Position
+define	INT		3	# Intensity
+define	GAU		4	# Gaussian FWHM
+define	LOR		5	# Lorentzian FWHM
+
+# Type of constraints.
+define	FIXED		1	# Fixed parameter
+define	SINGLE		2	# Fit a single value for all lines
+define	INDEP		3	# Fit independent values for all lines
+
+
+# DOFIT -- Fit line profiles.  This is an interface to DOFIT1
+# which puts parameters into the required form and vice-versa.
+# It also implements a constrained approach to the solution.
+
+procedure dofit (fit, x, y, s, npts, dx, nsub, y1, dy,
+    xp, yp, gp, lp, tp, np, chisq)
+
+int	fit[5]		# Fit constraints
+real	x[npts]		# X data
+real	y[npts]		# Y data
+real	s[npts]		# Sigma data
+int	npts		# Number of points
+real	dx		# Pixel size
+int	nsub		# Number of subpixels
+real	y1		# Continuum offset
+real	dy		# Continuum slope
+real	xp[np]		# Profile positions
+real	yp[np]		# Profile intensities
+real	gp[np]		# Profile Gaussian FWHM
+real	lp[np]		# Profile Lorentzian FWHM
+int	tp[np]		# Profile type	
+int	np		# Number of profiles
+real	chisq		# Chi squared
+
+int	i, j, fit1[5]
+pointer	sp, a, b
+errchk	dofit1
+
+begin
+	call smark (sp)
+	call salloc (a, 8 + 5 * np, TY_REAL)
+
+	# Convert positions and widths relative to first component.
+	Memr[a] = dx
+	Memr[a+1] = nsub
+	Memr[a+2] = y1
+	Memr[a+3] = dy
+	Memr[a+4] = yp[1]
+	Memr[a+5] = xp[1]
+	Memr[a+6] = gp[1]
+	Memr[a+7] = lp[1]
+	do i = 1, np {
+	    b = a + 5 * i + 3
+	    Memr[b]   = yp[i] / Memr[a+4]
+	    Memr[b+1] = xp[i] - Memr[a+5]
+	    switch (tp[i]) {
+	    case GAUSS:
+		if (Memr[a+6] == 0.)
+		    Memr[a+6] = gp[i]
+		Memr[b+2] = gp[i] / Memr[a+6]
+	    case LORENTZ:
+		if (Memr[a+7] == 0.)
+		    Memr[a+7] = lp[i]
+		Memr[b+3] = lp[i] / Memr[a+7]
+	    case VOIGT:
+		if (Memr[a+6] == 0.)
+		    Memr[a+6] = gp[i]
+		Memr[b+2] = gp[i] / Memr[a+6]
+		if (Memr[a+7] == 0.)
+		    Memr[a+7] = lp[i]
+		Memr[b+3] = lp[i] / Memr[a+7]
+	    }
+	    Memr[b+4] = tp[i]
+	}
+
+	# Do fit.
+	fit1[INT] = fit[INT]
+	do i = 1, fit[BKG] {
+	    fit1[BKG] = i
+	    fit1[GAU] = min (SINGLE, fit[GAU])
+	    fit1[LOR] = min (SINGLE, fit[LOR])
+	    do j = FIXED, fit[POS] {
+		fit1[POS] = j
+		if (np > 1 || j != INDEP)
+		    call dofit1 (fit1, x, y, s, npts, Memr[a], np, chisq)
+	    }
+	    if (np > 1 && (fit[GAU] == INDEP || fit[LOR] == INDEP)) {
+		fit1[GAU] = fit[GAU]
+		fit1[LOR] = fit[LOR]
+		call dofit1 (fit1, x, y, s, npts, Memr[a], np, chisq)
+	    }
+	}
+
+	y1 = Memr[a+2]
+	dy = Memr[a+3]
+	do i = 1, np {
+	    b = a + 5 * i + 3
+	    yp[i] = Memr[b] * Memr[a+4]
+	    xp[i] = Memr[b+1] + Memr[a+5]
+	    switch (tp[i]) {
+	    case GAUSS:
+		gp[i] = abs (Memr[b+2] * Memr[a+6])
+	    case LORENTZ:
+		lp[i] = abs (Memr[b+3] * Memr[a+7])
+	    case VOIGT:
+		gp[i] = abs (Memr[b+2] * Memr[a+6])
+		lp[i] = abs (Memr[b+3] * Memr[a+7])
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# DOREFIT -- Refit line profiles.  This assumes the input is very close
+# to the final solution and minimizes the number of calls to the
+# fitting routines.  This is intended for efficient use in the
+# in computing bootstrap error estimates.
+
+procedure dorefit (fit, x, y, s, npts, dx, nsub, y1, dy,
+    xp, yp, gp, lp, tp, np, chisq)
+
+int	fit[5]		# Fit constraints
+real	x[npts]		# X data
+real	y[npts]		# Y data
+real	s[npts]		# Sigma data
+int	npts		# Number of points
+real	dx		# Pixel size
+int	nsub		# Number of subpixels
+real	y1		# Continuum offset
+real	dy		# Continuum slope
+real	xp[np]		# Profile positions
+real	yp[np]		# Profile intensities
+real	gp[np]		# Profile Gaussian FWHM
+real	lp[np]		# Profile Lorentzian FWHM
+int	tp[np]		# Profile type	
+int	np		# Number of profiles
+real	chisq		# Chi squared
+
+int	i
+pointer	sp, a, b
+errchk	dofit1
+
+begin
+	call smark (sp)
+	call salloc (a, 8 + 5 * np, TY_REAL)
+
+	# Convert positions and widths relative to first component.
+	Memr[a] = dx
+	Memr[a+1] = nsub
+	Memr[a+2] = y1
+	Memr[a+3] = dy
+	Memr[a+4] = yp[1]
+	Memr[a+5] = xp[1]
+	Memr[a+6] = gp[1]
+	Memr[a+7] = lp[1]
+	do i = 1, np {
+	    b = a + 5 * i + 3
+	    Memr[b]   = yp[i] / Memr[a+4]
+	    Memr[b+1] = xp[i] - Memr[a+5]
+	    switch (tp[i]) {
+	    case GAUSS:
+		if (Memr[a+6] == 0.)
+		    Memr[a+6] = gp[i]
+		Memr[b+2] = gp[i] / Memr[a+6]
+	    case LORENTZ:
+		if (Memr[a+7] == 0.)
+		    Memr[a+7] = lp[i]
+		Memr[b+3] = lp[i] / Memr[a+7]
+	    case VOIGT:
+		if (Memr[a+6] == 0.)
+		    Memr[a+6] = gp[i]
+		Memr[b+2] = gp[i] / Memr[a+6]
+		if (Memr[a+7] == 0.)
+		    Memr[a+7] = lp[i]
+		Memr[b+3] = lp[i] / Memr[a+7]
+	    }
+	    Memr[b+4] = tp[i]
+	}
+
+	# Do fit.
+	call dofit1 (fit, x, y, s, npts, Memr[a], np, chisq)
+
+	y1 = Memr[a+2]
+	dy = Memr[a+3]
+	do i = 1, np {
+	    b = a + 5 * i + 3
+	    yp[i] = Memr[b] * Memr[a+4]
+	    xp[i] = Memr[b+1] + Memr[a+5]
+	    switch (tp[i]) {
+	    case GAUSS:
+		gp[i] = abs (Memr[b+2] * Memr[a+6])
+	    case LORENTZ:
+		lp[i] = abs (Memr[b+3] * Memr[a+7])
+	    case VOIGT:
+		gp[i] = abs (Memr[b+2] * Memr[a+6])
+		lp[i] = abs (Memr[b+3] * Memr[a+7])
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# MODEL -- Compute model.
+
+real procedure model (x, dx, nsub, xp, yp, gp, lp, tp, np)
+
+real	x		# X value to be evaluated
+real	dx		# Pixel width
+int	nsub		# Number of subpixels
+real	xp[np]		# Profile positions
+real	yp[np]		# Profile intensities
+real	gp[np]		# Profile Gaussian FWHM
+real	lp[np]		# Profile Lorentzian FWHM
+int	tp[np]		# Profile type	
+int	np		# Number of profiles
+
+int	i, j
+real	delta, x1, y, arg1, arg2, v, v0, u
+
+begin
+	delta = dx / nsub
+	x1 = x - (dx + delta) / 2
+	y = 0.
+	do j = 1, nsub {
+	    x1 = x1 + delta
+	    do i = 1, np {
+		switch (tp[i]) {
+		case GAUSS:
+		    arg1 = 1.66511 * abs ((x1 - xp[i]) / gp[i])
+		    if (arg1 < 5.)
+			y = y + yp[i] * exp (-arg1**2)
+		case LORENTZ:
+		    arg2 = abs ((x1 - xp[i]) / (lp[i] / 2))
+		    y = y + yp[i] / (1 + arg2**2)
+		case VOIGT:
+		    arg1 = 1.66511 * (x1 - xp[i]) / gp[i]
+		    arg2 = 0.832555 * lp[i] / gp[i]
+		    call voigt (0., arg2, v0, u)
+		    call voigt (arg1, arg2, v, u)
+		    y = y + yp[i] * v / v0
+		}
+	    }
+	}
+	y = y / nsub
+	return (y)
+end
+
+
+# DERIVS -- Compute model and derivatives for MR_SOLVE procedure.
+# This could be optimized more for the Voigt profile by reversing
+# the do loops since v0 need only be computed once per line.
+
+procedure derivs (x, a, y, dyda, na)
+
+real	x		# X value to be evaluated
+real	a[na]		# Parameters
+real	y		# Function value
+real	dyda[na]	# Derivatives
+int	na		# Number of parameters
+
+int	i, j, nsub
+real	dx, dx1, delta, x1, wg, wl, arg1, arg2, I0, dI, c, u, v, v0
+
+begin
+	dx = a[1]
+	nsub = a[2]
+	delta = dx / nsub
+	dx1 = .1 * delta
+	x1 = x - (dx + delta) / 2
+	y = 0.
+	do i = 1, na
+	   dyda[i] = 0.
+	do j = 1, nsub {
+	    x1 = x1 + delta
+	    y = y + a[3] + a[4] * x1
+	    dyda[3] = dyda[3] + 1.
+	    dyda[4] = dyda[4] + x1
+	    do i = 9, na, 5 {
+		switch (a[i+4]) {
+		case GAUSS:
+		    I0 = a[5] * a[i]
+		    wg = a[7] * a[i+2]
+		    arg1 = 1.66511 * (x1 - a[6] - a[i+1]) / wg
+		    if (abs (arg1) < 5.) {
+			dI = exp (-arg1**2)
+			c = I0 * dI * arg1
+			y = y + I0 * dI
+			dyda[5] = dyda[5] + a[i] * dI
+			dyda[6] = dyda[6] + c / wg
+			dyda[7] = dyda[7] + c * arg1 / a[7]
+			dyda[i] = dyda[i] + a[5] * dI
+			dyda[i+1] = dyda[i+1] + c / wg
+			dyda[i+2] = dyda[i+2] + c * arg1 / a[i+2]
+		    }
+		case LORENTZ:
+		    I0 = a[5] * a[i]
+		    wl = (a[8] * a[i+3] / 2)
+		    arg2 = (x1 - a[6] - a[i+1]) / wl
+		    dI = 1 / (1 + arg2**2)
+		    c = 2 * I0 * dI * dI * arg2
+		    y = y + I0 * dI
+		    dyda[5] = dyda[5] + a[i] * dI
+		    dyda[6] = dyda[6] + c / wl
+		    dyda[8] = dyda[8] + c * arg2 / a[8]
+		    dyda[i] = dyda[i] + a[5] * dI
+		    dyda[i+1] = dyda[i+1] + c / wl
+		    dyda[i+3] = dyda[i+3] + c * arg2 / a[i+3]
+		case VOIGT:
+		    a[7] = max (dx1, abs(a[7]))
+		    a[8] = max (dx1, abs(a[8]))
+		    a[i+2] = max (1E-6, abs(a[i+2]))
+		    a[i+3] = max (1E-6, abs(a[i+3]))
+
+		    I0 = a[5] * a[i]
+		    wg = a[7] * a[i+2]
+		    wl = a[8] * a[i+3]
+		    arg1 = 1.66511 * (x1 - a[6] - a[i+1]) / wg
+		    arg2 = 0.832555 * wl / wg
+		    call voigt (0., arg2, v0, u)
+		    call voigt (arg1, arg2, v, u)
+		    v = v / v0; u = u / v0
+		    dI = (1 - v) / (v0 * SQRTOFPI)
+		    c = 2 * I0 * arg2
+		    y = y + I0 * v
+		    dyda[5] = dyda[5] + a[i] * v
+		    dyda[6] = dyda[6] + 2 * c * (arg1 * v - arg2 * u) / wl
+		    dyda[7] = dyda[7] +
+			c * (dI + arg1 * (arg1 / arg2 * v - 2 * u)) / a[7]
+		    dyda[8] = dyda[8] + c * (arg1 * u - dI) / a[8]
+		    dyda[i] = dyda[i] + a[5] * v
+		    dyda[i+1] = dyda[i+1] + 2 * c * (arg1 * v - arg2 * u) / wl
+		    dyda[i+2] = dyda[i+2] +
+			c * (dI + arg1 * (arg1 / arg2 * v - 2 * u)) / a[i+2]
+		    dyda[i+3] = dyda[i+3] + c * (arg1 * u - dI) / a[i+3]
+		}
+	    }
+	}
+	y = y / nsub
+	do i = 1, na
+	   dyda[i] = dyda[i] / nsub
+end
+
+
+# DOFIT1 -- Perform nonlinear iterative fit for the specified parameters.
+# This uses the Levenberg-Marquardt method from NUMERICAL RECIPES.
+
+procedure dofit1 (fit, x, y, s, npts, a, nlines, chisq)
+
+int	fit[5]		# Fit constraints
+real	x[npts]		# X data
+real	y[npts]		# Y data
+real	s[npts]		# Sigma data
+int	npts		# Number of points
+real	a[ARB]		# Fitting parameters
+int	nlines		# Number of lines
+real	chisq		# Chi squared
+
+int	i, np, nfit
+real	mr, chi2
+pointer	sp, flags, ptr
+errchk	mr_solve
+
+begin
+	# Number of terms is 5 for each line plus common background, center,
+	# intensity and widths.  Also the pixel size and number of subpixels.
+
+	np = 5 * nlines + 8
+
+	call smark (sp)
+	call salloc (flags, np, TY_INT)
+	ptr = flags
+
+	# Background.
+	switch (fit[BKG]) {
+	case SINGLE:
+	    Memi[ptr] = 3
+	    Memi[ptr+1] = 4
+	    ptr = ptr + 2
+	}
+
+	# Peaks.
+	switch (fit[INT]) {
+	case SINGLE:
+	    Memi[ptr] = 5
+	    ptr = ptr + 1
+	case INDEP:
+	    do i = 1, nlines {
+		Memi[ptr] = 5 * i + 4
+		ptr = ptr + 1
+	    }
+	}
+
+	# Positions.
+	switch (fit[POS]) {
+	case SINGLE:
+	    Memi[ptr] = 6
+	    ptr = ptr + 1
+	case INDEP:
+	    do i = 1, nlines {
+		Memi[ptr] = 5 * i + 5
+		ptr = ptr + 1
+	    }
+	}
+
+	# Gaussian FWHM.
+	switch (fit[GAU]) {
+	case SINGLE:
+	    Memi[ptr] = 7
+	    ptr = ptr + 1
+	case INDEP:
+	    do i = 1, nlines {
+		Memi[ptr] = 5 * i + 6
+		ptr = ptr + 1
+	    }
+	}
+
+	# Lorentzian FWHM.
+	switch (fit[LOR]) {
+	case SINGLE:
+	    Memi[ptr] = 8
+	    ptr = ptr + 1
+	case INDEP:
+	    do i = 1, nlines {
+		Memi[ptr] = 5 * i + 7
+		ptr = ptr + 1
+	    }
+	}
+
+	nfit = ptr - flags
+	mr = -1.
+	i = 0
+	chi2 = MAX_REAL
+	repeat {
+	    call mr_solve (x, y, s, npts, a, Memi[flags], np, nfit, mr, chisq)
+	    if (chi2 - chisq > 0.0001)
+		i = 0
+	    else
+		i = i + 1
+	    chi2 = chisq
+	} until (i == 5)
+
+	mr = 0.
+	call mr_solve (x, y, s, npts, a, Memi[flags], np, nfit, mr, chisq)
+
+	call sfree (sp)
+end
+
+
+# MR_SOLVE -- Levenberg-Marquardt nonlinear chi square minimization.
+#
+# Use the Levenberg-Marquardt method to minimize the chi squared of a set
+# of paraemters.  The parameters being fit are indexed by the flag array.
+# To initialize the Marquardt parameter, MR, is less than zero.  After that
+# the parameter is adjusted as needed.  To finish set the parameter to zero
+# to free memory.  This procedure requires a subroutine, DERIVS, which
+# takes the derivatives of the function being fit with respect to the
+# parameters.  There is no limitation on the number of parameters or
+# data points.  For a description of the method see NUMERICAL RECIPES
+# by Press, Flannery, Teukolsky, and Vetterling, p523.
+
+procedure mr_solve (x, y, s, npts, params, flags, np, nfit, mr, chisq)
+
+real	x[npts]			# X data array
+real	y[npts]			# Y data array
+real	s[npts]			# Sigma data array
+int	npts			# Number of data points
+real	params[np]		# Parameter array
+int	flags[np]		# Flag array indexing parameters to fit
+int	np			# Number of parameters
+int	nfit			# Number of parameters to fit
+real	mr			# MR parameter
+real	chisq			# Chi square of fit
+
+int	i
+real	chisq1
+pointer	new, a1, a2, delta1, delta2
+
+errchk	mr_invert
+
+begin
+	# Allocate memory and initialize.
+	if (mr < 0.) {
+	    call mfree (new, TY_REAL)
+	    call mfree (a1, TY_REAL)
+	    call mfree (a2, TY_REAL)
+	    call mfree (delta1, TY_REAL)
+	    call mfree (delta2, TY_REAL)
+
+	    call malloc (new, np, TY_REAL)
+	    call malloc (a1, nfit*nfit, TY_REAL)
+	    call malloc (a2, nfit*nfit, TY_REAL)
+	    call malloc (delta1, nfit, TY_REAL)
+	    call malloc (delta2, nfit, TY_REAL)
+
+	    call amovr (params, Memr[new], np)
+	    call mr_eval (x, y, s, npts, Memr[new], flags, np, Memr[a2],
+	        Memr[delta2], nfit, chisq)
+	    mr = 0.001
+	}
+
+	# Restore last good fit and apply the Marquardt parameter.
+	call amovr (Memr[a2], Memr[a1], nfit * nfit)
+	call amovr (Memr[delta2], Memr[delta1], nfit)
+	do i = 1, nfit
+	    Memr[a1+(i-1)*(nfit+1)] = Memr[a2+(i-1)*(nfit+1)] * (1. + mr)
+
+	# Matrix solution.
+	call mr_invert (Memr[a1], Memr[delta1], nfit)
+
+	# Compute the new values and curvature matrix.
+	do i = 1, nfit
+	    Memr[new+flags[i]-1] = params[flags[i]] + Memr[delta1+i-1]
+	call mr_eval (x, y, s, npts, Memr[new], flags, np, Memr[a1],
+	    Memr[delta1], nfit, chisq1)
+
+	# Check if chisq has improved.
+	if (chisq1 < chisq) {
+	    mr = max (EPSILONR, 0.1 * mr)
+	    chisq = chisq1
+	    call amovr (Memr[a1], Memr[a2], nfit * nfit)
+	    call amovr (Memr[delta1], Memr[delta2], nfit)
+	    call amovr (Memr[new], params, np)
+	} else
+	    mr = 10. * mr
+
+	if (mr == 0.) {
+	    call mfree (new, TY_REAL)
+	    call mfree (a1,  TY_REAL)
+	    call mfree (a2,  TY_REAL)
+	    call mfree (delta1, TY_REAL)
+	    call mfree (delta2, TY_REAL)
+	}
+end
+
+
+# MR_EVAL -- Evaluate curvature matrix.  This calls procedure DERIVS.
+
+procedure mr_eval (x, y, s, npts, params, flags, np, a, delta, nfit, chisq)
+
+real	x[npts]			# X data array
+real	y[npts]			# Y data array
+real	s[npts]			# Sigma data array
+int	npts			# Number of data points
+real	params[np]		# Parameter array
+int	flags[np]		# Flag array indexing parameters to fit
+int	np			# Number of parameters
+real	a[nfit,nfit]		# Curvature matrix
+real	delta[nfit]		# Delta array
+int	nfit			# Number of parameters to fit
+real	chisq			# Chi square of fit
+
+int	i, j, k
+real	ymod, dy, dydpj, dydpk, sig2i
+pointer	sp, dydp
+
+begin
+	call smark (sp)
+	call salloc (dydp, np, TY_REAL)
+
+	do j = 1, nfit {
+	   do k = 1, j
+	       a[j,k] = 0.
+	    delta[j] = 0.
+	}
+
+	chisq = 0.
+	do i = 1, npts {
+	    call derivs (x[i], params, ymod, Memr[dydp], np)
+	    if (IS_INDEF(ymod))
+		next
+	    sig2i = 1. / (s[i] * s[i])
+	    dy = y[i] - ymod
+	    do j = 1, nfit {
+		dydpj = Memr[dydp+flags[j]-1] * sig2i
+		delta[j] = delta[j] + dy * dydpj
+		do k = 1, j {
+		    dydpk = Memr[dydp+flags[k]-1]
+		    a[j,k] = a[j,k] + dydpj * dydpk
+		}
+	    }
+	    chisq = chisq + dy * dy * sig2i
+	}
+
+	do j = 2, nfit
+	    do k = 1, j-1
+		a[k,j] = a[j,k]
+
+	call sfree (sp)
+end
+	    
+
+# MR_INVERT -- Solve a set of linear equations using Householder transforms.
+
+procedure mr_invert (a, b, n)
+
+real	a[n,n]		# Input matrix and returned inverse
+real	b[n]		# Input RHS vector and returned solution
+int	n		# Dimension of input matrices
+
+int	krank
+real	rnorm
+pointer	sp, h, g, ip
+
+begin
+	call smark (sp)
+	call salloc (h, n, TY_REAL)
+	call salloc (g, n, TY_REAL)
+	call salloc (ip, n, TY_INT)
+
+	call hfti (a, n, n, n, b, n, 1, 1E-10, krank, rnorm,
+	    Memr[h], Memr[g], Memi[ip])
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/eqwidth.x b/noao/onedspec/splot/eqwidth.x
new file mode 100644
index 00000000..0594041a
--- /dev/null
+++ b/noao/onedspec/splot/eqwidth.x
@@ -0,0 +1,109 @@
+# EQWIDTH -- Compute equivalent width, flux and center
+
+procedure eqwidth (sh, gfd, wx1, wy1, x, y, n, fd1, fd2)
+
+pointer	sh
+int	gfd
+real	wx1, wy1
+real	x[ARB]
+real	y[ARB]
+int	n
+int	fd1, fd2
+
+char	command[SZ_FNAME]
+real	wx2, wy2, sigma0, invgain
+real	flux_diff, rsum[2], esum[2], sum[2], cont, ctr[2]
+int	i, wc, key
+pointer	sp, s
+
+real	clgetr()
+int	clgcur()
+double	shdr_wl()
+
+begin
+	# Get second position
+	call printf ("e again:")
+	i = clgcur ("cursor", wx2, wy2, wc, key, command, SZ_FNAME)
+
+	if (wx1 == wx2) {
+	    call printf ("Cannot get EQW - move cursor")
+	    return
+	}
+
+	# Set noise.
+	sigma0 = clgetr ("sigma0")
+	invgain = clgetr ("invgain")
+	if (IS_INDEF(sigma0) || IS_INDEF(invgain) || sigma0<0. || invgain<0.) {
+	    sigma0 = INDEF
+	    invgain = INDEF
+	}
+	call smark (sp)
+	call salloc (s, n, TY_REAL)
+	if (IS_INDEF(invgain))
+	    call amovkr (INDEF, Memr[s], n)
+	else {
+	    do i = 1, n {
+		if (y[i] > 0)
+		    Memr[s+i-1] = sqrt (sigma0  ** 2 + invgain * y[i])
+		else
+		    Memr[s+i-1] = sqrt (sigma0  ** 2)
+	    }
+	}
+
+	# Derive the needed values
+	call sumflux (sh, x, y, Memr[s], n, wx1, wx2, wy1, wy2,
+	    sum, rsum, esum, ctr)
+
+	# Compute difference in flux between ramp and spectrum
+	flux_diff = sum[1] - rsum[1]
+	
+	# Compute eq. width of feature using ramp midpoint as
+	# continuum
+	cont = 0.5 * (wy1 + wy2)
+
+	# Print on status line - save in answer buffer
+	call printf (
+	    "center = %9.7g, eqw = %9.4f, continuum = %9.7g flux = %9.6g\n")
+	    call pargr (ctr[1])
+	    call pargr (esum[1])
+	    call pargr (cont)
+	    call pargr (flux_diff)
+
+	if (fd1 != NULL) {
+	    call fprintf (fd1, " %9.7g %9.7g %9.6g %9.4g\n")
+		call pargr (ctr[1])
+		call pargr (cont)
+		call pargr (flux_diff)
+		call pargr (esum[1])
+	}
+	if (fd2 != NULL) {
+	    call fprintf (fd2, " %9.7g %9.7g %9.6g %9.4g\n")
+		call pargr (ctr[1])
+		call pargr (cont)
+		call pargr (flux_diff)
+		call pargr (esum[1])
+	}
+	if (!IS_INDEF(sigma0)) {
+	    if (fd1 != NULL) {
+		call fprintf (fd1,
+		"  (%7.5g) %9w (%7.4g) (%7.2g)\n")
+		    call pargr (ctr[2])
+		    call pargr (sum[2])
+		    call pargr (esum[2])
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2,
+		"  (%7.5g) %9w (%7.4g) (%7.2g)\n")
+		    call pargr (ctr[2])
+		    call pargr (sum[2])
+		    call pargr (esum[2])
+	    }
+	}
+
+	# Draw cursor position
+	i = max (1, min (n, nint (shdr_wl (sh, double(ctr[1])))))
+	call gline (gfd, wx1, wy1, wx2, wy2)
+	call gline (gfd, ctr[1], cont, ctr[1], y[i])
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/eqwidthcp.x b/noao/onedspec/splot/eqwidthcp.x
new file mode 100644
index 00000000..4fc4fd3d
--- /dev/null
+++ b/noao/onedspec/splot/eqwidthcp.x
@@ -0,0 +1,240 @@
+include	<gset.h>
+
+
+# EQWIDTH_CP -- Equivalent width following algorithm provided by
+#               Caty Pilachowski. This assumes a Gaussian line profile
+#               and fits to the specified core level, the width at the
+#		specified flux level above the core, and the specified
+#		continuum.  The line position is found by searching
+#               near the vertical cursor for the nearest minimum.
+
+define	LEFT	1	# Fit to left edge
+define	RIGHT	2	# Fit to right edge
+define	BOTH	3	# Fit to both edges
+
+procedure eqwidth_cp (sh, gfd, center, cont, ylevel, y, n, key, fd1, fd2,
+	xg, yg, sg, lg, pg, ng)
+
+pointer	sh
+int	gfd
+real	center, cont, ylevel
+real	y[n]
+int	n
+int	key
+int	fd1, fd2
+pointer	xg, yg, sg, lg, pg	# Pointers to fit parameters
+int	ng			# Number of components
+
+int	i, i1, i2, isrch, icore, edge
+double	xleft, xright, rcore, rinter, yl, gfwhm, lfwhm, flux, eqw, w, w1, w2
+double	xpara[3], ypara[3], coefs[3], xcore, ycore
+double	shdr_lw(), shdr_wl()
+
+# Initialize reasonable values
+#	isrch -- nr of pixels on either side of cursor to search for min
+
+data	isrch /3/
+
+begin
+	# Check continuum.
+	if (cont <= 0.) {
+	    call eprintf ("Continuum cannot be less than zero.\n")
+	    return
+	}
+
+	# Determine which edges of the line to use.
+	switch (key) {
+	case 'a', 'l':
+	    edge = LEFT
+	case 'b', 'r':
+	    edge = RIGHT
+	default:
+	    edge = BOTH
+	}
+
+	# Search for local minimum or maximum
+	icore = max (1, min (n, nint (shdr_wl (sh, double(center)))))
+	i1 = max (1, icore-isrch)
+	i2 = min (n, icore+isrch)
+
+	# If half lines is selected, restrict the search
+	if (edge == LEFT)
+	    i2 = max (i2-2, icore+1)
+	if (edge == RIGHT)
+	    i1 = min (i1+2, icore-1)
+
+	# Search for core.
+	# Someday it may be desirable to use parabolic interpolation
+	# to locate an estimated minimum or maximum for the region
+	do i = i1, i2 {
+	    if (abs (y[i] - cont) > abs (y[icore] - cont))
+		icore = i
+	}
+
+	# Fit parabola to three points around minimum pixel
+	xpara[1] = icore - 1
+	xpara[2] = icore
+	xpara[3] = icore + 1
+	ypara[1] = y[icore-1]
+	ypara[2] = y[icore]
+	ypara[3] = y[icore+1]
+
+	call para (xpara, ypara, coefs)
+
+	# Compute pixel value at minimum
+	xcore = -coefs[2] / 2.0 / coefs[3]
+	ycore = coefs[1] + coefs[2] * xcore + coefs[3] * xcore**2
+
+	# Locate left and right line edges.  If the ylevel is INDEF then use
+	# the half flux point.
+	if (IS_INDEF (ylevel))
+	    yl = (cont + ycore) / 2.
+	else
+	    yl = ylevel
+
+	rcore = abs (ycore - cont)
+	rinter = abs (yl - cont)
+
+	if (rcore <= rinter) {
+	    call eprintf (
+		"Y cursor must be between the continuum and the line core\n")
+	    return
+	}
+
+	# Bound flux level of interest
+	if ((edge == LEFT) || (edge == BOTH)) {
+	    for (i=icore; i >= 1; i=i-1)
+		if (abs (y[i] - cont) < rinter)
+		    break
+
+	    if (i < 1) {
+		call eprintf ("Can't find left edge of line\n")
+		return
+	    }
+
+	    xleft = float (i) + (yl - y[i]) / (y[i+1] - y[i])
+	    if (edge == LEFT)
+	        xright = xcore + (xcore - xleft)
+	}
+
+	# Now bound the right side
+	if ((edge == RIGHT) || (edge == BOTH)) {
+	    for (i=icore; i <= n; i=i+1)
+		if (abs (y[i] - cont) < rinter)
+		    break
+
+	    if (i > n) {
+		call eprintf ("Can't find right edge of line\n")
+		return
+	    }
+
+	    xright = float (i) - (yl - y[i]) / (y[i-1] - y[i])
+	    if (edge == RIGHT)
+	        xleft  = xcore - (xright - xcore)
+	}
+
+	# Compute in wavelength
+	w = shdr_lw (sh, double(xcore))
+	w1 = shdr_lw (sh, double(xleft))
+	w2 = shdr_lw (sh, double(xright))
+
+	# Apply Gaussian model
+	gfwhm = 1.665109 * abs (w2 - w1) / 2. / sqrt (log (rcore/rinter))
+	lfwhm = 0.
+	rcore = ycore - cont
+	flux = 1.064467 * rcore * gfwhm
+	eqw = -flux / cont
+
+	call printf (
+	    "center = %9.7g, eqw = %9.4g, gfwhm = %9.4g\n")
+	    call pargd (w)
+	    call pargd (eqw)
+	    call pargd (gfwhm)
+
+	if (fd1 != NULL) {
+	    call fprintf (fd1, " %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+		call pargd (w)
+		call pargr (cont)
+		call pargd (flux)
+		call pargd (eqw)
+		call pargd (ycore - cont)
+		call pargd (gfwhm)
+		call pargd (lfwhm)
+	}
+	if (fd2 != NULL) {
+	    call fprintf (fd2, " %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+		call pargd (w)
+		call pargr (cont)
+		call pargd (flux)
+		call pargd (eqw)
+		call pargd (ycore - cont)
+		call pargd (gfwhm)
+		call pargd (lfwhm)
+	}
+
+	# Mark line computed
+	call gline (gfd, real(w), cont, real(w), real(ycore))
+	call gline (gfd, real(w1), real(yl), real(w2), real(yl))
+
+	w1 = w - 2 * gfwhm
+	w2 = cont + rcore * exp (-(1.665109*(w1-w)/gfwhm)**2)
+	call gseti (gfd, G_PLTYPE, 2)
+	call gseti (gfd, G_PLCOLOR, 2)
+	call gamove (gfd, real(w1), real(w2))
+	for (; w1 <= w+2*gfwhm; w1=w1+0.05*gfwhm) {
+	    w2 = cont + rcore * exp (-(1.665109*(w1-w)/gfwhm)**2)
+	    call gadraw (gfd, real(w1), real(w2))
+	}
+	call gseti (gfd, G_PLTYPE, 1)
+	call gseti (gfd, G_PLCOLOR, 1)
+
+	# Save fit parameters
+	if (ng == 0) {
+	    call malloc (xg, 1, TY_REAL)
+	    call malloc (yg, 1, TY_REAL)
+	    call malloc (sg, 1, TY_REAL)
+	    call malloc (lg, 1, TY_REAL)
+	    call malloc (pg, 1, TY_INT)
+	} else if (ng != 1) {
+	    call realloc (xg, 1, TY_REAL)
+	    call realloc (yg, 1, TY_REAL)
+	    call realloc (sg, 1, TY_REAL)
+	    call realloc (lg, 1, TY_REAL)
+	    call realloc (pg, 1, TY_INT)
+	}
+	Memr[xg] = w
+	Memr[yg] = rcore
+	Memr[sg] = gfwhm
+	Memr[lg] = lfwhm
+	Memi[pg] = 1
+	ng = 1
+end
+
+# PARA -- Fit a parabola to three points
+
+procedure para (x, y, c)
+
+double	x[3], y[3], c[3]
+double  x12, x13, x23, x213, x223, y13, y23
+
+begin
+        x12 = x[1] - x[2]
+        x13 = x[1] - x[3]
+        x23 = x[2] - x[3]
+
+	if (x12 == 0. || x13 == 0. || x23 == 0.)
+	    call error (1, "X points are not distinct")
+
+	# Compute relative to an origin at x[3]
+        x213 = x13 * x13
+        x223 = x23 * x23
+        y13 = y[1] - y[3]
+        y23 = y[2] - y[3]
+        c[3] = (y13 - y23 * x13 / x23) / (x213 - x223 * x13 / x23)
+        c[2] = (y23 - c[3] * x223) / x23
+        c[1] = y[3]
+
+	# Compute relative to an origin at 0.
+	c[1] = c[1] - x[3] * (c[2] - c[3] * x[3])
+	c[2] = c[2] - 2 * c[3] * x[3]
+end
diff --git a/noao/onedspec/splot/fixx.x b/noao/onedspec/splot/fixx.x
new file mode 100644
index 00000000..65bd4e38
--- /dev/null
+++ b/noao/onedspec/splot/fixx.x
@@ -0,0 +1,27 @@
+include	<smw.h>
+
+# FIXX - Adjust so that pixel indices are increasing.
+
+procedure fixx (sh, x1, x2, y1, y2, i1, i2)
+
+pointer	sh
+real	x1, x2, y1, y2
+int	i1, i2
+
+double	z, z1, z2, shdr_wl(), shdr_lw()
+
+begin
+	z1 = x1
+	z2 = x2
+	z1 = max (0.5D0, min (double (SN(sh)+.499), shdr_wl(sh, z1)))
+	z2 = max (0.5D0, min (double (SN(sh)+.499), shdr_wl(sh, z2)))
+	if (z1 > z2) {
+	    z = y1; y1 = y2; y2 = z
+	    z = z1; z1 = z2; z2 = z
+	}
+
+	x1 = shdr_lw (sh, z1)
+	x2 = shdr_lw (sh, z2)
+	i1 = nint (z1)
+	i2 = nint (z2)
+end
diff --git a/noao/onedspec/splot/flatten.x b/noao/onedspec/splot/flatten.x
new file mode 100644
index 00000000..aa038d27
--- /dev/null
+++ b/noao/onedspec/splot/flatten.x
@@ -0,0 +1,110 @@
+include	<pkg/gtools.h>
+
+# FLATTEN -- Flatten a spectrum and normalize to 1.0
+# Use ICFIT for fitting the spectrum
+
+procedure flatten (gp, gt, x, y, n)
+
+pointer	gp, gt
+real	x[n]
+real	y[n]
+int	n
+
+bool	b
+real	wx, z
+int	i, key
+pointer	sp, str, w, gt2, ic, cv
+
+bool	clgetb()
+real 	clgetr(), ic_getr(), cveval()
+int	clgeti(), ic_geti(), btoi(), clgcur()
+errchk	icg_fit
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call salloc (w, n, TY_REAL)
+
+	key = '?'
+	repeat {
+	    switch (key) {
+	    case '/', '-', 'f', 'c', 'n':
+		call ic_open (ic)
+		call clgstr ("function", Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "function", Memc[str])
+		call ic_puti (ic, "order", clgeti ("order"))
+		call ic_putr (ic, "low", clgetr ("low_reject"))
+		call ic_putr (ic, "high", clgetr ("high_reject"))
+		call ic_puti (ic, "niterate", clgeti ("niterate"))
+		call ic_putr (ic, "grow", clgetr ("grow"))
+		call ic_puti (ic, "markrej", btoi (clgetb ("markrej")))
+		switch (key) {
+		case '/':
+		    call ic_puti (ic, "key", 4)
+		case '-':
+		    call ic_puti (ic, "key", 3)
+		case 'f', 'n', 'c':
+		    call ic_puti (ic, "key", 1)
+		}
+
+		call ic_putr (ic, "xmin", min (x[1], x[n]))
+		call ic_putr (ic, "xmax", max (x[1], x[n]))
+
+		call gt_copy (gt, gt2)
+		call gt_gets (gt2, GTXLABEL, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "xlabel", Memc[str])
+		call gt_gets (gt2, GTYLABEL, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "ylabel", Memc[str])
+		call gt_gets (gt2, GTXUNITS, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "xunits", Memc[str])
+		call gt_gets (gt2, GTYUNITS, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "yunits", Memc[str])
+
+		call amovkr (1., Memr[w], n)
+		call icg_fit (ic, gp, "cursor", gt2, cv, x, y, Memr[w], n)
+
+		switch (key) {
+		case '/':
+		    do i = 1, n {
+			z = cveval (cv, x[i])
+			if (abs (z) < 1e-30)
+			    y[i] = 1.
+			else
+			    y[i] = y[i] / z
+		    }
+		case '-':
+		    do i = 1, n
+			y[i] = y[i] - cveval (cv, x[i])
+		case 'f':
+		    do i = 1, n
+			y[i] = cveval (cv, x[i])
+		case 'c':
+		    call ic_clean (ic, cv, x, y, Memr[w], n)
+		case 'n':
+		    ;
+		}
+
+		call ic_gstr (ic, "function", Memc[str], SZ_FNAME)
+		call clpstr ("function", Memc[str])
+		call clputi ("order", ic_geti (ic, "order"))
+		call clputr ("low_reject", ic_getr (ic, "low"))
+		call clputr ("high_reject", ic_getr (ic, "high"))
+		call clputi ("niterate", ic_geti (ic, "niterate"))
+		call clputr ("grow", ic_getr (ic, "grow"))
+		b = (ic_geti (ic, "markrej") == YES)
+		call clputb ("markrej", b)
+
+		call cv_free (cv)
+		call gt_free (gt2)
+		call ic_closer (ic)
+		break
+	    case 'q':
+		break
+	    default:
+		call printf (
+		    "/=normalize, -=subtract, f=fit, c=clean, n=nop, q=quit")
+	    }
+	} until (clgcur ("cursor", wx, z, i, key, Memc[str], SZ_FNAME) == EOF)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/fudgept.x b/noao/onedspec/splot/fudgept.x
new file mode 100644
index 00000000..c2aa3740
--- /dev/null
+++ b/noao/onedspec/splot/fudgept.x
@@ -0,0 +1,38 @@
+# FUDGEPT -- Fudge a point
+
+procedure fudgept (sh, gfd, x, y, n, wx, wy)
+
+pointer	sh
+int	gfd
+real	x[n]
+real	y[n]
+int	n
+real	wx, wy
+
+int	i1, nplot, istart
+double	shdr_wl()
+
+begin
+	# Get pixel number
+	i1 = max (1, min (n, nint (shdr_wl (sh, double(wx)))))
+
+	# Replace with Y-value
+	if (i1 > 0 && i1 <= n)
+	     y[i1] = wy
+	else
+	    return
+
+	# Plot region around new point
+	if (i1 > 1 && i1 < n) {
+	    nplot = 3
+	    istart = i1 - 1
+	} else if (i1 == 1) {
+	    nplot = 2
+	    istart = i1
+	} else if (i1 == n) {
+	    nplot = 2
+	    istart = n - 1
+	}
+
+	call gpline (gfd, x[istart], y[istart], nplot)
+end
diff --git a/noao/onedspec/splot/fudgex.x b/noao/onedspec/splot/fudgex.x
new file mode 100644
index 00000000..f1612b31
--- /dev/null
+++ b/noao/onedspec/splot/fudgex.x
@@ -0,0 +1,46 @@
+# FUDGEX -- Fudge an extended region marked by the cursor
+
+procedure fudgex (sh, gfd, x, y, n, wx1, wy1, xydraw)
+
+pointer	sh
+int	gfd
+real	x[n]
+real	y[n]
+int	n
+real	wx1, wy1
+int	xydraw
+
+char	command[SZ_FNAME]
+int	i, i1, i2, wc, key
+real	slope
+real	wx2, wy2
+
+int	clgcur()
+bool	fp_equalr()
+
+begin
+	# Get second point
+	call printf ("x again:")
+	call flush (STDOUT)
+	i = clgcur ("cursor", wx2, wy2, wc, key, command, SZ_FNAME)
+
+	# Fix order
+	call fixx (sh, wx1, wx2, wy1, wy2, i1, i2)
+
+	if (xydraw == NO) {
+	    wy1 = y[i1]
+	    wy2 = y[i2]
+	}
+	if (fp_equalr (wx1, wx2))
+	    slope = 0.
+	else
+	    slope = (wy2-wy1) / (wx2-wx1)
+
+	# Replace pixels
+	do i = i1, i2
+	    y[i] = wy1 + (x[i] - wx1) * slope
+
+	# Plot replaced pixels
+	i = i2 - i1 + 1
+	call gpline (gfd, x[i1], y[i1], i)
+end
diff --git a/noao/onedspec/splot/getimage.x b/noao/onedspec/splot/getimage.x
new file mode 100644
index 00000000..671f81de
--- /dev/null
+++ b/noao/onedspec/splot/getimage.x
@@ -0,0 +1,159 @@
+include	<error.h>
+include	<imhdr.h>
+include	<pkg/gtools.h>
+include <smw.h>
+
+# GETIMAGE -- Read new image pixels.
+
+procedure getimage (image, nline, nband, nap, wave_scl, w0, wpc, units,
+	im, mw, sh, gt)
+
+char	image[ARB]
+int	nline, nband, nap
+bool	wave_scl
+double	w0, wpc
+real	a, b
+char	units[ARB]
+pointer	sp, imsect, im, mw, sh, gt
+
+int	da, n, sec[3,3], clgeti()
+real	gt_getr()
+double	shdr_lw()
+pointer	immap(), smw_openim()
+errchk	immap, shdr_open, shdr_system, un_changer
+
+begin
+	call smark (sp)
+	call salloc (imsect, SZ_FNAME, TY_CHAR)
+
+	# Map the image if necessary.  Don't allow image sections but
+	# determine requested spectrum from any explicit specification.
+
+	da = 0
+	if (im == NULL) {
+	    call imgsection (image, Memc[imsect], SZ_FNAME)
+	    call imgimage (image, image, SZ_FNAME)
+	    im = immap (image, READ_ONLY, 0)
+	    mw = smw_openim (im)
+	    n = IM_NDIM(im)
+	    if (Memc[imsect] != EOS) {
+		call amovki (1, sec[1,1], n)
+		call amovi (IM_LEN(im,1), sec[1,2], n)
+		call amovki (1, sec[1,3], n)
+		call id_section (Memc[imsect], sec[1,1], sec[1,2], sec[1,3], n)
+		switch (SMW_FORMAT(mw)) {
+		case SMW_ND:
+		    if (n == 1)
+			da = 1
+		    if (n == 2) {
+			if (abs (sec[1,2]-sec[1,1]) == 0) {
+			    nline = sec[1,1]
+			    da = 2
+			} else if (abs (sec[2,2]-sec[2,1]) == 0) {
+			    nline = sec[2,1]
+			    da = 1
+			}
+		    } else {
+			if (abs (sec[1,2]-sec[1,1]) == 0) {
+			    nline = sec[1,1]
+			    if (abs (sec[2,2]-sec[2,1]) == 0) {
+				nband = sec[2,1]
+			        if (abs (sec[3,2]-sec[3,1]) > 0)
+				    da = 3
+			    } else if (abs (sec[3,2]-sec[3,1]) == 0) {
+				nband = sec[3,1]
+				da = 2
+			    }
+			} else if (abs (sec[2,2]-sec[2,1]) == 0) {
+			    nline = sec[2,1]
+			    if (abs (sec[3,2]-sec[3,1]) == 0) {
+				nband = sec[3,1]
+				da = 1
+			    }
+			}
+		    }
+		    if (da > 0) {
+			call smw_daxis (mw, im, da, INDEFI, INDEFI)
+			call smw_saxis (mw, NULL, im)
+		    }
+		default:
+		    da = 1
+		    if (n > 1 && abs (sec[2,2]-sec[2,1]) == 0)
+			nline = sec[2,1]
+		    if (n > 2 && abs (sec[3,2]-sec[3,1]) == 0)
+			nband = sec[3,1]
+		}
+	    }
+	}
+
+	# Get header info.
+	switch (SMW_FORMAT(mw)) {
+	case SMW_ND:
+	    nap = INDEFI
+	    n = SMW_LLEN(mw,2)
+	    if (n > 1) {
+		if (nline == 0)
+	            nline = max (1, min (n, clgeti ("line")))
+	    } else
+		nline = 0
+	    n = SMW_LLEN(mw,3)
+	    if (n > 1) {
+		if (nband == 0)
+	            nband = max (1, min (n, clgeti ("band")))
+	    } else
+		nband = 0
+	default:
+	    n = SMW_NSPEC(mw)
+	    if (n > 1) {
+		if (nline == 0) { 
+	            nline = clgeti ("line")
+		    nap = nline
+		}
+	    } else {
+		nline = 0
+		nap = INDEFI
+	    }
+	    n = SMW_NBANDS(mw)
+	    if (n > 1) {
+		if (nband == 0) 
+		    nband = max (1, min (n, clgeti ("band")))
+	    } else
+		nband = 0
+	}
+
+	call shdr_open (im, mw, nline, nband, nap, SHDATA, sh)
+	nap = AP(sh)
+	nline = LINDEX(sh,1)
+
+	if (DC(sh) == DCNO && !IS_INDEFD(w0))
+	    call usercoord (sh, 'l', 1D0, w0, 2D0, w0+wpc)
+
+	# Cancel wavelength coordinates if not desired or set units.
+	if (!wave_scl)
+	    call shdr_system (sh, "physical")
+	else {
+	    iferr (call shdr_units (sh, units))
+		;
+	}
+
+	if (da > 0) {
+	    a =  gt_getr (gt, GTXMIN)
+	    b =  gt_getr (gt, GTXMAX)
+	    if (IS_INDEF(a) && IS_INDEF(b)) {
+		if (!wave_scl) {
+		    call gt_setr (gt, GTXMIN, real(sec[da,1]))
+		    call gt_setr (gt, GTXMAX, real(sec[da,2]))
+		} else {
+		    a = shdr_lw (sh, double(sec[da,1]))
+		    b = shdr_lw (sh, double(sec[da,2]))
+		    call gt_setr (gt, GTXMIN, a)
+		    call gt_setr (gt, GTXMAX, b)
+		}
+	    }
+	}
+
+	# Make a title.
+	call mktitle (sh, gt)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/gfit.x b/noao/onedspec/splot/gfit.x
new file mode 100644
index 00000000..2e60d8c4
--- /dev/null
+++ b/noao/onedspec/splot/gfit.x
@@ -0,0 +1,391 @@
+include	<error.h>
+include	<mach.h>
+include	<gset.h>
+
+define	NSUB	3	# Number of pixel subsamples
+define	MC_N	50	# Monte-Carlo samples
+define	MC_P	10	# Percent done interval (percent)
+define	MC_SIG	68	# Sigma sample point (percent)
+
+# GFIT -- Fit Gaussian
+
+procedure gfit (sh, gfd, wx1, wy1, wcs, pix, n, fd1, fd2, xg, yg, sg, lg, pg,ng)
+
+pointer	sh			# SHDR pointer
+pointer	gfd			# GIO file descriptor
+real	wx1, wy1		# Cursor position
+real	wcs[n]			# Spectrum data
+real	pix[n]			# Spectrum data
+int	n			# Number of points
+int	fd1, fd2		# Output file descriptors
+pointer	xg, yg, sg, lg, pg	# Pointers to fit parameters
+int	ng			# Number of components
+
+int	fit[5], nsub, mc_p, mc_sig, mc_n
+int	i, j, i1, npts, nlines, wc, key
+long	seed
+real	w, dw, wyc, wx, wy, wx2, wy2, v, u
+real	slope, peak, flux, cont, gfwhm, lfwhm, eqw, scale, sscale, chisq
+real	sigma0, invgain, wyc1, slope1, flux1, cont1, eqw1
+bool	fitit
+pointer	xg1, yg1, sg1, lg1
+pointer	sp, cmd, x, y, s, z, ym, conte, xge, yge, sge, lge, fluxe, eqwe
+
+int	clgeti(), clgcur()
+real	clgetr(), model(), gasdev(), asumr()
+errchk	dofit, dorefit
+
+define	done_	99
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_FNAME, TY_CHAR)
+
+	# Input cursor is first continuum point now get second continuum point.
+	call printf ("k again:")
+	if (clgcur ("cursor", wx2, wy2, wc, key, Memc[cmd], SZ_FNAME) == EOF) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Set pixel indices and determine number of points to fit.
+	call fixx (sh, wx1, wx2, wy1, wy2, i1, j)
+	npts = j - i1 + 1
+	if (npts < 3) {
+	    call eprintf ("At least 3 points are required\n")
+	    call sfree (sp)
+	    return
+	}
+
+	# Allocate space for the points to be fit.
+	call salloc (x, npts, TY_REAL)
+	call salloc (y, npts, TY_REAL)
+	call salloc (s, npts, TY_REAL)
+	call salloc (z, npts, TY_REAL)
+
+	# Scale the data.
+	mc_n = clgeti ("nerrsample")
+	sigma0 = clgetr ("sigma0")
+	invgain = clgetr ("invgain")
+	if (IS_INDEF(sigma0) || IS_INDEF(invgain) || sigma0<0. ||
+	    invgain<0. || (sigma0 == 0. && invgain == 0.)) {
+	    sigma0 = INDEF
+	    invgain = INDEF
+	}
+	scale = 0.
+	do i = 1, npts {
+	    Memr[x+i-1] = wcs[i1+i-1]
+	    Memr[y+i-1] = pix[i1+i-1]
+	    if (Memr[y+i-1] <= 0.)
+		if (!IS_INDEF(invgain) && invgain != 0.) {
+		    sigma0 = INDEF
+		    invgain = INDEF
+		    call eprintf (
+			"WARNING: Cannot compute errors with non-zero gain")
+		    call eprintf (
+			" and negative pixel values.\n")
+		}
+	    scale = max (scale, abs (Memr[y+i-1]))
+	}
+	if (IS_INDEF(sigma0)) {
+	    call amovkr (1., Memr[s], npts)
+	    sscale = 1.
+	} else {
+	    do i = 1, npts
+		Memr[s+i-1] = sqrt (sigma0 ** 2 + invgain * Memr[y+i-1])
+	    sscale = asumr (Memr[s], npts) / npts
+	}
+	call adivkr (Memr[y], scale, Memr[y], npts)
+	call adivkr (Memr[s], sscale, Memr[s], npts)
+
+	# Allocate memory.
+	nlines = 1
+	if (ng == 0) {
+	    call malloc (xg, nlines, TY_REAL)
+	    call malloc (yg, nlines, TY_REAL)
+	    call malloc (sg, nlines, TY_REAL)
+	    call malloc (lg, nlines, TY_REAL)
+	    call malloc (pg, nlines, TY_INT)
+	} else if (ng != nlines) {
+	    call realloc (xg, nlines, TY_REAL)
+	    call realloc (yg, nlines, TY_REAL)
+	    call realloc (sg, nlines, TY_REAL)
+	    call realloc (lg, nlines, TY_REAL)
+	    call realloc (pg, nlines, TY_INT)
+	}
+	ng = nlines
+
+	# Do fit.
+	fit[1] = 1
+	fit[2] = 2
+	fit[3] = 2
+	fit[4] = 2
+	fit[5] = 2
+
+	# Setup initial estimates.
+	slope = (wy2-wy1) / (wx2-wx1) / scale
+	wyc = wy1 / scale - slope * wx1
+	wx = 0
+	do i = 0, npts-1 {
+	    w = Memr[x+i]
+	    wy = Memr[y+i] - wyc - slope * w
+	    if (abs (wy) > wx) {
+		wx = abs (wy)
+		j = i
+		Memr[xg] = w
+		Memr[yg] = wy
+	    }
+	}
+
+	if (j > 0 && j < npts-1) {
+	    w = Memr[x+j-1]
+	    wy = min (0.99, max (0.01, abs (Memr[y+j-1] - wyc - slope*w) / wx))
+	    gfwhm = 2.355 * sqrt (-0.5 * (w-Memr[xg])**2 / log (wy))
+	    w = Memr[x+j+1]
+	    wy = min (0.99, max (0.01, abs (Memr[y+j+1] - wyc - slope*w) / wx))
+	    gfwhm = (gfwhm + 2.355 * sqrt (-0.5*(w-Memr[xg])**2/log (wy))) / 2
+	} else
+	    gfwhm = 0.3 * abs (Memr[x+npts-1] - Memr[x])
+
+	switch (key) {
+	case 'l':
+	    Memr[sg] = 0.
+	    Memr[lg] = gfwhm
+	    Memi[pg] = 2
+	case 'v':
+	    Memr[sg] = 0.5 * gfwhm
+	    Memr[lg] = 0.5 * gfwhm
+	    Memi[pg] = 3
+	default:
+	    Memr[sg] = gfwhm
+	    Memr[lg] = 0.
+	    Memi[pg] = 1
+	}
+
+	nsub = NSUB
+	dw = (wcs[n] - wcs[1]) / (n - 1)
+	iferr (call dofit (fit, Memr[x], Memr[y], Memr[s], npts, dw, nsub,
+	    wyc, slope, Memr[xg], Memr[yg], Memr[sg], Memr[lg], Memi[pg],
+	    ng, chisq)) {
+	    fitit = false
+	    goto done_
+	}
+
+	# Compute Monte-Carlo errors.
+	if (mc_n > 9 && !IS_INDEF(sigma0)) {
+	    mc_p = nint (mc_n * MC_P / 100.)
+	    mc_sig = nint (mc_n * MC_SIG / 100.)
+
+	    call salloc (ym, npts, TY_REAL)
+	    call salloc (xg1, ng, TY_REAL)
+	    call salloc (yg1, ng, TY_REAL)
+	    call salloc (sg1, ng, TY_REAL)
+	    call salloc (lg1, ng, TY_REAL)
+	    call salloc (conte, mc_n*ng, TY_REAL)
+	    call salloc (xge, mc_n*ng, TY_REAL)
+	    call salloc (yge, mc_n*ng, TY_REAL)
+	    call salloc (sge, mc_n*ng, TY_REAL)
+	    call salloc (lge, mc_n*ng, TY_REAL)
+	    call salloc (fluxe, mc_n*ng, TY_REAL)
+	    call salloc (eqwe, mc_n*ng, TY_REAL)
+	    do i = 1, npts {
+		w = Memr[x+i-1]
+		Memr[ym+i-1] = model (w, dw, nsub, Memr[xg], Memr[yg],
+		    Memr[sg], Memr[lg], Memi[pg], ng) + wyc + slope * w
+	    }
+	    seed = 1
+	    do i = 0, mc_n-1 {
+		if (i > 0 && mod (i, mc_p) == 0) {
+		    call printf ("%2d ")
+			call pargi (100 * i / mc_n)
+		    call flush (STDOUT)
+		}
+		do j = 1, npts
+		    Memr[y+j-1] = Memr[ym+j-1] +
+			sscale / scale * Memr[s+j-1] * gasdev (seed)
+		wyc1 = wyc
+		slope1 = slope
+		call amovr (Memr[xg], Memr[xg1], ng)
+		call amovr (Memr[yg], Memr[yg1], ng)
+		call amovr (Memr[sg], Memr[sg1], ng)
+		call amovr (Memr[lg], Memr[lg1], ng)
+		call dorefit (fit, Memr[x], Memr[y], Memr[s], npts,
+		    dw, nsub, wyc1, slope1,
+		    Memr[xg1], Memr[yg1], Memr[sg1], Memr[lg1], Memi[pg], ng,
+		    chisq)
+
+		do j = 0, ng-1 {
+		    cont = wyc + slope * Memr[xg+j]
+		    cont1 = wyc1 + slope1 * Memr[xg+j]
+		    switch (Memi[pg+j]) {
+		    case 1:
+			flux = 1.064467 * Memr[yg+j] * Memr[sg+j]
+			flux1 = 1.064467 * Memr[yg1+j] * Memr[sg1+j]
+		    case 2:
+			flux = 1.570795 * Memr[yg+j] * Memr[lg+j]
+			flux1 = 1.570795 * Memr[yg1+j] * Memr[lg1+j]
+		    case 3:
+			call voigt (0., 0.832555*Memr[lg+j]/Memr[sg+j], v, u)
+			flux = 1.064467 * Memr[yg+j] * Memr[sg+j] / v
+			call voigt (0., 0.832555*Memr[lg1+j]/Memr[sg1+j], v, u)
+			flux1 = 1.064467 * Memr[yg1+j] * Memr[sg1+j] / v
+		    }
+		    if (cont > 0. && cont1 > 0.) {
+			eqw = -flux / cont
+			eqw1 = -flux1 / cont1
+		    } else {
+			eqw = 0.
+			eqw1 = 0.
+		    }
+		    Memr[conte+j*mc_n+i] = abs (cont1 - cont)
+		    Memr[xge+j*mc_n+i] = abs (Memr[xg1+j] - Memr[xg+j])
+		    Memr[yge+j*mc_n+i] = abs (Memr[yg1+j] - Memr[yg+j])
+		    Memr[sge+j*mc_n+i] = abs (Memr[sg1+j] - Memr[sg+j])
+		    Memr[lge+j*mc_n+i] = abs (Memr[lg1+j] - Memr[lg+j])
+		    Memr[fluxe+j*mc_n+i] = abs (flux1 - flux)
+		    Memr[eqwe+j*mc_n+i] = abs (eqw1 - eqw)
+		}
+	    }
+	    do j = 0, ng-1 {
+		call asrtr (Memr[conte+j*mc_n], Memr[conte+j*mc_n], mc_n)
+		call asrtr (Memr[xge+j*mc_n], Memr[xge+j*mc_n], mc_n)
+		call asrtr (Memr[yge+j*mc_n], Memr[yge+j*mc_n], mc_n)
+		call asrtr (Memr[sge+j*mc_n], Memr[sge+j*mc_n], mc_n)
+		call asrtr (Memr[lge+j*mc_n], Memr[lge+j*mc_n], mc_n)
+		call asrtr (Memr[fluxe+j*mc_n], Memr[fluxe+j*mc_n], mc_n)
+		call asrtr (Memr[eqwe+j*mc_n], Memr[eqwe+j*mc_n], mc_n)
+	    }
+	    call amulkr (Memr[conte], scale, Memr[conte], mc_n*ng)
+	    call amulkr (Memr[yge], scale, Memr[yge], mc_n*ng)
+	    call amulkr (Memr[fluxe], scale, Memr[fluxe], mc_n*ng)
+	}
+
+	call amulkr (Memr[yg], scale, Memr[yg], ng)
+	wyc = (wyc + slope * wx1) * scale
+	slope = slope * scale
+
+	# Compute model spectrum with continuum and plot.
+	fitit = true
+	do i = 1, npts {
+	    w = wcs[i1+i-1]
+	    Memr[z+i-1] = model (w, dw, nsub, Memr[xg], Memr[yg],
+		Memr[sg], Memr[lg], Memi[pg], ng) + wyc + slope * (w - wx1)
+	}
+
+	call gseti (gfd, G_PLTYPE, 2)
+	call gseti (gfd, G_PLCOLOR, 2)
+	call gpline (gfd, wcs[i1], Memr[z], npts)
+	call gseti (gfd, G_PLTYPE, 3)
+	call gseti (gfd, G_PLCOLOR, 3)
+	call gline (gfd, wx1, wyc, wx2, wyc + slope * (wx2 - wx1))
+	call gseti (gfd, G_PLTYPE, 1)
+	call gseti (gfd, G_PLCOLOR, 1)
+	call gflush (gfd)
+
+done_
+	# Log computed values
+	if (fitit) {
+	    do i = 1, nlines {
+		w = Memr[xg+i-1]
+		cont = wyc + slope * (w - wx1)
+		peak = Memr[yg+i-1]
+		gfwhm = Memr[sg+i-1]
+		lfwhm = Memr[lg+i-1]
+		switch (Memi[pg+i-1]) {
+		case 1:
+		    flux = 1.064467 * peak * gfwhm
+		    if (cont > 0.)
+			eqw = -flux / cont
+		    else
+			eqw = INDEF
+		    call printf (
+	"\n%d: center = %8.6g, flux = %8.4g, eqw = %6.4g, gfwhm = %6.4g")
+			call pargi (i)
+			call pargr (w)
+			call pargr (flux)
+			call pargr (eqw)
+			call pargr (gfwhm)
+		case 2:
+		    flux = 1.570795 * peak * lfwhm
+		    if (cont > 0.)
+			eqw = -flux / cont
+		    else
+			eqw = INDEF
+		    call printf (
+	"\n%d: center = %8.6g, flux = %8.4g, eqw = %6.4g, lfwhm = %6.4g")
+			call pargi (i)
+			call pargr (w)
+			call pargr (flux)
+			call pargr (eqw)
+			call pargr (lfwhm)
+		case 3:
+		    call voigt (0., 0.832555*lfwhm/gfwhm, v, u)
+		    flux = 1.064467 * peak * gfwhm / v
+		    if (cont > 0.)
+			eqw = -flux / cont
+		    else
+			eqw = INDEF
+		    call printf (
+	"\n%d: center = %8.6g, eqw = %6.4g, gfwhm = %6.4g, lfwhm = %6.4g")
+			call pargi (i)
+			call pargr (w)
+			call pargr (eqw)
+			call pargr (gfwhm)
+			call pargr (lfwhm)
+		}
+		if (fd1 != NULL) {
+		    call fprintf (fd1,
+			" %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+			call pargr (w)
+			call pargr (cont)
+			call pargr (flux)
+			call pargr (eqw)
+			call pargr (peak)
+			call pargr (gfwhm)
+			call pargr (lfwhm)
+		}
+		if (fd2 != NULL) {
+		    call fprintf (fd2,
+			" %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+			call pargr (w)
+			call pargr (cont)
+			call pargr (flux)
+			call pargr (eqw)
+			call pargr (peak)
+			call pargr (gfwhm)
+			call pargr (lfwhm)
+		}
+		if (mc_n > 9 && !IS_INDEF(sigma0)) {
+		    if (fd1 != NULL) {
+			call fprintf (fd1,
+		"  (%7.5g) (%7w) (%7.4g) (%7.4g) (%7.4g) (%7.4g) (%7.4g)\n")
+			    call pargr (Memr[xge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[fluxe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[eqwe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[yge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[sge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[lge+(i-1)*mc_n+mc_sig])
+		    }
+		    if (fd2 != NULL) {
+			call fprintf (fd2,
+		"  (%7.5g) (%7w) (%7.4g) (%7.4g) (%7.4g) (%7.4g) (%7.4g)\n")
+			    call pargr (Memr[xge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[fluxe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[eqwe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[yge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[sge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[lge+(i-1)*mc_n+mc_sig])
+		    }
+		}
+	    }
+	} else {
+	    call mfree (xg, TY_REAL)
+	    call mfree (yg, TY_REAL)
+	    call mfree (sg, TY_REAL)
+	    call mfree (lg, TY_REAL)
+	    call mfree (pg, TY_INT)
+	    ng = 0
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/mkpkg b/noao/onedspec/splot/mkpkg
new file mode 100644
index 00000000..43deb993
--- /dev/null
+++ b/noao/onedspec/splot/mkpkg
@@ -0,0 +1,38 @@
+# SPLOT task.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	anshdr.x	<smw.h> <time.h>
+	autoexp.x	<gset.h> <mach.h> <pkg/gtools.h>
+	avgsnr.x	
+	conflam.x	<error.h> <smw.h>
+	confnu.x	<error.h> <smw.h>
+	deblend.x	<mach.h> <math.h>
+	eqwidth.x	
+	eqwidthcp.x	<gset.h>
+	fixx.x		<smw.h>
+	flatten.x	<pkg/gtools.h>
+	fudgept.x	
+	fudgex.x	
+	getimage.x	<error.h> <imhdr.h> <pkg/gtools.h> <smw.h>
+	gfit.x		<error.h> <gset.h> <mach.h>
+	mktitle.x	<pkg/gtools.h> <smw.h> <units.h>
+	plotstd.x	<error.h> <gset.h> <smw.h>
+	replot.x	<gset.h>
+	smooth.x	
+	spdeblend.x	<error.h> <gset.h>
+	splabel.x	<gset.h> <smw.h>
+	splot.x		<error.h> <gset.h> <imhdr.h> <pkg/gtools.h> <units.h>\
+			<smw.h>
+	splotcolon.x	<ctype.h> <error.h> <pkg/gtools.h> <smw.h> <units.h>
+	splotfun.x	<mach.h> <smw.h> <error.h>
+	stshelp.x	<error.h>
+	sumflux.x	
+	usercoord.x	<error.h> <smw.h> <units.h>
+	voigt.x	
+	wrspect.x	<error.h> <imhdr.h> <imio.h> <smw.h> <units.h>
+	;
diff --git a/noao/onedspec/splot/mktitle.x b/noao/onedspec/splot/mktitle.x
new file mode 100644
index 00000000..554599bf
--- /dev/null
+++ b/noao/onedspec/splot/mktitle.x
@@ -0,0 +1,41 @@
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+
+# MKTITLE -- Make a spectrum title (IIDS style)
+
+procedure mktitle (sh, gt)
+
+pointer	sh, gt
+
+pointer	sp, str
+
+begin
+	# Do nothing if the GTOOLS pointer is undefined.
+	if (gt == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "[%s%s]: %s %.2s ap:%d beam:%d")
+	    call pargstr (IMNAME(sh))
+	    call pargstr (IMSEC(sh))
+	    call pargstr (TITLE(sh))
+	    call pargr (IT(sh))
+	    call pargi (AP(sh))
+	    call pargi (BEAM(sh))
+
+	# Set GTOOLS labels.
+	call gt_sets (gt, GTTITLE, Memc[str])
+	if (UN_LABEL(UN(sh)) != EOS) {
+	    call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+	    call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+	} else {
+	    call gt_sets (gt, GTXLABEL, LABEL(sh))
+	    call gt_sets (gt, GTXUNITS, UNITS(sh))
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/plotstd.x b/noao/onedspec/splot/plotstd.x
new file mode 100644
index 00000000..dab1554d
--- /dev/null
+++ b/noao/onedspec/splot/plotstd.x
@@ -0,0 +1,70 @@
+include	<error.h>
+include	<gset.h>
+include	<smw.h>
+
+define	VLIGHT	2.997925e18
+
+# PLOT_STD -- Plot the flux values for a standard star on current screen
+
+procedure plot_std (sh, gfd, fnu)
+
+pointer	sh
+int	gfd
+bool	fnu
+
+pointer	waves, bands, mags
+int	i, nwaves
+real	w1, w2
+real	fnuzero, clgetr()
+double	shdr_lw()
+
+begin
+	# Get calibration data.
+	iferr (call getcalib (waves, bands, mags, nwaves)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	# Convert to fnu or flambda
+	fnuzero = clgetr ("fnuzero")
+	do i = 1, nwaves {
+	    Memr[mags+i-1] = fnuzero * 10.0**(-0.4 * Memr[mags+i-1])
+	    if (!fnu)
+		Memr[mags+i-1] = Memr[mags+i-1] * VLIGHT / Memr[waves+i-1]**2
+	}
+
+	# Overplot boxes on current plot
+	w1 = shdr_lw (sh, double(1))
+	w2 = shdr_lw (sh, double(SN(sh)))
+
+	do i = 1, nwaves
+	    if (Memr[waves+i-1] > w1 && Memr[waves+i-1] < w2)
+		call plbox2 (gfd, Memr[waves+i-1]-Memr[bands+i-1]/2,
+		    Memr[mags+i-1], Memr[waves+i-1]+Memr[bands+i-1]/2, .015)
+
+	call freecalib (waves, bands, mags)
+end
+
+# PLBOX2 -- Plot a box of given height and width
+
+procedure plbox2 (gfd, x1, y1, x2, ndcy)
+
+int	gfd
+real	x1, x2, y1, ndcy
+
+real	ya1, ya2
+real	wx1, wx2, wy1, wy2
+
+begin
+	# Get current WCS range
+	call ggwind (gfd, wx1, wx2, wy1, wy2)
+
+	# Adjust vertical spacing 
+	ya1 = y1 - ndcy * (wy2 - wy1)
+	ya2 = y1 + ndcy * (wy2 - wy1)
+
+	call gline (gfd, x1, ya1, x2, ya1)
+	call gline (gfd, x2, ya1, x2, ya2)
+	call gline (gfd, x2, ya2, x1, ya2)
+	call gline (gfd, x1, ya2, x1, ya1)
+end
diff --git a/noao/onedspec/splot/replot.x b/noao/onedspec/splot/replot.x
new file mode 100644
index 00000000..9157846a
--- /dev/null
+++ b/noao/onedspec/splot/replot.x
@@ -0,0 +1,27 @@
+include	<gset.h>
+
+# REPLOT -- Replot the current array
+
+procedure replot (gfd, gt, x, y, npts, clear)
+
+pointer	gfd
+pointer	gt
+real	x[ARB]
+real	y[ARB]
+int	npts
+int	clear
+
+int	wc, gstati()
+
+begin
+	if (clear == YES) {
+	    wc = gstati (gfd, G_WCS)
+	    call gclear (gfd)
+	    call gseti (gfd, G_WCS, wc)
+	    call gt_ascale (gfd, gt, x, y, npts)
+	    call gt_swind (gfd, gt)
+	    call gt_labax (gfd, gt)
+	}
+
+	call gt_plot (gfd, gt, x, y, npts)
+end
diff --git a/noao/onedspec/splot/smooth.x b/noao/onedspec/splot/smooth.x
new file mode 100644
index 00000000..1418fc4f
--- /dev/null
+++ b/noao/onedspec/splot/smooth.x
@@ -0,0 +1,54 @@
+# SMOOTH -- Box smooth the array
+
+procedure smooth (y, n)
+
+real	y[ARB]
+int	n
+
+int	i, j, boxsize, halfbox, del
+int	nsum
+real	sum
+pointer	sp, smy
+
+int	clgeti()
+
+begin
+	call smark (sp)
+	call salloc (smy, n, TY_REAL)
+
+	# Get boxsize
+	boxsize = clgeti ("boxsize")
+	if (mod (boxsize, 2) == 0) {
+	    boxsize = boxsize + 1
+	    call eprintf ("WARNING: Using a box size of %d")
+		call pargi (boxsize)
+	}
+
+	halfbox = boxsize/2
+
+	# This is not efficiently coded, but easy to code
+	# A running box mean would be faster
+	do i = 1, n {
+	    sum = 0.0
+	    nsum = 0
+
+	    if (i > halfbox && i < (n-halfbox))
+		del = halfbox
+	    else
+	    if (i <= halfbox)
+		del = i/2
+	    else
+		del = (n - i + 1)/2
+
+	    do j = i-del, i+del {
+		nsum = nsum + 1
+		sum = sum + y[j]
+	    }
+
+	    Memr[smy+i-1] = sum / nsum
+	}
+
+	# Replace pixels back
+	call amovr (Memr[smy], y, n)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/spdeblend.x b/noao/onedspec/splot/spdeblend.x
new file mode 100644
index 00000000..a07cd52d
--- /dev/null
+++ b/noao/onedspec/splot/spdeblend.x
@@ -0,0 +1,819 @@
+include	<error.h>
+include	<gset.h>
+
+define	NSUB	3	# Number of pixel subsamples
+define	MC_N	50	# Monte-Carlo samples
+define	MC_P	10	# Percent done interval (percent)
+define	MC_SIG	68	# Sigma sample point (percent)
+
+# Profile types.
+define  PTYPES  "|gaussian|lorentzian|voigt|"
+define  GAUSS           1       # Gaussian profile
+define  LORENTZ         2       # Lorentzian profile
+define  VOIGT           3       # Voigt profile
+
+
+# SP_DEBLEND -- Deblend lines in a spectral region.
+
+procedure sp_deblend (sh, gfd, wx1, wy1, wcs, pix, n, fd1, fd2,
+	xg, yg, sg, lg, pg, ng)
+
+pointer	sh			# SHDR pointer
+pointer	gfd			# GIO file descriptor
+real	wx1, wy1		# Cursor position
+real	wcs[n]			# Coordinates
+real	pix[n]			# Spectrum data
+int	n			# Number of points
+int	fd1, fd2		# Output file descriptors
+pointer	xg, yg, sg, lg, pg	# Pointers to fit parameters
+int	ng			# Number of components
+
+int	fit[5], nsub, mc_p, mc_sig, mc_n
+int	i, j, i1, npts, nlines, maxlines, wc, key, type, ifit
+long	seed
+real	w, dw, wyc, wx, wy, wx2, wy2, u, v
+real	slope, peak, flux, cont, gfwhm, lfwhm, eqw, scale, sscale, chisq, rms
+real	sigma0, invgain, wyc1, slope1, flux1, cont1, eqw1
+bool	fitit, fitg, fitl
+pointer	xg1, yg1, sg1, lg1
+pointer	sp, cmd, x, y, s, z, waves, types, gfwhms, lfwhms, peaks, ym
+pointer	conte, xge, yge, sge, lge, fluxe, eqwe
+
+int	clgeti(), clgcur(), open(), fscan(), nscan(), strdic()
+real	clgetr(), model(), gasdev(), asumr()
+double	shdr_wl()
+errchk	dofit, dorefit
+
+define	fitp_	95
+define	fitg_	96
+define	fitl_	97
+define	fitb_	98
+define	done_	99
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_FNAME, TY_CHAR)
+
+	# Input cursor is first continuum point now get second continuum point.
+	call printf ("d again:")
+	if (clgcur ("cursor", wx2, wy2, wc, key, Memc[cmd], SZ_FNAME) == EOF) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Set pixel indices and determine number of points to fit.
+	call fixx (sh, wx1, wx2, wy1, wy2, i1, j)
+	    
+	npts = j - i1 + 1
+	if (npts < 3) {
+	    call eprintf ("At least 3 points are required\n")
+	    call sfree (sp)
+	    return
+	}
+
+	# Allocate space for the points to be fit.
+	call salloc (x, npts, TY_REAL)
+	call salloc (y, npts, TY_REAL)
+	call salloc (s, npts, TY_REAL)
+	call salloc (z, npts, TY_REAL)
+
+	# Scale the data.
+	sigma0 = clgetr ("sigma0")
+	invgain = clgetr ("invgain")
+	mc_n = clgeti ("nerrsample")
+	if (IS_INDEF(sigma0) || IS_INDEF(invgain) || sigma0<0. ||
+	    invgain<0. || (sigma0 == 0. && invgain == 0.)) {
+	    sigma0 = INDEF
+	    invgain = INDEF
+	}
+	scale = 0.
+	do i = 1, npts {
+	    Memr[x+i-1] = wcs[i1+i-1]
+	    Memr[y+i-1] = pix[i1+i-1]
+	    if (Memr[y+i-1] <= 0.)
+		if (invgain != 0.) {
+		    sigma0 = INDEF
+		    invgain = INDEF
+		    call eprintf (
+			"WARNING: Cannot compute errors with non-zero gain")
+		    call eprintf (
+			" and negative pixel values.\n")
+		}
+	    scale = max (scale, abs (Memr[y+i-1]))
+	}
+	if (IS_INDEF(sigma0)) {
+	    call amovkr (1., Memr[s], npts)
+	    sscale = 1.
+	} else {
+	    do i = 1, npts
+		Memr[s+i-1] = sqrt (sigma0 ** 2 + invgain * Memr[y+i-1])
+	    sscale = asumr (Memr[s], npts) / npts
+	}
+	call adivkr (Memr[y], scale, Memr[y], npts)
+	call adivkr (Memr[s], sscale, Memr[s], npts)
+
+	# Select the lines to be fit.  If no lines return.
+	fitit = false
+	fitg = false
+	fitl = false
+	maxlines = 5
+	call malloc (waves, maxlines, TY_REAL)
+	call malloc (peaks, maxlines, TY_REAL)
+	call malloc (gfwhms, maxlines, TY_REAL)
+	call malloc (lfwhms, maxlines, TY_REAL)
+	call malloc (types, maxlines, TY_INT)
+	nlines = 0
+	call printf (
+	    "Lines ('f'ile, 'g'aussian, 'l'orentzian, 'v'oigt, 't'ype, 'q'uit:")
+	while (clgcur ("cursor", wx, wy, wc, key, Memc[cmd], SZ_FNAME) != EOF) {
+	    switch (key) {
+	    case 'f':
+		call clgstr ("linelist", Memc[cmd], SZ_FNAME)
+		call printf (
+		    "Lines ('f'ile, 'g'aussian, 'l'orentzian, 'v'oigt, 't'ype, 'q'uit:")
+		iferr (j = open (Memc[cmd], READ_ONLY, TEXT_FILE)) {
+		    call erract (EA_WARN)
+		    next
+		}
+		while (fscan (j) != EOF) {
+		    call gargr (wx)
+		    if (nscan() < 1)
+			next
+		    if (wx < min (wcs[1], wcs[n]) || wx > max (wcs[1], wcs[n]))
+			next
+                    call gargr (peak)
+                    call gargwrd (Memc[cmd], SZ_FNAME)
+                    call gargr (gfwhm)
+                    call gargr (lfwhm)
+                    type = strdic (Memc[cmd], Memc[cmd], SZ_FNAME, PTYPES)
+		    if (type == 0)
+			type = GAUSS
+		    switch (nscan()) {
+		    case 0:
+			next
+		    case 1:
+			peak = INDEF
+			type = GAUSS
+			gfwhm = INDEF
+			lfwhm = INDEF
+		    case 2:
+			type = GAUSS
+			gfwhm = INDEF
+			lfwhm = INDEF
+		    case 3:
+			gfwhm = INDEF
+			lfwhm = INDEF
+		    case 4:
+			switch (type) {
+			case GAUSS:
+			    lfwhm = INDEF
+			case LORENTZ:
+			    lfwhm = gfwhm
+			    gfwhm = INDEF
+			case VOIGT:
+			    lfwhm = INDEF
+			}
+		    }
+		    for (i = 0; i < nlines && wx != Memr[waves+i]; i = i + 1)
+			;
+		    if (i == nlines) {
+			if (nlines == maxlines) {
+			    maxlines = maxlines + 5
+			    call realloc (waves, maxlines, TY_REAL)
+			    call realloc (peaks, maxlines, TY_REAL)
+			    call realloc (gfwhms, maxlines, TY_REAL)
+			    call realloc (lfwhms, maxlines, TY_REAL)
+			    call realloc (types, maxlines, TY_INT)
+			}
+			Memr[waves+i] = wx
+			Memr[peaks+i] = peak
+			Memr[gfwhms+i] = gfwhm
+			Memr[lfwhms+i] = lfwhm
+			Memi[types+i] = type
+			switch (type) {
+			case GAUSS:
+			    fitg = true
+			case LORENTZ:
+			    fitl = true
+			case VOIGT:
+			    fitg = true
+			    fitl = true
+			}
+			nlines = nlines + 1
+			call gmark (gfd, wx, wy, GM_VLINE, 3., 3.)
+		    }
+		}
+		call close (j)
+		next
+	    case 'g':
+		type = GAUSS
+		peak = INDEF
+		gfwhm = INDEF
+		lfwhm = INDEF
+	    case 'l':
+		type = LORENTZ
+		peak = INDEF
+		gfwhm = INDEF
+		lfwhm = INDEF
+	    case 'v':
+		type = VOIGT
+		peak = INDEF
+		gfwhm = INDEF
+		lfwhm = INDEF
+	    case 't':
+		type = GAUSS
+		wx = clgetr ("wavelength")
+		peak = INDEF
+		gfwhm = INDEF
+		lfwhm = INDEF
+		call printf (
+		"Lines ('f'ile, 'g'aussian, 'l'orentzian, 'v'oigt, 't'ype, 'q'uit:")
+	    case 'q':
+		call printf ("\n")
+		break
+	    case 'I':
+		call fatal (0, "Interrupt")
+	    default:
+		call printf (
+		"Lines ('f'ile, 'g'aussian, 'l'orentzian, 'v'oigt, 't'ype, 'q'uit:\007")
+		next
+	    }
+	    for (i = 0; i < nlines && wx != Memr[waves+i]; i = i + 1)
+		;
+	    if (i == nlines) {
+		if (nlines == maxlines) {
+		    maxlines = maxlines + 5
+		    call realloc (waves, maxlines, TY_REAL)
+		    call realloc (peaks, maxlines, TY_REAL)
+		    call realloc (gfwhms, maxlines, TY_REAL)
+		    call realloc (lfwhms, maxlines, TY_REAL)
+		    call realloc (types, maxlines, TY_INT)
+		}
+		Memr[waves+i] = wx
+		Memr[peaks+i] = peak
+		Memr[gfwhms+i] = gfwhm
+		Memr[lfwhms+i] = lfwhm
+		Memi[types+i] = type
+		switch (type) {
+		case GAUSS:
+		    fitg = true
+		case LORENTZ:
+		    fitl = true
+		case VOIGT:
+		    fitg = true
+		    fitl = true
+		}
+		nlines = nlines + 1
+		call gmark (gfd, wx, wy, GM_VLINE, 3., 3.)
+	    }
+	}
+	if (nlines == 0)
+	    goto done_
+
+	# Allocate memory.
+	if (ng == 0) {
+	    call malloc (xg, nlines, TY_REAL)
+	    call malloc (yg, nlines, TY_REAL)
+	    call malloc (sg, nlines, TY_REAL)
+	    call malloc (lg, nlines, TY_REAL)
+	    call malloc (pg, nlines, TY_INT)
+	} else if (ng != nlines) {
+	    call realloc (xg, nlines, TY_REAL)
+	    call realloc (yg, nlines, TY_REAL)
+	    call realloc (sg, nlines, TY_REAL)
+	    call realloc (lg, nlines, TY_REAL)
+	    call realloc (pg, nlines, TY_INT)
+	}
+	ng = nlines
+
+	# Do fits.
+	ifit = 0
+	fit[3] = 3
+	repeat {
+fitp_       call printf ("Fit positions (fixed, single, all, quit) ")
+	    if (clgcur ("cursor", wx, wy, wc, key, Memc[cmd], SZ_FNAME) == EOF)
+		break
+	    switch (key) {
+	    case 'f':
+		fit[2] = 1
+	    case 's':
+		fit[2] = 2
+	    case 'a':
+		fit[2] = 3
+	    case 'q':
+		break
+	    default:
+		goto fitp_
+	    }
+	    if (fitg) {
+fitg_		call printf ("Fit Gaussian widths (fixed, single, all, quit) ")
+		if (clgcur("cursor", wx, wy, wc, key, Memc[cmd], SZ_FNAME)==EOF)
+		    break
+		switch (key) {
+		case 'f':
+		    fit[4] = 1
+		case 's':
+		    fit[4] = 2
+		case 'a':
+		    fit[4] = 3
+		case 'q':
+		    break
+		default:
+		    goto fitg_
+		}
+	    }
+	    if (fitl) {
+fitl_		call printf (
+		    "Fit Lorentzian widths (fixed, single, all, quit) ")
+		if (clgcur("cursor", wx, wy, wc, key, Memc[cmd], SZ_FNAME)==EOF)
+		    break
+		switch (key) {
+		case 'f':
+		    fit[5] = 1
+		case 's':
+		    fit[5] = 2
+		case 'a':
+		    fit[5] = 3
+		case 'q':
+		    break
+		default:
+		    goto fitl_
+		}
+	    }
+fitb_	    call printf ("Fit background (no, yes, quit) ")
+	    if (clgcur ("cursor", wx, wy, wc, key, Memc[cmd], SZ_FNAME) == EOF)
+		break
+	    switch (key) {
+	    case 'n':
+		fit[1] = 1
+	    case 'y':
+		fit[1] = 2
+	    case 'q':
+		break
+	    default:
+		goto fitb_
+	    }
+	    call printf ("Fitting...")
+	    call flush (STDOUT)
+
+	    # Setup initial estimates.
+	    if (ifit == 0) {
+		slope = (wy2-wy1) / (wx2-wx1) / scale
+		wyc = wy1 / scale - slope * wx1
+		eqw = abs (Memr[x+npts-1] - Memr[x]) / nlines
+		do i = 0, nlines-1 {
+		    w = Memr[waves+i]
+		    peak = Memr[peaks+i]
+		    gfwhm = Memr[gfwhms+i]
+		    lfwhm = Memr[lfwhms+i]
+		    type = Memi[types+i]
+		    j = max (1, min (n, nint (shdr_wl (sh, double(w)))))
+		    Memr[xg+i] = w
+		    if (IS_INDEF(peak))
+			Memr[yg+i] = pix[j] / scale - wyc - slope * w
+		    else
+			Memr[yg+i] = peak / scale
+		    Memr[sg+i] = 0.
+		    Memr[lg+i] = 0.
+		    Memi[pg+i] = type
+		    switch (type) {
+		    case GAUSS:
+			if (IS_INDEF(gfwhm))
+			    Memr[sg+i] = 0.3 * eqw
+			else
+			    Memr[sg+i] = gfwhm
+		    case LORENTZ:
+			if (IS_INDEF(lfwhm))
+			    Memr[lg+i] = 0.3 * eqw
+			else
+			    Memr[lg+i] = lfwhm
+		    case VOIGT:
+			if (IS_INDEF(Memr[gfwhms+i]))
+			    Memr[sg+i] = 0.1 * eqw
+			else
+			    Memr[sg+i] = gfwhm
+			if (IS_INDEF(Memr[lfwhms+i]))
+			    Memr[lg+i] = 0.1 * eqw
+			else
+			    Memr[lg+i] = lfwhm
+		    }
+		}
+	    } else {
+		call adivkr (Memr[yg], scale, Memr[yg], ng)
+		slope = slope / scale
+		wyc = wyc / scale - slope * wx1
+	    }
+
+	    nsub = NSUB
+	    dw = (wcs[n] - wcs[1]) / (n - 1)
+	    iferr (call dofit (fit, Memr[x], Memr[y], Memr[s], npts,
+		dw, nsub, wyc, slope,
+		Memr[xg], Memr[yg], Memr[sg], Memr[lg], Memi[pg], ng, chisq)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    ifit = ifit + 1
+
+	    # Compute Monte-Carlo errors.
+	    if (mc_n > 9 && !IS_INDEF(sigma0)) {
+		mc_p = nint (mc_n * MC_P / 100.)
+		mc_sig = nint (mc_n * MC_SIG / 100.)
+
+		call salloc (ym, npts, TY_REAL)
+		call salloc (xg1, ng, TY_REAL)
+		call salloc (yg1, ng, TY_REAL)
+		call salloc (sg1, ng, TY_REAL)
+		call salloc (lg1, ng, TY_REAL)
+		call salloc (conte, mc_n*ng, TY_REAL)
+		call salloc (xge, mc_n*ng, TY_REAL)
+		call salloc (yge, mc_n*ng, TY_REAL)
+		call salloc (sge, mc_n*ng, TY_REAL)
+		call salloc (lge, mc_n*ng, TY_REAL)
+		call salloc (fluxe, mc_n*ng, TY_REAL)
+		call salloc (eqwe, mc_n*ng, TY_REAL)
+		do i = 1, npts {
+		    w = Memr[x+i-1]
+		    Memr[ym+i-1] = model (w, dw, nsub, Memr[xg], Memr[yg],
+			Memr[sg], Memr[lg], Memi[pg], ng) + wyc + slope * w
+		}
+		seed = 1
+		do i = 0, mc_n-1 {
+		    if (i > 0 && mod (i, mc_p) == 0) {
+			call printf ("%2d ")
+			    call pargi (100 * i / mc_n)
+			call flush (STDOUT)
+		    }
+		    do j = 1, npts
+			Memr[y+j-1] = Memr[ym+j-1] +
+			    sscale / scale * Memr[s+j-1] * gasdev (seed)
+		    wyc1 = wyc
+		    slope1 = slope
+		    call amovr (Memr[xg], Memr[xg1], ng)
+		    call amovr (Memr[yg], Memr[yg1], ng)
+		    call amovr (Memr[sg], Memr[sg1], ng)
+		    call amovr (Memr[lg], Memr[lg1], ng)
+		    call dorefit (fit, Memr[x], Memr[y], Memr[s], npts,
+			dw, nsub, wyc1, slope1,
+			Memr[xg1], Memr[yg1], Memr[sg1], Memr[lg1], Memi[pg],
+			ng, chisq)
+
+		    do j = 0, ng-1 {
+			cont = wyc + slope * Memr[xg+j]
+			cont1 = wyc1 + slope1 * Memr[xg+j]
+			switch (Memi[pg+j]) {
+			case GAUSS:
+			    flux = 1.064467 * Memr[yg+j] * Memr[sg+j]
+			    flux1 = 1.064467 * Memr[yg1+j] * Memr[sg1+j]
+			case LORENTZ:
+			    flux = 1.570795 * Memr[yg+j] * Memr[lg+j]
+			    flux1 = 1.570795 * Memr[yg1+j] * Memr[lg1+j]
+			case VOIGT:
+			    call voigt (0., 0.832555*Memr[lg+j]/Memr[sg+j],
+				v, u)
+			    flux = 1.064467 * Memr[yg+j] * Memr[sg+j] / v
+			    call voigt (0., 0.832555*Memr[lg1+j]/Memr[sg1+j],
+				v, u)
+			    flux1 = 1.064467 * Memr[yg1+j] * Memr[sg1+j] / v
+			}
+			if (cont > 0. && cont1 > 0.) {
+			    eqw = -flux / cont
+			    eqw1 = -flux1 / cont1
+			} else {
+			    eqw = 0.
+			    eqw1 = 0.
+			}
+			Memr[conte+j*mc_n+i] = abs (cont1 - cont)
+			Memr[xge+j*mc_n+i] = abs (Memr[xg1+j] - Memr[xg+j])
+			Memr[yge+j*mc_n+i] = abs (Memr[yg1+j] - Memr[yg+j])
+			Memr[sge+j*mc_n+i] = abs (Memr[sg1+j] - Memr[sg+j])
+			Memr[lge+j*mc_n+i] = abs (Memr[lg1+j] - Memr[lg+j])
+			Memr[fluxe+j*mc_n+i] = abs (flux1 - flux)
+			Memr[eqwe+j*mc_n+i] = abs (eqw1 - eqw)
+		    }
+		}
+		do j = 0, ng-1 {
+		    call asrtr (Memr[conte+j*mc_n], Memr[conte+j*mc_n], mc_n)
+		    call asrtr (Memr[xge+j*mc_n], Memr[xge+j*mc_n], mc_n)
+		    call asrtr (Memr[yge+j*mc_n], Memr[yge+j*mc_n], mc_n)
+		    call asrtr (Memr[sge+j*mc_n], Memr[sge+j*mc_n], mc_n)
+		    call asrtr (Memr[lge+j*mc_n], Memr[lge+j*mc_n], mc_n)
+		    call asrtr (Memr[fluxe+j*mc_n], Memr[fluxe+j*mc_n], mc_n)
+		    call asrtr (Memr[eqwe+j*mc_n], Memr[eqwe+j*mc_n], mc_n)
+		}
+		call amulkr (Memr[conte], scale, Memr[conte], mc_n*ng)
+		call amulkr (Memr[yge], scale, Memr[yge], mc_n*ng)
+		call amulkr (Memr[fluxe], scale, Memr[fluxe], mc_n*ng)
+	    }
+
+	    call amulkr (Memr[yg], scale, Memr[yg], ng)
+	    wyc = (wyc + slope * wx1) * scale
+	    slope = slope * scale
+
+	    fitit = true
+
+	    # Compute model spectrum with continuum and plot.
+	    call printf ("Overplot (total, components, both, none) ")
+	    if (clgcur ("cursor", wx, wy, wc, key, Memc[cmd], SZ_FNAME) == EOF)
+		break
+
+	    rms = 0.
+	    do i = 1, npts {
+		w = Memr[x+i-1]
+	        Memr[z+i-1] = model (w, dw, nsub, Memr[xg], Memr[yg],
+		    Memr[sg], Memr[lg], Memi[pg], ng)
+	        Memr[z+i-1] = Memr[z+i-1] + wyc + slope * (w - wx1)
+		rms = rms + (Memr[z+i-1] / scale - Memr[y+i-1]) ** 2
+	    }
+
+	    # Total.
+	    if (key == 't' || key == 'b') {
+		call gseti (gfd, G_PLTYPE, 2)
+		call gseti (gfd, G_PLCOLOR, 2)
+		call gpline (gfd, Memr[x], Memr[z], npts)
+		call gseti (gfd, G_PLTYPE, 1)
+		call gflush (gfd)
+	    }
+
+	    # Components.
+	    if (key == 'c' || key == 'b') {
+		call gseti (gfd, G_PLTYPE, 3)
+		call gseti (gfd, G_PLCOLOR, 5)
+		do j = 0, ng-1 {
+		    do i = 1, npts {
+			w = Memr[x+i-1]
+			Memr[z+i-1] = model (w, dw, nsub, Memr[xg+j], Memr[yg+j],
+			    Memr[sg+j], Memr[lg+j], Memi[pg+j], 1)
+			Memr[z+i-1] = Memr[z+i-1] + wyc + slope * (w - wx1)
+		    }
+		    call gpline (gfd, Memr[x], Memr[z], npts)
+		}
+		call gseti (gfd, G_PLTYPE, 1)
+		call gflush (gfd)
+	    }
+
+	    if (key != 'n') {
+		call gseti (gfd, G_PLTYPE, 4)
+		call gseti (gfd, G_PLCOLOR, 3)
+		call gline (gfd, wx1, wyc, wx2, wyc + slope * (wx2 - wx1))
+		call gseti (gfd, G_PLTYPE, 1)
+		call gflush (gfd)
+	    }
+
+
+	    # Print computed values on status line.
+	    i = 1
+	    key = ''
+	    repeat {
+	        switch (key) {
+	        case '-':
+		    i = i - 1
+		    if (i < 1)
+		        i = nlines
+	        case '+':
+		    i = i + 1
+		    if (i > nlines)
+		        i = 1
+	        case 'q':
+		    call printf ("\n")
+		    break
+	        }
+
+		if (key == 'r') {
+		    call printf ("\nrms = %8.4g")
+			call pargr (scale * sqrt (chisq / npts))
+		} else {
+		    w = Memr[xg+i-1]
+		    cont = wyc + slope * (w - wx1)
+		    peak = Memr[yg+i-1]
+		    gfwhm = Memr[sg+i-1]
+		    lfwhm = Memr[lg+i-1]
+		    switch (Memi[pg+i-1]) {
+		    case GAUSS:
+			flux = 1.064467 * peak * gfwhm
+			if (cont > 0.)
+			    eqw = -flux / cont
+			else
+			    eqw = INDEF
+			call printf (
+	    "\n%d: center = %8.6g, flux = %8.4g, eqw = %6.4g, gfwhm = %6.4g")
+			    call pargi (i)
+			    call pargr (w)
+			    call pargr (flux)
+			    call pargr (eqw)
+			    call pargr (gfwhm)
+		    case LORENTZ:
+			flux = 1.570795 * peak * lfwhm
+			if (cont > 0.)
+			    eqw = -flux / cont
+			else
+			    eqw = INDEF
+			call printf (
+	    "\n%d: center = %8.6g, flux = %8.4g, eqw = %6.4g, lfwhm = %6.4g")
+			    call pargi (i)
+			    call pargr (w)
+			    call pargr (flux)
+			    call pargr (eqw)
+			    call pargr (lfwhm)
+		    case VOIGT:
+			call voigt (0., 0.832555*lfwhm/gfwhm, v, u)
+			flux = 1.064467 * peak * gfwhm / v
+			if (cont > 0.)
+			    eqw = -flux / cont
+			else
+			    eqw = INDEF
+			call printf (
+	    "\n%d: center = %8.6g, eqw = %6.4g, gfwhm = %6.4g, lfwhm = %6.4g")
+			    call pargi (i)
+			    call pargr (w)
+			    call pargr (eqw)
+			    call pargr (gfwhm)
+			    call pargr (lfwhm)
+		    }
+		}
+
+	        call printf ("  (+,-,r,q):")
+	        call flush (STDOUT)
+	    } until (clgcur ("cursor",
+		wx, wy, wc, key, Memc[cmd], SZ_FNAME) == EOF)
+	}
+
+done_
+	call printf ("Deblending done\n")
+	# Log computed values
+	if (fitit) {
+	    do i = 1, nlines {
+		w = Memr[xg+i-1]
+		cont = wyc + slope * (w - wx1)
+		peak = Memr[yg+i-1]
+		gfwhm = Memr[sg+i-1]
+		lfwhm = Memr[lg+i-1]
+		switch (Memi[pg+i-1]) {
+		case GAUSS:
+		    flux = 1.064467 * peak * gfwhm
+		case LORENTZ:
+		    flux = 1.570795 * peak * lfwhm
+		case VOIGT:
+		    call voigt (0., 0.832555*lfwhm/gfwhm, v, u)
+		    flux = 1.064467 * peak * gfwhm / v
+		}
+
+		if (cont > 0.)
+		    eqw = -flux / cont
+		else
+		    eqw = INDEF
+		if (fd1 != NULL) {
+		    call fprintf (fd1,
+			" %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+			call pargr (w)
+			call pargr (cont)
+			call pargr (flux)
+			call pargr (eqw)
+			call pargr (peak)
+			call pargr (gfwhm)
+			call pargr (lfwhm)
+		}
+		if (fd2 != NULL) {
+		    call fprintf (fd2,
+			" %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+			call pargr (w)
+			call pargr (cont)
+			call pargr (flux)
+			call pargr (eqw)
+			call pargr (peak)
+			call pargr (gfwhm)
+			call pargr (lfwhm)
+		}
+		if (mc_n > 9 && !IS_INDEF(sigma0)) {
+		    if (fd1 != NULL) {
+			call fprintf (fd1,
+	    "  (%7.5g) (%7.5g) (%7.4g) (%7.4g) (%7.4g) (%7.4g) (%7.4g)\n")
+			    call pargr (Memr[xge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[conte+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[fluxe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[eqwe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[yge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[sge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[lge+(i-1)*mc_n+mc_sig])
+		    }
+		    if (fd2 != NULL) {
+			call fprintf (fd2,
+	    "  (%7.5g) (%7.5g) (%7.4g) (%7.4g) (%7.4g) (%7.4g) (%7.4g)\n")
+			    call pargr (Memr[xge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[conte+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[fluxe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[eqwe+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[yge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[sge+(i-1)*mc_n+mc_sig])
+			    call pargr (Memr[lge+(i-1)*mc_n+mc_sig])
+		    }
+		}
+	    }
+	} else {
+	    call mfree (xg, TY_REAL)
+	    call mfree (yg, TY_REAL)
+	    call mfree (sg, TY_REAL)
+	    call mfree (lg, TY_REAL)
+	    call mfree (pg, TY_INT)
+	    ng = 0
+	}
+
+	call mfree (waves, TY_REAL)
+	call mfree (peaks, TY_REAL)
+	call mfree (gfwhms, TY_REAL)
+	call mfree (lfwhms, TY_REAL)
+	call mfree (types, TY_INT)
+	call sfree (sp)
+end
+
+
+# SUBBLEND -- Subtract last fit.
+
+procedure subblend (sh, gfd, x, y, n, wx1, wy1, xg, yg, sg, lg, pg, ng)
+
+pointer	sh			# SHDR pointer
+pointer	gfd			# GIO file descriptor
+real	wx1, wy1		# Cursor position
+real	x[n]			# Spectrum data
+real	y[n]			# Spectrum data
+int	n			# Number of points
+pointer	xg, yg, sg, lg, pg	# Pointers to fit parameters
+int	ng			# Number of components
+
+int	i, j, i1, npts, wc, key, nsub
+real	wx2, wy2, dw
+pointer	sp, cmd
+
+int	clgcur()
+real	model()
+
+begin
+	if (ng == 0)
+	    return
+
+	call smark (sp)
+	call salloc (cmd, SZ_FNAME, TY_CHAR)
+
+	# Determine fit range
+	call printf ("- again:")
+	call flush (STDOUT)
+	if (clgcur ("cursor", wx2, wy2, wc, key, Memc[cmd], SZ_FNAME) == EOF) {
+	    call sfree (sp)
+	    return
+	}
+
+	call fixx (sh, wx1, wx2, wy1, wy2, i1, j)
+	npts = j - i1 + 1
+
+	dw = (x[n] - x[1]) / (n - 1)
+	nsub = NSUB
+	do i = 1, npts {
+	    y[i1+i-1] = y[i1+i-1] -
+		model (x[i1+i-1], dw, nsub, Memr[xg], Memr[yg], Memr[sg],
+		    Memr[lg], Memi[pg], ng)
+	}
+
+	# Plot subtracted curve
+	call gpline (gfd, x[i1], y[i1], npts)
+	call gflush (gfd)
+
+	call mfree (xg, TY_REAL)
+	call mfree (yg, TY_REAL)
+	call mfree (sg, TY_REAL)
+	call mfree (lg, TY_REAL)
+	call mfree (pg, TY_INT)
+	ng = 0
+	call sfree (sp)
+end
+
+
+# GASDEV -- Return a normally distributed deviate with zero mean and unit
+# variance.  The method computes two deviates simultaneously.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+real procedure gasdev (seed)
+
+long	seed		# Seed for random numbers
+
+real	v1, v2, r, fac, urand()
+int	iset
+data	iset/0/
+
+begin
+	if (iset == 0) {
+	    repeat {
+	        v1 = 2 * urand (seed) - 1.
+	        v2 = 2 * urand (seed) - 1.
+	        r = v1 ** 2 + v2 ** 2
+	    } until ((r > 0) && (r < 1))
+	    fac = sqrt (-2. * log (r) / r)
+
+	    iset = 1
+	    return (v1 * fac)
+	} else {
+	    iset = 0
+	    return (v2 * fac)
+	}
+end
diff --git a/noao/onedspec/splot/splabel.x b/noao/onedspec/splot/splabel.x
new file mode 100644
index 00000000..fcba2584
--- /dev/null
+++ b/noao/onedspec/splot/splabel.x
@@ -0,0 +1,112 @@
+include	<gset.h>
+include <smw.h>
+
+define	OPTIONS	"|label|mabove|mbelow|"
+define	LABEL	1	# Label at cursor position
+define	MABOVE	2	# Tick mark plus label above spectrum
+define	MBELOW	3	# Tick mark plus label below spectrum
+
+
+# SPLABEL -- Add a label.
+
+procedure splabel (option, sh, gp, x, y, label, format)
+
+char	option[ARB]		#I Label option
+pointer	sh			#I Spectrum object
+pointer	gp			#I Graphics object
+real	x, y			#I Label position
+char	label[ARB]		#I Label
+char	format[ARB]		#I Format
+
+int	op, pix, color, markcolor, strdic(), gstati()
+real	mx, my, x1, x2, y1, y2
+pointer	sp, fmt, lab
+double	shdr_wl()
+
+define	TICK	.03	# Tick size in NDC
+define	GAP	.02	# Gap size in NDC
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+	call salloc (lab, SZ_LINE, TY_CHAR)
+
+	op = strdic (option, Memc[lab], SZ_LINE, OPTIONS)
+	if (op == 0) {
+	    call sfree (sp)
+	    return
+	}
+	call ggwind (gp, x1, x2, y1, y2)
+	if ((x < min (x1, x2)) || (x > max (x1, x2))) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Set label position and draw tick mark.
+	switch (op) {
+	case LABEL:
+	    call gctran (gp, x, y, mx, my, 1, 0)
+	    call gctran (gp, mx, my, x1, y2, 0, 1)
+	    markcolor = gstati (gp, G_TICKLABELCOLOR)
+	    if (format[1] == EOS)
+		call strcpy ("h=c;v=c;s=1.0", Memc[fmt], SZ_LINE)
+	    else
+		call strcpy (format, Memc[fmt], SZ_LINE)
+
+	case MABOVE:
+	    pix = max (2, min (SN(sh)-3, int (shdr_wl (sh, double (x)))))
+	    y1 = max (Memr[SY(sh)+pix-2], Memr[SY(sh)+pix-1],
+		Memr[SY(sh)+pix], Memr[SY(sh)+pix+1])
+	    call gctran (gp, x, y1, mx, my, 1, 0)
+	    call gctran (gp, mx, my + GAP, x1, y1, 0, 1)
+	    call gctran (gp, mx, my + GAP + TICK, x1, y2, 0, 1)
+
+	    color = gstati (gp, G_PLCOLOR)
+	    markcolor = gstati (gp, G_TICKLABELCOLOR)
+	    call gseti (gp, G_PLCOLOR, markcolor)
+	    call gline (gp, x1, y1, x1, y2)
+	    call gseti (gp, G_PLCOLOR, color)
+
+	    call gctran (gp, mx, my + TICK + 2 * GAP, x1, y2, 0, 1)
+	    if (format[1] == EOS)
+	        call strcpy ("u=180;h=c;v=b;s=0.5", Memc[fmt], SZ_LINE)
+	    else
+		call strcpy (format, Memc[fmt], SZ_LINE)
+
+	case MBELOW:
+	    pix = max (2, min (SN(sh)-3, int (shdr_wl (sh, double (x)))))
+	    y1 = min (Memr[SY(sh)+pix-2], Memr[SY(sh)+pix-1],
+		Memr[SY(sh)+pix], Memr[SY(sh)+pix+1])
+	    call gctran (gp, x, y1, mx, my, 1, 0)
+	    call gctran (gp, mx, my - GAP, x1, y1, 0, 1)
+	    call gctran (gp, mx, my - GAP - TICK, x1, y2, 0, 1)
+
+	    color = gstati (gp, G_PLCOLOR)
+	    markcolor = gstati (gp, G_TICKLABELCOLOR)
+	    call gseti (gp, G_PLCOLOR, markcolor)
+	    call gline (gp, x1, y1, x1, y2)
+	    call gseti (gp, G_PLCOLOR, color)
+
+	    call gctran (gp, mx, my - TICK - 2 * GAP, x1, y2, 0, 1)
+	    if (format[1] == EOS)
+	        call strcpy ("u=0;h=c;v=t;s=0.5", Memc[fmt], SZ_LINE)
+	    else
+		call strcpy (format, Memc[fmt], SZ_LINE)
+	}
+
+	# Draw the label.
+	if (label[1] != EOS) {
+	    color = gstati (gp, G_TXCOLOR)
+	    call gseti (gp, G_TXCOLOR, markcolor)
+	    if (label[1] == '%') {
+		call sprintf (Memc[lab], SZ_LINE, label)
+		    call pargr (x)
+		call gtext (gp, x1, y2, Memc[lab], Memc[fmt])
+	    } else
+		call gtext (gp, x1, y2, label, Memc[fmt])
+	    call gseti (gp, G_TXCOLOR, color)
+	}
+
+	call gflush (gp)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/splot.key b/noao/onedspec/splot/splot.key
new file mode 100644
index 00000000..b78c722d
--- /dev/null
+++ b/noao/onedspec/splot/splot.key
@@ -0,0 +1,116 @@
+? - This display                          r - Redraw the current window
+/ - Cycle thru short help on stat line    s - Smooth (boxcar)
+a - Autoexpand between cursors            t - Fit continuum(*)
+b - Toggle base plot level to 0.0         u - Adjust coordinate scale(*)
+c - Clear and redraw full spectrum        v - Velocity scale (toggle)
+d - Deblend lines using profile models    w - Window the graph
+e - Equiv. width, integ flux, center      x - Connects 2 cursor positions
+f - Arithmetic functions: log, sqrt...    y - Plot std star flux from calib file
+g - Get new image and plot                z - Expand x range by factor of 2
+h - Equivalent widths(*)                  ) - Go to next spectrum in image
+i - Write current image as new image      ( - Go to previous spectrum in image
+j - Fudge a point to Y-cursor value       # - Select new line/aperture
+k - Profile fit to single line(*)         % - Select new band
+l - Convert to F-lambda                   $ - Toggle wavelength/pixel scale
+m - Mean, RMS, snr in marked region       - - Subtract deblended fit
+n - Convert to F-nu                       , - Down slide spectrum
+o - Toggle overplot of following plot     . - Up slide spectrum
+p - Convert to wavelength scale           I - Interrupt task immediately
+q - Quit and exit                   <space> - Cursor position and flux
+
+(*) For 'h' key: Measure equivalent widths
+    a - Left side for width at 1/2 flux   l - Left side for continuum = 1
+    b - Right side for width at 1/2 flux  r - Right side for continuum = 1
+    c - Both sides for width at 1/2 flux  k - Both sides for continuum = 1
+
+(*) For 'k' key: Second key may be used to select profile type
+    g - Gaussian, l - Lorentzian, v - Voigt, all others - Gaussiank
+
+(*) For 't' key: Fit the continuum with ICFIT and apply to spectrum
+    / = normalize by the continuum fit
+    - = subtract the continuum fit (residuals)
+    f = replace spectrum by the continuum fit
+    c = clean spectrum of rejected points
+    n = do the fitting but leave the spectrum unchanged
+    q = quit without fitting or modifying spectrum
+
+(*) For 'u' key: Adjust the coordinate scale by marking features
+    d = apply doppler correction to bring marked feature to specified coord.
+    l = set linear (in wavelength) coordinates based on two marked features
+    z = apply zero point shift to bring marked feature to
+	specified coordinate
+
+The colon commands do not allow abbreviations.
+
+:# <comment>      - Add comment to log file
+:dispaxis <val>   - Change summing parameter for 2D images
+:log	          - Enable logging to save_file
+:nolog            - Disable logging to save_file 
+:nsum <val>       - Change summing parameter for 2D images
+:show	          - Show full output of deblending and equiv. width measurments
+:units <value>	  - Change coordinate units (see below)
+
+:label  <label> <format> - Add label at cursor position
+:mabove <label> <format> - Add tick mark and label above spectrum
+:mbelow <label> <format> - Add tick mark and label below spectrum
+    The label must be quoted if it contains blanks.  A label beginning
+    with % (i.e. %.2f) is treated as a format for the x cursor position.
+    The optional format is a gtext string (see help on "cursors").
+    The labels are not remembered between redraws.
+
+:auto [yes|no]    - Enable/disable autodraw option
+:zero [yes|no]    - Enable/disable zero baseline option
+:xydraw [yes|no]  - Enable/disable xydraw option
+:hist [yes|no]    - Enable/disable histogram line type option
+:nosysid [yes|no] - Enable/disable system ID option
+:wreset [yes|no]  - Enable/disable window reset for new spectra option
+:flip [yes|no]    - Enable/disable dispersion coordinate flip
+:overplot [yes|no]- Enable/disable permanent overplot mode
+
+:/help  Get help on GTOOLS options
+:.help	Get help on cursor mode options
+
+
+				UNITS
+
+The units are specified by strings having a unit type from the list below
+along with the possible preceding modifiers, "inverse", to select the
+inverse of the unit and "log" to select logarithmic units. For example "log
+angstroms" to plot the logarithm of wavelength in Angstroms and "inv
+microns" to plot inverse microns.  The various identifiers may be
+abbreviated as words but the syntax is not sophisticated enough to
+recognized standard scientific abbreviations except as noted below.
+
+	   angstroms - Wavelength in Angstroms
+	  nanometers - Wavelength in nanometers
+	millimicrons - Wavelength in millimicrons
+	     microns - Wavelength in microns
+	 millimeters - Wavelength in millimeters
+	  centimeter - Wavelength in centimeters
+	      meters - Wavelength in meters
+	       hertz - Frequency in hertz (cycles per second)
+	   kilohertz - Frequency in kilohertz
+	   megahertz - Frequency in megahertz
+	    gigahertz - Frequency in gigahertz
+	         m/s - Velocity in meters per second
+	        km/s - Velocity in kilometers per second
+	          ev - Energy in electron volts
+	         kev - Energy in kilo electron volts
+	         mev - Energy in mega electron volts
+		   z - Redshift
+
+	          nm - Wavelength in nanometers
+	          mm - Wavelength in millimeters
+	          cm - Wavelength in centimeters
+	           m - Wavelength in meters
+	          Hz - Frequency in hertz (cycles per second)
+	         KHz - Frequency in kilohertz
+	         MHz - Frequency in megahertz
+	         GHz - Frequency in gigahertz
+		  wn - Wave number (inverse centimeters)
+
+The velocity and redshift units require a trailing value and unit defining the
+velocity zero point.  For example to plot velocity relative to
+a wavelength of 1 micron the unit string would be:
+
+	km/s 1 micron
diff --git a/noao/onedspec/splot/splot.log b/noao/onedspec/splot/splot.log
new file mode 100644
index 00000000..1efd91c0
--- /dev/null
+++ b/noao/onedspec/splot/splot.log
@@ -0,0 +1,8 @@
+
+Feb  6 15:44 [tofu$s2ndR136002]: NDR136002[1/1]
+  4103.416 5.470E-14 7.082E-14    -1.296
+   4060.36 5.637E-14 -6.87E-14     1.218
+
+Feb  6 15:45 [tofu$s2ndR136002]: NDR136002[1/1]
+   964.983 5.606E-14 1.030E-13     -1.84
+  907.3833 5.425E-14 -8.26E-14     1.525
diff --git a/noao/onedspec/splot/splot.x b/noao/onedspec/splot/splot.x
new file mode 100644
index 00000000..4b676660
--- /dev/null
+++ b/noao/onedspec/splot/splot.x
@@ -0,0 +1,605 @@
+include	<error.h>
+include	<imhdr.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include <smw.h>
+include	<units.h>
+
+define	KEY		"noao$onedspec/splot/splot.key"
+define	HELP		"noao$onedspec/splot/stshelp.key"
+define	PROMPT		"splot options"
+
+define	OPTIONS	",auto,zero,xydraw,histogram,nosysid,wreset,flip,overplot,"
+define	NOPTIONS	8
+define	AUTO		1	# Option number for auto graph
+define	ZERO		2	# Option number of zero y minimum
+define	XYDRAW		3	# Draw connection X,Y pairs
+define	HIST		4	# Draw histogram style lines
+define	NOSYSID		5	# Don't include system id
+define	WRESET		6	# Reset window for each new spectrum
+define	FLIP		7	# Flip spectra
+define	OVERPLOT	8	# Overplot toggle
+
+
+# SPLOT -- Plot an image line and play with it - Most appropriate for spectra
+
+procedure splot ()
+
+int	list
+int	i, j, npts, nline, nband, nap
+int	wc, key, keyu
+real	wx, wy
+double	w1, u1, w2, u2, w0, wpc
+real	avg_pix, sigma_pix
+
+int	fd1, fd2, ng, hline, hlines
+int	newgraph, newimage, overplot, options[NOPTIONS]
+pointer	sp, image, units, units1, units2, units3, cmd, save1, save2
+pointer	gp, gt, im, mw, x, y, sh, xg, yg, sg, lg, pg, hptr
+bool	wave_scl, fnu
+
+pointer	gopen(), gt_init()
+int	clgcur(), imtopen(), imtgetim(), imaccess(), gt_geti(), nowhite()
+real	clgetr(), gt_getr()
+double	clgetd(), shdr_wl()
+bool	streq(), fp_equald()
+errchk	getimage, fun_do, ans_hdr, un_changer
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (units, SZ_FNAME, TY_CHAR)
+	call salloc (units1, SZ_FNAME, TY_CHAR)
+	call salloc (units2, SZ_FNAME, TY_CHAR)
+	call salloc (units3, SZ_FNAME, TY_CHAR)
+	call salloc (cmd, SZ_FNAME, TY_CHAR)
+	call salloc (save1, SZ_FNAME, TY_CHAR)
+	call salloc (save2, SZ_FNAME, TY_CHAR)
+
+	# Get task parameters.
+
+	call clgstr ("images", Memc[image], SZ_FNAME)
+	list = imtopen (Memc[image])
+	call clgstr ("save_file", Memc[save1], SZ_FNAME)
+	call clgstr ("options", Memc[save2], SZ_FNAME)
+	call xt_gids (Memc[save2], OPTIONS, options, NOPTIONS)
+	call clgstr ("units", Memc[units], SZ_FNAME)
+	call mktemp ("tmp$splot", Memc[save2], SZ_FNAME)
+
+	# Allocate space for User area
+	x = NULL
+	y = NULL
+
+	# Initialize
+	im = NULL
+	sh = NULL
+	fd1 = NULL
+	fd2 = NULL
+	hptr = NULL
+	ng = 0
+	hline = 1
+	nline = 0
+	nband = 0
+	nap = 0
+	if (nowhite (Memc[units], Memc[units1], SZ_FNAME) == 0)
+	    call strcpy ("display", Memc[units], SZ_FNAME)
+	call strcpy (Memc[units], Memc[units1], SZ_FNAME)
+	call strcpy (Memc[units], Memc[units2], SZ_FNAME)
+	w0 = INDEFD
+	wpc = INDEFD
+
+	call clgstr ("graphics", Memc[cmd], SZ_FNAME)
+	gp = gopen (Memc[cmd], NEW_FILE+AW_DEFER, STDGRAPH)
+	call gseti (gp, G_WCS, 1)
+#	call gseti (gp, G_YNMINOR, 0)
+
+	gt = gt_init()
+	call gt_setr (gt, GTXMIN, clgetr ("xmin"))
+	call gt_setr (gt, GTXMAX, clgetr ("xmax"))
+	call gt_setr (gt, GTYMIN, clgetr ("ymin"))
+	call gt_setr (gt, GTYMAX, clgetr ("ymax"))
+	if (options[ZERO] == YES)
+	    call gt_setr (gt, GTYMIN, 0.)
+	if (options[HIST] == YES)
+	    call gt_sets (gt, GTTYPE, "histogram")
+	else
+	    call gt_sets (gt, GTTYPE, "line")
+	call gt_seti (gt, GTXFLIP, options[FLIP])
+	if (options[NOSYSID] == YES)
+	    call gt_seti (gt, GTSYSID, NO)
+
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+
+	    # Initialize to plot a wavelength scale
+	    wave_scl = true
+
+	    # Open image and get pixels
+	    if (imaccess (Memc[image], READ_ONLY) == NO) {
+		call eprintf ("Can't get image %s\n")
+		    call pargstr (Memc[image])
+		next
+	    }
+	    call getimage (Memc[image], nline, nband, nap, wave_scl,
+		w0, wpc, Memc[units], im, mw, sh, gt)
+	    x = SX(sh)
+	    y = SY(sh)
+	    npts = SN(sh)
+	    newimage = YES
+	    overplot = options[OVERPLOT]
+
+	    # Enter cursor loop with 'r' redraw.
+	    key = 'r'
+	    repeat {
+	        switch (key) {
+	        case ':':
+		    if (Memc[cmd] == '/')
+		        call gt_colon (Memc[cmd], gp, gt, newgraph)
+		    else {
+			call splot_colon (Memc[cmd], options, gp, gt, sh,
+			    wx, wy, Memc[units], Memc[save1], Memc[save2],
+			    fd1, fd2,  newgraph)
+			overplot = options[OVERPLOT]
+			if (sh == NULL) {
+			    call getimage (Memc[image], nline, nband, nap,
+				wave_scl, w0, wpc, Memc[units], im, mw, sh, gt)
+			    x = SX(sh)
+			    y = SY(sh)
+			    npts = SN(sh)
+			    newgraph = YES
+			    newimage = YES
+			}
+		    }
+
+	        case 'a': # Autoexpand
+		    call auto_exp (gp, gt, key, wx, Memr[x], Memr[y], npts)
+
+	        case 'b': # Toggle base to 0.0
+		    if (options[ZERO] == NO) {
+			call gt_setr (gt, GTYMIN, 0.)
+			options[ZERO] = YES
+		    } else {
+			call gt_setr (gt, GTYMIN, INDEF)
+			options[ZERO] = NO
+		    }
+		    newgraph = options[AUTO]
+		    overplot = NO
+
+	        case 'c':
+		    call gt_setr (gt, GTXMIN, INDEF)
+		    call gt_setr (gt, GTXMAX, INDEF)
+		    call gt_setr (gt, GTYMIN, INDEF)
+		    call gt_setr (gt, GTYMAX, INDEF)
+		    if (options[ZERO] == YES)
+			call gt_setr (gt, GTYMIN, 0.)
+		    newgraph = YES
+		    overplot = NO
+		    
+	        case 'd': # De-blend a group of lines
+		    call ans_hdr (sh, newimage, key, Memc[save1], Memc[save2],
+			fd1, fd2)
+		    call sp_deblend (sh, gp, wx, wy, Memr[x], Memr[y], npts,
+			fd1, fd2, xg, yg, sg, lg, pg, ng)
+		    newimage = NO
+    
+	        case 'k': # Fit gaussian
+		    call ans_hdr (sh, newimage, key, Memc[save1], Memc[save2],
+			fd1, fd2)
+		    call gfit (sh, gp, wx, wy, Memr[x], Memr[y], npts,
+			fd1, fd2, xg, yg, sg, lg, pg, ng)
+		    newimage = NO
+
+	        case 'e': # Equivalent width
+		    call ans_hdr (sh, newimage, key, Memc[save1], Memc[save2],
+			fd1, fd2)
+		    call eqwidth (sh, gp, wx, wy, Memr[x], Memr[y], npts,
+			fd1, fd2)
+		    newimage = NO
+
+	        case 'v':
+		    iferr {
+			if (UN_CLASS(UN(sh)) == UN_VEL) {
+			    call strcpy (Memc[units1], Memc[units], SZ_FNAME)
+			    call strcpy (Memc[units2], Memc[units3], SZ_FNAME)
+			} else {
+			    call strcpy (Memc[units], Memc[units1], SZ_FNAME)
+			    call strcpy (UNITS(sh), Memc[units2], SZ_FNAME)
+			    call un_changer (UN(sh), "angstroms", wx, 1, NO)
+			    call sprintf (Memc[units], SZ_FNAME,
+				"km/s %g angstroms")
+				call pargr (wx)
+			    call strcpy (Memc[units], Memc[units3], SZ_FNAME)
+			}
+			wx = gt_getr (gt, GTXMIN)
+			if (!IS_INDEF(wx)) {
+			    call un_changer (UN(sh), Memc[units3], wx, 1, NO)
+			    call gt_setr (gt, GTXMIN, wx)
+			}
+			wx = gt_getr (gt, GTXMAX)
+			if (!IS_INDEF(wx)) {
+			    call un_changer (UN(sh), Memc[units3], wx, 1, NO)
+			    call gt_setr (gt, GTXMAX, wx)
+			}
+			call un_changer (UN(sh), Memc[units3], Memr[x], npts,
+			    YES)
+			call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+			call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+			newgraph = YES
+			overplot = NO
+		    } then
+			call erract (EA_WARN)
+
+	        case 'h': # Equivalent widths -- C. Pilachowski style
+		    call ans_hdr (sh, newimage, key, Memc[save1], Memc[save2],
+			fd1, fd2)
+		    repeat {
+			switch (key) {
+			case 'a', 'b', 'c': # Continuum at cursor width at 1/2
+		            call eqwidth_cp (sh, gp, wx, wy, INDEF,
+				Memr[y], npts, key, fd1, fd2, xg, yg, sg,
+				lg, pg, ng)
+			    break
+			case 'l', 'r', 'k': # Continuum at 1
+		            call eqwidth_cp (sh, gp, wx, 1., wy,
+			        Memr[y], npts, key, fd1, fd2, xg, yg, sg,
+				lg, pg, ng)
+			    break
+			default:
+		    	    call printf (
+				"Set cursor and type a, b, c, l, r, or k:")
+			}
+		    } until (clgcur ("cursor", wx, wy, wc, key, Memc[cmd],
+			SZ_FNAME) == EOF)
+		    newimage = NO
+
+		case 'o': # Set overplot
+		    overplot = YES
+
+	        case 'g', '#', '%', '(', ')': # Get new image to plot
+		    i = nline
+		    j = nband
+
+		    switch (key) {
+		    case '(':
+			if (IM_LEN(im,2) > 1) {
+			    nline = max (1, min (IM_LEN(im,2), nline-1))
+			    nap = INDEFI
+			} else if (IM_LEN(im,3) > 1) {
+			    nband = max (1, min (IM_LEN(im,3), nband-1))
+			}
+		    case ')':
+			if (IM_LEN(im,2) > 1) {
+			    nline = max (1, min (IM_LEN(im,2), nline+1))
+			    nap = INDEFI
+			} else if (IM_LEN(im,3) > 1) {
+			    nband = max (1, min (IM_LEN(im,3), nband+1))
+			}
+		    case '#':
+			nline = 0
+		    case '%':
+			nband = 0
+		    default:
+			call clgstr ("next_image", Memc[cmd], SZ_FNAME)
+			if (streq (Memc[image], Memc[cmd])) {
+			    call shdr_close (sh)
+			} else if (imaccess (Memc[cmd], READ_ONLY) == YES) {
+			    call shdr_close (sh)
+			    call smw_close (mw)
+			    call imunmap (im)
+			    newimage = YES
+			} else {
+			    call eprintf ("Can't get %s\n")
+				call pargstr (Memc[cmd])
+			    next
+			}
+			call strcpy (Memc[cmd], Memc[image], SZ_FNAME)
+			nline = 0
+			nband = 0
+		    }
+
+		    call getimage (Memc[image], nline, nband, nap, wave_scl,
+			w0, wpc, Memc[units], im, mw, sh, gt)
+		    x = SX(sh)
+		    y = SY(sh)
+		    npts = SN(sh)
+
+		    if (options[WRESET] == YES && overplot == NO) {
+			call gt_setr (gt, GTXMIN, clgetr ("xmin"))
+			call gt_setr (gt, GTXMAX, clgetr ("xmax"))
+			call gt_setr (gt, GTYMIN, clgetr ("ymin"))
+			call gt_setr (gt, GTYMAX, clgetr ("ymax"))
+			if (options[ZERO] == YES)
+			    call gt_setr (gt, GTYMIN, 0.)
+		    }
+			
+		    if (nline != i || nband != j)
+			newimage = YES
+		    newgraph = YES
+
+	        case 'w': # Window the graph
+		    call gt_window (gt, gp, "cursor", newgraph)
+		    if (newgraph == YES) {
+			newgraph = options[AUTO]
+			overplot = NO
+		    }
+		
+	        case 'l': # Convert to f-lambda - issue warning if not a
+			  # calibrated image
+		    if (FC(sh) == FCNO)
+		        call eprintf (
+			    "Warning: (>flam) spectrum not calibrated\n")
+
+		    call conflam (sh)
+		    call gt_setr (gt, GTYMIN, INDEF)
+		    call gt_setr (gt, GTYMAX, INDEF)
+		    if (options[ZERO] == YES)
+			call gt_setr (gt, GTYMIN, 0.)
+		    newgraph = options[AUTO]
+		    overplot = NO
+
+	        case 'f': # Function operators
+		    call fun_help ()
+		    while (clgcur ("cursor", wx, wy, wc, key, Memc[cmd], 
+		        SZ_FNAME) != EOF) {
+			switch (key) {
+			case '?':
+			    call fun_help ()
+			case 'q':
+			    break
+			case 'I':
+			    call fatal (0, "Interrupt")
+			default:
+			    iferr {
+		                call fun_do (key, sh, Memr[y], npts, w0, wpc)
+				call gt_setr (gt, GTYMIN, INDEF)
+				call gt_setr (gt, GTYMAX, INDEF)
+				if (options[ZERO] == YES)
+				    call gt_setr (gt, GTYMIN, 0.)
+		                if (options[AUTO] == YES)
+			            call replot (gp, gt, Memr[x], Memr[y],
+					npts, YES)
+				overplot = NO
+		                call fun_help ()
+			    } then {
+			        call erract (EA_WARN)
+				call tsleep (2)
+				call fun_help ()
+			    }
+			}
+		    }
+		    call printf ("\n")
+
+	        case 'm': # Signal-to-noise
+		    call ans_hdr (sh, newimage, key, Memc[save1], Memc[save2],
+			fd1, fd2)
+		    call avgsnr (sh, wx, wy, Memr[y], npts, fd1, fd2)
+		    newimage = NO
+
+	        case 'n': # Convert to f-nu
+		    if (FC(sh) == FCNO)
+		        call eprintf (
+			    "Warning: (>fnu) spectrum not calibrated\n")
+
+		    call confnu (sh)
+		    call gt_setr (gt, GTYMIN, INDEF)
+		    call gt_setr (gt, GTYMAX, INDEF)
+		    if (options[ZERO] == YES)
+			call gt_setr (gt, GTYMIN, 0.)
+		    newgraph = options[AUTO]
+		    overplot = NO
+
+		case 'q':
+		    if (options[WRESET] == YES) {
+			call gt_setr (gt, GTXMIN, clgetr ("xmin"))
+			call gt_setr (gt, GTXMAX, clgetr ("xmax"))
+			call gt_setr (gt, GTYMIN, clgetr ("ymin"))
+			call gt_setr (gt, GTYMAX, clgetr ("ymax"))
+			if (options[ZERO] == YES)
+			    call gt_setr (gt, GTYMIN, 0.)
+		    }
+			
+		    if (nline != i || nband != j)
+			newimage = YES
+		    newgraph = YES
+		    break
+
+	        case 'r': # Replot
+		    newgraph = YES
+		    overplot = NO
+
+	        case 's': # Smooth
+		    call smooth (Memr[y], npts)
+		    newgraph = options[AUTO]
+
+	        case 't': # FlaTTen spectrum
+		    call flatten (gp, gt, Memr[x], Memr[y], npts)
+		    call gt_setr (gt, GTYMIN, INDEF)
+		    call gt_setr (gt, GTYMAX, INDEF)
+		    if (options[ZERO] == YES)
+			call gt_setr (gt, GTYMIN, 0.)
+		    newgraph = options[AUTO]
+		    overplot = NO
+
+	        case 'p', 'u': # Set user coordinates
+		    if (!wave_scl) {
+			call shdr_system (sh, "world")
+			wave_scl = true
+			call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+			call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+		    }
+		    switch (key) {
+		    case 'p':
+			keyu = 'l'
+			w1 = Memr[x]
+			u1 = clgetd ("wstart")
+			w2 = Memr[x+npts-1]
+			u2 = clgetd ("wend")
+			if (IS_INDEFD(u1)) {
+			    u1 = clgetd ("dw")
+			    u1 = u2 - (npts - 1) * u1
+			} else if (IS_INDEFD(u2)) {
+			    u2 = clgetd ("dw")
+			    u2 = u1 + (npts - 1) * u2
+			}
+		    case 'u':
+			call printf (
+	"Set cursor and select correction: d(oppler), z(eropoint), l(inear)\n")
+			call flush (STDOUT)
+			i = clgcur ("cursor", wx, wy, wc, keyu, Memc[cmd],
+			    SZ_FNAME)
+			w1 = wx
+			u1 = clgetd ("wavelength")
+			if (keyu == 'l') {
+			    repeat {
+				call printf ("Set cursor to second position:")
+				call flush (STDOUT)
+				i = clgcur ("cursor", wx, wy, wc, key,
+				    Memc[cmd], SZ_FNAME)
+				w2 = wx
+				if (!fp_equald (w1, w2)) {
+				    u2 = clgetd ("wavelength")
+				    break
+				}
+				call printf ("Cursor not moved: ")
+			    }
+			}
+		    }
+		    call usercoord (sh, keyu, w1, u1, w2, u2)
+		    w0 = Memr[x]
+		    wpc = Memr[x+1] - w0
+		    call gt_setr (gt, GTXMIN, INDEF)
+		    call gt_setr (gt, GTXMAX, INDEF)
+		    call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+		    call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+		    newgraph = options[AUTO]
+		    overplot = NO
+
+	        case 'i': # Write image spectrum out
+		    call sp_wrspect (sh)
+		    im = IM(sh)
+		    mw = MW(sh)
+
+	        case 'j': # Fudge (fix) a data point
+		    call fudgept (sh, gp, Memr[x], Memr[y], npts, wx, wy)
+
+	        case 'x': # Fudge eXtended over a line
+		    call fudgex (sh, gp, Memr[x], Memr[y], npts, wx, wy,
+			options[XYDRAW])
+
+	        case 'y': # Over plot standard star data
+		    # Estimate data is fnu or flambda: cutoff around dexp[-20]
+		    fnu = false
+		    call aavgr (Memr[y], npts, avg_pix, sigma_pix)
+		    if (log10 (avg_pix) < -19.5)
+		        fnu = true
+		    call plot_std (sh, gp, fnu)
+		    call printf ("\n")
+
+	        case 'z': # Zoom x region to larger range
+		    call auto_exp (gp, gt, key, wx, Memr[x], Memr[y], npts)
+
+	        case '-': # Subtract deblended fit
+		    call subblend (sh, gp, Memr[x], Memr[y], npts, wx, wy,
+			xg, yg, sg, lg, pg, ng)
+
+	        case '.': # Slide upward
+		    call auto_exp (gp, gt, key, wx, Memr[x], Memr[y], npts)
+
+	        case ',': # Slide downward
+		    call auto_exp (gp, gt, key, wx, Memr[x], Memr[y], npts)
+
+	        case '$': # Toggle wavelength scale
+		    if (wave_scl) {
+			call shdr_system (sh, "physical")
+			wave_scl = false
+			call gt_sets (gt, GTXLABEL, "Pixel")
+			call gt_sets (gt, GTXUNITS, "")
+		    } else {
+			call shdr_system (sh, "world")
+			wave_scl = true
+			call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+			call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+		    }
+		    call gt_setr (gt, GTXMIN, INDEF)
+		    call gt_setr (gt, GTXMAX, INDEF)
+		    call gt_setr (gt, GTYMIN, INDEF)
+		    call gt_setr (gt, GTYMAX, INDEF)
+		    if (options[ZERO] == YES)
+			call gt_setr (gt, GTYMIN, 0.)
+		    newgraph = options[AUTO]
+		    overplot = NO
+
+	        case '/': # Help on status line
+		    call sts_help (hline, hlines, HELP, hptr)
+		    hline = mod (hline, hlines) + 1
+
+	        case '?': # Help screen
+		    call gpagefile (gp, KEY, PROMPT)
+
+		case 'I': # Interrupt
+		    call fatal (0, "Interrupt")
+
+	        default: # Default - print cursor info
+		    i = max (1, min (npts, nint (shdr_wl (sh, double(wx)))))
+		    call printf ("x,y,z(x): %10.3f %10.4g %10.4g\n")
+		        call pargr (wx)
+		        call pargr (wy)
+		        call pargr (Memr[y+i-1])
+	        }
+
+	        if (newgraph == YES) {
+		    if (overplot == YES) {
+		        call printf ("Overplotting: %s")
+			    call pargstr (Memc[image])
+			if (nline > 0) {
+			    if (nband > 0) {
+				call printf ("(%d,%d)")
+				    call pargi (nline)
+				    call pargi (nband)
+			    } else {
+				call printf ("(%d)")
+				    call pargi (nline)
+			    }
+			}
+		        call flush (STDOUT)
+			i = gt_geti (gt, GTLINE)
+			j = gt_geti (gt, GTCOLOR)
+			if (options[OVERPLOT] == NO) {
+			    call gt_seti (gt, GTLINE, i+1)
+			    call gt_seti (gt, GTCOLOR, j+1)
+			}
+			call replot (gp, gt, Memr[x], Memr[y], npts, NO)
+			call gt_seti (gt, GTLINE, i)
+			call gt_seti (gt, GTCOLOR, j)
+		    } else
+			call replot (gp, gt, Memr[x], Memr[y], npts, YES)
+		    newgraph = NO
+		    overplot = options[OVERPLOT]
+	        }
+	    } until (clgcur ("cursor",wx,wy,wc,key,Memc[cmd],SZ_FNAME) == EOF)
+	    if (im != ERR) {
+		call shdr_close (sh)
+		call smw_close (mw)
+	        call imunmap (im)
+	    }
+	}
+
+	call gclose (gp)
+	if (fd1 != NULL)
+	    call close (fd1)
+	if (fd2 != NULL) {
+	    call close (fd2)
+	    call delete (Memc[save2])
+	}
+	if (hptr != NULL)
+	    call mfree (hptr, TY_CHAR)
+	if (ng > 0) {
+	    call mfree (xg, TY_REAL)
+	    call mfree (yg, TY_REAL)
+	    call mfree (sg, TY_REAL)
+	    call mfree (lg, TY_REAL)
+	    call mfree (pg, TY_INT)
+	}
+	call smw_daxis (NULL, NULL, 0, 0, 0)
+	call gt_free (gt)
+	call imtclose (list)
+end
diff --git a/noao/onedspec/splot/splotcolon.x b/noao/onedspec/splot/splotcolon.x
new file mode 100644
index 00000000..e68bbecc
--- /dev/null
+++ b/noao/onedspec/splot/splotcolon.x
@@ -0,0 +1,263 @@
+include	<error.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	<ctype.h>
+
+# List of colon commands.
+define	CMDS		 "|show|nolog|log|dispaxis|nsum|#|units|auto|zero\
+			  |xydraw|histogram|nosysid|wreset|flip|overplot\
+			  |label|mabove|mbelow|"
+define	SHOW		1	# Show logged data
+define	NOLOG		2	# Turn off logging
+define	LOG		3	# Turn on logging
+define	DA		4	# Dispersion axis
+define	NS		5	# Summing parameter
+define	COMMENT		6	# Comment
+define	UNITS		7	# Units
+define	AUTO		8	# Option auto graph
+define	ZERO		9	# Option for zero y minimum
+define	XYDRAW		10	# Draw connection X,Y pairs
+define	HIST		11	# Draw histogram style lines
+define	NOSYSID		12	# Don't include system id
+define	WRESET		13	# Reset window for each new spectrum
+define	FLIP		14	# Flip the dispersion coordinates
+define	OVERPLOT	15	# Toggle overplot
+define	LABEL		16	# Label spectrum
+define	MABOVE		17	# Tick mark plus label above spectrum
+define	MBELOW		18	# Tick mark plus label below spectrum
+
+define	OPOFF		7	# Offset in options array
+
+# SPLOT_COLON -- Respond to colon command.
+
+procedure splot_colon (command, options, gp, gt, sh, x, y, units,
+	fname1, fname2, fd1, fd2, newgraph)
+
+char	command[ARB]		# Colon command
+int	options[ARB]		# Options
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+pointer	sh			# SHIO pointer
+real	x, y			# Coordinate
+char	units[SZ_FNAME]		# Units string
+char	fname1[SZ_FNAME]	# Log file
+char	fname2[SZ_FNAME]	# Temporary log file
+int	fd1, fd2		# Log file descriptors
+int	newgraph		# New graph?
+
+bool	bval
+char	cmd[SZ_LINE]
+real	xval, gt_getr()
+int	ncmd, ival, access(), nscan(), strdic(), btoi(), gt_geti()
+pointer	sp, str, smw
+errchk	un_changer
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Scan the command string and get the first word.
+	call sscan (command)
+	call gargwrd (cmd, SZ_LINE)
+	ncmd = strdic (cmd, cmd, SZ_LINE, CMDS)
+
+	smw = MW(sh)
+
+	switch (ncmd) {
+	case SHOW:
+	    if (fd2 != NULL) {
+		call close (fd2)
+		fd2 = NULL
+	    }
+	    if (access (fname2, 0, 0) == YES)
+		call gpagefile (gp, fname2, "splot data")
+	    else
+		call printf ("No measurements\n")
+	case NOLOG:
+	    call printf ("Logging to %s disabled")
+		call pargstr (fname1)
+	    fname1[1] = EOS
+	    if (fd1 != NULL) {
+		call close (fd1) 
+		fd1 = NULL
+	    }
+	case LOG:
+	    call clgstr ("save_file", fname1, SZ_FNAME)
+	    call printf ("Logging to %s enabled")
+		call pargstr (fname1)
+	case DA:
+	    if (SMW_FORMAT(smw) == SMW_ND) {
+		call gargi (ival)
+		if (nscan() == 2) {
+		    if (ival < 1) {
+			call printf ("Bad value for dispaxis (%d)\n")
+			    call pargi (ival)
+		    } else if (ival != SMW_PAXIS(smw,1)) {
+			call smw_daxis (smw, IM(sh), ival, INDEFI, INDEFI)
+			call smw_saxes (smw, NULL, IM(sh))
+			call shdr_close (sh)
+		    }
+		} else {
+		    call printf ("dispaxis %d\n")
+			call pargi (SMW_PAXIS(smw,1))
+		}
+	    } else
+		call printf ("Image is not two dimensional\n")
+	case NS:
+	    if (SMW_FORMAT(smw) == SMW_ND) {
+		call gargi (ival)
+		call gargi (ncmd)
+		if (nscan() == 1) {
+		    call printf ("nsum %d %d\n")
+			call pargi (SMW_NSUM(smw,1))
+			call pargi (SMW_NSUM(smw,2))
+		} else {
+		    if (nscan() == 2)
+			ncmd = INDEFI
+		    if ((!IS_INDEFI(ival) && ival != SMW_NSUM(smw,1)) ||
+			(!IS_INDEFI(ncmd) && ncmd != SMW_NSUM(smw,2))) {
+			call smw_daxis (smw, IM(sh), INDEFI, ival, ncmd)
+			call smw_saxes (smw, NULL, IM(sh))
+			call shdr_close (sh)
+		    }
+		}
+	    } else
+		call printf ("Invalid image format\n")
+	case COMMENT:
+	    call ans_hdr (sh, NO, 'm', fname1, fname2, fd1, fd2)
+	    call gargstr (cmd, SZ_LINE)
+	    if (fd1 != NULL) {
+		call fprintf (fd1, "%s\n")
+		    call pargstr (command)
+	    }
+	    if (fd2 != NULL) {
+		call fprintf (fd2, "%s\n")
+		    call pargstr (command)
+	    }
+	case UNITS:
+	    call gargstr (cmd, SZ_LINE)
+	    for (ival=1; IS_WHITE(cmd[ival]); ival=ival+1)
+		;
+	    iferr {
+		xval = gt_getr (gt, GTXMIN)
+		if (!IS_INDEF(xval)) {
+		    call un_changer (UN(sh), cmd[ival], xval, 1, NO)
+		    call gt_setr (gt, GTXMIN, xval)
+		}
+		xval = gt_getr (gt, GTXMAX)
+		if (!IS_INDEF(xval)) {
+		    call un_changer (UN(sh), cmd[ival], xval, 1, NO)
+		    call gt_setr (gt, GTXMAX, xval)
+		}
+		call un_changer (UN(sh), cmd[ival], Memr[SX(sh)], SN(sh), YES)
+		call strcpy (cmd[ival], units, SZ_FNAME)
+		call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+		call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+		newgraph = YES
+	    } then
+		call erract (EA_WARN)
+	case AUTO:
+	    call gargb (bval)
+	    if (nscan() == 2)
+		options[AUTO-OPOFF] = btoi (bval)
+	    else {
+		call printf ("auto %b\n")
+		    call pargi (options[AUTO-OPOFF])
+	    }
+	case ZERO:
+	    call gargb (bval)
+	    if (nscan() == 2) {
+		options[ZERO-OPOFF] = btoi (bval)
+		if (bval)
+		    call gt_setr (gt, GTYMIN, 0.)
+		newgraph = options[AUTO-OPOFF]
+	    } else {
+		call printf ("zero %b\n")
+		    call pargi (options[ZERO-OPOFF])
+	    }
+	case XYDRAW:
+	    call gargb (bval)
+	    if (nscan() == 2)
+		options[XYDRAW-OPOFF] = btoi (bval)
+	    else {
+		call printf ("xydraw %b\n")
+		    call pargi (options[XYDRAW-OPOFF])
+	    }
+	case HIST:
+	    call gargb (bval)
+	    if (nscan() == 2) {
+		options[HIST-OPOFF] = btoi (bval)
+		if (bval)
+		    call gt_sets (gt, GTTYPE, "histogram")
+		else
+		    call gt_sets (gt, GTTYPE, "line")
+		newgraph = options[AUTO-OPOFF]
+	    } else {
+		call printf ("hist %b\n")
+		    call pargi (options[HIST-OPOFF])
+	    }
+	case NOSYSID:
+	    call gargb (bval)
+	    if (nscan() == 2) {
+		options[NOSYSID-OPOFF] = btoi (bval)
+		if (bval)
+		    call gt_seti (gt, GTSYSID, NO)
+		else
+		    call gt_seti (gt, GTSYSID, YES)
+		newgraph = options[AUTO-OPOFF]
+	    } else {
+		call printf ("nosysid %b\n")
+		    call pargi (options[NOSYSID-OPOFF])
+	    }
+	case WRESET:
+	    call gargb (bval)
+	    if (nscan() == 2)
+		options[WRESET-OPOFF] = btoi (bval)
+	    else {
+		call printf ("wreset %b\n")
+		    call pargi (options[WRESET-OPOFF])
+	    }
+	case FLIP:
+	    call gargb (bval)
+	    if (nscan() == 2) {
+		options[FLIP-OPOFF] = btoi (bval)
+		call gt_seti (gt, GTXFLIP, options[FLIP-OPOFF])
+	    } else {
+		options[FLIP-OPOFF] = gt_geti (gt, GTXFLIP)
+		call printf ("flip %b\n")
+		    call pargi (options[FLIP-OPOFF])
+	    }
+	case OVERPLOT:
+	    call gargb (bval)
+	    if (nscan() == 2) {
+		options[OVERPLOT-OPOFF] = btoi (bval)
+	    } else {
+		call printf ("overplot %b\n")
+		    call pargi (options[OVERPLOT-OPOFF])
+	    }
+	case LABEL, MABOVE, MBELOW:
+	    call gargwrd (cmd, SZ_LINE)
+	    for (ival=1; IS_WHITE(cmd[ival]); ival=ival+1)
+		;
+	    call strcpy (cmd[ival], cmd, SZ_LINE)
+	    call gargwrd (Memc[str], SZ_LINE)
+	    for (ival=1; IS_WHITE(Memc[str+ival-1]); ival=ival+1)
+		;
+	    call strcpy (Memc[str+ival-1], Memc[str], SZ_LINE)
+
+	    switch (ncmd) {
+	    case LABEL:
+		call splabel ("label", sh, gp, x, y, cmd, Memc[str])
+	    case MABOVE:
+		call splabel ("mabove", sh, gp, x, y, cmd, Memc[str])
+	    case MBELOW:
+		call splabel ("mbelow", sh, gp, x, y, cmd, Memc[str])
+	    }
+
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/splot/splotfun.x b/noao/onedspec/splot/splotfun.x
new file mode 100644
index 00000000..4c94350f
--- /dev/null
+++ b/noao/onedspec/splot/splotfun.x
@@ -0,0 +1,127 @@
+include <error.h>
+include	<mach.h>
+include	<smw.h>
+
+# Function Mode for STEK
+
+# FUN_DO -- Branch and execute proper function
+
+procedure fun_do (key, sh1, y, n, w0, wpc)
+
+int	key
+pointer	sh1
+real	y[n]
+int	n
+double	w0, wpc
+
+char	spec2[SZ_FNAME]
+int	i, nline, nband, nap, strlen()
+real	const, clgetr()
+pointer	im, mw, sh2
+bool	wave_scl
+errchk	getimage, shdr_rebin
+
+begin
+	switch (key) {
+	case 'a': # Absolute value
+	    do i = 1, n
+		y[i] = abs (y[i])
+	case 'd': # Dexp (base 10)
+	    const = log10 (MAX_REAL)
+	    do i = 1, n
+		if (abs (y[i]) < const)
+		    y[i] = 10.0 ** y[i]
+		else if (y[i] >= const)
+		    y[i] = MAX_REAL
+		else
+		    y[i] = 0.0
+	case 'e': # Exp base e
+	    const = log (MAX_REAL)
+	    do i = 1, n
+		if (abs (y[i]) < const)
+		    y[i] = exp (y[i])
+		else if (y[i] >= const)
+		    y[i] = MAX_REAL
+		else
+		    y[i] = 0.0
+	case 'i': # Inverse
+	    do i = 1, n
+		if (y[i] != 0.0)
+		    y[i] = 1.0/y[i]
+		else
+		    y[i] = 0.0
+	case 'l': # Log10
+	    do i = 1, n
+		if (y[i] > 0.0)
+		    y[i] = log10 (y[i])
+		else
+		    y[i] = -0.5
+	case 'm': # Multiply by constant
+	    const = clgetr ("constant")
+	    call amulkr (y, const, y, n)
+	case 'n': # Log base e
+	    do i = 1, n
+		if (y[i] > 0.0)
+		    y[i] = log (y[i])
+		else
+		    y[i] = -0.5
+	case 'p': # Add constant
+	    const = clgetr ("constant")
+	    call aaddkr (y, const, y, n)
+	case 's': # Square root
+	    do i = 1, n
+		if (y[i] >= 0.0)
+		    y[i] = sqrt (y[i])
+		else
+		    y[i] = 0.0
+
+	case '+', '-', '*', '/': # Binary operations
+	    call printf ("Second spectrum ")
+	    call clgstr ("spec2", spec2, SZ_FNAME)
+	    if (strlen (spec2) == 0)
+		return
+
+	    wave_scl = true
+	    nline = 0
+	    nband = 0
+	    nap = 0
+	    im = NULL
+	    mw = NULL
+	    sh2 = NULL
+	    call getimage (spec2, nline, nband, nap, wave_scl, w0, wpc,
+		"angstroms", im, mw, sh2, NULL)
+	    call shdr_rebin (sh2, sh1)
+	    switch (key) {
+	    case '+':
+		call aaddr (y, Memr[SY(sh2)], y, n)
+	    case '-':
+		call asubr (y, Memr[SY(sh2)], y, n)
+	    case '*':
+		call amulr (y, Memr[SY(sh2)], y, n)
+	    case '/':
+		do i = 1, n
+		    if (Memr[SY(sh2)+i-1] == 0.0)
+			y[i] = 0.0
+		else
+		    y[i] = y[i] / Memr[SY(sh2)+i-1]
+	    }
+	    call shdr_close (sh2)
+	    call smw_close (mw)
+	    call imunmap (im)
+
+	# Redraw
+	case 'r':
+	    ;
+	default:
+	    call error (0, "Unknown function")
+	}
+end
+
+# FUN_HELP
+
+procedure fun_help ()
+
+begin
+	call printf ("q=quit l,n=log10,e d,e=d,exp s=sqrt a=abs i=1/s")
+	call printf (" p=+k m=*k  +,-,*,/=2spec ops\n")
+end
diff --git a/noao/onedspec/splot/stshelp.key b/noao/onedspec/splot/stshelp.key
new file mode 100644
index 00000000..fe351182
--- /dev/null
+++ b/noao/onedspec/splot/stshelp.key
@@ -0,0 +1,7 @@
+a=expand   b=zero base   ,=left   .=right   w=window   z=zoom
+c=redraw full scale   o=overplot   r=redraw current scale
+d=deblend   e=eq. width   f=functions   h=1 sided eqw   i=write sp   j=fix pix
+k=gauss fit   l=flambda   m=mean/snr   n=fnu   p=>wavelth   q=quit   s=smooth
+t=curfit   u=set wave   v=velocity scale   x=fix line   y=plot std
+/=status help   ?=help   -=subtr fit   $=wavelength/pixel
+g=new spectrum   #=aperture   %=band   (=previous   )=next
diff --git a/noao/onedspec/splot/stshelp.x b/noao/onedspec/splot/stshelp.x
new file mode 100644
index 00000000..f34de38a
--- /dev/null
+++ b/noao/onedspec/splot/stshelp.x
@@ -0,0 +1,34 @@
+include	<error.h>
+
+
+# STS_HELP -- Issue a help line
+
+procedure sts_help (line, nlines, fname, ptr)
+
+int	line		# Line to print
+int	nlines		# Number of lines of help
+char	fname[ARB]	# Help file
+pointer	ptr		# Cache help
+
+int	fd, open(), getline()
+
+begin
+	if (ptr == NULL) {
+	    iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) {
+		call erract (EA_WARN)
+		return
+	    }
+	    nlines = 0
+	    call malloc (ptr, SZ_LINE, TY_CHAR)
+	    while (getline (fd, Memc[ptr+nlines*SZ_LINE]) != EOF) {
+		nlines = nlines + 1
+		call realloc (ptr, (nlines+1)*SZ_LINE, TY_CHAR)
+	    }
+	    call close (fd)
+	}
+
+	if (line >= 1  && line <= nlines) {
+	    call putline (STDOUT, Memc[ptr+(line-1)*SZ_LINE])
+	    call flush (STDOUT)
+	}
+end
diff --git a/noao/onedspec/splot/sumflux.x b/noao/onedspec/splot/sumflux.x
new file mode 100644
index 00000000..36f6ca3b
--- /dev/null
+++ b/noao/onedspec/splot/sumflux.x
@@ -0,0 +1,165 @@
+# SUMFLUX -- Sum up the flux in a specified bandpass
+
+procedure sumflux (sh, x, y, s, n, eqx1, eqx2, eqy1, eqy2,
+	sum, rsum, esum, ctr)
+
+pointer	sh
+real	x[n], y[n], s[n]
+int	n
+real	eqx1, eqx2, eqy1, eqy2
+real	sum[2], rsum[2], esum[2], ctr[2]
+
+real	slope, csum[2], sum2[2], rampval, scale, delta, wpc
+real	w1, w2
+int	i, i1, i2
+bool	fp_equalr()
+
+begin
+	call fixx (sh, eqx1, eqx2, eqy1, eqy2, i1, i2)
+	slope = (eqy2-eqy1) / (eqx2-eqx1)
+
+	sum[1]  = 0.0
+	rsum[1] = 0.0
+	esum[1] = 0.0
+	csum[1] = 0.0
+	sum2[1] = 0.0
+	scale = 0.0
+
+	for (i=i1+1; i <= i2-1; i = i+1)
+	    scale = max (scale, y[i])
+	if (scale <= 0.)
+	    scale = 1.
+
+	for (i=i1+1; i <= i2-1; i = i+1) {
+	    rampval = eqy1 + slope * (x[i] - eqx1)
+	    sum[1] = sum[1] + y[i]
+	    rsum[1] = rsum[1] + rampval
+	    if (!IS_INDEF(esum[1])) {
+		if (fp_equalr (0., rampval/scale))
+		    esum[1] = INDEF
+		else
+	            esum[1] = esum[1] + (1. - y[i] / rampval)
+	    }
+	}
+
+	for (i=i1+1; i <= i2-1; i = i+1) {
+	    rampval = eqy1 + slope * (x[i] - eqx1)
+	    delta = (y[i] - rampval) / scale
+	    csum[1] = csum[1] + abs(delta)**1.5 * x[i]
+	    sum2[1] = sum2[1] + abs(delta)**1.5
+	}
+
+	# end points
+	if (eqx1 < x[i1]) {
+	    if (i1 > 1)
+		w1 = (x[i1] - eqx1) / (x[i1] - x[i1-1])
+	    else
+		w1 = (x[i1] - eqx1) / (x[i1+1] - x[i1])
+	} else {
+	    if (i1 < n)
+		w1 = (x[i1] - eqx1) / (x[i1+1] - x[i1])
+	    else
+		w1 = (x[i1] - eqx1) / (x[i1] - x[i1-1])
+	}
+	if (eqx2 < x[i2]) {
+	    if (i2 > 1)
+		w2 = (x[i2] - eqx2) / (x[i2] - x[i2-1])
+	    else
+		w2 = (x[i2] - eqx2) / (x[i2+1] - x[i2])
+	} else {
+	    if (i2 < n)
+		w2 = (x[i2] - eqx2) / (x[i2+1] - x[i2])
+	    else
+		w2 = (x[i2] - eqx2) / (x[i2] - x[i2-1])
+	}
+	w2 = 1.0 - w2
+
+	sum[1] = sum[1] + w1 * y[i1] + w2 * y[i2]
+	rsum[1] = rsum[1] + w1 * eqy1 + w2 * eqy2
+	if (!IS_INDEF(esum[1])) {
+	    if (fp_equalr (0., eqy1/scale)|| fp_equalr (0., eqy2/scale))
+		esum[1] = INDEF
+	    else
+		esum[1] = esum[1] + w1 * (1. - y[i1] / eqy1) +
+		    w2 * (1. - y[i2] / eqy2)
+	}
+
+	delta = (y[i1] - eqy1) / scale
+	csum[1] = csum[1] + w1 * abs(delta)**1.5 * eqx1
+	sum2[1] = sum2[1] + w1 * abs(delta)**1.5
+
+	delta = (y[i2] - eqy2) / scale
+	csum[1] = csum[1] + w2 * abs(delta)**1.5 * eqx2
+	sum2[1] = sum2[1] + w2 * abs(delta)**1.5
+
+	if (sum2[1] != 0.0)
+	    ctr[1] = csum[1] / sum2[1]
+	else
+	    ctr[1] = 0.0
+
+	# Correct for angstroms/channel
+	if (i1 != i2)
+	    wpc = abs ((x[i2] - x[i1]) / (i2 - i1))
+	else if (i1 < n)
+	    wpc = abs (x[i1+1] - x[i1])
+	else
+	    wpc = abs (x[i1-1] - x[i1])
+	sum[1] = sum[1] * wpc
+	if (!IS_INDEF(esum[1]))
+	    esum[1] = esum[1] * wpc
+	rsum[1] = rsum[1] * wpc
+
+	# Errors (Note there are no errors in the ramp values).
+	if (!IS_INDEF(s[1])) {
+	    sum[2]  = 0.0
+	    rsum[2] = 0.0
+	    esum[2] = 0.0
+	    csum[2] = 0.0
+	    sum2[2] = 0.0
+	    for (i=i1+1; i <= i2-1; i = i+1) {
+		rampval = eqy1 + slope * (x[i] - eqx1)
+		sum[2] = sum[2] + s[i]**2
+		if (!IS_INDEF(esum[1])) {
+		    if (fp_equalr (0., rampval/scale))
+			esum[2] = INDEF
+		    else
+			esum[2] = esum[2] + (s[i] / rampval) ** 2
+		}
+	    }
+
+	    for (i=i1+1; i <= i2-1; i = i+1) {
+		rampval = eqy1 + slope * (x[i] - eqx1)
+		delta = (y[i] - rampval) / scale
+		csum[2] = csum[2] + abs(delta)*((x[i]-ctr[1])*s[i]) ** 2
+	    }
+
+	    # endpoints
+	    sum[2] = sum[2] + (w1 * s[i1])**2 + (w2 * s[i2])**2
+	    if (!IS_INDEF(esum[1])) {
+		if (fp_equalr (0., eqy1/scale)|| fp_equalr (0., eqy2/scale))
+		    esum[2] = INDEF
+		else
+		    esum[2] = esum[2] + (w1 * s[i1] / eqy1) ** 2 +
+			(w2 * s[i2] / eqy2) ** 2
+	    }
+
+	    delta = (y[i1] - eqy1) / scale
+	    csum[2] = csum[2] + abs(delta)*(w1*(eqx1-ctr[1])*s[i1]) ** 2
+
+	    delta = (y[i2] - eqy2) / scale
+	    csum[2] = csum[2] + abs(delta)*(w2*(eqx2-ctr[1])*s[i2]) ** 2
+
+	    if (sum2[1] != 0.0)
+		ctr[2] = 1.5 / scale * sqrt (csum[2]) / sum2[1]
+	    else
+		ctr[2] = 0.0
+
+	    sum[2] = sqrt (sum[2])
+	    esum[2] = sqrt (esum[2])
+
+	    # Correct for angstroms/channel
+	    sum[2] = sum[2] * wpc
+	    if (!IS_INDEF(esum[1]))
+		esum[2] = esum[2] * wpc
+	}
+end
diff --git a/noao/onedspec/splot/usercoord.x b/noao/onedspec/splot/usercoord.x
new file mode 100644
index 00000000..2a9b3584
--- /dev/null
+++ b/noao/onedspec/splot/usercoord.x
@@ -0,0 +1,94 @@
+include	<error.h>
+include	<smw.h>
+include <units.h>
+
+# USERCOORD -- Set user coordinates
+
+procedure usercoord (sh, key, w1, u1, w2, u2)
+
+pointer	sh
+int	key
+double	w1, u1, w2, u2
+
+int	i, format, ap, beam, dtype, nw
+double	shift, wa, wb, ua, ub, w0, dw, z, smw_c1trand()
+real	aplow[2], aphigh[2]
+pointer	coeff, smw, mw, ct, smw_sctran()
+errchk	smw_sctran
+
+begin
+	coeff = NULL
+	smw = MW(sh)
+	mw = SMW_MW(smw,0)
+	format = SMW_FORMAT(smw)
+
+	iferr {
+	    call un_ctrand (UN(sh), MWUN(sh), w1, wa, 1)
+	    call un_ctrand (UN(sh), MWUN(sh), u1, ua, 1)
+
+	    call smw_gwattrs (MW(sh), APINDEX(sh), LINDEX(sh,2),
+		ap, beam, dtype, w0, dw, nw, z, aplow, aphigh, coeff)
+
+	    switch (key) {
+	    case 'd':
+		wa = wa * (1 + z)
+		switch (UN_CLASS(MWUN(sh))) {
+		case UN_WAVE:
+		    z = (wa - ua) / ua
+		case UN_FREQ, UN_ENERGY:
+		    z = (ua - wa) / wa
+		default:
+		    call error (1, "Inappropriate coordinate units")
+		}
+	    case 'z':
+		shift = ua - wa
+		w0 = w0 + shift
+		if (dtype == 2)
+		    call sshift1 (shift, coeff)
+	    case 'l':
+		call un_ctrand (UN(sh), MWUN(sh), w2, wb, 1)
+		call un_ctrand (UN(sh), MWUN(sh), u2, ub, 1)
+
+		switch (format) {
+		case SMW_ND:
+		    i = 2 ** (SMW_PAXIS(smw,1) - 1)
+		    ct = smw_sctran (smw, "world", "physical", i)
+		    wa = smw_c1trand (ct, wa)
+		    wb = smw_c1trand (ct, wb)
+		case SMW_ES, SMW_MS:
+		    ct = smw_sctran (smw, "world", "physical", 3)
+		    call smw_c2trand (ct, wa, double (ap), wa, shift)
+		    call smw_c2trand (ct, wb, double (ap), wb, shift)
+		}
+		call smw_ctfree (ct)
+
+		dw = (ub - ua) / (wb - wa)
+		w0 = ua - (wa - 1) * dw
+		dtype = 0
+		if (UNITS(sh) == EOS) {
+		    call mw_swattrs (mw, SMW_PAXIS(smw,1),
+			"label", "Wavelength")
+		    call mw_swattrs (mw, SMW_PAXIS(smw,1),
+			"units", "angstroms")
+		}
+	    default:
+		call error (1, "Unknown correction")
+	    }
+
+	    call smw_swattrs (smw, LINDEX(sh,1), 1, ap, beam, dtype, w0,
+		dw, nw, z, aplow, aphigh, Memc[coeff])
+	    if (smw != MW(sh)) {
+		CTLW1(sh) = NULL
+		CTWL1(sh) = NULL
+		MW(sh) = smw
+	    }
+
+	    DC(sh) = dtype
+	    call shdr_system (sh, "world")
+	    if (UN_CLASS(UN(sh)) == UN_UNKNOWN)
+		call un_copy (MWUN(sh), UN(sh))
+	} then
+	    call erract (EA_WARN)
+
+	call mfree (coeff, TY_CHAR)
+end
diff --git a/noao/onedspec/splot/voigt.x b/noao/onedspec/splot/voigt.x
new file mode 100644
index 00000000..08a44c78
--- /dev/null
+++ b/noao/onedspec/splot/voigt.x
@@ -0,0 +1,71 @@
+# VOIGT -- Compute the real (Voigt function) and imaginary parts of the
+# complex function w(z)=exp(-z**2)*erfc(-i*z) in the upper half-plane
+# z=x+iy.  The maximum relative error of the real part is 2E-6 and the
+# imaginary part is 5E-6.
+#
+# From: Humlicek, J. Quant. Spectrosc. Radiat. Transfer, V21, p309, 1979.
+
+procedure voigt (xarg, yarg, wr, wi)
+
+real	xarg		#I Real part of argument
+real	yarg		#I Imaginary part of argument
+real	wr		#O Real part of function
+real	wi		#O Imaginary part of function
+
+int	i
+real	x, y, y1, y2, y3, d, d1, d2, d3, d4, r, r2
+real	t[6], c[6], s[6]
+
+data	t/.314240376,.947788391,1.59768264,2.27950708,3.02063703,3.8897249/
+data	c/1.01172805,-.75197147,1.2557727e-2,1.00220082e-2,-2.42068135e-4,
+	  5.00848061e-7/
+data	s/1.393237,.231152406,-.155351466,6.21836624e-3,9.19082986e-5,
+	  -6.27525958e-7/
+
+begin
+	x = xarg
+	y = abs (yarg)
+	wr = 0.
+	wi = 0.
+	y1 = y + 1.5
+	y2 = y1 * y1
+
+	# Region II
+	if (y < 0.85 && abs(x) > 18.1*y+1.65) {
+	    if (abs(x) < 12)
+		wr = exp (-x * x)
+	    y3 = y + 3
+	    do i = 1, 6 {
+		r = x - t[i]
+		r2 = r * r
+		d = 1 / (r2 + y2)
+		d1 = y1 * d
+		d2 = r * d
+		wr = wr + y * (c[i] * (r * d2 - 1.5 * d1) + s[i] * y3 * d2) /
+		    (r2 + 2.25)
+		r = x + t[i]
+		r2 = r * r
+		d = 1 / (r2 + y2)
+		d3 = y1 * d
+		d4 = r * d
+		wr = wr + y * (c[i] * (r * d4 - 1.5 * d3) - s[i] * y3 * d4) /
+		    (r2 + 2.25)
+		wi = wi + c[i] * (d2 + d4) + s[i] * (d1 - d3)
+	    }
+
+	# Region I
+	} else {
+	    do i = 1, 6 {
+		r = x - t[i]
+		d = 1 / (r * r + y2)
+		d1 = y1 * d
+		d2 = r * d
+		r = x + t[i]
+		d = 1 / (r * r + y2)
+		d3 = y1 * d
+		d4 = r * d
+		wr = wr + c[i] * (d1 + d3) - s[i] * (d2 - d4)
+		wi = wi + c[i] * (d2 + d4) + s[i] * (d1 - d3)
+	    }
+	}
+end
diff --git a/noao/onedspec/splot/wrspect.x b/noao/onedspec/splot/wrspect.x
new file mode 100644
index 00000000..b744a180
--- /dev/null
+++ b/noao/onedspec/splot/wrspect.x
@@ -0,0 +1,397 @@
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<smw.h>
+include	<units.h>
+
+# SP_WRSPECT -- Write spectrum to the same image or another image.
+
+procedure sp_wrspect (sh1)
+
+pointer	sh1		# Spectrum pointer to be written
+
+bool	overwrite
+pointer	sp, str
+int	nowhite(), errcode()
+bool	clgetb(), xt_imnameeq()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Initially set overwrite to false in order to warn the user.
+	overwrite = false
+
+	# Get new image name.
+	call clgstr ("new_image", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_LINE) == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Check for overwriting the current file.
+	if (xt_imnameeq (IMNAME(sh1), Memc[str])) {
+	    overwrite = clgetb ("overwrite")
+	    if (!overwrite) {
+		call sfree (sp)
+		return
+	    }
+	}
+
+	# Write spectrum.
+	iferr (call wrspect (sh1, Memc[str], overwrite)) {
+	    switch (errcode()) {
+	    case SYS_IKICLOB:
+		call erract (EA_WARN)
+		# Try again if overwrite is requested.
+		if (!overwrite)
+		    overwrite = clgetb ("overwrite")
+		if (overwrite) {
+		    iferr (call wrspect (sh1, Memc[str], overwrite))
+			call erract (EA_WARN)
+		}
+	    default:
+		call erract (EA_WARN)
+	    }
+	}
+	call sfree (sp)
+end
+
+
+# WRSPECT -- Write spectrum to the same image or another image.
+#
+# If overwriting reopen the image READ_WRITE.  If this is not possible it is
+# an error which may be trapped by the calling routine if desired.
+# 
+# If writing to another image determine if the image exists.  If not make a
+# NEW_COPY of the image and copy all spectra and associated data.  NDSPEC
+# format spectra, i.e. 2D or 3D images, are copied to a 1D spectrum.
+# 
+# If the image exists check the overwrite parameter.  If overwriting, open the
+# image READ_WRITE and return an error if this is not possible.  If the
+# output image has only one spectrum delete the image and create a NEW_COPY
+# of the current spectrum image.  Otherwise we will be replacing only the
+# current spectrum so copy all spectra from the current image.
+# 
+# When the input and output images are not the same open the output WCS and
+# select the spectrum of the same aperture to replace.  It is an error if the
+# output spectrum does not contain a spectrum of the same aperture.  It is
+# also an error if the output spectrum is an NDSPEC image.
+
+procedure wrspect (sh1, output, overwrite)
+
+pointer	sh1		# Spectrum pointer to be written
+char	output[ARB]	# Output spectrum filename
+bool	overwrite	# Overwrite existing spectrum?
+
+bool	delim
+char	errstr[SZ_LINE]
+int	i, j, np1, np2, dtype[2], nw[2], err
+real	r[2]
+double	w1[2], dw[2], z[2]
+pointer	coeff, im, in, out, mw1, mw2, sh2, outbuf, ptr
+
+int	imaccf(), errget()
+bool	xt_imnameeq(), fp_equald()
+pointer immap(), smw_openim(), imgl3r(), impl3r(), imps3r()
+errchk	immap,  imgl3r, impl3r, imps3r, imdelf, shdr_open, wrspect1
+errchk	smw_openim, smw_gwattrs, smw_swattrs, smw_saveim
+
+begin
+	in = IM(sh1)
+	mw1 = MW(sh1)
+	out = NULL
+	mw2 = NULL
+	sh2 = NULL
+	ptr = NULL
+	delim = false
+
+	iferr {
+	    # Open and initialize the output image.
+	    if (xt_imnameeq (IMNAME(sh1), output)) {
+		if (!overwrite) {
+		    call sprintf (errstr, SZ_LINE, "No overwrite set (%s)")
+			call pargstr (output)
+		    call error (1, errstr)
+		}
+
+		call imunmap (in)
+		iferr (im = immap (IMNAME(sh1), READ_WRITE, 0)) {
+		    in = immap (IMNAME(sh1), READ_ONLY, 0)
+		    call erract (EA_ERROR)
+		}
+		in = im
+		IM(sh1) = in
+		out = in
+		mw2 = MW(sh1)
+		sh2 = sh1
+
+	    } else {
+		iferr (im = immap (output, NEW_COPY, in)) {
+		    if (!overwrite)
+			call erract (EA_ERROR)
+		    im = immap (output, READ_WRITE, 0); out = im
+
+		    if (IM_LEN(out,2) == 1) {
+			call imunmap (out)
+			call imdelete (output)
+			im = immap (output, NEW_COPY, in); out = im
+			if (IM_PIXTYPE(out) != TY_DOUBLE)
+			    IM_PIXTYPE(out) = TY_REAL
+			do j = 1, IM_LEN(out,3)
+			    do i = 1, IM_LEN(out,2)
+				call amovr (Memr[imgl3r(in,i,j)],
+				    Memr[impl3r(out,i,j)], IM_LEN(out,1))
+		    }
+
+		    im = smw_openim (out); mw2 = im
+		    switch (SMW_FORMAT(mw1)) {
+		    case SMW_ND:
+			if (SMW_FORMAT(mw2) != SMW_ND)
+			    call error (1, "Incompatible spectral formats")
+			if (IM_NDIM(in) != IM_NDIM(out))
+			    call error (2, "Incompatible dimensions")
+			do i = 1, IM_NDIM(in)
+			    if (IM_LEN(in,i) != IM_LEN(out,i))
+				call error (2, "Incompatible dimensions")
+			coeff = NULL
+			call smw_gwattrs (mw1, 1, 1, i, i,
+			    dtype[1], w1[1], dw[1], nw[1], z, r, r, coeff)
+			call smw_gwattrs (mw2, 1, 1, i, i,
+			    dtype[2], w1[2], dw[2], nw[2], z, r, r, coeff)
+			call mfree (coeff, TY_CHAR)
+			if (dtype[1]!=dtype[2] || !fp_equald (w1[1],w1[2]) ||
+			    !fp_equald (dw[1],dw[2]))
+			    call error (3,
+				"Incompatible dispersion coordinates")
+			call shdr_open (out, mw2, APINDEX(sh1), LINDEX(sh1,2),
+			    AP(sh1), SHHDR, ptr)
+			sh2 = ptr
+		    case SMW_ES, SMW_MS:
+			if (SMW_FORMAT(mw2) == SMW_ND)
+			    call error (1, "Incompatible spectral formats")
+			call shdr_open (out, mw2, APINDEX(sh1), LINDEX(sh1,2),
+			    AP(sh1), SHHDR, ptr)
+			sh2 = ptr
+		    }
+
+		} else {
+		    delim = true
+		    out = im
+		    IM_PIXTYPE(out) = TY_REAL
+		    im = smw_openim (out); mw2 = im
+		    call shdr_open (out, mw2, APINDEX(sh1), LINDEX(sh1,2),
+			AP(sh1), SHHDR, ptr)
+		    sh2 = ptr
+
+		    do j = 1, IM_LEN(out,3)
+			do i = 1, IM_LEN(out,2)
+			    call amovr (Memr[imgl3r(in,i,j)],
+				Memr[impl3r(out,i,j)], IM_LEN(out,1))
+		}
+	    }
+
+	    # Check, set, and update the WCS information.  Note that
+	    # wrspect1 may change the smw pointers.
+
+	    call wrspect1 (sh1, sh2)
+	    mw1 = MW(sh1)
+	    mw2 = MW(sh2)
+	    call smw_saveim (mw2, out)
+
+	    # Update spectrum calibration parameters.
+	    if (EC(sh1) == ECYES)
+		call imaddi (out, "EX-FLAG", EC(sh1))
+	    else if (imaccf (out, "EX-FLAG") == YES)
+		call imdelf (out, "EX-FLAG")
+	    if (FC(sh1) == FCYES)
+		call imaddi (out, "CA-FLAG", FC(sh1))
+	    else if (imaccf (out, "CA-FLAG") == YES)
+		call imdelf (out, "CA-FLAG")
+	    if (RC(sh1) != EOS)
+		call imastr (out, "DEREDDEN", RC(sh1))
+	    else if (imaccf (out, "DEREDDEN") == YES)
+		call imdelf (out, "DEREDDEN")
+
+	    # Copy the spectrum.
+	    i =  max (1, LINDEX(sh2,1))
+	    j =  max (1, LINDEX(sh2,2))
+	    np1 = NP1(sh1)
+	    np2 = NP2(sh1)
+	    switch (SMW_FORMAT(mw1)) {
+	    case SMW_ND:
+		switch (SMW_LAXIS(mw1,1)) {
+		case 1:
+		    outbuf = imps3r (out, np1, np2, i, i, j, j)
+		case 2:
+		    outbuf = imps3r (out, i, i, np1, np2, j, j)
+		case 3:
+		    outbuf = imps3r (out, i, i, j, j, np1, np2)
+		}
+		call amovr (Memr[SY(sh1)], Memr[outbuf], SN(sh1))
+	    case SMW_ES, SMW_MS:
+		outbuf = impl3r (out, i, j)
+		call amovr (Memr[SY(sh1)], Memr[outbuf+np1-1], SN(sh1))
+		if (np1 > 1)
+		    call amovkr (Memr[outbuf+np1-1], Memr[outbuf], np1-1)
+		if (np2 < IM_LEN(out,1))
+		    call amovkr (Memr[outbuf+np2-1], Memr[outbuf+np2],
+			IM_LEN(out,1)-np2)
+	    }
+
+	    # Close output image if not the same as the input image.
+	    if (out != in) {
+		call shdr_close (sh2)
+		call smw_close (mw2)
+		call imunmap (out)
+	    }
+	} then {
+	    err = errget (errstr, SZ_LINE)
+	    if (out != in) {
+		if (sh2 != NULL)
+		    call shdr_close (sh2)
+		if (mw2 != NULL)
+		    call smw_close (mw2)
+		if (out != NULL) {
+		    call imunmap (out)
+		    if (delim)
+			iferr (call imdelete (output))
+			    ;
+		}
+	    }
+	    call error (err, errstr)
+	}
+
+end
+
+
+# WRSPECT1 -- Set output WCS attributes.
+# This requires checking compatibility of the WCS with other spectra
+# in the image.
+ 
+procedure wrspect1 (sh1, sh2)
+
+pointer	sh1			# Input
+pointer	sh2			# Output
+
+int	i, j, beam, dtype, nw
+double	w1, wb, dw, z, a, b, p1, p2, p3, shdr_lw()
+real	aplow[2], aphigh[2]
+pointer	in, out, smw1, smw2, mw, smw_sctran()
+pointer	sp, key, str, ltm, ltv, coeff
+bool	fp_equald(), strne()
+errchk	mw_glterm, smw_gwattrs, smw_swattrs, smw_sctran
+
+begin
+	in = IM(sh1)
+	out = IM(sh2)
+	smw1 = MW(sh1)
+	smw2 = MW(sh2)
+	mw = SMW_MW(smw2,0)
+
+	# The output format must not be NDSPEC and there must be a
+	# matching aperture in the output image.
+
+	if (AP(sh2) != AP(sh1) || LINDEX(sh2,1) != LINDEX(sh1,1))
+	    call error (6, "Matching aperture not found in output image")
+
+	call smark (sp)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (ltm, 3*3, TY_DOUBLE)
+	call salloc (ltv, 3, TY_DOUBLE)
+	call malloc (coeff, SZ_LINE, TY_CHAR)
+
+	# Check dispersion function compatibility.
+	# Nonlinear functions can't be copied to a different physical
+	# coordinate system though the linear dispersion can be
+	# adjusted.
+
+	i = SMW_PDIM(smw2)
+	j = SMW_PAXIS(smw2,1)
+	call mw_gltermd (mw, Memd[ltm], Memd[ltv], SMW_PDIM(smw2))
+	a = Memd[ltv+(j-1)]
+	b = Memd[ltm+(i+1)*(j-1)]
+	if (DC(sh1) == DCFUNC) {
+	    i = SMW_PDIM(smw1)
+	    j = SMW_PAXIS(smw1,1)
+	    call mw_gltermd (SMW_MW(smw1,0), Memd[ltm], Memd[ltv], i)
+	    Memd[ltv] = Memd[ltv+(j-1)]
+	    Memd[ltm] = Memd[ltm+(i+1)*(j-1)]
+	   if (!fp_equald (a, Memd[ltv]) || !fp_equald (b ,Memd[ltm])) {
+		call error (7,
+		"Physical basis for nonlinear dispersion functions don't match")
+	    }
+	}
+
+	call smw_gwattrs (smw1, LINDEX(sh1,1), LINDEX(sh1,2),
+	    AP(sh1), beam, dtype, w1, dw, nw, z, aplow, aphigh, coeff)
+
+	w1 = shdr_lw (sh1, 1D0)
+	wb = shdr_lw (sh1, double(SN(sh1)))
+	iferr {
+	    call un_ctrand (UN(sh1), MWUN(sh1), w1, w1, 1)
+	    call un_ctrand (UN(sh1), MWUN(sh1), wb, wb, 1)
+	} then
+	    ;
+
+	p1 = (NP1(sh1) - a) / b
+	p2 = (NP2(sh1) - a) / b
+	p3 = (IM_LEN(out,1) - a) / b
+	nw = nint (min (max (p1 ,p3), max (p1, p2))) + NP1(sh1) - 1
+	if (dtype == DCLOG) {
+	    if (p1 != p2)
+		dw = (log10(wb*(1+z)) - log10(w1*(1+z))) / (p2 - p1)
+	    w1 = log10 (w1*(1+z)) - (p1 - 1) * dw
+	    w1 = 10. ** w1
+	    dw = (w1 * 10D0 ** ((nw-1)*dw) - w1) / (nw - 1)
+	} else {
+	    if (p1 != p2)
+		dw = (wb - w1) / (p2 - p1) * (1 + z)
+	    w1 = w1 * (1 + z) - (p1 - 1) * dw
+	}
+
+	# Note that this may change the smw pointer.
+	call smw_swattrs (smw2, LINDEX(sh2,1), 1, AP(sh2), beam, dtype,
+	    w1, dw, nw, z, aplow, aphigh, Memc[coeff])
+	if (smw2 != MW(sh2)) {
+	    switch (SMW_FORMAT(smw2)) {
+	    case SMW_ND, SMW_ES:
+	        i = 2 ** (SMW_PAXIS(smw2,1) - 1)
+	    case SMW_MS:
+		i = 3B
+	    }
+	    CTLW1(sh2) = smw_sctran (smw2, "logical", "world", i)
+	    CTWL1(sh2) = smw_sctran (smw2, "world", "logical", i)
+	    CTLW(sh2) = CTLW1(sh2)
+	    CTWL(sh2) = CTWL1(sh2)
+	    MW(sh2) = smw2
+	    mw = SMW_MW(smw2,0)
+	}
+
+	# Copy title
+	call smw_sapid (smw2, LINDEX(sh2,1), 1, TITLE(sh1))
+	if (Memc[SID(sh1,1)] != EOS) {
+	    call sprintf (Memc[key], SZ_LINE, "BANDID%d")
+		call pargi (LINDEX(sh1,2))
+	    iferr (call imgstr (out, Memc[key], Memc[str], SZ_LINE))
+		call imastr (out, Memc[key], Memc[SID(sh1,1)])
+	    else {
+		if (strne (Memc[SID(sh1,1)], Memc[str]))
+		    call eprintf (
+			"Warning: Input and output types (BANDID) differ\n")
+	    }
+	}
+
+	# Copy label and units
+	if (UN_LABEL(MWUN(sh1)) != EOS)
+	    call mw_swattrs (mw, 1, "label", UN_LABEL(MWUN(sh1)))
+	if (UN_UNITS(MWUN(sh1)) != EOS)
+	    call mw_swattrs (mw, 1, "units", UN_UNITS(MWUN(sh1)))
+	if (UN_USER(UN(sh1)) != EOF)
+	    call mw_swattrs (mw, 1, "units_display", UN_USER(UN(sh1)))
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/standard.key b/noao/onedspec/standard.key
new file mode 100644
index 00000000..01e0165e
--- /dev/null
+++ b/noao/onedspec/standard.key
@@ -0,0 +1,11 @@
+	STANDARD TASK CURSOR KEY OPTIONS
+
+?  Display help page
+a  Add a new band by marking the endpoints
+d  Delete band nearest the cursor in wavelength
+r  Redraw current plot
+q  Quit with current bandpass definitions
+w  Window plot  (follow with '?' for help)
+I  Interrupt task immediately
+
+:show	Show current bandpass data
diff --git a/noao/onedspec/standard.par b/noao/onedspec/standard.par
new file mode 100644
index 00000000..d83a98d1
--- /dev/null
+++ b/noao/onedspec/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 file
+caldir,s,h,,,,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/onedspec/t_calibrate.x b/noao/onedspec/t_calibrate.x
new file mode 100644
index 00000000..5df62b45
--- /dev/null
+++ b/noao/onedspec/t_calibrate.x
@@ -0,0 +1,437 @@
+include	<error.h>
+include	<imset.h>
+include	<imhdr.h>
+include	<math/iminterp.h>
+include	<smw.h>
+
+define	EXTN_LOOKUP	10	# Interp index for de-extinction
+define	VLIGHT	2.997925e18	# Speed of light, Angstroms/sec
+
+# T_CALIBRATE -- Apply extinction correction and flux calibration to spectra.
+# The sensitivity function derived from the tasks STANDARD and SENSFUNC
+# are applied to the given spectra.  The output may be the same as the
+# input or new spectra may be created.
+#
+# The sensitivity function is contained in an image having its aperture
+# number indicated by the trailing integer of the image filename.
+# An option, "ignoreaps", can be set to override the appending of the
+# aperture number on those cases where no aperture correspondence is
+# appropriate.
+
+procedure t_calibrate ()
+
+pointer	inlist		# Input list
+pointer	outlist		# Output list
+pointer	sens		# Sensitivity image root name
+pointer	ob		# Observatory
+bool	ignoreaps	# Ignore aperture numbers?
+bool	extinct		# Apply extinction correction?
+bool	flux		# Apply flux calibration?
+bool	fnu		# Calibration flux in FNU?
+
+bool	doextinct, doflux, newobs, obshead
+int	i, j, k, l, n, enwaves, nout, ncal
+real	a, latitude, time, ext, fcor, ical, w, dw
+pointer	sp, input, output, temp
+pointer	obs, in, smw, sh, out, ewaves, emags, pcal, cal, asi, x, y, data
+
+int	imtgetim(), imtlen()
+bool	clgetb(), streq()
+real	clgetr(), obsgetr(), asieval()
+double	shdr_lw(), shdr_wl()
+pointer	imtopenp(), immap(), smw_openim(), imgl3r(), impl3r()
+errchk	immap, smw_openim, shdr_open, imgl3r, impl3r
+errchk	obsimopen, get_airm, ext_load, cal_getflux, cal_extn, cal_flux
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (sens, SZ_FNAME, TY_CHAR)
+	call salloc (ob, SZ_FNAME, TY_CHAR)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+
+	# Get task parameters.
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	call clgstr ("records", Memc[temp], SZ_LINE)
+	call odr_openp (inlist, Memc[temp])
+	call odr_openp (outlist, Memc[temp])
+	call clgstr ("sensitivity", Memc[sens], SZ_FNAME)
+	call clgstr ("observatory", Memc[ob], SZ_FNAME)
+	extinct = clgetb ("extinct")
+	flux = clgetb ("flux")
+	fnu = clgetb ("fnu")
+	ignoreaps = clgetb ("ignoreaps")
+
+	if (!extinct && !flux)
+	    call error (0, "No calibration correction specified")
+
+	# Loop over all input images.
+	sh = NULL
+	obs = NULL
+	enwaves = 0
+	ncal = 0
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+
+	    # Set output image.  Use a temporary image when output=input.
+	    if (imtlen (outlist) > 0) {
+		if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+		    break
+	    } else
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    # Map the input image.
+	    iferr (in = immap (Memc[input], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    smw = smw_openim (in)
+
+	    # Check the input image calibration status.
+	    call shdr_open (in, smw, 1, 1, INDEFI, SHHDR, sh)
+	    if (DC(sh) == DCNO) {
+		call eprintf ("WARNING: [%s] has no dispersion function\n")
+		    call pargstr (Memc[input])
+		call smw_close (MW(sh))
+		call imunmap (in)
+		next
+	    }
+	    call shdr_units (sh, "angstroms")
+
+	    doextinct = extinct && (EC(sh) == ECNO)
+	    doflux = flux && (FC(sh) == FCNO)
+	    if (!(doextinct || doflux)) {
+		call eprintf ("WARNING: [%s] is already calibrated\n")
+		    call pargstr (Memc[input])
+		call smw_close  (MW(sh))
+		call imunmap (in)
+		next
+	    }
+
+	    # Map the output image.
+	    if (streq (Memc[input], Memc[output]))
+		call mktemp ("temp", Memc[temp], SZ_LINE)
+	    else
+		call strcpy (Memc[output], Memc[temp], SZ_LINE)
+	    out = immap (Memc[temp], NEW_COPY, in)
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+
+	    # Log the operation.
+	    call printf ("%s: %s\n")
+		call pargstr (Memc[output])
+		call pargstr (IM_TITLE(out))
+	    call flush (STDOUT)
+
+	    # Initialize the extinction correction.
+	    if (doextinct) {
+		EC(sh) = ECYES
+
+		# Load extinction function.
+		if (enwaves == 0) {
+		    call ext_load (ewaves, emags, enwaves)
+		    call intrp0 (EXTN_LOOKUP)
+		}
+
+		# Determine airmass if needed.
+		if (IS_INDEF(AM(sh))) {
+		    call obsimopen (obs, in, Memc[ob], NO, newobs, obshead)
+		    if (newobs)
+			call obslog (obs, "CALIBRATE", "latitude", STDOUT)
+		    latitude = obsgetr (obs, "latitude")
+		    iferr (call get_airm (RA(sh), DEC(sh), HA(sh), ST(sh),
+			latitude, AM(sh))) {
+			call printf ("%s: ")
+			    call pargstr (Memc[input])
+			call flush (STDOUT)
+			AM(sh) = clgetr ("airmass")
+			call imunmap (in)
+			ifnoerr (in = immap (Memc[input], READ_WRITE, 0)) {
+			    IM(sh) = in
+			    call imseti (IM(sh), IM_WHEADER, YES)
+			    call imaddr (IM(sh), "airmass", AM(sh))
+			} else {
+			    in = immap (Memc[input], READ_ONLY, 0)
+			    IM(sh) = in
+			}
+		    }
+		}
+		a = AM(sh)
+	    } else
+		ext = 1.
+
+	    # Initialize the flux correction.
+	    nout = 0
+	    if (doflux) {
+		FC(sh) = FCYES
+
+		if (IS_INDEF (IT(sh)) || IT(sh) <= 0.) {
+		    call printf ("%s: ")
+			call pargstr (Memc[input])
+		    call flush (STDOUT)
+		    IT(sh) = clgetr ("exptime")
+		    call imunmap (in)
+		    ifnoerr (in = immap (Memc[input], READ_WRITE, 0)) {
+			IM(sh) = in
+			call imseti (IM(sh), IM_WHEADER, YES)
+			call imaddr (IM(sh), "exptime", IT(sh))
+			call imaddr (out, "exptime", IT(sh))
+		    } else {
+		        in = immap (Memc[input], READ_ONLY, 0)
+			IM(sh) = in
+		    }
+		}
+		time = IT(sh)
+	    } else
+		fcor = 1.
+
+	    # Calibrate.
+	    do j = 1, IM_LEN(in,3) {
+		do i = 1, IM_LEN(in,2) {
+		    data = impl3r (out, i, j)
+		    switch (SMW_FORMAT(smw)) {
+		    case SMW_ND:
+			if (doflux) {
+			    call cal_getflux (Memc[sens], INDEFI, fnu,
+				pcal, ncal, cal)
+
+			    asi = IM(cal)
+			    n = SN(cal)
+			}
+			y = imgl3r (in, i, j)
+			switch (SMW_LAXIS(smw,1)) {
+			case 1:
+			    do k = 1, IM_LEN(out,1) {
+				w = shdr_lw (sh, double(k))
+				if (doextinct) {
+				    call intrp (EXTN_LOOKUP, Memr[ewaves],
+					Memr[emags], enwaves, w, ext, l)
+				    ext = 10.0 ** (0.4 * a * ext)
+				}
+				if (doflux) {
+				    ical = shdr_wl (cal, double(w))
+				    if (ical < 1. || ical > n) {
+					if (ical < 0.5 || ical > n + 0.5)
+					    nout = nout + 1
+					ical = max (1., min (real(n), ical))
+				    }
+				    dw = abs (shdr_lw (sh, double(k+0.5)) -
+					shdr_lw (sh, double(k-0.5)))
+				    fcor = asieval (asi, ical) / dw / time
+				}
+				Memr[data] = Memr[y] * ext * fcor
+				y = y + 1
+				data = data + 1
+			    }
+			case 2, 3:
+			    if (SMW_LAXIS(smw,1) == 2)
+				k = i
+			    else
+				k = j
+			    w = shdr_lw (sh, double(k))
+			    if (doextinct) {
+				call intrp (EXTN_LOOKUP, Memr[ewaves],
+				    Memr[emags], enwaves, w, ext, l)
+				ext = 10.0 ** (0.4 * a * ext)
+			    }
+			    if (doflux) {
+				ical = shdr_wl (cal, double(w))
+				if (ical < 1. || ical > n) {
+				    if (ical < 0.5 || ical > n + 0.5)
+					nout = nout + 1
+				    ical = max (1., min (real(n), ical))
+				}
+				dw = abs (shdr_lw (sh, double(k+0.5)) -
+				    shdr_lw (sh, double(k-0.5)))
+				fcor = asieval (asi, ical) / dw / time
+			    }
+			    call amulkr (Memr[y], ext * fcor, Memr[data],
+				IM_LEN(out,1))
+			}
+		    case SMW_ES, SMW_MS:
+			call shdr_open (in, smw, i, j, INDEFI, SHDATA, sh)
+			call shdr_units (sh, "angstroms")
+			if (doflux) {
+			    if (ignoreaps)
+				call cal_getflux (Memc[sens], INDEFI, fnu,
+				    pcal, ncal, cal)
+			    else
+				call cal_getflux (Memc[sens], AP(sh), fnu,
+				    pcal, ncal, cal)
+
+			    asi = IM(cal)
+			    n = SN(cal)
+			}
+			x = SX(sh)
+			y = SY(sh)
+			do k = 1, SN(sh) {
+			    w = Memr[x]
+			    if (doextinct) {
+				call intrp (EXTN_LOOKUP, Memr[ewaves],
+				    Memr[emags], enwaves, w, ext, l)
+				ext = 10.0 ** (0.4 * a * ext)
+			    }
+			    if (doflux) {
+				ical = shdr_wl (cal, double(w))
+				if (ical < 1. || ical > n) {
+				    if (ical < 0.5 || ical > n + 0.5)
+					nout = nout + 1
+				    ical = max (1., min (real(n), ical))
+				}
+				dw = abs (shdr_lw (sh, double(k+0.5)) -
+				    shdr_lw (sh, double(k-0.5)))
+				fcor = asieval (asi, ical) / dw / time
+			    }
+			    Memr[data] = Memr[y] * ext * fcor
+			    x = x + 1
+			    y = y + 1
+			    data = data + 1
+			}
+			do k = SN(sh)+1, IM_LEN(out,1) {
+			    Memr[data] = 0
+			    data = data + 1
+			}
+		    }
+		}
+	    }
+
+	    # Log the results.
+	    if (doflux && (IS_INDEF (IT(sh)) || IT(sh) <= 0.)) {
+		call printf (
+		    "  WARNING: No exposure time found.  Using a time of %g.\n")
+		    call pargr (time)
+	    }
+	    if (nout > 0) {
+		call printf (
+		    "  WARNING: %d pixels outside of flux calibration limits\n")
+		    call pargi (nout)
+	    }
+	    if (doextinct)
+		call printf ("  Extinction correction applied\n")
+	    if (doflux)
+		call printf ("  Flux calibration applied\n")
+	    call flush (STDOUT)
+
+	    call imaddr (out, "AIRMASS", AM(sh))
+	    call imaddi (out, "EX-FLAG", EC(sh))
+	    call imaddi (out, "CA-FLAG", FC(sh))
+	    if (doflux) {
+		if (fnu)
+		    call imastr (out, "BUNIT", "erg/cm2/s/Hz")
+		else
+		    call imastr (out, "BUNIT", "erg/cm2/s/A")
+	    }
+
+	    # Close the input and output images.
+	    call smw_close (MW(sh))
+	    call imunmap (in)
+	    call imunmap (out)
+	    if (streq (Memc[input], Memc[output])) {
+		call imdelete (Memc[input])
+		call imrename (Memc[temp], Memc[output])
+	    }
+	}
+
+	# Finish up.
+	if (enwaves > 0) {
+	    call mfree (ewaves, TY_REAL)
+	    call mfree (emags, TY_REAL)
+	}
+	if (ncal > 0) {
+	    do i = 0, ncal-1 {
+		cal = Memi[pcal+i]
+		call asifree (IM(cal))
+		call smw_close (MW(cal))
+		call shdr_close (cal)
+	    }
+	    call mfree (pcal, TY_POINTER)
+	}
+	if (obs != NULL)
+	    call obsclose (obs)
+	call shdr_close (sh)
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call sfree (sp)
+end
+
+
+# CAL_GETFLUX -- Get flux calibration data
+# The sensitivity spectrum is in peculiar magnitudish units of 2.5 log10
+# [counts/sec/A / ergs/cm2/s/A].  This is converted back to reasonable
+# numbers to be multiplied into the data spectra.  An interpolation function
+# is then fit and stored in the image pointer field.  For efficiency the
+# calibration data is saved by aperture so that additional calls simply
+# return the data pointer.
+
+procedure cal_getflux (sens, ap, fnu, pcal, ncal, cal)
+
+char	sens[ARB]		# Sensitivity function image or rootname
+int	ap			# Aperture
+bool	fnu			# Fnu units?
+pointer	pcal			# Pointer to cal data
+int	ncal			# Number of active cal data structures
+pointer	cal			# Calibration data structure
+
+int	i, j, n, clgwrd()
+pointer	sp, fname, im, smw, x, y, immap(), smw_openim()
+errchk	immap, smw_openim, shdr_open, asifit
+
+begin
+	# Check for previously saved calibration
+	for (i=0; i<ncal; i=i+1) {
+	    cal = Memi[pcal+i]
+	    if (AP(cal) == ap)
+		return
+	}
+
+	# Allocate space for a new data pointer, get the calibration data,
+	# and convert to calibration array.
+
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	if (ncal == 0)
+	    call malloc (pcal, 10, TY_POINTER)
+	else if (mod (ncal, 10) == 0)
+	    call realloc (pcal, ncal+10, TY_POINTER)
+
+	if (IS_INDEFI(ap))
+	    call strcpy (sens, Memc[fname], SZ_FNAME)
+	else {
+	    call sprintf (Memc[fname], SZ_FNAME, "%s.%04d")
+		call pargstr (sens)
+		call pargi (ap)
+	}
+
+	im = immap (Memc[fname], READ_ONLY, 0)
+	smw = smw_openim (im)
+	cal = NULL
+	call shdr_open (im, smw, 1, 1, ap, SHDATA, cal)
+	call shdr_units (cal, "angstroms")
+	AP(cal) = ap
+	Memi[pcal+ncal] = cal
+	ncal = ncal + 1
+	call imunmap (im)
+
+	x = SX(cal)
+	y = SY(cal)
+	n = SN(cal)
+	do j = 1, n {
+	    Memr[y] = 10.0 ** (-0.4 * Memr[y])
+	    if (fnu) {
+		Memr[y] = Memr[y] * Memr[x] ** 2 / VLIGHT
+		x = x + 1
+	    }
+	    y = y + 1
+	}
+
+	call asiinit (im, clgwrd ("interp", Memc[fname], SZ_FNAME,II_FUNCTIONS))
+	call asifit (im, Memr[SY(cal)], n)
+	IM(cal) = im
+
+	call mfree (SX(cal), TY_REAL)
+	call mfree (SY(cal), TY_REAL)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_deredden.x b/noao/onedspec/t_deredden.x
new file mode 100644
index 00000000..e68eccbd
--- /dev/null
+++ b/noao/onedspec/t_deredden.x
@@ -0,0 +1,361 @@
+include	<error.h>
+include	<imhdr.h>
+include	<smw.h>
+
+define	DEREDTYPES	"|A(V)|E(B-V)|c|"
+
+
+# T_DEREDDEN -- Apply interstellar extinction correction to spectra.
+# The extinction function is taken from Cardelli, Clayton, and Mathis,
+# ApJ 345:245.  The input parameters are A(V)/E(B-V) and one of A(V),
+# E(B-V), or c.
+
+procedure t_deredden ()
+
+pointer	inlist		# Input list
+pointer	outlist		# Output list
+real	av		# Extinction parameter: A(V), E(B-V), c
+real	rv		# A(V)/E(B-V)
+
+int	i, j, n
+real	w, avold, rvold
+pointer	sp, input, output, temp, log, aps
+pointer	in, out, mw, sh, tmp, inbuf, outbuf
+
+long	clktime()
+real	clgetr()
+double	shdr_lw()
+bool	clgetb(), streq(), rng_elementi()
+int	clgwrd(), imtgetim(), imtlen(), imaccf(), nscan(), strncmp(), ctor()
+pointer	imtopenp(), rng_open(), immap(), smw_openim(), imgl3r(), impl3r()
+errchk	immap, smw_openim, shdr_open, deredden, deredden1
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+	call salloc (log,  SZ_LINE, TY_CHAR)
+
+	call cnvdate (clktime(0), Memc[log], SZ_LINE)
+
+	# Get task parameters.
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	call clgstr ("records", Memc[input], SZ_FNAME)
+	call odr_openp (inlist, Memc[input])
+	call odr_openp (outlist, Memc[input])
+
+	av = clgetr ("value")
+	rv = clgetr ("R")
+
+	# Convert input extinction type to A(V)
+	switch (clgwrd ("type", Memc[input], SZ_FNAME, DEREDTYPES)) {
+	case 1:
+	    call sprintf (Memc[log], SZ_LINE, "%s A(V)=%g R=%g")
+		call pargstr (Memc[log])
+		call pargr (av)
+		call pargr (rv)
+	case 2:
+	    call sprintf (Memc[log], SZ_LINE, "%s E(B-V)=%g A(V)=%g R=%g")
+		call pargstr (Memc[log])
+		call pargr (av)
+		call pargr (rv * av)
+		call pargr (rv)
+	    av = rv * av
+	case  3:
+	    call sprintf (Memc[log], SZ_LINE, "%s c=%g A(V)=%g R=%g")
+		call pargstr (Memc[log])
+		call pargr (av)
+		call pargr (rv * av * (0.61 + 0.024 * av))
+		call pargr (rv)
+	    av = rv * av * (0.61 + 0.024 * av)
+	}
+
+	call clgstr ("apertures", Memc[temp], SZ_LINE)
+	iferr (aps = rng_open (Memc[temp], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture list")
+	if (Memc[temp] != EOS) {
+	    call sprintf (Memc[log], SZ_LINE, "%s ap=%s")
+		call pargstr (Memc[log])
+		call pargstr (Memc[temp])
+	}
+
+	# Loop over all input images.
+	in = NULL
+	out = NULL
+	mw = NULL
+	sh = NULL
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtlen (outlist) > 0) {
+		if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+		    break
+	    } else
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    iferr {
+		# Map the image and check its calibration status.
+		tmp = immap (Memc[input], READ_ONLY, 0); in = tmp
+		tmp = smw_openim (in); mw = tmp
+
+		call shdr_open (in, mw, 1, 1, INDEFI, SHHDR, sh)
+		if (DC(sh) == DCNO) {
+		    call sprintf (Memc[temp], SZ_LINE,
+			"[%s] has no dispersion function")
+			call pargstr (Memc[input])
+		    call error (1, Memc[temp])
+		}
+		call shdr_units (sh, "angstroms")
+
+		rvold = rv
+		avold = 0.
+		if (imaccf (in, "DEREDDEN") == YES) {
+		    if (!clgetb ("override")) {
+			call sprintf (Memc[temp], SZ_LINE,
+			    "[%s] has already been corrected")
+			call pargstr (Memc[input])
+			call error (1, Memc[temp])
+		    } else {
+			if (clgetb ("uncorrect")) {
+			    call imgstr (in, "DEREDDEN", Memc[temp], SZ_LINE)
+			    call sscan (Memc[temp])
+			    for (i=1;; i=i+1) {
+				call gargwrd (Memc[temp], SZ_LINE)
+				if (nscan() < i)
+				    break
+				if (strncmp (Memc[temp], "A(V)=", 5) == 0) {
+				    j = 6
+				    j = ctor (Memc[temp], j, avold)
+				} else if (strncmp (Memc[temp], "R=", 2) == 0) {
+				    j = 3
+				    j = ctor (Memc[temp], j, rvold)
+				}
+			    }
+			}
+		    }
+		}
+
+		# Map the output image.
+		if (streq (Memc[input], Memc[output]))
+		    call mktemp ("temp", Memc[temp], SZ_LINE)
+		else
+		    call strcpy (Memc[output], Memc[temp], SZ_LINE)
+		tmp = immap (Memc[temp], NEW_COPY, in); out = tmp
+		if (IM_PIXTYPE(out) != TY_DOUBLE)
+		    IM_PIXTYPE(out) = TY_REAL
+		call imastr (out, "DEREDDEN", Memc[log])
+
+		# Initialize for NDSPEC data.
+		if (SMW_FORMAT(mw) == SMW_ND) {
+		    if (SX(sh) == NULL)
+			call malloc (SX(sh), SN(sh), TY_REAL)
+		    else
+			call realloc (SX(sh), SN(sh), TY_REAL)
+		    do i = 1, SN(sh)
+			Memr[SX(sh)+i-1] = shdr_lw (sh, double(i))
+		}
+
+		# Log operation.
+		call printf ("[%s]: %s\n  %s\n")
+		    call pargstr (Memc[output])
+		    call pargstr (IM_TITLE(in))
+		    call pargstr (Memc[log])
+
+		# Deredden data.
+		n = IM_LEN(in,1)
+		do j = 1, IM_LEN(in,3) {
+		    do i = 1, IM_LEN(in,2) {
+			outbuf = impl3r (out, i, j)
+			switch (SMW_FORMAT(mw)) {
+			case SMW_ND:
+			    inbuf = imgl3r (in, i, j)
+			    switch (SMW_LAXIS(mw,1)) {
+			    case 1:
+				call deredden (Memr[SX(sh)], Memr[inbuf],
+				    Memr[outbuf], SN(sh), av, rv, avold, rvold)
+			    case 2:
+				w = Memr[SX(sh)+i-1]
+				call deredden1 (w, Memr[inbuf], Memr[outbuf],
+				    n, av, rv, avold, rvold)
+			    case 3:
+				w = Memr[SX(sh)+j-1]
+				call deredden1 (w, Memr[inbuf], Memr[outbuf],
+				    n, av, rv, avold, rvold)
+			    }
+			case SMW_ES, SMW_MS:
+			    call shdr_open (in, mw, i, j, INDEFI, SHDATA, sh)
+			    if (rng_elementi (aps, AP(sh))) {
+				if (j==1) {
+				    call printf ("  Ap %d: %s\n")
+					call pargi (AP(sh))
+					call pargstr (TITLE(sh))
+				}
+				call deredden (Memr[SX(sh)], Memr[SY(sh)],
+				    Memr[outbuf], SN(sh), av, rv, avold, rvold)
+			    } else
+				call amovr (Memr[SY(sh)], Memr[outbuf], SN(sh))
+			    if (IM_LEN(out,1) > SN(sh))
+				call amovkr (Memr[SY(sh)+SN(sh)-1],
+				    Memr[outbuf+SN(sh)], IM_LEN(out,1)-SN(sh))
+			}
+		    }
+		}
+	    } then {
+		call erract (EA_WARN)
+		if (out != NULL) {
+		    call imunmap (out)
+		    call imdelete (Memc[temp])
+		}
+	    }
+
+	    if (mw != NULL) {
+		if (MW(sh) == mw)
+		    call smw_close (MW(sh))
+		else
+		    call smw_close (mw)
+	    }
+	    if (out != NULL) {
+		call imunmap (out)
+		call imunmap (in)
+		if (streq (Memc[input], Memc[output])) {
+		    call imdelete (Memc[input])
+		    call imrename (Memc[temp], Memc[output])
+		}
+	    } else if (in != NULL)
+		call imunmap (in)
+	}
+
+	call shdr_close (sh)
+	call rng_close (aps)
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call sfree (sp)
+end
+
+
+# DEREDDEN -- Deredden spectrum
+
+procedure deredden (x, y, z, n, av, rv, avold, rvold)
+
+real	x[n]			# Wavelengths
+real	y[n]			# Input fluxes
+real	z[n]			# Output fluxes
+int	n			# Number of points
+real	av, avold		# A(V)
+real	rv, rvold		# A(V)/E(B-V)
+
+int	i
+real	cor, ccm()
+errchk	ccm
+
+begin
+	if (avold != 0.) {
+	    if (rv != rvold) {
+		do i = 1, n {
+		    cor = 10. ** (0.4 *
+			(av * ccm (x[i], rv) - avold * ccm (x[i], rvold)))
+		    z[i] = y[i] * cor
+		}
+	    } else {
+		do i = 1, n {
+		    cor = 10. ** (0.4 * (av - avold) * ccm (x[i], rv))
+		    z[i] = y[i] * cor
+		}
+	    }
+	} else {
+	    do i = 1, n {
+		cor = 10. ** (0.4 * av * ccm (x[i], rv))
+		z[i] = y[i] * cor
+	    }
+	}
+end
+
+
+# DEREDDEN1 -- Deredden fluxes at a single wavelength
+
+procedure deredden1 (x, y, z, n, av, rv, avold, rvold)
+
+real	x			# Wavelength
+real	y[n]			# Input fluxes
+real	z[n]			# Output fluxes
+int	n			# Number of points
+real	av, avold		# A(V)
+real	rv, rvold		# A(V)/E(B-V)
+
+int	i
+real	cor, ccm()
+errchk	ccm
+
+begin
+	if (avold != 0.) {
+	    if (rv != rvold)
+		cor = 10. ** (0.4 *
+		    (av * ccm (x, rv) - avold * ccm (x, rvold)))
+	    else
+		cor = 10. ** (0.4 * (av - avold) * ccm (x, rv))
+	} else
+	    cor = 10. ** (0.4 * av * ccm (x, rv))
+	do i = 1, n
+	    z[i] = y[i] * cor
+end
+
+
+# CCM -- Compute CCM Extinction Law
+
+real procedure ccm (wavelength, rv) 
+
+real	wavelength		# Wavelength in Angstroms
+real	rv			# A(V) / E(B-V)
+
+real	x, y, a, b
+
+begin
+	# Convert to inverse microns
+	x = 10000. / wavelength
+
+	# Compute a(x) and b(x)
+	if (x < 0.3) {
+	    call error (1, "Wavelength out of range of extinction function")
+
+	} else if (x < 1.1) {
+	    y = x ** 1.61
+	    a = 0.574 * y
+	    b = -0.527 * y
+
+	} else if (x < 3.3) {
+	    y = x - 1.82
+	    a = 1 + y * (0.17699 + y * (-0.50447 + y * (-0.02427 +
+		y * (0.72085 + y * (0.01979 + y * (-0.77530 + y * 0.32999))))))
+	    b = y * (1.41338 + y * (2.28305 + y * (1.07233 + y * (-5.38434 +
+		y * (-0.62251 + y * (5.30260 + y * (-2.09002)))))))
+
+	} else if (x < 5.9) {
+	    y = (x - 4.67) ** 2
+	    a = 1.752 - 0.316 * x - 0.104 / (y + 0.341)
+	    y = (x - 4.62) ** 2
+	    b = -3.090 + 1.825 * x + 1.206 / (y + 0.263)
+
+	} else if (x < 8.0) {
+	    y = (x - 4.67) ** 2
+	    a = 1.752 - 0.316 * x - 0.104 / (y + 0.341)
+	    y = (x - 4.62) ** 2
+	    b = -3.090 + 1.825 * x + 1.206 / (y + 0.263)
+
+	    y = x - 5.9
+	    a = a - 0.04473 * y**2 - 0.009779 * y**3
+	    b = b + 0.2130 * y**2 + 0.1207 * y**3
+
+	} else if (x <= 10.0) {
+	    y = x - 8
+	    a = -1.072 - 0.628 * y + 0.137 * y**2 - 0.070 * y**3
+	    b = 13.670 + 4.257 * y - 0.420 * y**2 + 0.374 * y**3
+
+	} else {
+	    call error (1, "Wavelength out of range of extinction function")
+
+	}
+
+	# Compute A(lambda)/A(V)
+	y = a + b / rv
+	return (y)
+end
diff --git a/noao/onedspec/t_dopcor.x b/noao/onedspec/t_dopcor.x
new file mode 100644
index 00000000..a6f2d9a5
--- /dev/null
+++ b/noao/onedspec/t_dopcor.x
@@ -0,0 +1,293 @@
+include	<error.h>
+include	<imhdr.h>
+include	<smw.h>
+
+define	EXTN_LOOKUP	10	# Interp index for de-extinction
+define	VLIGHT	2.997925e5	# Speed of light, Km/sec
+
+# T_DOPCOR -- Apply doppler correction to spectra.
+
+procedure t_dopcor ()
+
+int	inlist			# List of input spectra
+int	outlist			# List of output spectra
+double	z			# Doppler redshift or velocity
+bool	isvel			# Is redshift parameter a velocity?
+bool	add			# Add to existing correction?
+bool	dcor			# Apply dispersion correction?
+bool	fcor			# Apply flux correction?
+real	ffac			# Flux correction factor (power of 1+z)
+pointer	aps			# Apertures
+bool	verbose			# Verbose?
+
+real	fcval
+bool	wc, fc, aplow[2], aphigh[2]
+int	i, j, ap, beam, nw, dtype
+double	w1, dw, zold, znew, zvel
+pointer	ptr, in, out, mw, sh, inbuf, outbuf
+pointer	sp, input, output, vkey, apstr, key, log, coeff
+
+real	clgetr()
+double	imgetd()
+bool	clgetb(), streq(), rng_elementi()
+int	imtopenp(), imtgetim(), ctod()
+pointer	rng_open(), immap(), smw_openim(), imgl3r(), impl3r()
+errchk	immap, imgetd, imgstr,imgl3r, impl3r
+errchk	smw_openim, shdr_open, smw_gwattrs
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (vkey, SZ_FNAME, TY_CHAR)
+	call salloc (apstr, SZ_FNAME, TY_CHAR)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (log, SZ_LINE, TY_CHAR)
+	coeff = NULL
+
+	# Parameters
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	call clgstr ("redshift", Memc[vkey], SZ_FNAME)
+	isvel = clgetb ("isvelocity")
+	add = clgetb ("add")
+	dcor = clgetb ("dispersion") 
+	fcor = clgetb ("flux")
+	if (fcor)
+	    ffac = clgetr ("factor")
+	else
+	    ffac = 0.
+	call clgstr ("apertures", Memc[apstr], SZ_FNAME)
+	verbose = clgetb ("verbose")
+
+	# Parameter checks
+	if (!dcor && !fcor)
+	    call error (1, "No correction specified")
+	iferr (aps = rng_open (Memc[apstr], INDEF, INDEF, INDEF))
+	    call error (1, "Bad aperture list")
+	if (Memc[apstr] == EOS)
+	    call strcpy ("all", Memc[apstr], SZ_LINE)
+
+	# Loop over input images.
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    iferr {
+		in = NULL
+		out = NULL
+		mw = NULL
+		sh = NULL
+
+		# Map and check input image.
+		if (streq (Memc[input], Memc[output]))
+		    ptr = immap (Memc[input], READ_WRITE, 0)
+		else
+		    ptr = immap (Memc[input], READ_ONLY, 0)
+		in = ptr
+
+		ptr = smw_openim (in); mw = ptr
+		call shdr_open (in, mw, 1, 1, INDEFI, SHHDR, sh)
+                if (DC(sh) == DCNO) {
+                    call sprintf (Memc[output], SZ_LINE,
+                        "[%s] has no dispersion function")
+                        call pargstr (Memc[input])
+                    call error (1, Memc[output])
+                }
+
+		# Map output image.
+		if (streq (Memc[input], Memc[output]))
+		    ptr = in
+		else
+		    ptr = immap (Memc[output], NEW_COPY, in)
+		out = ptr
+
+		# Set velocity and flux correction
+		i = 1
+		if (Memc[vkey] == '-' || Memc[vkey] == '+') {
+		    if (ctod (Memc[vkey+1], i, z) == 0) {
+			z = imgetd (in, Memc[vkey+1])
+			if (Memc[vkey] == '-') {
+			    if (isvel)
+				z = -z
+			    else
+				z = 1 / (1 + z) - 1
+			}
+		    } else if (Memc[vkey] == '-')
+			z = -z
+		} else {
+		    if (ctod (Memc[vkey], i, z) == 0)
+			z = imgetd (in, Memc[vkey])
+		}
+		zvel = z
+		if (isvel) {
+		    z = z / VLIGHT
+		    if (abs (z) >= 1.)
+			call error (1, "Impossible velocity")
+		    z = sqrt ((1 + z) / (1 - z)) - 1
+		}
+		if (z <= -1.)
+		    call error (1, "Impossible redshift")
+
+		if (fcor) {
+		    fcval = (1 + z) ** ffac
+		    if (in != out && IM_PIXTYPE(out) != TY_DOUBLE)
+			IM_PIXTYPE(out) = TY_REAL
+		}
+
+		# Go through spectrum and apply corrections.
+		switch (SMW_FORMAT(mw)) {
+		case SMW_ND:
+		    if (dcor) {
+			call smw_gwattrs (mw, 1, 1, ap, beam, dtype,
+			    w1, dw, nw, zold, aplow, aphigh, coeff)
+			if (add)
+			    znew = (1+z) * (1+zold) - 1
+			else
+			    znew = z
+			call smw_swattrs (mw, 1, 1, ap, beam, dtype,
+			    w1, dw, nw, znew, aplow, aphigh, Memc[coeff])
+		    }
+
+		    if (fcor || in != out) {
+			do j = 1, IM_LEN(in,3) {
+			    do i = 1, IM_LEN(in,2) {
+				inbuf = imgl3r (in, i, j)
+				outbuf = impl3r (out, i, j)
+				if (fcor)
+				    call amulkr (Memr[inbuf], fcval,
+					Memr[outbuf], IM_LEN(in,1))
+				else
+				    call amovr (Memr[inbuf], Memr[outbuf],
+					IM_LEN(in,1))
+			    }
+			}
+		    }
+		case SMW_ES, SMW_MS:
+		    do i = 1, IM_LEN(in,2) {
+			call shdr_open (in, mw, i, 1, INDEFI, SHHDR, sh)
+			if (rng_elementi (aps, AP(sh))) {
+			    wc = dcor
+			    fc = fcor
+			} else {
+			    wc = false
+			    fc = false
+			}
+
+			if (wc) {
+			    call smw_gwattrs (mw, i, 1, ap, beam, dtype,
+				w1, dw, nw, zold, aplow, aphigh, coeff)
+			    if (add)
+				znew = (1+z) * (1+zold) - 1
+			    else
+				znew = z
+			    call smw_swattrs (mw, i, 1, ap, beam, dtype, w1,
+				dw, nw, znew, aplow, aphigh, Memc[coeff])
+			    if (mw != MW(sh)) {
+				MW(sh) = NULL
+				call shdr_close (sh)
+			    }
+			}
+
+			# Correct fluxes
+			# Note that if the operation is in-place we can skip
+			# this step if there is no corrections.  Otherwise we
+			# still have to copy the data even if there is no
+			# correction.
+
+			if (fc || in != out) {
+			    do j = 1, IM_LEN(in,3) {
+				call shdr_open (in, mw, i, j, INDEFI,
+				    SHDATA, sh)
+				outbuf = impl3r (out, i, j)
+				if (fc)
+				    call amulkr (Memr[SY(sh)], fcval,
+					Memr[outbuf], SN(sh))
+				else
+				    call amovr (Memr[SY(sh)], Memr[outbuf],
+					SN(sh))
+				if (IM_LEN(out,1) > SN(sh))
+				    call amovkr (Memr[outbuf+SN(sh)-1],
+					Memr[outbuf+SN(sh)],
+					IM_LEN(out,1)-SN(sh))
+			    }
+			}
+		    }
+		}
+
+		# Document header.
+		do i = 1, 98 {
+		    call sprintf (Memc[key], SZ_FNAME, "DOPCOR%02d")
+			call pargi (i)
+		    iferr (call imgstr (out, Memc[key], Memc[log], SZ_LINE))
+			break
+		}
+		if (fcor) {
+		    call sprintf (Memc[log], SZ_LINE, "%8g %g %s")
+		        if (isvel)
+			    call pargd (zvel)
+			else
+			    call pargd (z)
+			call pargr (ffac)
+			call pargstr (Memc[apstr])
+		} else {
+		    call sprintf (Memc[log], SZ_LINE, "%8g %s")
+		        if (isvel)
+			    call pargd (zvel)
+			else
+			    call pargd (z)
+			call pargstr (Memc[apstr])
+		}
+		call imastr (out, Memc[key], Memc[log])
+
+
+		# Verbose output
+		if (verbose) {
+		    call printf ("%s: Doppler correction -")
+			call pargstr (Memc[output])
+		    if (SMW_FORMAT(mw) != SMW_ND) {
+			call printf (" apertures=%s,")
+			    call pargstr (Memc[apstr])
+		    }
+		    if (isvel) {
+			call printf (" velocity=%8g,")
+			    call pargd (zvel)
+		    }
+		    call printf (" redshift=%8g, flux factor=%g\n")
+			call pargd (z)
+			call pargr (ffac)
+		    if (add && zold != 0.) {
+			call printf ("    Correction added: %g + %g = %g\n")
+			    call pargd (zold)
+			    call pargd (z)
+			    call pargd (znew)
+		    }
+		    call flush (STDOUT)
+		}
+
+	    } then {
+		call erract (EA_WARN)
+		if (out != NULL && out != in) {
+		    call imunmap (out)
+		    call imdelete (Memc[output])
+		}
+	    }
+
+	    if (mw != NULL && out != NULL)
+		call smw_saveim (mw, out)
+	    if (sh != NULL)
+		call shdr_close (sh)
+	    if (mw != NULL)
+		call smw_close (mw)
+	    if (out != NULL && out != in)
+		call imunmap (out)
+	    if (in != NULL)
+		call imunmap (in)
+	}
+
+	call rng_close (aps)
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_fitprofs.x b/noao/onedspec/t_fitprofs.x
new file mode 100644
index 00000000..9aa389bc
--- /dev/null
+++ b/noao/onedspec/t_fitprofs.x
@@ -0,0 +1,1151 @@
+include	<error.h>
+include	<imhdr.h>
+include	<smw.h>
+include	<gset.h>
+include	<ctotok.h>
+
+
+# Profile types.
+define	PTYPES	"|gaussian|lorentzian|voigt|"
+define  GAUSS           1       # Gaussian profile
+define  LORENTZ         2       # Lorentzian profile
+define  VOIGT           3       # Voigt profile
+
+# Type of constraints.
+define	FITTYPES "|fixed|single|all|"
+define  FIXED           1       # Fixed parameter
+define  SINGLE          2       # Fit a single value for all lines
+define  INDEP           3       # Fit independent values for all lines
+
+# Elements of fit array.
+define  BKG             1       # Background
+define  POS             2       # Position
+define  INT             3       # Intensity
+define  GAU             4       # Gaussian FWHM
+define  LOR             5       # Lorentzian FWHM
+
+# Output image options.
+define	OPTIONS	"|difference|fit|"
+define	DIFF		1
+define	FIT		2
+
+# Monte-Carlo errors
+define  MC_N    50      # Monte-Carlo samples (overridden by users)
+define  MC_P    10      # Percent done interval (percent)
+define  MC_SIG  68      # Sigma sample point (percent)
+
+define  NSUB    3       # Number of pixel subsamples
+
+ 
+# T_FITPROFS -- Fit image profiles.
+ 
+procedure t_fitprofs()
+ 
+int	inlist			# List of input spectra
+pointer	aps			# Aperture list
+pointer	bands			# Band list
+
+int	ptype			# Profile type
+pointer	pg, xg, yg, sg, lg	# Fitting region and initial components
+real	gfwhm			# Default gfwhm
+real	lfwhm			# Default lfwhm
+int	fit[5]			# Fit flags: background, position, gfwhm, lfwhm
+
+int	nerrsample		# Number of error samples to use
+real	sigma0			# Constant noise
+real	invgain			# Inverse gain
+
+pointer	components		# List of components
+bool	verbose			# Verbose?
+int	log			# Log file
+int	plot			# Plot file
+int	outlist			# List of output spectra
+int	option			# Output image option
+bool	clobber			# Clobber existing images?
+bool	merge			# Merge with existing images?
+ 
+real	x, y, g, l
+bool	complement
+int	i, p, ng, nalloc
+pointer	sp, input, output, ptr
+ 
+real	clgetr()
+bool	clgetb()
+int	clgeti(), clgwrd(), clscan()
+int	imtopenp(), imtgetim(), imtlen()
+int	open(), fscan(), nscan(), strdic(), nowhite()
+pointer	rng_open()
+errchk	open
+ 
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+ 
+	# Get parameters.
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	if (imtlen (outlist) > 1 && imtlen (outlist) != imtlen (inlist))
+	    call error (1, "Input and output image lists do not make sense")
+
+	verbose = clgetb ("verbose")
+	call clgstr ("logfile", Memc[output], SZ_FNAME)
+	if (nowhite (Memc[output], Memc[output], SZ_FNAME) == 0)
+	    log = NULL
+	else
+	    log = open (Memc[output], APPEND, TEXT_FILE)
+	call clgstr ("plotfile", Memc[output], SZ_FNAME)
+	if (nowhite (Memc[output], Memc[output], SZ_FNAME) == 0)
+	    plot = NULL
+	else
+	    plot = open (Memc[output], APPEND, BINARY_FILE)
+
+	ptype = clgwrd ("profile", Memc[output], SZ_FNAME, PTYPES)
+	gfwhm = clgetr ("gfwhm")
+	lfwhm = clgetr ("lfwhm")
+
+	if (clgetb ("fitbackground"))
+	    fit[BKG] = SINGLE
+	else
+	    fit[BKG] = FIXED
+	fit[POS] = clgwrd ("fitpositions", Memc[output], SZ_FNAME, FITTYPES)
+	fit[INT] = INDEP
+	fit[GAU] = clgwrd ("fitgfwhm", Memc[output], SZ_FNAME, FITTYPES)
+	fit[LOR] = clgwrd ("fitlfwhm", Memc[output], SZ_FNAME, FITTYPES)
+	option = clgwrd ("option", Memc[output], SZ_FNAME, OPTIONS)
+	clobber = clgetb ("clobber")
+	merge = clgetb ("merge")
+	nerrsample = clgeti ("nerrsample")
+	sigma0 = clgetr ("sigma0")
+	invgain = clgetr ("invgain")
+	if (IS_INDEF(sigma0) || IS_INDEF(invgain) || sigma0<0. || invgain<0.) {
+	    sigma0 = INDEF
+	    invgain = INDEF
+	}
+
+	# Get the initial positions/peak/ptype/gfwhm/lfwhm.
+	call clgstr ("positions", Memc[input], SZ_FNAME)
+	if (nowhite (Memc[input], Memc[input], SZ_FNAME) == 0) {
+	    call sfree (sp)
+	    call error (1, "A 'positions' file must be specified")
+	}
+	i = open (Memc[input], READ_ONLY, TEXT_FILE)
+	ng = 0
+	while (fscan (i) != EOF) {
+	    call gargr (x)
+	    call gargr (y)
+	    call gargwrd (Memc[output], SZ_FNAME)
+	    call gargr (g)
+	    call gargr (l)
+	    p = strdic (Memc[output], Memc[output], SZ_FNAME, PTYPES)
+	    if (p == 0)
+		p = ptype
+	    switch (nscan()) {
+	    case 0:
+		next
+	    case 1:
+		y = INDEF
+		p = ptype
+		g = gfwhm
+		l = lfwhm
+	    case 2:
+		p = ptype
+		g = gfwhm
+		l = lfwhm
+	    case 3:
+		g = gfwhm
+		l = lfwhm
+	    case 4:
+		switch (p) {
+		case GAUSS:
+		    l = lfwhm
+		case LORENTZ:
+		    l = g
+		    g = gfwhm
+		case VOIGT:
+		    l = lfwhm
+		}
+	    }
+
+	    if (ng == 0) {
+		nalloc = 10
+		call malloc (pg, nalloc, TY_INT)
+		call malloc (xg, nalloc, TY_REAL)
+		call malloc (yg, nalloc, TY_REAL)
+		call malloc (sg, nalloc, TY_REAL)
+		call malloc (lg, nalloc, TY_REAL)
+	    } else if (ng == nalloc) {
+		nalloc = nalloc + 10
+		call realloc (pg, nalloc, TY_INT)
+		call realloc (xg, nalloc, TY_REAL)
+		call realloc (yg, nalloc, TY_REAL)
+		call realloc (sg, nalloc, TY_REAL)
+		call realloc (lg, nalloc, TY_REAL)
+	    }
+	    switch (p) {
+	    case GAUSS:
+		Memi[pg+ng] = p
+		Memr[xg+ng] = x
+		Memr[yg+ng] = y
+		Memr[sg+ng] = g
+		Memr[lg+ng] = 0.
+	    case LORENTZ:
+		Memi[pg+ng] = p
+		Memr[xg+ng] = x
+		Memr[yg+ng] = y
+		Memr[sg+ng] = 0.
+		Memr[lg+ng] = g
+	    case VOIGT:
+		Memi[pg+ng] = p
+		Memr[xg+ng] = x
+		Memr[yg+ng] = y
+		Memr[sg+ng] = g
+		Memr[lg+ng] = l
+	    }
+	    ng = ng + 1
+	}
+	call close (i)
+	if (ng == 0)
+	    call error (1, "No profiles defined")
+
+	call realloc (xg, ng+2, TY_REAL)
+	call realloc (yg, ng+2, TY_REAL)
+	call realloc (sg, ng+2, TY_REAL)
+	call realloc (lg, ng+2, TY_REAL)
+
+	# Get fitting region and add to end of xg array.
+	i = clscan ("region")
+	    call gargr (Memr[xg+ng])
+	    call gargr (Memr[xg+ng+1])
+	    if (i == EOF || nscan() < 1)
+ 
+	# Decode range strings and set complement if needed.
+	complement = false
+	call clgstr ("lines", Memc[input], SZ_FNAME)
+	ptr = input
+	if (Memc[ptr] == '!') {
+	    complement = true
+	    ptr = ptr + 1
+	}
+	iferr (aps = rng_open (Memc[ptr], INDEF, INDEF, INDEF))
+	    call error (1, "Bad lines/column/aperture list")
+
+	call clgstr ("bands", Memc[input], SZ_FNAME)
+	ptr = input
+	if (Memc[ptr] == '!') {
+	    complement = true
+	    ptr = ptr + 1
+	}
+	iferr (bands = rng_open (Memc[ptr], INDEF, INDEF, INDEF))
+	    call error (1, "Bad band list")
+
+	# Decode components.
+	call clgstr ("components", Memc[input], SZ_FNAME)
+	iferr (components = rng_open (Memc[input], INDEF, INDEF, INDEF))
+	    call error (1, "Bad component list")
+
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+		Memc[output] = EOS
+
+	    call fp_ms (Memc[input], aps, bands, complement, Memi[pg], Memr[xg],
+		Memr[yg], Memr[sg], Memr[lg], ng, fit, nerrsample,
+		sigma0, invgain, components, verbose, log, plot, Memc[output],
+		option, clobber, merge)
+	}
+
+	if (log != NULL)
+	    call close (log)
+	if (plot != NULL)
+	    call close (plot)
+	call rng_close (aps)
+	call rng_close (bands)
+	call rng_close (components)
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call mfree (pg, TY_INT)
+	call mfree (xg, TY_REAL)
+	call mfree (yg, TY_REAL)
+	call mfree (sg, TY_REAL)
+	call mfree (lg, TY_REAL)
+	call sfree (sp)
+end
+
+ 
+# FP_MS -- Handle I/O and call fitting procedure.
+
+procedure fp_ms (input, aps, bands, complement, pg, xg, yg, sg, lg, ng, fit,
+	nerrsample, sigma0, invgain, components, verbose, log, plot, output,
+	option, clobber, merge)
+
+char	input[ARB]		# Input image
+pointer	aps			# Apertures
+pointer	bands			# Bands
+bool	complement		# Complement aperture selection
+
+int	pg[ng]			# Profile type
+real	xg[ng]			# Positions
+real	yg[ng]			# Peaks
+real	sg[ng]			# Gaussian FWHM
+real	lg[ng]			# Lorentzian FWHM
+int	ng			# Number of profiles
+int	fit[5]			# Fit flags
+
+int	nerrsample		# Number of error samples
+real	sigma0			# Constant noise
+real	invgain			# Inverse gain
+
+pointer	components		# Output Component list
+bool	verbose			# Verbose output?
+int	log			# Log file descriptor
+int	plot			# Plot file descriptor
+char	output[ARB]		# Output image
+int	option			# Output image option
+bool	clobber			# Clobber existing image?
+bool	merge			# Merge with existing image?
+
+real	aplow[2], aphigh[2]
+double	a, b, w1, wb, dw, z, p1, p2, p3
+bool	select
+int	i, j, k, l, ap, beam, dtype, nw, ninaps, noutaps, nbands, naps, last
+int	mwoutdim, axis[3]
+pointer	ptr, in, out, tmp, mwin, mwout, sh, shout
+pointer	sp, str, key, temp, ltm1, ltv1, ltm2, ltv2, coeff, outaps
+pointer	model
+
+double	shdr_lw()
+int	imaccess(), imgnfn()
+bool	streq(), strne(), rng_elementi(), fp_equald()
+pointer	smw_openim(), mw_open()
+pointer	immap(), imgl3r(), impl3r(), imofnlu()
+errchk	immap, smw_openim, mw_open, shdr_open, imunmap, imgstr, imgl3r, impl3r
+errchk	imdelete
+data	axis/1,2,3/
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (ltm1, 3*3, TY_DOUBLE)
+	call salloc (ltv1, 3, TY_DOUBLE)
+	call salloc (ltm2, 3*3, TY_DOUBLE)
+	call salloc (ltv2, 3, TY_DOUBLE)
+	coeff = NULL
+
+	# Initialize.
+	in = NULL; out = NULL; tmp = NULL
+	mwin = NULL; mwout = NULL
+	sh = NULL; shout = NULL
+	ninaps = 0; noutaps = 0; nbands = 0
+
+	iferr {
+	# Check for existing output image and abort if clobber is not set.
+	if (output[1] != EOS && imaccess (output, READ_ONLY) == YES) {
+	    if (!clobber) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "Output spectrum %s already exists")
+		    call pargstr (output)
+		call error (1, Memc[str])
+	    } else if (merge) {
+		# Merging when the input and output are the same is a nop.
+		if (streq (input, output)) {
+		    call sfree (sp)
+		    return
+		}
+
+		# Open the output and check the type.
+		ptr = immap (output, READ_ONLY, 0); out = ptr
+		ptr = smw_openim (out); mwout = ptr
+                if (SMW_FORMAT(mwout) == SMW_ND) {
+                    call sprintf (Memc[str], SZ_LINE, "%s - Wrong format")
+                        call pargstr (output)
+                    call error (1, Memc[str])
+                }
+
+		# Determine existing apertures.
+		noutaps = SMW_NSPEC(mwout)
+		nbands = SMW_NBANDS(mwout)
+		call salloc (outaps, noutaps, TY_INT)
+		do i = 1, noutaps {
+		    call shdr_open (out, mwout, i, 1, INDEFI, SHHDR, sh)
+		    Memi[outaps+i-1] = AP(sh)
+		}
+	    }
+	    call mktemp ("temp", Memc[temp], SZ_FNAME)
+	} else
+	    call strcpy (output, Memc[temp], SZ_FNAME)
+
+	# Open the input and determine the number of final output
+	# apertures in order to set the output dimensions.
+
+	ptr = immap (input, READ_ONLY, 0); in = ptr
+	ptr = smw_openim (in); mwin = ptr
+
+	naps = noutaps
+
+	j = 1
+	if (SMW_FORMAT(mwin) != SMW_ND) {
+	    j = 0
+	    do i = 1, SMW_NBANDS(mwin) {
+		select = rng_elementi (bands, i)
+		if (!select)
+		    next
+		j = j + 1
+	    }
+	    if (j == 0)
+		call error (1, "No bands selected in image")
+	}
+	nbands = max (j, nbands)
+
+	do i = 1, SMW_NSPEC(mwin) {
+	    call shdr_open (in, mwin, i, 1, INDEFI, SHHDR, sh)
+	    ap = AP(sh)
+	    if (SMW_FORMAT(mwin) == SMW_ND) {
+		call smw_mw (mwin, i, 1, ptr, j, k)
+		select = rng_elementi (aps, j) && rng_elementi (bands, k)
+	    } else
+		select = rng_elementi (aps, ap)
+
+	    if ((complement && select) || (!complement && !select))
+		next
+	    for (j=0; j<noutaps && Memi[outaps+j]!=ap; j=j+1)
+		;
+	    if (j == noutaps)
+		naps = naps + 1
+	    ninaps = ninaps + 1
+	}
+	if (ninaps == 0) {
+	    call sprintf (Memc[str], SZ_LINE, "No apertures selected in %s")
+		call pargstr (input)
+	    call error (1, Memc[str])
+	}
+
+	# Set the output spectrum.  For merging with an existing output
+	# copy to a temporary spectrum with size set appropriately.
+	# For a new output setup copy the input header, reset the
+	# physical line mapping, and clear all dispersion parameters.
+	
+	if (out != NULL) {
+	    ptr = immap (Memc[temp], NEW_COPY, out); tmp = ptr
+	    if (IM_PIXTYPE(tmp) != TY_DOUBLE)
+		IM_PIXTYPE(tmp) = TY_REAL
+
+	    IM_LEN(tmp,1) = max (SMW_LLEN(mwin,1), IM_LEN(out,1))
+	    IM_LEN(tmp,2) = naps
+	    IM_LEN(tmp,3) = max (nbands, IM_LEN(out,3))
+	    if (nbands > 1)
+		IM_NDIM(tmp) = 3
+	    else if (naps > 1)
+		IM_NDIM(tmp) = 2
+	    else
+		IM_NDIM(tmp) = 1
+
+	    do j = 1, IM_LEN(out,3)
+		do i = 1, IM_LEN(out,2) {
+		    ptr = impl3r (tmp, i, j)
+		    call aclrr (Memr[ptr], IM_LEN(tmp,1))
+		    call amovr (Memr[imgl3r(out,i,j)], Memr[ptr], IM_LEN(out,1))
+		}
+	    do j = 1, IM_LEN(out,3)
+		do i = IM_LEN(out,2)+1, IM_LEN(tmp,2) {
+		    ptr = impl3r (tmp, i, j)
+		    call aclrr (Memr[ptr], IM_LEN(tmp,1))
+		}
+	    do j = IM_LEN(out,3)+1, nbands
+		do i = 1, IM_LEN(tmp,2) {
+		    ptr = impl3r (tmp, i, j)
+		    call aclrr (Memr[ptr], IM_LEN(tmp,1))
+		}
+	    call imunmap (out)
+	    out = tmp
+	    tmp = NULL
+	} else if (Memc[temp] != EOS) {
+	    ptr = immap (Memc[temp], NEW_COPY, in); out = ptr
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+
+	    # Set header
+	    IM_LEN(out,1) = SMW_LLEN(mwin,1)
+	    IM_LEN(out,2) = naps
+	    IM_LEN(out,3) = nbands
+	    if (nbands > 1)
+		IM_NDIM(out) = 3
+	    else if (naps > 1)
+		IM_NDIM(out) = 2
+	    else
+		IM_NDIM(out) = 1
+	    mwoutdim = IM_NDIM(out)
+
+	    j = imofnlu (out, "DISPAXIS,APID*,BANDID*")
+	    while (imgnfn (j, Memc[key], SZ_LINE) != EOF)
+		call imdelf (out, Memc[key])
+	    call imcfnl (j)
+
+	    i = SMW_PDIM(mwin)
+	    j = SMW_PAXIS(mwin,1)
+
+	    ptr = mw_open (NULL, mwoutdim); mwout = ptr
+	    call mw_newsystem (mwout, "equispec", mwoutdim)
+	    call mw_swtype (mwout, axis, mwoutdim, "linear", "")
+	    if (LABEL(sh) != EOS)
+		call mw_swattrs (mwout, 1, "label", LABEL(sh))
+	    if (UNITS(sh) != EOS)
+		call mw_swattrs (mwout, 1, "units", UNITS(sh))
+
+	    call mw_gltermd (SMW_MW(mwin,0), Memd[ltm1], Memd[ltv1], i)
+            call mw_gltermd (mwout, Memd[ltm2], Memd[ltv2], mwoutdim)
+            Memd[ltv2] = Memd[ltv1+(j-1)]
+            Memd[ltm2] = Memd[ltm1+(i+1)*(j-1)]
+	    call mw_sltermd (mwout, Memd[ltm2], Memd[ltv2], mwoutdim)
+	    call smw_open (mwout, NULL, out)
+	}
+
+	if (out != NULL) {
+	    # Check dispersion function compatibility
+	    # Nonlinear functions can be copied to different physical
+	    # coordinate system though the linear dispersion can be
+	    # modified.
+
+	    call mw_gltermd (SMW_MW(mwout,0), Memd[ltm2], Memd[ltv2], mwoutdim)
+	    a = Memd[ltv2]
+	    b = Memd[ltm2]
+	    if (DC(sh) == DCFUNC) {
+		i = SMW_PDIM(mwin)
+		j = SMW_PAXIS(mwin,1)
+
+		call mw_gltermd (SMW_MW(mwin,0), Memd[ltm1], Memd[ltv1], i)
+		Memd[ltv1] = Memd[ltv1+(j-1)]
+		Memd[ltm1] = Memd[ltm1+(i+1)*(j-1)]
+	       if (!fp_equald (a,Memd[ltv1]) || !fp_equald (b,Memd[ltm1])) {
+		    call error (1,
+		"Physical basis for nonlinear dispersion functions don't match")
+		}
+	    }
+	}
+
+	# Now do the actual fitting
+	call salloc (model, SMW_LLEN(mwin,1), TY_REAL)
+	last = noutaps
+	do i = 1, SMW_NSPEC(mwin) {
+	    call shdr_open (in, mwin, i, 1, INDEFI, SHHDR, sh)
+
+	    # Check apertures.
+	    ap = AP(sh)
+	    if (SMW_FORMAT(mwin) == SMW_ND) {
+		call smw_mw (mwin, i, 1, ptr, j, k)
+		select = rng_elementi (aps, j) && rng_elementi (bands, k)
+	    } else
+		select = rng_elementi (aps, ap)
+
+	    if ((complement && select) || (!complement && !select))
+		next
+
+	    call fp_title (sh, Memc[str], verbose, log)
+
+	    call shdr_open (in, mwin, i, 1, INDEFI, SHDATA, sh)
+	    if (SN(sh) < SMW_LLEN(mwin,1))
+		call aclrr (Memr[model], SMW_LLEN(mwin,1))
+	    iferr (call fp_fit (sh, Memr[SX(sh)], Memr[SY(sh)], SN(sh), pg,
+		xg, yg, sg, lg, ng, fit, nerrsample, sigma0, invgain,
+		components, verbose, log, plot, Memc[str], Memr[model])) {
+		call erract (EA_WARN)
+	    }
+
+	    if (out != NULL) {
+		for (j=0; j<noutaps && Memi[outaps+j]!=ap; j=j+1)
+		    ;
+
+		# Set output logical and physical lines
+		if (j < noutaps)
+		    l = j + 1
+		else {
+		    l = last + 1
+		    last = l
+		}
+
+		# Copy and adjust dispersion info
+		call smw_gwattrs (mwin, i, 1, AP(sh), beam,
+		    dtype, w1, dw, nw, z, aplow, aphigh, coeff)
+
+		w1 = shdr_lw (sh, 1D0)
+		wb = shdr_lw (sh, double (SN(sh)))
+		p1 = (NP1(sh) - a) / b
+		p2 = (NP2(sh) - a) / b
+		p3 = (IM_LEN(out,1) - a) / b
+		nw = nint (min (max (p1 ,p3), max (p1 ,p2))) + NP1(sh) - 1
+		if (p1 != p2)
+		    dw = (wb - w1) / (p2 - p1) * (1 + z)
+		w1 = w1 * (1 + z) - (p1 - 1) * dw
+
+		call smw_swattrs (mwout, l, 1, ap, beam, dtype,
+		    w1, dw, nw, z, aplow, aphigh, Memc[coeff])
+
+		# Copy titles
+		call smw_sapid (mwout, l, 1, TITLE(sh))
+		if (Memc[SID(sh,1)] != EOS)
+		    call imastr (out, "BANDID1", Memc[SID(sh,1)])
+
+		# Copy the data
+		switch (option) {
+		case DIFF:
+		    call asubr (Memr[SY(sh)], Memr[model],
+			Memr[impl3r(out,l,1)+NP1(sh)-1], SN(sh))
+		case FIT:
+		    call amovr (Memr[model], Memr[impl3r(out,l,1)+NP1(sh)-1],
+			SN(sh))
+		}
+
+		# Verify copy
+		if (verbose) {
+		    call shdr_open (out, mwout, l, 1, INDEFI, SHHDR, shout)
+		    call printf ("%s%s(%d)  -->  %s%s(%s)\n")
+			call pargstr (IMNAME(sh))
+			call pargstr (IMSEC(sh))
+			call pargi (AP(sh))
+			call pargstr (IMNAME(shout))
+			call pargstr (IMSEC(shout))
+			call pargi (AP(shout))
+		    call flush (STDOUT)
+		}
+	    }
+	}
+
+	call smw_close (MW(sh))
+	if (out != NULL) {
+	    call smw_saveim (mwout, out)
+	    if (shout != NULL)
+		call smw_close (MW(shout))
+	    call imunmap (out)
+	    if (strne (Memc[temp], output)) {
+		call imdelete (output)
+		call imrename (Memc[temp], output)
+	    }
+	}
+	call imunmap (in)
+	} then {
+	    if (shout != NULL)
+		call smw_close (MW(shout))
+	    else if (mwout != NULL)
+		call smw_close (mwout)
+	    if (sh != NULL)
+		call smw_close (MW(sh))
+	    else if (mwin != NULL)
+		call smw_close (mwin)
+	    if (tmp != NULL)
+	        call imunmap (tmp)
+	    if (out != NULL)
+	        call imunmap (out)
+	    if (in != NULL)
+	        call imunmap (in)
+	    call erract (EA_WARN)
+	}
+    
+	call shdr_close (shout)
+	call shdr_close (sh)
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+define	SQ2PI	2.5066283
+
+# FP_FIT -- Fit profile functions
+
+procedure fp_fit (sh, x, y, n, ptypes, pos, peaks, gfwhms, lfwhms, ng, fit,
+	nerrsample, sigma0, invgain, components, verbose, log, plot, title, mod)
+
+pointer	sh			# Spectrum data structure
+real	x[n]			# Coordinates
+real	y[n]			# Data
+int	n			# Number of data points
+
+int	ptypes[ARB]		# Profile types
+real	pos[ARB]		# Fitting region and initial positions
+real	peaks[ARB]		# Peak values
+real	gfwhms[ARB]		# Background levels and initial gfwhm
+real	lfwhms[ARB]		# Initial lfwhm
+int	ng			# Number of gaussian components
+
+int	fit[5]			# Fit flags
+
+int	nerrsample		# Number of error samples
+real	sigma0			# Constant noise
+real	invgain			# Inverse gain
+
+pointer	components		# Component list
+bool	verbose			# Output to STDOUT?
+int	log			# Log file descriptor
+int	plot			# Plot file descriptor
+char	title[ARB]		# Plot title
+real	mod[n]			# Model
+
+int	i, j, k, i1, i2, nfit, nsub, mc_n, mc_p, mc_sig
+long	seed
+real	xc, x1, x2, dx, y1, dy, z1, dz, w, z, scale, sscale
+real	peak, flux, cont, gfwhm, lfwhm, eqw, chisq
+real	flux1, cont1, eqw1, wyc1, slope1, v, u
+bool	doerr
+pointer	sp, str, xd, yd, sd, xg, yg, sg, lg, pg, yd1, xg1, yg1, sg1, lg1
+pointer	ym, conte, xge, yge, sge, lge, fluxe, eqwe
+pointer	gp, gopen()
+bool	rng_elementi()
+real	model(), gasdev(), asumr()
+double	shdr_lw(), shdr_wl
+errchk	fp_background, dofit, dorefit
+
+begin
+	# Determine fitting region.
+	x1 = pos[ng+1]
+	x2 = pos[ng+2]
+	i1 = nint (shdr_wl (sh, double(x1)))
+	i2 = nint (shdr_wl (sh, double(x2)))
+	i = min (n, max (i1, i2))
+	i1 = max (1, min (i1, i2))
+	i2 = i
+	nfit = i2 - i1 + 1
+	if (nfit < 3) {
+	    call aclrr (mod, n)
+	    call error (1, "Too few data points in fitting region")
+	}
+	x1 = shdr_lw (sh, double(i1))
+	x2 = shdr_lw (sh, double(i2))
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (xd, nfit, TY_REAL)
+	call salloc (yd, nfit, TY_REAL)
+	call salloc (sd, nfit, TY_REAL)
+	call salloc (xg, ng, TY_REAL)
+	call salloc (yg, ng, TY_REAL)
+	call salloc (sg, ng, TY_REAL)
+	call salloc (lg, ng, TY_REAL)
+	call salloc (pg, ng, TY_INT)
+
+	# Subtract the continuum and scale the data.
+	call fp_background (sh, x, y, n, x1, x2, y1, dy)
+	scale = 0.
+	doerr = !IS_INDEF(sigma0)
+	do i = i1, i2 {
+	    Memr[xd+i-i1] = x[i]
+	    Memr[yd+i-i1] = y[i] - (y1 + dy * (x[i]-x1))
+	    if (y[i] <= 0.)
+		doerr = false
+	    scale = max (scale, abs (Memr[yd+i-i1]))
+	}
+	if (doerr) {
+	    do i = i1, i2
+		Memr[sd+i-i1] = sqrt (sigma0 ** 2 + invgain * y[i])
+	    sscale = asumr (Memr[sd], nfit) / nfit
+	} else {
+	    call amovkr (1., Memr[sd], nfit)
+	    sscale = 1.
+	}
+	call adivkr (Memr[yd], scale, Memr[yd], nfit)
+	call adivkr (Memr[sd], sscale, Memr[sd], nfit)
+	y1 = y1 / scale
+	dy = dy / scale
+
+	# Setup initial estimates.
+	do i = 1, ng {
+	    Memr[xg+i-1] = pos[i]
+	    Memr[sg+i-1] = gfwhms[i]
+	    Memr[lg+i-1] = lfwhms[i]
+	    Memi[pg+i-1] = ptypes[i]
+	    if (IS_INDEF(peaks[i])) {
+		j = max (1, min (nfit, nint (shdr_wl(sh,double(pos[i])))-i1+1))
+		Memr[yg+i-1] = Memr[yd+j-1]
+	    } else
+		Memr[yg+i-1] = peaks[i] / scale
+	}
+	z1 = 0.
+	dz = 0.
+	dx = (x[n] - x[1]) / (n - 1)
+	nsub = NSUB
+	call dofit (fit, Memr[xd], Memr[yd], Memr[sd],
+	    nfit, dx, nsub, z1, dz, Memr[xg], Memr[yg], Memr[sg],
+	    Memr[lg], Memi[pg], ng, chisq)
+
+	# Compute Monte-Carlo errors.
+	mc_n = nerrsample
+	mc_p = nint (mc_n * MC_P / 100.)
+	mc_sig = nint (mc_n * MC_SIG / 100.)
+	if (doerr && mc_sig > 9) {
+	    call salloc (yd1, nfit, TY_REAL)
+	    call salloc (ym, nfit, TY_REAL)
+	    call salloc (xg1, ng, TY_REAL)
+	    call salloc (yg1, ng, TY_REAL)
+	    call salloc (sg1, ng, TY_REAL)
+	    call salloc (lg1, ng, TY_REAL)
+	    call salloc (conte, mc_n*ng, TY_REAL)
+	    call salloc (xge, mc_n*ng, TY_REAL)
+	    call salloc (yge, mc_n*ng, TY_REAL)
+	    call salloc (sge, mc_n*ng, TY_REAL)
+	    call salloc (lge, mc_n*ng, TY_REAL)
+	    call salloc (fluxe, mc_n*ng, TY_REAL)
+	    call salloc (eqwe, mc_n*ng, TY_REAL)
+	    do i = 1, nfit {
+		w = Memr[xd+i-1]
+		Memr[ym+i-1] = model (w, dx, nsub, Memr[xg], Memr[yg],
+		    Memr[sg], Memr[lg], Memi[pg], ng)
+	    }
+	    seed = 1
+	    do i = 0, mc_n-1 {
+		do j = 1, nfit
+		    Memr[yd1+j-1] = Memr[ym+j-1] +
+			sscale / scale * Memr[sd+j-1] * gasdev (seed)
+		wyc1 = z1
+		slope1 = dz
+		call amovr (Memr[xg], Memr[xg1], ng)
+		call amovr (Memr[yg], Memr[yg1], ng)
+		call amovr (Memr[sg], Memr[sg1], ng)
+		call amovr (Memr[lg], Memr[lg1], ng)
+		call dorefit (fit, Memr[xd], Memr[yd1], Memr[sd],
+		    nfit, dx, nsub, wyc1, slope1,
+		    Memr[xg1], Memr[yg1], Memr[sg1],
+		    Memr[lg1], Memi[pg], ng, chisq)
+
+		do j = 0, ng-1 {
+		    cont = y1 + z1 + (dy + dz) * Memr[xg+j] - dy * x1
+		    cont1 = y1 + wyc1 + (dy + slope1) * Memr[xg+j] - dy * x1
+		    switch (Memi[pg+j]) {
+		    case GAUSS:
+			flux = 1.064467 * Memr[yg+j] * Memr[sg+j]
+			flux1 = 1.064467 * Memr[yg1+j] * Memr[sg1+j]
+		    case LORENTZ:
+			flux = 1.570795 * Memr[yg+j] * Memr[lg+j]
+			flux1 = 1.570795 * Memr[yg1+j] * Memr[lg1+j]
+		    case VOIGT:
+			call voigt (0., 0.832555*Memr[lg+j]/Memr[sg+j], v, u)
+			flux = 1.064467 * Memr[yg+j] * Memr[sg+j] / v
+			call voigt (0., 0.832555*Memr[lg1+j]/Memr[sg1+j], v, u)
+			flux1 = 1.064467 * Memr[yg1+j] * Memr[sg1+j] / v
+		    }
+		    if (cont > 0. && cont1 > 0.) {
+			eqw = -flux / cont
+			eqw1 = -flux1 / cont1
+		    } else {
+			eqw = 0.
+			eqw1 = 0.
+		    }
+		    Memr[conte+j*mc_n+i] = abs (cont1 - cont)
+		    Memr[xge+j*mc_n+i] = abs (Memr[xg1+j] - Memr[xg+j])
+		    Memr[yge+j*mc_n+i] = abs (Memr[yg1+j] - Memr[yg+j])
+		    Memr[sge+j*mc_n+i] = abs (Memr[sg1+j] - Memr[sg+j])
+		    Memr[lge+j*mc_n+i] = abs (Memr[lg1+j] - Memr[lg+j])
+		    Memr[fluxe+j*mc_n+i] = abs (flux1 - flux)
+		    Memr[eqwe+j*mc_n+i] = abs (eqw1 - eqw)
+		}
+	    }
+	    do j = 0, ng-1 {
+		call asrtr (Memr[conte+j*mc_n], Memr[conte+j*mc_n], mc_n)
+		call asrtr (Memr[xge+j*mc_n], Memr[xge+j*mc_n], mc_n)
+		call asrtr (Memr[yge+j*mc_n], Memr[yge+j*mc_n], mc_n)
+		call asrtr (Memr[sge+j*mc_n], Memr[sge+j*mc_n], mc_n)
+		call asrtr (Memr[lge+j*mc_n], Memr[lge+j*mc_n], mc_n)
+		call asrtr (Memr[fluxe+j*mc_n], Memr[fluxe+j*mc_n], mc_n)
+		call asrtr (Memr[eqwe+j*mc_n], Memr[eqwe+j*mc_n], mc_n)
+	    }
+	    call amulkr (Memr[conte], scale, Memr[conte], mc_n*ng)
+	    call amulkr (Memr[yge], scale, Memr[yge], mc_n*ng)
+	    call amulkr (Memr[fluxe], scale, Memr[fluxe], mc_n*ng)
+	}
+
+	call amulkr (Memr[yg], scale, Memr[yg], ng)
+	y1 = (y1 + z1 + dz * x1) * scale
+	dy = (dy + dz) * scale
+
+	# Log computed values
+	call sprintf (Memc[str], SZ_LINE,
+	    "# Nfit=%d, background=%b, positions=%s, gfwhm=%s, lfwhm=%s\n")
+	    call pargi (ng)
+	    call pargb (fit[BKG] == SINGLE)
+	    if (fit[POS] == FIXED)
+		call pargstr ("fixed")
+	    else if (fit[POS] == SINGLE)
+		call pargstr ("single")
+	    else
+		call pargstr ("all")
+	    if (fit[GAU] == FIXED)
+		call pargstr ("fixed")
+	    else if (fit[GAU] == SINGLE)
+		call pargstr ("single")
+	    else
+		call pargstr ("all")
+	    if (fit[LOR] == FIXED)
+		call pargstr ("fixed")
+	    else if (fit[LOR] == SINGLE)
+		call pargstr ("single")
+	    else
+		call pargstr ("all")
+	if (log != NULL)
+	    call fprintf (log, Memc[str])
+	if (verbose)
+	    call printf (Memc[str])
+	call sprintf (Memc[str], SZ_LINE, "# %8s%10s%10s%10s%10s%10s%10s\n")
+	    call pargstr ("center")
+	    call pargstr ("cont")
+	    call pargstr ("flux")
+	    call pargstr ("eqw")
+	    call pargstr ("core")
+	    call pargstr ("gfwhm")
+	    call pargstr ("lfwhm")
+	if (log != NULL)
+	    call fprintf (log, Memc[str])
+	if (verbose)
+	    call printf (Memc[str])
+	do i = 1, ng {
+	    if (!rng_elementi (components, i))
+		next
+	    xc = Memr[xg+i-1]
+	    cont = y1 + dy * (xc - x1)
+	    peak = Memr[yg+i-1]
+	    gfwhm = Memr[sg+i-1]
+	    lfwhm = Memr[lg+i-1]
+	    switch (Memi[pg+i-1]) {
+	    case 1:
+		flux = 1.064467 * peak * gfwhm
+	    case 2:
+		flux = 1.570795 * peak * lfwhm
+	    case 3:
+		call voigt (0., 0.832555*lfwhm/gfwhm, v, u)
+		flux = 1.064467 * peak * gfwhm / v
+	    }
+
+	    if (cont > 0.)
+		eqw = -flux / cont
+	    else
+		eqw = INDEF
+
+	    call sprintf (Memc[str], SZ_LINE,
+		" %9.7g %9.7g %9.6g %9.4g %9.6g %9.4g %9.4g\n")
+		call pargr (xc)
+		call pargr (cont)
+		call pargr (flux)
+		call pargr (eqw)
+		call pargr (peak)
+		call pargr (gfwhm)
+		call pargr (lfwhm)
+	    if (log != NULL)
+		call fprintf (log, Memc[str])
+	    if (verbose)
+		call printf (Memc[str])
+	    if (doerr && mc_sig > 9) {
+		call sprintf (Memc[str], SZ_LINE,
+		" (%7.7g) (%7.7g) (%7.6g) (%7.4g) (%7.6g) (%7.4g) (%7.4g)\n")
+		    call pargr (Memr[xge+(i-1)*mc_n+mc_sig])
+		    call pargr (Memr[conte+(i-1)*mc_n+mc_sig])
+		    call pargr (Memr[fluxe+(i-1)*mc_n+mc_sig])
+		    call pargr (Memr[eqwe+(i-1)*mc_n+mc_sig])
+		    call pargr (Memr[yge+(i-1)*mc_n+mc_sig])
+		    call pargr (Memr[sge+(i-1)*mc_n+mc_sig])
+		    call pargr (Memr[lge+(i-1)*mc_n+mc_sig])
+		if (log != NULL)
+		    call fprintf (log, Memc[str])
+		if (verbose)
+		    call printf (Memc[str])
+	    }
+	}
+
+	# Compute model.
+	call aclrr (mod, n)
+	do i = 0, ng-1 {
+	    if (!rng_elementi (components, i+1))
+		next
+	    do j = 1, n
+		#mod[j] = model (x[j], dx, nsub, Memr[xg+i], Memr[yg+i],
+		#    Memr[sg+i], Memr[lg+i], Memi[pg+i], ng)
+		mod[j] = mod[j] + model (x[j], dx, nsub, Memr[xg+i], Memr[yg+i],
+		    Memr[sg+i], Memr[lg+i], Memi[pg+i], 1)
+	}
+
+	# Draw graphs
+	if (plot != NULL) {
+	    gp = gopen ("stdvdm", NEW_FILE, plot)
+	    call gascale (gp, y[i1], nfit, 2)
+	    call asubr (y[i1], mod[i1], Memr[yd], nfit)
+	    call grscale (gp, Memr[yd], nfit, 2)
+	    do i = i1, i2
+		Memr[yd+i-i1] = mod[i] + y1 + dy * (x[i] - x1)
+	    call grscale (gp, Memr[yd], nfit, 2)
+	    call gswind (gp, x1, x2, INDEF, INDEF)
+	    call glabax (gp, title, "", "")
+	    call gseti (gp, G_PLTYPE, 1)
+	    call gpline (gp, Memr[xd], y[i1], nfit)
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gpline (gp, Memr[xd], Memr[yd], nfit)
+	    call gline (gp, x1, y1, x2, y1+dy*(x2-x1))
+	    call gseti (gp, G_PLTYPE, 3)
+	    call asubr (y[i1], mod[i1], Memr[yd], nfit)
+	    call gpline (gp, Memr[xd], Memr[yd], nfit)
+	    call gseti (gp, G_PLTYPE, 4)
+	    do i = 0, ng-1 {
+		if (!rng_elementi (components, i+1))
+		    next
+		k = 0
+		do j = i1, i2 {
+		    w = x[j]
+		    z = model (w, dx, nsub, Memr[xg+i], Memr[yg+i],
+			Memr[sg+i], Memr[lg+i], Memi[pg+i], 1)
+		    z = z + y1 + dy * (w - x1)
+		    if (k == 0) {
+			call gamove (gp, w, z)
+			k = 1
+		    } else
+			call gadraw (gp, w, z)
+		}
+	    }
+	    call gclose (gp)
+	}
+
+	call sfree (sp)
+end
+
+
+# FP_BACKGROUND -- Iniital background.
+
+procedure fp_background (sh, x, y, n, x1, x2, y1, dy)
+
+pointer	sh			#I Spectrum pointer
+real	x[n]			#I Coordinate values
+real	y[n]			#I Data
+int	n			#I Number of data points
+real	x1, x2			#I Fit endpoints
+real	y1, dy			#O Background
+
+int	i, j, k, m, func
+real	xval[2], yval[2]
+double	z1, z2, z3
+pointer	sp, bkg, str
+
+int	ctotok(), ctor(), ctod(), strdic(), nscan()
+real	asumr(), amedr()
+double	shdr_wl(), shdr_lw()
+
+define	err_	10
+
+begin
+	call smark (sp)
+	call salloc (bkg, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	xval[1] = x1
+	xval[2] = x2
+
+	call clgstr ("background", Memc[bkg], SZ_LINE)
+	call sscan (Memc[bkg])
+	do j = 1, 2 {
+	    call gargwrd (Memc[bkg], SZ_LINE)
+	    if (nscan() != j) {
+		i = max (1, min (n, nint (shdr_wl (sh, double(xval[j])))))
+		xval[j] = shdr_lw (sh, double(i))
+		yval[j] = y[i]
+		next
+	    }
+
+	    k = 1
+	    if (ctor (Memc[bkg], k, yval[j]) == 0) {
+		if (ctotok (Memc[bkg], k, Memc[str], SZ_LINE) != TOK_IDENTIFIER)
+		    goto err_
+		func = strdic (Memc[str], Memc[str], SZ_LINE, "|avg|med|")
+		if (func == 0)
+		    goto err_
+		k = k + 1
+		if (ctod (Memc[bkg], k, z1) == 0)
+		    goto err_
+		k = k + 1
+		if (ctod (Memc[bkg], k, z2) == 0)
+		    goto err_
+		k = k + 1
+		if (ctod (Memc[bkg], k, z3) == 0)
+		    z3 = 1
+
+		z1 = shdr_wl (sh, z1)
+		z2 = shdr_wl (sh, z2)
+		i = max (1, nint(min(z1,z2)))
+		m = min (n, nint(max(z1,z2))) - i + 1
+		if (m < 1)
+		    goto err_
+
+		# This is included to eliminate an optimizer bug on solaris.
+		call sprintf (Memc[bkg], SZ_LINE, "%g %g %g %d %d\n")
+		    call pargd (z1)
+		    call pargd (z2)
+		    call pargd (z3)
+		    call pargi (i)
+		    call pargi (m)
+
+		switch (func) {
+		case 1:
+		    xval[j] = z3 * asumr (x[i], m) / m
+		    yval[j] = z3 * asumr (y[i], m) / m
+		case 2:
+		    xval[j] = z3 * asumr (x[i], m) / m
+		    yval[j] = z3 * amedr (y[i], m)
+		}
+	    }
+	}
+
+	if (xval[1] == xval[2]) {
+	   dy = 0.
+	   y1 = (yval[1] + yval[2]) / 2.
+	} else {
+	    dy = (yval[2] - yval[1]) / (xval[2] - xval[1])
+	    y1 = yval[1] + dy * (x1 - xval[1])
+	}
+	return
+    
+err_
+	call sfree (sp)
+	call error (1, "Syntax error in background specification")
+end
+
+
+include	<time.h>
+
+# FP_TITLE -- Set title string and print.
+
+procedure fp_title (sh, str, verbose, log)
+
+pointer	sh			# Spectrum header structure
+char	str[SZ_LINE]		# Title string
+bool	verbose			# Verbose?
+int	log			# Log file descriptor
+
+pointer	sp, time, smw
+long	clktime()
+
+begin
+	# Select title format.
+	smw = MW(sh)
+	switch (SMW_FORMAT(smw)) {
+	case SMW_ND:
+	    call sprintf (str, SZ_LINE, "%s%s: %s")
+		call pargstr (IMNAME(sh))
+		call pargstr (IMSEC(sh))
+		call pargstr (TITLE(sh))
+	case SMW_ES, SMW_MS:
+	    call sprintf (str, SZ_LINE, "%s - Ap %d: %s")
+		call pargstr (IMNAME(sh))
+		call pargi (AP(sh))
+		call pargstr (TITLE(sh))
+	}
+
+	# Set time and log header.
+	call smark (sp)
+	call salloc (time, SZ_DATE, TY_CHAR)
+	call cnvdate (clktime(0), Memc[time], SZ_DATE)
+       if (log != NULL) {
+	    call fprintf (log, "# %s %s\n")
+		call pargstr (Memc[time])
+		call pargstr (str)
+	}
+       if (verbose) {
+	    call printf ("# %s %s\n")
+		call pargstr (Memc[time])
+		call pargstr (str)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_lcalib.x b/noao/onedspec/t_lcalib.x
new file mode 100644
index 00000000..92f9a531
--- /dev/null
+++ b/noao/onedspec/t_lcalib.x
@@ -0,0 +1,98 @@
+include <ctype.h>
+
+define	VLIGHT	2.997925e18	# Speed of light in Angstroms/sec
+
+# Options
+define	OPTION	"|ext|mags|fnu|flam|bands|stars|"
+define	EXT	1	# Extinction
+define	MAGS	2	# Standard star magnitudes
+define	FNU	3	# Standard star fluxes
+define	FLAM	4	# Standard star fluxes
+define	BANDS	5	# Standard star band passes
+define	STARS	6	# Standard stars
+
+# T_LCALIB -- List information in calibration file:
+#		1) Extinction vs wavelength
+#		2) Magnitude vs wavelength
+#		3) F-nu vs wavelength
+#		4) F-lambda vs wavelength
+#		5) Bandpass vs wavelength
+#		6) Standard stars
+
+procedure t_lcalib ()
+
+int	i, nwaves, fd
+real	fnu, flam, fnuzero
+pointer	sp, str, file, waves, bands, mags, extns
+
+int	getline(), open(), clgwrd()
+real	clgetr()
+errchk	ext_load, getcalib
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (file, SZ_LINE, TY_CHAR)
+
+	#Switch on the option.
+	switch (clgwrd ("option", Memc[str], SZ_LINE, OPTION)) {
+	case EXT:
+	    call ext_load (waves, extns, nwaves)
+	    do i = 1, nwaves {
+	        call printf ("%6f %12.5g\n")
+		    call pargr (Memr[waves+i-1])
+		    call pargr (Memr[extns+i-1])
+	    }
+	    call ext_free (waves, extns)
+	case MAGS:
+	    call getcalib (waves, bands, mags, nwaves)
+	    do i = 1, nwaves {
+	        call printf ("%6f %12.5g\n")
+		    call pargr (Memr[waves+i-1])
+		    call pargr (Memr[mags+i-1])
+	    }
+	    call freecalib (waves, bands, mags)
+	case FNU:
+	    fnuzero = clgetr ("fnuzero")
+	    call getcalib (waves, bands, mags, nwaves)
+	    do i = 1, nwaves {
+		fnu = fnuzero * 10. ** (-0.4 * Memr[mags+i-1])
+	        call printf ("%6f %12.5g\n")
+		    call pargr (Memr[waves+i-1])
+		    call pargr (fnu)
+	    }
+	    call freecalib (waves, bands, mags)
+	case FLAM:
+	    fnuzero = clgetr ("fnuzero")
+	    call getcalib (waves, bands, mags, nwaves)
+	    do i = 1, nwaves {
+		fnu = fnuzero * 10. ** (-0.4 * Memr[mags+i-1])
+		flam = fnu * VLIGHT /  Memr[waves+i-1] ** 2
+	        call printf ("%6f %12.5g\n")
+		    call pargr (Memr[waves+i-1])
+		    call pargr (flam)
+	    }
+	    call freecalib (waves, bands, mags)
+	case BANDS:
+	    call getcalib (waves, bands, mags, nwaves)
+	    do i = 1, nwaves {
+	        call printf ("%6f %12.5g\n")
+		    call pargr (Memr[waves+i-1])
+		    call pargr (Memr[bands+i-1])
+	    }
+	    call freecalib (waves, bands, mags)
+	case STARS:
+	    call clgstr ("caldir", Memc[str], SZ_LINE)
+	    call sprintf (Memc[file], SZ_LINE, "%sstandards.men")
+		call pargstr (Memc[str])
+	    fd = open (Memc[file], READ_ONLY, TEXT_FILE)
+	    while (getline (fd, Memc[file]) != EOF)
+		call putline (STDERR, Memc[file]) 
+	    call close (fd)
+	default:
+	    call eprintf ("Unknown option: %s\n")
+		call pargstr (Memc[str])
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_mkspec.x b/noao/onedspec/t_mkspec.x
new file mode 100644
index 00000000..5264dbe2
--- /dev/null
+++ b/noao/onedspec/t_mkspec.x
@@ -0,0 +1,120 @@
+include	<imhdr.h>
+
+# T_MKSPEC -- Make a test artificial spectrum - May be 2 dimensional
+#           Options for the form of the spectrum currently include
+#              1 - Flat spectrum
+#              2 - Ramp
+#              3 - Black body - f-lambda
+
+procedure t_mkspec()
+
+char	spec[SZ_FNAME], sname[SZ_IMTITLE]
+int	ncols, nlines, func_type, i
+real	const1, const2, dconst, const
+real	wstart, wend, dw, temp, x, w, fmax
+real	c1, c2
+pointer	im, buf, sp, row
+
+pointer	immap(), impl1r(), impl2r()
+int	clgeti()
+real	clgetr()
+
+begin
+	# Initialize Black body constants
+	c1 = 3.7415e-5
+	c2 = 1.4388
+
+	# Get spectrum file name
+	call clgstr ("image_name", spec, SZ_FNAME)
+
+	# And title
+	call clgstr ("image_title", sname, SZ_IMTITLE)
+
+	# Length
+	ncols = clgeti ("ncols")
+
+	# Height
+	nlines = clgeti ("nlines")
+
+	# Pixel type
+
+	# Open image
+	im = immap (spec, NEW_IMAGE, 0)
+
+	# Load parameters
+	IM_LEN(im,1) = ncols
+	IM_LEN(im,2) = nlines
+	
+	# 1 or 2 Dimensional image
+	if (nlines > 1)
+	    IM_NDIM(im) = 2
+	else
+	    IM_NDIM(im) = 1
+
+	IM_PIXTYPE(im) = TY_REAL
+	call strcpy (sname, IM_TITLE(im), SZ_IMTITLE)
+	
+
+	func_type = clgeti ("function")
+
+	# Get additional parameters for functin types
+	switch (func_type) {
+
+	    # Flat spectrum
+	    case 1:
+		const = clgetr ("constant")
+
+	    # Ramp spectrum
+	    case 2:
+		const1 = clgetr ("start_level")
+		const2 = clgetr ("end_level")
+		dconst = (const2 - const1) / (ncols - 1)
+
+	    # Black body
+	    case 3:
+		wstart = clgetr ("start_wave")		# Start wave Angstroms
+		wend   = clgetr ("end_wave")		# End wave
+		temp   = clgetr ("temperature")		# BB temp deg.K
+		dw     = (wend - wstart) / (ncols - 1)
+		w      = wstart * 1.0e-8		# Convert to cm.
+		fmax   = 1.2865e-4 * temp**5		# Peak f-lambda
+
+	    default:
+		call error (1, "Unknown Function type")
+	}
+
+	# Allocate space for a row since each row will be duplicated
+	# NLINES times
+	call smark (sp)
+	call salloc (row, ncols, TY_REAL)
+
+	# Fill a row
+	do i = 1, ncols {
+	    switch (func_type) {
+	    case 1:
+		Memr[row+i-1] = const
+	    case 2:
+		Memr[row+i-1] = const1 + (i-1) * dconst
+	    case 3:
+		x = exp (c2 /w /temp)
+		Memr[row+i-1] = (c1 / w**5 / (x-1.0)) / fmax
+		w = w + dw * 1.0e-8
+	    }
+	}
+
+	# Write all lines out
+	do i = 1, nlines {
+
+	    # Access either 1 or 2 dimensional line
+	    if (nlines > 1)
+		buf = impl2r (im,i)
+	    else
+		buf = impl1r (im)
+
+	    # Copy saved row to output image
+	    call amovr (Memr[row], Memr[buf], ncols)
+	}
+
+	call sfree (sp)
+	call imunmap (im)
+end
diff --git a/noao/onedspec/t_names.x b/noao/onedspec/t_names.x
new file mode 100644
index 00000000..b6f81fe9
--- /dev/null
+++ b/noao/onedspec/t_names.x
@@ -0,0 +1,45 @@
+# T_NAMES -- Expand record extension format into a list of images.
+
+procedure t_names ()
+
+pointer	list			# Input record list
+pointer	append			# String to append to name
+bool	check			# Check existence of image?
+
+int	imtgetim()
+bool	clgetb()
+pointer	sp, image, im, imtopenp(), immap()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (append, SZ_LINE, TY_CHAR)
+
+	# Get parameters.
+	list = imtopenp ("input")
+	call clgstr ("records", Memc[append], SZ_LINE)
+	call odr_openp (list, Memc[append])
+	call clgstr ("append", Memc[append], SZ_LINE)
+	check = clgetb ("check")
+
+	# Loop over all input images - print name on STDOUT
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+	    # Open image if check for existence required
+	    if (check) {
+		ifnoerr (im = immap (Memc[image], READ_ONLY, 0)) {
+		    call printf ("%s%s\n")
+			call pargstr (Memc[image])
+			call pargstr (Memc[append])
+		    call imunmap (im)
+		}
+	    } else {
+		call printf ("%s%s\n")
+		    call pargstr (Memc[image])
+		    call pargstr (Memc[append])
+	    }
+	    call flush (STDOUT)
+	}
+
+	call imtclose (list)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_rstext.x b/noao/onedspec/t_rstext.x
new file mode 100644
index 00000000..16efa1dc
--- /dev/null
+++ b/noao/onedspec/t_rstext.x
@@ -0,0 +1,91 @@
+# T_RSTEXT -- This procedure replaces the following CL script code to
+# make the RSPECTEXT script efficient.  It also determines whether there
+# is a header rather than requiring the user to specify it.
+#
+#	# Separate the header and flux values for RTEXTIMAGE and the
+#	# wavelengths for later use.
+#
+#	fd = specin
+#	if (header) {
+#	    while (fscan (fd, line) != EOF) {
+#		print (line, >> temp1)
+#		if (substr (line,1,3) == "END")
+#		    break
+#	    }
+#	}
+#	dim = 0
+#	while (fscan (fd, x, y) != EOF) {
+#	    if (nscan() == 2) {
+#		print (y, >> temp1)
+#		print (x, >> temp2)
+#		dim = dim + 1
+#	    }
+#	}
+
+procedure t_rstext ()
+
+pointer	input		# Input RSPECTEXT text file
+pointer	output1		# Output text file for RTEXTIMAGE
+pointer	output2		# Output text file for DISPCOR
+
+int	in, out1, out2, dim
+bool	header
+real	x, y
+pointer	sp, line
+int	open(), getline(), strncmp(), fscan(), nscan()
+errchk	open
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output1, SZ_FNAME, TY_CHAR)
+	call salloc (output2, SZ_FNAME, TY_CHAR)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	call clgstr ("input", Memc[input], SZ_FNAME)
+	call clgstr ("output1", Memc[output1], SZ_FNAME)
+	call clgstr ("output2", Memc[output2], SZ_FNAME)
+
+	in = open (Memc[input], READ_ONLY, TEXT_FILE)
+	out1 = open (Memc[output1], NEW_FILE, TEXT_FILE)
+	out2 = open (Memc[output2], NEW_FILE, TEXT_FILE)
+
+	header = false
+	while (getline (in, Memc[line]) != EOF) {
+	    if (strncmp (Memc[line], "END", 3) == 0) {
+		header = true
+		break
+	    }
+	}
+	call seek (in, BOF)
+
+	if (header) {
+	    while (getline (in, Memc[line]) != EOF) {
+		call putline (out1, Memc[line])
+		if (strncmp (Memc[line], "END", 3) == 0)
+		    break
+	    }
+	}
+
+	dim = 0
+	while (fscan (in) != EOF) {
+	    call gargr (x)
+	    call gargr (y)
+	    if (nscan() != 2)
+		next
+	    call fprintf (out1, "%g\n")
+		call pargr (y)
+	    call fprintf (out2, "%g\n")
+		call pargr (x)
+	    dim = dim + 1
+	}
+
+	call printf ("%b %d\n")
+	    call pargb (header)
+	    call pargi (dim)
+
+	call close (out2)
+	call close (out1)
+	call close (in)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_sapertures.x b/noao/onedspec/t_sapertures.x
new file mode 100644
index 00000000..4aa0c16f
--- /dev/null
+++ b/noao/onedspec/t_sapertures.x
@@ -0,0 +1,428 @@
+include	<error.h>
+include	<imhdr.h>
+include	<smw.h>
+
+define	LEN_SAP		52		# Length of structure
+define	LEN_SAPTITLE	79		# Length of title
+
+define	AP	Memi[$1]		# Aperture number
+define	BEAM	Memi[$1+1]		# Beam number
+define	DTYPE	Memi[$1+2]		# Dispersion type
+define	W1	Memd[P2D($1+4)]		# Starting wavelength
+define	DW	Memd[P2D($1+6)]		# Wavelength per pixel
+define	Z	Memd[P2D($1+8)]		# Doppler factor
+define	APLOW	Memr[P2R($1+10)]	# Low aperture
+define	APHIGH	Memr[P2R($1+11)]	# High aperture
+define	TITLE	Memc[P2C($1+12)]	# Title
+ 
+ 
+# T_SAPERTURES -- Set aperture beam numbers and titles.
+ 
+procedure t_sapertures()
+ 
+int	list			# Input list
+bool	wcsreset		# Reset WCS?
+bool	verbose			# Verbose?
+pointer	saps			# Pointer to array of aperture structures
+ 
+int	imtopenp(), imtgetim()
+bool	clgetb()
+pointer	sp, input, ranges, tmp, im, mw, rng_open(), immap(), smw_openim()
+errchk	sap_gids, immap, smw_openim
+ 
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+
+	list = imtopenp ("input")
+	wcsreset = clgetb ("wcsreset")
+	verbose = clgetb ("verbose")
+	call clgstr ("apertures", Memc[input], SZ_FNAME)
+	iferr (ranges = rng_open (Memc[input], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture list")
+
+	call sap_gids (saps, wcsreset, verbose)
+	
+	while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) {
+	    im = NULL
+	    mw = NULL
+	    iferr {
+	        tmp = immap (Memc[input], READ_WRITE, 0); im = tmp
+		tmp = smw_openim (im); mw = tmp
+		if (SMW_FORMAT(mw) != SMW_ES && SMW_FORMAT(mw) != SMW_MS)
+		    call error (1, "Wrong spectrum format")
+		call sap_ms (im, mw, Memc[input], ranges, saps, verbose)
+	    } then
+		call erract (EA_WARN)
+
+	    if (mw != NULL) {
+		call smw_saveim (mw, im)
+		call smw_close (mw)
+	    }
+	    if (im != NULL)
+		call imunmap (im)
+	}
+
+	call rng_close (ranges)
+	call imtclose (list)
+	call sap_fids (saps)
+	call sfree (sp)
+end
+
+
+# SAP_MS -- Set aperture information
+
+procedure sap_ms (im, mw, input, ranges, saps, verbose)
+
+pointer	im			# IMIO pointer
+pointer	mw			# SMW pointer
+char	input[ARB]		# Image name
+pointer	ranges			# Aperture range list
+pointer	saps			# Pointer to array of aperture structures
+bool	verbose			# Verbose?
+
+int	i, naps, ap, beam, dtype, nw, obeam, odtype
+double	w1, dw, z, ow1, odw, oz
+real	aplow[2], aphigh[2], oaplow[2], oaphigh[2]
+bool	newtitle, streq(), rng_elementi()
+pointer	sp, title, coeff, sap
+
+begin
+	call smark (sp)
+	call salloc (title, SZ_LINE, TY_CHAR)
+	coeff = NULL
+ 
+	# Go through each spectrum and change the selected apertures.
+	naps = -1
+	do i = 1, SMW_NSPEC(mw) {
+	    # Get aperture info
+	    iferr (call smw_gwattrs (mw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, coeff))
+		break
+
+	    # Check if aperture is to be changed
+	    if (!rng_elementi (ranges, ap))
+		next
+
+	    # Check for aperture info
+	    for (sap = saps; Memi[sap] != NULL; sap = sap + 1)
+		if (ap == AP(Memi[sap]))
+		    break
+	    if (Memi[sap] == NULL) {
+		for (sap = saps; Memi[sap] != NULL; sap = sap + 1)
+		    if (IS_INDEFI (AP(Memi[sap])))
+			break
+	    }
+	    if (Memi[sap] == NULL)
+		next
+
+	    # Get aperture title
+	    call smw_gapid (mw, i, 1, Memc[title], SZ_LINE)
+
+	    # Set new aperture values
+	    sap = Memi[sap]
+	    obeam = BEAM(sap)
+	    odtype = DTYPE(sap)
+	    ow1 = W1(sap)
+	    odw = DW(sap)
+	    oz = Z(sap)
+	    oaplow[1] = APLOW(sap)
+	    oaphigh[1] = APHIGH(sap)
+	    oaplow[2] = INDEF
+	    oaphigh[2] = INDEF
+
+	    if (IS_INDEFI (obeam))
+		obeam = beam
+	    if (IS_INDEFI (odtype))
+		odtype = dtype
+	    else
+		odtype = max (-1, min (1, odtype))
+	    if (IS_INDEFD (ow1))
+		ow1 = w1
+	    if (IS_INDEFD (odw))
+		odw = dw
+	    if (IS_INDEFD (oz))
+		oz = z
+	    if (IS_INDEF (oaplow[1]))
+		oaplow[1] = aplow[1]
+	    if (IS_INDEF (oaphigh[1]))
+		oaphigh[1] = aphigh[1]
+	    if (streq (TITLE(sap), "INDEF") || TITLE(sap) == EOS)
+		newtitle = false
+	    else
+		newtitle = !streq (TITLE(sap), Memc[title])
+
+	    if (dtype == 2 && odtype != 2)
+		Memc[coeff] = EOS
+
+	    # Make change if needed
+	    if (obeam!=beam || odtype!=dtype || ow1!=w1 || odw !=dw || oz!=z ||
+		oaplow[1]!=aplow[1] || oaphigh[1]!=aphigh[1] || newtitle) {
+		call smw_swattrs (mw, i, 1, ap, obeam, odtype, ow1, odw, nw,
+		    oz, oaplow, oaphigh, Memc[coeff])
+		if (newtitle)
+		    call smw_sapid (mw, i, 1, TITLE(sap))
+		naps = naps + 1
+
+		# Make record
+		if (verbose) {
+		    if (naps == 0) {
+			call printf ("%s:\n")
+			    call pargstr (input)
+			naps = naps + 1
+		    }
+		    call printf ("  Aperture %d:\n")
+			call pargi (ap)
+		    if (obeam != beam) {
+			call printf ("    beam %d --> %d\n")
+			    call pargi (beam)
+			    call pargi (obeam)
+		    }
+		    if (odtype != dtype) {
+			call printf ("    dtype %d --> %d\n")
+			    call pargi (dtype)
+			    call pargi (odtype)
+		    }
+		    if (ow1 != w1) {
+			call printf ("    w1 %g --> %g\n")
+			    call pargd (w1)
+			    call pargd (ow1)
+		    }
+		    if (odw != dw) {
+			call printf ("    dw %g --> %g\n")
+			    call pargd (dw)
+			    call pargd (odw)
+		    }
+		    if (oz != z) {
+			call printf ("    z %g --> %g\n")
+			    call pargd (z)
+			    call pargd (oz)
+		    }
+		    if (oaplow[1] != aplow[1]) {
+			call printf ("    aplow %g --> %g\n")
+			    call pargr (aplow[1])
+			    call pargr (oaplow[1])
+		    }
+		    if (oaphigh[1] != aphigh[1]) {
+			call printf ("    aphigh %g --> %g\n")
+			    call pargr (aphigh[1])
+			    call pargr (oaphigh[1])
+		    }
+		    if (newtitle) {
+			call printf ("    apid %s --> %s\n")
+			    call pargstr (Memc[title])
+			    call pargstr (TITLE(sap))
+		    }
+		}
+	    }
+	}
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# SA_GIDS -- Get user aperture ID's.
+
+procedure sap_gids (saps, wcsreset, verbose)
+
+pointer	saps			# Pointer to array of aperture structures
+bool	wcsreset		# Reset WCS?
+bool	verbose			# Verbose (negative beam warning)?
+pointer	sap
+
+int	naps, ap, beam, fd, nalloc
+double	ra, dec
+pointer	sp, str, key, im, list
+
+real	clgetr()
+double	clgetd()
+int	nowhite(), open(), fscan(), nscan(), clgeti()
+pointer	immap(), imofnlu(), imgnfn()
+errchk	open
+
+begin
+
+	# If resetting ignore the APIDTABLE and the task parameters.
+	if (wcsreset) {
+	    call malloc (saps, 2, TY_POINTER)
+	    call malloc (Memi[saps], LEN_SAP, TY_STRUCT)
+	    Memi[saps+1] = NULL
+
+	    sap = Memi[saps]
+	    AP(sap) = INDEFI
+	    BEAM(sap) = INDEFI
+	    DTYPE(sap) = -1
+	    W1(sap) = 1.
+	    DW(sap) = 1.
+	    Z(sap) = 0.
+	    APLOW(sap) = INDEF
+	    APHIGH(sap) = INDEF
+	    TITLE(sap) = EOS
+	    return
+	}
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call clgstr ("apidtable", Memc[str], SZ_LINE)
+
+	# Set parameters from an APIDTABLE if given.
+	naps = 0
+	if (nowhite (Memc[str], Memc[str], SZ_LINE) > 0) {
+	    iferr {
+		# Read aperture information from an image.
+		ifnoerr (im = immap (Memc[str], 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)
+			call gargi (beam)
+			if (nscan() < 2)
+			    next
+			if (!IS_INDEFI(beam) && beam < 0 && verbose) {
+			    call eprintf (
+			    "Negative beam number for aperture %d ignored.\n") 
+				call pargi (ap)
+			    beam = INDEFI
+			}
+			if (naps == 0) {
+			    nalloc = 50
+			    call malloc (saps, nalloc, TY_POINTER)
+			} else if (naps == nalloc) {
+			    nalloc = nalloc + 50
+			    call realloc (saps, nalloc, TY_POINTER)
+			}
+			call malloc (Memi[saps+naps], LEN_SAP, TY_STRUCT)
+
+			sap = Memi[saps+naps]
+			AP(sap) = ap
+			BEAM(sap) = beam
+			call gargd (ra)
+			call gargd (dec)
+                        if (nscan() != 4) {
+                            call reset_scan ()
+                            call gargi (ap)
+                            call gargi (beam)
+			    call gargstr (TITLE(sap), LEN_SAPTITLE)
+                        } else {
+                            Memc[str] = EOS
+                            call gargstr (Memc[str], SZ_LINE)
+                            call xt_stripwhite (Memc[str])
+                            if (Memc[str] == EOS) {
+                                call sprintf (TITLE(sap), LEN_SAPTITLE,
+                                    "(%.2h %.2h)")
+                                    call pargd (ra)
+                                    call pargd (dec)
+                            } else {
+                                call sprintf (TITLE(sap), LEN_SAPTITLE,
+                                    "%s (%.2h %.2h)")
+                                    call pargstr (Memc[str])
+                                    call pargd (ra)
+                                    call pargd (dec)
+                            }
+                        }
+			DTYPE(sap) = INDEFI
+			W1(sap) = INDEFD
+			DW(sap) = INDEFD
+			Z(sap) = INDEFD
+			APLOW(sap) = INDEF
+			APHIGH(sap) = INDEF
+			call xt_stripwhite (TITLE(sap))
+			naps = naps + 1
+		    }	
+		    call imcfnl (list)
+		    call imunmap (im)
+
+		# Read aperture information from a file.
+		} else {
+		    fd = open (Memc[str], READ_ONLY, TEXT_FILE)
+		    while (fscan (fd) != EOF) {
+			call gargi (ap)
+			call gargi (beam)
+			if (nscan() < 2)
+			    next
+			if (!IS_INDEFI(beam) && beam < 0 && verbose) {
+			    call eprintf (
+			    "Negative beam number for aperture %d ignored.\n") 
+				call pargi (ap)
+			    beam = INDEFI
+			}
+			if (naps == 0) {
+			    nalloc = 50
+			    call malloc (saps, nalloc, TY_POINTER)
+			} else if (naps == nalloc) {
+			    nalloc = nalloc + 50
+			    call realloc (saps, nalloc, TY_POINTER)
+			}
+			call malloc (Memi[saps+naps], LEN_SAP, TY_STRUCT)
+
+			sap = Memi[saps+naps]
+			AP(sap) = ap
+			BEAM(sap) = beam
+			call gargi (DTYPE(sap))
+			call gargd (W1(sap))
+			call gargd (DW(sap))
+			call gargd (Z(sap))
+			call gargr (APLOW(sap))
+			call gargr (APHIGH(sap))
+			call gargstr (TITLE(sap), LEN_SAPTITLE)
+			if (nscan() < 9) {
+			    call reset_scan()
+			    call gargi (AP(sap))
+			    call gargi (BEAM(sap))
+			    if (!IS_INDEFI(BEAM(sap)) && BEAM(sap) < 0)
+				BEAM(sap) = INDEFI
+			    call gargstr (TITLE(sap), LEN_SAPTITLE)
+			    DTYPE(sap) = INDEFI
+			    W1(sap) = INDEFD
+			    DW(sap) = INDEFD
+			    Z(sap) = INDEFD
+			    APLOW(sap) = INDEF
+			    APHIGH(sap) = INDEF
+			}
+			call xt_stripwhite (TITLE(sap))
+			naps = naps + 1
+		    }	
+		    call close (fd)
+		}
+	    } then
+		call erract (EA_WARN)
+	}
+
+	# Set remaining default parameters and the list terminator.
+	call realloc (saps, naps+2, TY_INT)
+	call malloc (Memi[saps+naps], LEN_SAP, TY_STRUCT)
+	Memi[saps+naps+1] = NULL
+
+	sap = Memi[saps+naps]
+	AP(sap) = INDEFI
+	BEAM(sap) = clgeti ("beam")
+	if (!IS_INDEFI(BEAM(sap)) && BEAM(sap) < 0 && verbose) {
+	    call eprintf (
+		"Negative default beam number ignored.\n") 
+	    BEAM(sap) = INDEFI
+	}
+	DTYPE(sap) = clgeti ("dtype")
+	W1(sap) = clgetd ("w1")
+	DW(sap) = clgetd ("dw")
+	Z(sap) = clgetd ("z")
+	APLOW(sap) = clgetr ("aplow")
+	APHIGH(sap) = clgetr ("aphigh")
+	call clgstr ("title", TITLE(sap), LEN_SAPTITLE)
+
+	call sfree (sp)
+end
+
+
+procedure sap_fids (saps)
+
+pointer	saps			# Pointer to array of aperture structures
+pointer	sap
+
+begin
+	for (sap=saps; Memi[sap] != NULL; sap = sap + 1)
+	    call mfree (Memi[sap], TY_STRUCT)
+	call mfree (saps, TY_POINTER)
+end
diff --git a/noao/onedspec/t_sarith.x b/noao/onedspec/t_sarith.x
new file mode 100644
index 00000000..460ebd7a
--- /dev/null
+++ b/noao/onedspec/t_sarith.x
@@ -0,0 +1,1423 @@
+include	<error.h>
+include	<imhdr.h>
+include	<mach.h>
+include	<smw.h>
+ 
+# Output formats.
+define	FORMATS		"|multispec|onedspec|"
+
+# Operations.
+define	OPS	"|abs|copy|dex|exp|flam|fnu|inv|ln|log|lum|mag|sqrt\
+		 |replace|+|-|*|/|^|"
+define	ABS	1
+define	COPY	2
+define	DEX	3
+define	EXP	4
+define	FLAM	5
+define	FNU	6
+define	INV	7
+define	LN	8
+define	LOG	9
+define	LUM	10
+define	MAG	11
+define	SQRT	12
+
+define	REP	13
+define	ADD	14
+define	SUB	15
+define	MUL	16
+define	DIV	17
+define	POW	18
+
+
+# T_SARITH -- Arithmetic operations (including copying) on spectra.
+ 
+procedure t_sarith()
+ 
+int	inlist1			# List of input spectra
+int	op			# Operation
+int	inlist2			# List of input spectra or operands
+int	outlist			# List of output spectra
+double	w1			# Starting wavelength
+double	w2			# Ending wavelength
+bool	rebin			# Rebin wavelength region?
+int	format			# Output format
+pointer	aps			# Aperture/col/line list
+pointer	bands			# Band list
+pointer	beams			# Beam list
+bool	complement		# Complement aperture/beam selection
+int	apmod			# Aperture modulus (used with subapertures)
+int	offset			# Add this offset to apertures on output
+bool	reverse			# Reverse order of operands
+bool	ignoreaps		# Ignore apertures?
+bool	clobber			# Clobber existing images?
+bool	merge			# Merge with existing images?
+bool	renumber		# Renumber apertures?
+bool	verbose			# Verbose?
+real	errval			# Error value
+ 
+int	list1, list2
+pointer	sp, input1, opstr, input2, output, ptr
+ 
+double	clgetd()
+int	imtopenp(), imtopen(), imtlen(), imtgetim()
+int	clgwrd(), clgeti()
+bool	clgetb()
+pointer	rng_open()
+common	/sarith/ errval
+ 
+begin
+	call smark (sp)
+	call salloc (input1, SZ_LINE, TY_CHAR)
+	call salloc (opstr, SZ_LINE, TY_CHAR)
+	call salloc (input2, SZ_LINE, TY_CHAR)
+	call salloc (output, SZ_LINE, TY_CHAR)
+ 
+	# Get parameters.
+	inlist1 = imtopenp ("input1")
+	op = clgwrd ("op", Memc[opstr], SZ_LINE, OPS)
+	if (op > SQRT)
+	    inlist2 = imtopenp ("input2")
+	else
+	    inlist2 = imtopen ("")
+	outlist = imtopenp ("output")
+
+	w1 = clgetd ("w1")
+	w2 = clgetd ("w2")
+	if (IS_INDEFD(w1) && IS_INDEFD(w2))
+	    rebin = false
+	else
+	    rebin = clgetb ("rebin")
+
+	format = clgwrd ("format", Memc[input1], SZ_LINE, FORMATS)
+	call clgstr ("apertures", Memc[input1], SZ_LINE)
+	call clgstr ("bands", Memc[input2], SZ_LINE)
+	call clgstr ("beams", Memc[output], SZ_LINE)
+	apmod = clgeti ("apmodulus")
+	offset = clgeti ("offset")
+	reverse = clgetb ("reverse")
+	ignoreaps = clgetb ("ignoreaps")
+	clobber = clgetb ("clobber")
+	merge = clgetb ("merge")
+	renumber = clgetb ("renumber")
+	verbose = clgetb ("verbose")
+	errval = clgetd ("errval")
+ 
+	if (op == 0)
+	    call error (1, "Unknown operation")
+
+	# Decode range strings and set complement if needed
+	ptr = input1
+	complement = false
+	if (Memc[ptr] == '!') {
+	    complement = true
+	    ptr = ptr + 1
+	}
+	iferr (aps = rng_open (Memc[ptr], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture/column/line list")
+
+	ptr = input2
+	if (Memc[ptr] == '!') {
+	    complement = true
+	    ptr = ptr + 1
+	}
+	iferr (bands = rng_open (Memc[ptr], INDEF, INDEF, INDEF))
+	    call error (0, "Bad band list")
+
+	ptr = output
+	if (Memc[ptr] == '!') {
+	    complement = true
+	    ptr = ptr + 1
+	}
+	iferr (beams = rng_open (Memc[ptr], INDEF, INDEF, INDEF))
+	    call error (0, "Bad beam list")
+
+	# Check lists.
+	if (imtlen (outlist) > 1 && imtlen (outlist) != imtlen (inlist1))
+	    call error (1, "Input and output image lists don't make sense")
+	if (op > SQRT &&
+	    imtlen (inlist2) > 1 && imtlen (inlist2) != imtlen (inlist1))
+	    call error (1, "Input operand lists don't make sense")
+ 
+	# Do the operations.
+	while (imtgetim (inlist1, Memc[input1], SZ_LINE) != EOF) {
+	    if (imtgetim (inlist2, Memc[output], SZ_LINE) == EOF)
+		call strcpy (Memc[input2], Memc[output], SZ_LINE)
+	    call strcpy (Memc[output], Memc[input2], SZ_LINE)
+
+	    if (imtlen (outlist) > 1) {
+		list1 = imtopen (Memc[input1])
+		list2 = imtopen (Memc[input2])
+	    } else {
+		list1 = inlist1
+		list2 = inlist2
+	    }
+
+	    switch (format) {
+	    case 1:
+		if (imtgetim (outlist, Memc[output], SZ_LINE) == EOF)
+		    call strcpy (Memc[input1], Memc[output], SZ_LINE)
+		call imgimage (Memc[output], Memc[output], SZ_LINE)
+		call sa_ms (list1, list2, Memc[output], op, Memc[opstr],
+		    w1, w2, rebin, aps, bands, beams, complement, apmod,
+		    offset, reverse, ignoreaps, clobber, merge, renumber,
+		    verbose)
+	    case 2:
+		call sa_getim (outlist, Memc[input1], Memc[output], SZ_LINE)
+		call imgimage (Memc[output], Memc[output], SZ_LINE)
+		call sa_1d (list1, list2, Memc[output], op, Memc[opstr],
+		    w1, w2, rebin, aps, bands, beams, complement, apmod,
+		    offset, reverse, ignoreaps, clobber, renumber, verbose)
+	    }
+
+	    if (list1 != inlist1) {
+		call imtclose (list1)
+		call imtclose (list2)
+	    }
+	}
+
+	call rng_close (aps)
+	call rng_close (bands)
+	call rng_close (beams)
+	call imtclose (inlist1)
+	call imtclose (inlist2)
+	call imtclose (outlist)
+	call sfree (sp)
+end
+
+
+# SA_MS -- Operate on input list to multispec output
+ 
+procedure sa_ms (list1, list2, output, op, opstr, w1, w2, rebin,
+	aps, bands, beams, complement, apmod, offset, reverse, ignoreaps,
+	clobber, merge, renumber, verbose)
+
+int	list1			# Input image list
+int	list2			# Input image list
+char	output[ARB]		# Output image
+int	op			# Operation
+char	opstr[ARB]		# Operation string
+double	w1			# Starting wavelength
+double	w2			# Ending wavelength
+bool	rebin			# Rebin wavelength region?
+pointer	aps			# Apertures/columns/lines
+pointer	bands			# Bands
+pointer	beams			# Beams
+bool	complement		# Complement aperture/beam selection
+int	apmod			# Aperture modulus
+int	offset			# Offset to add to output aperture numbers
+bool	reverse			# Reverse order of operands
+bool	ignoreaps		# Ignore apertures?
+bool	clobber			# Clobber existing image?
+bool	merge			# Merge with existing image?
+bool	renumber		# Renumber apertures?
+bool	verbose			# Verbose output?
+
+bool	select, same
+real	aplow[2], aphigh[2]
+double	l1, dl, a, b, w, wb, dw, z, p1, p2, p3
+int	i, j, k, l, nin
+int	ap, beam, dtype, nw, err
+int	ninaps, noutaps, naps, npts, nbands, mwoutdim
+int	last, op1, axis[3]
+pointer	ptr, in1, in2, out, outtmp, mwtmp, mwin1, mwin2, mwout
+pointer	sh1, sh2, shout, const, coeff, inaps, outaps
+pointer	sp, str, str1, key, input1, input2, temp, ltm1, ltv1, ltm2, ltv2
+
+double	shdr_lw()
+int	imaccess(), ctod()
+int	imtlen(), imtgetim(), imgnfn()
+bool	strne(), rng_elementi(), fp_equald()
+pointer	immap() , imgl3r(), impl3r(), imofnlu()
+pointer	smw_openim(), mw_open()
+errchk	immap, smw_openim, mw_open, imunmap, imgstr, imdelete
+errchk	imgl3r, impl3r
+errchk	shdr_open, sa_sextract
+data	axis/1,2,3/
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (input1, SZ_FNAME, TY_CHAR)
+	call salloc (input2, SZ_FNAME, TY_CHAR)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (ltm1, 3*3, TY_DOUBLE)
+	call salloc (ltv1, 3, TY_DOUBLE)
+	call salloc (ltm2, 3*3, TY_DOUBLE)
+	call salloc (ltv2, 3, TY_DOUBLE)
+	call malloc (coeff, 1, TY_CHAR)
+	const = NULL
+
+	# Initialize.
+	Memc[input2] = EOS
+	in1 = NULL; in2 = NULL; out = NULL; outtmp=NULL; mwtmp = NULL
+	mwin1 = NULL; mwin2 = NULL; mwout = NULL
+	sh1 = NULL; sh2 = NULL; shout = NULL
+	ninaps = 0; noutaps = 0; nbands = 0
+	l1 = 1.; dl = 1.
+	err = NO
+
+	iferr {
+	# Check for existing output image and abort if clobber is not set.
+	if (imaccess (output, READ_ONLY) == YES) {
+	    if (!clobber) {
+		call sprintf (Memc[str], SZ_LINE,
+		    "Output spectrum %s already exists")
+		    call pargstr (output)
+		call error (1, Memc[str])
+	    } else if (merge) {
+		# Open the output and check the type.
+		ptr = immap (output, READ_ONLY, 0); out = ptr
+		ptr = smw_openim (out); mwout = ptr
+		if (SMW_FORMAT(mwout) == SMW_ND) {
+		    call sprintf (Memc[str], SZ_LINE, "%s - Wrong format")
+			call pargstr (output)
+		    call error (1, Memc[str])
+		}
+
+		# Determine existing apertures and renumber them if needed
+		noutaps = SMW_NSPEC(mwout)
+		nbands = SMW_NBANDS(mwout)
+		call salloc (outaps, noutaps, TY_INT)
+		do i = 1, noutaps {
+		    call shdr_open (out, mwout, i, 1, INDEFI, SHHDR, sh2)
+		    if (renumber)
+			Memi[outaps+i-1] = i + offset
+		    else
+			Memi[outaps+i-1] = AP(sh2)
+		}
+	    }
+	    call mktemp ("temp", Memc[temp], SZ_FNAME)
+	} else
+	    call strcpy (output, Memc[temp], SZ_FNAME)
+
+	# Open input list.  Determine the number of final output apertures
+	# and maximum length in order to set the output dimensions.  Check
+	# also that there is data to copy.
+
+	call imtrew (list1)
+	nin = imtlen (list1)
+	npts = 0
+	naps = noutaps
+	while (imtgetim (list1, Memc[input1], SZ_FNAME) != EOF) {
+	    iferr {
+	    in1 = NULL
+	    mwin1 = NULL
+
+	    ptr = immap (Memc[input1], READ_ONLY, 0); in1 = ptr
+	    ptr = smw_openim (in1); mwin1 = ptr
+
+	    j = 1
+	    if (SMW_FORMAT(mwin1) != SMW_ND) {
+		j = 0
+		do i = 1, SMW_NBANDS(mwin1) {
+		    select = rng_elementi (bands, i)
+		    if (!select)
+			next
+		    j = j + 1
+		}
+		if (j == 0)
+		    call error (1, "No bands selected in image")
+	    }
+	    nbands = max (j, nbands)
+
+	    do i = 1, SMW_NSPEC(mwin1) {
+		call shdr_open (in1, mwin1, i, 1, INDEFI, SHHDR, sh1)
+		ap = AP(sh1)
+		if (SMW_FORMAT(mwin1) == SMW_ND) {
+		    call smw_mw (mwin1, i, 1, ptr, j, k)
+		    select = rng_elementi (aps, j) && rng_elementi (bands, k)
+		} else {
+		    j = ap
+		    if (apmod > 1)
+			j = mod (j, apmod)
+		    select = rng_elementi (aps, j)
+		}
+
+		select = select && rng_elementi (beams, BEAM(sh1))
+		if ((complement && select) || (!complement && !select))
+		    next
+		if (renumber)
+		    ap = naps + 1
+		ap = ap + offset
+		for (j=0; j<noutaps && Memi[outaps+j]!=ap; j=j+1)
+		    ;
+		if (j == noutaps)
+		    naps = naps + 1
+		if (ninaps == 0)
+		    call malloc (inaps, 10, TY_INT)
+		else if (mod (ninaps, 10) == 0)
+		    call realloc (inaps, ninaps+10, TY_INT)
+		Memi[inaps+ninaps] = ap
+
+		call sa_sextract (sh1, w1, w2, rebin, dtype, w, dw, nw)
+		if (ninaps == 0) {
+		    l1 = w
+		    dl = dw
+		    same = true
+		}
+		if (same && !(fp_equald (w, l1) && fp_equald (dw, dl))) {
+		    l1 = 1.
+		    dl = 1.
+		    same = false
+		}
+
+		npts = max (npts, nw+NP1(sh1)-1)
+		ninaps = ninaps + 1
+		if (Memc[input2] == EOS)
+		    call strcpy (Memc[input1], Memc[input2], SZ_FNAME)
+	    }
+	    } then
+		call erract (EA_WARN)
+
+	    if (nin > 1) {
+		call shdr_close (sh1)
+		call smw_close (mwin1)
+		if (in1 != NULL)
+		    call imunmap (in1)
+	    }
+	}
+
+	# Check the selected apertures.
+	if (ninaps == 0)
+	    call error (1, "No spectra selected")
+	for (i=0; i<ninaps-1; i=i+1) {
+	    for (j=i+1; j<ninaps; j=j+1) {
+		if (Memi[inaps+i] == Memi[inaps+j]) {
+		    call error (1,
+			"Output spectra cannot have the same aperture number.\n\tUse renumber parameter.")
+		}
+	    }
+	}
+
+	# Set output image dimensions and WCS.  The WCS preserves the
+	# dispersion axis physical coordinates but resets the aperture
+	# axis physical coordinates.
+
+	if (out != NULL) {
+	    ptr = immap (Memc[temp], NEW_COPY, out); outtmp = ptr
+	    if (IM_PIXTYPE(outtmp) != TY_DOUBLE)
+		IM_PIXTYPE(outtmp) = TY_REAL
+
+	    IM_LEN(outtmp,1) = max (npts, IM_LEN(out,1))
+	    IM_LEN(outtmp,2) = naps
+	    IM_LEN(outtmp,3) = max (nbands, IM_LEN(out,3))
+	    if (nbands > 1)
+		IM_NDIM(outtmp) = 3
+	    else if (naps > 1)
+		IM_NDIM(outtmp) = 2
+	    else
+		IM_NDIM(outtmp) = 1
+
+	    l1 = 1.
+	    dl = 1.
+	    i = SMW_PDIM(MW(sh2))
+	    j = SMW_PAXIS(MW(sh2),1)
+	    mwoutdim = IM_NDIM(outtmp)
+
+	    mwtmp = mw_open (NULL, mwoutdim)
+	    call mw_newsystem (mwtmp, "equispec", mwoutdim)
+	    call mw_swattrs (SMW_MW(mwout,0), 0, "sformat", "equispec")
+	    call mw_swtype (mwtmp, axis, mwoutdim, "linear", "")
+	    if (LABEL(sh2) != EOS)
+		call mw_swattrs (mwtmp, 1, "label", LABEL(sh2))
+	    if (UNITS(sh2) != EOS)
+		call mw_swattrs (mwtmp, 1, "units", UNITS(sh2))
+	    ifnoerr (call mw_gwattrs (SMW_MW(MW(sh2),0), SMW_PAXIS(MW(sh2),1),
+		"units_display", Memc[str], SZ_LINE))
+		call mw_swattrs (mwtmp, 1, "units_display", Memc[str])
+
+	    call mw_gltermd (SMW_MW(mwout,0), Memd[ltm1], Memd[ltv1], i)
+	    call mw_gltermd (mwtmp, Memd[ltm2], Memd[ltv2], mwoutdim)
+	    Memd[ltm2] = dl * Memd[ltm1+(i+1)*(j-1)]
+	    Memd[ltv2] = (Memd[ltv1+(j-1)] - l1) / dl + 1
+	    call mw_sltermd (mwtmp, Memd[ltm2], Memd[ltv2], mwoutdim)
+	    call smw_open (mwtmp, NULL, outtmp)
+
+	    do i = 1, noutaps {
+		call smw_gwattrs (mwout, i, 1, ap, beam, dtype,
+		    w, dw, nw, z, aplow, aphigh, coeff)
+		call smw_swattrs (mwtmp, i, 1, Memi[outaps+i-1], beam, dtype,
+		    w, dw, nw, z, aplow, aphigh, Memc[coeff])
+	    }
+
+	    do j = 1, IM_LEN(out,3) {
+		do i = 1, IM_LEN(out,2) {
+		    ptr = impl3r (outtmp, i, j)
+		    call aclrr (Memr[ptr], IM_LEN(outtmp,1))
+		    call amovr (Memr[imgl3r(out,i,j)], Memr[ptr], IM_LEN(out,1))
+		    if (verbose) {
+			call shdr_open (out, mwout, i, j, INDEFI, SHHDR, sh2)
+			call shdr_open (outtmp, mwtmp, i, j, INDEFI,
+			    SHHDR, shout)
+			if (AP(sh2) != AP(shout))
+			    call sa_verbose (sh2, NULL, shout, output,
+				COPY, "copy", const, reverse)
+		    }
+		}
+	    }
+	    do j = 1, IM_LEN(out,3)
+		do i = IM_LEN(out,2)+1, IM_LEN(outtmp,2) {
+		    ptr = impl3r (outtmp, i, j)
+		    call aclrr (Memr[ptr], IM_LEN(outtmp,1))
+		}
+	    do j = IM_LEN(out,3)+1, nbands
+		do i = 1, IM_LEN(outtmp,2) {
+		    ptr = impl3r (outtmp, i, j)
+		    call aclrr (Memr[ptr], IM_LEN(outtmp,1))
+		}
+
+	    call shdr_close (shout)
+	    call shdr_close (sh2)
+	    call smw_close (mwout)
+	    mwout = mwtmp
+	    mwtmp = NULL
+	    call imunmap (out)
+	    out = outtmp
+	    outtmp = NULL
+
+	} else {
+	    if (nin > 1) {
+		ptr = immap (Memc[input2], READ_ONLY, 0); in1 = ptr
+		ptr = smw_openim (in1); mwin1 = ptr
+		call shdr_open (in1, mwin1, i, 1, INDEFI, SHDATA, sh1)
+	    }
+	    ptr = immap (Memc[temp], NEW_COPY, in1); out = ptr
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+	    ifnoerr (call imgstr (out, "MSTITLE", Memc[str], SZ_LINE)) {
+		call strcpy (Memc[str], IM_TITLE(out), SZ_IMTITLE)
+		call imdelf (out, "MSTITLE")
+	    }
+
+	    # Set header
+	    IM_LEN(out,1) = npts
+	    IM_LEN(out,2) = naps
+	    IM_LEN(out,3) = nbands
+	    if (nbands > 1)
+		IM_NDIM(out) = 3
+	    else if (naps > 1)
+		IM_NDIM(out) = 2
+	    else
+		IM_NDIM(out) = 1
+	    mwoutdim = IM_NDIM(out)
+
+	    j = imofnlu (out, "DISPAXIS,APID*,BANDID*")
+	    while (imgnfn (j, Memc[key], SZ_LINE) != EOF)
+		call imdelf (out, Memc[key])
+	    call imcfnl (j)
+
+	    i = SMW_PDIM(MW(sh1))
+	    j = SMW_PAXIS(MW(sh1),1)
+
+	    ptr = mw_open (NULL, mwoutdim); mwout = ptr
+	    call mw_newsystem (mwout, "equispec", mwoutdim)
+	    call mw_swattrs (mwout, 0, "sformat", "equispec")
+	    call mw_swtype (mwout, axis, mwoutdim, "linear", "")
+	    if (LABEL(sh1) != EOS)
+		call mw_swattrs (mwout, 1, "label", LABEL(sh1))
+	    if (UNITS(sh1) != EOS)
+		call mw_swattrs (mwout, 1, "units", UNITS(sh1))
+	    ifnoerr (call mw_gwattrs (SMW_MW(MW(sh1),0), SMW_PAXIS(MW(sh1),1),
+		"units_display", Memc[str], SZ_LINE))
+		call mw_swattrs (mwout, 1, "units_display", Memc[str])
+
+	    call mw_gltermd (SMW_MW(mwin1,0), Memd[ltm1], Memd[ltv1], i)
+	    call mw_gltermd (mwout, Memd[ltm2], Memd[ltv2], mwoutdim)
+	    Memd[ltv2] = (Memd[ltv1+(j-1)] - l1) / dl + 1
+	    Memd[ltm2] = dl * Memd[ltm1+(i+1)*(j-1)]
+	    call mw_sltermd (mwout, Memd[ltm2], Memd[ltv2], mwoutdim)
+	    call smw_open (mwout, NULL, out)
+
+	    if (nin > 1) {
+		call shdr_close (sh1)
+		call smw_close (mwin1)
+		call imunmap (in1)
+	    }
+	}
+
+	# Now do the actual copy
+	last = noutaps
+	call imtrew (list1)
+	call imtrew (list2)
+	while (imtgetim (list1, Memc[input1], SZ_FNAME) != EOF) {
+	    i = imtgetim (list2, Memc[input2], SZ_FNAME)
+	    iferr {
+	    if (nin > 1) {
+		in1 = NULL
+		mwin1 = NULL
+
+		ptr = immap (Memc[input1], READ_ONLY, 0); in1 = ptr
+		ptr = smw_openim (in1); mwin1 = ptr
+		call shdr_open (in1, mwin1, 1, 1, INDEFI, SHHDR, sh1)
+	    }
+
+	    # Check dispersion function compatibility
+	    # Nonlinear functions can't be copied to different physical
+	    # coordinate system though the linear dispersion can be
+	    # adjusted.
+
+	    call mw_gltermd (SMW_MW(mwout,0), Memd[ltm2], Memd[ltv2],
+		mwoutdim)
+	    a = Memd[ltv2]
+	    b = Memd[ltm2]
+	    if (DC(sh1) == DCFUNC && !rebin) {
+		i = SMW_PDIM(mwin1)
+		j = SMW_PAXIS(mwin1,1)
+
+		call mw_gltermd (SMW_MW(mwin1,0), Memd[ltm1], Memd[ltv1], i)
+		Memd[ltv1] = (Memd[ltv1+(j-1)] - l1) / dl + 1
+		Memd[ltm1] = dl * Memd[ltm1+(i+1)*(j-1)]
+		if (!fp_equald (a, Memd[ltv1]) || !fp_equald (b, Memd[ltm1])) {
+		    call error (1,
+		"Physical basis for nonlinear dispersion functions don't match")
+		}
+	    }
+
+	    # Check for second operand
+	    if (op > SQRT) {
+		ifnoerr (ptr = immap (Memc[input2], READ_ONLY, 0)) {
+		    in2 = ptr
+		    sh2 = NULL
+		    mwin2 = NULL
+		    ptr = smw_openim (in2); mwin2 = ptr
+		    call shdr_open (in2, mwin2, 1, 1, INDEFI, SHHDR, sh2)
+		} else {
+		    const = NULL
+		    i = 1
+		    if (ctod (Memc[input2], i, w) <= 0)
+			call error (1, "Error in second operand")
+		    call malloc (const, IM_LEN(out,1), TY_REAL)
+		    call amovkr (real (w), Memr[const], IM_LEN(out,1))
+		}
+	    }
+
+	    do i = 1, SMW_NSPEC(mwin1) {
+		call shdr_open (in1, mwin1, i, 1, INDEFI, SHHDR, sh1)
+		ap = AP(sh1)
+		if (SMW_FORMAT(mwin1) == SMW_ND) {
+		    call smw_mw (mwin1, i, 1, ptr, j, k)
+		    select = rng_elementi (aps, j) && rng_elementi (bands, k)
+		} else {
+		    j = ap
+		    if (apmod > 1)
+			j = mod (j, apmod)
+		    select = rng_elementi (aps, j)
+		}
+
+		select = select && rng_elementi (beams, BEAM(sh1))
+		if ((complement && select) || (!complement && !select))
+		    next
+		if (renumber)
+		    ap = last + 1
+		ap = ap + offset
+		for (j=0; j<noutaps && Memi[outaps+j]!=ap; j=j+1)
+		    ;
+		if (j < noutaps)
+		    l = j + 1
+		else {
+		    l = last + 1
+		    last = l
+		}
+
+		call shdr_open (in1, mwin1, i, 1, INDEFI, SHDATA, sh1)
+		call sa_sextract (sh1, w1, w2, rebin, dtype, w, dw, nw)
+
+		# Copy and adjust dispersion info
+		call smw_gwattrs (mwin1, i, 1, AP(sh1), beam,
+		    j, w, dw, nw, z, aplow, aphigh, coeff)
+
+		w = shdr_lw (sh1, 1D0)
+		wb = shdr_lw (sh1, double (SN(sh1)))
+		if (rebin)
+		    Memc[coeff] = EOS
+
+		p1 = (NP1(sh1) - a) / b
+		p2 = (NP2(sh1) - a) / b
+		p3 = (IM_LEN(out,1) - a) / b
+		nw = nint (min (max (p1, p3), max (p1, p2))) + NP1(sh1) - 1
+
+		w = w * (1 + z)
+		wb = wb * (1 + z)
+		if (dtype == DCLOG) {
+		    w = log10 (w)
+		    wb = log10 (wb)
+		    if (p1 != p2)
+			dw = (wb - w) / (p2 - p1)
+		    w = w - (p1 - 1) * dw
+		    wb = w + (nw - 1) * dw
+		    w = 10.**w
+		    wb = 10.**wb
+		    dw = (wb - w) / (nw - 1)
+		} else {
+		    if (p1 != p2)
+			dw = (wb - w) / (p2 - p1)
+		    w = w - (p1 - 1) * dw
+		    wb = w + (nw - 1) * dw
+		}
+
+		call smw_swattrs (mwout, l, 1, ap, beam, dtype,
+		    w, dw, nw, z, aplow, aphigh, Memc[coeff])
+
+		# Copy title
+		call smw_sapid (mwout, l, 1, TITLE(sh1))
+
+		# Copy the data
+		op1 = op
+		k = 0
+		do j = 1, SMW_NBANDS(mwin1) {
+		    if (SMW_FORMAT(mwin1) != SMW_ND) {
+			select = rng_elementi (bands, j)
+			if (!select)
+			    next
+		    }
+		    k = k + 1
+		    if (j != 1) {
+			call shdr_open (in1, mwin1, i, j, INDEFI, SHDATA, sh1)
+			call sa_sextract (sh1, w1, w2, rebin, dtype, w, dw,nw)
+		    }
+
+		    if (Memc[SID(sh1,1)] != EOS) {
+			call sprintf (Memc[key], SZ_LINE, "BANDID%d")
+			    call pargi (k)
+			iferr (call imgstr (out, Memc[key], Memc[str], SZ_LINE))
+			    call imastr (out, Memc[key], Memc[SID(sh1,1)])
+			else {
+			    if (strne (Memc[SID(sh1,1)], Memc[str]))
+				call eprintf (
+			    "Warning: Input and output types (BANDID) differ\n")
+			}
+		    }
+			    
+		    if (sh2 != NULL) {
+			if (ignoreaps)
+			    call shdr_open (in2, mwin2, i, j, INDEFI,
+				SHDATA, sh2)
+			else {
+			    call shdr_open (in2, mwin2, i, j, AP(sh1),
+				SHDATA, sh2)
+			    if (AP(sh2) != AP(sh1))
+				op1 = COPY
+			}
+		    }
+
+		    # For now just copy noise band.
+		    if (STYPE(sh1,1) == SHSIG)
+			op1 = COPY
+
+		    call sa_arith (op1, sh1, sh2, const, reverse,
+			Memr[SY(sh1)], Memr[impl3r(out,l,k)+NP1(sh1)-1],SN(sh1))
+
+		    if (verbose) {
+			call shdr_open (out, mwout, l, k, INDEFI, SHHDR, shout)
+			call sa_verbose (sh1, sh2, shout, output,
+			    op1, opstr, const, reverse)
+			call shdr_close (shout)
+		    }
+		}
+		do j = k+1, IM_LEN(out,3)
+		    call aclrr (Memr[impl3r(out,l,j)], IM_LEN(out,1))
+	    }
+	    } then
+		call erract (EA_WARN)
+
+	    call shdr_close (shout)
+	    call shdr_close (sh1)
+	    call shdr_close (sh2)
+	    call mfree (const, TY_REAL)
+	    call smw_close (mwin2)
+	    call smw_close (mwin1)
+	    if (in2 != NULL)
+		call imunmap (in2)
+	    if (in1 != NULL)
+		call imunmap (in1)
+	}
+	} then {
+	    err = YES
+	    call erract (EA_WARN)
+	}
+
+	# Finish up the output image.
+	if (mwout != NULL) {
+	    call smw_saveim (mwout, out)
+	    call smw_close (mwout)
+	}
+	if (outtmp != NULL)
+	    call imunmap (outtmp)
+	call smw_close (mwtmp)
+	if (out != NULL) {
+	    call imunmap (out)
+	    if (strne (Memc[temp], output)) {
+		if (err == NO) {
+		    call imdelete (output)
+		    call imrename (Memc[temp], output)
+		} else {
+		    iferr (call imdelete (Memc[temp]))
+			;
+		}
+	    }
+	}
+
+	call mfree (inaps, TY_INT)
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+ 
+# SA_1D -- Operate on input list to onedspec output.
+
+procedure sa_1d (list1, list2, output, op, opstr, w1, w2, rebin,
+	aps, bands, beams, complement, apmod, offset, reverse, ignoreaps,
+	clobber, renumber, verbose)
+
+int	list1			# Input image list
+int	list2			# Input image list
+char	output[ARB]		# Output image
+int	op			# Operation
+char	opstr[ARB]		# Operation string
+double	w1			# Starting wavelength
+double	w2			# Ending wavelength
+bool	rebin			# Rebin wavelength region?
+pointer	aps			# Apertures/columns/lines
+pointer	bands			# Bands
+pointer	beams			# Beams
+bool	complement		# Complement aperture/beam selection
+int	apmod			# Aperture modulus
+int	offset			# Offset to add to output aperture numbers
+bool	reverse			# Reverse order of operands
+bool	ignoreaps		# Ignore apertures?
+bool	clobber			# Clobber existing image?
+bool	renumber		# Renumber apertures?
+bool	verbose			# Verbose output?
+
+bool	select
+int	i, j, k
+int	ap, band, beam, dtype, nw, naps, op1, err
+double	w, wb, dw, z, p1, p2, p3
+real	aplow[2], aphigh[2]
+pointer	ptr, in1, in2, out, mwin1, mwin2, mwout, sh1, sh2, shout
+pointer	sp, str, key, input1, input2, output1, temp
+pointer	ltm1, ltv1, ltm2, ltv2, coeff, const
+
+double	shdr_lw()
+int	imaccess(), ctod(), patmake(), patmatch()
+int	imtgetim(), imgnfn()
+bool	rng_elementi(), streq()
+pointer	immap(), impl1r(), imofnlu(), smw_openim(), mw_open()
+errchk	immap, smw_openim, mw_open, imunmap, impl1r, imdelete
+errchk	shdr_open, sa_sextract
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (key, SZ_LINE, TY_CHAR)
+	call salloc (input1, SZ_FNAME, TY_CHAR)
+	call salloc (input2, SZ_FNAME, TY_CHAR)
+	call salloc (output1, SZ_FNAME, TY_CHAR)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (ltm1, 3*3, TY_DOUBLE)
+	call salloc (ltv1, 3, TY_DOUBLE)
+	call salloc (ltm2, 3*3, TY_DOUBLE)
+	call salloc (ltv2, 3, TY_DOUBLE)
+	call malloc (coeff, 1, TY_CHAR)
+
+	# Loop through each spectrum in each input image.
+	call imtrew (list1)
+	call imtrew (list2)
+	sh1 = NULL; sh2 = NULL; shout = NULL
+	naps = 0
+	while (imtgetim (list1, Memc[input1], SZ_FNAME) != EOF) {
+	    i = imtgetim (list2, Memc[input2], SZ_FNAME)
+
+	    iferr {
+	    in1 = NULL; in2 = NULL; mwin1 = NULL; mwin2 = NULL
+	    ptr = immap (Memc[input1], READ_ONLY, 0); in1 = ptr
+	    ptr = smw_openim (in1); mwin1 = ptr
+
+	    # Check for second operand
+	    if (op > SQRT) {
+		ifnoerr (ptr = immap (Memc[input2], READ_ONLY, 0)) {
+		    in2 = ptr
+		    sh2 = NULL
+		    mwin2 = NULL
+		    ptr = smw_openim (in2); mwin2 = ptr
+		    call shdr_open (in2, mwin2,1,1,INDEFI,SHHDR,sh2)
+		} else {
+		    const = NULL
+		    i = 1
+		    if (ctod (Memc[input2], i, w) <= 0)
+			call error (1, "Error in second operand")
+		    call malloc (const, IM_LEN(in1,1), TY_REAL)
+		    call amovkr (real (w), Memr[const], IM_LEN(in1,1))
+		}
+	    }
+
+	    do band = 1, SMW_NBANDS(mwin1) {
+		if (SMW_FORMAT(mwin1) != SMW_ND) {
+		    select = rng_elementi (bands, band)
+		    if (!select)
+			next
+		}
+		do i = 1, SMW_NSPEC(mwin1) {
+		    call shdr_open (in1, mwin1, i, band, INDEFI, SHHDR, sh1)
+
+		    # Check aperture and beam numbers.
+		    ap = AP(sh1)
+		    if (SMW_FORMAT(mwin1) == SMW_ND) {
+			call smw_mw (mwin1, i, band, ptr, j, k)
+			select = rng_elementi (aps,j) && rng_elementi (bands,k)
+		    } else {
+			j = ap
+			if (apmod > 1)
+			    j = mod (j, apmod)
+			select = rng_elementi (aps, j)
+		    }
+
+		    select = select && rng_elementi (beams, BEAM(sh1))
+		    if ((complement && select) || (!complement && !select))
+			next
+		    if (renumber) {
+			naps = naps + 1
+			ap = naps
+		    }
+		    ap = ap + offset
+
+		    iferr {
+		    out = NULL
+		    mwout = NULL
+		    err = NO
+
+		    # Open output spectrum
+		    call strcpy (output, Memc[str], SZ_LINE)
+		    j = patmake (".[0-9][0-9][0-9][0-9]$", Memc[key],
+			SZ_LINE)
+		    j = patmatch (Memc[str], Memc[key])
+		    if (j > 0)
+			Memc[str+j-6] = EOS
+		    if (SMW_FORMAT(mwin1) != SMW_ND) {
+			call sprintf (Memc[output1], SZ_FNAME,
+			    "%s.%d%03d")
+			    call pargstr (Memc[str])
+			    call pargi (PINDEX(sh1,2)-1)
+			    call pargi (ap)
+		    } else {
+			call sprintf (Memc[output1], SZ_FNAME,
+			    "%s.%04d")
+			    call pargstr (Memc[str])
+			    call pargi (ap)
+		    }
+		    if (imaccess (Memc[output1], READ_ONLY) == YES) {
+			if (clobber)
+			    call mktemp ("temp", Memc[temp], SZ_FNAME)
+			else {
+			    call sprintf (Memc[str], SZ_LINE,
+				"Output spectrum %s already exists")
+				call pargstr (output)
+			    call error (1, Memc[str])
+			}
+		    } else
+			call strcpy (Memc[output1], Memc[temp],
+			    SZ_FNAME)
+
+		    # Get data
+		    call shdr_open (in1, mwin1, i, band, INDEFI, SHDATA,
+			sh1)
+
+		    # Set header
+		    ptr = immap (Memc[temp], NEW_COPY, in1); out = ptr
+		    if (IM_PIXTYPE(out) != TY_DOUBLE)
+			IM_PIXTYPE(out) = TY_REAL
+		    IM_NDIM(out) = 1
+		    if (!streq (TITLE(sh1), IM_TITLE(out))) {
+			call imastr (out, "MSTITLE", IM_TITLE(out))
+			call strcpy (TITLE(sh1), IM_TITLE(out),
+			    SZ_IMTITLE)
+		    }
+		    j = imofnlu (out, "DISPAXIS,APID*,BANDID*")
+		    while (imgnfn (j, Memc[key], SZ_LINE) != EOF)
+			call imdelf (out, Memc[key])
+		    call imcfnl (j)
+
+		    if (Memc[SID(sh1,1)] != EOS)
+			call imastr (out, "BANDID1", Memc[SID(sh1,1)])
+
+		    # Set WCS
+		    j = SMW_PDIM(MW(sh1))
+		    k = SMW_PAXIS(MW(sh1),1)
+		    ptr = mw_open (NULL, 1); mwout = ptr
+		    call mw_newsystem (mwout, "equispec", 1)
+		    call mw_swattrs (mwout, 0, "sformat", "equispec")
+		    call mw_swtype (mwout, 1, 1, "linear", "")
+		    if (LABEL(sh1) != EOS)
+			call mw_swattrs (mwout, 1, "label", LABEL(sh1))
+		    if (UNITS(sh1) != EOS)
+			call mw_swattrs (mwout, 1, "units", UNITS(sh1))
+		    ifnoerr (call mw_gwattrs (SMW_MW(MW(sh1),0),
+			SMW_PAXIS(MW(sh1),1), "units_display",
+			Memc[str], SZ_LINE))
+			call mw_swattrs (mwout, 1, "units_display", Memc[str])
+
+		    call mw_gltermd (SMW_MW(mwin1,0), Memd[ltm1],
+			Memd[ltv1], j)
+		    call mw_gltermd (mwout, Memd[ltm2], Memd[ltv2], 1)
+		    Memd[ltv2] = Memd[ltv1+(k-1)]
+		    Memd[ltm2] = Memd[ltm1+(j+1)*(k-1)]
+		    call sa_sextract (sh1, w1, w2, rebin, dtype, w, dw, nw)
+		    IM_LEN(out,1) = nw + NP1(sh1) - 1
+		    Memd[ltv2] = (Memd[ltv1] - w) / dw + 1
+		    Memd[ltm2] = dw * Memd[ltm1]
+		    call mw_sltermd (mwout, Memd[ltm2], Memd[ltv2], 1)
+		    call smw_open (mwout, NULL, out)
+
+		    # Copy and adjust dispersion info
+		    call smw_gwattrs (mwin1, i, band, AP(sh1),
+			beam, j, w, dw, nw, z, aplow, aphigh, coeff)
+		    w = shdr_lw (sh1, 1D0)
+		    wb = shdr_lw (sh1, double(SN(sh1)))
+		    if (rebin)
+			Memc[coeff] = EOS
+
+		    p1 = (NP1(sh1) - Memd[ltv2]) / Memd[ltm2]
+		    p2 = (NP2(sh1) - Memd[ltv2]) / Memd[ltm2]
+		    p3 = (IM_LEN(out,1) - Memd[ltv2]) / Memd[ltm2]
+		    nw = nint (min (max (p1, p3), max (p1, p2))) + NP1(sh1) - 1
+
+		    w = w * (1 + z)
+		    wb = wb * (1 + z)
+		    if (dtype == DCLOG) {
+			w = log10 (w)
+			wb = log10 (wb)
+			if (p1 != p2)
+			    dw = (wb - w) / (p2 - p1)
+			w = w - (p1 - 1) * dw
+			wb = w + (nw - 1) * dw
+			w = 10.**w
+			wb = 10.**wb
+			dw = (wb - w) / (nw - 1)
+		    } else {
+			if (p1 != p2)
+			    dw = (wb - w) / (p2 - p1)
+			w = w - (p1 - 1) * dw
+			wb = w + (nw - 1) * dw
+		    }
+
+		    call smw_swattrs (mwout, 1, 1, ap, beam, dtype,
+			w, dw, nw, z, aplow, aphigh, Memc[coeff])
+
+		    # Copy data
+		    op1 = op
+		    if (sh2 != NULL) {
+			if (ignoreaps)
+			    call shdr_open (in2, mwin2, i, band, INDEFI,
+				SHDATA, sh2)
+			else {
+			    call shdr_open (in2, mwin2, i, band, AP(sh1),
+				SHDATA, sh2)
+			    if (AP(sh2) != AP(sh1))
+				op1 = COPY
+			}
+		    }
+
+		    # For now just copy noise band.
+		    if (STYPE(sh1,1) == SHSIG)
+			op1 = COPY
+
+		    call sa_arith (op1, sh1, sh2, const, reverse,
+			Memr[SY(sh1)], Memr[impl1r(out)+NP1(sh1)-1], SN(sh1))
+
+
+		    if (verbose) {
+			call shdr_open (out, mwout, 1, 1, INDEFI, SHHDR, shout)
+			call sa_verbose (sh1, sh2, shout, Memc[output1],
+			    op1, opstr, const, reverse)
+		    }
+		    } then {
+			err = YES
+			call erract (EA_WARN)
+		    }
+
+		    call shdr_close (shout)
+		    if (mwout != NULL) {
+			if (err == NO)
+			    call smw_saveim (mwout, out)
+			call smw_close (mwout)
+		    }
+		    if (out != NULL) {
+			call imunmap (out)
+			if (!streq (Memc[output1], Memc[temp])) {
+			    if (err == NO) {
+				call imgimage (Memc[input1], Memc[str], SZ_LINE)
+				if (streq (Memc[output1], Memc[str]))
+				    call imunmap (in1)
+				call imgimage (Memc[input2], Memc[str], SZ_LINE)
+				if (streq (Memc[output1], Memc[str]))
+				    call imunmap (in2)
+				call imdelete (Memc[output1])
+				call imrename (Memc[temp], Memc[output1])
+			    } else
+				call imdelete (Memc[temp])
+			} else if (err == YES)
+			    call imdelete (Memc[output1])
+		    }
+		}
+	    }
+	    } then
+		call erract (EA_WARN)
+
+	    call shdr_close (sh2)
+	    call shdr_close (sh1)
+	    call smw_close (mwin1)
+	    call smw_close (mwin2)
+	    if (in2 != NULL)
+		call imunmap (in2)
+	    if (in1 != NULL)
+		call imunmap (in1)
+	}
+
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# SA_ARITH -- Do arithmetic operation
+
+procedure sa_arith (op, sh, sh2, const, reverse, in, out, n)
+
+int	op			# Operation
+pointer	sh			# Input SHDR pointer
+pointer	sh2			# Second operand spectrum (NULL if none)
+pointer	const			# Second operand constant (NULL if none)
+bool	reverse			# Reverse order of operands
+real	in[n]			# Input data
+real	out[n]			# Output data
+int	n			# Number of data points
+
+int	i
+pointer	buf
+real	sa_errfcn()
+extern	sa_errfcn()
+
+begin
+	if (op > SQRT) {
+	    if (sh2 != NULL) {
+		call shdr_rebin (sh2, sh)
+		buf = SY(sh2)
+	    } else
+		buf = const
+	}
+
+	switch (op) {
+	case ABS:
+	    call aabsr (in, out, n)
+	case COPY:
+	    call amovr (in, out, n)
+	case DEX:
+	    do i = 1, n
+		out[i] = 10. ** in[i]
+	case EXP:
+	    do i = 1, n
+		out[i] = exp (in[i])
+	case FLAM:
+	    buf = SX(sh)
+	    do i = 1, n {
+		out[i] = in[i] / (Memr[buf] ** 2 / 2.997925e18)
+		buf = buf + 1
+	    }
+	case FNU:
+	    buf = SX(sh)
+	    do i = 1, n {
+		out[i] = in[i] * (Memr[buf] ** 2 / 2.997925e18)
+		buf = buf + 1
+	    }
+	case INV:
+	    call arczr (1., in, out, n, sa_errfcn)
+	case LN:
+	    call allnr (in, out, n, sa_errfcn)
+	case LOG:
+	    call alogr (in, out, n, sa_errfcn)
+	case LUM:
+	    do i = 1, n
+		out[i] = 10. ** (-0.4 * in[i])
+	case MAG:
+	    do i = 1, n {
+		if (in[i] <= 0.)
+		    out[i] = sa_errfcn (0.)
+		else
+		    out[i] = -2.5 * log10 (in[i])
+	    }
+	case SQRT:
+	    call asqrr (in, out, n, sa_errfcn)
+
+	case REP:
+	    call amovr (Memr[buf], out, n)
+	case ADD:
+	    call aaddr (in, Memr[buf], out, n)
+	case SUB:
+	    if (reverse)
+		call asubr (Memr[buf], in, out, n)
+	    else
+		call asubr (in, Memr[buf], out, n)
+	case MUL:
+	    call amulr (in, Memr[buf], out, n)
+	case DIV:
+	    if (reverse)
+		call advzr (Memr[buf], in, out, n, sa_errfcn)
+	    else
+		call advzr (in, Memr[buf], out, n, sa_errfcn)
+	case POW:
+	    if (reverse) {
+		do i = 1, n
+		    out[i] = Memr[buf+i-1] ** in[i]
+	    } else {
+		do i = 1, n
+		    out[i] = in[i] ** Memr[buf+i-1]
+	    }
+	}
+end
+
+
+# SA_ERRFCN -- SARITH Error Function
+
+real procedure sa_errfcn (x)
+
+real	x, errval
+common	/sarith/ errval
+
+begin
+	return (errval)
+end
+
+
+# SA_VERBOSE -- Print verbose output.
+
+procedure sa_verbose1 (input1, input2, output, ap1, ap2, apout, op, opstr,
+	const, reverse)
+
+char	input1[ARB], input2[ARB]	# Input spectra
+char	output[ARB]			# Output spectrum
+int	ap1, ap2			# Input apertures
+int	apout				# Output apertures
+int	op				# Opcode
+char	opstr[ARB]			# Operation string
+pointer	const				# Pointer to constant if used
+bool	reverse				# Reverse operands?
+
+begin
+	if (op <= SQRT) {
+	    if (op == COPY) {
+		call printf ("%s[%d]  -->  %s")
+		    call pargstr (input1)
+		    call pargi (ap1)
+		    call pargstr (output)
+		    call pargi (apout)
+	    } else {
+		call printf ("%s[%d]  -- %s -->  %s")
+		    call pargstr (input1)
+		    call pargi (ap1)
+		    call pargstr (opstr)
+		    call pargstr (output)
+		    call pargi (apout)
+	    }
+	} else if (const == NULL) {
+	    call printf ("%s[%d]  %s  %s[%d]  -->  %s")
+		if (reverse) {
+		    call pargstr (input2)
+		    call pargi (ap2)
+		    call pargstr (opstr)
+		    call pargstr (input1)
+		    call pargi (ap1)
+		} else {
+		    call pargstr (input1)
+		    call pargi (ap1)
+		    call pargstr (opstr)
+		    call pargstr (input2)
+		    call pargi (ap2)
+		}
+		call pargstr (output)
+		call pargi (apout)
+	} else {
+	    if (reverse) {
+		call printf ("%g  %s  %s[%d]  -->  %s")
+		    call pargr (Memr[const])
+		    call pargstr (opstr)
+		    call pargstr (input1)
+		    call pargi (ap1)
+	    } else {
+		call printf ("%s[%d]  %s  %g  -->  %s")
+		    call pargstr (input1)
+		    call pargi (ap1)
+		    call pargstr (opstr)
+		    call pargr (Memr[const])
+	    }
+	}
+	call pargstr (output)
+	if (!IS_INDEFI(apout)) { 
+	    call printf ("[%d]")
+		call pargi (apout)
+	}
+	call printf ("\n")
+	call flush (STDOUT)
+end
+
+
+# SA_VERBOSE -- Print verbose output.
+
+procedure sa_verbose (sh1, sh2, shout, output, op, opstr, const, reverse)
+
+pointer	sh1, sh2			# Input spectra
+pointer	shout				# Output spectrum
+char	output[ARB]			# Output image name
+int	op				# Opcode
+char	opstr[ARB]			# Operation string
+pointer	const				# Pointer to constant if used
+bool	reverse				# Reverse operands?
+
+begin
+	if (op <= SQRT) {
+	    if (op == COPY) {
+		call printf ("%s%s(%d)  -->  %s%s(%d)")
+		    call pargstr (IMNAME(sh1))
+		    call pargstr (IMSEC(sh1))
+		    call pargi (AP(sh1))
+	    } else {
+		call printf ("%s%s(%d) -- %s  -->  %s%s(%d)")
+		    call pargstr (IMNAME(sh1))
+		    call pargstr (IMSEC(sh1))
+		    call pargi (AP(sh1))
+		    call pargstr (opstr)
+	    }
+	} else if (const == NULL) {
+	    call printf ("%s%s(%d)  %s  %s%s(%d)  -->  %s%s(%d)")
+		if (reverse) {
+		    call pargstr (IMNAME(sh2))
+		    call pargstr (IMSEC(sh2))
+		    call pargi (AP(sh2))
+		    call pargstr (opstr)
+		    call pargstr (IMNAME(sh1))
+		    call pargstr (IMSEC(sh1))
+		    call pargi (AP(sh1))
+		} else {
+		    call pargstr (IMNAME(sh1))
+		    call pargstr (IMSEC(sh1))
+		    call pargi (AP(sh1))
+		    call pargstr (opstr)
+		    call pargstr (IMNAME(sh2))
+		    call pargstr (IMSEC(sh2))
+		    call pargi (AP(sh2))
+		}
+	} else {
+	    if (reverse) {
+		call printf ("%g  %s  %s%s(%d)  -->  %s%s(%d)")
+		    call pargr (Memr[const])
+		    call pargstr (opstr)
+		    call pargstr (IMNAME(sh1))
+		    call pargstr (IMSEC(sh1))
+		    call pargi (AP(sh1))
+	    } else {
+		call printf ("%s%s(%d)  %s  %g  -->  %s%s(%d)")
+		    call pargstr (IMNAME(sh1))
+		    call pargstr (IMSEC(sh1))
+		    call pargi (AP(sh1))
+		    call pargstr (opstr)
+		    call pargr (Memr[const])
+	    }
+	}
+	call pargstr (output)
+	call pargstr (IMSEC(shout))
+	call pargi (AP(shout))
+	call printf ("\n")
+	call flush (STDOUT)
+end
+
+
+# SA_GETIM -- Get image from a list with the image kernal extension removed.
+
+procedure sa_getim (list, defname, image, maxchar)
+
+int	list		# Image list
+char	defname[ARB]	# Default image name
+char	image[maxchar]	# Image name
+int	maxchar		# Image name maximum character length
+
+int	i, stat, imtgetim(), strmatch()
+pointer	sp, str, section
+
+begin
+	call smark (sp)
+	call salloc (str, maxchar, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+
+	stat = imtgetim (list, Memc[str], maxchar)
+	if (stat == EOF)
+	    call strcpy (defname, Memc[str], maxchar)
+
+	call imgsection (Memc[str], Memc[section], SZ_FNAME)
+	call imgimage (Memc[str], image, maxchar)
+	i = strmatch (image, ".??h$")
+	if (i > 0)
+	    image[i-4] = EOS
+	call strcat (Memc[section], image, maxchar)
+
+	call sfree (sp)
+end
+
+
+# SA_SEXTRACT -- Extract a specific wavelength region
+
+procedure sa_sextract (sh, w1, w2, rebin, dtype, l1, dl, n)
+
+pointer	sh			#U SHDR structure
+double	w1			#I Starting wavelength
+double	w2			#I Ending wavelength
+bool	rebin			#I Rebin wavelength region?
+int	dtype			#O Dispersion type
+double	l1			#O Starting logical pixel
+double	dl			#O Logical pixel increment
+int	n			#O Number of logical pixels
+
+int	i1, i2
+double	a, b
+bool	fp_equald()
+double	shdr_lw(), shdr_wl()
+errchk	shdr_wl, shdr_linear, shdr_extract
+
+begin
+	if (IS_INDEFD(w1) && IS_INDEFD(w2)) {
+	    l1 = 1.
+	    dl = 1.
+	    n = SN(sh)
+	    dtype = DC(sh)
+	    return
+	}
+
+	a = w1
+	b = w2
+	if (IS_INDEFD(a))
+	    a = shdr_lw (sh, 1.0D0)
+	if (IS_INDEFD(b))
+	    b = shdr_lw (sh, double (SN(sh)))
+
+	l1 = shdr_wl (sh, a)
+	dl = shdr_wl (sh, b)
+	if (fp_equald(l1,dl) || max(l1,dl) < 1. || min (l1,dl) > SN(sh))
+	    call error (1, "No pixels to extract")
+	l1 = max (1D0, min (double (SN(sh)), l1))
+	dl = max (1D0, min (double (SN(sh)), dl))
+	i1 = nint (l1)
+	i2 = nint (dl)
+	n = abs (i2 - i1) + 1
+	if (!rebin) {
+	    l1 = i1
+	    dl = i2
+	}
+	if (n == 1)
+	    dl = 1
+	else
+	    dl = (dl - l1) / (n - 1)
+
+	if (SY(sh) != NULL)
+	    call shdr_extract (sh, real(a), real(b), rebin)
+	dtype = DC(sh)
+end
diff --git a/noao/onedspec/t_sbands.x b/noao/onedspec/t_sbands.x
new file mode 100644
index 00000000..d3c3d1e2
--- /dev/null
+++ b/noao/onedspec/t_sbands.x
@@ -0,0 +1,585 @@
+include	<error.h>
+include	<smw.h>
+
+# Band structure
+define	LEN_BAND	9			# length of structure
+define	BAND_ID		Memi[$1]		# ptr to band id string
+define	BAND_FILTER	Memi[$1+1]		# ptr to filter string
+define	BAND_WC		Memd[P2D($1+2)]		# center wavelength
+define	BAND_DW		Memd[P2D($1+4)]		# wavelength width
+define	BAND_FN		Memi[$1+6]		# no. of filter points
+define	BAND_FW		Memi[$1+7]		# ptr to filter wavelengths
+define	BAND_FR		Memi[$1+8]		# ptr to filter responses
+
+# Multiple bands for indices and equivalent widths.
+define	NBANDS		3			# maximum number of bands
+define	BAND1		1
+define	BAND2		2
+define	BAND3		3
+define	BAND		Memi[$1+($2-1)*NBANDS+($3-1)]
+
+
+# T_SBANDS -- Compute band fluxes, indices, and equivalent widths.
+# A list of bandpasses is supplied in a text file, and all of them are applied
+# to each spectrum in the list.  The output is written to an output file
+# in multicolumn format.
+
+procedure t_sbands ()
+
+pointer	inlist			# Input list of spectra
+pointer	output			# Output file name
+pointer	fbands			# Band file name
+pointer	apertures		# Aperture list string
+bool	norm			# Normalize bands by response?
+bool	mag			# Output magnitudes instead of fluxes?
+double	magzero			# Magnitude zeropoint for magnitude output
+bool	verbose			# Verbose header?
+
+int	i, nbands, nsubbands, nimages, fd
+pointer	bands, aps, im, smw, sh
+pointer	sp, input
+
+int	open(), imtgetim()
+bool	clgetb(), rng_elementi()
+double	clgetd()
+pointer	imtopenp(), immap(), smw_openim(), rng_open()
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (fbands, SZ_FNAME, TY_CHAR)
+	call salloc (apertures, SZ_LINE, TY_CHAR)
+
+	# Get task parameters.
+	inlist = imtopenp ("input")
+	call clgstr ("output", Memc[output], SZ_FNAME)
+	call clgstr ("bands", Memc[fbands], SZ_FNAME)
+	call clgstr ("apertures", Memc[apertures], SZ_LINE)
+	norm = clgetb ("normalize")
+	mag = clgetb ("mag")
+	magzero = clgetd ("magzero")
+	verbose = clgetb ("verbose")
+
+	# Read bands from the band file.
+	fd = open (Memc[fbands], READ_ONLY, TEXT_FILE)
+	call sb_bands (fd, bands, nbands, nsubbands)
+	call close (fd)
+
+	# Open the aperture list.
+	iferr (aps = rng_open (Memc[apertures], INDEF, INDEF, INDEF))
+	    call error (1, "Bad aperture list")
+
+	# Loop over the input spectra.
+	fd = 0
+	nimages = 0
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    nimages = nimages + 1
+
+	    # Open the input image and get the WCS.
+	    iferr (im = immap (Memc[input], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    iferr (smw = smw_openim (im)) {
+		call imunmap (im)
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Open output file and write a verbose header if desired.
+	    # It is delayed until now to avoid output if an error occurs
+	    # such as image not found.
+
+	    if (nimages == 1) {
+		fd = open (Memc[output], APPEND, TEXT_FILE)
+		if (verbose)
+		    call sb_header (fd, norm, mag, magzero,
+			Memc[fbands], bands, nbands, nsubbands)
+	    }
+
+	    # Measure selected apertures.
+	    do i = 1, SMW_NSPEC(smw) {
+		call shdr_open (im, smw, i, 1, INDEFI, SHHDR, sh)
+		if (!rng_elementi (aps, AP(sh)))
+		    next
+		call shdr_open (im, smw, i, 1, INDEFI, SHDATA, sh)
+
+		call sb_proc (fd, sh, bands, nbands, norm, mag, magzero)
+	    }
+
+	    # Finish with image.
+	    call shdr_close (sh)
+	    call smw_close (smw)
+	    call imunmap (im)
+	}
+
+	# Finish up.
+	call sb_free (bands, nbands)
+	if (fd != 0)
+	    call close (fd)
+	call imtclose (inlist)
+	call sfree (sp)
+end
+
+
+# SB_BANDS - Read bands from the band file and put them into an array
+# of band pointers.
+
+procedure sb_bands (fd, bands, nbands, nsubbands)
+
+int	fd			#I Bandpass file descriptor
+pointer	bands			#O Bandpass table descriptor
+int	nbands			#O Number of bandpasses
+int	nsubbands		#O Number of individual bands
+
+bool	bandok
+int	ip
+double	center, width
+pointer	sp, line, id, filter
+
+int	getline(), ctowrd(), ctod()
+
+begin
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+	call salloc (id, SZ_FNAME, TY_CHAR)
+	call salloc (filter, SZ_FNAME, TY_CHAR)
+
+	# Read the bands.  If the first band is not seen
+	# skip the line.  Check for 1, 2, or 3 bandpasses.
+	# Can't use fscan() because fscan() will be called later to
+	# read any filter file.
+
+	bands = NULL
+	nbands = 0
+	nsubbands = 0
+	while (getline (fd, Memc[line]) != EOF) {
+	    ip = 1
+	    bandok = (ctowrd (Memc[line], ip, Memc[id], SZ_FNAME) > 0)
+	    bandok = (bandok && ctod (Memc[line], ip, center) > 0)
+	    bandok = (bandok && ctod (Memc[line], ip, width) > 0)
+	    bandok = (bandok && ctowrd (Memc[line],ip,Memc[filter],SZ_FNAME)>0)
+	    if (!bandok || Memc[id] == '#')
+		next
+
+	    # Allocate and reallocate the array of band pointers.
+	    if (nbands == 0)
+		call malloc (bands, 10 * NBANDS, TY_POINTER)
+	    else if (mod (nbands, 10) == 0)
+		call realloc (bands, (nbands + 10) * NBANDS, TY_POINTER)
+	    nbands = nbands + 1
+
+	    call sb_alloc (BAND(bands,nbands,BAND1),
+		Memc[id], Memc[filter], center, width)
+	    nsubbands = nsubbands + 1
+
+	    bandok = (ctowrd (Memc[line], ip, Memc[id], SZ_FNAME) > 0)
+	    bandok = (bandok && ctod (Memc[line], ip, center) > 0)
+	    bandok = (bandok && ctod (Memc[line], ip, width) > 0)
+	    bandok = (bandok && ctowrd (Memc[line],ip,Memc[filter],SZ_FNAME)>0)
+	    if (bandok) {
+		call sb_alloc (BAND(bands,nbands,BAND2),
+		    Memc[id], Memc[filter], center, width)
+		nsubbands = nsubbands + 1
+	    } else
+		BAND(bands,nbands,BAND2) = NULL
+
+	    bandok = (ctowrd (Memc[line], ip, Memc[id], SZ_FNAME) > 0)
+	    bandok = (bandok && ctod (Memc[line], ip, center) > 0)
+	    bandok = (bandok && ctod (Memc[line], ip, width) > 0)
+	    bandok = (bandok && ctowrd (Memc[line],ip,Memc[filter],SZ_FNAME)>0)
+	    if (bandok) {
+		call sb_alloc (BAND(bands,nbands,BAND3),
+		    Memc[id], Memc[filter], center, width)
+		nsubbands = nsubbands + 1
+	    } else
+		BAND(bands,nbands,BAND3) = NULL
+	}
+
+	call sfree (sp)
+end
+
+
+# SB_ALLOC -- Allocate a band structure.
+
+procedure sb_alloc (band, id, filter, center, width)
+
+pointer	band			#O Band pointer
+char	id[ARB]			#I Band id
+char	filter[ARB]		#I Band filter
+double	center			#I Band wavelength
+double	width			#I Band width
+
+int	fn, fd, strlen(), open(), fscan(), nscan()
+double	w, r
+pointer	fw, fr
+bool	streq()
+errchk	open()
+
+begin
+	call calloc (band, LEN_BAND, TY_STRUCT)
+	call malloc (BAND_ID(band), strlen(id), TY_CHAR)
+	call malloc (BAND_FILTER(band), strlen(filter), TY_CHAR)
+	call strcpy (id, Memc[BAND_ID(band)], ARB)
+	call strcpy (filter, Memc[BAND_FILTER(band)], ARB)
+	BAND_WC(band) = center
+	BAND_DW(band) = width
+	BAND_FN(band) = 0
+	BAND_FW(band) = NULL
+	BAND_FR(band) = NULL
+
+	if (streq (filter, "none"))
+	    return
+
+	# Read the filter file.
+	fd = open (filter, READ_ONLY, TEXT_FILE)
+	fn = 0
+	while (fscan (fd) != EOF) {
+	    call gargd (w)
+	    call gargd (r)
+	    if (nscan() != 2)
+		next
+	    if (fn == 0) {
+		call malloc (fw, 100, TY_DOUBLE)
+		call malloc (fr, 100, TY_DOUBLE)
+	    } else if (mod (fn, 100) == 0) {
+		call realloc (fw, fn+100, TY_DOUBLE)
+		call realloc (fr, fn+100, TY_DOUBLE)
+	    }
+	    Memd[fw+fn] = w
+	    Memd[fr+fn] = r
+	    fn = fn + 1
+	}
+	call close (fd)
+
+	BAND_FN(band) = fn
+	BAND_FW(band) = fw
+	BAND_FR(band) = fr
+end
+
+
+# SB_FREE -- Free band structures.
+
+procedure sb_free (bands, nbands)
+
+pointer	bands			#I bands descriptor
+int	nbands			#I number of bands
+
+int	i, j
+pointer	band
+
+begin
+	do i = 1, nbands {
+	    do j = 1, NBANDS {
+		band = BAND(bands,i,j)
+		if (band != NULL) {
+		    call mfree (BAND_ID(band), TY_CHAR)
+		    call mfree (BAND_FILTER(band), TY_CHAR)
+		    call mfree (BAND_FW(band), TY_DOUBLE)
+		    call mfree (BAND_FR(band), TY_DOUBLE)
+		    call mfree (band, TY_STRUCT)
+		}
+	    }
+	}
+	call mfree (bands, TY_POINTER)
+end
+
+
+# SB_HEADER -- Print output header.
+
+procedure sb_header (fd, norm, mag, magzero, fbands, bands, nbands, nsubbands)
+
+pointer	fd			#I Output file descriptor
+bool	norm			#I Normalization flag
+bool	mag			#I Magnitude flag
+double	magzero			#I Magnitude zeropoint
+char	fbands[ARB]		#I Band file
+pointer	bands			#I Pointer to array of bands
+int	nbands			#I Number of bands
+int	nsubbands		#I Number of subbands
+
+int	i, j
+pointer	sp, str, band
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Output a banner and task parameters.
+	call sysid (Memc[str], SZ_LINE)
+	call fprintf (fd, "\n# SBANDS: %s\n#  ")
+	    call pargstr (Memc[str])
+	if (fbands[1] != EOS) {
+	    call fprintf (fd, " bands = %s,")
+		call pargstr (fbands)
+	}
+	call fprintf (fd, " norm = %b, mag = %b")
+	    call pargb (norm)
+	    call pargb (mag)
+	if (mag) {
+	    call fprintf (fd, ", magzero = %.2f")
+		call pargd (magzero)
+	    call strcpy ("mag", Memc[str], SZ_LINE)
+	} else
+	    call strcpy ("flux", Memc[str], SZ_LINE)
+
+	# Output the bands.
+	call fprintf (fd, "\n# %10s %10s %10s %10s\n")
+	    call pargstr ("band")
+	    call pargstr ("filter")
+	    call pargstr ("wavelength")
+	    call pargstr ("width")
+	do i = 1, nbands {
+	    do j = 1, NBANDS {
+		band = BAND(bands,i,j)
+		if (band == NULL)
+		    next
+		call fprintf (fd, "# %10s %10s %10g %10g\n")
+		    call pargstr (Memc[BAND_ID(band)])
+		    call pargstr (Memc[BAND_FILTER(band)])
+		    call pargd (BAND_WC(band))
+		    call pargd (BAND_DW(band))
+	    }
+	}
+
+	# Output column headings.
+	call fprintf (fd,
+	    "#\n# %24s %7.7s %11.11s")
+	    call pargstr ("spectrum")
+	    call pargstr ("band")
+	    call pargstr (Memc[str])
+	if (nsubbands > nbands) {
+	    call fprintf (fd, " %7.7s %11.11s %9.9s %9.9s")
+		call pargstr ("band")
+		call pargstr (Memc[str])
+		call pargstr ("index")
+		call pargstr ("eqwidth")
+	}
+	call fprintf (fd, "\n")
+
+	call sfree (sp)
+end
+
+
+# SB_PROC -- Measure the band fluxes and possibly a band index and eq. width.
+
+procedure sb_proc (fd, sh, bands, nbands, norm, mag, magzero)
+
+int	fd			#I Output file descriptor
+pointer	sh			#I Spectrum descriptor
+pointer	bands			#I Bandpass table pointer
+int	nbands			#I Number of bandpasses
+bool	norm			#I Normalize?
+bool	mag			#I Magnitude output?
+double	magzero			#I Magnitude zero point
+
+int	i
+double	flux, contval, index, eqwidth
+double	flux1, norm1, flux2, norm2, flux3, norm3, a, b
+pointer	sp, imname, band1, band2, band3
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[imname], SZ_FNAME, "%s%s(%d)")
+	    call pargstr (IMNAME(sh))
+	    call pargstr (IMSEC(sh))
+	    call pargi (AP(sh))
+
+	# Loop over all bandpasses
+	do i = 1, nbands {
+	    # Measure primary band flux, normalize, and print result.
+	    band1 = BAND(bands,i,BAND1)
+	    call sb_flux (sh, band1, flux1, norm1)
+	    if (IS_INDEFD(flux1))
+		next
+
+	    if (norm) {
+		flux1 = flux1 / norm1
+		norm1 = 1
+	    }
+	    if (mag && flux1 > 0.)
+		flux = magzero - 2.5 * log10 (flux1)
+	    else
+		flux = flux1
+
+	    call fprintf (fd, "%26s %7.7s %11.6g")
+		call pargstr (Memc[imname])
+		call pargstr (Memc[BAND_ID(band1)])
+		call pargd (flux)
+		
+	    # Measure the alternate band fluxes and compute and output
+	    # the band index and equivalent width.
+
+	    band2 = BAND(bands,i,BAND2)
+	    band3 = BAND(bands,i,BAND3)
+	    call sb_flux (sh, band2, flux2, norm2)
+	    call sb_flux (sh, band3, flux3, norm3)
+	    if (IS_INDEFD(flux2) && IS_INDEFD(flux3)) {
+		call fprintf (fd, "\n")
+		next
+	    }
+
+	    if (norm) {
+		if (!IS_INDEFD(flux2)) {
+		    flux2 = flux2 / norm2
+		    norm2 = 1
+		}
+		if (!IS_INDEFD(flux3)) {
+		    flux3 = flux3 / norm3
+		    norm3 = 1
+		}
+	    }
+
+	    contval = INDEFD
+	    index = INDEFD
+	    eqwidth = INDEFD
+	    if (!IS_INDEFD(flux2) && !IS_INDEFD(flux3)) {
+		# Interpolate to the center of the primary band.
+		a = (flux2 / norm2 - flux3 / norm3) /
+		    (BAND_WC(band2) - BAND_WC(band3))
+		b = flux2 / norm2 - a * BAND_WC(band2)
+		contval = (a * BAND_WC(band1) + b) * norm1
+		call fprintf (fd, " %7.7s")
+		    call pargstr ("cont")
+	    } else if (!IS_INDEFD(flux2)) {
+		contval = flux2
+		call fprintf (fd, " %7.7s")
+		    call pargstr (Memc[BAND_ID(band2)])
+	    } else if (!IS_INDEFD(flux3)) {
+		contval = flux3
+		call fprintf (fd, " %7.7s")
+		    call pargstr (Memc[BAND_ID(band3)])
+	    }
+
+	    if (mag && contval > 0.)
+		flux = magzero - 2.5 * log10 (contval)
+	    else
+		flux = contval
+	    call fprintf (fd, " %11.6g")
+		call pargd (flux)
+
+	    if (flux1 > 0. && contval > 0.) {
+		index = flux1 / contval
+		eqwidth = (1 - index) * BAND_DW(band1)
+	    }
+	    if (mag) {
+		if (!IS_INDEFD(contval) && contval > 0.)
+		    contval = magzero - 2.5 * log10 (contval)
+		if (!IS_INDEFD(index))
+		    index = -2.5 * log10 (index)
+	    }
+
+	    call fprintf (fd, " %9.6g %9.6g\n")
+		call pargd (index)
+		call pargd (eqwidth)
+	}
+
+	# Flush output and finish up.
+	call flush (fd)
+	call sfree (sp)
+end
+
+
+# SB_FLUX - Compute the flux and total response in a given band.
+# Return INDEF if the band is outside of the spectrum.
+
+procedure sb_flux (sh, band, flux, norm)
+
+pointer	sh			#I spectrum descriptor
+pointer	band			#I band descriptor
+double	flux			#O flux
+double	norm			#O normalization
+
+int	i, i1, i2
+double	a, b, w1, w2, x1, x2, wt
+pointer	x, y
+double	sb_filter(), shdr_wl()
+
+begin
+	# Return if no band is defined.
+	flux = INDEFD
+	norm = 1
+	if (band == NULL)
+	    return
+
+	# Check end points.
+	a = BAND_WC(band) - BAND_DW(band) / 2.
+	b = BAND_WC(band) + BAND_DW(band) / 2.
+	w1 = min (a, b)
+	w2 = max (a, b)
+	a = shdr_wl (sh, w1)
+	b = shdr_wl (sh, w2)
+	x1 = min (a, b)
+	x2 = max (a, b)
+	i1 = nint (x1)
+	i2 = nint (x2)
+	if (x1 == x2 || i1 < 1 || i2 > SN(sh))
+	    return
+
+	x = SX(sh) + i1 - 1
+	y = SY(sh) + i1 - 1
+
+	if (i1 == i2) {
+	    wt = sb_filter (double(Memr[x]), band) * (x2 - x1)
+	    flux = wt * Memr[y]
+	    norm = wt
+	} else {
+	    wt = sb_filter (double(Memr[x]), band) * (i1 + 0.5 - x1)
+	    flux = wt * Memr[y]
+	    norm = wt
+	    x = x + 1
+	    y = y + 1
+	    for (i = i1 + 1; i <= i2 - 1; i = i + 1) {
+		wt = sb_filter (double(Memr[x]), band)
+		flux = flux + wt * Memr[y]
+		norm = norm + wt
+		x = x + 1
+		y = y + 1
+	    }
+	    wt = sb_filter (double(Memr[x]), band) * (x2 - i2 + 0.5)
+	    flux = flux + wt * Memr[y]
+	    norm = norm + wt
+	}
+end
+
+
+# SB_FILTER -- Given a filter array interpolate to the specified wavelength.
+
+double procedure sb_filter (w, band)
+
+double	w		# Wavelength desired
+pointer	band		# Band pointer
+
+int	i, n
+double	x1, x2
+pointer	x, y
+
+begin
+	n = BAND_FN(band)
+	if (n == 0)
+	    return (1.)
+
+	x = BAND_FW(band)
+	y = BAND_FR(band)
+	x1 = Memd[x]
+	x2 = Memd[x+n-1]
+
+	if (w <= x1)
+	    return (Memd[y])
+	else if (w >= x2)
+	    return (Memd[y+n-1])
+	
+	if ((w - x1) < (x2 - w))
+	    for (i = 1; w > Memd[x+i]; i=i+1)
+		;
+	else
+	    for (i = n - 1; w < Memd[x+i-1]; i=i-1)
+		;
+		
+	x1 = Memd[x+i-1]
+	x2 = Memd[x+i]
+	return ((w - x1) / (x2 - x1) * (Memd[y+i] - Memd[y+i-1]) + Memd[y+i-1])
+end
diff --git a/noao/onedspec/t_scoords.x b/noao/onedspec/t_scoords.x
new file mode 100644
index 00000000..fe2dd067
--- /dev/null
+++ b/noao/onedspec/t_scoords.x
@@ -0,0 +1,179 @@
+include	<error.h>
+include	<imhdr.h>
+
+# T_SCOORDS -- Set sampled coordinates in spectra.
+# This task is currently limited to 1D spectra.
+# It reads a text file of spectral coordinates and sets the WCS.
+
+procedure t_scoords ()
+
+pointer	speclist	# List of spectrum image names
+pointer	coordlist	# List of coordinate file names
+pointer	label		# Coordinate axis label
+pointer	units		# Coordinate axis units
+
+int	n, fd, open(), fscan(), nscan()
+int	imtopenp, imtlen(), imtgetim(), clpopnu(), fntlenb(), fntgfnb()
+bool	verbose, clgetb()
+pointer	sp, spec, coords, values, im, tmp, immap()
+
+errchk	immap, open, scoords
+
+begin
+	call smark (sp)
+	call salloc (spec, SZ_FNAME, TY_CHAR)
+	call salloc (coords, SZ_FNAME, TY_CHAR)
+	call salloc (label, SZ_FNAME, TY_CHAR)
+	call salloc (units, SZ_FNAME, TY_CHAR)
+
+	# Get task parameters.
+	speclist = imtopenp ("images")
+	coordlist = clpopnu ("coords")
+	call clgstr ("label", Memc[label], SZ_FNAME)
+	call clgstr ("units", Memc[units], SZ_FNAME)
+	verbose = clgetb ("verbose")
+
+	# Check for match between image and coordinate lists.
+	if (fntlenb (coordlist) > 1 && fntlenb (coordlist) != imtlen (speclist))
+	    call error (1, "Image and coordinate lists do not match")
+
+	# Loop through spectrum list.
+	while (imtgetim (speclist, Memc[spec], SZ_FNAME) != EOF) {
+	    if (fntgfnb (coordlist, Memc[coords], SZ_FNAME) == EOF)
+		;
+
+	    iferr {
+		im = NULL
+		fd = NULL
+
+		# Open the image.
+		tmp = immap (Memc[spec], READ_WRITE, 0); im = tmp
+
+		# Get the coordinate values.
+		tmp = open (Memc[coords], READ_ONLY, TEXT_FILE); fd = tmp
+		call salloc (values, IM_LEN(im,1)+1, TY_DOUBLE)
+		n = 0
+		while (fscan(fd) != EOF) {
+		    call gargd (Memd[values+n])
+		    if (nscan() == 1)
+			n = n + 1
+		    if (n > IM_LEN(im,1))
+			break
+		}
+		if (n != IM_LEN(im,1))
+		    call error (1, "Wrong number of coordinate values in file")
+
+		# Create the WCS
+		if (verbose) {
+		    call printf ("SCOORDS: ")
+		    call printf (
+			"Setting coordinates for %s from coordinate file %s.\n")
+			call pargstr (Memc[spec])
+			call pargstr (Memc[coords])
+		}
+		call scoords (im, Memc[label], Memc[units], Memd[values])
+	    } then
+		call erract (EA_WARN)
+
+	    # Close files.
+	    if (im != NULL)
+		call imunmap (im)
+	    if (fd != NULL)
+		call close (fd)
+	}
+
+	call imtclose (speclist)
+	call fntclsb (coordlist)
+	call sfree (sp)
+end
+
+
+
+# SCOORDS -- Make a multispec pixel array coordinate system.
+# This is currently limited to 1D spectra.
+
+procedure scoords (im, label, units, waves)
+
+pointer	im		#I Imageio I/O pointer (must be 1D image)
+char	label[ARB]	#I Axis label (e.g. "Wavelength")
+char	units[ARB]	#I Axis units (e.g. "Angstroms")
+double	waves[ARB]	#I Array of dispersion coordinates
+
+int	i, n, fd, stropen()
+double	dw
+pointer	sp, coeffs, mw, mw_open()
+
+int	axes[6]
+data	axes/1, 2, 1, 0, 0, 0/
+
+errchk	mw_open, mw_saveim, stropen
+
+begin
+	call smark (sp)
+
+	if (IM_NDIM(im) != 1)
+	    call error (1, "scoords: image must be one dimensional")
+
+	# Initialize the MWCS.
+	mw = mw_open (NULL, 2)
+	call mw_newsystem (mw, "multispec", 2)
+	call mw_swtype (mw, axes, 2, "multispec", "")
+	if (label[1] != EOS)
+	    call mw_swattrs (mw, 1, "label", label)
+	if (units[1] != EOS)
+	    call mw_swattrs (mw, 1, "units", label)
+	call mw_saxmap (mw, axes[3], axes[4], 2)
+
+	# Setup multispec coefficient string.
+	n = IM_LEN(im,1)
+	i = 20 * (n + 6)
+	call salloc (coeffs, i, TY_CHAR)
+	call aclrc (Memc[coeffs], i)
+	fd = stropen (Memc[coeffs], i, NEW_FILE)
+
+	# Set the common attribute parameters.
+	dw = (waves[n] - waves[1]) / (n - 1)
+	call fprintf (fd, "%d %d %d %g %g %d %g %g %g ")
+	    call pargi (1)		# Aperture number
+	    call pargi (1)		# Beam number
+	    call pargi (2)		# Dispersion type (2=non-linear)
+	    call pargd (waves[1])	# Starting coordinate
+	    call pargd (dw)		# Average dispersion
+	    call pargi (n)		# Number of pixels
+	    call pargd (0D0)		# Redshift
+	    call pargd (INDEFD)		# Aperture limit
+	    call pargd (INDEFD)		# Aperture limit
+
+	# Set the general non-linear function parameters.
+	call fprintf (fd, "%g %g %d ")
+	    call pargd (1D0)		# Function weight
+	    call pargd (0D0)		# Zero point shift
+	    call pargi (5)		# Function type (5=pixel array)
+
+	# Set the pixel array function values.
+	call fprintf (fd, "%d")
+	    call pargi (n)		# Number of pixels
+	do i = 1, n {
+	    if (i > 2) {
+		if ((waves[i]-waves[i-1]) * dw <= 0) {
+		    call strclose (fd)
+		    call mw_close (mw)
+		    call sfree (sp)
+		    call error (1, "Coordinates are not monotonic")
+		}
+	    }
+
+	    call fprintf (fd, " %g")
+		call pargd (waves[i])	# Coordinates
+	}
+
+	# Write the attribute.
+	call strclose (fd)
+	call mw_swattrs (mw, 2, "spec1", Memc[coeffs])
+
+	# Store the WCS in the image header.
+	call mw_saveim (mw, im)
+	call mw_close (mw)
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_sfit.x b/noao/onedspec/t_sfit.x
new file mode 100644
index 00000000..54e896bb
--- /dev/null
+++ b/noao/onedspec/t_sfit.x
@@ -0,0 +1,986 @@
+include	<imhdr.h>
+include <pkg/gtools.h>
+include <pkg/rg.h>
+include <math/curfit.h>
+include	<error.h>
+include	<smw.h>
+
+# SFIT -- Fit a function to spectra and output the fit, difference or
+# ratio; or print the power series coefficients of the fit.  The fitting
+# parameters may be set interactively using the icfit package.
+
+# Image header keywords for saving the previous fit
+
+define	SFT_KW		"SFIT"
+define	SFT_KWB		"SFITB"
+
+# Choices for the type of output
+
+define	OUT_TYPES	"|data|fit|difference|ratio|"
+
+define	DATA		1
+define	FIT		2
+define	DIFFERENCE	3
+define	RATIO		4
+
+# Choices for the interactive prompts
+# (the 1st define is for clgwrd (strdic), the 2nd for CL enumeration)
+# Note that the CL assumes that the separator is `|'.
+
+define	SFT_ANS1	"|yes|no|skip|YES|NO|SKIP|"
+define	SFT_ANS1X	"yes|no|skip|YES|NO|SKIP"
+
+define	SFT_ANS2	"|spectrum|image|all|cancel|"
+define	SFT_ANS2X	"spectrum|image|all|cancel"
+
+define	LEN_ANS		7
+
+define	YES_ONCE	1
+define	NO_ONCE		2
+define	SKIP_ONCE	3
+define	YES_ALWAYS	4
+define	NO_ALWAYS	5
+define	SKIP_ALWAYS	6
+
+define	SKIP_SPEC	1
+define	SKIP_IMAGE	2
+define	SKIP_ALL	3
+define	SKIP_CANCEL	4
+
+# Switches and pointers
+
+define	SFT_OFF		22
+
+define	INTERACTIVE	Memi[$1]		# all spectra are noninteractive
+define	REPLACE		Memi[$1+1]		# replace rejected points?
+define	WAVESCALE	Memi[$1+2]		# X is wavelength if possible
+define	LOGSCALE	Memi[$1+3]		# axes are logarithmic
+define	OVERRIDE	Memi[$1+4]		# allow lines to be redone
+define	LISTONLY	Memi[$1+5]		# don't modify images
+define	OUTTYPE		Memi[$1+6]		# output type code
+
+define	GRAPH_OPEN	Memi[$1+7]		# keep track of gopen
+define	LOG_TO_STDOUT	Memi[$1+8]		# STDOUT/ERR is used
+define	PROMPT		Memi[$1+9]		# prompt flag
+define	QUIET		Memi[$1+10]		# quiet flag
+
+define	RGIN		Memi[$1+11]		# lines specified
+define	RGFIT		Memi[$1+12]		# all lines to fit
+define	RGREFIT		Memi[$1+13]		# those to fit again
+define	RGINB		Memi[$1+14]		# bands specified
+define	RGFITB		Memi[$1+15]		# all bands to fit
+define	RGREFITB	Memi[$1+16]		# those to fit again
+
+define	NLOGFD		Memi[$1+17]		# number of logfiles
+define	LOGFD		Memi[$1+18]		# array of logfiles
+
+define	IC		Memi[$1+19]		# current ic descriptor
+define	YMAX		Memi[$1+20]		# max number of lines
+define	BMAX		Memi[$1+21]		# max number of lines
+define	IC_DESC		Memi[$1+SFT_OFF+($3-1)*YMAX($1)+$2-1]	# ic descriptors
+
+
+# T_SFIT -- Entry point for the task.  Read parameters,
+# initialize structures and loop over the image templates.
+
+procedure t_sfit ()
+
+pointer	listin, listout, input, output, graphics
+pointer	sf, gp, gt, in, out, mw, sh, sp
+int	stat
+
+int	sft_icfit(), imtgetim(), gt_init(), imtlen()
+bool	clgetb()
+pointer	imtopenp()
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (graphics, SZ_FNAME, TY_CHAR)
+
+	# Open the image templates
+	listin = imtopenp ("input")
+
+	if (clgetb ("listonly"))
+	    listout = NULL
+	else {
+	    listout = imtopenp ("output")
+	    if (imtlen (listin) != imtlen (listout)) {
+		call imtclose (listin)
+		call imtclose (listout)
+		call sfree (sp)
+		call error (1, "Input and output image lists do not match")
+	    }
+	}
+
+	# Initialize the various descriptors
+	iferr (call sft_init (listin, listout, sf)) {
+	    call imtclose (listin)
+	    if (listout != NULL)
+		call imtclose (listout)
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+
+	# The graphics pointers are passed explicitly
+	if (INTERACTIVE(sf) == YES) {
+	    call clgstr ("graphics", Memc[graphics], SZ_FNAME)
+	    gt = gt_init()
+	    call gt_sets (gt, GTTYPE, "line")
+	}
+
+	# Fit the lines in each input image.
+
+	while (imtgetim (listin, Memc[input], SZ_FNAME) != EOF) {
+
+	    if (listout != NULL)
+		stat = imtgetim (listout, Memc[output], SZ_FNAME)
+	    else
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    iferr {
+		call sft_immap (Memc[input], Memc[output],
+		    in, out, mw, sh, sf, gp)
+	    } then {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    stat = sft_icfit (in, out, mw, sh, sf, gp, gt, Memc[graphics])
+
+	    call sft_unmap (in, out, mw, sh, sf)
+
+	    if (stat == EOF)
+		break
+	}
+
+	if (INTERACTIVE(sf) == YES)
+	    call gt_free (gt)
+	if (GRAPH_OPEN(sf) == YES)
+	    call gclose (gp)
+
+	call sft_close (sf)
+	call imtclose (listin)
+	if (listout != NULL)
+	    call imtclose (listout)
+	call sfree (sp)
+end
+
+
+# SFT_INIT -- Initialize templates, ranges, logfiles, type, icfit descriptors.
+
+procedure sft_init (listin, listout, sf)
+
+pointer	listin, listout		#I Image template descriptors
+pointer	sf			#I Pointer to task switches
+
+pointer	input, output, im, sp, mw
+int	ymax, bmax, i, j
+
+real	clgetr()
+bool	clgetb()
+int	clgwrd(), clgeti(), btoi(), strlen()
+int	rg_next(), imtgetim(), imaccess(), xt_logopen()
+pointer	rg_ranges(), immap(), smw_openim()
+errchk	immap, smw_openim
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_LINE, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+
+	sf = NULL
+	iferr {
+
+	    # find the maximum number of lines and bands (spectra)
+	    ymax = 0
+	    bmax = 0
+
+	    while (imtgetim (listin, Memc[input], SZ_LINE) != EOF)
+		if (imaccess (Memc[input], READ_ONLY) == YES) {
+		    im = immap (Memc[input], READ_ONLY, 0)
+		    mw = smw_openim (im)
+		    ymax = max (SMW_LLEN(mw,2), ymax)
+		    bmax = max (SMW_LLEN(mw,3), bmax)
+		    call smw_close (mw)
+		    call imunmap (im)
+		}
+	    call imtrew (listin)
+
+	    if (listout != NULL) {
+		while (imtgetim (listout, Memc[output], SZ_FNAME) != EOF)
+		    if (imaccess (Memc[output], READ_ONLY) == YES) {
+			im = immap (Memc[output], READ_ONLY, 0)
+			mw = smw_openim (im)
+			ymax = max (SMW_LLEN(mw,2), ymax)
+			bmax = max (SMW_LLEN(mw,3), bmax)
+			call smw_close (mw)
+			call imunmap (im)
+		    }
+		call imtrew (listout)
+	    }
+
+	    # allocate space for the task switch structure
+	    call malloc (sf, SFT_OFF + ymax * bmax, TY_STRUCT)
+
+	    YMAX(sf) = ymax
+	    BMAX(sf) = bmax
+
+	    # NULL the pointers for error handling
+	    RGIN(sf)	= NULL
+	    RGINB(sf)	= NULL
+	    NLOGFD(sf)	= 0
+	    do j = 1, BMAX(sf)
+		do i = 1, YMAX(sf)
+		    IC_DESC(sf,i,j) = NULL
+
+	    # Set the switches
+	    INTERACTIVE(sf) = btoi (clgetb ("interactive"))
+	    REPLACE(sf) = btoi (clgetb ("replace"))
+	    WAVESCALE(sf) = btoi (clgetb ("wavescale"))
+	    LOGSCALE(sf) = btoi (clgetb ("logscale"))
+	    OVERRIDE(sf) = btoi (clgetb ("override"))
+	    LISTONLY(sf) = btoi (clgetb ("listonly"))
+	    GRAPH_OPEN(sf) = NO
+	    PROMPT(sf) = INTERACTIVE(sf)
+	    QUIET(sf) = btoi (INTERACTIVE(sf) == NO)
+
+	    # Expand the range specification, allow either hyphens or colons
+
+	    call clgstr ("lines", Memc[input], SZ_LINE)
+	    do i = 1, strlen (Memc[input])
+		if (Memc[input+i-1] == '-')
+		    Memc[input+i-1] =  ':'
+		else if (Memc[input+i-1] == 'x' || Memc[input+i-1] == 'X')
+		    call error (1, "Range step (`x' notation) not implemented")
+
+	    RGIN(sf) = rg_ranges (Memc[input], 1, YMAX(sf))
+	    call rg_order (RGIN(sf))
+	    call rg_merge (RGIN(sf))
+
+	    call clgstr ("bands", Memc[input], SZ_LINE)
+	    do i = 1, strlen (Memc[input])
+		if (Memc[input+i-1] == '-')
+		    Memc[input+i-1] =  ':'
+		else if (Memc[input+i-1] == 'x' || Memc[input+i-1] == 'X')
+		    call error (1, "Range step (`x' notation) not implemented")
+
+	    RGINB(sf) = rg_ranges (Memc[input], 1, BMAX(sf))
+	    call rg_order (RGINB(sf))
+	    call rg_merge (RGINB(sf))
+
+	    i = 0
+	    j = 0
+	    if (rg_next (RGIN(sf), i) == EOF || rg_next (RGINB(sf), j) == EOF)
+		call error (1, "With range specification for `lines or bands'")
+	    else {
+		# Open the initial icfit descriptor
+		call ic_open (IC(sf))
+
+		call clgstr ("sample", Memc[input], SZ_LINE)
+		call ic_pstr (IC(sf), "sample", Memc[input])
+		call clgstr ("function", Memc[input], SZ_LINE)
+		call ic_pstr (IC(sf), "function", Memc[input])
+
+		call ic_puti (IC(sf), "naverage", clgeti ("naverage"))
+		call ic_puti (IC(sf), "order", clgeti ("order"))
+		call ic_putr (IC(sf), "low", clgetr ("low_reject"))
+		call ic_putr (IC(sf), "high", clgetr ("high_reject"))
+		call ic_puti (IC(sf), "niterate", clgeti ("niterate"))
+		call ic_putr (IC(sf), "grow", clgetr ("grow"))
+		call ic_puti (IC(sf), "markrej", btoi (clgetb ("markrej")))
+
+		IC_DESC(sf,i,j) = IC(sf)
+	    }
+
+	    # Get the desired output type
+	    OUTTYPE(sf) = clgwrd ("type", Memc[input], SZ_LINE, OUT_TYPES)
+
+	    # Open the logfiles
+	    NLOGFD(sf) = xt_logopen ("logfiles", "SFIT:", LOGFD(sf),
+		LOG_TO_STDOUT(sf))
+
+	} then {
+	    call sfree (sp)
+	    call sft_close (sf)
+	    call erract (EA_ERROR)
+	}
+
+	call sfree (sp)
+	return
+end
+
+
+# SFT_CLOSE -- Close the various descriptors.
+
+procedure sft_close (sf)
+
+pointer	sf			#I Pointer to task switches
+
+int	i, j
+
+begin
+	if (sf != NULL) {
+	    if (RGIN(sf) != NULL)
+		call rg_free (RGIN(sf))
+	    if (RGINB(sf) != NULL)
+		call rg_free (RGINB(sf))
+	    if (NLOGFD(sf) != 0)
+		call xt_logclose (LOGFD(sf), NLOGFD(sf), "END:")
+	    do j = 1, BMAX(sf)
+		do i = 1, YMAX(sf)
+		    if (IC_DESC(sf,i,j) != NULL)
+			call ic_closer (IC_DESC(sf,i,j))
+	    call mfree (sf, TY_STRUCT)
+	}
+end
+
+
+# SFT_IMMAP -- Map images for sfit.
+
+procedure sft_immap (input, output, in, out, mw, sh, sf, gp)
+
+char	input[ARB]		#I Input image name
+char	output[ARB]		#I Output image name
+pointer	in, out			#O IMIO pointers
+pointer	mw			#O MWCS pointer
+pointer	sh			#O SHDR pointer
+pointer	sf			#I Pointer for task switches
+pointer	gp			#I GIO pointer
+
+int	i, ax1, ax2, ax3
+pointer	inroot, insect, outroot, outsect, b1, b2
+pointer	sp, inranges, outranges
+pointer	rgin, rgout, rgtmp, rgtmpb
+long	v1[IM_MAXDIM], v2[IM_MAXDIM]
+char	emsg[SZ_LINE]
+
+int	imaccess(), imaccf(), imgnlr(), impnlr(), strcmp()
+pointer	immap(), smw_openim()
+pointer	rg_ranges(), rg_window(), rg_union(), rg_intersect()
+errchk	immap, smw_openim
+
+define	err_	13
+
+begin
+	call smark (sp)
+	call salloc (inroot, SZ_FNAME, TY_CHAR)
+	call salloc (insect, SZ_FNAME, TY_CHAR)
+	call salloc (outroot, SZ_FNAME, TY_CHAR)
+	call salloc (outsect, SZ_FNAME, TY_CHAR)
+	call salloc (inranges, SZ_LINE, TY_CHAR)
+	call salloc (outranges, SZ_LINE, TY_CHAR)
+
+	in = NULL
+	out = NULL
+	mw = NULL
+	sh = NULL
+	RGFIT(sf) = NULL
+	RGREFIT(sf) = NULL
+	RGFITB(sf) = NULL
+	RGREFITB(sf) = NULL
+
+	call imgimage (input, Memc[inroot], SZ_FNAME)
+	call imgsection (input, Memc[insect], SZ_FNAME)
+
+	call imgimage (output, Memc[outroot], SZ_FNAME)
+	call imgsection (output, Memc[outsect], SZ_FNAME)
+
+	if (Memc[insect] != EOS || Memc[outsect] != EOS) {
+
+	    call sprintf (emsg, SZ_LINE, "Sections not allowed (%s --> %s)")
+		call pargstr (input)
+		call pargstr (output)
+	    goto err_
+
+	} else if (imaccess (Memc[inroot], READ_ONLY) == NO) {
+
+	    call sprintf (emsg, SZ_LINE, "Cannot access %s")
+		call pargstr (input)
+	    goto err_
+
+	} else if (LISTONLY(sf) == YES) {
+
+	    # The `out = in' allows the ranges code at the end of this
+	    # procedure to cover all cases (with a little inefficiency).
+	    # No check on the sizes of the input and output images.
+
+	    in = immap (Memc[inroot], READ_ONLY, 0)
+	    out = in
+
+	} else if (strcmp (Memc[inroot], Memc[outroot]) == 0) {
+
+	    # Overwrite the input image.
+	    in = immap (Memc[inroot], READ_WRITE, 0)
+	    out = in
+
+	} else if (imaccess (Memc[outroot], READ_WRITE) == NO) {
+
+	    in = immap (Memc[inroot], READ_ONLY, 0)
+	    out = immap (Memc[outroot], NEW_COPY, in)
+	    if (IM_PIXTYPE(out) != TY_DOUBLE)
+		IM_PIXTYPE(out) = TY_REAL
+
+	    # Do this since imcopy is unimplemented
+
+	    call amovkl (long(1), v1, IM_MAXDIM)
+	    call amovkl (long(1), v2, IM_MAXDIM)
+
+	    while (imgnlr (in, b1, v1) != EOF && impnlr (out, b2, v2) != EOF)
+		call amovr (Memr[b1], Memr[b2], IM_LEN(in, 1))
+
+	} else {
+
+	    in = immap (Memc[inroot], READ_ONLY, 0)
+	    out = immap (Memc[outroot], READ_WRITE, 0)
+
+	    # This relies on the axes beyond IM_NDIM(im) being unity
+
+	    do i = 1, max (IM_NDIM(in), IM_NDIM(out))
+		if (IM_LEN(in, i) != IM_LEN(out, i)) {
+		    call sprintf (emsg, SZ_LINE, "%s & %s aren't the same size")
+			call pargstr (Memc[inroot])
+			call pargstr (Memc[outroot])
+		    goto err_
+		}
+
+	}
+
+	do i = 4, IM_NDIM(in)
+	    if (IM_LEN(in, i) != 1) {
+		call sprintf (emsg, SZ_LINE, "Too many dimensions for %s")
+		    call pargstr (Memc[inroot])
+		goto err_
+	    }
+
+	if (imaccf (in, SFT_KW) == YES)
+	    call imgstr (in, SFT_KW, Memc[inranges], SZ_LINE)
+	else
+	    call strcpy ("", Memc[inranges], SZ_LINE)
+
+	if (imaccf (out, SFT_KW) == YES)
+	    call imgstr (out, SFT_KW, Memc[outranges], SZ_LINE)
+	else {
+	    call strcpy ("", Memc[outranges], SZ_LINE)
+	    call imastr (out, SFT_KW, Memc[outranges])
+	}
+
+	mw = smw_openim (in)
+	ax1 = SMW_LLEN(mw,1)
+	ax2 = SMW_LLEN(mw,2)
+	ax3 = SMW_LLEN(mw,3)
+
+	rgin = rg_ranges (Memc[inranges], 1, ax2)
+	rgout = rg_ranges (Memc[outranges], 1, ax2)
+	rgtmp = rg_union (rgin, rgout)
+	call rg_free (rgin)
+	call rg_free (rgout)
+
+	if (imaccf (in, SFT_KWB) == YES)
+	    call imgstr (in, SFT_KWB, Memc[inranges], SZ_LINE)
+	else
+	    call strcpy ("", Memc[inranges], SZ_LINE)
+
+	if (imaccf (out, SFT_KWB) == YES)
+	    call imgstr (out, SFT_KWB, Memc[outranges], SZ_LINE)
+	else {
+	    call strcpy ("", Memc[outranges], SZ_LINE)
+	    call imastr (out, SFT_KWB, Memc[outranges])
+	}
+
+	rgin = rg_ranges (Memc[inranges], 1, ax3)
+	rgout = rg_ranges (Memc[outranges], 1, ax3)
+	rgtmpb = rg_union (rgin, rgout)
+	call rg_free (rgin)
+	call rg_free (rgout)
+
+	if (OVERRIDE(sf) == YES) {
+	    RGFIT(sf) = rg_window (RGIN(sf), 1, ax2)
+	    RGREFIT(sf) = rgtmp
+	    RGFITB(sf) = rg_window (RGINB(sf), 1, ax3)
+	    RGREFITB(sf) = rgtmpb
+	} else {
+	    call rg_inverse (rgtmp, 1, ax2)
+	    RGFIT(sf) = rg_intersect (RGIN(sf), rgtmp)
+	    RGREFIT(sf) = rg_ranges ("0", 1, 2)
+	    call rg_free (rgtmp)
+	    #call rg_inverse (rgtmpb, 1, ax3)
+	    #RGFITB(sf) = rg_intersect (RGINB(sf), rgtmpb)
+	    #RGREFITB(sf) = rg_ranges ("0", 1, 2)
+	    #call rg_free (rgtmpb)
+	    RGFITB(sf) = rg_window (RGINB(sf), 1, ax3)
+	    RGREFITB(sf) = rgtmpb
+	}
+
+	if (RG_NPTS(RGFIT(sf)) <= 0) {
+	    call sprintf (emsg, SZ_LINE, "No lines left to fit for %s")
+		call pargstr (Memc[inroot])
+	    goto err_
+	}
+
+	call sfree (sp)
+	return
+
+err_	call sfree (sp)
+	call sft_unmap (in, out, mw, sh, sf)
+	if (GRAPH_OPEN(sf) == YES) {
+	    call gclose (gp)
+	    GRAPH_OPEN(sf) = NO
+	}
+	# STDERR should get flushed AFTER closing graphics
+	call error (1, emsg)
+end
+
+
+# SFT_UNMAP -- Unmap images for sfit.
+
+procedure sft_unmap (in, out, mw, sh, sf)
+
+pointer	in, out			#I IMIO pointers
+pointer	mw			#I MWCS pointer
+pointer	sh			#I SHDR pointer
+pointer	sf			#I Task structure pointer
+
+begin
+	call shdr_close (sh)
+	if (mw != NULL)
+	    call smw_close (mw)
+	if (out != NULL && out != in)
+	    call imunmap (out)
+	if (in != NULL)
+	    call imunmap (in)
+	if (RGFIT(sf) != NULL)
+	    call rg_free (RGFIT(sf))
+	if (RGREFIT(sf) != NULL)
+	    call rg_free (RGREFIT(sf))
+	if (RGFITB(sf) != NULL)
+	    call rg_free (RGFITB(sf))
+	if (RGREFITB(sf) != NULL)
+	    call rg_free (RGREFITB(sf))
+end
+
+
+# SFT_ICFIT -- Given the image descriptors determine the fitting function
+# for each line and output the fit, difference, ratio or coefficients.
+
+int procedure sft_icfit (in, out, mw, sh, sf, gp, gt, graphics)
+
+pointer	in, out				#I IMIO pointers
+pointer	mw				#I MWCS pointer
+pointer	sh				#I SHDR pointer
+pointer	sf				#I Pointer for task switches
+pointer	gp				#I GIO pointer
+pointer	gt				#I GTOOLS pointer
+char	graphics[ARB]			#I Graphics device
+
+pointer	sp, wts, cv, data
+int	line, band, i, j, n
+
+int	sft_getline()
+pointer	gopen(), imps3r()
+real	sft_efncr()
+extern	sft_efncr
+
+begin
+	call smark (sp)
+	call salloc (wts, SMW_LLEN(mw,1), TY_REAL)
+
+	line = 0
+	band = 0
+	while (sft_getline (in, mw, sh, sf, gt, line, band) != EOF) {
+
+	    call amovkr (1., Memr[wts], SN(sh))
+
+	    if (QUIET(sf) == NO) {
+		if (GRAPH_OPEN(sf) == NO) {
+		    gp = gopen (graphics, NEW_FILE, STDGRAPH)
+		    GRAPH_OPEN(sf) = YES
+		}
+		call icg_fit (IC(sf), gp, "cursor", gt, cv, Memr[SX(sh)],
+		    Memr[SY(sh)], Memr[wts], SN(sh))
+	    } else
+		call ic_fit (IC(sf), cv, Memr[SX(sh)], Memr[SY(sh)],
+		    Memr[wts], SN(sh), YES, YES, YES, YES)
+
+	    if (LISTONLY(sf) == NO) {
+		i = LINDEX(sh,1)
+		j = LINDEX(sh,2)
+		n = SMW_LLEN(mw,1)
+		switch (SMW_LAXIS(mw,1)) {
+		case 1:
+		    data = imps3r (out, 1, n, i, i, j, j)
+		case 2:
+		    data = imps3r (out, i, i, 1, n, j, j)
+		case 3:
+		    data = imps3r (out, i, i, j, j,  1, n)
+		}
+		if (SN(sh) < n)
+		    call aclrr (Memr[data], n)
+
+		switch (OUTTYPE(sf)) {
+		case DATA:
+		    if (REPLACE(sf) == YES)
+			call ic_clean (IC(sf), cv, Memr[SX(sh)], Memr[SY(sh)],
+			    Memr[wts], SN(sh))
+		    call amovr (Memr[SY(sh)], Memr[data], SN(sh))
+		    call sft_update (out, mw, line, band)
+		case FIT:
+		    call cvvector (cv, Memr[SX(sh)], Memr[data], SN(sh))
+		    call sft_update (out, mw, line, band)
+		case DIFFERENCE:
+		    call cvvector (cv, Memr[SX(sh)], Memr[data], SN(sh))
+		    if (REPLACE(sf) == YES)
+			call ic_clean (IC(sf), cv, Memr[SX(sh)], Memr[SY(sh)],
+			    Memr[wts], SN(sh))
+		    call asubr (Memr[SY(sh)], Memr[data], Memr[data], SN(sh))
+		    call sft_update (out, mw, line, band)
+		case RATIO:
+		    call cvvector (cv, Memr[SX(sh)], Memr[data], SN(sh))
+		    if (REPLACE(sf) == YES)
+			call ic_clean (IC(sf), cv, Memr[SX(sh)], Memr[SY(sh)],
+			    Memr[wts], SN(sh))
+		    call advzr (Memr[SY(sh)], Memr[data], Memr[data], SN(sh),
+			sft_efncr)
+		    call sft_update (out, mw, line, band)
+		default:
+		    call error (1, "bad switch in sft_icfit")
+		}
+	    }
+
+	    call sft_power (in, line, cv, gp, sf)
+	    call cvfree (cv)
+
+	}
+
+	# This terminates the cursor (GIN) mode echoplex suppression in
+	# case the next sft_immap generates a password prompt from ZFIOKS.
+	# Note that any such password prompt (from the kernel!) will
+	# now show up on the status line, not the graphics plane.
+
+	if (GRAPH_OPEN(sf) == YES) {
+	    call printf ("\r")
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+	return (line)
+end
+
+
+# SFT_GETLINE -- Get image data to be fit.  Returns the line and band numbers.
+# Returns EOF when done.
+
+int procedure sft_getline (in, mw, sh, sf, gt, line, band)
+
+pointer	in			#I IMIO pointer
+pointer	mw			#I MWCS pointer
+pointer	sh			#I SHDR pointer
+pointer	sf			#I Pointer for task switches
+pointer	gt			#I GTOOLS pointer
+int	line			#U Line number
+int	band			#U Band number
+
+int	i
+bool	waveok
+char	ask[LEN_ANS]
+pointer	linebuf, rg1, rg2, sp
+
+int	clgwrd(), rg_next(), rg_inrange()
+pointer	rg_ranges(), rg_intersect()
+real	sft_efncr()
+extern	sft_efncr
+errchk	shdr_open
+
+define	again_		99
+
+begin
+	call smark (sp)
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+
+	if (band == 0)
+	    if (rg_next (RGFITB(sf), band) == EOF)
+		return (EOF)
+
+again_	if (rg_next (RGFIT(sf), line) == EOF) {
+	    line = 0
+	    if (rg_next (RGFITB(sf), band) == EOF)
+		return (EOF)
+	    goto again_
+	}
+
+	if (PROMPT(sf) == YES) {
+	    call clprintf ("ask.p_min", "%s")
+		call pargstr (SFT_ANS1X)
+
+	    if (rg_inrange (RGREFIT(sf), line) == YES &&
+		rg_inrange (RGREFITB(sf), band) == YES) {
+		call clprintf ("ask.p_prompt",
+		    "Refit [%d,%d] of %s w/ graph?        ")
+	    } else {
+		call clprintf ("ask.p_prompt",
+		    "Fit [%d,%d] of %s w/ graph?          ")
+	    }
+	    call pargi (line)
+	    call pargi (band)
+	    call pargstr (IM_HDRFILE(in))
+
+	    switch (clgwrd ("ask", ask, LEN_ANS, SFT_ANS1)) {
+
+	    case YES_ONCE:
+		QUIET(sf) = NO
+
+	    case NO_ONCE:
+		QUIET(sf) = YES
+
+	    case SKIP_ONCE:
+		goto again_
+
+	    case YES_ALWAYS:
+		QUIET(sf) = NO
+		PROMPT(sf) = NO
+
+	    case NO_ALWAYS:
+		QUIET(sf) = YES
+		PROMPT(sf) = NO
+
+	    case SKIP_ALWAYS:
+		call clprintf ("ask", "cancel")
+		call clprintf ("ask.p_min", "%s")
+		    call pargstr (SFT_ANS2X)
+		call clprintf ("ask.p_prompt",
+		    "Skip what?    (`all' to exit task)   ")
+
+		switch (clgwrd ("ask", ask, LEN_ANS, SFT_ANS2)) {
+
+		case SKIP_SPEC:
+		    call clprintf ("ask", "yes")
+		    # delete the spectrum from the list
+		    call sprintf (Memc[linebuf], SZ_LINE, "%d")
+			call pargi (line)
+
+		    rg1 = rg_ranges (Memc[linebuf], 1, SMW_LLEN(mw,2))
+		    call rg_inverse (rg1, 1, SMW_LLEN(mw,2))
+		    rg2 = rg_intersect (RGIN(sf), rg1)
+		    call rg_free (rg1)
+		    call rg_free (RGIN(sf))
+
+		    RGIN(sf) = rg2
+		    goto again_
+
+		case SKIP_IMAGE:
+		    call clprintf ("ask", "yes")
+		    return (EOF)
+
+		case SKIP_ALL:
+		    call clprintf ("ask", "yes")
+		    return (EOF)
+
+		case SKIP_CANCEL:
+		    call clprintf ("ask", "yes")
+		    line = line - 1
+		    goto again_
+
+		default:
+		    call error (1, "bad switch (2) in sft_getline")
+
+		}
+
+	    default:
+		call error (1, "bad switch (1) in sft_getline")
+
+	    }
+
+	}
+
+	call shdr_open (in, mw, line, band, INDEFI, SHDATA, sh)
+
+	if (LOGSCALE(sf) == YES)
+	    call alogr (Memr[SY(sh)], Memr[SY(sh)], SN(sh), sft_efncr)
+
+	if (WAVESCALE(sf) == YES) {
+	    waveok = true
+	} else
+	    waveok = false
+
+	if (!waveok)
+	    do i = 1, SN(sh)
+		Memr[SX(sh)+i-1] = i
+
+	if (LOGSCALE(sf) == YES)
+	    call alogr (Memr[SX(sh)], Memr[SX(sh)], SN(sh), sft_efncr)
+
+	# Initialize and/or update the icfit descriptor
+
+	if (IC_DESC(sf,line,band) == NULL) {
+	    call ic_open (IC_DESC(sf,line,band))
+	    call ic_copy (IC(sf), IC_DESC(sf,line,band))
+	    #call ic_pstr (IC_DESC(sf,line,band), "sample", "*")
+	}
+
+	IC(sf) = IC_DESC(sf,line,band)
+
+	call ic_putr (IC(sf), "xmin", min (Memr[SX(sh)], Memr[SX(sh)+SN(sh)-1]))
+	call ic_putr (IC(sf), "xmax", max (Memr[SX(sh)], Memr[SX(sh)+SN(sh)-1]))
+
+	if (QUIET(sf) == NO) {
+	    if (waveok && LOGSCALE(sf) == YES) {
+		call ic_pstr (IC(sf), "xlabel", "log wavelength")
+		call ic_pstr (IC(sf), "ylabel", "log data")
+	    } else if (LOGSCALE(sf) == YES) {
+		call ic_pstr (IC(sf), "xlabel", "log column")
+		call ic_pstr (IC(sf), "ylabel", "log data")
+	    } else if (waveok) {
+		call ic_pstr (IC(sf), "xlabel", "wavelength")
+		call ic_pstr (IC(sf), "ylabel", "")
+	    } else {
+		call ic_pstr (IC(sf), "xlabel", "column")
+		call ic_pstr (IC(sf), "ylabel", "")
+	    }
+
+	    call sprintf (Memc[linebuf], SZ_LINE, "%s, [%d,%d]\n%s")
+		call pargstr (IM_HDRFILE(in))
+		call pargi (line)
+		call pargi (band)
+		call pargstr (TITLE(sh))
+
+	    call gt_sets (gt, GTTITLE, Memc[linebuf])
+	}
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# SFT_EFNCR -- Called by advzr on division by zero or by alogr for a
+# zero or negative argument.
+
+real procedure sft_efncr (x)
+
+real	x
+
+begin
+	return (0.)
+end
+
+
+# SFT_POWER -- Transform the curfit output into a power series and
+# print the coefficients to the logfiles.  This should be modified to
+# print the errors as well.  That requires modifying the curfit routine
+# cvpower to deal with errors; and adding an icfit routine (or include
+# file define) that allows access to the dynamic arrays of sample points
+# that are initialized if the sample is less than the whole set of points.
+
+procedure sft_power (im, line, cv, gp, sf)
+
+pointer	im			#I IMIO descriptor for labeling
+int	line			#I Image line number for labeling
+pointer	cv			#I CURFIT pointer
+pointer	gp			#I GIO pointer for tidy output
+pointer sf			#I Pointer for task switches
+
+pointer	ps_coeff, linebuf, sp
+int	ncoeffs, i, j, fd
+
+int	cvstati(), strcmp()
+
+begin
+	if (NLOGFD(sf) <= 0)
+	    return
+
+	call smark (sp)
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+
+	# cvpower only works with legendre or chebyshev functions
+
+	call ic_gstr (IC(sf), "function", Memc[linebuf], SZ_LINE)
+	if (strcmp (Memc[linebuf], "legendre") != 0 &&
+	    strcmp (Memc[linebuf], "chebyshev") != 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	if (GRAPH_OPEN(sf) == YES && LOG_TO_STDOUT(sf) == YES) {
+	    call gclose (gp)
+	    GRAPH_OPEN(sf) = NO
+	}
+
+	ncoeffs = cvstati (cv, CVNCOEFF)
+	call salloc (ps_coeff, ncoeffs, TY_REAL)
+	call cvpower (cv, Memr[ps_coeff], ncoeffs)
+
+	do i = 1, NLOGFD(sf) {
+	    fd = Memi[LOGFD(sf)+i-1]
+
+	    call fprintf (fd, "Line %d of %s:\n\n")
+		call pargi (line)
+		call pargstr (IM_HDRFILE(im))
+
+	    call fprintf (fd, "      coeff           value\n")
+
+	    do j = 1, ncoeffs {
+		call fprintf (fd, "\t%d\t%12.5e\n")
+		    call pargi (j)
+		    call pargr (Memr[ps_coeff+j-1])
+	    }
+
+	    call fprintf (fd, "\n")
+	    call flush (fd)
+	}
+
+	call sfree (sp)
+end
+
+
+# SFT_UPDATE -- Update the keyword with completed spectrum.  Flush the pixels.
+
+procedure sft_update (im, mw, line, band)
+
+pointer	im			#I IMIO pointer
+pointer	mw			#I MWCS pointer
+int	line			#I Line just completed
+int	band			#I Band just completed
+
+pointer linebuf, rg1, rg2, rgold, sp
+
+pointer	rg_ranges(), rg_union()
+
+begin
+	call smark (sp)
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+
+	# this could be recoded to use "rg_add"
+
+	call sprintf (Memc[linebuf], SZ_LINE, "%d")
+	    call pargi (line)
+	rg1 = rg_ranges (Memc[linebuf], 1, SMW_LLEN(mw,2))
+
+	call imgstr (im, SFT_KW, Memc[linebuf], SZ_LINE)
+	rg2 = rg_ranges (Memc[linebuf], 1, SMW_LLEN(mw,2))
+
+	rgold = rg_union (rg1, rg2)
+	call rg_encode (rgold, Memc[linebuf], SZ_LINE)
+	call impstr (im, SFT_KW, Memc[linebuf])
+
+	call rg_free (rg1)
+	call rg_free (rg2)
+	call rg_free (rgold)
+
+	call sprintf (Memc[linebuf], SZ_LINE, "%d")
+	    call pargi (band)
+	rg1 = rg_ranges (Memc[linebuf], 1, SMW_LLEN(mw,3))
+
+	call imgstr (im, SFT_KWB, Memc[linebuf], SZ_LINE)
+	rg2 = rg_ranges (Memc[linebuf], 1, SMW_LLEN(mw,3))
+
+	rgold = rg_union (rg1, rg2)
+	call rg_encode (rgold, Memc[linebuf], SZ_LINE)
+	call impstr (im, SFT_KWB, Memc[linebuf])
+
+	call rg_free (rg1)
+	call rg_free (rg2)
+	call rg_free (rgold)
+
+	call imflush (im)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_sflip.x b/noao/onedspec/t_sflip.x
new file mode 100644
index 00000000..b14e2ae0
--- /dev/null
+++ b/noao/onedspec/t_sflip.x
@@ -0,0 +1,145 @@
+include	<error.h>
+include	<imhdr.h>
+include	<smw.h>
+
+
+# SFLIP -- Flip data and/or coordinate system in spectra.
+
+procedure t_sflip ()
+
+pointer	inlist		# Input list
+pointer	outlist		# Output list
+bool	coord_flip	# Flip coordinates?
+bool	data_flip	# Flip data?
+
+bool	in_place
+int	i, j, k, n, axis
+pointer	sp, input, output, temp, a, b, c
+pointer	in, out, smw, mw, tmp, inbuf, outbuf
+
+bool	clgetb(), streq()
+int	imtgetim(), imtlen()
+pointer	imtopenp(), immap(), smw_openim(), imgl3r(), impl3r()
+errchk	immap, smw_openim
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (a, 3*3, TY_DOUBLE)
+	call salloc (b, 3, TY_DOUBLE)
+	call salloc (c, 3, TY_DOUBLE)
+
+	# Get task parameters.
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	coord_flip = clgetb ("coord_flip")
+	data_flip = clgetb ("data_flip")
+
+	# Loop over all input images.
+	in = NULL
+	out = NULL
+	smw = NULL
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtlen (outlist) > 0) {
+		if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+		    break
+	    } else
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+	    if (streq (Memc[input], Memc[output])) {
+		if (data_flip) {
+		    in_place = false
+		    call mktemp ("temp", Memc[temp], SZ_FNAME)
+		} else
+		    in_place = true
+	    } else {
+		in_place = false
+		call strcpy (Memc[output], Memc[temp], SZ_FNAME)
+	    }
+
+	    iferr {
+		# Map the images and WCS.
+		if (in_place) {
+		    tmp = immap (Memc[input], READ_WRITE, 0); in = tmp
+		    out = in
+		} else {
+		    tmp = immap (Memc[input], READ_ONLY, 0); in = tmp
+		    tmp = immap (Memc[temp], NEW_COPY, in); out = tmp
+		}
+		tmp = smw_openim (in); smw = tmp
+
+		# Flip coordinates.
+		if (coord_flip) {
+		    mw = SMW_MW(smw,0)
+		    n = SMW_PDIM(smw)
+		    axis = SMW_PAXIS(smw,1) - 1
+		    call mw_gltermd (mw, Memd[a], Memd[b], n)
+		    Memd[a+axis*(n+1)] = -Memd[a+axis*(n+1)]
+		    Memd[b+axis] = SMW_LLEN(smw,1) - Memd[b+axis] + 1
+		    call mw_sltermd (mw, Memd[a], Memd[b], n)
+		    call smw_saveim (smw, out)
+		}
+
+		# Flip data.
+		if (data_flip) {
+		    n = IM_LEN(in,1)
+		    do j = 1, IM_LEN(in,3) {
+			do i = 1, IM_LEN(in,2) {
+			    inbuf = imgl3r (in, i, j)
+			    switch (SMW_FORMAT(smw)) {
+			    case SMW_ND:
+				switch (SMW_LAXIS(smw,1)) {
+				case 1:
+				    outbuf = impl3r (out, i, j) + n - 1
+				    do k = 0, n-1
+					Memr[outbuf-k] = Memr[inbuf+k]
+				case 2:
+				    outbuf = impl3r (out, IM_LEN(in,2)-i+1, j)
+				    call amovr (Memr[inbuf], Memr[outbuf], n)
+				case 3:
+				    outbuf = impl3r (out, i, IM_LEN(in,3)-j+1)
+				    call amovr (Memr[inbuf], Memr[outbuf], n)
+				}
+			    case SMW_ES, SMW_MS:
+				outbuf = impl3r (out, i, j) + n - 1
+				do k = 0, n-1
+				    Memr[outbuf-k] = Memr[inbuf+k]
+			    }
+			}
+		    }
+		} else if (!in_place) {
+		    n = IM_LEN(in,1)
+		    do j = 1, IM_LEN(in,3) {
+			do i = 1, IM_LEN(in,2) {
+			    inbuf = imgl3r (in, i, j)
+			    outbuf = impl3r (out, i, j)
+			    call amovr (Memr[inbuf], Memr[outbuf], n)
+			}
+		    }
+		}
+	    } then {
+		if (!in_place && out != NULL) {
+		    call imunmap (out)
+		    call imdelete (Memc[temp])
+		}
+		call erract (EA_WARN)
+	    }
+
+	    if (smw != NULL)
+		call smw_close (smw)
+	    if (!in_place && out != NULL) {
+		call imunmap (out)
+		call imunmap (in)
+		if (streq (Memc[input], Memc[output])) {
+		    call imdelete (Memc[input])
+		    call imrename (Memc[temp], Memc[output])
+		}
+	    } else if (in != NULL)
+		call imunmap (in)
+	}
+
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_sinterp.x b/noao/onedspec/t_sinterp.x
new file mode 100644
index 00000000..2275a42b
--- /dev/null
+++ b/noao/onedspec/t_sinterp.x
@@ -0,0 +1,232 @@
+include	<imhdr.h>
+include	<math/curfit.h>
+
+# Interpolation mode
+define	SI_LINEAR		1
+define	SI_CURVES		2
+define	SI_LEGENDRE		3
+define	SI_CHEBYSHEV		4
+define	SI_SPLINE3		5
+define	SI_SPLINE1		6
+
+# T_SINTERP -- Interpolate for values in a table and optionally generate
+#		a spectral image
+#
+# A table of x,y pairs contained in a file is used to
+# find interpolated values, y, for any other given independent
+# variable, x. Extrapolation is performed if necessary.
+#
+# A series of values may be generated to generate a fine grid
+# through a coarse sampling for purposes of plotting. This is
+# done by setting the hidden parameter curve_gen to yes.
+# The starting point, ending point, and sampling interval
+# are also needed in this case (x1, x2, dx).
+#
+# If only a small number of values are needed to be interpolated
+# from the table, the user may enter a number of x's from either
+# a file or STDIN.
+
+procedure t_sinterp()
+
+real	x, y, x1, x2, dx
+int	npts, i
+int	filelist, tbl, in
+int	user_mode, imlen, order, maxpts
+char	fname[SZ_FNAME], tbl_file[SZ_FNAME]
+char	image[SZ_FNAME]
+char	interp[SZ_LINE]
+bool	gen, make_image
+pointer	im, pix, sp, xtab, ytab, cv
+
+int	clpopni(), clgfil(), open(), fscan(), nscan()
+int	clgeti(), clgwrd()
+real	clgetr()
+bool	clgetb()
+pointer	immap(), impl1r()
+
+begin
+	# Initialize interpolator
+	call intrp0 (1)
+	cv = NULL
+
+	# File containing x,y pairs in a table
+	call clgstr ("tbl_file", tbl_file, SZ_FNAME)
+
+	# Open table file and read as many points as possible
+	tbl = open (tbl_file, READ_ONLY, TEXT_FILE)
+
+	npts = 0
+	maxpts = clgeti ("tbl_size")
+
+	call smark (sp)
+	call salloc (xtab, maxpts, TY_REAL)
+	call salloc (ytab, maxpts, TY_REAL)
+
+	while (fscan(tbl) != EOF) {
+	    npts = npts + 1
+	    if (npts > maxpts)
+		call error (1, "Maximum table size exceeded.")
+	    call gargr (Memr[xtab+npts-1])
+	    call gargr (Memr[ytab+npts-1])
+	    if (nscan() < 2) {
+#		call eprintf ("Error reading x,y pairs\n")
+		npts = npts - 1
+	    }
+	}
+
+	call close (tbl)
+
+	if (npts < 1)
+	    call error (1, "Table has no entries.")
+
+	# Linear, spline, or CURFIT option interpolator?
+	user_mode = clgwrd ("interp_mode", interp, SZ_LINE,
+	    ",linear,curves,legendre,chebyshev,spline3,spline1")
+
+	if (user_mode > 2 && user_mode <= 6)
+	    order = clgeti ("order")
+
+	# Generate a curve?
+	gen = clgetb ("curve_gen")
+
+	# Or an image?
+	make_image = clgetb ("make_image")
+
+	if (gen || make_image) {
+	    x1 = clgetr ("x1")
+	    x2 = clgetr ("x2")
+	    dx = clgetr ("dx")
+	    imlen = clgeti ("npts")
+
+	    # The above four variables overdefine the function
+	    # One (other than x1) must be 0.0 --> solve for it
+	    if (x2 == 0.0)
+		x2 = x1 + (imlen-1) * dx
+	    else if (dx == 0.0)
+		dx = (x2 - x1) / (imlen - 1)
+
+	    imlen = nint ((x2 - x1) / dx + 1)
+
+	    # Verify that dx will not cause an infinite loop
+	    if (dx == 0.0 || dx * (x2-x1) < 0.0)
+		call error (1, "Interval paramater dx implies infinite loop.")
+
+	    if (make_image) {
+		call clgstr ("image", image, SZ_FNAME)
+		im = immap (image, NEW_IMAGE, 0)
+
+		IM_NDIM (im) = 1
+		IM_LEN (im, 1) = imlen
+		IM_PIXTYPE (im) = TY_REAL
+
+		pix = impl1r (im)
+
+		do i = 1, imlen {
+		    x = x1 + (i - 1) * dx
+		    call gen_pixel (Memr[xtab], Memr[ytab], npts, 
+			user_mode, order, x, y, cv)
+		    Memr[pix+i-1] = y
+		}
+
+		call imaddr (im, "CRVAL1", x1)
+		call imaddr (im, "CDELT1", dx)
+		call imaddr (im, "CD1_1", dx)
+		call imaddr (im, "CRPIX1", 1.)
+		call imaddi (im, "DC-FLAG", 0)
+
+		call imunmap (im)
+	    } else {
+		do i = 1, imlen {
+		    x = x1 + (i - 1) * dx
+		    call gen_pixel (Memr[xtab], Memr[ytab], npts, 
+			user_mode, order, x, y, cv)
+		    call printf ("%12.5g  %12.5g\n")
+		        call pargr (x)
+		        call pargr (y)
+		}
+		call flush (STDOUT)
+	    }
+
+	# No, just one point at a time
+	} else {
+
+	    # Open input list
+	    filelist = clpopni ("input")
+
+	    while (clgfil (filelist, fname, SZ_FNAME) != EOF) {
+		in = open (fname, READ_ONLY, TEXT_FILE)
+
+		# Process input requests
+		while (fscan(in) != EOF) {
+		    call gargr (x)
+
+		    call gen_pixel (Memr[xtab], Memr[ytab], npts, 
+			user_mode, order, x, y, cv)
+		    call printf ("%12.5g  %12.5g\n")
+			call pargr (x)
+			call pargr (y)
+		    call flush (STDOUT)
+		}
+
+		call close (in)
+	    }
+
+	    call clpcls (filelist)
+	}
+
+	call cvfree (cv)
+	call sfree (sp)
+end
+
+# GEN_PIXEL -- Generate a pixel value using specified interpolator
+
+procedure gen_pixel (xtab, ytab, npts, mode, order, x, y, cv)
+
+real	xtab[ARB], ytab[ARB]
+int	npts
+real	x
+int	mode, order
+real	y
+pointer	cv
+
+int	fit, ier
+pointer	wt, sp
+
+real	cveval()
+
+begin
+	# Interpolate after selecting option
+	switch (mode) {
+	    case SI_LINEAR:
+		call lintrp (1, xtab, ytab, npts, x, y, ier)
+
+	    case SI_CURVES:
+		call intrp  (1, xtab, ytab, npts, x, y, ier)
+
+	    default:
+		if (cv == NULL) {
+		    call smark (sp)
+		    call salloc (wt, npts, TY_REAL)
+		    call amovkr (1.0, Memr[wt], npts)
+
+		    switch (mode) {
+	    		case SI_LEGENDRE:
+			    fit = LEGENDRE
+	    		case SI_CHEBYSHEV:
+			    fit = CHEBYSHEV
+	    		case SI_SPLINE3:
+			    fit = SPLINE3
+	    		case SI_SPLINE1:
+			    fit = SPLINE1
+			default:
+			    fit = SPLINE1
+		    }
+
+		    call cvinit (cv, fit, order, xtab[1], xtab[npts])
+		    call cvfit (cv, xtab, ytab, Memr[wt], npts, WTS_UNIFORM,
+			ier)
+		    call sfree (sp)
+		}
+		y = cveval (cv, x)
+	}
+end
diff --git a/noao/onedspec/t_slist.x b/noao/onedspec/t_slist.x
new file mode 100644
index 00000000..aa31fa08
--- /dev/null
+++ b/noao/onedspec/t_slist.x
@@ -0,0 +1,105 @@
+include	<error.h>
+include	<imhdr.h>
+include	<fset.h>
+include	<smw.h>
+
+
+# T_SLIST --  Lists header information from MULTISPEC format header
+
+procedure t_slist ()
+
+int	list			# Input list
+pointer	aps			# Aperture range list
+int	long_header		# Long header?
+
+int	i
+pointer	sp, image, im, mw, sh, ptr
+
+bool	clgetb(), rng_elementi()
+int	 imtopenp(), imtgetim(), btoi()
+pointer	rng_open(), immap(), smw_openim()
+errchk	immap, smw_openim, shdr_open
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Parameters
+	list = imtopenp ("images")
+	call clgstr ("apertures", Memc[image], SZ_LINE)
+	long_header = btoi (clgetb ("long_header"))
+
+	# Initialize
+	call fseti (STDOUT, F_FLUSHNL, YES)
+	iferr (aps = rng_open (Memc[image], INDEF, INDEF, INDEF))
+	    call error (0, "Bad range specification")
+
+	# Loop over all input images.
+	while (imtgetim (list, Memc[image], SZ_LINE) != EOF) {
+	    iferr {
+		im = NULL
+		mw = NULL
+		ptr = immap (Memc[image], READ_ONLY, 0); im = ptr
+		ptr = smw_openim (im); mw = ptr
+		#if (SMW_FORMAT(mw) != SMW_ES && SMW_FORMAT(mw) != SMW_MS)
+		#    call error (1, "Invalid spectrum format")
+		call shdr_open (im, mw, 1, 1, INDEFI, SHHDR, sh)
+	    } then {
+		if (mw != NULL) {
+		    call smw_close (mw)
+		    if (sh != NULL)
+			MW(sh) = NULL
+		}
+		if (im != NULL)
+		    call imunmap (im)
+		call erract (EA_WARN)
+		next
+	    }
+
+	    if (long_header == YES) {
+		call printf ("%s: %s\n")
+		    call pargstr (IMNAME(sh))
+		    call pargstr (IM_TITLE(im))
+		call printf (
+		    "    EXPTIME = %.2f%24tUT = %0.1h%44tST = %0.1h\n")
+		    call pargr (IT(sh))
+		    call pargr (UT(sh))
+		    call pargr (ST(sh))
+		call printf (
+	"    RA = %0.2h%24tDEC = %0.1h%44tHA = %0.2h%64tAIRMASS = %5.3f\n")
+		    call pargr (RA(sh))
+		    call pargr (DEC(sh))
+		    call pargr (HA(sh))
+		    call pargr (AM(sh))
+	    }
+	    do i = 1, IM_LEN(im, SMW_LAXIS(MW(sh),2)) {
+		call shdr_open (im, mw, i, 1, INDEFI, SHHDR, sh)
+		if (!rng_elementi (aps, AP(sh)))
+		    next
+		if (long_header == NO)
+		    call printf (IMNAME(sh))
+		else
+		    call printf ("   ")
+		call printf (" %d %d %d %d %g %g %d %s\n")
+			call pargi (i)
+			call pargi (AP(sh))
+			call pargi (BEAM(sh))
+			call pargi (DC(sh))
+			call pargr (W0(sh))
+			call pargr (WP(sh))
+			call pargi (SN(sh))
+			call pargstr (TITLE(sh))
+	    }
+
+	    call smw_close (MW(sh))
+	    if (sh != NULL)
+		MW(sh) = NULL
+	    call imunmap (im)
+	}
+
+	# Free space
+	call shdr_close (sh)
+	call rng_close (aps)
+	call imtclose (list)
+	call sfree (sp)
+end
diff --git a/noao/onedspec/t_specplot.x b/noao/onedspec/t_specplot.x
new file mode 100644
index 00000000..414b275c
--- /dev/null
+++ b/noao/onedspec/t_specplot.x
@@ -0,0 +1,2030 @@
+include	<ctype.h>
+include	<imhdr.h>
+include	<error.h>
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	"specplot.h"
+
+# Define the help information.
+define	HELP		"noao$onedspec/specplot.key"
+define	PROMPT		"specplot options"
+
+ 
+# T_SPECPLOT -- Plot multiple spectra in a variety of formats and layouts.
+# The spectra may be individually scaled and offset in intensity, shifted
+# and scaled in wavelength, and plotted in uniform steps.  The plotting
+# type may be symbols or lines.  The spectra may be labeled.  Each spectrum
+# is read into memory in a structre defined in "specplot.h".  An array
+# of structures is then manipulated.  Each line of two dimensional images
+# are treated as separate spectra.
+
+procedure t_specplot ()
+
+pointer	list			# List of input spectra
+real	step			# Initial separation step
+int	labels			# Labeling mode
+real	fraction		# Fraction of minimum step
+bool	yscale			# Draw y scale?
+
+bool	wscale
+int	i, j, n, fd, nspec, wcs, key, redraw
+real	wx, wy, wx1, wy1, wx2, wy2
+pointer	stack, units, cmd, sp, sh, spsave, sps, gp, gt
+
+bool	clgetb()
+int	clgwrd(), clgcur()
+int	open(), imtgetim(), getline(), scan(), nscan()
+int	stridxs(), nowhite(), btoi(), gt_geti()
+real	clgetr()
+pointer	sp_nearest(), imtopenp(), gopen(), gt_init()
+errchk	sp_gdata, un_changer
+
+define	nospec_	99
+
+begin
+	call smark (stack)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call calloc (sps, 100, TY_POINTER)
+	spsave = NULL
+
+	# Read the input spectrum list into an array of structures.
+	i = 0
+	nspec = 0
+	list = imtopenp ("spectra")
+	call clgstr ("units", Memc[units], SZ_LINE)
+	if (nowhite (Memc[units], Memc[cmd], SZ_LINE) == 0)
+	    call strcpy ("display", Memc[units], SZ_LINE)
+	while (imtgetim (list, Memc[cmd], SZ_FNAME) != EOF) {
+	    iferr (call sp_gdata (Memc[cmd], Memc[units], i, sps, nspec))
+		call erract (EA_WARN)
+	}
+	call imtclose (list)
+
+
+	# Set the layout of the spectra.
+	step = clgetr ("step")
+	fraction = clgetr ("fraction")
+	if (clgetb ("autolayout")) {
+	    if (clgetb ("autoscale"))
+	        call sp_autolayout (Memi[sps], nspec, true, fraction, step)
+	    else
+	        call sp_autolayout (Memi[sps], nspec, false, fraction, step)
+	}
+	call sp_scale (Memi[sps], nspec, step)
+
+	# Get optional user labels from a file and set the label type.
+	call clgstr ("ulabels", Memc[cmd], SZ_FNAME)
+	ifnoerr (fd = open (Memc[cmd], READ_ONLY, TEXT_FILE)) {
+	    do i = 1, nspec {
+		sp = Memi[sps+i-1]
+		if (getline (fd, Memc[cmd]) != EOF)
+		    call strcpy (Memc[cmd], SP_ULABEL(sp), SP_SZULABEL)
+		else
+		    SP_ULABEL(sp) = EOS
+		j = stridxs ("\n", SP_ULABEL(sp))
+		if (j > 0)
+		    call strcpy (SP_ULABEL(sp), SP_ULABEL(sp), j-1)
+	    }
+	    call close (fd)
+	}
+	labels = clgwrd ("labels", Memc[cmd], SZ_FNAME, LABELS)
+	call sp_labels (Memi[sps], nspec, labels)
+
+	# Initialize the graphics
+	call clgstr ("graphics", Memc[cmd], SZ_FNAME)
+	gp = gopen (Memc[cmd], NEW_FILE, STDGRAPH)
+
+	gt = gt_init ()
+	call gt_seti (gt, GTSYSID, btoi (clgetb ("sysid")))
+	call clgstr ("title", Memc[cmd], SZ_LINE)
+	call gt_sets (gt, GTTITLE, Memc[cmd])
+	call clgstr ("xlabel", Memc[cmd], SZ_LINE)
+	if (Memc[cmd] != EOS) {
+	    call gt_sets (gt, GTXLABEL, Memc[cmd])
+	    call gt_sets (gt, GTXUNITS, "")
+	} else if (nspec > 0) {
+	    if (UN_LABEL(UN(SP_SH(Memi[sps]))) != EOS) {
+		call gt_sets (gt, GTXLABEL, UN_LABEL(UN(SP_SH(Memi[sps]))))
+		call gt_sets (gt, GTXUNITS, UN_UNITS(UN(SP_SH(Memi[sps]))))
+	    } else {
+		call gt_sets (gt, GTXLABEL, LABEL(SP_SH(Memi[sps])))
+		call gt_sets (gt, GTXUNITS, UNITS(SP_SH(Memi[sps])))
+	    }
+	}
+	call clgstr ("ylabel", Memc[cmd], SZ_LINE)
+	call gt_sets (gt, GTYLABEL, Memc[cmd])
+	wx = clgetr ("xmin")
+	call gt_setr (gt, GTXMIN, wx)
+	wx = clgetr ("xmax")
+	call gt_setr (gt, GTXMAX, wx)
+	wx = clgetr ("ymin")
+	call gt_setr (gt, GTYMIN, wx)
+	wx = clgetr ("ymax")
+	call gt_setr (gt, GTYMAX, wx)
+	wscale = true
+	yscale = clgetb ("yscale")
+	#if (!scale)
+	#    call gseti (gp, G_YDRAWTICKS, NO)
+
+	# Draw the graph on the first pass and then read the cursor.
+	key = 'r'
+	repeat {
+	    switch (key) {
+	    case '?': # Page help summary
+		call gpagefile (gp, HELP, PROMPT)
+	    case ':': # Process colon commands
+		if (Memc[cmd] == '/')
+		    call gt_colon (Memc[cmd], gp, gt, redraw)
+		else {
+		    i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps],
+			nspec)
+		    call sp_colon (Memc[cmd], gp, gt, Memi[sps], nspec,
+			Memc[units], labels, i, step, fraction, redraw)
+		    if (nspec == 0) {
+			redraw = NO
+			goto nospec_
+		    }
+		}
+	    case 'a', 'i': # Append or insert a new spectrum
+		i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps], nspec)
+		if (key == 'i')
+		    i = max (0, i - 1)
+		call printf ("Spectrum: ")
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargwrd (Memc[cmd], SZ_LINE)
+		    if (nscan() == 1) {
+			iferr {
+	    		    call sp_gdata (Memc[cmd], Memc[units],
+				i, sps, nspec)
+	    	    	    call sp_labels (Memi[sps], nspec, labels)
+	    	    	    call sp_scale (Memi[sps], nspec, step)
+		    	    redraw = YES
+			} then
+			    call erract (EA_WARN)
+		    }
+		}
+	    case 'd': # Delete a spectrum
+		if (nspec == 0)
+		    goto nospec_
+
+		i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps], nspec)
+		sp = Memi[sps+i-1]
+	    	call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp), YES, gp, gt)
+	    	call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+		call gline (gp, SP_X(sp), SP_Y(sp), SP_X(sp), SP_Y(SP))
+		call sp_delete (i, sps, nspec)
+	    	call sp_labels (Memi[sps], nspec, labels)
+	    	call sp_scale (Memi[sps], nspec, step)
+		if (spsave != NULL)
+		    call sp_free (spsave)
+		spsave = sp
+#		redraw = YES
+	    case 'e': # Undelete a spectrum
+		if (spsave != NULL) {
+		    i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps],
+			nspec)
+		    i = max (0, i - 1)
+		    call sp_add (spsave, i, sps, nspec)
+		    call sp_labels (Memi[sps], nspec, labels)
+		    call sp_scale (Memi[sps], nspec, step)
+		    spsave = NULL
+		    redraw = YES
+		}
+	    case 'f': # Toggle wavelength scale
+		if (wscale) {
+		    call gt_sets (gt, GTXLABEL, "Pixels")
+		    call gt_sets (gt, GTXUNITS, "")
+		    wscale = false
+		} else {
+		    if (nspec > 0) {
+			sp = Memi[sps]
+			sh = SP_SH(sp) 
+			call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+			call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+		    }
+		    wscale = true
+		}
+		redraw = YES
+	    case 'l', 'p': # Mark label position and enter label.
+		if (nspec == 0)
+		    goto nospec_
+
+		i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps], nspec)
+		sp = Memi[sps+i-1]
+		call printf (
+		    "Spectrum %d:  Mark position for label ('q' to cancel)")
+		    call pargi (SP_INDEX(sp))
+		i = clgcur ("cursor", wx, wy, wcs, j, Memc[cmd], SZ_LINE)
+		if (j != 'q') {
+		    call ggwind (gp, wx1, wx2, wy1, wy2)
+		    wx2 = wx2 - wx1
+		    wy2 = wy2 - wy1
+		    SP_XLPOS(sp) = (wx - wx1) / wx2
+		    SP_YLPOS(sp) = (wy - SP_MEAN(sp)) / wy2
+
+		    if (key == 'l') {
+		        call printf ("Spectrum %d: Label = ")
+		            call pargi (SP_INDEX(sp))
+		        call flush (STDOUT)
+		        if (scan() != EOF) {
+		            call gargstr (SP_ULABEL(sp), SP_SZULABEL)
+			    j = stridxs ("\n", SP_ULABEL(sp))
+			    if (j > 0)
+			        call strcpy (SP_ULABEL(sp), SP_ULABEL(sp), j-1)
+			    call strcpy (SP_ULABEL(sp), SP_LABEL(sp),
+				SP_SZLABEL)
+		        }
+		    }
+		    call gtext (gp, wx, wy, SP_LABEL(sp), "")
+		}
+		call printf ("\n")
+	    case 'o': # Reorder the spectra to eliminate gaps.
+		if (nspec == 0)
+		    goto nospec_
+
+		do i = 1, nspec {
+		    sp = Memi[sps+i-1]
+		    if (SP_INDEX(sp) != i) {
+		        SP_INDEX (sp) = i
+			redraw = YES
+		    }
+		}
+		if (redraw == YES) {
+	            call sp_labels (Memi[sps], nspec, labels)
+	            call sp_scale (Memi[sps], nspec, step)
+		}
+	    case 'q', 'I': # Quit or interrupt
+		break
+	    case 'r': # Redraw the current graph
+		redraw = YES
+	    case 's': # Shift the spectrum nearest the cursor
+		if (nspec == 0)
+		    goto nospec_
+
+		i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps], nspec)
+		sp = Memi[sps+i-1]
+		call printf ( "Shift spectrum %d: (q, r, s, t, x, y, z)")
+		    call pargi (SP_INDEX(sp))
+		while (clgcur ("cursor", wx1, wy1, wcs, key, Memc[cmd],
+		    SZ_LINE) != EOF) {
+		    switch (key) {
+		    case 's':
+			if (wy != SP_OFFSET(sp)) {
+	    	            call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+				YES, gp, gt)
+	    		    call gt_plot (gp, gt, SP_X(sp), SP_Y(sp),
+				SP_NPTS(sp))
+			    call gline (gp, SP_X(sp), SP_Y(sp), SP_X(sp),
+				SP_Y(sp))
+			    SP_SCALE(sp) = SP_SCALE(sp) *
+				(wy1 - SP_OFFSET(sp)) / (wy - SP_OFFSET(sp))
+		            call sp_scale (sp, 1, step)
+	    	            call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+				NO, gp, gt)
+	    		    call gt_plot (gp, gt, SP_X(sp), SP_Y(sp),
+				SP_NPTS(sp))
+			    wy = wy1
+			}
+		    case 't':
+			if (wy != SP_OFFSET(sp)) {
+	    	            call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+				YES, gp, gt)
+	    		    call gt_plot (gp, gt, SP_X(sp), SP_Y(sp),
+				SP_NPTS(sp))
+			    call gline (gp, SP_X(sp), SP_Y(sp), SP_X(sp),
+				SP_Y(sp))
+			    if (UN_CLASS(UN(SP_SH(sp))) == UN_VEL)
+				SP_XOFFSET(sp) = SP_XOFFSET(sp) + wx1 - wx
+			    else
+				SP_XSCALE(sp) = SP_XSCALE(sp) * wx1 / wx
+			    SP_SCALE(sp) = SP_SCALE(sp) *
+				(wy1 - SP_OFFSET(sp)) / (wy - SP_OFFSET(sp))
+		            call sp_scale (sp, 1, step)
+	    	            call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+				NO, gp, gt)
+	    		    call gt_plot (gp, gt, SP_X(sp), SP_Y(sp),
+				SP_NPTS(sp))
+			    wx = wx1
+			    wy = wy1
+			}
+		    case 'x':
+	    	        call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+			    YES, gp, gt)
+	    		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+			call gline (gp, SP_X(sp), SP_Y(sp), SP_X(sp), SP_Y(SP))
+			if (UN_CLASS(UN(SP_SH(sp))) == UN_VEL)
+			    SP_XOFFSET(sp) = SP_XOFFSET(sp) + wx1 - wx
+			else
+			    SP_XSCALE(sp) = SP_XSCALE(sp) * wx1 / wx
+		        call sp_scale (sp, 1, step)
+	    	        call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+			    NO, gp, gt)
+	    		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+			wx = wx1
+		    case 'y':
+	    	        call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+			    YES, gp, gt)
+	    		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+			call gline (gp, SP_X(sp), SP_Y(sp), SP_X(sp), SP_Y(SP))
+			SP_OFFSET(sp) = SP_OFFSET(sp) + wy1 - wy
+		        call sp_scale (sp, 1, step)
+	    	        call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+			    NO, gp, gt)
+	    		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+			wy = wy1
+		    case 'z':
+	    	        call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+			    YES, gp, gt)
+	    		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+			call gline (gp, SP_X(sp), SP_Y(sp), SP_X(sp), SP_Y(SP))
+			if (UN_CLASS(UN(SP_SH(sp))) == UN_VEL)
+			    SP_XOFFSET(sp) = SP_XOFFSET(sp) + wx1 - wx
+			else
+			    SP_XSCALE(sp) = SP_XSCALE(sp) * wx1 / wx
+			SP_OFFSET(sp) = SP_OFFSET(sp) + wy1 - wy
+		        call sp_scale (sp, 1, step)
+	    	        call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp),
+			    NO, gp, gt)
+	    		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+			wx = wx1
+			wy = wy1
+		    case 'r':
+			if (gt_geti (gt, GTSYSID) == YES) {
+			    call sprintf (Memc[cmd], SZ_LINE,
+				"Separation step = %g")
+			        call pargr (step)
+			    call gt_sets (gt, GTPARAMS, Memc[cmd])
+			} else
+			    call gt_sets (gt, GTPARAMS, "")
+			call sp_plot (gp, gt, Memi[sps], nspec, wscale, yscale)
+		    case 'q':
+			break
+		    }
+		    call printf ( "Shift spectrum %d: (q, r, s, t, x, y, z)")
+		        call pargi (SP_INDEX(sp))
+		}
+		call printf ("\n")
+	    case 't': # Set a wavelength scale using the cursor.
+		if (nspec == 0)
+		    goto nospec_
+
+		i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps], nspec)
+		sp = Memi[sps+i-1]
+		call printf ("X coordinate (%g): ")
+		    call pargr (wx)
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargr (wy)
+		    if (nscan() == 0)
+			wy = wx
+		} else
+		    wy = wx
+		call printf ("Mark another position")
+		i = clgcur ("cursor", wx1, wy1, wcs, key, Memc[cmd], SZ_LINE)
+		call printf ("X coordinate (%g): ")
+		    call pargr (wx1)
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargr (wy1)
+		    if (nscan() == 0)
+			wy1 = wx1
+		} else
+		    wy1 = wx1
+		if (wx != wx1) {
+		    n = SP_NPTS(sp) - 1
+		    sh = SP_PX(sp) - 1
+		    if (SP_WPC(sp) > 0.) {
+			for (i=1; i<n && wx<Memr[sh+i]; i=i+1)
+			    ;
+			for (j=1; j<n && wx1<Memr[sh+j]; j=j+1)
+			    ;
+		    } else {
+			for (i=1; i>n && wx>Memr[sh+i]; i=i+1)
+			    ;
+			for (j=1; j>n && wx1>Memr[sh+j]; j=j+1)
+			    ;
+		    }
+		    wx = i + (wx - Memr[sh+i]) / (Memr[sh+i+1] - Memr[sh+i])
+		    wx1 = j + (wx1 - Memr[sh+j]) / (Memr[sh+j+1] - Memr[sh+j])
+		    SP_WPC(sp) = (wy - wy1) / (wx - wx1)
+		    SP_W0(sp) = wy - SP_WPC(sp) * (wx - 1)
+		    call sp_linear (sp)
+		    call sp_scale (sp, 1, step)
+		    redraw = YES
+		}
+	    case 'u': # Set a wavelength point using the cursor.
+		if (nspec == 0)
+		    goto nospec_
+
+		i = sp_nearest (gp, wx, wy, key, Memc[cmd], Memi[sps], nspec)
+		sp = Memi[sps+i-1]
+		call printf ("X coordinate (%g): ")
+		    call pargr (wx)
+		    call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargr (wx1)
+		    if (nscan() == 1) {
+		        SP_XOFFSET(sp) = SP_XOFFSET(sp) + wx1 - wx
+			call sp_scale (sp, 1, step)
+			redraw = YES
+		    }
+		}
+	    case 'v': # Change to velocity scale
+		if (nspec == 0)
+		    goto nospec_
+
+		iferr {
+		    do i = 1, nspec {
+			sp = Memi[sps+i-1]
+			sh = SP_SH(sp) 
+			if (i == 1) {
+			    call un_changer (UN(sh), "angstroms", wx, 1, NO)
+			    call sprintf (Memc[units], SZ_LINE,
+				"km/s %g angstroms")
+				call pargr (wx)
+			    call un_changer (UN(sh), Memc[units], Memr[SX(sh)],
+				SN(sh), YES)
+			    call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+			    call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+			    redraw = YES
+			} else
+			    call un_changer (UN(sh), Memc[units], Memr[SX(sh)],
+				SN(sh), YES)
+			SP_W0(sp) = Memr[SX(sh)]
+			SP_WPC(sp) = (Memr[SX(sh)+SN(sh)-1] - Memr[SX(sh)]) /
+			    (SN(sh) - 1)
+			SP_XSCALE(sp) = 1.
+			SP_XOFFSET(sp) = 0.
+			call sp_scale (sp, 1, step)
+		    }
+		} then
+		    call erract (EA_WARN)
+	    case 'w': # Window the graph
+		call gt_window (gt, gp, "cursor", redraw)
+	    case 'x': # No layout
+		if (nspec == 0)
+		    goto nospec_
+
+		do i = 1, nspec {
+		    sp = Memi[sps+i-1]
+		    SP_SCALE(sp) = 1.
+		    SP_OFFSET(sp) = 0.
+		}
+	        call sp_scale (Memi[sps], nspec, step)
+		redraw = YES
+	    case 'y': # Layout the spectra offsets to common mean
+		if (nspec == 0)
+		    goto nospec_
+
+	        call sp_autolayout (Memi[sps], nspec, false, fraction, step)
+	        call sp_scale (Memi[sps], nspec, step)
+		redraw = YES
+	    case 'z': # Layout the spectra scaled to common mean
+		if (nspec == 0)
+		    goto nospec_
+
+	        call sp_autolayout (Memi[sps], nspec, true, fraction, step)
+	        call sp_scale (Memi[sps], nspec, step)
+		redraw = YES
+	    default:
+		call printf ("\007")
+	    }
+
+	    # Redraw the graph as needed.
+	    if (redraw == YES) {
+		if (gt_geti (gt, GTSYSID) == YES) {
+		    call sprintf (Memc[cmd], SZ_LINE, "Separation step = %g")
+		        call pargr (step)
+		    call gt_sets (gt, GTPARAMS, Memc[cmd])
+		} else
+		    call gt_sets (gt, GTPARAMS, "")
+		call sp_plot (gp, gt, Memi[sps], nspec, wscale, yscale)
+		redraw = NO
+	    }
+nospec_
+	if (nspec == 0)
+		call printf ("No spectra defined\007")
+
+	} until (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF)
+
+	
+	call clgstr ("logfile", Memc[cmd], SZ_LINE)
+	if (nowhite (Memc[cmd], Memc[cmd], SZ_LINE) > 0)
+	    iferr (call sp_vshow (Memc[cmd], NULL, Memi[sps], nspec, step))
+		call erract (EA_WARN)
+
+	# Close the graphics device and free memory.
+	call gclose (gp)
+	call gt_free (gt)
+
+	if (nspec > 0) {
+	    do i = 1, nspec
+		call sp_free (Memi[sps+i-1])
+	}
+	if (spsave != NULL)
+	    call sp_free (spsave)
+	call mfree (sps, TY_POINTER)
+	call sfree (stack)
+end
+
+
+# SP_SCALE -- Scale the spectra.  This uses the wavelength scale and intensity
+# scale parameters defined for each spectrum and adds the intensity offset. 
+
+procedure sp_scale (sps, nspec, step)
+
+pointer	sps[ARB]	# Spectrum structures
+int	nspec		# Number of spectra
+real	step		# Final step
+
+int	i, npts
+real	scale, offset
+pointer	sp, sh
+
+begin
+	do i = 1, nspec {
+	    sp = sps[i]
+	    sh = SP_SH(sp)
+	    npts = SP_NPTS(sp)
+
+	    scale = SP_XSCALE(sp)
+	    offset = SP_XOFFSET(sp)
+	    call altmr (Memr[SX(sh)], SP_X(sp), npts, scale, offset)
+
+	    scale = SP_SCALE(sp)
+	    offset = SP_OFFSET(sp) + (SP_INDEX(sp) - 1) * step
+	    call altmr (Memr[SY(sh)], SP_Y(sp), npts, scale, offset)
+
+	    SP_MEAN(sp) = SP_OMEAN(sp) * scale + offset
+	    SP_MIN(sp) = SP_OMIN(sp) * scale + offset
+	    SP_MAX(sp) = SP_OMAX(sp) * scale + offset
+	}
+end
+
+
+# SP_AUTOLAYOUT -- Apply an automatic layout algorithm in which the spectra
+# are scaled or offset to a common mean and a separation step is computed
+# to provide a specified degree of overlap between the nearest spectra.
+
+procedure sp_autolayout (sps, nspec, autoscale, fraction, step)
+
+pointer	sps[ARB]	# Spectrum structures
+int	nspec		# Number of spectra
+bool	autoscale	# Scale spectra to common mean?
+real	fraction	# Fraction to adjust step
+real	step		# Final step
+
+int	i
+real	a, b, scale, offset
+pointer	sp
+
+begin
+	if (nspec < 2)
+	    return
+
+	# Scale to the lowest indexed spectrum (usually 1).
+	sp = sps[1]
+	scale = SP_SCALE(sp)
+	offset = SP_OFFSET(sp)
+	a = SP_OMEAN(sp)
+
+	# If desired use a multiplicative scaling to a common mean.
+	# If the mean is <= 0 then use offset to common mean.
+
+	if (autoscale) {
+	    do i = 2, nspec {
+	        sp = sps[i]
+	        if (a * SP_OMEAN(sp) > 0.) {
+		    SP_SCALE(sp) = a / SP_OMEAN(sp) * scale
+		    SP_OFFSET(sp) = offset
+	        } else {
+		    SP_SCALE(sp) = scale
+		    SP_OFFSET(sp) = (a - SP_OMEAN(sp)) * scale + offset
+	        }
+	    }
+
+	# Otherwise use an offset scaling to a common mean.
+	} else {
+	    do i = 2, nspec {
+	        sp = sps[i]
+		SP_SCALE(sp) = scale
+		SP_OFFSET(sp) = (a - SP_OMEAN(sp)) * scale + offset
+	    }
+	}
+
+	# Compute the minimum step which just separates the maximum of
+	# one spectrum from the minimum of the next spectrum.  A degree
+	# of overlap can be set using the fraction parameter.
+
+	step = -MAX_REAL
+	do i = 2, nspec {
+	    sp = sps[i-1]
+	    a = SP_OMAX(sp) * SP_SCALE(sp) + SP_OFFSET(sp)
+	    sp = sps[i]
+	    b = SP_OMIN(sp) * SP_SCALE(sp) + SP_OFFSET(sp)
+	    step = max (step, a - b)
+	}
+	step = fraction * step
+end
+
+
+# SP_PLOT -- Determine the range of all the data and then make a plot with
+# specified labels.  The GTOOLS procedures are used to allow user adjustment.
+
+procedure sp_plot (gp, gt, sps, nspec, wscale, yscale)
+
+pointer	gp		# GIO pointer
+pointer	gt		# GTOOLS pointer
+pointer	sps[ARB]	# Spectrum structures
+int	nspec		# Number of spectra
+bool	wscale		# Draw in world coordinates?
+bool	yscale		# Draw Y scale?
+
+int	i, n
+real	x, y, xmin, xmax, ymin, ymax
+pointer	sp, pix
+
+begin
+	# Set the default limits from the data.
+	xmin = MAX_REAL
+	xmax = -MAX_REAL
+	ymin = MAX_REAL
+	ymax = -MAX_REAL
+	n = 0
+	do i = 1, nspec {
+	    sp = sps[i]
+	    if (wscale) {
+		xmin = min (xmin, SP_X(sp), Memr[SP_PX(sp)+SP_NPTS(sp)-1])
+		xmax = max (xmax, SP_X(sp), Memr[SP_PX(sp)+SP_NPTS(sp)-1])
+	    } else {
+		n = max (n, SP_NPTS(sp))
+		xmin = 1
+		xmax = n
+	    }
+	    ymin = min (ymin, SP_MIN(sp))
+	    ymax = max (ymax, SP_MAX(sp))
+	}
+
+	if (xmin > xmax) {
+	    xmin = 0.
+	    xmax = 1.
+	}
+	if (ymin > ymax) {
+	    ymin = 0.
+	    ymax = 1.
+	}
+
+	# Draw the axes with GTOOLS limits override.
+	#call gframe (gp)
+	call gclear (gp)
+	if (!yscale)
+	    call gseti (gp, G_YDRAWTICKS, NO)
+	call gswind (gp, xmin, xmax, ymin, ymax)
+	call gt_swind (gp, gt)
+	call gt_labax (gp, gt)
+
+	# The label positions are based on the limits of the graph.
+	call ggwind (gp, xmin, xmax, ymin, ymax)
+	xmax = xmax - xmin
+	ymax = ymax - ymin
+
+	if (!wscale) {
+	    call malloc (pix, n, TY_REAL)
+	    do i = 1, n
+		Memr[pix+i-1] = i
+	}
+
+	do i = 1, nspec {
+	    sp = sps[i]
+	    call sp_ptype (SP_PTYPE(sp), SP_COLOR(sp), NO, gp, gt)
+	    if (wscale)
+		call gt_plot (gp, gt, SP_X(sp), SP_Y(sp), SP_NPTS(sp))
+	    else
+		call gt_plot (gp, gt, Memr[pix], SP_Y(sp), SP_NPTS(sp))
+	    x = SP_XLPOS(sp) * xmax + xmin
+	    y = SP_YLPOS(sp) * ymax + SP_MEAN(sp)
+	    call gtext (gp, x, y, SP_LABEL(sp), "")
+	}
+
+	if (!wscale)
+	    call mfree (pix, TY_REAL)
+end
+
+
+# SP_PTYPE -- Decode the plotting type and set the GTOOLS structure.
+
+procedure sp_ptype (ptype, color, erase, gp, gt)
+
+char	ptype[ARB]		# Plotting type string
+int	color			# Color
+int	erase			# Erase plot?
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+
+int	i, j, ctoi()
+pointer	sp, gttype
+
+begin
+	call smark (sp)
+	call salloc (gttype, SZ_LINE, TY_CHAR)
+	call gt_gets (gt, GTTYPE, Memc[gttype], SZ_LINE)
+
+	i = 1
+	if (ctoi (ptype, i, j) > 0) {
+	    if (j < 0)
+		call gt_sets (gt, GTTYPE, "histogram")
+	    else
+		call gt_sets (gt, GTTYPE, "line")
+	    if (erase == YES)
+	        call gt_seti (gt, GTLINE, 0)
+	    else
+	        call gt_seti (gt, GTLINE, abs(j))
+	} else {
+	    call gt_sets (gt, GTTYPE, "mark")
+	    call gt_sets (gt, GTMARK, ptype)
+	    if (erase == YES)
+		call gseti (gp, G_PMLTYPE, 0)
+	    else
+		call gseti (gp, G_PMLTYPE, 1)
+	}
+	call gt_seti (gt, GTCOLOR, color)
+
+	call sfree (sp)
+end
+
+
+# List of colon commands.
+define	CMDS "|show|vshow|step|fraction|move|shift|w0|wpc|velocity|redshift\
+		|offset|scale|xlpos|ylpos|label|ulabel|ptype|units|color|"
+
+define	SHOW		1	# Show
+define	VSHOW		2	# Verbose show
+define	STEP		3	# Separation step
+define	FRACTION	4	# Fraction for autolayout
+define	MOVE		5	# Move spectrum index
+define	SHIFT		6	# Shift spectrum indices
+define	WZP		7	# Wavelength zero point
+define	WPC		8	# Wavelength per channel
+define	VELOCITY	9	# Radial velocity
+define	REDSHIFT	10	# Redshift
+define	OFFSET		11	# Intensity offset
+define	SCALE		12	# Intensity scale
+define	XLPOS		13	# X label position
+define	YLPOS		14	# Y label position
+define	LABEL		15	# Type of labels
+define	ULABEL		16	# User label
+define	PTYPE		17	# Plot type
+define	UNITS		18	# Plot units
+define	COLOR		19	# Color
+
+# SP_COLON -- Interpret colon commands.
+
+procedure sp_colon (cmdstr, gp, gt, sps, nspec, units, labels, current, step,
+	fraction, redraw)
+
+char	cmdstr[ARB]		# Colon command
+pointer	gp			# GIO pointer (used for paging screen)
+pointer	gt			# GTOOLS pointer
+pointer	sps[ARB]		# Array of spectra structures
+int	nspec			# Number of spectra
+char	units[SZ_LINE]		# Units string
+int	labels			# Label type
+int	current			# Current spectrum element (0 if not defined)
+real	step			# Separation step
+real	fraction		# Fraction for autolayout
+int	redraw			# Redraw graph
+
+int	i, j, index, ncmd
+real	rval
+pointer	stack, cmd, sp, sh, un1, un2
+
+int	nscan(), strdic(), ctoi(), stridxs()
+pointer	un_open()
+
+define	done_	10
+
+begin
+	call smark (stack)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Scan the command string and get the first word.
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+
+	# Parse the optional spectrum index.  Moving the the end of string.
+	# Set the spectrum element to 0 if a non-numeric index is specified.
+	# If an index number is given find the appropriate element and print
+	# an error if the spectrum index is not defined.
+	i = stridxs ("[", Memc[cmd])
+	j = 0
+	if (i > 0) {
+	    Memc[cmd+i-1] = EOS
+	    current = 0
+
+	    i = i + 1
+	    if (ctoi (Memc[cmd], i, index) > 0) {
+		for (i=1; (i<=nspec)&&(SP_INDEX(sps[i])!=index); i=i+1)
+		    ;
+
+		current = i
+		if (current > nspec) {
+		    call printf ("Spectrum %d not defined")
+			call pargi (index)
+		    call sfree (stack)
+		    return
+		}
+	    }
+	    j = current
+	}
+
+	# Parse the command.  Print the command if unknown.
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS)
+
+	switch (ncmd) {
+	case SHOW: # show spectrum parameters
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1)
+		call sp_show ("STDOUT", gp, sps, nspec, step)
+	    else
+		iferr (call sp_show (Memc[cmd], NULL, sps, nspec, step))
+		    call erract (EA_WARN)
+	case VSHOW: # show spectrum parameters
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1)
+		call sp_vshow ("STDOUT", gp, sps, nspec, step)
+	    else
+		iferr (call sp_vshow (Memc[cmd], NULL, sps, nspec, step))
+		    call erract (EA_WARN)
+	case STEP: # set or show step
+	    call gargr (rval)
+		if (nscan() == 1) {
+		    call printf ("step %g")
+		    call pargr (step)
+	    } else {
+		step = rval
+		call sp_scale (sps, nspec, step)
+		redraw = YES
+	    }
+	case FRACTION: # set or show autolayout fraction
+	    call gargr (rval)
+		if (nscan() == 1) {
+		    call printf ("fraction %g")
+		    call pargr (fraction)
+	    } else
+		fraction = rval
+	case MOVE: # Move spectrum by index
+	    call gargi (index)
+	    if (nscan() > 1) {
+	        if (current > 0) {
+		    sp = sps[current]
+		    if (index != SP_INDEX(sp)) {
+		        SP_INDEX(sp) = index
+
+		        for (i=current; i<nspec; i=i+1) {
+			    sps[i] = sps[i+1]
+			    SP_INDEX(sps[i]) = SP_INDEX(sps[i]) - 1
+			}
+		        for (i=1; (i<nspec)&&(index>SP_INDEX(sps[i])); i=i+1)
+			    ;
+			for (j=nspec; j>i; j=j-1)
+			    sps[j] = sps[j-1]
+		        sps[i] = sp
+			current = i
+
+			for (j=i; j<nspec; j=j+1) {
+			    sp = sps[j+1]
+			    if (SP_INDEX(sps[j]) == SP_INDEX(sp))
+				SP_INDEX(sp) = SP_INDEX(sp) + 1
+			}
+    
+		        if (labels == LABEL_INDEX)
+			    for (i=1; i<=nspec; i=i+1) {
+			        sp = sps[i]
+		                call sprintf (SP_LABEL(sp), SP_SZLABEL, "%-4d")
+				    call pargi (SP_INDEX(sp))
+			    }
+		        call sp_scale (sps, nspec, step)
+			redraw = YES
+		    }
+		} else
+		    call printf ("\007")
+	    }
+	case SHIFT: # Shift spectra by index
+	    call gargi (j)
+	    if (nscan() > 1) {
+	        if (current > 0) {
+		    if (j > 0) {
+		        for (i=current; i<=nspec; i=i+1) {
+			    sp = sps[i]
+			    SP_INDEX(sp) = SP_INDEX(sp) + j
+			    call sp_scale (sp, 1, step)
+			    call sp_labels (sp, 1, labels)
+			    redraw = YES
+			}
+		    } else if (j < 0) {
+		        for (i=current; i>0; i=i-1) {
+			    sp = sps[i]
+			    SP_INDEX(sp) = SP_INDEX(sp) + j
+			    call sp_scale (sp, 1, step)
+			    call sp_labels (sp, 1, labels)
+			    redraw = YES
+			}
+		    }
+		} else {
+		    for (i=1; i<=nspec; i=i+1) {
+			sp = sps[i]
+			SP_INDEX(sp) = SP_INDEX(sp) + j
+			call sp_scale (sp, 1, step)
+			call sp_labels (sp, 1, labels)
+			redraw = YES
+		    }
+		}
+	    }
+	case WZP: # set or show zero point wavelength
+	    call gargr (rval)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("w0[%d] %g")
+			call pargi (SP_INDEX(sp))
+			call pargr (SP_W0(sp)*SP_XSCALE(sp)+SP_XOFFSET(sp))
+		} else {
+		    SP_XOFFSET(sp) = rval - SP_W0(sp) * SP_XSCALE(sp)
+		    call sp_scale (sp, 1, step)
+		    redraw = YES
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("w0:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_W0(sp)*SP_XSCALE(sp)+SP_XOFFSET(sp))
+		    }
+		} else {
+		    do i = 1, nspec {
+			sp = sps[i]
+			SP_XOFFSET(sp) = rval - SP_W0(sp) * SP_XSCALE(sp)
+		        call sp_scale (sp, 1, step)
+		        redraw = YES
+		    }
+		}
+	    }
+	case WPC: # set or show wavelength per channel
+	    call gargr (rval)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("wpc[%d] %g")
+			call pargi (SP_INDEX(sp))
+			call pargr (SP_WPC(sp)*SP_XSCALE(sp))
+		} else {
+		    SP_WPC(sp) = rval
+		    call sp_linear (sp)
+		    call sp_scale (sp, 1, step)
+		    redraw = YES
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("wpc:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_WPC(sp)*SP_XSCALE(sp))
+		    }
+		} else {
+		    do i = 1, nspec {
+			sp = sps[i]
+			SP_WPC(sp) = rval
+			call sp_linear (sp)
+		        call sp_scale (sp, 1, step)
+		        redraw = YES
+		    }
+		}
+	    }
+	case VELOCITY: # set or show radial velocity
+	    if (nspec < 0)
+		goto done_
+	    call gargr (rval)
+	    un1 = UN(SP_SH(sps[1]))
+	    if (UN_CLASS(un1) == UN_VEL) {
+		if (current > 0) {
+		    sp = sps[current]
+		    if (nscan() == 1) {
+			call printf ("velocity[%d] %g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_XOFFSET(sp))
+		    } else {
+			SP_XOFFSET(sp) = rval
+			call sp_scale (sp, 1, step)
+			redraw = YES
+		    }
+		} else {
+		    if (nscan() == 1) {
+			call printf ("velocity:")
+			do i = 1, nspec {
+			    sp = sps[i]
+			    call printf (" %d=%g")
+				call pargi (SP_INDEX(sp))
+				call pargr (SP_XOFFSET(sp))
+			}
+		    } else {
+			do i = 1, nspec {
+			    sp = sps[i]
+			    SP_XOFFSET(sp) = rval
+			    call sp_scale (sp, 1, step)
+			    redraw = YES
+			}
+		    }
+		}
+	    } else if (UN_CLASS(un1) != UN_UNKNOWN) {
+		if (current > 0) {
+		    sp = sps[current]
+		    call sprintf (Memc[cmd], SZ_LINE, "km/s %g %s")
+			call pargr (SP_W0(sp))
+			call pargstr (UN_UNITS(un1))
+		    if (nscan() == 1) {
+			if (SP_XSCALE(sp) != 1.) {
+			    rval = SP_W0(sp) * SP_XSCALE(sp)
+			    call un_changer (un1, Memc[cmd], rval, 1, NO)
+			} else
+			    rval = 0.
+			call printf ("velocity[%d] %g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (rval)
+		    } else {
+			un2 = un_open (Memc[cmd])
+			call un_ctranr (un2, un1, rval, rval, 1)
+			call un_close (un2)
+			SP_XSCALE(sp) = rval / SP_W0(sp)
+			call sp_scale (sp, 1, step)
+			redraw = YES
+		    }
+		} else {
+		    if (nscan() == 1) {
+			call printf ("velocity:")
+			do i = 1, nspec {
+			    sp = sps[i]
+			    if (SP_XSCALE(sp) != 1.) {
+				call sprintf (Memc[cmd], SZ_LINE, "km/s %g %s")
+				    call pargr (SP_W0(sp))
+				    call pargstr (UN_UNITS(un1))
+				rval = SP_W0(sp) * SP_XSCALE(sp)
+				call un_changer (un1, Memc[cmd], rval, 1, NO)
+			    } else
+				rval = 0.
+			    call printf (" %d=%g")
+				call pargi (SP_INDEX(sp))
+				call pargr (rval)
+			}
+		    } else {
+			do i = 1, nspec {
+			    sp = sps[i]
+			    call sprintf (Memc[cmd], SZ_LINE, "km/s %g %s")
+				call pargr (SP_W0(sp))
+				call pargstr (UN_UNITS(un1))
+			    un2 = un_open (Memc[cmd])
+			    call un_ctranr (un2, un1, rval, rval, 1)
+			    call un_close (un1)
+			    SP_XSCALE(sp) = rval / SP_W0(sp)
+			    call sp_scale (sps[i], 1, step)
+			    redraw = YES
+			}
+		    }
+		}
+	    }
+	case REDSHIFT: # set or show redshift
+	    if (nspec < 0)
+		goto done_
+	    call gargr (rval)
+	    un1 = UN(SP_SH(sps[1]))
+	    if (UN_CLASS(un1) == UN_VEL) {
+		if (current > 0) {
+		    sp = sps[current]
+		    if (nscan() == 1) {
+			call printf ("redshift[%d] %g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_XOFFSET(sp)/UN_SCALE(un1))
+		    } else {
+			SP_XOFFSET(sp) = rval * UN_SCALE(un1)
+			call sp_scale (sp, 1, step)
+			redraw = YES
+		    }
+		} else {
+		    if (nscan() == 1) {
+			call printf ("redshift:")
+			do i = 1, nspec {
+			    sp = sps[i]
+			    call printf (" %d=%g")
+				call pargi (SP_INDEX(sp))
+				call pargr (SP_XOFFSET(sp)/UN_SCALE(un1))
+			}
+		    } else {
+			do i = 1, nspec {
+			    SP_XOFFSET(sp) = rval * UN_SCALE(un1)
+			    call sp_scale (sps[i], 1, step)
+			    redraw = YES
+			}
+		    }
+		}
+	    } else if (UN_CLASS(un1) == UN_WAVE) {
+		if (current > 0) {
+		    sp = sps[current]
+		    if (nscan() == 1) {
+			call printf ("redshift[%d] %g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_XSCALE(sp)-1)
+		    } else {
+			rval = 1. + rval
+			SP_XSCALE(sp) = rval
+			call sp_scale (sp, 1, step)
+			redraw = YES
+		    }
+		} else {
+		    if (nscan() == 1) {
+			call printf ("redshift:")
+			do i = 1, nspec {
+			    sp = sps[i]
+			    call printf (" %d=%g")
+				call pargi (SP_INDEX(sp))
+				call pargr (SP_XSCALE(sp)-1)
+			}
+		    } else {
+			rval = 1. + rval
+			do i = 1, nspec {
+			    SP_XSCALE(sps[i]) = rval
+			    call sp_scale (sps[i], 1, step)
+			    redraw = YES
+			}
+		    }
+		}
+	    } else if (UN_CLASS(un1) == UN_FREQ || UN_CLASS(un1) == UN_ENERGY) {
+		if (current > 0) {
+		    sp = sps[current]
+		    if (nscan() == 1) {
+			call printf ("redshift[%d] %g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (1./SP_XSCALE(sp)-1)
+		    } else {
+			rval = 1. / (1. + rval)
+			SP_XSCALE(sp) = rval
+			call sp_scale (sp, 1, step)
+			redraw = YES
+		    }
+		} else {
+		    if (nscan() == 1) {
+			call printf ("redshift:")
+			do i = 1, nspec {
+			    sp = sps[i]
+			    call printf (" %d=%g")
+				call pargi (SP_INDEX(sp))
+				call pargr (1./SP_XSCALE(sp)-1)
+			}
+		    } else {
+			rval = 1./ (1. + rval)
+			do i = 1, nspec {
+			    SP_XSCALE(sps[i]) = rval
+			    call sp_scale (sps[i], 1, step)
+			    redraw = YES
+			}
+		    }
+		}
+	    }
+	case OFFSET: # set or show intensity offset
+	    call gargr (rval)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("offset[%d] %g")
+			call pargi (SP_INDEX(sp))
+			call pargr (SP_OFFSET(sp))
+		} else {
+		    SP_OFFSET(sp) = rval
+		    call sp_scale (sp, 1, step)
+		    redraw = YES
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("offset:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_OFFSET(sp))
+		    }
+		} else {
+		    do i = 1, nspec {
+			SP_OFFSET(sps[i]) = rval
+		        call sp_scale (sps[i], 1, step)
+		        redraw = YES
+		    }
+		}
+	    }
+	case SCALE: # set or show intensity scale
+	    call gargr (rval)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("scale[%d] %g")
+			call pargi (SP_INDEX(sp))
+			call pargr (SP_SCALE(sp))
+		} else {
+		    SP_SCALE(sp) = rval
+		    call sp_scale (sp, 1, step)
+		    redraw = YES
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("scale:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_SCALE(sp))
+		    }
+		} else {
+		    do i = 1, nspec {
+			SP_SCALE(sps[i]) = rval
+		        call sp_scale (sps[i], 1, step)
+		        redraw = YES
+		    }
+		}
+	    }
+	case XLPOS: # set or show X label position
+	    call gargr (rval)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("xlpos[%d] %g")
+			call pargi (SP_INDEX(sp))
+			call pargr (SP_XLPOS(sp))
+		} else {
+		    SP_XLPOS(sp) = rval
+		    redraw = YES
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("xlpos:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_XLPOS(sp))
+		    }
+		} else {
+		    do i = 1, nspec {
+			SP_XLPOS(sps[i]) = rval
+		        redraw = YES
+		    }
+		}
+	    }
+	case YLPOS: # set or show Y label position
+	    call gargr (rval)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("ylpos[%d] %g")
+			call pargi (SP_INDEX(sp))
+			call pargr (SP_YLPOS(sp))
+		} else {
+		    SP_YLPOS(sp) = rval
+		    redraw = YES
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("ylpos:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%g")
+			    call pargi (SP_INDEX(sp))
+			    call pargr (SP_YLPOS(sp))
+		    }
+		} else {
+		    do i = 1, nspec {
+			SP_YLPOS(sps[i]) = rval
+		        redraw = YES
+		    }
+		}
+	    }
+	case LABEL: # Set or show label type
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		switch (labels) {
+		case LABEL_NONE:
+		    call printf ("labels none")
+		case LABEL_IMNAME:
+		    call printf ("labels imname")
+		case LABEL_IMTITLE:
+		    call printf ("labels imtitle")
+		case LABEL_INDEX:
+		    call printf ("labels index")
+		case LABEL_USER:
+		    call printf ("labels user")
+		}
+	    } else {
+		ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, LABELS)
+		if (ncmd == 0) {
+		    call printf ("Unknown label type: %s")
+			call pargstr (Memc[cmd])
+		} else {
+		    labels = ncmd
+		    call sp_labels (sps, nspec, labels)
+		}
+	    }
+	case ULABEL: # Set or show user labels
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("ulabel[%d] %s")
+			call pargi (SP_INDEX(sp))
+			call pargstr (SP_ULABEL(sp))
+		} else {
+		    call reset_scan ()
+		    call gargwrd (Memc[cmd], SZ_LINE)
+		    call gargstr (Memc[cmd], SZ_LINE)
+		    call strcpy (Memc[cmd], SP_ULABEL(sp), SP_SZULABEL)
+		    if (labels == LABEL_USER)
+		        call strcpy (SP_ULABEL(sp), SP_LABEL(sp), SP_SZLABEL)
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("ulabel:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%s")
+			    call pargi (SP_INDEX(sp))
+			    call pargstr (SP_ULABEL(sp))
+		    }
+		} else {
+		    call reset_scan ()
+		    call gargwrd (Memc[cmd], SZ_LINE)
+		    call gargstr (Memc[cmd], SZ_LINE)
+		    do i = 1, nspec {
+			sp = sps[i]
+			call strcpy (Memc[cmd], SP_ULABEL(sp), SP_SZULABEL)
+		        if (labels == LABEL_USER)
+		            call strcpy (SP_ULABEL(sp), SP_LABEL(sp),SP_SZLABEL)
+		    }
+		}
+	    }
+	case PTYPE: # Set or show plotting type
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("ptype[%d] %s")
+			call pargi (SP_INDEX(sp))
+			call pargstr (SP_PTYPE(sp))
+		} else {
+		    call strcpy (Memc[cmd], SP_PTYPE(sp), SP_SZPTYPE)
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("ptype:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%s")
+			    call pargi (SP_INDEX(sp))
+			    call pargstr (SP_PTYPE(sp))
+		    }
+		} else {
+		    do i = 1, nspec
+			call strcpy (Memc[cmd], SP_PTYPE(sps[i]),
+			    SP_SZPTYPE)
+		}
+	    }
+	case UNITS: # Change plotting units
+	    # Any change of units resets the offset and scale parametes.
+	    call gargstr (Memc[cmd], SZ_LINE)
+	    iferr {
+		do i = 1, nspec {
+		    if (j > 0 && i != j)
+			next
+		    sp = sps[i]
+		    sh = SP_SH(sp) 
+		    call un_changer (UN(sh), Memc[cmd], Memr[SX(sh)],
+			SN(sh), YES)
+		    SP_W0(sp) = Memr[SX(sh)]
+		    SP_WPC(sp) = (Memr[SX(sh)+SN(sh)-1] - Memr[SX(sh)]) /
+			(SN(sh) - 1)
+		    SP_XSCALE(sp) = 1.
+		    SP_XOFFSET(sp) = 0.
+		    call sp_scale (sp, 1, step)
+		    if (i == 1) {
+			call strcpy (Memc[cmd], units, SZ_FNAME)
+			call gt_sets (gt, GTXLABEL, UN_LABEL(UN(sh)))
+			call gt_sets (gt, GTXUNITS, UN_UNITS(UN(sh)))
+		    }
+		    redraw = YES
+		}
+	    } then
+		call erract (EA_WARN)
+	case COLOR: # Set or show color
+	    call gargi (j)
+	    if (current > 0) {
+		sp = sps[current]
+	        if (nscan() == 1) {
+		    call printf ("color[%d] %d")
+			call pargi (SP_INDEX(sp))
+			call pargi (SP_COLOR(sp))
+		} else {
+		    SP_COLOR(sp) = j
+		}
+	    } else {
+		if (nscan() == 1) {
+		    call printf ("color:")
+		    do i = 1, nspec {
+			sp = sps[i]
+			call printf (" %d=%d")
+			    call pargi (SP_INDEX(sp))
+			    call pargi (SP_COLOR(sp))
+		    }
+		} else {
+		    do i = 1, nspec
+			SP_COLOR(sps[i]) = j
+		}
+	    }
+	default: # Print unknown command
+	    call printf ("Unknown command: %s\007")
+		call pargstr (cmdstr)
+	}
+
+done_	call sfree (stack)
+end
+
+
+# SP_GDATA -- Get spectrum and add it to the array of spectrum structures.
+# Return an error if the image is not found.  If a two or three dimensional
+# image enter each line.  The spectrum data kept in memory and the image is
+# closed.
+
+procedure sp_gdata (image, units, current, sps, nspec)
+
+char	image[ARB]		# Image name
+char	units[ARB]		# Coordinate units
+int	current			# Element to append
+pointer	sps			# Pointer to array of spectra structures
+int	nspec			# Number of spectra
+
+real	scale			# Default intensity scale
+real	offset			# Default intensity offset
+real	xlpos, ylpos		# Default position of labels
+char	ptype[SP_SZPTYPE]	# Default plot type
+
+int	i, j, k, l, m, trans
+pointer	sp, im, mw, sh, stack, aps, bands, str, ptr
+
+int	ctor(), open(), fscan(), nowhite(), clgwrd()
+bool	rng_elementi(), fp_equalr()
+real	clgetr(), asumr(), imgetr(), sp_logerr()
+pointer	immap(), smw_openim(), rng_open()
+
+errchk	immap, smw_openim, open
+
+extern	sp_logerr
+
+begin
+	call smark (stack)
+	call salloc (str, SZ_LINE, TY_CHAR)
+ 
+	# Map the image and return an error if this fails.
+	im = immap (image, READ_ONLY, 0)
+	mw = smw_openim (im)
+
+	# Get parameters.
+	if (nspec == 0) {
+	    #scale = clgetr ("scale")
+	    #offset = clgetr ("offset")
+	    xlpos = clgetr ("xlpos")
+	    ylpos = clgetr ("ylpos")
+	    call clgstr ("ptype", ptype, SP_SZPTYPE)
+	    trans = clgwrd ("transform", Memc[str], SZ_LINE, TRANSFORMS)    
+	}
+
+	call clgstr ("scale", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_LINE) == 0)
+	    call error (1, "Error in scale parameter")
+	if (Memc[str] == '@') {
+	    j = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+	    do i = 1, nspec+1
+		if (fscan(j) == EOF)
+		    call error (1, "Error reading scale file")
+	    call gargr (scale)
+	    call close (j)
+	} else if (IS_ALPHA(Memc[str])) {
+	    scale = imgetr (im, Memc[str])
+	} else {
+	    i = 1
+	    if (ctor (Memc[str], i, scale) == 0)
+		call error (1, "Error in scale parameter")
+	}
+
+	call clgstr ("offset", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_LINE) == 0)
+	    call error (1, "Error in offset parameter")
+	if (Memc[str] == '@') {
+	    j = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+	    do i = 1, nspec+1
+		if (fscan(j) == EOF)
+		    call error (1, "Error reading offset file")
+	    call gargr (offset)
+	    call close (j)
+	} else if (IS_ALPHA(Memc[str]))
+	    offset = imgetr (im, Memc[str])
+	else {
+	    i = 1
+	    if (ctor (Memc[str], i, offset) == 0)
+		call error (1, "Error in offset parameter")
+	}
+
+	call clgstr ("apertures", Memc[str], SZ_LINE)
+	iferr (aps = rng_open (Memc[str], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture/record list")
+	call clgstr ("bands", Memc[str], SZ_LINE)
+	iferr (bands = rng_open (Memc[str], INDEF, INDEF, INDEF))
+	    call error (0, "Bad band list")
+
+	# For each line in the image, allocate memory for the spectrum
+	# structure, get the pixel data, compute the mean and limits,
+	# set the structure parameters, and add the structure to the
+	# array of structures.
+
+	do j = 1, SMW_NBANDS(mw) {
+	    if (SMW_FORMAT(mw) != SMW_ND)
+		if (!rng_elementi (bands, j))
+		    next
+	    do i = 1, SMW_NSPEC(mw) {
+		if (SMW_FORMAT(mw) == SMW_ND) {
+		    call smw_mw (mw, i, j, ptr, k, l)
+		    if (!rng_elementi (aps, k) || !rng_elementi (bands, l))
+			next
+		} else {
+		    call shdr_open (im, mw, i, j, INDEFI, SHHDR, sh)
+		    if (!rng_elementi (aps, AP(sh)))
+			next
+		}
+		call shdr_open (im, mw, i, j, INDEFI, SHDATA, sh)
+		iferr (call shdr_units (sh, units))
+		    ;
+
+	        call sp_alloc (sp, sh)
+	        SP_NPTS(sp) = SN(sh)
+		SP_W0(sp) = Memr[SX(sh)]
+		SP_WPC(sp) = (Memr[SX(sh)+SN(sh)-1] - Memr[SX(sh)]) /
+		    (SN(sh) - 1)
+		switch (trans) {
+		case TRANS_LOG:
+		    SP_OMIN(sp) = MAX_REAL; SP_OMAX(sp) = -MAX_REAL
+		    ptr = SY(sh);
+		    do m = 1, SP_NPTS(sp) {
+		        if (Memr[ptr] > 0.) {
+			    SP_OMIN(sp) = min (SP_OMIN(sp), Memr[ptr])
+			    SP_OMAX(sp) = max (SP_OMAX(sp), Memr[ptr])
+			}
+			ptr = ptr + 1
+		    }
+		    if (SP_OMAX(sp) > 0.) {
+		        call amaxkr (Memr[SY(sh)], SP_OMIN(sp), Memr[SY(sh)],
+			    SN(sh))
+			call alogr (Memr[SY(sh)], Memr[SY(sh)], SN(sh),
+			    sp_logerr)
+			call amovr (Memr[SY(sh)], Memr[SY(SP_SH(sp))], SN(sh))
+		    }
+		}
+	        SP_OMEAN(sp) = asumr (Memr[SY(sh)], SN(sh)) / SN(sh)
+	        call alimr (Memr[SY(sh)], SN(sh), SP_OMIN(sp), SP_OMAX(sp))
+
+		SP_XSCALE(sp) = 1.
+		SP_XOFFSET(sp) = 0.
+	        SP_SCALE(sp) = scale
+	        SP_OFFSET(sp) = offset
+	        SP_XLPOS(sp) = xlpos
+	        SP_YLPOS(sp) = ylpos
+		SP_COLOR(sp) = 1
+
+		call sprintf (SP_IMNAME(sp), SP_SZNAME, "%s%s(%d)")
+		    call pargstr (IMNAME(sh))
+		    call pargstr (IMSEC(sh))
+		    call pargi (AP(sh))
+		call strcpy (TITLE(sh), SP_IMTITLE(sp), SP_SZTITLE)
+	        call strcpy (ptype, SP_PTYPE(sp), SP_SZPTYPE)
+	        SP_ULABEL(sp) = EOS
+
+	        call sp_add (sp, current, sps, nspec)
+	    }
+	}
+
+	# Close the image.
+	call shdr_close (sh)
+	call rng_close (bands)
+	call rng_close (aps)
+	call smw_close (mw)
+	call imunmap (im)
+ 
+	call sfree (stack)
+end
+
+
+# SP_LINEAR -- Reset linear coordinates
+
+procedure sp_linear (sp)
+
+pointer	sp			# SPECPLOT pointer
+
+int	i
+pointer	x
+
+begin
+	x = SX(SP_SH(sp))
+	do i = 0, SP_NPTS(sp)-1
+	    Memr[x+i] = SP_W0(sp) + i * SP_WPC(sp)
+	SP_XSCALE(sp) = 1.
+	SP_XOFFSET(sp) = 0.
+end
+
+
+# SP_DELETE -- Delete a spectrum from memory.  The index numbers are
+# decreased to fill the hole.
+
+procedure sp_delete (current, sps, nspec)
+
+int	current			# Element to be deleted
+pointer	sps			# Pointer to array of spectrum structures
+int	nspec			# Number of spectra
+
+int	i
+
+begin
+	if (nspec == 0)
+	    return
+
+	for (i = current; i < nspec; i = i + 1) {
+	    Memi[sps+i-1] = Memi[sps+i]
+	    SP_INDEX(Memi[sps+i-1]) = SP_INDEX(Memi[sps+i-1]) - 1
+	}
+	nspec = nspec - 1
+end
+
+
+# SP_ADD --  Add a spectrum structure to the array of structures
+# following the specified element.  The spectrum index is defined to be
+# one higher than the spectrum to be followed and all higher indexed
+# spectra are increased by 1.  Special cases are when there are no
+# spectra in which case the index is set to 1 and when the current
+# element to be followed is zero.  The current element is set to the
+# added spectrum.  The array of pointers is expanded in blocks of 100.
+
+procedure sp_add (sp, current, sps, nspec)
+
+pointer	sp			# Spectrum structure to be appended
+int	current			# Element followed (in), added element (out)
+pointer	sps			# Pointer to array of spectrum structures
+int	nspec			# Number of spectra
+
+int	i
+
+begin
+	# Reallocate memory for the array of structure pointers in steps of 100.
+	if (mod (nspec, 100) == 0)
+	    call realloc (sps, nspec + 100, TY_POINTER)
+
+	# Shift higher spectra in the array and increase the index numbers by 1
+	# and then add the new spectrum pointer. 
+	for (i = nspec; i > current; i = i - 1) {
+	    Memi[sps+i] = Memi[sps+i-1]
+	    SP_INDEX(Memi[sps+i]) = SP_INDEX(Memi[sps+i]) + 1
+	}
+	Memi[sps+current] = sp
+
+	# Set the new spectrum index.
+	if (nspec == 0)
+	    SP_INDEX(sp) = 1
+	else if (current == 0)
+	    SP_INDEX(sp) = SP_INDEX(Memi[sps+current+1]) - 1
+	else
+	    SP_INDEX(sp) = SP_INDEX(Memi[sps+current-1]) + 1
+
+	# Adjust the current element and number of spectra.
+	current = current + 1
+	nspec = nspec + 1
+end
+
+
+# SP_LABELS -- Set the spectrum labels to the specified type.
+
+procedure sp_labels (sps, nspec, labels)
+
+pointer	sps[ARB]	# Spectrum pointers
+int	nspec		# Number of spectra
+int	labels		# Type of labels
+
+int	i
+
+begin
+	for (i = 1; i <= nspec; i = i + 1) {
+	    switch (labels) {
+	    case LABEL_NONE:
+		SP_LABEL(sps[i]) = EOS
+	    case LABEL_IMNAME:
+		call strcpy (SP_IMNAME(sps[i]), SP_LABEL(sps[i]), SP_SZLABEL)
+	    case LABEL_IMTITLE:
+		call strcpy (SP_IMTITLE(sps[i]), SP_LABEL(sps[i]), SP_SZLABEL)
+	    case LABEL_INDEX:
+		call sprintf (SP_LABEL(sps[i]), SP_SZLABEL, "%-4d")
+		    call pargi (SP_INDEX(sps[i]))
+	    case LABEL_USER:
+		call strcpy (SP_ULABEL(sps[i]), SP_LABEL(sps[i]), SP_SZULABEL)
+	    }
+	}
+end
+
+
+# SP_ALLOC -- Allocate memory for a spectrum structure with given number of
+# data points.  The MWCS is not used.
+
+procedure sp_alloc (sp, sh)
+
+pointer	sp		# Spectrum structure pointer to be allocated
+pointer	sh		# Spectrum header pointer
+
+begin
+	call calloc (sp, SP_LEN, TY_STRUCT)
+	call calloc (SP_PX(sp), SN(sh), TY_REAL)
+	call calloc (SP_PY(sp), SN(sh), TY_REAL)
+
+	call shdr_copy (sh, SP_SH(sp), NO)
+	MW(SP_SH(sp)) = NULL
+end
+
+
+# SP_FREE -- Free a spectrum structure.
+
+procedure sp_free (sp)
+
+pointer	sp, sh		# Spectrum structure pointers
+
+begin
+	sh = SP_SH(sp)
+	call shdr_close (sh)
+
+	call mfree (SP_PX(sp), TY_REAL)
+	call mfree (SP_PY(sp), TY_REAL)
+	call mfree (sp, TY_STRUCT)
+end
+
+
+# SP_NEAREST -- Find the nearest spectrum to the cursor and return the element.
+# Return zero if no spectra are defined.  The distance is in NDC.
+
+int procedure sp_nearest (gp, wx1, wy1, key, cmd, sps, nspec)
+
+pointer	gp			# GIO pointer
+real	wx1, wy1		# Cursor position
+int	key			# Key
+char	cmd[ARB]		# Cursor command
+pointer	sps[ARB]		# Array of structure pointers
+int	nspec			# Number of spectra
+
+int	i, j, k, stridxs()
+real	wx0, wy0, x0, y0, x1, y1, r2, r2min
+pointer	sp, px, py
+
+begin
+	# Check for explicit specification.
+	if (key == ':') {
+	    if (stridxs ("[", cmd) > 0)
+		return (1)
+	}
+
+	if (IS_INDEFR(wx1))
+	    wx1 = 0.
+	if (IS_INDEFR(wy1))
+	    wy1 = 0.
+
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx1, wy1, wx0, wy0, 1, 0)
+
+	# Search for nearest point.
+	k = 0
+	r2min = MAX_REAL
+	do i = 1, nspec {
+	    sp = sps[i]
+	    px = SP_PX(sp) - 1
+	    py = SP_PY(sp) - 1
+	    do j = 1, SP_NPTS(sp) {
+		x1 = Memr[px + j]
+		y1 = Memr[py + j]
+	        call gctran (gp, x1, y1, x0, y0, 1, 0)
+	        r2 = (x0 - wx0) ** 2 + (y0 - wy0) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    k = i
+		}
+	    }
+	}
+
+	return (k)
+end
+
+
+# SP_SHOW -- Show parameter information.  Clear the screen if the output is
+# to the graphics device otherwise append to the specified file.
+
+procedure sp_show (file, gp, sps, nspec, step)
+
+char	file[ARB]		# Optional file
+pointer	gp			# Graphics pointer
+pointer	sps[ARB]		# Spectra data
+int	nspec			# Number of spectra
+real	step			# Separation step
+
+int	i, fd
+pointer	stack, line, sp
+
+int	open()
+errchk	open()
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	if (gp != NULL)
+	    call gdeactivate (gp, AW_CLEAR)
+
+	call smark (stack)
+	call salloc (line, SZ_LINE, TY_CHAR)
+	call sysid (Memc[line], SZ_LINE)
+	call fprintf (fd, "%s\n\n")
+	call pargstr (Memc[line])
+
+	call fprintf (fd, "Step = %g\n\n")
+	    call pargr (step)
+	call fprintf (fd, "   %16s %7s %7s %7s %7s   %s\n")
+	    call pargstr ("Image Name")
+	    call pargstr ("W0")
+	    call pargstr ("WPC")
+	    call pargstr ("Offset")
+	    call pargstr ("Scale")
+	    call pargstr ("Title")
+
+	do i = 1, nspec {
+	    sp = sps[i]
+	    call fprintf (fd, "%2d %16s %7g %7g %7g %7g   %s\n")
+		call pargi (SP_INDEX(sp))
+		call pargstr (SP_IMNAME(sp))
+		call pargr (SP_W0(sp)*SP_XSCALE(sp)+SP_XOFFSET(sp))
+		call pargr (SP_WPC(sp)*SP_XSCALE(sp))
+		call pargr (SP_OFFSET(sp))
+		call pargr (SP_SCALE(sp))
+		call pargstr (SP_IMTITLE(sp))
+	}
+
+	call sfree (stack)
+
+	call close (fd)
+	if (gp != NULL)
+	    call greactivate (gp, AW_PAUSE)
+end
+
+
+# SP_VSHOW -- Show verbose parameter information.  Clear the screen if the
+# output is to the graphics device otherwise append to the specified file.
+
+procedure sp_vshow (file, gp, sps, nspec, step)
+
+char	file[ARB]		# Optional file
+pointer	gp			# Graphics pointer
+pointer	sps[ARB]		# Spectra data
+int	nspec			# Numbeer of spectra
+real	step			# Separation step
+
+int	i, fd
+real	z, v
+pointer	stack, line, sp, un
+
+int	open()
+errchk	open()
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	if (gp != NULL)
+	    call gdeactivate (gp, AW_CLEAR)
+
+	call smark (stack)
+	call salloc (line, SZ_LINE, TY_CHAR)
+	call sysid (Memc[line], SZ_LINE)
+	call fprintf (fd, "%s\n\n")
+	call pargstr (Memc[line])
+
+	call fprintf (fd, "Step = %g\n")
+	    call pargr (step)
+	call fprintf (fd, "\n   %16s %7s %7s %7s %7s   %s\n")
+	    call pargstr ("Image Name")
+	    call pargstr ("W0")
+	    call pargstr ("WPC")
+	    call pargstr ("Offset")
+	    call pargstr ("Scale")
+	    call pargstr ("Title")
+
+	do i = 1, nspec {
+	    sp = sps[i]
+	    call fprintf (fd, "%2d %16s %7g %7g %7g %7g   %s\n")
+		call pargi (SP_INDEX(sp))
+		call pargstr (SP_IMNAME(sp))
+		call pargr (SP_W0(sp)*SP_XSCALE(sp)+SP_XOFFSET(sp))
+		call pargr (SP_WPC(sp)*SP_XSCALE(sp))
+		call pargr (SP_OFFSET(sp))
+		call pargr (SP_SCALE(sp))
+		call pargstr (SP_IMTITLE(sp))
+	}
+
+	call fprintf (fd, "\n   %16s %9s %9s %9s %9s\n")
+	    call pargstr ("Image Name")
+	    call pargstr ("Mean")
+	    call pargstr ("DW0")
+	    call pargstr ("Z")
+	    call pargstr ("V(km/s)")
+
+	un = UN(SP_SH(sps[1]))
+	if (UN_CLASS(un) == UN_VEL) {
+	    do i = 1, nspec {
+		sp = sps[i]
+		z = SP_XOFFSET(sp) / UN_SCALE(un)
+		v = SP_XOFFSET(sp)
+		call fprintf (fd, "%2d %16s %9g %9g %9g %9g\n")
+		    call pargi (SP_INDEX(sp))
+		    call pargstr (SP_IMNAME(sp))
+		    call pargr (SP_OMEAN(sp))
+		    call pargr (SP_XOFFSET(sp))
+		    call pargr (z)
+		    call pargr (v)
+	    }
+	} else if (UN_CLASS(un) == UN_WAVE) {
+	    do i = 1, nspec {
+		sp = sps[i]
+		if (SP_XSCALE(sp) != 1.) {
+		    call sprintf (Memc[line], SZ_LINE, "km/s %g %s")
+			call pargr (SP_W0(sp))
+			call pargstr (UN_UNITS(un))
+		    z = SP_XSCALE(sp) - 1
+		    v = SP_W0(sp) * SP_XSCALE(sp)
+		    call un_changer (un, Memc[line], v, 1, NO)
+		} else {
+		    z = 0.
+		    v = 0.
+		}
+		call fprintf (fd, "%2d %16s %9g %9g %9g %9g\n")
+		    call pargi (SP_INDEX(sp))
+		    call pargstr (SP_IMNAME(sp))
+		    call pargr (SP_OMEAN(sp))
+		    call pargr (SP_XOFFSET(sp))
+		    call pargr (z)
+		    call pargr (v)
+	    }
+	} else if (UN_CLASS(un) == UN_FREQ || UN_CLASS(un) == UN_ENERGY) {
+	    do i = 1, nspec {
+		sp = sps[i]
+		if (SP_XSCALE(sp) != 1.) {
+		    call sprintf (Memc[line], SZ_LINE, "km/s %g %s")
+			call pargr (SP_W0(sp))
+			call pargstr (UN_UNITS(un))
+		    z = 1. / SP_XSCALE(sp) - 1
+		    v = SP_W0(sp) * SP_XSCALE(sp)
+		    call un_changer (un, Memc[line], v, 1, NO)
+		} else {
+		    z = 0.
+		    v = 0.
+		}
+		call fprintf (fd, "%2d %16s %9g %9g %9g %9g\n")
+		    call pargi (SP_INDEX(sp))
+		    call pargstr (SP_IMNAME(sp))
+		    call pargr (SP_OMEAN(sp))
+		    call pargr (SP_XOFFSET(sp))
+		    call pargr (z)
+		    call pargr (v)
+	    }
+	}
+
+	call sfree (stack)
+
+	call close (fd)
+	if (gp != NULL)
+	    call greactivate (gp, AW_PAUSE)
+end
+
+
+# SP_LOGERR -- Value for non-positive values in log function.
+
+real procedure sp_logerr (x)
+
+real	x
+
+begin
+	return (0.)
+end
diff --git a/noao/onedspec/t_specshift.x b/noao/onedspec/t_specshift.x
new file mode 100644
index 00000000..e5b8ea0e
--- /dev/null
+++ b/noao/onedspec/t_specshift.x
@@ -0,0 +1,222 @@
+include	<error.h>
+include	<smw.h>
+
+# Function types.
+define  CHEBYSHEV       1       # CURFIT Chebyshev polynomial
+define  LEGENDRE        2       # CURFIT Legendre polynomial
+define  SPLINE3         3       # CURFIT cubic spline
+define  SPLINE1         4       # CURFIT linear spline
+define  PIXEL           5       # pixel coordinate array
+define  SAMPLE          6       # sampled coordinates
+
+
+# T_SSHIFT -- Shift the spectral coordinates
+ 
+procedure t_sshift ()
+ 
+int	list			# Input list of spectra
+double	shift			# Shift to apply
+pointer	aps			# Aperture list
+bool	verbose			# Verbose?
+ 
+int	ap, beam, dtype, nw
+double	w1, dw, z
+real	aplow[2], aphigh[2]
+pointer	sp, image, coeff, tmp, im, mw
+
+bool	clgetb()
+double	clgetd()
+int	imtopenp(), imtgetim()
+pointer	rng_open(), immap(), smw_openim()
+errchk	immap, smw_openim, smw_gwattrs, smw_swattrs, sshift
+ 
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	coeff = NULL
+
+	list = imtopenp ("spectra")
+	shift = clgetd ("shift")
+	call clgstr ("apertures", Memc[image], SZ_FNAME)
+	verbose = clgetb ("verbose")
+
+	iferr (aps = rng_open (Memc[image], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture list")
+
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+	    im = NULL
+	    mw = NULL
+	    iferr {
+	        tmp = immap (Memc[image], READ_WRITE, 0); im = tmp
+		tmp = smw_openim (im); mw = tmp
+
+		switch (SMW_FORMAT(mw)) {
+		case SMW_ND:
+		    call smw_gwattrs (mw, 1, 1, ap, beam, dtype,
+			w1, dw, nw, z, aplow, aphigh, coeff)
+		    w1 = w1 + shift
+		    call smw_swattrs (mw, 1, 1, ap, beam, dtype,
+			w1, dw, nw, z, aplow, aphigh, Memc[coeff])
+		    if (verbose) {
+			call printf ("%s: shift = %g, %g --> %g\n")
+			    call pargstr (Memc[image])
+			    call pargd (shift)
+			    call pargd (w1 - shift)
+			    call pargd (w1)
+		    }
+		case SMW_ES, SMW_MS:
+		    call sshift (im, mw, Memc[image], aps, shift,
+			verbose)
+		}
+	    } then
+		call erract (EA_WARN)
+
+	    if (mw != NULL) {
+		call smw_saveim (mw, im)
+		call smw_close (mw)
+	    }
+	    if (im != NULL)
+		call imunmap (im)
+	}
+
+	call rng_close (aps)
+	call imtclose (list)
+	call mfree (coeff, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# SSHIFT -- Shift coordinate zero point of selected aperture in
+# MULTISPEC and EQUISPEC images.
+
+procedure sshift (im, mw, image, aps, shift, verbose)
+
+pointer	im			# IMIO pointer
+pointer	mw			# MWCS pointer
+char	image[ARB]		# Image name
+pointer	aps			# Aperture range list
+double	shift			# Shift to add
+bool	verbose			# Verbose?
+
+int	i, ap, beam, dtype, nw, naps
+double	w1, dw, z
+real	aplow[2], aphigh[2]
+pointer	coeff, coeffs
+bool	rng_elementi()
+errchk	sshift1
+
+begin
+	coeff = NULL
+	coeffs = NULL
+ 
+	# Go through each spectrum and change the selected apertures.
+	naps = 0
+	do i = 1, SMW_NSPEC(mw) {
+	    # Get aperture info
+	    iferr (call smw_gwattrs (mw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, coeff))
+		break
+
+	    # Check if aperture is to be changed
+	    if (!rng_elementi (aps, ap))
+		next
+
+	    # Apply shift
+	    w1 = w1 + shift
+	    if (dtype == 2)
+		call sshift1 (shift, coeff)
+
+	    call smw_swattrs (mw, i, 1, ap, beam, dtype, w1, dw, nw, z,
+		aplow, aphigh, Memc[coeff])
+
+	    # Make record
+	    if (verbose) {
+		if (naps == 1) {
+		    call printf ("%s: shift = %g\n")
+			call pargstr (image)
+			call pargd (shift)
+		}
+		call printf ("  Aperture %d:  %g --> %g\n")
+		    call pargi (ap)
+		    call pargd (w1 - shift)
+		    call pargd (w1)
+	    }
+	}
+
+	call mfree (coeff, TY_CHAR)
+	call mfree (coeffs, TY_DOUBLE)
+end
+
+
+# SSHIFT1 -- Shift coordinate zero point of nonlinear functions.
+
+procedure sshift1 (shift, coeff)
+
+double	shift			# Shift to add
+pointer	coeff			# Attribute function coefficients
+
+int	i, j, ip, nalloc, ncoeff, type, order, fd
+double	dval
+pointer	coeffs
+int	ctod(), stropen()
+errchk	stropen
+
+begin
+	if (coeff == NULL)
+	    return
+	if (Memc[coeff] == EOS)
+	    return
+
+	coeffs = NULL
+	ncoeff = 0
+	ip = 1
+	while (ctod (Memc[coeff], ip, dval) > 0) {
+	    if (coeffs == NULL) {
+		nalloc = 10
+		call malloc (coeffs, nalloc, TY_DOUBLE)
+	    } else if (ncoeff == nalloc) {
+		nalloc = nalloc + 10
+		call realloc (coeffs, nalloc, TY_DOUBLE)
+	    }
+	    Memd[coeffs+ncoeff] = dval
+	    ncoeff = ncoeff + 1
+	}
+	ip = ip + SZ_LINE
+	call realloc (coeff, ip, TY_CHAR)
+	call aclrc (Memc[coeff], ip)
+	fd = stropen (Memc[coeff], ip, NEW_FILE)
+
+	ip = 0
+	while (ip < ncoeff) {
+	    if (ip > 0)
+		call fprintf (fd, " ")
+	    Memd[coeffs+ip+1] = Memd[coeffs+ip+1] + shift
+	    type = nint (Memd[coeffs+ip+2])
+	    order = nint (Memd[coeffs+ip+3])
+	    call fprintf (fd, "%.3g %g %d %d")
+		call pargd (Memd[coeffs+ip])
+		call pargd (Memd[coeffs+ip+1])
+		call pargi (type)
+		call pargi (order)
+	    switch (type) {
+	    case CHEBYSHEV, LEGENDRE:
+		j = 6 + order
+	    case SPLINE3:
+		j = 9 + order
+	    case SPLINE1:
+		j = 7 + order
+	    case PIXEL:
+		j = 4 + order
+	    case SAMPLE:
+		j = 5 + order
+	    }
+	    do i = 4, j-1 {
+		call fprintf (fd, " %g")
+		    call pargd (Memd[coeffs+ip+i])
+	    }
+	    ip = ip + j
+	}
+	call strclose (fd)
+
+	call mfree (coeffs, TY_DOUBLE)
+end
diff --git a/noao/onedspec/t_standard.x b/noao/onedspec/t_standard.x
new file mode 100644
index 00000000..9a596150
--- /dev/null
+++ b/noao/onedspec/t_standard.x
@@ -0,0 +1,835 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+
+define	KEY	"noao$onedspec/standard.key"
+define	PROMPT	"STANDARD options"
+
+define	VLIGHT		2.997925e18	# Velocity of light in Angstroms/sec
+define	EXT_LOOKUP	1		# Interp entry ID for extinction table
+define	MAG_LOOKUP	2		# Interp entry ID for magnitude table
+
+define	STD_LEN		13		# Length of standard structure
+define	STD_AP		Memi[$1]	# Aperture number
+define	STD_TYPE	Memi[$1+1]	# Spectrum type	
+define	STD_SH		Memi[$1+2]	# Pointer to spectrum parameters
+define	STD_IFLAG	Memi[$1+3]	# Interactive flag
+define	STD_NWAVES	Memi[$1+4]	# Number of calibration points
+define	STD_WAVES	Memi[$1+5]	# Pointer to standard star wavelengths
+define	STD_DWAVES	Memi[$1+6]	# Pointer to standard star bandpasses
+define	STD_MAGS	Memi[$1+7]	# Pointer to standard star magnitudes
+define	STD_FLUXES	Memi[$1+8]	# Pointer to standard star fluxes
+define	CAL_NWAVES	Memi[$1+9]	# Number of calibration points
+define	CAL_WAVES	Memi[$1+10]	# Pointer to calibration wavelengths
+define	CAL_DWAVES	Memi[$1+11]	# Pointer to calibration bandpasses
+define	CAL_MAGS	Memi[$1+12]	# Pointer to calibration magnitudes
+
+# Object flags
+define	NONE	-1	# No object flag
+define	SKY	0	# Sky
+define	OBJ	1	# Object
+
+# Interactive flags
+define	ANSWERS	"|no|yes|N|Y|NO|YES|NO!|YES!|"
+define	NO1	1	# No for a single spectrum
+define	YES1	2	# Yes for a single spectrum
+define	N2	3	# No for all spectra of the same aperture
+define	Y2	4	# Yes for all spectra of the same aperture
+define	NO2	5	# No for all spectra of the same aperture
+define	YES2	6	# Yes for all spectra of the same aperture
+define	NO3	7	# No for all spectra
+define	YES3	8	# Yes for all spectra
+
+# T_STANDARD -- Read standard star spectrum and compare with tabulated
+#               fluxes for given star to ascertain the system sensitivity
+#               across the spectrum. The user may optionally define
+#               new and arbitrary bandpasses
+#
+#               The sensitivity function is stored in tabular form in a file
+#               containing the wavelength, sensitivity factor, and counts per
+#               bandpass at each required position along the spectrum.
+#               The file is appended to for each new measurement from either
+#               same or different standard stars.
+
+procedure t_standard()
+
+int	list			# List of input spectra
+pointer	output			# Output standard file
+pointer	observatory		# Observatory
+pointer	aps			# Aperture list
+real	bandwidth		# Width of bandpass
+real	bandsep			# Separation of bandpass
+bool	bswitch			# Beam switch?
+bool	samestar		# Same star in all apertures?
+int	interactive		# Interactive bandpass definition
+
+bool	newobs, obshead
+int	i, j, line, enwaves, nstds
+real	wave, dwave, latitude
+pointer	sp, units, errstr, str, image, ewaves, emags
+pointer	im, mw, un, unang, sh, obj, sky, std, stds, obs, gp
+
+int	imtgetim(), errget()
+real	clgetr(), obsgetr()
+bool	clgetb(), rng_elementi(), streq()
+pointer	imtopenp(), rng_open(), immap(), smw_openim(), un_open()
+errchk	immap, smw_openim, shdr_open, std_calib, get_airm, ext_load, obsimopen
+errchk	un_open, std_gcalib
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (observatory, SZ_FNAME, TY_CHAR)
+	call salloc (units, SZ_FNAME, TY_CHAR)
+	call salloc (errstr, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Get task parameters.
+	list = imtopenp ("input")
+	call clgstr ("records", Memc[image], SZ_FNAME)
+	call odr_openp (list, Memc[image])
+	call clgstr ("output", Memc[output], SZ_FNAME)
+	call clgstr ("apertures", Memc[image], SZ_FNAME)
+	bandwidth = clgetr ("bandwidth")
+	bandsep = clgetr ("bandsep")
+	bswitch = clgetb ("beam_switch")
+	if (bswitch)
+	    samestar = true
+	else
+	    samestar = clgetb ("samestar")
+	if (clgetb ("interact"))
+	    interactive = YES1
+	else
+	    interactive = NO3
+
+	# Expand the aperture list.
+	iferr (aps = rng_open (Memc[image], INDEF, INDEF, INDEF))
+	    call error (0, "Bad aperture list")
+
+	call ext_load (ewaves, emags, enwaves)
+
+	un = NULL
+	sh = NULL
+	obj = NULL
+	sky = NULL
+	obs = NULL
+	gp = NULL
+	nstds = 0
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    mw = smw_openim (im)
+	    call shdr_open (im, mw, 1, 1, INDEFI, SHHDR, sh)
+
+	    if (DC(sh) == DCNO) {
+		call eprintf ("%s: No dispersion function\n")
+		    call pargstr (Memc[image])
+		call smw_close (MW(sh))
+		call imunmap (IM(sh))
+		next
+	    }
+
+	    # Work in units of first spectrum.
+	    if (un == NULL) {
+		call strcpy (UNITS(sh), Memc[units], SZ_FNAME)
+		un = un_open (Memc[units])
+		unang = un_open ("Angstroms")
+		call un_ctranr (unang, un, Memr[ewaves], Memr[ewaves], enwaves)
+	    }
+	    if (IS_INDEF (IT(sh))) {
+		call printf ("%s: ")
+		    call pargstr (Memc[image])
+		call flush (STDOUT)
+		IT(sh) = clgetr ("exptime")
+		call imunmap (IM(sh))
+		ifnoerr (im = immap (Memc[image], READ_WRITE, 0)) {
+		    IM(sh) = im
+		    call imseti (IM(sh), IM_WHEADER, YES)
+		    call imaddr (IM(sh), "exptime", IT(sh))
+		} else {
+		    im = immap (Memc[image], READ_ONLY, 0)
+		    IM(sh) = im
+		}
+	    }
+
+	    do line = 1, SMW_NSPEC(mw) {
+		call shdr_open (im, mw, line, 1, INDEFI, SHDATA, sh)
+		if (!rng_elementi (aps, AP(sh)))
+		    next
+		call shdr_units (sh, Memc[units])
+
+		if (!bswitch || OFLAG(sh) == OBJ) {
+		    call printf ("%s%s(%d): %s\n")
+			call pargstr (IMNAME(sh))
+			call pargstr (IMSEC(sh))
+			call pargi (AP(sh))
+			call pargstr (TITLE(sh))
+		    call flush (STDOUT)
+		}
+
+	        if (IS_INDEF (AM(sh))) {
+		    call clgstr ("observatory", Memc[observatory], SZ_FNAME)
+		    call obsimopen (obs, im, Memc[observatory], NO, newobs,
+			obshead)
+		    if (newobs)
+			call obslog (obs, "STANDARD", "latitude", STDOUT)
+		    latitude = obsgetr (obs, "latitude")
+		    iferr (call get_airm (RA(sh), DEC(sh), HA(sh), ST(sh),
+			latitude, AM(sh))) {
+			call printf ("%s: ")
+			    call pargstr (Memc[image])
+			call flush (STDOUT)
+			AM(sh) = clgetr ("airmass")
+			call imunmap (IM(sh))
+			ifnoerr (im = immap (Memc[image], READ_WRITE, 0)) {
+			    IM(sh) = im
+			    call imseti (IM(sh), IM_WHEADER, YES)
+			    call imaddr (IM(sh), "airmass", AM(sh))
+			} else {
+			    im = immap (Memc[image], READ_ONLY, 0)
+			    IM(sh) = im
+			}
+		    }
+		}
+
+		for (i=0; i<nstds; i=i+1) {
+		    std = Memi[stds+i]
+		    if (STD_AP(std) == AP(sh))
+			break
+		}
+
+		# Allocate space for this aperture if not already done.
+		if (i >= nstds) {
+		    if (nstds == 0)
+			call malloc (stds, 10, TY_INT)
+		    else if (mod (nstds, 10) == 0)
+			call realloc (stds, nstds+10, TY_INT)
+		    call salloc (std, STD_LEN, TY_STRUCT)
+		    Memi[stds+i] = std
+		    nstds = nstds + 1
+
+		    STD_AP(std) = AP(sh)
+		    STD_TYPE(std) = NONE
+		    STD_SH(std) = NULL
+		    STD_IFLAG(std) = interactive
+		    STD_NWAVES(std) = 0
+
+		    if (!samestar || i == 0) {
+	 	        # Read calibration data
+			Memc[str] = EOS
+		        repeat {
+		            iferr (call std_gcalib (std, un)) {
+				j = errget (Memc[errstr], SZ_FNAME)
+				if (streq (Memc[errstr], Memc[str]))
+				    call erract (EA_ERROR)
+				call strcpy (Memc[errstr], Memc[str], SZ_LINE)
+		                call erract (EA_WARN)
+			        next
+			    }
+		            break
+			}
+		    } else {
+			CAL_NWAVES(std) = CAL_NWAVES(Memi[stds])
+			CAL_WAVES(std) = CAL_WAVES(Memi[stds])
+			CAL_DWAVES(std) = CAL_DWAVES(Memi[stds])
+			CAL_MAGS(std) = CAL_MAGS(Memi[stds])
+		    }
+
+		    if (IS_INDEF (bandwidth)) {
+		        do j = 1, CAL_NWAVES(std) {
+		            wave = Memr[CAL_WAVES(std)+j-1]
+		            dwave = Memr[CAL_DWAVES(std)+j-1]
+		            call std_addband (std, wave, dwave, 0.)
+		        }
+		    } else {
+			wave = W0(sh) + bandwidth / 2
+			dwave = W0(sh) + (SN(sh)-1) * WP(sh) - bandwidth / 2
+			while (wave <= dwave) {
+		            call std_addband (std, wave, bandwidth, 0.)
+			    wave = wave + bandsep
+			}
+		    }
+		}
+
+		# The copying of SHDR structures and associated MWCS only
+		# occurs with beam switched data.
+
+		if (bswitch) {
+		    switch (STD_TYPE(std)) {
+		    case NONE:
+			STD_TYPE(std) = OFLAG(sh)
+			call shdr_copy (sh, STD_SH(std), YES)
+			next
+		    case SKY:
+			obj = sh
+			sky = STD_SH(std)
+			if (OFLAG(sh) == SKY) {
+			    call eprintf ("%s[%d]: Object spectrum not found\n")
+				call pargstr (IMNAME(sky))
+				call pargi (AP(sky))
+
+			    call smw_close (MW(sky))
+			    call shdr_copy (sh, STD_SH(std), YES)
+			    next
+			}
+		    case OBJ:
+			obj = STD_SH(std)
+			sky = sh
+			if (OFLAG(sh) == OBJ) {
+			    obj = STD_SH(std)
+			    call eprintf ("%s[%d]: Sky spectrum not found\n")
+				call pargstr (IMNAME(obj))
+				call pargi (AP(obj))
+
+			    call smw_close (MW(obj))
+			    call shdr_copy (sh, STD_SH(std), YES)
+			    next
+			}
+		    }
+		} else {
+		    obj = sh
+		    sky = NULL
+		}
+
+		# Generate a calibration table
+		call std_calib (obj, sky, std, gp, Memr[ewaves], Memr[emags],
+		    enwaves)
+		call std_output (obj, sky, std, Memc[output])
+
+		if (interactive == YES1) {
+		    if (STD_IFLAG(std) == NO3 || STD_IFLAG(std) == YES3) {
+		        interactive = STD_IFLAG(std)
+		        do i = 0, nstds-1
+			    STD_IFLAG(Memi[stds+i]) = interactive
+		    }
+		    if (interactive == NO3 && gp != NULL)
+			call gclose (gp)
+		}
+
+		if (bswitch) {
+		    call smw_close (MW(STD_SH(std)))
+		    STD_TYPE(std) = NONE
+		}
+	    }
+
+	    call smw_close (MW(sh))
+	    call imunmap (IM(sh))
+	}
+
+	if (un != NULL) {
+	    call un_close (un)
+	    call un_close (unang)
+	}
+	if (obs != NULL)
+	    call obsclose (obs)
+	if (gp != NULL)
+	    call gclose (gp)
+	do i = 0, nstds-1 {
+	    std = Memi[stds+i]
+	    obj = STD_SH(std)
+	    switch (STD_TYPE(std)) {
+	    case SKY:
+		call eprintf ("%s[%d]: Object spectrum not found\n")
+		    call pargstr (IMNAME(obj))
+		    call pargi (AP(obj))
+	    case OBJ:
+		call eprintf ("%s[%d]: Sky spectrum not found\n")
+		    call pargstr (IMNAME(obj))
+		    call pargi (AP(obj))
+	    }
+	    if (obj != NULL)
+		call shdr_close (obj)
+	    if (!samestar || i == 0) {
+		call mfree (CAL_WAVES(std), TY_REAL)
+		call mfree (CAL_DWAVES(std), TY_REAL)
+		call mfree (CAL_MAGS(std), TY_REAL)
+	    }
+	    call mfree (STD_WAVES(std), TY_REAL)
+	    call mfree (STD_DWAVES(std), TY_REAL)
+	    call mfree (STD_MAGS(std), TY_REAL)
+	    call mfree (STD_FLUXES(std), TY_REAL)
+	}
+	call mfree (stds, TY_INT)
+	call mfree (ewaves, TY_REAL)
+	call mfree (emags, TY_REAL)
+	call shdr_close (sh)
+	call rng_close (aps)
+	call imtclose (list)
+	call sfree (sp)
+end
+
+
+# STD_CALIB -- Compute standard star calibrations
+
+procedure std_calib (obj, sky, std, gp, ewaves, emags, enwaves)
+
+pointer	obj			# Object pointer
+pointer	sky			# Sky pointer
+pointer	std			# Standard pointer
+pointer	gp			# Graphics pointer
+real	ewaves[enwaves]		# Extinction wavelengths
+real	emags[enwaves]		# Extinction magnitudes
+int	enwaves			# Extinction points
+
+int	i, j, n, nwaves, wcs, key, newgraph
+real	wave, dwave, flux, wx1, wx2, wy
+pointer	sp, cmd, gt, waves, dwaves, fluxes, x, y
+
+real	std_flux()
+double	shdr_wl()
+int	clgcur(), strdic(), clgwrd()
+pointer	gopen(), gt_init()
+errchk	gopen, std_output
+
+define	beep_	99
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Sky subtract
+	if (sky != NULL) {
+	    call shdr_rebin (sky, obj)
+	    call asubr (Memr[SY(obj)], Memr[SY(sky)], Memr[SY(obj)], SN(obj))
+	}
+
+	# Remove extinction correction
+	if (EC(obj) == ECYES) {
+	    x = SX(obj)
+	    y = SY(obj)
+	    n = SN(obj)
+	    do i = 1, n {
+	        call intrp (EXT_LOOKUP, ewaves, emags, enwaves,
+		    Memr[x], flux, j)
+	        Memr[y] = Memr[y] * 10.0 ** (-0.4 * flux * AM(obj))
+		x = x + 1
+		y = y + 1
+	    }
+	}
+
+	nwaves = STD_NWAVES(std)
+	waves = STD_WAVES(std)
+	dwaves = STD_DWAVES(std)
+	fluxes = STD_FLUXES(std)
+	do i = 0, nwaves-1 {
+	    wave = Memr[waves+i]
+	    dwave = Memr[dwaves+i]
+	    Memr[fluxes+i] = std_flux (obj, wave, dwave, ewaves, emags, enwaves)
+	}
+
+	# Plot spectrum if user wants to see whats happening
+	if (STD_IFLAG(std) == NO1 || STD_IFLAG(std) == YES1) {
+	    call printf ("%s[%d]: Edit bandpasses? ")
+		call pargstr (IMNAME(obj))
+		call pargi (AP(obj))
+	    STD_IFLAG(std) = clgwrd ("answer", Memc[cmd], SZ_FNAME, ANSWERS)
+	}
+
+	i = STD_IFLAG(std)
+	if (i==YES1||i==Y2||i==YES2||i==YES3) {
+	    if (gp == NULL) {
+	        call clgstr ("graphics", Memc[cmd], SZ_FNAME)
+	        gp = gopen (Memc[cmd], NEW_FILE, STDGRAPH)
+	    }
+	    gt = gt_init()
+	    call gt_sets (gt, GTTITLE, TITLE(obj))
+	    call gt_sets (gt, GTPARAMS, IMNAME(obj))
+	    call gt_sets (gt, GTXLABEL, LABEL(obj))
+	    call gt_sets (gt, GTXUNITS, UNITS(obj))
+	    call gt_sets (gt, GTYLABEL, "instrumental flux")
+	    call gt_sets (gt, GTTYPE, "line")
+
+	    key = 'r'
+	    repeat {
+	        switch (key) {
+	        case '?':
+		    call gpagefile (gp, KEY, PROMPT)
+	        case ':':
+		    if (Memc[cmd] == '/')
+		        call gt_colon (Memc[cmd], gp, gt, newgraph)
+		    else {
+			switch (strdic (Memc[cmd],Memc[cmd],SZ_LINE,"|show|")) {
+			case 1:
+			    call mktemp ("std", Memc[cmd], SZ_LINE)
+			    call std_output (obj, sky, std, Memc[cmd])
+		            call gpagefile (gp, Memc[cmd], "standard star data")
+			    call delete (Memc[cmd])
+			default:
+			    goto beep_
+			}
+		    }
+	        case 'a':
+		    call printf ("a again:\n")
+		    i = clgcur ("cursor", wx2, wy, wcs, key, Memc[cmd], SZ_LINE)
+		    call printf ("\n")
+		    if (wx1 == wx2) {
+		        call printf ("\07Two cursor positions required")
+			goto beep_
+		    }
+
+		    # Create artificial standard wavelength and bandpass
+		    wave = (wx1 + wx2) / 2.0
+		    dwave = wx2 - wx1
+	    	    flux = std_flux (obj, wave, dwave, ewaves, emags, enwaves)
+		    call std_addband (std, wave, dwave, flux)
+		    flux = flux / abs (shdr_wl (obj, double(wx1)) -
+			shdr_wl (obj, double (wx2)))
+		    call gmark (gp, wave, flux, GM_BOX, -dwave, 3.)
+
+		    nwaves = STD_NWAVES(std)
+		    waves = STD_WAVES(std)
+		    dwaves = STD_DWAVES(std)
+		    fluxes = STD_FLUXES(std)
+		case 'd':
+		    dwave = MAX_REAL
+		    do i = 0, nwaves-1 {
+			wave = Memr[waves+i]
+			if (abs (wx1 - wave) < dwave) {
+			    dwave = abs (wx1 - wave)
+			    j = i
+			}
+		    }
+		    wave = Memr[waves+j]
+		    dwave = Memr[dwaves+j]
+		    flux = Memr[fluxes+j]
+		    flux = flux / abs (shdr_wl (obj, double(wave-dwave/2)) -
+			shdr_wl (obj, double (wave+dwave/2)))
+		    call gseti (gp, G_PMLTYPE, 0)
+		    call gmark (gp, wave, flux, GM_BOX, -dwave, 3.)
+		    call gseti (gp, G_PMLTYPE, 1)
+		    call gscur (gp, wave, flux)
+		    call std_delband (std, j)
+		case 'q':
+		    break
+		case 'I':
+		    call fatal (0, "Interrupt")
+		case 'r':
+		    newgraph = YES
+	        case 'w':
+		    call gt_window (gt, gp, "cursor", newgraph)
+	        default: # Invalid keystroke
+beep_	            call printf ("\007")
+	        }
+
+		if (newgraph == YES) {
+		    call std_graph (obj, std, gp, gt, YES)
+		    newgraph = NO
+		}
+	    } until (clgcur ("cursor",wx1,wy,wcs,key,Memc[cmd],SZ_LINE) == EOF)
+	    call gt_free (gt)
+	}
+
+	call sfree (sp)
+end
+
+
+# STD_OUTPUT -- Output standard  star data.
+# For now we do this in Angstroms.
+
+procedure std_output (obj, sky, std, output)
+
+pointer	obj			# Object pointer
+pointer	sky			# Sky pointer
+pointer	std			# Standard pointer
+char	output[ARB]		# Output file name
+
+int	i, fd, open()
+real	wave, dwave, mag, flux, fnuzero, flambda, clgetr()
+pointer	unang, un_open()
+errchk	open, un_open, un_ctranr, std_units
+
+begin
+	fd = open (output, APPEND, TEXT_FILE)
+	call fprintf (fd, "[%s]")
+	    call pargstr (IMNAME(obj))
+	if (sky != NULL) {
+	    call fprintf (fd, "-[%s]")
+	        call pargstr (IMNAME(sky))
+	}
+
+	unang = un_open ("Angstroms")
+	call un_ctranr (UN(obj), unang, W0(obj), wave, 1)
+	call un_ctranr (UN(obj), unang, W0(obj)+(SN(obj)-1)*WP(obj), dwave, 1)
+	call fprintf (fd, " %d %d %.2f %5.3f %9.3f %9.3f %s\n")
+	    call pargi (AP(obj))
+	    call pargi (SN(obj))
+	    call pargr (IT(obj))
+	    call pargr (AM(obj))
+	    #call pargr (W0(obj))
+	    #call pargr (W0(obj) + (SN(obj)-1) * WP(obj))
+	    call pargr (wave)
+	    call pargr (dwave)
+	    call pargstr (TITLE(obj))
+
+	fnuzero = clgetr ("fnuzero")
+	do i = 0, STD_NWAVES(std)-1 {
+	    wave = Memr[STD_WAVES(std)+i]
+	    dwave = Memr[STD_DWAVES(std)+i]
+	    mag = Memr[STD_MAGS(std)+i]
+	    flux = Memr[STD_FLUXES(std)+i]
+	    if (flux == 0.)
+		next
+
+	    call std_units (UN(obj), unang, wave, dwave, 1)
+	    flambda = fnuzero * 10. ** (-0.4 * mag) * VLIGHT / wave**2
+	    call fprintf (fd, "%8.2f %12.5g %8.3f %12.5g\n")
+		call pargr (wave)
+		call pargr (flambda)
+		call pargr (dwave)
+		call pargr (flux)
+	}
+	call close (fd)
+
+	call un_close (unang)
+end
+
+
+# STD_FLUX -- Add up the flux in a given bandpass centered on a given
+# wavelength.  The bandpass must be entirely within the data.
+# A correction for differential extinction across the bandpass is made
+# by applying the extinction correction and then removing the correction
+# at the bandpass center
+
+real procedure std_flux (sh, wave, dwave, ewaves, emags, enwaves)
+
+pointer	sh			# Spectrum
+real	wave			# Bandpass wavelength
+real	dwave			# Bandpass width
+real	ewaves[enwaves]		# Extinction wavelengths
+real	emags[enwaves]		# Extinction magnitudes
+int	enwaves			# Extinction points
+
+real	flux			# Bandpass flux
+
+int	i, i1, i2, ierr
+real	a, e, ec, x1, x2
+double	w1, w2, w3, w4, shdr_lw(), shdr_wl()
+pointer	x, y
+
+begin
+	# Determine bandpass limits in pixel and return if out of bounds.
+	w1 = wave - dwave / 2.
+	w2 = wave + dwave / 2.
+	w3 = shdr_lw (sh, 0.5D0)
+	w4 = shdr_lw (sh, double (SN(sh)+0.5))
+	if (w1 < min (w3, w4) || w2 > max (w3, w4)) 
+	    return (0.)
+
+	a = shdr_wl (sh, w1)
+	x2 = shdr_wl (sh, w2)
+	x1 = min (a, x2)
+	x2 = max (a, x2)
+	i1 = nint (x1)
+	i2 = nint (x2 - 0.00001)
+	if (x1 == x2 || i1 < 1 || i2 > SN(sh))
+	    return (0.)
+
+	a = AM(sh)
+	x = SX(sh) + i1 - 1
+	y = SY(sh) + i1 - 1
+
+	call intrp (EXT_LOOKUP, ewaves, emags, enwaves, wave, ec, ierr)
+	call intrp (EXT_LOOKUP, ewaves, emags, enwaves, Memr[x], e, ierr)
+
+	if (i1 == i2) {
+	    flux = (x2-x1) * Memr[y] * 10.0 ** (0.4 * a * (e - ec))
+	    return (flux)
+	}
+
+	flux = (i1+0.5-x1) * Memr[y] * 10.0 ** (0.4 * a * (e - ec))
+	x = x + 1
+	y = y + 1
+
+	for (i=i1+1; i<=i2-1; i=i+1) {
+	    call intrp (EXT_LOOKUP, ewaves, emags, enwaves, Memr[x], e, ierr)
+	    flux = flux + Memr[y] * 10.0 ** (0.4 * a * (e - ec))
+	    x = x + 1
+	    y = y + 1
+	}
+
+	call intrp (EXT_LOOKUP, ewaves, emags, enwaves, Memr[x], e, ierr)
+	flux = flux + (x2-i2+0.5) * Memr[y] * 10.0 ** (0.4 * a * (e - ec))
+
+	return (flux)
+end
+
+
+# STD_ADDBAND -- Add a standard bandpass
+
+procedure std_addband (std, wave, dwave, flux)
+
+pointer	std		# Pointer to standard star data
+real	wave		# Wavelength to be added
+real	dwave		# Bandpass to be added
+real	flux		# Flux to be added
+
+int	i, nwaves
+real	mag
+pointer	waves, dwaves, mags, fluxes
+
+begin
+	nwaves = STD_NWAVES(std)
+	if (nwaves == 0) {
+	    call malloc (STD_WAVES(std), 10, TY_REAL)
+	    call malloc (STD_DWAVES(std), 10, TY_REAL)
+	    call malloc (STD_MAGS(std), 10, TY_REAL)
+	    call malloc (STD_FLUXES(std), 10, TY_REAL)
+	} else if (mod (nwaves, 10) == 0) {
+	    call realloc (STD_WAVES(std), nwaves+10, TY_REAL)
+	    call realloc (STD_DWAVES(std), nwaves+10, TY_REAL)
+	    call realloc (STD_MAGS(std), nwaves+10, TY_REAL)
+	    call realloc (STD_FLUXES(std), nwaves+10, TY_REAL)
+	}
+
+        call intrp (MAG_LOOKUP, Memr[CAL_WAVES(std)], Memr[CAL_MAGS(std)],
+	    CAL_NWAVES(std), wave, mag, i)
+
+	waves = STD_WAVES(std)
+	dwaves = STD_DWAVES(std)
+	mags = STD_MAGS(std)
+	fluxes = STD_FLUXES(std)
+	for (i=nwaves; (i>0)&&(Memr[waves+i-1]>wave); i=i-1) {
+            Memr[waves+i] = Memr[waves+i-1]
+            Memr[dwaves+i] = Memr[dwaves+i-1]
+            Memr[mags+i] = Memr[mags+i-1]
+            Memr[fluxes+i] = Memr[fluxes+i-1]
+	}
+        Memr[waves+i] = wave
+        Memr[dwaves+i] = dwave
+        Memr[mags+i] = mag
+        Memr[fluxes+i] = flux
+	STD_NWAVES(std) = nwaves + 1
+end
+
+
+# STD_DELBAND -- Delete a bandpass
+
+procedure std_delband (std, band)
+
+pointer	std		# Pointer to standard star data
+int	band		# Band to be deleted
+
+int	i, nwaves
+pointer	waves, dwaves, mags, fluxes
+
+begin
+	nwaves = STD_NWAVES(std)
+	waves = STD_WAVES(std)
+	dwaves = STD_DWAVES(std)
+	mags = STD_MAGS(std)
+	fluxes = STD_FLUXES(std)
+	for (i=band+1; i<nwaves; i=i+1) {
+	    Memr[waves+i-1] = Memr[waves+i]
+	    Memr[dwaves+i-1] = Memr[dwaves+i]
+	    Memr[mags+i-1] = Memr[mags+i]
+	    Memr[fluxes+i-1] = Memr[fluxes+i]
+	}
+	nwaves = nwaves - 1
+
+	STD_NWAVES(std) = nwaves
+	if (nwaves == 0) {
+	    call mfree (STD_WAVES(std), TY_REAL)
+	    call mfree (STD_DWAVES(std), TY_REAL)
+	    call mfree (STD_MAGS(std), TY_REAL)
+	    call mfree (STD_FLUXES(std), TY_REAL)
+	}
+end
+
+
+# STD_GRAPH -- Graph the spectrum and standard star calibration points.
+
+procedure std_graph (sh, std, gp, gt, clear)
+
+pointer	sh			# Spectrum pointer
+pointer	std			# Standard star data
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+int	clear			# Clear flag
+
+int	i
+real	dw, wave, dwave, flux
+double	shdr_wl()
+
+begin
+	if (clear == YES) {
+	    call gclear (gp)
+	    call gascale (gp, Memr[SX(sh)], SN(sh), 1)
+	    call gascale (gp, Memr[SY(sh)], SN(sh), 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	call gt_plot (gp, gt, Memr[SX(sh)], Memr[SY(sh)], SN(sh))
+
+	do i = 0, STD_NWAVES(std)-1 {
+	    wave = Memr[STD_WAVES(std)+i]
+	    dwave = Memr[STD_DWAVES(std)+i]
+	    flux = Memr[STD_FLUXES(std)+i]
+	    if (flux == 0.)
+		next
+	    dw = abs (shdr_wl (sh, double(wave-dwave/2)) -
+		shdr_wl (sh, double (wave+dwave/2)))
+	    flux = flux / dw
+	    call gmark (gp, wave, flux, GM_BOX, -dwave, 3.)
+	}
+end
+
+
+# STD_GCALIB -- Get calibration data in desired units.
+
+procedure std_gcalib (std, un)
+
+pointer	std		#I Standard pointer
+pointer	un		#I Desired units pointer
+
+pointer	unang, un_open()
+errchk	getcalib, std_units
+
+begin
+	call getcalib (CAL_WAVES(std), CAL_DWAVES(std), CAL_MAGS(std),
+	    CAL_NWAVES(std))
+
+	# Cnvert to desired units.
+	unang = un_open ("Angstroms")
+	call std_units (unang, un,
+	    Memr[CAL_WAVES(std)], Memr[CAL_DWAVES(std)], CAL_NWAVES(std))
+	call un_close (unang)
+end
+
+
+# STD_UNITS -- Convert bandpass information to different units.
+
+procedure std_units (unin, unout, center, width, n)
+
+pointer	unin		#I Input units
+pointer	unout		#I Output units
+real	center[ARB]	#U Bandpass centers
+real	width[ARB]	#U Bandpass widths
+int	n		#I Number of bandpasses
+
+int	i
+real	x1, x2
+bool	un_compare()
+errchk	un_ctranr
+
+
+begin
+	if (un_compare (unin, unout))
+	    return
+
+	do i = 1, n {
+	    x1 = center[i] - width[i] / 2
+	    x2 = center[i] + width[i] / 2
+	    call un_ctranr (unin, unout, x1, x1, 1)
+	    call un_ctranr (unin, unout, x2, x2, 1)
+	    center[i] = (x1 + x2) / 2.
+	    width[i] = abs (x1 - x2)
+	}
+end
diff --git a/noao/onedspec/t_tweak.x b/noao/onedspec/t_tweak.x
new file mode 100644
index 00000000..e50dccea
--- /dev/null
+++ b/noao/onedspec/t_tweak.x
@@ -0,0 +1,1352 @@
+include	<error.h>
+include	<gset.h>
+include	<imset.h>
+include	<imhdr.h>
+include	<math.h>
+include	<math/iminterp.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	<units.h>
+include	<pkg/xtanswer.h>
+
+# Tweak data object definitions.
+define	TWK_SLEN	999		  # Length of sample region string
+define	TWK_LEN		580		  # Length of data object
+
+define	TWK_TYPE	Memc[P2C($1)]	  # Tweak type (maxchars=19)
+define	TWK_SH		Memi[$1+11]	  # Spectrum pointer
+define	TWK_CAL		Memi[$1+12]	  # Calibration pointer
+define	TWK_WAVE	Memi[$1+13]	  # Pointer to wavelengths
+define	TWK_SPEC	Memi[$1+14]	  # Pointer to calibrated spectrum
+define	TWK_SHIFT	Memr[P2R($1+15)]  # Shift
+define	TWK_DSHIFT	Memr[P2R($1+16)]  # Shift step
+define	TWK_SCALE	Memr[P2R($1+17)]  # Scaling factor
+define	TWK_DSCALE	Memr[P2R($1+18)]  # Scaling factor step
+define	TWK_RG		Memi[$1+19]	  # Range pointer
+define	TWK_RMS		Memr[P2R($1+20)]  # RMS in sample regions
+define	TWK_OFFSET	Memr[P2R($1+21)]  # Offset in graphs
+define	TWK_BOX		Memi[$1+22]	  # Boxcar smoothing size
+define	TWK_THRESH	Memr[P2R($1+23)]  # Calibration threshold
+define	TWK_SAMPLE	Memc[P2C($1+30)]  # Sample regions (maxchars=999)
+define	TWK_HELP	Memc[P2C($1+530)] # Help file (maxchars=99)
+
+# Tweak types.
+define	SKYTWEAK	1		# Sky subtraction
+define	TELLURIC	2		# Telluric division
+
+# Secondary graph types.
+define	GNONE		0		# No graph
+define	GCAL		1		# Graph calibration spectrum
+define	GDATA		2		# Graph data spectrum
+
+
+# T_SKYTWEAK -- Sky subtract spectra with shift and scale tweaking.
+# The sky calibration spectra are scaled and shifted to best subtract
+# sky features.  Automatic and interactive methods are provided.
+
+procedure t_skytweak ()
+
+pointer	twk		# TWK data object
+
+begin
+	call malloc (twk, TWK_LEN, TY_STRUCT)
+	call strcpy ("SKYTWEAK", TWK_TYPE(twk), 19)
+	call strcpy ("onedspec$doc/skytweak.key", TWK_HELP(twk), 99)
+	call tweak (twk)
+	call mfree (twk, TY_STRUCT)
+end
+
+
+# T_TELLURIC -- Correct spectra for telluric features.
+# The telluric calibration spectra are scaled by raising to a power (Beers law)
+# and shifted to best remove telluric features.  Automatic and interactive
+# methods are provided.
+
+procedure t_telluric ()
+
+pointer	twk		# TWK data object
+
+begin
+	call malloc (twk, TWK_LEN, TY_STRUCT)
+	call strcpy ("TELLURIC", TWK_TYPE(twk), 19)
+	call strcpy ("onedspec$doc/telluric.key", TWK_HELP(twk), 99)
+	call tweak (twk)
+	call mfree (twk, TY_STRUCT)
+end
+
+
+# TWEAK -- Tweak spectra for shift and scale before applying a correction.
+# This procedure implements both sky subtraction and telluric division.
+
+procedure tweak (twk)
+
+pointer	twk		#I TWK data object
+
+pointer	inlist		# Input list
+pointer	outlist		# Output list
+pointer	callist		# Calibration list
+bool	xcorr		# Cross correlate for initial shift
+bool	tweakrms	# Tweak to minimize RMS?
+bool	ignoreaps	# Ignore aperture numbers?
+int	lag		# Cross correlation lag
+bool	interactive	# Interactive?
+
+int	i, j, k, n, nout, ncal, answer
+real	shift, scale, fcor, ical, mean
+pointer	sp, input, output, calname, temp
+pointer	in, smw, sh, out, pcal, cal, x, y, data, tmp
+
+int	clgeti(), imtgetim(), imtlen()
+bool	clgetb(), streq()
+real	clgetr(), asieval()
+double	shdr_wl(), shdr_lw()
+pointer	imtopenp(), immap(), smw_openim(), impl3r(), imgl3r()
+errchk	immap, smw_openim, shdr_open, twk_gcal, twk_tweak, impl3r, imgl3r
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (calname, SZ_FNAME, TY_CHAR)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+	call malloc (TWK_WAVE(twk), 1000, TY_DOUBLE)
+	call malloc (TWK_SPEC(twk), 1000, TY_REAL)
+
+	# Get task parameters.
+	inlist = imtopenp ("input")
+	outlist = imtopenp ("output")
+	callist = imtopenp ("cal")
+	ignoreaps = clgetb ("ignoreaps")
+	if (TWK_TYPE(twk) == 'T')
+	    TWK_THRESH(twk) = clgetr ("threshold")
+	TWK_SHIFT(twk) = clgetr ("shift")
+	TWK_SCALE(twk) = clgetr ("scale")
+	xcorr = clgetb ("xcorr")
+	tweakrms = clgetb ("tweakrms")
+	interactive = clgetb ("interactive")
+	if (interactive)
+	    answer = YES
+	else
+	    answer = ALWAYSNO
+	call clgstr ("sample", TWK_SAMPLE(twk), TWK_SLEN)
+	lag = clgeti ("lag")
+	TWK_DSHIFT(twk) = max (0., clgetr ("dshift"))
+	TWK_DSCALE(twk) = max (0., min (0.99, clgetr ("dscale")))
+	TWK_OFFSET(twk) = clgetr ("offset")
+	TWK_BOX(twk) = max (1, clgeti ("smooth"))
+
+	if (imtlen (inlist) != imtlen (callist) && imtlen (callist) != 1) {
+	    call imtclose (inlist)
+	    call imtclose (outlist)
+	    call imtclose (callist)
+	    call sfree (sp)
+	    call error (1, "Image lists do not match")
+	}
+
+	# Loop over all input images.
+	sh = NULL
+	ncal = 0
+	while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (callist, Memc[calname], SZ_FNAME) != EOF) {
+		if (ncal > 0) {
+		    do i = 0, ncal-1 {
+			cal = Memi[pcal+i]
+			call asifree (IM(cal))
+			call smw_close (MW(cal))
+			call shdr_close (cal)
+		    }
+		    call mfree (pcal, TY_POINTER)
+		    ncal = 0
+		}
+	    }
+
+	    in = NULL; smw = NULL; sh = NULL; out = NULL
+	    iferr {
+		# Set output image.  Use a temporary image when output=input.
+		if (imtlen (outlist) > 0) {
+		    if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF)
+			break
+		} else
+		    call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+		# Map the input image.
+		tmp = immap (Memc[input], READ_ONLY, 0); in = tmp
+		tmp = smw_openim (in); smw = tmp
+		if (smw == SMW_ND)
+		    call error (1, "NDSPEC data not supported")
+		call shdr_open (in, smw, 1, 1, INDEFI, SHHDR, sh)
+
+		# Map the output image.
+		if (streq (Memc[input], Memc[output]))
+		    call mktemp ("temp", Memc[temp], SZ_LINE)
+		else
+		    call strcpy (Memc[output], Memc[temp], SZ_LINE)
+		tmp = immap (Memc[temp], NEW_COPY, in); out = tmp
+		if (IM_PIXTYPE(out) != TY_DOUBLE)
+		    IM_PIXTYPE(out) = TY_REAL
+
+		# Determine airmass if needed.
+		if (TWK_TYPE(twk) == 'T') {
+		    if (IS_INDEF(AM(sh))) {
+			call printf ("%s: ")
+			    call pargstr (Memc[input])
+			call flush (STDOUT)
+			AM(sh) = clgetr ("airmass")
+		    }
+		}
+
+		# Calibrate all spectra in the image.
+		# Only the first band is done.
+		do i = 1, IM_LEN(in,2) {
+
+		    # Get the spectra.
+		    call shdr_open (in, smw, i, 1, INDEFI, SHDATA, sh)
+		    call realloc (TWK_WAVE(twk), SN(sh), TY_DOUBLE)
+		    x = TWK_WAVE(twk)
+		    do k = 1, SN(sh) {
+			Memd[x] = shdr_lw (sh, double(k))
+			x = x + 1
+		    }
+		    if (ignoreaps)
+			call twk_gcal (twk, Memc[calname], INDEFI,
+			    pcal, ncal, cal)
+		    else
+			call twk_gcal (twk, Memc[calname], AP(sh),
+			    pcal, ncal, cal)
+
+		    # Determine the shift and scale.
+		    TWK_SH(twk) = sh
+		    TWK_CAL(twk) = cal
+		    call realloc (SY(cal), SN(sh), TY_REAL)
+		    call realloc (TWK_SPEC(twk), SN(sh), TY_REAL)
+		    if (answer == NO || answer == YES) {
+			call printf ("%s%s: ")
+			    call pargstr (IMNAME(sh))
+			    call pargstr (IMSEC(sh))
+			call flush (STDOUT)
+			call xt_clanswer ("answer", answer)
+		    }
+		    if (answer == YES || answer == ALWAYSYES)
+			interactive = true
+		    else
+			interactive = false
+		    call twk_tweak (twk, xcorr, tweakrms, interactive, lag)
+		    shift = TWK_SHIFT(twk)
+		    if (TWK_TYPE(twk) == 'T')
+			scale = TWK_SCALE(twk) * AM(sh) / AM(cal)
+		    else
+			scale = TWK_SCALE(twk)
+
+		    # Calibrate the output spectrum.
+		    nout = 0
+		    mean = 0.
+		    x = TWK_WAVE(twk)
+		    y = SY(sh)
+		    n = SN(sh)
+		    data = impl3r (out, i, 1)
+		    do k = 1, n {
+			ical = shdr_wl (cal, Memd[x]) + shift
+			if (ical < 1. || ical > SN(cal)) {
+			    if (ical < 0.5 || ical > SN(cal) + 0.5)
+				nout = nout + 1
+			    ical = max (1., min (real(SN(cal)), ical))
+			}
+			if (TWK_TYPE(twk) == 'T') {
+			    fcor = max (TWK_THRESH(twk),
+				asieval (IM(cal),ical)) ** scale
+			    Memr[data] = Memr[y] / fcor
+			    mean = mean + fcor
+			} else {
+			    fcor = asieval (IM(cal),ical) * scale
+			    Memr[data] = Memr[y] - fcor
+			}
+			x = x + 1
+			y = y + 1
+			data = data + 1
+		    }
+		    mean = mean / n
+		    if (TWK_TYPE(twk) == 'T')
+			call amulkr (Memr[data-n], mean, Memr[data-n], n)
+		    do k = n+1, IM_LEN(out,1) {
+			Memr[data] = 0
+			data = data + 1
+		    }
+
+		    # Log the results.
+		    if (i == 1) {
+			call printf ("%s:\n  Output: %s - %s\n")
+			    call pargstr (TWK_TYPE(twk))
+			    call pargstr (Memc[output])
+			    call pargstr (IM_TITLE(out))
+		    }
+		    call printf ("  Input: %s%s - %s\n")
+			call pargstr (IMNAME(sh))
+			call pargstr (IMSEC(sh))
+			call pargstr (TITLE(sh))
+		    call printf ("  Calibration: %s%s - %s\n")
+			call pargstr (IMNAME(cal))
+			call pargstr (IMSEC(cal))
+			call pargstr (TITLE(cal))
+		    call printf ("  Tweak: shift = %.2f, scale = %.3f")
+			call pargr (shift)
+			call pargr (TWK_SCALE(twk))
+		    if (TWK_TYPE(twk) == 'T') {
+			call printf (", normalization = %.4g\n")
+			    call pargr (mean)
+		    } else
+			call printf ("\n")
+		    if (nout > 0) {
+			call printf (
+			"  WARNING: %d pixels outside of calibration limits\n")
+			    call pargi (nout)
+		    }
+		    call flush (STDOUT)
+		}
+		do j = 2, IM_LEN(in,3) {
+		    do i = 1, IM_LEN(in,2) {
+			y = imgl3r (in, i, j)
+			data = impl3r (out, i, j)
+			call amovr (Memr[y], Memr[data], IM_LEN(out,1))
+		    }
+		}
+	    } then {
+		call erract (EA_WARN)
+		if (out != NULL) {
+		    call imunmap (out)
+		    if (!streq (Memc[input], Memc[output]))
+			call imdelete (Memc[output])
+		}
+	    }
+
+	    # Finish up this image.
+	    if (in != NULL)
+		call imunmap (in)
+	    if (smw != NULL) {
+		call smw_close (smw)
+		if (sh != NULL)
+		    MW(sh) = NULL
+	    }
+	    if (out != NULL) {
+		call imunmap (out)
+		if (streq (Memc[input], Memc[output])) {
+		    call imdelete (Memc[input])
+		    call imrename (Memc[temp], Memc[output])
+		}
+	    }
+	}
+
+	# Finish up.
+	if (ncal > 0) {
+	    do i = 0, ncal-1 {
+		cal = Memi[pcal+i]
+		call asifree (IM(cal))
+		call smw_close (MW(cal))
+		call shdr_close (cal)
+	    }
+	    call mfree (pcal, TY_POINTER)
+	}
+	if (sh != NULL)
+	    call shdr_close (sh)
+	call imtclose (inlist)
+	call imtclose (outlist)
+	call imtclose (callist)
+	call mfree (TWK_SPEC(twk), TY_REAL)
+	call sfree (sp)
+end
+
+
+# TWK_GCAL -- Get calibration data
+# An interpolation function is fit and stored in the image pointer field.
+# For efficiency the calibration data is saved by aperture so that additional
+# calls simply return the data pointer.
+
+procedure twk_gcal (twk, calname, ap, pcal, ncal, cal)
+
+pointer	twk			# TWK data object
+char	calname[ARB]		# Calibration image name
+int	ap			# Aperture
+pointer	pcal			# Pointer to cal data
+int	ncal			# Number of active cal data structures
+pointer	cal			# Calibration data structure
+
+int	i, clgwrd()
+pointer	sp, str, im, smw, immap(), smw_openim()
+real	clgetr()
+errchk	immap, smw_openim, shdr_open, asifit
+
+begin
+	# Check for previously saved calibration
+	for (i=0; i<ncal; i=i+1) {
+	    cal = Memi[pcal+i]
+	    if (AP(cal) == ap)
+		return
+	}
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	# Allocate space for a new data pointer and get the calibration data.
+
+	if (ncal == 0)
+	    call malloc (pcal, 10, TY_POINTER)
+	else if (mod (ncal, 10) == 0)
+	    call realloc (pcal, ncal+10, TY_POINTER)
+
+	im = immap (calname, READ_ONLY, 0)
+	smw = smw_openim (im)
+	cal = NULL
+	call shdr_open (im, smw, 1, 1, ap, SHDATA, cal)
+	AP(cal) = ap
+	Memi[pcal+ncal] = cal
+	ncal = ncal + 1
+	call imunmap (im)
+
+	call asiinit (im, clgwrd ("interp", Memc[str], SZ_FNAME,II_FUNCTIONS))
+	call asifit (im, Memr[SY(cal)], SN(cal))
+	IM(cal) = im
+
+	# Determine airmass if needed.
+	if (TWK_TYPE(twk) == 'T') {
+	    if (IS_INDEF(AM(cal))) {
+		call printf ("%s: ")
+		    call pargstr (calname)
+		call flush (STDOUT)
+		AM(cal) = clgetr ("airmass")
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# TWK_TWEAK -- Determine the shift and scale using automatic and interactive
+# methods.
+
+procedure twk_tweak (twk, xcorr, tweakrms, interactive, lag)
+
+pointer	twk		#I TWK data object
+bool	xcorr		#I Cross correlate for shift
+bool	tweakrms	#I Tweak by minimizing RMS?
+bool	interactive	#I Interactive fitting?
+int	lag		#I Cross correlation lag
+
+int	i, n, nlag
+real	ical, asieval()
+double	shdr_wl()
+pointer	sh, cal, rg, asi, x, y, rg_xrangesd()
+errchk	twk_rmsmin, twk_fit
+
+begin
+	sh = TWK_SH(twk)
+	cal = TWK_CAL(twk)
+
+	# Set ranges.
+	rg = rg_xrangesd (TWK_SAMPLE(twk), Memd[TWK_WAVE(twk)], SN(sh))
+	call rg_order (rg)
+	call rg_merge (rg)
+	TWK_RG(twk) = rg
+
+	# Cross correlate for shift.
+	if (xcorr && lag > 0) {
+	    n = SN(sh)
+	    nlag =  n + 2 * lag
+	    call malloc (x, nlag, TY_REAL)
+	    call malloc (y, nlag, TY_REAL)
+
+	    do i = 0, n-1 {
+		ical = max (1D0, min (double(SN(cal)),
+		    shdr_wl (cal, Memd[TWK_WAVE(twk)+i])))
+		Memr[y+i] = asieval (IM(cal), ical)
+	    }
+
+	    call twk_prep (Memr[y], n, Memr[x], nlag)
+	    call twk_prep (Memr[SY(sh)], n, Memr[y], nlag)
+	    call twk_xcorr (Memr[x], Memr[y], i, rg, lag, asi, TWK_SHIFT(twk),
+		ical, 0.5)
+	    call asifree (asi)
+	    call mfree (x, TY_REAL)
+	    call mfree (y, TY_REAL)
+	}
+
+	# Tweak by minimizing RMS.
+	if (tweakrms)
+	    call twk_rmsmin (twk)
+
+	# Do interactive step.
+	if (interactive)
+	    call twk_fit (twk)
+
+	call rg_free (TWK_RG(twk))
+end
+
+
+# TWK_PREP -- Prepare spectra for correlation: fit continuum, subtract, taper
+
+procedure twk_prep (in, nin, out, nout)
+
+real	in[nin]			# Input spectrum
+int	nin			# Number of pixels in input spectrum
+real	out[nout]		# Output spectrum
+int	nout			# Number of pixels output spectrum (nin+2*lag)
+
+int	i, lag
+real	cveval()
+pointer	sp, x, w, ic, cv
+
+begin
+	call smark (sp)
+	call salloc (x, nin, TY_REAL)
+	call salloc (w, nin, TY_REAL)
+
+	call ic_open (ic)
+	call ic_pstr (ic, "function", "chebyshev")
+	call ic_puti (ic, "order", 3)
+	call ic_putr (ic, "low", 3.)
+	call ic_putr (ic, "high", 1.)
+	call ic_puti (ic, "niterate", 5)
+	call ic_putr (ic, "grow", 1.)
+	call ic_putr (ic, "xmin", 1.)
+	call ic_putr (ic, "xmax", real(nin))
+
+	do i = 1, nin {
+	    Memr[x+i-1] = i
+	    Memr[w+i-1] = 1
+	}
+	call ic_fit (ic, cv, Memr[x], in, Memr[w], nin, YES, YES, YES, YES)
+
+	lag = (nout - nin) / 2
+	do i = 1-lag, 0
+	    out[i+lag] = 0.
+	do i = 1, lag-1
+	    out[i+lag] = (1-cos (PI*i/lag))/2 * (in[i] - cveval (cv, real(i))) 
+	do i = lag, nin-lag+1
+	    out[i+lag] = (in[i] - cveval (cv, real(i))) 
+	do i = nin-lag+2, nin
+	    out[i+lag] = (1-cos (PI*(nin+1-i)/lag))/2 *
+		(in[i] - cveval (cv, real(i))) 
+	do i = nin+1, nin+lag
+	    out[i+lag] = 0.
+
+	call cvfree (cv)
+	call ic_closer (ic)
+	call sfree (sp)
+end
+
+
+# TWK_XCORR -- Correlate spectra, fit profile, and measure center/width
+
+procedure twk_xcorr (spec1, spec2, npix, rg, lag, asi, center, width, level)
+
+real	spec1[npix]		# First spectrum
+real	spec2[npix]		# Second spectrum
+int	npix			# Number of pixels in spectra
+pointer	rg			# Ranges
+int	lag			# Maximum correlation lag
+pointer	asi			# Pointer to correlation profile interpolator
+real	center			# Center of profile
+real	width			# Width of profile
+real	level			# Level at which width is determined
+
+int	i, j, k, n, ishift, nprof, rg_inrange()
+real	x, p, pmin, pmax, asieval()
+pointer	sp, prof
+
+begin
+	nprof = 2 * lag + 1
+
+	call smark (sp)
+	call salloc (prof, nprof, TY_REAL)
+
+	ishift = nint (center)
+	n = 0
+	do j = -lag, lag {
+	    p = 0.
+	    do i = 1+lag, npix-lag {
+		if (rg_inrange (rg, i-lag) == NO)
+		    next
+		k = i - j - ishift
+		if (k < 1 || k > npix)
+		    next
+		p = p + spec1[i] * spec2[k]
+		n = n + 1
+	    }
+	    Memr[prof+j+lag] = p
+	}
+	if (n < 10 * nprof) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Fit interpolator
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[prof], nprof)
+
+	# Find the minimum and maximum
+	center = 1.
+	pmin = asieval (asi, 1.)
+	pmax = pmin
+	for (x=1; x<=nprof; x=x+.01) {
+	    p = asieval (asi, x)
+	    if (p < pmin)
+		pmin = p
+	    if (p > pmax) {
+		pmax = p
+		center = x
+	    }
+	}
+
+	# Normalize
+	pmax = pmax - pmin
+	do i = 0, nprof-1
+	    Memr[prof+i] = (Memr[prof+i] - pmin) / pmax
+
+	call asifit (asi, Memr[prof], nprof)
+
+	# Find the equal flux points
+	for (x=center; x>=1 && asieval (asi,x)>level; x=x-0.01)
+	    ;
+	width = x
+	for (x=center; x<=nprof && asieval (asi,x)>level; x=x+0.01)
+	    ;
+	width = (x - width - 0.01) / sqrt (2.)
+	center = center - lag - 1 + ishift
+
+	call sfree (sp)
+end
+
+
+# TWK_RMSMIN -- Tweak shift and scale to minimize the RMS.
+# This changes the shift and scale parameters but not the step.
+
+procedure twk_rmsmin (twk)
+
+pointer	twk		#I TWK data object
+
+int	i
+real	lastshift, lastscale
+errchk	twk_ashift, twk_ascale
+
+begin
+	lastshift = INDEFR
+	lastscale = INDEFR
+	do i = 1, 2 {
+	    if (TWK_SHIFT(twk) == lastshift && TWK_SCALE(twk) == lastscale)
+		break
+	    lastshift = TWK_SHIFT(twk)
+	    call twk_ashift (twk)
+
+	    if (TWK_SHIFT(twk) == lastshift && TWK_SCALE(twk) == lastscale)
+		break
+	    lastscale = TWK_SCALE(twk)
+	    call twk_ascale (twk)
+	}
+end
+
+
+# TWK_ASCALE -- Automatically determine scale by minimizing RMS.
+
+procedure twk_ascale (twk)
+
+pointer	twk		#I TWK data object
+
+int	i
+real	shift, oscale, dscale, lastscale, scale[3], rms[3]
+errchk	twk_spec
+
+begin
+	dscale = TWK_DSCALE(twk)
+	if (dscale == 0.)
+	    return
+	oscale = TWK_SCALE(twk)
+	shift = TWK_SHIFT(twk)
+	do i = 1, 3 {
+	    scale[i] = (1 - (i - 2) * dscale) * oscale
+	    call twk_spec (twk, shift, scale[i])
+	    rms[i] = TWK_RMS(twk)
+	    lastscale = TWK_SCALE(twk)
+	}
+	while (dscale > 0.01) {
+	    if (scale[1] / oscale < 0.5 || scale[3] / oscale > 2.) {
+		TWK_SCALE(twk) = oscale
+		break
+	    }
+	    if (rms[1] < rms[2]) {
+		scale[3] = scale[2]
+		scale[2] = scale[1]
+		scale[1] = (1 - dscale) * scale[2]
+		rms[3] = rms[2]
+		rms[2] = rms[1]
+		call twk_spec (twk, shift, scale[1])
+		rms[1] = TWK_RMS(twk)
+		lastscale = TWK_SCALE(twk)
+	    } else if (rms[3] < rms[2]) {
+		scale[1] = scale[2]
+		scale[2] = scale[3]
+		scale[3] = (1+dscale) * scale[2]
+		rms[1] = rms[2]
+		rms[2] = rms[3]
+		call twk_spec (twk, shift, scale[3])
+		rms[3] = TWK_RMS(twk)
+		lastscale = TWK_SCALE(twk)
+	    } else {
+		dscale = dscale / 2
+		scale[1] = (1-dscale) * scale[2]
+		scale[3] = (1+dscale) * scale[2]
+		call twk_spec (twk, shift, scale[1])
+		rms[1] = TWK_RMS(twk)
+		call twk_spec (twk, shift, scale[3])
+		rms[3] = TWK_RMS(twk)
+		lastscale = TWK_SCALE(twk)
+	    }
+	    if (rms[1] < rms[2])
+		TWK_SCALE(twk) = scale[1]
+	    else if (rms[3] < rms[2])
+		TWK_SCALE(twk) = scale[3]
+	    else
+		TWK_SCALE(twk) = scale[2]
+	}
+
+	if (TWK_SCALE(twk) != lastscale)
+	    call twk_spec (twk, shift, TWK_SCALE(twk))
+end
+
+
+# TWK_ASHIFT -- Automatically determine shift by minimizing RMS.
+
+procedure twk_ashift (twk)
+
+pointer	twk		#I TWK data object
+
+int	i
+real	scale, oshift, dshift, lastshift, shift[3], rms[3]
+errchk	twk_spec
+
+begin
+	dshift = TWK_DSHIFT(twk)
+	if (dshift == 0.)
+	    return
+	oshift = TWK_SHIFT(twk)
+	scale = TWK_SCALE(twk)
+	do i = 1, 3 {
+	    shift[i] = oshift + dshift * (i - 2)
+	    call twk_spec (twk, shift[i], scale)
+	    rms[i] = TWK_RMS(twk)
+	    lastshift = TWK_SHIFT(twk)
+	}
+	while (dshift > 0.01) {
+	    if (abs (oshift - shift[2]) > 2.) {
+		TWK_SHIFT(twk) = oshift
+		break
+	    }
+	    if (rms[1] < rms[2]) {
+		shift[3] = shift[2]
+		shift[2] = shift[1]
+		shift[1] = shift[2] - dshift
+		rms[3] = rms[2]
+		rms[2] = rms[1]
+		call twk_spec (twk, shift[1], scale)
+		rms[1] = TWK_RMS(twk)
+		lastshift = TWK_SHIFT(twk)
+	    } else if (rms[3] < rms[2]) {
+		shift[1] = shift[2]
+		shift[2] = shift[3]
+		shift[3] = shift[2] + dshift
+		rms[1] = rms[2]
+		rms[2] = rms[3]
+		call twk_spec (twk, shift[3], scale)
+		rms[3] = TWK_RMS(twk)
+		lastshift = TWK_SHIFT(twk)
+	    } else {
+		dshift = dshift / 2
+		shift[1] = shift[2] - dshift
+		call twk_spec (twk, shift[1], scale)
+		rms[1] = TWK_RMS(twk)
+		shift[3] = shift[2] + dshift
+		call twk_spec (twk, shift[3], scale)
+		rms[3] = TWK_RMS(twk)
+		lastshift = TWK_SHIFT(twk)
+	    }
+	    if (rms[1] < rms[2])
+		TWK_SHIFT(twk) = shift[1]
+	    else if (rms[3] < rms[2])
+		TWK_SHIFT(twk) = shift[3]
+	    else
+		TWK_SHIFT(twk) = shift[2]
+	}
+
+	if (TWK_SHIFT(twk) != lastshift)
+	    call twk_spec (twk, TWK_SHIFT(twk), scale)
+end
+
+
+# TWK_SPEC -- Evaluate the calibrated spectrum with the specified shift
+# and scale.  Compute the RMS within the sample regions.  Apply a
+# smoothing if necessary.  The output spectrum and shift and scale
+# used are returned in the TWK data structure.
+
+procedure twk_spec (twk, shift, scale)
+
+pointer	twk		#I TWK data object
+real	shift		#I Shift
+real	scale		#I Scale
+
+char	type
+pointer	sh, cal, asi, x, y, ycal, z, rg, temp
+int	i, j, k, n, ncal, nstat, box, rg_inrange()
+real	thresh, amratio, norm, sum1, sum2, xcal, xcal1, zval, asieval()
+double	shdr_wl()
+
+begin
+	# Dereference the data structures.
+	type = TWK_TYPE(twk)
+	sh = TWK_SH(twk)
+	cal = TWK_CAL(twk)
+	asi = IM(cal)
+	x = TWK_WAVE(twk)
+	y = SY(sh)
+	ycal = SY(cal)
+	z = TWK_SPEC(twk)
+	n = SN(sh)
+	ncal = SN(cal)
+	rg = TWK_RG(twk)
+	thresh = TWK_THRESH(twk)
+	amratio = AM(sh) / AM(cal)
+
+	# Evaluate the calibrated spectrum and the statistics.
+	norm = 0.
+	sum1 = 0.
+	sum2 = 0.
+	nstat = 0
+	do i = 0, n-1 {
+	    # Spectra
+	    xcal = shdr_wl (cal, Memd[x+i]) + shift
+	    xcal1 = max (1., min (real(ncal), xcal))
+	    #Memr[ycal+i] = asieval (asi, xcal1) ** (amratio * scale)
+	    #Memr[z+i] = Memr[y+i] / (Memr[ycal+i]
+	    Memr[ycal+i] = asieval (asi, xcal1)
+	    if (type == 'T') {
+		Memr[ycal+i] = max (thresh, Memr[ycal+i])
+		if (Memr[ycal+i] <= 0.)
+		    call error (1,
+	    "Calibration spectrum negative or zero (set threshold parameter)")
+		Memr[z+i] = Memr[y+i] / (Memr[ycal+i] ** (amratio * scale))
+	    } else
+		Memr[z+i] = Memr[y+i] - (Memr[ycal+i] * scale)
+	    norm = norm + Memr[z+i]
+	}
+
+	do i = 3, n-4 {
+	    # Statistics
+	    if (rg_inrange (rg, i+1) == NO)
+		next
+#	    if (xcal < 1 || xcal > ncal)
+#		next
+#	    zval = Memr[z+i]
+	    zval = Memr[z+i] - (Memr[z+i-3] + Memr[z+i+3]) / 2
+	    sum1 = sum1 + zval
+	    sum2 = sum2 + zval * zval
+	    nstat = nstat + 1
+	}
+
+	# Normalize
+	if (TWK_TYPE(twk) == 'T') {
+	    norm = norm / n
+	    if (norm > 0.) {
+		call adivkr (Memr[z], norm, Memr[z], n)
+		sum1 = sum1 / norm
+		sum2 = sum2 / norm / norm
+	    }
+	}
+
+	# RMS
+	if (nstat == 0)
+	    TWK_RMS(twk) = INDEF
+	else
+	    TWK_RMS(twk) = sqrt (nstat * sum2 - sum1**2) / nstat
+
+	TWK_SHIFT(twk) = shift
+	TWK_SCALE(twk) = scale
+
+	# Smooth
+	if (TWK_BOX(twk) > 1) {
+	    call malloc (temp, n, TY_REAL)
+	    box = TWK_BOX(twk)
+	    box = min (n, box)
+	    i = (1-box) / 2
+	    sum1 = 0.
+	    for (j=i; j<i+box; j=j+1)
+		sum1 = sum1 + Memr[z+max(0,j)]
+	    for (k=0; k<n; k=k+1) {
+		Memr[temp+k] = sum1
+		sum1 = sum1 - Memr[z+max(0,i)] + Memr[z+min(n-1,j)]
+		i = i + 1
+		j = j + 1
+	    }
+	    call adivkr (Memr[temp], real(box), Memr[z], n)
+	    call mfree (temp, TY_REAL)
+	}
+end
+
+
+# TWK_FIT -- Interactive fitting procedure.
+
+procedure twk_fit (twk)
+
+pointer	twk		#I TWK data object
+
+int	i, j, n, newgraph, newdata, key, wcs, pix, clgcur(), gt_geti()
+int	graph1, graph2
+real	wx, wy, shift[3], scale[3], dy, gt_getr()
+double	shdr_wl()
+pointer	sp, str, cmd, z[3]
+pointer	sh, gp, gt[2], gopen(), gt_init(), rg_xrangesd()
+errchk	twk_spec, twk_rmsmin
+
+begin
+	sh = TWK_SH(twk)
+	n = SN(sh)
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (z[1], n, TY_REAL)
+	call salloc (z[3], n, TY_REAL)
+	z[2] = TWK_SPEC(twk)
+
+	# Initialize the graphics.
+	gp = gopen ("stdgraph", NEW_FILE+AW_DEFER, STDGRAPH)
+	gt[1] = gt_init ()
+	call sprintf (Memc[str], SZ_LINE,
+	    "%s: spectrum = %s%s, calibration = %s%s")
+	    call pargstr (TWK_TYPE(twk))
+	    call pargstr (IMNAME(sh))
+	    call pargstr (IMSEC(sh))
+	    call pargstr (IMNAME(TWK_CAL(twk)))
+	    call pargstr (IMSEC(TWK_CAL(twk)))
+	call gt_sets (gt[1], GTTITLE, Memc[str])
+	if (UN_LABEL(UN(sh)) != EOS) {
+	    call gt_sets (gt[1], GTXLABEL, UN_LABEL(UN(sh)))
+	    call gt_sets (gt[1], GTXUNITS, UN_UNITS(UN(sh)))
+	} else
+	    call gt_sets (gt[1], GTXLABEL, "Pixels")
+	call gt_sets (gt[1], GTTYPE, "line")
+
+	gt[2] = gt_init ()
+	if (UN_LABEL(UN(sh)) != EOS) {
+	    call gt_sets (gt[2], GTXLABEL, UN_LABEL(UN(sh)))
+	    call gt_sets (gt[2], GTXUNITS, UN_UNITS(UN(sh)))
+	} else
+	    call gt_sets (gt[2], GTXLABEL, "Pixels")
+	call gt_sets (gt[2], GTTYPE, "line")
+
+	# Cursor loop.
+	if (TWK_DSCALE(twk) > 0.)
+	    graph1 = 'y'
+	else
+	    graph1 = 'x'
+	graph2 = GCAL
+	newdata = YES
+	key = 'r'
+	repeat {
+	    switch (key) {
+	    case ':':
+		call twk_colon (Memc[cmd], twk, gp, gt, wcs, newdata, newgraph)
+	    case '?':
+		call twk_colon ("help", twk, gp, gt, wcs, newdata, newgraph)
+	    case 'a':
+		call twk_rmsmin (twk)
+		newdata = YES
+	    case 'c':
+		if (graph2 == GCAL)
+		    graph2 = GNONE
+		else
+		    graph2 = GCAL
+		call gt_setr (gt[2], GTYMIN, INDEF)
+		call gt_setr (gt[2], GTYMAX, INDEF)
+		newgraph = YES
+	    case 'd':
+		if (graph2 == GDATA)
+		    graph2 = GNONE
+		else
+		    graph2 = GDATA
+		call gt_setr (gt[2], GTYMIN, INDEF)
+		call gt_setr (gt[2], GTYMAX, INDEF)
+		newgraph = YES
+	    case 'e':
+		switch (graph1) {
+		case 'x':
+		    if (TWK_DSHIFT(twk) == 0.)
+			TWK_DSHIFT(twk) = 0.1
+		    else
+			TWK_DSHIFT(twk) = 2 * TWK_DSHIFT(twk)
+		case 'y':
+		    if (TWK_DSCALE(twk) == 0.)
+			TWK_DSCALE(twk) = 0.1
+		    else
+			TWK_DSCALE(twk) = min (0.99, 2 * TWK_DSCALE(twk))
+		}
+		newdata = YES
+	    case 'q':
+		break
+	    case 'r':
+		newgraph = YES
+	    case 's':
+		dy = wx
+		call printf ("s to add sample region or n for new regions:\n")
+	        if (clgcur ("cursor",wx,wy,wcs,key,Memc[cmd],SZ_LINE) == EOF)
+		    break
+		switch (key) {
+		case 'n':
+		    call rg_free (TWK_RG(twk))
+		    call sprintf (TWK_SAMPLE(twk), TWK_SLEN, "%g:%g")
+			call pargr (dy)
+			call pargr (wx)
+		    TWK_RG(twk) = rg_xrangesd (TWK_SAMPLE(twk),
+			Memd[TWK_WAVE(twk)], SN(sh))
+		    newdata = YES
+		case 's':
+		    call rg_free (TWK_RG(twk))
+		    if (TWK_SAMPLE(twk) == '*') {
+			call sprintf (TWK_SAMPLE(twk), TWK_SLEN, "%g:%g")
+			    call pargr (dy)
+			    call pargr (wx)
+		    } else {
+			call sprintf (Memc[cmd], SZ_LINE, ",%g:%g")
+			    call pargr (dy)
+			    call pargr (wx)
+			call strcat (Memc[cmd], TWK_SAMPLE(twk), TWK_SLEN)
+		    }
+		    TWK_RG(twk) = rg_xrangesd (TWK_SAMPLE(twk),
+			Memd[TWK_WAVE(twk)], SN(sh))
+		    newdata = YES
+		}
+	    case 'w':
+		call gt_window (gt[wcs], gp, "cursor", newgraph)
+		if (wcs == 1) {
+		    call gt_setr (gt[2], GTXMIN, gt_getr (gt[1], GTXMIN))
+		    call gt_setr (gt[2], GTXMAX, gt_getr (gt[1], GTXMAX))
+		    call gt_seti (gt[2], GTXFLIP, gt_geti (gt[1], GTXFLIP))
+		} else {
+		    call gt_setr (gt[1], GTXMIN, gt_getr (gt[2], GTXMIN))
+		    call gt_setr (gt[1], GTXMAX, gt_getr (gt[2], GTXMAX))
+		    call gt_seti (gt[1], GTXFLIP, gt_geti (gt[2], GTXFLIP))
+		}
+	    case 'x', 'y':
+		pix = max (1, min (n, nint (shdr_wl (sh, double (wx))))) - 1
+		j = 1
+		dy = abs (wy - Memr[z[j]+pix])
+		do i = 2, 3
+		    if (abs (wy - Memr[z[i]+pix]) < dy) {
+			j = i
+			dy = abs (wy - Memr[z[j]+pix])
+		    }
+		TWK_SHIFT(twk) = shift[j]
+		TWK_SCALE(twk) = scale[j]
+		if (j == 2 && graph1 == key) {
+		    if (key == 'x')
+			TWK_DSHIFT(twk) = TWK_DSHIFT(twk) / 2.
+		    else if (key == 'y')
+			TWK_DSCALE(twk) = TWK_DSCALE(twk) / 2.
+		}
+		if (TWK_DSHIFT(twk) == 0.)
+		    graph1 = 'y'
+		else if (TWK_DSHIFT(twk) == 0.)
+		    graph1 = 'x'
+		else
+		    graph1 = key
+		newdata = YES
+	    default:
+		call printf ("\007\n")
+	    }
+
+	    if (newdata == YES) {
+		if (graph1 == 'x') {
+		    shift[1] = TWK_SHIFT(twk) - TWK_DSHIFT(twk)
+		    shift[2] = TWK_SHIFT(twk)
+		    shift[3] = TWK_SHIFT(twk) + TWK_DSHIFT(twk)
+		    scale[1] = TWK_SCALE(twk)
+		    scale[2] = TWK_SCALE(twk)
+		    scale[3] = TWK_SCALE(twk)
+		} else if (graph1 == 'y') {
+		    shift[1] = TWK_SHIFT(twk)
+		    shift[2] = TWK_SHIFT(twk)
+		    shift[3] = TWK_SHIFT(twk)
+		    scale[1] = TWK_SCALE(twk) * (1 - TWK_DSCALE(twk))
+		    scale[2] = TWK_SCALE(twk)
+		    scale[3] = TWK_SCALE(twk) * (1 + TWK_DSCALE(twk))
+		}
+		iferr {
+		    TWK_SPEC(twk) = z[1]
+		    call twk_spec (twk, shift[1], scale[1])
+		    call asubkr (Memr[z[1]], TWK_OFFSET(twk), Memr[z[1]], n)
+		    TWK_SPEC(twk) = z[3]
+		    call twk_spec (twk, shift[3], scale[3])
+		    call aaddkr (Memr[z[3]], TWK_OFFSET(twk), Memr[z[3]], n)
+		    TWK_SPEC(twk) = z[2]
+		    call twk_spec (twk, shift[2], scale[2])
+		    newdata = NO
+		} then {
+		    TWK_SPEC(twk) = z[2]
+		    call gt_free (gt[1])
+		    call gt_free (gt[2])
+		    call gclose (gp)
+		    call sfree (sp)
+		    call erract (EA_ERROR)
+		}
+
+		call sprintf (Memc[str], SZ_LINE, "scale = %5g")
+		    call pargr (TWK_SCALE(twk))
+		if (graph1 == 'y') {
+		    call sprintf (Memc[cmd], SZ_LINE, " +/- %6g")
+			call pargr (TWK_DSCALE(twk))
+		    call strcat (Memc[cmd], Memc[str], SZ_LINE)
+		}
+		call sprintf (Memc[cmd], SZ_LINE, ", shift = %.2f")
+		    call pargr (TWK_SHIFT(twk))
+		call strcat (Memc[cmd], Memc[str], SZ_LINE)
+		if (graph1 == 'x') {
+		    call sprintf (Memc[cmd], SZ_LINE, " +/- %.2f")
+			call pargr (TWK_DSHIFT(twk))
+		    call strcat (Memc[cmd], Memc[str], SZ_LINE)
+		}
+		call sprintf (Memc[cmd], SZ_LINE, ", offset = %3g")
+		    call pargr (TWK_OFFSET(twk))
+		call strcat (Memc[cmd], Memc[str], SZ_LINE)
+		call sprintf (Memc[cmd], SZ_LINE, ", rms = %.3g")
+		    call pargr (TWK_RMS(twk))
+		call strcat (Memc[cmd], Memc[str], SZ_LINE)
+		call gt_sets (gt[1], GTCOMMENTS, Memc[str])
+
+		newgraph = YES
+	    }
+
+	    if (newgraph == YES) {
+		call twk_graph (twk, gp, gt, graph1, graph2, Memr[SX(sh)],
+		    Memr[z[1]], Memr[z[2]], Memr[z[3]], SN(sh))
+		newgraph = NO
+	    }
+	} until (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF)
+
+	call gt_free (gt[1])
+	call gt_free (gt[2])
+	call gclose (gp)
+	call sfree (sp)
+end
+
+
+# TWK_GRAPH -- Make the interactive graph.
+
+procedure twk_graph (twk, gp, gt, graph1, graph2, x, y1, y2, y3, npts)
+
+pointer	twk		#I TWK data object
+pointer	gp		#I GIO pointer
+pointer	gt[2]		#I GTOOLS pointer
+int	graph1		#I Type for graph 1
+int	graph2		#I Type for graph 2
+real	x[npts]		#I X values
+real	y1[npts]	#I Y values
+real	y2[npts]	#I Y values
+real	y3[npts]	#I Y values
+int	npts		#I Number of values
+
+real	xmin, xmax, ymin, ymax, xmin1, xmax1, ymin1, ymax1
+
+begin
+	call gclear (gp)
+	call gseti (gp, G_WCS, 1)
+	if (graph2 != GNONE) {
+	    call gsview (gp, 0.1, 0.9, 0.4, 0.9)
+	    call gseti (gp, G_XLABELTICKS, NO)
+	    call gt_seti (gt[1], GTDRAWXLABELS, NO)
+	}
+	call gt_ascale (gp, gt[1], x, y1, npts)
+	call ggwind (gp, xmin, xmax, ymin, ymax)
+	call gt_ascale (gp, gt[1], x, y2, npts)
+	call ggwind (gp, xmin1, xmax1, ymin1, ymax1)
+	xmin = min (xmin, xmin1)
+	xmax = max (xmax, xmax1)
+	ymin = min (ymin, ymin1)
+	ymax = max (ymax, ymax1)
+	call gt_ascale (gp, gt[1], x, y3, npts)
+	call ggwind (gp, xmin1, xmax1, ymin1, ymax1)
+	xmin = min (xmin, xmin1)
+	xmax = max (xmax, xmax1)
+	ymin = min (ymin, ymin1)
+	ymax = max (ymax, ymax1)
+	call gswind (gp, xmin, xmax, ymin, ymax)
+	call gt_swind (gp, gt[1])
+	call gt_labax (gp, gt[1])
+
+	call gt_plot (gp, gt[1], x, y1, npts)
+	call gt_plot (gp, gt[1], x, y2, npts)
+	call gt_plot (gp, gt[1], x, y3, npts)
+	call rg_gxmarkr (gp, TWK_SAMPLE(twk), x, npts, 1)
+
+	switch (graph2) {
+	case GCAL:
+	    call gseti (gp, G_WCS, 2)
+	    call gseti (gp, G_YNMAJOR, 3)
+	    call gseti (gp, G_XLABELTICKS, YES)
+	    call gt_seti (gt[2], GTDRAWXLABELS, YES)
+	    call gt_seti (gt[2], GTDRAWTITLE, NO)
+	    call gt_ascale (gp, gt[2], x, Memr[SY(TWK_CAL(twk))], npts)
+	    call gsview (gp, 0.1, 0.9, 0.1, 0.4)
+	    call gswind (gp, xmin, xmax, INDEF, INDEF)
+	    call gt_swind (gp, gt[2])
+	    call gt_labax (gp, gt[2])
+	    call gt_plot (gp, gt[2], x, Memr[SY(TWK_CAL(twk))], npts)
+	case GDATA:
+	    call gseti (gp, G_WCS, 2)
+	    call gseti (gp, G_YNMAJOR, 3)
+	    call gseti (gp, G_XLABELTICKS, YES)
+	    call gt_seti (gt[2], GTDRAWXLABELS, YES)
+	    call gt_seti (gt[2], GTDRAWTITLE, NO)
+	    call gt_ascale (gp, gt[2], x, Memr[SY(TWK_SH(twk))], npts)
+	    call gsview (gp, 0.1, 0.9, 0.1, 0.4)
+	    call gswind (gp, xmin, xmax, INDEF, INDEF)
+	    call gt_swind (gp, gt[2])
+	    call gt_labax (gp, gt[2])
+	    call gt_plot (gp, gt[2], x, Memr[SY(TWK_SH(twk))], npts)
+	}
+end
+
+
+# List of colon commands.
+define	CMDS	"|help|shift|scale|dshift|dscale|offset|smooth|sample|"
+define	HELP	1	# Print help
+define	SHIFT	2	# Shift
+define	SCALE	3	# Scale factor
+define	DSHIFT	4	# Shift intervale
+define	DSCALE	5	# Scale factor interval
+define	OFFSET	6	# Offset
+define	SMOOTH	7	# Boxcar smoothing
+define	SAMPLE	8	# Sample
+
+# TWK_COLON -- Act on colon commands.
+
+procedure twk_colon (command, twk, gp, gt, wcs, newdata, newgraph)
+
+char	command[ARB]		#I Colon command
+pointer	twk			#I TWK data object
+pointer	gp			#I GIO
+pointer	gt[2]			#I GTOOLS
+int	wcs			#I WCS
+int	newdata			#O New data flag
+int	newgraph		#O New graph flag
+
+int	ncmd, ival, gt_geti(), strdic(), nscan()
+real	rval, gt_getr()
+pointer	sp, cmd, rg, rg_xrangesd()
+
+begin
+	# Check for GTOOLS command.
+	if (command[1] == '/') {
+	    call gt_colon (command, gp, gt[wcs], newgraph)
+	    if (wcs == 1) {
+		call gt_setr (gt[2], GTXMIN, gt_getr (gt[1], GTXMIN))
+		call gt_setr (gt[2], GTXMAX, gt_getr (gt[1], GTXMAX))
+		call gt_seti (gt[2], GTXFLIP, gt_geti (gt[1], GTXFLIP))
+	    } else {
+		call gt_setr (gt[1], GTXMIN, gt_getr (gt[2], GTXMIN))
+		call gt_setr (gt[1], GTXMAX, gt_getr (gt[2], GTXMAX))
+		call gt_seti (gt[1], GTXFLIP, gt_geti (gt[2], GTXFLIP))
+	    }
+	    return
+	}
+
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Scan the command string.
+	call sscan (command)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS)
+
+	# Execute command.
+	switch (ncmd) {
+	case HELP:
+	    call gpagefile (gp, TWK_HELP(twk), TWK_TYPE(twk))
+	case SHIFT:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("shift %g\n")
+		    call pargr (TWK_SHIFT(twk))
+	    } else {
+		TWK_SHIFT(twk) = rval
+		newdata = YES
+	    }
+	case SCALE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("scale %g\n")
+		    call pargr (TWK_SCALE(twk))
+	    } else {
+		TWK_SCALE(twk) = rval
+		newdata = YES
+	    }
+	case DSHIFT:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("dshift %g\n")
+		    call pargr (TWK_DSHIFT(twk))
+	    } else {
+		TWK_DSHIFT(twk) = rval
+		newdata = YES
+	    }
+	case DSCALE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("dscale %g\n")
+		    call pargr (TWK_DSCALE(twk))
+	    } else {
+		if (rval < 0. || rval >= 1.)
+		    call printf ("dscale must be between zero and one\007\n")
+		else {
+		    TWK_DSCALE(twk) = rval
+		    newdata = YES
+		}
+	    }
+	case OFFSET:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("offset %g\n")
+		    call pargr (TWK_OFFSET(twk))
+	    } else if (rval != TWK_OFFSET(twk)) {
+		TWK_OFFSET(twk) = rval
+		call gt_setr (gt[1], GTYMIN, INDEF)
+		call gt_setr (gt[1], GTYMAX, INDEF)
+		newdata = YES
+	    }
+	case SMOOTH:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("smooth %d\n")
+		    call pargi (TWK_BOX(twk))
+	    } else {
+		ival = max (1, ival)
+		if (ival != TWK_BOX(twk)) {
+		    TWK_BOX(twk) = max (1, ival)
+		    newdata = YES
+		}
+	    }
+	case SAMPLE:
+	    call gargstr (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS) {
+		call printf ("sample %s\n")
+		    call pargstr (TWK_SAMPLE(twk))
+	    } else {
+		ifnoerr (rg = rg_xrangesd (Memc[cmd+1], Memd[TWK_WAVE(twk)],
+		    SN(TWK_SH(twk)))) {
+		    call rg_free (TWK_RG(twk))
+		    call strcpy (Memc[cmd+1], TWK_SAMPLE(twk), TWK_SLEN)
+		    TWK_RG(twk) = rg
+		    newdata = YES
+		} else
+		    call erract (EA_WARN)
+	    }
+	default:
+	    call printf ("\007\n")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/onedspec/telluric.par b/noao/onedspec/telluric.par
new file mode 100644
index 00000000..80e5c55a
--- /dev/null
+++ b/noao/onedspec/telluric.par
@@ -0,0 +1,21 @@
+# TELLURIC
+
+input,s,a,,,,List of input spectra to correct
+output,s,a,,,,List of output corrected spectra
+cal,s,a,,,,List of telluric calibration spectra
+ignoreaps,b,h,no,,,Ignore aperture numbers in calibration spectra?
+xcorr,b,h,yes,,,Cross correlate for shift?
+tweakrms,b,h,yes,,,Tweak to minimize RMS?
+interactive,b,h,yes,,,Interactive tweaking?
+sample,s,h,"*",,,Sample ranges
+threshold,r,h,0.,,,Threshold for calibration
+lag,i,h,10,0,,Cross correlation lag (pixels)
+shift,r,h,0.,,,Initial shift of calibration spectrum (pixels)
+scale,r,h,1.,1e-10,,Initial scale factor multiplying airmass ratio
+dshift,r,h,1.,0.,,Initial shift search step
+dscale,r,h,0.2,0.,0.99,Initial scale factor search step
+offset,r,h,1.,0.,,Initial offset for graphs
+smooth,i,h,1,1,,Smoothing box for graphs
+cursor,*gcur,h,"",,,Cursor input
+airmass,r,q,,1.,,Airmass
+answer,s,q,"yes","no|yes|NO|YES",,Search interactively?
diff --git a/noao/onedspec/wspectext.cl b/noao/onedspec/wspectext.cl
new file mode 100644
index 00000000..9a7e1571
--- /dev/null
+++ b/noao/onedspec/wspectext.cl
@@ -0,0 +1,47 @@
+# WSPECTEXT -- Write a 1D image spectrum as an ascii text file.
+# This simply uses WTEXTIMAGE to write the header is selected and
+# formats the wavelength/flux data using LISTPIX.
+
+procedure wspectext (input, output)
+
+string	input			{prompt="Input list of image spectra"}
+string	output			{prompt="Output list of text spectra"}
+bool	header = yes		{prompt="Include header?"}
+string	wformat = ""		{prompt="Wavelength format"}
+
+begin
+    int		ndim
+    string	specin, specout, spec
+
+    specin = mktemp ("tmp$iraf")
+    specout = mktemp ("tmp$iraf")
+    spec = mktemp ("tmp$iraf")
+
+    # Expand the input and output image templates and include naxis.
+    hselect (input, "$I,naxis", yes, > specin)
+    sections (output, option="fullname", > specout)
+    join (specin, specout, output=spec, delim=" ", shortest=yes, verbose=yes)
+    delete (specin, verify=no)
+    delete (specout, verify=no)
+
+    # For each input spectrum check the dimensionality.  Extract the header
+    # with WTEXTIMAGE if desired and then use LISTPIX to extract the
+    # wavelengths and fluxes.
+
+    list = spec
+    while (fscan (list, specin, ndim, specout) != EOF) {
+	if (ndim != 1) {
+	    print ("WARNING: "//specin//" is not one dimensional")
+	    next
+	}
+	if (header) {
+	    wtextimage (specin, specout, header=yes, pixels=no, format="",
+		maxlinelen=80)
+	    listpixels (specin, wcs="world", formats=wformat, verbose=no,
+		>> specout)
+	} else
+	    listpixels (specin, wcs="world", formats=wformat, verbose=no,
+		> specout)
+    }
+    list=""; delete (spec, verify=no)
+end
diff --git a/noao/onedspec/x_onedspec.x b/noao/onedspec/x_onedspec.x
new file mode 100644
index 00000000..4db13865
--- /dev/null
+++ b/noao/onedspec/x_onedspec.x
@@ -0,0 +1,43 @@
+task	addsets		= t_addsets,
+	autoidentify	= t_autoidentify,
+	bswitch		= t_bswitch,
+	calibrate	= t_calibrate,
+	coefs		= t_coefs,
+	coincor		= t_coincor,
+	continuum	= t_sfit,
+	deredden	= t_deredden,
+	dispcor		= t_dispcor,
+	disptrans	= t_disptrans,
+	dopcor		= t_dopcor,
+	ecidentify	= t_ecidentify,
+	ecreidentify	= t_ecreidentify,
+	fitprofs	= t_fitprofs,
+	flatfit		= t_flatfit,
+	flatdiv		= t_flatdiv,
+	identify	= t_identify,
+	lcalib		= t_lcalib,
+	mkspec		= t_mkspec,
+	names		= t_names,
+	odcombine	= t_odcombine,
+	refspectra	= t_refspectra,
+	reidentify	= t_reidentify,
+	rstext		= t_rstext,
+	sapertures	= t_sapertures,
+	sbands		= t_sbands,
+	scoords		= t_scoords,
+	sensfunc	= t_sensfunc,
+	sinterp		= t_sinterp,
+	sfit		= t_sfit,
+	sflip		= t_sflip,
+	slist		= t_slist,
+	slist1d		= t_slist1d,
+	specplot	= t_specplot,
+	specshift	= t_sshift,
+	splot		= splot,
+	sarith		= t_sarith,
+	skytweak	= t_skytweak,
+	standard	= t_standard,
+	subsets		= t_subsets,
+	sums		= t_sums,
+	telluric	= t_telluric,
+	widstape	= t_widstape