aboutsummaryrefslogtreecommitdiff
path: root/pkg/xtools/inlfit/inrefit.gx
blob: 2effe21e9694c841c2bb63e6d8c7830a6804128f (plain) (blame)
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
include	<math/nlfit.h>
include	<pkg/inlfit.h>


# IN_REFIT -- Refit a function. This procedure is analogous to in_fit(),
# except that this one does not initialize the weigths and the rejected
# point list, and it does not reject points after the fit, because it is
# intended to be called from the data rejection procedure.

procedure in_refit$t (in, nl, x, y, wts, npts, nvars, wtflag)

pointer	in				# INLFIT pointer
pointer	nl				# NLFIT pointer
PIXEL	x[ARB]				# Ordinates
PIXEL	y[npts]				# Data to be fit
PIXEL	wts[npts]			# Weights
int	npts				# Number of points
int	nvars				# Number of variables
int	wtflag				# Type of weighting

int	i, ndeleted, ier
pointer	rejpts
pointer	in_getp()
int	in_geti()

begin
#	# Debug
#	call eprintf ("in_refit: in=%d, nl=%d, npts=%d, nvars=%d\n")
#	    call pargi (in)
#	    call pargi (nl)
#	    call pargi (npts)
#	    call pargi (nvars)


	# Assign a zero weight to each rejected point.
	rejpts = in_getp (in, INLREJPTS)
	do i = 1, npts {
	    if (Memi[rejpts+i-1] == YES)
		wts[i] = PIXEL (0.0)
	}

	# Reinitialize NLFIT.
	call in_nlinit$t (in, nl)

	# Check number of data points.
	if (npts == 0) {
	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
	    return
	}

	# Check number of deleted points.
	ndeleted = 0
	do i = 1, npts {
	    if (wts[i] <= PIXEL(0.0))
		ndeleted = ndeleted + 1
	}
	if ((npts - ndeleted) < in_geti(in, INLNFPARAMS)) {
	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
	    return
	}

	# Refit.
	call nlfit$t (nl, x, y, wts, npts, nvars, wtflag, ier)

	# Store fit status in the INLFIT structure.
	call in_puti (in, INLFITERROR, ier)
end