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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <math/gsurfit.h>
$if (datatype == r)
include "gsurfitdef.h"
$else
include "dgsurfitdef.h"
$endif
# GSSOLVE -- Solve the matrix normal equations of the form ca = b for a,
# where c is a symmetric, positive semi-definite, banded matrix with
# GS_NXCOEFF(sf) * GS_NYCOEFF(sf) rows and a and b are GS_NXCOEFF(sf) *
# GS_NYCOEFF(sf)-vectors.
# Initially c is stored in the matrix MATRIX
# and b is stored in VECTOR.
# The Cholesky factorization of MATRIX is calculated and stored in CHOFAC.
# Finally the coefficients are calculated by forward and back substitution
# and stored in COEFF.
#
# This version has two options: fit all the coefficients or fix the
# the zeroth coefficient at a specified reference point.
$if (datatype == r)
procedure gssolve (sf, ier)
$else
procedure dgssolve (sf, ier)
$endif
pointer sf # curve descriptor
int ier # ier = OK, everything OK
# ier = SINGULAR, matrix is singular, 1 or more
# coefficients are 0.
# ier = NO_DEG_FREEDOM, too few points to solve matrix
int i, ncoeff
pointer sp, vector, matrix
$if (datatype == r)
PIXEL gseval()
$else
PIXEL dgseval()
$endif
begin
if (IS_INDEF(GS_XREF(sf)) || IS_INDEF(GS_YREF(sf)) ||
IS_INDEF(GS_ZREF(sf)))
ncoeff = GS_NCOEFF(sf)
else
ncoeff = GS_NCOEFF(sf) - 1
# test for number of degrees of freedom
ier = OK
i = GS_NPTS(sf) - ncoeff
if (i < 0) {
ier = NO_DEG_FREEDOM
return
}
if (ncoeff == GS_NCOEFF(sf)) {
vector = GS_VECTOR(sf)
matrix = GS_MATRIX(sf)
} else {
# allocate working space for the reduced vector and matrix
call smark (sp)
call salloc (vector, ncoeff, TY_PIXEL)
call salloc (matrix, ncoeff*ncoeff, TY_PIXEL)
# eliminate the terms from the vector and matrix
call amov$t (VECTOR(GS_VECTOR(sf)+1), Mem$t[vector], ncoeff)
do i = 0, ncoeff-1
call amov$t (MATRIX(GS_MATRIX(sf)+(i+1)*GS_NCOEFF(sf)),
Mem$t[matrix+i*ncoeff], ncoeff)
}
# solve for the coefficients.
switch (GS_TYPE(sf)) {
case GS_LEGENDRE, GS_CHEBYSHEV, GS_POLYNOMIAL:
# calculate the Cholesky factorization of the data matrix
call $tgschofac (MATRIX(matrix), ncoeff, ncoeff,
CHOFAC(GS_CHOFAC(sf)), ier)
# solve for the coefficients by forward and back substitution
call $tgschoslv (CHOFAC(GS_CHOFAC(sf)), ncoeff, ncoeff,
VECTOR(vector), COEFF(GS_COEFF(sf)+GS_NCOEFF(sf)-ncoeff))
default:
call error (0, "GSSOLVE: Illegal surface type.")
}
if (ncoeff != GS_NCOEFF(sf)) {
$if (datatype == r)
COEFF(GS_COEFF(sf)) = GS_ZREF(sf) -
gseval (sf, GS_XREF(sf), GS_YREF(sf))
$else
COEFF(GS_COEFF(sf)) = GS_ZREF(sf) -
dgseval (sf, GS_XREF(sf), GS_YREF(sf))
$endif
call sfree (sp)
}
end
|
