aboutsummaryrefslogtreecommitdiff
path: root/pkg/xtools/inlfit/ingaxesd.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/xtools/inlfit/ingaxesd.x')
-rw-r--r--pkg/xtools/inlfit/ingaxesd.x105
1 files changed, 105 insertions, 0 deletions
diff --git a/pkg/xtools/inlfit/ingaxesd.x b/pkg/xtools/inlfit/ingaxesd.x
new file mode 100644
index 00000000..9a9816a6
--- /dev/null
+++ b/pkg/xtools/inlfit/ingaxesd.x
@@ -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_axesd (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
+double x[ARB] # Independent variables (npts * nvars)
+double y[npts] # Dependent variable
+double 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]
+double a, b, xmin, xmax
+pointer sp, label, units, minptr, maxptr
+
+double nlevald()
+double ing_dvzd()
+errchk adivd()
+extern ing_dvzd()
+
+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 amovd (y, z, npts)
+ case KEY_FIT: # Fitted values
+ call nlvectord (nl, x, z, npts, nvars)
+ case KEY_RESIDUALS: # Residuals
+ call nlvectord (nl, x, z, npts, nvars)
+ call asubd (y, z, z, npts)
+ case KEY_RATIO: # Ratio
+ call nlvectord (nl, x, z, npts, nvars)
+ call advzd (y, z, z, npts, ing_dvzd)
+ case KEY_NONLINEAR: # Linear component removed
+ call aclrd (z, npts)
+ minptr = in_getp (in, INLXMIN)
+ maxptr = in_getp (in, INLXMAX)
+ a = nlevald (nl, Memd[minptr], nvars)
+ do i = 1, nvars {
+ xmin = Memd[minptr+i-1]
+ xmax = Memd[maxptr+i-1]
+ Memd[minptr+i-1] = xmax
+ b = (nlevald (nl, Memd[minptr], nvars) - a) /
+ (xmax - xmin)
+ Memd[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 amovd (y, z, npts)
+ call ing_uaxesd (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.
+
+double procedure ing_dvzd (x)
+
+double x # Numerator
+
+begin
+ return (double (1.0))
+end