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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
include "nlfitdefr.h"
# NL_DUMP -- Dump NLFIT structure to a file
procedure nl_dumpr (fd, nl)
int fd # file descriptor
pointer nl # NLFIT descriptor
int i, npars, nfpars
begin
# Test NLFIT pointer
if (nl == NULL) {
call fprintf (fd, "\n****** nl_dump: Null NLFIT pointer\n")
call flush (fd)
return
}
# File and NLFIT descriptors
call fprintf (fd, "\n****** nl_dump: (fd=%d), (nl=%d)\n")
call pargi (fd)
call pargi (nl)
call flush (fd)
# Dump function and derivative addresses
call fprintf (fd, "Fitting function pointer = %d\n")
call pargi (NL_FUNC (nl))
call fprintf (fd, "Derivative function pointer = %d\n")
call pargi (NL_DFUNC (nl))
call flush (fd)
# Number of parameters
npars = NL_NPARAMS (nl)
nfpars = NL_NFPARAMS (nl)
call fprintf (fd, "Number of parameters = %d\n")
call pargi (npars)
call fprintf (fd, "Number of fitted parameters = %d\n")
call pargi (nfpars)
call flush (fd)
# Fit parameters
call fprintf (fd, "Max number of iterations = %d\n")
call pargi (NL_ITMAX (nl))
call fprintf (fd, "Tolerance for convergence = %g\n")
call pargr (NL_TOL (nl))
call flush (fd)
# Sums
call fprintf (fd, "Damping factor = %g\n")
call pargr (NL_LAMBDA (nl))
call fprintf (fd, "Sum of residuals squared last iteration = %g\n")
call pargr (NL_OLDSQ (nl))
call fprintf (fd, "Sum of residuals squared = %g\n")
call pargr (NL_SUMSQ (nl))
call flush (fd)
# Counters
call fprintf (fd, "Iteration counter = %d\n")
call pargi (NL_ITER (nl))
call fprintf (fd, "Number of points in fit = %d\n")
call pargi (NL_NPTS (nl))
call flush (fd)
# Parameter values
call fprintf (fd, "Parameter values (%d):\n")
call pargi (NL_PARAM (nl))
if (NL_PARAM (nl) != NULL) {
do i = 1, npars {
call fprintf (fd, "%d -> %g\n")
call pargi (i)
call pargr (Memr[NL_PARAM (nl) + i - 1])
}
} else
call fprintf (fd, " Null pointer\n")
call flush (fd)
# Parameter errors
call fprintf (fd, "Parameter errors (%d):\n")
call pargi (NL_DPARAM (nl))
if (NL_DPARAM (nl) != NULL) {
do i = 1, npars {
call fprintf (fd, "%d -> %g\n")
call pargi (i)
call pargr (Memr[NL_DPARAM (nl) + i - 1])
}
} else
call fprintf (fd, " Null pointer\n")
call flush (fd)
# Parameter list
call fprintf (fd, "Parameter list (%d):\n")
call pargi (NL_PLIST (nl))
if (NL_PLIST (nl) != NULL) {
do i = 1, npars {
call fprintf (fd, "%d -> %d\n")
call pargi (i)
call pargi (Memi[NL_PLIST (nl) + i - 1])
}
} else
call fprintf (fd, " Null pointer\n")
call flush (fd)
# Alpha matrix
call fprintf (fd, "Alpha matrix (%d):\n")
call pargi (NL_ALPHA (nl))
if (NL_ALPHA (nl) != NULL)
call nl_adumpr (fd, Memr[NL_ALPHA (nl)], nfpars, nfpars)
else
call fprintf (fd, " Null pointer\n")
call flush (fd)
# Beta matrix
call fprintf (fd, "Beta matrix (%d):\n")
call pargi (NL_BETA (nl))
if (NL_BETA (nl) != NULL)
call nl_adumpr (fd, Memr[NL_BETA (nl)], nfpars, 1)
else
call fprintf (fd, " Null pointer\n")
call flush (fd)
# Covariance matrix
call fprintf (fd, "Covariance matrix (%d):\n")
call pargi (NL_COVAR (nl))
if (NL_COVAR (nl) != NULL)
call nl_adumpr (fd, Memr[NL_COVAR (nl)], nfpars, nfpars)
else
call fprintf (fd, " Null pointer\n")
call flush (fd)
# Cholesky factorization
call fprintf (fd, "Cholesky factorization matrix (%d):\n")
call pargi (NL_CHOFAC (nl))
if (NL_CHOFAC (nl) != NULL)
call nl_adumpr (fd, Memr[NL_CHOFAC (nl)], nfpars, nfpars)
else
call fprintf (fd, " Null pointer\n")
call flush (fd)
end
# NL_ADUMP -- Dump array to file
procedure nl_adumpr (fd, a, nrows, ncols)
int fd # file descriptor
real a[nrows, ncols] # array
int nrows, ncols # dimension
int i, j
begin
do i = 1, nrows {
do j = 1, ncols {
call fprintf (fd, "%g ")
call pargr (a[i, j])
}
call fprintf (fd, "\n")
}
end
|
