/*! \fn allocate memory for linear system solver Klu
*
*/
int
allocateKluData(int n_row, int n_col, int nz, void** voiddata)
{
DATA_KLU* data = (DATA_KLU*) malloc(sizeof(DATA_KLU));
assertStreamPrint(NULL, 0 != data, "Could not allocate data for linear solver Klu.");
data->symbolic = NULL;
data->numeric = NULL;
data->n_col = n_col;
data->n_row = n_row;
data->nnz = nz;
data->Ap = (int*) calloc((n_row+1),sizeof(int));
data->Ai = (int*) calloc(nz,sizeof(int));
data->Ax = (double*) calloc(nz,sizeof(double));
data->work = (double*) calloc(n_col,sizeof(double));
data->numberSolving = 0;
klu_defaults(&(data->common));
*voiddata = (void*)data;
return 0;
}
KLU::~KLU() {
klu_common Common;
klu_defaults(&Common);
klu_symbolic *Sym = (klu_symbolic*)_Symbolic;
klu_numeric *Num = (klu_numeric*)_Numeric;
if ( _Symbolic ) klu_free_symbolic( &Sym, &Common);
if ( _Numeric ) klu_free_numeric ( &Num, &Common);
}
/*
This will prep KLU for subsequent linear solves by computing an initial fill-reducing ordering and numeric factorization (if values are available) of the user-supplied Jacobian.
*/
int InitKINKlu(KINMem kin_memory){
//check inputs
if(!kin_memory) return 1;
//grab the kinklu block
KINKluMem kin_klu_mem=(KINKluMem)kin_memory->kin_lmem;
if(!kin_klu_mem) return 1;
kin_memory->kin_inexact_ls=FALSE;
kin_memory->kin_setupNonNull=TRUE;
//grab klu objects from kinklu memory
int n=kin_klu_mem->n, ok;
cs_di *jac=kin_klu_mem->jac;
klu_symbolic *symb=kin_klu_mem->symbolic;
klu_numeric *numeric=kin_klu_mem->numeric;
klu_common *comm=&(kin_klu_mem->klu_comm);
//if theres no jacobian to try factoring, we're done
if(!jac) return 1;
//check for, and delete if necessary, existing klu symbolic and numeric objects.
if(symb){klu_free_symbolic(&symb, comm); symb=NULL; kin_klu_mem->symbolic=NULL;}
if(numeric){klu_free_numeric(&numeric, comm); numeric=NULL; kin_klu_mem->numeric=NULL;}
ok=klu_defaults(comm);
//attempt the symbolic factorization.
symb=klu_analyze(n, jac->p, jac->i, comm);
//if there's an error doing the factorization, abort. don't delete the jacobian passed in, but null the kinklu jac pointer
if(!symb) return 1;
//otherwise, assign the kinklu symbolic pointer and indicate that the jacobian has been fill-reduced
kin_klu_mem->symbolic=symb;
kin_klu_mem->is_fill_reduced=1;
//do numeric factor if values are available
/*
if(jac->x){
//try factorization. on failure, free the previous symbolic object and return.
numeric = klu_factor(jac->p, jac->i, jac->x, symb, comm);
if(!numeric){
klu_free_symbolic(&symb, comm);
kin_klu_mem->symbolic = NULL;
return 1;
}
//otherwise, assign the kinklu numeric pointer and return.
kin_klu_mem->numeric = numeric;
}*/
return 0;
};
void KLUSystem::InitDefaults ()
{
m_nBus = 0;
bFactored = false;
acx = NULL;
zero_indices ();
null_pointers ();
if (!common_init) {
klu_defaults (&Common);
Common.halt_if_singular = 0;
common_init = 1;
}
}
int main (void)
{
klu_symbolic *Symbolic ;
klu_numeric *Numeric ;
klu_common Common ;
int i ;
klu_defaults (&Common) ;
Symbolic = klu_analyze (n, Ap, Ai, &Common) ;
Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ;
klu_solve (Symbolic, Numeric, 5, 1, b, &Common) ;
klu_free_symbolic (&Symbolic, &Common) ;
klu_free_numeric (&Numeric, &Common) ;
for (i = 0 ; i < n ; i++) printf ("x [%d] = %g\n", i, b [i]) ;
return (0) ;
}
/***
KLU
***/
int KLU::Factor() {
int status;
int ndim;
_NRC = _nnz;
ndim = _dim;
memcpy(&_rows[0], _rows_ptr, _nnz*sizeof(int));
memcpy(&_cols[0], _cols_ptr, _nnz*sizeof(int));
memcpy(&_vals[0], _vals_ptr, _nnz*sizeof(double));
_Ap.size(_dim+1);
_Ai.size(_nnz);
_Ax.size(_nnz);
status = umfpack_di_triplet_to_col (ndim,ndim, _NRC, &_rows[0], &_cols[0], &_vals[0],
&_Ap[0], &_Ai[0], &_Ax[0], (int*)NULL) ;
if (status < 0 ) {
fprintf(stderr,"KLU: umfpack_di_triplet_to_col failed\n");
return (-1);
}
klu_common Common;
klu_defaults( &Common );
klu_numeric *Num;
if ( _Symbolic == NULL ) _Symbolic = (void*)klu_analyze(ndim, &_Ap[0], &_Ai[0], &Common);
if ( _Symbolic == NULL ) {
fprintf(stderr,"KLU: symbolic analysis failed\n");
return (-1);
}
if ( _Numeric ) {
Num = (klu_numeric*)_Numeric;
klu_free_numeric( &Num, &Common);
}
_Numeric = (void*)klu_factor(&_Ap[0], &_Ai[0], &_Ax[0], (klu_symbolic*)_Symbolic, &Common);
if ( _Numeric == NULL ) {
fprintf(stderr,"KLU: numeric factorization failed\n");
return (-1);
}
_is_factored = 1;
return 0;
}
int KLU::Solve(double *rhs, double *x) {
int rc = 0;
if (!_is_factored) rc = Factor();
int NEQN = _dim;
klu_symbolic *Sym = (klu_symbolic*)_Symbolic;
klu_numeric *Num = (klu_numeric*)_Numeric;
klu_common Common;
klu_defaults( &Common );
/* load the rhs only (matrix already there) */
if (x != rhs) memcpy( x, rhs, NEQN*sizeof(double) );
/* we will deal with transpose later */
rc = klu_solve(Sym, Num, NEQN, 1, x, &Common);
return rc;
}
int IDAKLU(void *ida_mem, int n, int nnz)
{
IDAMem IDA_mem;
IDASlsMem idasls_mem;
KLUData klu_data;
int flag;
/* Return immediately if ida_mem is NULL. */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDASLS_MEM_NULL, "IDASLS", "IDAKLU",
MSGSP_IDAMEM_NULL);
return(IDASLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the NVECTOR package is compatible with the Direct solver */
if (IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDASLS_ILL_INPUT, "IDASLS", "IDAKLU",
MSGSP_BAD_NVECTOR);
return(IDASLS_ILL_INPUT);
}
if (IDA_mem->ida_lfree != NULL) flag = IDA_mem->ida_lfree(IDA_mem);
/* Set five main function fields in IDA_mem. */
IDA_mem->ida_linit = IDAKLUInit;
IDA_mem->ida_lsetup = IDAKLUSetup;
IDA_mem->ida_lsolve = IDAKLUSolve;
IDA_mem->ida_lperf = NULL;
IDA_mem->ida_lfree = IDAKLUFree;
/* Get memory for IDASlsMemRec. */
idasls_mem = (IDASlsMem) malloc(sizeof(struct IDASlsMemRec));
if (idasls_mem == NULL) {
IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU",
MSGSP_MEM_FAIL);
return(IDASLS_MEM_FAIL);
}
/* Get memory for KLUData. */
klu_data = (KLUData)malloc(sizeof(struct KLUDataRec));
if (klu_data == NULL) {
IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU",
MSGSP_MEM_FAIL);
return(IDASLS_MEM_FAIL);
}
IDA_mem->ida_setupNonNull = TRUE;
/* Set default Jacobian routine and Jacobian data */
idasls_mem->s_jaceval = NULL;
idasls_mem->s_jacdata = IDA_mem->ida_user_data;
/* Allocate memory for the sparse Jacobian */
idasls_mem->s_JacMat = NewSparseMat(n, n, nnz);
if (idasls_mem->s_JacMat == NULL) {
IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU",
MSGSP_MEM_FAIL);
return(IDASLS_MEM_FAIL);
}
/* KInitialize KLU structures */
klu_data->s_Symbolic = NULL;
klu_data->s_Numeric = NULL;
/* Set default parameters for KLU */
flag = klu_defaults(&klu_data->s_Common);
if (flag == 0) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLU",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
/* Set ordering to COLAMD as the idas default use.
Users can set a different value with IDAKLUSetOrdering,
and the user-set value is loaded before any call to klu_analyze in
IDAKLUSetup. */
klu_data->s_ordering = 1;
klu_data->s_Common.ordering = klu_data->s_ordering;
/* Attach linear solver memory to the integrator memory */
idasls_mem->s_solver_data = (void *) klu_data;
IDA_mem->ida_lmem = idasls_mem;
idasls_mem->s_last_flag = IDASLS_SUCCESS;
return(IDASLS_SUCCESS);
}
/*---------------------------------------------------------------
ARKKLU
This routine initializes the memory record and sets various
function fields specific to the ARKode / KLU linear solver
module. ARKKLU first calls the existing lfree routine if this
is not NULL. Then it sets the ark_linit, ark_lsetup, ark_lsolve
and ark_lfree fields in (*arkode_mem) to be arkKLUInit,
arkKLUSetup, arkKLUSolve and arkKLUFree, respectively. It
allocates memory for a structure of type ARKSlsMemRec and sets
the ark_lmem field in (*arkode_mem) to the address of this
structure. It sets setupNonNull in (*arkode_mem) to TRUE.
Finally, it allocates memory for KLU. The return value is
ARKSLS_SUCCESS = 0, ARKSLS_LMEM_FAIL = -1, or
ARKSLS_ILL_INPUT = -2.
NOTE: The KLU linear solver assumes a serial implementation
of the NVECTOR package. Therefore, ARKKLU will first
test for a compatible N_Vector internal representation
by checking that the function N_VGetArrayPointer exists.
---------------------------------------------------------------*/
int ARKKLU(void *arkode_mem, int n, int nnz, int sparsetype)
{
ARKodeMem ark_mem;
ARKSlsMem arksls_mem;
KLUData klu_data;
int flag;
/* Return immediately if ark_mem is NULL. */
if (arkode_mem == NULL) {
arkProcessError(NULL, ARKSLS_MEM_NULL, "ARKSLS",
"ARKKLU", MSGSP_ARKMEM_NULL);
return(ARKSLS_MEM_NULL);
}
ark_mem = (ARKodeMem) arkode_mem;
/* Test if the NVECTOR package is compatible with the solver */
if (ark_mem->ark_tempv->ops->nvgetarraypointer == NULL) {
arkProcessError(ark_mem, ARKSLS_ILL_INPUT, "ARKSLS",
"ARKKLU", MSGSP_BAD_NVECTOR);
return(ARKSLS_ILL_INPUT);
}
if (ark_mem->ark_lfree != NULL) ark_mem->ark_lfree(ark_mem);
/* Set four main function fields in ark_mem. */
ark_mem->ark_linit = arkKLUInit;
ark_mem->ark_lsetup = arkKLUSetup;
ark_mem->ark_lsolve = arkKLUSolve;
ark_mem->ark_lfree = arkKLUFree;
ark_mem->ark_lsolve_type = 3;
/* Get memory for ARKSlsMemRec. */
arksls_mem = (ARKSlsMem) malloc(sizeof(struct ARKSlsMemRec));
if (arksls_mem == NULL) {
arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS",
"ARKKLU", MSGSP_MEM_FAIL);
return(ARKSLS_MEM_FAIL);
}
/* Get memory for KLUData. */
klu_data = (KLUData) malloc(sizeof(struct KLUDataRec));
if (klu_data == NULL) {
arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS",
"ARKKLU", MSGSP_MEM_FAIL);
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_MEM_FAIL);
}
/* Initialize Jacobian-related data */
arksls_mem->s_Jeval = NULL;
arksls_mem->s_Jdata = NULL;
ark_mem->ark_setupNonNull = TRUE;
arksls_mem->sparsetype = sparsetype;
/* Initialize counters */
arksls_mem->s_nje = 0;
arksls_mem->s_first_factorize = 1;
arksls_mem->s_nstlj = 0;
/* Allocate memory for the sparse Jacobian */
arksls_mem->s_A = NULL;
arksls_mem->s_A = SparseNewMat(n, n, nnz, sparsetype);
if (arksls_mem->s_A == NULL) {
arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS",
"ARKKLU", MSGSP_MEM_FAIL);
free(klu_data); klu_data = NULL;
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_MEM_FAIL);
}
/* Allocate memory for saved sparse Jacobian */
arksls_mem->s_savedJ = NULL;
arksls_mem->s_savedJ = SparseNewMat(n, n, nnz, sparsetype);
if (arksls_mem->s_savedJ == NULL) {
arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS",
"ARKKLU", MSGSP_MEM_FAIL);
SparseDestroyMat(arksls_mem->s_A);
free(klu_data); klu_data = NULL;
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_MEM_FAIL);
}
/* Initialize KLU structures */
switch (sparsetype) {
case CSC_MAT:
klu_data->sun_klu_solve = &klu_solve;
break;
case CSR_MAT:
klu_data->sun_klu_solve = &klu_tsolve;
break;
default:
SparseDestroyMat(arksls_mem->s_A);
SparseDestroyMat(arksls_mem->s_savedJ);
free(klu_data); klu_data = NULL;
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_ILL_INPUT);
}
klu_data->s_Symbolic = NULL;
klu_data->s_Numeric = NULL;
/* Set default parameters for KLU */
flag = klu_defaults(&klu_data->s_Common);
if (flag == 0) {
arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS",
"ARKKLU", MSGSP_MEM_FAIL);
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
free(klu_data->s_Numeric); klu_data->s_Numeric = NULL;
klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common));
free(klu_data->s_Symbolic); klu_data->s_Symbolic = NULL;
SparseDestroyMat(arksls_mem->s_A);
SparseDestroyMat(arksls_mem->s_savedJ);
free(klu_data); klu_data = NULL;
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_MEM_FAIL);
}
/* Set ordering to COLAMD as the arkode default use.
Users can set a different value with ARKKLUSetOrdering,
and the user-set value is loaded before any call to klu_analyze in
ARKKLUSetup. */
klu_data->s_ordering = 1;
klu_data->s_Common.ordering = klu_data->s_ordering;
/* Attach linear solver memory to the integrator memory */
arksls_mem->s_solver_data = (void *) klu_data;
ark_mem->ark_lmem = arksls_mem;
arksls_mem->s_last_flag = ARKSLS_SUCCESS;
return(ARKSLS_SUCCESS);
}
int CVKLU(void *cvode_mem, int n, int nnz, int sparsetype)
{
CVodeMem cv_mem;
CVSlsMem cvsls_mem;
KLUData klu_data;
int flag;
/* Return immediately if cv_mem is NULL. */
if (cvode_mem == NULL) {
cvProcessError(NULL, CVSLS_MEM_NULL, "CVSLS", "cvKLU",
MSGSP_CVMEM_NULL);
return(CVSLS_MEM_NULL);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if the NVECTOR package is compatible with the Direct solver */
if (cv_mem->cv_tempv->ops->nvgetarraypointer == NULL) {
cvProcessError(cv_mem, CVSLS_ILL_INPUT, "CVSLS", "cvKLU",
MSGSP_BAD_NVECTOR);
return(CVSLS_ILL_INPUT);
}
if (cv_mem->cv_lfree != NULL) cv_mem->cv_lfree(cv_mem);
/* Set five main function fields in cv_mem. */
cv_mem->cv_linit = cvKLUInit;
cv_mem->cv_lsetup = cvKLUSetup;
cv_mem->cv_lsolve = cvKLUSolve;
cv_mem->cv_lfree = cvKLUFree;
/* Get memory for CVSlsMemRec. */
cvsls_mem = (CVSlsMem) malloc(sizeof(struct CVSlsMemRec));
if (cvsls_mem == NULL) {
cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU",
MSGSP_MEM_FAIL);
return(CVSLS_MEM_FAIL);
}
/* Get memory for KLUData. */
klu_data = (KLUData)malloc(sizeof(struct KLUDataRec));
if (klu_data == NULL) {
cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU",
MSGSP_MEM_FAIL);
return(CVSLS_MEM_FAIL);
}
cv_mem->cv_setupNonNull = TRUE;
/* Set default Jacobian routine and Jacobian data */
cvsls_mem->s_jaceval = NULL;
cvsls_mem->s_jacdata = NULL;
cvsls_mem->sparsetype = sparsetype;
/* Allocate memory for the sparse Jacobian */
cvsls_mem->s_JacMat = SparseNewMat(n, n, nnz, sparsetype);
if (cvsls_mem->s_JacMat == NULL) {
cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU",
MSGSP_MEM_FAIL);
free(cvsls_mem);
return(CVSLS_MEM_FAIL);
}
/* Allocate memory for saved sparse Jacobian */
cvsls_mem->s_savedJ = SparseNewMat(n, n, nnz, sparsetype);
if (cvsls_mem->s_savedJ == NULL) {
cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU",
MSGSP_MEM_FAIL);
SparseDestroyMat(cvsls_mem->s_JacMat);
free(cvsls_mem);
return(CVSLS_MEM_FAIL);
}
/* Initialize KLU structures */
switch (sparsetype) {
case CSC_MAT:
klu_data->sun_klu_solve = &klu_solve;
break;
case CSR_MAT:
klu_data->sun_klu_solve = &klu_tsolve;
break;
default:
SparseDestroyMat(cvsls_mem->s_JacMat);
free(klu_data);
free(cvsls_mem);
return(CVSLS_ILL_INPUT);
}
klu_data->s_Symbolic = NULL;
klu_data->s_Numeric = NULL;
/* Set default parameters for KLU */
flag = klu_defaults(&klu_data->s_Common);
if (flag == 0) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "cvKLU",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
/* Set ordering to COLAMD as the cvode default use.
Users can set a different value with CVKLUSetOrdering,
and the user-set value is loaded before any call to klu_analyze in
CVKLUSetup. */
klu_data->s_ordering = 1;
klu_data->s_Common.ordering = klu_data->s_ordering;
/* Attach linear solver memory to the integrator memory */
cvsls_mem->s_solver_data = (void *) klu_data;
cv_mem->cv_lmem = cvsls_mem;
cvsls_mem->s_last_flag = CVSLS_SUCCESS;
return(CVSLS_SUCCESS);
}
int main (void)
{
KLU_common Common ;
cholmod_sparse *A, *A2 ;
cholmod_dense *X, *B ;
cholmod_common ch ;
Int *Ap, *Ai, *Puser, *Quser, *Gunk ;
double *Ax, *Bx, *Xx, *A2x ;
double one [2], zero [2], xsave, maxerr ;
Int n, i, j, nz, save, isreal, k, nan ;
KLU_symbolic *Symbolic, *Symbolic2 ;
KLU_numeric *Numeric ;
one [0] = 1 ;
one [1] = 0 ;
zero [0] = 0 ;
zero [1] = 0 ;
printf ("klu test: -------------------------------------------------\n") ;
OK (klu_defaults (&Common)) ;
CHOLMOD_start (&ch) ;
ch.print = 0 ;
normal_memory_handler (&Common) ;
/* ---------------------------------------------------------------------- */
/* read in a sparse matrix from stdin */
/* ---------------------------------------------------------------------- */
A = CHOLMOD_read_sparse (stdin, &ch) ;
if (A->nrow != A->ncol || A->stype != 0)
{
fprintf (stderr, "error: only square unsymmetric matrices handled\n") ;
CHOLMOD_free_sparse (&A, &ch) ;
return (0) ;
}
if (!(A->xtype == CHOLMOD_REAL || A->xtype == CHOLMOD_COMPLEX))
{
fprintf (stderr, "error: only real or complex matrices hanlded\n") ;
CHOLMOD_free_sparse (&A, &ch) ;
return (0) ;
}
n = A->nrow ;
Ap = A->p ;
Ai = A->i ;
Ax = A->x ;
nz = Ap [n] ;
isreal = (A->xtype == CHOLMOD_REAL) ;
/* ---------------------------------------------------------------------- */
/* construct random permutations */
/* ---------------------------------------------------------------------- */
Puser = randperm (n, n) ;
Quser = randperm (n, n) ;
/* ---------------------------------------------------------------------- */
/* select known solution to Ax=b */
/* ---------------------------------------------------------------------- */
X = CHOLMOD_allocate_dense (n, NRHS, n, A->xtype, &ch) ;
Xx = X->x ;
for (j = 0 ; j < NRHS ; j++)
{
for (i = 0 ; i < n ; i++)
{
if (isreal)
{
Xx [i] = 1 + ((double) i) / ((double) n) + j * 100;
}
else
{
Xx [2*i ] = 1 + ((double) i) / ((double) n) + j * 100 ;
Xx [2*i+1] = - ((double) i+1) / ((double) n + j) ;
if (j == NRHS-1)
{
Xx [2*i+1] = 0 ; /* zero imaginary part */
}
else if (j == NRHS-2)
{
Xx [2*i] = 0 ; /* zero real part */
}
}
}
Xx += isreal ? n : 2*n ;
}
/* B = A*X */
B = CHOLMOD_allocate_dense (n, NRHS, n, A->xtype, &ch) ;
CHOLMOD_sdmult (A, 0, one, zero, X, B, &ch) ;
Bx = B->x ;
/* ---------------------------------------------------------------------- */
/* test KLU */
/* ---------------------------------------------------------------------- */
test_memory_handler (&Common) ;
maxerr = do_solves (A, B, X, Puser, Quser, &Common, &ch, &nan) ;
/* ---------------------------------------------------------------------- */
/* basic error checking */
/* ---------------------------------------------------------------------- */
FAIL (klu_defaults (NULL)) ;
FAIL (klu_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_z_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_z_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_analyze (0, NULL, NULL, NULL)) ;
FAIL (klu_analyze (0, NULL, NULL, &Common)) ;
FAIL (klu_analyze_given (0, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_analyze_given (0, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_cholmod (0, NULL, NULL, NULL, NULL)) ;
FAIL (klu_factor (NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_factor (NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_z_factor (NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_z_factor (NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_refactor (NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_refactor (NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_z_refactor (NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_z_refactor (NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_rgrowth (NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_rgrowth (NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_z_rgrowth (NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_z_rgrowth (NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_condest (NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_condest (NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_z_condest (NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_z_condest (NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_flops (NULL, NULL, NULL)) ;
FAIL (klu_flops (NULL, NULL, &Common)) ;
FAIL (klu_z_flops (NULL, NULL, NULL)) ;
FAIL (klu_z_flops (NULL, NULL, &Common)) ;
FAIL (klu_rcond (NULL, NULL, NULL)) ;
FAIL (klu_rcond (NULL, NULL, &Common)) ;
FAIL (klu_z_rcond (NULL, NULL, NULL)) ;
FAIL (klu_z_rcond (NULL, NULL, &Common)) ;
FAIL (klu_free_symbolic (NULL, NULL)) ;
OK (klu_free_symbolic (NULL, &Common)) ;
FAIL (klu_free_numeric (NULL, NULL)) ;
OK (klu_free_numeric (NULL, &Common)) ;
FAIL (klu_z_free_numeric (NULL, NULL)) ;
OK (klu_z_free_numeric (NULL, &Common)) ;
FAIL (klu_scale (0, 0, NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_scale (0, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ;
OK (klu_scale (-1, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_z_scale (0, 0, NULL, NULL, NULL, NULL, NULL, NULL)) ;
FAIL (klu_z_scale (0, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ;
OK (klu_z_scale (-1, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ;
FAIL (klu_solve (NULL, NULL, 0, 0, NULL, NULL)) ;
FAIL (klu_solve (NULL, NULL, 0, 0, NULL, &Common)) ;
FAIL (klu_z_solve (NULL, NULL, 0, 0, NULL, NULL)) ;
FAIL (klu_z_solve (NULL, NULL, 0, 0, NULL, &Common)) ;
FAIL (klu_tsolve (NULL, NULL, 0, 0, NULL, NULL)) ;
FAIL (klu_tsolve (NULL, NULL, 0, 0, NULL, &Common)) ;
FAIL (klu_z_tsolve (NULL, NULL, 0, 0, NULL, 0, NULL)) ;
FAIL (klu_z_tsolve (NULL, NULL, 0, 0, NULL, 0, &Common)) ;
FAIL (klu_malloc (0, 0, NULL)) ;
FAIL (klu_malloc (0, 0, &Common)) ;
FAIL (klu_malloc (Int_MAX, 1, &Common)) ;
FAIL (klu_realloc (0, 0, 0, NULL, NULL)) ;
FAIL (klu_realloc (0, 0, 0, NULL, &Common)) ;
FAIL (klu_realloc (Int_MAX, 1, 0, NULL, &Common)) ;
Gunk = (Int *) klu_realloc (1, 0, sizeof (Int), NULL, &Common) ;
OK (Gunk) ;
OK (klu_realloc (Int_MAX, 1, sizeof (Int), Gunk, &Common)) ;
OK (Common.status == KLU_TOO_LARGE) ;
klu_free (Gunk, 1, sizeof (Int), &Common) ;
/* ---------------------------------------------------------------------- */
/* mangle the matrix, and other error checking */
/* ---------------------------------------------------------------------- */
printf ("\nerror handling:\n") ;
Symbolic = klu_analyze (n, Ap, Ai, &Common) ;
OK (Symbolic) ;
Xx = X->x ;
if (nz > 0)
{
/* ------------------------------------------------------------------ */
/* row index out of bounds */
/* ------------------------------------------------------------------ */
save = Ai [0] ;
Ai [0] = -1 ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
if (isreal)
{
FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
else
{
FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
Ai [0] = save ;
/* ------------------------------------------------------------------ */
/* row index out of bounds */
/* ------------------------------------------------------------------ */
save = Ai [0] ;
Ai [0] = Int_MAX ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
if (isreal)
{
FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
else
{
FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
Ai [0] = save ;
/* ------------------------------------------------------------------ */
/* column pointers mangled */
/* ------------------------------------------------------------------ */
save = Ap [n] ;
Ap [n] = -1 ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
if (isreal)
{
FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
else
{
FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
Ap [n] = save ;
/* ------------------------------------------------------------------ */
/* column pointers mangled */
/* ------------------------------------------------------------------ */
save = Ap [n] ;
Ap [n] = Ap [n-1] - 1 ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
if (isreal)
{
FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
else
{
FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
Ap [n] = save ;
/* ------------------------------------------------------------------ */
/* duplicates */
/* ------------------------------------------------------------------ */
if (n > 1 && Ap [1] - Ap [0] > 1)
{
save = Ai [1] ;
Ai [1] = Ai [0] ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
if (isreal)
{
FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
else
{
FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ;
}
Ai [1] = save ;
}
/* ------------------------------------------------------------------ */
/* invalid ordering */
/* ------------------------------------------------------------------ */
save = Common.ordering ;
Common.ordering = 42 ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
Common.ordering = save ;
/* ------------------------------------------------------------------ */
/* invalid ordering (klu_cholmod, with NULL user_ordering) */
/* ------------------------------------------------------------------ */
save = Common.ordering ;
Common.user_order = NULL ;
Common.ordering = 3 ;
FAIL (klu_analyze (n, Ap, Ai, &Common)) ;
Common.ordering = save ;
}
/* ---------------------------------------------------------------------- */
/* tests with valid symbolic factorization */
/* ---------------------------------------------------------------------- */
Common.halt_if_singular = FALSE ;
Common.scale = 0 ;
Numeric = NULL ;
if (nz > 0)
{
/* ------------------------------------------------------------------ */
/* Int overflow */
/* ------------------------------------------------------------------ */
if (n == 100)
{
Common.ordering = 2 ;
Symbolic2 = klu_analyze (n, Ap, Ai, &Common) ;
OK (Symbolic2) ;
Common.memgrow = Int_MAX ;
if (isreal)
{
Numeric = klu_factor (Ap, Ai, Ax, Symbolic2, &Common) ;
}
else
{
Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic2, &Common) ;
}
Common.memgrow = 1.2 ;
Common.ordering = 0 ;
klu_free_symbolic (&Symbolic2, &Common) ;
klu_free_numeric (&Numeric, &Common) ;
}
/* ------------------------------------------------------------------ */
/* Int overflow again */
/* ------------------------------------------------------------------ */
Common.initmem = Int_MAX ;
Common.initmem_amd = Int_MAX ;
if (isreal)
{
Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ;
}
else
{
Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ;
}
Common.initmem = 10 ;
Common.initmem_amd = 1.2 ;
klu_free_numeric (&Numeric, &Common) ;
/* ------------------------------------------------------------------ */
/* mangle the matrix */
/* ------------------------------------------------------------------ */
save = Ai [0] ;
Ai [0] = -1 ;
if (isreal)
{
Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ;
}
else
{
Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ;
}
FAIL (Numeric) ;
Ai [0] = save ;
/* ------------------------------------------------------------------ */
/* nan and inf handling */
/* ------------------------------------------------------------------ */
xsave = Ax [0] ;
Ax [0] = one [0] / zero [0] ;
if (isreal)
{
Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ;
klu_rcond (Symbolic, Numeric, &Common) ;
klu_condest (Ap, Ax, Symbolic, Numeric, &Common) ;
}
else
{
Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ;
klu_z_rcond (Symbolic, Numeric, &Common) ;
klu_z_condest (Ap, Ax, Symbolic, Numeric, &Common) ;
}
printf ("Nan case: rcond %g condest %g\n",
Common.rcond, Common.condest) ;
OK (Numeric) ;
Ax [0] = xsave ;
/* ------------------------------------------------------------------ */
/* mangle the matrix again */
/* ------------------------------------------------------------------ */
save = Ai [0] ;
Ai [0] = -1 ;
if (isreal)
{
FAIL (klu_refactor (Ap, Ai, Ax, Symbolic, Numeric, &Common)) ;
}
else
{
FAIL (klu_z_refactor (Ap, Ai, Ax, Symbolic, Numeric, &Common)) ;
}
Ai [0] = save ;
/* ------------------------------------------------------------------ */
/* all zero */
/* ------------------------------------------------------------------ */
A2 = CHOLMOD_copy_sparse (A, &ch) ;
A2x = A2->x ;
for (k = 0 ; k < nz * (isreal ? 1:2) ; k++)
{
A2x [k] = 0 ;
}
for (Common.halt_if_singular = 0 ; Common.halt_if_singular <= 1 ;
Common.halt_if_singular++)
{
for (Common.scale = -1 ; Common.scale <= 2 ; Common.scale++)
{
if (isreal)
{
klu_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ;
klu_condest (Ap, A2x, Symbolic, Numeric, &Common) ;
}
else
{
klu_z_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ;
klu_z_condest (Ap, A2x, Symbolic, Numeric, &Common) ;
}
OK (Common.status = KLU_SINGULAR) ;
}
}
CHOLMOD_free_sparse (&A2, &ch) ;
/* ------------------------------------------------------------------ */
/* all one, or all 1i for complex case */
/* ------------------------------------------------------------------ */
A2 = CHOLMOD_copy_sparse (A, &ch) ;
A2x = A2->x ;
for (k = 0 ; k < nz ; k++)
{
if (isreal)
{
A2x [k] = 1 ;
}
else
{
A2x [2*k ] = 0 ;
A2x [2*k+1] = 1 ;
}
}
Common.halt_if_singular = 0 ;
Common.scale = 0 ;
if (isreal)
{
klu_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ;
klu_condest (Ap, A2x, Symbolic, Numeric, &Common) ;
}
else
{
klu_z_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ;
klu_z_condest (Ap, A2x, Symbolic, Numeric, &Common) ;
}
OK (Common.status = KLU_SINGULAR) ;
CHOLMOD_free_sparse (&A2, &ch) ;
}
klu_free_symbolic (&Symbolic, &Common) ;
if (isreal)
{
klu_free_numeric (&Numeric, &Common) ;
}
else
{
klu_z_free_numeric (&Numeric, &Common) ;
}
/* ---------------------------------------------------------------------- */
/* free problem and quit */
/* ---------------------------------------------------------------------- */
CHOLMOD_free_dense (&X, &ch) ;
CHOLMOD_free_dense (&B, &ch) ;
CHOLMOD_free_sparse (&A, &ch) ;
free (Puser) ;
free (Quser) ;
CHOLMOD_finish (&ch) ;
fprintf (stderr, " maxerr %10.3e", maxerr) ;
printf (" maxerr %10.3e", maxerr) ;
if (maxerr < 1e-8)
{
fprintf (stderr, " test passed") ;
printf (" test passed") ;
}
else
{
fprintf (stderr, " test FAILED") ;
printf (" test FAILED") ;
}
if (nan)
{
fprintf (stderr, " *") ;
printf (" *") ;
}
fprintf (stderr, "\n") ;
printf ("\n-----------------------------------------------------------\n") ;
return (0) ;
}
