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
|
$if (datatype == r)
include "nlfitdefr.h"
$else
include "nlfitdefd.h"
$endif
# NLINIT -- Initialize for non-linear fitting
procedure nlinit$t (nl, fnc, dfnc, params, dparams, nparams, plist, nfparams,
tol, itmax)
pointer nl # pointer to nl fitting structure
int fnc # fitting function address
int dfnc # derivative function address
PIXEL params[ARB] # initial values for the parameters
PIXEL dparams[ARB] # initial guess at uncertainties in parameters
int nparams # number of parameters
int plist[ARB] # list of active parameters
int nfparams # number of fitted parameters
PIXEL tol # fitting tolerance
int itmax # maximum number of iterations
errchk malloc, calloc, nl_list
begin
# Allocate space for the non-linear package structure.
call calloc (nl, LEN_NLSTRUCT, TY_STRUCT)
# Store the addresses of the non-linear functions.
NL_FUNC(nl) = fnc
NL_DFUNC(nl) = dfnc
# Allocate temporary space for arrays.
call calloc (NL_ALPHA(nl), nfparams * nfparams, TY_PIXEL)
call calloc (NL_COVAR(nl), nfparams * nfparams, TY_PIXEL)
call calloc (NL_CHOFAC(nl), nfparams * nfparams, TY_PIXEL)
call calloc (NL_BETA(nl), nfparams, TY_PIXEL)
# Allocate space for parameter and trial parameter vectors.
call calloc (NL_DERIV(nl), nparams, TY_PIXEL)
call calloc (NL_PARAM(nl), nparams, TY_PIXEL)
call calloc (NL_OPARAM(nl), nparams, TY_PIXEL)
call calloc (NL_TRY(nl), nparams, TY_PIXEL)
call calloc (NL_DPARAM(nl), nparams, TY_PIXEL)
call calloc (NL_DELPARAM(nl), nparams, TY_PIXEL)
call calloc (NL_PLIST(nl), nparams, TY_INT)
# Initialize the parameters.
NL_NPARAMS(nl) = nparams
NL_NFPARAMS(nl) = nfparams
call amov$t (params, PARAM(NL_PARAM(nl)), nparams)
call amov$t (params, PARAM(NL_OPARAM(nl)), nparams)
call amov$t (dparams, DPARAM(NL_DELPARAM(nl)), nparams)
call amovi (plist, PLIST(NL_PLIST(nl)), nfparams)
NL_TOL(nl) = tol
NL_ITMAX(nl) = itmax
NL_SCATTER(nl) = PIXEL(0.0)
# Set up the parameter list.
iferr {
call nl_list (PLIST(NL_PLIST(nl)), NL_NPARAMS(nl), NL_NFPARAMS(nl))
} then {
call nlfree$t (nl)
nl = NULL
}
end
|
