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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
include <pkg/gtools.h>
include <math/nlfit.h>
include <pkg/inlfit.h>
# ING_PARAMS -- Set parameter string.
procedure ing_params$t (in, nl, x, y, wts, npts, nvars, gt)
pointer in # INLFIT pointer
pointer nl # NLFIT pointer
PIXEL x[ARB] # Ordinates (npts * nvars)
PIXEL y[ARB] # Abscissas
PIXEL wts[ARB] # Weights
int npts # Number of data points
int nvars # Number of variables
pointer gt # GTOOLS pointer
int i, rejected, deleted, length
int len3, len4
PIXEL rms
pointer sp, fit, wts1, rejpts
pointer str1, str2, str3, str4, line
int strlen()
int nlstati()
int inlstrwrd()
int in_geti()
PIXEL nlstat$t()
PIXEL in_rms$t()
PIXEL in_get$t()
pointer in_getp()
begin
# Allocate memory
call smark (sp)
call salloc (fit, npts, TY_PIXEL)
call salloc (wts1, npts, TY_PIXEL)
call salloc (str1, SZ_LINE, TY_CHAR)
call salloc (str2, SZ_LINE, TY_CHAR)
call salloc (str3, SZ_LINE, TY_CHAR)
call salloc (str4, SZ_LINE, TY_CHAR)
# Mark rejected points as deleted for rms comnputation,
# and count number of deleted points.
call amov$t (wts, Mem$t[wts1], npts)
rejected = in_geti (in, INLNREJPTS)
rejpts = in_getp (in, INLREJPTS)
if (rejected > 0) {
do i = 1, npts {
if (Memi[rejpts+i-1] == YES)
Mem$t[wts1+i-1] = PIXEL (0.0)
}
}
deleted = 0
do i = 1, npts {
if (wts[i] == PIXEL (0.0))
deleted = deleted + 1
}
# Set the fit and compute the RMS error.
if (in_geti (in, INLFITERROR) == DONE) {
call nlvector$t (nl, x, Mem$t[fit], npts, nvars)
rms = in_rms$t (y, Mem$t[fit], Mem$t[wts1], npts)
} else
rms = INDEF
# Build interactive graphics and NLFIT parameter strings
call sprintf (Memc[str1], SZ_LINE,
#"low_rej=%7.4g, high_rej=%7.4g, nreject=%d, grow=%7.4g")
"low_rej=%.4g, high_rej=%.4g, nreject=%d, grow=%.4g")
call parg$t (in_get$t (in, INLLOW))
call parg$t (in_get$t (in, INLHIGH))
call pargi (in_geti (in, INLNREJECT))
call parg$t (in_get$t (in, INLGROW))
call sprintf (Memc[str2], SZ_LINE,
#"total=%d, rejected=%d, deleted=%d, RMS=%7.4g")
"total=%d, rejected=%d, deleted=%d, RMS=%.4g")
call pargi (npts)
call pargi (rejected)
call pargi (deleted)
call parg$t (rms)
call sprintf (Memc[str3], SZ_LINE,
#"tolerance=%7.4g, maxiter=%d, iterations=%d")
"tolerance=%.4g, maxiter=%d, iterations=%d")
call parg$t (nlstat$t (nl, NLTOL))
call pargi (nlstati (nl, NLITMAX))
call pargi (nlstati (nl, NLITER))
# Set the output parameter line.
length = strlen (Memc[str1]) + strlen (Memc[str2]) +
strlen (Memc[str3]) + 3
call salloc (line, length + 1, TY_CHAR)
call sprintf (Memc[line], length, "%s\n%s\n%s")
call pargstr (Memc[str1])
call pargstr (Memc[str2])
call pargstr (Memc[str3])
call gt_sets (gt, GTPARAMS, Memc[line])
# Get the error and function label strings.
call nlerrmsg (in_geti (in, INLFITERROR), Memc[str1], SZ_LINE)
call in_gstr (in, INLFLABELS, Memc[str2], SZ_LINE)
# Set the output title line.
len3 = inlstrwrd (1, Memc[str3], SZ_LINE, Memc[str2])
len4 = inlstrwrd (2, Memc[str4], SZ_LINE, Memc[str2])
if (len3 != 0 && len4 != 0) {
call sprintf (Memc[line], length, "%s = %s\n%s")
call pargstr (Memc[str3])
call pargstr (Memc[str4])
call pargstr (Memc[str1])
} else {
call sprintf (Memc[line], length, "%s")
call pargstr (Memc[str2])
}
call gt_sets (gt, GTTITLE, Memc[line])
# Free allocated memory.
call sfree (sp)
end
|
