1 files changed, 252 insertions, 0 deletions
diff --git a/noao/onedspec/identify/t_autoid.x b/noao/onedspec/identify/t_autoid.x
new file mode 100644
index 00000000..fbdaa0cd
--- /dev/null
+++ b/noao/onedspec/identify/t_autoid.x
@@ -0,0 +1,252 @@
+include	<error.h>
+include	<fset.h>
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<smw.h>
+include	"identify.h"
+
+define	ICFITHELP	"noao$lib/scr/idicgfit.key"
+
+
+# T_AUTOIDENTIFY -- Automatically identify spectral features.
+
+procedure t_autoidentify ()
+
+int	list			# List of images
+int	interactive		# Examine identifications interactively?
+int	dbwrite			# Write database results?
+
+int	i, fd, hdr, hdr1
+pointer	sp, str, aid, id
+
+int	clgeti(), clgwrd(), nscan(), open(), nowhite()
+int	imtopenp(), imtgetim(), id_dbcheck()
+bool	clgetb(), aid_autoid()
+real	clgetr()
+pointer	gopen(), gt_init(), un_open()
+errchk	open, id_mapll, aid_autoid, aid_init, reidentify
+
+define	done_	10
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Initialize data structures.  Note the AID structure is initialized
+	# with CL queries to the AIDPARS pset.
+
+	aid = NULL
+	call aid_init (aid, "aidpars")
+	call id_init (id)
+
+	# Get query parameters.
+	list = imtopenp ("images")
+	call aid_sets (aid, "crval", "CL crval")
+	call aid_sets (aid, "cdelt", "CL cdelt")
+
+	# Get other parameters and IDENITFY set data structures.
+	ID_NSUM(id,1) = clgeti ("nsum")
+	call gargi (ID_NSUM(id,2))
+	if (nscan() != 2)
+	    ID_NSUM(id,2) = ID_NSUM(id,1)
+	ID_NSUM(id,1) = max (1, ID_NSUM(id,1))
+	ID_NSUM(id,2) = max (1, ID_NSUM(id,2))
+	ID_MAXFEATURES(id) = clgetr ("aidpars.ntarget")
+	ID_MINSEP(id) = clgetr ("minsep")
+	ID_FTYPE(id) = clgwrd ("ftype", Memc[str], SZ_LINE, FTYPES)
+	ID_FWIDTH(id) = clgetr ("fwidth")
+	ID_CRADIUS(id) = clgetr ("cradius")
+	ID_THRESHOLD(id) = clgetr ("threshold")
+	ID_MATCH(id) = clgetr ("match")
+	ID_ZWIDTH(id) = clgetr ("identify.zwidth")
+	ID_LABELS(id) = 1
+
+	call clgstr ("database", ID_DATABASE(id), ID_LENSTRING)
+	dbwrite = clgwrd ("dbwrite", Memc[str], SZ_FNAME, "|no|yes|NO|YES|")
+	if (dbwrite == 1)
+	    dbwrite = 3
+
+	call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING)
+	if (nowhite (ID_COORDLIST(id), ID_COORDLIST(id), ID_LENSTRING) == 0) {
+	    call clgstr ("coordlist.p_prompt", Memc[str], SZ_LINE)
+	    call printf (Memc[str])
+	    call flush (STDOUT)
+	    call clgstr ("query", ID_COORDLIST(id), ID_LENSTRING)
+	}
+	call clgstr ("units", Memc[str], SZ_LINE)
+	call xt_stripwhite (Memc[str])
+	if (Memc[str] != EOS)
+	    ID_UN(id) = un_open (Memc[str])
+	call id_mapll (id)
+	if (ID_LL(id) == NULL)
+	    call error (0, "Required coordinate line list not found")
+
+	# Dispersion fitting parameters.
+        call ic_open (ID_IC(id))
+        call clgstr ("function", Memc[str], SZ_LINE)
+        call ic_pstr (ID_IC(id), "function", Memc[str])
+        call ic_puti (ID_IC(id), "order", clgeti ("order"))
+        call clgstr ("sample", Memc[str], SZ_LINE)
+        call ic_pstr (ID_IC(id), "sample", Memc[str])
+        call ic_puti (ID_IC(id), "naverage", 1)
+        call ic_puti (ID_IC(id), "niterate", clgeti ("niterate"))
+        call ic_putr (ID_IC(id), "low", clgetr ("low_reject"))
+        call ic_putr (ID_IC(id), "high", clgetr ("high_reject"))
+        call ic_putr (ID_IC(id), "grow", clgetr ("grow"))
+
+        call ic_pstr (ID_IC(id), "xlabel", "Feature positions")
+        call ic_pstr (ID_IC(id), "xunits", "pixels")
+        call ic_pstr (ID_IC(id), "ylabel", "")
+        call ic_pkey (ID_IC(id), 1, 'y', 'x')
+        call ic_pkey (ID_IC(id), 2, 'y', 'v')
+        call ic_pkey (ID_IC(id), 3, 'y', 'r')
+        call ic_pkey (ID_IC(id), 4, 'y', 'd')
+        call ic_pkey (ID_IC(id), 5, 'y', 'n')
+        call ic_puti (ID_IC(id), "key", 5)
+	call ic_pstr (ID_IC(id), "help", ICFITHELP)
+
+	# Interactive, graphics, and output parameters.
+	interactive = clgwrd ("interactive", Memc[str], SZ_FNAME,
+	    "|no|yes|NO|YES|")
+	switch (interactive) {
+	case 1, 3:
+	    ID_GP(id) = NULL
+	    interactive = 3
+	case 2, 4:
+	    # Open graphics
+	    call clgstr ("graphics", Memc[str], SZ_LINE)
+	    ID_GP(id) = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH)
+	}
+
+	ID_GT(id) = gt_init()
+	call gt_sets (ID_GT(id), GTTYPE, "line")
+	call fseti (STDOUT, F_FLUSHNL, YES)
+	hdr = YES
+	hdr1 = YES
+
+	# Log and plot files.
+	call calloc (ID_LOGFILES(id), 4, TY_INT)
+	if (clgetb ("verbose"))
+	    Memi[ID_LOGFILES(id)] = STDOUT
+	call clgstr ("logfile", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) {
+	    fd = open (Memc[str], APPEND, TEXT_FILE)
+	    Memi[ID_LOGFILES(id)+1] = fd
+	}
+	call clgstr ("plotfile", Memc[str], SZ_LINE)
+	if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) {
+	    fd = open (Memc[str], APPEND, BINARY_FILE)
+	    Memi[ID_LOGFILES(id)+2] = fd
+	}
+
+	# Expand the image template and identify features.
+	while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF) {
+	    # Initialize.
+	    iferr (call id_map(id)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    if (!clgetb ("overwrite")) {
+		if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) {
+		    if (Memi[ID_LOGFILES(id)] != NULL) {
+			if (ID_GP(id) != NULL)
+			    call gdeactivate (ID_GP(id), 0)
+			call fprintf (Memi[ID_LOGFILES(id)],
+			    "  %s%s%24t Database entry already exists\n")
+			    call pargstr (ID_IMAGE(id))
+			    call pargstr (ID_SECTION(id))
+		    }
+		    goto done_
+		}
+	    }
+
+	    call id_gdata(id)
+	    call id_fitdata(id)
+	    call ic_putr (ID_IC(id), "xmin", real (PIXDATA(id,1)))
+	    call ic_putr (ID_IC(id), "xmax", real (PIXDATA(id,ID_NPTS(id))))
+
+	    call dcvfree (ID_CV(id))
+	    ID_SHIFT(id) = 0.
+	    ID_NFEATURES(id) = 0
+
+	    # Automatically identify the features.
+	    if (aid_autoid (id, aid))
+		ID_NEWDBENTRY(id) = YES
+	    else if (Memi[ID_LOGFILES(id)] == NULL)
+		call aid_log (id, STDOUT, NO)
+	    call aid_log (id, Memi[ID_LOGFILES(id)], hdr)
+	    call aid_log (id, Memi[ID_LOGFILES(id)+1], hdr1)
+
+	    # Enter interactive identification mode if desired.
+	    if (interactive != 3) {
+		if (interactive != 4) {
+		    repeat {
+			call clgstr ("interactive.p_prompt", Memc[str],
+			    SZ_FNAME)
+			call printf ("%s%s: %s")
+			    call pargstr (ID_IMAGE(id))
+			    call pargstr (ID_SECTION(id))
+			    call pargstr (Memc[str])
+			call flush (STDOUT)
+			if (interactive == 1)
+			    call clpstr ("query", "no")
+			else
+			    call clpstr ("query", "yes")
+			ifnoerr (interactive = clgwrd ("query", Memc[str],
+			    SZ_FNAME, "|no|yes|NO|YES|"))
+			break
+		    }
+		}
+		if (interactive == 2 || interactive == 4) {
+		    call reidentify (id)
+		    call gdeactivate (ID_GP(id), 0)
+		}
+	    }
+
+	    # Write results to the database.
+	    if (ID_NEWDBENTRY(id) == YES) {
+		if (dbwrite == 1 || dbwrite == 2) {
+		    repeat {
+			call clgstr ("dbwrite.p_prompt", Memc[str], SZ_FNAME)
+			call printf ("%s%s: %s")
+			    call pargstr (ID_IMAGE(id))
+			    call pargstr (ID_SECTION(id))
+			    call pargstr (Memc[str])
+			call flush (STDOUT)
+			if (dbwrite == 1)
+			    call clpstr ("query", "no")
+			else
+			    call clpstr ("query", "yes")
+			ifnoerr (dbwrite = clgwrd ("query", Memc[str],
+			    SZ_FNAME, "|no|yes|NO|YES|"))
+			    break
+		    }
+		}
+		if (dbwrite == 2 || dbwrite == 4)
+		    call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO)
+	    }
+
+done_	    # Close the database, image, and spectrum data structures.
+	    if (ID_DT(id) != NULL)
+		call dtunmap (ID_DT(id))
+	    call smw_close (MW(ID_SH(id)))
+	    call imunmap (IM(ID_SH(id)))
+	    call shdr_close (ID_SH(id))
+	}
+
+	# Finish up.
+	do i = 1, 3 {
+	    fd = Memi[ID_LOGFILES(id)+i-1]
+	    if (fd != NULL)
+		call close (fd)
+	}
+	call mfree (ID_LOGFILES(id), TY_INT)
+	if (ID_GP(id) != NULL)
+	    call gclose (ID_GP(id))
+	call smw_daxis (NULL, NULL, 0, 0, 0)
+	call imtclose (list)
+	if (aid != NULL)
+	    call aid_free (aid)
+	call id_free (id)
+	call sfree (sp)
+end