Initial commit

1 files changed, 110 insertions, 0 deletions

diff --git a/noao/onedspec/splot/flatten.x b/noao/onedspec/splot/flatten.x
new file mode 100644
index 00000000..aa038d27
--- /dev/null
+++ b/noao/onedspec/splot/flatten.x
@@ -0,0 +1,110 @@
+include	<pkg/gtools.h>
+
+# FLATTEN -- Flatten a spectrum and normalize to 1.0
+# Use ICFIT for fitting the spectrum
+
+procedure flatten (gp, gt, x, y, n)
+
+pointer	gp, gt
+real	x[n]
+real	y[n]
+int	n
+
+bool	b
+real	wx, z
+int	i, key
+pointer	sp, str, w, gt2, ic, cv
+
+bool	clgetb()
+real 	clgetr(), ic_getr(), cveval()
+int	clgeti(), ic_geti(), btoi(), clgcur()
+errchk	icg_fit
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call salloc (w, n, TY_REAL)
+
+	key = '?'
+	repeat {
+	    switch (key) {
+	    case '/', '-', 'f', 'c', 'n':
+		call ic_open (ic)
+		call clgstr ("function", Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "function", Memc[str])
+		call ic_puti (ic, "order", clgeti ("order"))
+		call ic_putr (ic, "low", clgetr ("low_reject"))
+		call ic_putr (ic, "high", clgetr ("high_reject"))
+		call ic_puti (ic, "niterate", clgeti ("niterate"))
+		call ic_putr (ic, "grow", clgetr ("grow"))
+		call ic_puti (ic, "markrej", btoi (clgetb ("markrej")))
+		switch (key) {
+		case '/':
+		    call ic_puti (ic, "key", 4)
+		case '-':
+		    call ic_puti (ic, "key", 3)
+		case 'f', 'n', 'c':
+		    call ic_puti (ic, "key", 1)
+		}
+
+		call ic_putr (ic, "xmin", min (x[1], x[n]))
+		call ic_putr (ic, "xmax", max (x[1], x[n]))
+
+		call gt_copy (gt, gt2)
+		call gt_gets (gt2, GTXLABEL, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "xlabel", Memc[str])
+		call gt_gets (gt2, GTYLABEL, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "ylabel", Memc[str])
+		call gt_gets (gt2, GTXUNITS, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "xunits", Memc[str])
+		call gt_gets (gt2, GTYUNITS, Memc[str], SZ_FNAME)
+		call ic_pstr (ic, "yunits", Memc[str])
+
+		call amovkr (1., Memr[w], n)
+		call icg_fit (ic, gp, "cursor", gt2, cv, x, y, Memr[w], n)
+
+		switch (key) {
+		case '/':
+		    do i = 1, n {
+			z = cveval (cv, x[i])
+			if (abs (z) < 1e-30)
+			    y[i] = 1.
+			else
+			    y[i] = y[i] / z
+		    }
+		case '-':
+		    do i = 1, n
+			y[i] = y[i] - cveval (cv, x[i])
+		case 'f':
+		    do i = 1, n
+			y[i] = cveval (cv, x[i])
+		case 'c':
+		    call ic_clean (ic, cv, x, y, Memr[w], n)
+		case 'n':
+		    ;
+		}
+
+		call ic_gstr (ic, "function", Memc[str], SZ_FNAME)
+		call clpstr ("function", Memc[str])
+		call clputi ("order", ic_geti (ic, "order"))
+		call clputr ("low_reject", ic_getr (ic, "low"))
+		call clputr ("high_reject", ic_getr (ic, "high"))
+		call clputi ("niterate", ic_geti (ic, "niterate"))
+		call clputr ("grow", ic_getr (ic, "grow"))
+		b = (ic_geti (ic, "markrej") == YES)
+		call clputb ("markrej", b)
+
+		call cv_free (cv)
+		call gt_free (gt2)
+		call ic_closer (ic)
+		break
+	    case 'q':
+		break
+	    default:
+		call printf (
+		    "/=normalize, -=subtract, f=fit, c=clean, n=nop, q=quit")
+	    }
+	} until (clgcur ("cursor", wx, z, i, key, Memc[str], SZ_FNAME) == EOF)
+
+	call sfree (sp)
+end