diff options
Diffstat (limited to 'noao/onedspec/ecidentify/ecffit/ecffit.x')
| -rw-r--r-- | noao/onedspec/ecidentify/ecffit/ecffit.x | 193 |
1 files changed, 193 insertions, 0 deletions
diff --git a/noao/onedspec/ecidentify/ecffit/ecffit.x b/noao/onedspec/ecidentify/ecffit/ecffit.x new file mode 100644 index 00000000..408a1b77 --- /dev/null +++ b/noao/onedspec/ecidentify/ecffit/ecffit.x @@ -0,0 +1,193 @@ +include <error.h> +include <pkg/gtools.h> + +define HELP "noao$onedspec/ecidentify/ecffit/ecffit.key" +define PROMPT "fitcoords surface fitting options" + +# EC_FIT -- Echelle dispersion fitting. +# +# X - Pixel coordinates along dispersion +# Y - Relative order number +# Z - Wavelength + +procedure ecf_fit (ecf, gp, gt, xd, yd, zd, wd, npts, fixedorder) + +pointer ecf # GSURFIT pointer +pointer gp # GIO pointer +pointer gt # GTOOLS pointer +double xd[npts] # Pixel coordinates along dispersion +double yd[npts] # Order number +double zd[npts] # Wavelength +double wd[npts] # Weights +int npts # Number of points +int fixedorder # Fixed order? + +real wx, wy +int wcs, key +int i, newgraph +pointer sp, wd1, rd, xr, yr +char cmd[SZ_LINE] + +int ecf_nearest() +int clgcur(), scan(), nscan() +errchk ecf_solve() +include "ecffit.com" + +begin + # Allocate residuals and weights with rejected points arrays + call smark (sp) + call salloc (wd1, npts, TY_DOUBLE) + call salloc (rd, npts, TY_DOUBLE) + call amovd (wd, Memd[wd1], npts) + + # Compute a solution and return if not interactive. + if (gp == NULL) { + call ecf_solve (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts, + fixedorder) + call ecf_reject (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts, + fixedorder) + do i = 1, npts + if (Memd[wd1+i-1] != wd[i]) + wd[i] = -1. + call sfree (sp) + return + } + + # Allocate real graph vectors. + call salloc (xr, npts, TY_REAL) + call salloc (yr, npts, TY_REAL) + + # Read cursor commands. + key = 'f' + repeat { + switch (key) { + case 'o': + call printf ("Order offset (%d): ") + call pargi (offset) + call flush (STDOUT) + if (scan() != EOF) { + call gargi (i) + if (nscan() == 1) + offset = i + call amovd (wd, Memd[wd1], npts) + call ecf_solve (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts, + YES) + call ecf_reject (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts, + YES) + call ecf_gdata (ecf, xtype, xd, yd, zd, Memd[rd], + Memr[xr], npts) + call ecf_gdata (ecf, ytype, xd, yd, zd, Memd[rd], + Memr[yr], npts) + call ecf_title (gt) + newgraph = YES + } + + case '?': # Print help text. + call gpagefile (gp, HELP, PROMPT) + + case ':': # List or set parameters + if (cmd[1] == '/') + call gt_colon (cmd, gp, gt, newgraph) + else + call ecf_colon (cmd, gp) + + case 'x': # Set ordinate + call printf ("Ordinate - ") + call printf ( + "(p)ixel, (o)rder, (w)avelength, (r)esidual, (v)elocity: ") + if (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF) + break + + if (key != xtype) { + if (key=='p'||key=='o'||key=='w'||key=='r'||key=='v') { + xtype = key + call gt_setr (gt, GTXMIN, INDEF) + call gt_setr (gt, GTXMAX, INDEF) + call ecf_gdata (ecf, xtype, xd, yd, zd, Memd[rd], + Memr[xr], npts) + call ecf_title (gt) + newgraph = YES + } else + call printf ("\007") + } + + case 'y': # Set abscissa + call printf ("Abscissa - ") + call printf ( + "(p)ixel, (o)rder, (w)avelength, (r)esidual, (v)elocity: ") + if(clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF) + break + + if (key != ytype) { + if (key=='p'||key=='o'||key=='w'||key=='r'||key=='v') { + ytype = key + call gt_setr (gt, GTYMIN, INDEF) + call gt_setr (gt, GTYMAX, INDEF) + call ecf_gdata (ecf, ytype, xd, yd, zd, Memd[rd], + Memr[yr], npts) + call ecf_title (gt) + newgraph = YES + } else + call printf ("\007") + } + + case 'r': # Redraw + newgraph = YES + + case 'c': # Cursor coordinates + i = ecf_nearest (gp, gt, wx, wy, wcs, key, Memr[xr], Memr[yr], + wd, npts) + call printf ("%10.2g %d %10.8g\n") + call pargd (xd[i]) + call pargd (yd[i]) + call pargd (zd[i]) + + case 'd': # Delete + i = ecf_nearest (gp, gt, wx, wy, wcs, key, Memr[xr], Memr[yr], + wd, npts) + if (i > 0) + Memd[wd1+i-1] = wd[i] + + case 'u': # Undelete + i = ecf_nearest (gp, gt, wx, wy, wcs, key, Memr[xr], Memr[yr], + wd, npts) + if (i > 0) + Memd[wd1+i-1] = wd[i] + + case 'f': # Fit + call amovd (wd, Memd[wd1], npts) + call ecf_solve (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts, + fixedorder) + call ecf_reject (ecf, xd, yd, zd, Memd[wd1], Memd[rd], npts, + fixedorder) + call ecf_gdata (ecf, xtype, xd, yd, zd, Memd[rd], + Memr[xr], npts) + call ecf_gdata (ecf, ytype, xd, yd, zd, Memd[rd], + Memr[yr], npts) + call ecf_title (gt) + newgraph = YES + + case 'w': # Window graph + call gt_window (gt, gp, "cursor", newgraph) + + case 'q': # Quit + break + + case 'I': # Interrupt + call fatal (0, "Interrupt") + + default: # Ring the bell. + call printf ("\07\n") + } + + if (newgraph == YES) { + call ecf_graph (gp, gt, Memr[xr], Memr[yr], wd, Memd[wd1], npts) + newgraph = NO + } + } until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF) + + do i = 1, npts + if (Memd[wd1+i-1] != wd[i]) + wd[i] = -1. + call sfree (sp) +end |