include "nlfitdefd.h"

# NL_DUMP -- Dump NLFIT structure to a file

procedure nl_dumpd (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 pargd (NL_TOL (nl))
	call flush (fd)

	# Sums
	call fprintf (fd, "Damping factor = %g\n")
	    call pargd (NL_LAMBDA (nl))
	call fprintf (fd, "Sum of residuals squared last iteration = %g\n")
	    call pargd (NL_OLDSQ (nl))
	call fprintf (fd, "Sum of residuals squared                = %g\n")
	    call pargd (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 pargd (Memd[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 pargd (Memd[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_adumpd (fd, Memd[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_adumpd (fd, Memd[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_adumpd (fd, Memd[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_adumpd (fd, Memd[NL_CHOFAC (nl)], nfpars, nfpars)
	else
	    call fprintf (fd, "	Null pointer\n")
	call flush (fd)
end


# NL_ADUMP -- Dump array to file

procedure nl_adumpd (fd, a, nrows, ncols)

int	fd			# file descriptor
double	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 pargd (a[i, j])
	    }
	    call fprintf (fd, "\n")
	}
end