luke
/
ngspice
mirror of https://git.code.sf.net/p/ngspice/ngspice
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

remove klu/btf/colamd/amd sources

This commit is contained in:
dwarning 2024-12-03 16:45:36 +01:00
parent 89cf3cf5c6
commit 3f432c19f3
58 changed files with 246 additions and 19997 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
configure.ac
View File

@ -304,15 +304,6 @@ if test "x$with_editline" = xyes; then
fi
fi
# Add KLU solver to ngspice
if test "x$enable_klu" = xyes || test "x$enable_klu" = x ; then
AC_DEFINE(KLU, [], [Define if we want KLU linear systems solver])
AC_MSG_RESULT([KLU solver enabled])
else
AC_MSG_RESULT([KLU solver disabled!])
fi
AM_CONDITIONAL([KLU_WANTED], [test "x$enable_klu" = xyes || test "x$enable_klu" = x])
# Enable maintainer commands only if requested
AM_MAINTAINER_MODE([enable])
@ -934,12 +925,6 @@ AC_MSG_RESULT([Checking mathematical features of the system:])
# Look for math library:
AC_CHECK_LIB([m], [sqrt])
AC_CHECK_HEADERS([float.h limits.h values.h ieeefp.h])
if test "x$with_fftw3" != xno; then
AC_CHECK_HEADERS([fftw3.h])
AC_CHECK_LIB([fftw3], [fftw_plan_dft_1d],
[AC_DEFINE([HAVE_LIBFFTW3], [], [Have fft routines in libfftw3])
LIBS="$LIBS -lfftw3"])
fi
# Check for a few mathematical functions:
AC_CHECK_FUNCS([erfc logb scalb scalbn asinh acosh atanh finite])
@ -1325,6 +1310,30 @@ fi
AC_CHECK_HEADERS([ncurses/termcap.h termcap.h])
AC_CHECK_HEADERS([sys/sysctl.h])
if test "x$with_fftw3" != xno; then
AC_CHECK_HEADERS([fftw3.h])
AC_CHECK_LIB([fftw3], [fftw_plan_dft_1d],
[AC_DEFINE([HAVE_LIBFFTW3], [], [Have fft routines in libfftw3])
LIBS="$LIBS -lfftw3"])
fi
# Add KLU solver to ngspice
if test "x$enable_klu" = xyes || test "x$enable_klu" = x ; then
# Check for KLU
AC_CHECK_HEADERS([suitesparse/klu.h], [have_klu_h=yes])
if test "$have_klu_h" != yes; then
AC_MSG_ERROR([Can't find klu.h])
else
AC_CHECK_LIB([klu], [klu_defaults],
[AC_DEFINE(KLU, [], [Define if we want KLU linear systems solver])
LIBS="$LIBS -lklu -lamd -lbtf -lcolamd"])
AC_MSG_RESULT([KLU solver enabled])
fi
else
AC_MSG_RESULT([KLU solver disabled!])
fi
AM_CONDITIONAL([KLU_WANTED], [test "x$enable_klu" = xyes || test "x$enable_klu" = x])
# --enable-openmp: Use OpenMP on multi-core processors
AC_ARG_ENABLE([openmp],

7
src/include/ngspice/Makefile.am
View File

@ -3,10 +3,8 @@
noinst_HEADERS = \
tclspice.h \
acdefs.h \
amd.h \
bdrydefs.h \
bool.h \
btf.h \
carddefs.h \
ciderinp.h \
cidersupt.h \
@ -16,7 +14,6 @@ noinst_HEADERS = \
cm.h \
cmproto.h \
cmtypes.h \
colamd.h \
compatmode.h \
complex.h \
const.h \
@ -67,7 +64,6 @@ noinst_HEADERS = \
ipcproto.h \
ipctiein.h \
jobdefs.h \
klu.h \
klu-binding.h \
logicexp.h \
lsort.h \
@ -136,8 +132,7 @@ noinst_HEADERS = \
fftext.h \
wallace.h \
wincolornames.h \
wstdio.h \
SuiteSparse_config.h
wstdio.h
if SHARED_MODULE
pkginclude_HEADERS = \

2301
src/include/ngspice/SuiteSparse_config.h
View File

File diff suppressed because it is too large Load Diff

399
src/include/ngspice/amd.h
View File

@ -1,399 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Include/amd.h: approximate minimum degree ordering
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2024, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* AMD finds a symmetric ordering P of a matrix A so that the Cholesky
* factorization of P*A*P' has fewer nonzeros and takes less work than the
* Cholesky factorization of A. If A is not symmetric, then it performs its
* ordering on the matrix A+A'. Two sets of user-callable routines are
* provided, one for int32_t integers and the other for int64_t integers.
*
* The method is based on the approximate minimum degree algorithm, discussed
* in Amestoy, Davis, and Duff, "An approximate degree ordering algorithm",
* SIAM Journal of Matrix Analysis and Applications, vol. 17, no. 4, pp.
* 886-905, 1996. This package can perform both the AMD ordering (with
* aggressive absorption), and the AMDBAR ordering (without aggressive
* absorption) discussed in the above paper. This package differs from the
* Fortran codes discussed in the paper:
*
* (1) it can ignore "dense" rows and columns, leading to faster run times
* (2) it computes the ordering of A+A' if A is not symmetric
* (3) it is followed by a depth-first post-ordering of the assembly tree
* (or supernodal elimination tree)
*
* For historical reasons, the Fortran versions, amd.f and amdbar.f, have
* been left (nearly) unchanged. They compute the identical ordering as
* described in the above paper.
*/
#ifndef AMD_H
#define AMD_H
#include "SuiteSparse_config.h"
/* make it easy for C++ programs to include AMD */
#ifdef __cplusplus
extern "C" {
#endif
int amd_order /* returns AMD_OK, AMD_OK_BUT_JUMBLED,
* AMD_INVALID, or AMD_OUT_OF_MEMORY */
(
int32_t n, /* A is n-by-n. n must be >= 0. */
const int32_t Ap [ ], /* column pointers for A, of size n+1 */
const int32_t Ai [ ], /* row indices of A, of size nz = Ap [n] */
int32_t P [ ], /* output permutation, of size n */
double Control [ ], /* input Control settings, of size AMD_CONTROL */
double Info [ ] /* output Info statistics, of size AMD_INFO */
) ;
int amd_l_order /* see above for description */
(
int64_t n,
const int64_t Ap [ ],
const int64_t Ai [ ],
int64_t P [ ],
double Control [ ],
double Info [ ]
) ;
/* Input arguments (not modified):
*
* n: the matrix A is n-by-n.
* Ap: an int32_t/int64_t array of size n+1, containing column
* pointers of A.
* Ai: an int32_t/int64_t array of size nz, containing the row
* indices of A, where nz = Ap [n].
* Control: a double array of size AMD_CONTROL, containing control
* parameters. Defaults are used if Control is NULL.
*
* Output arguments (not defined on input):
*
* P: an int32_t/int64_t array of size n, containing the output
* permutation. If row i is the kth pivot row, then P [k] = i. In
* MATLAB notation, the reordered matrix is A (P,P).
* Info: a double array of size AMD_INFO, containing statistical
* information. Ignored if Info is NULL.
*
* On input, the matrix A is stored in column-oriented form. The row indices
* of nonzero entries in column j are stored in Ai [Ap [j] ... Ap [j+1]-1].
*
* If the row indices appear in ascending order in each column, and there
* are no duplicate entries, then amd_order is slightly more efficient in
* terms of time and memory usage. If this condition does not hold, a copy
* of the matrix is created (where these conditions do hold), and the copy is
* ordered.
*
* Row indices must be in the range 0 to
* n-1. Ap [0] must be zero, and thus nz = Ap [n] is the number of nonzeros
* in A. The array Ap is of size n+1, and the array Ai is of size nz = Ap [n].
* The matrix does not need to be symmetric, and the diagonal does not need to
* be present (if diagonal entries are present, they are ignored except for
* the output statistic Info [AMD_NZDIAG]). The arrays Ai and Ap are not
* modified. This form of the Ap and Ai arrays to represent the nonzero
* pattern of the matrix A is the same as that used internally by MATLAB.
* If you wish to use a more flexible input structure, please see the
* umfpack_*_triplet_to_col routines in the UMFPACK package, at
* http://www.suitesparse.com.
*
* Restrictions: n >= 0. Ap [0] = 0. Ap [j] <= Ap [j+1] for all j in the
* range 0 to n-1. nz = Ap [n] >= 0. Ai [0..nz-1] must be in the range 0
* to n-1. Finally, Ai, Ap, and P must not be NULL. If any of these
* restrictions are not met, AMD returns AMD_INVALID.
*
* AMD returns:
*
* AMD_OK if the matrix is valid and sufficient memory can be allocated to
* perform the ordering.
*
* AMD_OUT_OF_MEMORY if not enough memory can be allocated.
*
* AMD_INVALID if the input arguments n, Ap, Ai are invalid, or if P is
* NULL.
*
* AMD_OK_BUT_JUMBLED if the matrix had unsorted columns, and/or duplicate
* entries, but was otherwise valid.
*
* The AMD routine first forms the pattern of the matrix A+A', and then
* computes a fill-reducing ordering, P. If P [k] = i, then row/column i of
* the original is the kth pivotal row. In MATLAB notation, the permuted
* matrix is A (P,P), except that 0-based indexing is used instead of the
* 1-based indexing in MATLAB.
*
* The Control array is used to set various parameters for AMD. If a NULL
* pointer is passed, default values are used. The Control array is not
* modified.
*
* Control [AMD_DENSE]: controls the threshold for "dense" rows/columns.
* A dense row/column in A+A' can cause AMD to spend a lot of time in
* ordering the matrix. If Control [AMD_DENSE] >= 0, rows/columns
* with more than Control [AMD_DENSE] * sqrt (n) entries are ignored
* during the ordering, and placed last in the output order. The
* default value of Control [AMD_DENSE] is 10. If negative, no
* rows/columns are treated as "dense". Rows/columns with 16 or
* fewer off-diagonal entries are never considered "dense".
*
* Control [AMD_AGGRESSIVE]: controls whether or not to use aggressive
* absorption, in which a prior element is absorbed into the current
* element if is a subset of the current element, even if it is not
* adjacent to the current pivot element (refer to Amestoy, Davis,
* & Duff, 1996, for more details). The default value is nonzero,
* which means to perform aggressive absorption. This nearly always
* leads to a better ordering (because the approximate degrees are
* more accurate) and a lower execution time. There are cases where
* it can lead to a slightly worse ordering, however. To turn it off,
* set Control [AMD_AGGRESSIVE] to 0.
*
* Control [2..4] are not used in the current version, but may be used in
* future versions.
*
* The Info array provides statistics about the ordering on output. If it is
* not present, the statistics are not returned. This is not an error
* condition.
*
* Info [AMD_STATUS]: the return value of AMD, either AMD_OK,
* AMD_OK_BUT_JUMBLED, AMD_OUT_OF_MEMORY, or AMD_INVALID.
*
* Info [AMD_N]: n, the size of the input matrix
*
* Info [AMD_NZ]: the number of nonzeros in A, nz = Ap [n]
*
* Info [AMD_SYMMETRY]: the symmetry of the matrix A. It is the number
* of "matched" off-diagonal entries divided by the total number of
* off-diagonal entries. An entry A(i,j) is matched if A(j,i) is also
* an entry, for any pair (i,j) for which i != j. In MATLAB notation,
* S = spones (A) ;
* B = tril (S, -1) + triu (S, 1) ;
* symmetry = nnz (B & B') / nnz (B) ;
*
* Info [AMD_NZDIAG]: the number of entries on the diagonal of A.
*
* Info [AMD_NZ_A_PLUS_AT]: the number of nonzeros in A+A', excluding the
* diagonal. If A is perfectly symmetric (Info [AMD_SYMMETRY] = 1)
* with a fully nonzero diagonal, then Info [AMD_NZ_A_PLUS_AT] = nz-n
* (the smallest possible value). If A is perfectly unsymmetric
* (Info [AMD_SYMMETRY] = 0, for an upper triangular matrix, for
* example) with no diagonal, then Info [AMD_NZ_A_PLUS_AT] = 2*nz
* (the largest possible value).
*
* Info [AMD_NDENSE]: the number of "dense" rows/columns of A+A' that were
* removed from A prior to ordering. These are placed last in the
* output order P.
*
* Info [AMD_MEMORY]: the amount of memory used by AMD, in bytes. In the
* current version, this is 1.2 * Info [AMD_NZ_A_PLUS_AT] + 9*n
* times the size of an integer. This is at most 2.4nz + 9n. This
* excludes the size of the input arguments Ai, Ap, and P, which have
* a total size of nz + 2*n + 1 integers.
*
* Info [AMD_NCMPA]: the number of garbage collections performed.
*
* Info [AMD_LNZ]: the number of nonzeros in L (excluding the diagonal).
* This is a slight upper bound because mass elimination is combined
* with the approximate degree update. It is a rough upper bound if
* there are many "dense" rows/columns. The rest of the statistics,
* below, are also slight or rough upper bounds, for the same reasons.
* The post-ordering of the assembly tree might also not exactly
* correspond to a true elimination tree postordering.
*
* Info [AMD_NDIV]: the number of divide operations for a subsequent LDL'
* or LU factorization of the permuted matrix A (P,P).
*
* Info [AMD_NMULTSUBS_LDL]: the number of multiply-subtract pairs for a
* subsequent LDL' factorization of A (P,P).
*
* Info [AMD_NMULTSUBS_LU]: the number of multiply-subtract pairs for a
* subsequent LU factorization of A (P,P), assuming that no numerical
* pivoting is required.
*
* Info [AMD_DMAX]: the maximum number of nonzeros in any column of L,
* including the diagonal.
*
* Info [14..19] are not used in the current version, but may be used in
* future versions.
*/
/* ------------------------------------------------------------------------- */
/* direct interface to AMD */
/* ------------------------------------------------------------------------- */
/* amd_2 is the primary AMD ordering routine. It is not meant to be
* user-callable because of its restrictive inputs and because it destroys
* the user's input matrix. It does not check its inputs for errors, either.
* However, if you can work with these restrictions it can be faster than
* amd_order and use less memory (assuming that you can create your own copy
* of the matrix for AMD to destroy). Refer to AMD/Source/amd_2.c for a
* description of each parameter. */
void amd_2
(
int32_t n,
int32_t Pe [ ],
int32_t Iw [ ],
int32_t Len [ ],
int32_t iwlen,
int32_t pfree,
int32_t Nv [ ],
int32_t Next [ ],
int32_t Last [ ],
int32_t Head [ ],
int32_t Elen [ ],
int32_t Degree [ ],
int32_t W [ ],
double Control [ ],
double Info [ ]
) ;
void amd_l2
(
int64_t n,
int64_t Pe [ ],
int64_t Iw [ ],
int64_t Len [ ],
int64_t iwlen,
int64_t pfree,
int64_t Nv [ ],
int64_t Next [ ],
int64_t Last [ ],
int64_t Head [ ],
int64_t Elen [ ],
int64_t Degree [ ],
int64_t W [ ],
double Control [ ],
double Info [ ]
) ;
/* ------------------------------------------------------------------------- */
/* amd_valid */
/* ------------------------------------------------------------------------- */
/* Returns AMD_OK or AMD_OK_BUT_JUMBLED if the matrix is valid as input to
* amd_order; the latter is returned if the matrix has unsorted and/or
* duplicate row indices in one or more columns. Returns AMD_INVALID if the
* matrix cannot be passed to amd_order. For amd_order, the matrix must also
* be square. The first two arguments are the number of rows and the number
* of columns of the matrix. For its use in AMD, these must both equal n.
*/
int amd_valid
(
int32_t n_row, /* # of rows */
int32_t n_col, /* # of columns */
const int32_t Ap [ ], /* column pointers, of size n_col+1 */
const int32_t Ai [ ] /* row indices, of size Ap [n_col] */
) ;
int amd_l_valid
(
int64_t n_row,
int64_t n_col,
const int64_t Ap [ ],
const int64_t Ai [ ]
) ;
/* ------------------------------------------------------------------------- */
/* AMD Control and Info arrays */
/* ------------------------------------------------------------------------- */
/* amd_defaults: sets the default control settings */
void amd_defaults (double Control [ ]) ;
void amd_l_defaults (double Control [ ]) ;
/* amd_control: prints the control settings */
void amd_control (double Control [ ]) ;
void amd_l_control (double Control [ ]) ;
/* amd_info: prints the statistics */
void amd_info (double Info [ ]) ;
void amd_l_info (double Info [ ]) ;
// amd_version: return AMD version. The version array is returned with
// version [0..2] = {AMD_MAIN_VERSION, AMD_SUB_VERSION, AMD_SUBSUB_VERSION}
void amd_version (int version [3]) ;
#ifdef __cplusplus
}
#endif
#define AMD_CONTROL 5 /* size of Control array */
#define AMD_INFO 20 /* size of Info array */
/* contents of Control */
#define AMD_DENSE 0 /* "dense" if degree > Control [0] * sqrt (n) */
#define AMD_AGGRESSIVE 1 /* do aggressive absorption if Control [1] != 0 */
/* default Control settings */
#define AMD_DEFAULT_DENSE 10.0 /* default "dense" degree 10*sqrt(n) */
#define AMD_DEFAULT_AGGRESSIVE 1 /* do aggressive absorption by default */
/* contents of Info */
#define AMD_STATUS 0 /* return value of amd_order and amd_l_order */
#define AMD_N 1 /* A is n-by-n */
#define AMD_NZ 2 /* number of nonzeros in A */
#define AMD_SYMMETRY 3 /* symmetry of pattern (1 is sym., 0 is unsym.) */
#define AMD_NZDIAG 4 /* # of entries on diagonal */
#define AMD_NZ_A_PLUS_AT 5 /* nz in A+A' */
#define AMD_NDENSE 6 /* number of "dense" rows/columns in A */
#define AMD_MEMORY 7 /* amount of memory used by AMD */
#define AMD_NCMPA 8 /* number of garbage collections in AMD */
#define AMD_LNZ 9 /* approx. nz in L, excluding the diagonal */
#define AMD_NDIV 10 /* number of fl. point divides for LU and LDL' */
#define AMD_NMULTSUBS_LDL 11 /* number of fl. point (*,-) pairs for LDL' */
#define AMD_NMULTSUBS_LU 12 /* number of fl. point (*,-) pairs for LU */
#define AMD_DMAX 13 /* max nz. in any column of L, incl. diagonal */
/* ------------------------------------------------------------------------- */
/* return values of AMD */
/* ------------------------------------------------------------------------- */
#define AMD_OK 0 /* success */
#define AMD_OUT_OF_MEMORY -1 /* malloc failed, or problem too large */
#define AMD_INVALID -2 /* input arguments are not valid */
#define AMD_OK_BUT_JUMBLED 1 /* input matrix is OK for amd_order, but
* columns were not sorted, and/or duplicate entries were present. AMD had
* to do extra work before ordering the matrix. This is a warning, not an
* error. */
/* ========================================================================== */
/* === AMD version ========================================================== */
/* ========================================================================== */
/* AMD Version 1.2 and later include the following definitions.
* As an example, to test if the version you are using is 1.2 or later:
*
* #ifdef AMD_VERSION
* if (AMD_VERSION >= AMD_VERSION_CODE (1,2)) ...
* #endif
*
* This also works during compile-time:
*
* #if defined(AMD_VERSION) && (AMD_VERSION >= AMD_VERSION_CODE (1,2))
* printf ("This is version 1.2 or later\n") ;
* #else
* printf ("This is an early version\n") ;
* #endif
*
* Versions 1.1 and earlier of AMD do not include a #define'd version number.
*/
#define AMD_DATE "June 20, 2024"
#define AMD_MAIN_VERSION 3
#define AMD_SUB_VERSION 3
#define AMD_SUBSUB_VERSION 3
#define AMD_VERSION_CODE(main,sub) SUITESPARSE_VER_CODE(main,sub)
#define AMD_VERSION AMD_VERSION_CODE(3,3)
#define AMD__VERSION SUITESPARSE__VERCODE(3,3,3)
#if !defined (SUITESPARSE__VERSION) || \
(SUITESPARSE__VERSION < SUITESPARSE__VERCODE(7,8,0))
#error "AMD 3.3.3 requires SuiteSparse_config 7.8.0 or later"
#endif
#endif

281
src/include/ngspice/btf.h
View File

@ -1,281 +0,0 @@
//------------------------------------------------------------------------------
// BTF/Include/btf.h: include file for BTF
//------------------------------------------------------------------------------
// BTF, Copyright (c) 2004-2024, University of Florida. All Rights Reserved.
// Author: Timothy A. Davis.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* BTF_MAXTRANS: find a column permutation Q to give A*Q a zero-free diagonal
* BTF_STRONGCOMP: find a symmetric permutation P to put P*A*P' into block
* upper triangular form.
* BTF_ORDER: do both of the above (btf_maxtrans then btf_strongcomp).
*/
/* ========================================================================== */
/* === BTF_MAXTRANS ========================================================= */
/* ========================================================================== */
/* BTF_MAXTRANS: finds a permutation of the columns of a matrix so that it has a
* zero-free diagonal. The input is an m-by-n sparse matrix in compressed
* column form. The array Ap of size n+1 gives the starting and ending
* positions of the columns in the array Ai. Ap[0] must be zero. The array Ai
* contains the row indices of the nonzeros of the matrix A, and is of size
* Ap[n]. The row indices of column j are located in Ai[Ap[j] ... Ap[j+1]-1].
* Row indices must be in the range 0 to m-1. Duplicate entries may be present
* in any given column. The input matrix is not checked for validity (row
* indices out of the range 0 to m-1 will lead to an undeterminate result -
* possibly a core dump, for example). Row indices in any given column need
* not be in sorted order. However, if they are sorted and the matrix already
* has a zero-free diagonal, then the identity permutation is returned.
*
* The output of btf_maxtrans is an array Match of size n. If row i is matched
* with column j, then A(i,j) is nonzero, and then Match[i] = j. If the matrix
* is structurally nonsingular, all entries in the Match array are unique, and
* Match can be viewed as a column permutation if A is square. That is, column
* k of the original matrix becomes column Match[k] of the permuted matrix. In
* MATLAB, this can be expressed as (for non-structurally singular matrices):
*
* Match = maxtrans (A) ;
* B = A (:, Match) ;
*
* except of course here the A matrix and Match vector are all 0-based (rows
* and columns in the range 0 to n-1), not 1-based (rows/cols in range 1 to n).
* The MATLAB dmperm routine returns a row permutation. See the maxtrans
* mexFunction for more details.
*
* If row i is not matched to any column, then Match[i] is == -1. The
* btf_maxtrans routine returns the number of nonzeros on diagonal of the
* permuted matrix.
*
* In the MATLAB mexFunction interface to btf_maxtrans, 1 is added to the Match
* array to obtain a 1-based permutation. Thus, in MATLAB where A is m-by-n:
*
* q = maxtrans (A) ; % has entries in the range 0:n
* q % a column permutation (only if sprank(A)==n)
* B = A (:, q) ; % permuted matrix (only if sprank(A)==n)
* sum (q > 0) ; % same as "sprank (A)"
*
* This behaviour differs from p = dmperm (A) in MATLAB, which returns the
* matching as p(j)=i if row i and column j are matched, and p(j)=0 if column j
* is unmatched.
*
* p = dmperm (A) ; % has entries in the range 0:m
* p % a row permutation (only if sprank(A)==m)
* B = A (p, :) ; % permuted matrix (only if sprank(A)==m)
* sum (p > 0) ; % definition of sprank (A)
*
* This algorithm is based on the paper "On Algorithms for obtaining a maximum
* transversal" by Iain Duff, ACM Trans. Mathematical Software, vol 7, no. 1,
* pp. 315-330, and "Algorithm 575: Permutations for a zero-free diagonal",
* same issue, pp. 387-390. Algorithm 575 is MC21A in the Harwell Subroutine
* Library. This code is not merely a translation of the Fortran code into C.
* It is a completely new implementation of the basic underlying method (depth
* first search over a subgraph with nodes corresponding to columns matched so
* far, and cheap matching). This code was written with minimal observation of
* the MC21A/B code itself. See comments below for a comparison between the
* maxtrans and MC21A/B codes.
*
* This routine operates on a column-form matrix and produces a column
* permutation. MC21A uses a row-form matrix and produces a row permutation.
* The difference is merely one of convention in the comments and interpretation
* of the inputs and outputs. If you want a row permutation, simply pass a
* compressed-row sparse matrix to this routine and you will get a row
* permutation (just like MC21A). Similarly, you can pass a column-oriented
* matrix to MC21A and it will happily return a column permutation.
*/
#ifndef _BTF_H
#define _BTF_H
#include "SuiteSparse_config.h"
/* make it easy for C++ programs to include BTF */
#ifdef __cplusplus
extern "C" {
#endif
int32_t btf_maxtrans /* returns # of columns matched */
(
/* --- input, not modified: --- */
int32_t nrow, /* A is nrow-by-ncol in compressed column form */
int32_t ncol,
int32_t Ap [ ], /* size ncol+1 */
int32_t Ai [ ], /* size nz = Ap [ncol] */
double maxwork, /* maximum amount of work to do is maxwork*nnz(A); no limit
* if <= 0 */
/* --- output, not defined on input --- */
double *work, /* work = -1 if maxwork > 0 and the total work performed
* reached the maximum of maxwork*nnz(A).
* Otherwise, work = the total work performed. */
int32_t Match [ ], /* size nrow. Match [i] = j if column j matched to row i
* (see above for the singular-matrix case) */
/* --- workspace, not defined on input or output --- */
int32_t Work [ ] /* size 5*ncol */
) ;
/* int64_t integer version */
int64_t btf_l_maxtrans (int64_t, int64_t,
int64_t *, int64_t *, double, double *,
int64_t *, int64_t *) ;
/* ========================================================================== */
/* === BTF_STRONGCOMP ======================================================= */
/* ========================================================================== */
/* BTF_STRONGCOMP finds the strongly connected components of a graph, returning
* a symmetric permutation. The matrix A must be square, and is provided on
* input in compressed-column form (see BTF_MAXTRANS, above). The diagonal of
* the input matrix A (or A*Q if Q is provided on input) is ignored.
*
* If Q is not NULL on input, then the strongly connected components of A*Q are
* found. Q may be flagged on input, where Q[k] < 0 denotes a flagged column k.
* The permutation is j = BTF_UNFLIP (Q [k]). On output, Q is modified (the
* flags are preserved) so that P*A*Q is in block upper triangular form.
*
* If Q is NULL, then the permutation P is returned so that P*A*P' is in upper
* block triangular form.
*
* The vector R gives the block boundaries, where block b is in rows/columns
* R[b] to R[b+1]-1 of the permuted matrix, and where b ranges from 1 to the
* number of strongly connected components found.
*/
int32_t btf_strongcomp /* return # of strongly connected components */
(
/* input, not modified: */
int32_t n, /* A is n-by-n in compressed column form */
int32_t Ap [ ], /* size n+1 */
int32_t Ai [ ], /* size nz = Ap [n] */
/* optional input, modified (if present) on output: */
int32_t Q [ ], /* size n, input column permutation */
/* output, not defined on input */
int32_t P [ ], /* size n. P [k] = j if row and column j are kth row/col
* in permuted matrix. */
int32_t R [ ], /* size n+1. block b is in rows/cols R[b] ... R[b+1]-1 */
/* workspace, not defined on input or output */
int32_t Work [ ] /* size 4n */
) ;
int64_t btf_l_strongcomp (int64_t, int64_t *,
int64_t *, int64_t *, int64_t *,
int64_t *, int64_t *) ;
/* ========================================================================== */
/* === BTF_ORDER ============================================================ */
/* ========================================================================== */
/* BTF_ORDER permutes a square matrix into upper block triangular form. It
* does this by first finding a maximum matching (or perhaps a limited matching
* if the work is limited), via the btf_maxtrans function. If a complete
* matching is not found, BTF_ORDER completes the permutation, but flags the
* columns of P*A*Q to denote which columns are not matched. If the matrix is
* structurally rank deficient, some of the entries on the diagonal of the
* permuted matrix will be zero. BTF_ORDER then calls btf_strongcomp to find
* the strongly-connected components.
*
* On output, P and Q are the row and column permutations, where i = P[k] if
* row i of A is the kth row of P*A*Q, and j = BTF_UNFLIP(Q[k]) if column j of
* A is the kth column of P*A*Q. If Q[k] < 0, then the (k,k)th entry in P*A*Q
* is structurally zero.
*
* The vector R gives the block boundaries, where block b is in rows/columns
* R[b] to R[b+1]-1 of the permuted matrix, and where b ranges from 1 to the
* number of strongly connected components found.
*/
int32_t btf_order /* returns number of blocks found */
(
/* --- input, not modified: --- */
int32_t n, /* A is n-by-n in compressed column form */
int32_t Ap [ ], /* size n+1 */
int32_t Ai [ ], /* size nz = Ap [n] */
double maxwork, /* do at most maxwork*nnz(A) work in the maximum
* transversal; no limit if <= 0 */
/* --- output, not defined on input --- */
double *work, /* return value from btf_maxtrans */
int32_t P [ ], /* size n, row permutation */
int32_t Q [ ], /* size n, column permutation */
int32_t R [ ], /* size n+1. block b is in rows/cols R[b] ... R[b+1]-1 */
int32_t *nmatch, /* # nonzeros on diagonal of P*A*Q */
/* --- workspace, not defined on input or output --- */
int32_t Work [ ] /* size 5n */
) ;
int64_t btf_l_order (int64_t, int64_t *, int64_t *, double , double *,
int64_t *, int64_t *, int64_t *, int64_t *, int64_t *) ;
//------------------------------------------------------------------------------
// btf_version: return BTF version
//------------------------------------------------------------------------------
void btf_version (int version [3]) ;
#ifdef __cplusplus
}
#endif
/* ========================================================================== */
/* === BTF marking of singular columns ====================================== */
/* ========================================================================== */
/* BTF_FLIP is a "negation about -1", and is used to mark an integer j
* that is normally non-negative. BTF_FLIP (-1) is -1. BTF_FLIP of
* a number > -1 is negative, and BTF_FLIP of a number < -1 is positive.
* BTF_FLIP (BTF_FLIP (j)) = j for all integers j. UNFLIP (j) acts
* like an "absolute value" operation, and is always >= -1. You can test
* whether or not an integer j is "flipped" with the BTF_ISFLIPPED (j)
* macro.
*/
#define BTF_FLIP(j) (-(j)-2)
#define BTF_ISFLIPPED(j) ((j) < -1)
#define BTF_UNFLIP(j) ((BTF_ISFLIPPED (j)) ? BTF_FLIP (j) : (j))
/* ========================================================================== */
/* === BTF version ========================================================== */
/* ========================================================================== */
/* All versions of BTF include these definitions.
* As an example, to test if the version you are using is 1.2 or later:
*
* if (BTF_VERSION >= BTF_VERSION_CODE (1,2)) ...
*
* This also works during compile-time:
*
* #if (BTF_VERSION >= BTF_VERSION_CODE (1,2))
* printf ("This is version 1.2 or later\n") ;
* #else
* printf ("This is an early version\n") ;
* #endif
*/
#define BTF_DATE "Mar 22, 2024"
#define BTF_MAIN_VERSION 2
#define BTF_SUB_VERSION 3
#define BTF_SUBSUB_VERSION 2
#define BTF_VERSION_CODE(main,sub) SUITESPARSE_VER_CODE(main,sub)
#define BTF_VERSION BTF_VERSION_CODE(2,3)
#define BTF__VERSION SUITESPARSE__VERCODE(2,3,2)
#if !defined (SUITESPARSE__VERSION) || \
(SUITESPARSE__VERSION < SUITESPARSE__VERCODE(7,7,0))
#error "BTF 2.3.2 requires SuiteSparse_config 7.7.0 or later"
#endif
#endif

243
src/include/ngspice/colamd.h
View File

@ -1,243 +0,0 @@
//------------------------------------------------------------------------------
// COLAMD/Include/colamd.h: include file for COLAMD
//------------------------------------------------------------------------------
// COLAMD, Copyright (c) 1998-2024, Timothy A. Davis and Stefan Larimore,
// All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* COLAMD / SYMAMD include file
You must include this file (colamd.h) in any routine that uses colamd,
symamd, or the related macros and definitions.
Authors:
The authors of the code itself are Stefan I. Larimore and Timothy A.
Davis (DrTimothyAldenDavis@gmail.com). The algorithm was
developed in collaboration with John Gilbert, Xerox PARC, and Esmond
Ng, Oak Ridge National Laboratory.
Acknowledgements:
This work was supported by the National Science Foundation, under
grants DMS-9504974 and DMS-9803599.
Availability:
The colamd/symamd library is available at http://www.suitesparse.com
This file is required by the colamd.c, colamdmex.c, and symamdmex.c
files, and by any C code that calls the routines whose prototypes are
listed below, or that uses the colamd/symamd definitions listed below.
*/
#ifndef COLAMD_H
#define COLAMD_H
/* ========================================================================== */
/* === Include files ======================================================== */
/* ========================================================================== */
#include "SuiteSparse_config.h"
/* ========================================================================== */
/* === COLAMD version ======================================================= */
/* ========================================================================== */
/* COLAMD Version 2.4 and later will include the following definitions.
* As an example, to test if the version you are using is 2.4 or later:
*
* #ifdef COLAMD_VERSION
* if (COLAMD_VERSION >= COLAMD_VERSION_CODE (2,4)) ...
* #endif
*
* This also works during compile-time:
*
* #if defined(COLAMD_VERSION) && (COLAMD_VERSION >= COLAMD_VERSION_CODE (2,4))
* printf ("This is version 2.4 or later\n") ;
* #else
* printf ("This is an early version\n") ;
* #endif
*
* Versions 2.3 and earlier of COLAMD do not include a #define'd version number.
*/
#define COLAMD_DATE "June 20, 2024"
#define COLAMD_MAIN_VERSION 3
#define COLAMD_SUB_VERSION 3
#define COLAMD_SUBSUB_VERSION 4
#define COLAMD_VERSION_CODE(main,sub) SUITESPARSE_VER_CODE(main,sub)
#define COLAMD_VERSION COLAMD_VERSION_CODE(3,3)
#define COLAMD__VERSION SUITESPARSE__VERCODE(3,3,4)
#if !defined (SUITESPARSE__VERSION) || \
(SUITESPARSE__VERSION < SUITESPARSE__VERCODE(7,8,0))
#error "COLAMD 3.3.4 requires SuiteSparse_config 7.8.0 or later"
#endif
/* ========================================================================== */
/* === Knob and statistics definitions ====================================== */
/* ========================================================================== */
/* size of the knobs [ ] array. Only knobs [0..1] are currently used. */
#define COLAMD_KNOBS 20
/* number of output statistics. Only stats [0..6] are currently used. */
#define COLAMD_STATS 20
/* knobs [0] and stats [0]: dense row knob and output statistic. */
#define COLAMD_DENSE_ROW 0
/* knobs [1] and stats [1]: dense column knob and output statistic. */
#define COLAMD_DENSE_COL 1
/* knobs [2]: aggressive absorption */
#define COLAMD_AGGRESSIVE 2
/* stats [2]: memory defragmentation count output statistic */
#define COLAMD_DEFRAG_COUNT 2
/* stats [3]: colamd status: zero OK, > 0 warning or notice, < 0 error */
#define COLAMD_STATUS 3
/* stats [4..6]: error info, or info on jumbled columns */
#define COLAMD_INFO1 4
#define COLAMD_INFO2 5
#define COLAMD_INFO3 6
/* error codes returned in stats [3]: */
#define COLAMD_OK (0)
#define COLAMD_OK_BUT_JUMBLED (1)
#define COLAMD_ERROR_A_not_present (-1)
#define COLAMD_ERROR_p_not_present (-2)
#define COLAMD_ERROR_nrow_negative (-3)
#define COLAMD_ERROR_ncol_negative (-4)
#define COLAMD_ERROR_nnz_negative (-5)
#define COLAMD_ERROR_p0_nonzero (-6)
#define COLAMD_ERROR_A_too_small (-7)
#define COLAMD_ERROR_col_length_negative (-8)
#define COLAMD_ERROR_row_index_out_of_bounds (-9)
#define COLAMD_ERROR_out_of_memory (-10)
#define COLAMD_ERROR_internal_error (-999)
/* ========================================================================== */
/* === Prototypes of user-callable routines ================================= */
/* ========================================================================== */
/* make it easy for C++ programs to include COLAMD */
#ifdef __cplusplus
extern "C" {
#endif
size_t colamd_recommended /* returns recommended value of Alen, */
/* or 0 if input arguments are erroneous */
(
int32_t nnz, /* nonzeros in A */
int32_t n_row, /* number of rows in A */
int32_t n_col /* number of columns in A */
) ;
size_t colamd_l_recommended /* returns recommended value of Alen, */
/* or 0 if input arguments are erroneous */
(
int64_t nnz, /* nonzeros in A */
int64_t n_row, /* number of rows in A */
int64_t n_col /* number of columns in A */
) ;
void colamd_set_defaults /* sets default parameters */
( /* knobs argument is modified on output */
double knobs [COLAMD_KNOBS] /* parameter settings for colamd */
) ;
void colamd_l_set_defaults /* sets default parameters */
( /* knobs argument is modified on output */
double knobs [COLAMD_KNOBS] /* parameter settings for colamd */
) ;
int colamd /* returns (1) if successful, (0) otherwise*/
( /* A and p arguments are modified on output */
int32_t n_row, /* number of rows in A */
int32_t n_col, /* number of columns in A */
int32_t Alen, /* size of the array A */
int32_t A [], /* row indices of A, of size Alen */
int32_t p [], /* column pointers of A, of size n_col+1 */
double knobs [COLAMD_KNOBS], /* parameter settings for colamd */
int32_t stats [COLAMD_STATS] /* colamd output stats and error codes */
) ;
int colamd_l /* returns (1) if successful, (0) otherwise*/
( /* A and p arguments are modified on output */
int64_t n_row, /* number of rows in A */
int64_t n_col, /* number of columns in A */
int64_t Alen, /* size of the array A */
int64_t A [], /* row indices of A, of size Alen */
int64_t p [], /* column pointers of A, of size n_col+1 */
double knobs [COLAMD_KNOBS], /* parameter settings for colamd */
int64_t stats [COLAMD_STATS] /* colamd output stats and error codes */
) ;
int symamd /* return (1) if OK, (0) otherwise */
(
int32_t n, /* number of rows and columns of A */
int32_t A [], /* row indices of A */
int32_t p [], /* column pointers of A */
int32_t perm [], /* output permutation, size n_col+1 */
double knobs [COLAMD_KNOBS], /* parameters (uses defaults if NULL) */
int32_t stats [COLAMD_STATS], /* output stats and error codes */
void * (*allocate) (size_t, size_t),
/* pointer to calloc (ANSI C) or */
/* mxCalloc (for MATLAB mexFunction) */
void (*release) (void *)
/* pointer to free (ANSI C) or */
/* mxFree (for MATLAB mexFunction) */
) ;
int symamd_l /* return (1) if OK, (0) otherwise */
(
int64_t n, /* number of rows and columns of A */
int64_t A [], /* row indices of A */
int64_t p [], /* column pointers of A */
int64_t perm [], /* output permutation, size n_col+1 */
double knobs [COLAMD_KNOBS], /* parameters (uses defaults if NULL) */
int64_t stats [COLAMD_STATS], /* output stats and error codes */
void * (*allocate) (size_t, size_t),
/* pointer to calloc (ANSI C) or */
/* mxCalloc (for MATLAB mexFunction) */
void (*release) (void *)
/* pointer to free (ANSI C) or */
/* mxFree (for MATLAB mexFunction) */
) ;
void colamd_report
(
int32_t stats [COLAMD_STATS]
) ;
void colamd_l_report
(
int64_t stats [COLAMD_STATS]
) ;
void symamd_report
(
int32_t stats [COLAMD_STATS]
) ;
void symamd_l_report
(
int64_t stats [COLAMD_STATS]
) ;
void colamd_version (int version [3]) ;
#ifdef __cplusplus
}
#endif
#endif /* COLAMD_H */

2
src/include/ngspice/klu-binding.h
View File

@ -1,7 +1,7 @@
#ifndef _KLU_BINDING_H
#define _KLU_BINDING_H
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#define CREATE_KLU_BINDING_TABLE(ptr, binding, a, b) \
if ((here->a > 0) && (here->b > 0)) { \

1049
src/include/ngspice/klu.h
View File

File diff suppressed because it is too large Load Diff

206
src/include/ngspice/klu_ext.h Normal file
View File

@ -0,0 +1,206 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_ext.h: include file for KLU
//------------------------------------------------------------------------------
/* Include file for user programs that call klu_* routines */
#ifndef _KLU_EXT_H
#define _KLU_EXT_H
#define KLU_EMPTY_MATRIX (2) /* Modified by Francesco Lannutti - Case when the matrix is empty */
/* Francesco - Extract only Udiag */
int klu_extract_Udiag /* returns TRUE if successful, FALSE otherwise */
(
/* inputs: */
klu_numeric *Numeric,
klu_symbolic *Symbolic,
/* outputs, all of which must be allocated on input */
/* U */
double *Ux, /* size nnz(U) */
int *P,
int *Q,
double *Rs,
klu_common *Common
) ;
/* Francesco - Extract only Udiag */
int klu_z_extract_Udiag /* returns TRUE if successful, FALSE otherwise */
(
/* inputs: */
klu_numeric *Numeric,
klu_symbolic *Symbolic,
/* outputs, all of which must be allocated on input */
/* U */
double *Ux, /* size nnz(U) */
double *Uz, /* size nnz(U) for the complex case, ignored if real */
int *P,
int *Q,
double *Rs,
klu_common *Common
) ;
/* Francesco - Utilities */
int klu_print
(
int *Ap,
int *Ai,
double *Ax,
int n,
int *IntToExtRowMap,
int *IntToExtColMap
) ;
int klu_z_print
(
int *Ap,
int *Ai,
double *Ax,
int n,
int *IntToExtRowMap,
int *IntToExtColMap
) ;
int klu_constant_multiply
(
int *Ap,
double *Ax,
int n,
klu_common *Common,
double constant
) ;
int klu_z_constant_multiply
(
int *Ap,
double *Ax,
int n,
klu_common *Common,
double constant
) ;
int klu_matrix_vector_multiply
(
int *Ap, /* CSR */
int *Ai, /* CSR */
double *Ax, /* CSR */
double *RHS,
double *Solution,
int *IntToExtRowMap,
int *IntToExtColMap,
int n,
klu_common *Common
) ;
int klu_z_matrix_vector_multiply
(
int *Ap, /* CSR */
int *Ai, /* CSR */
double *Ax, /* CSR */
double *RHS,
double *Solution,
double *iRHS,
double *iSolution,
int *IntToExtRowMap,
int *IntToExtColMap,
int n,
klu_common *Common
) ;
int klu_convert_matrix_in_CSR
(
int *Ap_CSC, /* CSC */
int *Ai_CSC, /* CSC */
double *Ax_CSC, /* CSC */
int *Ap_CSR, /* CSR */
int *Ai_CSR, /* CSR */
double *Ax_CSR, /* CSR */
int n,
int nz,
klu_common *Common
) ;
int klu_z_convert_matrix_in_CSR
(
int *Ap_CSC, /* CSC */
int *Ai_CSC, /* CSC */
double *Ax_CSC, /* CSC */
int *Ap_CSR, /* CSR */
int *Ai_CSR, /* CSR */
double *Ax_CSR, /* CSR */
int n,
int nz,
klu_common *Common
) ;
typedef struct sBindElement {
double *COO ;
double *CSC ;
double *CSC_Complex ;
} BindElement ;
#ifdef CIDER
typedef struct sBindElementKLUforCIDER {
double *COO ;
double *CSC_Complex ;
} BindElementKLUforCIDER ;
#endif
typedef struct sKluLinkedListCOO {
unsigned int row ;
unsigned int col ;
double *pointer ;
struct sKluLinkedListCOO *next ;
} KluLinkedListCOO ;
int BindCompare (const void *a, const void *b) ;
#ifdef CIDER
int BindCompareKLUforCIDER (const void *a, const void *b) ;
int BindKluCompareCSCKLUforCIDER (const void *a, const void *b) ;
#endif
typedef struct sKLUmatrix {
klu_common *KLUmatrixCommon ; /* KLU common object */
klu_symbolic *KLUmatrixSymbolic ; /* KLU symbolic object */
klu_numeric *KLUmatrixNumeric ; /* KLU numeric object */
int *KLUmatrixAp ; /* KLU column pointer */
int *KLUmatrixAi ; /* KLU row pointer */
double *KLUmatrixAx ; /* KLU Real Elements */
double *KLUmatrixAxComplex ; /* KLU Complex Elements */
unsigned int KLUmatrixIsComplex:1 ; /* KLU Matrix Is Complex Flag */
#define KLUmatrixReal 0 /* KLU Matrix Real definition */
#define KLUMatrixComplex 1 /* KLU Matrix Complex definition */
double *KLUmatrixIntermediate ; /* KLU RHS Intermediate for Solve Real Step */
double *KLUmatrixIntermediateComplex ; /* KLU iRHS Intermediate for Solve Complex Step */
unsigned int KLUmatrixN ; /* KLU N */
unsigned int KLUmatrixNrhs ; /* KLU N for RHS - needed by Node Collapsing */
unsigned int KLUmatrixNZ ; /* KLU nz */
BindElement *KLUmatrixBindStructCOO ; /* KLU COO Binding Structure */
KluLinkedListCOO *KLUmatrixLinkedListCOO ; /* KLU COO in Linked List Format for Initial Parsing */
// unsigned int *KLUmatrixNodeCollapsingOldToNew ; /* KLU Node Collapsing Mapping from New Node to Old Node */
unsigned int *KLUmatrixNodeCollapsingNewToOld ; /* KLU Node Collapsing Mapping from New Node to Old Node */
unsigned int KLUmatrixLinkedListNZ ; /* KLU nz for the Initial Parsing */
double *KLUmatrixTrashCOO ; /* KLU COO Trash Pointer for Ground Node not Stored in the Matrix */
double **KLUmatrixDiag ; /* KLU pointer to diagonal element to perform Gmin */
unsigned int KLUloadDiagGmin:1 ; /* KLU flag to load Diag Gmin */
#ifdef CIDER
int *KLUmatrixColCOOforCIDER ; /* KLU Col Index for COO storage (for CIDER) */
int *KLUmatrixRowCOOforCIDER ; /* KLU Row Index for COO storage (for CIDER) */
double *KLUmatrixValueComplexCOOforCIDER ; /* KLU Complex Elements for COO storage (for CIDER) */
BindElementKLUforCIDER *KLUmatrixBindStructForCIDER ; /* KLU COO Binding Structure (for CIDER) */
#endif
} KLUmatrix ;
#endif

3
src/include/ngspice/onemesh.h
View File

@ -17,7 +17,8 @@ Authors: 1987 Karti Mayaram, 1991 David Gates
#include "ngspice/material.h"
#ifdef KLU
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#include "ngspice/klu_ext.h"
#endif
typedef struct sONEelem {

3
src/include/ngspice/smpdefs.h
View File

@ -19,7 +19,8 @@ Modified: 2000 AlansFixes
#include "ngspice/complex.h"
#ifdef KLU
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#include "ngspice/klu_ext.h"
#include "ngspice/spmatrix.h"
#endif

3
src/include/ngspice/twomesh.h
View File

@ -17,7 +17,8 @@ Authors: 1987 Karti Mayaram, 1991 David Gates
#include "ngspice/material.h"
#ifdef KLU
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#include "ngspice/klu_ext.h"
#endif
typedef struct sTWOelem

52
src/maths/KLU/Makefile.am
View File

@ -5,26 +5,12 @@ EXTRA_DIST = SuiteSparse.org
noinst_LTLIBRARIES = libKLU_real.la libKLU_complex.la libKLU.la
noinst_HEADERS = \
amd_internal.h \
btf_internal.h \
klu_internal.h \
klu_version.h
libKLU_real_la_SOURCES = \
klu.c \
klu_diagnostics.c \
klu_dump.c \
klu_extract.c \
klu_factor.c \
klu_free_numeric.c \
klu_kernel.c \
klu_multiply.c \
klu_refactor.c \
klu_scale.c \
klu_solve.c \
klu_sort.c \
klu_tsolve.c \
klu_utils.c
@ -32,19 +18,7 @@ libKLU_real_la_CPPFLAGS = @AM_CPPFLAGS@ -I$(top_srcdir)/src/include
libKLU_complex_la_SOURCES = \
klu.c \
klu_diagnostics.c \
klu_dump.c \
klu_extract.c \
klu_factor.c \
klu_free_numeric.c \
klu_kernel.c \
klu_multiply.c \
klu_refactor.c \
klu_scale.c \
klu_solve.c \
klu_sort.c \
klu_tsolve.c \
klu_utils.c
@ -52,31 +26,7 @@ libKLU_complex_la_CPPFLAGS = @AM_CPPFLAGS@ -I$(top_srcdir)/src/include -DCOMPLEX
libKLU_la_SOURCES = \
amd_1.c \
amd_2.c \
amd_aat.c \
amd_control.c \
amd_defaults.c \
amd_dump.c \
amd_global.c \
amd_info.c \
amd_order.c \
amd_postorder.c \
amd_post_tree.c \
amd_preprocess.c \
amd_valid.c \
btf_maxtrans.c \
btf_order.c \
btf_strongcomp.c \
colamd.c \
colamd_global.c \
klu_analyze.c \
klu_analyze_given.c \
klu_defaults.c \
klu_free_symbolic.c \
klu_memory.c \
klusmp.c \
SuiteSparse_config.c
klusmp.c
libKLU_la_LIBADD = \
libKLU_real.la \

43
src/maths/KLU/SuiteSparse.org
View File

@ -1,43 +0,0 @@
<2016-07-03 So>
old/archived source from
http://faculty.cse.tamu.edu/davis/suitesparse.html
http://faculty.cse.tamu.edu/davis/SuiteSparse/SuiteSparse-3.7.0.tar.gz
inject source files from there :
(compile "tar=../../../SuiteSparse-3.7.0.tar.gz
for dir in SuiteSparse/KLU/Source SuiteSparse/KLU/Include \\
SuiteSparse/AMD/Source SuiteSparse/AMD/Include \\
SuiteSparse/BTF/Source SuiteSparse/BTF/Include \\
SuiteSparse/COLAMD/Source SuiteSparse/COLAMD/Include
do
tar -zxf $tar $dir
files=$(cd $dir && ls -1 *.c *.h)
mv $dir/*.c $dir/*.h .
git add $files
done
file=SuiteSparse/UFconfig/UFconfig.h
tar -zxf $tar $file
mv $file .
git add $(basename $file)
")
(compile "for file in colamd.h amd.h btf.h klu.h UFconfig.h
do
git mv $file ../../include/ngspice/$file
done
")
delete-trailing-whitespace and untabify :
(loop for file in (process-lines "git" "ls-files")
do (with-temp-file file
(insert-file-contents file)
(delete-trailing-whitespace)
;; (untabify (point-min) (point-max))
))

789
src/maths/KLU/SuiteSparse_config.c
View File

@ -1,789 +0,0 @@
//------------------------------------------------------------------------------
// SuiteSparse_config/SuiteSparse_config.c: common utilites for SuiteSparse
//------------------------------------------------------------------------------
// SuiteSparse_config, Copyright (c) 2012-2023, Timothy A. Davis.
// All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* SuiteSparse configuration : memory manager and printf functions.
*/
#include "ngspice/SuiteSparse_config.h"
#if defined ( MATLAB_MEX_FILE )
#include "mex.h"
#endif
/* -------------------------------------------------------------------------- */
/* SuiteSparse_config : a static struct */
/* -------------------------------------------------------------------------- */
/* The SuiteSparse_config struct is indirectly available to all SuiteSparse
functions and to all applications that use those functions. In v6.x and
earlier, it was globally visible, but it is now hidden and accessible only
by functions in this file (SuiteSparse v7.0.0 and later).
It must be modified with care, particularly in a multithreaded context.
Normally, the application will initialize this object once, via
SuiteSparse_start, possibily followed by application-specific modifications
if the applications wants to use alternative memory manager functions.
The user can redefine these pointers at run-time to change the
memory manager and printf function used by SuiteSparse.
If -DNMALLOC is defined at compile-time, then no memory-manager is
specified. You must define them at run-time, after calling
SuiteSparse_start.
If -DPRINT is defined a compile time, then printf is disabled, and
SuiteSparse will not use printf.
*/
struct SuiteSparse_config_struct
{
void *(*malloc_func) (size_t) ; // pointer to malloc
void *(*calloc_func) (size_t, size_t) ; // pointer to calloc
void *(*realloc_func) (void *, size_t) ; // pointer to realloc
void (*free_func) (void *) ; // pointer to free
int (*printf_func) (const char *, ...) ; // pointer to printf
double (*hypot_func) (double, double) ; // pointer to hypot
int (*divcomplex_func) (double, double, double, double, double *, double *);
} ;
static struct SuiteSparse_config_struct SuiteSparse_config =
{
/* memory management functions */
#ifndef NMALLOC
#ifdef MATLAB_MEX_FILE
/* MATLAB mexFunction: */
mxMalloc, mxCalloc, mxRealloc, mxFree,
#else
/* standard ANSI C: */
malloc, calloc, realloc, free,
#endif
#else
/* no memory manager defined; you must define one at run-time: */
NULL, NULL, NULL, NULL,
#endif
/* printf function */
#ifndef NPRINT
#ifdef MATLAB_MEX_FILE
/* MATLAB mexFunction: */
mexPrintf,
#else
/* standard ANSI C: */
printf,
#endif
#else
/* printf is disabled */
NULL,
#endif
hypot, // was SuiteSparse_hypot in v5 and earlier
SuiteSparse_divcomplex
} ;
//------------------------------------------------------------------------------
// SuiteSparse_config_*_get methods
//------------------------------------------------------------------------------
// Methods that return the contents of the SuiteSparse_config struct.
void *(*SuiteSparse_config_malloc_func_get (void)) (size_t)
{
return (SuiteSparse_config.malloc_func) ;
}
void *(*SuiteSparse_config_calloc_func_get (void)) (size_t, size_t)
{
return (SuiteSparse_config.calloc_func) ;
}
void *(*SuiteSparse_config_realloc_func_get (void)) (void *, size_t)
{
return (SuiteSparse_config.realloc_func) ;
}
void (*SuiteSparse_config_free_func_get (void)) (void *)
{
return (SuiteSparse_config.free_func) ;
}
int (*SuiteSparse_config_printf_func_get (void)) (const char *, ...)
{
return (SuiteSparse_config.printf_func) ;
}
double (*SuiteSparse_config_hypot_func_get (void)) (double, double)
{
return (SuiteSparse_config.hypot_func) ;
}
int (*SuiteSparse_config_divcomplex_func_get (void)) (double, double, double, double, double *, double *)
{
return (SuiteSparse_config.divcomplex_func) ;
}
//------------------------------------------------------------------------------
// SuiteSparse_config_*_set methods
//------------------------------------------------------------------------------
// Methods that set the contents of the SuiteSparse_config struct.
void SuiteSparse_config_malloc_func_set (void *(*malloc_func) (size_t))
{
SuiteSparse_config.malloc_func = malloc_func ;
}
void SuiteSparse_config_calloc_func_set (void *(*calloc_func) (size_t, size_t))
{
SuiteSparse_config.calloc_func = calloc_func ;
}
void SuiteSparse_config_realloc_func_set (void *(*realloc_func) (void *, size_t))
{
SuiteSparse_config.realloc_func = realloc_func ;
}
void SuiteSparse_config_free_func_set (void (*free_func) (void *))
{
SuiteSparse_config.free_func = free_func ;
}
void SuiteSparse_config_printf_func_set (int (*printf_func) (const char *, ...))
{
SuiteSparse_config.printf_func = printf_func ;
}
void SuiteSparse_config_hypot_func_set (double (*hypot_func) (double, double))
{
SuiteSparse_config.hypot_func = hypot_func ;
}
void SuiteSparse_config_divcomplex_func_set (int (*divcomplex_func) (double, double, double, double, double *, double *))
{
SuiteSparse_config.divcomplex_func = divcomplex_func ;
}
//------------------------------------------------------------------------------
// SuiteSparse_config_*_call methods
//------------------------------------------------------------------------------
// Methods that directly call the functions in the SuiteSparse_config struct.
// Note that there is no wrapper for the printf_func.
void *SuiteSparse_config_malloc (size_t s)
{
return (SuiteSparse_config.malloc_func (s)) ;
}
void *SuiteSparse_config_calloc (size_t n, size_t s)
{
return (SuiteSparse_config.calloc_func (n, s)) ;
}
void *SuiteSparse_config_realloc (void *p, size_t s)
{
return (SuiteSparse_config.realloc_func (p, s)) ;
}
void SuiteSparse_config_free (void *p)
{
SuiteSparse_config.free_func (p) ;
}
double SuiteSparse_config_hypot (double x, double y)
{
return (SuiteSparse_config.hypot_func (x, y)) ;
}
int SuiteSparse_config_divcomplex
(
double xr, double xi, double yr, double yi, double *zr, double *zi
)
{
return (SuiteSparse_config.divcomplex_func (xr, xi, yr, yi, zr, zi)) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_start */
/* -------------------------------------------------------------------------- */
/* All applications that use SuiteSparse should call SuiteSparse_start prior
to using any SuiteSparse function. Only a single thread should call this
function, in a multithreaded application. Currently, this function is
optional, since all this function currently does is to set the four memory
function pointers to NULL (which tells SuiteSparse to use the default
functions). In a multi- threaded application, only a single thread should
call this function.
Future releases of SuiteSparse might enforce a requirement that
SuiteSparse_start be called prior to calling any SuiteSparse function.
*/
void SuiteSparse_start ( void )
{
/* memory management functions */
#ifndef NMALLOC
#ifdef MATLAB_MEX_FILE
/* MATLAB mexFunction: */
SuiteSparse_config.malloc_func = mxMalloc ;
SuiteSparse_config.calloc_func = mxCalloc ;
SuiteSparse_config.realloc_func = mxRealloc ;
SuiteSparse_config.free_func = mxFree ;
#else
/* standard ANSI C: */
SuiteSparse_config.malloc_func = malloc ;
SuiteSparse_config.calloc_func = calloc ;
SuiteSparse_config.realloc_func = realloc ;
SuiteSparse_config.free_func = free ;
#endif
#else
/* no memory manager defined; you must define one after calling
SuiteSparse_start */
SuiteSparse_config.malloc_func = NULL ;
SuiteSparse_config.calloc_func = NULL ;
SuiteSparse_config.realloc_func = NULL ;
SuiteSparse_config.free_func = NULL ;
#endif
/* printf function */
#ifndef NPRINT
#ifdef MATLAB_MEX_FILE
/* MATLAB mexFunction: */
SuiteSparse_config.printf_func = mexPrintf ;
#else
/* standard ANSI C: */
SuiteSparse_config.printf_func = printf ;
#endif
#else
/* printf is disabled */
SuiteSparse_config.printf_func = NULL ;
#endif
/* math functions */
SuiteSparse_config.hypot_func = hypot ; // was SuiteSparse_hypot in v5
SuiteSparse_config.divcomplex_func = SuiteSparse_divcomplex ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_finish */
/* -------------------------------------------------------------------------- */
/* This currently does nothing, but in the future, applications should call
SuiteSparse_start before calling any SuiteSparse function, and then
SuiteSparse_finish after calling the last SuiteSparse function, just before
exiting. In a multithreaded application, only a single thread should call
this function.
Future releases of SuiteSparse might use this function for any
SuiteSparse-wide cleanup operations or finalization of statistics.
*/
void SuiteSparse_finish ( void )
{
/* do nothing */ ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_malloc: malloc wrapper */
/* -------------------------------------------------------------------------- */
void *SuiteSparse_malloc /* pointer to allocated block of memory */
(
size_t nitems, /* number of items to malloc */
size_t size_of_item /* sizeof each item */
)
{
void *p ;
size_t size ;
if (nitems < 1) nitems = 1 ;
if (size_of_item < 1) size_of_item = 1 ;
size = nitems * size_of_item ;
if (size != ((double) nitems) * size_of_item)
{
/* size_t overflow */
p = NULL ;
}
else
{
p = (void *) (SuiteSparse_config.malloc_func) (size) ;
}
return (p) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_calloc: calloc wrapper */
/* -------------------------------------------------------------------------- */
void *SuiteSparse_calloc /* pointer to allocated block of memory */
(
size_t nitems, /* number of items to calloc */
size_t size_of_item /* sizeof each item */
)
{
void *p ;
size_t size ;
if (nitems < 1) nitems = 1 ;
if (size_of_item < 1) size_of_item = 1 ;
size = nitems * size_of_item ;
if (size != ((double) nitems) * size_of_item)
{
/* size_t overflow */
p = NULL ;
}
else
{
p = (void *) (SuiteSparse_config.calloc_func) (nitems, size_of_item) ;
}
return (p) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_realloc: realloc wrapper */
/* -------------------------------------------------------------------------- */
/* If p is non-NULL on input, it points to a previously allocated object of
size nitems_old * size_of_item. The object is reallocated to be of size
nitems_new * size_of_item. If p is NULL on input, then a new object of that
size is allocated. On success, a pointer to the new object is returned,
and ok is returned as 1. If the allocation fails, ok is set to 0 and a
pointer to the old (unmodified) object is returned.
*/
void *SuiteSparse_realloc /* pointer to reallocated block of memory, or
to original block if the realloc failed. */
(
size_t nitems_new, /* new number of items in the object */
size_t nitems_old, /* old number of items in the object */
size_t size_of_item, /* sizeof each item */
void *p, /* old object to reallocate */
int *ok /* 1 if successful, 0 otherwise */
)
{
size_t size ;
if (nitems_old < 1) nitems_old = 1 ;
if (nitems_new < 1) nitems_new = 1 ;
if (size_of_item < 1) size_of_item = 1 ;
size = nitems_new * size_of_item ;
if (size != ((double) nitems_new) * size_of_item)
{
/* size_t overflow */
(*ok) = 0 ;
}
else if (p == NULL)
{
/* a fresh object is being allocated */
p = SuiteSparse_malloc (nitems_new, size_of_item) ;
(*ok) = (p != NULL) ;
}
else if (nitems_old == nitems_new)
{
/* the object does not change; do nothing */
(*ok) = 1 ;
}
else
{
/* change the size of the object from nitems_old to nitems_new */
void *pnew ;
pnew = (void *) (SuiteSparse_config.realloc_func) (p, size) ;
if (pnew == NULL)
{
if (nitems_new < nitems_old)
{
/* the attempt to reduce the size of the block failed, but
the old block is unchanged. So pretend to succeed. */
(*ok) = 1 ;
}
else
{
/* out of memory */
(*ok) = 0 ;
}
}
else
{
/* success */
p = pnew ;
(*ok) = 1 ;
}
}
return (p) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_free: free wrapper */
/* -------------------------------------------------------------------------- */
void *SuiteSparse_free /* always returns NULL */
(
void *p /* block to free */
)
{
if (p)
{
(SuiteSparse_config.free_func) (p) ;
}
return (NULL) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_tic: return current wall clock time */
/* -------------------------------------------------------------------------- */
/* Returns the number of seconds (tic [0]) and nanoseconds (tic [1]) since some
* unspecified but fixed time in the past. If no timer is installed, zero is
* returned. A scalar double precision value for 'tic' could be used, but this
* might cause loss of precision because clock_getttime returns the time from
* some distant time in the past. Thus, an array of size 2 is used.
*
* The timer is enabled by default. To disable the timer, compile with
* -DNTIMER. If enabled on a POSIX C 1993 system, the timer requires linking
* with the -lrt library.
*
* example:
*
* double tic [2], r, s, t ;
* SuiteSparse_tic (tic) ; // start the timer
* // do some work A
* t = SuiteSparse_toc (tic) ; // t is time for work A, in seconds
* // do some work B
* s = SuiteSparse_toc (tic) ; // s is time for work A and B, in seconds
* SuiteSparse_tic (tic) ; // restart the timer
* // do some work C
* r = SuiteSparse_toc (tic) ; // s is time for work C, in seconds
*
* A double array of size 2 is used so that this routine can be more easily
* ported to non-POSIX systems. The caller does not rely on the POSIX
* <time.h> include file.
*/
#if !defined ( SUITESPARSE_TIMER_ENABLED )
/* ---------------------------------------------------------------------- */
/* no timer */
/* ---------------------------------------------------------------------- */
void SuiteSparse_tic
(
double tic [2] /* output, contents undefined on input */
)
{
/* no timer installed */
tic [0] = 0 ;
tic [1] = 0 ;
}
#elif defined ( _OPENMP )
/* ---------------------------------------------------------------------- */
/* OpenMP timer */
/* ---------------------------------------------------------------------- */
void SuiteSparse_tic
(
double tic [2] /* output, contents undefined on input */
)
{
tic [0] = omp_get_wtime ( ) ;
tic [1] = 0 ;
}
#else
/* ---------------------------------------------------------------------- */
/* POSIX timer */
/* ---------------------------------------------------------------------- */
#include <time.h>
void SuiteSparse_tic
(
double tic [2] /* output, contents undefined on input */
)
{
/* POSIX C 1993 timer, requires -lrt */
struct timespec t ;
clock_gettime (CLOCK_MONOTONIC, &t) ;
tic [0] = (double) (t.tv_sec) ;
tic [1] = (double) (t.tv_nsec) ;
}
#endif
/* -------------------------------------------------------------------------- */
/* SuiteSparse_toc: return time since last tic */
/* -------------------------------------------------------------------------- */
/* Assuming SuiteSparse_tic is accurate to the nanosecond, this function is
* accurate down to the nanosecond for 2^53 nanoseconds since the last call to
* SuiteSparse_tic, which is sufficient for SuiteSparse (about 104 days). If
* additional accuracy is required, the caller can use two calls to
* SuiteSparse_tic and do the calculations differently.
*/
double SuiteSparse_toc /* returns time in seconds since last tic */
(
double tic [2] /* input, not modified from last call to SuiteSparse_tic */
)
{
double toc [2] ;
SuiteSparse_tic (toc) ;
return ((toc [0] - tic [0]) + 1e-9 * (toc [1] - tic [1])) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_time: return current wallclock time in seconds */
/* -------------------------------------------------------------------------- */
/* This function might not be accurate down to the nanosecond. */
double SuiteSparse_time /* returns current wall clock time in seconds */
(
void
)
{
double toc [2] ;
SuiteSparse_tic (toc) ;
return (toc [0] + 1e-9 * toc [1]) ;
}
/* -------------------------------------------------------------------------- */
/* SuiteSparse_version: return the current version of SuiteSparse */
/* -------------------------------------------------------------------------- */
int SuiteSparse_version
(
int version [3]
)
{
if (version != NULL)
{
version [0] = SUITESPARSE_MAIN_VERSION ;
version [1] = SUITESPARSE_SUB_VERSION ;
version [2] = SUITESPARSE_SUBSUB_VERSION ;
}
return (SUITESPARSE_VERSION) ;
}
//------------------------------------------------------------------------------
// SuiteSparse_hypot
//------------------------------------------------------------------------------
// SuiteSparse_config v5 and earlier used SuiteSparse_hypot, defined below.
// SuiteSparse_config v6 now uses the hypot method in <math.h>, by default.
// The hypot function appears in ANSI C99 and later, and SuiteSparse now
// assumes ANSI C11.
// s = hypot (x,y) computes s = sqrt (x*x + y*y) but does so more accurately.
// The NaN cases for the double relops x >= y and x+y == x are safely ignored.
// Source: Algorithm 312, "Absolute value and square root of a complex number,"
// P. Friedland, Comm. ACM, vol 10, no 10, October 1967, page 665.
// This method below is kept for historical purposes.
double SuiteSparse_hypot (double x, double y)
{
double s, r ;
x = fabs (x) ;
y = fabs (y) ;
if (x >= y)
{
if (x + y == x)
{
s = x ;
}
else
{
r = y / x ;
s = x * sqrt (1.0 + r*r) ;
}
}
else
{
if (y + x == y)
{
s = y ;
}
else
{
r = x / y ;
s = y * sqrt (1.0 + r*r) ;
}
}
return (s) ;
}
//------------------------------------------------------------------------------
// SuiteSparse_divcomplex
//------------------------------------------------------------------------------
// z = x/y where z, x, and y are complex. The real and imaginary parts are
// passed as separate arguments to this routine. The NaN case is ignored
// for the double relop yr >= yi. Returns 1 if the denominator is zero,
// 0 otherwise.
//
// This uses ACM Algo 116, by R. L. Smith, 1962, which tries to avoid
// underflow and overflow.
//
// z can be the same variable as x or y.
//
// Default value of the SuiteSparse_config.divcomplex_func pointer is
// SuiteSparse_divcomplex.
//
// This function is identical to GB_divcomplex in GraphBLAS/Source/GB_math.h.
// The only difference is the name of the function.
int SuiteSparse_divcomplex
(
double xr, double xi, // real and imaginary parts of x
double yr, double yi, // real and imaginary parts of y
double *zr, double *zi // real and imaginary parts of z
)
{
double tr, ti, r, den ;
int yr_class = fpclassify (yr) ;
int yi_class = fpclassify (yi) ;
if (yi_class == FP_ZERO)
{
den = yr ;
if (xi == 0)
{
tr = xr / den ;
ti = 0 ;
}
else if (xr == 0)
{
tr = 0 ;
ti = xi / den ;
}
else
{
tr = xr / den ;
ti = xi / den ;
}
}
else if (yr_class == FP_ZERO)
{
den = yi ;
if (xr == 0)
{
tr = xi / den ;
ti = 0 ;
}
else if (xi == 0)
{
tr = 0 ;
ti = -xr / den ;
}
else
{
tr = xi / den ;
ti = -xr / den ;
}
}
else if (yi_class == FP_INFINITE && yr_class == FP_INFINITE)
{
if (signbit (yr) == signbit (yi))
{
// r = 1
den = yr + yi ;
tr = (xr + xi) / den ;
ti = (xi - xr) / den ;
}
else
{
// r = -1
den = yr - yi ;
tr = (xr - xi) / den ;
ti = (xi + xr) / den ;
}
}
else
{
if (fabs (yr) >= fabs (yi))
{
r = yi / yr ;
den = yr + r * yi ;
tr = (xr + xi * r) / den ;
ti = (xi - xr * r) / den ;
}
else
{
r = yr / yi ;
den = r * yr + yi ;
tr = (xr * r + xi) / den ;
ti = (xi * r - xr) / den ;
}
}
(*zr) = tr ;
(*zi) = ti ;
return (den == 0) ;
}
//------------------------------------------------------------------------------
// SuiteSparse_BLAS_library: return name of BLAS library found
//------------------------------------------------------------------------------
// Returns the name of the BLAS library found by SuiteSparse_config
const char *SuiteSparse_BLAS_library ( void )
{
#if defined ( BLAS_Intel10_64ilp )
return ("Intel MKL 64ilp BLAS (64-bit integers)") ;
#elif defined ( BLAS_Intel10_64lp )
return ("Intel MKL 64lp BLAS (32-bit integers)") ;
#elif defined ( BLAS_Apple )
return ("Apple Accelerate Framework BLAS (32-bit integers)") ;
#elif defined ( BLAS_Arm_ilp64_mp )
return ("ARM MP BLAS (64-bit integers)") ;
#elif defined ( BLAS_Arm_mp )
return ("ARM MP BLAS (32-bit integers)") ;
#elif defined ( BLAS_IBMESSL_SMP )
return ((sizeof (SUITESPARSE_BLAS_INT) == 8) ?
"IBMESSL_SMP BLAS (64-bit integers)" :
"IBMESSL_SMP BLAS (32-bit integers)") ;
#elif defined ( BLAS_OpenBLAS )
return ((sizeof (SUITESPARSE_BLAS_INT) == 8) ?
"OpenBLAS (64-bit integers)" :
"OpenBLAS (32-bit integers)") ;
#elif defined ( BLAS_FLAME )
return ((sizeof (SUITESPARSE_BLAS_INT) == 8) ?
"FLAME (64-bit integers)" :
"FLAME (32-bit integers)") ;
#elif defined ( BLAS_Generic )
return ((sizeof (SUITESPARSE_BLAS_INT) == 8) ?
"Reference BLAS (64-bit integers)" :
"Reference BLAS (32-bit integers)") ;
#else
return ((sizeof (SUITESPARSE_BLAS_INT) == 8) ?
"Other BLAS (64-bit integers)" :
"Other BLAS (32-bit integers)") ;
#endif
}
//------------------------------------------------------------------------------
// SuiteSparse_BLAS_integer: return size of BLAS integer
//------------------------------------------------------------------------------
size_t SuiteSparse_BLAS_integer_size ( void )
{
return (sizeof (SUITESPARSE_BLAS_INT)) ;
}

180
src/maths/KLU/amd_1.c
View File

@ -1,180 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_1: construct input matrix and then order with amd_2
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* AMD_1: Construct A+A' for a sparse matrix A and perform the AMD ordering.
*
* The n-by-n sparse matrix A can be unsymmetric. It is stored in MATLAB-style
* compressed-column form, with sorted row indices in each column, and no
* duplicate entries. Diagonal entries may be present, but they are ignored.
* Row indices of column j of A are stored in Ai [Ap [j] ... Ap [j+1]-1].
* Ap [0] must be zero, and nz = Ap [n] is the number of entries in A. The
* size of the matrix, n, must be greater than or equal to zero.
*
* This routine must be preceded by a call to AMD_aat, which computes the
* number of entries in each row/column in A+A', excluding the diagonal.
* Len [j], on input, is the number of entries in row/column j of A+A'. This
* routine constructs the matrix A+A' and then calls AMD_2. No error checking
* is performed (this was done in AMD_valid).
*/
#include "amd_internal.h"
void AMD_1
(
Int n, /* n > 0 */
const Int Ap [ ], /* input of size n+1, not modified */
const Int Ai [ ], /* input of size nz = Ap [n], not modified */
Int P [ ], /* size n output permutation */
Int Pinv [ ], /* size n output inverse permutation */
Int Len [ ], /* size n input, undefined on output */
Int slen, /* slen >= sum (Len [0..n-1]) + 7n,
* ideally slen = 1.2 * sum (Len) + 8n */
Int S [ ], /* size slen workspace */
double Control [ ], /* input array of size AMD_CONTROL */
double Info [ ] /* output array of size AMD_INFO */
)
{
Int i, j, k, p, pfree, iwlen, pj, p1, p2, pj2, *Iw, *Pe, *Nv, *Head,
*Elen, *Degree, *s, *W, *Sp, *Tp ;
/* --------------------------------------------------------------------- */
/* construct the matrix for AMD_2 */
/* --------------------------------------------------------------------- */
ASSERT (n > 0) ;
iwlen = slen - 6*n ;
s = S ;
Pe = s ; s += n ;
Nv = s ; s += n ;
Head = s ; s += n ;
Elen = s ; s += n ;
Degree = s ; s += n ;
W = s ; s += n ;
Iw = s ; s += iwlen ;
ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ;
/* construct the pointers for A+A' */
Sp = Nv ; /* use Nv and W as workspace for Sp and Tp [ */
Tp = W ;
pfree = 0 ;
for (j = 0 ; j < n ; j++)
{
Pe [j] = pfree ;
Sp [j] = pfree ;
pfree += Len [j] ;
}
/* Note that this restriction on iwlen is slightly more restrictive than
* what is strictly required in AMD_2. AMD_2 can operate with no elbow
* room at all, but it will be very slow. For better performance, at
* least size-n elbow room is enforced. */
ASSERT (iwlen >= pfree + n) ;
#ifndef NDEBUG
for (p = 0 ; p < iwlen ; p++) Iw [p] = EMPTY ;
#endif
for (k = 0 ; k < n ; k++)
{
AMD_DEBUG1 (("Construct row/column k= "ID" of A+A'\n", k)) ;
p1 = Ap [k] ;
p2 = Ap [k+1] ;
/* construct A+A' */
for (p = p1 ; p < p2 ; )
{
/* scan the upper triangular part of A */
j = Ai [p] ;
ASSERT (j >= 0 && j < n) ;
if (j < k)
{
/* entry A (j,k) in the strictly upper triangular part */
ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ;
ASSERT (Sp [k] < (k == n-1 ? pfree : Pe [k+1])) ;
Iw [Sp [j]++] = k ;
Iw [Sp [k]++] = j ;
p++ ;
}
else if (j == k)
{
/* skip the diagonal */
p++ ;
break ;
}
else /* j > k */
{
/* first entry below the diagonal */
break ;
}
/* scan lower triangular part of A, in column j until reaching
* row k. Start where last scan left off. */
ASSERT (Ap [j] <= Tp [j] && Tp [j] <= Ap [j+1]) ;
pj2 = Ap [j+1] ;
for (pj = Tp [j] ; pj < pj2 ; )
{
i = Ai [pj] ;
ASSERT (i >= 0 && i < n) ;
if (i < k)
{
/* A (i,j) is only in the lower part, not in upper */
ASSERT (Sp [i] < (i == n-1 ? pfree : Pe [i+1])) ;
ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ;
Iw [Sp [i]++] = j ;
Iw [Sp [j]++] = i ;
pj++ ;
}
else if (i == k)
{
/* entry A (k,j) in lower part and A (j,k) in upper */
pj++ ;
break ;
}
else /* i > k */
{
/* consider this entry later, when k advances to i */
break ;
}
}
Tp [j] = pj ;
}
Tp [k] = p ;
}
/* clean up, for remaining mismatched entries */
for (j = 0 ; j < n ; j++)
{
for (pj = Tp [j] ; pj < Ap [j+1] ; pj++)
{
i = Ai [pj] ;
ASSERT (i >= 0 && i < n) ;
/* A (i,j) is only in the lower part, not in upper */
ASSERT (Sp [i] < (i == n-1 ? pfree : Pe [i+1])) ;
ASSERT (Sp [j] < (j == n-1 ? pfree : Pe [j+1])) ;
Iw [Sp [i]++] = j ;
Iw [Sp [j]++] = i ;
}
}
#ifndef NDEBUG
for (j = 0 ; j < n-1 ; j++) ASSERT (Sp [j] == Pe [j+1]) ;
ASSERT (Sp [n-1] == pfree) ;
#endif
/* Tp and Sp no longer needed ] */
/* --------------------------------------------------------------------- */
/* order the matrix */
/* --------------------------------------------------------------------- */
AMD_2 (n, Pe, Iw, Len, iwlen, pfree,
Nv, Pinv, P, Head, Elen, Degree, W, Control, Info) ;
}

1842
src/maths/KLU/amd_2.c
View File

File diff suppressed because it is too large Load Diff

184
src/maths/KLU/amd_aat.c
View File

@ -1,184 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_aat: compute symmetry of A and nnz in each column of A+A'
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* AMD_aat: compute the symmetry of the pattern of A, and count the number of
* nonzeros each column of A+A' (excluding the diagonal). Assumes the input
* matrix has no errors, with sorted columns and no duplicates
* (AMD_valid (n, n, Ap, Ai) must be AMD_OK, but this condition is not
* checked).
*/
#include "amd_internal.h"
size_t AMD_aat /* returns nz in A+A' */
(
Int n,
const Int Ap [ ],
const Int Ai [ ],
Int Len [ ], /* Len [j]: length of column j of A+A', excl diagonal*/
Int Tp [ ], /* workspace of size n */
double Info [ ]
)
{
Int p1, p2, p, i, j, pj, pj2, k, nzdiag, nzboth, nz ;
double sym ;
size_t nzaat ;
#ifndef NDEBUG
AMD_debug_init ("AMD AAT") ;
for (k = 0 ; k < n ; k++) Tp [k] = EMPTY ;
ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ;
#endif
if (Info != (double *) NULL)
{
/* clear the Info array, if it exists */
for (i = 0 ; i < AMD_INFO ; i++)
{
Info [i] = EMPTY ;
}
Info [AMD_STATUS] = AMD_OK ;
}
for (k = 0 ; k < n ; k++)
{
Len [k] = 0 ;
}
nzdiag = 0 ;
nzboth = 0 ;
nz = Ap [n] ;
for (k = 0 ; k < n ; k++)
{
p1 = Ap [k] ;
p2 = Ap [k+1] ;
AMD_DEBUG2 (("\nAAT Column: "ID" p1: "ID" p2: "ID"\n", k, p1, p2)) ;
/* construct A+A' */
for (p = p1 ; p < p2 ; )
{
/* scan the upper triangular part of A */
j = Ai [p] ;
if (j < k)
{
/* entry A (j,k) is in the strictly upper triangular part,
* add both A (j,k) and A (k,j) to the matrix A+A' */
Len [j]++ ;
Len [k]++ ;
AMD_DEBUG3 ((" upper ("ID","ID") ("ID","ID")\n", j,k, k,j));
p++ ;
}
else if (j == k)
{
/* skip the diagonal */
p++ ;
nzdiag++ ;
break ;
}
else /* j > k */
{
/* first entry below the diagonal */
break ;
}
/* scan lower triangular part of A, in column j until reaching
* row k. Start where last scan left off. */
ASSERT (Tp [j] != EMPTY) ;
ASSERT (Ap [j] <= Tp [j] && Tp [j] <= Ap [j+1]) ;
pj2 = Ap [j+1] ;
for (pj = Tp [j] ; pj < pj2 ; )
{
i = Ai [pj] ;
if (i < k)
{
/* A (i,j) is only in the lower part, not in upper.
* add both A (i,j) and A (j,i) to the matrix A+A' */
Len [i]++ ;
Len [j]++ ;
AMD_DEBUG3 ((" lower ("ID","ID") ("ID","ID")\n",
i,j, j,i)) ;
pj++ ;
}
else if (i == k)
{
/* entry A (k,j) in lower part and A (j,k) in upper */
pj++ ;
nzboth++ ;
break ;
}
else /* i > k */
{
/* consider this entry later, when k advances to i */
break ;
}
}
Tp [j] = pj ;
}
/* Tp [k] points to the entry just below the diagonal in column k */
Tp [k] = p ;
}
/* clean up, for remaining mismatched entries */
for (j = 0 ; j < n ; j++)
{
for (pj = Tp [j] ; pj < Ap [j+1] ; pj++)
{
i = Ai [pj] ;
/* A (i,j) is only in the lower part, not in upper.
* add both A (i,j) and A (j,i) to the matrix A+A' */
Len [i]++ ;
Len [j]++ ;
AMD_DEBUG3 ((" lower cleanup ("ID","ID") ("ID","ID")\n",
i,j, j,i)) ;
}
}
/* --------------------------------------------------------------------- */
/* compute the symmetry of the nonzero pattern of A */
/* --------------------------------------------------------------------- */
/* Given a matrix A, the symmetry of A is:
* B = tril (spones (A), -1) + triu (spones (A), 1) ;
* sym = nnz (B & B') / nnz (B) ;
* or 1 if nnz (B) is zero.
*/
if (nz == nzdiag)
{
sym = 1 ;
}
else
{
sym = (2 * (double) nzboth) / ((double) (nz - nzdiag)) ;
}
nzaat = 0 ;
for (k = 0 ; k < n ; k++)
{
nzaat += Len [k] ;
}
AMD_DEBUG1 (("AMD nz in A+A', excluding diagonal (nzaat) = %g\n",
(double) nzaat)) ;
AMD_DEBUG1 ((" nzboth: "ID" nz: "ID" nzdiag: "ID" symmetry: %g\n",
nzboth, nz, nzdiag, sym)) ;
if (Info != (double *) NULL)
{
Info [AMD_STATUS] = AMD_OK ;
Info [AMD_N] = n ;
Info [AMD_NZ] = nz ;
Info [AMD_SYMMETRY] = sym ; /* symmetry of pattern of A */
Info [AMD_NZDIAG] = nzdiag ; /* nonzeros on diagonal of A */
Info [AMD_NZ_A_PLUS_AT] = nzaat ; /* nonzeros in A+A' */
}
return (nzaat) ;
}

64
src/maths/KLU/amd_control.c
View File

@ -1,64 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_control: print control parameters for AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* User-callable. Prints the control parameters for AMD. See amd.h
* for details. If the Control array is not present, the defaults are
* printed instead.
*/
#include "amd_internal.h"
void AMD_control
(
double Control [ ]
)
{
double alpha ;
Int aggressive ;
if (Control != (double *) NULL)
{
alpha = Control [AMD_DENSE] ;
aggressive = Control [AMD_AGGRESSIVE] != 0 ;
}
else
{
alpha = AMD_DEFAULT_DENSE ;
aggressive = AMD_DEFAULT_AGGRESSIVE ;
}
SUITESPARSE_PRINTF ((
"\nAMD version %d.%d.%d, %s: approximate minimum degree ordering\n"
" dense row parameter: %g\n", AMD_MAIN_VERSION, AMD_SUB_VERSION,
AMD_SUBSUB_VERSION, AMD_DATE, alpha)) ;
if (alpha < 0)
{
SUITESPARSE_PRINTF ((" no rows treated as dense\n")) ;
}
else
{
SUITESPARSE_PRINTF ((
" (rows with more than max (%g * sqrt (n), 16) entries are\n"
" considered \"dense\", and placed last in output permutation)\n",
alpha)) ;
}
if (aggressive)
{
SUITESPARSE_PRINTF ((" aggressive absorption: yes\n")) ;
}
else
{
SUITESPARSE_PRINTF ((" aggressive absorption: no\n")) ;
}
SUITESPARSE_PRINTF ((" size of AMD integer: %d\n\n", sizeof (Int))) ;
}

37
src/maths/KLU/amd_defaults.c
View File

@ -1,37 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_defaults: set defaults for AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* User-callable. Sets default control parameters for AMD. See amd.h
* for details.
*/
#include "amd_internal.h"
/* ========================================================================= */
/* === AMD defaults ======================================================== */
/* ========================================================================= */
void AMD_defaults
(
double Control [ ]
)
{
Int i ;
if (Control != (double *) NULL)
{
for (i = 0 ; i < AMD_CONTROL ; i++)
{
Control [i] = 0 ;
}
Control [AMD_DENSE] = AMD_DEFAULT_DENSE ;
Control [AMD_AGGRESSIVE] = AMD_DEFAULT_AGGRESSIVE ;
}
}

179
src/maths/KLU/amd_dump.c
View File

@ -1,179 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_dump: debug routines for AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* Debugging routines for AMD. Not used if NDEBUG is not defined at compile-
* time (the default). See comments in amd_internal.h on how to enable
* debugging. Not user-callable.
*/
#include "amd_internal.h"
#ifndef NDEBUG
/* This global variable is present only when debugging */
Int AMD_debug = -999 ; /* default is no debug printing */
/* ========================================================================= */
/* === AMD_debug_init ====================================================== */
/* ========================================================================= */
/* Sets the debug print level, by reading the file debug.amd (if it exists) */
void AMD_debug_init ( char *s )
{
FILE *f ;
f = fopen ("debug.amd", "r") ;
if (f == (FILE *) NULL)
{
AMD_debug = -999 ;
}
else
{
fscanf (f, ID, &AMD_debug) ;
fclose (f) ;
}
if (AMD_debug >= 0)
{
printf ("%s: AMD_debug_init, D= "ID"\n", s, AMD_debug) ;
}
}
/* ========================================================================= */
/* === AMD_dump ============================================================ */
/* ========================================================================= */
/* Dump AMD's data structure, except for the hash buckets. This routine
* cannot be called when the hash buckets are non-empty.
*/
void AMD_dump (
Int n, /* A is n-by-n */
Int Pe [ ], /* pe [0..n-1]: index in iw of start of row i */
Int Iw [ ], /* workspace of size iwlen, iwlen [0..pfree-1]
* holds the matrix on input */
Int Len [ ], /* len [0..n-1]: length for row i */
Int iwlen, /* length of iw */
Int pfree, /* iw [pfree ... iwlen-1] is empty on input */
Int Nv [ ], /* nv [0..n-1] */
Int Next [ ], /* next [0..n-1] */
Int Last [ ], /* last [0..n-1] */
Int Head [ ], /* head [0..n-1] */
Int Elen [ ], /* size n */
Int Degree [ ], /* size n */
Int W [ ], /* size n */
Int nel
)
{
Int i, pe, elen, nv, len, e, p, k, j, deg, w, cnt, ilast ;
if (AMD_debug < 0) return ;
ASSERT (pfree <= iwlen) ;
AMD_DEBUG3 (("\nAMD dump, pfree: "ID"\n", pfree)) ;
for (i = 0 ; i < n ; i++)
{
pe = Pe [i] ;
elen = Elen [i] ;
nv = Nv [i] ;
len = Len [i] ;
w = W [i] ;
if (elen >= EMPTY)
{
if (nv == 0)
{
AMD_DEBUG3 (("\nI "ID": nonprincipal: ", i)) ;
ASSERT (elen == EMPTY) ;
if (pe == EMPTY)
{
AMD_DEBUG3 ((" dense node\n")) ;
ASSERT (w == 1) ;
}
else
{
ASSERT (pe < EMPTY) ;
AMD_DEBUG3 ((" i "ID" -> parent "ID"\n", i, FLIP (Pe[i])));
}
}
else
{
AMD_DEBUG3 (("\nI "ID": active principal supervariable:\n",i));
AMD_DEBUG3 ((" nv(i): "ID" Flag: %d\n", nv, (nv < 0))) ;
ASSERT (elen >= 0) ;
ASSERT (nv > 0 && pe >= 0) ;
p = pe ;
AMD_DEBUG3 ((" e/s: ")) ;
if (elen == 0) AMD_DEBUG3 ((" : ")) ;
ASSERT (pe + len <= pfree) ;
for (k = 0 ; k < len ; k++)
{
j = Iw [p] ;
AMD_DEBUG3 ((" "ID"", j)) ;
ASSERT (j >= 0 && j < n) ;
if (k == elen-1) AMD_DEBUG3 ((" : ")) ;
p++ ;
}
AMD_DEBUG3 (("\n")) ;
}
}
else
{
e = i ;
if (w == 0)
{
AMD_DEBUG3 (("\nE "ID": absorbed element: w "ID"\n", e, w)) ;
ASSERT (nv > 0 && pe < 0) ;
AMD_DEBUG3 ((" e "ID" -> parent "ID"\n", e, FLIP (Pe [e]))) ;
}
else
{
AMD_DEBUG3 (("\nE "ID": unabsorbed element: w "ID"\n", e, w)) ;
ASSERT (nv > 0 && pe >= 0) ;
p = pe ;
AMD_DEBUG3 ((" : ")) ;
ASSERT (pe + len <= pfree) ;
for (k = 0 ; k < len ; k++)
{
j = Iw [p] ;
AMD_DEBUG3 ((" "ID"", j)) ;
ASSERT (j >= 0 && j < n) ;
p++ ;
}
AMD_DEBUG3 (("\n")) ;
}
}
}
/* this routine cannot be called when the hash buckets are non-empty */
AMD_DEBUG3 (("\nDegree lists:\n")) ;
if (nel >= 0)
{
cnt = 0 ;
for (deg = 0 ; deg < n ; deg++)
{
if (Head [deg] == EMPTY) continue ;
ilast = EMPTY ;
AMD_DEBUG3 ((ID": \n", deg)) ;
for (i = Head [deg] ; i != EMPTY ; i = Next [i])
{
AMD_DEBUG3 ((" "ID" : next "ID" last "ID" deg "ID"\n",
i, Next [i], Last [i], Degree [i])) ;
ASSERT (i >= 0 && i < n && ilast == Last [i] &&
deg == Degree [i]) ;
cnt += Nv [i] ;
ilast = i ;
}
AMD_DEBUG3 (("\n")) ;
}
ASSERT (cnt == n - nel) ;
}
}
#endif

84
src/maths/KLU/amd_global.c
View File

@ -1,84 +0,0 @@
/* ========================================================================= */
/* === amd_global ========================================================== */
/* ========================================================================= */
/* ------------------------------------------------------------------------- */
/* AMD, Copyright (c) Timothy A. Davis, */
/* Patrick R. Amestoy, and Iain S. Duff. See ../README.txt for License. */
/* email: davis at cise.ufl.edu CISE Department, Univ. of Florida. */
/* web: http://www.cise.ufl.edu/research/sparse/amd */
/* ------------------------------------------------------------------------- */
#include <stdlib.h>
#ifdef MATLAB_MEX_FILE
#include "mex.h"
#include "matrix.h"
#endif
#ifndef NULL
#define NULL 0
#endif
/* ========================================================================= */
/* === Default AMD memory manager ========================================== */
/* ========================================================================= */
/* The user can redefine these global pointers at run-time to change the memory
* manager used by AMD. AMD only uses malloc and free; realloc and calloc are
* include for completeness, in case another package wants to use the same
* memory manager as AMD.
*
* If compiling as a MATLAB mexFunction, the default memory manager is mxMalloc.
* You can also compile AMD as a standard ANSI-C library and link a mexFunction
* against it, and then redefine these pointers at run-time, in your
* mexFunction.
*
* If -DNMALLOC is defined at compile-time, no memory manager is specified at
* compile-time. You must then define these functions at run-time, before
* calling AMD, for AMD to work properly.
*/
#ifndef NMALLOC
#ifdef MATLAB_MEX_FILE
/* MATLAB mexFunction: */
void *(*amd_malloc) (size_t) = mxMalloc ;
void (*amd_free) (void *) = mxFree ;
void *(*amd_realloc) (void *, size_t) = mxRealloc ;
void *(*amd_calloc) (size_t, size_t) = mxCalloc ;
#else
/* standard ANSI-C: */
void *(*amd_malloc) (size_t) = malloc ;
void (*amd_free) (void *) = free ;
void *(*amd_realloc) (void *, size_t) = realloc ;
void *(*amd_calloc) (size_t, size_t) = calloc ;
#endif
#else
/* no memory manager defined at compile-time; you MUST define one at run-time */
void *(*amd_malloc) (size_t) = NULL ;
void (*amd_free) (void *) = NULL ;
void *(*amd_realloc) (void *, size_t) = NULL ;
void *(*amd_calloc) (size_t, size_t) = NULL ;
#endif
/* ========================================================================= */
/* === Default AMD printf routine ========================================== */
/* ========================================================================= */
/* The user can redefine this global pointer at run-time to change the printf
* routine used by AMD. If NULL, no printing occurs.
*
* If -DNPRINT is defined at compile-time, stdio.h is not included. Printing
* can then be enabled at run-time by setting amd_printf to a non-NULL function.
*/
#ifndef NPRINT
#ifdef MATLAB_MEX_FILE
int (*amd_printf) (const char *, ...) = mexPrintf ;
#else
#include <stdio.h>
int (*amd_printf) (const char *, ...) = printf ;
#endif
#else
int (*amd_printf) (const char *, ...) = NULL ;
#endif

119
src/maths/KLU/amd_info.c
View File

@ -1,119 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_info: print output statistics for AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* User-callable. Prints the output statistics for AMD. See amd.h
* for details. If the Info array is not present, nothing is printed.
*/
#include "amd_internal.h"
#define PRI(format,x) { if (x >= 0) { SUITESPARSE_PRINTF ((format, x)) ; }}
void AMD_info
(
double Info [ ]
)
{
double n, ndiv, nmultsubs_ldl, nmultsubs_lu, lnz, lnzd ;
SUITESPARSE_PRINTF (("\nAMD version %d.%d.%d, %s, results:\n",
AMD_MAIN_VERSION, AMD_SUB_VERSION, AMD_SUBSUB_VERSION, AMD_DATE)) ;
if (!Info)
{
return ;
}
n = Info [AMD_N] ;
ndiv = Info [AMD_NDIV] ;
nmultsubs_ldl = Info [AMD_NMULTSUBS_LDL] ;
nmultsubs_lu = Info [AMD_NMULTSUBS_LU] ;
lnz = Info [AMD_LNZ] ;
lnzd = (n >= 0 && lnz >= 0) ? (n + lnz) : (-1) ;
/* AMD return status */
SUITESPARSE_PRINTF ((" status: ")) ;
if (Info [AMD_STATUS] == AMD_OK)
{
SUITESPARSE_PRINTF (("OK\n")) ;
}
else if (Info [AMD_STATUS] == AMD_OUT_OF_MEMORY)
{
SUITESPARSE_PRINTF (("out of memory\n")) ;
}
else if (Info [AMD_STATUS] == AMD_INVALID)
{
SUITESPARSE_PRINTF (("invalid matrix\n")) ;
}
else if (Info [AMD_STATUS] == AMD_OK_BUT_JUMBLED)
{
SUITESPARSE_PRINTF (("OK, but jumbled\n")) ;
}
else
{
SUITESPARSE_PRINTF (("unknown\n")) ;
}
/* statistics about the input matrix */
PRI (" n, dimension of A: %.20g\n", n);
PRI (" nz, number of nonzeros in A: %.20g\n",
Info [AMD_NZ]) ;
PRI (" symmetry of A: %.4f\n",
Info [AMD_SYMMETRY]) ;
PRI (" number of nonzeros on diagonal: %.20g\n",
Info [AMD_NZDIAG]) ;
PRI (" nonzeros in pattern of A+A' (excl. diagonal): %.20g\n",
Info [AMD_NZ_A_PLUS_AT]) ;
PRI (" # dense rows/columns of A+A': %.20g\n",
Info [AMD_NDENSE]) ;
/* statistics about AMD's behavior */
PRI (" memory used, in bytes: %.20g\n",
Info [AMD_MEMORY]) ;
PRI (" # of memory compactions: %.20g\n",
Info [AMD_NCMPA]) ;
/* statistics about the ordering quality */
SUITESPARSE_PRINTF (("\n"
" The following approximate statistics are for a subsequent\n"
" factorization of A(P,P) + A(P,P)'. They are slight upper\n"
" bounds if there are no dense rows/columns in A+A', and become\n"
" looser if dense rows/columns exist.\n\n")) ;
PRI (" nonzeros in L (excluding diagonal): %.20g\n",
lnz) ;
PRI (" nonzeros in L (including diagonal): %.20g\n",
lnzd) ;
PRI (" # divide operations for LDL' or LU: %.20g\n",
ndiv) ;
PRI (" # multiply-subtract operations for LDL': %.20g\n",
nmultsubs_ldl) ;
PRI (" # multiply-subtract operations for LU: %.20g\n",
nmultsubs_lu) ;
PRI (" max nz. in any column of L (incl. diagonal): %.20g\n",
Info [AMD_DMAX]) ;
/* total flop counts for various factorizations */
if (n >= 0 && ndiv >= 0 && nmultsubs_ldl >= 0 && nmultsubs_lu >= 0)
{
SUITESPARSE_PRINTF (("\n"
" chol flop count for real A, sqrt counted as 1 flop: %.20g\n"
" LDL' flop count for real A: %.20g\n"
" LDL' flop count for complex A: %.20g\n"
" LU flop count for real A (with no pivoting): %.20g\n"
" LU flop count for complex A (with no pivoting): %.20g\n\n",
n + ndiv + 2*nmultsubs_ldl,
ndiv + 2*nmultsubs_ldl,
9*ndiv + 8*nmultsubs_ldl,
ndiv + 2*nmultsubs_lu,
9*ndiv + 8*nmultsubs_lu)) ;
}
}

277
src/maths/KLU/amd_internal.h
View File

@ -1,277 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Include/amd_internal.h: internal definitions for AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2023, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* This file is for internal use in AMD itself, and does not normally need to
* be included in user code (it is included in UMFPACK, however). All others
* should use amd.h instead.
*/
/* ========================================================================= */
/* === NDEBUG ============================================================== */
/* ========================================================================= */
/*
* Turning on debugging takes some work (see below). If you do not edit this
* file, then debugging is always turned off, regardless of whether or not
* -DNDEBUG is specified in your compiler options.
*
* If AMD is being compiled as a mexFunction, then MATLAB_MEX_FILE is defined,
* and mxAssert is used instead of assert. If debugging is not enabled, no
* MATLAB include files or functions are used. Thus, the AMD library libamd.a
* can be safely used in either a stand-alone C program or in another
* mexFunction, without any change.
*/
/*
AMD will be exceedingly slow when running in debug mode. The next three
lines ensure that debugging is turned off.
*/
#ifndef NDEBUG
#define NDEBUG
#endif
// To enable debugging, uncomment the following line:
// #undef NDEBUG
#include "ngspice/amd.h"
/* ------------------------------------------------------------------------- */
/* basic definitions */
/* ------------------------------------------------------------------------- */
#ifdef FLIP
#undef FLIP
#endif
#ifdef MAX
#undef MAX
#endif
#ifdef MIN
#undef MIN
#endif
#ifdef EMPTY
#undef EMPTY
#endif
#define PRIVATE static
/* FLIP is a "negation about -1", and is used to mark an integer i that is
* normally non-negative. FLIP (EMPTY) is EMPTY. FLIP of a number > EMPTY
* is negative, and FLIP of a number < EMTPY is positive. FLIP (FLIP (i)) = i
* for all integers i. UNFLIP (i) is >= EMPTY. */
#define EMPTY (-1)
#define FLIP(i) (-(i)-2)
#define UNFLIP(i) ((i < EMPTY) ? FLIP (i) : (i))
/* for integer MAX/MIN, or for doubles when we don't care how NaN's behave: */
#define MAX(a,b) (((a) > (b)) ? (a) : (b))
#define MIN(a,b) (((a) < (b)) ? (a) : (b))
/* logical expression of p implies q: */
#define IMPLIES(p,q) (!(p) || (q))
/* Note that the IBM RS 6000 xlc predefines TRUE and FALSE in <types.h>. */
/* The Compaq Alpha also predefines TRUE and FALSE. */
#ifdef TRUE
#undef TRUE
#endif
#ifdef FALSE
#undef FALSE
#endif
#define TRUE (1)
#define FALSE (0)
#define EMPTY (-1)
/* largest value of size_t */
#ifndef SIZE_T_MAX
#ifdef SIZE_MAX
/* C99 only */
#define SIZE_T_MAX SIZE_MAX
#else
#define SIZE_T_MAX ((size_t) (-1))
#endif
#endif
/* ------------------------------------------------------------------------- */
/* integer type for AMD: int32_t or int64_t */
/* ------------------------------------------------------------------------- */
#if defined (DLONG) || defined (ZLONG)
#define Int int64_t
#define UInt uint64_t
#define ID "%" PRId64
#define Int_MAX INT64_MAX
#define AMD_order amd_l_order
#define AMD_defaults amd_l_defaults
#define AMD_control amd_l_control
#define AMD_info amd_l_info
#define AMD_1 amd_l1
#define AMD_2 amd_l2
#define AMD_valid amd_l_valid
#define AMD_aat amd_l_aat
#define AMD_postorder amd_l_postorder
#define AMD_post_tree amd_l_post_tree
#define AMD_dump amd_l_dump
#define AMD_debug amd_l_debug
#define AMD_debug_init amd_l_debug_init
#define AMD_preprocess amd_l_preprocess
#else
#define Int int32_t
#define UInt uint32_t
#define ID "%d"
#define Int_MAX INT32_MAX
#define AMD_order amd_order
#define AMD_defaults amd_defaults
#define AMD_control amd_control
#define AMD_info amd_info
#define AMD_1 amd_1
#define AMD_2 amd_2
#define AMD_valid amd_valid
#define AMD_aat amd_aat
#define AMD_postorder amd_postorder
#define AMD_post_tree amd_post_tree
#define AMD_dump amd_dump
#define AMD_debug amd_debug
#define AMD_debug_init amd_debug_init
#define AMD_preprocess amd_preprocess
#endif
/* ------------------------------------------------------------------------- */
/* AMD routine definitions (not user-callable) */
/* ------------------------------------------------------------------------- */
size_t AMD_aat
(
Int n,
const Int Ap [ ],
const Int Ai [ ],
Int Len [ ],
Int Tp [ ],
double Info [ ]
) ;
void AMD_1
(
Int n,
const Int Ap [ ],
const Int Ai [ ],
Int P [ ],
Int Pinv [ ],
Int Len [ ],
Int slen,
Int S [ ],
double Control [ ],
double Info [ ]
) ;
void AMD_postorder
(
Int nn,
Int Parent [ ],
Int Npiv [ ],
Int Fsize [ ],
Int Order [ ],
Int Child [ ],
Int Sibling [ ],
Int Stack [ ]
) ;
Int AMD_post_tree
(
Int root,
Int k,
Int Child [ ],
const Int Sibling [ ],
Int Order [ ],
Int Stack [ ]
#ifndef NDEBUG
, Int nn
#endif
) ;
void AMD_preprocess
(
Int n,
const Int Ap [ ],
const Int Ai [ ],
Int Rp [ ],
Int Ri [ ],
Int W [ ],
Int Flag [ ]
) ;
/* ------------------------------------------------------------------------- */
/* debugging definitions */
/* ------------------------------------------------------------------------- */
#ifndef NDEBUG
/* from assert.h: assert macro */
#include <assert.h>
extern Int AMD_debug ;
void AMD_debug_init ( char *s ) ;
void AMD_dump
(
Int n,
Int Pe [ ],
Int Iw [ ],
Int Len [ ],
Int iwlen,
Int pfree,
Int Nv [ ],
Int Next [ ],
Int Last [ ],
Int Head [ ],
Int Elen [ ],
Int Degree [ ],
Int W [ ],
Int nel
) ;
#ifdef ASSERT
#undef ASSERT
#endif
/* Use mxAssert if AMD is compiled into a mexFunction */
#ifdef MATLAB_MEX_FILE
#define ASSERT(expression) (mxAssert ((expression), ""))
#else
#define ASSERT(expression) (assert (expression))
#endif
#define AMD_DEBUG0(params) { SUITESPARSE_PRINTF (params) ; }
#define AMD_DEBUG1(params) { if (AMD_debug >= 1) SUITESPARSE_PRINTF (params) ; }
#define AMD_DEBUG2(params) { if (AMD_debug >= 2) SUITESPARSE_PRINTF (params) ; }
#define AMD_DEBUG3(params) { if (AMD_debug >= 3) SUITESPARSE_PRINTF (params) ; }
#define AMD_DEBUG4(params) { if (AMD_debug >= 4) SUITESPARSE_PRINTF (params) ; }
#else
/* no debugging */
#define ASSERT(expression)
#define AMD_DEBUG0(params)
#define AMD_DEBUG1(params)
#define AMD_DEBUG2(params)
#define AMD_DEBUG3(params)
#define AMD_DEBUG4(params)
#endif

199
src/maths/KLU/amd_order.c
View File

@ -1,199 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_order: user-callable AMD ordering method
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* User-callable AMD minimum degree ordering routine. See amd.h for
* documentation.
*/
#include "amd_internal.h"
/* ========================================================================= */
/* === AMD_order =========================================================== */
/* ========================================================================= */
int AMD_order
(
Int n,
const Int Ap [ ],
const Int Ai [ ],
Int P [ ],
double Control [ ],
double Info [ ]
)
{
Int *Len, *S, nz, i, *Pinv, info, status, *Rp, *Ri, *Cp, *Ci, ok ;
size_t nzaat, slen ;
double mem = 0 ;
#ifndef NDEBUG
AMD_debug_init ("amd") ;
#endif
/* clear the Info array, if it exists */
info = Info != (double *) NULL ;
if (info)
{
for (i = 0 ; i < AMD_INFO ; i++)
{
Info [i] = EMPTY ;
}
Info [AMD_N] = n ;
Info [AMD_STATUS] = AMD_OK ;
}
/* make sure inputs exist and n is >= 0 */
if (Ai == (Int *) NULL || Ap == (Int *) NULL || P == (Int *) NULL || n < 0)
{
if (info) Info [AMD_STATUS] = AMD_INVALID ;
return (AMD_INVALID) ; /* arguments are invalid */
}
if (n == 0)
{
return (AMD_OK) ; /* n is 0 so there's nothing to do */
}
nz = Ap [n] ;
if (info)
{
Info [AMD_NZ] = nz ;
}
if (nz < 0)
{
if (info) Info [AMD_STATUS] = AMD_INVALID ;
return (AMD_INVALID) ;
}
/* check if n or nz will cause integer overflow */
if (((size_t) n) >= Int_MAX / sizeof (Int)
|| ((size_t) nz) >= Int_MAX / sizeof (Int))
{
if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ;
return (AMD_OUT_OF_MEMORY) ; /* problem too large */
}
/* check the input matrix: AMD_OK, AMD_INVALID, or AMD_OK_BUT_JUMBLED */
status = AMD_valid (n, n, Ap, Ai) ;
if (status == AMD_INVALID)
{
if (info) Info [AMD_STATUS] = AMD_INVALID ;
return (AMD_INVALID) ; /* matrix is invalid */
}
/* allocate two size-n integer workspaces */
size_t nn = (size_t) n ;
Len = SuiteSparse_malloc (nn, sizeof (Int)) ;
Pinv = SuiteSparse_malloc (nn, sizeof (Int)) ;
mem += n ;
mem += n ;
if (!Len || !Pinv)
{
/* :: out of memory :: */
SuiteSparse_free (Len) ;
SuiteSparse_free (Pinv) ;
if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ;
return (AMD_OUT_OF_MEMORY) ;
}
if (status == AMD_OK_BUT_JUMBLED)
{
/* sort the input matrix and remove duplicate entries */
AMD_DEBUG1 (("Matrix is jumbled\n")) ;
Rp = SuiteSparse_malloc (nn+1, sizeof (Int)) ;
Ri = SuiteSparse_malloc (nz, sizeof (Int)) ;
mem += (n+1) ;
mem += MAX (nz,1) ;
if (!Rp || !Ri)
{
/* :: out of memory :: */
SuiteSparse_free (Rp) ;
SuiteSparse_free (Ri) ;
SuiteSparse_free (Len) ;
SuiteSparse_free (Pinv) ;
if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ;
return (AMD_OUT_OF_MEMORY) ;
}
/* use Len and Pinv as workspace to create R = A' */
AMD_preprocess (n, Ap, Ai, Rp, Ri, Len, Pinv) ;
Cp = Rp ;
Ci = Ri ;
}
else
{
/* order the input matrix as-is. No need to compute R = A' first */
Rp = NULL ;
Ri = NULL ;
Cp = (Int *) Ap ;
Ci = (Int *) Ai ;
}
/* --------------------------------------------------------------------- */
/* determine the symmetry and count off-diagonal nonzeros in A+A' */
/* --------------------------------------------------------------------- */
nzaat = AMD_aat (n, Cp, Ci, Len, P, Info) ;
AMD_DEBUG1 (("nzaat: %g\n", (double) nzaat)) ;
ASSERT ((MAX (nz-n, 0) <= nzaat) && (nzaat <= 2 * (size_t) nz)) ;
/* --------------------------------------------------------------------- */
/* allocate workspace for matrix, elbow room, and 6 size-n vectors */
/* --------------------------------------------------------------------- */
S = NULL ;
slen = nzaat ; /* space for matrix */
ok = ((slen + nzaat/5) >= slen) ; /* check for size_t overflow */
slen += nzaat/5 ; /* add elbow room */
for (i = 0 ; ok && i < 7 ; i++)
{
ok = ((slen + nn) > slen) ; /* check for size_t overflow */
slen += nn ; /* size-n elbow room, 6 size-n work */
}
mem += slen ;
ok = ok && (slen < SIZE_T_MAX / sizeof (Int)) ; /* check for overflow */
if (ok)
{
S = SuiteSparse_malloc (slen, sizeof (Int)) ;
}
AMD_DEBUG1 (("slen %g\n", (double) slen)) ;
if (!S)
{
/* :: out of memory :: (or problem too large) */
SuiteSparse_free (Rp) ;
SuiteSparse_free (Ri) ;
SuiteSparse_free (Len) ;
SuiteSparse_free (Pinv) ;
if (info) Info [AMD_STATUS] = AMD_OUT_OF_MEMORY ;
return (AMD_OUT_OF_MEMORY) ;
}
if (info)
{
/* memory usage, in bytes. */
Info [AMD_MEMORY] = mem * sizeof (Int) ;
}
/* --------------------------------------------------------------------- */
/* order the matrix */
/* --------------------------------------------------------------------- */
AMD_1 (n, Cp, Ci, P, Pinv, Len, slen, S, Control, Info) ;
/* --------------------------------------------------------------------- */
/* free the workspace */
/* --------------------------------------------------------------------- */
SuiteSparse_free (Rp) ;
SuiteSparse_free (Ri) ;
SuiteSparse_free (Len) ;
SuiteSparse_free (Pinv) ;
SuiteSparse_free (S) ;
if (info) Info [AMD_STATUS] = status ;
return (status) ; /* successful ordering */
}

120
src/maths/KLU/amd_post_tree.c
View File

@ -1,120 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_post_tree: post-ordering of a single etree
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* Post-ordering of a supernodal elimination tree. */
#include "amd_internal.h"
Int AMD_post_tree
(
Int root, /* root of the tree */
Int k, /* start numbering at k */
Int Child [ ], /* input argument of size nn, undefined on
* output. Child [i] is the head of a link
* list of all nodes that are children of node
* i in the tree. */
const Int Sibling [ ], /* input argument of size nn, not modified.
* If f is a node in the link list of the
* children of node i, then Sibling [f] is the
* next child of node i.
*/
Int Order [ ], /* output order, of size nn. Order [i] = k
* if node i is the kth node of the reordered
* tree. */
Int Stack [ ] /* workspace of size nn */
#ifndef NDEBUG
, Int nn /* nodes are in the range 0..nn-1. */
#endif
)
{
Int f, head, h, i ;
#if 0
/* --------------------------------------------------------------------- */
/* recursive version (Stack [ ] is not used): */
/* --------------------------------------------------------------------- */
/* this is simple, but can cause stack overflow if nn is large */
i = root ;
for (f = Child [i] ; f != EMPTY ; f = Sibling [f])
{
k = AMD_post_tree (f, k, Child, Sibling, Order, Stack, nn) ;
}
Order [i] = k++ ;
return (k) ;
#endif
/* --------------------------------------------------------------------- */
/* non-recursive version, using an explicit stack */
/* --------------------------------------------------------------------- */
/* push root on the stack */
head = 0 ;
Stack [0] = root ;
while (head >= 0)
{
/* get head of stack */
ASSERT (head < nn) ;
i = Stack [head] ;
AMD_DEBUG1 (("head of stack "ID" \n", i)) ;
ASSERT (i >= 0 && i < nn) ;
if (Child [i] != EMPTY)
{
/* the children of i are not yet ordered */
/* push each child onto the stack in reverse order */
/* so that small ones at the head of the list get popped first */
/* and the biggest one at the end of the list gets popped last */
for (f = Child [i] ; f != EMPTY ; f = Sibling [f])
{
head++ ;
ASSERT (head < nn) ;
ASSERT (f >= 0 && f < nn) ;
}
h = head ;
ASSERT (head < nn) ;
for (f = Child [i] ; f != EMPTY ; f = Sibling [f])
{
ASSERT (h > 0) ;
Stack [h--] = f ;
AMD_DEBUG1 (("push "ID" on stack\n", f)) ;
ASSERT (f >= 0 && f < nn) ;
}
ASSERT (Stack [h] == i) ;
/* delete child list so that i gets ordered next time we see it */
Child [i] = EMPTY ;
}
else
{
/* the children of i (if there were any) are already ordered */
/* remove i from the stack and order it. Front i is kth front */
head-- ;
AMD_DEBUG1 (("pop "ID" order "ID"\n", i, k)) ;
Order [i] = k++ ;
ASSERT (k <= nn) ;
}
#ifndef NDEBUG
AMD_DEBUG1 (("\nStack:")) ;
for (h = head ; h >= 0 ; h--)
{
Int j = Stack [h] ;
AMD_DEBUG1 ((" "ID, j)) ;
ASSERT (j >= 0 && j < nn) ;
}
AMD_DEBUG1 (("\n\n")) ;
ASSERT (head < nn) ;
#endif
}
return (k) ;
}

206
src/maths/KLU/amd_postorder.c
View File

@ -1,206 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_postorder: post-order the assembly tree from AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* Perform a postordering (via depth-first search) of an assembly tree. */
#include "amd_internal.h"
void AMD_postorder
(
/* inputs, not modified on output: */
Int nn, /* nodes are in the range 0..nn-1 */
Int Parent [ ], /* Parent [j] is the parent of j, or EMPTY if root */
Int Nv [ ], /* Nv [j] > 0 number of pivots represented by node j,
* or zero if j is not a node. */
Int Fsize [ ], /* Fsize [j]: size of node j */
/* output, not defined on input: */
Int Order [ ], /* output post-order */
/* workspaces of size nn: */
Int Child [ ],
Int Sibling [ ],
Int Stack [ ]
)
{
Int i, j, k, parent, frsize, f, fprev, maxfrsize, bigfprev, bigf, fnext ;
for (j = 0 ; j < nn ; j++)
{
Child [j] = EMPTY ;
Sibling [j] = EMPTY ;
}
/* --------------------------------------------------------------------- */
/* place the children in link lists - bigger elements tend to be last */
/* --------------------------------------------------------------------- */
for (j = nn-1 ; j >= 0 ; j--)
{
if (Nv [j] > 0)
{
/* this is an element */
parent = Parent [j] ;
if (parent != EMPTY)
{
/* place the element in link list of the children its parent */
/* bigger elements will tend to be at the end of the list */
Sibling [j] = Child [parent] ;
Child [parent] = j ;
}
}
}
#ifndef NDEBUG
{
Int nels, ff, nchild ;
AMD_DEBUG1 (("\n\n================================ AMD_postorder:\n"));
nels = 0 ;
for (j = 0 ; j < nn ; j++)
{
if (Nv [j] > 0)
{
AMD_DEBUG1 (( ""ID" : nels "ID" npiv "ID" size "ID
" parent "ID" maxfr "ID"\n", j, nels,
Nv [j], Fsize [j], Parent [j], Fsize [j])) ;
/* this is an element */
/* dump the link list of children */
nchild = 0 ;
AMD_DEBUG1 ((" Children: ")) ;
for (ff = Child [j] ; ff != EMPTY ; ff = Sibling [ff])
{
AMD_DEBUG1 ((ID" ", ff)) ;
ASSERT (Parent [ff] == j) ;
nchild++ ;
ASSERT (nchild < nn) ;
}
AMD_DEBUG1 (("\n")) ;
parent = Parent [j] ;
if (parent != EMPTY)
{
ASSERT (Nv [parent] > 0) ;
}
nels++ ;
}
}
}
AMD_DEBUG1 (("\n\nGo through the children of each node, and put\n"
"the biggest child last in each list:\n")) ;
#endif
/* --------------------------------------------------------------------- */
/* place the largest child last in the list of children for each node */
/* --------------------------------------------------------------------- */
for (i = 0 ; i < nn ; i++)
{
if (Nv [i] > 0 && Child [i] != EMPTY)
{
#ifndef NDEBUG
Int nchild ;
AMD_DEBUG1 (("Before partial sort, element "ID"\n", i)) ;
nchild = 0 ;
for (f = Child [i] ; f != EMPTY ; f = Sibling [f])
{
ASSERT (f >= 0 && f < nn) ;
AMD_DEBUG1 ((" f: "ID" size: "ID"\n", f, Fsize [f])) ;
nchild++ ;
ASSERT (nchild <= nn) ;
}
#endif
/* find the biggest element in the child list */
fprev = EMPTY ;
maxfrsize = EMPTY ;
bigfprev = EMPTY ;
bigf = EMPTY ;
for (f = Child [i] ; f != EMPTY ; f = Sibling [f])
{
ASSERT (f >= 0 && f < nn) ;
frsize = Fsize [f] ;
if (frsize >= maxfrsize)
{
/* this is the biggest seen so far */
maxfrsize = frsize ;
bigfprev = fprev ;
bigf = f ;
}
fprev = f ;
}
ASSERT (bigf != EMPTY) ;
fnext = Sibling [bigf] ;
AMD_DEBUG1 (("bigf "ID" maxfrsize "ID" bigfprev "ID" fnext "ID
" fprev " ID"\n", bigf, maxfrsize, bigfprev, fnext, fprev)) ;
if (fnext != EMPTY)
{
/* if fnext is EMPTY then bigf is already at the end of list */
if (bigfprev == EMPTY)
{
/* delete bigf from the element of the list */
Child [i] = fnext ;
}
else
{
/* delete bigf from the middle of the list */
Sibling [bigfprev] = fnext ;
}
/* put bigf at the end of the list */
Sibling [bigf] = EMPTY ;
ASSERT (Child [i] != EMPTY) ;
ASSERT (fprev != bigf) ;
ASSERT (fprev != EMPTY) ;
Sibling [fprev] = bigf ;
}
#ifndef NDEBUG
AMD_DEBUG1 (("After partial sort, element "ID"\n", i)) ;
for (f = Child [i] ; f != EMPTY ; f = Sibling [f])
{
ASSERT (f >= 0 && f < nn) ;
AMD_DEBUG1 ((" "ID" "ID"\n", f, Fsize [f])) ;
ASSERT (Nv [f] > 0) ;
nchild-- ;
}
ASSERT (nchild == 0) ;
#endif
}
}
/* --------------------------------------------------------------------- */
/* postorder the assembly tree */
/* --------------------------------------------------------------------- */
for (i = 0 ; i < nn ; i++)
{
Order [i] = EMPTY ;
}
k = 0 ;
for (i = 0 ; i < nn ; i++)
{
if (Parent [i] == EMPTY && Nv [i] > 0)
{
AMD_DEBUG1 (("Root of assembly tree "ID"\n", i)) ;
k = AMD_post_tree (i, k, Child, Sibling, Order, Stack
#ifndef NDEBUG
, nn
#endif
) ;
}
}
}

114
src/maths/KLU/amd_preprocess.c
View File

@ -1,114 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_preprocess: sort, remove duplicates, transpose a matrix
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* Sorts, removes duplicate entries, and transposes from the nonzero pattern of
* a column-form matrix A, to obtain the matrix R. The input matrix can have
* duplicate entries and/or unsorted columns (AMD_valid (n,Ap,Ai) must not be
* AMD_INVALID).
*
* This input condition is NOT checked. This routine is not user-callable.
*/
#include "amd_internal.h"
/* AMD_preprocess does not check its input for errors or allocate workspace.
* On input, the condition (AMD_valid (n,n,Ap,Ai) != AMD_INVALID) must hold.
*/
void AMD_preprocess
(
Int n, /* input matrix: A is n-by-n */
const Int Ap [ ], /* size n+1 */
const Int Ai [ ], /* size nz = Ap [n] */
/* output matrix R: */
Int Rp [ ], /* size n+1 */
Int Ri [ ], /* size nz (or less, if duplicates present) */
Int W [ ], /* workspace of size n */
Int Flag [ ] /* workspace of size n */
)
{
/* --------------------------------------------------------------------- */
/* local variables */
/* --------------------------------------------------------------------- */
Int i, j, p, p2 ;
ASSERT (AMD_valid (n, n, Ap, Ai) != AMD_INVALID) ;
/* --------------------------------------------------------------------- */
/* count the entries in each row of A (excluding duplicates) */
/* --------------------------------------------------------------------- */
for (i = 0 ; i < n ; i++)
{
W [i] = 0 ; /* # of nonzeros in row i (excl duplicates) */
Flag [i] = EMPTY ; /* Flag [i] = j if i appears in column j */
}
for (j = 0 ; j < n ; j++)
{
p2 = Ap [j+1] ;
for (p = Ap [j] ; p < p2 ; p++)
{
i = Ai [p] ;
if (Flag [i] != j)
{
/* row index i has not yet appeared in column j */
W [i]++ ; /* one more entry in row i */
Flag [i] = j ; /* flag row index i as appearing in col j*/
}
}
}
/* --------------------------------------------------------------------- */
/* compute the row pointers for R */
/* --------------------------------------------------------------------- */
Rp [0] = 0 ;
for (i = 0 ; i < n ; i++)
{
Rp [i+1] = Rp [i] + W [i] ;
}
for (i = 0 ; i < n ; i++)
{
W [i] = Rp [i] ;
Flag [i] = EMPTY ;
}
/* --------------------------------------------------------------------- */
/* construct the row form matrix R */
/* --------------------------------------------------------------------- */
/* R = row form of pattern of A */
for (j = 0 ; j < n ; j++)
{
p2 = Ap [j+1] ;
for (p = Ap [j] ; p < p2 ; p++)
{
i = Ai [p] ;
if (Flag [i] != j)
{
/* row index i has not yet appeared in column j */
Ri [W [i]++] = j ; /* put col j in row i */
Flag [i] = j ; /* flag row index i as appearing in col j*/
}
}
}
#ifndef NDEBUG
ASSERT (AMD_valid (n, n, Rp, Ri) == AMD_OK) ;
for (j = 0 ; j < n ; j++)
{
ASSERT (W [j] == Rp [j+1]) ;
}
#endif
}

93
src/maths/KLU/amd_valid.c
View File

@ -1,93 +0,0 @@
//------------------------------------------------------------------------------
// AMD/Source/amd_valid: check if a matrix is valid for AMD
//------------------------------------------------------------------------------
// AMD, Copyright (c) 1996-2022, Timothy A. Davis, Patrick R. Amestoy, and
// Iain S. Duff. All Rights Reserved.
// SPDX-License-Identifier: BSD-3-clause
//------------------------------------------------------------------------------
/* Check if a column-form matrix is valid or not. The matrix A is
* n_row-by-n_col. The row indices of entries in column j are in
* Ai [Ap [j] ... Ap [j+1]-1]. Required conditions are:
*
* n_row >= 0
* n_col >= 0
* nz = Ap [n_col] >= 0 number of entries in the matrix
* Ap [0] == 0
* Ap [j] <= Ap [j+1] for all j in the range 0 to n_col.
* Ai [0 ... nz-1] must be in the range 0 to n_row-1.
*
* If any of the above conditions hold, AMD_INVALID is returned. If the
* following condition holds, AMD_OK_BUT_JUMBLED is returned (a warning,
* not an error):
*
* row indices in Ai [Ap [j] ... Ap [j+1]-1] are not sorted in ascending
* order, and/or duplicate entries exist.
*
* Otherwise, AMD_OK is returned.
*
* In v1.2 and earlier, this function returned TRUE if the matrix was valid
* (now returns AMD_OK), or FALSE otherwise (now returns AMD_INVALID or
* AMD_OK_BUT_JUMBLED).
*/
#include "amd_internal.h"
int AMD_valid
(
/* inputs, not modified on output: */
Int n_row, /* A is n_row-by-n_col */
Int n_col,
const Int Ap [ ], /* column pointers of A, of size n_col+1 */
const Int Ai [ ] /* row indices of A, of size nz = Ap [n_col] */
)
{
Int nz, j, p1, p2, ilast, i, p ;
int result = AMD_OK ;
if (n_row < 0 || n_col < 0 || Ap == NULL || Ai == NULL)
{
return (AMD_INVALID) ;
}
nz = Ap [n_col] ;
if (Ap [0] != 0 || nz < 0)
{
/* column pointers must start at Ap [0] = 0, and Ap [n] must be >= 0 */
AMD_DEBUG0 (("column 0 pointer bad or nz < 0\n")) ;
return (AMD_INVALID) ;
}
for (j = 0 ; j < n_col ; j++)
{
p1 = Ap [j] ;
p2 = Ap [j+1] ;
AMD_DEBUG2 (("\nColumn: "ID" p1: "ID" p2: "ID"\n", j, p1, p2)) ;
if (p1 > p2)
{
/* column pointers must be ascending */
AMD_DEBUG0 (("column "ID" pointer bad\n", j)) ;
return (AMD_INVALID) ;
}
ilast = EMPTY ;
for (p = p1 ; p < p2 ; p++)
{
i = Ai [p] ;
AMD_DEBUG3 (("row: "ID"\n", i)) ;
if (i < 0 || i >= n_row)
{
/* row index out of range */
AMD_DEBUG0 (("index out of range, col "ID" row "ID"\n", j, i));
return (AMD_INVALID) ;
}
if (i <= ilast)
{
/* row index unsorted, or duplicate entry present */
AMD_DEBUG1 (("index unsorted/dupl col "ID" row "ID"\n", j, i));
result = AMD_OK_BUT_JUMBLED ;
}
ilast = i ;
}
}
return (result) ;
}

65
src/maths/KLU/btf_internal.h
View File

@ -1,65 +0,0 @@
//------------------------------------------------------------------------------
// BTF/Include/btf_internsl.h: internal include file for BTF
//------------------------------------------------------------------------------
// BTF, Copyright (c) 2004-2023, University of Florida. All Rights Reserved.
// Author: Timothy A. Davis.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
#ifndef _BTF_INTERNAL_H
#define _BTF_INTERNAL_H
/* Not to be included in any user program. */
#ifdef DLONG
#define Int int64_t
#define Int_id "%" PRId64
#define BTF(name) btf_l_ ## name
#else
#define Int int32_t
#define Int_id "%d"
#define BTF(name) btf_ ## name
#endif
/* ========================================================================== */
/* make sure debugging and printing is turned off */
#ifndef NDEBUG
#define NDEBUG
#endif
#ifndef NPRINT
#define NPRINT
#endif
/* To enable debugging and assertions, uncomment this line:
#undef NDEBUG
*/
/* To enable diagnostic printing, uncomment this line:
#undef NPRINT
*/
/* ========================================================================== */
#include <stdio.h>
#include <assert.h>
#define ASSERT(a) assert(a)
#undef TRUE
#undef FALSE
#undef PRINTF
#undef MIN
#ifndef NPRINT
#define PRINTF(s) { printf s ; } ;
#else
#define PRINTF(s)
#endif
#define TRUE 1
#define FALSE 0
#define EMPTY (-1)
#define MIN(a,b) (((a) < (b)) ? (a) : (b))
#endif

391
src/maths/KLU/btf_maxtrans.c
View File

@ -1,391 +0,0 @@
//------------------------------------------------------------------------------
// BTF/Source/btf_maxtrans: maximum transversal
//------------------------------------------------------------------------------
// BTF, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Author: Timothy A. Davis.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Finds a column permutation that maximizes the number of entries on the
* diagonal of a sparse matrix. See btf.h for more information.
*
* This function is identical to cs_maxtrans in CSparse, with the following
* exceptions:
*
* (1) cs_maxtrans finds both jmatch and imatch, where jmatch [i] = j and
* imatch [j] = i if row i is matched to column j. This function returns
* just jmatch (the Match array). The MATLAB interface to cs_maxtrans
* (the single-output cs_dmperm) returns imatch, not jmatch to the MATLAB
* caller.
*
* (2) cs_maxtrans includes a pre-pass that counts the number of non-empty
* rows and columns (m2 and n2, respectively), and computes the matching
* using the transpose of A if m2 < n2. cs_maxtrans also returns quickly
* if the diagonal of the matrix is already zero-free. This pre-pass
* allows cs_maxtrans to be much faster than maxtrans, if the use of the
* transpose is warranted.
*
* However, for square structurally non-singular matrices with one or more
* zeros on the diagonal, the pre-pass is a waste of time, and for these
* matrices, maxtrans can be twice as fast as cs_maxtrans. Since the
* maxtrans function is intended primarily for square matrices that are
* typically structurally nonsingular, the pre-pass is not included here.
* If this maxtrans function is used on a matrix with many more columns
* than rows, consider passing the transpose to this function, or use
* cs_maxtrans instead.
*
* (3) cs_maxtrans can operate as a randomized algorithm, to help avoid
* rare cases of excessive run-time.
*
* (4) this maxtrans function includes an option that limits the total work
* performed. If this limit is reached, the maximum transveral might not
* be found.
*
* Thus, for general usage, cs_maxtrans is preferred. For square matrices that
* are typically structurally non-singular, maxtrans is preferred. A partial
* maxtrans can still be very useful when solving a sparse linear system.
*/
#include "ngspice/btf.h"
#include "btf_internal.h"
/* ========================================================================== */
/* === augment ============================================================== */
/* ========================================================================== */
/* Perform a depth-first-search starting at column k, to find an augmenting
* path. An augmenting path is a sequence of row/column pairs (i1,k), (i2,j1),
* (i3,j2), ..., (i(s+1), js), such that all of the following properties hold:
*
* * column k is not matched to any row
* * entries in the path are nonzero
* * the pairs (i1,j1), (i2,j2), (i3,j3) ..., (is,js) have been
* previously matched to each other
* * (i(s+1), js) is nonzero, and row i(s+1) is not matched to any column
*
* Once this path is found, the matching can be changed to the set of pairs
* path. An augmenting path is a sequence of row/column pairs
*
* (i1,k), (i2,j1), (i3,j2), ..., (i(s+1), js)
*
* Once a row is matched with a column it remains matched with some column, but
* not necessarily the column it was first matched with.
*
* In the worst case, this function can examine every nonzero in A. Since it
* is called n times by maxtrans, the total time of maxtrans can be as high as
* O(n*nnz(A)). To limit this work, pass a value of maxwork > 0. Then at
* most O((maxwork+1)*nnz(A)) work will be performed; the maximum matching might
* not be found, however.
*
* This routine is very similar to the dfs routine in klu_kernel.c, in the
* KLU sparse LU factorization package. It is essentially identical to the
* cs_augment routine in CSparse, and its recursive version (augment function
* in cs_maxtransr_mex.c), except that this routine allows for the search to be
* terminated early if too much work is being performed.
*
* The algorithm is based on the paper "On Algorithms for obtaining a maximum
* transversal" by Iain Duff, ACM Trans. Mathematical Software, vol 7, no. 1,
* pp. 315-330, and "Algorithm 575: Permutations for a zero-free diagonal",
* same issue, pp. 387-390. The code here is a new implementation of that
* algorithm, with different data structures and control flow. After writing
* this code, I carefully compared my algorithm with MC21A/B (ACM Algorithm 575)
* Some of the comparisons are partial because I didn't dig deeply into all of
* the details of MC21A/B, such as how the stack is maintained. The following
* arguments are essentially identical between this code and MC21A:
*
* maxtrans MC21A,B
* -------- -------
* n N identical
* k JORD identical
* Ap IP column / row pointers
* Ai ICN row / column indices
* Ap[n] LICN length of index array (# of nonzeros in A)
* Match IPERM output column / row permutation
* nmatch NUMNZ # of nonzeros on diagonal of permuted matrix
* Flag CV mark a node as visited by the depth-first-search
*
* The following are different, but analogous:
*
* Cheap ARP indicates what part of the a column / row has
* already been matched.
*
* The following arguments are very different:
*
* - LENR # of entries in each row/column (unused in maxtrans)
* Pstack OUT Pstack keeps track of where we are in the depth-
* first-search scan of column j. I think that OUT
* plays a similar role in MC21B, but I'm unsure.
* Istack PR keeps track of the rows in the path. PR is a link
* list, though, whereas Istack is a stack. Maxtrans
* does not use any link lists.
* Jstack OUT? PR? the stack for nodes in the path (unsure)
*
* The following control structures are roughly comparable:
*
* maxtrans MC21B
* -------- -----
* for (k = 0 ; k < n ; k++) DO 100 JORD=1,N
* while (head >= 0) DO 70 K=1,JORD
* for (p = Cheap [j] ; ...) DO 20 II=IN1,IN2
* for (p = head ; ...) DO 90 K=1,JORD
*/
static int augment
(
Int k, /* which stage of the main loop we're in */
Int Ap [ ], /* column pointers, size n+1 */
Int Ai [ ], /* row indices, size nz = Ap [n] */
Int Match [ ], /* size n, Match [i] = j if col j matched to i */
Int Cheap [ ], /* rows Ai [Ap [j] .. Cheap [j]-1] alread matched */
Int Flag [ ], /* Flag [j] = k if j already visited this stage */
Int Istack [ ], /* size n. Row index stack. */
Int Jstack [ ], /* size n. Column index stack. */
Int Pstack [ ], /* size n. Keeps track of position in adjacency list */
double *work, /* work performed by the depth-first-search */
double maxwork /* maximum work allowed */
)
{
/* local variables, but "global" to all DFS levels: */
Int found ; /* true if match found. */
Int head ; /* top of stack */
/* variables that are purely local to any one DFS level: */
Int j2 ; /* the next DFS goes to node j2 */
Int pend ; /* one past the end of the adjacency list for node j */
Int pstart ;
Int quick ;
/* variables that need to be pushed then popped from the stack: */
Int i ; /* the row tentatively matched to i if DFS successful */
Int j ; /* the DFS is at the current node j */
Int p ; /* current index into the adj. list for node j */
/* the variables i, j, and p are stacked in Istack, Jstack, and Pstack */
quick = (maxwork > 0) ;
/* start a DFS to find a match for column k */
found = FALSE ;
i = EMPTY ;
head = 0 ;
Jstack [0] = k ;
ASSERT (Flag [k] != k) ;
while (head >= 0)
{
j = Jstack [head] ;
pend = Ap [j+1] ;
if (Flag [j] != k) /* a node is not yet visited */
{
/* -------------------------------------------------------------- */
/* prework for node j */
/* -------------------------------------------------------------- */
/* first time that j has been visited */
Flag [j] = k ;
/* cheap assignment: find the next unmatched row in col j. This
* loop takes at most O(nnz(A)) time for the sum total of all
* calls to augment. */
for (p = Cheap [j] ; p < pend && !found ; p++)
{
i = Ai [p] ;
found = (Match [i] == EMPTY) ;
}
Cheap [j] = p ;
/* -------------------------------------------------------------- */
/* prepare for DFS */
if (found)
{
/* end of augmenting path, column j matched with row i */
Istack [head] = i ;
break ;
}
/* set Pstack [head] to the first entry in column j to scan */
Pstack [head] = Ap [j] ;
}
/* ------------------------------------------------------------------ */
/* quick return if too much work done */
/* ------------------------------------------------------------------ */
if (quick && *work > maxwork)
{
/* too much work has been performed; abort the search */
return (EMPTY) ;
}
/* ------------------------------------------------------------------ */
/* DFS for nodes adjacent to j */
/* ------------------------------------------------------------------ */
/* If cheap assignment not made, continue the depth-first search. All
* rows in column j are already matched. Add the adjacent nodes to the
* stack by iterating through until finding another non-visited node.
*
* It is the following loop that can force maxtrans to take
* O(n*nnz(A)) time. */
pstart = Pstack [head] ;
for (p = pstart ; p < pend ; p++)
{
i = Ai [p] ;
j2 = Match [i] ;
ASSERT (j2 != EMPTY) ;
if (Flag [j2] != k)
{
/* Node j2 is not yet visited, start a depth-first search on
* node j2. Keep track of where we left off in the scan of adj
* list of node j so we can restart j where we left off. */
Pstack [head] = p + 1 ;
/* Push j2 onto the stack and immediately break so we can
* recurse on node j2. Also keep track of row i which (if this
* search for an augmenting path works) will be matched with the
* current node j. */
Istack [head] = i ;
Jstack [++head] = j2 ;
break ;
}
}
/* ------------------------------------------------------------------ */
/* determine how much work was just performed */
/* ------------------------------------------------------------------ */
*work += (p - pstart + 1) ;
/* ------------------------------------------------------------------ */
/* node j is done, but the postwork is postponed - see below */
/* ------------------------------------------------------------------ */
if (p == pend)
{
/* If all adjacent nodes of j are already visited, pop j from
* stack and continue. We failed to find a match. */
head-- ;
}
}
/* postwork for all nodes j in the stack */
/* unwind the path and make the corresponding matches */
if (found)
{
for (p = head ; p >= 0 ; p--)
{
j = Jstack [p] ;
i = Istack [p] ;
/* -------------------------------------------------------------- */
/* postwork for node j */
/* -------------------------------------------------------------- */
/* if found, match row i with column j */
Match [i] = j ;
}
}
return (found) ;
}
/* ========================================================================== */
/* === maxtrans ============================================================= */
/* ========================================================================== */
Int BTF(maxtrans) /* returns # of columns in the matching */
(
/* --- input --- */
Int nrow, /* A is nrow-by-ncol in compressed column form */
Int ncol,
Int Ap [ ], /* size ncol+1 */
Int Ai [ ], /* size nz = Ap [ncol] */
double maxwork, /* do at most maxwork*nnz(A) work; no limit if <= 0. This
* work limit excludes the O(nnz(A)) cheap-match phase. */
/* --- output --- */
double *work, /* work = -1 if maxwork > 0 and the total work performed
* reached the maximum of maxwork*nnz(A)).
* Otherwise, work = the total work performed. */
Int Match [ ], /* size nrow. Match [i] = j if column j matched to row i */
/* --- workspace --- */
Int Work [ ] /* size 5*ncol */
)
{
Int *Cheap, *Flag, *Istack, *Jstack, *Pstack ;
Int i, j, k, nmatch, work_limit_reached ;
int result ;
/* ---------------------------------------------------------------------- */
/* get workspace and initialize */
/* ---------------------------------------------------------------------- */
Cheap = Work ; Work += ncol ;
Flag = Work ; Work += ncol ;
/* stack for non-recursive depth-first search in augment function */
Istack = Work ; Work += ncol ;
Jstack = Work ; Work += ncol ;
Pstack = Work ;
/* in column j, rows Ai [Ap [j] .. Cheap [j]-1] are known to be matched */
for (j = 0 ; j < ncol ; j++)
{
Cheap [j] = Ap [j] ;
Flag [j] = EMPTY ;
}
/* all rows and columns are currently unmatched */
for (i = 0 ; i < nrow ; i++)
{
Match [i] = EMPTY ;
}
if (maxwork > 0)
{
maxwork *= Ap [ncol] ;
}
*work = 0 ;
/* ---------------------------------------------------------------------- */
/* find a matching row for each column k */
/* ---------------------------------------------------------------------- */
nmatch = 0 ;
work_limit_reached = FALSE ;
for (k = 0 ; k < ncol ; k++)
{
/* find an augmenting path to match some row i to column k */
result = augment (k, Ap, Ai, Match, Cheap, Flag, Istack, Jstack, Pstack,
work, maxwork) ;
if (result == TRUE)
{
/* we found it. Match [i] = k for some row i has been done. */
nmatch++ ;
}
else if (result == EMPTY)
{
/* augment gave up because of too much work, and no match found */
work_limit_reached = TRUE ;
}
}
/* ---------------------------------------------------------------------- */
/* return the Match, and the # of matches made */
/* ---------------------------------------------------------------------- */
/* At this point, row i is matched to j = Match [i] if j >= 0. i is an
* unmatched row if Match [i] == EMPTY. */
if (work_limit_reached)
{
/* return -1 if the work limit of maxwork*nnz(A) was reached */
*work = EMPTY ;
}
return (nmatch) ;
}

135
src/maths/KLU/btf_order.c
View File

@ -1,135 +0,0 @@
//------------------------------------------------------------------------------
// BTF/Source/btf_order: permute a matrix to block triangular form
//------------------------------------------------------------------------------
// BTF, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Author: Timothy A. Davis.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Find a permutation P and Q to permute a square sparse matrix into upper block
* triangular form. A(P,Q) will contain a zero-free diagonal if A has
* structural full-rank. Otherwise, the number of nonzeros on the diagonal of
* A(P,Q) will be maximized, and will equal the structural rank of A.
*
* Q[k] will be "flipped" if a zero-free diagonal was not found. Q[k] will be
* negative, and j = BTF_UNFLIP (Q [k]) gives the corresponding permutation.
*
* R defines the block boundaries of A(P,Q). The kth block consists of rows
* and columns R[k] to R[k+1]-1.
*
* If maxwork > 0 on input, then the work performed in btf_maxtrans is limited
* to maxwork*nnz(A) (excluding the "cheap match" phase, which can take another
* nnz(A) work). On output, the work parameter gives the actual work performed,
* or -1 if the limit was reached. In the latter case, the diagonal of A(P,Q)
* might not be zero-free, and the number of nonzeros on the diagonal of A(P,Q)
* might not be equal to the structural rank.
*
* See btf.h for more details.
*/
#include "ngspice/btf.h"
#include "btf_internal.h"
/* This function only operates on square matrices (either structurally full-
* rank, or structurally rank deficient). */
Int BTF(order) /* returns number of blocks found */
(
/* input, not modified: */
Int n, /* A is n-by-n in compressed column form */
Int Ap [ ], /* size n+1 */
Int Ai [ ], /* size nz = Ap [n] */
double maxwork, /* do at most maxwork*nnz(A) work in the maximum
* transversal; no limit if <= 0 */
/* output, not defined on input */
double *work, /* work performed in maxtrans, or -1 if limit reached */
Int P [ ], /* size n, row permutation */
Int Q [ ], /* size n, column permutation */
Int R [ ], /* size n+1. block b is in rows/cols R[b] ... R[b+1]-1 */
Int *nmatch, /* # nonzeros on diagonal of P*A*Q */
/* workspace, not defined on input or output */
Int Work [ ] /* size 5n */
)
{
Int *Flag ;
Int nblocks, i, j, nbadcol ;
/* ---------------------------------------------------------------------- */
/* compute the maximum matching */
/* ---------------------------------------------------------------------- */
/* if maxwork > 0, then a maximum matching might not be found */
*nmatch = BTF(maxtrans) (n, n, Ap, Ai, maxwork, work, Q, Work) ;
/* ---------------------------------------------------------------------- */
/* complete permutation if the matrix is structurally singular */
/* ---------------------------------------------------------------------- */
/* Since the matrix is square, ensure BTF_UNFLIP(Q[0..n-1]) is a
* permutation of the columns of A so that A has as many nonzeros on the
* diagonal as possible.
*/
if (*nmatch < n)
{
/* get a size-n work array */
Flag = Work + n ;
for (j = 0 ; j < n ; j++)
{
Flag [j] = 0 ;
}
/* flag all matched columns */
for (i = 0 ; i < n ; i++)
{
j = Q [i] ;
if (j != EMPTY)
{
/* row i and column j are matched to each other */
Flag [j] = 1 ;
}
}
/* make a list of all unmatched columns, in Work [0..nbadcol-1] */
nbadcol = 0 ;
for (j = n-1 ; j >= 0 ; j--)
{
if (!Flag [j])
{
/* j is matched to nobody */
Work [nbadcol++] = j ;
}
}
ASSERT (*nmatch + nbadcol == n) ;
/* make an assignment for each unmatched row */
for (i = 0 ; i < n ; i++)
{
if (Q [i] == EMPTY && nbadcol > 0)
{
/* get an unmatched column j */
j = Work [--nbadcol] ;
/* assign j to row i and flag the entry by "flipping" it */
Q [i] = BTF_FLIP (j) ;
}
}
}
/* The permutation of a square matrix can be recovered as follows: Row i is
* matched with column j, where j = BTF_UNFLIP (Q [i]) and where j
* will always be in the valid range 0 to n-1. The entry A(i,j) is zero
* if BTF_ISFLIPPED (Q [i]) is true, and nonzero otherwise. nmatch
* is the number of entries in the Q array that are non-negative. */
/* ---------------------------------------------------------------------- */
/* find the strongly connected components */
/* ---------------------------------------------------------------------- */
nblocks = BTF(strongcomp) (n, Ap, Ai, Q, P, R, Work) ;
return (nblocks) ;
}

596
src/maths/KLU/btf_strongcomp.c
View File

@ -1,596 +0,0 @@
//------------------------------------------------------------------------------
// BTF/Source/btf_strongcomp: strongly connected components
//------------------------------------------------------------------------------
// BTF, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Author: Timothy A. Davis.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Finds the strongly connected components of a graph, or equivalently, permutes
* the matrix into upper block triangular form. See btf.h for more details.
* Input matrix and Q are not checked on input.
*/
#include "ngspice/btf.h"
#include "btf_internal.h"
#define UNVISITED (-2) /* Flag [j] = UNVISITED if node j not visited yet */
#define UNASSIGNED (-1) /* Flag [j] = UNASSIGNED if node j has been visited,
* but not yet assigned to a strongly-connected
* component (aka block). Flag [j] = k (k in the
* range 0 to nblocks-1) if node j has been visited
* (and completed, with its postwork done) and
* assigned to component k. */
/* This file contains two versions of the depth-first-search, a recursive one
* and a non-recursive one. By default, the non-recursive one is used. */
#ifndef RECURSIVE
/* ========================================================================== */
/* === dfs: non-recursive version (default) ================================= */
/* ========================================================================== */
/* Perform a depth-first-search of a graph, stored in an adjacency-list form.
* The row indices of column j (equivalently, the out-adjacency list of node j)
* are stored in Ai [Ap[j] ... Ap[j+1]-1]. Self-edge (diagonal entries) are
* ignored. Ap[0] must be zero, and thus nz = Ap[n] is the number of entries
* in the matrix (or edges in the graph). The row indices in each column need
* not be in any particular order. If an input column permutation is given,
* node j (in the permuted matrix A*Q) is located in
* Ai [Ap[Q[j]] ... Ap[Q[j]+1]-1]. This Q can be the same as the Match array
* output from the maxtrans routine, for a square matrix that is structurally
* full rank.
*
* The algorithm is from the paper by Robert E. Tarjan, "Depth-first search and
* linear graph algorithms," SIAM Journal on Computing, vol. 1, no. 2,
* pp. 146-160, 1972. The time taken by strongcomp is O(nnz(A)).
*
* See also MC13A/B in the Harwell subroutine library (Iain S. Duff and John
* K. Reid, "Algorithm 529: permutations to block triangular form," ACM Trans.
* on Mathematical Software, vol. 4, no. 2, pp. 189-192, 1978, and "An
* implementation of Tarjan's algorithm for the block triangular form of a
* matrix," same journal, pp. 137-147. This code is implements the same
* algorithm as MC13A/B, except that the data structures are very different.
* Also, unlike MC13A/B, the output permutation preserves the natural ordering
* within each block.
*/
static void dfs
(
/* inputs, not modified on output: */
Int j, /* start the DFS at node j */
Int Ap [ ], /* size n+1, column pointers for the matrix A */
Int Ai [ ], /* row indices, size nz = Ap [n] */
Int Q [ ], /* input column permutation */
/* inputs, modified on output (each array is of size n): */
Int Time [ ], /* Time [j] = "time" that node j was first visited */
Int Flag [ ], /* Flag [j]: see above */
Int Low [ ], /* Low [j]: see definition below */
Int *p_nblocks, /* number of blocks (aka strongly-connected-comp.)*/
Int *p_timestamp, /* current "time" */
/* workspace, not defined on input or output: */
Int Cstack [ ], /* size n, output stack to hold nodes of components */
Int Jstack [ ], /* size n, stack for the variable j */
Int Pstack [ ] /* size n, stack for the variable p */
)
{
/* ---------------------------------------------------------------------- */
/* local variables, and initializations */
/* ---------------------------------------------------------------------- */
/* local variables, but "global" to all DFS levels: */
Int chead ; /* top of Cstack */
Int jhead ; /* top of Jstack and Pstack */
/* variables that are purely local to any one DFS level: */
Int i ; /* edge (j,i) considered; i can be next node to traverse */
Int parent ; /* parent of node j in the DFS tree */
Int pend ; /* one past the end of the adjacency list for node j */
Int jj ; /* column j of A*Q is column jj of the input matrix A */
/* variables that need to be pushed then popped from the stack: */
Int p ; /* current index into the adj. list for node j */
/* the variables j and p are stacked in Jstack and Pstack */
/* local copies of variables in the calling routine */
Int nblocks = *p_nblocks ;
Int timestamp = *p_timestamp ;
/* ---------------------------------------------------------------------- */
/* start a DFS at node j (same as the recursive call dfs (EMPTY, j)) */
/* ---------------------------------------------------------------------- */
chead = 0 ; /* component stack is empty */
jhead = 0 ; /* Jstack and Pstack are empty */
Jstack [0] = j ; /* put the first node j on the Jstack */
ASSERT (Flag [j] == UNVISITED) ;
while (jhead >= 0)
{
j = Jstack [jhead] ; /* grab the node j from the top of Jstack */
/* determine which column jj of the A is column j of A*Q */
jj = (Q == (Int *) NULL) ? (j) : (BTF_UNFLIP (Q [j])) ;
pend = Ap [jj+1] ; /* j's row index list ends at Ai [pend-1] */
if (Flag [j] == UNVISITED)
{
/* -------------------------------------------------------------- */
/* prework at node j */
/* -------------------------------------------------------------- */
/* node j is being visited for the first time */
Cstack [++chead] = j ; /* push j onto the stack */
timestamp++ ; /* get a timestamp */
Time [j] = timestamp ; /* give the timestamp to node j */
Low [j] = timestamp ;
Flag [j] = UNASSIGNED ; /* flag node j as visited */
/* -------------------------------------------------------------- */
/* set Pstack [jhead] to the first entry in column j to scan */
/* -------------------------------------------------------------- */
Pstack [jhead] = Ap [jj] ;
}
/* ------------------------------------------------------------------ */
/* DFS rooted at node j (start it, or continue where left off) */
/* ------------------------------------------------------------------ */
for (p = Pstack [jhead] ; p < pend ; p++)
{
i = Ai [p] ; /* examine the edge from node j to node i */
if (Flag [i] == UNVISITED)
{
/* Node i has not been visited - start a DFS at node i.
* Keep track of where we left off in the scan of adjacency list
* of node j so we can restart j where we left off. */
Pstack [jhead] = p + 1 ;
/* Push i onto the stack and immediately break
* so we can recurse on node i. */
Jstack [++jhead] = i ;
ASSERT (Time [i] == EMPTY) ;
ASSERT (Low [i] == EMPTY) ;
/* break here to do what the recursive call dfs (j,i) does */
break ;
}
else if (Flag [i] == UNASSIGNED)
{
/* Node i has been visited, but still unassigned to a block
* this is a back or cross edge if Time [i] < Time [j].
* Note that i might equal j, in which case this code does
* nothing. */
ASSERT (Time [i] > 0) ;
ASSERT (Low [i] > 0) ;
Low [j] = MIN (Low [j], Time [i]) ;
}
}
if (p == pend)
{
/* If all adjacent nodes of j are already visited, pop j from
* Jstack and do the post work for node j. This also pops p
* from the Pstack. */
jhead-- ;
/* -------------------------------------------------------------- */
/* postwork at node j */
/* -------------------------------------------------------------- */
/* determine if node j is the head of a component */
if (Low [j] == Time [j])
{
/* pop all nodes in this SCC from Cstack */
while (TRUE)
{
ASSERT (chead >= 0) ; /* stack not empty (j in it) */
i = Cstack [chead--] ; /* pop a node from the Cstack */
ASSERT (i >= 0) ;
ASSERT (Flag [i] == UNASSIGNED) ;
Flag [i] = nblocks ; /* assign i to current block */
if (i == j) break ; /* current block ends at j */
}
nblocks++ ; /* one more block has been found */
}
/* update Low [parent], if the parent exists */
if (jhead >= 0)
{
parent = Jstack [jhead] ;
Low [parent] = MIN (Low [parent], Low [j]) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* cleanup: update timestamp and nblocks */
/* ---------------------------------------------------------------------- */
*p_timestamp = timestamp ;
*p_nblocks = nblocks ;
}
#else
/* ========================================================================== */
/* === dfs: recursive version (only for illustration) ======================= */
/* ========================================================================== */
/* The following is a recursive version of dfs, which computes identical results
* as the non-recursive dfs. It is included here because it is easier to read.
* Compare the comments in the code below with the identical comments in the
* non-recursive code above, and that will help you see the correlation between
* the two routines.
*
* This routine can cause stack overflow, and is thus not recommended for heavy
* usage, particularly for large matrices. To help in delaying stack overflow,
* global variables are used, reducing the amount of information each call to
* dfs places on the call/return stack (the integers i, j, p, parent, and the
* return address). Note that this means the recursive code is not thread-safe.
* To try this version, compile the code with -DRECURSIVE or include the
* following line at the top of this file:
#define RECURSIVE
*/
static Int /* for recursive illustration only, not for production use */
chead, timestamp, nblocks, n, *Ap, *Ai, *Flag, *Cstack, *Time, *Low,
*P, *R, *Q ;
static void dfs
(
Int parent, /* came from parent node */
Int j /* at node j in the DFS */
)
{
Int p ; /* current index into the adj. list for node j */
Int i ; /* edge (j,i) considered; i can be next node to traverse */
Int jj ; /* column j of A*Q is column jj of the input matrix A */
/* ---------------------------------------------------------------------- */
/* prework at node j */
/* ---------------------------------------------------------------------- */
/* node j is being visited for the first time */
Cstack [++chead] = j ; /* push j onto the stack */
timestamp++ ; /* get a timestamp */
Time [j] = timestamp ; /* give the timestamp to node j */
Low [j] = timestamp ;
Flag [j] = UNASSIGNED ; /* flag node j as visited */
/* ---------------------------------------------------------------------- */
/* DFS rooted at node j */
/* ---------------------------------------------------------------------- */
/* determine which column jj of the A is column j of A*Q */
jj = (Q == (Int *) NULL) ? (j) : (BTF_UNFLIP (Q [j])) ;
for (p = Ap [jj] ; p < Ap [jj+1] ; p++)
{
i = Ai [p] ; /* examine the edge from node j to node i */
if (Flag [i] == UNVISITED)
{
/* Node i has not been visited - start a DFS at node i. */
dfs (j, i) ;
}
else if (Flag [i] == UNASSIGNED)
{
/* Node i has been visited, but still unassigned to a block
* this is a back or cross edge if Time [i] < Time [j].
* Note that i might equal j, in which case this code does
* nothing. */
Low [j] = MIN (Low [j], Time [i]) ;
}
}
/* ---------------------------------------------------------------------- */
/* postwork at node j */
/* ---------------------------------------------------------------------- */
/* determine if node j is the head of a component */
if (Low [j] == Time [j])
{
/* pop all nodes in this strongly connected component from Cstack */
while (TRUE)
{
i = Cstack [chead--] ; /* pop a node from the Cstack */
Flag [i] = nblocks ; /* assign node i to current block */
if (i == j) break ; /* current block ends at node j */
}
nblocks++ ; /* one more block has been found */
}
/* update Low [parent] */
if (parent != EMPTY)
{
/* Note that this could be done with Low[j] = MIN(Low[j],Low[i]) just
* after the dfs (j,i) statement above, and then parent would not have
* to be an input argument. Putting it here places all the postwork
* for node j in one place, thus making the non-recursive DFS easier. */
Low [parent] = MIN (Low [parent], Low [j]) ;
}
}
#endif
/* ========================================================================== */
/* === btf_strongcomp ======================================================= */
/* ========================================================================== */
#ifndef RECURSIVE
Int BTF(strongcomp) /* return # of strongly connected components */
(
/* input, not modified: */
Int n, /* A is n-by-n in compressed column form */
Int Ap [ ], /* size n+1 */
Int Ai [ ], /* size nz = Ap [n] */
/* optional input, modified (if present) on output: */
Int Q [ ], /* size n, input column permutation. The permutation Q can
* include a flag which indicates an unmatched row.
* jold = BTF_UNFLIP (Q [jnew]) is the permutation;
* this function ingnores these flags. On output, it is
* modified according to the permutation P. */
/* output, not defined on input: */
Int P [ ], /* size n. P [k] = j if row and column j are kth row/col
* in permuted matrix. */
Int R [ ], /* size n+1. kth block is in rows/cols R[k] ... R[k+1]-1
* of the permuted matrix. */
/* workspace, not defined on input or output: */
Int Work [ ] /* size 4n */
)
#else
Int BTF(strongcomp) /* recursive version - same as above except for Work size */
(
Int n_in,
Int Ap_in [ ],
Int Ai_in [ ],
Int Q_in [ ],
Int P_in [ ],
Int R_in [ ],
Int Work [ ] /* size 2n */
)
#endif
{
Int j, k, b ;
#ifndef RECURSIVE
Int timestamp, nblocks, *Flag, *Cstack, *Time, *Low, *Jstack, *Pstack ;
#else
n = n_in ;
Ap = Ap_in ;
Ai = Ai_in ;
Q = Q_in ;
P = P_in ;
R = R_in ;
chead = EMPTY ;
#endif
/* ---------------------------------------------------------------------- */
/* get and initialize workspace */
/* ---------------------------------------------------------------------- */
/* timestamp is incremented each time a new node is visited.
*
* Time [j] is the timestamp given to node j.
*
* Low [j] is the lowest timestamp of any node reachable from j via either
* a path to any descendent of j in the DFS tree, or via a single edge to
* an either an ancestor (a back edge) or another node that's neither an
* ancestor nor a descendant (a cross edge). If Low [j] is equal to
* the timestamp of node j (Time [j]), then node j is the "head" of a
* strongly connected component (SCC). That is, it is the first node
* visited in its strongly connected component, and the DFS subtree rooted
* at node j spans all the nodes of the strongly connected component.
*
* The term "block" and "component" are used interchangebly in this code;
* "block" being a matrix term and "component" being a graph term for the
* same thing.
*
* When a node is visited, it is placed on the Cstack (for "component"
* stack). When node j is found to be an SCC head, all the nodes from the
* top of the stack to node j itself form the nodes in the SCC. This Cstack
* is used for both the recursive and non-recursive versions.
*/
Time = Work ; Work += n ;
Flag = Work ; Work += n ;
Low = P ; /* use output array P as workspace for Low */
Cstack = R ; /* use output array R as workspace for Cstack */
#ifndef RECURSIVE
/* stack for non-recursive dfs */
Jstack = Work ; Work += n ; /* stack for j */
Pstack = Work ; /* stack for p */
#endif
for (j = 0 ; j < n ; j++)
{
Flag [j] = UNVISITED ;
Low [j] = EMPTY ;
Time [j] = EMPTY ;
#ifndef NDEBUG
Cstack [j] = EMPTY ;
#ifndef RECURSIVE
Jstack [j] = EMPTY ;
Pstack [j] = EMPTY ;
#endif
#endif
}
timestamp = 0 ; /* each node given a timestamp when it is visited */
nblocks = 0 ; /* number of blocks found so far */
/* ---------------------------------------------------------------------- */
/* find the connected components via a depth-first-search */
/* ---------------------------------------------------------------------- */
for (j = 0 ; j < n ; j++)
{
/* node j is unvisited or assigned to a block. Cstack is empty. */
ASSERT (Flag [j] == UNVISITED || (Flag [j] >= 0 && Flag [j] < nblocks));
if (Flag [j] == UNVISITED)
{
#ifndef RECURSIVE
/* non-recursive dfs (default) */
dfs (j, Ap, Ai, Q, Time, Flag, Low, &nblocks, &timestamp,
Cstack, Jstack, Pstack) ;
#else
/* recursive dfs (for illustration only) */
ASSERT (chead == EMPTY) ;
dfs (EMPTY, j) ;
ASSERT (chead == EMPTY) ;
#endif
}
}
ASSERT (timestamp == n) ;
/* ---------------------------------------------------------------------- */
/* construct the block boundary array, R */
/* ---------------------------------------------------------------------- */
for (b = 0 ; b < nblocks ; b++)
{
R [b] = 0 ;
}
for (j = 0 ; j < n ; j++)
{
/* node j has been assigned to block b = Flag [j] */
ASSERT (Time [j] > 0 && Time [j] <= n) ;
ASSERT (Low [j] > 0 && Low [j] <= n) ;
ASSERT (Flag [j] >= 0 && Flag [j] < nblocks) ;
R [Flag [j]]++ ;
}
/* R [b] is now the number of nodes in block b. Compute cumulative sum
* of R, using Time [0 ... nblocks-1] as workspace. */
Time [0] = 0 ;
for (b = 1 ; b < nblocks ; b++)
{
Time [b] = Time [b-1] + R [b-1] ;
}
for (b = 0 ; b < nblocks ; b++)
{
R [b] = Time [b] ;
}
R [nblocks] = n ;
/* ---------------------------------------------------------------------- */
/* construct the permutation, preserving the natural order */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
P [k] = EMPTY ;
}
#endif
for (j = 0 ; j < n ; j++)
{
/* place column j in the permutation */
P [Time [Flag [j]]++] = j ;
}
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
ASSERT (P [k] != EMPTY) ;
}
#endif
/* Now block b consists of the nodes k1 to k2-1 in the permuted matrix,
* where k1 = R [b] and k2 = R [b+1]. Row and column j of the original
* matrix becomes row and column P [k] of the permuted matrix. The set of
* of rows/columns (nodes) in block b is given by P [k1 ... k2-1], and this
* set is sorted in ascending order. Thus, if the matrix consists of just
* one block, P is the identity permutation. */
/* ---------------------------------------------------------------------- */
/* if Q is present on input, set Q = Q*P' */
/* ---------------------------------------------------------------------- */
if (Q != (Int *) NULL)
{
/* We found a symmetric permutation P for the matrix A*Q. The overall
* permutation is thus P*(A*Q)*P'. Set Q=Q*P' so that the final
* permutation is P*A*Q. Use Time as workspace. Note that this
* preserves the negative values of Q if the matrix is structurally
* singular. */
for (k = 0 ; k < n ; k++)
{
Time [k] = Q [P [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Q [k] = Time [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* how to traverse the permuted matrix */
/* ---------------------------------------------------------------------- */
/* If Q is not present, the following code can be used to traverse the
* permuted matrix P*A*P'
*
* // compute the inverse of P
* for (knew = 0 ; knew < n ; knew++)
* {
* // row and column kold in the old matrix is row/column knew
* // in the permuted matrix P*A*P'
* kold = P [knew] ;
* Pinv [kold] = knew ;
* }
* for (b = 0 ; b < nblocks ; b++)
* {
* // traverse block b of the permuted matrix P*A*P'
* k1 = R [b] ;
* k2 = R [b+1] ;
* nk = k2 - k1 ;
* for (jnew = k1 ; jnew < k2 ; jnew++)
* {
* jold = P [jnew] ;
* for (p = Ap [jold] ; p < Ap [jold+1] ; p++)
* {
* iold = Ai [p] ;
* inew = Pinv [iold] ;
* // Entry in the old matrix is A (iold, jold), and its
* // position in the new matrix P*A*P' is (inew, jnew).
* // Let B be the bth diagonal block of the permuted
* // matrix. If inew >= k1, then this entry is in row/
* // column (inew-k1, jnew-k1) of the nk-by-nk matrix B.
* // Otherwise, the entry is in the upper block triangular
* // part, not in any diagonal block.
* }
* }
* }
*
* If Q is present replace the above statement
* jold = P [jnew] ;
* with
* jold = Q [jnew] ;
* or
* jold = BTF_UNFLIP (Q [jnew]) ;
*
* then entry A (iold,jold) in the old (unpermuted) matrix is at (inew,jnew)
* in the permuted matrix P*A*Q. Everything else remains the same as the
* above (simply replace P*A*P' with P*A*Q in the above comments).
*/
/* ---------------------------------------------------------------------- */
/* return # of blocks / # of strongly connected components */
/* ---------------------------------------------------------------------- */
return (nblocks) ;
}

19
src/maths/KLU/btf_version.c
View File

@ -1,19 +0,0 @@
//------------------------------------------------------------------------------
// BTF/Source/btf_version: return BTF version
//------------------------------------------------------------------------------
// BTF, Copyright (c) 2004-2023, University of Florida. All Rights Reserved.
// Author: Timothy A. Davis.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
#include "btf.h"
void btf_version (int version [3])
{
version [0] = BTF_MAIN_VERSION ;
version [1] = BTF_SUB_VERSION ;
version [2] = BTF_SUBSUB_VERSION ;
}

3581
src/maths/KLU/colamd.c
View File

File diff suppressed because it is too large Load Diff

23
src/maths/KLU/colamd_global.c
View File

@ -1,23 +0,0 @@
/* ========================================================================== */
/* === colamd_global.c ====================================================== */
/* ========================================================================== */
/* ----------------------------------------------------------------------------
* COLAMD, Copyright (C) 2007, Timothy A. Davis.
* See License.txt for the Version 2.1 of the GNU Lesser General Public License
* http://www.cise.ufl.edu/research/sparse
* -------------------------------------------------------------------------- */
/* Global variables for COLAMD */
#ifndef NPRINT
#ifdef MATLAB_MEX_FILE
#include "mex.h"
int (*colamd_printf) (const char *, ...) = mexPrintf ;
#else
#include <stdio.h>
int (*colamd_printf) (const char *, ...) = printf ;
#endif
#else
int (*colamd_printf) (const char *, ...) = ((void *) 0) ;
#endif

773
src/maths/KLU/klu.c
View File

@ -1,773 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu: primary factorization and forward/backsolve kernels for KLU
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* KLU: factorizes P*A into L*U, using the Gilbert-Peierls algorithm [1], with
* optional symmetric pruning by Eisenstat and Liu [2]. The code is by Tim
* Davis. This algorithm is what appears as the default sparse LU routine in
* MATLAB version 6.0, and still appears in MATLAB 6.5 as [L,U,P] = lu (A).
* Note that no column ordering is provided (see COLAMD or AMD for suitable
* orderings). SuperLU is based on this algorithm, except that it adds the
* use of dense matrix operations on "supernodes" (adjacent columns with
* identical). This code doesn't use supernodes, thus its name ("Kent" LU,
* as in "Clark Kent", in contrast with Super-LU...). This algorithm is slower
* than SuperLU and UMFPACK for large matrices with lots of nonzeros in their
* factors (such as for most finite-element problems). However, for matrices
* with very sparse LU factors, this algorithm is typically faster than both
* SuperLU and UMFPACK, since in this case there is little chance to exploit
* dense matrix kernels (the BLAS).
*
* Only one block of A is factorized, in the BTF form. The input n is the
* size of the block; k1 is the first row and column in the block.
*
* NOTE: no error checking is done on the inputs. This version is not meant to
* be called directly by the user. Use klu_factor instead.
*
* No fill-reducing ordering is provided. The ordering quality of
* klu_kernel_factor is the responsibility of the caller. The input A must
* pre-permuted to reduce fill-in, or fill-reducing input permutation Q must
* be provided.
*
* The input matrix A must be in compressed-column form, with either sorted
* or unsorted row indices. Row indices for column j of A is in
* Ai [Ap [j] ... Ap [j+1]-1] and the same range of indices in Ax holds the
* numerical values. No duplicate entries are allowed.
*
* If an input permutation Q is provided, the factorization L*U = A (P,Q)
* is computed, where P is determined by partial pivoting, and Q is the input
* ordering. If the pivot tolerance is less than 1, the "diagonal" entry that
* KLU attempts to choose is the diagonal of A (Q,Q). In other words, the
* input permutation is applied symmetrically to the input matrix. The output
* permutation P includes both the partial pivoting ordering and the input
* permutation. If Q is NULL, then it is assumed to be the identity
* permutation. Q is not modified.
*
* [1] Gilbert, J. R. and Peierls, T., "Sparse Partial Pivoting in Time
* Proportional to Arithmetic Operations," SIAM J. Sci. Stat. Comp.,
* vol 9, pp. 862-874, 1988.
* [2] Eisenstat, S. C. and Liu, J. W. H., "Exploiting Structural Symmetry in
* Unsymmetric Sparse Symbolic Factorization," SIAM J. Matrix Analysis &
* Applic., vol 13, pp. 202-211, 1992.
*/
/* ========================================================================== */
#include "klu_internal.h"
size_t KLU_kernel_factor /* 0 if failure, size of LU if OK */
(
/* inputs, not modified */
Int n, /* A is n-by-n. n must be > 0. */
Int Ap [ ], /* size n+1, column pointers for A */
Int Ai [ ], /* size nz = Ap [n], row indices for A */
Entry Ax [ ], /* size nz, values of A */
Int Q [ ], /* size n, optional column permutation */
double Lsize, /* estimate of number of nonzeros in L */
/* outputs, not defined on input */
Unit **p_LU, /* row indices and values of L and U */
Entry Udiag [ ], /* size n, diagonal of U */
Int Llen [ ], /* size n, column length of L */
Int Ulen [ ], /* size n, column length of U */
Int Lip [ ], /* size n, column pointers for L */
Int Uip [ ], /* size n, column pointers for U */
Int P [ ], /* row permutation, size n */
Int *lnz, /* size of L */
Int *unz, /* size of U */
/* workspace, undefined on input */
Entry *X, /* size n double's, zero on output */
Int *Work, /* size 5n Int's */
/* inputs, not modified on output */
Int k1, /* the block of A is from k1 to k2-1 */
Int PSinv [ ], /* inverse of P from symbolic factorization */
double Rs [ ], /* scale factors for A */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ],
/* --------------- */
KLU_common *Common
)
{
double maxlnz, dunits ;
Unit *LU ;
Int *Pinv, *Lpend, *Stack, *Flag, *Ap_pos, *W ;
Int lsize, usize, anz, ok ;
size_t lusize ;
ASSERT (Common != NULL) ;
/* ---------------------------------------------------------------------- */
/* get control parameters, or use defaults */
/* ---------------------------------------------------------------------- */
n = MAX (1, n) ;
anz = Ap [n+k1] - Ap [k1] ;
if (Lsize <= 0)
{
Lsize = -Lsize ;
Lsize = MAX (Lsize, 1.0) ;
lsize = Lsize * anz + n ;
}
else
{
lsize = Lsize ;
}
usize = lsize ;
lsize = MAX (n+1, lsize) ;
usize = MAX (n+1, usize) ;
maxlnz = (((double) n) * ((double) n) + ((double) n)) / 2. ;
maxlnz = MIN (maxlnz, ((double) Int_MAX)) ;
lsize = MIN (maxlnz, lsize) ;
usize = MIN (maxlnz, usize) ;
PRINTF (("Welcome to klu: n %d anz %d k1 %d lsize %d usize %d maxlnz %g\n",
n, anz, k1, lsize, usize, maxlnz)) ;
/* ---------------------------------------------------------------------- */
/* allocate workspace and outputs */
/* ---------------------------------------------------------------------- */
/* return arguments are not yet assigned */
*p_LU = (Unit *) NULL ;
/* these computations are safe from size_t overflow */
W = Work ;
Pinv = (Int *) W ; W += n ;
Stack = (Int *) W ; W += n ;
Flag = (Int *) W ; W += n ;
Lpend = (Int *) W ; W += n ;
Ap_pos = (Int *) W ; W += n ;
dunits = DUNITS (Int, lsize) + DUNITS (Entry, lsize) +
DUNITS (Int, usize) + DUNITS (Entry, usize) ;
lusize = (size_t) dunits ;
ok = !INT_OVERFLOW (dunits) ;
LU = ok ? KLU_malloc (lusize, sizeof (Unit), Common) : NULL ;
if (LU == NULL)
{
/* out of memory, or problem too large */
Common->status = KLU_OUT_OF_MEMORY ;
lusize = 0 ;
return (lusize) ;
}
/* ---------------------------------------------------------------------- */
/* factorize */
/* ---------------------------------------------------------------------- */
/* with pruning, and non-recursive depth-first-search */
lusize = KLU_kernel (n, Ap, Ai, Ax, Q, lusize,
Pinv, P, &LU, Udiag, Llen, Ulen, Lip, Uip, lnz, unz,
X, Stack, Flag, Ap_pos, Lpend,
k1, PSinv, Rs, Offp, Offi, Offx, Common) ;
/* ---------------------------------------------------------------------- */
/* return LU factors, or return nothing if an error occurred */
/* ---------------------------------------------------------------------- */
if (Common->status < KLU_OK)
{
LU = KLU_free (LU, lusize, sizeof (Unit), Common) ;
lusize = 0 ;
}
*p_LU = LU ;
PRINTF ((" in klu noffdiag %d\n", Common->noffdiag)) ;
return (lusize) ;
}
/* ========================================================================== */
/* === KLU_lsolve =========================================================== */
/* ========================================================================== */
/* Solve Lx=b. Assumes L is unit lower triangular and where the unit diagonal
* entry is NOT stored. Overwrites B with the solution X. B is n-by-nrhs
* and is stored in ROW form with row dimension nrhs. nrhs must be in the
* range 1 to 4. */
void KLU_lsolve
(
/* inputs, not modified: */
Int n,
Int Lip [ ],
Int Llen [ ],
Unit LU [ ],
Int nrhs,
/* right-hand-side on input, solution to Lx=b on output */
Entry X [ ]
)
{
Entry x [4], lik ;
Int *Li ;
Entry *Lx ;
Int k, p, len, i ;
switch (nrhs)
{
case 1:
for (k = 0 ; k < n ; k++)
{
x [0] = X [k] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
/* unit diagonal of L is not stored*/
for (p = 0 ; p < len ; p++)
{
/* X [Li [p]] -= Lx [p] * x [0] ; */
MULT_SUB (X [Li [p]], Lx [p], x [0]) ;
}
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
lik = Lx [p] ;
MULT_SUB (X [2*i], lik, x [0]) ;
MULT_SUB (X [2*i + 1], lik, x [1]) ;
}
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
lik = Lx [p] ;
MULT_SUB (X [3*i], lik, x [0]) ;
MULT_SUB (X [3*i + 1], lik, x [1]) ;
MULT_SUB (X [3*i + 2], lik, x [2]) ;
}
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
lik = Lx [p] ;
MULT_SUB (X [4*i], lik, x [0]) ;
MULT_SUB (X [4*i + 1], lik, x [1]) ;
MULT_SUB (X [4*i + 2], lik, x [2]) ;
MULT_SUB (X [4*i + 3], lik, x [3]) ;
}
}
break ;
}
}
/* ========================================================================== */
/* === KLU_usolve =========================================================== */
/* ========================================================================== */
/* Solve Ux=b. Assumes U is non-unit upper triangular and where the diagonal
* entry is NOT stored. Overwrites B with the solution X. B is n-by-nrhs
* and is stored in ROW form with row dimension nrhs. nrhs must be in the
* range 1 to 4. */
void KLU_usolve
(
/* inputs, not modified: */
Int n,
Int Uip [ ],
Int Ulen [ ],
Unit LU [ ],
Entry Udiag [ ],
Int nrhs,
/* right-hand-side on input, solution to Ux=b on output */
Entry X [ ]
)
{
Entry x [4], uik, ukk ;
Int *Ui ;
Entry *Ux ;
Int k, p, len, i ;
switch (nrhs)
{
case 1:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
/* x [0] = X [k] / Udiag [k] ; */
DIV (x [0], X [k], Udiag [k]) ;
X [k] = x [0] ;
for (p = 0 ; p < len ; p++)
{
/* X [Ui [p]] -= Ux [p] * x [0] ; */
MULT_SUB (X [Ui [p]], Ux [p], x [0]) ;
}
}
break ;
case 2:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
ukk = Udiag [k] ;
/* x [0] = X [2*k ] / ukk ;
x [1] = X [2*k + 1] / ukk ; */
DIV (x [0], X [2*k], ukk) ;
DIV (x [1], X [2*k + 1], ukk) ;
X [2*k ] = x [0] ;
X [2*k + 1] = x [1] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
uik = Ux [p] ;
/* X [2*i ] -= uik * x [0] ;
X [2*i + 1] -= uik * x [1] ; */
MULT_SUB (X [2*i], uik, x [0]) ;
MULT_SUB (X [2*i + 1], uik, x [1]) ;
}
}
break ;
case 3:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
ukk = Udiag [k] ;
DIV (x [0], X [3*k], ukk) ;
DIV (x [1], X [3*k + 1], ukk) ;
DIV (x [2], X [3*k + 2], ukk) ;
X [3*k ] = x [0] ;
X [3*k + 1] = x [1] ;
X [3*k + 2] = x [2] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
uik = Ux [p] ;
MULT_SUB (X [3*i], uik, x [0]) ;
MULT_SUB (X [3*i + 1], uik, x [1]) ;
MULT_SUB (X [3*i + 2], uik, x [2]) ;
}
}
break ;
case 4:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
ukk = Udiag [k] ;
DIV (x [0], X [4*k], ukk) ;
DIV (x [1], X [4*k + 1], ukk) ;
DIV (x [2], X [4*k + 2], ukk) ;
DIV (x [3], X [4*k + 3], ukk) ;
X [4*k ] = x [0] ;
X [4*k + 1] = x [1] ;
X [4*k + 2] = x [2] ;
X [4*k + 3] = x [3] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
uik = Ux [p] ;
MULT_SUB (X [4*i], uik, x [0]) ;
MULT_SUB (X [4*i + 1], uik, x [1]) ;
MULT_SUB (X [4*i + 2], uik, x [2]) ;
MULT_SUB (X [4*i + 3], uik, x [3]) ;
}
}
break ;
}
}
/* ========================================================================== */
/* === KLU_ltsolve ========================================================== */
/* ========================================================================== */
/* Solve L'x=b. Assumes L is unit lower triangular and where the unit diagonal
* entry is NOT stored. Overwrites B with the solution X. B is n-by-nrhs
* and is stored in ROW form with row dimension nrhs. nrhs must in the
* range 1 to 4. */
void KLU_ltsolve
(
/* inputs, not modified: */
Int n,
Int Lip [ ],
Int Llen [ ],
Unit LU [ ],
Int nrhs,
#ifdef COMPLEX
Int conj_solve,
#endif
/* right-hand-side on input, solution to L'x=b on output */
Entry X [ ]
)
{
Entry x [4], lik ;
Int *Li ;
Entry *Lx ;
Int k, p, len, i ;
switch (nrhs)
{
case 1:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
x [0] = X [k] ;
for (p = 0 ; p < len ; p++)
{
#ifdef COMPLEX
if (conj_solve)
{
/* x [0] -= CONJ (Lx [p]) * X [Li [p]] ; */
MULT_SUB_CONJ (x [0], X [Li [p]], Lx [p]) ;
}
else
#endif
{
/*x [0] -= Lx [p] * X [Li [p]] ;*/
MULT_SUB (x [0], Lx [p], X [Li [p]]) ;
}
}
X [k] = x [0] ;
}
break ;
case 2:
for (k = n-1 ; k >= 0 ; k--)
{
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (lik, Lx [p]) ;
}
else
#endif
{
lik = Lx [p] ;
}
MULT_SUB (x [0], lik, X [2*i]) ;
MULT_SUB (x [1], lik, X [2*i + 1]) ;
}
X [2*k ] = x [0] ;
X [2*k + 1] = x [1] ;
}
break ;
case 3:
for (k = n-1 ; k >= 0 ; k--)
{
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (lik, Lx [p]) ;
}
else
#endif
{
lik = Lx [p] ;
}
MULT_SUB (x [0], lik, X [3*i]) ;
MULT_SUB (x [1], lik, X [3*i + 1]) ;
MULT_SUB (x [2], lik, X [3*i + 2]) ;
}
X [3*k ] = x [0] ;
X [3*k + 1] = x [1] ;
X [3*k + 2] = x [2] ;
}
break ;
case 4:
for (k = n-1 ; k >= 0 ; k--)
{
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (lik, Lx [p]) ;
}
else
#endif
{
lik = Lx [p] ;
}
MULT_SUB (x [0], lik, X [4*i]) ;
MULT_SUB (x [1], lik, X [4*i + 1]) ;
MULT_SUB (x [2], lik, X [4*i + 2]) ;
MULT_SUB (x [3], lik, X [4*i + 3]) ;
}
X [4*k ] = x [0] ;
X [4*k + 1] = x [1] ;
X [4*k + 2] = x [2] ;
X [4*k + 3] = x [3] ;
}
break ;
}
}
/* ========================================================================== */
/* === KLU_utsolve ========================================================== */
/* ========================================================================== */
/* Solve U'x=b. Assumes U is non-unit upper triangular and where the diagonal
* entry is stored (and appears last in each column of U). Overwrites B
* with the solution X. B is n-by-nrhs and is stored in ROW form with row
* dimension nrhs. nrhs must be in the range 1 to 4. */
void KLU_utsolve
(
/* inputs, not modified: */
Int n,
Int Uip [ ],
Int Ulen [ ],
Unit LU [ ],
Entry Udiag [ ],
Int nrhs,
#ifdef COMPLEX
Int conj_solve,
#endif
/* right-hand-side on input, solution to Ux=b on output */
Entry X [ ]
)
{
Entry x [4], uik, ukk ;
Int k, p, len, i ;
Int *Ui ;
Entry *Ux ;
switch (nrhs)
{
case 1:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [k] ;
for (p = 0 ; p < len ; p++)
{
#ifdef COMPLEX
if (conj_solve)
{
/* x [0] -= CONJ (Ux [p]) * X [Ui [p]] ; */
MULT_SUB_CONJ (x [0], X [Ui [p]], Ux [p]) ;
}
else
#endif
{
/* x [0] -= Ux [p] * X [Ui [p]] ; */
MULT_SUB (x [0], Ux [p], X [Ui [p]]) ;
}
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [k], x [0], ukk) ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (uik, Ux [p]) ;
}
else
#endif
{
uik = Ux [p] ;
}
MULT_SUB (x [0], uik, X [2*i]) ;
MULT_SUB (x [1], uik, X [2*i + 1]) ;
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [2*k], x [0], ukk) ;
DIV (X [2*k + 1], x [1], ukk) ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (uik, Ux [p]) ;
}
else
#endif
{
uik = Ux [p] ;
}
MULT_SUB (x [0], uik, X [3*i]) ;
MULT_SUB (x [1], uik, X [3*i + 1]) ;
MULT_SUB (x [2], uik, X [3*i + 2]) ;
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [3*k], x [0], ukk) ;
DIV (X [3*k + 1], x [1], ukk) ;
DIV (X [3*k + 2], x [2], ukk) ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (uik, Ux [p]) ;
}
else
#endif
{
uik = Ux [p] ;
}
MULT_SUB (x [0], uik, X [4*i]) ;
MULT_SUB (x [1], uik, X [4*i + 1]) ;
MULT_SUB (x [2], uik, X [4*i + 2]) ;
MULT_SUB (x [3], uik, X [4*i + 3]) ;
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [4*k], x [0], ukk) ;
DIV (X [4*k + 1], x [1], ukk) ;
DIV (X [4*k + 2], x [2], ukk) ;
DIV (X [4*k + 3], x [3], ukk) ;
}
break ;
}
}

488
src/maths/KLU/klu_analyze.c
View File

@ -1,488 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_analyze: symbolic analysis
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Order the matrix using BTF (or not), and then AMD, COLAMD, the natural
* ordering, or the user-provided-function on the blocks. Does not support
* using a given ordering (use klu_analyze_given for that case). */
#include "klu_internal.h"
/* ========================================================================== */
/* === analyze_worker ======================================================= */
/* ========================================================================== */
static Int analyze_worker /* returns KLU_OK or < 0 if error */
(
/* inputs, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
Int nblocks, /* # of blocks */
Int Pbtf [ ], /* BTF row permutation */
Int Qbtf [ ], /* BTF col permutation */
Int R [ ], /* size n+1, but only Rbtf [0..nblocks] is used */
Int ordering, /* what ordering to use (0, 1, or 3 for this routine) */
/* output only, not defined on input */
Int P [ ], /* size n */
Int Q [ ], /* size n */
double Lnz [ ], /* size n, but only Lnz [0..nblocks-1] is used */
/* workspace, not defined on input or output */
Int Pblk [ ], /* size maxblock */
Int Cp [ ], /* size maxblock+1 */
Int Ci [ ], /* size MAX (nz+1, Cilen) */
Int Cilen, /* nz+1, or COLAMD_recommend(nz,n,n) for COLAMD */
Int Pinv [ ], /* size maxblock */
/* input/output */
KLU_symbolic *Symbolic,
KLU_common *Common
)
{
double amd_Info [AMD_INFO], lnz, lnz1, flops, flops1 ;
Int k1, k2, nk, k, block, oldcol, pend, newcol, result, pc, p, newrow,
maxnz, nzoff, cstats [COLAMD_STATS], ok, err = KLU_INVALID ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
/* compute the inverse of Pbtf */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
P [k] = EMPTY ;
Q [k] = EMPTY ;
Pinv [k] = EMPTY ;
}
#endif
for (k = 0 ; k < n ; k++)
{
ASSERT (Pbtf [k] >= 0 && Pbtf [k] < n) ;
Pinv [Pbtf [k]] = k ;
}
#ifndef NDEBUG
for (k = 0 ; k < n ; k++) ASSERT (Pinv [k] != EMPTY) ;
#endif
nzoff = 0 ;
lnz = 0 ;
maxnz = 0 ;
flops = 0 ;
Symbolic->symmetry = EMPTY ; /* only computed by AMD */
/* ---------------------------------------------------------------------- */
/* order each block */
/* ---------------------------------------------------------------------- */
for (block = 0 ; block < nblocks ; block++)
{
/* ------------------------------------------------------------------ */
/* the block is from rows/columns k1 to k2-1 */
/* ------------------------------------------------------------------ */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("BLOCK %d, k1 %d k2-1 %d nk %d\n", block, k1, k2-1, nk)) ;
/* ------------------------------------------------------------------ */
/* construct the kth block, C */
/* ------------------------------------------------------------------ */
Lnz [block] = EMPTY ;
pc = 0 ;
for (k = k1 ; k < k2 ; k++)
{
newcol = k-k1 ;
Cp [newcol] = pc ;
oldcol = Qbtf [k] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] ;
if (newrow < k1)
{
nzoff++ ;
}
else
{
/* (newrow,newcol) is an entry in the block */
ASSERT (newrow < k2) ;
newrow -= k1 ;
Ci [pc++] = newrow ;
}
}
}
Cp [nk] = pc ;
maxnz = MAX (maxnz, pc) ;
ASSERT (KLU_valid (nk, Cp, Ci, NULL)) ;
/* ------------------------------------------------------------------ */
/* order the block C */
/* ------------------------------------------------------------------ */
if (nk <= 3)
{
/* -------------------------------------------------------------- */
/* use natural ordering for tiny blocks (3-by-3 or less) */
/* -------------------------------------------------------------- */
for (k = 0 ; k < nk ; k++)
{
Pblk [k] = k ;
}
lnz1 = nk * (nk + 1) / 2 ;
flops1 = nk * (nk - 1) / 2 + (nk-1)*nk*(2*nk-1) / 6 ;
ok = TRUE ;
}
else if (ordering == 0)
{
/* -------------------------------------------------------------- */
/* order the block with AMD (C+C') */
/* -------------------------------------------------------------- */
result = AMD_order (nk, Cp, Ci, Pblk, NULL, amd_Info) ;
ok = (result >= AMD_OK) ;
if (result == AMD_OUT_OF_MEMORY)
{
err = KLU_OUT_OF_MEMORY ;
}
/* account for memory usage in AMD */
Common->mempeak = MAX (Common->mempeak,
Common->memusage + amd_Info [AMD_MEMORY]) ;
/* get the ordering statistics from AMD */
lnz1 = (Int) (amd_Info [AMD_LNZ]) + nk ;
flops1 = 2 * amd_Info [AMD_NMULTSUBS_LU] + amd_Info [AMD_NDIV] ;
if (pc == maxnz)
{
/* get the symmetry of the biggest block */
Symbolic->symmetry = amd_Info [AMD_SYMMETRY] ;
}
}
else if (ordering == 1)
{
/* -------------------------------------------------------------- */
/* order the block with COLAMD (C) */
/* -------------------------------------------------------------- */
/* order (and destroy) Ci, returning column permutation in Cp.
* COLAMD "cannot" fail since the matrix has already been checked,
* and Ci allocated. */
ok = COLAMD (nk, nk, Cilen, Ci, Cp, NULL, cstats) ;
lnz1 = EMPTY ;
flops1 = EMPTY ;
/* copy the permutation from Cp to Pblk */
for (k = 0 ; k < nk ; k++)
{
Pblk [k] = Cp [k] ;
}
}
else
{
/* -------------------------------------------------------------- */
/* pass the block to the user-provided ordering function */
/* -------------------------------------------------------------- */
lnz1 = (Common->user_order) (nk, Cp, Ci, Pblk, Common) ;
flops1 = EMPTY ;
ok = (lnz1 != 0) ;
}
if (!ok)
{
return (err) ; /* ordering method failed */
}
/* ------------------------------------------------------------------ */
/* keep track of nnz(L) and flops statistics */
/* ------------------------------------------------------------------ */
Lnz [block] = lnz1 ;
lnz = (lnz == EMPTY || lnz1 == EMPTY) ? EMPTY : (lnz + lnz1) ;
flops = (flops == EMPTY || flops1 == EMPTY) ? EMPTY : (flops + flops1) ;
/* ------------------------------------------------------------------ */
/* combine the preordering with the BTF ordering */
/* ------------------------------------------------------------------ */
PRINTF (("Pblk, 1-based:\n")) ;
for (k = 0 ; k < nk ; k++)
{
ASSERT (k + k1 < n) ;
ASSERT (Pblk [k] + k1 < n) ;
Q [k + k1] = Qbtf [Pblk [k] + k1] ;
}
for (k = 0 ; k < nk ; k++)
{
ASSERT (k + k1 < n) ;
ASSERT (Pblk [k] + k1 < n) ;
P [k + k1] = Pbtf [Pblk [k] + k1] ;
}
}
PRINTF (("nzoff %d Ap[n] %d\n", nzoff, Ap [n])) ;
ASSERT (nzoff >= 0 && nzoff <= Ap [n]) ;
/* return estimates of # of nonzeros in L including diagonal */
Symbolic->lnz = lnz ; /* EMPTY if COLAMD used */
Symbolic->unz = lnz ;
Symbolic->nzoff = nzoff ;
Symbolic->est_flops = flops ; /* EMPTY if COLAMD or user-ordering used */
return (KLU_OK) ;
}
/* ========================================================================== */
/* === order_and_analyze ==================================================== */
/* ========================================================================== */
/* Orders the matrix with or with BTF, then orders each block with AMD, COLAMD,
* or the user ordering function. Does not handle the natural or given
* ordering cases. */
static KLU_symbolic *order_and_analyze /* returns NULL if error, or a valid
KLU_symbolic object if successful */
(
/* inputs, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
/* --------------------- */
KLU_common *Common
)
{
double work ;
KLU_symbolic *Symbolic ;
double *Lnz ;
Int *Qbtf, *Cp, *Ci, *Pinv, *Pblk, *Pbtf, *P, *Q, *R ;
Int nblocks, nz, block, maxblock, k1, k2, nk, do_btf, ordering, k, Cilen,
*Work ;
/* ---------------------------------------------------------------------- */
/* allocate the Symbolic object, and check input matrix */
/* ---------------------------------------------------------------------- */
Symbolic = KLU_alloc_symbolic (n, Ap, Ai, Common) ;
if (Symbolic == NULL)
{
return (NULL) ;
}
P = Symbolic->P ;
Q = Symbolic->Q ;
R = Symbolic->R ;
Lnz = Symbolic->Lnz ;
nz = Symbolic->nz ;
ordering = Common->ordering ;
if (ordering == 1)
{
/* COLAMD */
Cilen = COLAMD_recommended (nz, n, n) ;
}
else if (ordering == 0 || (ordering == 3 && Common->user_order != NULL))
{
/* AMD or user ordering function */
Cilen = nz+1 ;
}
else
{
/* invalid ordering */
Common->status = KLU_INVALID ;
KLU_free_symbolic (&Symbolic, Common) ;
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* allocate workspace for BTF permutation */
/* ---------------------------------------------------------------------- */
Pbtf = KLU_malloc (n, sizeof (Int), Common) ;
Qbtf = KLU_malloc (n, sizeof (Int), Common) ;
if (Common->status < KLU_OK)
{
KLU_free (Pbtf, n, sizeof (Int), Common) ;
KLU_free (Qbtf, n, sizeof (Int), Common) ;
KLU_free_symbolic (&Symbolic, Common) ;
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* get the common parameters for BTF and ordering method */
/* ---------------------------------------------------------------------- */
do_btf = Common->btf ;
do_btf = (do_btf) ? TRUE : FALSE ;
Symbolic->ordering = ordering ;
Symbolic->do_btf = do_btf ;
Symbolic->structural_rank = EMPTY ;
/* ---------------------------------------------------------------------- */
/* find the block triangular form (if requested) */
/* ---------------------------------------------------------------------- */
Common->work = 0 ;
if (do_btf)
{
Work = KLU_malloc (5*n, sizeof (Int), Common) ;
if (Common->status < KLU_OK)
{
/* out of memory */
KLU_free (Pbtf, n, sizeof (Int), Common) ;
KLU_free (Qbtf, n, sizeof (Int), Common) ;
KLU_free_symbolic (&Symbolic, Common) ;
return (NULL) ;
}
nblocks = BTF_order (n, Ap, Ai, Common->maxwork, &work, Pbtf, Qbtf, R,
&(Symbolic->structural_rank), Work) ;
Common->structural_rank = Symbolic->structural_rank ;
Common->work += work ;
KLU_free (Work, 5*n, sizeof (Int), Common) ;
/* unflip Qbtf if the matrix does not have full structural rank */
if (Symbolic->structural_rank < n)
{
for (k = 0 ; k < n ; k++)
{
Qbtf [k] = BTF_UNFLIP (Qbtf [k]) ;
}
}
/* find the size of the largest block */
maxblock = 1 ;
for (block = 0 ; block < nblocks ; block++)
{
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("block %d size %d\n", block, nk)) ;
maxblock = MAX (maxblock, nk) ;
}
}
else
{
/* BTF not requested */
nblocks = 1 ;
maxblock = n ;
R [0] = 0 ;
R [1] = n ;
for (k = 0 ; k < n ; k++)
{
Pbtf [k] = k ;
Qbtf [k] = k ;
}
}
Symbolic->nblocks = nblocks ;
PRINTF (("maxblock size %d\n", maxblock)) ;
Symbolic->maxblock = maxblock ;
/* ---------------------------------------------------------------------- */
/* allocate more workspace, for analyze_worker */
/* ---------------------------------------------------------------------- */
Pblk = KLU_malloc (maxblock, sizeof (Int), Common) ;
Cp = KLU_malloc (maxblock + 1, sizeof (Int), Common) ;
Ci = KLU_malloc (MAX (Cilen, nz+1), sizeof (Int), Common) ;
Pinv = KLU_malloc (n, sizeof (Int), Common) ;
/* ---------------------------------------------------------------------- */
/* order each block of the BTF ordering, and a fill-reducing ordering */
/* ---------------------------------------------------------------------- */
if (Common->status == KLU_OK)
{
PRINTF (("calling analyze_worker\n")) ;
Common->status = analyze_worker (n, Ap, Ai, nblocks, Pbtf, Qbtf, R,
ordering, P, Q, Lnz, Pblk, Cp, Ci, Cilen, Pinv, Symbolic, Common) ;
PRINTF (("analyze_worker done\n")) ;
}
/* ---------------------------------------------------------------------- */
/* free all workspace */
/* ---------------------------------------------------------------------- */
KLU_free (Pblk, maxblock, sizeof (Int), Common) ;
KLU_free (Cp, maxblock+1, sizeof (Int), Common) ;
KLU_free (Ci, MAX (Cilen, nz+1), sizeof (Int), Common) ;
KLU_free (Pinv, n, sizeof (Int), Common) ;
KLU_free (Pbtf, n, sizeof (Int), Common) ;
KLU_free (Qbtf, n, sizeof (Int), Common) ;
/* ---------------------------------------------------------------------- */
/* return the symbolic object */
/* ---------------------------------------------------------------------- */
if (Common->status < KLU_OK)
{
KLU_free_symbolic (&Symbolic, Common) ;
}
return (Symbolic) ;
}
/* ========================================================================== */
/* === KLU_analyze ========================================================== */
/* ========================================================================== */
KLU_symbolic *KLU_analyze /* returns NULL if error, or a valid
KLU_symbolic object if successful */
(
/* inputs, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
/* -------------------- */
KLU_common *Common
)
{
/* ---------------------------------------------------------------------- */
/* get the control parameters for BTF and ordering method */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (NULL) ;
}
Common->status = KLU_OK ;
Common->structural_rank = EMPTY ;
/* ---------------------------------------------------------------------- */
/* order and analyze */
/* ---------------------------------------------------------------------- */
if (Common->ordering == 2)
{
/* natural ordering */
return (KLU_analyze_given (n, Ap, Ai, NULL, NULL, Common)) ;
}
else
{
/* order with P and Q */
return (order_and_analyze (n, Ap, Ai, Common)) ;
}
}

375
src/maths/KLU/klu_analyze_given.c
View File

@ -1,375 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_analyze_given: symbolic analysis with given permutation
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Given an input permutation P and Q, create the Symbolic object. BTF can
* be done to modify the user's P and Q (does not perform the max transversal;
* just finds the strongly-connected components). */
#include "klu_internal.h"
/* ========================================================================== */
/* === klu_alloc_symbolic =================================================== */
/* ========================================================================== */
/* Allocate Symbolic object, and check input matrix. Not user callable. */
KLU_symbolic *KLU_alloc_symbolic
(
Int n,
Int *Ap,
Int *Ai,
KLU_common *Common
)
{
KLU_symbolic *Symbolic ;
Int *P, *Q, *R ;
double *Lnz ;
Int nz, i, j, p, pend ;
if (Common == NULL)
{
return (NULL) ;
}
Common->status = KLU_OK ;
/* A is n-by-n, with n > 0. Ap [0] = 0 and nz = Ap [n] >= 0 required.
* Ap [j] <= Ap [j+1] must hold for all j = 0 to n-1. Row indices in Ai
* must be in the range 0 to n-1, and no duplicate entries can be present.
* The list of row indices in each column of A need not be sorted.
*/
if (n <= 0 || Ap == NULL || Ai == NULL)
{
/* Ap and Ai must be present, and n must be > 0 */
Common->status = KLU_INVALID ;
return (NULL) ;
}
nz = Ap [n] ;
if (Ap [0] != 0 || nz < 0)
{
/* nz must be >= 0 and Ap [0] must equal zero */
Common->status = KLU_INVALID ;
return (NULL) ;
}
for (j = 0 ; j < n ; j++)
{
if (Ap [j] > Ap [j+1])
{
/* column pointers must be non-decreasing */
Common->status = KLU_INVALID ;
return (NULL) ;
}
}
P = KLU_malloc (n, sizeof (Int), Common) ;
if (Common->status < KLU_OK)
{
/* out of memory */
Common->status = KLU_OUT_OF_MEMORY ;
return (NULL) ;
}
for (i = 0 ; i < n ; i++)
{
P [i] = EMPTY ;
}
for (j = 0 ; j < n ; j++)
{
pend = Ap [j+1] ;
for (p = Ap [j] ; p < pend ; p++)
{
i = Ai [p] ;
if (i < 0 || i >= n || P [i] == j)
{
/* row index out of range, or duplicate entry */
KLU_free (P, n, sizeof (Int), Common) ;
Common->status = KLU_INVALID ;
return (NULL) ;
}
/* flag row i as appearing in column j */
P [i] = j ;
}
}
/* ---------------------------------------------------------------------- */
/* allocate the Symbolic object */
/* ---------------------------------------------------------------------- */
Symbolic = KLU_malloc (1, sizeof (KLU_symbolic), Common) ;
if (Common->status < KLU_OK)
{
/* out of memory */
KLU_free (P, n, sizeof (Int), Common) ;
Common->status = KLU_OUT_OF_MEMORY ;
return (NULL) ;
}
Q = KLU_malloc (n, sizeof (Int), Common) ;
R = KLU_malloc (n+1, sizeof (Int), Common) ;
Lnz = KLU_malloc (n, sizeof (double), Common) ;
Symbolic->n = n ;
Symbolic->nz = nz ;
Symbolic->P = P ;
Symbolic->Q = Q ;
Symbolic->R = R ;
Symbolic->Lnz = Lnz ;
if (Common->status < KLU_OK)
{
/* out of memory */
KLU_free_symbolic (&Symbolic, Common) ;
Common->status = KLU_OUT_OF_MEMORY ;
return (NULL) ;
}
return (Symbolic) ;
}
/* ========================================================================== */
/* === KLU_analyze_given ==================================================== */
/* ========================================================================== */
KLU_symbolic *KLU_analyze_given /* returns NULL if error, or a valid
KLU_symbolic object if successful */
(
/* inputs, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
Int Puser [ ], /* size n, user's row permutation (may be NULL) */
Int Quser [ ], /* size n, user's column permutation (may be NULL) */
/* -------------------- */
KLU_common *Common
)
{
KLU_symbolic *Symbolic ;
double *Lnz ;
Int nblocks, nz, block, maxblock, *P, *Q, *R, nzoff, p, pend, do_btf, k ;
/* ---------------------------------------------------------------------- */
/* determine if input matrix is valid, and get # of nonzeros */
/* ---------------------------------------------------------------------- */
Symbolic = KLU_alloc_symbolic (n, Ap, Ai, Common) ;
if (Symbolic == NULL)
{
return (NULL) ;
}
P = Symbolic->P ;
Q = Symbolic->Q ;
R = Symbolic->R ;
Lnz = Symbolic->Lnz ;
nz = Symbolic->nz ;
/* ---------------------------------------------------------------------- */
/* Q = Quser, or identity if Quser is NULL */
/* ---------------------------------------------------------------------- */
if (Quser == (Int *) NULL)
{
for (k = 0 ; k < n ; k++)
{
Q [k] = k ;
}
}
else
{
for (k = 0 ; k < n ; k++)
{
Q [k] = Quser [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* get the control parameters for BTF and ordering method */
/* ---------------------------------------------------------------------- */
do_btf = Common->btf ;
do_btf = (do_btf) ? TRUE : FALSE ;
Symbolic->ordering = 2 ;
Symbolic->do_btf = do_btf ;
/* ---------------------------------------------------------------------- */
/* find the block triangular form, if requested */
/* ---------------------------------------------------------------------- */
if (do_btf)
{
/* ------------------------------------------------------------------ */
/* get workspace for BTF_strongcomp */
/* ------------------------------------------------------------------ */
Int *Pinv, *Work, *Bi, k1, k2, nk, oldcol ;
Work = KLU_malloc (4*n, sizeof (Int), Common) ;
Pinv = KLU_malloc (n, sizeof (Int), Common) ;
if (Puser != (Int *) NULL)
{
Bi = KLU_malloc (nz+1, sizeof (Int), Common) ;
}
else
{
Bi = Ai ;
}
if (Common->status < KLU_OK)
{
/* out of memory */
KLU_free (Work, 4*n, sizeof (Int), Common) ;
KLU_free (Pinv, n, sizeof (Int), Common) ;
if (Puser != (Int *) NULL)
{
KLU_free (Bi, nz+1, sizeof (Int), Common) ;
}
KLU_free_symbolic (&Symbolic, Common) ;
Common->status = KLU_OUT_OF_MEMORY ;
return (NULL) ;
}
/* ------------------------------------------------------------------ */
/* B = Puser * A */
/* ------------------------------------------------------------------ */
if (Puser != (Int *) NULL)
{
for (k = 0 ; k < n ; k++)
{
Pinv [Puser [k]] = k ;
}
for (p = 0 ; p < nz ; p++)
{
Bi [p] = Pinv [Ai [p]] ;
}
}
/* ------------------------------------------------------------------ */
/* find the strongly-connected components */
/* ------------------------------------------------------------------ */
/* modifies Q, and determines P and R */
nblocks = BTF_strongcomp (n, Ap, Bi, Q, P, R, Work) ;
/* ------------------------------------------------------------------ */
/* P = P * Puser */
/* ------------------------------------------------------------------ */
if (Puser != (Int *) NULL)
{
for (k = 0 ; k < n ; k++)
{
Work [k] = Puser [P [k]] ;
}
for (k = 0 ; k < n ; k++)
{
P [k] = Work [k] ;
}
}
/* ------------------------------------------------------------------ */
/* Pinv = inverse of P */
/* ------------------------------------------------------------------ */
for (k = 0 ; k < n ; k++)
{
Pinv [P [k]] = k ;
}
/* ------------------------------------------------------------------ */
/* analyze each block */
/* ------------------------------------------------------------------ */
nzoff = 0 ; /* nz in off-diagonal part */
maxblock = 1 ; /* size of the largest block */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("BLOCK %d, k1 %d k2-1 %d nk %d\n", block, k1, k2-1, nk)) ;
maxblock = MAX (maxblock, nk) ;
/* -------------------------------------------------------------- */
/* scan the kth block, C */
/* -------------------------------------------------------------- */
for (k = k1 ; k < k2 ; k++)
{
oldcol = Q [k] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
if (Pinv [Ai [p]] < k1)
{
nzoff++ ;
}
}
}
/* fill-in not estimated */
Lnz [block] = EMPTY ;
}
/* ------------------------------------------------------------------ */
/* free all workspace */
/* ------------------------------------------------------------------ */
KLU_free (Work, 4*n, sizeof (Int), Common) ;
KLU_free (Pinv, n, sizeof (Int), Common) ;
if (Puser != (Int *) NULL)
{
KLU_free (Bi, nz+1, sizeof (Int), Common) ;
}
}
else
{
/* ------------------------------------------------------------------ */
/* BTF not requested */
/* ------------------------------------------------------------------ */
nzoff = 0 ;
nblocks = 1 ;
maxblock = n ;
R [0] = 0 ;
R [1] = n ;
Lnz [0] = EMPTY ;
/* ------------------------------------------------------------------ */
/* P = Puser, or identity if Puser is NULL */
/* ------------------------------------------------------------------ */
for (k = 0 ; k < n ; k++)
{
P [k] = (Puser == NULL) ? k : Puser [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* return the symbolic object */
/* ---------------------------------------------------------------------- */
Symbolic->nblocks = nblocks ;
Symbolic->maxblock = maxblock ;
Symbolic->lnz = EMPTY ;
Symbolic->unz = EMPTY ;
Symbolic->nzoff = nzoff ;
return (Symbolic) ;
}

60
src/maths/KLU/klu_defaults.c
View File

@ -1,60 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_defaults: default parameters for KLU
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Sets default parameters for KLU */
#include "klu_internal.h"
int KLU_defaults
(
KLU_common *Common
)
{
if (Common == NULL)
{
return (FALSE) ;
}
/* parameters */
Common->tol = 0.001 ; /* pivot tolerance for diagonal */
Common->memgrow = 1.2; /* realloc size ratio increase for LU factors */
Common->initmem_amd = 1.2 ; /* init. mem with AMD: c*nnz(L) + n */
Common->initmem = 10 ; /* init. mem otherwise: c*nnz(A) + n */
Common->btf = TRUE ; /* use BTF pre-ordering, or not */
Common->maxwork = 0 ; /* no limit to work done by btf_order */
Common->ordering = 0 ; /* 0: AMD, 1: COLAMD, 2: user-provided P and Q,
* 3: user-provided function */
Common->scale = 2 ; /* scale: -1: none, and do not check for errors
* in the input matrix in KLU_refactor.
* 0: none, but check for errors,
* 1: sum, 2: max */
Common->halt_if_singular = TRUE ; /* quick halt if matrix is singular */
/* user ordering function and optional argument */
Common->user_order = NULL ;
Common->user_data = NULL ;
/* statistics */
Common->status = KLU_OK ;
Common->nrealloc = 0 ;
Common->structural_rank = EMPTY ;
Common->numerical_rank = EMPTY ;
Common->noffdiag = EMPTY ;
Common->flops = EMPTY ;
Common->rcond = EMPTY ;
Common->condest = EMPTY ;
Common->rgrowth = EMPTY ;
Common->work = 0 ; /* work done by btf_order */
Common->memusage = 0 ;
Common->mempeak = 0 ;
return (TRUE) ;
}

574
src/maths/KLU/klu_diagnostics.c
View File

@ -1,574 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_diagnostics: linear algebraic diagnostics
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Linear algebraic diagnostics:
* KLU_rgrowth: reciprocal pivot growth, takes O(|A|+|U|) time
* KLU_condest: condition number estimator, takes about O(|A|+5*(|L|+|U|)) time
* KLU_flops: compute # flops required to factorize A into L*U
* KLU_rcond: compute a really cheap estimate of the reciprocal of the
* condition number, min(abs(diag(U))) / max(abs(diag(U))).
* Takes O(n) time.
*/
#include "klu_internal.h"
/* ========================================================================== */
/* === KLU_rgrowth ========================================================== */
/* ========================================================================== */
/* Compute the reciprocal pivot growth factor. In MATLAB notation:
*
* rgrowth = min (max (abs ((R \ A (p,q)) - F))) ./ max (abs (U)))
*/
int KLU_rgrowth /* return TRUE if successful, FALSE otherwise */
(
Int *Ap,
Int *Ai,
double *Ax,
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
KLU_common *Common
)
{
double temp, max_ai, max_ui, min_block_rgrowth ;
Entry aik ;
Int *Q, *Ui, *Uip, *Ulen, *Pinv ;
Unit *LU ;
Entry *Aentry, *Ux, *Ukk ;
double *Rs ;
Int i, newrow, oldrow, k1, k2, nk, j, oldcol, k, pend, len ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
if (Symbolic == NULL || Ap == NULL || Ai == NULL || Ax == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
if (Numeric == NULL)
{
/* treat this as a singular matrix */
Common->rgrowth = 0 ;
Common->status = KLU_SINGULAR ;
return (TRUE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* compute the reciprocal pivot growth */
/* ---------------------------------------------------------------------- */
Aentry = (Entry *) Ax ;
Pinv = Numeric->Pinv ;
Rs = Numeric->Rs ;
Q = Symbolic->Q ;
Common->rgrowth = 1 ;
for (i = 0 ; i < Symbolic->nblocks ; i++)
{
k1 = Symbolic->R[i] ;
k2 = Symbolic->R[i+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
continue ; /* skip singleton blocks */
}
LU = (Unit *) Numeric->LUbx[i] ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
Ukk = ((Entry *) Numeric->Udiag) + k1 ;
min_block_rgrowth = 1 ;
for (j = 0 ; j < nk ; j++)
{
max_ai = 0 ;
max_ui = 0 ;
oldcol = Q[j + k1] ;
pend = Ap [oldcol + 1] ;
for (k = Ap [oldcol] ; k < pend ; k++)
{
oldrow = Ai [k] ;
newrow = Pinv [oldrow] ;
if (newrow < k1)
{
continue ; /* skip entry outside the block */
}
ASSERT (newrow < k2) ;
if (Rs != NULL)
{
/* aik = Aentry [k] / Rs [oldrow] */
SCALE_DIV_ASSIGN (aik, Aentry [k], Rs [newrow]) ;
}
else
{
aik = Aentry [k] ;
}
/* temp = ABS (aik) */
ABS (temp, aik) ;
if (temp > max_ai)
{
max_ai = temp ;
}
}
/* Ui is set but not used. This is OK, because otherwise the macro
would have to be redesigned. */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, j, len) ;
for (k = 0 ; k < len ; k++)
{
/* temp = ABS (Ux [k]) */
ABS (temp, Ux [k]) ;
if (temp > max_ui)
{
max_ui = temp ;
}
}
/* consider the diagonal element */
ABS (temp, Ukk [j]) ;
if (temp > max_ui)
{
max_ui = temp ;
}
/* if max_ui is 0, skip the column */
if (SCALAR_IS_ZERO (max_ui))
{
continue ;
}
temp = max_ai / max_ui ;
if (temp < min_block_rgrowth)
{
min_block_rgrowth = temp ;
}
}
if (min_block_rgrowth < Common->rgrowth)
{
Common->rgrowth = min_block_rgrowth ;
}
}
return (TRUE) ;
}
/* ========================================================================== */
/* === KLU_condest ========================================================== */
/* ========================================================================== */
/* Estimate the condition number. Uses Higham and Tisseur's algorithm
* (A block algorithm for matrix 1-norm estimation, with applications to
* 1-norm pseudospectra, SIAM J. Matrix Anal. Appl., 21(4):1185-1201, 2000.
*/
int KLU_condest /* return TRUE if successful, FALSE otherwise */
(
Int Ap [ ],
double Ax [ ],
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
KLU_common *Common
)
{
double xj, Xmax, csum, anorm, ainv_norm, est_old, est_new, abs_value ;
Entry *Udiag, *Aentry, *X, *S ;
Int i, j, jmax, jnew, pend, n ;
#ifndef COMPLEX
Int unchanged ;
#endif
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
if (Symbolic == NULL || Ap == NULL || Ax == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
abs_value = 0 ;
if (Numeric == NULL)
{
/* treat this as a singular matrix */
Common->condest = 1 / abs_value ;
Common->status = KLU_SINGULAR ;
return (TRUE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
n = Symbolic->n ;
Udiag = Numeric->Udiag ;
/* ---------------------------------------------------------------------- */
/* check if diagonal of U has a zero on it */
/* ---------------------------------------------------------------------- */
for (i = 0 ; i < n ; i++)
{
ABS (abs_value, Udiag [i]) ;
if (SCALAR_IS_ZERO (abs_value))
{
Common->condest = 1 / abs_value ;
Common->status = KLU_SINGULAR ;
return (TRUE) ;
}
}
/* ---------------------------------------------------------------------- */
/* compute 1-norm (maximum column sum) of the matrix */
/* ---------------------------------------------------------------------- */
anorm = 0.0 ;
Aentry = (Entry *) Ax ;
for (i = 0 ; i < n ; i++)
{
pend = Ap [i + 1] ;
csum = 0.0 ;
for (j = Ap [i] ; j < pend ; j++)
{
ABS (abs_value, Aentry [j]) ;
csum += abs_value ;
}
if (csum > anorm)
{
anorm = csum ;
}
}
/* ---------------------------------------------------------------------- */
/* compute estimate of 1-norm of inv (A) */
/* ---------------------------------------------------------------------- */
/* get workspace (size 2*n Entry's) */
X = Numeric->Xwork ; /* size n space used in KLU_solve, tsolve */
X += n ; /* X is size n */
S = X + n ; /* S is size n */
for (i = 0 ; i < n ; i++)
{
CLEAR (S [i]) ;
CLEAR (X [i]) ;
REAL (X [i]) = 1.0 / ((double) n) ;
}
jmax = 0 ;
ainv_norm = 0.0 ;
for (i = 0 ; i < 5 ; i++)
{
if (i > 0)
{
/* X [jmax] is the largest entry in X */
for (j = 0 ; j < n ; j++)
{
/* X [j] = 0 ;*/
CLEAR (X [j]) ;
}
REAL (X [jmax]) = 1 ;
}
KLU_solve (Symbolic, Numeric, n, 1, (double *) X, Common) ;
est_old = ainv_norm ;
ainv_norm = 0.0 ;
for (j = 0 ; j < n ; j++)
{
/* ainv_norm += ABS (X [j]) ;*/
ABS (abs_value, X [j]) ;
ainv_norm += abs_value ;
}
#ifndef COMPLEX
unchanged = TRUE ;
for (j = 0 ; j < n ; j++)
{
double s = (X [j] >= 0) ? 1 : -1 ;
if (s != (Int) REAL (S [j]))
{
S [j] = s ;
unchanged = FALSE ;
}
}
if (i > 0 && (ainv_norm <= est_old || unchanged))
{
break ;
}
#else
for (j = 0 ; j < n ; j++)
{
if (IS_NONZERO (X [j]))
{
ABS (abs_value, X [j]) ;
SCALE_DIV_ASSIGN (S [j], X [j], abs_value) ;
}
else
{
CLEAR (S [j]) ;
REAL (S [j]) = 1 ;
}
}
if (i > 0 && ainv_norm <= est_old)
{
break ;
}
#endif
for (j = 0 ; j < n ; j++)
{
X [j] = S [j] ;
}
#ifndef COMPLEX
/* do a transpose solve */
KLU_tsolve (Symbolic, Numeric, n, 1, X, Common) ;
#else
/* do a conjugate transpose solve */
KLU_tsolve (Symbolic, Numeric, n, 1, (double *) X, 1, Common) ;
#endif
/* jnew = the position of the largest entry in X */
jnew = 0 ;
Xmax = 0 ;
for (j = 0 ; j < n ; j++)
{
/* xj = ABS (X [j]) ;*/
ABS (xj, X [j]) ;
if (xj > Xmax)
{
Xmax = xj ;
jnew = j ;
}
}
if (i > 0 && jnew == jmax)
{
/* the position of the largest entry did not change
* from the previous iteration */
break ;
}
jmax = jnew ;
}
/* ---------------------------------------------------------------------- */
/* compute another estimate of norm(inv(A),1), and take the largest one */
/* ---------------------------------------------------------------------- */
for (j = 0 ; j < n ; j++)
{
CLEAR (X [j]) ;
if (j % 2)
{
REAL (X [j]) = 1 + ((double) j) / ((double) (n-1)) ;
}
else
{
REAL (X [j]) = -1 - ((double) j) / ((double) (n-1)) ;
}
}
KLU_solve (Symbolic, Numeric, n, 1, (double *) X, Common) ;
est_new = 0.0 ;
for (j = 0 ; j < n ; j++)
{
/* est_new += ABS (X [j]) ;*/
ABS (abs_value, X [j]) ;
est_new += abs_value ;
}
est_new = 2 * est_new / (3 * n) ;
ainv_norm = MAX (est_new, ainv_norm) ;
/* ---------------------------------------------------------------------- */
/* compute estimate of condition number */
/* ---------------------------------------------------------------------- */
Common->condest = ainv_norm * anorm ;
return (TRUE) ;
}
/* ========================================================================== */
/* === KLU_flops ============================================================ */
/* ========================================================================== */
/* Compute the flop count for the LU factorization (in Common->flops) */
int KLU_flops /* return TRUE if successful, FALSE otherwise */
(
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
KLU_common *Common
)
{
double flops = 0 ;
Int *R, *Ui, *Uip, *Llen, *Ulen ;
Unit **LUbx ;
Unit *LU ;
Int k, ulen, p, nk, block, nblocks, k1 ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
Common->flops = EMPTY ;
if (Numeric == NULL || Symbolic == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
R = Symbolic->R ;
nblocks = Symbolic->nblocks ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Numeric object */
/* ---------------------------------------------------------------------- */
LUbx = (Unit **) Numeric->LUbx ;
/* ---------------------------------------------------------------------- */
/* compute the flop count */
/* ---------------------------------------------------------------------- */
for (block = 0 ; block < nblocks ; block++)
{
k1 = R [block] ;
nk = R [block+1] - k1 ;
if (nk > 1)
{
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* compute kth column of U, and update kth column of A */
GET_I_POINTER (LU, Uip, Ui, k) ;
ulen = Ulen [k] ;
for (p = 0 ; p < ulen ; p++)
{
flops += 2 * Llen [Ui [p]] ;
}
/* gather and divide by pivot to get kth column of L */
flops += Llen [k] ;
}
}
}
Common->flops = flops ;
return (TRUE) ;
}
/* ========================================================================== */
/* === KLU_rcond ============================================================ */
/* ========================================================================== */
/* Compute a really cheap estimate of the reciprocal of the condition number,
* condition number, min(abs(diag(U))) / max(abs(diag(U))). If U has a zero
* pivot, or a NaN pivot, rcond will be zero. Takes O(n) time.
*/
int KLU_rcond /* return TRUE if successful, FALSE otherwise */
(
KLU_symbolic *Symbolic, /* input, not modified */
KLU_numeric *Numeric, /* input, not modified */
KLU_common *Common /* result in Common->rcond */
)
{
double ukk, umin = 0, umax = 0 ;
Entry *Udiag ;
Int j, n ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
if (Symbolic == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
if (Numeric == NULL)
{
Common->rcond = 0 ;
Common->status = KLU_SINGULAR ;
return (TRUE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* compute rcond */
/* ---------------------------------------------------------------------- */
n = Symbolic->n ;
Udiag = Numeric->Udiag ;
for (j = 0 ; j < n ; j++)
{
/* get the magnitude of the pivot */
ABS (ukk, Udiag [j]) ;
if (SCALAR_IS_NAN (ukk) || SCALAR_IS_ZERO (ukk))
{
/* if NaN, or zero, the rcond is zero */
Common->rcond = 0 ;
Common->status = KLU_SINGULAR ;
return (TRUE) ;
}
if (j == 0)
{
/* first pivot entry */
umin = ukk ;
umax = ukk ;
}
else
{
/* subsequent pivots */
umin = MIN (umin, ukk) ;
umax = MAX (umax, ukk) ;
}
}
Common->rcond = umin / umax ;
if (SCALAR_IS_NAN (Common->rcond) || SCALAR_IS_ZERO (Common->rcond))
{
/* this can occur if umin or umax are Inf or NaN */
Common->rcond = 0 ;
Common->status = KLU_SINGULAR ;
}
return (TRUE) ;
}

153
src/maths/KLU/klu_dump.c
View File

@ -1,153 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_dump: debug routines for KLU
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Debug routines for klu. Only used when NDEBUG is not defined at
* compile-time.
*/
#include "klu_internal.h"
#ifndef NDEBUG
/* ========================================================================== */
/* === KLU_valid ============================================================ */
/* ========================================================================== */
/* Check if a column-form matrix is valid or not. The matrix A is
* n-by-n. The row indices of entries in column j are in
* Ai [Ap [j] ... Ap [j+1]-1]. Required conditions are:
*
* n >= 0
* nz = Ap [n_col] >= 0 number of entries in the matrix
* Ap [0] == 0
* Ap [j] <= Ap [j+1] for all j in the range 0 to n_col.
* row indices in Ai [Ap [j] ... Ap [j+1]-1]
* must be in the range 0 to n_row-1,
* and no duplicate entries can exist (duplicates not checked here).
*
* Not user-callable. Only used when debugging.
*/
Int KLU_valid (Int n, Int Ap [ ], Int Ai [ ], Entry Ax [ ])
{
Int nz, j, p1, p2, i, p ;
PRINTF (("\ncolumn oriented matrix, n = %d\n", n)) ;
if (n <= 0)
{
PRINTF (("n must be >= 0: %d\n", n)) ;
return (FALSE) ;
}
nz = Ap [n] ;
if (Ap [0] != 0 || nz < 0)
{
/* column pointers must start at Ap [0] = 0, and Ap [n] must be >= 0 */
PRINTF (("column 0 pointer bad or nz < 0\n")) ;
return (FALSE) ;
}
for (j = 0 ; j < n ; j++)
{
p1 = Ap [j] ;
p2 = Ap [j+1] ;
PRINTF (("\nColumn: %d p1: %d p2: %d\n", j, p1, p2)) ;
if (p1 > p2)
{
/* column pointers must be ascending */
PRINTF (("column %d pointer bad\n", j)) ;
return (FALSE) ;
}
for (p = p1 ; p < p2 ; p++)
{
i = Ai [p] ;
PRINTF (("row: %d", i)) ;
if (i < 0 || i >= n)
{
/* row index out of range */
PRINTF (("index out of range, col %d row %d\n", j, i)) ;
return (FALSE) ;
}
if (Ax != (Entry *) NULL)
{
PRINT_ENTRY (Ax [p]) ;
}
PRINTF (("\n")) ;
}
}
return (TRUE) ;
}
/* ========================================================================== */
/* === KLU_valid_LU ========================================================= */
/* ========================================================================== */
/* This function does the same validity tests as KLU_valid but for the
* LU factor storage format. The flag flag_test_start_ptr is used to
* test if Xip [0] = 0. This is not applicable for U. So when calling this
* function for U, the flag should be set to false. Only used when debugging.
*/
Int KLU_valid_LU (Int n, Int flag_test_start_ptr, Int Xip [ ],
Int Xlen [ ], Unit LU [ ])
{
Int *Xi ;
Entry *Xx ;
Int j, p1, p2, i, p, len ;
PRINTF (("\ncolumn oriented matrix, n = %d\n", n)) ;
if (n <= 0)
{
PRINTF (("n must be >= 0: %d\n", n)) ;
return (FALSE) ;
}
if (flag_test_start_ptr && Xip [0] != 0)
{
/* column pointers must start at Xip [0] = 0*/
PRINTF (("column 0 pointer bad\n")) ;
return (FALSE) ;
}
for (j = 0 ; j < n ; j++)
{
p1 = Xip [j] ;
PRINTF (("\nColumn of factor: %d p1: %d ", j, p1)) ;
if (j < n-1)
{
p2 = Xip [j+1] ;
PRINTF (("p2: %d ", p2)) ;
if (p1 > p2)
{
/* column pointers must be ascending */
PRINTF (("column %d pointer bad\n", j)) ;
return (FALSE) ;
}
}
PRINTF (("\n")) ;
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
i = Xi [p] ;
PRINTF (("row: %d", i)) ;
if (i < 0 || i >= n)
{
/* row index out of range */
PRINTF (("index out of range, col %d row %d\n", j, i)) ;
return (FALSE) ;
}
if (Xx != (Entry *) NULL)
{
PRINT_ENTRY (Xx [p]) ;
}
PRINTF (("\n")) ;
}
}
return (TRUE) ;
}
#endif

296
src/maths/KLU/klu_extract.c
View File

@ -1,296 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_extract: extract the KLU factorization
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Extract KLU factorization into conventional compressed-column matrices.
* If any output array is NULL, that part of the LU factorization is not
* extracted (this is not an error condition).
*
* nnz(L) = Numeric->lnz, nnz(U) = Numeric->unz, and nnz(F) = Numeric->Offp [n]
*/
#include "klu_internal.h"
int KLU_extract /* returns TRUE if successful, FALSE otherwise */
(
/* inputs: */
KLU_numeric *Numeric,
KLU_symbolic *Symbolic,
/* outputs, all of which must be allocated on input */
/* L */
Int *Lp, /* size n+1 */
Int *Li, /* size nnz(L) */
double *Lx, /* size nnz(L) */
#ifdef COMPLEX
double *Lz, /* size nnz(L) for the complex case, ignored if real */
#endif
/* U */
Int *Up, /* size n+1 */
Int *Ui, /* size nnz(U) */
double *Ux, /* size nnz(U) */
#ifdef COMPLEX
double *Uz, /* size nnz(U) for the complex case, ignored if real */
#endif
/* F */
Int *Fp, /* size n+1 */
Int *Fi, /* size nnz(F) */
double *Fx, /* size nnz(F) */
#ifdef COMPLEX
double *Fz, /* size nnz(F) for the complex case, ignored if real */
#endif
/* P, row permutation */
Int *P, /* size n */
/* Q, column permutation */
Int *Q, /* size n */
/* Rs, scale factors */
double *Rs, /* size n */
/* R, block boundaries */
Int *R, /* size nblocks+1 */
KLU_common *Common
)
{
Int *Lip, *Llen, *Uip, *Ulen, *Li2, *Ui2 ;
Unit *LU ;
Entry *Lx2, *Ux2, *Ukk ;
Int i, k, block, nblocks, n, nz, k1, k2, nk, len, kk, p ;
if (Common == NULL)
{
return (FALSE) ;
}
if (Symbolic == NULL || Numeric == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->status = KLU_OK ;
n = Symbolic->n ;
nblocks = Symbolic->nblocks ;
/* ---------------------------------------------------------------------- */
/* extract scale factors */
/* ---------------------------------------------------------------------- */
if (Rs != NULL)
{
if (Numeric->Rs != NULL)
{
for (i = 0 ; i < n ; i++)
{
Rs [i] = Numeric->Rs [i] ;
}
}
else
{
/* no scaling */
for (i = 0 ; i < n ; i++)
{
Rs [i] = 1 ;
}
}
}
/* ---------------------------------------------------------------------- */
/* extract block boundaries */
/* ---------------------------------------------------------------------- */
if (R != NULL)
{
for (block = 0 ; block <= nblocks ; block++)
{
R [block] = Symbolic->R [block] ;
}
}
/* ---------------------------------------------------------------------- */
/* extract final row permutation */
/* ---------------------------------------------------------------------- */
if (P != NULL)
{
for (k = 0 ; k < n ; k++)
{
P [k] = Numeric->Pnum [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* extract column permutation */
/* ---------------------------------------------------------------------- */
if (Q != NULL)
{
for (k = 0 ; k < n ; k++)
{
Q [k] = Symbolic->Q [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* extract each block of L */
/* ---------------------------------------------------------------------- */
if (Lp != NULL && Li != NULL && Lx != NULL
#ifdef COMPLEX
&& Lz != NULL
#endif
)
{
nz = 0 ;
for (block = 0 ; block < nblocks ; block++)
{
k1 = Symbolic->R [block] ;
k2 = Symbolic->R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* singleton block */
Lp [k1] = nz ;
Li [nz] = k1 ;
Lx [nz] = 1 ;
#ifdef COMPLEX
Lz [nz] = 0 ;
#endif
nz++ ;
}
else
{
/* non-singleton block */
LU = Numeric->LUbx [block] ;
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
for (kk = 0 ; kk < nk ; kk++)
{
Lp [k1+kk] = nz ;
/* add the unit diagonal entry */
Li [nz] = k1 + kk ;
Lx [nz] = 1 ;
#ifdef COMPLEX
Lz [nz] = 0 ;
#endif
nz++ ;
GET_POINTER (LU, Lip, Llen, Li2, Lx2, kk, len) ;
for (p = 0 ; p < len ; p++)
{
Li [nz] = k1 + Li2 [p] ;
Lx [nz] = REAL (Lx2 [p]) ;
#ifdef COMPLEX
Lz [nz] = IMAG (Lx2 [p]) ;
#endif
nz++ ;
}
}
}
}
Lp [n] = nz ;
ASSERT (nz == Numeric->lnz) ;
}
/* ---------------------------------------------------------------------- */
/* extract each block of U */
/* ---------------------------------------------------------------------- */
if (Up != NULL && Ui != NULL && Ux != NULL
#ifdef COMPLEX
&& Uz != NULL
#endif
)
{
nz = 0 ;
for (block = 0 ; block < nblocks ; block++)
{
k1 = Symbolic->R [block] ;
k2 = Symbolic->R [block+1] ;
nk = k2 - k1 ;
Ukk = ((Entry *) Numeric->Udiag) + k1 ;
if (nk == 1)
{
/* singleton block */
Up [k1] = nz ;
Ui [nz] = k1 ;
Ux [nz] = REAL (Ukk [0]) ;
#ifdef COMPLEX
Uz [nz] = IMAG (Ukk [0]) ;
#endif
nz++ ;
}
else
{
/* non-singleton block */
LU = Numeric->LUbx [block] ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
for (kk = 0 ; kk < nk ; kk++)
{
Up [k1+kk] = nz ;
GET_POINTER (LU, Uip, Ulen, Ui2, Ux2, kk, len) ;
for (p = 0 ; p < len ; p++)
{
Ui [nz] = k1 + Ui2 [p] ;
Ux [nz] = REAL (Ux2 [p]) ;
#ifdef COMPLEX
Uz [nz] = IMAG (Ux2 [p]) ;
#endif
nz++ ;
}
/* add the diagonal entry */
Ui [nz] = k1 + kk ;
Ux [nz] = REAL (Ukk [kk]) ;
#ifdef COMPLEX
Uz [nz] = IMAG (Ukk [kk]) ;
#endif
nz++ ;
}
}
}
Up [n] = nz ;
ASSERT (nz == Numeric->unz) ;
}
/* ---------------------------------------------------------------------- */
/* extract the off-diagonal blocks, F */
/* ---------------------------------------------------------------------- */
if (Fp != NULL && Fi != NULL && Fx != NULL
#ifdef COMPLEX
&& Fz != NULL
#endif
)
{
for (k = 0 ; k <= n ; k++)
{
Fp [k] = Numeric->Offp [k] ;
}
nz = Fp [n] ;
for (k = 0 ; k < nz ; k++)
{
Fi [k] = Numeric->Offi [k] ;
}
for (k = 0 ; k < nz ; k++)
{
Fx [k] = REAL (((Entry *) Numeric->Offx) [k]) ;
#ifdef COMPLEX
Fz [k] = IMAG (((Entry *) Numeric->Offx) [k]) ;
#endif
}
}
return (TRUE) ;
}

549
src/maths/KLU/klu_factor.c
View File

@ -1,549 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_factor: sparse LU factorization
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Factor the matrix, after ordering and analyzing it with KLU_analyze
* or KLU_analyze_given.
*/
#include "klu_internal.h"
/* ========================================================================== */
/* === KLU_factor2 ========================================================== */
/* ========================================================================== */
static void factor2
(
/* inputs, not modified */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
Entry Ax [ ],
KLU_symbolic *Symbolic,
/* inputs, modified on output: */
KLU_numeric *Numeric,
KLU_common *Common
)
{
double lsize ;
double *Lnz, *Rs ;
Int *P, *Q, *R, *Pnum, *Offp, *Offi, *Pblock, *Pinv, *Iwork,
*Lip, *Uip, *Llen, *Ulen ;
Entry *Offx, *X, s, *Udiag ;
Unit **LUbx ;
Int k1, k2, nk, k, block, oldcol, pend, oldrow, n, lnz, unz, p, newrow,
nblocks, poff, nzoff, lnz_block, unz_block, scale, max_lnz_block,
max_unz_block ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
n = Symbolic->n ;
P = Symbolic->P ;
Q = Symbolic->Q ;
R = Symbolic->R ;
Lnz = Symbolic->Lnz ;
nblocks = Symbolic->nblocks ;
nzoff = Symbolic->nzoff ;
Pnum = Numeric->Pnum ;
Offp = Numeric->Offp ;
Offi = Numeric->Offi ;
Offx = (Entry *) Numeric->Offx ;
Lip = Numeric->Lip ;
Uip = Numeric->Uip ;
Llen = Numeric->Llen ;
Ulen = Numeric->Ulen ;
LUbx = (Unit **) Numeric->LUbx ;
Udiag = Numeric->Udiag ;
Rs = Numeric->Rs ;
Pinv = Numeric->Pinv ;
X = (Entry *) Numeric->Xwork ; /* X is of size n */
Iwork = Numeric->Iwork ; /* 5*maxblock for KLU_factor */
/* 1*maxblock for Pblock */
Pblock = Iwork + 5*((size_t) Symbolic->maxblock) ;
Common->nrealloc = 0 ;
scale = Common->scale ;
max_lnz_block = 1 ;
max_unz_block = 1 ;
/* compute the inverse of P from symbolic analysis. Will be updated to
* become the inverse of the numerical factorization when the factorization
* is done, for use in KLU_refactor */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
Pinv [k] = EMPTY ;
}
#endif
for (k = 0 ; k < n ; k++)
{
ASSERT (P [k] >= 0 && P [k] < n) ;
Pinv [P [k]] = k ;
}
#ifndef NDEBUG
for (k = 0 ; k < n ; k++) ASSERT (Pinv [k] != EMPTY) ;
#endif
lnz = 0 ;
unz = 0 ;
Common->noffdiag = 0 ;
Offp [0] = 0 ;
/* ---------------------------------------------------------------------- */
/* optionally check input matrix and compute scale factors */
/* ---------------------------------------------------------------------- */
if (scale >= 0)
{
/* use Pnum as workspace. NOTE: scale factors are not yet permuted
* according to the final pivot row ordering, so Rs [oldrow] is the
* scale factor for A (oldrow,:), for the user's matrix A. Pnum is
* used as workspace in KLU_scale. When the factorization is done,
* the scale factors are permuted according to the final pivot row
* permutation, so that Rs [k] is the scale factor for the kth row of
* A(p,q) where p and q are the final row and column permutations. */
KLU_scale (scale, n, Ap, Ai, (double *) Ax, Rs, Pnum, Common) ;
if (Common->status < KLU_OK)
{
/* matrix is invalid */
return ;
}
}
#ifndef NDEBUG
if (scale > 0)
{
for (k = 0 ; k < n ; k++) PRINTF (("Rs [%d] %g\n", k, Rs [k])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* factor each block using klu */
/* ---------------------------------------------------------------------- */
for (block = 0 ; block < nblocks ; block++)
{
/* ------------------------------------------------------------------ */
/* the block is from rows/columns k1 to k2-1 */
/* ------------------------------------------------------------------ */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("FACTOR BLOCK %d, k1 %d k2-1 %d nk %d\n", block, k1,k2-1,nk)) ;
if (nk == 1)
{
/* -------------------------------------------------------------- */
/* singleton case */
/* -------------------------------------------------------------- */
poff = Offp [k1] ;
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
if (scale <= 0)
{
/* no scaling */
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] ;
if (newrow < k1)
{
Offi [poff] = oldrow ;
Offx [poff] = Ax [p] ;
poff++ ;
}
else
{
ASSERT (newrow == k1) ;
PRINTF (("singleton block %d", block)) ;
PRINT_ENTRY (Ax [p]) ;
s = Ax [p] ;
}
}
}
else
{
/* row scaling. NOTE: scale factors are not yet permuted
* according to the pivot row permutation, so Rs [oldrow] is
* used below. When the factorization is done, the scale
* factors are permuted, so that Rs [newrow] will be used in
* klu_solve, klu_tsolve, and klu_rgrowth */
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] ;
if (newrow < k1)
{
Offi [poff] = oldrow ;
/* Offx [poff] = Ax [p] / Rs [oldrow] ; */
SCALE_DIV_ASSIGN (Offx [poff], Ax [p], Rs [oldrow]) ;
poff++ ;
}
else
{
ASSERT (newrow == k1) ;
PRINTF (("singleton block %d ", block)) ;
PRINT_ENTRY (Ax[p]) ;
SCALE_DIV_ASSIGN (s, Ax [p], Rs [oldrow]) ;
}
}
}
Udiag [k1] = s ;
if (IS_ZERO (s))
{
/* singular singleton */
Common->status = KLU_SINGULAR ;
Common->numerical_rank = k1 ;
Common->singular_col = oldcol ;
if (Common->halt_if_singular)
{
return ;
}
}
Offp [k1+1] = poff ;
Pnum [k1] = P [k1] ;
lnz++ ;
unz++ ;
}
else
{
/* -------------------------------------------------------------- */
/* construct and factorize the kth block */
/* -------------------------------------------------------------- */
if (Lnz [block] < 0)
{
/* COLAMD was used - no estimate of fill-in */
/* use 10 times the nnz in A, plus n */
lsize = -(Common->initmem) ;
}
else
{
lsize = Common->initmem_amd * Lnz [block] + nk ;
}
/* allocates 1 arrays: LUbx [block] */
Numeric->LUsize [block] = KLU_kernel_factor (nk, Ap, Ai, Ax, Q,
lsize, &LUbx [block], Udiag + k1, Llen + k1, Ulen + k1,
Lip + k1, Uip + k1, Pblock, &lnz_block, &unz_block,
X, Iwork, k1, Pinv, Rs, Offp, Offi, Offx, Common) ;
if (Common->status < KLU_OK ||
(Common->status == KLU_SINGULAR && Common->halt_if_singular))
{
/* out of memory, invalid inputs, or singular */
return ;
}
PRINTF (("\n----------------------- L %d:\n", block)) ;
ASSERT (KLU_valid_LU (nk, TRUE, Lip+k1, Llen+k1, LUbx [block])) ;
PRINTF (("\n----------------------- U %d:\n", block)) ;
ASSERT (KLU_valid_LU (nk, FALSE, Uip+k1, Ulen+k1, LUbx [block])) ;
/* -------------------------------------------------------------- */
/* get statistics */
/* -------------------------------------------------------------- */
lnz += lnz_block ;
unz += unz_block ;
max_lnz_block = MAX (max_lnz_block, lnz_block) ;
max_unz_block = MAX (max_unz_block, unz_block) ;
if (Lnz [block] == EMPTY)
{
/* revise estimate for subsequent factorization */
Lnz [block] = MAX (lnz_block, unz_block) ;
}
/* -------------------------------------------------------------- */
/* combine the klu row ordering with the symbolic pre-ordering */
/* -------------------------------------------------------------- */
PRINTF (("Pnum, 1-based:\n")) ;
for (k = 0 ; k < nk ; k++)
{
ASSERT (k + k1 < n) ;
ASSERT (Pblock [k] + k1 < n) ;
Pnum [k + k1] = P [Pblock [k] + k1] ;
PRINTF (("Pnum (%d + %d + 1 = %d) = %d + 1 = %d\n",
k, k1, k+k1+1, Pnum [k+k1], Pnum [k+k1]+1)) ;
}
/* the local pivot row permutation Pblock is no longer needed */
}
}
ASSERT (nzoff == Offp [n]) ;
PRINTF (("\n------------------- Off diagonal entries:\n")) ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
Numeric->lnz = lnz ;
Numeric->unz = unz ;
Numeric->max_lnz_block = max_lnz_block ;
Numeric->max_unz_block = max_unz_block ;
/* compute the inverse of Pnum */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
Pinv [k] = EMPTY ;
}
#endif
for (k = 0 ; k < n ; k++)
{
ASSERT (Pnum [k] >= 0 && Pnum [k] < n) ;
Pinv [Pnum [k]] = k ;
}
#ifndef NDEBUG
for (k = 0 ; k < n ; k++) ASSERT (Pinv [k] != EMPTY) ;
#endif
/* permute scale factors Rs according to pivotal row order */
if (scale > 0)
{
for (k = 0 ; k < n ; k++)
{
REAL (X [k]) = Rs [Pnum [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Rs [k] = REAL (X [k]) ;
}
}
PRINTF (("\n------------------- Off diagonal entries, old:\n")) ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
/* apply the pivot row permutations to the off-diagonal entries */
for (p = 0 ; p < nzoff ; p++)
{
ASSERT (Offi [p] >= 0 && Offi [p] < n) ;
Offi [p] = Pinv [Offi [p]] ;
}
PRINTF (("\n------------------- Off diagonal entries, new:\n")) ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
#ifndef NDEBUG
{
PRINTF (("\n ------------ KLU_BTF_FACTOR done, nblocks %d\n",nblocks));
Entry ss, *Udiag = Numeric->Udiag ;
for (block = 0 ; block < nblocks && Common->status == KLU_OK ; block++)
{
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("\n== KLU_factor output: k1 %d k2 %d nk %d\n",k1,k2,nk)) ;
if (nk == 1)
{
PRINTF (("singleton ")) ;
/* ENTRY_PRINT (singleton [block]) ; */
ss = Udiag [k1] ;
PRINT_ENTRY (ss) ;
}
else
{
Int *Lip, *Uip, *Llen, *Ulen ;
Unit *LU ;
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
LU = (Unit *) Numeric->LUbx [block] ;
PRINTF (("\n---- L block %d\n", block));
ASSERT (KLU_valid_LU (nk, TRUE, Lip, Llen, LU)) ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
PRINTF (("\n---- U block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, FALSE, Uip, Ulen, LU)) ;
}
}
}
#endif
}
/* ========================================================================== */
/* === KLU_factor =========================================================== */
/* ========================================================================== */
KLU_numeric *KLU_factor /* returns NULL if error, or a valid
KLU_numeric object if successful */
(
/* --- inputs --- */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
double Ax [ ],
KLU_symbolic *Symbolic,
/* -------------- */
KLU_common *Common
)
{
Int n, nzoff, nblocks, maxblock, k, ok = TRUE ;
KLU_numeric *Numeric ;
size_t n1, nzoff1, s, b6, n3 ;
if (Common == NULL)
{
return (NULL) ;
}
Common->status = KLU_OK ;
Common->numerical_rank = EMPTY ;
Common->singular_col = EMPTY ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
/* check for a valid Symbolic object */
if (Symbolic == NULL)
{
Common->status = KLU_INVALID ;
return (NULL) ;
}
n = Symbolic->n ;
nzoff = Symbolic->nzoff ;
nblocks = Symbolic->nblocks ;
maxblock = Symbolic->maxblock ;
PRINTF (("KLU_factor: n %d nzoff %d nblocks %d maxblock %d\n",
n, nzoff, nblocks, maxblock)) ;
/* ---------------------------------------------------------------------- */
/* get control parameters and make sure they are in the proper range */
/* ---------------------------------------------------------------------- */
Common->initmem_amd = MAX (1.0, Common->initmem_amd) ;
Common->initmem = MAX (1.0, Common->initmem) ;
Common->tol = MIN (Common->tol, 1.0) ;
Common->tol = MAX (0.0, Common->tol) ;
Common->memgrow = MAX (1.0, Common->memgrow) ;
/* ---------------------------------------------------------------------- */
/* allocate the Numeric object */
/* ---------------------------------------------------------------------- */
/* this will not cause size_t overflow (already checked by KLU_symbolic) */
n1 = ((size_t) n) + 1 ;
nzoff1 = ((size_t) nzoff) + 1 ;
Numeric = KLU_malloc (1, sizeof (KLU_numeric), Common) ;
if (Common->status < KLU_OK)
{
/* out of memory */
Common->status = KLU_OUT_OF_MEMORY ;
return (NULL) ;
}
Numeric->n = n ;
Numeric->nblocks = nblocks ;
Numeric->nzoff = nzoff ;
Numeric->Pnum = KLU_malloc (n, sizeof (Int), Common) ;
Numeric->Offp = KLU_malloc (n1, sizeof (Int), Common) ;
Numeric->Offi = KLU_malloc (nzoff1, sizeof (Int), Common) ;
Numeric->Offx = KLU_malloc (nzoff1, sizeof (Entry), Common) ;
Numeric->Lip = KLU_malloc (n, sizeof (Int), Common) ;
Numeric->Uip = KLU_malloc (n, sizeof (Int), Common) ;
Numeric->Llen = KLU_malloc (n, sizeof (Int), Common) ;
Numeric->Ulen = KLU_malloc (n, sizeof (Int), Common) ;
Numeric->LUsize = KLU_malloc (nblocks, sizeof (size_t), Common) ;
Numeric->LUbx = KLU_malloc (nblocks, sizeof (Unit *), Common) ;
if (Numeric->LUbx != NULL)
{
for (k = 0 ; k < nblocks ; k++)
{
Numeric->LUbx [k] = NULL ;
}
}
Numeric->Udiag = KLU_malloc (n, sizeof (Entry), Common) ;
if (Common->scale > 0)
{
Numeric->Rs = KLU_malloc (n, sizeof (double), Common) ;
}
else
{
/* no scaling */
Numeric->Rs = NULL ;
}
Numeric->Pinv = KLU_malloc (n, sizeof (Int), Common) ;
/* allocate permanent workspace for factorization and solve. Note that the
* solver will use an Xwork of size 4n, whereas the factorization codes use
* an Xwork of size n and integer space (Iwork) of size 6n. KLU_condest
* uses an Xwork of size 2n. Total size is:
*
* n*sizeof(Entry) + max (6*maxblock*sizeof(Int), 3*n*sizeof(Entry))
*/
s = KLU_mult_size_t (n, sizeof (Entry), &ok) ;
n3 = KLU_mult_size_t (n, 3 * sizeof (Entry), &ok) ;
b6 = KLU_mult_size_t (maxblock, 6 * sizeof (Int), &ok) ;
Numeric->worksize = KLU_add_size_t (s, MAX (n3, b6), &ok) ;
Numeric->Work = KLU_malloc (Numeric->worksize, 1, Common) ;
Numeric->Xwork = Numeric->Work ;
Numeric->Iwork = (Int *) ((Entry *) Numeric->Xwork + n) ;
if (!ok || Common->status < KLU_OK)
{
/* out of memory or problem too large */
Common->status = ok ? KLU_OUT_OF_MEMORY : KLU_TOO_LARGE ;
KLU_free_numeric (&Numeric, Common) ;
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* factorize the blocks */
/* ---------------------------------------------------------------------- */
factor2 (Ap, Ai, (Entry *) Ax, Symbolic, Numeric, Common) ;
/* ---------------------------------------------------------------------- */
/* return or free the Numeric object */
/* ---------------------------------------------------------------------- */
if (Common->status < KLU_OK)
{
/* out of memory or inputs invalid */
KLU_free_numeric (&Numeric, Common) ;
}
else if (Common->status == KLU_SINGULAR)
{
if (Common->halt_if_singular)
{
/* Matrix is singular, and the Numeric object is only partially
* defined because we halted early. This is the default case for
* a singular matrix. */
KLU_free_numeric (&Numeric, Common) ;
}
}
else if (Common->status == KLU_OK)
{
/* successful non-singular factorization */
Common->numerical_rank = n ;
Common->singular_col = n ;
}
return (Numeric) ;
}

77
src/maths/KLU/klu_free_numeric.c
View File

@ -1,77 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_free_numeric: free the KLU numeric factorization
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Free the KLU Numeric object. */
#include "klu_internal.h"
int KLU_free_numeric
(
KLU_numeric **NumericHandle,
KLU_common *Common
)
{
KLU_numeric *Numeric ;
Unit **LUbx ;
size_t *LUsize ;
Int block, n, nzoff, nblocks ;
if (Common == NULL)
{
return (FALSE) ;
}
if (NumericHandle == NULL || *NumericHandle == NULL)
{
return (TRUE) ;
}
Numeric = *NumericHandle ;
n = Numeric->n ;
nzoff = Numeric->nzoff ;
nblocks = Numeric->nblocks ;
LUsize = Numeric->LUsize ;
LUbx = (Unit **) Numeric->LUbx ;
if (LUbx != NULL)
{
for (block = 0 ; block < nblocks ; block++)
{
KLU_free (LUbx [block], LUsize ? LUsize [block] : 0,
sizeof (Unit), Common) ;
}
}
KLU_free (Numeric->Pnum, n, sizeof (Int), Common) ;
KLU_free (Numeric->Offp, n+1, sizeof (Int), Common) ;
KLU_free (Numeric->Offi, nzoff+1, sizeof (Int), Common) ;
KLU_free (Numeric->Offx, nzoff+1, sizeof (Entry), Common) ;
KLU_free (Numeric->Lip, n, sizeof (Int), Common) ;
KLU_free (Numeric->Llen, n, sizeof (Int), Common) ;
KLU_free (Numeric->Uip, n, sizeof (Int), Common) ;
KLU_free (Numeric->Ulen, n, sizeof (Int), Common) ;
KLU_free (Numeric->LUsize, nblocks, sizeof (size_t), Common) ;
KLU_free (Numeric->LUbx, nblocks, sizeof (Unit *), Common) ;
KLU_free (Numeric->Udiag, n, sizeof (Entry), Common) ;
KLU_free (Numeric->Rs, n, sizeof (double), Common) ;
KLU_free (Numeric->Pinv, n, sizeof (Int), Common) ;
KLU_free (Numeric->Work, Numeric->worksize, 1, Common) ;
KLU_free (Numeric, 1, sizeof (KLU_numeric), Common) ;
*NumericHandle = NULL ;
return (TRUE) ;
}

40
src/maths/KLU/klu_free_symbolic.c
View File

@ -1,40 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_free_symbolic: free the KLU symbolic analysis
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Free the KLU Symbolic object. */
#include "klu_internal.h"
int KLU_free_symbolic
(
KLU_symbolic **SymbolicHandle,
KLU_common *Common
)
{
KLU_symbolic *Symbolic ;
Int n ;
if (Common == NULL)
{
return (FALSE) ;
}
if (SymbolicHandle == NULL || *SymbolicHandle == NULL)
{
return (TRUE) ;
}
Symbolic = *SymbolicHandle ;
n = Symbolic->n ;
KLU_free (Symbolic->P, n, sizeof (Int), Common) ;
KLU_free (Symbolic->Q, n, sizeof (Int), Common) ;
KLU_free (Symbolic->R, n+1, sizeof (Int), Common) ;
KLU_free (Symbolic->Lnz, n, sizeof (double), Common) ;
KLU_free (Symbolic, 1, sizeof (KLU_symbolic), Common) ;
*SymbolicHandle = NULL ;
return (TRUE) ;
}

4
src/maths/KLU/klu_internal.h
View File

@ -13,8 +13,8 @@
#ifndef _KLU_INTERNAL_H
#define _KLU_INTERNAL_H
#include "ngspice/klu.h"
#include "ngspice/btf.h"
#include <suitesparse/klu.h>
#include <suitesparse/btf.h>
#include "klu_version.h"
/* ========================================================================== */

1016
src/maths/KLU/klu_kernel.c
View File

File diff suppressed because it is too large Load Diff

222
src/maths/KLU/klu_memory.c
View File

@ -1,222 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_memory: memory management for KLU
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* KLU memory management routines:
*
* KLU_malloc malloc wrapper
* KLU_free free wrapper
* KLU_realloc realloc wrapper
*/
#include "klu_internal.h"
/* ========================================================================== */
/* === KLU_add_size_t ======================================================= */
/* ========================================================================== */
/* Safely compute a+b, and check for size_t overflow */
size_t KLU_add_size_t (size_t a, size_t b, Int *ok)
{
(*ok) = (*ok) && ((a + b) >= MAX (a,b)) ;
return ((*ok) ? (a + b) : ((size_t) -1)) ;
}
/* ========================================================================== */
/* === KLU_mult_size_t ====================================================== */
/* ========================================================================== */
/* Safely compute a*k, where k should be small, and check for size_t overflow */
size_t KLU_mult_size_t (size_t a, size_t k, Int *ok)
{
size_t i, s = 0 ;
for (i = 0 ; i < k ; i++)
{
s = KLU_add_size_t (s, a, ok) ;
}
return ((*ok) ? s : ((size_t) -1)) ;
}
/* ========================================================================== */
/* === KLU_malloc =========================================================== */
/* ========================================================================== */
/* Wrapper around malloc routine (mxMalloc for a mexFunction). Allocates
* space of size MAX(1,n)*size, where size is normally a sizeof (...).
*
* This routine and KLU_realloc do not set Common->status to KLU_OK on success,
* so that a sequence of KLU_malloc's or KLU_realloc's can be used. If any of
* them fails, the Common->status will hold the most recent error status.
*
* Usage, for a pointer to Int:
*
* p = KLU_malloc (n, sizeof (Int), Common)
*
* Uses a pointer to the malloc routine (or its equivalent) defined in Common.
*/
void *KLU_malloc /* returns pointer to the newly malloc'd block */
(
/* ---- input ---- */
size_t n, /* number of items */
size_t size, /* size of each item */
/* --------------- */
KLU_common *Common
)
{
void *p ;
if (Common == NULL)
{
p = NULL ;
}
else if (size == 0)
{
/* size must be > 0 */
Common->status = KLU_INVALID ;
p = NULL ;
}
else if (sizeof (size_t) > sizeof (Int) && n >= Int_MAX)
{
/* object is too big to allocate; p[i] where i is an Int will not
* be enough. */
Common->status = KLU_TOO_LARGE ;
p = NULL ;
}
else
{
/* call malloc, or its equivalent */
p = SuiteSparse_malloc (n, size) ;
if (p == NULL)
{
/* failure: out of memory */
Common->status = KLU_OUT_OF_MEMORY ;
}
else
{
Common->memusage += (MAX (1,n) * size) ;
Common->mempeak = MAX (Common->mempeak, Common->memusage) ;
}
}
return (p) ;
}
/* ========================================================================== */
/* === KLU_free ============================================================= */
/* ========================================================================== */
/* Wrapper around free routine (mxFree for a mexFunction). Returns NULL,
* which can be assigned to the pointer being freed, as in:
*
* p = KLU_free (p, n, sizeof (int), Common) ;
*/
void *KLU_free /* always returns NULL */
(
/* ---- in/out --- */
void *p, /* block of memory to free */
/* ---- input --- */
size_t n, /* size of block to free, in # of items */
size_t size, /* size of each item */
/* --------------- */
KLU_common *Common
)
{
if (p != NULL && Common != NULL)
{
/* only free the object if the pointer is not NULL */
/* call free, or its equivalent */
SuiteSparse_free (p) ;
Common->memusage -= (MAX (1,n) * size) ;
}
/* return NULL, and the caller should assign this to p. This avoids
* freeing the same pointer twice. */
return (NULL) ;
}
/* ========================================================================== */
/* === KLU_realloc ========================================================== */
/* ========================================================================== */
/* Wrapper around realloc routine (mxRealloc for a mexFunction). Given a
* pointer p to a block allocated by KLU_malloc, it changes the size of the
* block pointed to by p to be MAX(1,nnew)*size in size. It may return a
* pointer different than p. This should be used as (for a pointer to Int):
*
* p = KLU_realloc (nnew, nold, sizeof (Int), p, Common) ;
*
* If p is NULL, this is the same as p = KLU_malloc (...).
* A size of nnew=0 is treated as nnew=1.
*
* If the realloc fails, p is returned unchanged and Common->status is set
* to KLU_OUT_OF_MEMORY. If successful, Common->status is not modified,
* and p is returned (possibly changed) and pointing to a large block of memory.
*
* Uses a pointer to the realloc routine (or its equivalent) defined in Common.
*/
void *KLU_realloc /* returns pointer to reallocated block */
(
/* ---- input ---- */
size_t nnew, /* requested # of items in reallocated block */
size_t nold, /* old # of items */
size_t size, /* size of each item */
/* ---- in/out --- */
void *p, /* block of memory to realloc */
/* --------------- */
KLU_common *Common
)
{
void *pnew ;
int ok = TRUE ;
if (Common == NULL)
{
p = NULL ;
}
else if (size == 0)
{
/* size must be > 0 */
Common->status = KLU_INVALID ;
p = NULL ;
}
else if (p == NULL)
{
/* A fresh object is being allocated. */
p = KLU_malloc (nnew, size, Common) ;
}
else if (sizeof (size_t) > sizeof (Int) && nnew >= Int_MAX)
{
/* failure: nnew is too big. Do not change p */
Common->status = KLU_TOO_LARGE ;
}
else
{
/* The object exists, and is changing to some other nonzero size. */
/* call realloc, or its equivalent */
pnew = SuiteSparse_realloc (nnew, nold, size, p, &ok) ;
if (ok)
{
/* success: return the new p and change the size of the block */
Common->memusage += ((nnew-nold) * size) ;
Common->mempeak = MAX (Common->mempeak, Common->memusage) ;
p = pnew ;
}
else
{
/* Do not change p, since it still points to allocated memory */
Common->status = KLU_OUT_OF_MEMORY ;
}
}
return (p) ;
}

480
src/maths/KLU/klu_refactor.c
View File

@ -1,480 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_refactor: factor another matrix (no pivoting)
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Factor the matrix, after ordering and analyzing it with KLU_analyze, and
* factoring it once with KLU_factor. This routine cannot do any numerical
* pivoting. The pattern of the input matrix (Ap, Ai) must be identical to
* the pattern given to KLU_factor.
*/
#include "klu_internal.h"
/* ========================================================================== */
/* === KLU_refactor ========================================================= */
/* ========================================================================== */
int KLU_refactor /* returns TRUE if successful, FALSE otherwise */
(
/* inputs, not modified */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
double Ax [ ],
KLU_symbolic *Symbolic,
/* input/output */
KLU_numeric *Numeric,
KLU_common *Common
)
{
Entry ukk, ujk, s ;
Entry *Offx, *Lx, *Ux, *X, *Az, *Udiag ;
double *Rs ;
Int *Q, *R, *Pnum, *Ui, *Li, *Pinv, *Lip, *Uip, *Llen, *Ulen ;
Unit **LUbx ;
Unit *LU ;
Int k1, k2, nk, k, block, oldcol, pend, oldrow, n, p, newrow, scale,
nblocks, poff, i, j, up, ulen, llen, maxblock, nzoff ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
Common->status = KLU_OK ;
if (Numeric == NULL)
{
/* invalid Numeric object */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->numerical_rank = EMPTY ;
Common->singular_col = EMPTY ;
Az = (Entry *) Ax ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
n = Symbolic->n ;
Q = Symbolic->Q ;
R = Symbolic->R ;
nblocks = Symbolic->nblocks ;
maxblock = Symbolic->maxblock ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Numeric object */
/* ---------------------------------------------------------------------- */
Pnum = Numeric->Pnum ;
Offx = (Entry *) Numeric->Offx ;
LUbx = (Unit **) Numeric->LUbx ;
scale = Common->scale ;
if (scale > 0)
{
/* factorization was not scaled, but refactorization is scaled */
if (Numeric->Rs == NULL)
{
Numeric->Rs = KLU_malloc (n, sizeof (double), Common) ;
if (Common->status < KLU_OK)
{
Common->status = KLU_OUT_OF_MEMORY ;
return (FALSE) ;
}
}
}
else
{
/* no scaling for refactorization; ensure Numeric->Rs is freed. This
* does nothing if Numeric->Rs is already NULL. */
Numeric->Rs = KLU_free (Numeric->Rs, n, sizeof (double), Common) ;
}
Rs = Numeric->Rs ;
Pinv = Numeric->Pinv ;
X = (Entry *) Numeric->Xwork ;
Common->nrealloc = 0 ;
Udiag = Numeric->Udiag ;
nzoff = Symbolic->nzoff ;
/* ---------------------------------------------------------------------- */
/* check the input matrix compute the row scale factors, Rs */
/* ---------------------------------------------------------------------- */
/* do no scale, or check the input matrix, if scale < 0 */
if (scale >= 0)
{
/* check for out-of-range indices, but do not check for duplicates */
if (!KLU_scale (scale, n, Ap, Ai, Ax, Rs, NULL, Common))
{
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* clear workspace X */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < maxblock ; k++)
{
/* X [k] = 0 */
CLEAR (X [k]) ;
}
poff = 0 ;
/* ---------------------------------------------------------------------- */
/* factor each block */
/* ---------------------------------------------------------------------- */
if (scale <= 0)
{
/* ------------------------------------------------------------------ */
/* no scaling */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* ---------------------------------------------------------- */
/* singleton case */
/* ---------------------------------------------------------- */
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
Offx [poff] = Az [p] ;
poff++ ;
}
else
{
/* singleton */
s = Az [p] ;
}
}
Udiag [k1] = s ;
}
else
{
/* ---------------------------------------------------------- */
/* construct and factor the kth block */
/* ---------------------------------------------------------- */
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* ------------------------------------------------------ */
/* scatter kth column of the block into workspace X */
/* ------------------------------------------------------ */
oldcol = Q [k+k1] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
Offx [poff] = Az [p] ;
poff++ ;
}
else
{
/* (newrow,k) is an entry in the block */
X [newrow] = Az [p] ;
}
}
/* ------------------------------------------------------ */
/* compute kth column of U, and update kth column of A */
/* ------------------------------------------------------ */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (up = 0 ; up < ulen ; up++)
{
j = Ui [up] ;
ujk = X [j] ;
/* X [j] = 0 */
CLEAR (X [j]) ;
Ux [up] = ujk ;
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p = 0 ; p < llen ; p++)
{
/* X [Li [p]] -= Lx [p] * ujk */
MULT_SUB (X [Li [p]], Lx [p], ujk) ;
}
}
/* get the diagonal entry of U */
ukk = X [k] ;
/* X [k] = 0 */
CLEAR (X [k]) ;
/* singular case */
if (IS_ZERO (ukk))
{
/* matrix is numerically singular */
Common->status = KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (FALSE) ;
}
}
Udiag [k+k1] = ukk ;
/* gather and divide by pivot to get kth column of L */
GET_POINTER (LU, Lip, Llen, Li, Lx, k, llen) ;
for (p = 0 ; p < llen ; p++)
{
i = Li [p] ;
DIV (Lx [p], X [i], ukk) ;
CLEAR (X [i]) ;
}
}
}
}
}
else
{
/* ------------------------------------------------------------------ */
/* scaling */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* ---------------------------------------------------------- */
/* singleton case */
/* ---------------------------------------------------------- */
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
/* Offx [poff] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (Offx [poff], Az [p], Rs [oldrow]) ;
poff++ ;
}
else
{
/* singleton */
/* s = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (s, Az [p], Rs [oldrow]) ;
}
}
Udiag [k1] = s ;
}
else
{
/* ---------------------------------------------------------- */
/* construct and factor the kth block */
/* ---------------------------------------------------------- */
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* ------------------------------------------------------ */
/* scatter kth column of the block into workspace X */
/* ------------------------------------------------------ */
oldcol = Q [k+k1] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal part */
/* Offx [poff] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (Offx [poff], Az [p], Rs [oldrow]);
poff++ ;
}
else
{
/* (newrow,k) is an entry in the block */
/* X [newrow] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (X [newrow], Az [p], Rs [oldrow]) ;
}
}
/* ------------------------------------------------------ */
/* compute kth column of U, and update kth column of A */
/* ------------------------------------------------------ */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (up = 0 ; up < ulen ; up++)
{
j = Ui [up] ;
ujk = X [j] ;
/* X [j] = 0 */
CLEAR (X [j]) ;
Ux [up] = ujk ;
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p = 0 ; p < llen ; p++)
{
/* X [Li [p]] -= Lx [p] * ujk */
MULT_SUB (X [Li [p]], Lx [p], ujk) ;
}
}
/* get the diagonal entry of U */
ukk = X [k] ;
/* X [k] = 0 */
CLEAR (X [k]) ;
/* singular case */
if (IS_ZERO (ukk))
{
/* matrix is numerically singular */
Common->status = KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (FALSE) ;
}
}
Udiag [k+k1] = ukk ;
/* gather and divide by pivot to get kth column of L */
GET_POINTER (LU, Lip, Llen, Li, Lx, k, llen) ;
for (p = 0 ; p < llen ; p++)
{
i = Li [p] ;
DIV (Lx [p], X [i], ukk) ;
CLEAR (X [i]) ;
}
}
}
}
}
/* ---------------------------------------------------------------------- */
/* permute scale factors Rs according to pivotal row order */
/* ---------------------------------------------------------------------- */
if (scale > 0)
{
for (k = 0 ; k < n ; k++)
{
REAL (X [k]) = Rs [Pnum [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Rs [k] = REAL (X [k]) ;
}
}
#ifndef NDEBUG
ASSERT (Numeric->Offp [n] == poff) ;
ASSERT (Symbolic->nzoff == poff) ;
PRINTF (("\n------------------- Off diagonal entries, new:\n")) ;
ASSERT (KLU_valid (n, Numeric->Offp, Numeric->Offi, Offx)) ;
if (Common->status == KLU_OK)
{
PRINTF (("\n ----------- KLU_BTF_REFACTOR done, nblocks %d\n",nblocks));
for (block = 0 ; block < nblocks ; block++)
{
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF ((
"\n--------------- KLU_refactor output: k1 %d k2 %d nk %d\n",
k1, k2, nk)) ;
if (nk == 1)
{
PRINTF (("singleton ")) ;
PRINT_ENTRY (Udiag [k1]) ;
}
else
{
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
LU = (Unit *) Numeric->LUbx [block] ;
PRINTF (("\n---- L block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, TRUE, Lip, Llen, LU)) ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
PRINTF (("\n---- U block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, FALSE, Uip, Ulen, LU)) ;
}
}
}
#endif
return (TRUE) ;
}

165
src/maths/KLU/klu_scale.c
View File

@ -1,165 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_scale: scale a sparse matrix
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Scale a matrix and check to see if it is valid. Can be called by the user.
* This is called by KLU_factor and KLU_refactor. Returns TRUE if the input
* matrix is valid, FALSE otherwise. If the W input argument is non-NULL,
* then the input matrix is checked for duplicate entries.
*
* scaling methods:
* <0: no scaling, do not compute Rs, and do not check input matrix.
* 0: no scaling
* 1: the scale factor for row i is sum (abs (A (i,:)))
* 2 or more: the scale factor for row i is max (abs (A (i,:)))
*/
#include "klu_internal.h"
int KLU_scale /* return TRUE if successful, FALSE otherwise */
(
/* inputs, not modified */
int scale, /* 0: none, 1: sum, 2: max */
Int n,
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
double Ax [ ],
/* outputs, not defined on input */
double Rs [ ], /* size n, can be NULL if scale <= 0 */
/* workspace, not defined on input or output */
Int W [ ], /* size n, can be NULL */
/* --------------- */
KLU_common *Common
)
{
double a ;
Entry *Az ;
Int row, col, p, pend, check_duplicates ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
Common->status = KLU_OK ;
if (scale < 0)
{
/* return without checking anything and without computing the
* scale factors */
return (TRUE) ;
}
Az = (Entry *) Ax ;
if (n <= 0 || Ap == NULL || Ai == NULL || Az == NULL ||
(scale > 0 && Rs == NULL))
{
/* Ap, Ai, Ax and Rs must be present, and n must be > 0 */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
if (Ap [0] != 0 || Ap [n] < 0)
{
/* nz = Ap [n] must be >= 0 and Ap [0] must equal zero */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
for (col = 0 ; col < n ; col++)
{
if (Ap [col] > Ap [col+1])
{
/* column pointers must be non-decreasing */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* scale */
/* ---------------------------------------------------------------------- */
if (scale > 0)
{
/* initialize row sum or row max */
for (row = 0 ; row < n ; row++)
{
Rs [row] = 0 ;
}
}
/* check for duplicates only if W is present */
check_duplicates = (W != (Int *) NULL) ;
if (check_duplicates)
{
for (row = 0 ; row < n ; row++)
{
W [row] = EMPTY ;
}
}
for (col = 0 ; col < n ; col++)
{
pend = Ap [col+1] ;
for (p = Ap [col] ; p < pend ; p++)
{
row = Ai [p] ;
if (row < 0 || row >= n)
{
/* row index out of range, or duplicate entry */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
if (check_duplicates)
{
if (W [row] == col)
{
/* duplicate entry */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
/* flag row i as appearing in column col */
W [row] = col ;
}
/* a = ABS (Az [p]) ;*/
ABS (a, Az [p]) ;
if (scale == 1)
{
/* accumulate the abs. row sum */
Rs [row] += a ;
}
else if (scale > 1)
{
/* find the max abs. value in the row */
Rs [row] = MAX (Rs [row], a) ;
}
}
}
if (scale > 0)
{
/* do not scale empty rows */
for (row = 0 ; row < n ; row++)
{
/* matrix is singular */
PRINTF (("Rs [%d] = %g\n", row, Rs [row])) ;
if (Rs [row] == 0.0)
{
PRINTF (("Row %d of A is all zero\n", row)) ;
Rs [row] = 1.0 ;
}
}
}
return (TRUE) ;
}

402
src/maths/KLU/klu_solve.c
View File

@ -1,402 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_solve: solve x=A\b using the KLU factorization
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Solve Ax=b using the symbolic and numeric objects from KLU_analyze
* (or KLU_analyze_given) and KLU_factor. Note that no iterative refinement is
* performed. Uses Numeric->Xwork as workspace (undefined on input and output),
* of size 4n Entry's (note that columns 2 to 4 of Xwork overlap with
* Numeric->Iwork).
*/
#include "klu_internal.h"
int KLU_solve
(
/* inputs, not modified */
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
Int d, /* leading dimension of B */
Int nrhs, /* number of right-hand-sides */
/* right-hand-side on input, overwritten with solution to Ax=b on output */
double B [ ], /* size n*nrhs, in column-oriented form, with
* leading dimension d. */
/* --------------- */
KLU_common *Common
)
{
Entry x [4], offik, s ;
double rs, *Rs ;
Entry *Offx, *X, *Bz, *Udiag ;
Int *Q, *R, *Pnum, *Offp, *Offi, *Lip, *Uip, *Llen, *Ulen ;
Unit **LUbx ;
Int k1, k2, nk, k, block, pend, n, p, nblocks, chunk, nr, i ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
if (Numeric == NULL || Symbolic == NULL || d < Symbolic->n || nrhs < 0 ||
B == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
Bz = (Entry *) B ;
n = Symbolic->n ;
nblocks = Symbolic->nblocks ;
Q = Symbolic->Q ;
R = Symbolic->R ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Numeric object */
/* ---------------------------------------------------------------------- */
ASSERT (nblocks == Numeric->nblocks) ;
Pnum = Numeric->Pnum ;
Offp = Numeric->Offp ;
Offi = Numeric->Offi ;
Offx = (Entry *) Numeric->Offx ;
Lip = Numeric->Lip ;
Llen = Numeric->Llen ;
Uip = Numeric->Uip ;
Ulen = Numeric->Ulen ;
LUbx = (Unit **) Numeric->LUbx ;
Udiag = Numeric->Udiag ;
Rs = Numeric->Rs ;
X = (Entry *) Numeric->Xwork ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
/* ---------------------------------------------------------------------- */
/* solve in chunks of 4 columns at a time */
/* ---------------------------------------------------------------------- */
for (chunk = 0 ; chunk < nrhs ; chunk += 4)
{
/* ------------------------------------------------------------------ */
/* get the size of the current chunk */
/* ------------------------------------------------------------------ */
nr = MIN (nrhs - chunk, 4) ;
/* ------------------------------------------------------------------ */
/* scale and permute the right hand side, X = P*(R\B) */
/* ------------------------------------------------------------------ */
if (Rs == NULL)
{
/* no scaling */
switch (nr)
{
case 1:
for (k = 0 ; k < n ; k++)
{
X [k] = Bz [Pnum [k]] ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
X [2*k ] = Bz [i ] ;
X [2*k + 1] = Bz [i + d ] ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
X [3*k ] = Bz [i ] ;
X [3*k + 1] = Bz [i + d ] ;
X [3*k + 2] = Bz [i + d*2] ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
X [4*k ] = Bz [i ] ;
X [4*k + 1] = Bz [i + d ] ;
X [4*k + 2] = Bz [i + d*2] ;
X [4*k + 3] = Bz [i + d*3] ;
}
break ;
}
}
else
{
switch (nr)
{
case 1:
for (k = 0 ; k < n ; k++)
{
SCALE_DIV_ASSIGN (X [k], Bz [Pnum [k]], Rs [k]) ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
rs = Rs [k] ;
SCALE_DIV_ASSIGN (X [2*k], Bz [i], rs) ;
SCALE_DIV_ASSIGN (X [2*k + 1], Bz [i + d], rs) ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
rs = Rs [k] ;
SCALE_DIV_ASSIGN (X [3*k], Bz [i], rs) ;
SCALE_DIV_ASSIGN (X [3*k + 1], Bz [i + d], rs) ;
SCALE_DIV_ASSIGN (X [3*k + 2], Bz [i + d*2], rs) ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
rs = Rs [k] ;
SCALE_DIV_ASSIGN (X [4*k], Bz [i], rs) ;
SCALE_DIV_ASSIGN (X [4*k + 1], Bz [i + d], rs) ;
SCALE_DIV_ASSIGN (X [4*k + 2], Bz [i + d*2], rs) ;
SCALE_DIV_ASSIGN (X [4*k + 3], Bz [i + d*3], rs) ;
}
break ;
}
}
/* ------------------------------------------------------------------ */
/* solve X = (L*U + Off)\X */
/* ------------------------------------------------------------------ */
for (block = nblocks-1 ; block >= 0 ; block--)
{
/* -------------------------------------------------------------- */
/* the block of size nk is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("solve %d, k1 %d k2-1 %d nk %d\n", block, k1,k2-1,nk)) ;
/* solve the block system */
if (nk == 1)
{
s = Udiag [k1] ;
switch (nr)
{
case 1:
DIV (X [k1], X [k1], s) ;
break ;
case 2:
DIV (X [2*k1], X [2*k1], s) ;
DIV (X [2*k1 + 1], X [2*k1 + 1], s) ;
break ;
case 3:
DIV (X [3*k1], X [3*k1], s) ;
DIV (X [3*k1 + 1], X [3*k1 + 1], s) ;
DIV (X [3*k1 + 2], X [3*k1 + 2], s) ;
break ;
case 4:
DIV (X [4*k1], X [4*k1], s) ;
DIV (X [4*k1 + 1], X [4*k1 + 1], s) ;
DIV (X [4*k1 + 2], X [4*k1 + 2], s) ;
DIV (X [4*k1 + 3], X [4*k1 + 3], s) ;
break ;
}
}
else
{
KLU_lsolve (nk, Lip + k1, Llen + k1, LUbx [block], nr,
X + nr*k1) ;
KLU_usolve (nk, Uip + k1, Ulen + k1, LUbx [block],
Udiag + k1, nr, X + nr*k1) ;
}
/* -------------------------------------------------------------- */
/* block back-substitution for the off-diagonal-block entries */
/* -------------------------------------------------------------- */
if (block > 0)
{
switch (nr)
{
case 1:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [k] ;
for (p = Offp [k] ; p < pend ; p++)
{
MULT_SUB (X [Offi [p]], Offx [p], x [0]) ;
}
}
break ;
case 2:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
for (p = Offp [k] ; p < pend ; p++)
{
i = Offi [p] ;
offik = Offx [p] ;
MULT_SUB (X [2*i], offik, x [0]) ;
MULT_SUB (X [2*i + 1], offik, x [1]) ;
}
}
break ;
case 3:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
for (p = Offp [k] ; p < pend ; p++)
{
i = Offi [p] ;
offik = Offx [p] ;
MULT_SUB (X [3*i], offik, x [0]) ;
MULT_SUB (X [3*i + 1], offik, x [1]) ;
MULT_SUB (X [3*i + 2], offik, x [2]) ;
}
}
break ;
case 4:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
for (p = Offp [k] ; p < pend ; p++)
{
i = Offi [p] ;
offik = Offx [p] ;
MULT_SUB (X [4*i], offik, x [0]) ;
MULT_SUB (X [4*i + 1], offik, x [1]) ;
MULT_SUB (X [4*i + 2], offik, x [2]) ;
MULT_SUB (X [4*i + 3], offik, x [3]) ;
}
}
break ;
}
}
}
/* ------------------------------------------------------------------ */
/* permute the result, Bz = Q*X */
/* ------------------------------------------------------------------ */
switch (nr)
{
case 1:
for (k = 0 ; k < n ; k++)
{
Bz [Q [k]] = X [k] ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
i = Q [k] ;
Bz [i ] = X [2*k ] ;
Bz [i + d ] = X [2*k + 1] ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
i = Q [k] ;
Bz [i ] = X [3*k ] ;
Bz [i + d ] = X [3*k + 1] ;
Bz [i + d*2] = X [3*k + 2] ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
i = Q [k] ;
Bz [i ] = X [4*k ] ;
Bz [i + d ] = X [4*k + 1] ;
Bz [i + d*2] = X [4*k + 2] ;
Bz [i + d*3] = X [4*k + 3] ;
}
break ;
}
/* ------------------------------------------------------------------ */
/* go to the next chunk of B */
/* ------------------------------------------------------------------ */
Bz += d*4 ;
}
return (TRUE) ;
}

162
src/maths/KLU/klu_sort.c
View File

@ -1,162 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_sort: sorts the L and U factors of KLU
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* sorts the columns of L and U so that the row indices appear in strictly
* increasing order.
*/
#include "klu_internal.h"
/* ========================================================================== */
/* === sort ================================================================= */
/* ========================================================================== */
/* Sort L or U using a double-transpose */
static void sort (Int n, Int *Xip, Int *Xlen, Unit *LU, Int *Tp, Int *Tj,
Entry *Tx, Int *W)
{
Int *Xi ;
Entry *Xx ;
Int p, i, j, len, nz, tp, xlen, pend ;
ASSERT (KLU_valid_LU (n, FALSE, Xip, Xlen, LU)) ;
/* count the number of entries in each row of L or U */
for (i = 0 ; i < n ; i++)
{
W [i] = 0 ;
}
for (j = 0 ; j < n ; j++)
{
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
W [Xi [p]]++ ;
}
}
/* construct the row pointers for T */
nz = 0 ;
for (i = 0 ; i < n ; i++)
{
Tp [i] = nz ;
nz += W [i] ;
}
Tp [n] = nz ;
for (i = 0 ; i < n ; i++)
{
W [i] = Tp [i] ;
}
/* transpose the matrix into Tp, Ti, Tx */
for (j = 0 ; j < n ; j++)
{
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
tp = W [Xi [p]]++ ;
Tj [tp] = j ;
Tx [tp] = Xx [p] ;
}
}
/* transpose the matrix back into Xip, Xlen, Xi, Xx */
for (j = 0 ; j < n ; j++)
{
W [j] = 0 ;
}
for (i = 0 ; i < n ; i++)
{
pend = Tp [i+1] ;
for (p = Tp [i] ; p < pend ; p++)
{
j = Tj [p] ;
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
xlen = W [j]++ ;
Xi [xlen] = i ;
Xx [xlen] = Tx [p] ;
}
}
ASSERT (KLU_valid_LU (n, FALSE, Xip, Xlen, LU)) ;
}
/* ========================================================================== */
/* === KLU_sort ============================================================= */
/* ========================================================================== */
int KLU_sort
(
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
KLU_common *Common
)
{
Int *R, *W, *Tp, *Ti, *Lip, *Uip, *Llen, *Ulen ;
Entry *Tx ;
Unit **LUbx ;
Int n, nk, nz, block, nblocks, maxblock, k1 ;
size_t m1 ;
if (Common == NULL)
{
return (FALSE) ;
}
Common->status = KLU_OK ;
n = Symbolic->n ;
R = Symbolic->R ;
nblocks = Symbolic->nblocks ;
maxblock = Symbolic->maxblock ;
Lip = Numeric->Lip ;
Llen = Numeric->Llen ;
Uip = Numeric->Uip ;
Ulen = Numeric->Ulen ;
LUbx = (Unit **) Numeric->LUbx ;
m1 = ((size_t) maxblock) + 1 ;
/* allocate workspace */
nz = MAX (Numeric->max_lnz_block, Numeric->max_unz_block) ;
W = KLU_malloc (maxblock, sizeof (Int), Common) ;
Tp = KLU_malloc (m1, sizeof (Int), Common) ;
Ti = KLU_malloc (nz, sizeof (Int), Common) ;
Tx = KLU_malloc (nz, sizeof (Entry), Common) ;
PRINTF (("\n======================= Start sort:\n")) ;
if (Common->status == KLU_OK)
{
/* sort each block of L and U */
for (block = 0 ; block < nblocks ; block++)
{
k1 = R [block] ;
nk = R [block+1] - k1 ;
if (nk > 1)
{
PRINTF (("\n-------------------block: %d nk %d\n", block, nk)) ;
sort (nk, Lip + k1, Llen + k1, LUbx [block], Tp, Ti, Tx, W) ;
sort (nk, Uip + k1, Ulen + k1, LUbx [block], Tp, Ti, Tx, W) ;
}
}
}
PRINTF (("\n======================= sort done.\n")) ;
/* free workspace */
KLU_free (W, maxblock, sizeof (Int), Common) ;
KLU_free (Tp, m1, sizeof (Int), Common) ;
KLU_free (Ti, nz, sizeof (Int), Common) ;
KLU_free (Tx, nz, sizeof (Entry), Common) ;
return (Common->status == KLU_OK) ;
}

471
src/maths/KLU/klu_tsolve.c
View File

@ -1,471 +0,0 @@
//------------------------------------------------------------------------------
// KLU/Source/klu_tsolve: solve x=A'\b using the KLU factorization
//------------------------------------------------------------------------------
// KLU, Copyright (c) 2004-2022, University of Florida. All Rights Reserved.
// Authors: Timothy A. Davis and Ekanathan Palamadai.
// SPDX-License-Identifier: LGPL-2.1+
//------------------------------------------------------------------------------
/* Solve A'x=b using the symbolic and numeric objects from KLU_analyze
* (or KLU_analyze_given) and KLU_factor. Note that no iterative refinement is
* performed. Uses Numeric->Xwork as workspace (undefined on input and output),
* of size 4n Entry's (note that columns 2 to 4 of Xwork overlap with
* Numeric->Iwork).
*/
#include "klu_internal.h"
int KLU_tsolve
(
/* inputs, not modified */
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
Int d, /* leading dimension of B */
Int nrhs, /* number of right-hand-sides */
/* right-hand-side on input, overwritten with solution to Ax=b on output */
double B [ ], /* size n*nrhs, in column-oriented form, with
* leading dimension d. */
#ifdef COMPLEX
int conj_solve, /* TRUE for conjugate transpose solve, FALSE for
* array transpose solve. Used for the complex
* case only. */
#endif
/* --------------- */
KLU_common *Common
)
{
Entry x [4], offik, s ;
double rs, *Rs ;
Entry *Offx, *X, *Bz, *Udiag ;
Int *Q, *R, *Pnum, *Offp, *Offi, *Lip, *Uip, *Llen, *Ulen ;
Unit **LUbx ;
Int k1, k2, nk, k, block, pend, n, p, nblocks, chunk, nr, i ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
if (Numeric == NULL || Symbolic == NULL || d < Symbolic->n || nrhs < 0 ||
B == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
Bz = (Entry *) B ;
n = Symbolic->n ;
nblocks = Symbolic->nblocks ;
Q = Symbolic->Q ;
R = Symbolic->R ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Numeric object */
/* ---------------------------------------------------------------------- */
ASSERT (nblocks == Numeric->nblocks) ;
Pnum = Numeric->Pnum ;
Offp = Numeric->Offp ;
Offi = Numeric->Offi ;
Offx = (Entry *) Numeric->Offx ;
Lip = Numeric->Lip ;
Llen = Numeric->Llen ;
Uip = Numeric->Uip ;
Ulen = Numeric->Ulen ;
LUbx = (Unit **) Numeric->LUbx ;
Udiag = Numeric->Udiag ;
Rs = Numeric->Rs ;
X = (Entry *) Numeric->Xwork ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
/* ---------------------------------------------------------------------- */
/* solve in chunks of 4 columns at a time */
/* ---------------------------------------------------------------------- */
for (chunk = 0 ; chunk < nrhs ; chunk += 4)
{
/* ------------------------------------------------------------------ */
/* get the size of the current chunk */
/* ------------------------------------------------------------------ */
nr = MIN (nrhs - chunk, 4) ;
/* ------------------------------------------------------------------ */
/* permute the right hand side, X = Q'*B */
/* ------------------------------------------------------------------ */
switch (nr)
{
case 1:
for (k = 0 ; k < n ; k++)
{
X [k] = Bz [Q [k]] ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
i = Q [k] ;
X [2*k ] = Bz [i ] ;
X [2*k + 1] = Bz [i + d ] ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
i = Q [k] ;
X [3*k ] = Bz [i ] ;
X [3*k + 1] = Bz [i + d ] ;
X [3*k + 2] = Bz [i + d*2] ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
i = Q [k] ;
X [4*k ] = Bz [i ] ;
X [4*k + 1] = Bz [i + d ] ;
X [4*k + 2] = Bz [i + d*2] ;
X [4*k + 3] = Bz [i + d*3] ;
}
break ;
}
/* ------------------------------------------------------------------ */
/* solve X = (L*U + Off)'\X */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block of size nk is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF (("tsolve %d, k1 %d k2-1 %d nk %d\n", block, k1,k2-1,nk)) ;
/* -------------------------------------------------------------- */
/* block back-substitution for the off-diagonal-block entries */
/* -------------------------------------------------------------- */
if (block > 0)
{
switch (nr)
{
case 1:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
for (p = Offp [k] ; p < pend ; p++)
{
#ifdef COMPLEX
if (conj_solve)
{
MULT_SUB_CONJ (X [k], X [Offi [p]],
Offx [p]) ;
}
else
#endif
{
MULT_SUB (X [k], Offx [p], X [Offi [p]]) ;
}
}
}
break ;
case 2:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
for (p = Offp [k] ; p < pend ; p++)
{
i = Offi [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (offik, Offx [p]) ;
}
else
#endif
{
offik = Offx [p] ;
}
MULT_SUB (x [0], offik, X [2*i]) ;
MULT_SUB (x [1], offik, X [2*i + 1]) ;
}
X [2*k ] = x [0] ;
X [2*k + 1] = x [1] ;
}
break ;
case 3:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
for (p = Offp [k] ; p < pend ; p++)
{
i = Offi [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (offik, Offx [p]) ;
}
else
#endif
{
offik = Offx [p] ;
}
MULT_SUB (x [0], offik, X [3*i]) ;
MULT_SUB (x [1], offik, X [3*i + 1]) ;
MULT_SUB (x [2], offik, X [3*i + 2]) ;
}
X [3*k ] = x [0] ;
X [3*k + 1] = x [1] ;
X [3*k + 2] = x [2] ;
}
break ;
case 4:
for (k = k1 ; k < k2 ; k++)
{
pend = Offp [k+1] ;
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
for (p = Offp [k] ; p < pend ; p++)
{
i = Offi [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ(offik, Offx [p]) ;
}
else
#endif
{
offik = Offx [p] ;
}
MULT_SUB (x [0], offik, X [4*i]) ;
MULT_SUB (x [1], offik, X [4*i + 1]) ;
MULT_SUB (x [2], offik, X [4*i + 2]) ;
MULT_SUB (x [3], offik, X [4*i + 3]) ;
}
X [4*k ] = x [0] ;
X [4*k + 1] = x [1] ;
X [4*k + 2] = x [2] ;
X [4*k + 3] = x [3] ;
}
break ;
}
}
/* -------------------------------------------------------------- */
/* solve the block system */
/* -------------------------------------------------------------- */
if (nk == 1)
{
#ifdef COMPLEX
if (conj_solve)
{
CONJ (s, Udiag [k1]) ;
}
else
#endif
{
s = Udiag [k1] ;
}
switch (nr)
{
case 1:
DIV (X [k1], X [k1], s) ;
break ;
case 2:
DIV (X [2*k1], X [2*k1], s) ;
DIV (X [2*k1 + 1], X [2*k1 + 1], s) ;
break ;
case 3:
DIV (X [3*k1], X [3*k1], s) ;
DIV (X [3*k1 + 1], X [3*k1 + 1], s) ;
DIV (X [3*k1 + 2], X [3*k1 + 2], s) ;
break ;
case 4:
DIV (X [4*k1], X [4*k1], s) ;
DIV (X [4*k1 + 1], X [4*k1 + 1], s) ;
DIV (X [4*k1 + 2], X [4*k1 + 2], s) ;
DIV (X [4*k1 + 3], X [4*k1 + 3], s) ;
break ;
}
}
else
{
KLU_utsolve (nk, Uip + k1, Ulen + k1, LUbx [block],
Udiag + k1, nr,
#ifdef COMPLEX
conj_solve,
#endif
X + nr*k1) ;
KLU_ltsolve (nk, Lip + k1, Llen + k1, LUbx [block], nr,
#ifdef COMPLEX
conj_solve,
#endif
X + nr*k1) ;
}
}
/* ------------------------------------------------------------------ */
/* scale and permute the result, Bz = P'(R\X) */
/* ------------------------------------------------------------------ */
if (Rs == NULL)
{
/* no scaling */
switch (nr)
{
case 1:
for (k = 0 ; k < n ; k++)
{
Bz [Pnum [k]] = X [k] ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
Bz [i ] = X [2*k ] ;
Bz [i + d ] = X [2*k + 1] ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
Bz [i ] = X [3*k ] ;
Bz [i + d ] = X [3*k + 1] ;
Bz [i + d*2] = X [3*k + 2] ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
Bz [i ] = X [4*k ] ;
Bz [i + d ] = X [4*k + 1] ;
Bz [i + d*2] = X [4*k + 2] ;
Bz [i + d*3] = X [4*k + 3] ;
}
break ;
}
}
else
{
switch (nr)
{
case 1:
for (k = 0 ; k < n ; k++)
{
SCALE_DIV_ASSIGN (Bz [Pnum [k]], X [k], Rs [k]) ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
rs = Rs [k] ;
SCALE_DIV_ASSIGN (Bz [i], X [2*k], rs) ;
SCALE_DIV_ASSIGN (Bz [i + d], X [2*k + 1], rs) ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
rs = Rs [k] ;
SCALE_DIV_ASSIGN (Bz [i], X [3*k], rs) ;
SCALE_DIV_ASSIGN (Bz [i + d], X [3*k + 1], rs) ;
SCALE_DIV_ASSIGN (Bz [i + d*2], X [3*k + 2], rs) ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
i = Pnum [k] ;
rs = Rs [k] ;
SCALE_DIV_ASSIGN (Bz [i], X [4*k], rs) ;
SCALE_DIV_ASSIGN (Bz [i + d], X [4*k + 1], rs) ;
SCALE_DIV_ASSIGN (Bz [i + d*2], X [4*k + 2], rs) ;
SCALE_DIV_ASSIGN (Bz [i + d*3], X [4*k + 3], rs) ;
}
break ;
}
}
/* ------------------------------------------------------------------ */
/* go to the next chunk of B */
/* ------------------------------------------------------------------ */
Bz += d*4 ;
}
return (TRUE) ;
}

2
src/maths/KLU/klu_version.h
View File

@ -11,6 +11,8 @@
#ifndef _KLU_VERSION_H
#define _KLU_VERSION_H
#include "ngspice/klu_ext.h"
#ifdef DLONG
#define Int int64_t
#define Int_id "%" PRId64

2
src/maths/ni/niinit.c
View File

@ -17,7 +17,7 @@ Author: 1985 Thomas L. Quarles
#include "ngspice/smpdefs.h"
#ifdef KLU
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#endif
int

2
src/osdi/osdisetup.c
View File

@ -10,7 +10,7 @@
*/
#include "ngspice/iferrmsg.h"
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#include "ngspice/memory.h"
#include "ngspice/ngspice.h"
#include "ngspice/typedefs.h"

2
src/spicelib/analysis/cktacct.c
View File

@ -19,7 +19,7 @@ Author: 1985 Thomas L. Quarles
#include "ngspice/spmatrix.h"
#ifdef KLU
#include "ngspice/klu.h"
#include <suitesparse/klu.h>
#endif
/* Francesco Lannutti