From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001
From: Joseph Hunkeler <jhunkeler@gmail.com>
Date: Wed, 8 Jul 2015 20:46:52 -0400
Subject: Initial commit

---
 math/gsurfit/gszero.gx | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 60 insertions(+)
 create mode 100644 math/gsurfit/gszero.gx

(limited to 'math/gsurfit/gszero.gx')

diff --git a/math/gsurfit/gszero.gx b/math/gsurfit/gszero.gx
new file mode 100644
index 00000000..e99cbe4d
--- /dev/null
+++ b/math/gsurfit/gszero.gx
@@ -0,0 +1,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
-- 
cgit