cholmod_sparse *CHOLMOD(triplet_to_sparse)
(
/* ---- input ---- */
cholmod_triplet *T, /* matrix to copy */
size_t nzmax, /* allocate at least this much space in output matrix */
/* --------------- */
cholmod_common *Common
)
{
cholmod_sparse *R, *A = NULL ;
Int *Wj, *Rp, *Ri, *Rnz, *Ti, *Tj ;
Int i, j, p, k, stype, nrow, ncol, nz, ok ;
size_t anz = 0 ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (T, NULL) ;
Ti = T->i ;
Tj = T->j ;
RETURN_IF_NULL (Ti, NULL) ;
RETURN_IF_NULL (Tj, NULL) ;
RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
stype = SIGN (T->stype) ;
if (stype && T->nrow != T->ncol)
{
/* inputs invalid */
ERROR (CHOLMOD_INVALID, "matrix invalid") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
DEBUG (CHOLMOD(dump_triplet) (T, "T", Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
nrow = T->nrow ;
ncol = T->ncol ;
nz = T->nnz ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(allocate_work) (0, MAX (nrow, ncol), 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
/* ---------------------------------------------------------------------- */
/* allocate temporary matrix R */
/* ---------------------------------------------------------------------- */
R = CHOLMOD(allocate_sparse) (ncol, nrow, nz, FALSE, FALSE, -stype,
T->xtype, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
Rp = R->p ;
Ri = R->i ;
Rnz = R->nz ;
/* ---------------------------------------------------------------------- */
/* count the entries in each row of A (also counting duplicates) */
/* ---------------------------------------------------------------------- */
for (i = 0 ; i < nrow ; i++)
{
Rnz [i] = 0 ;
}
if (stype > 0)
{
for (k = 0 ; k < nz ; k++)
{
i = Ti [k] ;
j = Tj [k] ;
if (i < 0 || i >= nrow || j < 0 || j >= ncol)
{
ERROR (CHOLMOD_INVALID, "index out of range") ;
break ;
}
/* A will be symmetric with just the upper triangular part stored.
* Create a matrix R that is lower triangular. Entries in the
* upper part of R are transposed to the lower part. */
Rnz [MIN (i,j)]++ ;
}
}
else if (stype < 0)
{
for (k = 0 ; k < nz ; k++)
{
i = Ti [k] ;
j = Tj [k] ;
if (i < 0 || i >= nrow || j < 0 || j >= ncol)
{
ERROR (CHOLMOD_INVALID, "index out of range") ;
break ;
}
/* A will be symmetric with just the lower triangular part stored.
* Create a matrix R that is upper triangular. Entries in the
* lower part of R are transposed to the upper part. */
Rnz [MAX (i,j)]++ ;
}
}
else
{
for (k = 0 ; k < nz ; k++)
{
i = Ti [k] ;
j = Tj [k] ;
if (i < 0 || i >= nrow || j < 0 || j >= ncol)
{
ERROR (CHOLMOD_INVALID, "index out of range") ;
break ;
}
/* constructing an unsymmetric matrix */
Rnz [i]++ ;
}
}
if (Common->status < CHOLMOD_OK)
{
/* triplet matrix is invalid */
CHOLMOD(free_sparse) (&R, Common) ;
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* construct the row pointers */
/* ---------------------------------------------------------------------- */
p = 0 ;
for (i = 0 ; i < nrow ; i++)
{
Rp [i] = p ;
p += Rnz [i] ;
}
Rp [nrow] = p ;
/* use Wj (i/l/l) as temporary row pointers */
Wj = Common->Iwork ; /* size MAX (nrow,ncol) FUTURE WORK: (i/l/l) */
for (i = 0 ; i < nrow ; i++)
{
Wj [i] = Rp [i] ;
}
/* ---------------------------------------------------------------------- */
/* construct triplet matrix, using template routine */
/* ---------------------------------------------------------------------- */
switch (T->xtype)
{
case CHOLMOD_PATTERN:
anz = p_cholmod_triplet_to_sparse (T, R, Common) ;
break ;
case CHOLMOD_REAL:
anz = r_cholmod_triplet_to_sparse (T, R, Common) ;
break ;
case CHOLMOD_COMPLEX:
anz = c_cholmod_triplet_to_sparse (T, R, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
anz = z_cholmod_triplet_to_sparse (T, R, Common) ;
break ;
}
/* ---------------------------------------------------------------------- */
/* A = R' (array transpose, not complex conjugate transpose) */
/* ---------------------------------------------------------------------- */
/* workspace: Iwork (R->nrow), which is A->ncol */
ASSERT (CHOLMOD(dump_sparse) (R, "R", Common) >= 0) ;
A = CHOLMOD(allocate_sparse) (nrow, ncol, MAX (anz, nzmax), TRUE, TRUE,
stype, T->xtype, Common) ;
if (stype)
{
ok = CHOLMOD(transpose_sym) (R, 1, NULL, A, Common) ;
}
else
{
ok = CHOLMOD(transpose_unsym) (R, 1, NULL, NULL, 0, A, Common) ;
}
CHOLMOD(free_sparse) (&R, Common) ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_sparse) (&A, Common) ;
}
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_sparse) (A, "A = triplet(T) result", Common) >= 0) ;
return (A) ;
}
double CHOLMOD(rcond) /* return min(diag(L)) / max(diag(L)) */
(
/* ---- input ---- */
cholmod_factor *L,
/* --------------- */
cholmod_common *Common
)
{
double lmin, lmax ;
double *Lx ;
Int *Lpi, *Lpx, *Super, *Lp ;
Int n, e, nsuper, s, k1, k2, psi, psend, psx, nsrow, nscol, jj, j ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (EMPTY) ;
RETURN_IF_NULL (L, EMPTY) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, EMPTY) ;
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
n = L->n ;
if (n == 0)
{
return (1) ;
}
if (L->minor < L->n)
{
return (0) ;
}
e = (L->xtype == CHOLMOD_COMPLEX) ? 2 : 1 ;
if (L->is_super)
{
/* L is supernodal */
nsuper = L->nsuper ; /* number of supernodes in L */
Lpi = L->pi ; /* column pointers for integer pattern */
Lpx = L->px ; /* column pointers for numeric values */
Super = L->super ; /* supernode sizes */
Lx = L->x ; /* numeric values */
FIRST_LMINMAX (Lx [0], lmin, lmax) ; /* first diagonal entry of L */
for (s = 0 ; s < nsuper ; s++)
{
k1 = Super [s] ; /* first column in supernode s */
k2 = Super [s+1] ; /* last column in supernode is k2-1 */
psi = Lpi [s] ; /* first row index is L->s [psi] */
psend = Lpi [s+1] ; /* last row index is L->s [psend-1] */
psx = Lpx [s] ; /* first numeric entry is Lx [psx] */
nsrow = psend - psi ; /* supernode is nsrow-by-nscol */
nscol = k2 - k1 ;
for (jj = 0 ; jj < nscol ; jj++)
{
LMINMAX (Lx [e * (psx + jj + jj*nsrow)], lmin, lmax) ;
}
}
}
else
{
/* L is simplicial */
Lp = L->p ;
Lx = L->x ;
if (L->is_ll)
{
/* LL' factorization */
FIRST_LMINMAX (Lx [Lp [0]], lmin, lmax) ;
for (j = 1 ; j < n ; j++)
{
LMINMAX (Lx [e * Lp [j]], lmin, lmax) ;
}
}
else
{
/* LDL' factorization, the diagonal might be negative */
FIRST_LMINMAX (fabs (Lx [Lp [0]]), lmin, lmax) ;
for (j = 1 ; j < n ; j++)
{
LMINMAX (fabs (Lx [e * Lp [j]]), lmin, lmax) ;
}
}
}
return (lmin / lmax) ;
}
int CHOLMOD(resymbol)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to analyze */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
int pack, /* if TRUE, pack the columns of L */
/* ---- in/out --- */
cholmod_factor *L, /* factorization, entries pruned on output */
/* --------------- */
cholmod_common *Common
)
{
cholmod_sparse *H, *F, *G ;
Int ok, stype, nrow, ncol ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
if (L->is_super)
{
/* cannot operate on a supernodal factorization */
ERROR (CHOLMOD_INVALID, "cannot operate on supernodal L") ;
return (FALSE) ;
}
if (L->n != A->nrow)
{
/* dimensions must agree */
ERROR (CHOLMOD_INVALID, "A and L dimensions do not match") ;
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
stype = A->stype ;
nrow = A->nrow ;
ncol = A->ncol ;
CHOLMOD(allocate_work) (nrow, 2*nrow + (stype ? 0 : ncol), 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* permute the input matrix if necessary */
/* ---------------------------------------------------------------------- */
H = NULL ;
G = NULL ;
if (stype > 0)
{
if (L->ordering == CHOLMOD_NATURAL)
{
/* F = triu(A)' */
/* workspace: Iwork (nrow) */
G = CHOLMOD(ptranspose) (A, 0, NULL, NULL, 0, Common) ;
}
else
{
/* F = triu(A(p,p))' */
/* workspace: Iwork (2*nrow) */
G = CHOLMOD(ptranspose) (A, 0, L->Perm, NULL, 0, Common) ;
}
F = G ;
}
else if (stype < 0)
{
if (L->ordering == CHOLMOD_NATURAL)
{
F = A ;
}
else
{
/* G = triu(A(p,p))' */
/* workspace: Iwork (2*nrow) */
G = CHOLMOD(ptranspose) (A, 0, L->Perm, NULL, 0, Common) ;
/* H = G' */
/* workspace: Iwork (nrow) */
H = CHOLMOD(ptranspose) (G, 0, NULL, NULL, 0, Common) ;
F = H ;
}
}
else
{
if (L->ordering == CHOLMOD_NATURAL)
{
F = A ;
}
else
{
/* G = A(p,f)' */
/* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/
G = CHOLMOD(ptranspose) (A, 0, L->Perm, fset, fsize, Common) ;
/* H = G' */
/* workspace: Iwork (ncol) */
H = CHOLMOD(ptranspose) (G, 0, NULL, NULL, 0, Common) ;
F = H ;
}
}
/* No need to check for failure here. cholmod_resymbol_noperm will return
* FALSE if F is NULL. */
/* ---------------------------------------------------------------------- */
/* resymbol */
/* ---------------------------------------------------------------------- */
ok = CHOLMOD(resymbol_noperm) (F, fset, fsize, pack, L, Common) ;
/* ---------------------------------------------------------------------- */
/* free the temporary matrices, if they exist */
/* ---------------------------------------------------------------------- */
CHOLMOD(free_sparse) (&H, Common) ;
CHOLMOD(free_sparse) (&G, Common) ;
return (ok) ;
}
int CHOLMOD(change_factor)
(
/* ---- input ---- */
int to_xtype, /* convert to CHOLMOD_PATTERN, _REAL, _COMPLEX, or
* _ZOMPLEX */
int to_ll, /* TRUE: convert to LL', FALSE: LDL' */
int to_super, /* TRUE: convert to supernodal, FALSE: simplicial */
int to_packed, /* TRUE: pack simplicial columns, FALSE: do not pack */
int to_monotonic, /* TRUE: put simplicial columns in order, FALSE: not */
/* ---- in/out --- */
cholmod_factor *L, /* factor to modify */
/* --------------- */
cholmod_common *Common
)
{
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
if (to_xtype < CHOLMOD_PATTERN || to_xtype > CHOLMOD_ZOMPLEX)
{
ERROR (CHOLMOD_INVALID, "xtype invalid") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
PRINT1 (("-----convert from (%d,%d,%d,%d,%d) to (%d,%d,%d,%d,%d)\n",
L->xtype, L->is_ll, L->is_super, L_is_packed (L, Common), L->is_monotonic,
to_xtype, to_ll, to_super, to_packed, to_monotonic)) ;
/* ensure all parameters are TRUE/FALSE */
to_ll = BOOLEAN (to_ll) ;
to_super = BOOLEAN (to_super) ;
ASSERT (BOOLEAN (L->is_ll) == L->is_ll) ;
ASSERT (BOOLEAN (L->is_super) == L->is_super) ;
if (to_super && to_xtype == CHOLMOD_ZOMPLEX)
{
ERROR (CHOLMOD_INVALID, "supernodal zomplex L not supported") ;
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* convert */
/* ---------------------------------------------------------------------- */
if (to_xtype == CHOLMOD_PATTERN)
{
/* ------------------------------------------------------------------ */
/* convert to symbolic */
/* ------------------------------------------------------------------ */
if (!to_super)
{
/* -------------------------------------------------------------- */
/* convert any factor into a simplicial symbolic factor */
/* -------------------------------------------------------------- */
any_to_simplicial_symbolic (L, to_ll, Common) ; /* cannot fail */
}
else
{
/* -------------------------------------------------------------- */
/* convert to a supernodal symbolic factor */
/* -------------------------------------------------------------- */
if (L->xtype != CHOLMOD_PATTERN && L->is_super)
{
/* convert from supernodal numeric to supernodal symbolic.
* this preserves symbolic pattern of L, discards numeric
* values */
ll_super_to_super_symbolic (L, Common) ; /* cannot fail */
}
else if (L->xtype == CHOLMOD_PATTERN && !(L->is_super))
{
/* convert from simplicial symbolic to supernodal symbolic.
* contents of supernodal pattern are uninitialized. Not meant
* for the end user. */
simplicial_symbolic_to_super_symbolic (L, Common) ;
}
else
{
/* cannot convert from simplicial numeric to supernodal
* symbolic */
ERROR (CHOLMOD_INVALID,
"cannot convert L to supernodal symbolic") ;
}
}
}
else
{
/* ------------------------------------------------------------------ */
/* convert to numeric */
/* ------------------------------------------------------------------ */
if (to_super)
{
/* -------------------------------------------------------------- */
/* convert to supernodal numeric factor */
/* -------------------------------------------------------------- */
if (L->xtype == CHOLMOD_PATTERN)
{
if (L->is_super)
{
/* Convert supernodal symbolic to supernodal numeric.
* Contents of supernodal numeric values are uninitialized.
* This is used by cholmod_super_numeric. Not meant for
* the end user. */
super_symbolic_to_ll_super (to_xtype, L, Common) ;
}
else
{
/* Convert simplicial symbolic to supernodal numeric.
* Contents not defined. This is used by
* Core/cholmod_copy_factor only. Not meant for the end
* user. */
if (!simplicial_symbolic_to_super_symbolic (L, Common))
{
/* failure, convert back to simplicial symbolic */
any_to_simplicial_symbolic (L, to_ll, Common) ;
}
else
{
/* conversion to super symbolic OK, allocate numeric
* part */
super_symbolic_to_ll_super (to_xtype, L, Common) ;
}
}
}
else
{
/* nothing to do if L is already in supernodal numeric form */
if (!(L->is_super))
{
ERROR (CHOLMOD_INVALID,
"cannot convert simplicial L to supernodal") ;
}
/* FUTURE WORK: convert to/from supernodal LL' and LDL' */
}
}
else
{
/* -------------------------------------------------------------- */
/* convert any factor to simplicial numeric */
/* -------------------------------------------------------------- */
if (L->xtype == CHOLMOD_PATTERN && !(L->is_super))
{
/* ---------------------------------------------------------- */
/* convert simplicial symbolic to simplicial numeric (L=I,D=I)*/
/* ---------------------------------------------------------- */
simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed,
to_xtype, Common) ;
}
else if (L->xtype != CHOLMOD_PATTERN && L->is_super)
{
/* ---------------------------------------------------------- */
/* convert a supernodal LL' to simplicial numeric */
/* ---------------------------------------------------------- */
ll_super_to_simplicial_numeric (L, to_packed, to_ll, Common) ;
}
else if (L->xtype == CHOLMOD_PATTERN && L->is_super)
{
/* ---------------------------------------------------------- */
/* convert a supernodal symbolic to simplicial numeric (L=D=I)*/
/* ---------------------------------------------------------- */
any_to_simplicial_symbolic (L, to_ll, Common) ;
/* if the following fails, it leaves the factor in simplicial
* symbolic form */
simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed,
to_xtype, Common) ;
}
else
{
/* ---------------------------------------------------------- */
/* change a simplicial numeric factor */
/* ---------------------------------------------------------- */
/* change LL' to LDL', LDL' to LL', or leave as-is. pack the
* columns of L, or leave as-is. Ensure the columns are
* monotonic, or leave as-is. */
change_simplicial_numeric (L, to_ll, to_packed, to_monotonic,
Common) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
return (Common->status >= CHOLMOD_OK) ;
}
int CHOLMOD(colamd)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to order */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
int postorder, /* if TRUE, follow with a coletree postorder */
/* ---- output --- */
Int *Perm, /* size A->nrow, output permutation */
/* --------------- */
cholmod_common *Common
)
{
double knobs [COLAMD_KNOBS] ;
cholmod_sparse *C ;
Int *NewPerm, *Parent, *Post, *Work2n ;
Int k, nrow, ncol ;
size_t s, alen ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (Perm, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
if (A->stype != 0)
{
ERROR (CHOLMOD_INVALID, "matrix must be unsymmetric") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
nrow = A->nrow ;
ncol = A->ncol ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* Note: this is less than the space used in cholmod_analyze, so if
* cholmod_colamd is being called by that routine, no space will be
* allocated.
*/
/* s = 4*nrow + ncol */
s = CHOLMOD(mult_size_t) (nrow, 4, &ok) ;
s = CHOLMOD(add_size_t) (s, ncol, &ok) ;
#ifdef LONG
alen = trilinos_colamd_l_recommended (A->nzmax, ncol, nrow) ;
trilinos_colamd_l_set_defaults (knobs) ;
#else
alen = trilinos_colamd_recommended (A->nzmax, ncol, nrow) ;
trilinos_colamd_set_defaults (knobs) ;
#endif
if (!ok || alen == 0)
{
ERROR (CHOLMOD_TOO_LARGE, "matrix invalid or too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (0, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* allocate COLAMD workspace */
/* ---------------------------------------------------------------------- */
/* colamd_printf is only available in colamd v2.4 or later */
trilinos_colamd_printf = Common->print_function ;
C = CHOLMOD(allocate_sparse) (ncol, nrow, alen, TRUE, TRUE, 0,
CHOLMOD_PATTERN, Common) ;
/* ---------------------------------------------------------------------- */
/* copy (and transpose) the input matrix A into the colamd workspace */
/* ---------------------------------------------------------------------- */
/* C = A (:,f)', which also packs A if needed. */
/* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset) */
ok = CHOLMOD(transpose_unsym) (A, 0, NULL, fset, fsize, C, Common) ;
/* ---------------------------------------------------------------------- */
/* order the matrix (destroys the contents of C->i and C->p) */
/* ---------------------------------------------------------------------- */
/* get parameters */
if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS)
{
/* this is the CHOLMOD default, not the COLAMD default */
knobs [COLAMD_DENSE_ROW] = -1 ;
}
else
{
/* get the knobs from the Common parameters */
knobs [COLAMD_DENSE_COL] = Common->method[Common->current].prune_dense ;
knobs [COLAMD_DENSE_ROW] = Common->method[Common->current].prune_dense2;
knobs [COLAMD_AGGRESSIVE] = Common->method[Common->current].aggressive ;
}
if (ok)
{
Int *Cp ;
Int stats [COLAMD_STATS] ;
Cp = C->p ;
#ifdef LONG
trilinos_colamd_l (ncol, nrow, alen, C->i, Cp, knobs, stats) ;
#else
trilinos_colamd (ncol, nrow, alen, C->i, Cp, knobs, stats) ;
#endif
ok = stats [COLAMD_STATUS] ;
ok = (ok == COLAMD_OK || ok == COLAMD_OK_BUT_JUMBLED) ;
/* permutation returned in C->p, if the ordering succeeded */
for (k = 0 ; k < nrow ; k++)
{
Perm [k] = Cp [k] ;
}
}
CHOLMOD(free_sparse) (&C, Common) ;
/* ---------------------------------------------------------------------- */
/* column etree postordering */
/* ---------------------------------------------------------------------- */
if (postorder)
{
/* use the last 2*n space in Iwork for Parent and Post */
Work2n = Common->Iwork ;
Work2n += 2*((size_t) nrow) + ncol ;
Parent = Work2n ; /* size nrow (i/i/l) */
Post = Work2n + nrow ; /* size nrow (i/i/l) */
/* workspace: Iwork (2*nrow+ncol), Flag (nrow), Head (nrow+1) */
ok = ok && CHOLMOD(analyze_ordering) (A, CHOLMOD_COLAMD, Perm, fset,
fsize, Parent, Post, NULL, NULL, NULL, Common) ;
/* combine the colamd permutation with its postordering */
if (ok)
{
NewPerm = Common->Iwork ; /* size nrow (i/i/l) */
for (k = 0 ; k < nrow ; k++)
{
NewPerm [k] = Perm [Post [k]] ;
}
for (k = 0 ; k < nrow ; k++)
{
Perm [k] = NewPerm [k] ;
}
}
}
return (ok) ;
}
SuiteSparse_long CHOLMOD(postorder) /* return # of nodes postordered */
(
/* ---- input ---- */
Int *Parent, /* size n. Parent [j] = p if p is the parent of j */
size_t n,
Int *Weight, /* size n, optional. Weight [j] is weight of node j */
/* ---- output --- */
Int *Post, /* size n. Post [k] = j is kth in postordered tree */
/* --------------- */
cholmod_common *Common
)
{
Int *Head, *Next, *Pstack, *Iwork ;
Int j, p, k, w, nextj ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (EMPTY) ;
RETURN_IF_NULL (Parent, EMPTY) ;
RETURN_IF_NULL (Post, EMPTY) ;
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* s = 2*n */
s = CHOLMOD(mult_size_t) (n, 2, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (EMPTY) ;
}
CHOLMOD(allocate_work) (n, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (EMPTY) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Head = Common->Head ; /* size n+1, initially all EMPTY */
Iwork = Common->Iwork ;
Next = Iwork ; /* size n (i/i/l) */
Pstack = Iwork + n ; /* size n (i/i/l) */
/* ---------------------------------------------------------------------- */
/* construct a link list of children for each node */
/* ---------------------------------------------------------------------- */
if (Weight == NULL)
{
/* in reverse order so children are in ascending order in each list */
for (j = n-1 ; j >= 0 ; j--)
{
p = Parent [j] ;
if (p >= 0 && p < ((Int) n))
{
/* add j to the list of children for node p */
Next [j] = Head [p] ;
Head [p] = j ;
}
}
/* Head [p] = j if j is the youngest (least-numbered) child of p */
/* Next [j1] = j2 if j2 is the next-oldest sibling of j1 */
}
else
{
/* First, construct a set of link lists according to Weight.
*
* Whead [w] = j if node j is the first node in bucket w.
* Next [j1] = j2 if node j2 follows j1 in a link list.
*/
Int *Whead = Pstack ; /* use Pstack as workspace for Whead [ */
for (w = 0 ; w < ((Int) n) ; w++)
{
Whead [w] = EMPTY ;
}
/* do in forward order, so nodes that ties are ordered by node index */
for (j = 0 ; j < ((Int) n) ; j++)
{
p = Parent [j] ;
if (p >= 0 && p < ((Int) n))
{
w = Weight [j] ;
w = MAX (0, w) ;
w = MIN (w, ((Int) n) - 1) ;
/* place node j at the head of link list for weight w */
Next [j] = Whead [w] ;
Whead [w] = j ;
}
}
/* traverse weight buckets, placing each node in its parent's list */
for (w = n-1 ; w >= 0 ; w--)
{
for (j = Whead [w] ; j != EMPTY ; j = nextj)
{
nextj = Next [j] ;
/* put node j in the link list of its parent */
p = Parent [j] ;
ASSERT (p >= 0 && p < ((Int) n)) ;
Next [j] = Head [p] ;
Head [p] = j ;
}
}
/* Whead no longer needed ] */
/* Head [p] = j if j is the lightest child of p */
/* Next [j1] = j2 if j2 is the next-heaviest sibling of j1 */
}
/* ---------------------------------------------------------------------- */
/* start a DFS at each root node of the etree */
/* ---------------------------------------------------------------------- */
k = 0 ;
for (j = 0 ; j < ((Int) n) ; j++)
{
if (Parent [j] == EMPTY)
{
/* j is the root of a tree; start a DFS here */
k = dfs (j, k, Post, Head, Next, Pstack) ;
}
}
/* this would normally be EMPTY already, unless Parent is invalid */
for (j = 0 ; j < ((Int) n) ; j++)
{
Head [j] = EMPTY ;
}
PRINT1 (("postordered "ID" nodes\n", k)) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (k) ;
}
cholmod_sparse *CHOLMOD(aat)
(
/* ---- input ---- */
cholmod_sparse *A, /* input matrix; C=A*A' is constructed */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag)
* -2: pattern only, no diagonal, add 50% + n extra
* space to C */
/* --------------- */
cholmod_common *Common
)
{
double fjt ;
double *Ax, *Fx, *Cx, *W ;
Int *Ap, *Anz, *Ai, *Fp, *Fi, *Cp, *Ci, *Flag ;
cholmod_sparse *C, *F ;
Int packed, j, i, pa, paend, pf, pfend, n, mark, cnz, t, p, values, diag,
extra ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
if (A->stype)
{
ERROR (CHOLMOD_INVALID, "matrix cannot be symmetric") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
diag = (mode >= 0) ;
n = A->nrow ;
CHOLMOD(allocate_work) (n, MAX (A->ncol, A->nrow), values ? n : 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;
/* get the A matrix */
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
packed = A->packed ;
/* get workspace */
W = Common->Xwork ; /* size n, unused if values is FALSE */
Flag = Common->Flag ; /* size n, Flag [0..n-1] < mark on input*/
/* ---------------------------------------------------------------------- */
/* F = A' or A(:,f)' */
/* ---------------------------------------------------------------------- */
/* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/
F = CHOLMOD(ptranspose) (A, values, NULL, fset, fsize, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
Fp = F->p ;
Fi = F->i ;
Fx = F->x ;
/* ---------------------------------------------------------------------- */
/* count the number of entries in the result C */
/* ---------------------------------------------------------------------- */
cnz = 0 ;
for (j = 0 ; j < n ; j++)
{
/* clear the Flag array */
mark = CHOLMOD(clear_flag) (Common) ;
/* exclude the diagonal, if requested */
if (!diag)
{
Flag [j] = mark ;
}
/* for each nonzero F(t,j) in column j, do: */
pfend = Fp [j+1] ;
for (pf = Fp [j] ; pf < pfend ; pf++)
{
/* F(t,j) is nonzero */
t = Fi [pf] ;
/* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
pa = Ap [t] ;
paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ;
for ( ; pa < paend ; pa++)
{
i = Ai [pa] ;
if (Flag [i] != mark)
{
Flag [i] = mark ;
cnz++ ;
}
}
}
if (cnz < 0)
{
break ; /* integer overflow case */
}
}
extra = (mode == -2) ? (cnz/2 + n) : 0 ;
mark = CHOLMOD(clear_flag) (Common) ;
/* ---------------------------------------------------------------------- */
/* check for integer overflow */
/* ---------------------------------------------------------------------- */
if (cnz < 0 || (cnz + extra) < 0)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
CHOLMOD(clear_flag) (Common) ;
CHOLMOD(free_sparse) (&F, Common) ;
return (NULL) ; /* problem too large */
}
/* ---------------------------------------------------------------------- */
/* allocate C */
/* ---------------------------------------------------------------------- */
C = CHOLMOD(allocate_sparse) (n, n, cnz + extra, FALSE, TRUE, 0,
values ? A->xtype : CHOLMOD_PATTERN, Common) ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_sparse) (&F, Common) ;
return (NULL) ; /* out of memory */
}
Cp = C->p ;
Ci = C->i ;
Cx = C->x ;
/* ---------------------------------------------------------------------- */
/* C = A*A' */
/* ---------------------------------------------------------------------- */
cnz = 0 ;
if (values)
{
/* pattern and values */
for (j = 0 ; j < n ; j++)
{
/* clear the Flag array */
mark = CHOLMOD(clear_flag) (Common) ;
/* start column j of C */
Cp [j] = cnz ;
/* for each nonzero F(t,j) in column j, do: */
pfend = Fp [j+1] ;
for (pf = Fp [j] ; pf < pfend ; pf++)
{
/* F(t,j) is nonzero */
t = Fi [pf] ;
fjt = Fx [pf] ;
/* add the nonzero pattern of A(:,t) to the pattern of C(:,j)
* and scatter the values into W */
pa = Ap [t] ;
paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ;
for ( ; pa < paend ; pa++)
{
i = Ai [pa] ;
if (Flag [i] != mark)
{
Flag [i] = mark ;
Ci [cnz++] = i ;
}
W [i] += Ax [pa] * fjt ;
}
}
/* gather the values into C(:,j) */
for (p = Cp [j] ; p < cnz ; p++)
{
i = Ci [p] ;
Cx [p] = W [i] ;
W [i] = 0 ;
}
}
}
else
{
/* pattern only */
for (j = 0 ; j < n ; j++)
{
/* clear the Flag array */
mark = CHOLMOD(clear_flag) (Common) ;
/* exclude the diagonal, if requested */
if (!diag)
{
Flag [j] = mark ;
}
/* start column j of C */
Cp [j] = cnz ;
/* for each nonzero F(t,j) in column j, do: */
pfend = Fp [j+1] ;
for (pf = Fp [j] ; pf < pfend ; pf++)
{
/* F(t,j) is nonzero */
t = Fi [pf] ;
/* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
pa = Ap [t] ;
paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ;
for ( ; pa < paend ; pa++)
{
i = Ai [pa] ;
if (Flag [i] != mark)
{
Flag [i] = mark ;
Ci [cnz++] = i ;
}
}
}
}
}
Cp [n] = cnz ;
ASSERT (IMPLIES (mode != -2, MAX (1,cnz) == C->nzmax)) ;
/* ---------------------------------------------------------------------- */
/* clear workspace and free temporary matrices and return result */
/* ---------------------------------------------------------------------- */
CHOLMOD(free_sparse) (&F, Common) ;
CHOLMOD(clear_flag) (Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ;
DEBUG (i = CHOLMOD(dump_sparse) (C, "aat", Common)) ;
ASSERT (IMPLIES (mode < 0, i == 0)) ;
return (C) ;
}
int CHOLMOD(camd)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to order */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
Int *Cmember, /* size nrow. see cholmod_ccolamd.c for description.*/
/* ---- output ---- */
Int *Perm, /* size A->nrow, output permutation */
/* --------------- */
cholmod_common *Common
)
{
double Info [CAMD_INFO], Control2 [CAMD_CONTROL], *Control ;
Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Next, *BucketSet,
*Work3n, *p ;
cholmod_sparse *C ;
Int j, n, cnz ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
n = A->nrow ;
/* s = 4*n */
s = CHOLMOD(mult_size_t) (n, 4, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
RETURN_IF_NULL (Perm, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
if (n == 0)
{
/* nothing to do */
Common->fl = 0 ;
Common->lnz = 0 ;
Common->anz = 0 ;
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
/* cholmod_analyze has allocated Cmember at Common->Iwork + 5*n+uncol, and
* CParent at Common->Iwork + 4*n+uncol, where uncol is 0 if A is symmetric
* or A->ncol otherwise. Thus, only the first 4n integers in Common->Iwork
* can be used here. */
CHOLMOD(allocate_work) (n, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
p = Common->Iwork ;
Degree = p ; p += n ; /* size n */
Elen = p ; p += n ; /* size n */
Len = p ; p += n ; /* size n */
Nv = p ; p += n ; /* size n */
Work3n = CHOLMOD(malloc) (n+1, 3*sizeof (Int), Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
p = Work3n ;
Next = p ; p += n ; /* size n */
Wi = p ; p += (n+1) ; /* size n+1 */
BucketSet = p ; /* size n */
Head = Common->Head ; /* size n+1 */
/* ---------------------------------------------------------------------- */
/* construct the input matrix for CAMD */
/* ---------------------------------------------------------------------- */
if (A->stype == 0)
{
/* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */
C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ;
}
else
{
/* C = A+A', but use only the upper triangular part of A if A->stype = 1
* and only the lower part of A if A->stype = -1. Add extra space of
* nnz(C)/2+n to C. */
C = CHOLMOD(copy) (A, 0, -2, Common) ;
}
if (Common->status < CHOLMOD_OK)
{
/* out of memory, fset invalid, or other error */
CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ;
return (FALSE) ;
}
Cp = C->p ;
for (j = 0 ; j < n ; j++)
{
Len [j] = Cp [j+1] - Cp [j] ;
}
/* C does not include the diagonal, and both upper and lower parts.
* Common->anz includes the diagonal, and just the lower part of C */
cnz = Cp [n] ;
Common->anz = cnz / 2 + n ;
/* ---------------------------------------------------------------------- */
/* order C using CAMD */
/* ---------------------------------------------------------------------- */
/* get parameters */
if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS)
{
/* use CAMD defaults */
Control = NULL ;
}
else
{
Control = Control2 ;
Control [CAMD_DENSE] = Common->method [Common->current].prune_dense ;
Control [CAMD_AGGRESSIVE] = Common->method [Common->current].aggressive;
}
/* CAMD_2 does not use camd_malloc and camd_free, but set these pointers
* just be safe. */
amesos_camd_malloc = Common->malloc_memory ;
amesos_camd_free = Common->free_memory ;
amesos_camd_calloc = Common->calloc_memory ;
amesos_camd_realloc = Common->realloc_memory ;
/* CAMD_2 doesn't print anything either, but future versions might,
* so set the camd_printf pointer too. */
amesos_camd_printf = Common->print_function ;
#ifdef LONG
/* DEBUG (camd_l_debug_init ("cholmod_l_camd")) ; */
amesos_camd_l2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
Degree, Wi, Control, Info, Cmember, BucketSet) ;
#else
/* DEBUG (camd_debug_init ("cholmod_camd")) ; */
amesos_camd_2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
Degree, Wi, Control, Info, Cmember, BucketSet) ;
#endif
/* LL' flop count. Need to subtract n for LL' flop count. Note that this
* is a slight upper bound which is often exact (see CAMD/Source/camd_2.c
* for details). cholmod_analyze computes an exact flop count and
* fill-in. */
Common->fl = Info [CAMD_NDIV] + 2 * Info [CAMD_NMULTSUBS_LDL] + n ;
/* Info [CAMD_LNZ] excludes the diagonal */
Common->lnz = n + Info [CAMD_LNZ] ;
/* ---------------------------------------------------------------------- */
/* free the CAMD workspace and clear the persistent workspace in Common */
/* ---------------------------------------------------------------------- */
ASSERT (IMPLIES (Common->status == CHOLMOD_OK,
CHOLMOD(dump_perm) (Perm, n, n, "CAMD2 perm", Common))) ;
CHOLMOD(free_sparse) (&C, Common) ;
for (j = 0 ; j <= n ; j++)
{
Head [j] = EMPTY ;
}
CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ;
return (TRUE) ;
}
int CHOLMOD(analyze_ordering)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to analyze */
int ordering, /* ordering method used */
Int *Perm, /* size n, fill-reducing permutation to analyze */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
/* ---- output --- */
Int *Parent, /* size n, elimination tree */
Int *Post, /* size n, postordering of elimination tree */
Int *ColCount, /* size n, nnz in each column of L */
/* ---- workspace */
Int *First, /* size n workspace for cholmod_postorder */
Int *Level, /* size n workspace for cholmod_postorder */
/* --------------- */
cholmod_common *Common
)
{
cholmod_sparse *A1, *A2, *S, *F ;
Int n, ok, do_rowcolcounts ;
/* check inputs */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
n = A->nrow ;
do_rowcolcounts = (ColCount != NULL) ;
/* permute A according to Perm and fset */
ok = permute_matrices (A, ordering, Perm, fset, fsize, do_rowcolcounts,
&A1, &A2, &S, &F, Common) ;
/* find etree of S (symmetric upper/lower case) or F (unsym case) */
/* workspace: symmmetric: Iwork (nrow), unsym: Iwork (nrow+ncol) */
ok = ok && CHOLMOD(etree) (A->stype ? S:F, Parent, Common) ;
/* postorder the etree (required by cholmod_rowcolcounts) */
/* workspace: Iwork (2*nrow) */
ok = ok && (CHOLMOD(postorder) (Parent, n, NULL, Post, Common) == n) ;
/* cholmod_postorder doesn't set Common->status if it returns < n */
Common->status = (!ok && Common->status == CHOLMOD_OK) ?
CHOLMOD_INVALID : Common->status ;
/* analyze LL'=S or SS' or S(:,f)*S(:,f)' */
/* workspace:
* if symmetric: Flag (nrow), Iwork (2*nrow)
* if unsymmetric: Flag (nrow), Iwork (2*nrow+ncol), Head (nrow+1)
*/
if (do_rowcolcounts)
{
ok = ok && CHOLMOD(rowcolcounts) (A->stype ? F:S, fset, fsize, Parent,
Post, NULL, ColCount, First, Level, Common) ;
}
/* free temporary matrices and return result */
CHOLMOD(free_sparse) (&A1, Common) ;
CHOLMOD(free_sparse) (&A2, Common) ;
return (ok) ;
}
UF_long CHOLMOD(metis_bisector) /* returns separator size */
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to bisect */
Int *Anw, /* size A->nrow, node weights */
Int *Aew, /* size nz, edge weights */
/* ---- output --- */
Int *Partition, /* size A->nrow */
/* --------------- */
cholmod_common *Common
)
{
Int *Ap, *Ai ;
idxtype *Mp, *Mi, *Mnw, *Mew, *Mpart ;
Int n, nleft, nright, j, p, csep, total_weight, lightest, nz ;
int Opt [8], nn, csp ;
size_t n1 ;
DEBUG (Int nsep) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (EMPTY) ;
RETURN_IF_NULL (A, EMPTY) ;
RETURN_IF_NULL (Anw, EMPTY) ;
RETURN_IF_NULL (Aew, EMPTY) ;
RETURN_IF_NULL (Partition, EMPTY) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ;
if (A->stype || A->nrow != A->ncol)
{
/* A must be square, with both upper and lower parts present */
ERROR (CHOLMOD_INVALID, "matrix must be square, symmetric,"
" and with both upper/lower parts present") ;
return (EMPTY) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* quick return */
/* ---------------------------------------------------------------------- */
n = A->nrow ;
if (n == 0)
{
return (0) ;
}
n1 = ((size_t) n) + 1 ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Ai = A->i ;
nz = Ap [n] ;
/* ---------------------------------------------------------------------- */
/* METIS does not have a 64-bit integer version */
/* ---------------------------------------------------------------------- */
#ifdef LONG
if (sizeof (Int) > sizeof (idxtype) && MAX (n,nz) > INT_MAX / sizeof (int))
{
/* CHOLMOD's matrix is too large for METIS */
return (EMPTY) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* set default options */
/* ---------------------------------------------------------------------- */
Opt [0] = 0 ; /* use defaults */
Opt [1] = 3 ; /* matching type */
Opt [2] = 1 ; /* init. partitioning algo*/
Opt [3] = 2 ; /* refinement algorithm */
Opt [4] = 0 ; /* no debug */
Opt [5] = 0 ; /* unused */
Opt [6] = 0 ; /* unused */
Opt [7] = -1 ; /* random seed */
DEBUG (for (j = 0 ; j < n ; j++) ASSERT (Anw [j] > 0)) ;
/* ---------------------------------------------------------------------- */
/* copy Int to METIS idxtype, if necessary */
/* ---------------------------------------------------------------------- */
DEBUG (for (j = 0 ; j < nz ; j++) ASSERT (Aew [j] > 0)) ;
if (sizeof (Int) == sizeof (idxtype))
{
/* this is the typical case */
Mi = (idxtype *) Ai ;
Mew = (idxtype *) Aew ;
Mp = (idxtype *) Ap ;
Mnw = (idxtype *) Anw ;
Mpart = (idxtype *) Partition ;
}
else
{
/* idxtype and Int differ; copy the graph into the METIS idxtype */
Mi = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ;
Mew = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ;
Mp = CHOLMOD(malloc) (n1, sizeof (idxtype), Common) ;
Mnw = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ;
Mpart = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ;
CHOLMOD(free) (nz, sizeof (idxtype), Mew, Common) ;
CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mnw, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mpart, Common) ;
return (EMPTY) ;
}
for (p = 0 ; p < nz ; p++)
{
Mi [p] = Ai [p] ;
}
for (p = 0 ; p < nz ; p++)
{
Mew [p] = Aew [p] ;
}
for (j = 0 ; j <= n ; j++)
{
Mp [j] = Ap [j] ;
}
for (j = 0 ; j < n ; j++)
{
Mnw [j] = Anw [j] ;
}
}
/* ---------------------------------------------------------------------- */
/* METIS workaround: try to ensure METIS doesn't run out of memory */
/* ---------------------------------------------------------------------- */
if (!metis_memory_ok (n, nz, Common))
{
/* METIS might ask for too much memory and thus terminate the program */
if (sizeof (Int) != sizeof (idxtype))
{
CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ;
CHOLMOD(free) (nz, sizeof (idxtype), Mew, Common) ;
CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mnw, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mpart, Common) ;
}
return (EMPTY) ;
}
/* ---------------------------------------------------------------------- */
/* partition the graph */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
PRINT1 (("Metis graph, n = "ID"\n", n)) ;
for (j = 0 ; j < n ; j++)
{
Int ppp ;
PRINT2 (("M(:,"ID") node weight "ID"\n", j, (Int) Mnw [j])) ;
ASSERT (Mnw [j] > 0) ;
for (ppp = Mp [j] ; ppp < Mp [j+1] ; ppp++)
{
PRINT3 ((" "ID" : "ID"\n", (Int) Mi [ppp], (Int) Mew [ppp])) ;
ASSERT (Mi [ppp] != j) ;
ASSERT (Mew [ppp] > 0) ;
}
}
#endif
nn = n ;
METIS_NodeComputeSeparator (&nn, Mp, Mi, Mnw, Mew, Opt, &csp, Mpart) ;
n = nn ;
csep = csp ;
PRINT1 (("METIS csep "ID"\n", csep)) ;
/* ---------------------------------------------------------------------- */
/* copy the results back from idxtype, if required */
/* ---------------------------------------------------------------------- */
if (sizeof (Int) != sizeof (idxtype))
{
for (j = 0 ; j < n ; j++)
{
Partition [j] = Mpart [j] ;
}
CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ;
CHOLMOD(free) (nz, sizeof (idxtype), Mew, Common) ;
CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mnw, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mpart, Common) ;
}
/* ---------------------------------------------------------------------- */
/* ensure a reasonable separator */
/* ---------------------------------------------------------------------- */
/* METIS can return a valid separator with no nodes in (for example) the
* left part. In this case, there really is no separator. CHOLMOD
* prefers, in this case, for all nodes to be in the separator (and both
* left and right parts to be empty). Also, if the graph is unconnected,
* METIS can return a valid empty separator. CHOLMOD prefers at least one
* node in the separator. Note that cholmod_nested_dissection only calls
* this routine on connected components, but cholmod_bisect can call this
* routine for any graph. */
if (csep == 0)
{
/* The separator is empty, select lightest node as separator. If
* ties, select the highest numbered node. */
lightest = 0 ;
for (j = 0 ; j < n ; j++)
{
if (Anw [j] <= Anw [lightest])
{
lightest = j ;
}
}
PRINT1 (("Force "ID" as sep\n", lightest)) ;
Partition [lightest] = 2 ;
csep = Anw [lightest] ;
}
/* determine the node weights in the left and right part of the graph */
nleft = 0 ;
nright = 0 ;
DEBUG (nsep = 0) ;
for (j = 0 ; j < n ; j++)
{
PRINT1 (("Partition ["ID"] = "ID"\n", j, Partition [j])) ;
if (Partition [j] == 0)
{
nleft += Anw [j] ;
}
else if (Partition [j] == 1)
{
nright += Anw [j] ;
}
#ifndef NDEBUG
else
{
ASSERT (Partition [j] == 2) ;
nsep += Anw [j] ;
}
#endif
}
ASSERT (csep == nsep) ;
total_weight = nleft + nright + csep ;
if (csep < total_weight)
{
/* The separator is less than the whole graph. Make sure the left and
* right parts are either both empty or both non-empty. */
PRINT1 (("nleft "ID" nright "ID" csep "ID" tot "ID"\n",
nleft, nright, csep, total_weight)) ;
ASSERT (nleft + nright + csep == total_weight) ;
ASSERT (nleft > 0 || nright > 0) ;
if ((nleft == 0 && nright > 0) || (nleft > 0 && nright == 0))
{
/* left or right is empty; put all nodes in the separator */
PRINT1 (("Force all in sep\n")) ;
csep = total_weight ;
for (j = 0 ; j < n ; j++)
{
Partition [j] = 2 ;
}
}
}
ASSERT (CHOLMOD(dump_partition) (n, Ap, Ai, Anw, Partition, csep, Common)) ;
/* ---------------------------------------------------------------------- */
/* return the sum of the weights of nodes in the separator */
/* ---------------------------------------------------------------------- */
return (csep) ;
}
int CHOLMOD(metis)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to order */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
int postorder, /* if TRUE, follow with etree or coletree postorder */
/* ---- output --- */
Int *Perm, /* size A->nrow, output permutation */
/* --------------- */
cholmod_common *Common
)
{
double d ;
Int *Iperm, *Iwork, *Bp, *Bi ;
idxtype *Mp, *Mi, *Mperm, *Miperm ;
cholmod_sparse *B ;
Int i, j, n, nz, p, identity, uncol ;
int Opt [8], nn, zero = 0 ;
size_t n1, s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (Perm, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* quick return */
/* ---------------------------------------------------------------------- */
n = A->nrow ;
if (n == 0)
{
return (TRUE) ;
}
n1 = ((size_t) n) + 1 ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* s = 4*n + uncol */
uncol = (A->stype == 0) ? A->ncol : 0 ;
s = CHOLMOD(mult_size_t) (n, 4, &ok) ;
s = CHOLMOD(add_size_t) (s, uncol, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (n, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* convert the matrix to adjacency list form */
/* ---------------------------------------------------------------------- */
/* The input graph for METIS must be symmetric, with both upper and lower
* parts present, and with no diagonal entries. The columns need not be
* sorted.
* B = A+A', A*A', or A(:,f)*A(:,f)', upper and lower parts present */
if (A->stype)
{
/* Add the upper/lower part to a symmetric lower/upper matrix by
* converting to unsymmetric mode */
/* workspace: Iwork (nrow) */
B = CHOLMOD(copy) (A, 0, -1, Common) ;
}
else
{
/* B = A*A' or A(:,f)*A(:,f)', no diagonal */
/* workspace: Flag (nrow), Iwork (max (nrow,ncol)) */
B = CHOLMOD(aat) (A, fset, fsize, -1, Common) ;
}
ASSERT (CHOLMOD(dump_sparse) (B, "B for NodeND", Common) >= 0) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (B->nrow == A->nrow) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Iwork = Common->Iwork ;
Iperm = Iwork ; /* size n (i/i/l) */
Bp = B->p ;
Bi = B->i ;
nz = Bp [n] ;
/* ---------------------------------------------------------------------- */
/* METIS does not have a UF_long integer version */
/* ---------------------------------------------------------------------- */
#ifdef LONG
if (sizeof (Int) > sizeof (idxtype) && MAX (n,nz) > INT_MAX / sizeof (int))
{
/* CHOLMOD's matrix is too large for METIS */
CHOLMOD(free_sparse) (&B, Common) ;
return (FALSE) ;
}
#endif
/* B does not include the diagonal, and both upper and lower parts.
* Common->anz includes the diagonal, and just the lower part of B */
Common->anz = nz / 2 + n ;
/* ---------------------------------------------------------------------- */
/* set control parameters for METIS_NodeND */
/* ---------------------------------------------------------------------- */
Opt [0] = 0 ; /* use defaults */
Opt [1] = 3 ; /* matching type */
Opt [2] = 1 ; /* init. partitioning algo*/
Opt [3] = 2 ; /* refinement algorithm */
Opt [4] = 0 ; /* no debug */
Opt [5] = 1 ; /* initial compression */
Opt [6] = 0 ; /* no dense node removal */
Opt [7] = 1 ; /* number of separators @ each step */
/* ---------------------------------------------------------------------- */
/* allocate the METIS input arrays, if needed */
/* ---------------------------------------------------------------------- */
if (sizeof (Int) == sizeof (idxtype))
{
/* This is the typical case. */
Miperm = (idxtype *) Iperm ;
Mperm = (idxtype *) Perm ;
Mp = (idxtype *) Bp ;
Mi = (idxtype *) Bi ;
}
else
{
/* allocate graph for METIS only if Int and idxtype differ */
Miperm = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ;
Mperm = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ;
Mp = CHOLMOD(malloc) (n1, sizeof (idxtype), Common) ;
Mi = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
CHOLMOD(free_sparse) (&B, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Miperm, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mperm, Common) ;
CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ;
CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ;
return (FALSE) ;
}
for (j = 0 ; j <= n ; j++)
{
Mp [j] = Bp [j] ;
}
for (p = 0 ; p < nz ; p++)
{
Mi [p] = Bi [p] ;
}
}
/* ---------------------------------------------------------------------- */
/* METIS workarounds */
/* ---------------------------------------------------------------------- */
identity = FALSE ;
if (nz == 0)
{
/* The matrix has no off-diagonal entries. METIS_NodeND fails in this
* case, so avoid using it. The best permutation is identity anyway,
* so this is an easy fix. */
identity = TRUE ;
PRINT1 (("METIS:: no nz\n")) ;
}
else if (Common->metis_nswitch > 0)
{
/* METIS_NodeND in METIS 4.0.1 gives a seg fault with one matrix of
* order n = 3005 and nz = 6,036,025, including the diagonal entries.
* The workaround is to return the identity permutation instead of using
* METIS for matrices of dimension 3000 or more and with density of 66%
* or more - admittedly an uncertain fix, but such matrices are so dense
* that any reasonable ordering will do, even identity (n^2 is only 50%
* higher than nz in this case). CHOLMOD's nested dissection method
* (cholmod_nested_dissection) has no problems with the same matrix,
* even though it too uses METIS_NodeComputeSeparator. The matrix is
* derived from LPnetlib/lpi_cplex1 in the UF sparse matrix collection.
* If C is the lpi_cplex matrix (of order 3005-by-5224), A = (C*C')^2
* results in the seg fault. The seg fault also occurs in the stand-
* alone onmetis program that comes with METIS. If a future version of
* METIS fixes this problem, then set Common->metis_nswitch to zero.
*/
d = ((double) nz) / (((double) n) * ((double) n)) ;
if (n > (Int) (Common->metis_nswitch) && d > Common->metis_dswitch)
{
identity = TRUE ;
PRINT1 (("METIS:: nswitch/dswitch activated\n")) ;
}
}
if (!identity && !metis_memory_ok (n, nz, Common))
{
/* METIS might ask for too much memory and thus terminate the program */
identity = TRUE ;
}
/* ---------------------------------------------------------------------- */
/* find the permutation */
/* ---------------------------------------------------------------------- */
if (identity)
{
/* no need to do the postorder */
postorder = FALSE ;
for (i = 0 ; i < n ; i++)
{
Mperm [i] = i ;
}
}
else
{
#ifdef DUMP_GRAPH
/* DUMP_GRAPH */ printf ("Calling METIS_NodeND n "ID" nz "ID""
"density %g\n", n, nz, ((double) nz) / (((double) n) * ((double) n)));
dumpgraph (Mp, Mi, n, Common) ;
#endif
nn = n ;
METIS_NodeND (&nn, Mp, Mi, &zero, Opt, Mperm, Miperm) ;
n = nn ;
PRINT0 (("METIS_NodeND done\n")) ;
}
/* ---------------------------------------------------------------------- */
/* free the METIS input arrays */
/* ---------------------------------------------------------------------- */
if (sizeof (Int) != sizeof (idxtype))
{
for (i = 0 ; i < n ; i++)
{
Perm [i] = (Int) (Mperm [i]) ;
}
CHOLMOD(free) (n, sizeof (idxtype), Miperm, Common) ;
CHOLMOD(free) (n, sizeof (idxtype), Mperm, Common) ;
CHOLMOD(free) (n+1, sizeof (idxtype), Mp, Common) ;
CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ;
}
CHOLMOD(free_sparse) (&B, Common) ;
/* ---------------------------------------------------------------------- */
/* etree or column-etree postordering, using the Cholesky Module */
/* ---------------------------------------------------------------------- */
if (postorder)
{
Int *Parent, *Post, *NewPerm ;
Int k ;
Parent = Iwork + 2*((size_t) n) + uncol ; /* size n = nrow */
Post = Parent + n ; /* size n */
/* workspace: Iwork (2*nrow+uncol), Flag (nrow), Head (nrow+1) */
CHOLMOD(analyze_ordering) (A, CHOLMOD_METIS, Perm, fset, fsize,
Parent, Post, NULL, NULL, NULL, Common) ;
if (Common->status == CHOLMOD_OK)
{
/* combine the METIS permutation with its postordering */
NewPerm = Parent ; /* use Parent as workspace */
for (k = 0 ; k < n ; k++)
{
NewPerm [k] = Perm [Post [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Perm [k] = NewPerm [k] ;
}
}
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
PRINT1 (("cholmod_metis done\n")) ;
return (Common->status == CHOLMOD_OK) ;
}
int CHOLMOD(rowdel_mark)
(
/* ---- input ---- */
size_t kdel, /* row/column index to delete */
cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */
double yk [2], /* kth entry in the solution to A*y=b */
Int *colmark, /* Int array of size 1. See cholmod_updown.c */
/* ---- in/out --- */
cholmod_factor *L, /* factor to modify */
cholmod_dense *X, /* solution to Lx=b (size n-by-1) */
cholmod_dense *DeltaB, /* change in b, zero on output */
/* --------------- */
cholmod_common *Common
)
{
double dk, sqrt_dk, xk, dj, fl ;
double *Lx, *Cx, *W, *Xx, *Nx ;
Int *Li, *Lp, *Lnz, *Ci, *Rj, *Rp, *Iwork ;
cholmod_sparse *C, Cmatrix ;
Int j, p, pend, kk, lnz, n, Cp [2], do_solve, do_update, left, k,
right, middle, i, klast, given_row, rnz, ok ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
n = L->n ;
k = kdel ;
if (k >= n || k < 0)
{
ERROR (CHOLMOD_INVALID, "k invalid") ;
return (FALSE) ;
}
if (R == NULL)
{
Rj = NULL ;
rnz = EMPTY ;
}
else
{
RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
if (R->ncol != 1 || R->nrow != L->n)
{
ERROR (CHOLMOD_INVALID, "R invalid") ;
return (FALSE) ;
}
Rj = R->i ;
Rp = R->p ;
rnz = Rp [1] ;
}
do_solve = (X != NULL) && (DeltaB != NULL) ;
if (do_solve)
{
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
Xx = X->x ;
Nx = DeltaB->x ;
if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n ||
DeltaB->ncol != 1 || Xx == NULL || Nx == NULL)
{
ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ;
return (FALSE) ;
}
}
else
{
Xx = NULL ;
Nx = NULL ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(allocate_work) (n, 2*n, 2*n, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ;
/* ---------------------------------------------------------------------- */
/* convert to simplicial numeric LDL' factor, if not already */
/* ---------------------------------------------------------------------- */
if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll)
{
/* can only update/downdate a simplicial LDL' factorization */
CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L,
Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory, L is returned unchanged */
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
/* inputs, not modified on output: */
Lp = L->p ; /* size n+1 */
/* outputs, contents defined on input for incremental case only: */
Lnz = L->nz ; /* size n */
Li = L->i ; /* size L->nzmax. Can change in size. */
Lx = L->x ; /* size L->nzmax. Can change in size. */
ASSERT (L->nz != NULL) ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
W = Common->Xwork ; /* size n, used only in cholmod_updown */
Cx = W + n ; /* use 2nd column of Xwork for C (size n) */
Iwork = Common->Iwork ;
Ci = Iwork + n ; /* size n (i/i/l) */
/* NOTE: cholmod_updown uses Iwork [0..n-1] (i/i/l) as Stack */
/* ---------------------------------------------------------------------- */
/* prune row k from all columns of L */
/* ---------------------------------------------------------------------- */
given_row = (rnz >= 0) ;
klast = given_row ? rnz : k ;
PRINT2 (("given_row "ID"\n", given_row)) ;
for (kk = 0 ; kk < klast ; kk++)
{
/* either search j = 0:k-1 or j = Rj [0:rnz-1] */
j = given_row ? (Rj [kk]) : (kk) ;
if (j < 0 || j >= k)
{
ERROR (CHOLMOD_INVALID, "R invalid") ;
return (FALSE) ;
}
PRINT2 (("Prune col j = "ID":\n", j)) ;
lnz = Lnz [j] ;
dj = Lx [Lp [j]] ;
ASSERT (Lnz [j] > 0 && Li [Lp [j]] == j) ;
if (lnz > 1)
{
left = Lp [j] ;
pend = left + lnz ;
right = pend - 1 ;
i = Li [right] ;
if (i < k)
{
/* row k is not in column j */
continue ;
}
else if (i == k)
{
/* k is the last row index in this column (quick delete) */
if (do_solve)
{
Xx [j] -= yk [0] * dj * Lx [right] ;
}
Lx [right] = 0 ;
}
else
{
/* binary search for row k in column j */
PRINT2 (("\nBinary search: lnz "ID" k = "ID"\n", lnz, k)) ;
while (left < right)
{
middle = (left + right) / 2 ;
PRINT2 (("left "ID" right "ID" middle "ID": ["ID" "ID""
""ID"]\n", left, right, middle,
Li [left], Li [middle], Li [right])) ;
if (k > Li [middle])
{
left = middle + 1 ;
}
else
{
right = middle ;
}
}
ASSERT (left >= Lp [j] && left < pend) ;
#ifndef NDEBUG
/* brute force, linear-time search */
{
Int p3 = Lp [j] ;
i = EMPTY ;
PRINT2 (("Brute force:\n")) ;
for ( ; p3 < pend ; p3++)
{
i = Li [p3] ;
PRINT2 (("p "ID" ["ID"]\n", p3, i)) ;
if (i >= k)
{
break ;
}
}
if (i == k)
{
ASSERT (k == Li [p3]) ;
ASSERT (p3 == left) ;
}
}
#endif
if (k == Li [left])
{
if (do_solve)
{
Xx [j] -= yk [0] * dj * Lx [left] ;
}
/* found row k in column j. Prune it from the column.*/
Lx [left] = 0 ;
}
}
}
}
#ifndef NDEBUG
/* ensure that row k has been deleted from the matrix L */
for (j = 0 ; j < k ; j++)
{
Int lasti ;
lasti = EMPTY ;
p = Lp [j] ;
pend = p + Lnz [j] ;
/* look for row k in column j */
PRINT1 (("Pruned column "ID"\n", j)) ;
for ( ; p < pend ; p++)
{
i = Li [p] ;
PRINT2 ((" "ID"", i)) ;
PRINT2 ((" %g\n", Lx [p])) ;
ASSERT (IMPLIES (i == k, Lx [p] == 0)) ;
ASSERT (i > lasti) ;
lasti = i ;
}
PRINT1 (("\n")) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* set diagonal and clear column k of L */
/* ---------------------------------------------------------------------- */
lnz = Lnz [k] - 1 ;
ASSERT (Lnz [k] > 0) ;
/* ---------------------------------------------------------------------- */
/* update/downdate */
/* ---------------------------------------------------------------------- */
/* update or downdate L (k+1:n, k+1:n) with the vector
* C = L (:,k) * sqrt (abs (D [k]))
* Do a numeric update if D[k] > 0, numeric downdate otherwise.
*/
PRINT1 (("rowdel downdate lnz = "ID"\n", lnz)) ;
/* store the new unit diagonal */
p = Lp [k] ;
pend = p + lnz + 1 ;
dk = Lx [p] ;
Lx [p++] = 1 ;
PRINT2 (("D [k = "ID"] = %g\n", k, dk)) ;
ok = TRUE ;
fl = 0 ;
if (lnz > 0)
{
/* compute DeltaB for updown (in DeltaB) */
if (do_solve)
{
xk = Xx [k] - yk [0] * dk ;
for ( ; p < pend ; p++)
{
Nx [Li [p]] += Lx [p] * xk ;
}
}
do_update = IS_GT_ZERO (dk) ;
if (!do_update)
{
dk = -dk ;
}
sqrt_dk = sqrt (dk) ;
p = Lp [k] + 1 ;
for (kk = 0 ; kk < lnz ; kk++, p++)
{
Ci [kk] = Li [p] ;
Cx [kk] = Lx [p] * sqrt_dk ;
Lx [p] = 0 ; /* clear column k */
}
fl = lnz + 1 ;
/* create a n-by-1 sparse matrix to hold the single column */
C = &Cmatrix ;
C->nrow = n ;
C->ncol = 1 ;
C->nzmax = lnz ;
C->sorted = TRUE ;
C->packed = TRUE ;
C->p = Cp ;
C->i = Ci ;
C->x = Cx ;
C->nz = NULL ;
C->itype = L->itype ;
C->xtype = L->xtype ;
C->dtype = L->dtype ;
C->z = NULL ;
C->stype = 0 ;
Cp [0] = 0 ;
Cp [1] = lnz ;
/* numeric update if dk > 0, and with Lx=b change */
/* workspace: Flag (nrow), Head (nrow+1), W (nrow), Iwork (2*nrow) */
ok = CHOLMOD(updown_mark) (do_update ? (1) : (0), C, colmark,
L, X, DeltaB, Common) ;
/* clear workspace */
for (kk = 0 ; kk < lnz ; kk++)
{
Cx [kk] = 0 ;
}
}
Common->modfl += fl ;
if (do_solve)
{
/* kth equation becomes identity, so X(k) is now Y(k) */
Xx [k] = yk [0] ;
}
DEBUG (CHOLMOD(dump_factor) (L, "LDL factorization, L:", Common)) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ;
return (ok) ;
}
cholmod_triplet *CHOLMOD(copy_triplet)
(
/* ---- input ---- */
cholmod_triplet *T, /* matrix to copy */
/* --------------- */
cholmod_common *Common
)
{
double *Tx, *Tz, *Cx, *Cz ;
Int *Ci, *Cj, *Ti, *Tj ;
cholmod_triplet *C ;
Int xtype, k, nz ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (T, NULL) ;
RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
nz = T->nnz ;
Ti = T->i ;
Tj = T->j ;
Tx = T->x ;
Tz = T->z ;
xtype = T->xtype ;
RETURN_IF_NULL (Ti, NULL) ;
RETURN_IF_NULL (Tj, NULL) ;
Common->status = CHOLMOD_OK ;
DEBUG (CHOLMOD(dump_triplet) (T, "T input", Common)) ;
/* ---------------------------------------------------------------------- */
/* allocate copy */
/* ---------------------------------------------------------------------- */
C = CHOLMOD(allocate_triplet) (T->nrow, T->ncol, T->nzmax, T->stype,
xtype, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
/* ---------------------------------------------------------------------- */
/* copy the triplet matrix */
/* ---------------------------------------------------------------------- */
Ci = C->i ;
Cj = C->j ;
Cx = C->x ;
Cz = C->z ;
C->nnz = nz ;
for (k = 0 ; k < nz ; k++)
{
Ci [k] = Ti [k] ;
}
for (k = 0 ; k < nz ; k++)
{
Cj [k] = Tj [k] ;
}
if (xtype == CHOLMOD_REAL)
{
for (k = 0 ; k < nz ; k++)
{
Cx [k] = Tx [k] ;
}
}
else if (xtype == CHOLMOD_COMPLEX)
{
for (k = 0 ; k < nz ; k++)
{
Cx [2*k ] = Tx [2*k ] ;
Cx [2*k+1] = Tx [2*k+1] ;
}
}
else if (xtype == CHOLMOD_ZOMPLEX)
{
for (k = 0 ; k < nz ; k++)
{
Cx [k] = Tx [k] ;
Cz [k] = Tz [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* return the result */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_triplet) (C, "C triplet copy", Common)) ;
return (C) ;
}
cholmod_triplet *CHOLMOD(sparse_to_triplet)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to copy */
/* --------------- */
cholmod_common *Common
)
{
double *Ax, *Az, *Tx, *Tz ;
Int *Ap, *Ai, *Ti, *Tj, *Anz ;
cholmod_triplet *T ;
Int i, xtype, p, pend, k, j, nrow, ncol, nz, stype, packed, up, lo,
both ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
stype = SIGN (A->stype) ;
nrow = A->nrow ;
ncol = A->ncol ;
if (stype && nrow != ncol)
{
/* inputs invalid */
ERROR (CHOLMOD_INVALID, "matrix invalid") ;
return (NULL) ;
}
Ax = A->x ;
Az = A->z ;
xtype = A->xtype ;
Common->status = CHOLMOD_OK ;
ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;
/* ---------------------------------------------------------------------- */
/* allocate triplet matrix */
/* ---------------------------------------------------------------------- */
nz = CHOLMOD(nnz) (A, Common) ;
T = CHOLMOD(allocate_triplet) (nrow, ncol, nz, A->stype, A->xtype, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
/* ---------------------------------------------------------------------- */
/* convert to a sparse matrix */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Ai = A->i ;
Anz = A->nz ;
packed = A->packed ;
Ti = T->i ;
Tj = T->j ;
Tx = T->x ;
Tz = T->z ;
T->stype = A->stype ;
both = (A->stype == 0) ;
up = (A->stype > 0) ;
lo = (A->stype < 0) ;
k = 0 ;
for (j = 0 ; j < ncol ; j++)
{
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
i = Ai [p] ;
if (both || (up && i <= j) || (lo && i >= j))
{
Ti [k] = Ai [p] ;
Tj [k] = j ;
if (xtype == CHOLMOD_REAL)
{
Tx [k] = Ax [p] ;
}
else if (xtype == CHOLMOD_COMPLEX)
{
Tx [2*k ] = Ax [2*p ] ;
Tx [2*k+1] = Ax [2*p+1] ;
}
else if (xtype == CHOLMOD_ZOMPLEX)
{
Tx [k] = Ax [p] ;
Tz [k] = Az [p] ;
}
k++ ;
ASSERT (k <= nz) ;
}
}
}
T->nnz = k ;
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_triplet) (T, "T", Common)) ;
return (T) ;
}
cholmod_sparse *CHOLMOD(add)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to add */
cholmod_sparse *B, /* matrix to add */
double alpha [2], /* scale factor for A */
double beta [2], /* scale factor for B */
int values, /* if TRUE compute the numerical values of C */
int sorted, /* if TRUE, sort columns of C */
/* --------------- */
cholmod_common *Common
)
{
double *Ax, *Bx, *Cx, *W ;
Int apacked, up, lo, nrow, ncol, bpacked, nzmax, pa, paend, pb, pbend, i,
j, p, mark, nz ;
Int *Ap, *Ai, *Anz, *Bp, *Bi, *Bnz, *Flag, *Cp, *Ci ;
cholmod_sparse *A2, *B2, *C ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
RETURN_IF_NULL (B, NULL) ;
values = values &&
(A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
if (A->nrow != B->nrow || A->ncol != B->ncol)
{
/* A and B must have the same dimensions */
ERROR (CHOLMOD_INVALID, "A and B dimesions do not match") ;
return (NULL) ;
}
/* A and B must have the same numerical type if values is TRUE (both must
* be CHOLMOD_REAL, this is implicitly checked above) */
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
nrow = A->nrow ;
ncol = A->ncol ;
CHOLMOD(allocate_work) (nrow, MAX (nrow,ncol), values ? nrow : 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nrow <= 1)
{
/* C will be implicitly sorted, so no need to sort it here */
sorted = FALSE ;
}
/* convert A or B to unsymmetric, if necessary */
A2 = NULL ;
B2 = NULL ;
if (A->stype != B->stype)
{
if (A->stype)
{
/* workspace: Iwork (max (nrow,ncol)) */
A2 = CHOLMOD(copy) (A, 0, values, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
A = A2 ;
}
if (B->stype)
{
/* workspace: Iwork (max (nrow,ncol)) */
B2 = CHOLMOD(copy) (B, 0, values, Common) ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_sparse) (&A2, Common) ;
return (NULL) ; /* out of memory */
}
B = B2 ;
}
}
/* get the A matrix */
ASSERT (A->stype == B->stype) ;
up = (A->stype > 0) ;
lo = (A->stype < 0) ;
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
apacked = A->packed ;
/* get the B matrix */
Bp = B->p ;
Bnz = B->nz ;
Bi = B->i ;
Bx = B->x ;
bpacked = B->packed ;
/* get workspace */
W = Common->Xwork ; /* size nrow, used if values is TRUE */
Flag = Common->Flag ; /* size nrow, Flag [0..nrow-1] < mark on input */
/* ---------------------------------------------------------------------- */
/* allocate the result C */
/* ---------------------------------------------------------------------- */
/* If integer overflow occurs, nzmax < 0 and the allocate fails properly
* (likewise in most other matrix manipulation routines). */
nzmax = CHOLMOD(nnz) (A, Common) + CHOLMOD(nnz) (B, Common) ;
C = CHOLMOD(allocate_sparse) (nrow, ncol, nzmax, FALSE, TRUE,
SIGN (A->stype), values ? A->xtype : CHOLMOD_PATTERN, Common) ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
return (NULL) ; /* out of memory */
}
Cp = C->p ;
Ci = C->i ;
Cx = C->x ;
/* ---------------------------------------------------------------------- */
/* compute C = alpha*A + beta*B */
/* ---------------------------------------------------------------------- */
nz = 0 ;
for (j = 0 ; j < ncol ; j++)
{
Cp [j] = nz ;
/* clear the Flag array */
/* mark = CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
/* scatter B into W */
pb = Bp [j] ;
pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
for (p = pb ; p < pbend ; p++)
{
i = Bi [p] ;
if ((up && i > j) || (lo && i < j))
{
continue ;
}
Flag [i] = mark ;
if (values)
{
W [i] = beta [0] * Bx [p] ;
}
}
/* add A and gather from W into C(:,j) */
pa = Ap [j] ;
paend = (apacked) ? (Ap [j+1]) : (pa + Anz [j]) ;
for (p = pa ; p < paend ; p++)
{
i = Ai [p] ;
if ((up && i > j) || (lo && i < j))
{
continue ;
}
Flag [i] = EMPTY ;
Ci [nz] = i ;
if (values)
{
Cx [nz] = W [i] + alpha [0] * Ax [p] ;
W [i] = 0 ;
}
nz++ ;
}
/* gather remaining entries into C(:,j), using pattern of B */
for (p = pb ; p < pbend ; p++)
{
i = Bi [p] ;
if ((up && i > j) || (lo && i < j))
{
continue ;
}
if (Flag [i] == mark)
{
Ci [nz] = i ;
if (values)
{
Cx [nz] = W [i] ;
W [i] = 0 ;
}
nz++ ;
}
}
}
Cp [ncol] = nz ;
/* ---------------------------------------------------------------------- */
/* reduce C in size and free temporary matrices */
/* ---------------------------------------------------------------------- */
ASSERT (MAX (1,nz) <= C->nzmax) ;
CHOLMOD(reallocate_sparse) (nz, C, Common) ;
ASSERT (Common->status >= CHOLMOD_OK) ;
/* clear the Flag array */
mark = CHOLMOD(clear_flag) (Common) ;
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
/* ---------------------------------------------------------------------- */
/* sort C, if requested */
/* ---------------------------------------------------------------------- */
if (sorted)
{
/* workspace: Iwork (max (nrow,ncol)) */
if (!CHOLMOD(sort) (C, Common))
{
CHOLMOD(free_sparse) (&C, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
}
}
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_sparse) (C, "add", Common) >= 0) ;
return (C) ;
}
cholmod_factor *CHOLMOD(analyze_p2)
(
/* ---- input ---- */
int for_cholesky, /* if TRUE, then analyze for Cholesky; else for QR */
cholmod_sparse *A, /* matrix to order and analyze */
Int *UserPerm, /* user-provided permutation, size A->nrow */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
/* --------------- */
cholmod_common *Common
)
{
double lnz_best ;
Int *First, *Level, *Work4n, *Cmember, *CParent, *ColCount, *Lperm, *Parent,
*Post, *Perm, *Lparent, *Lcolcount ;
cholmod_factor *L ;
Int k, n, ordering, method, nmethods, status, default_strategy, ncol, uncol,
skip_analysis, skip_best ;
Int amd_backup ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
Common->status = CHOLMOD_OK ;
status = CHOLMOD_OK ;
Common->selected = EMPTY ;
Common->called_nd = FALSE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
n = A->nrow ;
ncol = A->ncol ;
uncol = (A->stype == 0) ? (A->ncol) : 0 ;
/* ---------------------------------------------------------------------- */
/* set the default strategy */
/* ---------------------------------------------------------------------- */
lnz_best = (double) EMPTY ;
skip_best = FALSE ;
nmethods = MIN (Common->nmethods, CHOLMOD_MAXMETHODS) ;
nmethods = MAX (0, nmethods) ;
PRINT1 (("nmethods "ID"\n", nmethods)) ;
default_strategy = (nmethods == 0) ;
if (default_strategy)
{
/* default strategy: try UserPerm, if given. Try AMD for A, or AMD
* to order A*A'. Try METIS for the symmetric case only if AMD reports
* a high degree of fill-in and flop count. METIS is not tried if the
* Partition Module isn't installed. If Common->default_nesdis is
* TRUE, then NESDIS is used as the 3rd ordering instead. */
Common->method [0].ordering = CHOLMOD_GIVEN ;/* skip if UserPerm NULL */
Common->method [1].ordering = CHOLMOD_AMD ;
Common->method [2].ordering =
(Common->default_nesdis ? CHOLMOD_NESDIS : CHOLMOD_METIS) ;
amd_backup = FALSE ;
#ifndef NPARTITION
nmethods = 3 ;
#else
nmethods = 2 ;
#endif
}
else
{
/* If only METIS and NESDIS are selected, or if 2 or more methods are
* being tried, then enable AMD backup */
amd_backup = (nmethods > 1) || (nmethods == 1 &&
(Common->method [0].ordering == CHOLMOD_METIS ||
Common->method [0].ordering == CHOLMOD_NESDIS)) ;
}
#ifdef NSUPERNODAL
/* CHOLMOD Supernodal module not installed, just do simplicial analysis */
Common->supernodal = CHOLMOD_SIMPLICIAL ;
#endif
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* Note: enough space needs to be allocated here so that routines called by
* cholmod_analyze do not reallocate the space.
*/
/* s = 6*n + uncol */
s = CHOLMOD(mult_size_t) (n, 6, &ok) ;
s = CHOLMOD(add_size_t) (s, uncol, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (NULL) ;
}
CHOLMOD(allocate_work) (n, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ensure that subsequent routines, called by cholmod_analyze, do not
* reallocate any workspace. This is set back to FALSE in the
* FREE_WORKSPACE_AND_RETURN macro, which is the only way this function
* returns to its caller. */
Common->no_workspace_reallocate = TRUE ;
/* Use the last 4*n Int's in Iwork for Parent, First, Level, and Post, since
* other CHOLMOD routines will use the first 2n+uncol space. The ordering
* routines (cholmod_amd, cholmod_colamd, cholmod_ccolamd, cholmod_metis)
* are an exception. They can use all 6n + ncol space, since the contents
* of Parent, First, Level, and Post are not needed across calls to those
* routines. */
Work4n = Common->Iwork ;
Work4n += 2*((size_t) n) + uncol ;
Parent = Work4n ;
First = Work4n + n ;
Level = Work4n + 2*((size_t) n) ;
Post = Work4n + 3*((size_t) n) ;
/* note that this assignment means that cholmod_nested_dissection,
* cholmod_ccolamd, and cholmod_camd can use only the first 4n+uncol
* space in Common->Iwork */
Cmember = Post ;
CParent = Level ;
/* ---------------------------------------------------------------------- */
/* allocate more workspace, and an empty simplicial symbolic factor */
/* ---------------------------------------------------------------------- */
L = CHOLMOD(allocate_factor) (n, Common) ;
Lparent = CHOLMOD(malloc) (n, sizeof (Int), Common) ;
Perm = CHOLMOD(malloc) (n, sizeof (Int), Common) ;
ColCount = CHOLMOD(malloc) (n, sizeof (Int), Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
FREE_WORKSPACE_AND_RETURN ;
}
Lperm = L->Perm ;
Lcolcount = L->ColCount ;
Common->anz = EMPTY ;
/* ---------------------------------------------------------------------- */
/* try all the requested ordering options and backup to AMD if needed */
/* ---------------------------------------------------------------------- */
/* turn off error handling [ */
Common->try_catch = TRUE ;
for (method = 0 ; method <= nmethods ; method++)
{
/* ------------------------------------------------------------------ */
/* determine the method to try */
/* ------------------------------------------------------------------ */
Common->fl = EMPTY ;
Common->lnz = EMPTY ;
skip_analysis = FALSE ;
if (method == nmethods)
{
/* All methods failed: backup to AMD */
if (Common->selected == EMPTY && amd_backup)
{
PRINT1 (("All methods requested failed: backup to AMD\n")) ;
ordering = CHOLMOD_AMD ;
}
else
{
break ;
}
}
else
{
ordering = Common->method [method].ordering ;
}
Common->current = method ;
PRINT1 (("method "ID": Try method: "ID"\n", method, ordering)) ;
/* ------------------------------------------------------------------ */
/* find the fill-reducing permutation */
/* ------------------------------------------------------------------ */
if (ordering == CHOLMOD_NATURAL)
{
/* -------------------------------------------------------------- */
/* natural ordering */
/* -------------------------------------------------------------- */
for (k = 0 ; k < n ; k++)
{
Perm [k] = k ;
}
}
else if (ordering == CHOLMOD_GIVEN)
{
/* -------------------------------------------------------------- */
/* use given ordering of A, if provided */
/* -------------------------------------------------------------- */
if (UserPerm == NULL)
{
/* this is not an error condition */
PRINT1 (("skip, no user perm given\n")) ;
continue ;
}
for (k = 0 ; k < n ; k++)
{
/* UserPerm is checked in cholmod_ptranspose */
Perm [k] = UserPerm [k] ;
}
}
else if (ordering == CHOLMOD_AMD)
{
/* -------------------------------------------------------------- */
/* AMD ordering of A, A*A', or A(:,f)*A(:,f)' */
/* -------------------------------------------------------------- */
amd_backup = FALSE ; /* no need to try AMD twice ... */
CHOLMOD(amd) (A, fset, fsize, Perm, Common) ;
skip_analysis = TRUE ;
}
else if (ordering == CHOLMOD_COLAMD)
{
/* -------------------------------------------------------------- */
/* AMD for symmetric case, COLAMD for A*A' or A(:,f)*A(:,f)' */
/* -------------------------------------------------------------- */
if (A->stype)
{
CHOLMOD(amd) (A, fset, fsize, Perm, Common) ;
skip_analysis = TRUE ;
}
else
{
/* Alternative:
CHOLMOD(ccolamd) (A, fset, fsize, NULL, Perm, Common) ;
*/
/* do not postorder, it is done later, below */
/* workspace: Iwork (4*nrow+uncol), Flag (nrow), Head (nrow+1)*/
CHOLMOD(colamd) (A, fset, fsize, FALSE, Perm, Common) ;
}
}
else if (ordering == CHOLMOD_METIS)
{
/* -------------------------------------------------------------- */
/* use METIS_NodeND directly (via a CHOLMOD wrapper) */
/* -------------------------------------------------------------- */
#ifndef NPARTITION
/* postorder parameter is false, because it will be later, below */
/* workspace: Iwork (4*nrow+uncol), Flag (nrow), Head (nrow+1) */
Common->called_nd = TRUE ;
CHOLMOD(metis) (A, fset, fsize, FALSE, Perm, Common) ;
#else
Common->status = CHOLMOD_NOT_INSTALLED ;
#endif
}
else if (ordering == CHOLMOD_NESDIS)
{
/* -------------------------------------------------------------- */
/* use CHOLMOD's nested dissection */
/* -------------------------------------------------------------- */
/* this method is based on METIS' node bissection routine
* (METIS_NodeComputeSeparator). In contrast to METIS_NodeND,
* it calls CAMD or CCOLAMD on the whole graph, instead of MMD
* on just the leaves. */
#ifndef NPARTITION
/* workspace: Flag (nrow), Head (nrow+1), Iwork (2*nrow) */
Common->called_nd = TRUE ;
CHOLMOD(nested_dissection) (A, fset, fsize, Perm, CParent, Cmember,
Common) ;
#else
Common->status = CHOLMOD_NOT_INSTALLED ;
#endif
}
else
{
/* -------------------------------------------------------------- */
/* invalid ordering method */
/* -------------------------------------------------------------- */
Common->status = CHOLMOD_INVALID ;
PRINT1 (("No such ordering: "ID"\n", ordering)) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory, or method failed */
status = MIN (status, Common->status) ;
Common->status = CHOLMOD_OK ;
continue ;
}
/* ------------------------------------------------------------------ */
/* analyze the ordering */
/* ------------------------------------------------------------------ */
if (!skip_analysis)
{
if (!CHOLMOD(analyze_ordering) (A, ordering, Perm, fset, fsize,
Parent, Post, ColCount, First, Level, Common))
{
/* ordering method failed; clear status and try next method */
status = MIN (status, Common->status) ;
Common->status = CHOLMOD_OK ;
continue ;
}
}
ASSERT (Common->fl >= 0 && Common->lnz >= 0) ;
Common->method [method].fl = Common->fl ;
Common->method [method].lnz = Common->lnz ;
PRINT1 (("lnz %g fl %g\n", Common->lnz, Common->fl)) ;
/* ------------------------------------------------------------------ */
/* pick the best method */
/* ------------------------------------------------------------------ */
/* fl.pt. compare, but lnz can never be NaN */
if (Common->selected == EMPTY || Common->lnz < lnz_best)
{
Common->selected = method ;
PRINT1 (("this is best so far, method "ID"\n", method)) ;
L->ordering = ordering ;
lnz_best = Common->lnz ;
for (k = 0 ; k < n ; k++)
{
Lperm [k] = Perm [k] ;
}
/* save the results of cholmod_analyze_ordering, if it was called */
skip_best = skip_analysis ;
if (!skip_analysis)
{
/* save the column count; becomes permanent part of L */
for (k = 0 ; k < n ; k++)
{
Lcolcount [k] = ColCount [k] ;
}
/* Parent is needed for weighted postordering and for supernodal
* analysis. Does not become a permanent part of L */
for (k = 0 ; k < n ; k++)
{
Lparent [k] = Parent [k] ;
}
}
}
/* ------------------------------------------------------------------ */
/* determine if METIS is to be skipped */
/* ------------------------------------------------------------------ */
if (default_strategy && ordering == CHOLMOD_AMD)
{
if ((Common->fl < 500 * Common->lnz) ||
(Common->lnz < 5 * Common->anz))
{
/* AMD found an ordering with less than 500 flops per nonzero in
* L, or one with a fill-in ratio (nnz(L)/nnz(A)) of less than
* 5. This is pretty good, and it's unlikely that METIS will do
* better (this heuristic is based on tests on all symmetric
* positive definite matrices in the UF sparse matrix
* collection, and it works well across a wide range of
* problems). METIS can take much more time than AMD. */
break ;
}
}
}
/* turn error printing back on ] */
Common->try_catch = FALSE ;
/* ---------------------------------------------------------------------- */
/* return if no ordering method succeeded */
/* ---------------------------------------------------------------------- */
if (Common->selected == EMPTY)
{
/* All methods failed.
* If two or more methods failed, they may have failed for different
* reasons. Both would clear Common->status and skip to the next
* method. Common->status needs to be restored here to the worst error
* obtained in any of the methods. CHOLMOD_INVALID is worse
* than CHOLMOD_OUT_OF_MEMORY, since the former implies something may
* be wrong with the user's input. CHOLMOD_OUT_OF_MEMORY is simply an
* indication of lack of resources. */
ASSERT (status < CHOLMOD_OK) ;
ERROR (status, "all methods failed") ;
FREE_WORKSPACE_AND_RETURN ;
}
/* ---------------------------------------------------------------------- */
/* do the analysis for AMD, if skipped */
/* ---------------------------------------------------------------------- */
Common->fl = Common->method [Common->selected].fl ;
Common->lnz = Common->method [Common->selected].lnz ;
ASSERT (Common->lnz >= 0) ;
if (skip_best)
{
if (!CHOLMOD(analyze_ordering) (A, L->ordering, Lperm, fset, fsize,
Lparent, Post, Lcolcount, First, Level, Common))
{
/* out of memory, or method failed */
FREE_WORKSPACE_AND_RETURN ;
}
}
/* ---------------------------------------------------------------------- */
/* postorder the etree, weighted by the column counts */
/* ---------------------------------------------------------------------- */
if (Common->postorder)
{
/* combine the fill-reducing ordering with the weighted postorder */
/* workspace: Iwork (2*nrow) */
if (CHOLMOD(postorder) (Lparent, n, Lcolcount, Post, Common) == n)
{
/* use First and Level as workspace [ */
Int *Wi = First, *InvPost = Level ;
Int newchild, oldchild, newparent, oldparent ;
for (k = 0 ; k < n ; k++)
{
Wi [k] = Lperm [Post [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Lperm [k] = Wi [k] ;
}
for (k = 0 ; k < n ; k++)
{
Wi [k] = Lcolcount [Post [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Lcolcount [k] = Wi [k] ;
}
for (k = 0 ; k < n ; k++)
{
InvPost [Post [k]] = k ;
}
/* updated Lparent needed only for supernodal case */
for (newchild = 0 ; newchild < n ; newchild++)
{
oldchild = Post [newchild] ;
oldparent = Lparent [oldchild] ;
newparent = (oldparent == EMPTY) ? EMPTY : InvPost [oldparent] ;
Wi [newchild] = newparent ;
}
for (k = 0 ; k < n ; k++)
{
Lparent [k] = Wi [k] ;
}
/* done using Iwork as workspace ] */
/* L is now postordered, no longer in natural ordering */
if (L->ordering == CHOLMOD_NATURAL)
{
L->ordering = CHOLMOD_POSTORDERED ;
}
}
}
/* ---------------------------------------------------------------------- */
/* supernodal analysis, if requested or if selected automatically */
/* ---------------------------------------------------------------------- */
#ifndef NSUPERNODAL
if (Common->supernodal > CHOLMOD_AUTO
|| (Common->supernodal == CHOLMOD_AUTO &&
Common->lnz > 0 &&
(Common->fl / Common->lnz) >= Common->supernodal_switch))
{
cholmod_sparse *S, *F, *A2, *A1 ;
permute_matrices (A, L->ordering, Lperm, fset, fsize, TRUE,
&A1, &A2, &S, &F, Common) ;
/* workspace: Flag (nrow), Head (nrow), Iwork (5*nrow) */
CHOLMOD(super_symbolic2) (for_cholesky, S, F, Lparent, L, Common) ;
PRINT1 (("status %d\n", Common->status)) ;
CHOLMOD(free_sparse) (&A1, Common) ;
CHOLMOD(free_sparse) (&A2, Common) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* free temporary matrices and workspace, and return result L */
/* ---------------------------------------------------------------------- */
FREE_WORKSPACE_AND_RETURN ;
}
int CHOLMOD(super_symbolic2)
(
/* ---- input ---- */
int for_whom, /* FOR_SPQR (0): for SPQR but not GPU-accelerated
FOR_CHOLESKY (1): for Cholesky (GPU or not)
FOR_SPQRGPU (2): for SPQR with GPU acceleration */
cholmod_sparse *A, /* matrix to analyze */
cholmod_sparse *F, /* F = A' or A(:,f)' */
Int *Parent, /* elimination tree */
/* ---- in/out --- */
cholmod_factor *L, /* simplicial symbolic on input,
* supernodal symbolic on output */
/* --------------- */
cholmod_common *Common
)
{
double zrelax0, zrelax1, zrelax2, xxsize ;
Int *Wi, *Wj, *Super, *Snz, *Ap, *Ai, *Flag, *Head, *Ls, *Lpi, *Lpx, *Fnz,
*Sparent, *Anz, *SuperMap, *Merged, *Nscol, *Zeros, *Fp, *Fj,
*ColCount, *Lpi2, *Lsuper, *Iwork ;
Int nsuper, d, n, j, k, s, mark, parent, p, pend, k1, k2, packed, nscol,
nsrow, ndrow1, ndrow2, stype, ssize, xsize, sparent, plast, slast,
csize, maxcsize, ss, nscol0, nscol1, ns, nfsuper, newzeros, totzeros,
merge, snext, esize, maxesize, nrelax0, nrelax1, nrelax2, Asorted ;
size_t w ;
int ok = TRUE, find_xsize ;
const char* env_use_gpu;
const char* env_max_bytes;
size_t max_bytes;
const char* env_max_fraction;
double max_fraction;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_NULL (Parent, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_PATTERN, FALSE) ;
stype = A->stype ;
if (stype < 0)
{
/* invalid symmetry; symmetric lower form not supported */
ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ;
return (FALSE) ;
}
if (stype == 0)
{
/* F must be present in the unsymmetric case */
RETURN_IF_NULL (F, FALSE) ;
}
if (L->is_super)
{
/* L must be a simplicial symbolic factor */
ERROR (CHOLMOD_INVALID, "L must be symbolic on input") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
n = A->nrow ;
/* w = 5*n */
w = CHOLMOD(mult_size_t) (n, 5, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (n, w, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* allocate GPU workspace */
/* ---------------------------------------------------------------------- */
L->useGPU = 0 ; /* only used for Cholesky factorization, not QR */
#ifdef GPU_BLAS
/* GPU module is installed */
if ( for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY )
{
/* only allocate GPU workspace for supernodal Cholesky, and only when
the GPU is requested and available. */
max_bytes = 0;
max_fraction = 0;
#ifdef DLONG
if ( Common->useGPU == EMPTY )
{
/* useGPU not explicity requested by the user, but not explicitly
* prohibited either. Query OS environment variables for request.*/
env_use_gpu = getenv("CHOLMOD_USE_GPU");
if ( env_use_gpu )
{
/* CHOLMOD_USE_GPU environment variable is set to something */
if ( atoi ( env_use_gpu ) == 0 )
{
Common->useGPU = 0; /* don't use the gpu */
}
else
{
Common->useGPU = 1; /* use the gpu */
env_max_bytes = getenv("CHOLMOD_GPU_MEM_BYTES");
env_max_fraction = getenv("CHOLMOD_GPU_MEM_FRACTION");
if ( env_max_bytes )
{
max_bytes = atol(env_max_bytes);
Common->maxGpuMemBytes = max_bytes;
}
if ( env_max_fraction )
{
max_fraction = atof (env_max_fraction);
if ( max_fraction < 0 ) max_fraction = 0;
if ( max_fraction > 1 ) max_fraction = 1;
Common->maxGpuMemFraction = max_fraction;
}
}
}
else
{
/* CHOLMOD_USE_GPU environment variable not set, so no GPU
* acceleration will be used */
Common->useGPU = 0;
}
/* fprintf (stderr, "useGPU queried: %d\n", Common->useGPU) ; */
}
/* Ensure that a GPU is present */
if ( Common->useGPU == 1 )
{
/* fprintf (stderr, "\nprobe GPU:\n") ; */
Common->useGPU = CHOLMOD(gpu_probe) (Common);
/* fprintf (stderr, "\nprobe GPU: result %d\n", Common->useGPU) ; */
}
if ( Common->useGPU == 1 )
{
/* Cholesky + GPU, so allocate space */
/* fprintf (stderr, "allocate GPU:\n") ; */
CHOLMOD(gpu_allocate) ( Common );
/* fprintf (stderr, "allocate GPU done\n") ; */
}
#else
/* GPU acceleration is only supported for long int version */
Common->useGPU = 0;
#endif
/* Cache the fact that the symbolic factorization supports
* GPU acceleration */
L->useGPU = Common->useGPU;
}
#else
/* GPU module is not installed */
Common->useGPU = 0 ;
#endif
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
/* A is now either A or triu(A(p,p)) for the symmetric case. It is either
* A or A(p,f) for the unsymmetric case (both in column form). It can be
* either packed or unpacked, and either sorted or unsorted. Entries in
* the lower triangular part may be present if A is symmetric, but these
* are ignored. */
Ap = A->p ;
Ai = A->i ;
Anz = A->nz ;
if (stype != 0)
{
/* F not accessed */
Fp = NULL ;
Fj = NULL ;
Fnz = NULL ;
packed = TRUE ;
}
else
{
/* F = A(:,f) or A(p,f) in packed row form, either sorted or unsorted */
Fp = F->p ;
Fj = F->i ;
Fnz = F->nz ;
packed = F->packed ;
}
ColCount = L->ColCount ;
nrelax0 = Common->nrelax [0] ;
nrelax1 = Common->nrelax [1] ;
nrelax2 = Common->nrelax [2] ;
zrelax0 = Common->zrelax [0] ;
zrelax1 = Common->zrelax [1] ;
zrelax2 = Common->zrelax [2] ;
zrelax0 = IS_NAN (zrelax0) ? 0 : zrelax0 ;
zrelax1 = IS_NAN (zrelax1) ? 0 : zrelax1 ;
zrelax2 = IS_NAN (zrelax2) ? 0 : zrelax2 ;
ASSERT (CHOLMOD(dump_parent) (Parent, n, "Parent", Common)) ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
/* Sparent, Snz, and Merged could be allocated later, of size nfsuper */
Iwork = Common->Iwork ;
Wi = Iwork ; /* size n (i/l/l). Lpi2 is i/l/l */
Wj = Iwork + n ; /* size n (i/l/l). Zeros is i/l/l */
Sparent = Iwork + 2*((size_t) n) ; /* size nfsuper <= n [ */
Snz = Iwork + 3*((size_t) n) ; /* size nfsuper <= n [ */
Merged = Iwork + 4*((size_t) n) ; /* size nfsuper <= n [ */
Flag = Common->Flag ; /* size n */
Head = Common->Head ; /* size n+1 */
/* ---------------------------------------------------------------------- */
/* find the fundamental supernodes */
/* ---------------------------------------------------------------------- */
/* count the number of children of each node, using Wi [ */
for (j = 0 ; j < n ; j++)
{
Wi [j] = 0 ;
}
for (j = 0 ; j < n ; j++)
{
parent = Parent [j] ;
if (parent != EMPTY)
{
Wi [parent]++ ;
}
}
Super = Head ; /* use Head [0..nfsuper] as workspace for Super list ( */
/* column 0 always starts a new supernode */
nfsuper = (n == 0) ? 0 : 1 ; /* number of fundamental supernodes */
Super [0] = 0 ;
for (j = 1 ; j < n ; j++)
{
/* check if j starts new supernode, or in the same supernode as j-1 */
if (Parent [j-1] != j /* parent of j-1 is not j */
|| (ColCount [j-1] != ColCount [j] + 1) /* j-1 not subset of j*/
|| Wi [j] > 1 /* j has more than one child */
#ifdef GPU_BLAS
/* Ensure that the supernode will fit in the GPU buffers */
/* Data size of 16 bytes must be assumed for case of PATTERN */
|| (for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY && L->useGPU &&
(j-Super[nfsuper-1]+1) *
ColCount[Super[nfsuper-1]] * sizeof(double) * 2 >=
Common->devBuffSize)
#endif
)
{
/* j is the leading node of a supernode */
Super [nfsuper++] = j ;
}
}
Super [nfsuper] = n ;
/* contents of Wi no longer needed for child count ] */
Nscol = Wi ; /* use Wi as size-nfsuper workspace for Nscol [ */
/* ---------------------------------------------------------------------- */
/* find the mapping of fundamental nodes to supernodes */
/* ---------------------------------------------------------------------- */
SuperMap = Wj ; /* use Wj as workspace for SuperMap [ */
/* SuperMap [k] = s if column k is contained in supernode s */
for (s = 0 ; s < nfsuper ; s++)
{
for (k = Super [s] ; k < Super [s+1] ; k++)
{
SuperMap [k] = s ;
}
}
/* ---------------------------------------------------------------------- */
/* construct the fundamental supernodal etree */
/* ---------------------------------------------------------------------- */
for (s = 0 ; s < nfsuper ; s++)
{
j = Super [s+1] - 1 ; /* last node in supernode s */
parent = Parent [j] ; /* parent of last node */
Sparent [s] = (parent == EMPTY) ? EMPTY : SuperMap [parent] ;
PRINT1 (("Sparent ["ID"] = "ID"\n", s, Sparent [s])) ;
}
/* contents of Wj no longer needed as workspace for SuperMap ]
* SuperMap will be recomputed below, for the relaxed supernodes. */
Zeros = Wj ; /* use Wj for Zeros, workspace of size nfsuper [ */
/* ---------------------------------------------------------------------- */
/* relaxed amalgamation */
/* ---------------------------------------------------------------------- */
for (s = 0 ; s < nfsuper ; s++)
{
Merged [s] = EMPTY ; /* s not merged into another */
Nscol [s] = Super [s+1] - Super [s] ; /* # of columns in s */
Zeros [s] = 0 ; /* # of zero entries in s */
ASSERT (s <= Super [s]) ;
Snz [s] = ColCount [Super [s]] ; /* # of entries in leading col of s */
PRINT2 (("lnz ["ID"] "ID"\n", s, Snz [s])) ;
}
for (s = nfsuper-2 ; s >= 0 ; s--)
{
double lnz1 ;
/* should supernodes s and s+1 merge into a new node s? */
PRINT1 (("\n========= Check relax of s "ID" and s+1 "ID"\n", s, s+1)) ;
ss = Sparent [s] ;
if (ss == EMPTY)
{
PRINT1 (("s "ID" is a root, no merge with s+1 = "ID"\n", s, s+1)) ;
continue ;
}
/* find the current parent of s (perform path compression as needed) */
for (ss = Sparent [s] ; Merged [ss] != EMPTY ; ss = Merged [ss]) ;
sparent = ss ;
PRINT2 (("Current sparent of s "ID" is "ID"\n", s, sparent)) ;
/* ss is the current parent of s */
for (ss = Sparent [s] ; Merged [ss] != EMPTY ; ss = snext)
{
snext = Merged [ss] ;
PRINT2 (("ss "ID" is dead, merged into snext "ID"\n", ss, snext)) ;
Merged [ss] = sparent ;
}
/* if s+1 is not the current parent of s, do not merge */
if (sparent != s+1)
{
continue ;
}
nscol0 = Nscol [s] ; /* # of columns in s */
nscol1 = Nscol [s+1] ; /* # of columns in s+1 */
ns = nscol0 + nscol1 ;
PRINT2 (("ns "ID" nscol0 "ID" nscol1 "ID"\n", ns, nscol0, nscol1)) ;
totzeros = Zeros [s+1] ; /* current # of zeros in s+1 */
lnz1 = (double) (Snz [s+1]) ; /* # entries in leading column of s+1 */
/* determine if supernodes s and s+1 should merge */
if (ns <= nrelax0)
{
PRINT2 (("ns is tiny ("ID"), so go ahead and merge\n", ns)) ;
merge = TRUE ;
}
else
{
/* use double to avoid integer overflow */
double lnz0 = Snz [s] ; /* # entries in leading column of s */
double xnewzeros = nscol0 * (lnz1 + nscol0 - lnz0) ;
/* use Int for the final update of Zeros [s] below */
newzeros = nscol0 * (Snz [s+1] + nscol0 - Snz [s]) ;
ASSERT (newzeros == xnewzeros) ;
PRINT2 (("lnz0 %g lnz1 %g xnewzeros %g\n", lnz0, lnz1, xnewzeros)) ;
if (xnewzeros == 0)
{
/* no new zeros, so go ahead and merge */
PRINT2 (("no new fillin, so go ahead and merge\n")) ;
merge = TRUE ;
}
else
{
/* # of zeros if merged */
double xtotzeros = ((double) totzeros) + xnewzeros ;
/* xtotsize: total size of merged supernode, if merged: */
double xns = (double) ns ;
double xtotsize = (xns * (xns+1) / 2) + xns * (lnz1 - nscol1) ;
double z = xtotzeros / xtotsize ;
Int totsize ;
totsize = (ns * (ns+1) / 2) + ns * (Snz [s+1] - nscol1) ;
PRINT2 (("oldzeros "ID" newzeros "ID" xtotsize %g z %g\n",
Zeros [s+1], newzeros, xtotsize, z)) ;
/* use Int for the final update of Zeros [s] below */
totzeros += newzeros ;
/* do not merge if supernode would become too big
* (Int overflow). Continue computing; not (yet) an error. */
/* fl.pt. compare, but no NaN's can occur here */
merge = ((ns <= nrelax1 && z < zrelax0) ||
(ns <= nrelax2 && z < zrelax1) ||
(z < zrelax2)) &&
(xtotsize < Int_max / sizeof (double)) ;
}
}
#ifdef GPU_BLAS
if ( for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY && L->useGPU ) {
/* Ensure that the aggregated supernode fits in the device
supernode buffers */
double xns = (double) ns;
if ( ((xns * xns) + xns * (lnz1 - nscol1))*sizeof(double)*2 >=
Common->devBuffSize ) {
merge = FALSE;
}
}
#endif
if (merge)
{
PRINT1 (("Merge node s ("ID") and s+1 ("ID")\n", s, s+1)) ;
Zeros [s] = totzeros ;
Merged [s+1] = s ;
Snz [s] = nscol0 + Snz [s+1] ;
Nscol [s] += Nscol [s+1] ;
}
}
/* contents of Wj no longer needed for Zeros ] */
/* contents of Wi no longer needed for Nscol ] */
/* contents of Sparent no longer needed (recomputed below) */
/* ---------------------------------------------------------------------- */
/* construct the relaxed supernode list */
/* ---------------------------------------------------------------------- */
nsuper = 0 ;
for (s = 0 ; s < nfsuper ; s++)
{
if (Merged [s] == EMPTY)
{
PRINT1 (("live supernode: "ID" snz "ID"\n", s, Snz [s])) ;
Super [nsuper] = Super [s] ;
Snz [nsuper] = Snz [s] ;
nsuper++ ;
}
}
Super [nsuper] = n ;
PRINT1 (("Fundamental supernodes: "ID" relaxed "ID"\n", nfsuper, nsuper)) ;
/* Merged no longer needed ] */
/* ---------------------------------------------------------------------- */
/* find the mapping of relaxed nodes to supernodes */
/* ---------------------------------------------------------------------- */
/* use Wj as workspace for SuperMap { */
/* SuperMap [k] = s if column k is contained in supernode s */
for (s = 0 ; s < nsuper ; s++)
{
for (k = Super [s] ; k < Super [s+1] ; k++)
{
SuperMap [k] = s ;
}
}
/* ---------------------------------------------------------------------- */
/* construct the relaxed supernodal etree */
/* ---------------------------------------------------------------------- */
for (s = 0 ; s < nsuper ; s++)
{
j = Super [s+1] - 1 ; /* last node in supernode s */
parent = Parent [j] ; /* parent of last node */
Sparent [s] = (parent == EMPTY) ? EMPTY : SuperMap [parent] ;
PRINT1 (("new Sparent ["ID"] = "ID"\n", s, Sparent [s])) ;
}
/* ---------------------------------------------------------------------- */
/* determine the size of L->s and L->x */
/* ---------------------------------------------------------------------- */
ssize = 0 ;
xsize = 0 ;
xxsize = 0 ;
find_xsize = for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY ||
for_whom == CHOLMOD_ANALYZE_FOR_SPQRGPU ;
for (s = 0 ; s < nsuper ; s++)
{
nscol = Super [s+1] - Super [s] ;
nsrow = Snz [s] ;
ASSERT (nscol > 0) ;
ssize += nsrow ;
if (find_xsize)
{
xsize += nscol * nsrow ;
/* also compute xsize in double to guard against Int overflow */
xxsize += ((double) nscol) * ((double) nsrow) ;
}
if (ssize < 0 ||(find_xsize && xxsize > Int_max))
{
/* Int overflow, clear workspace and return.
QR factorization will not use xxsize, so that error is ignored.
For Cholesky factorization, however, memory of space xxsize
will be allocated, so this is a failure. Both QR and Cholesky
fail if ssize overflows. */
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
FREE_WORKSPACE ;
return (FALSE) ;
}
ASSERT (ssize > 0) ;
ASSERT (IMPLIES (find_xsize, xsize > 0)) ;
}
xsize = MAX (1, xsize) ;
ssize = MAX (1, ssize) ;
PRINT1 (("ix sizes: "ID" "ID" nsuper "ID"\n", ssize, xsize, nsuper)) ;
/* ---------------------------------------------------------------------- */
/* allocate L (all except real part L->x) */
/* ---------------------------------------------------------------------- */
L->ssize = ssize ;
L->xsize = xsize ;
L->nsuper = nsuper ;
CHOLMOD(change_factor) (CHOLMOD_PATTERN, TRUE, TRUE, TRUE, TRUE, L, Common);
if (Common->status < CHOLMOD_OK)
{
/* out of memory; L is still a valid simplicial symbolic factor */
FREE_WORKSPACE ;
return (FALSE) ;
}
DEBUG (CHOLMOD(dump_factor) (L, "L to symbolic super", Common)) ;
ASSERT (L->is_ll && L->xtype == CHOLMOD_PATTERN && L->is_super) ;
Lpi = L->pi ;
Lpx = L->px ;
Ls = L->s ;
Ls [0] = 0 ; /* flag for cholmod_check_factor; supernodes are defined */
Lsuper = L->super ;
/* copy the list of relaxed supernodes into the final list in L */
for (s = 0 ; s <= nsuper ; s++)
{
Lsuper [s] = Super [s] ;
}
/* Head no longer needed as workspace for fundamental Super list ) */
Super = Lsuper ; /* Super is now the list of relaxed supernodes */
/* ---------------------------------------------------------------------- */
/* construct column pointers of relaxed supernodal pattern (L->pi) */
/* ---------------------------------------------------------------------- */
p = 0 ;
for (s = 0 ; s < nsuper ; s++)
{
Lpi [s] = p ;
p += Snz [s] ;
PRINT1 (("Snz ["ID"] = "ID", Super ["ID"] = "ID"\n",
s, Snz [s], s, Super[s])) ;
}
Lpi [nsuper] = p ;
ASSERT ((Int) (L->ssize) == MAX (1,p)) ;
/* ---------------------------------------------------------------------- */
/* construct pointers for supernodal values (L->px) */
/* ---------------------------------------------------------------------- */
if (for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY ||
for_whom == CHOLMOD_ANALYZE_FOR_SPQRGPU)
{
Lpx [0] = 0 ;
p = 0 ;
for (s = 0 ; s < nsuper ; s++)
{
nscol = Super [s+1] - Super [s] ; /* number of columns in s */
nsrow = Snz [s] ; /* # of rows, incl triangular part*/
Lpx [s] = p ; /* pointer to numerical part of s */
p += nscol * nsrow ;
}
Lpx [s] = p ;
ASSERT ((Int) (L->xsize) == MAX (1,p)) ;
}
else
{
/* L->px is not needed for non-GPU accelerated QR factorization (it may
* lead to Int overflow, anyway, if xsize caused Int overflow above).
* Use a magic number to tell cholmod_check_factor to ignore Lpx. */
Lpx [0] = 123456 ;
}
/* Snz no longer needed ] */
/* ---------------------------------------------------------------------- */
/* symbolic analysis to construct the relaxed supernodal pattern (L->s) */
/* ---------------------------------------------------------------------- */
Lpi2 = Wi ; /* copy Lpi into Lpi2, using Wi as workspace for Lpi2 [ */
for (s = 0 ; s < nsuper ; s++)
{
Lpi2 [s] = Lpi [s] ;
}
Asorted = A->sorted ;
for (s = 0 ; s < nsuper ; s++)
{
/* sth supernode is in columns k1 to k2-1.
* compute nonzero pattern of L (k1:k2-1,:). */
/* place rows k1 to k2-1 in leading column of supernode s */
k1 = Super [s] ;
k2 = Super [s+1] ;
PRINT1 (("=========>>> Supernode "ID" k1 "ID" k2-1 "ID"\n",
s, k1, k2-1)) ;
for (k = k1 ; k < k2 ; k++)
{
Ls [Lpi2 [s]++] = k ;
}
/* compute nonzero pattern each row k1 to k2-1 */
for (k = k1 ; k < k2 ; k++)
{
/* compute row k of L. In the symmetric case, the pattern of L(k,:)
* is the set of nodes reachable in the supernodal etree from any
* row i in the nonzero pattern of A(0:k,k). In the unsymmetric
* case, the pattern of the kth column of A*A' is the set union
* of all columns A(0:k,j) for each nonzero F(j,k). */
/* clear the Flag array and mark the current supernode */
/* mark = CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
Flag [s] = mark ;
ASSERT (s == SuperMap [k]) ;
/* traverse the row subtree for each nonzero in A or AA' */
if (stype != 0)
{
subtree (k, k, Ap, Ai, Anz, SuperMap, Sparent, mark,
Asorted, k1, Flag, Ls, Lpi2) ;
}
else
{
/* for each j nonzero in F (:,k) do */
p = Fp [k] ;
pend = (packed) ? (Fp [k+1]) : (p + Fnz [k]) ;
for ( ; p < pend ; p++)
{
subtree (Fj [p], k, Ap, Ai, Anz, SuperMap, Sparent, mark,
Asorted, k1, Flag, Ls, Lpi2) ;
}
}
}
}
#ifndef NDEBUG
for (s = 0 ; s < nsuper ; s++)
{
PRINT1 (("Lpi2[s] "ID" Lpi[s+1] "ID"\n", Lpi2 [s], Lpi [s+1])) ;
ASSERT (Lpi2 [s] == Lpi [s+1]) ;
CHOLMOD(dump_super) (s, Super, Lpi, Ls, NULL, NULL, 0, Common) ;
}
#endif
/* contents of Wi no longer needed for Lpi2 ] */
/* Sparent no longer needed ] */
/* ---------------------------------------------------------------------- */
/* determine the largest update matrix (L->maxcsize) */
/* ---------------------------------------------------------------------- */
/* maxcsize could be determined before L->s is allocated and defined, which
* would mean that all memory requirements for both the symbolic and numeric
* factorizations could be computed using O(nnz(A)+O(n)) space. However, it
* would require a lot of extra work. The analysis phase, above, would need
* to be duplicated, but with Ls not kept; instead, the algorithm would keep
* track of the current s and slast for each supernode d, and update them
* when a new row index appears in supernode d. An alternative would be to
* do this computation only if the allocation of L->s failed, in which case
* the following code would be skipped.
*
* The csize for a supernode is the size of its largest contribution to
* a subsequent ancestor supernode. For example, suppose the rows of #'s
* in the figure below correspond to the columns of a subsequent supernode,
* and the dots are the entries in that ancestore.
*
* c
* c c
* c c c
* x x x
* x x x
* # # # .
* # # # . .
* * * * . .
* * * * . .
* * * * . .
* . .
*
* Then for this update, the csize is 3-by-2, or 6, because there are 3
* rows of *'s which is the number of rows in the update, and there are
* 2 rows of #'s, which is the number columns in the update. The csize
* of a supernode is the largest such contribution for any ancestor
* supernode. maxcsize, for the whole matrix, has a rough upper bound of
* the maximum size of any supernode. This bound is loose, because the
* the contribution must be less than the size of the ancestor supernodal
* that it's updating. maxcsize of a completely dense matrix, with one
* supernode, is zero.
*
* maxesize is the column dimension for the workspace E needed for the
* solve. E is of size nrhs-by-maxesize, where the nrhs is the number of
* columns in the right-hand-side. The maxesize is the largest esize of
* any supernode. The esize of a supernode is the number of row indices
* it contains, excluding the column indices of the supernode itself.
* For the following example, esize is 4:
*
* c
* c c
* c c c
* x x x
* x x x
* x x x
* x x x
*
* maxesize can be no bigger than n.
*/
maxcsize = 1 ;
maxesize = 1 ;
/* Do not need to guard csize against Int overflow since xsize is OK. */
if (for_whom == CHOLMOD_ANALYZE_FOR_CHOLESKY ||
for_whom == CHOLMOD_ANALYZE_FOR_SPQRGPU)
{
/* this is not needed for non-GPU accelerated QR factorization */
for (d = 0 ; d < nsuper ; d++)
{
nscol = Super [d+1] - Super [d] ;
p = Lpi [d] + nscol ;
plast = p ;
pend = Lpi [d+1] ;
esize = pend - p ;
maxesize = MAX (maxesize, esize) ;
slast = (p == pend) ? (EMPTY) : (SuperMap [Ls [p]]) ;
for ( ; p <= pend ; p++)
{
s = (p == pend) ? (EMPTY) : (SuperMap [Ls [p]]) ;
if (s != slast)
{
/* row i is the start of a new supernode */
ndrow1 = p - plast ;
ndrow2 = pend - plast ;
csize = ndrow2 * ndrow1 ;
PRINT1 (("Supernode "ID" ancestor "ID" C: "ID"-by-"ID
" csize "ID"\n", d, slast, ndrow1, ndrow2, csize)) ;
maxcsize = MAX (maxcsize, csize) ;
plast = p ;
slast = s ;
}
}
}
PRINT1 (("max csize "ID"\n", maxcsize)) ;
}
/* Wj no longer needed for SuperMap } */
L->maxcsize = maxcsize ;
L->maxesize = maxesize ;
L->is_super = TRUE ;
ASSERT (L->xtype == CHOLMOD_PATTERN && L->is_ll) ;
/* ---------------------------------------------------------------------- */
/* supernodal symbolic factorization is complete */
/* ---------------------------------------------------------------------- */
FREE_WORKSPACE ;
return (TRUE) ;
}
int CHOLMOD(symmetry)
(
/* ---- input ---- */
cholmod_sparse *A,
int option, /* option 0, 1, or 2 (see above) */
/* ---- output --- */ /* outputs ignored if any are NULL */
Int *p_xmatched, /* # of matched numerical entries */
Int *p_pmatched, /* # of matched entries in pattern */
Int *p_nzoffdiag, /* # of off diagonal entries */
Int *p_nzdiag, /* # of diagonal entries */
/* --------------- */
cholmod_common *Common
)
{
double aij_real = 0, aij_imag = 0, aji_real = 0, aji_imag = 0 ;
double *Ax, *Az ;
Int *Ap, *Ai, *Anz, *munch ;
Int packed, nrow, ncol, xtype, is_symmetric, is_skew, is_hermitian, posdiag,
j, p, pend, i, piend, result, xmatched, pmatched, nzdiag, i2, found ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (EMPTY) ;
RETURN_IF_NULL (A, EMPTY) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ;
Common->status = CHOLMOD_OK ;
ASSERT (CHOLMOD(dump_sparse) (A, "cholmod_symmetry", Common) >= 0) ;
if (p_xmatched == NULL || p_pmatched == NULL
|| p_nzoffdiag == NULL || p_nzdiag == NULL)
{
/* option 2 is not performed if any output parameter is NULL */
option = MAX (option, 1) ;
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Ai = A->i ;
Ax = A->x ;
Az = A->z ;
Anz = A->nz ;
packed = A->packed ;
ncol = A->ncol ;
nrow = A->nrow ;
xtype = A->xtype ;
/* ---------------------------------------------------------------------- */
/* check if rectangular, unsorted, or stype is not zero */
/* ---------------------------------------------------------------------- */
if (nrow != ncol)
{
/* matrix is rectangular */
return (CHOLMOD_MM_RECTANGULAR) ;
}
if (!(A->sorted) || A->stype != 0)
{
/* this function cannot determine the type or symmetry */
return (EMPTY) ;
}
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* this function requires uninitialized Int workspace of size ncol */
CHOLMOD(allocate_work) (0, ncol, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (EMPTY) ;
}
munch = Common->Iwork ; /* the munch array is size ncol */
/* ---------------------------------------------------------------------- */
/* determine symmetry of a square matrix */
/* ---------------------------------------------------------------------- */
/* a complex or zomplex matrix is Hermitian until proven otherwise */
is_hermitian = (xtype >= CHOLMOD_COMPLEX) ;
/* any matrix is symmetric until proven otherwise */
is_symmetric = TRUE ;
/* a non-pattern matrix is skew-symmetric until proven otherwise */
is_skew = (xtype != CHOLMOD_PATTERN) ;
/* a matrix has positive diagonal entries until proven otherwise */
posdiag = TRUE ;
/* munch pointers start at the top of each column */
for (j = 0 ; j < ncol ; j++)
{
munch [j] = Ap [j] ;
}
xmatched = 0 ;
pmatched = 0 ;
nzdiag = 0 ;
for (j = 0 ; j < ncol ; j++) /* examine each column of A */
{
/* ------------------------------------------------------------------ */
/* look at the entire munch column j */
/* ------------------------------------------------------------------ */
/* start at the munch point of column j, and go to end of the column */
p = munch [j] ;
pend = (packed) ? (Ap [j+1]) : (Ap [j] + Anz [j]) ;
for ( ; p < pend ; p++)
{
/* get the row index of A(i,j) */
i = Ai [p] ;
if (i < j)
{
/* ---------------------------------------------------------- */
/* A(i,j) in triu(A), but matching A(j,i) not in tril(A) */
/* ---------------------------------------------------------- */
/* entry A(i,j) is unmatched; it appears in the upper triangular
* part, but not the lower triangular part. The matrix is
* unsymmetric. */
is_hermitian = FALSE ;
is_symmetric = FALSE ;
is_skew = FALSE ;
}
else if (i == j)
{
/* ---------------------------------------------------------- */
/* the diagonal A(j,j) is present; check its value */
/* ---------------------------------------------------------- */
get_value (Ax, Az, p, xtype, &aij_real, &aij_imag) ;
if (aij_real != 0. || aij_imag != 0.)
{
/* diagonal is nonzero; matrix is not skew-symmetric */
nzdiag++ ;
is_skew = FALSE ;
}
if (aij_real <= 0. || aij_imag != 0.)
{
/* diagonal negative or imaginary; not chol candidate */
posdiag = FALSE ;
}
if (aij_imag != 0.)
{
/* imaginary part is present; not Hermitian */
is_hermitian = FALSE ;
}
}
else /* i > j */
{
/* ---------------------------------------------------------- */
/* consider column i, up to and including row j */
/* ---------------------------------------------------------- */
/* munch the entry at top of column i up to and incl row j */
piend = (packed) ? (Ap [i+1]) : (Ap [i] + Anz [i]) ;
found = FALSE ;
for ( ; munch [i] < piend ; munch [i]++)
{
i2 = Ai [munch [i]] ;
if (i2 < j)
{
/* -------------------------------------------------- */
/* A(i2,i) in triu(A) but A(i,i2) not in tril(A) */
/* -------------------------------------------------- */
/* The matrix is unsymmetric. */
is_hermitian = FALSE ;
is_symmetric = FALSE ;
is_skew = FALSE ;
}
else if (i2 == j)
{
/* -------------------------------------------------- */
/* both A(i,j) and A(j,i) exist in the matrix */
/* -------------------------------------------------- */
/* this is one more matching entry in the pattern */
pmatched += 2 ;
found = TRUE ;
/* get the value of A(i,j) */
get_value (Ax, Az, p, xtype, &aij_real, &aij_imag) ;
/* get the value of A(j,i) */
get_value (Ax, Az, munch [i],
xtype, &aji_real, &aji_imag) ;
/* compare A(i,j) with A(j,i) */
if (aij_real != aji_real || aij_imag != aji_imag)
{
/* the matrix cannot be symmetric */
is_symmetric = FALSE ;
}
if (aij_real != -aji_real || aij_imag != aji_imag)
{
/* the matrix cannot be skew-symmetric */
is_skew = FALSE ;
}
if (aij_real != aji_real || aij_imag != -aji_imag)
{
/* the matrix cannot be Hermitian */
is_hermitian = FALSE ;
}
else
{
/* A(i,j) and A(j,i) are numerically matched */
xmatched += 2 ;
}
}
else /* i2 > j */
{
/* -------------------------------------------------- */
/* entry A(i2,i) is not munched; consider it later */
/* -------------------------------------------------- */
break ;
}
}
if (!found)
{
/* A(i,j) in tril(A) but A(j,i) not in triu(A).
* The matrix is unsymmetric. */
is_hermitian = FALSE ;
is_symmetric = FALSE ;
is_skew = FALSE ;
}
}
if (option < 2 && !(is_symmetric || is_skew || is_hermitian))
{
/* matrix is unsymmetric; terminate the test */
return (CHOLMOD_MM_UNSYMMETRIC) ;
}
}
/* ------------------------------------------------------------------ */
/* quick return if not Cholesky candidate */
/* ------------------------------------------------------------------ */
if (option < 1 && (!posdiag || nzdiag < ncol))
{
/* Diagonal entry not present, or present but negative or with
* nonzero imaginary part. Quick return for option 0. */
return (CHOLMOD_MM_UNSYMMETRIC) ;
}
}
/* ---------------------------------------------------------------------- */
/* return the results */
/* ---------------------------------------------------------------------- */
if (nzdiag < ncol)
{
/* not all diagonal entries are present */
posdiag = FALSE ;
}
if (option >= 2)
{
*p_xmatched = xmatched ;
*p_pmatched = pmatched ;
*p_nzoffdiag = CHOLMOD(nnz) (A, Common) - nzdiag ;
*p_nzdiag = nzdiag ;
}
result = CHOLMOD_MM_UNSYMMETRIC ;
if (is_hermitian)
{
/* complex Hermitian matrix, with either pos. or non-pos. diagonal */
result = posdiag ? CHOLMOD_MM_HERMITIAN_POSDIAG : CHOLMOD_MM_HERMITIAN ;
}
else if (is_symmetric)
{
/* real or complex symmetric matrix, with pos. or non-pos. diagonal */
result = posdiag ? CHOLMOD_MM_SYMMETRIC_POSDIAG : CHOLMOD_MM_SYMMETRIC ;
}
else if (is_skew)
{
/* real or complex skew-symmetric matrix */
result = CHOLMOD_MM_SKEW_SYMMETRIC ;
}
return (result) ;
}
int CHOLMOD(scale)
(
/* ---- input ---- */
cholmod_dense *S, /* scale factors (scalar or vector) */
int scale, /* type of scaling to compute */
/* ---- in/out --- */
cholmod_sparse *A, /* matrix to scale */
/* --------------- */
cholmod_common *Common
)
{
double t ;
double *Ax, *s ;
Int *Ap, *Anz, *Ai ;
Int packed, j, ncol, nrow, p, pend, sncol, snrow, nn, ok ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (S, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (S, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
ncol = A->ncol ;
nrow = A->nrow ;
sncol = S->ncol ;
snrow = S->nrow ;
if (scale == CHOLMOD_SCALAR)
{
ok = (snrow == 1 && sncol == 1) ;
}
else if (scale == CHOLMOD_ROW)
{
ok = (snrow == nrow && sncol == 1) || (snrow == 1 && sncol == nrow) ;
}
else if (scale == CHOLMOD_COL)
{
ok = (snrow == ncol && sncol == 1) || (snrow == 1 && sncol == ncol) ;
}
else if (scale == CHOLMOD_SYM)
{
nn = MAX (nrow, ncol) ;
ok = (snrow == nn && sncol == 1) || (snrow == 1 && sncol == nn) ;
}
else
{
/* scale invalid */
ERROR (CHOLMOD_INVALID, "invalid scaling option") ;
return (FALSE) ;
}
if (!ok)
{
/* S is wrong size */
ERROR (CHOLMOD_INVALID, "invalid scale factors") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
packed = A->packed ;
s = S->x ;
/* ---------------------------------------------------------------------- */
/* scale the matrix */
/* ---------------------------------------------------------------------- */
if (scale == CHOLMOD_ROW)
{
/* ------------------------------------------------------------------ */
/* A = diag(s)*A, row scaling */
/* ------------------------------------------------------------------ */
for (j = 0 ; j < ncol ; j++)
{
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
Ax [p] *= s [Ai [p]] ;
}
}
}
else if (scale == CHOLMOD_COL)
{
/* ------------------------------------------------------------------ */
/* A = A*diag(s), column scaling */
/* ------------------------------------------------------------------ */
for (j = 0 ; j < ncol ; j++)
{
t = s [j] ;
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
Ax [p] *= t ;
}
}
}
else if (scale == CHOLMOD_SYM)
{
/* ------------------------------------------------------------------ */
/* A = diag(s)*A*diag(s), symmetric scaling */
/* ------------------------------------------------------------------ */
for (j = 0 ; j < ncol ; j++)
{
t = s [j] ;
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
Ax [p] *= t * s [Ai [p]] ;
}
}
}
else if (scale == CHOLMOD_SCALAR)
{
/* ------------------------------------------------------------------ */
/* A = s[0] * A, scalar scaling */
/* ------------------------------------------------------------------ */
t = s [0] ;
for (j = 0 ; j < ncol ; j++)
{
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
Ax [p] *= t ;
}
}
}
ASSERT (CHOLMOD(dump_sparse) (A, "A scaled", Common) >= 0) ;
return (TRUE) ;
}
int CHOLMOD(rowadd_mark)
(
/* ---- input ---- */
size_t kadd, /* row/column index to add */
cholmod_sparse *R, /* row/column of matrix to factorize (n-by-1) */
double bk [2], /* kth entry of the right hand side, b */
Int *colmark, /* Int array of size 1. See cholmod_updown.c */
/* ---- in/out --- */
cholmod_factor *L, /* factor to modify */
cholmod_dense *X, /* solution to Lx=b (size n-by-1) */
cholmod_dense *DeltaB, /* change in b, zero on output */
/* --------------- */
cholmod_common *Common
)
{
double dk, yj, l_kj, lx, l_ij, sqrt_dk, dj, xk, rnz, fl ;
double *Lx, *W, *Cx, *Rx, *Xx, *Nx ;
Int *Li, *Lp, *Lnz, *Flag, *Stack, *Ci, *Rj, *Rp, *Lnext, *Iwork, *Rnz ;
cholmod_sparse *C, Cmatrix ;
Int i, j, p, pend, top, len, kk, li, lnz, mark, k, n, parent, Cp [2],
do_solve, do_update ;
size_t s ;
int ok = TRUE ;
DEBUG (Int lastrow) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_NULL (R, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (R, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
n = L->n ;
k = kadd ;
if (kadd >= L->n || k < 0)
{
ERROR (CHOLMOD_INVALID, "k invalid") ;
return (FALSE) ;
}
if (R->ncol != 1 || R->nrow != L->n)
{
ERROR (CHOLMOD_INVALID, "R invalid") ;
return (FALSE) ;
}
Rj = R->i ;
Rx = R->x ;
Rp = R->p ;
Rnz = R->nz ;
rnz = (R->packed) ? (Rp [1]) : (Rnz [0]) ;
do_solve = (X != NULL) && (DeltaB != NULL) ;
if (do_solve)
{
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
Xx = X->x ;
Nx = DeltaB->x ;
if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n ||
DeltaB->ncol != 1 || Xx == NULL || Nx == NULL)
{
ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ;
return (FALSE) ;
}
}
else
{
Xx = NULL ;
Nx = NULL ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* s = 2*n */
s = CHOLMOD(mult_size_t) (n, 2, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (n, s, s, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, s, Common)) ;
/* ---------------------------------------------------------------------- */
/* convert to simplicial numeric LDL' factor, if not already */
/* ---------------------------------------------------------------------- */
if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll)
{
/* can only update/downdate a simplicial LDL' factorization */
CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L,
Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory, L is returned unchanged */
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
/* inputs, not modified on output: */
Lp = L->p ; /* size n+1. input, not modified on output */
/* outputs, contents defined on input for incremental case only: */
Lnz = L->nz ; /* size n */
Li = L->i ; /* size L->nzmax. Can change in size. */
Lx = L->x ; /* size L->nzmax. Can change in size. */
Lnext = L->next ; /* size n+2 */
ASSERT (L->nz != NULL) ;
PRINT1 (("rowadd:\n")) ;
fl = 0 ;
#if 0
#ifndef NDEBUG
/* column k of L should be zero, except for the diagonal. This test is
* overly cautious. */
for (p = Lp [k] + 1 ; p < Lp [k] + Lnz [k] ; p++) ASSERT (Lx [p] == 0) ;
#endif
#endif
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Flag = Common->Flag ; /* size n */
W = Common->Xwork ; /* size n */
Cx = W + n ; /* size n (use 2nd column of Xwork for C) */
Iwork = Common->Iwork ;
Stack = Iwork ; /* size n (i/i/l), also in cholmod_updown */
Ci = Iwork + n ; /* size n (i/i/l) */
/* NOTE: cholmod_updown uses Iwork [0..n-1] (i/i/l) as Stack as well */
mark = Common->mark ;
/* copy Rj/Rx into W/Ci */
for (p = 0 ; p < rnz ; p++)
{
i = Rj [p] ;
ASSERT (i >= 0 && i < n) ;
W [i] = Rx [p] ;
Ci [p] = i ;
}
/* At this point, W [Ci [0..rnz-1]] holds the sparse vector to add */
/* The nonzero pattern of column W is held in Ci (it may be unsorted). */
/* ---------------------------------------------------------------------- */
/* symbolic factorization to get pattern of kth row of L */
/* ---------------------------------------------------------------------- */
DEBUG (for (p = 0 ; p < rnz ; p++)
PRINT1 (("C ("ID",%g)\n", Ci [p], W [Ci [p]]))) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* flag the diagonal */
Flag [k] = mark ;
/* find the union of all the paths */
top = n ;
lnz = 0 ; /* # of nonzeros in column k of L, excluding diagonal */
for (p = 0 ; p < rnz ; p++)
{
i = Ci [p] ;
if (i < k)
{
/* walk from i = entry in Ci to root (and stop if i marked)*/
PRINT2 (("\nwalk from i = "ID" towards k = "ID"\n", i, k)) ;
len = 0 ;
/* walk up tree, but stop if we go below the diagonal */
while (i < k && i != EMPTY && Flag [i] < mark)
{
PRINT2 ((" Add "ID" to path\n", i)) ;
ASSERT (i >= 0 && i < k) ;
Stack [len++] = i ; /* place i on the stack */
Flag [i] = mark ; /* mark i as visited */
/* parent is the first entry in the column after the diagonal */
ASSERT (Lnz [i] > 0) ;
parent = (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY ;
PRINT2 ((" parent: "ID"\n", parent)) ;
i = parent ; /* go up the tree */
}
ASSERT (len <= top) ;
/* move the path down to the bottom of the stack */
/* this shifts Stack [0..len-1] down to [ ... oldtop-1] */
while (len > 0)
{
Stack [--top] = Stack [--len] ;
}
}
else if (i > k)
{
/* prune the diagonal and upper triangular entries from Ci */
Ci [lnz++] = i ;
Flag [i] = mark ;
}
}
#ifndef NDEBUG
PRINT1 (("length of S after prune: "ID"\n", lnz)) ;
for (p = 0 ; p < lnz ; p++)
{
PRINT1 (("After prune Ci ["ID"] = "ID"\n", p, Ci [p])) ;
ASSERT (Ci [p] > k) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* ensure each column of L has enough space to grow */
/* ---------------------------------------------------------------------- */
for (kk = top ; kk < n ; kk++)
{
/* could skip this if we knew column j already included row k */
j = Stack [kk] ;
if (Lp [j] + Lnz [j] >= Lp [Lnext [j]])
{
PRINT1 (("Col "ID" realloc, old Lnz "ID"\n", j, Lnz [j])) ;
if (!CHOLMOD(reallocate_column) (j, Lnz [j] + 1, L, Common))
{
/* out of memory, L is now simplicial symbolic */
/* CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
for (i = 0 ; i < n ; i++)
{
W [i] = 0 ;
}
return (FALSE) ;
}
/* L->i and L->x may have moved */
Li = L->i ;
Lx = L->x ;
}
ASSERT (Lp [j] + Lnz [j] < Lp [Lnext [j]]
|| (Lp [Lnext [j]] - Lp [j] == n-j)) ;
}
/* ---------------------------------------------------------------------- */
/* compute kth row of L and store in column form */
/* ---------------------------------------------------------------------- */
/* solve L (1:k-1, 1:k-1) * y (1:k-1) = b (1:k-1) */
/* where b (1:k) is in W and Ci */
/* L (k, 1:k-1) = y (1:k-1) ./ D (1:k-1) */
/* D (k) = B (k,k) - L (k, 1:k-1) * y (1:k-1) */
PRINT2 (("\nForward solve: "ID" to "ID"\n", top, n)) ;
ASSERT (Lnz [k] >= 1 && Li [Lp [k]] == k) ;
DEBUG (for (i = top ; i < n ; i++) PRINT2 ((" Path: "ID"\n", Stack [i]))) ;
dk = W [k] ;
W [k] = 0.0 ;
/* if do_solve: compute x (k) = b (k) - L (k, 1:k-1) * x (1:k-1) */
xk = bk [0] ;
PRINT2 (("B [k] = %g\n", xk)) ;
for (kk = top ; kk < n ; kk++)
{
j = Stack [kk] ;
i = j ;
PRINT2 (("Forward solve col j = "ID":\n", j)) ;
ASSERT (j >= 0 && j < k) ;
/* forward solve using L (j+1:k-1,j) */
yj = W [j] ;
W [j] = 0.0 ;
p = Lp [j] ;
pend = p + Lnz [j] ;
ASSERT (Lnz [j] > 0) ;
dj = Lx [p++] ;
for ( ; p < pend ; p++)
{
i = Li [p] ;
PRINT2 ((" row "ID"\n", i)) ;
ASSERT (i > j) ;
ASSERT (i < n) ;
/* stop at row k */
if (i >= k)
{
break ;
}
W [i] -= Lx [p] * yj ;
}
/* each iteration of the above for loop did 2 flops, and 3 flops
* are done below. so: fl += 2 * (Lp [j] - p - 1) + 3 becomes: */
fl += 2 * (Lp [j] - p) + 1 ;
/* scale L (k,1:k-1) and compute dot product for D (k,k) */
l_kj = yj / dj ;
dk -= l_kj * yj ;
/* compute dot product for X(k) */
if (do_solve)
{
xk -= l_kj * Xx [j] ;
}
/* store l_kj in the jth column of L */
/* and shift the rest of the column down */
li = k ;
lx = l_kj ;
if (i == k)
{
/* no need to modify the nonzero pattern of L, since it already
* contains row index k. */
ASSERT (Li [p] == k) ;
Lx [p] = l_kj ;
for (p++ ; p < pend ; p++)
{
i = Li [p] ;
l_ij = Lx [p] ;
ASSERT (i > k && i < n) ;
PRINT2 ((" apply to row "ID" of column k of L\n", i)) ;
/* add to the pattern of the kth column of L */
if (Flag [i] < mark)
{
PRINT2 ((" add Ci["ID"] = "ID"\n", lnz, i)) ;
ASSERT (i > k) ;
Ci [lnz++] = i ;
Flag [i] = mark ;
}
/* apply the update to the kth column of L */
/* yj is equal to l_kj * d_j */
W [i] -= l_ij * yj ;
}
}
else
{
PRINT2 (("Shift col j = "ID", apply saxpy to col k of L\n", j)) ;
for ( ; p < pend ; p++)
{
/* swap (Li [p],Lx [p]) with (li,lx) */
i = Li [p] ;
l_ij = Lx [p] ;
Li [p] = li ;
Lx [p] = lx ;
li = i ;
lx = l_ij ;
ASSERT (i > k && i < n) ;
PRINT2 ((" apply to row "ID" of column k of L\n", i)) ;
/* add to the pattern of the kth column of L */
if (Flag [i] < mark)
{
PRINT2 ((" add Ci["ID"] = "ID"\n", lnz, i)) ;
ASSERT (i > k) ;
Ci [lnz++] = i ;
Flag [i] = mark ;
}
/* apply the update to the kth column of L */
/* yj is equal to l_kj * d_j */
W [i] -= l_ij * yj ;
}
/* store the last value in the jth column of L */
Li [p] = li ;
Lx [p] = lx ;
Lnz [j]++ ;
}
}
/* ---------------------------------------------------------------------- */
/* merge C with the pattern of the existing column of L */
/* ---------------------------------------------------------------------- */
/* This column should be zero, but it may contain explicit zero entries.
* These entries should be kept, not dropped. */
p = Lp [k] ;
pend = p + Lnz [k] ;
for (p++ ; p < pend ; p++)
{
i = Li [p] ;
/* add to the pattern of the kth column of L */
if (Flag [i] < mark)
{
PRINT2 ((" add Ci["ID"] = "ID" from existing col k\n", lnz, i)) ;
ASSERT (i > k) ;
Ci [lnz++] = i ;
Flag [i] = mark ;
}
}
/* ---------------------------------------------------------------------- */
if (do_solve)
{
Xx [k] = xk ;
PRINT2 (("Xx [k] = %g\n", Xx [k])) ;
}
/* ---------------------------------------------------------------------- */
/* ensure abs (dk) >= dbound, if dbound is given */
/* ---------------------------------------------------------------------- */
dk = (IS_GT_ZERO (Common->dbound)) ? (CHOLMOD(dbound) (dk, Common)) : dk ;
PRINT2 (("D [k = "ID"] = %g\n", k, dk)) ;
/* ---------------------------------------------------------------------- */
/* store the kth column of L */
/* ---------------------------------------------------------------------- */
/* ensure the new column of L has enough space */
if (Lp [k] + lnz + 1 > Lp [Lnext [k]])
{
PRINT1 (("New Col "ID" realloc, old Lnz "ID"\n", k, Lnz [k])) ;
if (!CHOLMOD(reallocate_column) (k, lnz + 1, L, Common))
{
/* out of memory, L is now simplicial symbolic */
CHOLMOD(clear_flag) (Common) ;
for (i = 0 ; i < n ; i++)
{
W [i] = 0 ;
}
return (FALSE) ;
}
/* L->i and L->x may have moved */
Li = L->i ;
Lx = L->x ;
}
ASSERT (Lp [k] + lnz + 1 <= Lp [Lnext [k]]) ;
#ifndef NDEBUG
PRINT2 (("\nPrior to sort: lnz "ID" (excluding diagonal)\n", lnz)) ;
for (kk = 0 ; kk < lnz ; kk++)
{
i = Ci [kk] ;
PRINT2 (("L ["ID"] kept: "ID" %e\n", kk, i, W [i] / dk)) ;
}
#endif
/* sort Ci */
qsort (Ci, lnz, sizeof (Int), (int (*) (const void *, const void *)) icomp);
/* store the kth column of L */
DEBUG (lastrow = k) ;
p = Lp [k] ;
Lx [p++] = dk ;
Lnz [k] = lnz + 1 ;
fl += lnz ;
for (kk = 0 ; kk < lnz ; kk++, p++)
{
i = Ci [kk] ;
PRINT2 (("L ["ID"] after sort: "ID", %e\n", kk, i, W [i] / dk)) ;
ASSERT (i > lastrow) ;
Li [p] = i ;
Lx [p] = W [i] / dk ;
W [i] = 0.0 ;
DEBUG (lastrow = i) ;
}
/* compute DeltaB for updown (in DeltaB) */
if (do_solve)
{
p = Lp [k] ;
pend = p + Lnz [k] ;
for (p++ ; p < pend ; p++)
{
ASSERT (Li [p] > k) ;
Nx [Li [p]] -= Lx [p] * xk ;
}
}
/* clear the flag for the update */
mark = CHOLMOD(clear_flag) (Common) ;
/* workspaces are now cleared */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ;
/* ---------------------------------------------------------------------- */
/* update/downdate */
/* ---------------------------------------------------------------------- */
/* update or downdate L (k+1:n, k+1:n) with the vector
* C = L (:,k) * sqrt (abs (D [k])).
* Do a numeric update if D[k] < 0, numeric downdate otherwise.
*/
ok = TRUE ;
Common->modfl = 0 ;
PRINT1 (("rowadd update lnz = "ID"\n", lnz)) ;
if (lnz > 0)
{
do_update = IS_LT_ZERO (dk) ;
if (do_update)
{
dk = -dk ;
}
sqrt_dk = sqrt (dk) ;
p = Lp [k] + 1 ;
for (kk = 0 ; kk < lnz ; kk++, p++)
{
Cx [kk] = Lx [p] * sqrt_dk ;
}
fl += lnz + 1 ;
/* create a n-by-1 sparse matrix to hold the single column */
C = &Cmatrix ;
C->nrow = n ;
C->ncol = 1 ;
C->nzmax = lnz ;
C->sorted = TRUE ;
C->packed = TRUE ;
C->p = Cp ;
C->i = Ci ;
C->x = Cx ;
C->nz = NULL ;
C->itype = L->itype ;
C->xtype = L->xtype ;
C->dtype = L->dtype ;
C->z = NULL ;
C->stype = 0 ;
Cp [0] = 0 ;
Cp [1] = lnz ;
/* numeric downdate if dk > 0, and optional Lx=b change */
/* workspace: Flag (nrow), Head (nrow+1), W (nrow), Iwork (2*nrow) */
ok = CHOLMOD(updown_mark) (do_update ? (1) : (0), C, colmark,
L, X, DeltaB, Common) ;
/* clear workspace */
for (kk = 0 ; kk < lnz ; kk++)
{
Cx [kk] = 0 ;
}
}
Common->modfl += fl ;
DEBUG (CHOLMOD(dump_factor) (L, "LDL factorization, L:", Common)) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ;
return (ok) ;
}
cholmod_sparse *CHOLMOD(copy)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to copy */
int stype, /* requested stype of C */
int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) */
/* --------------- */
cholmod_common *Common
)
{
cholmod_sparse *C ;
Int nrow, ncol, up, lo, values, diag, astype ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
nrow = A->nrow ;
ncol = A->ncol ;
if ((stype || A->stype) && nrow != ncol)
{
/* inputs invalid */
ERROR (CHOLMOD_INVALID, "matrix invalid") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(allocate_work) (0, MAX (nrow,ncol), 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
diag = (mode >= 0) ;
astype = SIGN (A->stype) ;
stype = SIGN (stype) ;
up = (astype > 0) ;
lo = (astype < 0) ;
/* ---------------------------------------------------------------------- */
/* copy the matrix */
/* ---------------------------------------------------------------------- */
if (astype == stype)
{
/* ------------------------------------------------------------------ */
/* symmetry of A and C are the same */
/* ------------------------------------------------------------------ */
/* copy A into C, keeping the same symmetry. If A is symmetric
* entries in the ignored part of A are not copied into C */
C = CHOLMOD(band) (A, -nrow, ncol, mode, Common) ;
}
else if (!astype)
{
/* ------------------------------------------------------------------ */
/* convert unsymmetric matrix A into a symmetric matrix C */
/* ------------------------------------------------------------------ */
if (stype > 0)
{
/* C = triu (A) */
C = CHOLMOD(band) (A, 0, ncol, mode, Common) ;
}
else
{
/* C = tril (A) */
C = CHOLMOD(band) (A, -nrow, 0, mode, Common) ;
}
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
C->stype = stype ;
}
else if (astype == -stype)
{
/* ------------------------------------------------------------------ */
/* transpose a symmetric matrix */
/* ------------------------------------------------------------------ */
/* converting upper to lower or lower to upper */
/* workspace: Iwork (nrow) */
C = CHOLMOD(transpose) (A, values, Common) ;
if (!diag)
{
/* remove diagonal, if requested */
CHOLMOD(band_inplace) (-nrow, ncol, -1, C, Common) ;
}
}
else
{
/* ------------------------------------------------------------------ */
/* create an unsymmetric copy of a symmetric matrix */
/* ------------------------------------------------------------------ */
C = copy_sym_to_unsym (A, mode, Common) ;
}
/* ---------------------------------------------------------------------- */
/* return if error */
/* ---------------------------------------------------------------------- */
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* return the result */
/* ---------------------------------------------------------------------- */
DEBUG (diag = CHOLMOD(dump_sparse) (C, "copy", Common)) ;
PRINT1 (("mode %d nnzdiag "ID"\n", mode, diag)) ;
ASSERT (IMPLIES (mode < 0, diag == 0)) ;
return (C) ;
}
int CHOLMOD(amd)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to order */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
/* ---- output --- */
Int *Perm, /* size A->nrow, output permutation */
/* --------------- */
cholmod_common *Common
)
{
double Info [TRILINOS_AMD_INFO], Control2 [TRILINOS_AMD_CONTROL], *Control ;
Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Iwork, *Next ;
cholmod_sparse *C ;
Int j, n, cnz ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
n = A->nrow ;
RETURN_IF_NULL (Perm, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
if (n == 0)
{
/* nothing to do */
Common->fl = 0 ;
Common->lnz = 0 ;
Common->anz = 0 ;
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
/* Note: this is less than the space used in cholmod_analyze, so if
* cholmod_amd is being called by that routine, no space will be
* allocated.
*/
/* s = MAX (6*n, A->ncol) */
s = CHOLMOD(mult_size_t) (n, 6, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
s = MAX (s, A->ncol) ;
CHOLMOD(allocate_work) (n, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
Iwork = Common->Iwork ;
Degree = Iwork ; /* size n */
Wi = Iwork + n ; /* size n */
Len = Iwork + 2*((size_t) n) ; /* size n */
Nv = Iwork + 3*((size_t) n) ; /* size n */
Next = Iwork + 4*((size_t) n) ; /* size n */
Elen = Iwork + 5*((size_t) n) ; /* size n */
Head = Common->Head ; /* size n+1, but only n is used */
/* ---------------------------------------------------------------------- */
/* construct the input matrix for AMD */
/* ---------------------------------------------------------------------- */
if (A->stype == 0)
{
/* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */
C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ;
}
else
{
/* C = A+A', but use only the upper triangular part of A if A->stype = 1
* and only the lower part of A if A->stype = -1. Add extra space of
* nnz(C)/2+n to C. */
C = CHOLMOD(copy) (A, 0, -2, Common) ;
}
if (Common->status < CHOLMOD_OK)
{
/* out of memory, fset invalid, or other error */
return (FALSE) ;
}
Cp = C->p ;
for (j = 0 ; j < n ; j++)
{
Len [j] = Cp [j+1] - Cp [j] ;
}
/* C does not include the diagonal, and both upper and lower parts.
* Common->anz includes the diagonal, and just the lower part of C */
cnz = Cp [n] ;
Common->anz = cnz / 2 + n ;
/* ---------------------------------------------------------------------- */
/* order C using AMD */
/* ---------------------------------------------------------------------- */
/* get parameters */
if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS)
{
/* use AMD defaults */
Control = NULL ;
}
else
{
Control = Control2 ;
Control [TRILINOS_AMD_DENSE] = Common->method [Common->current].prune_dense ;
Control [TRILINOS_AMD_AGGRESSIVE] = Common->method [Common->current].aggressive ;
}
/* TRILINOS_AMD_2 does not use amd_malloc and amd_free, but set these pointers just
* be safe. */
trilinos_amd_malloc = Common->malloc_memory ;
trilinos_amd_free = Common->free_memory ;
trilinos_amd_calloc = Common->calloc_memory ;
trilinos_amd_realloc = Common->realloc_memory ;
/* TRILINOS_AMD_2 doesn't print anything either, but future versions might,
* so set the amd_printf pointer too. */
trilinos_amd_printf = Common->print_function ;
#ifdef LONG
trilinos_amd_l2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
Degree, Wi, Control, Info) ;
#else
trilinos_amd_2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
Degree, Wi, Control, Info) ;
#endif
/* LL' flop count. Need to subtract n for LL' flop count. Note that this
* is a slight upper bound which is often exact (see AMD/Source/amd_2.c for
* details). cholmod_analyze computes an exact flop count and fill-in. */
Common->fl = Info [TRILINOS_AMD_NDIV] + 2 * Info [TRILINOS_AMD_NMULTSUBS_LDL] + n ;
/* Info [TRILINOS_AMD_LNZ] excludes the diagonal */
Common->lnz = n + Info [TRILINOS_AMD_LNZ] ;
/* ---------------------------------------------------------------------- */
/* free the AMD workspace and clear the persistent workspace in Common */
/* ---------------------------------------------------------------------- */
ASSERT (IMPLIES (Common->status == CHOLMOD_OK,
CHOLMOD(dump_perm) (Perm, n, n, "AMD2 perm", Common))) ;
CHOLMOD(free_sparse) (&C, Common) ;
for (j = 0 ; j <= n ; j++)
{
Head [j] = EMPTY ;
}
return (TRUE) ;
}
int CHOLMOD(csymamd)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to order */
/* ---- output --- */
Int *Cmember, /* size nrow. see cholmod_ccolamd.c for description */
Int *Perm, /* size A->nrow, output permutation */
/* --------------- */
cholmod_common *Common
)
{
double knobs [CCOLAMD_KNOBS] ;
Int *perm, *Head ;
Int ok, i, nrow, stats [CCOLAMD_STATS] ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (Perm, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
if (A->nrow != A->ncol || !(A->packed))
{
ERROR (CHOLMOD_INVALID, "matrix must be square and packed") ;
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
nrow = A->nrow ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(allocate_work) (nrow, 0, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* order the matrix (does not affect A->p or A->i) */
/* ---------------------------------------------------------------------- */
perm = Common->Head ; /* size nrow+1 (i/l/l) */
/* get parameters */
#ifdef LONG
amesos_ccolamd_l_set_defaults (knobs) ;
#else
amesos_ccolamd_set_defaults (knobs) ;
#endif
if (Common->current >= 0 && Common->current < CHOLMOD_MAXMETHODS)
{
/* get the knobs from the Common parameters */
knobs [CCOLAMD_DENSE_ROW] =Common->method[Common->current].prune_dense ;
knobs [CCOLAMD_AGGRESSIVE]=Common->method[Common->current].aggressive ;
}
{
#ifdef LONG
amesos_csymamd_l (nrow, A->i, A->p, perm, knobs, stats, Common->calloc_memory,
Common->free_memory, Cmember, A->stype) ;
#else
amesos_csymamd (nrow, A->i, A->p, perm, knobs, stats, Common->calloc_memory,
Common->free_memory, Cmember, A->stype) ;
#endif
ok = stats [CCOLAMD_STATUS] ;
}
if (ok == CCOLAMD_ERROR_out_of_memory)
{
ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ;
}
ok = (ok == CCOLAMD_OK || ok == CCOLAMD_OK_BUT_JUMBLED) ;
/* ---------------------------------------------------------------------- */
/* free the workspace and return result */
/* ---------------------------------------------------------------------- */
/* permutation returned in perm [0..n-1] */
for (i = 0 ; i < nrow ; i++)
{
Perm [i] = perm [i] ;
}
/* clear Head workspace (used for perm, in csymamd): */
Head = Common->Head ;
for (i = 0 ; i <= nrow ; i++)
{
Head [i] = EMPTY ;
}
return (ok) ;
}
int CHOLMOD(defaults)
(
cholmod_common *Common
)
{
Int i ;
RETURN_IF_NULL_COMMON (FALSE) ;
/* ---------------------------------------------------------------------- */
/* default control parameters */
/* ---------------------------------------------------------------------- */
Common->dbound = 0.0 ;
Common->grow0 = 1.2 ;
Common->grow1 = 1.2 ;
Common->grow2 = 5 ;
Common->maxrank = 8 ;
Common->final_asis = TRUE ;
Common->final_super = TRUE ;
Common->final_ll = FALSE ;
Common->final_pack = TRUE ;
Common->final_monotonic = TRUE ;
Common->final_resymbol = FALSE ;
/* use simplicial factorization if flop/nnz(L) < 40, supernodal otherwise */
Common->supernodal = CHOLMOD_AUTO ;
Common->supernodal_switch = 40 ;
Common->nrelax [0] = 4 ;
Common->nrelax [1] = 16 ;
Common->nrelax [2] = 48 ;
Common->zrelax [0] = 0.8 ;
Common->zrelax [1] = 0.1 ;
Common->zrelax [2] = 0.05 ;
Common->prefer_zomplex = FALSE ;
Common->prefer_upper = TRUE ;
Common->prefer_binary = FALSE ;
Common->quick_return_if_not_posdef = FALSE ;
/* METIS workarounds */
Common->metis_memory = 0.0 ; /* > 0 for memory guard (2 is reasonable) */
Common->metis_nswitch = 3000 ;
Common->metis_dswitch = 0.66 ;
Common->print = 3 ;
Common->precise = FALSE ;
/* ---------------------------------------------------------------------- */
/* default ordering methods */
/* ---------------------------------------------------------------------- */
/* Note that if the Partition module is not installed, the CHOLMOD_METIS
* and CHOLMOD_NESDIS methods will not be available. cholmod_analyze will
* report the CHOLMOD_NOT_INSTALLED error, and safely skip over them.
*/
#if (CHOLMOD_MAXMETHODS < 9)
#error "CHOLMOD_MAXMETHODS must be 9 or more (defined in cholmod_core.h)."
#endif
/* default strategy: try given, AMD, and then METIS if AMD reports high
* fill-in. NESDIS can be used instead, if Common->default_nesdis is TRUE.
*/
Common->nmethods = 0 ; /* use default strategy */
Common->default_nesdis = FALSE ; /* use METIS in default strategy */
Common->current = 0 ; /* current method being tried */
Common->selected = 0 ; /* the best method selected */
/* first, fill each method with default parameters */
for (i = 0 ; i <= CHOLMOD_MAXMETHODS ; i++)
{
/* CHOLMOD's default method is AMD for A or AA' */
Common->method [i].ordering = CHOLMOD_AMD ;
/* CHOLMOD nested dissection and minimum degree parameter */
Common->method [i].prune_dense = 10.0 ; /* dense row/col control */
/* min degree parameters (AMD, COLAMD, SYMAMD, CAMD, CCOLAMD, CSYMAMD)*/
Common->method [i].prune_dense2 = -1 ; /* COLAMD dense row control */
Common->method [i].aggressive = TRUE ; /* aggressive absorption */
Common->method [i].order_for_lu = FALSE ;/* order for Cholesky not LU */
/* CHOLMOD's nested dissection (METIS + constrained AMD) */
Common->method [i].nd_small = 200 ; /* small graphs aren't cut */
Common->method [i].nd_compress = TRUE ; /* compress graph & subgraphs */
Common->method [i].nd_camd = 1 ; /* use CAMD */
Common->method [i].nd_components = FALSE ; /* lump connected comp. */
Common->method [i].nd_oksep = 1.0 ; /* sep ok if < oksep*n */
/* statistics for each method are not yet computed */
Common->method [i].fl = EMPTY ;
Common->method [i].lnz = EMPTY ;
}
Common->postorder = TRUE ; /* follow ordering with weighted postorder */
/* Next, define some methods. The first five use default parameters. */
Common->method [0].ordering = CHOLMOD_GIVEN ; /* skip if UserPerm NULL */
Common->method [1].ordering = CHOLMOD_AMD ;
Common->method [2].ordering = CHOLMOD_METIS ;
Common->method [3].ordering = CHOLMOD_NESDIS ;
Common->method [4].ordering = CHOLMOD_NATURAL ;
/* CHOLMOD's nested dissection with large leaves of separator tree */
Common->method [5].ordering = CHOLMOD_NESDIS ;
Common->method [5].nd_small = 20000 ;
/* CHOLMOD's nested dissection with tiny leaves, and no AMD ordering */
Common->method [6].ordering = CHOLMOD_NESDIS ;
Common->method [6].nd_small = 4 ;
Common->method [6].nd_camd = 0 ; /* no CSYMAMD or CAMD */
/* CHOLMOD's nested dissection with no dense node removal */
Common->method [7].ordering = CHOLMOD_NESDIS ;
Common->method [7].prune_dense = -1. ;
/* COLAMD for A*A', AMD for A */
Common->method [8].ordering = CHOLMOD_COLAMD ;
return (TRUE) ;
}
int CHOLMOD(super_numeric)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to factorize */
cholmod_sparse *F, /* F = A' or A(:,f)' */
double beta [2], /* beta*I is added to diagonal of matrix to factorize */
/* ---- in/out --- */
cholmod_factor *L, /* factorization */
/* --------------- */
cholmod_common *Common
)
{
cholmod_dense *C ;
Int *Super, *Map, *SuperMap ;
size_t maxcsize ;
Int nsuper, n, i, k, s, stype, nrow ;
int ok = TRUE, symbolic ;
size_t t, w ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_COMPLEX, FALSE) ;
stype = A->stype ;
if (stype < 0)
{
if (A->nrow != A->ncol || A->nrow != L->n)
{
ERROR (CHOLMOD_INVALID, "invalid dimensions") ;
return (FALSE) ;
}
}
else if (stype == 0)
{
if (A->nrow != L->n)
{
ERROR (CHOLMOD_INVALID, "invalid dimensions") ;
return (FALSE) ;
}
RETURN_IF_NULL (F, FALSE) ;
RETURN_IF_XTYPE_INVALID (F, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
if (A->nrow != F->ncol || A->ncol != F->nrow || F->stype != 0)
{
ERROR (CHOLMOD_INVALID, "F invalid") ;
return (FALSE) ;
}
if (A->xtype != F->xtype)
{
ERROR (CHOLMOD_INVALID, "A and F must have same xtype") ;
return (FALSE) ;
}
}
else
{
/* symmetric upper case not suppored */
ERROR (CHOLMOD_INVALID, "symmetric upper case not supported") ;
return (FALSE) ;
}
if (!(L->is_super))
{
ERROR (CHOLMOD_INVALID, "L not supernodal") ;
return (FALSE) ;
}
if (L->xtype != CHOLMOD_PATTERN)
{
if (! ((A->xtype == CHOLMOD_REAL && L->xtype == CHOLMOD_REAL)
|| (A->xtype == CHOLMOD_COMPLEX && L->xtype == CHOLMOD_COMPLEX)
|| (A->xtype == CHOLMOD_ZOMPLEX && L->xtype == CHOLMOD_COMPLEX)))
{
ERROR (CHOLMOD_INVALID, "complex type mismatch") ;
return (FALSE) ;
}
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace in Common */
/* ---------------------------------------------------------------------- */
nsuper = L->nsuper ;
maxcsize = L->maxcsize ;
nrow = A->nrow ;
n = nrow ;
PRINT1 (("nsuper "ID" maxcsize %g\n", nsuper, (double) maxcsize)) ;
ASSERT (nsuper >= 0 && maxcsize > 0) ;
/* w = 2*n + 5*nsuper */
w = CHOLMOD(mult_size_t) (n, 2, &ok) ;
t = CHOLMOD(mult_size_t) (nsuper, 5, &ok) ;
w = CHOLMOD(add_size_t) (w, t, &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (n, w, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get the current factor L and allocate numerical part, if needed */
/* ---------------------------------------------------------------------- */
Super = L->super ;
symbolic = (L->xtype == CHOLMOD_PATTERN) ;
if (symbolic)
{
/* convert to supernodal numeric by allocating L->x */
CHOLMOD(change_factor) (
(A->xtype == CHOLMOD_REAL) ? CHOLMOD_REAL : CHOLMOD_COMPLEX,
TRUE, TRUE, TRUE, TRUE, L, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* the factor L remains in symbolic supernodal form */
return (FALSE) ;
}
}
ASSERT (L->dtype == DTYPE) ;
ASSERT (L->xtype == CHOLMOD_REAL || L->xtype == CHOLMOD_COMPLEX) ;
/* supernodal LDL' is not supported */
L->is_ll = TRUE ;
/* ---------------------------------------------------------------------- */
/* get more workspace */
/* ---------------------------------------------------------------------- */
C = CHOLMOD(allocate_dense) (maxcsize, 1, maxcsize, L->xtype, Common) ;
if (Common->status < CHOLMOD_OK)
{
int status = Common->status ;
if (symbolic)
{
/* Change L back to symbolic, since the numeric values are not
* initialized. This cannot fail. */
CHOLMOD(change_factor) (CHOLMOD_PATTERN, TRUE, TRUE, TRUE, TRUE,
L, Common) ;
}
/* the factor L is now back to the form it had on input */
Common->status = status ;
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
SuperMap = Common->Iwork ; /* size n (i/i/l) */
Map = Common->Flag ; /* size n, use Flag as workspace for Map array */
for (i = 0 ; i < n ; i++)
{
Map [i] = EMPTY ;
}
/* ---------------------------------------------------------------------- */
/* find the mapping of nodes to relaxed supernodes */
/* ---------------------------------------------------------------------- */
/* SuperMap [k] = s if column k is contained in supernode s */
for (s = 0 ; s < nsuper ; s++)
{
PRINT1 (("Super ["ID"] "ID" ncols "ID"\n",
s, Super[s], Super[s+1]-Super[s]));
for (k = Super [s] ; k < Super [s+1] ; k++)
{
SuperMap [k] = s ;
PRINT2 (("relaxed SuperMap ["ID"] = "ID"\n", k, SuperMap [k])) ;
}
}
/* ---------------------------------------------------------------------- */
/* supernodal numerical factorization, using template routine */
/* ---------------------------------------------------------------------- */
switch (A->xtype)
{
case CHOLMOD_REAL:
ok = r_cholmod_super_numeric (A, F, beta, L, C, Common) ;
break ;
case CHOLMOD_COMPLEX:
ok = c_cholmod_super_numeric (A, F, beta, L, C, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
/* This operates on complex L, not zomplex */
ok = z_cholmod_super_numeric (A, F, beta, L, C, Common) ;
break ;
}
/* ---------------------------------------------------------------------- */
/* clear Common workspace, free temp workspace C, and return */
/* ---------------------------------------------------------------------- */
/* Flag array was used as workspace, clear it */
Common->mark = EMPTY ;
/* CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
CHOLMOD(free_dense) (&C, Common) ;
return (ok) ;
}
int CHOLMOD(allocate_work)
(
/* ---- input ---- */
size_t nrow, /* # of rows in the matrix A */
size_t iworksize, /* size of Iwork */
size_t xworksize, /* size of Xwork */
/* --------------- */
cholmod_common *Common
)
{
double *W ;
Int *Head ;
Int i ;
size_t nrow1 ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* Allocate Flag (nrow) and Head (nrow+1) */
/* ---------------------------------------------------------------------- */
nrow = MAX (1, nrow) ;
/* nrow1 = nrow + 1 */
nrow1 = CHOLMOD(add_size_t) (nrow, 1, &ok) ;
if (!ok)
{
/* nrow+1 causes size_t overflow ; problem is too large */
Common->status = CHOLMOD_TOO_LARGE ;
CHOLMOD(free_work) (Common) ;
return (FALSE) ;
}
if (nrow > Common->nrow)
{
if (Common->no_workspace_reallocate)
{
/* CHOLMOD is not allowed to change the workspace here */
Common->status = CHOLMOD_INVALID ;
return (FALSE) ;
}
/* free the old workspace (if any) and allocate new space */
Common->Flag = CHOLMOD(free) (Common->nrow, sizeof (Int), Common->Flag,
Common) ;
Common->Head = CHOLMOD(free) (Common->nrow+1,sizeof (Int), Common->Head,
Common) ;
Common->Flag = CHOLMOD(malloc) (nrow, sizeof (Int), Common) ;
Common->Head = CHOLMOD(malloc) (nrow1, sizeof (Int), Common) ;
/* record the new size of Flag and Head */
Common->nrow = nrow ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_work) (Common) ;
return (FALSE) ;
}
/* initialize Flag and Head */
Common->mark = EMPTY ;
CHOLMOD(clear_flag) (Common) ;
Head = Common->Head ;
for (i = 0 ; i <= (Int) (nrow) ; i++)
{
Head [i] = EMPTY ;
}
}
/* ---------------------------------------------------------------------- */
/* Allocate Iwork (iworksize) */
/* ---------------------------------------------------------------------- */
iworksize = MAX (1, iworksize) ;
if (iworksize > Common->iworksize)
{
if (Common->no_workspace_reallocate)
{
/* CHOLMOD is not allowed to change the workspace here */
Common->status = CHOLMOD_INVALID ;
return (FALSE) ;
}
/* free the old workspace (if any) and allocate new space.
* integer overflow safely detected in cholmod_malloc */
CHOLMOD(free) (Common->iworksize, sizeof (Int), Common->Iwork, Common) ;
Common->Iwork = CHOLMOD(malloc) (iworksize, sizeof (Int), Common) ;
/* record the new size of Iwork */
Common->iworksize = iworksize ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_work) (Common) ;
return (FALSE) ;
}
/* note that Iwork does not need to be initialized */
}
/* ---------------------------------------------------------------------- */
/* Allocate Xwork (xworksize) and set it to ((double) 0.) */
/* ---------------------------------------------------------------------- */
/* make sure xworksize is >= 1 */
xworksize = MAX (1, xworksize) ;
if (xworksize > Common->xworksize)
{
if (Common->no_workspace_reallocate)
{
/* CHOLMOD is not allowed to change the workspace here */
Common->status = CHOLMOD_INVALID ;
return (FALSE) ;
}
/* free the old workspace (if any) and allocate new space */
CHOLMOD(free) (Common->xworksize, sizeof (double), Common->Xwork,
Common) ;
Common->Xwork = CHOLMOD(malloc) (xworksize, sizeof (double), Common) ;
/* record the new size of Xwork */
Common->xworksize = xworksize ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_work) (Common) ;
return (FALSE) ;
}
/* initialize Xwork */
W = Common->Xwork ;
for (i = 0 ; i < (Int) xworksize ; i++)
{
W [i] = 0. ;
}
}
return (TRUE) ;
}
int CHOLMOD(resymbol_noperm)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to analyze */
Int *fset, /* subset of 0:(A->ncol)-1 */
size_t fsize, /* size of fset */
int pack, /* if TRUE, pack the columns of L */
/* ---- in/out --- */
cholmod_factor *L, /* factorization, entries pruned on output */
/* --------------- */
cholmod_common *Common
)
{
double *Lx, *Lz ;
Int i, j, k, row, parent, p, pend, pdest, ncol, apacked, sorted, nrow, nf,
use_fset, mark, jj, stype, xtype ;
Int *Ap, *Ai, *Anz, *Li, *Lp, *Lnz, *Flag, *Head, *Link, *Anext, *Iwork ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
ncol = A->ncol ;
nrow = A->nrow ;
stype = A->stype ;
ASSERT (IMPLIES (stype != 0, nrow == ncol)) ;
if (stype > 0)
{
/* symmetric, with upper triangular part, not supported */
ERROR (CHOLMOD_INVALID, "symmetric upper not supported ") ;
return (FALSE) ;
}
if (L->is_super)
{
/* cannot operate on a supernodal or symbolic factorization */
ERROR (CHOLMOD_INVALID, "cannot operate on supernodal L") ;
return (FALSE) ;
}
if (L->n != A->nrow)
{
/* dimensions must agree */
ERROR (CHOLMOD_INVALID, "A and L dimensions do not match") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(allocate_work) (nrow, 2*nrow + (stype ? 0 : ncol), 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ; /* out of memory */
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ai = A->i ;
Ap = A->p ;
Anz = A->nz ;
apacked = A->packed ;
sorted = A->sorted ;
Li = L->i ;
Lx = L->x ;
Lz = L->z ;
Lp = L->p ;
Lnz = L->nz ;
xtype = L->xtype ;
/* If L is monotonic on input, then it can be packed or
* unpacked on output, depending on the pack input parameter. */
/* cannot pack a non-monotonic matrix */
if (!(L->is_monotonic))
{
pack = FALSE ;
}
ASSERT (L->nzmax >= (size_t) (Lp [L->n])) ;
pdest = 0 ;
PRINT1 (("\n\n===================== Resymbol pack %d Apacked %d\n",
pack, A->packed)) ;
ASSERT (CHOLMOD(dump_sparse) (A, "ReSymbol A:", Common) >= 0) ;
DEBUG (CHOLMOD(dump_factor) (L, "ReSymbol initial L (i, x):", Common)) ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Flag = Common->Flag ; /* size nrow */
Head = Common->Head ; /* size nrow+1 */
Iwork = Common->Iwork ;
Link = Iwork ; /* size nrow (i/i/l) [ */
Lnz = Iwork + nrow ; /* size nrow (i/i/l), if L not packed */
Anext = Iwork + 2*nrow ; /* size ncol (i/i/l), unsym. only */
for (j = 0 ; j < nrow ; j++)
{
Link [j] = EMPTY ;
}
/* use Lnz in L itself */
Lnz = L->nz ;
ASSERT (Lnz != NULL) ;
/* ---------------------------------------------------------------------- */
/* for the unsymmetric case, queue each column of A (:,f) */
/* ---------------------------------------------------------------------- */
/* place each column of the basis set on the link list corresponding to */
/* the smallest row index in that column */
if (stype == 0)
{
use_fset = (fset != NULL) ;
if (use_fset)
{
nf = fsize ;
/* This is the only O(ncol) loop in cholmod_resymbol.
* It is required only to check the fset. */
for (j = 0 ; j < ncol ; j++)
{
Anext [j] = -2 ;
}
for (jj = 0 ; jj < nf ; jj++)
{
j = fset [jj] ;
if (j < 0 || j > ncol || Anext [j] != -2)
{
/* out-of-range or duplicate entry in fset */
ERROR (CHOLMOD_INVALID, "fset invalid") ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (FALSE) ;
}
/* flag column j as having been seen */
Anext [j] = EMPTY ;
}
/* the fset is now valid */
ASSERT (CHOLMOD(dump_perm) (fset, nf, ncol, "fset", Common)) ;
}
else
{
nf = ncol ;
}
for (jj = 0 ; jj < nf ; jj++)
{
j = (use_fset) ? (fset [jj]) : jj ;
/* column j is the fset; find the smallest row (if any) */
p = Ap [j] ;
pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ;
if (pend > p)
{
k = Ai [p] ;
if (!sorted)
{
for ( ; p < pend ; p++)
{
k = MIN (k, Ai [p]) ;
}
}
/* place column j on link list k */
ASSERT (k >= 0 && k < nrow) ;
Anext [j] = Head [k] ;
Head [k] = j ;
}
}
}
/* ---------------------------------------------------------------------- */
/* recompute symbolic LDL' factorization */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < nrow ; k++)
{
#ifndef NDEBUG
PRINT1 (("\n\n================== Initial column k = "ID"\n", k)) ;
for (p = Lp [k] ; p < Lp [k] + Lnz [k] ; p++)
{
PRINT1 ((" row: "ID" value: ", Li [p])) ;
PRINT1 (("\n")) ;
}
PRINT1 (("Recomputing LDL, column k = "ID"\n", k)) ;
#endif
/* ------------------------------------------------------------------ */
/* compute column k of I+F*F' or I+A */
/* ------------------------------------------------------------------ */
/* flag the diagonal entry */
mark = CHOLMOD(clear_flag) (Common) ;
Flag [k] = mark ;
PRINT1 ((" row: "ID" (diagonal)\n", k)) ;
if (stype != 0)
{
/* merge column k of A into Flag (lower triangular part only) */
p = Ap [k] ;
pend = (apacked) ? (Ap [k+1]) : (p + Anz [k]) ;
for ( ; p < pend ; p++)
{
i = Ai [p] ;
if (i > k)
{
Flag [i] = mark ;
}
}
}
else
{
/* for each column j whos first row index is in row k */
for (j = Head [k] ; j != EMPTY ; j = Anext [j])
{
/* merge column j of A into Flag */
PRINT1 ((" ---- A column "ID"\n", j)) ;
p = Ap [j] ;
pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ;
PRINT1 ((" length "ID" adding\n", pend-p)) ;
for ( ; p < pend ; p++)
{
#ifndef NDEBUG
ASSERT (Ai [p] >= k && Ai [p] < nrow) ;
if (Flag [Ai [p]] < mark) PRINT1 ((" row "ID"\n", Ai [p])) ;
#endif
Flag [Ai [p]] = mark ;
}
}
/* clear the kth link list */
Head [k] = EMPTY ;
}
/* ------------------------------------------------------------------ */
/* compute pruned pattern of kth column of L = union of children */
/* ------------------------------------------------------------------ */
/* for each column j of L whose parent is k */
for (j = Link [k] ; j != EMPTY ; j = Link [j])
{
/* merge column j of L into Flag */
PRINT1 ((" ---- L column "ID"\n", k)) ;
ASSERT (j < k) ;
ASSERT (Lnz [j] > 0) ;
p = Lp [j] ;
pend = p + Lnz [j] ;
ASSERT (Li [p] == j && Li [p+1] == k) ;
p++ ; /* skip past the diagonal entry */
for ( ; p < pend ; p++)
{
/* add to pattern */
ASSERT (Li [p] >= k && Li [p] < nrow) ;
Flag [Li [p]] = mark ;
}
}
/* ------------------------------------------------------------------ */
/* prune the kth column of L */
/* ------------------------------------------------------------------ */
PRINT1 (("Final column of L:\n")) ;
p = Lp [k] ;
pend = p + Lnz [k] ;
if (pack)
{
/* shift column k upwards */
Lp [k] = pdest ;
}
else
{
/* leave column k in place, just reduce Lnz [k] */
pdest = p ;
}
for ( ; p < pend ; p++)
{
ASSERT (pdest < pend) ;
ASSERT (pdest <= p) ;
row = Li [p] ;
ASSERT (row >= k && row < nrow) ;
if (Flag [row] == mark)
{
/* keep this entry */
Li [pdest] = row ;
if (xtype == CHOLMOD_REAL)
{
Lx [pdest] = Lx [p] ;
}
else if (xtype == CHOLMOD_COMPLEX)
{
Lx [2*pdest ] = Lx [2*p ] ;
Lx [2*pdest+1] = Lx [2*p+1] ;
}
else if (xtype == CHOLMOD_ZOMPLEX)
{
Lx [pdest] = Lx [p] ;
Lz [pdest] = Lz [p] ;
}
pdest++ ;
}
}
/* ------------------------------------------------------------------ */
/* prepare this column for its parent */
/* ------------------------------------------------------------------ */
Lnz [k] = pdest - Lp [k] ;
PRINT1 ((" L("ID") length "ID"\n", k, Lnz [k])) ;
ASSERT (Lnz [k] > 0) ;
/* parent is the first entry in the column after the diagonal */
parent = (Lnz [k] > 1) ? (Li [Lp [k] + 1]) : EMPTY ;
PRINT1 (("parent ("ID") = "ID"\n", k, parent)) ;
ASSERT ((parent > k && parent < nrow) || (parent == EMPTY)) ;
if (parent != EMPTY)
{
Link [k] = Link [parent] ;
Link [parent] = k ;
}
}
/* done using Iwork for Link, Lnz (if needed), and Anext ] */
/* ---------------------------------------------------------------------- */
/* convert L to packed, if requested */
/* ---------------------------------------------------------------------- */
if (pack)
{
/* finalize Lp */
Lp [nrow] = pdest ;
/* Shrink L to be just large enough. It cannot fail. */
/* workspace: none */
ASSERT ((size_t) (Lp [nrow]) <= L->nzmax) ;
CHOLMOD(reallocate_factor) (Lp [nrow], L, Common) ;
ASSERT (Common->status >= CHOLMOD_OK) ;
}
/* ---------------------------------------------------------------------- */
/* clear workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(clear_flag) (Common) ;
DEBUG (CHOLMOD(dump_factor) (L, "ReSymbol final L (i, x):", Common)) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (TRUE) ;
}
cholmod_sparse *CHOLMOD(ssmult)
(
/* ---- input ---- */
cholmod_sparse *A, /* left matrix to multiply */
cholmod_sparse *B, /* right matrix to multiply */
int stype, /* requested stype of C */
int values, /* TRUE: do numerical values, FALSE: pattern only */
int sorted, /* if TRUE then return C with sorted columns */
/* --------------- */
cholmod_common *Common
)
{
double bjt ;
double *Ax, *Bx, *Cx, *W ;
Int *Ap, *Anz, *Ai, *Bp, *Bnz, *Bi, *Cp, *Ci, *Flag ;
cholmod_sparse *C, *A2, *B2, *A3, *B3, *C2 ;
Int apacked, bpacked, j, i, pa, paend, pb, pbend, ncol, mark, cnz, t, p,
nrow, anz, bnz, do_swap_and_transpose, n1, n2 ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
RETURN_IF_NULL (B, NULL) ;
values = values &&
(A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
if (A->ncol != B->nrow)
{
/* inner dimensions must agree */
ERROR (CHOLMOD_INVALID, "A and B inner dimensions must match") ;
return (NULL) ;
}
/* A and B must have the same numerical type if values is TRUE (both must
* be CHOLMOD_REAL, this is implicitly checked above) */
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
if (A->nrow <= 1)
{
/* C will be implicitly sorted, so no need to sort it here */
sorted = FALSE ;
}
if (sorted)
{
n1 = MAX (A->nrow, B->ncol) ;
}
else
{
n1 = A->nrow ;
}
n2 = MAX4 (A->ncol, A->nrow, B->nrow, B->ncol) ;
CHOLMOD(allocate_work) (n1, n2, values ? n1 : 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1 : 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
/* convert A to unsymmetric, if necessary */
A2 = NULL ;
B2 = NULL ;
if (A->stype)
{
/* workspace: Iwork (max (A->nrow,A->ncol)) */
A2 = CHOLMOD(copy) (A, 0, values, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
return (NULL) ;
}
A = A2 ;
}
/* convert B to unsymmetric, if necessary */
if (B->stype)
{
/* workspace: Iwork (max (B->nrow,B->ncol)) */
B2 = CHOLMOD(copy) (B, 0, values, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
CHOLMOD(free_sparse) (&A2, Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
return (NULL) ;
}
B = B2 ;
}
ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;
ASSERT (CHOLMOD(dump_sparse) (B, "B", Common) >= 0) ;
/* get the A matrix */
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
apacked = A->packed ;
/* get the B matrix */
Bp = B->p ;
Bnz = B->nz ;
Bi = B->i ;
Bx = B->x ;
bpacked = B->packed ;
/* get the size of C */
nrow = A->nrow ;
ncol = B->ncol ;
/* get workspace */
W = Common->Xwork ; /* size nrow, unused if values is FALSE */
Flag = Common->Flag ; /* size nrow, Flag [0..nrow-1] < mark on input*/
/* ---------------------------------------------------------------------- */
/* count the number of entries in the result C */
/* ---------------------------------------------------------------------- */
cnz = 0 ;
for (j = 0 ; j < ncol ; j++)
{
/* clear the Flag array */
/* mark = CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
/* for each nonzero B(t,j) in column j, do: */
pb = Bp [j] ;
pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
for ( ; pb < pbend ; pb++)
{
/* B(t,j) is nonzero */
t = Bi [pb] ;
/* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
pa = Ap [t] ;
paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ;
for ( ; pa < paend ; pa++)
{
i = Ai [pa] ;
if (Flag [i] != mark)
{
Flag [i] = mark ;
cnz++ ;
}
}
}
if (cnz < 0)
{
break ; /* integer overflow case */
}
}
/* mark = CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
/* ---------------------------------------------------------------------- */
/* check for integer overflow */
/* ---------------------------------------------------------------------- */
if (cnz < 0)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* Determine how to return C sorted (if requested) */
/* ---------------------------------------------------------------------- */
do_swap_and_transpose = FALSE ;
if (sorted)
{
/* Determine the best way to return C with sorted columns. Computing
* C = (B'*A')' takes cnz + anz + bnz time (ignoring O(n) terms).
* Sorting C when done, C = (A*B)'', takes 2*cnz time. Pick the one
* with the least amount of work. */
anz = CHOLMOD(nnz) (A, Common) ;
bnz = CHOLMOD(nnz) (B, Common) ;
do_swap_and_transpose = (anz + bnz < cnz) ;
if (do_swap_and_transpose)
{
/* -------------------------------------------------------------- */
/* C = (B'*A')' */
/* -------------------------------------------------------------- */
/* workspace: Iwork (A->nrow) */
A3 = CHOLMOD(ptranspose) (A, values, NULL, NULL, 0, Common) ;
CHOLMOD(free_sparse) (&A2, Common) ;
A2 = A3 ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
return (NULL) ;
}
/* workspace: Iwork (B->nrow) */
B3 = CHOLMOD(ptranspose) (B, values, NULL, NULL, 0, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
B2 = B3 ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
return (NULL) ;
}
A = B2 ;
B = A2 ;
/* get the new A matrix */
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
apacked = A->packed ;
/* get the new B matrix */
Bp = B->p ;
Bnz = B->nz ;
Bi = B->i ;
Bx = B->x ;
bpacked = B->packed ;
/* get the size of C' */
nrow = A->nrow ;
ncol = B->ncol ;
}
}
/* ---------------------------------------------------------------------- */
/* allocate C */
/* ---------------------------------------------------------------------- */
C = CHOLMOD(allocate_sparse) (nrow, ncol, cnz, FALSE, TRUE, 0,
values ? A->xtype : CHOLMOD_PATTERN, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
return (NULL) ;
}
Cp = C->p ;
Ci = C->i ;
Cx = C->x ;
/* ---------------------------------------------------------------------- */
/* C = A*B */
/* ---------------------------------------------------------------------- */
cnz = 0 ;
if (values)
{
/* pattern and values */
for (j = 0 ; j < ncol ; j++)
{
/* clear the Flag array */
/* mark = CHOLMOD(clear_flag (Common)) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
/* start column j of C */
Cp [j] = cnz ;
/* for each nonzero B(t,j) in column j, do: */
pb = Bp [j] ;
pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
for ( ; pb < pbend ; pb++)
{
/* B(t,j) is nonzero */
t = Bi [pb] ;
bjt = Bx [pb] ;
/* add the nonzero pattern of A(:,t) to the pattern of C(:,j)
* and scatter the values into W */
pa = Ap [t] ;
paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ;
for ( ; pa < paend ; pa++)
{
i = Ai [pa] ;
if (Flag [i] != mark)
{
Flag [i] = mark ;
Ci [cnz++] = i ;
}
W [i] += Ax [pa] * bjt ;
}
}
/* gather the values into C(:,j) */
for (p = Cp [j] ; p < cnz ; p++)
{
i = Ci [p] ;
Cx [p] = W [i] ;
W [i] = 0 ;
}
}
}
else
{
/* pattern only */
for (j = 0 ; j < ncol ; j++)
{
/* clear the Flag array */
/* mark = CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
/* start column j of C */
Cp [j] = cnz ;
/* for each nonzero B(t,j) in column j, do: */
pb = Bp [j] ;
pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
for ( ; pb < pbend ; pb++)
{
/* B(t,j) is nonzero */
t = Bi [pb] ;
/* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
pa = Ap [t] ;
paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ;
for ( ; pa < paend ; pa++)
{
i = Ai [pa] ;
if (Flag [i] != mark)
{
Flag [i] = mark ;
Ci [cnz++] = i ;
}
}
}
}
}
Cp [ncol] = cnz ;
ASSERT (MAX (1,cnz) == C->nzmax) ;
/* ---------------------------------------------------------------------- */
/* clear workspace and free temporary matrices */
/* ---------------------------------------------------------------------- */
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
/* CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
/* ---------------------------------------------------------------------- */
/* convert C to a symmetric upper/lower matrix if requested */
/* ---------------------------------------------------------------------- */
/* convert C in place, which cannot fail since no memory is allocated */
if (stype > 0)
{
/* C = triu (C), in place */
(void) CHOLMOD(band_inplace) (0, ncol, values, C, Common) ;
C->stype = 1 ;
}
else if (stype < 0)
{
/* C = tril (C), in place */
(void) CHOLMOD(band_inplace) (-nrow, 0, values, C, Common) ;
C->stype = -1 ;
}
ASSERT (Common->status >= CHOLMOD_OK) ;
/* ---------------------------------------------------------------------- */
/* sort C, if requested */
/* ---------------------------------------------------------------------- */
if (sorted)
{
if (do_swap_and_transpose)
{
/* workspace: Iwork (C->ncol), which is A->nrow since C=(B'*A') */
C2 = CHOLMOD(ptranspose) (C, values, NULL, NULL, 0, Common) ;
CHOLMOD(free_sparse) (&C, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
return (NULL) ;
}
C = C2 ;
}
else
{
/* workspace: Iwork (max (C->nrow,C->ncol)) */
if (!CHOLMOD(sort) (C, Common))
{
/* out of memory */
CHOLMOD(free_sparse) (&C, Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
return (NULL) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
DEBUG (CHOLMOD(dump_sparse) (C, "ssmult", Common) >= 0) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
return (C) ;
}
int CHOLMOD(updown_mark)
(
/* ---- input ---- */
int update, /* TRUE for update, FALSE for downdate */
cholmod_sparse *C, /* the incoming sparse update */
Int *colmark, /* Int array of size n. See cholmod_updown.c */
/* ---- in/out --- */
cholmod_factor *L, /* factor to modify */
cholmod_dense *X, /* solution to Lx=b (size n-by-1) */
cholmod_dense *DeltaB, /* change in b, zero on output */
Int *rowmark, /* Int array of size n. See cholmod_updown.c */
/* --------------- */
cholmod_common *Common
)
{
double xj, fl ;
double *Lx, *W, *Xx, *Nx ;
Int *Li, *Lp, *Lnz, *Cp, *Ci, *Cnz, *Head, *Flag, *Stack, *Lnext, *Iwork,
*Set_ps1 [32], *Set_ps2 [32], *ps1, *ps2 ;
size_t maxrank ;
Path_type OrderedPath [32], Path [32] ;
Int n, wdim, k1, k2, npaths, i, j, row, packed, ccol, p, cncol, do_solve,
mark, jj, j2, kk, nextj, p1, p2, c, use_rowmark, use_colmark, newlnz,
k, newpath, path_order, w_order, scattered, path, newparent, pp1, pp2,
smax, maxrow, row1, nsets, s, p3, newlnz1, Set [32], top, len, lnz, m,
botrow ;
DEBUG (Int oldparent) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (C, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (C, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
n = L->n ;
cncol = C->ncol ;
Common->modfl = 0 ;
if (!(C->sorted))
{
ERROR (CHOLMOD_INVALID, "C must have sorted columns") ;
return (FALSE) ;
}
if (n != (Int) (C->nrow))
{
ERROR (CHOLMOD_INVALID, "C and L dimensions do not match") ;
return (FALSE) ;
}
do_solve = (X != NULL) && (DeltaB != NULL) ;
if (do_solve)
{
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
Xx = X->x ;
Nx = DeltaB->x ;
if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n ||
DeltaB->ncol != 1 || Xx == NULL || Nx == NULL)
{
ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ;
return (FALSE) ;
}
}
else
{
Xx = NULL ;
Nx = NULL ;
}
Common->status = CHOLMOD_OK ;
fl = 0 ;
use_rowmark = (rowmark != NULL) ;
use_colmark = (colmark != NULL) ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* Note: cholmod_rowadd and cholmod_rowdel use the second n doubles in
* Common->Xwork for Cx, and then perform a rank-1 update here, which uses
* the first n doubles in Common->Xwork. Both the rowadd and rowdel
* routines allocate enough workspace so that Common->Xwork isn't destroyed
* below. Also, both cholmod_rowadd and cholmod_rowdel use the second n
* ints in Common->Iwork for Ci.
*/
/* make sure maxrank is in the proper range */
maxrank = CHOLMOD(maxrank) (n, Common) ;
k = MIN (cncol, (Int) maxrank) ; /* maximum k is wdim */
wdim = Power2 [k] ; /* number of columns needed in W */
ASSERT (wdim <= (Int) maxrank) ;
PRINT1 (("updown wdim final "ID" k "ID"\n", wdim, k)) ;
CHOLMOD(allocate_work) (n, n, wdim * n, Common) ;
if (Common->status < CHOLMOD_OK || maxrank == 0)
{
/* out of memory, L is returned unchanged */
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* convert to simplicial numeric LDL' factor, if not already */
/* ---------------------------------------------------------------------- */
if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll)
{
/* can only update/downdate a simplicial LDL' factorization */
CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L,
Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory, L is returned unchanged */
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
mark = CHOLMOD(clear_flag) (Common) ;
PRINT1 (("updown, rank %ld update %d\n", (long) C->ncol, update)) ;
DEBUG (CHOLMOD(dump_factor) (L, "input L for updown", Common)) ;
ASSERT (CHOLMOD(dump_sparse) (C, "input C for updown", Common) >= 0) ;
Ci = C->i ;
Cp = C->p ;
Cnz = C->nz ;
packed = C->packed ;
ASSERT (IMPLIES (!packed, Cnz != NULL)) ;
/* ---------------------------------------------------------------------- */
/* quick return */
/* ---------------------------------------------------------------------- */
if (cncol <= 0 || n == 0)
{
/* nothing to do */
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* get L */
/* ---------------------------------------------------------------------- */
Li = L->i ;
Lx = L->x ;
Lp = L->p ;
Lnz = L->nz ;
Lnext = L->next ;
ASSERT (Lnz != NULL) ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Flag = Common->Flag ; /* size n, Flag [i] <= mark must hold */
Head = Common->Head ; /* size n, Head [i] == EMPTY must hold */
W = Common->Xwork ; /* size n-by-wdim, zero on input and output*/
/* note that Iwork [n .. 2*n-1] (i/i/l) may be in use in rowadd/rowdel: */
Iwork = Common->Iwork ;
Stack = Iwork ; /* size n, uninitialized (i/i/l) */
/* ---------------------------------------------------------------------- */
/* entire rank-cncol update, done as a sequence of rank-k updates */
/* ---------------------------------------------------------------------- */
ps1 = NULL ;
ps2 = NULL ;
for (k1 = 0 ; k1 < cncol ; k1 += k)
{
/* ------------------------------------------------------------------ */
/* get the next k columns of C for the update/downdate */
/* ------------------------------------------------------------------ */
/* the last update/downdate might be less than rank-k */
if (k > cncol - k1)
{
k = cncol - k1 ;
wdim = Power2 [k] ;
}
k2 = k1 + k - 1 ;
/* workspaces are in the following state, on input and output */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
/* ------------------------------------------------------------------ */
/* create a zero-length path for each column of W */
/* ------------------------------------------------------------------ */
nextj = n ;
path = 0 ;
for (ccol = k1 ; ccol <= k2 ; ccol++)
{
PRINT1 (("Column ["ID"]: "ID"\n", path, ccol)) ;
ASSERT (ccol >= 0 && ccol <= cncol) ;
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
/* get the row index j of the first entry in C (:,ccol) */
if (pp2 > pp1)
{
/* Column ccol of C has at least one entry. */
j = Ci [pp1] ;
}
else
{
/* Column ccol of C is empty. Pretend it has one entry in
* the last column with numerical value of zero. */
j = n-1 ;
}
ASSERT (j >= 0 && j < n) ;
/* find first column to work on */
nextj = MIN (nextj, j) ;
Path [path].ccol = ccol ; /* which column of C this path is for */
Path [path].start = EMPTY ; /* paths for C have zero length */
Path [path].end = EMPTY ;
Path [path].parent = EMPTY ; /* no parent yet */
Path [path].rank = 1 ; /* one column of W */
Path [path].c = EMPTY ; /* no child of this path (case A) */
Path [path].next = Head [j] ; /* this path is pending at col j */
Path [path].pending = j ; /* this path is pending at col j */
Head [j] = path ; /* this path is pending at col j */
PRINT1(("Path "ID" starts: start "ID" end "ID" parent "ID" c "ID""
"j "ID" ccol "ID"\n", path, Path [path].start,
Path [path].end, Path [path].parent,
Path [path].c, j, ccol)) ;
path++ ;
}
/* we start with paths 0 to k-1. Next one (now unused) is npaths */
npaths = k ;
j = nextj ;
ASSERT (j < n) ;
scattered = FALSE ;
/* ------------------------------------------------------------------ */
/* symbolic update of columns of L */
/* ------------------------------------------------------------------ */
while (j < n)
{
ASSERT (j >= 0 && j < n && Lnz [j] > 0) ;
/* the old column, Li [p1..p2-1]. D (j,j) is stored in Lx [p1] */
p1 = Lp [j] ;
newlnz = Lnz [j] ;
p2 = p1 + newlnz ;
#ifndef NDEBUG
PRINT1 (("\n=========Column j="ID" p1 "ID" p2 "ID" lnz "ID" \n",
j, p1, p2, newlnz)) ;
dump_col ("Old", j, p1, p2, Li, Lx, n, Common) ;
oldparent = (Lnz [j] > 1) ? (Li [p1 + 1]) : EMPTY ;
ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ;
ASSERT (!scattered) ;
PRINT1 (("Col "ID": Checking paths, npaths: "ID"\n", j, npaths)) ;
for (kk = 0 ; kk < npaths ; kk++)
{
Int kk2, found, j3 = Path [kk].pending ;
PRINT2 (("Path "ID" pending at "ID".\n", kk, j3)) ;
if (j3 != EMPTY)
{
/* Path kk must be somewhere in link list for column j3 */
ASSERT (Head [j3] != EMPTY) ;
PRINT3 ((" List at "ID": ", j3)) ;
found = FALSE ;
for (kk2 = Head [j3] ; kk2 != EMPTY ; kk2 = Path [kk2].next)
{
PRINT3 ((""ID" ", kk2)) ;
ASSERT (Path [kk2].pending == j3) ;
found = found || (kk2 == kk) ;
}
PRINT3 (("\n")) ;
ASSERT (found) ;
}
}
PRINT1 (("\nCol "ID": Paths at this column, head "ID"\n",
j, Head [j]));
ASSERT (Head [j] != EMPTY) ;
for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next)
{
PRINT1 (("path "ID": (c="ID" j="ID") npaths "ID"\n",
kk, Path[kk].c, j, npaths)) ;
ASSERT (kk >= 0 && kk < npaths) ;
ASSERT (Path [kk].pending == j) ;
}
#endif
/* -------------------------------------------------------------- */
/* update/downdate of forward solve, Lx=b */
/* -------------------------------------------------------------- */
if (do_solve)
{
xj = Xx [j] ;
if (IS_NONZERO (xj))
{
xj = Xx [j] ;
/* This is first time column j has been seen for entire */
/* rank-k update/downdate. */
/* DeltaB += Lold (j:botrow-1,j) * X (j) */
Nx [j] += xj ; /* diagonal of L */
botrow = (use_rowmark) ? (rowmark [j]) : n ;
for (p = p1 + 1 ; p < p2 ; p++)
{
i = Li [p] ;
if (i >= botrow)
{
break ;
}
Nx [i] += Lx [p] * xj ;
}
/* clear X[j] to flag col j of Lold as having been seen. If
* X (j) was initially zero, then the above code is never
* executed for column j. This is safe, since if xj=0 the
* code above does not do anything anyway. */
Xx [j] = 0.0 ;
}
}
/* -------------------------------------------------------------- */
/* start a new path at this column if two or more paths merge */
/* -------------------------------------------------------------- */
/* get the first old path at column j */
path = Head [j] ;
newpath =
/* start a new path if paths have merged */
(Path [path].next != EMPTY)
/* or if j is the first node on a path (case A). */
|| (Path [path].c == EMPTY) ;
if (newpath)
{
path = npaths++ ;
ASSERT (npaths <= 3*k) ;
Path [path].ccol = EMPTY ; /* no single col of C for this path*/
Path [path].start = j ; /* path starts at this column j */
Path [path].end = EMPTY ; /* don't know yet where it ends */
Path [path].parent = EMPTY ;/* don't know parent path yet */
Path [path].rank = 0 ; /* rank is sum of child path ranks */
PRINT1 (("Path "ID" starts: start "ID" end "ID" parent "ID"\n",
path, Path [path].start, Path [path].end, Path [path].parent)) ;
}
/* -------------------------------------------------------------- */
/* for each path kk pending at column j */
/* -------------------------------------------------------------- */
/* make a list of the sets that need to be merged into column j */
nsets = 0 ;
for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next)
{
/* ---------------------------------------------------------- */
/* path kk is at (c,j) */
/* ---------------------------------------------------------- */
c = Path [kk].c ;
ASSERT (c < j) ;
PRINT1 (("TUPLE on path "ID" (c="ID" j="ID")\n", kk, c, j)) ;
ASSERT (Path [kk].pending == j) ;
if (newpath)
{
/* finalize path kk and find rank of this path */
Path [kk].end = c ; /* end of old path is previous node c */
Path [kk].parent = path ; /* parent is this path */
Path [path].rank += Path [kk].rank ; /* sum up ranks */
Path [kk].pending = EMPTY ;
PRINT1 (("Path "ID" done:start "ID" end "ID" parent "ID"\n",
kk, Path [kk].start, Path [kk].end, Path [kk].parent)) ;
}
if (c == EMPTY)
{
/* ------------------------------------------------------ */
/* CASE A: first node in path */
/* ------------------------------------------------------ */
/* update: add pattern of incoming column */
/* Column ccol of C is in Ci [pp1 ... pp2-1] */
ccol = Path [kk].ccol ;
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
PRINT1 (("Case A, ccol = "ID" len "ID"\n", ccol, pp2-pp1)) ;
ASSERT (IMPLIES (pp2 > pp1, Ci [pp1] == j)) ;
if (!scattered)
{
/* scatter the original pattern of column j of L */
for (p = p1 ; p < p2 ; p++)
{
Flag [Li [p]] = mark ;
}
scattered = TRUE ;
}
/* scatter column ccol of C (skip first entry, j) */
newlnz1 = newlnz ;
for (p = pp1 + 1 ; p < pp2 ; p++)
{
row = Ci [p] ;
if (Flag [row] < mark)
{
/* this is a new entry in Lj' */
Flag [row] = mark ;
newlnz++ ;
}
}
if (newlnz1 != newlnz)
{
/* column ccol of C adds something to column j of L */
Set [nsets++] = FLIP (ccol) ;
}
}
else if (Head [c] == 1)
{
/* ------------------------------------------------------ */
/* CASE B: c is old, but changed, child of j */
/* CASE C: new child of j */
/* ------------------------------------------------------ */
/* Head [c] is 1 if col c of L has new entries,
* EMPTY otherwise */
Flag [c] = 0 ;
Head [c] = EMPTY ;
/* update: add Lc' */
/* column c of L is in Li [pp1 .. pp2-1] */
pp1 = Lp [c] ;
pp2 = pp1 + Lnz [c] ;
PRINT1 (("Case B/C: c = "ID"\n", c)) ;
DEBUG (dump_col ("Child", c, pp1, pp2, Li, Lx, n, Common)) ;
ASSERT (j == Li [pp1 + 1]) ; /* j is new parent of c */
if (!scattered)
{
/* scatter the original pattern of column j of L */
for (p = p1 ; p < p2 ; p++)
{
Flag [Li [p]] = mark ;
}
scattered = TRUE ;
}
/* scatter column c of L (skip first two entries, c and j)*/
newlnz1 = newlnz ;
for (p = pp1 + 2 ; p < pp2 ; p++)
{
row = Li [p] ;
if (Flag [row] < mark)
{
/* this is a new entry in Lj' */
Flag [row] = mark ;
newlnz++ ;
}
}
PRINT2 (("\n")) ;
if (newlnz1 != newlnz)
{
/* column c of L adds something to column j of L */
Set [nsets++] = c ;
}
}
}
/* -------------------------------------------------------------- */
/* update the pattern of column j of L */
/* -------------------------------------------------------------- */
/* Column j of L will be in Li/Lx [p1 .. p3-1] */
p3 = p1 + newlnz ;
ASSERT (IMPLIES (nsets == 0, newlnz == Lnz [j])) ;
PRINT1 (("p1 "ID" p2 "ID" p3 "ID" nsets "ID"\n", p1, p2, p3,nsets));
/* -------------------------------------------------------------- */
/* ensure we have enough space for the longer column */
/* -------------------------------------------------------------- */
if (nsets > 0 && p3 > Lp [Lnext [j]])
{
PRINT1 (("Col realloc: j "ID" newlnz "ID"\n", j, newlnz)) ;
if (!CHOLMOD(reallocate_column) (j, newlnz, L, Common))
{
/* out of memory, L is now simplicial symbolic */
CHOLMOD(clear_flag) (Common) ;
for (j = 0 ; j <= n ; j++)
{
Head [j] = EMPTY ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
return (FALSE) ;
}
/* L->i and L->x may have moved. Column j has moved too */
Li = L->i ;
Lx = L->x ;
p1 = Lp [j] ;
p2 = p1 + Lnz [j] ;
p3 = p1 + newlnz ;
}
/* -------------------------------------------------------------- */
/* create set pointers */
/* -------------------------------------------------------------- */
for (s = 0 ; s < nsets ; s++)
{
/* Pattern of Set s is *(Set_ps1 [s] ... Set_ps2 [s]-1) */
c = Set [s] ;
if (c < EMPTY)
{
/* column ccol of C, skip first entry (j) */
ccol = FLIP (c) ;
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
ASSERT (pp2 - pp1 > 1) ;
Set_ps1 [s] = &(Ci [pp1 + 1]) ;
Set_ps2 [s] = &(Ci [pp2]) ;
PRINT1 (("set "ID" is ccol "ID"\n", s, ccol)) ;
}
else
{
/* column c of L, skip first two entries (c and j) */
pp1 = Lp [c] ;
pp2 = pp1 + Lnz [c] ;
ASSERT (Lnz [c] > 2) ;
Set_ps1 [s] = &(Li [pp1 + 2]) ;
Set_ps2 [s] = &(Li [pp2]) ;
PRINT1 (("set "ID" is L "ID"\n", s, c)) ;
}
DEBUG (dump_set (s, Set_ps1, Set_ps2, j, n, Common)) ;
}
/* -------------------------------------------------------------- */
/* multiset merge */
/* -------------------------------------------------------------- */
/* Merge the sets into a single sorted set, Lj'. Before the merge
* starts, column j is located in Li/Lx [p1 ... p2-1] and the
* space Li/Lx [p2 ... p3-1] is empty. p1 is Lp [j], p2 is
* Lp [j] + Lnz [j] (the old length of the column), and p3 is
* Lp [j] + newlnz (the new and longer length of the column).
*
* The sets 0 to nsets-1 are defined by the Set_ps1 and Set_ps2
* pointers. Set s is located in *(Set_ps1 [s] ... Set_ps2 [s]-1).
* It may be a column of C, or a column of L. All row indices i in
* the sets are in the range i > j and i < n. All sets are sorted.
*
* The merge into column j of L is done in place.
*
* During the merge, p2 and p3 are updated. Li/Lx [p1..p2-1]
* reflects the indices of the old column j of L that are yet to
* be merged into the new column. Entries in their proper place in
* the new column j of L are located in Li/Lx [p3 ... p1+newlnz-1].
* The merge finishes when p2 == p3.
*
* During the merge, set s consumed as it is merged into column j of
* L. Its unconsumed contents are *(Set_ps1 [s] ... Set_ps2 [s]-1).
* When a set is completely consumed, it is removed from the set of
* sets, and nsets is decremented.
*
* The multiset merge and 2-set merge finishes when p2 == p3.
*/
PRINT1 (("Multiset merge p3 "ID" p2 "ID" nsets "ID"\n",
p3, p2, nsets)) ;
while (p3 > p2 && nsets > 1)
{
#ifndef NDEBUG
PRINT2 (("\nMultiset merge. nsets = "ID"\n", nsets)) ;
PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n",
p1, p2, p3)) ;
for (p = p1 + 1 ; p < p2 ; p++)
{
PRINT2 ((" p: "ID" source row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
PRINT2 (("---\n")) ;
for (p = p3 ; p < p1 + newlnz ; p++)
{
PRINT2 ((" p: "ID" target row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
for (s = 0 ; s < nsets ; s++)
{
dump_set (s, Set_ps1, Set_ps2, j, n, Common) ;
}
#endif
/* get the entry at the tail end of source column Lj */
row1 = Li [p2 - 1] ;
ASSERT (row1 >= j && p2 >= p1) ;
/* find the largest row in all the sets */
maxrow = row1 ;
smax = EMPTY ;
for (s = nsets-1 ; s >= 0 ; s--)
{
ASSERT (Set_ps1 [s] < Set_ps2 [s]) ;
row = *(Set_ps2 [s] - 1) ;
if (row == maxrow)
{
/* skip past this entry in set s (it is a duplicate) */
Set_ps2 [s]-- ;
if (Set_ps1 [s] == Set_ps2 [s])
{
/* nothing more in this set */
nsets-- ;
Set_ps1 [s] = Set_ps1 [nsets] ;
Set_ps2 [s] = Set_ps2 [nsets] ;
if (smax == nsets)
{
/* Set smax redefined; it is now this set */
smax = s ;
}
}
}
else if (row > maxrow)
{
maxrow = row ;
smax = s ;
}
}
ASSERT (maxrow > j) ;
/* move the row onto the stack of the target column */
if (maxrow == row1)
{
/* next entry is in Lj, move to the bottom of Lj' */
ASSERT (smax == EMPTY) ;
p2-- ;
p3-- ;
Li [p3] = maxrow ;
Lx [p3] = Lx [p2] ;
}
else
{
/* new entry in Lj' */
ASSERT (smax >= 0 && smax < nsets) ;
Set_ps2 [smax]-- ;
p3-- ;
Li [p3] = maxrow ;
Lx [p3] = 0.0 ;
if (Set_ps1 [smax] == Set_ps2 [smax])
{
/* nothing more in this set */
nsets-- ;
Set_ps1 [smax] = Set_ps1 [nsets] ;
Set_ps2 [smax] = Set_ps2 [nsets] ;
PRINT1 (("Set "ID" now empty\n", smax)) ;
}
}
}
/* -------------------------------------------------------------- */
/* 2-set merge: */
/* -------------------------------------------------------------- */
/* This the same as the multi-set merge, except there is only one
* set s = 0 left. The source column j and the set 0 are being
* merged into the target column j. */
if (nsets > 0)
{
ps1 = Set_ps1 [0] ;
ps2 = Set_ps2 [0] ;
}
while (p3 > p2)
{
#ifndef NDEBUG
PRINT2 (("\n2-set merge.\n")) ;
ASSERT (nsets == 1) ;
PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n",
p1, p2, p3)) ;
for (p = p1 + 1 ; p < p2 ; p++)
{
PRINT2 ((" p: "ID" source row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
PRINT2 (("---\n")) ;
for (p = p3 ; p < p1 + newlnz ; p++)
{
PRINT2 ((" p: "ID" target row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
dump_set (0, Set_ps1, Set_ps2, j, n, Common) ;
#endif
if (p2 == p1 + 1)
{
/* the top of Lj is empty; copy the set and quit */
while (p3 > p2)
{
/* new entry in Lj' */
row = *(--ps2) ;
p3-- ;
Li [p3] = row ;
Lx [p3] = 0.0 ;
}
}
else
{
/* get the entry at the tail end of Lj */
row1 = Li [p2 - 1] ;
ASSERT (row1 > j && row1 < n) ;
/* get the entry at the tail end of the incoming set */
ASSERT (ps1 < ps2) ;
row = *(ps2-1) ;
ASSERT (row > j && row1 < n) ;
/* move the larger of the two entries to the target set */
if (row1 >= row)
{
/* next entry is in Lj, move to the bottom */
if (row1 == row)
{
/* skip past this entry in the set */
ps2-- ;
}
p2-- ;
p3-- ;
Li [p3] = row1 ;
Lx [p3] = Lx [p2] ;
}
else
{
/* new entry in Lj' */
ps2-- ;
p3-- ;
Li [p3] = row ;
Lx [p3] = 0.0 ;
}
}
}
/* -------------------------------------------------------------- */
/* The new column j of L is now in Li/Lx [p1 ... p2-1] */
/* -------------------------------------------------------------- */
p2 = p1 + newlnz ;
DEBUG (dump_col ("After merge: ", j, p1, p2, Li, Lx, n, Common)) ;
fl += Path [path].rank * (6 + 4 * (double) newlnz) ;
/* -------------------------------------------------------------- */
/* clear Flag; original pattern of column j L no longer marked */
/* -------------------------------------------------------------- */
mark = CHOLMOD(clear_flag) (Common) ;
scattered = FALSE ;
/* -------------------------------------------------------------- */
/* find the new parent */
/* -------------------------------------------------------------- */
newparent = (newlnz > 1) ? (Li [p1 + 1]) : EMPTY ;
PRINT1 (("\nNew parent, Lnz: "ID": "ID" "ID"\n",
j, newparent,newlnz));
ASSERT (oldparent == EMPTY || newparent <= oldparent) ;
/* -------------------------------------------------------------- */
/* go to the next node in the path */
/* -------------------------------------------------------------- */
/* path moves to (j,nextj) unless j is a root */
nextj = (newparent == EMPTY) ? n : newparent ;
/* place path at head of list for nextj, or terminate the path */
PRINT1 (("\n j = "ID" nextj = "ID"\n\n", j, nextj)) ;
Path [path].c = j ;
if (nextj < n)
{
/* put path on link list of pending paths at column nextj */
Path [path].next = Head [nextj] ;
Path [path].pending = nextj ;
Head [nextj] = path ;
PRINT1 (("Path "ID" continues to ("ID","ID"). Rank "ID"\n",
path, Path [path].c, nextj, Path [path].rank)) ;
}
else
{
/* path has ended here, at a root */
Path [path].next = EMPTY ;
Path [path].pending = EMPTY ;
Path [path].end = j ;
PRINT1 (("Path "ID" ends at root ("ID"). Rank "ID"\n",
path, Path [path].end, Path [path].rank)) ;
}
/* The link list Head [j] can now be emptied. Set Head [j] to 1
* if column j has changed (it is no longer used as a link list). */
PRINT1 (("column "ID", oldlnz = "ID"\n", j, Lnz [j])) ;
Head [j] = (Lnz [j] != newlnz) ? 1 : EMPTY ;
Lnz [j] = newlnz ;
PRINT1 (("column "ID", newlnz = "ID"\n", j, newlnz)) ;
DEBUG (dump_col ("New", j, p1, p2, Li, Lx, n, Common)) ;
/* move to the next column */
if (k == Path [path].rank)
{
/* only one path left */
j = nextj ;
}
else
{
/* The current path is moving from column j to column nextj
* (nextj is n if the path has ended). However, there may be
* other paths pending in columns j+1 to nextj-1. There are
* two methods for looking for the next column with a pending
* update. The first one looks at all columns j+1 to nextj-1
* for a non-empty link list. This can be costly if j and
* nextj differ by a large amount (it can be O(n), but this
* entire routine may take Omega(1) time). The second method
* looks at all paths and finds the smallest column at which any
* path is pending. It takes O(# of paths), which is bounded
* by 23: one for each column of C (up to 8), and then 15 for a
* balanced binary tree with 8 leaves. However, if j and
* nextj differ by a tiny amount (nextj is often j+1 near
* the end of the matrix), looking at columns j+1 to nextj
* would be faster. Both methods give the same answer. */
if (nextj - j < npaths)
{
/* there are fewer columns to search than paths */
PRINT1 (("check j="ID" to nextj="ID"\n", j, nextj)) ;
for (j2 = j + 1 ; j2 < nextj ; j2++)
{
PRINT1 (("check j="ID" "ID"\n", j2, Head [j2])) ;
if (Head [j2] != EMPTY)
{
PRINT1 (("found, j="ID"\n", j2)) ;
ASSERT (Path [Head [j2]].pending == j2) ;
break ;
}
}
}
else
{
/* there are fewer paths than columns to search */
j2 = nextj ;
for (kk = 0 ; kk < npaths ; kk++)
{
jj = Path [kk].pending ;
PRINT2 (("Path "ID" pending at "ID"\n", kk, jj)) ;
if (jj != EMPTY) j2 = MIN (j2, jj) ;
}
}
j = j2 ;
}
}
/* ensure workspaces are back to the values required on input */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ;
/* ------------------------------------------------------------------ */
/* depth-first-search of tree to order the paths */
/* ------------------------------------------------------------------ */
/* create lists of child paths */
PRINT1 (("\n\nDFS search:\n\n")) ;
for (path = 0 ; path < npaths ; path++)
{
Path [path].c = EMPTY ; /* first child of path */
Path [path].next = EMPTY ; /* next sibling of path */
Path [path].order = EMPTY ; /* path is not ordered yet */
Path [path].wfirst = EMPTY ; /* 1st column of W not found yet */
#ifndef NDEBUG
j = Path [path].start ;
PRINT1 (("Path "ID" : start "ID" end "ID" parent "ID" ccol "ID"\n",
path, j, Path [path].end, Path [path].parent, Path [path].ccol)) ;
for ( ; ; )
{
PRINT1 ((" column "ID"\n", j)) ;
ASSERT (j == EMPTY || (j >= 0 && j < n)) ;
if (j == Path [path].end)
{
break ;
}
ASSERT (j >= 0 && j < n) ;
j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ;
}
#endif
}
for (path = 0 ; path < npaths ; path++)
{
p = Path [path].parent ; /* add path to child list of parent */
if (p != EMPTY)
{
ASSERT (p < npaths) ;
Path [path].next = Path [p].c ;
Path [p].c = path ;
}
}
path_order = k ;
w_order = 0 ;
for (path = npaths-1 ; path >= 0 ; path--)
{
if (Path [path].order == EMPTY)
{
/* this path is the root of a subtree of Tbar */
PRINT1 (("Root path "ID"\n", path)) ;
ASSERT (path >= k) ;
dfs (Path, k, path, &path_order, &w_order, 0, npaths) ;
}
}
ASSERT (path_order == npaths) ;
ASSERT (w_order == k) ;
/* reorder the paths */
for (path = 0 ; path < npaths ; path++)
{
/* old order is path, new order is Path [path].order */
OrderedPath [Path [path].order] = Path [path] ;
}
#ifndef NDEBUG
for (path = 0 ; path < npaths ; path++)
{
PRINT1 (("Ordered Path "ID": start "ID" end "ID" wfirst "ID" rank "
""ID" ccol "ID"\n", path, OrderedPath [path].start,
OrderedPath [path].end, OrderedPath [path].wfirst,
OrderedPath [path].rank, OrderedPath [path].ccol)) ;
if (path < k)
{
ASSERT (OrderedPath [path].ccol >= 0) ;
}
else
{
ASSERT (OrderedPath [path].ccol == EMPTY) ;
}
}
#endif
/* ------------------------------------------------------------------ */
/* numeric update/downdate for all paths */
/* ------------------------------------------------------------------ */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
switch (wdim)
{
case 1:
updown_1_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
case 2:
updown_2_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
case 4:
updown_4_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
case 8:
updown_8_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
}
/* ---------------------------------------------------------------------- */
/* update/downdate the forward solve */
/* ---------------------------------------------------------------------- */
if (do_solve)
{
/* We now have DeltaB += Lold (:,j) * X (j) for all columns j in union
* of all paths seen during the entire rank-cncol update/downdate. For
* each j in path, do DeltaB -= Lnew (:,j)*DeltaB(j)
* in topological order. */
#ifndef NDEBUG
PRINT1 (("\ndo_solve, DeltaB + Lold(:,Path)*X(Path):\n")) ;
for (i = 0 ; i < n ; i++)
{
PRINT1 (("do_solve: "ID" %30.20e\n", i, Nx [i])) ;
}
#endif
/* Note that the downdate, if it deleted entries, would need to compute
* the Stack prior to doing any downdates. */
/* find the union of all the paths in the new L */
top = n ; /* "top" is stack pointer, not a row or column index */
for (ccol = 0 ; ccol < cncol ; ccol++)
{
/* -------------------------------------------------------------- */
/* j = first row index of C (:,ccol) */
/* -------------------------------------------------------------- */
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
if (pp2 > pp1)
{
/* Column ccol of C has at least one entry. */
j = Ci [pp1] ;
}
else
{
/* Column ccol of C is empty */
j = n-1 ;
}
PRINT1 (("\ndo_solve: ccol= "ID"\n", ccol)) ;
ASSERT (j >= 0 && j < n) ;
len = 0 ;
/* -------------------------------------------------------------- */
/* find the new rowmark */
/* -------------------------------------------------------------- */
/* Each column of C can redefine the region of L that takes part in
* the update/downdate of the triangular solve Lx=b. If
* i = colmark [ccol] for column C(:,ccol), then i = rowmark [j] is
* redefined for all columns along the path modified by C(:,ccol).
* If more than one column modifies any given column j of L, then
* the rowmark of j is determined by the colmark of the least-
* numbered column that affects column j. That is, if both
* C(:,ccol1) and C(:,ccol2) affect column j of L, then
* rowmark [j] = colmark [MIN (ccol1, ccol2)].
*
* rowmark [j] is not modified if rowmark or colmark are NULL,
* or if colmark [ccol] is EMPTY.
*/
botrow = (use_colmark && use_rowmark) ? (colmark [ccol]) : EMPTY ;
/* -------------------------------------------------------------- */
/* traverse from j towards root, stopping if node already visited */
/* -------------------------------------------------------------- */
while (j != EMPTY && Flag [j] < mark)
{
PRINT1 (("do_solve: subpath j= "ID"\n", j)) ;
ASSERT (j >= 0 && j < n) ;
Stack [len++] = j ; /* place j on the stack */
Flag [j] = mark ; /* flag j as visited */
/* redefine the parts of column j of L that take part in
* the triangular solve. */
if (botrow != EMPTY)
{
/* update rowmark to keep track of botrow for col j */
rowmark [j] = botrow ;
}
/* go up the tree, to the parent of j */
j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ;
}
/* -------------------------------------------------------------- */
/* move the path down to the bottom of the stack */
/* -------------------------------------------------------------- */
ASSERT (len <= top) ;
while (len > 0)
{
Stack [--top] = Stack [--len] ;
}
}
#ifndef NDEBUG
/* Union of paths now in Stack [top..n-1] in topological order */
PRINT1 (("\nTopological order:\n")) ;
for (i = top ; i < n ; i++)
{
PRINT1 (("column "ID" in full path\n", Stack [i])) ;
}
#endif
/* Do the forward solve for the full path part of L */
for (m = top ; m < n ; m++)
{
j = Stack [m] ;
ASSERT (j >= 0 && j < n) ;
PRINT1 (("do_solve: path j= "ID"\n", j)) ;
p1 = Lp [j] ;
lnz = Lnz [j] ;
p2 = p1 + lnz ;
xj = Nx [j] ;
/* copy new solution onto old one, for all cols in full path */
Xx [j] = xj ;
Nx [j] = 0. ;
/* DeltaB -= Lnew (j+1:botrow-1,j) * deltab(j) */
botrow = (use_rowmark) ? (rowmark [j]) : n ;
for (p = p1 + 1 ; p < p2 ; p++)
{
i = Li [p] ;
if (i >= botrow)
{
break ;
}
Nx [i] -= Lx [p] * xj ;
}
}
/* clear the Flag */
mark = CHOLMOD(clear_flag) (Common) ;
}
/* ---------------------------------------------------------------------- */
/* successful update/downdate */
/* ---------------------------------------------------------------------- */
Common->modfl = fl ;
DEBUG (for (j = 0 ; j < n ; j++) ASSERT (IMPLIES (do_solve, Nx[j] == 0.))) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ;
DEBUG (CHOLMOD(dump_factor) (L, "output L for updown", Common)) ;
return (TRUE) ;
}
cholmod_triplet *CHOLMOD(allocate_triplet)
(
/* ---- input ---- */
size_t nrow, /* # of rows of T */
size_t ncol, /* # of columns of T */
size_t nzmax, /* max # of nonzeros of T */
int stype, /* stype of T */
int xtype, /* CHOLMOD_PATTERN, _REAL, _COMPLEX, or _ZOMPLEX */
/* --------------- */
cholmod_common *Common
)
{
cholmod_triplet *T ;
size_t nzmax0 ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
if (xtype < CHOLMOD_PATTERN || xtype > CHOLMOD_ZOMPLEX)
{
ERROR (CHOLMOD_INVALID, "xtype invalid") ;
return (NULL) ;
}
/* ensure the dimensions do not cause integer overflow */
(void) CHOLMOD(add_size_t) (ncol, 2, &ok) ;
if (!ok || nrow > Int_max || ncol > Int_max || nzmax > Int_max)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate header */
/* ---------------------------------------------------------------------- */
T = CHOLMOD(malloc) (sizeof (cholmod_triplet), 1, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory */
}
PRINT1 (("cholmod_allocate_triplet %d-by-%d nzmax %d xtype %d\n",
nrow, ncol, nzmax, xtype)) ;
nzmax = MAX (1, nzmax) ;
T->nrow = nrow ;
T->ncol = ncol ;
T->nzmax = nzmax ;
T->nnz = 0 ;
T->stype = stype ;
T->itype = ITYPE ;
T->xtype = xtype ;
T->dtype = DTYPE ;
T->j = NULL ;
T->i = NULL ;
T->x = NULL ;
T->z = NULL ;
/* ---------------------------------------------------------------------- */
/* allocate the matrix itself */
/* ---------------------------------------------------------------------- */
nzmax0 = 0 ;
CHOLMOD(realloc_multiple) (nzmax, 2, xtype, &(T->i), &(T->j),
&(T->x), &(T->z), &nzmax0, Common) ;
if (Common->status < CHOLMOD_OK)
{
CHOLMOD(free_triplet) (&T, Common) ;
return (NULL) ; /* out of memory */
}
return (T) ;
}
