1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <pkg/gtools.h>
include "icfit.h"
include "names.h"
# ICG_AXES -- Set axes data.
# The applications program may set additional axes types.
procedure icg_axesr (ic, gt, cv, axis, x, y, z, npts)
pointer ic # ICFIT pointer
pointer gt # GTOOLS pointer
pointer cv # CURFIT pointer
int axis # Output axis
real x[npts] # Independent variable
real y[npts] # Dependent variable
real z[npts] # Output values
int npts # Number of points
int i, axistype, gtlabel[2], gtunits[2]
real a, b, xmin, xmax
pointer label, units
real rcveval(), icg_dvzr()
errchk adivr()
extern icg_dvzr()
data gtlabel/GTXLABEL, GTYLABEL/
data gtunits/GTXUNITS, GTYUNITS/
begin
axistype = IC_AXES(ic, IC_GKEY(ic), axis)
switch (axistype) {
case 'x': # Independent variable
call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,1)])
call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,1)])
call amovr (x, z, npts)
case 'y': # Dependent variable
call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,2)])
call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
call amovr (y, z, npts)
case 'f': # Fitted values
call gt_sets (gt, gtlabel[axis], "fit")
call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
call rcvvector (cv, x, z, npts)
case 'r': # Residuals
call gt_sets (gt, gtlabel[axis], "residuals")
call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
call rcvvector (cv, x, z, npts)
call asubr (y, z, z, npts)
case 'd': # Ratio
call gt_sets (gt, gtlabel[axis], "ratio")
call gt_sets (gt, gtunits[axis], "")
call rcvvector (cv, x, z, npts)
# iferr (call adiv$t (y, z, z, npts))
call advzr (y, z, z, npts, icg_dvzr)
case 'n': # Linear component removed
call gt_sets (gt, gtlabel[axis], "non-linear component")
call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
xmin = IC_XMIN(ic)
xmax = IC_XMAX(ic)
a = rcveval (cv, real (xmin))
b = (rcveval (cv, real (xmax)) - a) / (xmax - xmin)
do i = 1, npts
z[i] = y[i] - a - b * (x[i] - xmin)
case 'v':
call gt_sets (gt, gtlabel[axis], "Velocity")
call gt_sets (gt, gtunits[axis], "km/s")
call rcvvector (cv, x, z, npts)
do i = 1, npts
z[i] = (z[i] - y[i]) / y[i] * 300000.
default: # User axes types.
call malloc (label, SZ_LINE, TY_CHAR)
call malloc (units, SZ_LINE, TY_CHAR)
if (axis == 1) {
call strcpy (Memc[IC_LABELS(ic,1)], Memc[label], SZ_LINE)
call strcpy (Memc[IC_UNITS(ic,1)], Memc[units], SZ_LINE)
call amovr (x, z, npts)
} else {
call strcpy (Memc[IC_LABELS(ic,2)], Memc[label], SZ_LINE)
call strcpy (Memc[IC_UNITS(ic,2)], Memc[units], SZ_LINE)
call amovr (y, z, npts)
}
call icg_uaxesr (axistype, cv, x, y, z, npts, Memc[label],
Memc[units], SZ_LINE)
call gt_sets (gt, gtlabel[axis], Memc[label])
call gt_sets (gt, gtunits[axis], Memc[units])
call mfree (label, TY_CHAR)
call mfree (units, TY_CHAR)
}
end
# ICG_DVZ -- Error action to take on zero division.
real procedure icg_dvzr (x)
real x # Numerator
begin
return (1.)
end
|
