static int IDAKLUSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight,
N_Vector ycur, N_Vector ypcur, N_Vector rrcur)
{
int flag;
realtype cjratio;
IDASlsMem idasls_mem;
KLUData klu_data;
SlsMat JacMat;
realtype *bd;
idasls_mem = (IDASlsMem) IDA_mem->ida_lmem;
JacMat = idasls_mem->s_JacMat;
cjratio = IDA_mem->ida_cjratio;
klu_data = (KLUData) idasls_mem->s_solver_data;
bd = N_VGetArrayPointer(b);
/* Call KLU to solve the linear system */
flag = klu_solve(klu_data->s_Symbolic, klu_data->s_Numeric, JacMat->N, 1, bd,
&(klu_data->s_Common));
if (flag == 0) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSolve",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
/* Scale the correction to account for change in cj. */
if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b);
idasls_mem->s_last_flag = IDASLS_SUCCESS;
return(IDASLS_SUCCESS);
}
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) ;
}
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;
}
/*
Perform linear solve with KLU. This process is pretty quick once the
fill-reducing orderings and numeric factorizations are performed.
*/
int SolveKlu(KINMem kin_memory, N_Vector x, N_Vector b, realtype *res_norm){
//get the klu memory block
KINKluMem kin_klu_mem = (KINKluMem)kin_memory->kin_lmem;
if(!kin_klu_mem) return 1;
//grab the right-hand side data from the nvector passed in
double *b_data = NV_DATA_S(b);
int i,n=kin_klu_mem->n;
klu_symbolic *symb=kin_klu_mem->symbolic;
klu_numeric *numeric=kin_klu_mem->numeric;
klu_common *comm=&(kin_klu_mem->klu_comm);
SetupKINKlu(kin_memory);
//perform the linear solve
klu_solve(symb, numeric, n, 1, b_data, comm);
NV_DATA_S(x)=b_data;
//return
return 0;
};
static int cvKLUSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight,
N_Vector ycur, N_Vector fcur)
{
int flag, lmm;
realtype gamrat;
CVSlsMem cvsls_mem;
KLUData klu_data;
SlsMat JacMat;
realtype *bd;
gamrat = cv_mem->cv_gamrat;
lmm = cv_mem->cv_lmm;
cvsls_mem = (CVSlsMem) cv_mem->cv_lmem;
JacMat = cvsls_mem->s_JacMat;
klu_data = (KLUData) cvsls_mem->s_solver_data;
bd = N_VGetArrayPointer(b);
/* Call KLU to solve the linear system */
flag = klu_solve(klu_data->s_Symbolic, klu_data->s_Numeric, JacMat->N, 1, bd,
&(klu_data->s_Common));
if (flag == 0) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "CVKLUSolve",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
/* Scale the correction to account for change in gamma. */
if ((lmm == CV_BDF) && (gamrat != ONE)) {
N_VScale(TWO/(ONE + gamrat), b, b);
}
cvsls_mem->s_last_flag = CVSLS_SUCCESS;
return(CVSLS_SUCCESS);
}
/*! \fn solve linear system with Klu method
*
* \param [in] [data]
* [sysNumber] index of the corresponding linear system
*
*
* author: wbraun
*/
int
solveKlu(DATA *data, threadData_t *threadData, int sysNumber)
{
void *dataAndThreadData[2] = {data, threadData};
LINEAR_SYSTEM_DATA* systemData = &(data->simulationInfo->linearSystemData[sysNumber]);
DATA_KLU* solverData = (DATA_KLU*)systemData->solverData;
int i, j, status = 0, success = 0, n = systemData->size, eqSystemNumber = systemData->equationIndex, indexes[2] = {1,eqSystemNumber};
infoStreamPrintWithEquationIndexes(LOG_LS, 0, indexes, "Start solving Linear System %d (size %d) at time %g with Klu Solver",
eqSystemNumber, (int) systemData->size,
data->localData[0]->timeValue);
rt_ext_tp_tick(&(solverData->timeClock));
if (0 == systemData->method)
{
/* set A matrix */
solverData->Ap[0] = 0;
systemData->setA(data, threadData, systemData);
solverData->Ap[solverData->n_row] = solverData->nnz;
if (ACTIVE_STREAM(LOG_LS_V))
{
infoStreamPrint(LOG_LS_V, 1, "Matrix A");
printMatrixCSR(solverData->Ap, solverData->Ai, solverData->Ax, n);
messageClose(LOG_LS_V);
}
/* set b vector */
systemData->setb(data, threadData, systemData);
} else {
solverData->Ap[0] = 0;
/* calculate jacobian -> matrix A*/
if(systemData->jacobianIndex != -1){
getAnalyticalJacobian(data, threadData, sysNumber);
} else {
assertStreamPrint(threadData, 1, "jacobian function pointer is invalid" );
}
solverData->Ap[solverData->n_row] = solverData->nnz;
/* calculate vector b (rhs) */
memcpy(solverData->work, systemData->x, sizeof(double)*solverData->n_row);
residual_wrapper(solverData->work, systemData->b, dataAndThreadData, sysNumber);
}
infoStreamPrint(LOG_LS, 0, "### %f time to set Matrix A and vector b.", rt_ext_tp_tock(&(solverData->timeClock)));
if (ACTIVE_STREAM(LOG_LS_V))
{
if (ACTIVE_STREAM(LOG_LS_V))
{
infoStreamPrint(LOG_LS_V, 1, "Old solution x:");
for(i = 0; i < solverData->n_row; ++i)
infoStreamPrint(LOG_LS_V, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->x[i]);
messageClose(LOG_LS_V);
}
infoStreamPrint(LOG_LS_V, 1, "Matrix A n_rows = %d", solverData->n_row);
for (i=0; i<solverData->n_row; i++){
infoStreamPrint(LOG_LS_V, 0, "%d. Ap => %d -> %d", i, solverData->Ap[i], solverData->Ap[i+1]);
for (j=solverData->Ap[i]; j<solverData->Ap[i+1]; j++){
infoStreamPrint(LOG_LS_V, 0, "A[%d,%d] = %f", i, solverData->Ai[j], solverData->Ax[j]);
}
}
messageClose(LOG_LS_V);
for (i=0; i<solverData->n_row; i++)
infoStreamPrint(LOG_LS_V, 0, "b[%d] = %e", i, systemData->b[i]);
}
rt_ext_tp_tick(&(solverData->timeClock));
/* symbolic pre-ordering of A to reduce fill-in of L and U */
if (0 == solverData->numberSolving)
{
infoStreamPrint(LOG_LS_V, 0, "Perform analyze settings:\n - ordering used: %d\n - current status: %d", solverData->common.ordering, solverData->common.status);
solverData->symbolic = klu_analyze(solverData->n_col, solverData->Ap, solverData->Ai, &solverData->common);
}
/* compute the LU factorization of A */
if (0 == solverData->common.status){
solverData->numeric = klu_factor(solverData->Ap, solverData->Ai, solverData->Ax, solverData->symbolic, &solverData->common);
}
if (0 == solverData->common.status){
if (1 == systemData->method){
if (klu_solve(solverData->symbolic, solverData->numeric, solverData->n_col, 1, systemData->b, &solverData->common)){
success = 1;
}
} else {
if (klu_tsolve(solverData->symbolic, solverData->numeric, solverData->n_col, 1, systemData->b, &solverData->common)){
success = 1;
}
}
}
infoStreamPrint(LOG_LS, 0, "Solve System: %f", rt_ext_tp_tock(&(solverData->timeClock)));
/* print solution */
if (1 == success){
if (1 == systemData->method){
/* take the solution */
for(i = 0; i < solverData->n_row; ++i)
systemData->x[i] += systemData->b[i];
/* update inner equations */
residual_wrapper(systemData->x, solverData->work, dataAndThreadData, sysNumber);
} else {
/* the solution is automatically in x */
memcpy(systemData->x, systemData->b, sizeof(double)*systemData->size);
}
if (ACTIVE_STREAM(LOG_LS_V))
{
infoStreamPrint(LOG_LS_V, 1, "Solution x:");
infoStreamPrint(LOG_LS_V, 0, "System %d numVars %d.", eqSystemNumber, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).numVar);
for(i = 0; i < systemData->size; ++i)
infoStreamPrint(LOG_LS_V, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->x[i]);
messageClose(LOG_LS_V);
}
}
else
{
warningStreamPrint(LOG_STDOUT, 0,
"Failed to solve linear system of equations (no. %d) at time %f, system status %d.",
(int)systemData->equationIndex, data->localData[0]->timeValue, status);
}
solverData->numberSolving += 1;
return 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) ;
}
static double do_1_solve (cholmod_sparse *A, cholmod_dense *B,
cholmod_dense *Xknown, Int *Puser, Int *Quser,
KLU_common *Common, cholmod_common *ch, Int *nan)
{
Int *Ai, *Ap ;
double *Ax, *Bx, *Xknownx, *Xx, *Ax2, *Axx ;
KLU_symbolic *Symbolic = NULL ;
KLU_numeric *Numeric = NULL ;
cholmod_dense *X = NULL, *R = NULL ;
cholmod_sparse *AT = NULL, *A2 = NULL, *AT2 = NULL ;
double one [2], minusone [2],
rnorm, anorm, bnorm, xnorm, relresid, relerr, err = 0. ;
Int i, j, nrhs2, isreal, n, nrhs, transpose, step, k, save, tries ;
printf ("\ndo_1_solve: btf "ID" maxwork %g scale "ID" ordering "ID" user: "******" P,Q: %d halt: "ID"\n",
Common->btf, Common->maxwork, Common->scale, Common->ordering,
Common->user_data ? (*((Int *) Common->user_data)) : -1,
(Puser != NULL || Quser != NULL), Common->halt_if_singular) ;
fflush (stdout) ;
fflush (stderr) ;
CHOLMOD_print_sparse (A, "A", ch) ;
CHOLMOD_print_dense (B, "B", ch) ;
Ap = A->p ;
Ai = A->i ;
Ax = A->x ;
n = A->nrow ;
isreal = (A->xtype == CHOLMOD_REAL) ;
Bx = B->x ;
Xknownx = Xknown->x ;
nrhs = B->ncol ;
one [0] = 1 ;
one [1] = 0 ;
minusone [0] = -1 ;
minusone [1] = 0 ;
/* ---------------------------------------------------------------------- */
/* symbolic analysis */
/* ---------------------------------------------------------------------- */
Symbolic = NULL ;
my_tries = 0 ;
for (tries = 0 ; Symbolic == NULL && my_tries == 0 ; tries++)
{
my_tries = tries ;
if (Puser != NULL || Quser != NULL)
{
Symbolic = klu_analyze_given (n, Ap, Ai, Puser, Quser, Common) ;
}
else
{
Symbolic = klu_analyze (n, Ap, Ai, Common) ;
}
}
printf ("sym try "ID" btf "ID" ordering "ID"\n",
tries, Common->btf, Common->ordering) ;
if (Symbolic == NULL)
{
printf ("Symbolic is null\n") ;
return (998) ;
}
my_tries = -1 ;
/* create a modified version of A */
A2 = CHOLMOD_copy_sparse (A, ch) ;
Ax2 = A2->x ;
my_srand (42) ;
for (k = 0 ; k < Ap [n] * (isreal ? 1:2) ; k++)
{
Ax2 [k] = Ax [k] *
(1 + 1e-4 * ((double) my_rand ( )) / ((double) MY_RAND_MAX)) ;
}
AT = isreal ? NULL : CHOLMOD_transpose (A, 1, ch) ;
AT2 = isreal ? NULL : CHOLMOD_transpose (A2, 1, ch) ;
/* ---------------------------------------------------------------------- */
/* factorize then solve */
/* ---------------------------------------------------------------------- */
for (step = 1 ; step <= 3 ; step++)
{
printf ("step: "ID"\n", step) ;
fflush (stdout) ;
/* ------------------------------------------------------------------ */
/* factorization or refactorization */
/* ------------------------------------------------------------------ */
/* step 1: factor
step 2: refactor with same A
step 3: refactor with modified A, and scaling forced on
and solve each time
*/
if (step == 1)
{
/* numeric factorization */
Numeric = NULL ;
my_tries = 0 ;
for (tries = 0 ; Numeric == NULL && my_tries == 0 ; tries++)
{
my_tries = tries ;
if (isreal)
{
Numeric = klu_factor (Ap, Ai, Ax, Symbolic, Common) ;
}
else
{
Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, Common) ;
}
}
printf ("num try "ID" btf "ID"\n", tries, Common->btf) ;
my_tries = -1 ;
if (Common->status == KLU_OK ||
(Common->status == KLU_SINGULAR && !Common->halt_if_singular))
{
OK (Numeric) ;
}
else
{
FAIL (Numeric) ;
}
if (Common->status < KLU_OK)
{
printf ("factor failed: "ID"\n", Common->status) ;
}
}
else if (step == 2)
{
/* numeric refactorization with same values, same scaling */
if (isreal)
{
klu_refactor (Ap, Ai, Ax, Symbolic, Numeric, Common) ;
}
else
{
klu_z_refactor (Ap, Ai, Ax, Symbolic, Numeric, Common) ;
}
}
else
{
/* numeric refactorization with different values */
save = Common->scale ;
if (Common->scale == 0)
{
Common->scale = 1 ;
}
for (tries = 0 ; tries <= 1 ; tries++)
{
my_tries = tries ;
if (isreal)
{
klu_refactor (Ap, Ai, Ax2, Symbolic, Numeric, Common) ;
}
else
{
klu_z_refactor (Ap, Ai, Ax2, Symbolic, Numeric, Common) ;
}
}
my_tries = -1 ;
Common->scale = save ;
}
if (Common->status == KLU_SINGULAR)
{
printf ("# singular column : "ID"\n", Common->singular_col) ;
}
/* ------------------------------------------------------------------ */
/* diagnostics */
/* ------------------------------------------------------------------ */
Axx = (step == 3) ? Ax2 : Ax ;
if (isreal)
{
klu_rgrowth (Ap, Ai, Axx, Symbolic, Numeric, Common) ;
klu_condest (Ap, Axx, Symbolic, Numeric, Common) ;
klu_rcond (Symbolic, Numeric, Common) ;
klu_flops (Symbolic, Numeric, Common) ;
}
else
{
klu_z_rgrowth (Ap, Ai, Axx, Symbolic, Numeric, Common) ;
klu_z_condest (Ap, Axx, Symbolic, Numeric, Common) ;
klu_z_rcond (Symbolic, Numeric, Common) ;
klu_z_flops (Symbolic, Numeric, Common) ;
}
printf ("growth %g condest %g rcond %g flops %g\n",
Common->rgrowth, Common->condest, Common->rcond, Common->flops) ;
ludump (Symbolic, Numeric, isreal, ch, Common) ;
if (Numeric == NULL || Common->status < KLU_OK)
{
continue ;
}
/* ------------------------------------------------------------------ */
/* solve */
/* ------------------------------------------------------------------ */
/* forward/backsolve to solve A*X=B or A'*X=B */
for (transpose = (isreal ? 0 : -1) ; transpose <= 1 ; transpose++)
{
for (nrhs2 = 1 ; nrhs2 <= nrhs ; nrhs2++)
{
/* mangle B so that it has only nrhs2 columns */
B->ncol = nrhs2 ;
X = CHOLMOD_copy_dense (B, ch) ;
CHOLMOD_print_dense (X, "X before solve", ch) ;
Xx = X->x ;
if (isreal)
{
if (transpose)
{
/* solve A'x=b */
klu_tsolve (Symbolic, Numeric, n, nrhs2, Xx, Common) ;
}
else
{
/* solve A*x=b */
klu_solve (Symbolic, Numeric, n, nrhs2, Xx, Common) ;
}
}
else
{
if (transpose)
{
/* solve A'x=b (if 1) or A.'x=b (if -1) */
klu_z_tsolve (Symbolic, Numeric, n, nrhs2, Xx,
(transpose == 1), Common) ;
}
else
{
/* solve A*x=b */
klu_z_solve (Symbolic, Numeric, n, nrhs2, Xx, Common) ;
}
}
CHOLMOD_print_dense (X, "X", ch) ;
/* compute the residual, R = B-A*X, B-A'*X, or B-A.'*X */
R = CHOLMOD_copy_dense (B, ch) ;
if (transpose == -1)
{
/* R = B-A.'*X (use A.' explicitly) */
CHOLMOD_sdmult ((step == 3) ? AT2 : AT,
0, minusone, one, X, R, ch) ;
}
else
{
/* R = B-A*X or B-A'*X */
CHOLMOD_sdmult ((step == 3) ? A2 :A,
transpose, minusone, one, X, R, ch) ;
}
CHOLMOD_print_dense (R, "R", ch) ;
/* compute the norms of R, A, X, and B */
rnorm = CHOLMOD_norm_dense (R, 1, ch) ;
anorm = CHOLMOD_norm_sparse ((step == 3) ? A2 : A, 1, ch) ;
xnorm = CHOLMOD_norm_dense (X, 1, ch) ;
bnorm = CHOLMOD_norm_dense (B, 1, ch) ;
CHOLMOD_free_dense (&R, ch) ;
/* relative residual = norm (r) / (norm (A) * norm (x)) */
relresid = rnorm ;
if (anorm > 0)
{
relresid /= anorm ;
}
if (xnorm > 0)
{
relresid /= xnorm ;
}
if (SCALAR_IS_NAN (relresid))
{
*nan = TRUE ;
}
else
{
err = MAX (err, relresid) ;
}
/* relative error = norm (x - xknown) / norm (xknown) */
/* overwrite X with X - Xknown */
if (transpose || step == 3)
{
/* not computed */
relerr = -1 ;
}
else
{
for (j = 0 ; j < nrhs2 ; j++)
{
for (i = 0 ; i < n ; i++)
{
if (isreal)
{
Xx [i+j*n] -= Xknownx [i+j*n] ;
}
else
{
Xx [2*(i+j*n) ] -= Xknownx [2*(i+j*n) ] ;
Xx [2*(i+j*n)+1] -= Xknownx [2*(i+j*n)+1] ;
}
}
}
relerr = CHOLMOD_norm_dense (X, 1, ch) ;
xnorm = CHOLMOD_norm_dense (Xknown, 1, ch) ;
if (xnorm > 0)
{
relerr /= xnorm ;
}
if (SCALAR_IS_NAN (relerr))
{
*nan = TRUE ;
}
else
{
err = MAX (relerr, err) ;
}
}
CHOLMOD_free_dense (&X, ch) ;
printf (ID" "ID" relresid %10.3g relerr %10.3g %g\n",
transpose, nrhs2, relresid, relerr, err) ;
B->ncol = nrhs ; /* restore B */
}
}
}
/* ---------------------------------------------------------------------- */
/* free factorization and temporary matrices, and return */
/* ---------------------------------------------------------------------- */
klu_free_symbolic (&Symbolic, Common) ;
if (isreal)
{
klu_free_numeric (&Numeric, Common) ;
}
else
{
klu_z_free_numeric (&Numeric, Common) ;
}
CHOLMOD_free_sparse (&A2, ch) ;
CHOLMOD_free_sparse (&AT, ch) ;
CHOLMOD_free_sparse (&AT2, ch) ;
fflush (stdout) ;
fflush (stderr) ;
return (err) ;
}
