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/gssolve.gx | 101 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 101 insertions(+)
 create mode 100644 math/gsurfit/gssolve.gx

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

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