Initial commit

18 files changed, 1707 insertions, 0 deletions

diff --git a/noao/imred/src/dofoe/Revisions b/noao/imred/src/dofoe/Revisions
new file mode 100644
index 00000000..25357644
--- /dev/null
+++ b/noao/imred/src/dofoe/Revisions
@@ -0,0 +1,47 @@
+.help revisions Jan95 noao.imred.src.dofoe
+.nf
+dofoe$batch.cl
+dofoe$proc.cl
+dofoe$response.cl
+    Error messages now hint to check imtype setting.
+    (4/15/05, Valdes)
+
+========
+V2.11.3b
+========
+
+dofoe$proc.cl
+    Modified code to eliminate goto.  This is for use with pyraf.
+    (11/21/00, Valdes)
+
+========
+V2.11.3a
+========
+
+dofoe$arcrefs.cl
+dofoe$batch.cl
+dofoe$doarcs.cl
+dofoe$listonly.cl
+dofoe$proc.cl
+dofoe$response.cl
+    Any additional qualifiers in the imtype string are stripped.
+    (8/14/97, Valdes)
+
+=========
+V2.11BETA
+=========
+
+dofoe$apsript.par
+    Made changes for the new aperture selection option.  (9/5/96, Valdes)
+
+dofoe$params.par
+dofoe$arcrefs.cl
+dofoe$doarcs.cl
+    Added "threshold" as a user parameter.  (1/16/95, Valdes)
+
+dofoe$proc.cl
+dofoe$batch.cl
+dofoe$listonly.cl
+    The test for extracted spectra based on the system keyword was failing
+    and so it was removed.  (1/16/95, Valdes)
+.endhelp
diff --git a/noao/imred/src/dofoe/apscript.par b/noao/imred/src/dofoe/apscript.par
new file mode 100644
index 00000000..c316829d
--- /dev/null
+++ b/noao/imred/src/dofoe/apscript.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,)params.line,,,>params.line
+nsum,i,h,)params.nsum,,,>params.nsum
+buffer,r,h,)params.buffer,,,">params.buffer
+
+# OUTPUT PARAMETERS
+"
+format,s,h,"echelle",,,Extracted spectra format
+extras,b,h,)params.extras,,,>params.extras
+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,)params.lower,,,>params.lower
+upper,r,h,)params.upper,,,>params.upper
+apidtable,s,h,"",,,"Aperture ID table (optional)
+
+# DEFAULT BACKGROUND PARAMETERS
+"
+b_function,s,h,)params.b_function,,,>params.b_function
+b_order,i,h,)params.b_order,,,>params.b_order
+b_sample,s,h,)params.b_sample,,,>params.b_sample
+b_naverage,i,h,)params.b_naverage,,,>params.b_naverage
+b_niterate,i,h,)params.b_niterate,,,>params.b_niterate
+b_low_reject,r,h,)params.b_low,,,>params.b_low
+b_high_reject,r,h,)params.b_high,,,>params.b_high
+b_grow,r,h,)params.b_grow,,,">params.b_grow
+
+# APERTURE CENTERING PARAMETERS
+"
+width,r,h,,0.,,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,,,,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","increasing|decreasing",,"Order of apertures
+
+# RECENTERING PARAMETERS
+"
+aprecenter,s,h,"",,,Apertures for recentering calculation
+npeaks,r,h,0.5,,,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,)params.ylevel,,,>params.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,)params.nsum,,,>params.nsum
+t_step,i,h,)params.t_step,,,>params.t_step
+t_nlost,i,h,3,1,,Number of consecutive times profile is lost before quitting
+t_width,r,h,,0.,,Profile centering width
+t_function,s,h,)params.t_function,,,>params.t_function
+t_sample,s,h,"*",,,Trace sample regions
+t_order,i,h,)params.t_order,,,>params.t_order
+t_naverage,i,h,1,,,Trace average or median
+t_niterate,i,h,)params.t_niterate,,,>params.t_niterate
+t_low_reject,r,h,)params.t_low,,,>params.t_low
+t_high_reject,r,h,)params.t_high,,,>params.t_high
+t_grow,r,h,0.,0.,,"Trace rejection growing radius
+
+# EXTRACTION PARAMETERS
+"
+background,s,h,,"none|average|median|minimum|fit",,Background to subtract
+skybox,i,h,)params.b_smooth,,,>params.b_smooth
+weights,s,h,)params.weights,,,>params.weights
+pfit,s,h,)params.pfit,,,>params.pfit
+clean,b,h,,,,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,)params.lsigma,,,>params.lsigma
+usigma,r,h,)params.usigma,,,>params.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/dofoe/arcrefs.cl b/noao/imred/src/dofoe/arcrefs.cl
new file mode 100644
index 00000000..fa8f950a
--- /dev/null
+++ b/noao/imred/src/dofoe/arcrefs.cl
@@ -0,0 +1,106 @@
+# ARCREFS -- Determine dispersion relation for reference arc.
+
+procedure arcrefs (arcref, arcaps, arcbeams, response, done, log1, log2)
+
+file	arcref
+string	arcaps
+string	arcbeams
+file	response
+file	done
+file	log1
+file	log2
+
+struct	*fd
+
+begin
+	string	arcrefec, arcec, temp, str, imtype
+	int	i, dc
+	bool	log
+
+	temp = mktemp ("tmp$iraf")
+
+	# Extract the primary arc reference spectrum.  Determine the
+	# dispersion function with ECIDENTIFY/ECREIDENTIFY.  Set the wavelength
+	# parameters with ECDISPCOR.
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	arcrefec = arcref // ".ec"
+	if (arcaps != "" || arcbeams  != "")
+	    arcec = arcref // "arc.ec"
+	else
+	    arcec = ""
+	if (!access (arcrefec//imtype)) {
+	    print ("Extract arc reference image ", arcref) | tee (log1)
+	    apscript (arcref, ansrecenter="NO", ansresize="NO", ansedit="NO",
+		anstrace="NO", background="none", clean=no, weights="none")
+	    if (response != "")
+		sarith (arcrefec, "/", response, arcrefec, w1=INDEF, w2=INDEF,
+		    apertures="", bands="", beams="", apmodulus=0, reverse=no,
+		    ignoreaps=no, format="multispec", renumber=no, offset=0,
+		    clobber=yes, merge=no, errval=0, verbose=no)
+	    if (arcec != "") {
+		scopy (arcrefec, arcec, w1=INDEF, w2=INDEF, apertures=arcaps,
+		    bands="", beams=arcbeams, apmodulus=0, offset=0,
+		    format="multispec", clobber=yes, merge=no, renumber=yes,
+		    verbose=no)
+		scopy (arcrefec, "", w1=INDEF, w2=INDEF, apertures="!"//arcaps,
+		    bands="", beams=arcbeams, apmodulus=0, offset=0,
+		    format="multispec", clobber=yes, merge=no, renumber=yes,
+		    verbose=no)
+	    }
+	}
+		    
+	# Get the dispersion parameters from the header.  These are
+	# used for all further spectra and also flag whether this
+	# spectrum has been processed.  If the parameters are missing
+	# the spectrum needs to have the dispersion function and
+	# wavelength scale determined.  The HEDIT is needed because
+	# in some cases the user may exit IDENTIFY without updating
+	# the database (if the image was deleted but the database
+	# entry was not).
+
+	hselect (arcrefec, "dc-flag", yes, > temp)
+	fd = temp
+	dc = -1
+	i = fscan (fd, dc)
+	fd = ""; delete (temp, verify=no)
+	if (dc == -1) {
+	    print ("Determine dispersion solution for ", arcref) | tee (log1)
+	    delete (database//"/ec"//arcref//".ec*", verify=no)
+	    ecidentify (arcrefec, database=database,
+		coordlist=params.coordlist, match=params.match,
+		maxfeatures=100, zwidth=10., ftype="emission",
+		fwidth=params.fwidth, cradius=params.cradius,
+		threshold=params.threshold, minsep=2.,
+		function=params.i_function, xorder=params.i_xorder,
+		yorder=params.i_yorder, niterate=params.i_niterate,
+		lowreject=params.i_low, highreject=params.i_high,
+		autowrite=yes)
+	    if (arcec != "") {
+		ecreidentify (arcec, arcrefec, shift=0., cradius=params.cradius,
+		    threshold=params.threshold, refit=yes, database=database,
+		    logfiles=log1//","//log2)
+		imdelete (arcec, verify=no)
+	    }
+	    hedit (arcrefec, "refspec1", arcref // ".ec", add=yes,
+		show=no, verify=no, update=yes)
+	}
+
+	# Dispersion correct the reference arc.  Set the newdisp flag.
+
+	if (dc == -1) {
+	    dispcor (arcrefec, "", linearize=params.linearize,
+		database=database, table="", w1=INDEF, w2=INDEF, dw=INDEF,
+		nw=INDEF, log=params.log, flux=params.flux, samedisp=no,
+		global=no, ignoreaps=no, confirm=no, listonly=no, verbose=yes,
+		logfile=log1, > log2)
+	    hedit (arcrefec, "dc-flag", 0, add=yes, verify=no,
+		show=no, update=yes)
+	    proc.newdisp = yes
+	}
+
+	print (arcref, >> done)
+end
diff --git a/noao/imred/src/dofoe/arcrefs.par b/noao/imred/src/dofoe/arcrefs.par
new file mode 100644
index 00000000..5aa35c57
--- /dev/null
+++ b/noao/imred/src/dofoe/arcrefs.par
@@ -0,0 +1,9 @@
+arcref,f,a,"",,,
+arcaps,s,a,,,,
+arcbeams,s,a,,,,
+response,f,a,"",,,
+done,f,a,"",,,
+log1,f,a,"",,,
+log2,f,a,"",,,
+fd,*struct,h,"",,,
+mode,s,h,"q",,,
diff --git a/noao/imred/src/dofoe/batch.cl b/noao/imred/src/dofoe/batch.cl
new file mode 100644
index 00000000..6adcbb04
--- /dev/null
+++ b/noao/imred/src/dofoe/batch.cl
@@ -0,0 +1,207 @@
+# BATCH -- 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 batch ()
+
+string	objects		{prompt="Object spectra"}
+real	datamax 	{prompt="Max data value / cosmic ray threshold"}
+
+file	response	{prompt="Response spectrum"}
+string	arcs		{prompt="List of arc spectra"}
+file	arcref		{prompt="Arc reference for dispersion solution"}
+string	arcrefs		{prompt="Arc references"}
+
+string	objaps		{prompt="Object apertures"}
+string	arcaps		{prompt="Arc apertures"}
+string	objbeams	{prompt="Object beam numbers"}
+string	arcbeams	{prompt="Arc beam numbers\n"}
+
+file	done		{prompt="File of spectra already done"}
+file	logfile		{prompt="Logfile"}
+
+bool	redo		{prompt="Redo operations?"}
+bool	update		{prompt="Update spectra?"}
+bool	scattered	{prompt="Subtract scattered light?"}
+bool	arcap		{prompt="Use object apertures for arcs?"}
+bool	dispcor		{prompt="Dispersion correct spectra?"}
+
+bool	newaps, newresp, newdisp, newarcs
+
+struct	*fd1, *fd2
+
+begin
+	file	temp1, temp2, spec, specec, arc, arcec
+	bool	reextract, extract, scat, disp, log
+	string	imtype, ectype, str
+	int	i, n
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	ectype = ".ec" // imtype
+	n = strlen (imtype)
+
+	temp1 = mktemp ("tmp$iraf")
+	temp2 = mktemp ("tmp$iraf")
+
+	# Initialize extraction to be noninteractive.
+	if (apscript.ansrecenter == "yes")
+	    apscript.ansrecenter = "YES"
+	else if (apscript.ansrecenter == "no")
+	    apscript.ansrecenter = "NO"
+	apscript.ansedit = "NO"
+	if (apscript.anstrace == "yes") {
+	    apscript.anstrace = "YES"
+	    apscript.ansfittrace = "NO"
+	} else if (apscript.anstrace == "no")
+	    apscript.anstrace = "NO"
+
+	reextract = redo || (update && (newaps || newresp || newdisp))
+
+	hselect (objects, "$I", yes, > temp1)
+	#sections (objects, option="fullname", > temp1)
+	fd1 = temp1
+	while (fscan (fd1, spec) != EOF) {
+	    i = strlen (spec)
+	    if (i > n && substr (spec, i-n+1, i) == imtype)
+		spec = substr (spec, 1, i-n)
+	    
+	    if (access (done)) {
+	        fd2 = done
+	        while (fscan (fd2, specec) != EOF)
+		    if (spec == specec)
+		        break
+	        if (spec == specec)
+		    next
+	        fd2 = ""
+	    }
+	    if (!access (spec // imtype)) {
+		printf ("Object spectrum not found - %s%s\nCheck setting of imtype\n", spec, imtype) | tee (log1)
+		next
+	    }
+	    specec = spec // ectype
+
+	    scat = no
+	    extract = no
+	    disp = no
+	    if (scattered) {
+		hselect (spec, "apscatte", yes, > temp2)
+		fd2 = temp2
+		if (fscan (fd2, str) < 1)
+		    scat = yes
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+	    if (reextract || !access (specec) || (update && scat))
+		extract = yes
+	    else {
+		hselect (specec, "dc-flag", yes, > temp2)
+		fd2 = temp2
+		if (fscan (fd2, str) == 1) {
+		    extract = update && newdisp
+		    if (update && !newdisp)
+		        # We really should check if REFSPEC will assign
+			# different reference spectra.
+			;
+		} else
+		    disp = dispcor
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+		
+	    if (extract)
+		disp = dispcor
+
+	    if (extract) {
+		if (access (specec))
+		    imdelete (specec, verify=no)
+		if (scat) {
+		    print ("Subtract scattered light in ", spec, >> logfile)
+		    apscript (spec, output="", ansextract="NO",
+			ansscat="YES", anssmooth="YES", verbose=no)
+		}
+		print ("Extract object spectrum ", spec, >> logfile)
+		setjd (spec, observatory=observatory, date="date-obs",
+		    time="ut", exposure="exptime", jd="jd", hjd="",
+		    ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+		    >> logfile)
+	        setairmass (spec, intype="beginning",
+		    outtype="effective", exposure="exptime",
+		    observatory=observatory, show=no, update=yes,
+		    override=yes, >> logfile)
+		apscript (spec, saturation=datamax, verbose=no)
+		if (response != "")
+		    sarith (specec, "/", response, specec, w1=INDEF, w2=INDEF,
+			apertures="", bands="", beams="", apmodulus=0,
+			reverse=no, ignoreaps=no, format="multispec",
+			renumber=no, offset=0, clobber=yes, merge=no,
+			errval=0, verbose=no)
+	    }
+
+	    if (disp) {
+		# Fix arc headers if necessary.
+		if (newarcs) {
+	    	    sections (arcs, option="fullname", >temp2)
+		    setjd ("@"//temp2, observatory=observatory, date="date-obs",
+			time="ut", exposure="exptime", jd="jd", hjd="",
+			ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+			>> logfile)
+	    	    setairmass ("@"//temp2, intype="beginning",
+			outtype="effective", exposure="exptime",
+			observatory=observatory, show=no, update=yes,
+			override=yes, >> logfile)
+		    delete (temp2, verify=no)
+		    hselect (arcs, "$I", yes, >temp2)
+	    	    fd2 = temp2
+	    	    while (fscan (fd2, arc) != EOF) {
+	        	i = strlen (arc)
+	        	if (i > n && substr (arc, i-n+1, i) == imtype)
+	            	    arc = substr (arc, 1, i-n)
+	        	hedit (arc, "refspec1", arc, add=yes, verify=no,
+		    	    show=no, update=yes)
+	        	hedit (arc, "arctype", "henear", add=yes, verify=no,
+		    	    show=no, update=yes)
+	    	    }
+	    	    fd2 = ""; delete (temp2, verify=no)
+		    newarcs = no
+		}
+
+		print ("Assign arc spectra for ", spec, >> logfile)
+		refspectra (spec, references=arcrefs,
+		    apertures="", refaps="", ignoreaps=no,
+		    select=params.select, sort=params.sort,
+		    group=params.group, time=params.time,
+		    timewrap=params.timewrap, override=yes, confirm=no,
+		    assign=yes, logfiles="STDOUT", verbose=no,
+		    >> logfile)
+
+		doarcs (spec, response, arcref, arcaps, arcbeams, reextract,
+		    arcap, logfile, yes)
+
+	        hselect (specec, "refspec1", yes, > temp2)
+	        fd2 = temp2
+	        i = fscan (fd2, arc)
+	        fd2 = ""; delete (temp2, verify=no)
+		if (i < 1)
+		    print ("No arc reference assigned for ", spec, >> logfile)
+		else {
+	            print ("Dispersion correct ", spec, >> logfile)
+		    dispcor (specec, "", linearize=params.linearize,
+			database=database, table=arcref//ectype,
+			w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF,
+			log=params.log, samedisp=no, flux=params.flux,
+			global=no, ignoreaps=no, confirm=no, listonly=no,
+			verbose=no, logfile=logfile)
+		    hedit (specec, "dc-flag", 0, add=yes, verify=no,
+			show=no, update=yes)
+		    disp = no
+		}
+	    }
+	}
+	fd1 = ""; delete (temp1, verify=no)
+
+	if (access (done))
+	    delete (done, verify=no)
+
+	flprcache (0)
+end
diff --git a/noao/imred/src/dofoe/batch.par b/noao/imred/src/dofoe/batch.par
new file mode 100644
index 00000000..81b8c8ae
--- /dev/null
+++ b/noao/imred/src/dofoe/batch.par
@@ -0,0 +1,25 @@
+objects,s,h,,,,"Object spectra"
+datamax,r,h,,,,"Max data value / cosmic ray threshold"
+response,f,h,"",,,"Response spectrum"
+arcs,s,h,,,,"List of arc spectra"
+arcref,f,h,"",,,"Arc reference for dispersion solution"
+arcrefs,s,h,,,,"Arc references"
+objaps,s,h,,,,"Object apertures"
+arcaps,s,h,,,,"Arc apertures"
+objbeams,s,h,,,,"Object beam numbers"
+arcbeams,s,h,,,,"Arc beam numbers
+"
+done,f,h,"",,,"File of spectra already done"
+logfile,f,h,"",,,"Logfile"
+redo,b,h,,,,"Redo operations?"
+update,b,h,,,,"Update spectra?"
+scattered,b,h,,,,"Subtract scattered light?"
+arcap,b,h,,,,"Use object apertures for arcs?"
+dispcor,b,h,,,,"Dispersion correct spectra?"
+newaps,b,h,,,,
+newresp,b,h,,,,
+newdisp,b,h,,,,
+newarcs,b,h,,,,
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/dofoe/doarcs.cl b/noao/imred/src/dofoe/doarcs.cl
new file mode 100644
index 00000000..653146b1
--- /dev/null
+++ b/noao/imred/src/dofoe/doarcs.cl
@@ -0,0 +1,167 @@
+# DOARCS -- Determine dispersion relation for spectrum based on reference arcs.
+
+procedure doarcs (spec, response, arcref, arcaps, arcbeams, reextract,
+	arcap, logfile, batch)
+
+file	spec
+file	response
+file	arcref
+string	arcaps
+string	arcbeams
+bool	reextract
+bool	arcap
+file	logfile
+bool	batch
+
+struct	*fd
+
+begin
+	string	imtype, ectype
+	int	i, j, k, n
+	file	temp, arc1, arc2, str1, str2, arctype, apref, arc, arcec, logs
+	file	specec, specarc
+	bool	verbose1
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	ectype = ".ec" // imtype
+	n = strlen (imtype)
+
+	temp = mktemp ("tmp$iraf")
+
+	if (batch)
+	    verbose1 = no
+	else
+	    verbose1 = verbose
+	if (verbose1)
+	    logs = logfile//",STDOUT"
+	else
+	    logs = logfile
+
+	# Separate simultaneous arc from object.
+	specec = spec // ".ec"
+	if (arcaps != "" || arcbeams != "")
+	    specarc = spec // "arc1.ec"
+	else
+	     specarc = ""
+	if (specarc != "") {
+	    scopy (specec, specarc, w1=INDEF, w2=INDEF, apertures=arcaps,
+		bands="", beams="", apmodulus=0, format="multispec",
+		renumber=yes, offset=0, clobber=yes, merge=no, verbose=no)
+	    scopy (specec, "", w1=INDEF, w2=INDEF, apertures="!"//arcaps,
+		bands="", beams="", apmodulus=0, format="multispec",
+		renumber=yes, offset=0, clobber=yes, merge=no, verbose=no)
+	}
+
+	for (j=1; j<=2; j+=1) {
+	    # 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
+	    k = fscan (fd, arc1, str1)
+	    fd = ""; delete (temp, verify=no)
+	    if (k < 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.
+
+	    if (arcap &&
+		(apscript.ansrecenter=="yes" || apscript.anstrace=="yes" ||
+		 apscript.ansrecenter=="YES" || apscript.anstrace=="YES")) {
+		arc2 = spec // arc1
+		apref = spec
+		if (access (arc2//ectype))
+		    imdelete (arc2//ectype, verify=no)
+		delete (database//"/ec"//arc2//".ec*", verify = no)
+	    } else {
+		arc2 = arc1
+		apref = apscript.references
+	    }
+
+	    # Arcs are reidentified using the user refit option.
+	    #	Also internal arcs are checked if HENEAR.
+
+	    hselect (arc1, "arctype", yes, > temp)
+	    fd = temp
+	    i = fscan (fd, arctype)
+	    fd = ""; delete (temp, verify=no)
+    
+	    # Extract and determine dispersion function if necessary.
+	    if (!access (arc2//ectype)) {
+		if (!batch)
+		    print ("Extract and reidentify arc spectrum ", arc1)
+		print ("Extract and reidentify arc spectrum ", arc1, >> logfile)
+		apscript (arc1, output=arc2//".ec", references=apref,
+		    ansrecenter="NO", ansresize="NO", ansedit="NO",
+		    anstrace="NO", background="none",
+		    clean=no, weights="none", verbose=verbose1)
+		if (response != "")
+		    sarith (arc2//".ec", "/", response, arc2//".ec", w1=INDEF,
+			w2=INDEF, apertures="", bands="", beams="", apmodulus=0,
+			reverse=no, ignoreaps=no, format="multispec",
+			renumber=no, offset=0, clobber=yes, merge=no, errval=0,
+			verbose=no)
+
+		if (arcaps != "") {
+		    scopy (arc2//".ec", arc2//"arc.ec", w1=INDEF, w2=INDEF,
+			apertures=arcaps, bands="",  beams="", apmodulus=0,
+			format="multispec", renumber=yes, offset=0,
+			clobber=yes, merge=no, verbose=no)
+		    scopy (arc2//".ec", "", w1=INDEF, w2=INDEF,
+			apertures="!"//arcaps, bands="",  beams="",
+			apmodulus=0, format="multispec", renumber=yes, offset=0,
+			clobber=yes, merge=no, verbose=no)
+		    ecreidentify (arc2//"arc.ec", arcref//"arc.ec", shift=0.,
+			cradius=params.cradius, threshold=params.threshold,
+			refit=yes, database=database, logfiles=logs)
+		    imdelete (arc2//"arc.ec", verify=no)
+		}
+		ecreidentify (arc2//".ec", arcref//".ec", shift=0.,
+		    cradius=params.cradius, threshold=params.threshold,
+		    refit=yes, database=database, logfiles=logs)
+
+		# If not reextracting arcs based on object apertures
+		# then save the extracted arc to avoid doing it again.
+
+		if (arc1 != arc2)
+		    imdelete (arc2//".ec", verify=no)
+	    }
+    
+	    # Set the REFSPEC parameters for echelle spectrum.
+	    if (k == 1)
+		hedit (specec, "refspec"//j, arc2//".ec", add=yes,
+		    verify=no, show=no, update=yes)
+	    else
+		hedit (specec, "refspec"//j, arc2//".ec "//str1,
+		    add=yes, verify=no, show=no, update=yes)
+
+	    # Check for arc fibers in object spectra.
+	    if (specarc != "") {
+		if (!batch)
+		    print ("Reidentify arc fibers in ", spec,
+			" with respect to ", arc1)
+		print ("Reidentify arc fibers in ", spec,
+		    " with respect to ", arc1, >> logfile)
+		delete (database//"/ec"//specarc, verify = no, >& "dev$null")
+		ecreidentify (specarc, arc2//"arc.ec", shift=0.,
+		    cradius=params.cradius, threshold=params.threshold,
+		    refit=no, database=database, logfiles=logs)
+		hedit (specec, "refshft"//j, specarc,
+		    add=yes, verify=no, show=no, update=yes)
+		imrename (specarc, spec//"arc"//j+1//".ec", verbose=no)
+		specarc = spec // "arc" // j+1 // ".ec"
+	    }
+	}
+	if (specarc != "")
+	    imdelete (specarc, verify=no)
+end
diff --git a/noao/imred/src/dofoe/doarcs.par b/noao/imred/src/dofoe/doarcs.par
new file mode 100644
index 00000000..e399380b
--- /dev/null
+++ b/noao/imred/src/dofoe/doarcs.par
@@ -0,0 +1,11 @@
+spec,f,a,"",,,
+response,f,a,"",,,
+arcref,f,a,"",,,
+arcaps,s,a,,,,
+arcbeams,s,a,,,,
+reextract,b,a,,,,
+arcap,b,a,,,,
+logfile,f,a,"",,,
+batch,b,a,,,,
+fd,*struct,h,"",,,
+mode,s,h,"q",,,
diff --git a/noao/imred/src/dofoe/dofoe.cl b/noao/imred/src/dofoe/dofoe.cl
new file mode 100644
index 00000000..ae1c2ca8
--- /dev/null
+++ b/noao/imred/src/dofoe/dofoe.cl
@@ -0,0 +1,89 @@
+# DOFOE -- Process FOE spectra from 2D to wavelength calibrated 1D.
+#
+# The task PROC does all of the interactive work and BATCH does the
+# background work.  This procedure is organized this way to minimize the
+# dictionary space when the background task is submitted.
+
+procedure dofoe (objects)
+
+string	objects = ""		{prompt="List of object spectra"}
+
+file	apref = ""		{prompt="Aperture reference spectrum"}
+file	flat = ""		{prompt="Flat field spectrum"}
+string	arcs = ""		{prompt="List of arc spectra"}
+file	arctable = ""		{prompt="Arc assignment table (optional)\n"}
+
+string	readnoise = "0."	{prompt="Read out noise sigma (photons)"}
+string	gain = "1."		{prompt="Photon gain (photons/data number)"}
+real	datamax = INDEF		{prompt="Max data value / cosmic ray threshold"}
+int	norders = 12		{prompt="Number of orders"}
+real	width = 4.		{prompt="Width of profiles (pixels)"}
+string	arcaps = "2x2"		{prompt="Arc apertures\n"}
+
+bool	fitflat = yes		{prompt="Fit and ratio flat field spectrum?"}
+string	background = "none"	{prompt="Background to subtract",
+			 enum="none|scattered|average|median|minimum|fit"}
+bool	clean = no		{prompt="Detect and replace bad pixels?"}
+bool	dispcor = yes		{prompt="Dispersion correct spectra?"}
+bool	redo = no		{prompt="Redo operations if previously done?"}
+bool	update = no		{prompt="Update spectra if cal data changes?"}
+bool	batch = no		{prompt="Extract objects in batch?"}
+bool	listonly = no		{prompt="List steps but don't process?\n"}
+
+pset	params = ""		{prompt="Algorithm parameters"}
+
+begin
+	int	i, j
+	bool	scattered
+
+	# Remove any leading whitespace from parameters that might be null.
+	if (logfile != "") {
+	    j = strlen (logfile)
+	    for (i=1; i<=j && substr(logfile,i,i)==" "; i+=1);
+	    logfile = substr (logfile, i, j)
+	}
+	if (flat != "") {
+	    j = strlen (flat)
+	    for (i=1; i<=j && substr(flat,i,i)==" "; i+=1);
+	    flat = substr (flat, i, j)
+	}
+	if (arctable != "") {
+	    j = strlen (arctable)
+	    for (i=1; i<=j && substr(arctable,i,i)==" "; i+=1);
+	    arctable = substr (arctable, i, j)
+	}
+	if (arcaps != "") {
+	    j = strlen (arcaps)
+	    for (i=1; i<=j && substr(arcaps,i,i)==" "; i+=1);
+	    arcaps = substr (arcaps, i, j)
+	}
+
+	apscript.readnoise = readnoise
+	apscript.gain = gain
+	if (arcaps != "")
+	    i = 2 * norders
+	else
+	    i = norders
+	apscript.nfind = i
+	apscript.width = width
+	apscript.t_width = width
+	apscript.radius = width
+	apscript.clean = clean
+	if (background == "scattered") {
+	    scattered = yes
+	    apscript.background = "none"
+	} else {
+	    scattered = no
+	    apscript.background = background
+	}
+	proc.datamax = datamax
+
+	proc (objects, apref, flat, arcs, arctable, i, "", arcaps,
+	    "", "", fitflat, yes, scattered, no, no, no, clean, dispcor,
+	    no, redo, update, batch, listonly)
+
+	if (proc.dobatch) {
+	    print ("-- Do remaining spectra as a batch job --")
+	    print ("batch&batch") | cl
+	}
+end
diff --git a/noao/imred/src/dofoe/dofoe.par b/noao/imred/src/dofoe/dofoe.par
new file mode 100644
index 00000000..9853b7e5
--- /dev/null
+++ b/noao/imred/src/dofoe/dofoe.par
@@ -0,0 +1,24 @@
+objects,s,a,"",,,"List of object spectra"
+apref,f,h,"",,,"Aperture reference spectrum"
+flat,f,h,"",,,"Flat field spectrum"
+arcs,s,h,"",,,"List of arc spectra"
+arctable,f,h,"",,,"Arc assignment table (optional)
+"
+readnoise,s,h,"0.",,,"Read out noise sigma (photons)"
+gain,s,h,"1.",,,"Photon gain (photons/data number)"
+datamax,r,h,INDEF,,,"Max data value / cosmic ray threshold"
+norders,i,h,12,,,"Number of orders"
+width,r,h,4.,,,"Width of profiles (pixels)"
+arcaps,s,h,"2x2",,,"Arc apertures
+"
+fitflat,b,h,yes,,,"Fit and ratio flat field spectrum?"
+background,s,h,"none",none|scattered|average|median|minimum|fit,,"Background to subtract"
+clean,b,h,no,,,"Detect and replace bad pixels?"
+dispcor,b,h,yes,,,"Dispersion correct spectra?"
+redo,b,h,no,,,"Redo operations if previously done?"
+update,b,h,no,,,"Update spectra if cal data changes?"
+batch,b,h,no,,,"Extract objects in batch?"
+listonly,b,h,no,,,"List steps but don\'t process?
+"
+params,pset,h,"",,,"Algorithm parameters"
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/dofoe/dofoetasks.cl b/noao/imred/src/dofoe/dofoetasks.cl
new file mode 100644
index 00000000..4c602be0
--- /dev/null
+++ b/noao/imred/src/dofoe/dofoetasks.cl
@@ -0,0 +1,19 @@
+#{ DOFOE tasks
+
+task	dofoe		= "dofoe$dofoe.cl"
+task	params		= "dofoe$params.par"
+
+task	proc		= "dofoe$proc.cl"
+task	response	= "dofoe$response.cl"
+task	arcrefs		= "dofoe$arcrefs.cl"
+task	doarcs		= "dofoe$doarcs.cl"
+task	batch		= "dofoe$batch.cl"
+task	listonly	= "dofoe$listonly.cl"
+
+task	apscript	= "dofoe$x_apextract.e"
+
+# Hide tasks from the user
+hidetask apscript
+hidetask params, proc, batch, arcrefs, doarcs, listonly, response
+
+keep
diff --git a/noao/imred/src/dofoe/listonly.cl b/noao/imred/src/dofoe/listonly.cl
new file mode 100644
index 00000000..bae8aff8
--- /dev/null
+++ b/noao/imred/src/dofoe/listonly.cl
@@ -0,0 +1,167 @@
+# LISTONLY -- 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 listonly (objects, apref, flat, arcs, scattered, dispcor,
+	redo, update)
+
+string	objects = ""		{prompt="List of object spectra"}
+file	apref = ""		{prompt="Aperture reference spectrum"}
+file	flat = ""		{prompt="Flat field spectrum"}
+string	arcs = ""		{prompt="List of arc spectra"}
+
+bool	scattered		{prompt="Subtract scattered light?"}
+bool	dispcor			{prompt="Dispersion correct spectra?"}
+bool	redo			{prompt="Redo operations if previously done?"}
+bool	update			{prompt="Update spectra if cal data changes?"}
+
+struct	*fd1
+struct	*fd2
+
+begin
+	string	imtype, ectype
+	string	spec, arcref
+	string	specec, arcrefec, response
+	string	temp1, temp2, done, str
+	bool	reextract, newaps, newresp, newdisp, extract, disp, scat
+	int	i, j, n
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	ectype = ".ec" // imtype
+	n = strlen (imtype)
+
+	temp1 = mktemp ("tmp$iraf")
+	temp2 = mktemp ("tmp$iraf")
+	done = mktemp ("tmp$iraf")
+
+	newaps = no
+	newresp = no
+	newdisp = no
+
+	i = strlen (apref)
+	if (i > n && substr (apref, i-n+1, i) == imtype)
+	    apref = substr (apref, 1, i-n)
+
+	reextract = redo
+	if (reextract || !access (database // "/ap" // apref)) {
+	    print ("Set reference aperture for ", apref)
+	    newaps = yes
+	}
+
+	if (flat != "") {
+	    response = flat
+	    i = strlen (response)
+	    if (i > n && substr (response, i-n+1, i) == imtype)
+	        response = substr (response, 1, i-n)
+	    response = response // "norm.ec"
+
+	    reextract = redo || (update && newaps)
+	    scat = no
+	    if (scattered) {
+		hselect (flat, "apscatte", yes, > temp2)
+		fd2 = temp2
+		if (fscan (fd2, str) < 1)
+		    scat = yes
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+	    if (reextract || !access (response // imtype) || (update && scat)) {
+		if (scat)
+		    print ("Subtract scattered light from ", flat)
+	        print ("Create response function ", response)
+	        newresp = yes
+	    }
+	}
+
+	if (dispcor) {
+	    hselect (arcs, "$I", yes, > temp1)
+	    #sections (arcs, option="fullname", > temp1)
+	    fd1 = temp1
+	    i = fscan (fd1, arcref)
+	    if (i < 1)
+		error (1, "No reference arcs")
+	    fd1 = ""; delete (temp1, verify=no)
+	    i = strlen (arcref)
+	    if (i > n && substr (arcref, i-n+1, i) == imtype)
+	        arcref = substr (arcref, 1, i-n)
+	    arcrefec = arcref // ectype
+
+	    reextract = redo || (update && newaps)
+	    if (reextract || !access (arcrefec)) {
+	        print ("Extract arc reference image ", arcref)
+	        print ("Determine dispersion solution for ", arcref)
+	        newdisp = yes
+	    } else {
+		hselect (arcrefec, "refspec1,dc-flag", yes, > temp1)
+	        fd1 = temp1
+	        i = fscan (fd1, str, j)
+	        fd1 = ""; delete (temp1, verify=no)
+	        if (i < 1) {
+	            print ("Determine dispersion solution for ", arcref)
+	            newdisp = yes
+	        }
+	    }
+	    print (arcref, > done)
+	}
+
+	reextract = redo || (update && (newaps || newresp || newdisp))
+	hselect (objects, "$I", yes, > temp1)
+	#sections (objects, option="fullname", > temp1)
+	fd1 = temp1
+	while (fscan (fd1, spec) != EOF) {
+	    if (i > n && substr (spec, i-n+1, i) == imtype)
+	        spec = substr (spec, 1, i-n)
+
+	    if (access (done)) {
+	        fd2 = done
+	        while (fscan (fd2, specec) != EOF)
+		    if (spec == specec)
+		        break
+	        if (spec == specec)
+		    next
+	        fd2 = ""
+	    }
+
+	    specec = spec // ectype
+
+	    scat = no
+	    extract = no
+	    disp = no
+	    if (scattered) {
+		hselect (spec, "apscatte", yes, > temp2)
+		fd2 = temp2
+		if (fscan (fd2, str) < 1)
+		    scat = yes
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+	    if (reextract || !access (specec) || (update && scat)) {
+		extract = yes
+	    } else {
+		hselect (specec, "dc-flag", yes, > temp2)
+		fd2 = temp2
+		extract = update && newaps
+		if (fscan (fd2, str) == 1)
+		    extract = update && newdisp
+		else
+		    disp = yes
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+		
+	    if (extract)
+		disp = dispcor
+		    
+	    if (scat)
+		print ("Subtract scattered light from ", spec)
+	    if (extract)
+		print ("Extract object spectrum ", spec)
+	    if (disp)
+	        print ("Dispersion correct ", spec)
+	}
+	fd1 = ""; delete (temp1, verify=no)
+
+	if (access (done))
+	    delete (done, verify=no)
+end
diff --git a/noao/imred/src/dofoe/listonly.par b/noao/imred/src/dofoe/listonly.par
new file mode 100644
index 00000000..a05b8f94
--- /dev/null
+++ b/noao/imred/src/dofoe/listonly.par
@@ -0,0 +1,11 @@
+objects,s,a,"",,,"List of object spectra"
+apref,f,a,"",,,"Aperture reference spectrum"
+flat,f,a,"",,,"Flat field spectrum"
+arcs,s,a,"",,,"List of arc spectra"
+scattered,b,a,,,,"Subtract scattered light?"
+dispcor,b,a,,,,"Dispersion correct spectra?"
+redo,b,a,,,,"Redo operations if previously done?"
+update,b,a,,,,"Update spectra if cal data changes?"
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+mode,s,h,"q",,,
diff --git a/noao/imred/src/dofoe/params.par b/noao/imred/src/dofoe/params.par
new file mode 100644
index 00000000..fafb71f7
--- /dev/null
+++ b/noao/imred/src/dofoe/params.par
@@ -0,0 +1,69 @@
+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 LIMITS --"
+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,2,,,"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
+
+-- DEFAULT BACKGROUND PARAMETERS --"
+buffer,r,h,1.,0.,,Buffer distance from apertures
+apscat1,pset,h,"",,,Fitting parameters across the dispersion
+apscat2,pset,h,"",,,Fitting parameters along the dispersion
+b_function,s,h,"legendre","chebyshev|legendre|spline1|spline3",,Background function
+b_order,i,h,2,,,Background function order
+b_sample,s,h,"-10:-6,6:10",,,Background sample regions
+b_naverage,i,h,-3,,,Background average or median
+b_niterate,i,h,0,0,,Background rejection iterations
+b_low,r,h,3.,0.,,Background lower rejection sigma
+b_high,r,h,3.,0.,,Background upper rejection sigma
+b_grow,r,h,0.,0.,,Background rejection growing radius
+b_smooth,i,h,10,,,"Background smoothing length
+
+-- APERTURE EXTRACTION PARAMETERS --"
+weights,s,h,"none","none|variance",,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
+
+-- FLAT FIELD FUNCTION FITTING PARAMETERS --"
+f_interactive,b,h,no,,,"Fit flat field interactively?"
+f_function,s,h,"spline3",spline3|legendre|chebyshev|spline1,,"Fitting function"
+f_order,i,h,20,1,,"Fitting function order
+
+-- ARC DISPERSION FUNCTION PARAMETERS --"
+threshold,r,h,10.,0.,,"Minimum line contrast threshold"
+coordlist,f,h,linelists$thar.dat,,,"Line list"
+match,r,h,1.,,,"Line list matching limit in Angstroms"
+fwidth,r,h,4.,,,"Arc line widths in pixels"
+cradius,r,h,4.,,,Centering radius in pixels
+i_function,s,h,"chebyshev","legendre|chebyshev",,"Echelle coordinate function"
+i_xorder,i,h,3,1,,Order of coordinate function along dispersion
+i_yorder,i,h,3,1,,Order of coordinate function across dispersion
+i_niterate,i,h,3,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?
+
+-- 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?"
diff --git a/noao/imred/src/dofoe/proc.cl b/noao/imred/src/dofoe/proc.cl
new file mode 100644
index 00000000..75740bda
--- /dev/null
+++ b/noao/imred/src/dofoe/proc.cl
@@ -0,0 +1,464 @@
+# PROC -- Process echelle fiber spectra
+# This program combines the operations of extraction, flat fielding, and
+# dispersion correction in as simple and noninteractive way as possible.
+# It supports a second simultaneous arc fiber.  The data must all share
+# the same position on the 2D image and the same dispersion solution
+# apart from small instrumental changes which can be tracked
+# automatically.  The apertures must be identified sequentially and must
+# be properly paired if a arc fiber is used.
+# 
+# If every needed on could add sky subtraction (with a sky fiber) and
+# fluxing following the model of the multifiber packages.
+
+procedure proc (objects, apref, flat, arcs, arctable, naps, objaps, arcaps,
+	objbeams, arcbeams, fitflat, recenter, scattered, edit, trace, arcap,
+	clean, dispcor, splot, redo, update, batch, listonly)
+
+string	objects			{prompt="List of object spectra"}
+
+file	apref			{prompt="Aperture reference spectrum"}
+file	flat			{prompt="Flat field spectrum"}
+string	arcs			{prompt="List of arc spectra"}
+file	arctable		{prompt="Arc assignment table (optional)\n"}
+
+int	naps			{prompt="Number of apertures"}
+string	objaps			{prompt="Object apertures"}
+string	arcaps			{prompt="Arc apertures"}
+string	objbeams		{prompt="Object beam numbers"}
+string	arcbeams		{prompt="Arc beam numbers\n"}
+
+bool	fitflat			{prompt="Fit and ratio flat field spectrum?"}
+bool	recenter		{prompt="Recenter object apertures?"}
+bool	scattered		{prompt="Subtract scattered light?"}
+bool	edit			{prompt="Edit/review object apertures?"}
+bool	trace			{prompt="Trace object spectra?"}
+bool	arcap			{prompt="Use object apertures for arcs?"}
+bool	clean			{prompt="Detect and replace bad pixels?"}
+bool	dispcor			{prompt="Dispersion correct spectra?"}
+bool	splot			{prompt="Plot the final spectrum?"}
+bool	redo			{prompt="Redo operations if previously done?"}
+bool	update			{prompt="Update spectra if cal data changes?"}
+bool	batch			{prompt="Extract objects in batch?"}
+bool	listonly		{prompt="List steps but don't process?\n"}
+
+real	datamax = INDEF		{prompt="Max data value / cosmic ray threshold"}
+
+bool	newaps, newresp, newdisp, newarcs, dobatch
+
+string	anssplot = "yes"	{prompt="Splot spectrum?", mode="q",
+				 enum="no|yes|NO|YES"}
+
+struct	*fd1, *fd2
+
+begin
+	string	imtype, ectype
+	string	arcref, spec, arc
+	string	arcrefec, specec, arcec, response
+	string	temp1, temp2, done
+	string	str1, objs, arcrefs, log1, log2
+	bool	reextract, extract, scat, disp, disperr, log
+	bool	splot1, splot2
+	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) {
+	    listonly (objects, apref, flat, arcs, scattered, dispcor,
+		redo, update)
+	    bye
+	}
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	ectype = ".ec" // imtype
+	n = strlen (imtype)
+
+	# Get query parameter.
+	objs = objects
+	if (arctable == "")
+	    arcrefs = arcs
+	else
+	    arcrefs = arctable
+	arcref = ""
+
+	# Temporary files used repeatedly in this script.  Under some
+	# abort circumstances these files may be left behind.
+
+	temp1 = mktemp ("tmp$iraf")
+	temp2 = mktemp ("tmp$iraf")
+	done = mktemp ("tmp$iraf")
+
+	# 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 aperture definitions,
+	# response function, 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.
+
+	newaps = no
+	newresp = no
+	newdisp = no
+	newarcs = yes
+
+	# Check if there are aperture definitions in the database and
+	# define them if needed.  This is usually somewhat interactive.
+	# Delete the database entry to start fresh if we enter this
+	# because of a redo.  Set the newaps flag in case an update is
+	# desired.
+
+	i = strlen (apref)
+	if (i > n && substr (apref, i-n+1, i) == imtype)
+	    apref = substr (apref, 1, i-n)
+
+	# Initialize
+	apscript.saturation = INDEF
+	apscript.references = apref
+	apscript.profiles = ""
+	apscript.nfind = naps
+	apscript.clean = clean
+	if (splot) {
+	    splot1 = yes
+	    splot2 = yes
+	} else {
+	    splot1 = no
+	    splot2 = no
+	}
+
+	reextract = redo
+	if (reextract || !access (database // "/ap" // apref)) {
+	    if (!access (apref // imtype)) {
+		printf ("Aperture reference spectrum not found - %s%s\n",
+		    apref, imtype) | scan (err)
+		error (1, err // "\nCheck setting of imtype")
+	    }
+	    print ("Set reference apertures for ", apref) | tee (log1)
+	    if (access (database // "/ap" // apref))
+		delete (database // "/ap" // apref, verify=no)
+	    apscript.ansresize = "yes"
+	    apscript.ansedit = "YES"
+	    apscript.ansfittrace = "yes"
+	    apscript (apref, references="", ansfind="YES", ansrecenter="NO",
+		anstrace="YES", ansextract="NO")
+	    newaps = yes
+	}
+
+	if (recenter)
+	    apscript.ansrecenter = "YES"
+	else
+	    apscript.ansrecenter = "NO"
+	apscript.ansresize = "NO"
+	if (edit)
+	    apscript.ansedit = "yes"
+	else
+	    apscript.ansedit = "NO"
+	if (trace)
+	    apscript.anstrace = "YES"
+	else
+	    apscript.anstrace = "NO"
+	apscript.ansfittrace = "NO"
+	apscript.ansextract = "YES"
+	apscript.ansreview = "NO"
+
+	# The next step is to setup the scattered light correction if needed.
+	# We use the flat field image for the interactive setting unless
+	# one is not used an then we use the aperture reference.
+	# If these images have been  scattered light corrected we assume the
+	# scattered light functions parameters are correctly set.
+
+	i = strlen (flat)
+	if (i > n && substr (flat, i-n+1, i) == imtype)
+	    flat = substr (flat, 1, i-n)
+
+	if (flat != "")
+	    spec = flat
+	else
+	    spec = apref
+
+	scat = no
+	if (scattered) {
+	    hselect (spec, "apscatte", yes, > temp1)
+	    fd1 = temp1
+	    if (fscan (fd1, str1) < 1)
+		scat = yes
+	    fd1 = ""; delete (temp1, verify=no)
+	}
+	if (scat) {
+	    print ("Subtract scattered light in ", spec) | tee (log1)
+	    apscript.ansfitscatter = "yes"
+	    apscript.ansfitsmooth = "yes"
+	    apscript (spec, output="", ansextract="NO", ansscat="YES",
+		anssmooth="YES")
+	    apscript.ansfitscatter = "NO"
+	    apscript.ansfitsmooth = "NO"
+	}
+
+	response = ""
+	if (flat != "") {
+	    response = flat // "norm.ec"
+	    reextract = redo || (update && newaps)
+	    if (reextract || !access (response // imtype) || (update && scat)) {
+	        print ("Create response function ", response) | tee (log1)
+
+	        if (access (response // imtype))
+		    imdelete (response, verify=no)
+	        if (access (flat //ectype))
+		    imdelete (flat//ectype, verify=no)
+
+	        response (flat, apref, response, recenter=recenter,
+		    edit=edit, trace=trace, clean=clean, fitflat=fitflat,
+		    interactive=params.f_interactive,
+		    function=params.f_function, order=params.f_order)
+
+	        newresp = yes
+	    }
+	}
+
+	# 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 ARCREFS.
+
+	if (dispcor) {
+	    hselect (arcs, "$I", yes, >temp1)
+	    fd1 = temp1
+	    i = fscan (fd1, arcref)
+	    if (i < 1)
+		error (1, "No reference arcs")
+	    fd1 = ""; delete (temp1, verify=no)
+	    i = strlen (arcref)
+	    if (i > n && substr (arcref, i-n+1, i) == imtype)
+	        arcref = substr (arcref, 1, i-n)
+	    if (!access (arcref // imtype)) {
+		printf ("Arc reference spectrum not found - %s%s\n",
+		    arcref, imtype) | scan (err)
+		error (1, err // "\nCheck setting of imtype")
+	    }
+	    arcrefec = arcref // ectype
+	    reextract = redo || (update && newaps)
+	    if (reextract && access (arcrefec))
+	        imdelete (arcrefec, verify=no)
+
+	    arcrefs (arcref, arcaps, arcbeams, response, done, log1, log2)
+	}
+
+	# Now we are ready to process the object spectra.
+
+	reextract = redo || (update && (newaps || newresp || newdisp))
+	hselect (objs, "$I", yes, > temp1)
+	fd1 = temp1
+	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, specec) != EOF)
+		    if (spec == specec)
+		        break
+	        if (spec == specec)
+		    next
+	        fd2 = ""
+	    }
+	    if (!access (spec // imtype)) {
+		printf ("Object spectrum not found - %s%s\n",
+		    spec, imtype) | scan (err)
+		print (err) | tee (log1)
+		print ("Check setting of imtype")
+		next
+	    }
+	    specec = spec // ectype
+
+	    # Determine required operations from the flags and image header.
+	    scat = no
+	    extract = no
+	    disp = no
+	    if (scattered) {
+		hselect (spec, "apscatte", yes, > temp2)
+		fd2 = temp2
+		if (fscan (fd2, str1) < 1)
+		    scat = yes
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+	    if (reextract || !access (specec) || (update && scat))
+		extract = yes
+	    else {
+		hselect (specec, "dc-flag", yes, > temp2)
+		fd2 = temp2
+		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
+
+		fd2 = ""; delete (temp2, verify=no)
+	    }
+		
+	    if (extract)
+		disp = dispcor
+
+	    # If fully processed go to the next object.
+	    if (!extract && !disp)
+		next
+
+	    # If not interactive and the batch flag is set submit rest to batch.
+	    if (batch && !splot1 && !splot2 && apscript.ansedit == "NO") {
+		fd1 = ""; delete (temp1, verify=no)
+		flprcache
+		batch.objects = objs
+		batch.datamax = datamax
+		batch.response = response
+		batch.arcs = arcs
+		batch.arcref = arcref
+		batch.arcrefs = arcrefs
+		batch.objaps = objaps
+		batch.arcaps = arcaps
+		batch.objbeams = objbeams
+		batch.arcbeams = arcbeams
+		batch.done = done
+		batch.logfile = log1
+		batch.redo = reextract
+		batch.update = update
+		batch.scattered = scattered
+		batch.arcap = arcap
+		batch.dispcor = dispcor
+		batch.newaps = newaps
+		batch.newresp = newresp
+		batch.newdisp = newdisp
+		batch.newarcs = newarcs
+		dobatch = yes
+		return
+	    }
+
+	    # Process the spectrum in foreground.
+	    if (extract) {
+		if (access (specec))
+		    imdelete (specec, verify=no)
+
+		if (scat) {
+		    print ("Subtract scattered light in ", spec) | tee (log1)
+		    apscript (spec, output="", ansextract="NO",
+			ansscat="YES", anssmooth="YES")
+		}
+
+		print ("Extract object spectrum ", spec) | tee (log1)
+		setjd (spec, observatory=observatory, date="date-obs",
+		    time="ut", exposure="exptime", jd="jd", hjd="",
+		    ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+		    >> log1)
+	        setairmass (spec, intype="beginning",
+		    outtype="effective", exposure="exptime",
+		    observatory=observatory, show=no, update=yes,
+		    override=yes, >> log1)
+		apscript (spec, saturation=datamax)
+		if (response != "")
+		    imarith (specec, "/", response, specec)
+	    }
+
+	    disperr = no
+	    if (disp) {
+		# Fix arc headers if necessary.
+		if (newarcs) {
+	    	    sections (arcs, option="fullname", >temp2)
+		    setjd ("@"//temp2, observatory=observatory, date="date-obs",
+			time="ut", exposure="exptime", jd="jd", hjd="",
+			ljd="ljd", utdate=yes, uttime=yes, listonly=no,
+			>> log1)
+	    	    setairmass ("@"//temp2, intype="beginning",
+			outtype="effective", exposure="exptime",
+			observatory=observatory, show=no, update=yes,
+			override=yes, >> log1)
+		    delete (temp2, verify=no)
+		    hselect (arcs, "$I", yes, >temp2)
+	    	    fd2 = temp2
+	    	    while (fscan (fd2, arc) != EOF) {
+	        	i = strlen (arc)
+	        	if (i > n && substr (arc, i-n+1, i) == imtype)
+	            	    arc = substr (arc, 1, i-n)
+	        	hedit (arc, "refspec1", arc, add=yes, verify=no,
+		    	    show=no, update=yes)
+	        	hedit (arc, "arctype", "henear", add=yes, verify=no,
+		    	    show=no, update=yes)
+	    	    }
+	    	    fd2 = ""; delete (temp2, verify=no)
+		    newarcs = no
+		}
+
+		print ("Assign arc spectra for ", spec) | tee (log1)
+		refspectra (spec, references=arcrefs,
+		    apertures="", refaps="", ignoreaps=no,
+		    select=params.select, sort=params.sort,
+		    group=params.group, time=params.time,
+		    timewrap=params.timewrap, override=yes, confirm=no,
+		    assign=yes, logfiles="STDOUT", verbose=no) |
+		    tee (log1, > log2)
+
+		doarcs (spec, response, arcref, arcaps, arcbeams, reextract,
+		    arcap, log1, no)
+
+	        hselect (specec, "refspec1", yes, > temp2)
+	        fd2 = temp2
+	        i = fscan (fd2, arc)
+	        fd2 = ""; delete (temp2, verify=no)
+		if (i < 1) {
+		    print ("No arc reference assigned for ", spec) | tee (log1)
+		    disperr = yes
+		} else {
+	            print ("Dispersion correct ", spec) | tee (log1)
+		    dispcor (specec, "", linearize=params.linearize,
+			database=database, table=arcref//ectype,
+			w1=INDEF, w2=INDEF, dw=INDEF, nw=INDEF,
+			log=params.log, samedisp=no, flux=params.flux,
+			global=no, ignoreaps=no, confirm=no, listonly=no,
+			verbose=verbose, logfile=logfile)
+		    hedit (specec, "dc-flag", 0, add=yes, verify=no,
+			show=no, update=yes)
+		}
+	    }
+
+	    if (!disperr && (extract || disp)) {
+		if (splot1) {
+		    print (specec, ":")
+		    str1 = anssplot
+		    if (str1 == "NO" || str1 == "YES")
+			splot1 = no
+		    if (str1 == "no" || str1 == "NO")
+			splot2 = no
+		    else
+			splot2 = yes
+		}
+		if (splot2)
+		    splot (specec)
+	    }
+
+	    print (spec, >> done)
+	}
+	fd1 = ""; delete (temp1, verify=no)
+
+	if (access (done))
+	    delete (done, verify=no)
+end
diff --git a/noao/imred/src/dofoe/proc.par b/noao/imred/src/dofoe/proc.par
new file mode 100644
index 00000000..f74d6651
--- /dev/null
+++ b/noao/imred/src/dofoe/proc.par
@@ -0,0 +1,36 @@
+objects,s,a,,,,"List of object spectra"
+apref,f,a,"",,,"Aperture reference spectrum"
+flat,f,a,"",,,"Flat field spectrum"
+arcs,s,a,,,,"List of arc spectra"
+arctable,f,a,"",,,"Arc assignment table (optional)
+"
+naps,i,a,,,,"Number of apertures"
+objaps,s,a,,,,"Object apertures"
+arcaps,s,a,,,,"Arc apertures"
+objbeams,s,a,,,,"Object beam numbers"
+arcbeams,s,a,,,,"Arc beam numbers
+"
+fitflat,b,a,,,,"Fit and ratio flat field spectrum?"
+recenter,b,a,,,,"Recenter object apertures?"
+scattered,b,a,,,,"Subtract scattered light?"
+edit,b,a,,,,"Edit/review object apertures?"
+trace,b,a,,,,"Trace object spectra?"
+arcap,b,a,,,,"Use object apertures for arcs?"
+clean,b,a,,,,"Detect and replace bad pixels?"
+dispcor,b,a,,,,"Dispersion correct spectra?"
+splot,b,a,,,,"Plot the final spectrum?"
+redo,b,a,,,,"Redo operations if previously done?"
+update,b,a,,,,"Update spectra if cal data changes?"
+batch,b,a,,,,"Extract objects in batch?"
+listonly,b,a,,,,"List steps but don\'t process?
+"
+datamax,r,h,INDEF,,,"Max data value / cosmic ray threshold"
+newaps,b,h,,,,
+newresp,b,h,,,,
+newdisp,b,h,,,,
+newarcs,b,h,,,,
+dobatch,b,h,,,,
+anssplot,s,q,"yes",no|yes|NO|YES,,"Splot spectrum?"
+fd1,*struct,h,"",,,
+fd2,*struct,h,"",,,
+mode,s,h,"ql",,,
diff --git a/noao/imred/src/dofoe/response.cl b/noao/imred/src/dofoe/response.cl
new file mode 100644
index 00000000..a59c5ea3
--- /dev/null
+++ b/noao/imred/src/dofoe/response.cl
@@ -0,0 +1,99 @@
+# RESPONSE -- Make a fiber response spectrum using a flat field and sky flat.
+
+procedure response (flat, apreference, response)
+
+string	flat			{prompt="Flat field spectrum"}
+string	apreference		{prompt="Aperture reference spectrum"}
+string	response		{prompt="Response spectrum"}
+
+bool	recenter = no		{prompt="Recenter sky apertures?"}
+bool	edit = no		{prompt="Edit/review sky apertures?"}
+bool	trace = no		{prompt="Trace sky spectra?"}
+bool	clean = no		{prompt="Detect and replace bad pixels?"}
+bool	fitflat = no		{prompt="Fit and ratio flat field spectrum?"}
+bool	interactive = yes	{prompt="Fit flat field interactively?"}
+string	function = "spline3"	{prompt="Fitting function",
+				 enum="spline3|legendre|chebyshev|spline1"}
+int	order = 20		{prompt="Fitting function order", min=1}
+
+begin
+	string	imtype
+	file	log1, log2, flat2d, flatec, resp
+	int	i, n
+	struct	err
+
+	imtype = "." // envget ("imtype")
+	i = stridx (",", imtype)
+	if (i > 0)
+	    imtype = substr (imtype, 1, i-1)
+	n = strlen (imtype)
+
+	flat2d = flat
+	resp = response
+
+	if (flat2d == "")
+	    error (1, "No flat field defined")
+	if (flat2d != "") {
+	    i = strlen (flat2d)
+	    if (i > n && substr (flat2d, i-n+1, i) == imtype)
+		flat2d = substr (flat2d, 1, i-n)
+	    flatec = flat2d // ".ec"
+	    if (!access (flat2d // imtype)) {
+		printf ("Flat field spectrum not found - %s%s\n",
+		    flat2d, imtype) | scan (err)
+		error (1, err // "\nCheck setting of imtype")
+	    }
+	}
+
+	tee.append = yes
+	if (logfile == "")
+	    log1 = "dev$null"
+	else
+	    log1 = logfile
+	if (verbose)
+	    log2 = "STDOUT"
+	else
+	    log2 = "dev$null"
+
+	# Initialize APALL
+	apscript.references = apreference
+	if (recenter)
+	    apscript.ansrecenter = "YES"
+	else
+	    apscript.ansrecenter = "NO"
+	apscript.ansresize = "NO"
+	if (edit)
+	    apscript.ansedit = "yes"
+	else
+	    apscript.ansedit = "NO"
+	if (trace)
+	    apscript.anstrace = "YES"
+	else
+	    apscript.anstrace = "NO"
+	apscript.ansextract = "YES"
+
+	print ("Extract flat field ", flat2d) | tee (log1)
+	if (flat2d == apscript.references)
+	    apscript (flat2d, ansrecenter="NO", ansedit="NO", anstrace="NO",
+		background="none", clean=clean, extras=no)
+	else
+	    apscript (flat2d, clean=clean, extras=no)
+
+	if (fitflat) {
+	    print ("Fit and ratio flat field ", flat2d) | tee (log1)
+	    fit1d (flatec, resp, "fit", axis=1, interactive=interactive,
+		sample="*", naverage=1, function=function, order=order,
+		low_reject=0., high_reject=0., niterate=1, grow=0.,
+		graphics="stdgraph")
+	    sarith (flatec, "/", resp, resp, w1=INDEF, w2=INDEF, apertures="",
+		bands="", beams="", apmodulus=0, reverse=no, ignoreaps=yes,
+		format="multispec", renumber=no, offset=0, clobber=yes,
+		merge=no, errval=0, verbose=no)
+	    imdelete (flatec, verify=no)
+	} else
+	    imrename (flatec, resp, verbose=no)
+
+	print ("Create the normalized response ", resp) | tee (log1)
+	bscale (resp, resp, bzero="0.", bscale="mean", section="",
+	    step=1, upper=INDEF, lower=INDEF, verbose=yes) | tee (log1, >log2)
+end
diff --git a/noao/imred/src/dofoe/response.par b/noao/imred/src/dofoe/response.par
new file mode 100644
index 00000000..2bff1f0f
--- /dev/null
+++ b/noao/imred/src/dofoe/response.par
@@ -0,0 +1,12 @@
+flat,s,a,,,,"Flat field spectrum"
+apreference,s,a,,,,"Aperture reference spectrum"
+response,s,a,,,,"Response spectrum"
+recenter,b,h,no,,,"Recenter sky apertures?"
+edit,b,h,no,,,"Edit/review sky apertures?"
+trace,b,h,no,,,"Trace sky spectra?"
+clean,b,h,no,,,"Detect and replace bad pixels?"
+fitflat,b,h,no,,,"Fit and ratio flat field spectrum?"
+interactive,b,h,yes,,,"Fit flat field interactively?"
+function,s,h,"spline3",spline3|legendre|chebyshev|spline1,,"Fitting function"
+order,i,h,20,1,,"Fitting function order"
+mode,s,h,"q",,,