int UMF_cholmod
(
/* inputs */
Int nrow, /* A is nrow-by-ncol */
Int ncol, /* A is nrow-by-ncol */
Int symmetric, /* if true and nrow=ncol do A+A', else do A'A */
Int Ap [ ], /* column pointers, size ncol+1 */
Int Ai [ ], /* row indices, size nz = Ap [ncol] */
/* output */
Int Perm [ ], /* fill-reducing permutation, size ncol */
/* user-defined */
void *user_params, /* Int array of size 3 */
double user_info [3] /* [0]: max col count for L=chol(P(A+A')P')
[1]: nnz (L)
[2]: flop count for chol, if A real */
)
{
#ifndef NCHOLMOD
double dmax, flops, c, lnz ;
cholmod_sparse Amatrix, *A, *AT, *S ;
cholmod_factor *L ;
cholmod_common cm ;
Int *P, *ColCount ;
Int k, ordering_option, print_level, *params ;
params = (Int *) user_params ;
ordering_option = params [0] ;
print_level = params [1] - 1 ;
params [2] = -1 ;
if (Ap == NULL || Ai == NULL || Perm == NULL || nrow < 0 || ncol < 0)
{
/* invalid inputs */
return (FALSE) ;
}
if (nrow != ncol)
{
/* force symmetric to be false */
symmetric = FALSE ;
}
/* start CHOLMOD */
CHOLMOD_start (&cm) ;
cm.supernodal = CHOLMOD_SIMPLICIAL ;
cm.print = print_level ;
/* adjust cm based on ordering_option */
switch (ordering_option)
{
default:
case UMFPACK_ORDERING_AMD:
/* AMD on A+A' if symmetric, COLAMD on A otherwise */
cm.nmethods = 1 ;
cm.method [0].ordering = symmetric ? CHOLMOD_AMD : CHOLMOD_COLAMD ;
cm.postorder = TRUE ;
break ;
case UMFPACK_ORDERING_METIS:
/* metis on A+A' if symmetric, A'A otherwise */
cm.nmethods = 1 ;
cm.method [0].ordering = CHOLMOD_METIS ;
cm.postorder = TRUE ;
break ;
case UMFPACK_ORDERING_NONE:
case UMFPACK_ORDERING_GIVEN:
case UMFPACK_ORDERING_USER:
/* no ordering. No input permutation here, and no user
function, so all these are the same as "none". */
cm.nmethods = 1 ;
cm.method [0].ordering = CHOLMOD_NATURAL ;
cm.postorder = FALSE ;
break ;
case UMFPACK_ORDERING_BEST:
/* try AMD, METIS and NESDIS on A+A', or COLAMD(A), METIS(A'A),
and NESDIS (A'A) */
cm.nmethods = 3 ;
cm.method [0].ordering = symmetric ? CHOLMOD_AMD : CHOLMOD_COLAMD ;
cm.method [1].ordering = CHOLMOD_METIS ;
cm.method [2].ordering = CHOLMOD_NESDIS ;
cm.postorder = TRUE ;
break ;
case UMFPACK_ORDERING_CHOLMOD:
/* no change to CHOLMOD defaults:
Do not use given permutation, since it's not provided.
Try AMD. If fill-in and flop count are low, use AMD.
Otherwise, try METIS and take the best of AMD and METIS.
cm.method [0].ordering = CHOLMOD_GIVEN
cm.method [1].ordering = CHOLMOD_AMD
cm.method [2].ordering = CHOLMOD_METIS
cm.nmethods = 2 if METIS installed, 3 otherwise ('given' is skipped)
*/
break ;
}
/* construct a CHOLMOD version of the input matrix A */
A = &Amatrix ;
A->nrow = nrow ; /* A is nrow-by-ncol */
A->ncol = ncol ;
A->nzmax = Ap [ncol] ; /* with nzmax entries */
A->packed = TRUE ; /* there is no A->nz array */
if (symmetric)
{
A->stype = 1 ; /* A is symmetric */
}
else
{
A->stype = 0 ; /* A is unsymmetric */
}
A->itype = CHOLMOD_INT ;
A->xtype = CHOLMOD_PATTERN ;
A->dtype = CHOLMOD_DOUBLE ;
A->nz = NULL ;
A->p = Ap ; /* column pointers */
A->i = Ai ; /* row indices */
A->x = NULL ; /* no numerical values */
A->z = NULL ;
A->sorted = FALSE ; /* columns of A might not be sorted */
if (symmetric)
{
/* CHOLMOD with order the symmetric matrix A */
AT = NULL ;
S = A ;
}
else
{
/* S = A'. CHOLMOD will order S*S', which is A'*A */
AT = CHOLMOD_transpose (A, 0, &cm) ;
S = AT ;
}
/* order and analyze S or S*S' */
L = CHOLMOD_analyze (S, &cm) ;
CHOLMOD_free_sparse (&AT, &cm) ;
if (L == NULL)
{
return (FALSE) ;
}
/* determine the ordering used */
switch (L->ordering)
{
case CHOLMOD_AMD:
case CHOLMOD_COLAMD:
params [2] = UMFPACK_ORDERING_AMD ;
break ;
case CHOLMOD_METIS:
case CHOLMOD_NESDIS:
params [2] = UMFPACK_ORDERING_METIS ;
break ;
case CHOLMOD_GIVEN:
case CHOLMOD_NATURAL:
default:
params [2] = UMFPACK_ORDERING_NONE ;
break ;
}
/* copy the permutation from L to the output and compute statistics */
P = L->Perm ;
ColCount = L->ColCount ;
dmax = 1 ;
lnz = 0 ;
flops = 0 ;
for (k = 0 ; k < ncol ; k++)
{
Perm [k] = P [k] ;
c = ColCount [k] ;
if (c > dmax) dmax = c ;
lnz += c ;
flops += c*c ;
}
user_info [0] = dmax ;
user_info [1] = lnz ;
user_info [2] = flops ;
CHOLMOD_free_factor (&L, &cm) ;
if (print_level > 0)
{
CHOLMOD_print_common ("for UMFPACK", &cm) ;
}
CHOLMOD_finish (&cm) ;
return (TRUE) ;
#else
/* CHOLMOD and its supporting packages (CAMD, CCOLAMD, COLAMD, metis-4.0)
not installed */
return (FALSE) ;
#endif
}
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) ;
}