aboutsummaryrefslogtreecommitdiff
path: root/noao/rv/rvdrawfit.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/rv/rvdrawfit.x')
-rw-r--r--noao/rv/rvdrawfit.x358
1 files changed, 358 insertions, 0 deletions
diff --git a/noao/rv/rvdrawfit.x b/noao/rv/rvdrawfit.x
new file mode 100644
index 00000000..cd1dcbba
--- /dev/null
+++ b/noao/rv/rvdrawfit.x
@@ -0,0 +1,358 @@
+include <gset.h>
+include "rvpackage.h"
+include "rvflags.h"
+
+# RV_DRAW_FIT - Draw the fitted function to the screen. Called in
+# rv_erase_fit() to erase old fit, and from the fitting rouines and
+# plot rouines so they all draw the same function.
+
+procedure rv_draw_fit (rv, gp, is_velocity)
+
+pointer rv #I RV struct pointer
+pointer gp #I Graphics descriptor
+int is_velocity #I Plot function on velocity scale?
+
+extern cgauss1d, lorentz
+pointer sp, pltx, plty
+real step, xl
+int i, pltnpts, nfitpts, nvars, gstati()
+double rv_shift2vel()
+
+include "rvsinc.com"
+
+begin
+ # Check for exit conditions
+ #if (RV_INTERACTIVE(rv) == NO || gp == NULL)
+ if (gp == NULL || RV_FITDONE(rv) == NO || RV_ERRCODE(rv) == ERR_FIT)
+ return
+
+ nfitpts = RV_IEND(rv) - RV_ISTART(rv) + 1
+ if (RV_FITFUNC(rv) == SINC)
+ pltnpts = (snfit-1) * 10
+ else
+ pltnpts = 10 * nfitpts
+ nvars = 1
+
+ # Plot the deblended fit if that is what was done
+ if (IS_DBLSTAR(rv) == YES) {
+ call rv_plt_deblend (rv, gp, is_velocity)
+ return
+ }
+
+ call smark (sp) # Allocate space for the plt
+ call salloc (pltx, pltnpts, TY_REAL)
+ call salloc (plty, pltnpts, TY_REAL)
+
+ # Draw the computed CCF
+ call gseti (gp, G_WCS, 2)
+ if (RV_FITFUNC(rv) == CENTER1D) {
+ if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
+ call gline (gp, RV_VREL(rv), WRKPIXY(rv,RV_ISHIFT(rv)),
+ RV_VREL(rv), WRKPIXY(rv,RV_ISHIFT(rv))+0.1)
+ } else {
+ call gline (gp, RV_SHIFT(rv), WRKPIXY(rv,RV_ISHIFT(rv)),
+ RV_SHIFT(rv), WRKPIXY(rv,RV_ISHIFT(rv))+0.1)
+ }
+ call gflush (gp)
+ call sfree (sp)
+ return
+
+ } else if (RV_FITFUNC(rv) == SINC) {
+ if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
+ do i = 1, pltnpts
+ Memr[pltx+i-1] = real(rv_shift2vel(rv, Memr[splx+i-1]))
+ } else
+ call amovr (Memr[splx], Memr[pltx], pltnpts)
+ call amovr (Memr[sply], Memr[plty], pltnpts)
+ } else {
+ call rv_gpltsteps (rv, pltnpts, xl, step)
+
+ do i = 1, pltnpts {
+ Memr[pltx+i-1] = xl + (i-1) * step
+ switch (RV_FITFUNC(rv)) {
+ case GAUSSIAN:
+ call cgauss1d (Memr[pltx+i-1], nvars, COEFF(rv,1), 4,
+ Memr[plty+i-1])
+ case LORENTZIAN:
+ call lorentz (Memr[pltx+i-1], nvars, COEFF(rv,1), 4,
+ Memr[plty+i-1])
+ case PARABOLA:
+ call polyfit (Memr[pltx+i-1], nvars, COEFF(rv,1), 3,
+ Memr[plty+i-1])
+ }
+ }
+ if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
+ do i = 1, pltnpts
+ Memr[pltx+i-1] = real(rv_shift2vel(rv, Memr[pltx+i-1]))
+ }
+ }
+
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_DASHED)
+ call gseti (gp, G_PLCOLOR, RV_LINECOLOR(rv))
+ }
+ call gpline (gp, Memr[pltx], Memr[plty], pltnpts)
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_SOLID)
+ call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+ }
+
+ call gflush (gp)
+ call sfree (sp)
+end
+
+
+# RV_DRAW_BACKGROUND - Draw the background marker with the correct line type
+# and at the same level.
+
+procedure rv_draw_background (rv, gp)
+
+pointer rv #I RV struct pointer
+pointer gp #I Graphics pointer
+
+real left, right
+int gstati()
+
+begin
+ # Check error conditions.
+ if (gp == NULL || RV_FITFUNC(rv) == PARABOLA)
+ return
+ if (RV_FITFUNC(rv) == CENTER1D || IS_DBLSTAR(rv) == YES)
+ return
+ if (IS_INDEF(RV_BACKGROUND(rv)) && RV_FITFUNC(rv) == SINC)
+ return
+
+ # Get the background window sizes.
+ if (RV_DTYPE(rv) == SUMMARY_PLOT) {
+ if (RV_DCFLAG(rv) != -1) {
+ left = (RV_WINL(rv) - RV_WINDOW(rv)) * RV_DELTAV(rv)
+ right = (RV_WINR(rv) + RV_WINDOW(rv)) * RV_DELTAV(rv)
+ } else {
+ left = RV_WINL(rv) - RV_WINDOW(rv)
+ right = RV_WINR(rv) + RV_WINDOW(rv)
+ }
+ } else {
+ left = real (RV_WINL(rv))
+ right = real (RV_WINR(rv))
+ }
+
+ # Draw the background.
+ if (RV_FITDONE(rv) == YES) {
+ # Mark the background level
+ if (IS_INDEF(RV_BACKGROUND(rv))) {
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_DASHED)
+ call gseti (gp, G_PLCOLOR, C_GREEN)
+ }
+ call gline (gp, left, COEFF(rv,4), right, COEFF(rv,4))
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_SOLID)
+ call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+ }
+ } else {
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_DASHED)
+ call gseti (gp, G_PLCOLOR, C_GREEN)
+ }
+ call gline (gp, left, RV_BACKGROUND(rv), right,
+ RV_BACKGROUND(rv))
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_SOLID)
+ call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+ }
+ }
+
+ } else if (!IS_INDEF(RV_BACKGROUND(rv))) {
+ #call gseti (gp, G_PLCOLOR, C_GREEN)
+ call gline (gp, left, RV_BACKGROUND(rv), left, RV_BACKGROUND(rv))
+ #call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+
+ } else {
+ #call gseti (gp, G_PLCOLOR, C_GREEN)
+ call gline (gp, left, 0.0, right, 0.0)
+ #call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+ }
+end
+
+
+# RV_ERASE_FIT - Erase the previous fit prior to computing new one. Points,
+# function, FWHM line and background level are erased, and the underlying
+# ccf in the region redrawn,
+
+procedure rv_erase_fit (rv, redraw)
+
+pointer rv #I RV struct pointer
+bool redraw #I Redraw background?
+
+pointer gp
+real statr, rv_width()
+int ledge, redge, npts
+
+begin
+ # Check for exit conditions
+ if (RV_INTERACTIVE(rv) == NO || RV_GP(rv) == NULL)
+ return
+ if (RV_FITDONE(rv) == NO || RV_AUTODRAW(rv) == NO)
+ return
+
+ gp = RV_GP(rv)
+ redge = RV_IEND(rv) # initializations
+ ledge = RV_ISTART(rv)
+ npts = redge - ledge + 1
+
+ # First set the line and polymarker types to be black.
+ call gseti (gp, G_WCS, 2)
+ call gseti (gp, G_PLCOLOR, C_BACKGROUND)
+ call gseti (gp, G_PLTYPE, GL_CLEAR)
+ call gseti (gp, G_PMLTYPE, GL_CLEAR)
+
+ # Erase the computed CCF.
+ call rv_draw_fit (rv, gp, NO)
+
+ # Erase the points being used in the fit.
+ call gpmark (gp, WRKPIXX(rv,ledge), WRKPIXY(rv,ledge), npts, 4, 2., 2.)
+ call gflush (gp)
+
+ # Erase the background level.
+ if ((RV_FITFUNC(rv) == GAUSSIAN || RV_FITFUNC(rv) == LORENTZIAN) &&
+ IS_DBLSTAR(rv) == NO) {
+ call rv_draw_background (rv, gp)
+ call gflush (gp)
+ }
+
+ # Erase the FWHM level.
+ if (!IS_INDEF(RV_FWHM_Y(rv)) && IS_DBLSTAR(rv) == NO) {
+ statr = rv_width (rv)
+ call gflush (gp)
+ }
+
+ # Erase the computed CCF.
+ #call rv_draw_fit (rv, gp, NO)
+
+ # Just in case, let's also erase the residuals.
+ if (RV_RESDONE(rv) == YES) {
+ call rv_resid_plot (rv)
+ RV_RESDONE(rv) = NO
+ }
+
+ # Now redraw the ccf, with a little on each end to cover up the slop.
+ call gseti (gp, G_PLTYPE, GL_SOLID)
+ call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+ call gseti (gp, G_PMLTYPE, GL_SOLID)
+ call gpline (gp, WRKPIXX(rv,max(1,ledge-4)), WRKPIXY(rv,max(1,ledge-4)),
+ min(npts+8,RV_CCFNPTS(rv)))
+ call gflush (gp)
+
+ # Redraw the background level.
+ if (redraw && IS_DBLSTAR(rv) == NO)
+ call rv_draw_background (rv, gp)
+ call gflush (gp)
+end
+
+
+# RV_GPLTSTEPS - Get the function starting and increment parameters
+
+procedure rv_gpltsteps (rv, npts, xl, step)
+
+pointer rv #I RV struct pointer
+int npts #I Npts being plotted
+real xl #O Start position
+real step #O Plot increment
+
+real dv, c2, c3, istart, iend
+
+begin
+ dv = RV_DELTAV(rv) # Initialize
+ c2 = COEFF(rv,2)
+ c3 = COEFF(rv,3)
+ istart = WRKPIXX(rv,RV_ISTART(rv))
+ iend = WRKPIXX(rv,RV_IEND(rv))
+
+ switch (RV_FITFUNC(rv)) {
+ case PARABOLA:
+ xl = istart
+ step = abs (iend - istart) / real (npts-1)
+ case GAUSSIAN:
+ xl = c2 - (3. * sqrt(c3))
+ step = (c2 + (3. * sqrt(c3)) - xl) / real (npts-1)
+ case LORENTZIAN:
+ xl = c2 - (2. * c3)
+ step = ((c2 + (2. * c3)) - xl) / real(npts-1)
+ }
+end
+
+
+# RV_PLT_DEBLEND -- Plot the fitted model function.
+
+procedure rv_plt_deblend (rv, gp, is_velocity)
+
+pointer rv #I RV struct pointer
+pointer gp #I Graphics descriptor
+int is_velocity #I Plot on velocity axis?
+
+real w, xval, yval
+real x1, x2, y1, y2
+int i, j, npts, pnpts
+int i1, nsub, offset
+
+double rv_shift2vel()
+real model()
+int gstati()
+
+begin
+ if (gp == NULL)
+ return
+
+ nsub = 10
+ pnpts = nsub * (npts-1)
+
+ # Compute model spectrum with continuum and plot.
+ i1 = DBL_I1(rv)
+ x1 = WRKPIXX(rv,1)
+ npts = DBL_NFITP(rv)
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_DASHED)
+ call gseti (gp, G_PLCOLOR, RV_LINECOLOR(rv))
+ }
+ do i = 1, npts-1 {
+ do j = 1, nsub {
+ offset = ((i-1)*nsub+j)-1
+ w = x1 + (i1+i-2) + (j-1) * 0.1
+ if (is_velocity == YES && RV_DCFLAG(rv) != -1)
+ #xval = w * RV_DELTAV(rv)
+ xval = real (rv_shift2vel(rv,w))
+ else
+ xval = w
+ yval = model (w, DBL_COEFFS(rv,1), 3*DBL_NSHIFTS(rv)+2)
+ yval = DBL_SCALE(rv) * yval +
+ (DBL_Y1(rv)+DBL_SLOPE(rv)*(w-DBL_X1(rv)))
+
+ if (i == 1 && j == 1)
+ call gamove (gp, xval, yval)
+ else
+ call gadraw (gp, xval, yval)
+ }
+ call gflush (gp)
+ }
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR)
+ call gseti (gp, G_PLTYPE, GL_SOLID)
+
+ # Draw the background to the screen.
+ y1 = DBL_Y1(rv)
+ y2 = DBL_Y2(rv)
+ if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
+ #x1 = DBL_X1(rv) * RV_DELTAV(rv)
+ #x2 = DBL_X2(rv) * RV_DELTAV(rv)
+ x1 = real (rv_shift2vel(rv,DBL_X1(rv)))
+ x2 = real (rv_shift2vel(rv,DBL_X2(rv)))
+ } else {
+ x1 = DBL_X1(rv)
+ x2 = DBL_X2(rv)
+ }
+ call gline (gp, x1, y1, x2, y2)
+ if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
+ call gseti (gp, G_PLTYPE, GL_SOLID)
+ call gseti (gp, G_PLCOLOR, C_FOREGROUND)
+ }
+ call gflush (gp)
+end
generated by cgit (git 2.34.1) at 2025-09-20 12:36:01 -0400