Initial commit

1 files changed, 105 insertions, 0 deletions

diff --git a/pkg/xtools/inlfit/ingaxes.gx b/pkg/xtools/inlfit/ingaxes.gx
new file mode 100644
index 00000000..d836e074
--- /dev/null
+++ b/pkg/xtools/inlfit/ingaxes.gx
@@ -0,0 +1,105 @@
+include	<pkg/gtools.h>
+include	<pkg/inlfit.h>
+
+# ING_AXES -- Set axes data. The applications program may set additional
+# axes types.
+
+procedure ing_axes$t (in, gt, nl, axis, x, y, z, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+int	axis				# Output axis
+PIXEL	x[ARB]				# Independent variables (npts * nvars)
+PIXEL	y[npts]				# Dependent variable
+PIXEL	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	i, j
+int	axistype, axisnum
+int	gtlabel[2], gtunits[2]
+PIXEL 	a, b, xmin, xmax
+pointer	sp, label, units, minptr, maxptr
+
+PIXEL	nleval$t()
+PIXEL	ing_dvz$t()
+errchk	adiv$t()
+extern	ing_dvz$t()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+
+	# Get the appropiate axis type and variable number.
+	call in_gkey (in, in_geti (in, INLGKEY), axis, axistype, axisnum)
+
+	# Get and set axes labels and units.
+	call ing_getlabel (in, axistype, axisnum, Memc[label], Memc[units],
+	    SZ_LINE)
+	call gt_sets (gt, gtlabel[axis], Memc[label])
+	call gt_sets (gt, gtunits[axis], Memc[units])
+
+	# Branch on axis type.
+	switch (axistype) {
+	case KEY_VARIABLE:	# Independent variable
+	    do i = 1, npts
+		z[i] = x[(i-1)*nvars+axisnum]
+	case KEY_FUNCTION:	# Function variable
+	    call amov$t (y, z, npts)
+	case KEY_FIT:		# Fitted values
+	    call nlvector$t (nl, x, z, npts, nvars)
+	case KEY_RESIDUALS:	# Residuals
+	    call nlvector$t (nl, x, z, npts, nvars)
+	    call asub$t (y, z, z, npts)
+	case KEY_RATIO:		# Ratio
+	    call nlvector$t (nl, x, z, npts, nvars)
+	    call advz$t (y, z, z, npts, ing_dvz$t)
+	case KEY_NONLINEAR:	# Linear component removed
+	    call aclr$t (z, npts)
+	    minptr = in_getp (in, INLXMIN)
+	    maxptr = in_getp (in, INLXMAX)
+	    a = nleval$t (nl, Mem$t[minptr], nvars)
+	    do i = 1, nvars {
+		xmin = Mem$t[minptr+i-1]
+		xmax = Mem$t[maxptr+i-1]
+		Mem$t[minptr+i-1] = xmax
+		b = (nleval$t (nl, Mem$t[minptr], nvars) - a) /
+		    (xmax - xmin)
+		Mem$t[minptr+i-1] = xmin
+		do j = 1, npts
+		    z[j] = z[j] + y[j] - a - b * (x[(j-1)*nvars+i] - xmin)
+	    }
+	case KEY_UAXIS:	# User axes plots.
+	    if (axis == 1) {
+	        do i = 1, npts
+		    z[i] = x[(i-1)*nvars+axisnum]
+	    } else
+	        call amov$t (y, z, npts)
+	    call ing_uaxes$t (axisnum, in, nl, x, y, z, npts, nvars)
+	default:
+	    call error (0, "ing_axes: Unknown axis type")
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_DVZ -- Error action to take on zero division.
+
+PIXEL procedure ing_dvz$t (x)
+
+PIXEL	x			# Numerator
+
+begin
+	return (PIXEL (1.0))
+end