int CHOLMOD(copy_dense2)
(
/* ---- input ---- */
cholmod_dense *X, /* matrix to copy */
/* ---- output --- */
cholmod_dense *Y, /* copy of matrix X */
/* --------------- */
cholmod_common *Common
)
{
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (X, FALSE) ;
RETURN_IF_NULL (Y, FALSE) ;
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (Y, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
if (X->nrow != Y->nrow || X->ncol != Y->ncol || X->xtype != Y->xtype)
{
ERROR (CHOLMOD_INVALID, "X and Y must have same dimensions and xtype") ;
return (FALSE) ;
}
if (X->d < X->nrow || Y->d < Y->nrow
|| (X->d * X->ncol) > X->nzmax || (Y->d * Y->ncol) > Y->nzmax)
{
ERROR (CHOLMOD_INVALID, "X and/or Y invalid") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* copy the matrix, using template routine */
/* ---------------------------------------------------------------------- */
switch (X->xtype)
{
case CHOLMOD_REAL:
r_cholmod_copy_dense2 (X, Y) ;
break ;
case CHOLMOD_COMPLEX:
c_cholmod_copy_dense2 (X, Y) ;
break ;
case CHOLMOD_ZOMPLEX:
z_cholmod_copy_dense2 (X, Y) ;
break ;
}
return (TRUE) ;
}
int CHOLMOD(reallocate_sparse)
(
/* ---- input ---- */
size_t nznew, /* new # of entries in A */
/* ---- in/out --- */
cholmod_sparse *A, /* matrix to reallocate */
/* --------------- */
cholmod_common *Common
)
{
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
PRINT1 (("realloc matrix %d to %d, xtype: %d\n",
A->nzmax, nznew, A->xtype)) ;
/* ---------------------------------------------------------------------- */
/* resize the matrix */
/* ---------------------------------------------------------------------- */
CHOLMOD(realloc_multiple) (MAX (1,nznew), 1, A->xtype, &(A->i), NULL,
&(A->x), &(A->z), &(A->nzmax), Common) ;
return (Common->status == CHOLMOD_OK) ;
}
int CHOLMOD(reallocate_triplet)
(
/* ---- input ---- */
size_t nznew, /* new # of entries in T */
/* ---- in/out --- */
cholmod_triplet *T, /* triplet matrix to modify */
/* --------------- */
cholmod_common *Common
)
{
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (T, FALSE) ;
RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
PRINT1 (("realloc triplet %d to %d, xtype: %d\n",
T->nzmax, nznew, T->xtype)) ;
/* ---------------------------------------------------------------------- */
/* resize the matrix */
/* ---------------------------------------------------------------------- */
CHOLMOD(realloc_multiple) (MAX (1,nznew), 2, T->xtype, &(T->i), &(T->j),
&(T->x), &(T->z), &(T->nzmax), Common) ;
return (Common->status == CHOLMOD_OK) ;
}
int CHOLMOD(reallocate_factor)
(
/* ---- input ---- */
size_t nznew, /* new # of entries in L */
/* ---- 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_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
PRINT1 (("realloc factor: xtype %d\n", L->xtype)) ;
if (L->is_super)
{
/* L must be simplicial, and not symbolic */
ERROR (CHOLMOD_INVALID, "L invalid") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
PRINT1 (("realloc factor %g to %g\n", (double) L->nzmax, (double) nznew)) ;
/* ---------------------------------------------------------------------- */
/* resize (or allocate) the L->i and L->x components of the factor */
/* ---------------------------------------------------------------------- */
CHOLMOD(realloc_multiple) (nznew, 1, L->xtype, &(L->i), NULL,
&(L->x), &(L->z), &(L->nzmax), Common) ;
return (Common->status == CHOLMOD_OK) ;
}
cholmod_dense *CHOLMOD(sparse_to_dense)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to copy */
/* --------------- */
cholmod_common *Common
)
{
cholmod_dense *X = NULL ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
if (A->stype && A->nrow != A->ncol)
{
ERROR (CHOLMOD_INVALID, "matrix invalid") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;
/* ---------------------------------------------------------------------- */
/* convert the matrix, using template routine */
/* ---------------------------------------------------------------------- */
switch (A->xtype)
{
case CHOLMOD_PATTERN:
X = p_cholmod_sparse_to_dense (A, Common) ;
break ;
case CHOLMOD_REAL:
X = r_cholmod_sparse_to_dense (A, Common) ;
break ;
case CHOLMOD_COMPLEX:
X = c_cholmod_sparse_to_dense (A, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
X = z_cholmod_sparse_to_dense (A, Common) ;
break ;
}
return (X) ;
}
cholmod_sparse *CHOLMOD(dense_to_sparse)
(
/* ---- input ---- */
cholmod_dense *X, /* matrix to copy */
int values, /* TRUE if values to be copied, FALSE otherwise */
/* --------------- */
cholmod_common *Common
)
{
cholmod_sparse *C = NULL ;
DEBUG (CHOLMOD(dump_dense) (X, "X", Common)) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (X, NULL) ;
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ;
if (X->d < X->nrow)
{
ERROR (CHOLMOD_INVALID, "matrix invalid") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* convert the matrix, using template routine */
/* ---------------------------------------------------------------------- */
switch (X->xtype)
{
case CHOLMOD_REAL:
C = r_cholmod_dense_to_sparse (X, values, Common) ;
break ;
case CHOLMOD_COMPLEX:
C = c_cholmod_dense_to_sparse (X, values, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
C = z_cholmod_dense_to_sparse (X, values, Common) ;
break ;
}
return (C) ;
}
UF_long CHOLMOD(nnz)
(
/* ---- input ---- */
cholmod_sparse *A,
/* --------------- */
cholmod_common *Common
)
{
Int *Ap, *Anz ;
size_t nz ;
Int j, ncol ;
/* ---------------------------------------------------------------------- */
/* get 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 ;
/* ---------------------------------------------------------------------- */
/* return nnz (A) */
/* ---------------------------------------------------------------------- */
ncol = A->ncol ;
if (A->packed)
{
Ap = A->p ;
RETURN_IF_NULL (Ap, EMPTY) ;
nz = Ap [ncol] ;
}
else
{
Anz = A->nz ;
RETURN_IF_NULL (Anz, EMPTY) ;
nz = 0 ;
for (j = 0 ; j < ncol ; j++)
{
nz += MAX (0, Anz [j]) ;
}
}
return (nz) ;
}
cholmod_dense *CHOLMOD(copy_dense)
(
/* ---- input ---- */
cholmod_dense *X, /* matrix to copy */
/* --------------- */
cholmod_common *Common
)
{
cholmod_dense *Y ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (X, NULL) ;
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, NULL) ;
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate result */
/* ---------------------------------------------------------------------- */
Y = CHOLMOD(allocate_dense) (X->nrow, X->ncol, X->d, X->xtype, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (NULL) ; /* out of memory or X invalid */
}
/* ---------------------------------------------------------------------- */
/* Y = X */
/* ---------------------------------------------------------------------- */
/* This cannot fail (X and Y are allocated, and have the same nrow, ncol
* d, and xtype) */
CHOLMOD(copy_dense2) (X, Y, Common) ;
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
return (Y) ;
}
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) ;
}
cholmod_sparse *CHOLMOD(submatrix)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to subreference */
Int *rset, /* set of row indices, duplicates OK */
SuiteSparse_long rsize, /* size of rset, or -1 for ":" */
Int *cset, /* set of column indices, duplicates OK */
SuiteSparse_long csize, /* size of cset, or -1 for ":" */
int values, /* if TRUE compute the numerical values of C */
int sorted, /* if TRUE then return C with sorted columns */
/* --------------- */
cholmod_common *Common
)
{
double aij = 0 ;
double *Ax, *Cx ;
Int *Ap, *Ai, *Anz, *Ci, *Cp, *Head, *Rlen, *Rnext, *Iwork ;
cholmod_sparse *C ;
Int packed, ancol, anrow, cnrow, cncol, nnz, i, j, csorted, ilast, p,
pend, pdest, ci, cj, head, nr, nc ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (NULL) ;
RETURN_IF_NULL (A, NULL) ;
values = (values && (A->xtype != CHOLMOD_PATTERN)) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN,
values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
if (A->stype != 0)
{
/* A must be unsymmetric */
ERROR (CHOLMOD_INVALID, "symmetric upper or lower case not supported") ;
return (NULL) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
ancol = A->ncol ;
anrow = A->nrow ;
nr = rsize ;
nc = csize ;
if (rset == NULL)
{
/* nr = 0 denotes rset = [ ], nr < 0 denotes rset = 0:anrow-1 */
nr = (nr < 0) ? (-1) : 0 ;
}
if (cset == NULL)
{
/* nr = 0 denotes cset = [ ], nr < 0 denotes cset = 0:ancol-1 */
nc = (nc < 0) ? (-1) : 0 ;
}
cnrow = (nr < 0) ? anrow : nr ; /* negative rset means rset = 0:anrow-1 */
cncol = (nc < 0) ? ancol : nc ; /* negative cset means cset = 0:ancol-1 */
if (nr < 0 && nc < 0)
{
/* ------------------------------------------------------------------ */
/* C = A (:,:), use cholmod_copy instead */
/* ------------------------------------------------------------------ */
/* workspace: Iwork (max (C->nrow,C->ncol)) */
PRINT1 (("submatrix C = A (:,:)\n")) ;
C = CHOLMOD(copy) (A, 0, values, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
return (C) ;
}
PRINT1 (("submatrix nr "ID" nc "ID" Cnrow "ID" Cncol "ID""
" Anrow "ID" Ancol "ID"\n", nr, nc, cnrow, cncol, anrow, ancol)) ;
/* s = MAX3 (anrow+MAX(0,nr), cncol, cnrow) ; */
s = CHOLMOD(add_size_t) (anrow, MAX (0,nr), &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (NULL) ;
}
s = MAX3 (s, ((size_t) cncol), ((size_t) cnrow)) ;
CHOLMOD(allocate_work) (anrow, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
packed = A->packed ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Head = Common->Head ; /* size anrow */
Iwork = Common->Iwork ;
Rlen = Iwork ; /* size anrow (i/i/l) */
Rnext = Iwork + anrow ; /* size nr (i/i/l), not used if nr < 0 */
/* ---------------------------------------------------------------------- */
/* construct inverse of rset and compute nnz (C) */
/* ---------------------------------------------------------------------- */
PRINT1 (("nr "ID" nc "ID"\n", nr, nc)) ;
PRINT1 (("anrow "ID" ancol "ID"\n", anrow, ancol)) ;
PRINT1 (("cnrow "ID" cncol "ID"\n", cnrow, cncol)) ;
DEBUG (for (i = 0 ; i < nr ; i++) PRINT2 (("rset ["ID"] = "ID"\n",
i, rset [i])));
DEBUG (for (i = 0 ; i < nc ; i++) PRINT2 (("cset ["ID"] = "ID"\n",
i, cset [i])));
/* C is sorted if A and rset are sorted, or if C has one row or less */
csorted = A->sorted || (cnrow <= 1) ;
if (!check_subset (rset, nr, anrow))
{
ERROR (CHOLMOD_INVALID, "invalid rset") ;
return (NULL) ;
}
if (!check_subset (cset, nc, ancol))
{
ERROR (CHOLMOD_INVALID, "invalid cset") ;
return (NULL) ;
}
nnz = 0 ;
if (nr < 0)
{
/* C = A (:,cset) where cset = [ ] or cset is not empty */
ASSERT (IMPLIES (cncol > 0, cset != NULL)) ;
for (cj = 0 ; cj < cncol ; cj++)
{
/* construct column cj of C, which is column j of A */
j = cset [cj] ;
nnz += (packed) ? (Ap [j+1] - Ap [j]) : MAX (0, Anz [j]) ;
}
}
else
{
/* C = A (rset,cset), where rset is not empty but cset might be empty */
/* create link lists in reverse order to preserve natural order */
ilast = anrow ;
for (ci = nr-1 ; ci >= 0 ; ci--)
{
/* row i of A becomes row ci of C; add ci to ith link list */
i = rset [ci] ;
head = Head [i] ;
Rlen [i] = (head == EMPTY) ? 1 : (Rlen [i] + 1) ;
Rnext [ci] = head ;
Head [i] = ci ;
if (i > ilast)
{
/* row indices in columns of C will not be sorted */
csorted = FALSE ;
}
ilast = i ;
}
#ifndef NDEBUG
for (i = 0 ; i < anrow ; i++)
{
Int k = 0 ;
Int rlen = (Head [i] != EMPTY) ? Rlen [i] : -1 ;
PRINT1 (("Row "ID" Rlen "ID": ", i, rlen)) ;
for (ci = Head [i] ; ci != EMPTY ; ci = Rnext [ci])
{
k++ ;
PRINT2 ((""ID" ", ci)) ;
}
PRINT1 (("\n")) ;
ASSERT (IMPLIES (Head [i] != EMPTY, k == Rlen [i])) ;
}
#endif
/* count nonzeros in C */
for (cj = 0 ; cj < cncol ; cj++)
{
/* count rows in column cj of C, which is column j of A */
j = (nc < 0) ? cj : (cset [cj]) ;
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
/* row i of A becomes multiple rows (ci) of C */
i = Ai [p] ;
ASSERT (i >= 0 && i < anrow) ;
if (Head [i] != EMPTY)
{
nnz += Rlen [i] ;
}
}
}
}
PRINT1 (("nnz (C) "ID"\n", nnz)) ;
/* rset and cset are now valid */
DEBUG (CHOLMOD(dump_subset) (rset, rsize, anrow, "rset", Common)) ;
DEBUG (CHOLMOD(dump_subset) (cset, csize, ancol, "cset", Common)) ;
/* ---------------------------------------------------------------------- */
/* allocate C */
/* ---------------------------------------------------------------------- */
C = CHOLMOD(allocate_sparse) (cnrow, cncol, nnz, csorted, TRUE, 0,
values ? A->xtype : CHOLMOD_PATTERN, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
for (i = 0 ; i < anrow ; i++)
{
Head [i] = EMPTY ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (NULL) ;
}
Cp = C->p ;
Ci = C->i ;
Cx = C->x ;
/* ---------------------------------------------------------------------- */
/* C = A (rset,cset) */
/* ---------------------------------------------------------------------- */
pdest = 0 ;
if (nnz == 0)
{
/* C has no nonzeros */
for (cj = 0 ; cj <= cncol ; cj++)
{
Cp [cj] = 0 ;
}
}
else if (nr < 0)
{
/* C = A (:,cset), where cset is not empty */
for (cj = 0 ; cj < cncol ; cj++)
{
/* construct column cj of C, which is column j of A */
PRINT1 (("construct cj = j = "ID"\n", cj)) ;
j = cset [cj] ;
Cp [cj] = pdest ;
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
Ci [pdest] = Ai [p] ;
if (values)
{
Cx [pdest] = Ax [p] ;
}
pdest++ ;
ASSERT (pdest <= nnz) ;
}
}
}
else
{
/* C = A (rset,cset), where rset is not empty but cset might be empty */
for (cj = 0 ; cj < cncol ; cj++)
{
/* construct column cj of C, which is column j of A */
PRINT1 (("construct cj = "ID"\n", cj)) ;
j = (nc < 0) ? cj : (cset [cj]) ;
PRINT1 (("cj = "ID"\n", j)) ;
Cp [cj] = pdest ;
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
/* row (Ai [p]) of A becomes multiple rows (ci) of C */
PRINT2 (("i: "ID" becomes: ", Ai [p])) ;
if (values)
{
aij = Ax [p] ;
}
for (ci = Head [Ai [p]] ; ci != EMPTY ; ci = Rnext [ci])
{
PRINT3 ((""ID" ", ci)) ;
Ci [pdest] = ci ;
if (values)
{
Cx [pdest] = aij ;
}
pdest++ ;
ASSERT (pdest <= nnz) ;
}
PRINT2 (("\n")) ;
}
}
}
Cp [cncol] = pdest ;
ASSERT (nnz == pdest) ;
/* ---------------------------------------------------------------------- */
/* clear workspace */
/* ---------------------------------------------------------------------- */
for (ci = 0 ; ci < nr ; ci++)
{
Head [rset [ci]] = EMPTY ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* sort C, if requested */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_sparse) (C , "C before sort", Common) >= 0) ;
if (sorted && !csorted)
{
/* 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, 0, Common)) ;
return (NULL) ;
}
}
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
ASSERT (CHOLMOD(dump_sparse) (C , "Final C", Common) >= 0) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (C) ;
}
int CHOLMOD(row_lsubtree)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to analyze */
Int *Fi, size_t fnz, /* nonzero pattern of kth row of A', not required
* for the symmetric case. Need not be sorted. */
size_t krow, /* row k of L */
cholmod_factor *L, /* the factor L from which parent(i) is derived */
/* ---- output --- */
cholmod_sparse *R, /* pattern of L(k,:), n-by-1 with R->nzmax >= n */
/* --------------- */
cholmod_common *Common
)
{
Int *Rp, *Stack, *Flag, *Ap, *Ai, *Anz, *Lp, *Li, *Lnz ;
Int p, pend, parent, t, stype, nrow, k, pf, packed, sorted, top, len, i,
mark, ka ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (R, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
nrow = A->nrow ;
stype = A->stype ;
if (stype < 0)
{
/* symmetric lower triangular form not supported */
ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ;
return (FALSE) ;
}
if (krow > nrow)
{
ERROR (CHOLMOD_INVALID, "lsubtree: krow invalid") ;
return (FALSE) ;
}
else if (krow == nrow)
{
/* find pattern of x=L\b where b=A(:,0) */
k = nrow ; /* compute all of the result; don't stop in SUBTREE */
ka = 0 ; /* use column A(:,0) */
if (stype != 0 || A->ncol != 1)
{
/* A must be unsymmetric (it's a single sparse column vector) */
ERROR (CHOLMOD_INVALID, "lsubtree: A invalid") ;
return (FALSE) ;
}
}
else
{
/* find pattern of L(k,:) using A(:,k) and Fi if A unsymmetric */
k = krow ; /* which row of L to compute */
ka = k ; /* which column of A to use */
if (stype == 0)
{
RETURN_IF_NULL (Fi, FALSE) ;
}
}
if (R->ncol != 1 || nrow != R->nrow || nrow > R->nzmax ||
((krow == nrow || stype != 0) && ka >= A->ncol))
{
ERROR (CHOLMOD_INVALID, "lsubtree: R invalid") ;
return (FALSE) ;
}
if (L->is_super)
{
ERROR (CHOLMOD_INVALID, "lsubtree: L invalid (cannot be supernodal)") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
CHOLMOD(allocate_work) (nrow, 0, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Ai = A->i ;
Anz = A->nz ;
packed = A->packed ;
sorted = A->sorted ;
Stack = R->i ;
Lp = L->p ;
Li = L->i ;
Lnz = L->nz ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Flag = Common->Flag ; /* size nrow, Flag [i] < mark must hold */
mark = CHOLMOD(clear_flag) (Common) ;
/* ---------------------------------------------------------------------- */
/* compute the pattern of L(k,:) */
/* ---------------------------------------------------------------------- */
top = nrow ; /* Stack is empty */
if (k < nrow)
{
Flag [k] = mark ; /* do not include diagonal entry in Stack */
}
#define SCATTER /* do not scatter numerical values */
#define PARENT(i) (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY
if (krow == nrow || stype != 0)
{
/* scatter kth col of triu (A), get pattern L(k,:) */
p = Ap [ka] ;
pend = (packed) ? (Ap [ka+1]) : (p + Anz [ka]) ;
SUBTREE ;
}
else
{
/* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */
for (pf = 0 ; pf < (Int) fnz ; pf++)
{
/* get nonzero entry F (t,k) */
t = Fi [pf] ;
p = Ap [t] ;
pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ;
SUBTREE ;
}
}
#undef SCATTER
#undef PARENT
/* shift the stack upwards, to the first part of R */
len = nrow - top ;
for (i = 0 ; i < len ; i++)
{
Stack [i] = Stack [top + i] ;
}
Rp = R->p ;
Rp [0] = 0 ;
Rp [1] = len ;
R->sorted = FALSE ;
CHOLMOD(clear_flag) (Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (TRUE) ;
}
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 SuiteSparse_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(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 + 4*nsuper */
w = CHOLMOD(mult_size_t) (n, 2, &ok) ;
t = CHOLMOD(mult_size_t) (nsuper, 4, &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(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 ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* 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 */
/* ---------------------------------------------------------------------- */
/* s = 2*nrow + (stype ? 0 : ncol) */
s = CHOLMOD(mult_size_t) (nrow, 2, &ok) ;
if (stype != 0)
{
s = CHOLMOD(add_size_t) (s, ncol, &ok) ;
}
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (nrow, s, 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*((size_t) 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) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
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) ; */
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(vertcat)
(
/* ---- input ---- */
cholmod_sparse *A, /* left matrix to concatenate */
cholmod_sparse *B, /* right matrix to concatenate */
int values, /* if TRUE compute the numerical values of C */
/* --------------- */
cholmod_common *Common
)
{
double *Ax, *Bx, *Cx ;
Int *Ap, *Ai, *Anz, *Bp, *Bi, *Bnz, *Cp, *Ci ;
cholmod_sparse *C, *A2, *B2 ;
Int apacked, bpacked, anrow, bnrow, ncol, nrow, anz, bnz, nz, j, p, pend,
pdest ;
/* ---------------------------------------------------------------------- */
/* 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->ncol)
{
/* A and B must have the same number of columns */
ERROR (CHOLMOD_INVALID, "A and B must have same # of columns") ;
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 */
/* ---------------------------------------------------------------------- */
anrow = A->nrow ;
bnrow = B->nrow ;
ncol = A->ncol ;
CHOLMOD(allocate_work) (0, MAX3 (anrow, bnrow, ncol), 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
/* convert A to unsymmetric, if necessary */
A2 = NULL ;
if (A->stype != 0)
{
/* workspace: Iwork (max (A->nrow,A->ncol)) */
A2 = CHOLMOD(copy) (A, 0, values, Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory */
return (NULL) ;
}
A = A2 ;
}
/* convert B to unsymmetric, if necessary */
B2 = NULL ;
if (B->stype != 0)
{
/* 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) ;
return (NULL) ;
}
B = B2 ;
}
Ap = A->p ;
Anz = A->nz ;
Ai = A->i ;
Ax = A->x ;
apacked = A->packed ;
Bp = B->p ;
Bnz = B->nz ;
Bi = B->i ;
Bx = B->x ;
bpacked = B->packed ;
/* ---------------------------------------------------------------------- */
/* allocate C */
/* ---------------------------------------------------------------------- */
anz = CHOLMOD(nnz) (A, Common) ;
bnz = CHOLMOD(nnz) (B, Common) ;
nrow = anrow + bnrow ;
nz = anz + bnz ;
C = CHOLMOD(allocate_sparse) (nrow, ncol, nz, A->sorted && B->sorted, 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) ;
return (NULL) ;
}
Cp = C->p ;
Ci = C->i ;
Cx = C->x ;
/* ---------------------------------------------------------------------- */
/* C = [A ; B] */
/* ---------------------------------------------------------------------- */
pdest = 0 ;
for (j = 0 ; j < ncol ; j++)
{
/* attach A(:,j) as the first part of C(:,j) */
p = Ap [j] ;
pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ;
Cp [j] = pdest ;
for ( ; p < pend ; p++)
{
Ci [pdest] = Ai [p] ;
if (values)
{
Cx [pdest] = Ax [p] ;
}
pdest++ ;
}
/* attach B(:,j) as the second part of C(:,j) */
p = Bp [j] ;
pend = (bpacked) ? (Bp [j+1]) : (p + Bnz [j]) ;
for ( ; p < pend ; p++)
{
Ci [pdest] = Bi [p] + anrow ;
if (values)
{
Cx [pdest] = Bx [p] ;
}
pdest++ ;
}
}
Cp [ncol] = pdest ;
ASSERT (pdest == nz) ;
/* ---------------------------------------------------------------------- */
/* free the unsymmetric copies of A and B, and return C */
/* ---------------------------------------------------------------------- */
CHOLMOD(free_sparse) (&A2, Common) ;
CHOLMOD(free_sparse) (&B2, Common) ;
return (C) ;
}
int CHOLMOD(super_lsolve) /* TRUE if OK, FALSE if BLAS overflow occured */
(
/* ---- input ---- */
cholmod_factor *L, /* factor to use for the forward solve */
/* ---- output ---- */
cholmod_dense *X, /* b on input, solution to Lx=b on output */
/* ---- workspace ---- */
cholmod_dense *E, /* workspace of size nrhs*(L->maxesize) */
/* --------------- */
cholmod_common *Common
)
{
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_NULL (X, FALSE) ;
RETURN_IF_NULL (E, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (E, CHOLMOD_REAL, CHOLMOD_COMPLEX, FALSE) ;
if (L->xtype != X->xtype)
{
ERROR (CHOLMOD_INVALID, "L and X must have the same xtype") ;
return (FALSE) ;
}
if (L->xtype != E->xtype)
{
ERROR (CHOLMOD_INVALID, "L and E must have the same xtype") ;
return (FALSE) ;
}
if (X->d < X->nrow || L->n != X->nrow)
{
ERROR (CHOLMOD_INVALID, "X and L dimensions must match") ;
return (FALSE) ;
}
if (E->nzmax < X->ncol * (L->maxesize))
{
ERROR (CHOLMOD_INVALID, "workspace E not large enough") ;
return (FALSE) ;
}
if (!(L->is_ll) || !(L->is_super))
{
ERROR (CHOLMOD_INVALID, "L not supernodal") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
ASSERT (IMPLIES (L->n == 0, L->nsuper == 0)) ;
if (L->n == 0 || X->ncol == 0)
{
/* nothing to do */
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* solve Lx=b using template routine */
/* ---------------------------------------------------------------------- */
switch (L->xtype)
{
case CHOLMOD_REAL:
r_cholmod_super_lsolve (L, X, E, Common) ;
break ;
case CHOLMOD_COMPLEX:
c_cholmod_super_lsolve (L, X, E, Common) ;
break ;
}
if (CHECK_BLAS_INT && !Common->blas_ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large for the BLAS") ;
}
return (Common->blas_ok) ;
}
int CHOLMOD(etree)
(
/* ---- input ---- */
cholmod_sparse *A,
/* ---- output --- */
Int *Parent, /* size ncol. Parent [j] = p if p is the parent of j */
/* --------------- */
cholmod_common *Common
)
{
Int *Ap, *Ai, *Anz, *Ancestor, *Prev, *Iwork ;
Int i, j, jprev, p, pend, nrow, ncol, packed, stype ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (Parent, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
stype = A->stype ;
/* s = A->nrow + (stype ? 0 : A->ncol) */
s = CHOLMOD(add_size_t) (A->nrow, (stype ? 0 : A->ncol), &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (0, s, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ; /* out of memory */
}
ASSERT (CHOLMOD(dump_sparse) (A, "etree", Common) >= 0) ;
Iwork = Common->Iwork ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
ncol = A->ncol ; /* the number of columns of A */
nrow = A->nrow ; /* the number of rows of A */
Ap = A->p ; /* size ncol+1, column pointers for A */
Ai = A->i ; /* the row indices of A */
Anz = A->nz ; /* number of nonzeros in each column of A */
packed = A->packed ;
Ancestor = Iwork ; /* size ncol (i/i/l) */
for (j = 0 ; j < ncol ; j++)
{
Parent [j] = EMPTY ;
Ancestor [j] = EMPTY ;
}
/* ---------------------------------------------------------------------- */
/* compute the etree */
/* ---------------------------------------------------------------------- */
if (stype > 0)
{
/* ------------------------------------------------------------------ */
/* symmetric (upper) case: compute etree (A) */
/* ------------------------------------------------------------------ */
for (j = 0 ; j < ncol ; j++)
{
/* for each row i in column j of triu(A), excluding the diagonal */
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
i = Ai [p] ;
if (i < j)
{
update_etree (i, j, Parent, Ancestor) ;
}
}
}
}
else if (stype == 0)
{
/* ------------------------------------------------------------------ */
/* unsymmetric case: compute etree (A'*A) */
/* ------------------------------------------------------------------ */
Prev = Iwork + ncol ; /* size nrow (i/i/l) */
for (i = 0 ; i < nrow ; i++)
{
Prev [i] = EMPTY ;
}
for (j = 0 ; j < ncol ; j++)
{
/* for each row i in column j of A */
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
for ( ; p < pend ; p++)
{
/* a graph is constructed dynamically with one path per row
* of A. If the ith row of A contains column indices
* (j1,j2,j3,j4) then the new graph has edges (j1,j2), (j2,j3),
* and (j3,j4). When at node i of this path-graph, all edges
* (jprev,j) are considered, where jprev<j */
i = Ai [p] ;
jprev = Prev [i] ;
if (jprev != EMPTY)
{
update_etree (jprev, j, Parent, Ancestor) ;
}
Prev [i] = j ;
}
}
}
else
{
/* ------------------------------------------------------------------ */
/* symmetric case with lower triangular part not supported */
/* ------------------------------------------------------------------ */
ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ;
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_parent) (Parent, ncol, "Parent", Common)) ;
return (TRUE) ;
}
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. */
camd_malloc = Common->malloc_memory ;
camd_free = Common->free_memory ;
camd_calloc = Common->calloc_memory ;
camd_realloc = Common->realloc_memory ;
/* CAMD_2 doesn't print anything either, but future versions might,
* so set the camd_printf pointer too. */
camd_printf = Common->print_function ;
#ifdef LONG
/* DEBUG (camd_l_debug_init ("cholmod_l_camd")) ; */
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")) ; */
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(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 stype, nrow, ncol ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* 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 ;
/* s = 2*nrow + (stype ? 0 : ncol) */
s = CHOLMOD(mult_size_t) (nrow, 2, &ok) ;
s = CHOLMOD(add_size_t) (s, (stype ? 0 : ncol), &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (nrow, s, 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(drop)
(
/* ---- input ---- */
double tol, /* keep entries with absolute value > tol */
/* ---- in/out --- */
cholmod_sparse *A, /* matrix to drop entries from */
/* --------------- */
cholmod_common *Common
)
{
double aij ;
double *Ax ;
Int *Ap, *Ai, *Anz ;
Int packed, i, j, nrow, ncol, p, pend, nz, values ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
Common->status = CHOLMOD_OK ;
ASSERT (CHOLMOD(dump_sparse) (A, "A predrop", Common) >= 0) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
Ap = A->p ;
Ai = A->i ;
Ax = A->x ;
Anz = A->nz ;
packed = A->packed ;
ncol = A->ncol ;
nrow = A->nrow ;
values = (A->xtype != CHOLMOD_PATTERN) ;
nz = 0 ;
if (values)
{
/* ------------------------------------------------------------------ */
/* drop small numerical entries from A, and entries in ignored part */
/* ------------------------------------------------------------------ */
if (A->stype > 0)
{
/* -------------------------------------------------------------- */
/* A is symmetric, with just upper triangular part stored */
/* -------------------------------------------------------------- */
for (j = 0 ; j < ncol ; j++)
{
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
Ap [j] = nz ;
for ( ; p < pend ; p++)
{
i = Ai [p] ;
aij = Ax [p] ;
if (i <= j && (fabs (aij) > tol || IS_NAN (aij)))
{
Ai [nz] = i ;
Ax [nz] = aij ;
nz++ ;
}
}
}
}
else if (A->stype < 0)
{
/* -------------------------------------------------------------- */
/* A is symmetric, with just lower triangular part stored */
/* -------------------------------------------------------------- */
for (j = 0 ; j < ncol ; j++)
{
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
Ap [j] = nz ;
for ( ; p < pend ; p++)
{
i = Ai [p] ;
aij = Ax [p] ;
if (i >= j && (fabs (aij) > tol || IS_NAN (aij)))
{
Ai [nz] = i ;
Ax [nz] = aij ;
nz++ ;
}
}
}
}
else
{
/* -------------------------------------------------------------- */
/* both parts of A present, just drop small entries */
/* -------------------------------------------------------------- */
for (j = 0 ; j < ncol ; j++)
{
p = Ap [j] ;
pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
Ap [j] = nz ;
for ( ; p < pend ; p++)
{
i = Ai [p] ;
aij = Ax [p] ;
if (fabs (aij) > tol || IS_NAN (aij))
{
Ai [nz] = i ;
Ax [nz] = aij ;
nz++ ;
}
}
}
}
Ap [ncol] = nz ;
/* reduce A->i and A->x in size */
ASSERT (MAX (1,nz) <= A->nzmax) ;
CHOLMOD(reallocate_sparse) (nz, A, Common) ;
ASSERT (Common->status >= CHOLMOD_OK) ;
}
else
{
/* ------------------------------------------------------------------ */
/* consider only the pattern of A */
/* ------------------------------------------------------------------ */
/* Note that cholmod_band_inplace calls cholmod_reallocate_sparse */
if (A->stype > 0)
{
CHOLMOD(band_inplace) (0, ncol, 0, A, Common) ;
}
else if (A->stype < 0)
{
CHOLMOD(band_inplace) (-nrow, 0, 0, A, Common) ;
}
}
ASSERT (CHOLMOD(dump_sparse) (A, "A dropped", Common) >= 0) ;
return (TRUE) ;
}
SuiteSparse_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(rowfac)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to factorize */
cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */
double beta [2], /* factorize beta*I+A or beta*I+AA' */
size_t kstart, /* first row to factorize */
size_t kend, /* last row to factorize is kend-1 */
/* ---- in/out --- */
cholmod_factor *L,
/* --------------- */
cholmod_common *Common
)
{
Int n, ok = FALSE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
if (L->xtype != CHOLMOD_PATTERN && A->xtype != L->xtype)
{
ERROR (CHOLMOD_INVALID, "xtype of A and L do not match") ;
return (FALSE) ;
}
if (L->is_super)
{
ERROR (CHOLMOD_INVALID, "can only do simplicial factorization");
return (FALSE) ;
}
if (A->stype == 0)
{
RETURN_IF_NULL (F, FALSE) ;
if (A->xtype != F->xtype)
{
ERROR (CHOLMOD_INVALID, "xtype of A and F do not match") ;
return (FALSE) ;
}
}
if (A->stype < 0)
{
/* symmetric lower triangular form not supported */
ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ;
return (FALSE) ;
}
if (kend > L->n)
{
ERROR (CHOLMOD_INVALID, "kend invalid") ;
return (FALSE) ;
}
if (A->nrow != L->n)
{
ERROR (CHOLMOD_INVALID, "dimensions of A and L do not match") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* Xwork is of size n for the real case, 2*n for complex/zomplex */
n = L->n ;
CHOLMOD(allocate_work) (n, n, ((A->xtype != CHOLMOD_REAL) ? 2:1)*n, Common);
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, A->nrow, Common)) ;
/* ---------------------------------------------------------------------- */
/* factorize the matrix, using template routine */
/* ---------------------------------------------------------------------- */
switch (A->xtype)
{
case CHOLMOD_REAL:
ok = r_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ;
break ;
case CHOLMOD_COMPLEX:
ok = c_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
ok = z_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ;
break ;
}
return (ok) ;
}
int CHOLMOD(row_subtree)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to analyze */
cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */
size_t krow, /* row k of L */
Int *Parent, /* elimination tree */
/* ---- output --- */
cholmod_sparse *R, /* pattern of L(k,:), 1-by-n with R->nzmax >= n */
/* --------------- */
cholmod_common *Common
)
{
Int *Rp, *Stack, *Flag, *Ap, *Ai, *Anz, *Fp, *Fi, *Fnz ;
Int p, pend, parent, t, stype, nrow, k, pf, pfend, Fpacked, packed,
sorted, top, len, i, mark ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (R, FALSE) ;
RETURN_IF_NULL (Parent, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
stype = A->stype ;
if (stype == 0)
{
RETURN_IF_NULL (F, FALSE) ;
RETURN_IF_XTYPE_INVALID (F, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
}
if (krow >= A->nrow)
{
ERROR (CHOLMOD_INVALID, "subtree: k invalid") ;
return (FALSE) ;
}
if (R->ncol != 1 || A->nrow != R->nrow || A->nrow > R->nzmax)
{
ERROR (CHOLMOD_INVALID, "subtree: R invalid") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
nrow = A->nrow ;
CHOLMOD(allocate_work) (nrow, 0, 0, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (stype > 0)
{
/* symmetric upper case: F is not needed. It may be NULL */
Fp = NULL ;
Fi = NULL ;
Fnz = NULL ;
Fpacked = TRUE ;
}
else if (stype == 0)
{
/* unsymmetric case: F is required. */
Fp = F->p ;
Fi = F->i ;
Fnz = F->nz ;
Fpacked = F->packed ;
}
else
{
/* symmetric lower triangular form not supported */
ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ;
return (FALSE) ;
}
Ap = A->p ;
Ai = A->i ;
Anz = A->nz ;
packed = A->packed ;
sorted = A->sorted ;
k = krow ;
Stack = R->i ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Flag = Common->Flag ; /* size nrow, Flag [i] < mark must hold */
/* mark = CHOLMOD(clear_flag) (Common) ; */
CHOLMOD_CLEAR_FLAG (Common) ;
mark = Common->mark ;
/* ---------------------------------------------------------------------- */
/* compute the pattern of L(k,:) */
/* ---------------------------------------------------------------------- */
top = nrow ; /* Stack is empty */
Flag [k] = mark ; /* do not include diagonal entry in Stack */
#define SCATTER /* do not scatter numerical values */
#define PARENT(i) Parent [i] /* use Parent for etree */
if (stype != 0)
{
/* scatter kth col of triu (A), get pattern L(k,:) */
p = Ap [k] ;
pend = (packed) ? (Ap [k+1]) : (p + Anz [k]) ;
SUBTREE ;
}
else
{
/* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */
pf = Fp [k] ;
pfend = (Fpacked) ? (Fp [k+1]) : (pf + Fnz [k]) ;
for ( ; pf < pfend ; pf++)
{
/* get nonzero entry F (t,k) */
t = Fi [pf] ;
p = Ap [t] ;
pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ;
SUBTREE ;
}
}
#undef SCATTER
#undef PARENT
/* shift the stack upwards, to the first part of R */
len = nrow - top ;
for (i = 0 ; i < len ; i++)
{
Stack [i] = Stack [top + i] ;
}
Rp = R->p ;
Rp [0] = 0 ;
Rp [1] = len ;
R->sorted = FALSE ;
CHOLMOD(clear_flag) (Common) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
return (TRUE) ;
}
double CHOLMOD(norm_dense)
(
/* ---- input ---- */
cholmod_dense *X, /* matrix to compute the norm of */
int norm, /* type of norm: 0: inf. norm, 1: 1-norm, 2: 2-norm */
/* --------------- */
cholmod_common *Common
)
{
double xnorm, s, x, z ;
double *Xx, *Xz, *W ;
Int nrow, ncol, d, i, j, use_workspace, xtype ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (EMPTY) ;
RETURN_IF_NULL (X, EMPTY) ;
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, EMPTY) ;
Common->status = CHOLMOD_OK ;
ncol = X->ncol ;
if (norm < 0 || norm > 2 || (norm == 2 && ncol > 1))
{
ERROR (CHOLMOD_INVALID, "invalid norm") ;
return (EMPTY) ;
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
nrow = X->nrow ;
d = X->d ;
Xx = X->x ;
Xz = X->z ;
xtype = X->xtype ;
/* ---------------------------------------------------------------------- */
/* allocate workspace, if needed */
/* ---------------------------------------------------------------------- */
W = NULL ;
use_workspace = (norm == 0 && ncol > 4) ;
if (use_workspace)
{
CHOLMOD(allocate_work) (0, 0, nrow, Common) ;
W = Common->Xwork ;
if (Common->status < CHOLMOD_OK)
{
/* oops, no workspace */
use_workspace = FALSE ;
}
}
/* ---------------------------------------------------------------------- */
/* compute the norm */
/* ---------------------------------------------------------------------- */
xnorm = 0 ;
if (use_workspace)
{
/* ------------------------------------------------------------------ */
/* infinity-norm = max row sum, using stride-1 access of X */
/* ------------------------------------------------------------------ */
DEBUG (for (i = 0 ; i < nrow ; i++) ASSERT (W [i] == 0)) ;
/* this is faster than stride-d, but requires O(nrow) workspace */
for (j = 0 ; j < ncol ; j++)
{
for (i = 0 ; i < nrow ; i++)
{
W [i] += abs_value (xtype, Xx, Xz, i+j*d, Common) ;
}
}
for (i = 0 ; i < nrow ; i++)
{
s = W [i] ;
if ((IS_NAN (s) || s > xnorm) && !IS_NAN (xnorm))
{
xnorm = s ;
}
W [i] = 0 ;
}
}
else if (norm == 0)
int CHOLMOD(rowfac_mask2)
(
/* ---- input ---- */
cholmod_sparse *A, /* matrix to factorize */
cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */
double beta [2], /* factorize beta*I+A or beta*I+AA' */
size_t kstart, /* first row to factorize */
size_t kend, /* last row to factorize is kend-1 */
Int *mask, /* size A->nrow. if mask[i] >= maskmark row i is set
to zero */
Int maskmark, /* for mask [i] test */
Int *RLinkUp, /* size A->nrow. link list of rows to compute */
/* ---- in/out --- */
cholmod_factor *L,
/* --------------- */
cholmod_common *Common
)
{
Int n ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (A, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
if (L->xtype != CHOLMOD_PATTERN && A->xtype != L->xtype)
{
ERROR (CHOLMOD_INVALID, "xtype of A and L do not match") ;
return (FALSE) ;
}
if (L->is_super)
{
ERROR (CHOLMOD_INVALID, "can only do simplicial factorization");
return (FALSE) ;
}
if (A->stype == 0)
{
RETURN_IF_NULL (F, FALSE) ;
if (A->xtype != F->xtype)
{
ERROR (CHOLMOD_INVALID, "xtype of A and F do not match") ;
return (FALSE) ;
}
}
if (A->stype < 0)
{
/* symmetric lower triangular form not supported */
ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ;
return (FALSE) ;
}
if (kend > L->n)
{
ERROR (CHOLMOD_INVALID, "kend invalid") ;
return (FALSE) ;
}
if (A->nrow != L->n)
{
ERROR (CHOLMOD_INVALID, "dimensions of A and L do not match") ;
return (FALSE) ;
}
Common->status = CHOLMOD_OK ;
Common->rowfacfl = 0 ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* Xwork is of size n for the real case, 2*n for complex/zomplex */
n = L->n ;
/* s = ((A->xtype != CHOLMOD_REAL) ? 2:1)*n */
s = CHOLMOD(mult_size_t) (n, ((A->xtype != CHOLMOD_REAL) ? 2:1), &ok) ;
if (!ok)
{
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
return (FALSE) ;
}
CHOLMOD(allocate_work) (n, n, s, Common) ;
if (Common->status < CHOLMOD_OK)
{
return (FALSE) ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, A->nrow, Common)) ;
/* ---------------------------------------------------------------------- */
/* factorize the matrix, using template routine */
/* ---------------------------------------------------------------------- */
if (RLinkUp == NULL)
{
switch (A->xtype)
{
case CHOLMOD_REAL:
ok = r_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ;
break ;
case CHOLMOD_COMPLEX:
ok = c_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
ok = z_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ;
break ;
}
}
else
{
switch (A->xtype)
{
case CHOLMOD_REAL:
ok = r_cholmod_rowfac_mask (A, F, beta, kstart, kend,
mask, maskmark, RLinkUp, L, Common) ;
break ;
case CHOLMOD_COMPLEX:
ok = c_cholmod_rowfac_mask (A, F, beta, kstart, kend,
mask, maskmark, RLinkUp, L, Common) ;
break ;
case CHOLMOD_ZOMPLEX:
ok = z_cholmod_rowfac_mask (A, F, beta, kstart, kend,
mask, maskmark, RLinkUp, L, Common) ;
break ;
}
}
return (ok) ;
}
int CHOLMOD(super_symbolic)
(
/* ---- input ---- */
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 ;
size_t w ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* 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) ;
ASSERT (CHOLMOD(dump_sparse) (F, "Fsup", Common) >= 0) ;
}
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 ;
ASSERT (CHOLMOD(dump_sparse) (A, "Asup", Common) >= 0) ;
/* ---------------------------------------------------------------------- */
/* 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)) ;
/* ---------------------------------------------------------------------- */
/* 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 */
{
/* 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--)
{
/* 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 */
/* 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 lnz1 = Snz [s+1] ; /* # entries in leading column of s+1 */
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)) ;
}
}
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 ;
for (s = 0 ; s < nsuper ; s++)
{
nscol = Super [s+1] - Super [s] ;
nsrow = Snz [s] ;
ASSERT (nscol > 0) ;
ssize += nsrow ;
xsize += nscol * nsrow ;
/* also compute xsize in double to guard against Int overflow */
xxsize += ((double) nscol) * ((double) nsrow) ;
if (xxsize > Int_max)
{
/* Int overflow, clear workspace and return */
ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
FREE_WORKSPACE ;
return (FALSE) ;
}
ASSERT (ssize > 0 && 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) */
/* ---------------------------------------------------------------------- */
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)) ;
/* 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] ;
}
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) ;
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,
Flag, Ls, Lpi2) ;
}
else
{
/* for each 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,
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 if xsize is OK */
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) ;
}
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 = A->nzmax + B->nzmax ;
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) ;
/* 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(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 ;
size_t s ;
int ok = TRUE ;
/* ---------------------------------------------------------------------- */
/* 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 (kdel >= L->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 */
/* ---------------------------------------------------------------------- */
/* 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, 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) ;
}
