Initial commit

1 files changed, 167 insertions, 0 deletions

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