diff options
Diffstat (limited to 'math/nlfit/nldumpr.x')
| -rw-r--r-- | math/nlfit/nldumpr.x | 160 |
1 files changed, 160 insertions, 0 deletions
diff --git a/math/nlfit/nldumpr.x b/math/nlfit/nldumpr.x new file mode 100644 index 00000000..a81c6366 --- /dev/null +++ b/math/nlfit/nldumpr.x @@ -0,0 +1,160 @@ +include "nlfitdefr.h" + +# NL_DUMP -- Dump NLFIT structure to a file + +procedure nl_dumpr (fd, nl) + +int fd # file descriptor +pointer nl # NLFIT descriptor + +int i, npars, nfpars + +begin + # Test NLFIT pointer + if (nl == NULL) { + call fprintf (fd, "\n****** nl_dump: Null NLFIT pointer\n") + call flush (fd) + return + } + + # File and NLFIT descriptors + call fprintf (fd, "\n****** nl_dump: (fd=%d), (nl=%d)\n") + call pargi (fd) + call pargi (nl) + call flush (fd) + + # Dump function and derivative addresses + call fprintf (fd, "Fitting function pointer = %d\n") + call pargi (NL_FUNC (nl)) + call fprintf (fd, "Derivative function pointer = %d\n") + call pargi (NL_DFUNC (nl)) + call flush (fd) + + # Number of parameters + npars = NL_NPARAMS (nl) + nfpars = NL_NFPARAMS (nl) + call fprintf (fd, "Number of parameters = %d\n") + call pargi (npars) + call fprintf (fd, "Number of fitted parameters = %d\n") + call pargi (nfpars) + call flush (fd) + + # Fit parameters + call fprintf (fd, "Max number of iterations = %d\n") + call pargi (NL_ITMAX (nl)) + call fprintf (fd, "Tolerance for convergence = %g\n") + call pargr (NL_TOL (nl)) + call flush (fd) + + # Sums + call fprintf (fd, "Damping factor = %g\n") + call pargr (NL_LAMBDA (nl)) + call fprintf (fd, "Sum of residuals squared last iteration = %g\n") + call pargr (NL_OLDSQ (nl)) + call fprintf (fd, "Sum of residuals squared = %g\n") + call pargr (NL_SUMSQ (nl)) + call flush (fd) + + # Counters + call fprintf (fd, "Iteration counter = %d\n") + call pargi (NL_ITER (nl)) + call fprintf (fd, "Number of points in fit = %d\n") + call pargi (NL_NPTS (nl)) + call flush (fd) + + # Parameter values + call fprintf (fd, "Parameter values (%d):\n") + call pargi (NL_PARAM (nl)) + if (NL_PARAM (nl) != NULL) { + do i = 1, npars { + call fprintf (fd, "%d -> %g\n") + call pargi (i) + call pargr (Memr[NL_PARAM (nl) + i - 1]) + } + } else + call fprintf (fd, " Null pointer\n") + call flush (fd) + + # Parameter errors + call fprintf (fd, "Parameter errors (%d):\n") + call pargi (NL_DPARAM (nl)) + if (NL_DPARAM (nl) != NULL) { + do i = 1, npars { + call fprintf (fd, "%d -> %g\n") + call pargi (i) + call pargr (Memr[NL_DPARAM (nl) + i - 1]) + } + } else + call fprintf (fd, " Null pointer\n") + call flush (fd) + + # Parameter list + call fprintf (fd, "Parameter list (%d):\n") + call pargi (NL_PLIST (nl)) + if (NL_PLIST (nl) != NULL) { + do i = 1, npars { + call fprintf (fd, "%d -> %d\n") + call pargi (i) + call pargi (Memi[NL_PLIST (nl) + i - 1]) + } + } else + call fprintf (fd, " Null pointer\n") + call flush (fd) + + # Alpha matrix + call fprintf (fd, "Alpha matrix (%d):\n") + call pargi (NL_ALPHA (nl)) + if (NL_ALPHA (nl) != NULL) + call nl_adumpr (fd, Memr[NL_ALPHA (nl)], nfpars, nfpars) + else + call fprintf (fd, " Null pointer\n") + call flush (fd) + + # Beta matrix + call fprintf (fd, "Beta matrix (%d):\n") + call pargi (NL_BETA (nl)) + if (NL_BETA (nl) != NULL) + call nl_adumpr (fd, Memr[NL_BETA (nl)], nfpars, 1) + else + call fprintf (fd, " Null pointer\n") + call flush (fd) + + # Covariance matrix + call fprintf (fd, "Covariance matrix (%d):\n") + call pargi (NL_COVAR (nl)) + if (NL_COVAR (nl) != NULL) + call nl_adumpr (fd, Memr[NL_COVAR (nl)], nfpars, nfpars) + else + call fprintf (fd, " Null pointer\n") + call flush (fd) + + # Cholesky factorization + call fprintf (fd, "Cholesky factorization matrix (%d):\n") + call pargi (NL_CHOFAC (nl)) + if (NL_CHOFAC (nl) != NULL) + call nl_adumpr (fd, Memr[NL_CHOFAC (nl)], nfpars, nfpars) + else + call fprintf (fd, " Null pointer\n") + call flush (fd) +end + + +# NL_ADUMP -- Dump array to file + +procedure nl_adumpr (fd, a, nrows, ncols) + +int fd # file descriptor +real a[nrows, ncols] # array +int nrows, ncols # dimension + +int i, j + +begin + do i = 1, nrows { + do j = 1, ncols { + call fprintf (fd, "%g ") + call pargr (a[i, j]) + } + call fprintf (fd, "\n") + } +end |