Repatch (from linux) of OSX IRAF

21 files changed, 1929 insertions, 0 deletions

diff --git a/noao/imred/src/doslit/Revisions b/noao/imred/src/doslit/Revisions
new file mode 100644
index 00000000..5e219369
--- /dev/null
+++ b/noao/imred/src/doslit/Revisions
@@ -0,0 +1,129 @@
+.help revisions Dec94 noao.imred.src.doslit
+.nf
+
+=======
+V2.12.3
+=======
+
+doslit$sbatch.cl
+doslit$sproc.cl
+    Error messages now hint to check imtype setting.
+	(4/15/05, Valdes)
+
+========
+V2.12.2b
+========
+
+=======
+V2.12.1
+=======
+
+doslit$sproc.cl
+doslit$sbatch.cl
+doslit$sarcrefs.cl
+doslit$sfluxcal.cl
+    Added a flpr after dispcor to workaround a bug with the FITS kernel
+    header caching.  (6/24/02, Valdes)
+
+=====
+V2.12
+=====
+
+doslit$sproc.cl
+    Modified code to eliminate goto.  This is for use with pyraf.
+    (11/21/00, Valdes)
+
+========
+V2.11.3a
+========
+
+doslit$sarcrefs.cl
+     The test for INDEF values on CRVAL/CDELT did not work correctly.
+     (9/24/99, Valdes)
+
+doslit$doslit.cl
+doslit$doslit.par
+doslit$sarcrefs.cl
+doslit$sarcrefs.par
+doslit$sproc.cl
+doslit$sproc.par
+     No change made though dates were modified.  (9/24/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+doslit$sarcrefs.cl
+    The test on CRVAL and CDELT would not work with header keywords.
+    (9/22/98, Valdes)
+
+doslit$sarcrefs.cl
+doslit$sbatch.cl
+doslit$sdoarcs.cl
+doslit$sfluxcal.cl
+doslit$sgetspec.cl
+doslit$slistonly.cl
+doslit$sproc.cl
+    Any additional qualifiers in the imtype string are stripped.
+    (8/14/97, Valdes)
+
+doslit$sgetspec.cl
+    Added the field parameter to the RENAME call.  (8/12/97, Valdes)
+
+=========
+V2.11Beta
+=========
+
+doslit$sarcrefs.cl
+    If both crval and cdelt are INDEF then the autoidentify option is not
+    used.  (5/2/97, Valdes)
+
+doslit$apslitproc.par
+    Made changes for the new aperture selection option.  (9/5/96, Valdes)
+
+doslit.cl
+doslit.par
+sproc.cl
+sproc.par
+sarcrefs.cl
+sarcrefs.par
+sparams.par
+    Modified to use autoidentify.  (4/5/96, Valdes)
+
+doslit$sproc.cl
+doslit$sproc.par
+    Added missing parameter declaration.  (5/25/95, Valdes)
+
+doslit$sgetspec.cl
+doslit$doslit.cl
+    The arc table will now be checked for arc spectra. (5/1/95, Valdes)
+
+doslit$sparams.par
+doslit$sdoarcs.cl
+doslit$sarcrefs.cl
+    Added "threshold" as a user parameter.  (1/16/95, Valdes)
+
+doslit$sproc.cl
+doslit$sbatch.cl
+doslit$sfluxcal.cl
+doslit$sproc.par
+doslit$sbatch.par
+doslit$sfluxcal.par
+    SETAIRMASS and SETJD are only called if the required keywords are
+    present.  Errors from missing airmass or JD are then reported from
+    the task that actually uses them.  (12/31/94, Valdes)
+
+doslit$sgetspec.cl
+doslit$sgetspec.par
+    Added warning and query for missing CCDPROC keyword.  (12/31/94, Valdes)
+
+doslit$sproc.cl
+doslit$sarcrefs.cl
+    1.	If the object apertures used for reference arc contain more than
+	one aperture then after extraction all apertures but the first
+	are removed.  This will be one reference arc aperture for the
+	master dispersion solution.
+    2.  Set ignoreaps=yes so that any new apertures added to the objects
+	will inherit the wavelength scale of the reference arc.
+    (10/12/94, Valdes)
+.endhelp
diff --git a/noao/imred/src/doslit/apslitproc.par b/noao/imred/src/doslit/apslitproc.par
new file mode 100644
index 00000000..bab5b58e
--- /dev/null
+++ b/noao/imred/src/doslit/apslitproc.par
@@ -0,0 +1,145 @@
+# APSCRIPT
+
+input,s,a,,,,List of input images
+output,s,h,"",,,List of output spectra
+apertures,s,h,"",,,Apertures
+scatter,s,h,"",,,List of scattered light images (optional)
+references,s,h,"",,,List of aperture reference images
+profiles,s,h,"",,,"List of aperture profile images
+"
+interactive,b,h,yes,,,Run task interactively?
+find,b,h,yes,,,Find apertures?
+recenter,b,h,yes,,,Recenter apertures?
+resize,b,h,yes,,,Resize apertures?
+edit,b,h,yes,,,Edit apertures?
+trace,b,h,yes,,,Trace apertures?
+fittrace,b,h,yes,,,Fit the traced points interactively?
+extract,b,h,yes,,,Extract spectra?
+review,b,h,yes,,,Review extractions?
+subtract,b,h,yes,,,Subtract scattered light?
+smooth,b,h,yes,,,Smooth scattered light along the dispersion?
+fitscatter,b,h,yes,,,Fit scattered light interactively?
+fitsmooth,b,h,yes,,,"Smooth the scattered light interactively?
+"
+line,i,h,)sparams.line,,,>sparams.line
+nsum,i,h,)sparams.nsum,,,>sparams.nsum
+buffer,r,h,)sparams.buffer,,,">sparams.buffer
+
+# OUTPUT PARAMETERS
+"
+format,s,h,"multispec",,,Extracted spectra format
+extras,b,h,)sparams.extras,,,"Extract sky, sigma, etc.?"
+dbwrite,s,h,"YES",,,Write to database?
+initialize,b,h,no,,,Initialize answers?
+verbose,b,h,)_.verbose,,,"Verbose output?
+
+# DEFAULT APERTURE PARAMETERS
+"
+lower,r,h,)sparams.lower,,,>sparams.lower
+upper,r,h,)sparams.upper,,,>sparams.upper
+apidtable,s,h,"",,,"Aperture ID table (optional)
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)sparams.b_function,,,>sparams.b_function
+b_order,i,h,)sparams.b_order,,,>sparams.b_order
+b_sample,s,h,)sparams.b_sample,,,>sparams.b_sample
+b_naverage,i,h,)sparams.b_naverage,,,>sparams.b_naverage
+b_niterate,i,h,)sparams.b_niterate,,,>sparams.b_niterate
+b_low_reject,r,h,)sparams.b_low,,,>sparams.b_low
+b_high_reject,r,h,)sparams.b_high,,,>sparams.b_high
+b_grow,r,h,0.,0.,,"Background rejection growing radius
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,,,,Profile centering width
+radius,r,h,,,,Profile centering radius
+threshold,r,h,10.,0.,,"Detection threshold for profile centering
+
+# AUTOMATIC FINDING AND ORDERING PARAMETERS
+"
+nfind,i,h,1,,,Number of apertures to be found automatically
+minsep,r,h,1.,,,Minimum separation between spectra
+maxsep,r,h,100000.,,,Maximum separation between spectra
+order,s,h,"increasing",,,"Order of apertures
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,"",,,Apertures for recentering calculation
+npeaks,r,h,INDEF,,,Select brightest peaks
+shift,b,h,yes,,,"Use average shift instead of recentering?
+
+# RESIZING PARAMETERS
+"
+llimit,r,h,INDEF,,,Lower aperture limit relative to center
+ulimit,r,h,INDEF,,,Upper aperture limit relative to center
+ylevel,r,h,)sparams.ylevel,,,>sparams.ylevel
+peak,b,h,yes,,,Is ylevel a fraction of the peak?
+bkg,b,h,yes,,,Subtract background in automatic width?
+r_grow,r,h,0.,,,Grow limits by this factor
+avglimits,b,h,no,,,"Average limits over all apertures?
+
+# EDITING PARAMETERS
+"
+e_output,s,q,,,,Output spectra rootname
+e_profiles,s,q,,,,"Profile reference image
+
+# TRACING PARAMETERS
+"
+t_nsum,i,h,)sparams.nsum,,,>sparams.nsum
+t_step,i,h,)sparams.t_step,,,>sparams.t_step
+t_nlost,i,h,3,1,,Number of consecutive times profile is lost before quitting
+t_width,r,h,)sparams.width,,,>sparams.width
+t_function,s,h,)sparams.t_function,,,>sparams.t_function
+t_sample,s,h,"*",,,Trace sample regions
+t_order,i,h,)sparams.t_order,,,>sparams.t_order
+t_naverage,i,h,1,,,Trace average or median
+t_niterate,i,h,)sparams.t_niterate,,,>sparams.t_niterate
+t_low_reject,r,h,)sparams.t_low,,,>sparams.t_low
+t_high_reject,r,h,)sparams.t_high,,,>sparams.t_high
+t_grow,r,h,0.,0.,,"Trace rejection growing radius
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,)sparams.background,,,>sparams.background
+skybox,i,h,1,,,Box car smoothing length for sky
+weights,s,h,)sparams.weights,,,>sparams.weights
+pfit,s,h,)sparams.pfit,,,>sparams.pfit
+clean,b,h,no,,,Detect and replace bad pixels?
+nclean,r,h,0.5,,,Maximum number of pixels to clean
+niterate,i,h,5,0,,Number of profile fitting iterations
+saturation,r,h,INDEF,,,Saturation level
+readnoise,s,h,,,,Read out noise sigma (photons)
+gain,s,h,,,,Photon gain (photons/data number)
+lsigma,r,h,)sparams.lsigma,,,>sparams.lsigma
+usigma,r,h,)sparams.usigma,,,>sparams.usigma
+polysep,r,h,0.95,0.1,0.95,Marsh algorithm polynomial spacing
+polyorder,i,h,10,1,,Marsh algorithm polynomial order
+nsubaps,i,h,1,1,,"Number of subapertures per aperture
+
+# ANSWER PARAMETERS
+"
+ansclobber,s,h,"NO",,," "
+ansclobber1,s,h,"NO",,," "
+ansdbwrite,s,h,"YES",,," "
+ansdbwrite1,s,h,"NO",,," "
+ansedit,s,h,"NO",,," "
+ansextract,s,h,"NO",,," "
+ansfind,s,h,"NO",,," "
+ansfit,s,h,"NO",,," "
+ansfitscatter,s,h,"NO",,," "
+ansfitsmooth,s,h,"NO",,," "
+ansfitspec,s,h,"NO",,," "
+ansfitspec1,s,h,"NO",,," "
+ansfittrace,s,h,"NO",,," "
+ansfittrace1,s,h,"NO",,," "
+ansflat,s,h,"NO",,," "
+ansnorm,s,h,"NO",,," "
+ansrecenter,s,h,"NO",,," "
+ansresize,s,h,"NO",,," "
+ansreview,s,h,"NO",,," "
+ansreview1,s,h,"NO",,," "
+ansscat,s,h,"NO",,," "
+ansskyextract,s,h,"NO",,," "
+anssmooth,s,h,"NO",,," "
+anstrace,s,h,"NO",,," "
diff --git a/noao/imred/src/doslit/demologfile b/noao/imred/src/doslit/demologfile
new file mode 100644
index 00000000..a5a245c2
--- /dev/null
+++ b/noao/imred/src/doslit/demologfile
@@ -0,0 +1 @@
+Define object apertures
diff --git a/noao/imred/src/doslit/doslit.cl b/noao/imred/src/doslit/doslit.cl
new file mode 100644
index 00000000..56458435
--- /dev/null
+++ b/noao/imred/src/doslit/doslit.cl
@@ -0,0 +1,64 @@
+# DOSLIT -- Process slit spectra from 2D to wavelength calibrated 1D.
+#
+# The task SPROC does all of the interactive work and SBATCH does the
+# background work.  This procedure is organized this way to minimize the
+# dictionary space when the background task is submitted.
+
+procedure doslit (objects)
+
+string	objects = ""		{prompt="List of object spectra"}
+
+string	arcs = ""		{prompt="List of arc spectra"}
+file	arctable		{prompt="Arc assignment table (optional)"}
+string	standards = ""		{prompt="List of standard star spectra\n"}
+
+string	readnoise = "rdnoise"	{prompt="Read out noise sigma (photons)"}
+string	gain = "gain"		{prompt="Photon gain (photons/data number)"}
+real	datamax = INDEF		{prompt="Max data value / cosmic ray threshold"}
+real	width = 5.		{prompt="Width of profiles (pixels)"}
+string	crval = "INDEF"		{prompt="Approximate wavelength"}
+string	cdelt = "INDEF"		{prompt="Approximate dispersion\n"}
+
+bool	dispcor = yes		{prompt="Dispersion correct spectra?"}
+bool	extcor = no		{prompt="Extinction correct spectra?"}
+bool	fluxcal = no		{prompt="Flux calibrate spectra?"}
+bool	resize = no		{prompt="Automatically resize apertures?"}
+bool	clean = no		{prompt="Detect and replace bad pixels?"}
+bool	splot = no		{prompt="Plot the final spectrum?"}
+bool	redo = no		{prompt="Redo operations if previously done?"}
+bool	update = no		{prompt="Update spectra if cal data changes?"}
+bool	quicklook = no		{prompt="Minimally interactive quick-look?"}
+bool	batch = no		{prompt="Extract objects in batch?"}
+bool	listonly = no		{prompt="List steps but don't process?\n"}
+
+pset	sparams = ""		{prompt="Algorithm parameters"}
+
+begin
+	file	obj, arc, std
+
+	# Expand image lists
+	obj = mktemp ("tmp$iraf") 
+	arc = mktemp ("tmp$iraf")
+	std = mktemp ("tmp$iraf")
+	sgetspec (objects, arcs, arctable, standards, obj, arc, std)
+
+	apslitproc.readnoise = readnoise
+	apslitproc.gain = gain
+	apslitproc.width = width
+	apslitproc.t_width = width
+	apslitproc.radius = width
+	apslitproc.clean = clean
+	sproc.datamax = datamax
+
+	sproc (obj, arc, arctable, std, crval, cdelt, dispcor, extcor, fluxcal,
+	    resize, clean, splot, redo, update, quicklook, batch, listonly)
+	delete (std, verify=no)
+
+	if (sproc.dobatch) {
+	    print ("-- Do remaining spectra as a batch job --")
+	    print ("sbatch&batch") | cl
+	} else {
+	    delete (obj, verify=no)
+	    delete (arc, verify=no)
+	}
+end
diff --git a/noao/imred/src/doslit/doslit.par b/noao/imred/src/doslit/doslit.par
new file mode 100644
index 00000000..6e4119f6
--- /dev/null
+++ b/noao/imred/src/doslit/doslit.par
@@ -0,0 +1,26 @@
+objects,s,a,"",,,"List of object spectra"
+arcs,s,h,"",,,"List of arc spectra"
+arctable,f,h,"",,,"Arc assignment table (optional)"
+standards,s,h,"",,,"List of standard star spectra
+"
+readnoise,s,h,"rdnoise",,,"Read out noise sigma (photons)"
+gain,s,h,"gain",,,"Photon gain (photons/data number)"
+datamax,r,h,INDEF,,,"Max data value / cosmic ray threshold"
+width,r,h,5.,,,"Width of profiles (pixels)"
+crval,s,h,"INDEF",,,"Approximate wavelength"
+cdelt,s,h,"INDEF",,,"Approximate dispersion
+"
+dispcor,b,h,yes,,,"Dispersion correct spectra?"
+extcor,b,h,no,,,"Extinction correct spectra?"
+fluxcal,b,h,no,,,"Flux calibrate spectra?"
+resize,b,h,no,,,"Automatically resize apertures?"
+clean,b,h,no,,,"Detect and replace bad pixels?"
+splot,b,h,no,,,"Plot the final spectrum?"
+redo,b,h,no,,,"Redo operations if previously done?"
+update,b,h,no,,,"Update spectra if cal data changes?"
+quicklook,b,h,no,,,"Minimally interactive quick-look?"
+batch,b,h,no,,,"Extract objects in batch?"
+listonly,b,h,no,,,"List steps but don\'t process?
+"
+sparams,pset,h,"",,,"Algorithm parameters"
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/doslittasks.cl b/noao/imred/src/doslit/doslittasks.cl
new file mode 100644
index 00000000..a7b635a9
--- /dev/null
+++ b/noao/imred/src/doslit/doslittasks.cl
@@ -0,0 +1,17 @@
+#{ SLITPROC tasks
+
+task	doslit		= "doslit$doslit.cl"
+task	sproc		= "doslit$sproc.cl"
+task	sarcrefs	= "doslit$sarcrefs.cl"
+task	sdoarcs		= "doslit$sdoarcs.cl"
+task	sfluxcal	= "doslit$sfluxcal.cl"
+task	sbatch		= "doslit$sbatch.cl"
+task	slistonly	= "doslit$slistonly.cl"
+task	sgetspec	= "doslit$sgetspec.cl"
+
+task	apslitproc	= "doslit$x_apextract.e"
+
+hidetask sproc, sbatch, sarcrefs, sdoarcs, sfluxcal, slistonly, sgetspec
+hidetask apslitproc
+
+keep
diff --git a/noao/imred/src/doslit/sarcrefs.cl b/noao/imred/src/doslit/sarcrefs.cl
new file mode 100644
index 00000000..304983f1
--- /dev/null
+++ b/noao/imred/src/doslit/sarcrefs.cl
@@ -0,0 +1,118 @@
+# SARCREFS -- Determine dispersion relation for reference arcs.
+
+procedure sarcrefs (arcref1, crval, cdelt, done, log1, log2)
+
+file	arcref1
+string	crval = "INDEF"
+string	cdelt = "INDEF"
+file	done
+file	log1
+file	log2
+bool	newdisp = no
+
+struct	*fd
+
+begin
+	string	arcref, arcrefms, arc, arcms, temp, str1, str2
+	int	i, dc, nspec
+	bool	log
+	struct	str3
+
+	temp = mktemp ("tmp$iraf")
+
+	# Extract the primary arc reference spectrum.  Determine the
+	# dispersion function with IDENTIFY/REIDENTIFY.  Set the wavelength
+	# parameters with MSDISPCOR.
+
+	newdisp = no
+	arcref = arcref1
+	arcrefms = arcref1 // ".ms." // envget ("imtype")
+	i = stridx (",", arcrefms)
+	if (i > 0)
+	    arcrefms = substr (arcrefms, 1, i-1)
+	if (!access (arcrefms)) {
+	    print ("Extract arc reference image ", arcref) | tee (log1)
+	    if (apslitproc.reference == "") {
+		delete (database//"/ap"//arcref, verify=no, >& "dev$null")
+		apslitproc (arcref, nfind=-1, ansfind="YES",
+		    background="none", clean=no, weights="none")
+	    } else
+		apslitproc (arcref, background="none", clean=no, weights="none")
+
+	    nspec = 1
+	    hselect (arcrefms, "naxis2", yes) | scan (nspec)
+	    if (nspec > 1)
+		scopy (arcrefms//"[*,1]", arcrefms, w1=INDEF, w2=INDEF,
+		    apertures="", bands="", beams="", apmodulus=0,
+		    format="multispec", renumber=no, offset=0, clobber=yes,
+		    merge=no, rebin=yes, verbose=no)
+	}
+		    
+	# Check for dispersion correction.  If missing determine the
+	# dispersion function and dispersion correct.  Dispersion
+	# correction is required to define the dispersion parameters
+	# for the objects.
+
+	hselect (arcrefms, "dispcor", yes, > temp)
+	fd = temp
+	dc = -1
+	i = fscan (fd, dc)
+	fd = ""; delete (temp, verify=no)
+	if (i < 1 || dc == -1) {
+	    print ("Determine dispersion solution for ", arcref) | tee (log1)
+	    #delete (database//"/id"//arcref//".ms*", verify=no)
+	    printf ("%s %s\n", crval, cdelt) | scan (str3)
+	    if (str3 == "INDEF INDEF")
+		identify (arcrefms, section="middle line", database=database,
+		    coordlist=sparams.coordlist, nsum=1, match=sparams.match,
+		    maxfeatures=50, zwidth=100., ftype="emission",
+		    fwidth=sparams.fwidth, cradius=sparams.cradius,
+		    threshold=sparams.threshold, minsep=2.,
+		    function=sparams.i_function, order=sparams.i_order,
+		    sample="*", niterate=sparams.i_niterate,
+		    low_reject=sparams.i_low, high_reject=sparams.i_high,
+		    grow=0., autowrite=yes)
+	    else
+		autoidentify (arcrefms, crval, cdelt,
+		    coordlist=sparams.coordlist,
+		    interactive="YES", section="middle line", nsum="1",
+		    ftype="emission", fwidth=sparams.fwidth,
+		    cradius=sparams.cradius, threshold=sparams.threshold,
+		    minsep=2., match=sparams.match, function=sparams.i_function,
+		    order=sparams.i_order, sample="*",
+		    niterate=sparams.i_niterate, low_reject=sparams.i_low,
+		    high_reject=sparams.i_high, grow=0., dbwrite="YES",
+		    overwrite=yes, database="database", verbose=yes,
+		    logfile=logfile, plotfile=plotfile,
+		    reflist="", refspec="", crpix="INDEF", cddir="unknown",
+		    crsearch="-0.5", cdsearch="INDEF", aidpars="")
+
+	    hedit (arcrefms, "refspec1", arcref // ".ms", add=yes,
+		show=no, verify=no)
+
+	    dispcor (arcrefms, "", linearize=sparams.linearize,
+		database=database, table="", w1=INDEF, w2=INDEF, dw=INDEF,
+		nw=INDEF, log=sparams.log, flux=sparams.flux, samedisp=yes,
+		global=no, ignoreaps=yes, confirm=yes, verbose=no, listonly=no,
+		logfile=logfile)
+	    flpr
+
+	    hedit (arcrefms, "dispcor", 0, add=yes, verify=no,
+		show=no, update=yes)
+	    newdisp = yes
+
+#	    if (sproc.splot1) {
+#	        print (arcrefms, ":")
+#	        str1 = sproc.anssplot
+#	        if (str1 == "NO" || str1 == "YES")
+#		    sproc.splot1 = no
+#	        if (str1 == "no" || str1 == "NO")
+#		    sproc.splot2 = no
+#	        else
+#		    sproc.splot2 = yes
+#	    }
+#	    if (sproc.splot2)
+#		splot (arcrefms)
+	}
+	print (arcref, >> done)
+end
diff --git a/noao/imred/src/doslit/sarcrefs.par b/noao/imred/src/doslit/sarcrefs.par
new file mode 100644
index 00000000..012dcaf7
--- /dev/null
+++ b/noao/imred/src/doslit/sarcrefs.par
@@ -0,0 +1,9 @@
+arcref1,f,a,"",,,
+crval,s,a,"INDEF",,,
+cdelt,s,a,"INDEF",,,
+done,f,a,"",,,
+log1,f,a,"",,,
+log2,f,a,"",,,
+newdisp,b,h,no,,,
+fd,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/sbatch.cl b/noao/imred/src/doslit/sbatch.cl
new file mode 100644
index 00000000..8e01b09e
--- /dev/null
+++ b/noao/imred/src/doslit/sbatch.cl
@@ -0,0 +1,199 @@
+# SBATCH -- Process spectra in batch.
+# This task is called in batch mode.  It only processes objects
+# not previously processed unless the update or redo flags are set.
+
+procedure sbatch ()
+
+file	objects		{prompt="List of object spectra"}
+real	datamax 	{prompt="Max data value / cosmic ray threshold"}
+file	arcs1		{prompt="List of arc spectra"}
+file	arcref1		{prompt="Arc reference for dispersion solution"}
+string	arcrefs		{prompt="Arc references\n"}
+
+file	done		{prompt="File of spectra already done"}
+file	logfile		{prompt="Logfile"}
+
+bool	redo		{prompt="Redo operations?"}
+bool	update		{prompt="Update spectra?"}
+bool	dispcor		{prompt="Dispersion correct spectra?"}
+bool	extcor		{prompt="Extinction correct spectra?"}
+bool	fluxcal1	{prompt="Flux calibrate spectra?"}
+
+bool	newdisp, newsens, newarcs
+
+struct	*fd1, *fd2, *fd3
+
+begin
+	file	temp, spec, specms, arc, arcms
+	bool	reextract, extract, disp, ext, flux, log
+	string	imtype, mstype, str1, str2, str3, str4
+	int	i
+	struct	err
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	mstype = ".ms" // imtype
+	temp = mktemp ("tmp$iraf")
+
+	reextract = redo || (update && newdisp)
+
+	fd1 = objects
+	while (fscan (fd1, spec) != EOF) {
+	    if (access (done)) {
+	        fd2 = done
+	        while (fscan (fd2, specms) != EOF)
+		    if (spec == specms)
+		        break
+	        if (spec == specms)
+		    next
+	        fd2 = ""
+	    }
+	    if (!access (spec // imtype)) {
+		printf ("Object spectrum not found - %s%s\n",
+		    spec, imtype) | scan (err)
+		print (err, >> logfile)
+		print ("Check setting of imtype", >> logfile)
+		next
+	    }
+	    specms = spec // mstype
+
+	    extract = no
+	    disp = no
+	    ext = no
+	    flux = no
+	    if (reextract || !access (specms))
+		extract = yes
+	    else {
+		hselect (specms, "dispcor", yes, > temp)
+		hselect (specms, "ex-flag", yes, >> temp)
+		hselect (specms, "ca-flag", yes, >> temp)
+		fd2 = temp
+		if (fscan (fd2, str1) == 1) {
+		    extract = update && newdisp
+		    if (update && !newdisp)
+		        # We really should check if REFSPEC will assign
+			# different reference spectra.
+			;
+		} else
+		    disp = dispcor
+		if (fscan (fd2, str1) == 1)
+		    extract = update && !extcor
+		else
+		    ext = extcor
+		if (fscan (fd2, str1) == 1)
+		    extract = update && (!fluxcal1 || newsens)
+		else
+		    flux = fluxcal1
+		fd2 = ""; delete (temp, verify=no)
+	    }
+		
+	    if (extract) {
+		disp = dispcor
+		ext = extcor
+		flux = fluxcal1
+	    }
+
+	    if (extract) {
+		if (access (specms))
+		    imdelete (specms, verify=no)
+		print ("Extract object spectrum ", spec, >> logfile)
+		hselect (spec, "date-obs,ut,exptime", yes, > temp)
+		hselect (spec, "ra,dec,epoch,st", yes, >> temp)
+		fd2 = temp
+		if (fscan (fd2, str1, str2, str3) == 3) {
+		    setjd (spec, observatory=observatory, date="date-obs",
+			time="ut", exposure="exptime", jd="jd", hjd="",
+			ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+			>> logfile)
+		    if (fscan (fd2, str1, str2, str3, str4) == 4)
+			setairmass (spec, intype="beginning",
+			    outtype="effective", exposure="exptime",
+			    observatory=observatory, show=no, update=yes,
+			    override=yes, >> logfile)
+		}
+		fd2 = ""; delete (temp, verify=no)
+		apslitproc (spec, saturation=datamax, verbose=no)
+	    }
+
+	    if (disp) {
+		# Fix arc headers if necessary.
+		if (newarcs) {
+	    	    fd2 = arcs1
+	    	    while (fscan (fd2, arc) != EOF) {
+			hselect (arc, "date-obs,ut,exptime", yes, > temp)
+			hselect (arc, "ra,dec,epoch,st", yes, >> temp)
+			fd3 = temp
+			if (fscan (fd3, str1, str2, str3) == 3) {
+			    setjd (arc, observatory=observatory,
+				date="date-obs", time="ut", exposure="exptime",
+				jd="jd", hjd="", ljd="ljd", utdate=yes,
+				uttime=yes, listonly=no, >> logfile)
+			    if (fscan (fd3, str1, str2, str3, str4) == 4)
+				setairmass (arc, intype="beginning",
+				    outtype="effective", exposure="exptime",
+				    observatory=observatory, show=no,
+				    update=yes, override=yes, >> logfile)
+			}
+			fd3 = ""; delete (temp, verify=no)
+	        	hedit (arc, "refspec1", arc, add=yes, verify=no,
+		    	    show=no, update=yes)
+		    }
+	    	    fd2 = ""
+		    newarcs = no
+		}
+
+		print ("Assign arc spectra for ", spec, >> logfile)
+		refspectra (spec, references=arcrefs,
+		    apertures="", refaps="", ignoreaps=no,
+		    select=sparams.select, sort=sparams.sort,
+		    group=sparams.group, time=sparams.time,
+		    timewrap=sparams.timewrap, override=yes, confirm=no,
+		    assign=yes, logfiles="STDOUT", verbose=no,
+		    >> logfile)
+
+		sdoarcs (spec, arcref1, reextract, logfile, yes)
+
+	        hselect (specms, "refspec1", yes, > temp)
+	        fd2 = temp
+	        i = fscan (fd2, arc)
+	        fd2 = ""; delete (temp, verify=no)
+		if (i < 1)
+		    print ("No arc reference assigned for ", spec, >> logfile)
+		else {
+	            print ("Dispersion correct ", spec, >> logfile)
+		    dispcor (specms, "", linearize=sparams.linearize,
+			database=database, table=arcref1//mstype,
+			w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF,
+			log=sparams.log, flux=sparams.flux, samedisp=no,
+			global=no, ignoreaps=no, confirm=no, listonly=no,
+			verbose=no, logfile=logfile)
+		    flpr
+		    hedit (specms, "dispcor", 0, add=yes, verify=no,
+			show=no, update=yes)
+		    disp = no
+		}
+	    }
+
+	    if (!disp) {
+	        if (ext)
+		    print ("Extinction correct ", spec, >> logfile)
+	        if (flux)
+		    print ("Flux calibrate ", spec, >> logfile)
+	        if (flux || ext)
+		    calibrate (specms, "", extinct=extcor, flux=fluxcal1,
+			extinction=extinction, observatory=observatory,
+			ignoreaps=yes, sensitivity="sens", fnu=sparams.fnu,
+			>> logfile)
+	    }
+	}
+	fd1 = ""
+	delete (objects, verify=no)
+	delete (arcs1, verify=no)
+
+	if (access (done))
+	    delete (done, verify=no)
+
+	flprcache (0)
+end
diff --git a/noao/imred/src/doslit/sbatch.par b/noao/imred/src/doslit/sbatch.par
new file mode 100644
index 00000000..582bdf03
--- /dev/null
+++ b/noao/imred/src/doslit/sbatch.par
@@ -0,0 +1,20 @@
+objects,f,h,"",,,"List of object spectra"
+datamax,r,h,,,,"Max data value / cosmic ray threshold"
+arcs1,f,h,"",,,"List of arc spectra"
+arcref1,f,h,"",,,"Arc reference for dispersion solution"
+arcrefs,s,h,,,,"Arc references
+"
+done,f,h,"",,,"File of spectra already done"
+logfile,f,h,"",,,"Logfile"
+redo,b,h,,,,"Redo operations?"
+update,b,h,,,,"Update spectra?"
+dispcor,b,h,,,,"Dispersion correct spectra?"
+extcor,b,h,,,,"Extinction correct spectra?"
+fluxcal1,b,h,,,,"Flux calibrate spectra?"
+newdisp,b,h,,,,
+newsens,b,h,,,,
+newarcs,b,h,,,,
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+fd3,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/sdoarcs.cl b/noao/imred/src/doslit/sdoarcs.cl
new file mode 100644
index 00000000..19b8f3af
--- /dev/null
+++ b/noao/imred/src/doslit/sdoarcs.cl
@@ -0,0 +1,101 @@
+# SDOARCS -- Determine dispersion relation for spectrum based on refernece arcs.
+
+procedure sdoarcs (spec, arcref1, reextract, logfile, batch)
+
+file	spec
+file	arcref1
+bool	reextract
+file	logfile
+bool	batch
+
+struct	*fd
+
+begin
+	file	temp, arc1, arc2, str1
+	string	imtype, mstype, reid
+	bool	verbose1
+	int	i, n
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	mstype = ".ms" // imtype
+	n = strlen (imtype)
+
+	temp = mktemp ("tmp$iraf")
+
+	for (j=1; j<=2; j+=1) {
+
+	    # Setup interactive/batch parameters
+	    if (batch) {
+		verbose1 = no
+		reid = "no"
+	    } else {
+		verbose1 = verbose
+		reidentify.answer.p_mode = "h"
+		reid = reidentify.answer
+		reidentify.answer.p_mode = "q"
+		if (reid == "no")
+		    reid = "yes"
+	    }
+
+	    # The reference spectra refer initially to the 2D image.  At the
+	    # end we will reset them to refer to the 1D spectra.
+
+	    hselect (spec, "refspec"//j, yes, > temp)
+	    fd = temp
+	    i = fscan (fd, arc1, str1)
+	    fd = ""; delete (temp, verify=no)
+	    if (nscan() < 1)
+		break
+
+	    # Strip possible image extension.
+	    i = strlen (arc1)
+	    if (i > n && substr (arc1, i-n+1, i) == imtype)
+		arc1 = substr (arc1, 1, i-n)
+    
+	    # Set extraction output and aperture reference depending on whether
+	    # the arcs are to be rextracted using recentered or retraced object
+	    # apertures.
+
+	    arc2 = spec // arc1
+	    if (access (arc2//mstype))
+		imdelete (arc2//mstype, verify=no)
+	    delete (database//"/id"//arc2//".ms*", verify = no, >& "dev$null")
+    
+	    # Extract and determine dispersion function if necessary.
+	    if (!access (arc2//mstype)) {
+		if (!batch)
+		    print ("Extract and reidentify arc spectrum ", arc1)
+		print ("Extract and reidentify arc spectrum ", arc1, >> logfile)
+		apslitproc (arc1, output=arc2//".ms", references=spec,
+		    background="none", clean=no, weights="none",
+		    verbose=verbose1)
+		delete (database//"/id"//arc2//".ms*", verify = no,
+		    >& "dev$null")
+		reidentify (arcref1//".ms", arc2//".ms", interactive=reid,
+		    section="middle line", shift=0., step=1, nsum=1,
+		    cradius=sparams.cradius, threshold=sparams.threshold,
+		    nlost=100, refit=sparams.refit, trace=no, override=no,
+		    newaps=yes, addfeatures=sparams.addfeatures,
+		    coordlist=sparams.coordlist, match=sparams.match,
+		    maxfeatures=50, minsep=2., database=database,
+		    plotfile=plotfile, logfiles=logfile, verbose=verbose1)
+
+		# If not reextracting arcs based on object apertures
+		# then save the extracted arc to avoid doing it again.
+
+		if (arc1 != arc2)
+		    imdelete (arc2//".ms", verify=no)
+	    }
+    
+	    # Set the REFSPEC parameters for multispec spectrum.
+	    if (nscan() == 1)
+		hedit (spec//".ms", "refspec"//j, arc2//".ms", add=yes,
+		    verify=no, show=no, update=yes)
+	    else
+		hedit (spec//".ms", "refspec"//j, arc2//".ms "//str1,
+		    add=yes, verify=no, show=no, update=yes)
+	}
+end
diff --git a/noao/imred/src/doslit/sdoarcs.par b/noao/imred/src/doslit/sdoarcs.par
new file mode 100644
index 00000000..cea554c2
--- /dev/null
+++ b/noao/imred/src/doslit/sdoarcs.par
@@ -0,0 +1,7 @@
+spec,f,a,"",,,
+arcref1,f,a,"",,,
+reextract,b,a,,,,
+logfile,f,a,"",,,
+batch,b,a,,,,
+fd,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/sfluxcal.cl b/noao/imred/src/doslit/sfluxcal.cl
new file mode 100644
index 00000000..e9399ac3
--- /dev/null
+++ b/noao/imred/src/doslit/sfluxcal.cl
@@ -0,0 +1,196 @@
+# SFLUXCAL -- Extract standard stars and determine sensitivity function.
+# If flux calibrating, extract and dispersion correct the standard star
+# spectra.  Compile the standard star fluxes from the calibration
+# directory.  The user is queried for the star name but the band passes
+# are not allow to change interactively.  Next compute the sensitivity
+# function using SENSFUNC.  This is interactive.  Once the sensitivity
+# function images are created, flux and extinction calibrate the standard
+# stars.  This is done in such a way that if new standard stars are added
+# in a later execution only the new stars are added and then a new
+# sensitivity function is computed.  If the update flag is set all
+# spectra which are specified are reprocessed if they were previously
+# processed.  In a redo the "std" file is deleted, otherwise additions
+# are appended to this file.
+
+procedure sfluxcal (stds, arcs1, arcref1, arcrefs, redo, update, extcor,
+	done, log1, log2)
+
+file	stds
+file	arcs1
+file	arcref1
+string	arcrefs
+bool	redo
+bool	update
+bool	extcor
+file	done
+file	log1
+file	log2
+
+struct	*fd1, *fd2, *fd3
+
+begin
+	string	imtype, mstype
+	string	spec, specms, arc, str1, str2, str3, str4
+	file	temp1, temp2
+	int	i, j
+	bool	reextract, log
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	mstype = ".ms" // imtype
+
+	temp1 = mktemp ("tmp$iraf")
+	temp2 = mktemp ("tmp$iraf")
+
+	reextract = redo || (update && sproc.newdisp)
+	sproc.newsens = no
+
+	if (redo && access ("std"))
+	    delete ("std", verify=no)
+
+        fd1 = stds
+        while (fscan (fd1, spec) != EOF) {
+	    specms = spec // mstype
+
+	    if (reextract && access (specms))
+	        imdelete (specms, verify=no)
+            if (!access (specms)) {
+	        print ("Extract standard star spectrum ", spec) | tee (log1)
+		hselect (spec, "date-obs,ut,exptime", yes, > temp1)
+		hselect (spec, "ra,dec,epoch,st", yes, >> temp1)
+		fd2 = temp1
+		if (fscan (fd2, str1, str2, str3) == 3) {
+		    setjd (spec, observatory=observatory, date="date-obs",
+			time="ut", exposure="exptime", jd="jd", hjd="",
+			ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+			>> log1)
+		    if (fscan (fd2, str1, str2, str3, str4) == 4)
+			setairmass (spec, intype="beginning",
+			    outtype="effective", exposure="exptime",
+			    observatory=observatory, show=no, update=yes,
+			    override=yes, >> log1)
+		}
+		fd2 = ""; delete (temp1, verify=no)
+		apslitproc (spec)
+	    }
+
+	    hselect (specms, "dispcor,std-flag", yes, > temp1)
+	    fd2 = temp1
+	    j = fscan (fd2, str1, str2)
+	    fd2 = ""; delete (temp1, verify=no)
+	    if (j < 1) {
+		# Fix arc headers if necessary.
+		if (sproc.newarcs) {
+	    	    fd2 = arcs1
+	    	    while (fscan (fd2, arc) != EOF) {
+			hselect (arc, "date-obs,ut,exptime", yes, > temp1)
+			hselect (arc, "ra,dec,epoch,st", yes, >> temp1)
+			fd3 = temp1
+			if (fscan (fd3, str1, str2, str3) == 3) {
+			    setjd (arc, observatory=observatory,
+				date="date-obs", time="ut", exposure="exptime",
+				jd="jd", hjd="", ljd="ljd", utdate=yes,
+				uttime=yes, listonly=no, >> log1)
+			    if (fscan (fd3, str1, str2, str3, str4) == 4)
+				setairmass (arc, intype="beginning",
+				    outtype="effective", exposure="exptime",
+				    observatory=observatory, show=no,
+				    update=yes, override=yes, >> log1)
+			}
+			fd3 = ""; delete (temp1, verify=no)
+	        	hedit (arc, "refspec1", arc, add=yes, verify=no,
+		    	    show=no, update=yes)
+		    }
+	    	    fd2 = ""
+		    sproc.newarcs = no
+		}
+
+		print ("Assign arc spectra for ", spec) | tee (log1)
+		refspectra (spec, references=arcrefs,
+		    apertures="", refaps="", ignoreaps=no,
+		    select=sparams.select, sort=sparams.sort,
+		    group=sparams.group, time=sparams.time,
+		    timewrap=sparams.timewrap, override=yes, confirm=no,
+		    assign=yes, logfiles="STDOUT", verbose=no) |
+		    tee (log1, > log2)
+
+		sdoarcs (spec, arcref1, reextract, log1, no)
+
+	        hselect (specms, "refspec1", yes, > temp1)
+	        fd2 = temp1
+	        i = fscan (fd2, arc)
+	        fd2 = ""; delete (temp1, verify=no)
+		if (i < 1) {
+		    print ("No arc reference assigned for ", spec) | tee (log1)
+		    next
+		} else {
+	            print ("Dispersion correct ", spec) | tee (log1)
+		    dispcor (specms, "", linearize=sparams.linearize,
+			database=database, table=arcref1//mstype,
+			w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF,
+			log=sparams.log, flux=sparams.flux, samedisp=no,
+			global=no, ignoreaps=no, confirm=no, listonly=no,
+			logfile=logfile, > log2)
+		    flpr
+		    hedit (specms, "dispcor", 0, add=yes, verify=no,
+			show=no, update=yes)
+		}
+	    }
+
+	    if (j < 2 || !access ("std")) {
+                print ("Compile standard star fluxes for ", spec) | tee (log1)
+	        standard (specms, output="std", samestar=no, beam_switch=no,
+		    apertures="", bandwidth=INDEF, bandsep=INDEF,
+		    fnuzero=3.68E-20, extinction=extinction, caldir=caldir,
+		    observatory=observatory, interact=no)
+	        hedit (specms, "std-flag", "yes", add=yes, verify=no,
+		    show=no, update=yes)
+	        print (specms, >> temp2)
+	        sproc.newsens = yes
+            }
+        }
+        fd1 = ""
+
+	if (sproc.newsens || !access ("sens"//imtype)) {
+	    if (!access ("std")) {
+	        print ("No standard star data") | tee (log1)
+	        sproc.fluxcal1 = no
+	    } else {
+	        imdelete ("sens"//imtype, verify=no, >& "dev$null")
+                print ("Compute sensitivity function") | tee (log1)
+                sensfunc ("std", "sens", apertures="", ignoreaps=yes,
+		    logfile=logfile, extinction=extinction,
+		    newextinction="extinct.dat", observatory=observatory,
+		    function=sparams.s_function, order=sparams.s_order,
+		    interactive=yes, graphs="sr", marks="plus cross box")
+	        sproc.newsens = yes
+	    }
+        }
+
+        # Note that if new standard stars are added the old standard
+        # stars are not recalibrated unless the redo flag is used.
+
+        if (sproc.fluxcal1 && sproc.newsens && access (temp2)) {
+            print ("Flux and/or extinction calibrate standard stars") |
+	        tee (log1)
+	    calibrate ("@"//temp2, "", extinct=extcor, flux=sproc.fluxcal1,
+		extinction=extinction, observatory=observatory, ignoreaps=yes,
+		sensitivity="sens", fnu=sparams.fnu) | tee (log1, > log2)
+	    if (sproc.splot1) {
+	        print ("Standard stars:")
+	        str1 = sproc.anssplot
+	        if (str1 == "NO" || str1 == "YES")
+		    sproc.splot1 = no
+	        if (str1 == "no" || str1 == "NO")
+		    sproc.splot2 = no
+	        else
+		    sproc.splot2 = yes
+	    }
+	    if (sproc.splot2)
+		splot ("@"//temp2)
+	    sections (temp2, option="fullname", >> done)
+            delete (temp2, verify=no)
+        }
+end
diff --git a/noao/imred/src/doslit/sfluxcal.par b/noao/imred/src/doslit/sfluxcal.par
new file mode 100644
index 00000000..44474335
--- /dev/null
+++ b/noao/imred/src/doslit/sfluxcal.par
@@ -0,0 +1,14 @@
+stds,f,a,,,,
+arcs1,f,a,,,,
+arcref1,f,a,"",,,
+arcrefs,s,a,,,,
+redo,b,a,,,,
+update,b,a,,,,
+extcor,b,a,,,,
+done,f,a,"",,,
+log1,f,a,"",,,
+log2,f,a,"",,,
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+fd3,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/sgetspec.cl b/noao/imred/src/doslit/sgetspec.cl
new file mode 100644
index 00000000..1140e610
--- /dev/null
+++ b/noao/imred/src/doslit/sgetspec.cl
@@ -0,0 +1,178 @@
+# SGETSPEC -- Get spectra which are CCD processed and not extracted.
+# This task also recognizes the arc spectra in the object list and arc table.
+# This task also strips the image type extension.
+
+procedure sgetspec (objects, arcs, arctable, standards, obj, arc, std)
+
+string	objects			{prompt="List of object images"}
+string	arcs			{prompt="List of arc images"}
+file	arctable		{prompt="Arc table"}
+string	standards		{prompt="List of standard images"}
+file	obj			{prompt="File of object images"}
+file	arc			{prompt="File of arc images"}
+file	std			{prompt="File of standard images"}
+bool	ccdproc			{prompt="Add CCDPROC keyword and continue?",
+				 mode="q"}
+struct	*fd1, *fd2
+
+begin
+	string	imtype, temp, image, itype
+	int	n, n1, narcs
+
+	imtype = "." // envget ("imtype")
+	n = stridx (",", imtype)
+	if (n > 0)
+	    imtype = substr (imtype, 1, n-1)
+	n1 = strlen (imtype)
+
+	temp = mktemp ("tmp$iraf")
+
+	# Initialize files
+	set clobber=yes
+	sleep (> obj)
+	sleep (> arc)
+	sleep (> std)
+	set clobber=no
+
+	# Do arcs
+	itype = ""
+	narcs = 0
+	sections (arcs, option="fullname", > temp)
+	fd1 = temp
+	while (fscan (fd1, image) != EOF) {
+	    hselect (image, "ccdproc", yes) | scan (itype)
+	    if (nscan() == 0) {
+		printf ("%s: CCDPROC keyword not found.\n", image)
+		printf ("  Either run CCDPROC or add CCDPROC keyword with HEDIT.\n")
+		if (!ccdproc)
+		    error (1, "Exit")
+		hedit (image, "ccdproc", "DOSLIT", add=yes, update=yes,
+		    verify=no, show=no)
+	    }
+	    hselect (image, "wat0_001", yes) | scanf ("system=%s", itype)
+	    if (itype == "equispec" || itype == "multispec")
+		next
+	    hselect (image, "imagetyp", yes) | scan (itype)
+	    if (nscan() == 0)
+		itype = "comp"
+	    if (itype != "comp" && itype != "COMPARISON" &&
+		itype != "comparison" && itype != "COMP")
+		next
+	    n = strlen (image)
+	    if (n > n1 && substr (image, n-n1+1, n) == imtype)
+		image = substr (image, 1, n-n1)
+	    narcs = narcs + 1
+	    printf ("%s %02d\n", image, narcs, >> arc)
+	}
+	fd1 = ""; delete (temp, verify=no)
+
+	# Do arc table.
+	if (arctable != "") {
+	    fd2 = arctable
+	    while (fscan (fd2, image, image) != EOF) {
+		if (nscan() != 2)
+		    next
+		sections (image, option="fullname", > temp)
+		fd1 = temp
+		while (fscan (fd1, image) != EOF) {
+		    hselect (image, "ccdproc", yes) | scan (itype)
+		    if (nscan() == 0) {
+			printf ("%s: CCDPROC keyword not found.\n", image)
+			printf ("  Either run CCDPROC or add CCDPROC keyword with HEDIT.\n")
+			if (!ccdproc)
+			    error (1, "Exit")
+			hedit (image, "ccdproc", "DOSLIT", add=yes, update=yes,
+			    verify=no, show=no)
+		    }
+		    hselect (image, "wat0_001", yes) | scanf ("system=%s", itype)
+		    if (itype == "equispec" || itype == "multispec")
+			next
+		    hselect (image, "imagetyp", yes) | scan (itype)
+		    if (nscan() == 0)
+			itype = "comp"
+		    if (itype != "comp" && itype != "COMPARISON" &&
+			itype != "comparison" && itype != "COMP")
+			next
+		    n = strlen (image)
+		    if (n > n1 && substr (image, n-n1+1, n) == imtype)
+			image = substr (image, 1, n-n1)
+		    narcs = narcs + 1
+		    printf ("%s %02d\n", image, narcs, >> arc)
+		}
+		fd1 = ""; delete (temp, verify=no)
+	    }
+	}
+
+	# Do standards
+	sections (standards, option="fullname", > temp)
+	fd1 = temp
+	while (fscan (fd1, image) != EOF) {
+	    hselect (image, "ccdproc", yes) | scan (itype)
+	    if (nscan() == 0) {
+		printf ("%s: CCDPROC keyword not found.\n", image)
+		printf ("  Either run CCDPROC or add CCDPROC keyword with HEDIT.\n")
+		if (!ccdproc)
+		    error (1, "Exit")
+		hedit (image, "ccdproc", "DOSLIT", add=yes, update=yes,
+		    verify=no, show=no)
+	    }
+	    hselect (image, "wat0_001", yes) | scanf ("system=%s", itype)
+	    if (itype == "equispec" || itype == "multispec")
+		next
+	    n = strlen (image)
+	    if (n > n1 && substr (image, n-n1+1, n) == imtype)
+		image = substr (image, 1, n-n1)
+	    print (image, >> std)
+	}
+	fd1 = ""; delete (temp, verify=no)
+
+	# Do objects
+	sections (objects, option="fullname", > temp)
+	fd1 = temp
+	while (fscan (fd1, image) != EOF) {
+	    hselect (image, "ccdproc", yes) | scan (itype)
+	    if (nscan() == 0) {
+		printf ("%s: CCDPROC keyword not found.\n", image)
+		printf ("  Either run CCDPROC or add CCDPROC keyword with HEDIT.\n")
+		if (!ccdproc)
+		    error (1, "Exit")
+		hedit (image, "ccdproc", "DOSLIT", add=yes, update=yes,
+		    verify=no, show=no)
+	    }
+	    hselect (image, "wat0_001", yes) | scanf ("system=%s", itype)
+	    if (itype == "equispec" || itype == "multispec")
+		next
+	    hselect (image, "imagetyp", yes) | scan (itype)
+	    if (nscan() == 0)
+		itype = "object"
+
+	    n = strlen (image)
+	    if (n > n1 && substr (image, n-n1+1, n) == imtype)
+		image = substr (image, 1, n-n1)
+	    if (itype == "object" || itype == "OBJECT")
+		print (image, >> obj)
+	    else if (itype == "comp" || itype == "COMPARISON" ||
+		itype == "comparison" || itype == "COMP") {
+		narcs = narcs + 1
+		printf ("%s %02d\n", image, narcs, >> arc)
+	    }
+	}
+	fd1 = ""; delete (temp, verify=no)
+
+	if (narcs > 0) {
+	    sort (arc, column=0, ignore=yes, numeric=no, reverse=no, > temp)
+	    delete (arc, verify=no)
+	    rename (temp, arc, field="all")
+	    itype = ""
+	    fd1 = arc
+	    while (fscan (fd1, image, narcs) != EOF) {
+		if (image != itype)
+		    printf ("%s %02d\n", image, narcs, >> temp)
+		itype = image
+	    }
+	    delete (arc, verify=no)
+	    sort (temp, column=2, ignore=yes, numeric=yes, reverse=no) |
+	    fields ("STDIN", "1", lines="1-99", > arc)
+	    delete (temp, verify=no)
+	}
+end
diff --git a/noao/imred/src/doslit/sgetspec.par b/noao/imred/src/doslit/sgetspec.par
new file mode 100644
index 00000000..1f5387cc
--- /dev/null
+++ b/noao/imred/src/doslit/sgetspec.par
@@ -0,0 +1,11 @@
+objects,s,a,,,,"List of object images"
+arcs,s,a,,,,"List of arc images"
+arctable,f,a,"",,,"Arc table"
+standards,s,a,,,,"List of standard images"
+obj,f,a,"",,,"File of object images"
+arc,f,a,"",,,"File of arc images"
+std,f,a,"",,,"File of standard images"
+ccdproc,b,q,,,,"Add CCDPROC keyword and continue?"
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/slistonly.cl b/noao/imred/src/doslit/slistonly.cl
new file mode 100644
index 00000000..71ee3b40
--- /dev/null
+++ b/noao/imred/src/doslit/slistonly.cl
@@ -0,0 +1,180 @@
+# SLISTONLY -- List processing to be done.
+#
+# This follows pretty much the same logic as the full procedure but doesn't
+# do anything but list the operations.
+
+procedure slistonly (objects, arcs1, standards, dispcor, extcor, fluxcal,
+	redo, update)
+
+file	objects
+file	arcs1
+file	standards
+
+bool	dispcor
+bool	extcor
+bool	fluxcal
+bool	redo
+bool	update
+
+struct	*fd1
+struct	*fd2
+
+begin
+	string	imtype, mstype
+	string	spec, arcref1
+	string	specms, arcref1ms
+	string	temp, done, str1, str2
+	bool	reextract, fluxcal1, stdfile
+	bool	newdisp, newsens, extract, disp, ext, flux
+	int	i, dc, sf
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	mstype = ".ms" // imtype
+	temp = mktemp ("tmp$iraf")
+	done = mktemp ("tmp$iraf")
+
+	newdisp = no
+	newsens = no
+	fluxcal1 = fluxcal
+
+	print ("Check and set new object aperture definitions")
+
+	if (dispcor) {
+	    fd1 = arcs1
+	    if (fscan (fd1, arcref1) == EOF)
+		error (1, "No reference arcs")
+	    fd1 = ""
+	    arcref1ms = arcref1 // mstype
+
+	    if (redo || !access (arcref1ms)) {
+	        print ("Extract arc reference image ", arcref1)
+	        print ("Determine dispersion solution for ", arcref1)
+	        newdisp = yes
+	    } else {
+		hselect (arcref1ms, "dispcor", yes, > temp)
+	        fd1 = temp
+		dc = -1
+	        i = fscan (fd1, dc)
+	        fd1 = ""; delete (temp, verify=no)
+	        if (i < 1) {
+	            print ("Determine dispersion solution for ", arcref1)
+	            newdisp = yes
+	        }
+	    }
+	    print (arcref1, > done)
+
+	    if (fluxcal1) {
+		stdfile = access ("std")
+		if (redo && stdfile)
+		    stdfile = no
+
+	        reextract = redo || (update && newdisp)
+	        fd1 = standards
+	        while (fscan (fd1, spec) != EOF) {
+		    specms = spec // mstype
+	            if (reextract || !access (specms)) {
+		        print ("Extract standard star spectrum ", spec)
+	                print ("Dispersion correct ", spec)
+	                print ("Compile standard star fluxes for ", spec)
+		        stdfile = yes
+		        newsens = yes
+		    } else {
+		        hselect (specms, "dispcor,std-flag", yes, > temp)
+		        fd2 = temp
+			dc = -1
+			sf = -1
+		        i = fscan (fd2, dc, sf)
+		        fd2 = ""; delete (temp, verify=no)
+		        if (i < 1)
+		            print ("Dispersion correct ", spec)
+		        if (i < 2) {
+		            print ("Compile standard star fluxes for ", spec)
+		            stdfile = yes
+		            newsens = yes
+		        }
+	            }
+		    print (spec, >> done)
+	        }
+	        fd1 = ""
+
+	        sections ("sens.????" // imtype, option="nolist")
+	        if (newsens || sections.nimages == 0) {
+		    if (!stdfile) {
+		        print ("No standard stars")
+		        fluxcal1 = no
+		    } else {
+	                print ("Compute sensitivity function")
+		        newsens = yes
+		    }
+	        }
+
+	        if (fluxcal1 && newsens)
+	            print ("Flux and/or extinction calibrate standard stars")
+	    }
+	}
+
+	reextract = redo || (update && newdisp)
+	fd1 = objects
+	while (fscan (fd1, spec) != EOF) {
+	    if (access (done)) {
+	        fd2 = done
+	        while (fscan (fd2, specms) != EOF)
+		    if (spec == specms)
+		        break
+	        if (spec == specms)
+		    next
+	        fd2 = ""
+	    }
+
+	    specms = spec // mstype
+
+	    extract = no
+	    disp = no
+	    ext = no
+	    flux = no
+	    if (reextract || !access (specms))
+		extract = yes
+	    else {
+		hselect (specms, "dispcor", yes, > temp)
+		hselect (specms, "ex-flag", yes, >> temp)
+		hselect (specms, "ca-flag", yes, >> temp)
+		fd2 = temp
+		extract = update
+		if (fscan (fd2, str1) == 1)
+		    extract = update && newdisp
+		else
+		    disp = yes
+		if (fscan (fd2, str1) == 1)
+		    extract = update && !extcor
+		else
+		    ext = extcor
+		if (fscan (fd2, str1) == 1)
+		    extract = update && (!fluxcal1 || newsens)
+		else
+		    flux = fluxcal1
+		fd2 = ""; delete (temp, verify=no)
+	    }
+		
+	    if (extract) {
+		disp = dispcor
+		ext = extcor
+		flux = fluxcal1
+	    }
+		    
+	    if (extract)
+		print ("Extract object spectrum ", spec)
+	    if (disp)
+	        print ("Dispersion correct ", spec)
+	    if (ext)
+		print ("Extinction correct ", spec)
+	    if (flux)
+		print ("Flux calibrate ", spec)
+	}
+	fd1 = ""
+
+	if (access (done))
+	    delete (done, verify=no)
+end
diff --git a/noao/imred/src/doslit/slistonly.par b/noao/imred/src/doslit/slistonly.par
new file mode 100644
index 00000000..08d4e016
--- /dev/null
+++ b/noao/imred/src/doslit/slistonly.par
@@ -0,0 +1,12 @@
+objects,f,a,,,,
+arcs1,f,a,,,,
+standards,f,a,,,,
+dispcor,b,a,,,,
+extcor,b,a,,,,
+fluxcal,b,a,,,,
+redo,b,a,,,,
+update,b,a,,,,
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+fd3,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/doslit/sparams.par b/noao/imred/src/doslit/sparams.par
new file mode 100644
index 00000000..1cc001d8
--- /dev/null
+++ b/noao/imred/src/doslit/sparams.par
@@ -0,0 +1,65 @@
+line,i,h,INDEF,,,"Default dispersion line"
+nsum,i,h,10,,,"Number of dispersion lines to sum or median"
+extras,b,h,no,,,"Extract sky, sigma, etc.?
+
+-- DEFAULT APERTURE PARAMETERS -- "
+lower,r,h,-3.,,,Lower aperture limit relative to center
+upper,r,h,3.,,,"Upper aperture limit relative to center
+
+-- AUTOMATIC APERTURE RESIZING PARAMETERS --"
+ylevel,r,h,0.05,,,"Fraction of peak or intensity for resizing
+
+-- TRACE PARAMETERS --"
+t_step,i,h,10,,,"Tracing step"
+t_function,s,h,"spline3","chebyshev|legendre|spline1|spline3",,"Trace fitting function"
+t_order,i,h,1,,,"Trace fitting function order"
+t_niterate,i,h,1,0,,"Trace rejection iterations"
+t_low,r,h,3.,0.,,"Trace lower rejection sigma"
+t_high,r,h,3.,0.,,"Trace upper rejection sigma
+
+-- APERTURE EXTRACTION PARAMETERS --"
+weights,s,h,"none",,,Extraction weights (none|variance)
+pfit,s,h,"fit1d","fit1d|fit2d",,Profile fitting algorithm (fit1d|fit2d)
+lsigma,r,h,3.,,,Lower rejection threshold
+usigma,r,h,3.,,,"Upper rejection threshold
+
+-- BACKGROUND SUBTRACTION PARAMETERS --"
+background,s,h,"fit","none|average|median|minimum|fit",,Background to subtract
+b_function,s,h,"legendre","chebyshev|legendre|spline1|spline3",,"Background function"
+b_order,i,h,1,,,"Background function order"
+b_sample,s,h,"-10:-6,6:10",,,"Background sample regions"
+b_naverage,i,h,-100,,,"Background average or median"
+b_niterate,i,h,1,0,,"Background rejection iterations"
+b_low,r,h,3.,0.,,"Background lower rejection sigma"
+b_high,r,h,3.,0.,,"Background upper rejection sigma
+
+-- ARC DISPERSION FUNCTION PARAMETERS --"
+threshold,r,h,10.,0.,,"Minimum line contrast threshold"
+coordlist,f,h,linelists$idhenear.dat,,,"Line list"
+match,r,h,-3.,,,"Line list matching limit in Angstroms"
+fwidth,r,h,4.,,,"Arc line widths in pixels"
+cradius,r,h,10.,,,Centering radius in pixels
+i_function,s,h,"spline3","legendre|chebyshev|spline1|spline3",,"Coordinate function"
+i_order,i,h,1,1,,"Order of dispersion function"
+i_niterate,i,h,1,0,,"Rejection iterations"
+i_low,r,h,3.,0.,,"Lower rejection sigma"
+i_high,r,h,3.,0.,,"Upper rejection sigma"
+refit,b,h,yes,,,"Refit coordinate function when reidentifying?"
+addfeatures,b,h,no,,,"Add features when reidentifying?
+
+-- AUTOMATIC ARC ASSIGNMENT PARAMETERS --"
+select,s,h,"interp",,,"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
+
+-- DISPERSION CORRECTION PARAMETERS --"
+linearize,b,h,yes,,,Linearize (interpolate) spectra?
+log,b,h,no,,,"Logarithmic wavelength scale?"
+flux,b,h,yes,,,"Conserve flux?
+
+-- SENSITIVITY CALIBRATION PARAMETERS --"
+s_function,s,h,"spline3","chebyshev|legendre|spline3|spline1",,"Fitting function"
+s_order,i,h,1,1,,"Order of sensitivity function"
+fnu,b,h,no,,,"Create spectra having units of FNU?"
diff --git a/noao/imred/src/doslit/sproc.cl b/noao/imred/src/doslit/sproc.cl
new file mode 100644
index 00000000..0b13d71a
--- /dev/null
+++ b/noao/imred/src/doslit/sproc.cl
@@ -0,0 +1,404 @@
+# SPROC -- Process spectra from 2D to 1D
+#
+# This program combines all the operations of extraction, dispersion
+# correction, extinction correction, and flux calibration in as simple
+# and noninteractive manner as possible.
+
+procedure sproc (objects, arcs1, arctable, standards, crval, cdelt, dispcor,
+	extcor, fluxcal, resize, clean, splot, redo, update, quicklook, batch,
+	listonly)
+
+file	objects = ""		{prompt="List of object spectra"}
+
+file	arcs1 = ""		{prompt="List of arc spectra"}
+file	arctable = ""		{prompt="Arc assignment table (optional)"}
+file	standards = ""		{prompt="List of standard star spectra\n"}
+
+string	crval = "INDEF"		{prompt="Approximate wavelength"}
+string	cdelt = "INDEF"		{prompt="Approximate dispersion\n"}
+
+bool	dispcor = yes		{prompt="Dispersion correct spectra?"}
+bool	extcor = no		{prompt="Extinction correct spectra?"}
+bool	fluxcal = no		{prompt="Flux calibrate spectra?"}
+bool	resize = no		{prompt="Automatically resize apertures?"}
+bool	clean = no		{prompt="Detect and replace bad pixels?"}
+bool	splot = no		{prompt="Plot the final spectrum?"}
+bool	redo = no		{prompt="Redo operations if previously done?"}
+bool	update = no		{prompt="Update spectra if cal data changes?"}
+bool	quicklook = no		{prompt="Minimally interactive quick-look?"}
+bool	batch = no		{prompt="Extract objects in batch?"}
+bool	listonly = no		{prompt="List steps but don't process?\n"}
+
+real	datamax = INDEF		{prompt="Max data value / cosmic ray threshold"}
+
+string	anssplot		{prompt="Splot spectrum?", mode="q",
+				 enum="no|yes|NO|YES"}
+bool	newdisp, newsens, newarcs
+bool	fluxcal1, splot1, splot2
+bool	dobatch
+
+struct	*fd1, *fd2, *fd3
+
+begin
+	file	arcref1, spec, arc
+	file	arcref1ms, specms, arcms
+	file	temp, done
+	string	imtype, mstype
+	string	str1, str2, str3, str4, arcrefs, log1, log2
+	bool	reextract, extract, disp, ext, flux, log
+	int	i, j, n, nspec
+	struct	err
+
+	# Call a separate task to do the listing to minimize the size of
+	# this script and improve it's readability.
+
+	dobatch = no
+	if (listonly) {
+	    slistonly (objects, arcs1, standards, dispcor, extcor,
+		fluxcal, redo, update)
+	    bye
+	}
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	mstype = ".ms" // imtype
+	n = strlen (imtype)
+
+	# Temporary files used repeatedly in this script.  Under some
+	# abort circumstances these files may be left behind.
+
+	temp = mktemp ("tmp$iraf")
+	done = mktemp ("tmp$iraf")
+
+	# Get query parameters
+	if (arctable == "")
+	    arcrefs = "@"//arcs1
+	else
+	    arcrefs = arctable
+	arcref1 = ""
+
+	# Rather than always have switches on the logfile and verbose flags
+	# we use TEE and set a file to "dev$null" if output is not desired.
+	# We must check for the null string to signify no logfile.
+
+	tee.append = yes
+	if (logfile == "")
+	    log1 = "dev$null"
+	else
+	    log1 = logfile
+	if (verbose)
+	    log2 = "STDOUT"
+	else
+	    log2 = "dev$null"
+
+	# If the update switch is used changes in the calibration data can
+	# cause images to be reprocessed (if they are in the object list).
+	# Possible changes are in the dispersion solution and sensitivity
+	# function.  The newarcs flag is used to only go through the arc
+	# image headers once setting the reference spectrum, airmass, and UT.
+
+	newdisp = no
+	newsens = no
+	newarcs = yes
+	fluxcal1 = fluxcal
+
+	# Check if there are aperture definitions in the database and
+	# define them if needed.  This is interactive.
+
+	print ("Define object apertures", >> log1)
+	if (resize)
+	    apslitproc.ansresize = "YES"
+	else
+	    apslitproc.ansresize = "NO"
+	if (quicklook) {
+	    apslitproc.ansedit = "NO"
+	    apslitproc.ansfittrace = "NO"
+	} else {
+	    apslitproc.ansedit = "yes"
+	    apslitproc.ansfittrace = "yes"
+	}
+	if (redo) {
+	    delete (database//"/ap//@"//objects, verify=no, >& "dev$null")
+	    apslitproc ("@"//objects, references="", ansfind="YES",
+		ansrecenter="NO", anstrace="YES", ansextract="NO")
+	} else
+	    apslitproc ("@"//objects, references="NEW", ansfind="YES",
+		ansrecenter="NO", anstrace="YES", ansextract="NO")
+	if (dispcor && fluxcal1) {
+	    if (redo) {
+		delete (database//"/ap//@"//standards, verify=no, >& "dev$null")
+		apslitproc ("@"//standards, references="", ansfind="YES",
+		    ansrecenter="NO", anstrace="YES", ansextract="NO")
+	    } else
+		apslitproc ("@"//standards, references="NEW", ansfind="YES",
+		    ansrecenter="NO", anstrace="YES", ansextract="NO")
+	}
+
+	# Initialize APSLITPROC.
+	apslitproc.saturation = INDEF
+	apslitproc.references = ""
+	apslitproc.profiles = ""
+	apslitproc.ansrecenter = "NO"
+	apslitproc.ansresize = "NO"
+	apslitproc.ansedit = "NO"
+	apslitproc.anstrace = "NO"
+	apslitproc.ansfittrace = "NO"
+	apslitproc.ansextract = "YES"
+	apslitproc.ansreview = "NO"
+
+	# Initialize REIDENTIFY
+	if (quicklook)
+	    reidentify.answer = "NO"
+	else
+	    reidentify.answer = "yes"
+
+	if (splot && !quicklook) {
+	    splot1 = yes
+	    splot2 = yes
+	} else {
+	    splot1 = no
+	    splot2 = no
+	}
+
+	# If not dispersion correcting we can go directly to extracting
+	# the object spectra.  The reference arcs are the first on
+	# the arc lists.  The processing of the reference arcs is done
+	# by the task SARCREFS.
+
+	if (dispcor) {
+	    fd1 = arcs1
+	    fd2 = objects
+	    if (fscan (fd1, arcref1) == EOF)
+		error (1, "No reference arcs")
+	    fd1 = ""
+	    if (fscan (fd2, spec) == EOF)
+		error (1, "No object spectra for arc reference")
+	    fd2 = ""
+	    i = strlen (arcref1)
+	    if (!access (arcref1 // imtype)) {
+		printf ("Arc reference spectrum not found - %s%s\n",
+		    arcref1, imtype) | scan (err)
+		error (1, err // "\nCheck setting of imtype")
+	    }
+	    arcref1ms = arcref1 // mstype
+	    if (redo && access (arcref1ms))
+	        imdelete (arcref1ms, verify=no)
+	    apslitproc.references = spec
+	    sarcrefs (arcref1, crval, cdelt, done, log1, log2)
+	    apslitproc.references = ""
+
+	    if (fluxcal1)
+		sfluxcal (standards, arcs1, arcref1, arcrefs,
+		    redo, update, extcor, done, log1, log2)
+	}
+
+	# Now we are ready to process the object spectra.
+
+	reextract = redo || (update && newdisp)
+	fd1 = objects
+	while (fscan (fd1, spec) != EOF) {
+	    i = strlen (spec)
+	    if (i > n && substr (spec, i-n+1, i) == imtype)
+		spec = substr (spec, 1, i-n)
+	    
+	    # Check if previously done; i.e. arc.
+	    if (access (done)) {
+	        fd2 = done
+	        while (fscan (fd2, specms) != EOF)
+		    if (spec == specms)
+		        break
+	        if (spec == specms)
+		    next
+	        fd2 = ""
+	    }
+	    if (!access (spec // imtype)) {
+		print ("Object spectrum not found - " // spec // imtype) |
+		    tee (log1)
+		print ("Check setting of imtype")
+		next
+	    }
+	    specms = spec // mstype
+
+	    # Determine required operations from the flags and image header.
+	    extract = no
+	    disp = no
+	    ext = no
+	    flux = no
+	    if (reextract || !access (specms))
+		extract = yes
+	    else {
+		hselect (specms, "dispcor", yes, > temp)
+		hselect (specms, "ex-flag", yes, >> temp)
+		hselect (specms, "ca-flag", yes, >> temp)
+		fd2 = temp
+		if (fscan (fd2, str1) == 1) {
+		    extract = update && newdisp
+		    if (update && !newdisp)
+		        # We really should check if REFSPEC will assign
+			# different reference spectra.
+			;
+		} else
+		    disp = dispcor
+		if (fscan (fd2, str1) == 1)
+		    extract = update && !extcor
+		else
+		    ext = extcor
+		if (fscan (fd2, str1) == 1)
+		    extract = update && (!fluxcal1 || newsens)
+		else
+		    flux = fluxcal1
+		fd2 = ""; delete (temp, verify=no)
+	    }
+		
+	    if (extract) {
+		disp = dispcor
+		ext = extcor
+		flux = fluxcal1
+	    }
+
+	    # If fully processed go to the next object.
+	    if (!extract && !disp && !extcor && !flux)
+		next
+
+	    # If not interactive and the batch flag is set submit rest to batch.
+	    if (batch && !splot1 && !splot2) {
+		fd1 = ""
+		flprcache
+		sbatch.objects = objects
+		sbatch.datamax = datamax
+		sbatch.arcs1 = arcs1
+		sbatch.arcref1 = arcref1
+		sbatch.arcrefs = arcrefs
+		sbatch.done = done
+		sbatch.logfile = log1
+		sbatch.redo = reextract
+		sbatch.update = update
+		sbatch.dispcor = dispcor
+		sbatch.fluxcal1 = fluxcal1
+		sbatch.extcor = extcor
+		sbatch.newdisp = newdisp
+		sbatch.newsens = newsens
+		sbatch.newarcs = newarcs
+		dobatch = yes
+		return
+	    }
+
+	    # Process the spectrum in foreground.
+	    if (extract) {
+		if (access (specms))
+		    imdelete (specms, verify=no)
+		print ("Extract object spectrum ", spec) | tee (log1)
+		hselect (spec, "date-obs,ut,exptime", yes, > temp)
+		hselect (spec, "ra,dec,epoch,st", yes, >> temp)
+		fd2 = temp
+		if (fscan (fd2, str1, str2, str3) == 3) {
+		    setjd (spec, observatory=observatory, date="date-obs",
+			time="ut", exposure="exptime", jd="jd", hjd="",
+			ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+			>> log1)
+		    if (fscan (fd2, str1, str2, str3, str4) == 4)
+			setairmass (spec, intype="beginning",
+			    outtype="effective", exposure="exptime",
+			    observatory=observatory, show=no, update=yes,
+			    override=yes, >> log1)
+		}
+		fd2 = ""; delete (temp, verify=no)
+		apslitproc (spec, saturation=datamax)
+	    }
+
+	    if (disp) {
+		# Fix arc headers if necessary.
+		if (newarcs) {
+	    	    fd2 = arcs1
+	    	    while (fscan (fd2, arc) != EOF) {
+			hselect (arc, "date-obs,ut,exptime", yes, > temp)
+			hselect (arc, "ra,dec,epoch,st", yes, >> temp)
+			fd3 = temp
+			if (fscan (fd3, str1, str2, str3) == 3) {
+			    setjd (arc, observatory=observatory,
+				date="date-obs", time="ut", exposure="exptime",
+				jd="jd", hjd="", ljd="ljd", utdate=yes,
+				uttime=yes, listonly=no, >> log1)
+			    if (fscan (fd3, str1, str2, str3, str4) == 4)
+				setairmass (arc, intype="beginning",
+				    outtype="effective", exposure="exptime",
+				    observatory=observatory, show=no,
+				    update=yes, override=yes, >> log1)
+			}
+			fd3 = ""; delete (temp, verify=no)
+	        	hedit (arc, "refspec1", arc, add=yes, verify=no,
+		    	    show=no, update=yes)
+		    }
+	    	    fd2 = ""
+		    newarcs = no
+		}
+
+		print ("Assign arc spectra for ", spec) | tee (log1)
+		refspectra (spec, references=arcrefs,
+		    apertures="", refaps="", ignoreaps=no,
+		    select=sparams.select, sort=sparams.sort,
+		    group=sparams.group, time=sparams.time,
+		    timewrap=sparams.timewrap, override=yes, confirm=no,
+		    assign=yes, logfiles="STDOUT", verbose=no) |
+		    tee (log1, > log2)
+
+		sdoarcs (spec, arcref1, reextract, log1, no)
+
+	        hselect (specms, "refspec1", yes, > temp)
+	        fd2 = temp
+	        i = fscan (fd2, arc)
+	        fd2 = ""; delete (temp, verify=no)
+		if (i < 1)
+		    print ("No arc reference assigned for ", spec) | tee (log1)
+		else {
+	            print ("Dispersion correct ", spec) | tee (log1)
+		    dispcor (specms, "", linearize=sparams.linearize,
+			database=database, table=arcref1//mstype,
+			w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF,
+			log=sparams.log, flux=sparams.flux, samedisp=no,
+			global=no, ignoreaps=yes, confirm=no, listonly=no,
+			verbose=verbose, logfile=logfile)
+		    flpr
+		    hedit (specms, "dispcor", 0, add=yes, verify=no,
+			show=no, update=yes)
+		    disp = no
+		}
+	    }
+
+	    if (!disp) {
+	        if (ext)
+		    print ("Extinction correct ", spec) | tee (log1)
+	        if (flux)
+		    print ("Flux calibrate ", spec) | tee (log1)
+	        if (flux || ext)
+		    calibrate (specms, "", extinct=extcor, flux=fluxcal1,
+			extinction=extinction, observatory=observatory,
+			ignoreaps=yes, sensitivity="sens", fnu=sparams.fnu) |
+			tee (log1, > log2)
+	    }
+	    if (extract || disp || ext || flux) {
+		if (splot1) {
+		    print (specms, ":")
+		    str1 = anssplot
+		    if (str1 == "NO" || str1 == "YES")
+			splot1 = no
+		    if (str1 == "no" || str1 == "NO")
+			splot2 = no
+		    else
+			splot2 = yes
+		}
+		if (splot2)
+		    splot (specms)
+		else if (splot && quicklook)
+		    bplot (specms, apertures="1", band=1, graphics="stdgraph",
+			cursor="onedspec$gcurval")
+	    }
+	    print (spec, >> done)
+	}
+	fd1 = ""
+
+	if (access (done))
+	    delete (done, verify=no)
+end
diff --git a/noao/imred/src/doslit/sproc.par b/noao/imred/src/doslit/sproc.par
new file mode 100644
index 00000000..536e05e4
--- /dev/null
+++ b/noao/imred/src/doslit/sproc.par
@@ -0,0 +1,33 @@
+objects,f,a,"",,,"List of object spectra"
+arcs1,f,a,"",,,"List of arc spectra"
+arctable,f,a,"",,,"Arc assignment table (optional)"
+standards,f,a,"",,,"List of standard star spectra
+"
+crval,s,a,"INDEF",,,"Approximate wavelength"
+cdelt,s,a,"INDEF",,,"Approximate dispersion
+"
+dispcor,b,a,yes,,,"Dispersion correct spectra?"
+extcor,b,a,no,,,"Extinction correct spectra?"
+fluxcal,b,a,no,,,"Flux calibrate spectra?"
+resize,b,a,no,,,"Automatically resize apertures?"
+clean,b,a,no,,,"Detect and replace bad pixels?"
+splot,b,a,no,,,"Plot the final spectrum?"
+redo,b,a,no,,,"Redo operations if previously done?"
+update,b,a,no,,,"Update spectra if cal data changes?"
+quicklook,b,a,no,,,"Minimally interactive quick-look?"
+batch,b,a,no,,,"Extract objects in batch?"
+listonly,b,a,no,,,"List steps but don\'t process?
+"
+datamax,r,h,INDEF,,,"Max data value / cosmic ray threshold"
+anssplot,s,q,,no|yes|NO|YES,,"Splot spectrum?"
+newdisp,b,h,,,,
+newsens,b,h,,,,
+newarcs,b,h,,,,
+fluxcal1,b,h,,,,
+splot1,b,h,,,,
+splot2,b,h,,,,
+dobatch,b,h,,,,
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+fd3,*struct,h,"",,,
+mode,s,h,"ql",,,