blob: e99cbe4d31d3cca7688d1681307908aeceed917f (
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
|
# 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
# GSZERO -- Procedure to zero the accumulators before doing
# a new fit in accumulate mode. The inner products of the basis functions
# are accumulated in the GS_NCOEFF(sf) ** 2
# array MATRIX, while
# the inner products of the basis functions and the data ordinates are
# accumulated in the NCOEFF(sf)-vector VECTOR.
$if (datatype == r)
procedure gszero (sf)
$else
procedure dgszero (sf)
$endif
pointer sf # pointer to surface descriptor
errchk mfree
begin
# zero the accumulators
switch (GS_TYPE(sf)) {
case GS_LEGENDRE, GS_CHEBYSHEV, GS_POLYNOMIAL:
GS_NPTS(sf) = 0
call aclr$t (VECTOR(GS_VECTOR(sf)), GS_NCOEFF(sf))
call aclr$t (MATRIX(GS_MATRIX(sf)), GS_NCOEFF(sf) ** 2)
# free the basis functions defined from previous calls to sfrefit
$if (datatype == r)
if (GS_XBASIS(sf) != NULL)
call mfree (GS_XBASIS(sf), TY_REAL)
GS_XBASIS(sf) = NULL
if (GS_YBASIS(sf) != NULL)
call mfree (GS_YBASIS(sf), TY_REAL)
GS_YBASIS(sf) = NULL
if (GS_WZ(sf) != NULL)
call mfree (GS_WZ(sf), TY_REAL)
GS_WZ(sf) = NULL
$else
if (GS_XBASIS(sf) != NULL)
call mfree (GS_XBASIS(sf), TY_DOUBLE)
GS_XBASIS(sf) = NULL
if (GS_YBASIS(sf) != NULL)
call mfree (GS_YBASIS(sf), TY_DOUBLE)
GS_YBASIS(sf) = NULL
if (GS_WZ(sf) != NULL)
call mfree (GS_WZ(sf), TY_DOUBLE)
GS_WZ(sf) = NULL
$endif
default:
call error (0, "GSZERO: Unknown surface type.")
}
end
|
