Exemple #1
0
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,:), 1-by-n 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 ;

    /* ---------------------------------------------------------------------- */
    /* 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) ;
    stype = A->stype ;
    if (stype == 0)
    {
	RETURN_IF_NULL (Fi, FALSE) ;
    }
    if (krow >= A->nrow)
    {
	ERROR (CHOLMOD_INVALID, "lsubtree: k invalid") ;
	return (FALSE) ;
    }
    if (R->ncol != 1 || A->nrow != R->nrow || A->nrow > R->nzmax)
    {
	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 */
    /* ---------------------------------------------------------------------- */

    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 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 ;

    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 */
    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 (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,:) */
	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) ;
}
Exemple #2
0
int CHOLMOD(colamd)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to order */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    int postorder,	/* if TRUE, follow with a coletree postorder */
    /* ---- output --- */
    Int *Perm,		/* size A->nrow, output permutation */
    /* --------------- */
    cholmod_common *Common
)
{
    double knobs [COLAMD_KNOBS] ;
    cholmod_sparse *C ;
    Int *NewPerm, *Parent, *Post, *Work2n ;
    Int k, nrow, ncol ;
    size_t s, alen ;
    int ok = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;
    RETURN_IF_NULL (Perm, FALSE) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    if (A->stype != 0)
    {
	ERROR (CHOLMOD_INVALID, "matrix must be unsymmetric") ;
	return (FALSE) ;
    }
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    nrow = A->nrow ;
    ncol = A->ncol ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    /* Note: this is less than the space used in cholmod_analyze, so if
     * cholmod_colamd is being called by that routine, no space will be
     * allocated.
     */

    /* s = 4*nrow + ncol */
    s = CHOLMOD(mult_size_t) (nrow, 4, &ok) ;
    s = CHOLMOD(add_size_t) (s, ncol, &ok) ;

#ifdef LONG
    alen = colamd_l_recommended (A->nzmax, ncol, nrow) ;
    colamd_l_set_defaults (knobs) ;
#else
    alen = colamd_recommended (A->nzmax, ncol, nrow) ;
    colamd_set_defaults (knobs) ;
#endif

    if (!ok || alen == 0)
    {
	ERROR (CHOLMOD_TOO_LARGE, "matrix invalid or too large") ;
	return (FALSE) ;
    }

    CHOLMOD(allocate_work) (0, s, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* allocate COLAMD workspace */
    /* ---------------------------------------------------------------------- */

    /* colamd_printf is only available in colamd v2.4 or later */
    colamd_printf = Common->print_function ;

    C = CHOLMOD(allocate_sparse) (ncol, nrow, alen, TRUE, TRUE, 0,
	    CHOLMOD_PATTERN, Common) ;

    /* ---------------------------------------------------------------------- */
    /* copy (and transpose) the input matrix A into the colamd workspace */
    /* ---------------------------------------------------------------------- */

    /* C = A (:,f)', which also packs A if needed. */
    /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset) */
    ok = CHOLMOD(transpose_unsym) (A, 0, NULL, fset, fsize, C, Common) ;

    /* ---------------------------------------------------------------------- */
    /* order the matrix (destroys the contents of C->i and C->p) */
    /* ---------------------------------------------------------------------- */

    /* get parameters */
    if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS)
    {
	/* this is the CHOLMOD default, not the COLAMD default */
	knobs [COLAMD_DENSE_ROW] = -1 ;
    }
    else
    {
	/* get the knobs from the Common parameters */
	knobs [COLAMD_DENSE_COL] = Common->method[Common->current].prune_dense ;
	knobs [COLAMD_DENSE_ROW] = Common->method[Common->current].prune_dense2;
	knobs [COLAMD_AGGRESSIVE] = Common->method[Common->current].aggressive ;
    }

    if (ok)
    {
	Int *Cp ;
	Int stats [COLAMD_STATS] ;
	Cp = C->p ;

#ifdef LONG
	colamd_l (ncol, nrow, alen, C->i, Cp, knobs, stats) ;
#else
	colamd (ncol, nrow, alen, C->i, Cp, knobs, stats) ;
#endif

	ok = stats [COLAMD_STATUS] ;
	ok = (ok == COLAMD_OK || ok == COLAMD_OK_BUT_JUMBLED) ;
	/* permutation returned in C->p, if the ordering succeeded */
	for (k = 0 ; k < nrow ; k++)
	{
	    Perm [k] = Cp [k] ;
	}
    }

    CHOLMOD(free_sparse) (&C, Common) ;

    /* ---------------------------------------------------------------------- */
    /* column etree postordering */
    /* ---------------------------------------------------------------------- */

    if (postorder)
    {
	/* use the last 2*n space in Iwork for Parent and Post */
	Work2n = Common->Iwork ;
	Work2n += 2*((size_t) nrow) + ncol ;
	Parent = Work2n ;		/* size nrow (i/i/l) */
	Post   = Work2n + nrow ;	/* size nrow (i/i/l) */

	/* workspace: Iwork (2*nrow+ncol), Flag (nrow), Head (nrow+1) */
	ok = ok && CHOLMOD(analyze_ordering) (A, CHOLMOD_COLAMD, Perm, fset,
		fsize, Parent, Post, NULL, NULL, NULL, Common) ;

	/* combine the colamd permutation with its postordering */
	if (ok)
	{
	    NewPerm = Common->Iwork ;		/* size nrow (i/i/l) */
	    for (k = 0 ; k < nrow ; k++)
	    {
		NewPerm [k] = Perm [Post [k]] ;
	    }
	    for (k = 0 ; k < nrow ; k++)
	    {
		Perm [k] = NewPerm [k] ;
	    }
	}
    }

    return (ok) ;
}
Exemple #3
0
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(metis)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to order */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    int postorder,	/* if TRUE, follow with etree or coletree postorder */
    /* ---- output --- */
    Int *Perm,		/* size A->nrow, output permutation */
    /* --------------- */
    cholmod_common *Common
)
{
    double d ;
    Int *Iperm, *Iwork, *Bp, *Bi ;
    idxtype *Mp, *Mi, *Mperm, *Miperm ;
    cholmod_sparse *B ;
    Int i, j, n, nz, p, identity, uncol ;
    int Opt [8], nn, zero = 0 ;
    size_t n1, s ;
    int ok = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;
    RETURN_IF_NULL (Perm, FALSE) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* quick return */
    /* ---------------------------------------------------------------------- */

    n = A->nrow ;
    if (n == 0)
    {
	return (TRUE) ;
    }
    n1 = ((size_t) n) + 1 ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    /* s = 4*n + uncol */
    uncol = (A->stype == 0) ? A->ncol : 0 ;
    s = CHOLMOD(mult_size_t) (n, 4, &ok) ;
    s = CHOLMOD(add_size_t) (s, uncol, &ok) ;
    if (!ok)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	return (FALSE) ;
    }

    CHOLMOD(allocate_work) (n, s, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* convert the matrix to adjacency list form */
    /* ---------------------------------------------------------------------- */

    /* The input graph for METIS must be symmetric, with both upper and lower
     * parts present, and with no diagonal entries.  The columns need not be
     * sorted.
     * B = A+A', A*A', or A(:,f)*A(:,f)', upper and lower parts present */
    if (A->stype)
    {
	/* Add the upper/lower part to a symmetric lower/upper matrix by
	 * converting to unsymmetric mode */
	/* workspace: Iwork (nrow) */
	B = CHOLMOD(copy) (A, 0, -1, Common) ;
    }
    else
    {
	/* B = A*A' or A(:,f)*A(:,f)', no diagonal */
	/* workspace: Flag (nrow), Iwork (max (nrow,ncol)) */
	B = CHOLMOD(aat) (A, fset, fsize, -1, Common) ;
    }
    ASSERT (CHOLMOD(dump_sparse) (B, "B for NodeND", Common) >= 0) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }
    ASSERT (B->nrow == A->nrow) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    Iwork = Common->Iwork ;
    Iperm = Iwork ;		/* size n (i/i/l) */

    Bp = B->p ;
    Bi = B->i ;
    nz = Bp [n] ;

    /* ---------------------------------------------------------------------- */
    /* METIS does not have a UF_long integer version */
    /* ---------------------------------------------------------------------- */

#ifdef LONG
    if (sizeof (Int) > sizeof (idxtype) && MAX (n,nz) > INT_MAX / sizeof (int))
    {
	/* CHOLMOD's matrix is too large for METIS */
	CHOLMOD(free_sparse) (&B, Common) ;
	return (FALSE) ;
    }
#endif

    /* B does not include the diagonal, and both upper and lower parts.
     * Common->anz includes the diagonal, and just the lower part of B */
    Common->anz = nz / 2 + n ;

    /* ---------------------------------------------------------------------- */
    /* set control parameters for METIS_NodeND */
    /* ---------------------------------------------------------------------- */

    Opt [0] = 0 ;	/* use defaults */
    Opt [1] = 3 ;	/* matching type */
    Opt [2] = 1 ;	/* init. partitioning algo*/
    Opt [3] = 2 ;	/* refinement algorithm */
    Opt [4] = 0 ;	/* no debug */
    Opt [5] = 1 ;	/* initial compression */
    Opt [6] = 0 ;	/* no dense node removal */
    Opt [7] = 1 ;	/* number of separators @ each step */

    /* ---------------------------------------------------------------------- */
    /* allocate the METIS input arrays, if needed */
    /* ---------------------------------------------------------------------- */

    if (sizeof (Int) == sizeof (idxtype))
    {
	/* This is the typical case. */
	Miperm = (idxtype *) Iperm ;
	Mperm  = (idxtype *) Perm ;
	Mp     = (idxtype *) Bp ;
	Mi     = (idxtype *) Bi ;
    }
    else
    {
	/* allocate graph for METIS only if Int and idxtype differ */
	Miperm = CHOLMOD(malloc) (n,  sizeof (idxtype), Common) ;
	Mperm  = CHOLMOD(malloc) (n,  sizeof (idxtype), Common) ;
	Mp     = CHOLMOD(malloc) (n1, sizeof (idxtype), Common) ;
	Mi     = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    /* out of memory */
	    CHOLMOD(free_sparse) (&B, Common) ;
	    CHOLMOD(free) (n,  sizeof (idxtype), Miperm, Common) ;
	    CHOLMOD(free) (n,  sizeof (idxtype), Mperm, Common) ;
	    CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ;
	    CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ;
	    return (FALSE) ;
	}
	for (j = 0 ; j <= n ; j++)
	{
	    Mp [j] = Bp [j] ;
	}
	for (p = 0 ; p < nz ; p++)
	{
	    Mi [p] = Bi [p] ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* METIS workarounds */
    /* ---------------------------------------------------------------------- */

    identity = FALSE ;
    if (nz == 0)
    {
	/* The matrix has no off-diagonal entries.  METIS_NodeND fails in this
	 * case, so avoid using it.  The best permutation is identity anyway,
	 * so this is an easy fix. */
	identity = TRUE ;
	PRINT1 (("METIS:: no nz\n")) ;
    }
    else if (Common->metis_nswitch > 0)
    {
	/* METIS_NodeND in METIS 4.0.1 gives a seg fault with one matrix of
	 * order n = 3005 and nz = 6,036,025, including the diagonal entries.
	 * The workaround is to return the identity permutation instead of using
	 * METIS for matrices of dimension 3000 or more and with density of 66%
	 * or more - admittedly an uncertain fix, but such matrices are so dense
	 * that any reasonable ordering will do, even identity (n^2 is only 50%
	 * higher than nz in this case).  CHOLMOD's nested dissection method
	 * (cholmod_nested_dissection) has no problems with the same matrix,
	 * even though it too uses METIS_NodeComputeSeparator.  The matrix is
	 * derived from LPnetlib/lpi_cplex1 in the UF sparse matrix collection.
	 * If C is the lpi_cplex matrix (of order 3005-by-5224), A = (C*C')^2
	 * results in the seg fault.  The seg fault also occurs in the stand-
	 * alone onmetis program that comes with METIS.  If a future version of
	 * METIS fixes this problem, then set Common->metis_nswitch to zero.
	 */
	d = ((double) nz) / (((double) n) * ((double) n)) ;
	if (n > (Int) (Common->metis_nswitch) && d > Common->metis_dswitch)
	{
	    identity = TRUE ;
	    PRINT1 (("METIS:: nswitch/dswitch activated\n")) ;
	}
    }

    if (!identity && !metis_memory_ok (n, nz, Common))
    {
	/* METIS might ask for too much memory and thus terminate the program */
	identity = TRUE ;
    }

    /* ---------------------------------------------------------------------- */
    /* find the permutation */
    /* ---------------------------------------------------------------------- */

    if (identity)
    {
	/* no need to do the postorder */
	postorder = FALSE ;
	for (i = 0 ; i < n ; i++)
	{
	    Mperm [i] = i ;
	}
    }
    else
    {
#ifdef DUMP_GRAPH
	/* DUMP_GRAPH */ printf ("Calling METIS_NodeND n "ID" nz "ID""
	"density %g\n", n, nz, ((double) nz) / (((double) n) * ((double) n)));
	dumpgraph (Mp, Mi, n, Common) ;
#endif

	nn = n ;
	METIS_NodeND (&nn, Mp, Mi, &zero, Opt, Mperm, Miperm) ;
	n = nn ;

	PRINT0 (("METIS_NodeND done\n")) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free the METIS input arrays */
    /* ---------------------------------------------------------------------- */

    if (sizeof (Int) != sizeof (idxtype))
    {
	for (i = 0 ; i < n ; i++)
	{
	    Perm [i] = (Int) (Mperm [i]) ;
	}
	CHOLMOD(free) (n,   sizeof (idxtype), Miperm, Common) ;
	CHOLMOD(free) (n,   sizeof (idxtype), Mperm, Common) ;
	CHOLMOD(free) (n+1, sizeof (idxtype), Mp, Common) ;
	CHOLMOD(free) (nz,  sizeof (idxtype), Mi, Common) ;
    }

    CHOLMOD(free_sparse) (&B, Common) ;

    /* ---------------------------------------------------------------------- */
    /* etree or column-etree postordering, using the Cholesky Module */
    /* ---------------------------------------------------------------------- */

    if (postorder)
    {
	Int *Parent, *Post, *NewPerm ;
	Int k ;

	Parent = Iwork + 2*((size_t) n) + uncol ;   /* size n = nrow */
	Post   = Parent + n ;			    /* size n */

	/* workspace: Iwork (2*nrow+uncol), Flag (nrow), Head (nrow+1) */
	CHOLMOD(analyze_ordering) (A, CHOLMOD_METIS, Perm, fset, fsize,
		Parent, Post, NULL, NULL, NULL, Common) ;
	if (Common->status == CHOLMOD_OK)
	{
	    /* combine the METIS permutation with its postordering */
	    NewPerm = Parent ;	    /* use Parent as workspace */
	    for (k = 0 ; k < n ; k++)
	    {
		NewPerm [k] = Perm [Post [k]] ;
	    }
	    for (k = 0 ; k < n ; k++)
	    {
		Perm [k] = NewPerm [k] ;
	    }
	}
    }

    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
    PRINT1 (("cholmod_metis done\n")) ;
    return (Common->status == CHOLMOD_OK) ;
}
int CHOLMOD(camd)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to order */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    Int *Cmember,	/* size nrow.  see cholmod_ccolamd.c for description.*/
    /* ---- output ---- */
    Int *Perm,		/* size A->nrow, output permutation */
    /* --------------- */
    cholmod_common *Common
)
{
    double Info [CAMD_INFO], Control2 [CAMD_CONTROL], *Control ;
    Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Next, *BucketSet,
	*Work3n, *p ;
    cholmod_sparse *C ;
    Int j, n, cnz ;
    size_t s ;
    int ok = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;
    n = A->nrow ;

    /* s = 4*n */
    s = CHOLMOD(mult_size_t) (n, 4, &ok) ;
    if (!ok)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	return (FALSE) ;
    }

    RETURN_IF_NULL (Perm, FALSE) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    Common->status = CHOLMOD_OK ;
    if (n == 0)
    {
	/* nothing to do */
	Common->fl = 0 ;
	Common->lnz = 0 ;
	Common->anz = 0 ;
	return (TRUE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    /* cholmod_analyze has allocated Cmember at Common->Iwork + 5*n+uncol, and
     * CParent at Common->Iwork + 4*n+uncol, where uncol is 0 if A is symmetric
     * or A->ncol otherwise.  Thus, only the first 4n integers in Common->Iwork
     * can be used here. */

    CHOLMOD(allocate_work) (n, s, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }

    p = Common->Iwork ;
    Degree = p ; p += n ;	/* size n */
    Elen   = p ; p += n ;	/* size n */
    Len    = p ; p += n ;	/* size n */
    Nv     = p ; p += n ;	/* size n */

    Work3n = CHOLMOD(malloc) (n+1, 3*sizeof (Int), Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }
    p = Work3n ;
    Next = p ; p += n ;		/* size n */
    Wi   = p ; p += (n+1) ;	/* size n+1 */
    BucketSet = p ;		/* size n */

    Head = Common->Head ;	/* size n+1 */

    /* ---------------------------------------------------------------------- */
    /* construct the input matrix for CAMD */
    /* ---------------------------------------------------------------------- */

    if (A->stype == 0)
    {
	/* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */
	C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ;
    }
    else
    {
	/* C = A+A', but use only the upper triangular part of A if A->stype = 1
	 * and only the lower part of A if A->stype = -1.  Add extra space of
	 * nnz(C)/2+n to C. */
	C = CHOLMOD(copy) (A, 0, -2, Common) ;
    }

    if (Common->status < CHOLMOD_OK)
    {
	/* out of memory, fset invalid, or other error */
	CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ;
	return (FALSE) ;
    }

    Cp = C->p ;
    for (j = 0 ; j < n ; j++)
    {
	Len [j] = Cp [j+1] - Cp [j] ;
    }

    /* C does not include the diagonal, and both upper and lower parts.
     * Common->anz includes the diagonal, and just the lower part of C */
    cnz = Cp [n] ;
    Common->anz = cnz / 2 + n ;

    /* ---------------------------------------------------------------------- */
    /* order C using CAMD */
    /* ---------------------------------------------------------------------- */

    /* get parameters */
    if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS)
    {
	/* use CAMD defaults */
	Control = NULL ;
    }
    else
    {
	Control = Control2 ;
	Control [CAMD_DENSE] = Common->method [Common->current].prune_dense ;
	Control [CAMD_AGGRESSIVE] = Common->method [Common->current].aggressive;
    }

    /* CAMD_2 does not use camd_malloc and camd_free, but set these pointers
     * just be safe. */
    amesos_camd_malloc = Common->malloc_memory ;
    amesos_camd_free = Common->free_memory ;
    amesos_camd_calloc = Common->calloc_memory ;
    amesos_camd_realloc = Common->realloc_memory ;

    /* CAMD_2 doesn't print anything either, but future versions might,
     * so set the camd_printf pointer too. */
    amesos_camd_printf = Common->print_function ;

#ifdef LONG
    /* DEBUG (camd_l_debug_init ("cholmod_l_camd")) ; */
    amesos_camd_l2 (n, C->p,  C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
	    Degree, Wi, Control, Info, Cmember, BucketSet) ;
#else
    /* DEBUG (camd_debug_init ("cholmod_camd")) ; */
    amesos_camd_2 (n, C->p,  C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
	    Degree, Wi, Control, Info, Cmember, BucketSet) ;
#endif

    /* LL' flop count.  Need to subtract n for LL' flop count.  Note that this
     * is a slight upper bound which is often exact (see CAMD/Source/camd_2.c
     * for details).  cholmod_analyze computes an exact flop count and
     * fill-in. */
    Common->fl = Info [CAMD_NDIV] + 2 * Info [CAMD_NMULTSUBS_LDL] + n ;

    /* Info [CAMD_LNZ] excludes the diagonal */
    Common->lnz = n + Info [CAMD_LNZ] ;

    /* ---------------------------------------------------------------------- */
    /* free the CAMD workspace and clear the persistent workspace in Common */
    /* ---------------------------------------------------------------------- */

    ASSERT (IMPLIES (Common->status == CHOLMOD_OK,
		CHOLMOD(dump_perm) (Perm, n, n, "CAMD2 perm", Common))) ;
    CHOLMOD(free_sparse) (&C, Common) ;
    for (j = 0 ; j <= n ; j++)
    {
	Head [j] = EMPTY ;
    }
    CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ;
    return (TRUE) ;
}
Exemple #6
0
cholmod_sparse *CHOLMOD(ssmult)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* left matrix to multiply */
    cholmod_sparse *B,	/* right matrix to multiply */
    int stype,		/* requested stype of C */
    int values,		/* TRUE: do numerical values, FALSE: pattern only */
    int sorted,		/* if TRUE then return C with sorted columns */
    /* --------------- */
    cholmod_common *Common
)
{
    double bjt ;
    double *Ax, *Bx, *Cx, *W ;
    Int *Ap, *Anz, *Ai, *Bp, *Bnz, *Bi, *Cp, *Ci, *Flag ;
    cholmod_sparse *C, *A2, *B2, *A3, *B3, *C2 ;
    Int apacked, bpacked, j, i, pa, paend, pb, pbend, ncol, mark, cnz, t, p,
	nrow, anz, bnz, do_swap_and_transpose, n1, n2 ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (NULL) ;
    RETURN_IF_NULL (A, NULL) ;
    RETURN_IF_NULL (B, NULL) ;
    values = values &&
	(A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, 
	    values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
    RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, 
	    values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
    if (A->ncol != B->nrow)
    {
	/* inner dimensions must agree */
	ERROR (CHOLMOD_INVALID, "A and B inner dimensions must match") ;
	return (NULL) ;
    }
    /* A and B must have the same numerical type if values is TRUE (both must
     * be CHOLMOD_REAL, this is implicitly checked above) */
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    if (A->nrow <= 1)
    {
	/* C will be implicitly sorted, so no need to sort it here */
	sorted = FALSE ;
    }
    if (sorted)
    {
	n1 = MAX (A->nrow, B->ncol) ;
    }
    else
    {
	n1 = A->nrow ;
    }
    n2 = MAX4 (A->ncol, A->nrow, B->nrow, B->ncol) ;
    CHOLMOD(allocate_work) (n1, n2, values ? n1 : 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	/* out of memory */
	return (NULL) ;
    }
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1 : 0, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    /* convert A to unsymmetric, if necessary */
    A2 = NULL ;
    B2 = NULL ;
    if (A->stype)
    {
	/* workspace: Iwork (max (A->nrow,A->ncol)) */
	A2 = CHOLMOD(copy) (A, 0, values, Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    /* out of memory */
	    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
	    return (NULL) ;
	}
	A = A2 ;
    }

    /* convert B to unsymmetric, if necessary */
    if (B->stype)
    {
	/* workspace: Iwork (max (B->nrow,B->ncol)) */
	B2 = CHOLMOD(copy) (B, 0, values, Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    /* out of memory */
	    CHOLMOD(free_sparse) (&A2, Common) ;
	    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
	    return (NULL) ;
	}
	B = B2 ;
    }

    ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;
    ASSERT (CHOLMOD(dump_sparse) (B, "B", Common) >= 0) ;

    /* get the A matrix */
    Ap  = A->p ;
    Anz = A->nz ;
    Ai  = A->i ;
    Ax  = A->x ;
    apacked = A->packed ;

    /* get the B matrix */
    Bp  = B->p ;
    Bnz = B->nz ;
    Bi  = B->i ;
    Bx  = B->x ;
    bpacked = B->packed ;

    /* get the size of C */
    nrow = A->nrow ;
    ncol = B->ncol ;

    /* get workspace */
    W = Common->Xwork ;		/* size nrow, unused if values is FALSE */
    Flag = Common->Flag ;	/* size nrow, Flag [0..nrow-1] < mark on input*/

    /* ---------------------------------------------------------------------- */
    /* count the number of entries in the result C */
    /* ---------------------------------------------------------------------- */

    cnz = 0 ;
    for (j = 0 ; j < ncol ; j++)
    {
	/* clear the Flag array */
	/* mark = CHOLMOD(clear_flag) (Common) ; */
	CHOLMOD_CLEAR_FLAG (Common) ;
	mark = Common->mark ;

	/* for each nonzero B(t,j) in column j, do: */
	pb = Bp [j] ;
	pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
	for ( ; pb < pbend ; pb++)
	{
	    /* B(t,j) is nonzero */
	    t = Bi [pb] ;

	    /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
	    pa = Ap [t] ;
	    paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ;
	    for ( ; pa < paend ; pa++)
	    {
		i = Ai [pa] ;
		if (Flag [i] != mark)
		{
		    Flag [i] = mark ;
		    cnz++ ;
		}
	    }
	}
	if (cnz < 0)
	{
	    break ;	    /* integer overflow case */
	}
    }

    /* mark = CHOLMOD(clear_flag) (Common) ; */
    CHOLMOD_CLEAR_FLAG (Common) ;
    mark = Common->mark ;

    /* ---------------------------------------------------------------------- */
    /* check for integer overflow */
    /* ---------------------------------------------------------------------- */

    if (cnz < 0)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	CHOLMOD(free_sparse) (&A2, Common) ;
	CHOLMOD(free_sparse) (&B2, Common) ;
	ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
	return (NULL) ;
    }

    /* ---------------------------------------------------------------------- */
    /* Determine how to return C sorted (if requested) */
    /* ---------------------------------------------------------------------- */

    do_swap_and_transpose = FALSE ;

    if (sorted)
    {
	/* Determine the best way to return C with sorted columns.  Computing
	 * C = (B'*A')' takes cnz + anz + bnz time (ignoring O(n) terms).
	 * Sorting C when done, C = (A*B)'', takes 2*cnz time.  Pick the one
	 * with the least amount of work. */

	anz = CHOLMOD(nnz) (A, Common) ;
	bnz = CHOLMOD(nnz) (B, Common) ;

	do_swap_and_transpose = (anz + bnz < cnz) ;

	if (do_swap_and_transpose)
	{

	    /* -------------------------------------------------------------- */
	    /* C = (B'*A')' */
	    /* -------------------------------------------------------------- */

	    /* workspace: Iwork (A->nrow) */
	    A3 = CHOLMOD(ptranspose) (A, values, NULL, NULL, 0, Common) ;
	    CHOLMOD(free_sparse) (&A2, Common) ;
	    A2 = A3 ;
	    if (Common->status < CHOLMOD_OK)
	    {
		/* out of memory */
		CHOLMOD(free_sparse) (&A2, Common) ;
		CHOLMOD(free_sparse) (&B2, Common) ;
		ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
		return (NULL) ;
	    }
	    /* workspace: Iwork (B->nrow) */
	    B3 = CHOLMOD(ptranspose) (B, values, NULL, NULL, 0, Common) ;
	    CHOLMOD(free_sparse) (&B2, Common) ;
	    B2 = B3 ;
	    if (Common->status < CHOLMOD_OK)
	    {
		/* out of memory */
		CHOLMOD(free_sparse) (&A2, Common) ;
		CHOLMOD(free_sparse) (&B2, Common) ;
		ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
		return (NULL) ;
	    }
	    A = B2 ;
	    B = A2 ;

	    /* get the new A matrix */
	    Ap  = A->p ;
	    Anz = A->nz ;
	    Ai  = A->i ;
	    Ax  = A->x ;
	    apacked = A->packed ;

	    /* get the new B matrix */
	    Bp  = B->p ;
	    Bnz = B->nz ;
	    Bi  = B->i ;
	    Bx  = B->x ;
	    bpacked = B->packed ;

	    /* get the size of C' */
	    nrow = A->nrow ;
	    ncol = B->ncol ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* allocate C */
    /* ---------------------------------------------------------------------- */

    C = CHOLMOD(allocate_sparse) (nrow, ncol, cnz, FALSE, TRUE, 0,
	    values ? A->xtype : CHOLMOD_PATTERN, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	/* out of memory */
	CHOLMOD(free_sparse) (&A2, Common) ;
	CHOLMOD(free_sparse) (&B2, Common) ;
	ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
	return (NULL) ;
    }

    Cp = C->p ;
    Ci = C->i ;
    Cx = C->x ;

    /* ---------------------------------------------------------------------- */
    /* C = A*B */
    /* ---------------------------------------------------------------------- */

    cnz = 0 ;

    if (values)
    {

	/* pattern and values */
	for (j = 0 ; j < ncol ; j++)
	{
	    /* clear the Flag array */
	    /* mark = CHOLMOD(clear_flag (Common)) ; */
	    CHOLMOD_CLEAR_FLAG (Common) ;
	    mark = Common->mark ;

	    /* start column j of C */
	    Cp [j] = cnz ;

	    /* for each nonzero B(t,j) in column j, do: */
	    pb = Bp [j] ;
	    pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
	    for ( ; pb < pbend ; pb++)
	    {
		/* B(t,j) is nonzero */
		t = Bi [pb] ;
		bjt = Bx [pb] ;

		/* add the nonzero pattern of A(:,t) to the pattern of C(:,j)
		 * and scatter the values into W */
		pa = Ap [t] ;
		paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ;
		for ( ; pa < paend ; pa++)
		{
		    i = Ai [pa] ;
		    if (Flag [i] != mark)
		    {
			Flag [i] = mark ;
			Ci [cnz++] = i ;
		    }
		    W [i] += Ax [pa] * bjt ;
		}
	    }

	    /* gather the values into C(:,j) */
	    for (p = Cp [j] ; p < cnz ; p++)
	    {
		i = Ci [p] ;
		Cx [p] = W [i] ;
		W [i] = 0 ;
	    }
	}

    }
    else
    {

	/* pattern only */
	for (j = 0 ; j < ncol ; j++)
	{
	    /* clear the Flag array */
	    /* mark = CHOLMOD(clear_flag) (Common) ; */
	    CHOLMOD_CLEAR_FLAG (Common) ;
	    mark = Common->mark ;

	    /* start column j of C */
	    Cp [j] = cnz ;

	    /* for each nonzero B(t,j) in column j, do: */
	    pb = Bp [j] ;
	    pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ;
	    for ( ; pb < pbend ; pb++)
	    {
		/* B(t,j) is nonzero */
		t = Bi [pb] ;

		/* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
		pa = Ap [t] ;
		paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ;
		for ( ; pa < paend ; pa++)
		{
		    i = Ai [pa] ;
		    if (Flag [i] != mark)
		    {
			Flag [i] = mark ;
			Ci [cnz++] = i ;
		    }
		}
	    }
	}
    }

    Cp [ncol] = cnz ;
    ASSERT (MAX (1,cnz) == C->nzmax) ;

    /* ---------------------------------------------------------------------- */
    /* clear workspace and free temporary matrices */
    /* ---------------------------------------------------------------------- */

    CHOLMOD(free_sparse) (&A2, Common) ;
    CHOLMOD(free_sparse) (&B2, Common) ;
    /* CHOLMOD(clear_flag) (Common) ; */
    CHOLMOD_CLEAR_FLAG (Common) ;
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* convert C to a symmetric upper/lower matrix if requested */
    /* ---------------------------------------------------------------------- */

    /* convert C in place, which cannot fail since no memory is allocated */
    if (stype > 0)
    {
	/* C = triu (C), in place */
	(void) CHOLMOD(band_inplace) (0, ncol, values, C, Common) ;
	C->stype = 1 ;
    }
    else if (stype < 0)
    {
	/* C = tril (C), in place */
	(void) CHOLMOD(band_inplace) (-nrow, 0, values, C, Common) ;
	C->stype = -1 ;
    }
    ASSERT (Common->status >= CHOLMOD_OK) ;

    /* ---------------------------------------------------------------------- */
    /* sort C, if requested */
    /* ---------------------------------------------------------------------- */

    if (sorted)
    {
	if (do_swap_and_transpose)
	{
	    /* workspace: Iwork (C->ncol), which is A->nrow since C=(B'*A') */
	    C2 = CHOLMOD(ptranspose) (C, values, NULL, NULL, 0, Common) ;
	    CHOLMOD(free_sparse) (&C, Common) ;
	    if (Common->status < CHOLMOD_OK)
	    {
		/* out of memory */
		ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
		return (NULL) ;
	    }
	    C = C2 ;
	}
	else
	{
	    /* workspace: Iwork (max (C->nrow,C->ncol)) */
	    if (!CHOLMOD(sort) (C, Common))
	    {
		/* out of memory */
		CHOLMOD(free_sparse) (&C, Common) ;
		ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common));
		return (NULL) ;
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* return result */
    /* ---------------------------------------------------------------------- */

    DEBUG (CHOLMOD(dump_sparse) (C, "ssmult", Common) >= 0) ;
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ;
    return (C) ;
}
Exemple #7
0
int CHOLMOD(csymamd)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to order */
    /* ---- output --- */
    Int *Cmember,	/* size nrow.  see cholmod_ccolamd.c for description */
    Int *Perm,		/* size A->nrow, output permutation */
    /* --------------- */
    cholmod_common *Common
)
{
    double knobs [CCOLAMD_KNOBS] ;
    Int *perm, *Head ;
    Int ok, i, nrow, stats [CCOLAMD_STATS] ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;
    RETURN_IF_NULL (Perm, FALSE) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    Common->status = CHOLMOD_OK ;

    if (A->nrow != A->ncol || !(A->packed))
    {
	ERROR (CHOLMOD_INVALID, "matrix must be square and packed") ;
	return (FALSE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    nrow = A->nrow ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    CHOLMOD(allocate_work) (nrow, 0, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* order the matrix (does not affect A->p or A->i) */
    /* ---------------------------------------------------------------------- */

    perm = Common->Head ;	/* size nrow+1 (i/l/l) */

    /* get parameters */
#ifdef LONG
    ccolamd_l_set_defaults (knobs) ;
#else
    ccolamd_set_defaults (knobs) ;
#endif
    if (Common->current >= 0 && Common->current < CHOLMOD_MAXMETHODS)
    {
	/* get the knobs from the Common parameters */
	knobs [CCOLAMD_DENSE_ROW] =Common->method[Common->current].prune_dense ;
	knobs [CCOLAMD_AGGRESSIVE]=Common->method[Common->current].aggressive ;
    }

    {
#ifdef LONG
	csymamd_l (nrow, A->i, A->p, perm, knobs, stats, Common->calloc_memory,
		Common->free_memory, Cmember, A->stype) ;
#else
	csymamd (nrow, A->i, A->p, perm, knobs, stats, Common->calloc_memory,
		Common->free_memory, Cmember, A->stype) ;
#endif
	ok = stats [CCOLAMD_STATUS] ;
    }

    if (ok == CCOLAMD_ERROR_out_of_memory)
    {
	ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; 
    }
    ok = (ok == CCOLAMD_OK || ok == CCOLAMD_OK_BUT_JUMBLED) ;

    /* ---------------------------------------------------------------------- */
    /* free the workspace and return result */
    /* ---------------------------------------------------------------------- */

    /* permutation returned in perm [0..n-1] */
    for (i = 0 ; i < nrow ; i++)
    {
	Perm [i] = perm [i] ;
    }

    /* clear Head workspace (used for perm, in csymamd): */
    Head = Common->Head ;
    for (i = 0 ; i <= nrow ; i++)
    {
	Head [i] = EMPTY ;
    }

    return (ok) ;
}
Exemple #8
0
int CHOLMOD(amd)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to order */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    /* ---- output --- */
    Int *Perm,		/* size A->nrow, output permutation */
    /* --------------- */
    cholmod_common *Common
)
{
    double Info [AMD_INFO], Control2 [AMD_CONTROL], *Control ;
    Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Iwork, *Next ;
    cholmod_sparse *C ;
    Int j, n, cnz ;
    size_t s ;
    int ok = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;
    n = A->nrow ;

    RETURN_IF_NULL (Perm, FALSE) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    Common->status = CHOLMOD_OK ;
    if (n == 0)
    {
	/* nothing to do */
	Common->fl = 0 ;
	Common->lnz = 0 ;
	Common->anz = 0 ;
	return (TRUE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    /* Note: this is less than the space used in cholmod_analyze, so if
     * cholmod_amd is being called by that routine, no space will be
     * allocated.
     */

    /* s = MAX (6*n, A->ncol) */
    s = CHOLMOD(mult_size_t) (n, 6, &ok) ;
    if (!ok)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	return (FALSE) ;
    }
    s = MAX (s, A->ncol) ;

    CHOLMOD(allocate_work) (n, s, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }

    Iwork  = Common->Iwork ;
    Degree = Iwork ;			/* size n */
    Wi     = Iwork + n ;		/* size n */
    Len    = Iwork + 2*((size_t) n) ;	/* size n */
    Nv     = Iwork + 3*((size_t) n) ;   /* size n */
    Next   = Iwork + 4*((size_t) n) ;   /* size n */
    Elen   = Iwork + 5*((size_t) n) ;   /* size n */

    Head = Common->Head ;   /* size n+1, but only n is used */

    /* ---------------------------------------------------------------------- */
    /* construct the input matrix for AMD */
    /* ---------------------------------------------------------------------- */

    if (A->stype == 0)
    {
	/* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */
	C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ;
    }
    else
    {
	/* C = A+A', but use only the upper triangular part of A if A->stype = 1
	 * and only the lower part of A if A->stype = -1.  Add extra space of
	 * nnz(C)/2+n to C. */
	C = CHOLMOD(copy) (A, 0, -2, Common) ;
    }

    if (Common->status < CHOLMOD_OK)
    {
	/* out of memory, fset invalid, or other error */
	return (FALSE) ;
    }

    Cp = C->p ;
    for (j = 0 ; j < n ; j++)
    {
	Len [j] = Cp [j+1] - Cp [j] ;
    }

    /* C does not include the diagonal, and both upper and lower parts.
     * Common->anz includes the diagonal, and just the lower part of C */
    cnz = Cp [n] ;
    Common->anz = cnz / 2 + n ;

    /* ---------------------------------------------------------------------- */
    /* order C using AMD */
    /* ---------------------------------------------------------------------- */

    /* get parameters */
    if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS)
    {
	/* use AMD defaults */
	Control = NULL ;
    }
    else
    {
	Control = Control2 ;
	Control [AMD_DENSE] = Common->method [Common->current].prune_dense ;
	Control [AMD_AGGRESSIVE] = Common->method [Common->current].aggressive ;
    }

#ifdef LONG
    amd_l2 (n, C->p,  C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
	    Degree, Wi, Control, Info) ;
#else
    amd_2 (n, C->p,  C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen,
	    Degree, Wi, Control, Info) ;
#endif

    /* LL' flop count.  Need to subtract n for LL' flop count.  Note that this
     * is a slight upper bound which is often exact (see AMD/Source/amd_2.c for
     * details).  cholmod_analyze computes an exact flop count and fill-in. */
    Common->fl = Info [AMD_NDIV] + 2 * Info [AMD_NMULTSUBS_LDL] + n ;

    /* Info [AMD_LNZ] excludes the diagonal */
    Common->lnz = n + Info [AMD_LNZ] ;

    /* ---------------------------------------------------------------------- */
    /* free the AMD workspace and clear the persistent workspace in Common */
    /* ---------------------------------------------------------------------- */

    ASSERT (IMPLIES (Common->status == CHOLMOD_OK,
		CHOLMOD(dump_perm) (Perm, n, n, "AMD2 perm", Common))) ;
    CHOLMOD(free_sparse) (&C, Common) ;
    for (j = 0 ; j <= n ; j++)
    {
	Head [j] = EMPTY ;
    }
    return (TRUE) ;
}
Exemple #9
0
int CHOLMOD(updown_mask)
(
    /* ---- input ---- */
    int update,		/* TRUE for update, FALSE for downdate */
    cholmod_sparse *C,	/* the incoming sparse update */
    Int *colmark,	/* Int array of size n.  See cholmod_updown.c */
    Int *mask,		/* size n */
    /* ---- 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 xj, fl ;
    double *Lx, *W, *Xx, *Nx ;
    Int *Li, *Lp, *Lnz, *Cp, *Ci, *Cnz, *Head, *Flag, *Stack, *Lnext, *Iwork,
	*Set_ps1 [32], *Set_ps2 [32], *ps1, *ps2 ;
    size_t maxrank ;
    Path_type OrderedPath [32], Path [32] ;
    Int n, wdim, k1, k2, npaths, i, j, row, packed, ccol, p, cncol, do_solve,
	mark, jj, j2, kk, nextj, p1, p2, c, use_colmark, newlnz,
	k, newpath, path_order, w_order, scattered, path, newparent, pp1, pp2,
	smax, maxrow, row1, nsets, s, p3, newlnz1, Set [32], top, len, lnz, m,
	botrow ;
    size_t w ;
    int ok = TRUE ;
    DEBUG (Int oldparent) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (C, FALSE) ;
    RETURN_IF_NULL (L, FALSE) ;
    RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
    RETURN_IF_XTYPE_INVALID (C, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
    n = L->n ;
    cncol = C->ncol ;
    if (!(C->sorted))
    {
	ERROR (CHOLMOD_INVALID, "C must have sorted columns") ;
	return (FALSE) ;
    }
    if (n != (Int) (C->nrow))
    {
	ERROR (CHOLMOD_INVALID, "C and L dimensions do not match") ;
	return (FALSE) ;
    }
    do_solve = (X != NULL) && (DeltaB != NULL) ;
    if (do_solve)
    {
	RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
	RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
	Xx = X->x ;
	Nx = DeltaB->x ;
	if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n ||
		DeltaB->ncol != 1 || Xx == NULL || Nx == NULL)
	{
	    ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ;
	    return (FALSE) ;
	}
    }
    else
    {
	Xx = NULL ;
	Nx = NULL ;
    }
    Common->status = CHOLMOD_OK ;
    Common->modfl = 0 ;

    fl = 0 ;
    use_colmark = (colmark != NULL) ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    /* Note: cholmod_rowadd and cholmod_rowdel use the second n doubles in
     * Common->Xwork for Cx, and then perform a rank-1 update here, which uses
     * the first n doubles in Common->Xwork.   Both the rowadd and rowdel
     * routines allocate enough workspace so that Common->Xwork isn't destroyed
     * below.  Also, both cholmod_rowadd and cholmod_rowdel use the second n
     * ints in Common->Iwork for Ci.
     */

    /* make sure maxrank is in the proper range */
    maxrank = CHOLMOD(maxrank) (n, Common) ;
    k = MIN (cncol, (Int) maxrank) ;	/* maximum k is wdim */
    wdim = Power2 [k] ;		/* number of columns needed in W */
    ASSERT (wdim <= (Int) maxrank) ;
    PRINT1 (("updown wdim final "ID" k "ID"\n", wdim, k)) ;

    /* w = wdim * n */
    w = CHOLMOD(mult_size_t) (n, wdim, &ok) ;
    if (!ok)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	return (FALSE) ;
    }

    CHOLMOD(allocate_work) (n, n, w, Common) ;
    if (Common->status < CHOLMOD_OK || maxrank == 0)
    {
	/* out of memory, L is returned unchanged */
	return (FALSE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* convert to simplicial numeric LDL' factor, if not already */
    /* ---------------------------------------------------------------------- */

    if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) 
    {
	/* can only update/downdate a simplicial LDL' factorization */
	CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L,
		Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    /* out of memory, L is returned unchanged */
	    return (FALSE) ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    /* mark = CHOLMOD(clear_flag) (Common) ; */
    CHOLMOD_CLEAR_FLAG (Common) ;
    mark = Common->mark ;

    PRINT1 (("updown, rank %g update %d\n", (double) C->ncol, update)) ;
    DEBUG (CHOLMOD(dump_factor) (L, "input L for updown", Common)) ;
    ASSERT (CHOLMOD(dump_sparse) (C, "input C for updown", Common) >= 0) ;

    Ci = C->i ;
    Cp = C->p ;
    Cnz = C->nz ;
    packed = C->packed ;
    ASSERT (IMPLIES (!packed, Cnz != NULL)) ;

    /* ---------------------------------------------------------------------- */
    /* quick return */
    /* ---------------------------------------------------------------------- */

    if (cncol <= 0 || n == 0)
    {
	/* nothing to do */
	return (TRUE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get L */
    /* ---------------------------------------------------------------------- */

    Li = L->i ;
    Lx = L->x ;
    Lp = L->p ;
    Lnz = L->nz ;
    Lnext = L->next ;
    ASSERT (Lnz != NULL) ;

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    Flag = Common->Flag ;	/* size n, Flag [i] <= mark must hold */
    Head = Common->Head ;	/* size n, Head [i] == EMPTY must hold */
    W = Common->Xwork ;		/* size n-by-wdim, zero on input and output*/

    /* note that Iwork [n .. 2*n-1] (i/i/l) may be in use in rowadd/rowdel: */
    Iwork = Common->Iwork ;
    Stack = Iwork ;		/* size n, uninitialized (i/i/l) */

    /* ---------------------------------------------------------------------- */
    /* entire rank-cncol update, done as a sequence of rank-k updates */
    /* ---------------------------------------------------------------------- */

    ps1 = NULL ;
    ps2 = NULL ;

    for (k1 = 0 ; k1 < cncol ; k1 += k)
    {

	/* ------------------------------------------------------------------ */
	/* get the next k columns of C for the update/downdate */
	/* ------------------------------------------------------------------ */

	/* the last update/downdate might be less than rank-k */
	if (k > cncol - k1)
	{
	    k = cncol - k1 ;
	    wdim = Power2 [k] ;
	}
	k2 = k1 + k - 1 ;

	/* workspaces are in the following state, on input and output */
	ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;

	/* ------------------------------------------------------------------ */
	/* create a zero-length path for each column of W */
	/* ------------------------------------------------------------------ */

	nextj = n ;
	path = 0 ;
	for (ccol = k1 ; ccol <= k2 ; ccol++)
	{
	    PRINT1 (("Column ["ID"]: "ID"\n", path, ccol)) ;
	    ASSERT (ccol >= 0 && ccol <= cncol) ;
	    pp1 = Cp [ccol] ;
	    pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
	    /* get the row index j of the first entry in C (:,ccol) */
	    if (pp2 > pp1)
	    {
		/* Column ccol of C has at least one entry. */
		j = Ci [pp1] ;
	    }
	    else
	    {
		/* Column ccol of C is empty.  Pretend it has one entry in
		 * the last column with numerical value of zero. */
		j = n-1 ;
	    }
	    ASSERT (j >= 0 && j < n) ;

	    /* find first column to work on */
	    nextj = MIN (nextj, j) ;

	    Path [path].ccol = ccol ;	/* which column of C this path is for */
	    Path [path].start = EMPTY ;	/* paths for C have zero length */
	    Path [path].end = EMPTY ;
	    Path [path].parent = EMPTY ;    /* no parent yet */
	    Path [path].rank = 1 ;	    /* one column of W */
	    Path [path].c = EMPTY ;	    /* no child of this path (case A) */
	    Path [path].next = Head [j] ;   /* this path is pending at col j */
	    Path [path].pending = j ;	    /* this path is pending at col j */
	    Head [j] = path ;		    /* this path is pending at col j */
	    PRINT1(("Path "ID" starts: start "ID" end "ID" parent "ID" c "ID""
		    "j "ID" ccol "ID"\n", path, Path [path].start,
		    Path [path].end, Path [path].parent,
		    Path [path].c, j, ccol)) ;

	    /* initialize botrow for this path */
	    Path [path].botrow = (use_colmark) ? colmark [ccol] : n ;

	    path++ ;
	}

	/* we start with paths 0 to k-1.  Next one (now unused) is npaths */
	npaths = k ;

	j = nextj ;
	ASSERT (j < n) ;
	scattered = FALSE ;

	/* ------------------------------------------------------------------ */
	/* symbolic update of columns of L */
	/* ------------------------------------------------------------------ */

	while (j < n)
	{
	    ASSERT (j >= 0 && j < n && Lnz [j] > 0) ;

	    /* the old column, Li [p1..p2-1].  D (j,j) is stored in Lx [p1] */
	    p1 = Lp [j] ;
	    newlnz = Lnz [j] ;
	    p2 = p1 + newlnz  ;

#ifndef NDEBUG
	    PRINT1 (("\n=========Column j="ID" p1 "ID" p2 "ID" lnz "ID" \n",
			j, p1, p2, newlnz)) ;
	    dump_col ("Old", j, p1, p2, Li, Lx, n, Common) ;
	    oldparent = (Lnz [j] > 1) ? (Li [p1 + 1]) : EMPTY ;
	    ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ;
	    ASSERT (!scattered) ;
	    PRINT1 (("Col "ID": Checking paths, npaths: "ID"\n", j, npaths)) ;
	    for (kk = 0 ; kk < npaths ; kk++)
	    {
		Int kk2, found, j3 = Path [kk].pending ;
		PRINT2 (("Path "ID" pending at "ID".\n", kk, j3)) ;
		if (j3 != EMPTY)
		{
		    /* Path kk must be somewhere in link list for column j3 */
		    ASSERT (Head [j3] != EMPTY) ;
		    PRINT3 (("    List at "ID": ", j3)) ;
		    found = FALSE ;
		    for (kk2 = Head [j3] ; kk2 != EMPTY ; kk2 = Path [kk2].next)
		    {
			PRINT3 ((""ID" ", kk2)) ;
			ASSERT (Path [kk2].pending == j3) ;
			found = found || (kk2 == kk) ;
		    }
		    PRINT3 (("\n")) ;
		    ASSERT (found) ;
		}
	    }
	    PRINT1 (("\nCol "ID": Paths at this column, head "ID"\n",
			j, Head [j]));
	    ASSERT (Head [j] != EMPTY) ;
	    for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next)
	    {
		PRINT1 (("path "ID": (c="ID" j="ID") npaths "ID"\n",
			    kk, Path[kk].c, j, npaths)) ;
		ASSERT (kk >= 0 && kk < npaths) ;
		ASSERT (Path [kk].pending == j) ;
	    }
#endif

	    /* -------------------------------------------------------------- */
	    /* determine the path we're on */
	    /* -------------------------------------------------------------- */

	    /* get the first old path at column j */
	    path = Head [j] ;

	    /* -------------------------------------------------------------- */
	    /* update/downdate of forward solve, Lx=b */
	    /* -------------------------------------------------------------- */

	    if (do_solve)
	    {
		xj = Xx [j] ;
		if (IS_NONZERO (xj))
		{
		    xj = Xx [j] ;
		    /* This is first time column j has been seen for entire */
		    /* rank-k update/downdate. */

		    /* DeltaB += Lold (j:botrow-1,j) * X (j) */
		    Nx [j] += xj ;			/* diagonal of L */

		    /* find the botrow for this column */
		    botrow = (use_colmark) ? Path [path].botrow : n ;

		    for (p = p1 + 1 ; p < p2 ; p++)
		    {
			i = Li [p] ;
			if (i >= botrow)
			{
			    break ;
			}
			Nx [i] += Lx [p] * xj ;
		    }

		    /* clear X[j] to flag col j of Lold as having been seen.  If
		     * X (j) was initially zero, then the above code is never
		     * executed for column j.  This is safe, since if xj=0 the
		     * code above does not do anything anyway.  */
		    Xx [j] = 0.0 ;
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* start a new path at this column if two or more paths merge */
	    /* -------------------------------------------------------------- */

	    newpath =
		/* start a new path if paths have merged */
		(Path [path].next != EMPTY)
		/* or if j is the first node on a path (case A). */
		|| (Path [path].c == EMPTY) ;

	    if (newpath)
	    {
		/* get the botrow of the first path at column j */
		botrow = (use_colmark) ? Path [path].botrow : n ;

		path = npaths++ ;
		ASSERT (npaths <= 3*k) ;
		Path [path].ccol = EMPTY ; /* no single col of C for this path*/
		Path [path].start = j ;	   /* path starts at this column j */
		Path [path].end = EMPTY ;  /* don't know yet where it ends */
		Path [path].parent = EMPTY ;/* don't know parent path yet */
		Path [path].rank = 0 ;	/* rank is sum of child path ranks */
		PRINT1 (("Path "ID" starts: start "ID" end "ID" parent "ID"\n",
		path, Path [path].start, Path [path].end, Path [path].parent)) ;

		/* set the botrow of the new path */
		Path [path].botrow = (use_colmark) ? botrow : n ;
	    }

	    /* -------------------------------------------------------------- */
	    /* for each path kk pending at column j */
	    /* -------------------------------------------------------------- */

	    /* make a list of the sets that need to be merged into column j */
	    nsets = 0 ;

	    for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next)
	    {

		/* ---------------------------------------------------------- */
		/* path kk is at (c,j) */
		/* ---------------------------------------------------------- */

		c = Path [kk].c ;
		ASSERT (c < j) ;
		PRINT1 (("TUPLE on path "ID" (c="ID" j="ID")\n", kk, c, j)) ;
		ASSERT (Path [kk].pending == j) ;

		if (newpath)
		{
		    /* finalize path kk and find rank of this path */
		    Path [kk].end = c ;	/* end of old path is previous node c */
		    Path [kk].parent = path ;	/* parent is this path */
		    Path [path].rank += Path [kk].rank ;    /* sum up ranks */
		    Path [kk].pending = EMPTY ;
		    PRINT1 (("Path "ID" done:start "ID" end "ID" parent "ID"\n",
		    kk, Path [kk].start, Path [kk].end, Path [kk].parent)) ;
		}

		if (c == EMPTY)
		{

		    /* ------------------------------------------------------ */
		    /* CASE A: first node in path */
		    /* ------------------------------------------------------ */

		    /* update:  add pattern of incoming column */

		    /* Column ccol of C is in Ci [pp1 ... pp2-1] */
		    ccol = Path [kk].ccol ;
		    pp1 = Cp [ccol] ;
		    pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
		    PRINT1 (("Case A, ccol = "ID" len "ID"\n", ccol, pp2-pp1)) ;
		    ASSERT (IMPLIES (pp2 > pp1, Ci [pp1] == j)) ;

		    if (!scattered)
		    {
			/* scatter the original pattern of column j of L */
			for (p = p1 ; p < p2 ; p++)
			{
			    Flag [Li [p]] = mark ;
			}
			scattered = TRUE ;
		    }

		    /* scatter column ccol of C (skip first entry, j) */
		    newlnz1 = newlnz ;
		    for (p = pp1 + 1 ; p < pp2 ; p++)
		    {
			row = Ci [p] ;
			if (Flag [row] < mark)
			{
			    /* this is a new entry in Lj' */
			    Flag [row] = mark ;
			    newlnz++ ;
			}
		    }
		    if (newlnz1 != newlnz)
		    {
			/* column ccol of C adds something to column j of L */
			Set [nsets++] = FLIP (ccol) ;
		    }

		}
		else if (Head [c] == 1)
		{

		    /* ------------------------------------------------------ */
		    /* CASE B: c is old, but changed, child of j */
		    /* CASE C: new child of j */
		    /* ------------------------------------------------------ */

		    /* Head [c] is 1 if col c of L has new entries,
		     * EMPTY otherwise */
		    Flag [c] = 0 ;
		    Head [c] = EMPTY ;

		    /* update: add Lc' */

		    /* column c of L is in Li [pp1 .. pp2-1] */
		    pp1 = Lp [c] ;
		    pp2 = pp1 + Lnz [c] ;
		    PRINT1 (("Case B/C: c = "ID"\n", c)) ;
		    DEBUG (dump_col ("Child", c, pp1, pp2, Li, Lx, n, Common)) ;
		    ASSERT (j == Li [pp1 + 1]) ; /* j is new parent of c */

		    if (!scattered)
		    {
			/* scatter the original pattern of column j of L */
			for (p = p1 ; p < p2 ; p++)
			{
			    Flag [Li [p]] = mark ;
			}
			scattered = TRUE ;
		    }

		    /* scatter column c of L (skip first two entries, c and j)*/
		    newlnz1 = newlnz ;
		    for (p = pp1 + 2 ; p < pp2 ; p++)
		    {
			row = Li [p] ;
			if (Flag [row] < mark)
			{
			    /* this is a new entry in Lj' */
			    Flag [row] = mark ;
			    newlnz++ ;
			}
		    }
		    PRINT2 (("\n")) ;

		    if (newlnz1 != newlnz)
		    {
			/* column c of L adds something to column j of L */
			Set [nsets++] = c ;
		    }
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* update the pattern of column j of L */
	    /* -------------------------------------------------------------- */

	    /* Column j of L will be in Li/Lx [p1 .. p3-1] */
	    p3 = p1 + newlnz ;
	    ASSERT (IMPLIES (nsets == 0, newlnz == Lnz [j])) ;
	    PRINT1 (("p1 "ID" p2 "ID" p3 "ID" nsets "ID"\n", p1, p2, p3,nsets));

	    /* -------------------------------------------------------------- */
	    /* ensure we have enough space for the longer column */
	    /* -------------------------------------------------------------- */

	    if (nsets > 0 && p3 > Lp [Lnext [j]])
	    {
		PRINT1 (("Col realloc: j "ID" newlnz "ID"\n", j, newlnz)) ;
		if (!CHOLMOD(reallocate_column) (j, newlnz, L, Common))
		{
		    /* out of memory, L is now simplicial symbolic */
		    CHOLMOD(clear_flag) (Common) ;
		    for (j = 0 ; j <= n ; j++)
		    {
			Head [j] = EMPTY ;
		    }
		    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
		    return (FALSE) ;
		}
		/* L->i and L->x may have moved.  Column j has moved too */
		Li = L->i ;
		Lx = L->x ;
		p1 = Lp [j] ;
		p2 = p1 + Lnz [j] ;
		p3 = p1 + newlnz ;
	    }

	    /* -------------------------------------------------------------- */
	    /* create set pointers */
	    /* -------------------------------------------------------------- */

	    for (s = 0 ; s < nsets ; s++)
	    {
		/* Pattern of Set s is *(Set_ps1 [s] ... Set_ps2 [s]-1) */
		c = Set [s] ;
		if (c < EMPTY)
		{
		    /* column ccol of C, skip first entry (j) */
		    ccol = FLIP (c) ;
		    pp1 = Cp [ccol] ;
		    pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
		    ASSERT (pp2 - pp1 > 1) ;
		    Set_ps1 [s] = &(Ci [pp1 + 1]) ;
		    Set_ps2 [s] = &(Ci [pp2]) ;
		    PRINT1 (("set "ID" is ccol "ID"\n", s, ccol)) ;
		}
		else
		{
		    /* column c of L, skip first two entries (c and j)  */
		    pp1 = Lp [c] ;
		    pp2 = pp1 + Lnz [c]  ;
		    ASSERT (Lnz [c] > 2) ;
		    Set_ps1 [s] = &(Li [pp1 + 2]) ;
		    Set_ps2 [s] = &(Li [pp2]) ;
		    PRINT1 (("set "ID" is L "ID"\n", s, c)) ;
		}
		DEBUG (dump_set (s, Set_ps1, Set_ps2, j, n, Common)) ;
	    }

	    /* -------------------------------------------------------------- */
	    /* multiset merge */
	    /* -------------------------------------------------------------- */

	    /* Merge the sets into a single sorted set, Lj'.  Before the merge
	     * starts, column j is located in Li/Lx [p1 ... p2-1] and the
	     * space Li/Lx [p2 ... p3-1] is empty.  p1 is Lp [j], p2 is
	     * Lp [j] + Lnz [j] (the old length of the column), and p3 is
	     * Lp [j] + newlnz (the new and longer length of the column).
	     *
	     * The sets 0 to nsets-1 are defined by the Set_ps1 and Set_ps2
	     * pointers.  Set s is located in *(Set_ps1 [s] ... Set_ps2 [s]-1).
	     * It may be a column of C, or a column of L.  All row indices i in
	     * the sets are in the range i > j and i < n.  All sets are sorted.
	     *
	     * The merge into column j of L is done in place.
	     *
	     * During the merge, p2 and p3 are updated.  Li/Lx [p1..p2-1]
	     * reflects the indices of the old column j of L that are yet to
	     * be merged into the new column.  Entries in their proper place in
	     * the new column j of L are located in Li/Lx [p3 ... p1+newlnz-1].
	     * The merge finishes when p2 == p3.
	     *
	     * During the merge, set s consumed as it is merged into column j of
	     * L.  Its unconsumed contents are *(Set_ps1 [s] ... Set_ps2 [s]-1).
	     * When a set is completely consumed, it is removed from the set of
	     * sets, and nsets is decremented.
	     *
	     * The multiset merge and 2-set merge finishes when p2 == p3.
	     */

	    PRINT1 (("Multiset merge p3 "ID" p2 "ID" nsets "ID"\n",
			p3, p2, nsets)) ;

	    while (p3 > p2 && nsets > 1)
	    {

#ifndef NDEBUG
		PRINT2 (("\nMultiset merge.  nsets = "ID"\n", nsets)) ;
		PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n",
			    p1, p2, p3)) ;
		for (p = p1 + 1 ; p < p2 ; p++)
		{
		    PRINT2 (("    p: "ID" source row "ID" %g\n",
				p, Li[p], Lx[p])) ;
		    ASSERT (Li [p] > j && Li [p] < n) ;
		}
		PRINT2 (("---\n")) ;
		for (p = p3 ; p < p1 + newlnz ; p++)
		{
		    PRINT2 (("    p: "ID" target row "ID" %g\n",
				p, Li[p], Lx[p])) ;
		    ASSERT (Li [p] > j && Li [p] <  n) ;
		}
		for (s = 0 ; s < nsets ; s++)
		{
		    dump_set (s, Set_ps1, Set_ps2, j, n, Common) ;
		}
#endif

		/* get the entry at the tail end of source column Lj */
		row1 = Li [p2 - 1] ;
		ASSERT (row1 >= j && p2 >= p1) ;

		/* find the largest row in all the sets */
		maxrow = row1 ;
		smax = EMPTY ;
		for (s = nsets-1 ; s >= 0 ; s--)
		{
		    ASSERT (Set_ps1 [s] < Set_ps2 [s]) ;
		    row = *(Set_ps2 [s] - 1) ;
		    if (row == maxrow)
		    {
			/* skip past this entry in set s (it is a duplicate) */
			Set_ps2 [s]-- ;
			if (Set_ps1 [s] == Set_ps2 [s])
			{
			    /* nothing more in this set */
			    nsets-- ;
			    Set_ps1 [s] = Set_ps1 [nsets] ;
			    Set_ps2 [s] = Set_ps2 [nsets] ;
			    if (smax == nsets)
			    {
				/* Set smax redefined; it is now this set */
				smax = s ;
			    }
			}
		    }
		    else if (row > maxrow)
		    {
			maxrow = row ;
			smax = s ;
		    }
		}
		ASSERT (maxrow > j) ;

		/* move the row onto the stack of the target column */
		if (maxrow == row1)
		{
		    /* next entry is in Lj, move to the bottom of Lj' */
		    ASSERT (smax == EMPTY) ;
		    p2-- ;
		    p3-- ;
		    Li [p3] = maxrow ;
		    Lx [p3] = Lx [p2] ;
		}
		else
		{
		    /* new entry in Lj' */
		    ASSERT (smax >= 0 && smax < nsets) ;
		    Set_ps2 [smax]-- ;
		    p3-- ;
		    Li [p3] = maxrow ;
		    Lx [p3] = 0.0 ;
		    if (Set_ps1 [smax] == Set_ps2 [smax])
		    {
			/* nothing more in this set */
			nsets-- ;
			Set_ps1 [smax] = Set_ps1 [nsets] ;
			Set_ps2 [smax] = Set_ps2 [nsets] ;
			PRINT1 (("Set "ID" now empty\n", smax)) ;
		    }
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* 2-set merge: */
	    /* -------------------------------------------------------------- */

	    /* This the same as the multi-set merge, except there is only one
	     * set s = 0 left.  The source column j and the set 0 are being
	     * merged into the target column j. */

	    if (nsets > 0)
	    {
		ps1 = Set_ps1 [0] ;
		ps2 = Set_ps2 [0] ;
	    }

	    while (p3 > p2)
	    {

#ifndef NDEBUG
		PRINT2 (("\n2-set merge.\n")) ;
		ASSERT (nsets == 1) ;
		PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n",
			    p1, p2, p3)) ;
		for (p = p1 + 1 ; p < p2 ; p++)
		{
		    PRINT2 (("    p: "ID" source row "ID" %g\n",
				p, Li[p], Lx[p])) ;
		    ASSERT (Li [p] > j && Li [p] < n) ;
		}
		PRINT2 (("---\n")) ;
		for (p = p3 ; p < p1 + newlnz ; p++)
		{
		    PRINT2 (("    p: "ID" target row "ID" %g\n",
				p, Li[p], Lx[p])) ;
		    ASSERT (Li [p] > j && Li [p] <  n) ;
		}
		dump_set (0, Set_ps1, Set_ps2, j, n, Common) ;
#endif

		if (p2 == p1 + 1)
		{
		    /* the top of Lj is empty; copy the set and quit */
		    while (p3 > p2)
		    {
			/* new entry in Lj' */
			row = *(--ps2) ;
			p3-- ;
			Li [p3] = row ;
			Lx [p3] = 0.0 ;
		    }
		}
		else
		{
		    /* get the entry at the tail end of Lj */
		    row1 = Li [p2 - 1] ;
		    ASSERT (row1 > j && row1 < n) ;
		    /* get the entry at the tail end of the incoming set */
		    ASSERT (ps1 < ps2) ;
		    row = *(ps2-1) ;
		    ASSERT (row > j && row1 < n) ;
		    /* move the larger of the two entries to the target set */
		    if (row1 >= row)
		    {
			/* next entry is in Lj, move to the bottom */
			if (row1 == row)
			{
			    /* skip past this entry in the set */
			    ps2-- ;
			}
			p2-- ;
			p3-- ;
			Li [p3] = row1 ;
			Lx [p3] = Lx [p2] ;
		    }
		    else
		    {
			/* new entry in Lj' */
			ps2-- ;
			p3-- ;
			Li [p3] = row ;
			Lx [p3] = 0.0 ;
		    }
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* The new column j of L is now in Li/Lx [p1 ... p2-1] */
	    /* -------------------------------------------------------------- */

	    p2 = p1 + newlnz ;
	    DEBUG (dump_col ("After merge: ", j, p1, p2, Li, Lx, n, Common)) ;

	    fl += Path [path].rank * (6 + 4 * (double) newlnz) ;

	    /* -------------------------------------------------------------- */
	    /* clear Flag; original pattern of column j L no longer marked */
	    /* -------------------------------------------------------------- */

	    mark = CHOLMOD(clear_flag) (Common) ;
	    scattered = FALSE ;

	    /* -------------------------------------------------------------- */
	    /* find the new parent */
	    /* -------------------------------------------------------------- */

	    newparent = (newlnz > 1) ? (Li [p1 + 1]) : EMPTY ;
	    PRINT1 (("\nNew parent, Lnz: "ID": "ID" "ID"\n",
			j, newparent,newlnz));
	    ASSERT (oldparent == EMPTY || newparent <= oldparent) ;

	    /* -------------------------------------------------------------- */
	    /* go to the next node in the path */
	    /* -------------------------------------------------------------- */

	    /* path moves to (j,nextj) unless j is a root */
	    nextj = (newparent == EMPTY) ? n : newparent ;

	    /* place path at head of list for nextj, or terminate the path */
	    PRINT1 (("\n j = "ID" nextj = "ID"\n\n", j, nextj)) ;
	    Path [path].c = j ;
	    if (nextj < n)
	    {
		/* put path on link list of pending paths at column nextj */
		Path [path].next = Head [nextj] ;
		Path [path].pending = nextj ;
		Head [nextj] = path ;
		PRINT1 (("Path "ID" continues to ("ID","ID").  Rank "ID"\n",
		    path, Path [path].c, nextj, Path [path].rank)) ;
	    }
	    else
	    {
		/* path has ended here, at a root */
		Path [path].next = EMPTY ;
		Path [path].pending = EMPTY ;
		Path [path].end = j ;
		PRINT1 (("Path "ID" ends at root ("ID").  Rank "ID"\n",
		    path, Path [path].end, Path [path].rank)) ;
	    }

	    /* The link list Head [j] can now be emptied.  Set Head [j] to 1
	     * if column j has changed (it is no longer used as a link list). */
	    PRINT1 (("column "ID", oldlnz = "ID"\n", j, Lnz [j])) ;
	    Head [j] = (Lnz [j] != newlnz) ? 1 : EMPTY ;
	    Lnz [j] = newlnz ;
	    PRINT1 (("column "ID", newlnz = "ID"\n", j, newlnz)) ;
	    DEBUG (dump_col ("New", j, p1, p2, Li, Lx, n, Common)) ;

	    /* move to the next column */
	    if (k == Path [path].rank)
	    {
		/* only one path left */
		j = nextj ;
	    }
	    else
	    {
		/* The current path is moving from column j to column nextj
		 * (nextj is n if the path has ended).  However, there may be
		 * other paths pending in columns j+1 to nextj-1.  There are
		 * two methods for looking for the next column with a pending
		 * update.  The first one looks at all columns j+1 to nextj-1
		 * for a non-empty link list.  This can be costly if j and
		 * nextj differ by a large amount (it can be O(n), but this
		 * entire routine may take Omega(1) time).  The second method
		 * looks at all paths and finds the smallest column at which any
		 * path is pending.  It takes O(# of paths), which is bounded
		 * by 23: one for each column of C (up to 8), and then 15 for a
		 * balanced binary tree with 8 leaves.  However, if j and
		 * nextj differ by a tiny amount (nextj is often j+1 near
		 * the end of the matrix), looking at columns j+1 to nextj
		 * would be faster.  Both methods give the same answer. */

		if (nextj - j < npaths)
		{
		    /* there are fewer columns to search than paths */
		    PRINT1 (("check j="ID" to nextj="ID"\n", j, nextj)) ;
		    for (j2 = j + 1 ; j2 < nextj ; j2++)
		    {
			PRINT1 (("check j="ID" "ID"\n", j2, Head [j2])) ;
			if (Head [j2] != EMPTY)
			{
			    PRINT1 (("found, j="ID"\n", j2)) ;
			    ASSERT (Path [Head [j2]].pending == j2) ;
			    break ;
			}
		    }
		}
		else
		{
		    /* there are fewer paths than columns to search */
		    j2 = nextj ;
		    for (kk = 0 ; kk < npaths ; kk++)
		    {
			jj = Path [kk].pending ;
			PRINT2 (("Path "ID" pending at "ID"\n", kk, jj)) ;
			if (jj != EMPTY) j2 = MIN (j2, jj) ;
		    }
		}
		j = j2 ;
	    }
	}

	/* ensure workspaces are back to the values required on input */
	ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ;

	/* ------------------------------------------------------------------ */
	/* depth-first-search of tree to order the paths */
	/* ------------------------------------------------------------------ */

	/* create lists of child paths */
	PRINT1 (("\n\nDFS search:\n\n")) ;
	for (path = 0 ; path < npaths ; path++)
	{
	    Path [path].c = EMPTY ;	    /* first child of path */
	    Path [path].next = EMPTY ;	    /* next sibling of path */
	    Path [path].order = EMPTY ;	    /* path is not ordered yet */
	    Path [path].wfirst = EMPTY ;    /* 1st column of W not found yet */

#ifndef NDEBUG
	    j = Path [path].start ;
	    PRINT1 (("Path "ID" : start "ID" end "ID" parent "ID" ccol "ID"\n", 
	    path, j, Path [path].end, Path [path].parent, Path [path].ccol)) ;
	    for ( ; ; )
	    {
		PRINT1 (("	column "ID"\n", j)) ;
		ASSERT (j == EMPTY || (j >= 0 && j < n)) ;
		if (j == Path [path].end)
		{
		    break ;
		}
		ASSERT (j >= 0 && j < n) ;
		j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ;
	    }
#endif
	}

	for (path = 0 ; path < npaths ; path++)
	{
	    p = Path [path].parent ;	/* add path to child list of parent */
	    if (p != EMPTY)
	    {
		ASSERT (p < npaths) ;
		Path [path].next = Path [p].c ;
		Path [p].c = path ;
	    }
	}

	path_order = k ;
	w_order = 0 ;
	for (path = npaths-1 ; path >= 0 ; path--)
	{
	    if (Path [path].order == EMPTY)
	    {
		/* this path is the root of a subtree of Tbar */
		PRINT1 (("Root path "ID"\n", path)) ;
		ASSERT (path >= k) ;
		dfs (Path, k, path, &path_order, &w_order, 0, npaths) ;
	    }
	}
	ASSERT (path_order == npaths) ;
	ASSERT (w_order == k) ;

	/* reorder the paths */
	for (path = 0 ; path < npaths ; path++)
	{
	    /* old order is path, new order is Path [path].order */
	    OrderedPath [Path [path].order] = Path [path] ;
	}

#ifndef NDEBUG
	for (path = 0 ; path < npaths ; path++)
	{
	    PRINT1 (("Ordered Path "ID": start "ID" end "ID" wfirst "ID" rank "
		    ""ID" ccol "ID"\n", path, OrderedPath [path].start,
		    OrderedPath [path].end, OrderedPath [path].wfirst,
		    OrderedPath [path].rank, OrderedPath [path].ccol)) ;
	    if (path < k)
	    {
		ASSERT (OrderedPath [path].ccol >= 0) ;
	    }
	    else
	    {
		ASSERT (OrderedPath [path].ccol == EMPTY) ;
	    }
	}
#endif

	/* ------------------------------------------------------------------ */
	/* numeric update/downdate for all paths */
	/* ------------------------------------------------------------------ */

	ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;

	switch (wdim)
	{
	    case 1:
		updown_1_r (update, C, k, L, W, OrderedPath, npaths, mask,
		    Common) ;
		break ;
	    case 2:
		updown_2_r (update, C, k, L, W, OrderedPath, npaths, mask,
		    Common) ;
		break ;
	    case 4:
		updown_4_r (update, C, k, L, W, OrderedPath, npaths, mask,
		    Common) ;
		break ;
	    case 8:
		updown_8_r (update, C, k, L, W, OrderedPath, npaths, mask,
		    Common) ;
		break ;
	}

	ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
    }

    /* ---------------------------------------------------------------------- */
    /* update/downdate the forward solve */
    /* ---------------------------------------------------------------------- */

    if (do_solve)
    {
	/* We now have DeltaB += Lold (:,j) * X (j) for all columns j in union
	 * of all paths seen during the entire rank-cncol update/downdate. For
	 * each j in path, do DeltaB -= Lnew (:,j)*DeltaB(j) 
	 * in topological order. */

#ifndef NDEBUG
	PRINT1 (("\ndo_solve, DeltaB + Lold(:,Path)*X(Path):\n")) ;
	for (i = 0 ; i < n ; i++)
	{
	    PRINT1 (("do_solve: "ID" %30.20e\n", i, Nx [i])) ;
	}
#endif

	/* Note that the downdate, if it deleted entries, would need to compute
	 * the Stack prior to doing any downdates. */

	/* find the union of all the paths in the new L */
	top = n ;	/* "top" is stack pointer, not a row or column index */
	for (ccol = 0 ; ccol < cncol ; ccol++)
	{

	    /* -------------------------------------------------------------- */
	    /* j = first row index of C (:,ccol) */
	    /* -------------------------------------------------------------- */

	    pp1 = Cp [ccol] ;
	    pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
	    if (pp2 > pp1)
	    {
		/* Column ccol of C has at least one entry. */
		j = Ci [pp1] ;
	    }
	    else
	    {
		/* Column ccol of C is empty */
		j = n-1 ;
	    }
	    PRINT1 (("\ndo_solve:      ccol= "ID"\n", ccol)) ;
	    ASSERT (j >= 0 && j < n) ;
	    len = 0 ;

	    /* -------------------------------------------------------------- */
	    /* find the new rowmark */
	    /* -------------------------------------------------------------- */

	    /* Each column of C can redefine the region of L that takes part in
	     * the update/downdate of the triangular solve Lx=b.  If
	     * i = colmark [ccol] for column C(:,ccol), then i = rowmark [j] is
	     * redefined for all columns along the path modified by C(:,ccol).
	     * If more than one column modifies any given column j of L, then
	     * the rowmark of j is determined by the colmark of the least-
	     * numbered column that affects column j.  That is, if both
	     * C(:,ccol1) and C(:,ccol2) affect column j of L, then
	     * rowmark [j] = colmark [MIN (ccol1, ccol2)].
	     *
	     * rowmark [j] is not modified if rowmark or colmark are NULL,
	     * or if colmark [ccol] is EMPTY.
	     */

	    botrow = (use_colmark) ? (colmark [ccol]) : EMPTY ;

	    /* -------------------------------------------------------------- */
	    /* traverse from j towards root, stopping if node already visited */
	    /* -------------------------------------------------------------- */

	    while (j != EMPTY && Flag [j] < mark)
	    {
		PRINT1 (("do_solve: subpath j= "ID"\n", j)) ;
		ASSERT (j >= 0 && j < n) ;
		Stack [len++] = j ;		/* place j on the stack */
		Flag [j] = mark ;		/* flag j as visited */

		/* if using colmark, mark column j with botrow */
		ASSERT (Li [Lp [j]] == j) ;	/* diagonal is always present */
		if (use_colmark)
		{
		    Li [Lp [j]] = botrow ;	/* use the space for botrow */
		}

		/* go up the tree, to the parent of j */
		j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ;
	    }

	    /* -------------------------------------------------------------- */
	    /* move the path down to the bottom of the stack */
	    /* -------------------------------------------------------------- */

	    ASSERT (len <= top) ;
	    while (len > 0)
	    {
		Stack [--top] = Stack [--len] ;
	    }
	}

#ifndef NDEBUG
	/* Union of paths now in Stack [top..n-1] in topological order */
	PRINT1 (("\nTopological order:\n")) ;
	for (i = top ; i < n ; i++)
	{
	    PRINT1 (("column "ID" in full path\n", Stack [i])) ;
	}
#endif

	/* Do the forward solve for the full path part of L */
	for (m = top ; m < n ; m++)
	{
	    j = Stack [m] ;
	    ASSERT (j >= 0 && j < n) ;
	    PRINT1 (("do_solve: path j= "ID"\n", j)) ;
	    p1 = Lp [j] ;
	    lnz = Lnz [j] ;
	    p2 = p1 + lnz ;
	    xj = Nx [j] ;

	    /* copy new solution onto old one, for all cols in full path */
	    Xx [j] = xj ;
	    Nx [j] = 0. ;

	    /* DeltaB -= Lnew (j+1:botrow-1,j) * deltab(j) */
	    if (use_colmark)
	    {
		botrow = Li [p1] ;	/* get botrow */
		Li [p1] = j ;		/* restore diagonal entry */
		for (p = p1 + 1 ; p < p2 ; p++)
		{
		    i = Li [p] ;
		    if (i >= botrow) break ;
		    Nx [i] -= Lx [p] * xj ;
		}
	    }
	    else
	    {
		for (p = p1 + 1 ; p < p2 ; p++)
		{
		    Nx [Li [p]] -= Lx [p] * xj ;
		}
	    }
	}

	/* clear the Flag */
	mark = CHOLMOD(clear_flag) (Common) ;
    }

    /* ---------------------------------------------------------------------- */
    /* successful update/downdate */
    /* ---------------------------------------------------------------------- */

    Common->modfl = fl ;
    DEBUG (for (j = 0 ; j < n ; j++) ASSERT (IMPLIES (do_solve, Nx[j] == 0.))) ;
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ;
    DEBUG (CHOLMOD(dump_factor) (L, "output L for updown", Common)) ;
    return (TRUE) ;
}
UF_long CHOLMOD(postorder)	/* return # of nodes postordered */
(
    /* ---- input ---- */
    Int *Parent,	/* size n. Parent [j] = p if p is the parent of j */
    size_t n,
    Int *Weight,	/* size n, optional. Weight [j] is weight of node j */
    /* ---- output --- */
    Int *Post,		/* size n. Post [k] = j is kth in postordered tree */
    /* --------------- */
    cholmod_common *Common
)
{
    Int *Head, *Next, *Pstack, *Iwork ;
    Int j, p, k, w, nextj ;
    size_t s ;
    int ok = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (EMPTY) ;
    RETURN_IF_NULL (Parent, EMPTY) ;
    RETURN_IF_NULL (Post, EMPTY) ;
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    /* s = 2*n */
    s = CHOLMOD(mult_size_t) (n, 2, &ok) ;
    if (!ok)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	return (EMPTY) ;
    }

    CHOLMOD(allocate_work) (n, s, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (EMPTY) ;
    }
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    Head  = Common->Head ;	/* size n+1, initially all EMPTY */
    Iwork = Common->Iwork ;
    Next  = Iwork ;		/* size n (i/i/l) */
    Pstack = Iwork + n ;	/* size n (i/i/l) */

    /* ---------------------------------------------------------------------- */
    /* construct a link list of children for each node */
    /* ---------------------------------------------------------------------- */

    if (Weight == NULL)
    {

	/* in reverse order so children are in ascending order in each list */
	for (j = n-1 ; j >= 0 ; j--)
	{
	    p = Parent [j] ;
	    if (p >= 0 && p < ((Int) n))
	    {
		/* add j to the list of children for node p */
		Next [j] = Head [p] ;
		Head [p] = j ;
	    }
	}

	/* Head [p] = j if j is the youngest (least-numbered) child of p */
	/* Next [j1] = j2 if j2 is the next-oldest sibling of j1 */

    }
    else
    {

	/* First, construct a set of link lists according to Weight.
	 *
	 * Whead [w] = j if node j is the first node in bucket w.
	 * Next [j1] = j2 if node j2 follows j1 in a link list.
	 */

	Int *Whead = Pstack ;	    /* use Pstack as workspace for Whead [ */

	for (w = 0 ; w < ((Int) n) ; w++)
	{
	    Whead [w] = EMPTY ;
	}
	/* do in forward order, so nodes that ties are ordered by node index */
	for (j = 0 ; j < ((Int) n) ; j++)
	{
	    p = Parent [j] ;
	    if (p >= 0 && p < ((Int) n))
	    {
		w = Weight [j] ;
		w = MAX (0, w) ;
		w = MIN (w, ((Int) n) - 1) ;
		/* place node j at the head of link list for weight w */
		Next [j] = Whead [w] ;
		Whead [w] = j ;
	    }
	}

	/* traverse weight buckets, placing each node in its parent's list */
	for (w = n-1 ; w >= 0 ; w--)
	{
	    for (j = Whead [w] ; j != EMPTY ; j = nextj)
	    {
		nextj = Next [j] ;
		/* put node j in the link list of its parent */
		p = Parent [j] ;
		ASSERT (p >= 0 && p < ((Int) n)) ;
		Next [j] = Head [p] ;
		Head [p] = j ;
	    }
	}

	/* Whead no longer needed ] */
	/* Head [p] = j if j is the lightest child of p */
	/* Next [j1] = j2 if j2 is the next-heaviest sibling of j1 */
    }

    /* ---------------------------------------------------------------------- */
    /* start a DFS at each root node of the etree */
    /* ---------------------------------------------------------------------- */

    k = 0 ;
    for (j = 0 ; j < ((Int) n) ; j++)
    {
	if (Parent [j] == EMPTY)
	{
	    /* j is the root of a tree; start a DFS here */
	    k = trilinos_dfs (j, k, Post, Head, Next, Pstack) ;
	}
    }

    /* this would normally be EMPTY already, unless Parent is invalid */
    for (j = 0 ; j < ((Int) n) ; j++)
    {
	Head [j] = EMPTY ;
    }

    PRINT1 (("postordered "ID" nodes\n", k)) ;
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;
    return (k) ;
}
Exemple #11
0
void
gsl_integration_qaws_table_free (gsl_integration_qaws_table * t)
{
  RETURN_IF_NULL (t);
  free (t);
}
Exemple #12
0
static void init_p(int argc, const char **argv)
{
	RETURN_IF_NULL(if_pan);

	EXEC(if_pan->init, &pan_cbacks);
}
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 <= j))
	{
	    /* 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) ;
}
Exemple #14
0
int CHOLMOD(rowfac_mask)
(
    /* ---- 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] >= 0 row i is set to zero */
    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, RLinkUp, L, Common) ;
		break ;

	    case CHOLMOD_COMPLEX:
		ok = c_cholmod_rowfac_mask (A, F, beta, kstart, kend,
		    mask, RLinkUp, L, Common) ;
		break ;

	    case CHOLMOD_ZOMPLEX:
		ok = z_cholmod_rowfac_mask (A, F, beta, kstart, kend,
		    mask, RLinkUp, L, Common) ;
		break ;
	}
    }

    return (ok) ;
}
Exemple #15
0
cholmod_triplet *CHOLMOD(sparse_to_triplet)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to copy */
    /* --------------- */
    cholmod_common *Common
)
{
    double *Ax, *Az, *Tx, *Tz ;
    Int *Ap, *Ai, *Ti, *Tj, *Anz ;
    cholmod_triplet *T ;
    Int i, xtype, p, pend, k, j, nrow, ncol, nz, stype, packed, up, lo,
	both ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (NULL) ;
    RETURN_IF_NULL (A, NULL) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
    stype = SIGN (A->stype) ;
    nrow = A->nrow ;
    ncol = A->ncol ;
    if (stype && nrow != ncol)
    {
	/* inputs invalid */
	ERROR (CHOLMOD_INVALID, "matrix invalid") ;
	return (NULL) ;
    }
    Ax = A->x ;
    Az = A->z ;
    xtype = A->xtype ;
    Common->status = CHOLMOD_OK ;

    ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;

    /* ---------------------------------------------------------------------- */
    /* allocate triplet matrix */
    /* ---------------------------------------------------------------------- */

    nz = CHOLMOD(nnz) (A, Common) ;
    T = CHOLMOD(allocate_triplet) (nrow, ncol, nz, A->stype, A->xtype, Common) ;

    if (Common->status < CHOLMOD_OK)
    {
	return (NULL) ;	    /* out of memory */
    }

    /* ---------------------------------------------------------------------- */
    /* convert to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    Ap = A->p ;
    Ai = A->i ;
    Anz = A->nz ;
    packed = A->packed ;

    Ti = T->i ;
    Tj = T->j ;
    Tx = T->x ;
    Tz = T->z ;
    T->stype = A->stype ;

    both = (A->stype == 0) ;
    up = (A->stype > 0) ;
    lo = (A->stype < 0) ;

    k = 0 ;

    for (j = 0 ; j < ncol ; j++)
    {
	p = Ap [j] ;
	pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
	for ( ; p < pend ; p++)
	{
	    i = Ai [p] ;
	    if (both || (up && i <= j) || (lo && i >= j))
	    {
		Ti [k] = Ai [p] ;
		Tj [k] = j ;

		if (xtype == CHOLMOD_REAL)
		{
		    Tx [k] = Ax [p] ;
		}
		else if (xtype == CHOLMOD_COMPLEX)
		{
		    Tx [2*k  ] = Ax [2*p  ] ;
		    Tx [2*k+1] = Ax [2*p+1] ;
		}
		else if (xtype == CHOLMOD_ZOMPLEX)
		{
		    Tx [k] = Ax [p] ;
		    Tz [k] = Az [p] ;
		}

		k++ ;
		ASSERT (k <= nz) ;
	    }
	}
    }

    T->nnz = k ;

    /* ---------------------------------------------------------------------- */
    /* return result */
    /* ---------------------------------------------------------------------- */

    ASSERT (CHOLMOD(dump_triplet) (T, "T", Common)) ;
    return (T) ;
}
int CHOLMOD(rowcolcounts)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to analyze */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    Int *Parent,	/* size nrow.  Parent [i] = p if p is the parent of i */
    Int *Post,		/* size nrow.  Post [k] = i if i is the kth node in
			 * the postordered etree. */
    /* ---- output --- */
    Int *RowCount,	/* size nrow. RowCount [i] = # entries in the ith row of
			 * L, including the diagonal. */
    Int *ColCount,	/* size nrow. ColCount [i] = # entries in the ith
			 * column of L, including the diagonal. */
    Int *First,		/* size nrow.  First [i] = k is the least postordering
			 * of any descendant of i. */
    Int *Level,		/* size nrow.  Level [i] is the length of the path from
			 * i to the root, with Level [root] = 0. */
    /* --------------- */
    cholmod_common *Common
)
{
    double fl, ff ;
    Int *Ap, *Ai, *Anz, *PrevNbr, *SetParent, *Head, *PrevLeaf, *Anext, *Ipost,
	*Iwork ;
    Int i, j, r, k, len, s, p, pend, inew, stype, nf, anz, inode, parent,
	nrow, ncol, packed, use_fset, jj ;
    size_t w ;
    int ok = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;
    RETURN_IF_NULL (Parent, FALSE) ;
    RETURN_IF_NULL (Post, FALSE) ;
    RETURN_IF_NULL (ColCount, FALSE) ;
    RETURN_IF_NULL (First, FALSE) ;
    RETURN_IF_NULL (Level, FALSE) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    stype = A->stype ;
    if (stype > 0)
    {
	/* symmetric with upper triangular part not supported */
	ERROR (CHOLMOD_INVALID, "symmetric upper not supported") ;
	return (FALSE) ;
    }
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    nrow = A->nrow ;	/* the number of rows of A */
    ncol = A->ncol ;	/* the number of columns of A */

    /* w = 2*nrow + (stype ? 0 : ncol) */
    w = CHOLMOD(mult_size_t) (nrow, 2, &ok) ;
    w = CHOLMOD(add_size_t) (w, (stype ? 0 : ncol), &ok) ;
    if (!ok)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	return (FALSE) ;
    }

    CHOLMOD(allocate_work) (nrow, w, 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }

    ASSERT (CHOLMOD(dump_perm) (Post, nrow, nrow, "Post", Common)) ;
    ASSERT (CHOLMOD(dump_parent) (Parent, nrow, "Parent", Common)) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    Ap = A->p ;	/* size ncol+1, column pointers for A */
    Ai = A->i ;	/* the row indices of A, of size nz=Ap[ncol+1] */
    Anz = A->nz ;
    packed = A->packed ;
    ASSERT (IMPLIES (!packed, Anz != NULL)) ;

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    Iwork = Common->Iwork ;
    SetParent = Iwork ;		    /* size nrow (i/i/l) */
    PrevNbr   = Iwork + nrow ;	    /* size nrow (i/i/l) */
    Anext     = Iwork + 2*((size_t) nrow) ;    /* size ncol (i/i/l) (unsym only) */
    PrevLeaf  = Common->Flag ;	    /* size nrow */
    Head      = Common->Head ;	    /* size nrow+1 (unsym only)*/

    /* ---------------------------------------------------------------------- */
    /* find the first descendant and level of each node in the tree */
    /* ---------------------------------------------------------------------- */

    /* First [i] = k if the postordering of first descendent of node i is k */
    /* Level [i] = length of path from node i to the root (Level [root] = 0) */

    for (i = 0 ; i < nrow ; i++)
    {
	First [i] = EMPTY ;
    }

    /* postorder traversal of the etree */
    for (k = 0 ; k < nrow ; k++)
    {
	/* node i of the etree is the kth node in the postordered etree */
	i = Post [k] ;

	/* i is a leaf if First [i] is still EMPTY */
	/* ColCount [i] starts at 1 if i is a leaf, zero otherwise */
	ColCount [i] = (First [i] == EMPTY) ? 1 : 0 ;

	/* traverse the path from node i to the root, stopping if we find a
	 * node r whose First [r] is already defined. */
	len = 0 ;
	for (r = i ; (r != EMPTY) && (First [r] == EMPTY) ; r = Parent [r])
	{
	    First [r] = k ;
	    len++ ;
	}
	if (r == EMPTY)
	{
	    /* we hit a root node, the level of which is zero */
	    len-- ;
	}
	else
	{
	    /* we stopped at node r, where Level [r] is already defined */
	    len += Level [r] ;
	}
	/* re-traverse the path from node i to r; set the level of each node */
	for (s = i ; s != r ; s = Parent [s])
	{
	    Level [s] = len-- ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* AA' case: sort columns of A according to first postordered row index */
    /* ---------------------------------------------------------------------- */

    fl = 0.0 ;
    if (stype == 0)
    {
	/* [ use PrevNbr [0..nrow-1] as workspace for Ipost */
	Ipost = PrevNbr ;
	/* Ipost [i] = k if i is the kth node in the postordered etree. */
	for (k = 0 ; k < nrow ; k++)
	{
	    Ipost [Post [k]] = k ;
	}
	use_fset = (fset != NULL) ;
	if (use_fset)
	{
	    nf = fsize ;
	    /* clear Anext to check fset */
	    for (j = 0 ; j < ncol ; j++)
	    {
		Anext [j] = -2 ;
	    }
	    /* find the first postordered row in each column of A (post,f)
	     * and place the column in the corresponding link list */
	    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") ;
		    return (FALSE) ;
		}
		/* flag column j as having been seen */
		Anext [j] = EMPTY ;
	    }
	    /* 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 in the fset; find the smallest row (if any) */
	    p = Ap [j] ;
	    pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
	    ff = (double) MAX (0, pend - p) ;
	    fl += ff*ff + ff ;
	    if (pend > p)
	    {
		k = Ipost [Ai [p]] ;
		for ( ; p < pend ; p++)
		{
		    inew = Ipost [Ai [p]] ;
		    k = MIN (k, inew) ;
		}
		/* place column j in link list k */
		ASSERT (k >= 0 && k < nrow) ;
		Anext [j] = Head [k] ;
		Head [k] = j ;
	    }
	}
	/* Ipost no longer needed for inverse postordering ]
	 * Head [k] contains a link list of all columns whose first
	 * postordered row index is equal to k, for k = 0 to nrow-1. */
    }

    /* ---------------------------------------------------------------------- */
    /* compute the row counts and node weights */
    /* ---------------------------------------------------------------------- */

    if (RowCount != NULL)
    {
	for (i = 0 ; i < nrow ; i++)
	{
	    RowCount [i] = 1 ;
	}
    }
    for (i = 0 ; i < nrow ; i++)
    {
	PrevLeaf [i] = EMPTY ;
	PrevNbr [i] = EMPTY ;
	SetParent [i] = i ;	/* every node is in its own set, by itself */
    }

    if (stype != 0)
    {

	/* ------------------------------------------------------------------ */
	/* symmetric case: LL' = A */
	/* ------------------------------------------------------------------ */

	/* also determine the number of entries in triu(A) */
	anz = nrow ;
	for (k = 0 ; k < nrow ; k++)
	{
	    /* j is the kth node in the postordered etree */
	    j = initialize_node (k, Post, Parent, ColCount, PrevNbr) ;

	    /* for all nonzeros A(i,j) below the diagonal, in column j of A */
	    p = Ap [j] ;
	    pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
	    for ( ; p < pend ; p++)
	    {
		i = Ai [p] ;
		if (i > j)
		{
		    /* j is a descendant of i in etree(A) */
		    anz++ ;
		    process_edge (j, i, k, First, PrevNbr, ColCount,
			    PrevLeaf, RowCount, SetParent, Level) ;
		}
	    }
	    /* update SetParent: UNION (j, Parent [j]) */
	    finalize_node (j, Parent, SetParent) ;
	}
	Common->anz = anz ;
    }
    else
    {

	/* ------------------------------------------------------------------ */
	/* unsymmetric case: LL' = AA' */
	/* ------------------------------------------------------------------ */

	for (k = 0 ; k < nrow ; k++)
	{
	    /* inode is the kth node in the postordered etree */
	    inode = initialize_node (k, Post, Parent, ColCount, PrevNbr) ;

	    /* for all cols j whose first postordered row is k: */
	    for (j = Head [k] ; j != EMPTY ; j = Anext [j])
	    {
		/* k is the first postordered row in column j of A */
		/* for all rows i in column j: */
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    /* has i already been considered at this step k */
		    if (PrevNbr [i] < k)
		    {
			/* inode is a descendant of i in etree(AA') */
			/* process edge (inode,i) and set PrevNbr[i] to k */
			process_edge (inode, i, k, First, PrevNbr, ColCount,
				PrevLeaf, RowCount, SetParent, Level) ;
		    }
		}
	    }
	    /* clear link list k */
	    Head [k] = EMPTY ;
	    /* update SetParent: UNION (inode, Parent [inode]) */
	    finalize_node (inode, Parent, SetParent) ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* finish computing the column counts */
    /* ---------------------------------------------------------------------- */

    for (j = 0 ; j < nrow ; j++)
    {
	parent = Parent [j] ;
	if (parent != EMPTY)
	{
	    /* add the ColCount of j to its parent */
	    ColCount [parent] += ColCount [j] ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* clear workspace */
    /* ---------------------------------------------------------------------- */

    Common->mark = EMPTY ;
    /* CHOLMOD(clear_flag) (Common) ; */
    CHOLMOD_CLEAR_FLAG (Common) ;

    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* flop count and nnz(L) for subsequent LL' numerical factorization */
    /* ---------------------------------------------------------------------- */

    /* use double to avoid integer overflow.  lnz cannot be NaN. */
    Common->aatfl = fl ;
    Common->lnz = 0. ;
    fl = 0 ;
    for (j = 0 ; j < nrow ; j++)
    {
	ff = (double) (ColCount [j]) ;
	Common->lnz += ff ;
	fl += ff*ff ;
    }

    Common->fl = fl ;
    PRINT1 (("rowcol fl %g lnz %g\n", Common->fl, Common->lnz)) ;

    return (TRUE) ;
}
Exemple #17
0
cholmod_triplet *CHOLMOD(copy_triplet)
(
    /* ---- input ---- */
    cholmod_triplet *T,	/* matrix to copy */
    /* --------------- */
    cholmod_common *Common
)
{
    double *Tx, *Tz, *Cx, *Cz ;
    Int *Ci, *Cj, *Ti, *Tj ;
    cholmod_triplet *C ;
    Int xtype, k, nz ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (NULL) ;
    RETURN_IF_NULL (T, NULL) ;
    RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
    nz = T->nnz ;
    Ti = T->i ;
    Tj = T->j ;
    Tx = T->x ;
    Tz = T->z ;
    xtype = T->xtype ;
    RETURN_IF_NULL (Ti, NULL) ;
    RETURN_IF_NULL (Tj, NULL) ;
    Common->status = CHOLMOD_OK ;
    DEBUG (CHOLMOD(dump_triplet) (T, "T input", Common)) ;

    /* ---------------------------------------------------------------------- */
    /* allocate copy */
    /* ---------------------------------------------------------------------- */

    C = CHOLMOD(allocate_triplet) (T->nrow, T->ncol, T->nzmax, T->stype,
	    xtype, Common) ;

    if (Common->status < CHOLMOD_OK)
    {
	return (NULL) ;	    /* out of memory */
    }

    /* ---------------------------------------------------------------------- */
    /* copy the triplet matrix */
    /* ---------------------------------------------------------------------- */

    Ci = C->i ;
    Cj = C->j ;
    Cx = C->x ;
    Cz = C->z ;
    C->nnz = nz ;

    for (k = 0 ; k < nz ; k++)
    {
	Ci [k] = Ti [k] ;
    }
    for (k = 0 ; k < nz ; k++)
    {
	Cj [k] = Tj [k] ;
    }

    if (xtype == CHOLMOD_REAL)
    {
	for (k = 0 ; k < nz ; k++)
	{
	    Cx [k] = Tx [k] ;
	}
    }
    else if (xtype == CHOLMOD_COMPLEX)
    {
	for (k = 0 ; k < nz ; k++)
	{
	    Cx [2*k  ] = Tx [2*k  ] ;
	    Cx [2*k+1] = Tx [2*k+1] ;
	}
    }
    else if (xtype == CHOLMOD_ZOMPLEX)
    {
	for (k = 0 ; k < nz ; k++)
	{
	    Cx [k] = Tx [k] ;
	    Cz [k] = Tz [k] ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* return the result */
    /* ---------------------------------------------------------------------- */

    ASSERT (CHOLMOD(dump_triplet) (C, "C triplet copy", Common)) ;
    return (C) ;
}
cholmod_sparse *CHOLMOD(horzcat)
(
    /* ---- 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, ancol, bncol, 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->nrow != B->nrow)
    {
	/* A and B must have the same number of rows */
	ERROR (CHOLMOD_INVALID, "A and B must have same # rows") ;
	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 */
    /* ---------------------------------------------------------------------- */

    ancol = A->ncol ;
    bncol = B->ncol ;
    nrow = A->nrow ;
    CHOLMOD(allocate_work) (0, MAX3 (nrow, ancol, bncol), 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) ;
    ncol = ancol + bncol ;
    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 ;

    /* copy A as the first A->ncol columns of C */
    for (j = 0 ; j < ancol ; j++)
    {
	/* A(:,j) is the jth column of C */
	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++ ;
	}
    }

    /* copy B as the next B->ncol columns of C */
    for (j = 0 ; j < bncol ; j++)
    {
	/* B(:,j) is the (ancol+j)th column of C */
	p = Bp [j] ;
	pend = (bpacked) ? (Bp [j+1]) : (p + Bnz [j]) ;
	Cp [ancol + j] = pdest ;
	for ( ; p < pend ; p++)
	{
	    Ci [pdest] = Bi [p] ;
	    if (values) Cx [pdest] = Bx [p] ;
	    pdest++ ;
	}
    }
    Cp [ncol] = pdest ;
    ASSERT (pdest == anz + bnz) ;

    /* ---------------------------------------------------------------------- */
    /* 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(rowdel_mark)
(
    /* ---- input ---- */
    size_t kdel,	/* row/column index to delete */
    cholmod_sparse *R,	/* NULL, or the nonzero pattern of kth row of L */
    double yk [2],	/* kth entry in the solution to A*y=b */
    Int *colmark,	/* Int array of size 1.  See cholmod_updown.c */
    /* ---- in/out --- */
    cholmod_factor *L,	/* factor to modify */
    cholmod_dense *X,	/* solution to Lx=b (size n-by-1) */
    cholmod_dense *DeltaB,  /* change in b, zero on output */
    /* --------------- */
    cholmod_common *Common
)
{
    double dk, sqrt_dk, xk, dj, fl ;
    double *Lx, *Cx, *W, *Xx, *Nx ;
    Int *Li, *Lp, *Lnz, *Ci, *Rj, *Rp, *Iwork ;
    cholmod_sparse *C, Cmatrix ;
    Int j, p, pend, kk, lnz, n, Cp [2], do_solve, do_update, left, k,
	right, middle, i, klast, given_row, rnz, ok ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (L, FALSE) ;
    RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
    n = L->n ;
    k = kdel ;
    if (k >= n || k < 0)
    {
	ERROR (CHOLMOD_INVALID, "k invalid") ;
	return (FALSE) ;
    }
    if (R == NULL)
    {
	Rj = NULL ;
	rnz = EMPTY ;
    }
    else
    {
	RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
	if (R->ncol != 1 || R->nrow != L->n)
	{
	    ERROR (CHOLMOD_INVALID, "R invalid") ;
	    return (FALSE) ;
	}
	Rj = R->i ;
	Rp = R->p ;
	rnz = Rp [1] ;
    }
    do_solve = (X != NULL) && (DeltaB != NULL) ;
    if (do_solve)
    {
	RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
	RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
	Xx = X->x ;
	Nx = DeltaB->x ;
	if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n ||
		DeltaB->ncol != 1 || Xx == NULL || Nx == NULL)
	{
	    ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ;
	    return (FALSE) ;
	}
    }
    else
    {
	Xx = NULL ;
	Nx = NULL ;
    }
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    CHOLMOD(allocate_work) (n, 2*n, 2*n, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (FALSE) ;
    }
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* convert to simplicial numeric LDL' factor, if not already */
    /* ---------------------------------------------------------------------- */

    if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) 
    {
	/* can only update/downdate a simplicial LDL' factorization */
	CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L,
		Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    /* out of memory, L is returned unchanged */
	    return (FALSE) ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    /* inputs, not modified on output: */
    Lp = L->p ;		/* size n+1 */

    /* outputs, contents defined on input for incremental case only: */
    Lnz = L->nz ;	/* size n */
    Li = L->i ;		/* size L->nzmax.  Can change in size. */
    Lx = L->x ;		/* size L->nzmax.  Can change in size. */

    ASSERT (L->nz != NULL) ;

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    W = Common->Xwork ; 	/* size n, used only in cholmod_updown */
    Cx = W + n ;		/* use 2nd column of Xwork for C (size n) */
    Iwork = Common->Iwork ;
    Ci = Iwork + n ;		/* size n (i/i/l) */
    /* NOTE: cholmod_updown uses Iwork [0..n-1] (i/i/l) as Stack */

    /* ---------------------------------------------------------------------- */
    /* prune row k from all columns of L */
    /* ---------------------------------------------------------------------- */

    given_row = (rnz >= 0) ;
    klast = given_row ? rnz : k ;
    PRINT2 (("given_row "ID"\n", given_row)) ;

    for (kk = 0 ; kk < klast ; kk++)
    {
	/* either search j = 0:k-1 or j = Rj [0:rnz-1] */
	j = given_row ? (Rj [kk]) : (kk) ;

	if (j < 0 || j >= k)
	{
	    ERROR (CHOLMOD_INVALID, "R invalid") ;
	    return (FALSE) ;
	}

	PRINT2 (("Prune col j = "ID":\n", j)) ;

	lnz = Lnz [j] ;
	dj = Lx [Lp [j]] ;
	ASSERT (Lnz [j] > 0 && Li [Lp [j]] == j) ;

	if (lnz > 1)
	{
	    left = Lp [j] ;
	    pend = left + lnz ;
	    right = pend - 1 ;

	    i = Li [right] ;

	    if (i < k)
	    {
		/* row k is not in column j */
		continue ;
	    }
	    else if (i == k)
	    {
		/* k is the last row index in this column (quick delete) */
		if (do_solve)
		{
		    Xx [j] -= yk [0] * dj * Lx [right] ;
		}
		Lx [right] = 0 ;
	    }
	    else
	    {
		/* binary search for row k in column j */
		PRINT2 (("\nBinary search: lnz "ID" k = "ID"\n", lnz, k)) ;
		while (left < right)
		{
		    middle = (left + right) / 2 ;
		    PRINT2 (("left "ID" right "ID" middle "ID": ["ID" "ID""
			""ID"]\n", left, right, middle,
			Li [left], Li [middle], Li [right])) ;
		    if (k > Li [middle])
		    {
			left = middle + 1 ;
		    }
		    else
		    {
			right = middle ;
		    }
		}
		ASSERT (left >= Lp [j] && left < pend) ;

#ifndef NDEBUG
		/* brute force, linear-time search */
		{
		    Int p3 = Lp [j] ;
		    i = EMPTY ;
		    PRINT2 (("Brute force:\n")) ;
		    for ( ; p3 < pend ; p3++)
		    {
			i = Li [p3] ;
			PRINT2 (("p "ID" ["ID"]\n", p3, i)) ;
			if (i >= k)
			{
			    break ;
			}
		    }
		    if (i == k)
		    {
			ASSERT (k == Li [p3]) ;
			ASSERT (p3 == left) ;
		    }
		}
#endif

		if (k == Li [left])
		{
		    if (do_solve)
		    {
			Xx [j] -= yk [0] * dj * Lx [left] ;
		    }
		    /* found row k in column j.  Prune it from the column.*/
		    Lx [left] = 0 ;
		}
	    }
	}
    }

#ifndef NDEBUG
    /* ensure that row k has been deleted from the matrix L */
    for (j = 0 ; j < k ; j++)
    {
	Int lasti ;
	lasti = EMPTY ;
	p = Lp [j] ;
	pend = p + Lnz [j] ;
	/* look for row k in column j */
	PRINT1 (("Pruned column "ID"\n", j)) ;
	for ( ; p < pend ; p++)
	{
	    i = Li [p] ;
	    PRINT2 ((" "ID"", i)) ;
	    PRINT2 ((" %g\n", Lx [p])) ;
	    ASSERT (IMPLIES (i == k, Lx [p] == 0)) ;
	    ASSERT (i > lasti) ;
	    lasti = i ;
	}
	PRINT1 (("\n")) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* set diagonal and clear column k of L */
    /* ---------------------------------------------------------------------- */

    lnz = Lnz [k] - 1 ;
    ASSERT (Lnz [k] > 0) ;

    /* ---------------------------------------------------------------------- */
    /* update/downdate */
    /* ---------------------------------------------------------------------- */

    /* update or downdate L (k+1:n, k+1:n) with the vector
     * C = L (:,k) * sqrt (abs (D [k]))
     * Do a numeric update if D[k] > 0, numeric downdate otherwise.
     */

    PRINT1 (("rowdel downdate lnz = "ID"\n", lnz)) ;

    /* store the new unit diagonal */
    p = Lp [k] ;
    pend = p + lnz + 1 ;
    dk = Lx [p] ;
    Lx [p++] = 1 ;
    PRINT2 (("D [k = "ID"] = %g\n", k, dk)) ;
    ok = TRUE ;
    fl = 0 ;

    if (lnz > 0)
    {
	/* compute DeltaB for updown (in DeltaB) */
	if (do_solve)
	{
	    xk = Xx [k] - yk [0] * dk ;
	    for ( ; p < pend ; p++)
	    {
		Nx [Li [p]] += Lx [p] * xk ;
	    }
	}

	do_update = IS_GT_ZERO (dk) ;
	if (!do_update)
	{
	    dk = -dk ;
	}
	sqrt_dk = sqrt (dk) ;
	p = Lp [k] + 1 ;
	for (kk = 0 ; kk < lnz ; kk++, p++)
	{
	    Ci [kk] = Li [p] ;
	    Cx [kk] = Lx [p] * sqrt_dk ;
	    Lx [p] = 0 ;		/* clear column k */
	}
	fl = lnz + 1 ;

	/* create a n-by-1 sparse matrix to hold the single column */
	C = &Cmatrix ;
	C->nrow = n ;
	C->ncol = 1 ;
	C->nzmax = lnz ;
	C->sorted = TRUE ;
	C->packed = TRUE ;
	C->p = Cp ;
	C->i = Ci ;
	C->x = Cx ;
	C->nz = NULL ;
	C->itype = L->itype ;
	C->xtype = L->xtype ;
	C->dtype = L->dtype ;
	C->z = NULL ;
	C->stype = 0 ;

	Cp [0] = 0 ;
	Cp [1] = lnz ;

	/* numeric update if dk > 0, and with Lx=b change */
	/* workspace: Flag (nrow), Head (nrow+1), W (nrow), Iwork (2*nrow) */
	ok = CHOLMOD(updown_mark) (do_update ? (1) : (0), C, colmark,
		L, X, DeltaB, Common) ;

	/* clear workspace */
	for (kk = 0 ; kk < lnz ; kk++)
	{
	    Cx [kk] = 0 ;
	}
    }

    Common->modfl += fl ;

    if (do_solve)
    {
	/* kth equation becomes identity, so X(k) is now Y(k) */
	Xx [k] = yk [0] ;
    }

    DEBUG (CHOLMOD(dump_factor) (L, "LDL factorization, L:", Common)) ;
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ;
    return (ok) ;
}
Exemple #20
0
static cholmod_sparse *band		/* returns C, or NULL if failure */
(
    /* ---- input or in/out if inplace is TRUE --- */
    cholmod_sparse *A,
    /* ---- input ---- */
    long k1,	    /* ignore entries below the k1-st diagonal */
    long k2,	    /* ignore entries above the k2-nd diagonal */
    int mode,	    /* >0: numerical, 0: pattern, <0: pattern (no diagonal) */
    int inplace,    /* if TRUE, then convert A in place */
    /* --------------- */
    cholmod_common *Common
)
{
    double *Ax, *Cx ;
    Int packed, nz, j, p, pend, i, ncol, nrow, jlo, jhi, ilo, ihi, sorted,
	values, diag ;
    Int *Ap, *Anz, *Ai, *Cp, *Ci ;
    cholmod_sparse *C ;

    /* ---------------------------------------------------------------------- */
    /* 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) ;
    packed = A->packed ;
    diag = (mode >= 0) ;
    if (inplace && !packed)
    {
	/* cannot operate on an unpacked matrix in place */
	ERROR (CHOLMOD_INVALID, "cannot operate on unpacked matrix in-place") ;
	return (NULL) ;
    }
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */


    PRINT1 (("k1 %ld k2 %ld\n", k1, k2)) ;
    Ap  = A->p ;
    Anz = A->nz ;
    Ai  = A->i ;
    Ax  = A->x ;
    sorted = A->sorted ;


    if (A->stype > 0)
    {
	/* ignore any entries in strictly lower triangular part of A */
	k1 = MAX (k1, 0) ;
    }
    if (A->stype < 0)
    {
	/* ignore any entries in strictly upper triangular part of A */
	k2 = MIN (k2, 0) ;
    }
    ncol = A->ncol ;
    nrow = A->nrow ;

    /* ensure k1 and k2 are in the range -nrow to +ncol to
     * avoid possible integer overflow if k1 and k2 are huge */
    k1 = MAX (-nrow, k1) ;
    k1 = MIN (k1, ncol) ;
    k2 = MAX (-nrow, k2) ;
    k2 = MIN (k2, ncol) ;

    /* consider columns jlo to jhi.  columns outside this range are empty */
    jlo = MAX (k1, 0) ;
    jhi = MIN (k2+nrow, ncol) ;

    if (k1 > k2)
    {
	/* nothing to do */
	jlo = ncol ;
	jhi = ncol ;
    }

    /* ---------------------------------------------------------------------- */
    /* allocate C, or operate on A in place */
    /* ---------------------------------------------------------------------- */

    if (inplace)
    {
	/* convert A in place */
	C = A ;
    }
    else
    {
	/* count the number of entries in the result C */
	nz = 0 ;
	if (sorted)
	{
	    for (j = jlo ; j < jhi ; j++)
	    {
		ilo = j-k2 ;
		ihi = j-k1 ;
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    if (i > ihi)
		    {
			break ;
		    }
		    if (i >= ilo && (diag || i != j))
		    {
			nz++ ;
		    }
		}
	    }
	}
	else
	{
	    for (j = jlo ; j < jhi ; j++)
	    {
		ilo = j-k2 ;
		ihi = j-k1 ;
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    if (i >= ilo && i <= ihi && (diag || i != j))
		    {
			nz++ ;
		    }
		}
	    }
	}
	/* allocate C; A will not be modified.  C is sorted if A is sorted */
	C = CHOLMOD(allocate_sparse) (A->nrow, ncol, nz, sorted, TRUE,
		A->stype, values ? A->xtype : CHOLMOD_PATTERN, Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    return (NULL) ;	/* out of memory */
	}
    }

    Cp = C->p ;
    Ci = C->i ;
    Cx = C->x ;

    /* ---------------------------------------------------------------------- */
    /* construct C */
    /* ---------------------------------------------------------------------- */

    /* columns 0 to jlo-1 are empty */
    for (j = 0 ; j < jlo ; j++)
    {
	Cp [j] = 0 ;
    }

    nz = 0 ;
    if (sorted)
    {
	if (values)
	{
	    /* pattern and values */
	    ASSERT (diag) ;
	    for (j = jlo ; j < jhi ; j++)
	    {
		ilo = j-k2 ;
		ihi = j-k1 ;
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		Cp [j] = nz ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    if (i > ihi)
		    {
			break ;
		    }
		    if (i >= ilo)
		    {
			Ci [nz] = i ;
			Cx [nz] = Ax [p] ;
			nz++ ;
		    }
		}
	    }
	}
	else
	{
	    /* pattern only, perhaps with no diagonal */
	    for (j = jlo ; j < jhi ; j++)
	    {
		ilo = j-k2 ;
		ihi = j-k1 ;
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		Cp [j] = nz ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    if (i > ihi)
		    {
			break ;
		    }
		    if (i >= ilo && (diag || i != j))
		    {
			Ci [nz++] = i ;
		    }
		}
	    }
	}
    }
    else
    {
	if (values)
	{
	    /* pattern and values */
	    ASSERT (diag) ;
	    for (j = jlo ; j < jhi ; j++)
	    {
		ilo = j-k2 ;
		ihi = j-k1 ;
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		Cp [j] = nz ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    if (i >= ilo && i <= ihi)
		    {
			Ci [nz] = i ;
			Cx [nz] = Ax [p] ;
			nz++ ;
		    }
		}
	    }
	}
	else
	{
	    /* pattern only, perhaps with no diagonal */
	    for (j = jlo ; j < jhi ; j++)
	    {
		ilo = j-k2 ;
		ihi = j-k1 ;
		p = Ap [j] ;
		pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ;
		Cp [j] = nz ;
		for ( ; p < pend ; p++)
		{
		    i = Ai [p] ;
		    if (i >= ilo && i <= ihi && (diag || i != j))
		    {
			Ci [nz++] = i ;
		    }
		}
	    }
	}
    }

    /* columns jhi to ncol-1 are empty */
    for (j = jhi ; j <= ncol ; j++)
    {
	Cp [j] = nz ;
    }

    /* ---------------------------------------------------------------------- */
    /* reduce A in size if done in place */
    /* ---------------------------------------------------------------------- */

    if (inplace)
    {
	/* free the unused parts of A, and 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) ;
    }

    /* ---------------------------------------------------------------------- */
    /* return the result C */
    /* ---------------------------------------------------------------------- */

    DEBUG (i = CHOLMOD(dump_sparse) (C, "band", Common)) ;
    ASSERT (IMPLIES (mode < 0, i == 0)) ;
    return (C) ;
}
UF_long CHOLMOD(metis_bisector)	/* returns separator size */
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to bisect */
    Int *Anw,		/* size A->nrow, node weights */
    Int *Aew,		/* size nz, edge weights */
    /* ---- output --- */
    Int *Partition,	/* size A->nrow */
    /* --------------- */
    cholmod_common *Common
)
{
    Int *Ap, *Ai ;
    idxtype *Mp, *Mi, *Mnw, *Mew, *Mpart ;
    Int n, nleft, nright, j, p, csep, total_weight, lightest, nz ;
    int Opt [8], nn, csp ;
    size_t n1 ;
    DEBUG (Int nsep) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (EMPTY) ;
    RETURN_IF_NULL (A, EMPTY) ;
    RETURN_IF_NULL (Anw, EMPTY) ;
    RETURN_IF_NULL (Aew, EMPTY) ;
    RETURN_IF_NULL (Partition, EMPTY) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ;
    if (A->stype || A->nrow != A->ncol)
    {
	/* A must be square, with both upper and lower parts present */
	ERROR (CHOLMOD_INVALID, "matrix must be square, symmetric,"
		" and with both upper/lower parts present") ;
	return (EMPTY) ;
    }
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* quick return */
    /* ---------------------------------------------------------------------- */

    n = A->nrow ;
    if (n == 0)
    {
	return (0) ;
    }
    n1 = ((size_t) n) + 1 ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    Ap = A->p ;
    Ai = A->i ;
    nz = Ap [n] ;

    /* ---------------------------------------------------------------------- */
    /* METIS does not have a 64-bit integer version */
    /* ---------------------------------------------------------------------- */

#ifdef LONG
    if (sizeof (Int) > sizeof (idxtype) && MAX (n,nz) > INT_MAX / sizeof (int))
    {
	/* CHOLMOD's matrix is too large for METIS */
	return (EMPTY) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* set default options */
    /* ---------------------------------------------------------------------- */

    Opt [0] = 0 ;	/* use defaults */
    Opt [1] = 3 ;	/* matching type */
    Opt [2] = 1 ;	/* init. partitioning algo*/
    Opt [3] = 2 ;	/* refinement algorithm */
    Opt [4] = 0 ;	/* no debug */
    Opt [5] = 0 ;	/* unused */
    Opt [6] = 0 ;	/* unused */
    Opt [7] = -1 ;	/* random seed */

    DEBUG (for (j = 0 ; j < n ; j++) ASSERT (Anw [j] > 0)) ;

    /* ---------------------------------------------------------------------- */
    /* copy Int to METIS idxtype, if necessary */
    /* ---------------------------------------------------------------------- */

    DEBUG (for (j = 0 ; j < nz ; j++) ASSERT (Aew [j] > 0)) ;
    if (sizeof (Int) == sizeof (idxtype))
    {
	/* this is the typical case */
	Mi    = (idxtype *) Ai ;
	Mew   = (idxtype *) Aew ;
	Mp    = (idxtype *) Ap ;
	Mnw   = (idxtype *) Anw ;
	Mpart = (idxtype *) Partition ;
    }
    else
    {
	/* idxtype and Int differ; copy the graph into the METIS idxtype */
	Mi    = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ;
	Mew   = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ;
	Mp    = CHOLMOD(malloc) (n1, sizeof (idxtype), Common) ;
	Mnw   = CHOLMOD(malloc) (n,  sizeof (idxtype), Common) ;
	Mpart = CHOLMOD(malloc) (n,  sizeof (idxtype), Common) ;
	if (Common->status < CHOLMOD_OK)
	{
	    CHOLMOD(free) (nz, sizeof (idxtype), Mi,    Common) ;
	    CHOLMOD(free) (nz, sizeof (idxtype), Mew,   Common) ;
	    CHOLMOD(free) (n1, sizeof (idxtype), Mp,    Common) ;
	    CHOLMOD(free) (n,  sizeof (idxtype), Mnw,   Common) ;
	    CHOLMOD(free) (n,  sizeof (idxtype), Mpart, Common) ;
	    return (EMPTY) ;
	}
	for (p = 0 ; p < nz ; p++)
	{
	    Mi [p] = Ai [p] ;
	}
	for (p = 0 ; p < nz ; p++)
	{
	    Mew [p] = Aew [p] ;
	}
	for (j = 0 ; j <= n ; j++)
	{
	    Mp [j] = Ap [j] ;
	}
	for (j = 0 ; j <  n ; j++)
	{
	    Mnw [j] = Anw [j] ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* METIS workaround: try to ensure METIS doesn't run out of memory */
    /* ---------------------------------------------------------------------- */

    if (!metis_memory_ok (n, nz, Common))
    {
	/* METIS might ask for too much memory and thus terminate the program */
	if (sizeof (Int) != sizeof (idxtype))
	{
	    CHOLMOD(free) (nz, sizeof (idxtype), Mi,    Common) ;
	    CHOLMOD(free) (nz, sizeof (idxtype), Mew,   Common) ;
	    CHOLMOD(free) (n1, sizeof (idxtype), Mp,    Common) ;
	    CHOLMOD(free) (n,  sizeof (idxtype), Mnw,   Common) ;
	    CHOLMOD(free) (n,  sizeof (idxtype), Mpart, Common) ;
	}
	return (EMPTY) ;
    }

    /* ---------------------------------------------------------------------- */
    /* partition the graph */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    PRINT1 (("Metis graph, n = "ID"\n", n)) ;
    for (j = 0 ; j < n ; j++)
    {
	Int ppp ;
	PRINT2 (("M(:,"ID") node weight "ID"\n", j, (Int) Mnw [j])) ;
	ASSERT (Mnw [j] > 0) ;
	for (ppp = Mp [j] ; ppp < Mp [j+1] ; ppp++)
	{
	    PRINT3 ((" "ID" : "ID"\n", (Int) Mi [ppp], (Int) Mew [ppp])) ;
	    ASSERT (Mi [ppp] != j) ;
	    ASSERT (Mew [ppp] > 0) ;
	}
    }
#endif

    nn = n ;
    METIS_NodeComputeSeparator (&nn, Mp, Mi, Mnw, Mew, Opt, &csp, Mpart) ;
    n = nn ;
    csep = csp ;

    PRINT1 (("METIS csep "ID"\n", csep)) ;

    /* ---------------------------------------------------------------------- */
    /* copy the results back from idxtype, if required */
    /* ---------------------------------------------------------------------- */

    if (sizeof (Int) != sizeof (idxtype))
    {
	for (j = 0 ; j < n ; j++)
	{
	    Partition [j] = Mpart [j] ;
	}
	CHOLMOD(free) (nz, sizeof (idxtype), Mi,    Common) ;
	CHOLMOD(free) (nz, sizeof (idxtype), Mew,   Common) ;
	CHOLMOD(free) (n1, sizeof (idxtype), Mp,    Common) ;
	CHOLMOD(free) (n,  sizeof (idxtype), Mnw,   Common) ;
	CHOLMOD(free) (n,  sizeof (idxtype), Mpart, Common) ;
    }

    /* ---------------------------------------------------------------------- */
    /* ensure a reasonable separator */
    /* ---------------------------------------------------------------------- */

    /* METIS can return a valid separator with no nodes in (for example) the
     * left part.  In this case, there really is no separator.  CHOLMOD
     * prefers, in this case, for all nodes to be in the separator (and both
     * left and right parts to be empty).  Also, if the graph is unconnected,
     * METIS can return a valid empty separator.  CHOLMOD prefers at least one
     * node in the separator.  Note that cholmod_nested_dissection only calls
     * this routine on connected components, but cholmod_bisect can call this
     * routine for any graph. */

    if (csep == 0)
    {
	/* The separator is empty, select lightest node as separator.  If
	 * ties, select the highest numbered node. */
	lightest = 0 ;
	for (j = 0 ; j < n ; j++)
	{
	    if (Anw [j] <= Anw [lightest])
	    {
		lightest = j ;
	    }
	}
	PRINT1 (("Force "ID" as sep\n", lightest)) ;
	Partition [lightest] = 2 ;
	csep = Anw [lightest] ;
    }

    /* determine the node weights in the left and right part of the graph */
    nleft = 0 ;
    nright = 0 ;
    DEBUG (nsep = 0) ;
    for (j = 0 ; j < n ; j++)
    {
	PRINT1 (("Partition ["ID"] = "ID"\n", j, Partition [j])) ;
	if (Partition [j] == 0)
	{
	    nleft += Anw [j] ;
	}
	else if (Partition [j] == 1)
	{
	    nright += Anw [j] ;
	}
#ifndef NDEBUG
	else
	{
	    ASSERT (Partition [j] == 2) ;
	    nsep += Anw [j] ;
	}
#endif
    }
    ASSERT (csep == nsep) ;

    total_weight = nleft + nright + csep ;

    if (csep < total_weight)
    {
	/* The separator is less than the whole graph.  Make sure the left and
	 * right parts are either both empty or both non-empty. */
	PRINT1 (("nleft "ID" nright "ID" csep "ID" tot "ID"\n",
		nleft, nright, csep, total_weight)) ;
	ASSERT (nleft + nright + csep == total_weight) ;
	ASSERT (nleft > 0 || nright > 0) ;
	if ((nleft == 0 && nright > 0) || (nleft > 0 && nright == 0))
	{
	    /* left or right is empty; put all nodes in the separator */
	    PRINT1 (("Force all in sep\n")) ;
	    csep = total_weight ;
	    for (j = 0 ; j < n ; j++)
	    {
		Partition [j] = 2 ;
	    }
	}
    }

    ASSERT (CHOLMOD(dump_partition) (n, Ap, Ai, Anw, Partition, csep, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* return the sum of the weights of nodes in the separator */
    /* ---------------------------------------------------------------------- */

    return (csep) ;
}
Exemple #22
0
void RenderingObject::UnregisterMaterialChanged(const Delegate<void(RenderableChangedFlags)>& val)
{
	RETURN_IF_NULL(mMaterial);
	mMaterial->OnMaterialChanged -= val;
}
int CHOLMOD(change_factor)
(
    /* ---- input ---- */
    int to_xtype,	/* convert to CHOLMOD_PATTERN, _REAL, _COMPLEX, or
			 * _ZOMPLEX */
    int to_ll,		/* TRUE: convert to LL', FALSE: LDL' */
    int to_super,	/* TRUE: convert to supernodal, FALSE: simplicial */
    int to_packed,	/* TRUE: pack simplicial columns, FALSE: do not pack */
    int to_monotonic,	/* TRUE: put simplicial columns in order, FALSE: not */
    /* ---- in/out --- */
    cholmod_factor *L,	/* factor to modify */
    /* --------------- */
    cholmod_common *Common
)
{

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (L, FALSE) ;
    RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ;
    if (to_xtype < CHOLMOD_PATTERN || to_xtype > CHOLMOD_ZOMPLEX)
    {
	ERROR (CHOLMOD_INVALID, "xtype invalid") ;
	return (FALSE) ;
    }
    Common->status = CHOLMOD_OK ;

    PRINT1 (("-----convert from (%d,%d,%d,%d,%d) to (%d,%d,%d,%d,%d)\n",
    L->xtype, L->is_ll, L->is_super, L_is_packed (L, Common), L->is_monotonic,
    to_xtype, to_ll,    to_super,    to_packed,               to_monotonic)) ;

    /* ensure all parameters are TRUE/FALSE */
    to_ll = BOOLEAN (to_ll) ;
    to_super = BOOLEAN (to_super) ;

    ASSERT (BOOLEAN (L->is_ll) == L->is_ll) ;
    ASSERT (BOOLEAN (L->is_super) == L->is_super) ;

    if (to_super && to_xtype == CHOLMOD_ZOMPLEX)
    {
	ERROR (CHOLMOD_INVALID, "supernodal zomplex L not supported") ;
	return (FALSE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* convert */
    /* ---------------------------------------------------------------------- */

    if (to_xtype == CHOLMOD_PATTERN)
    {

	/* ------------------------------------------------------------------ */
	/* convert to symbolic */
	/* ------------------------------------------------------------------ */

	if (!to_super)
	{

	    /* -------------------------------------------------------------- */
	    /* convert any factor into a simplicial symbolic factor */
	    /* -------------------------------------------------------------- */

	    any_to_simplicial_symbolic (L, to_ll, Common) ;    /* cannot fail */

	}
	else
	{

	    /* -------------------------------------------------------------- */
	    /* convert to a supernodal symbolic factor */
	    /* -------------------------------------------------------------- */

	    if (L->xtype != CHOLMOD_PATTERN && L->is_super)
	    {
		/* convert from supernodal numeric to supernodal symbolic.
		 * this preserves symbolic pattern of L, discards numeric
		 * values */
		ll_super_to_super_symbolic (L, Common) ;       /* cannot fail */
	    }
	    else if (L->xtype == CHOLMOD_PATTERN && !(L->is_super))
	    {
		/* convert from simplicial symbolic to supernodal symbolic.
		 * contents of supernodal pattern are uninitialized.  Not meant
		 * for the end user. */
		simplicial_symbolic_to_super_symbolic (L, Common) ;
	    }
	    else
	    {
		/* cannot convert from simplicial numeric to supernodal
		 * symbolic */
		ERROR (CHOLMOD_INVALID,
			"cannot convert L to supernodal symbolic") ;
	    }
	}

    }
    else
    {

	/* ------------------------------------------------------------------ */
	/* convert to numeric */
	/* ------------------------------------------------------------------ */
	    
	if (to_super)
	{

	    /* -------------------------------------------------------------- */
	    /* convert to supernodal numeric factor */
	    /* -------------------------------------------------------------- */

	    if (L->xtype == CHOLMOD_PATTERN)
	    {
		if (L->is_super)
		{
		    /* Convert supernodal symbolic to supernodal numeric.
		     * Contents of supernodal numeric values are uninitialized.
		     * This is used by cholmod_super_numeric.  Not meant for
		     * the end user. */
		    super_symbolic_to_ll_super (to_xtype, L, Common) ;
		}
		else
		{
		    /* Convert simplicial symbolic to supernodal numeric.
		     * Contents not defined.  This is used by
		     * Core/cholmod_copy_factor only.  Not meant for the end
		     * user. */
		    if (!simplicial_symbolic_to_super_symbolic (L, Common))
		    {
			/* failure, convert back to simplicial symbolic */
			any_to_simplicial_symbolic (L, to_ll, Common) ;
		    }
		    else
		    {
			/* conversion to super symbolic OK, allocate numeric
			 * part */
			super_symbolic_to_ll_super (to_xtype, L, Common) ;
		    }
		}
	    }
	    else
	    {
		/* nothing to do if L is already in supernodal numeric form */
		if (!(L->is_super))
		{
		    ERROR (CHOLMOD_INVALID,
			"cannot convert simplicial L to supernodal") ;
		}
		/* FUTURE WORK: convert to/from supernodal LL' and LDL' */
	    }

	}
	else
	{

	    /* -------------------------------------------------------------- */
	    /* convert any factor to simplicial numeric */
	    /* -------------------------------------------------------------- */

	    if (L->xtype == CHOLMOD_PATTERN && !(L->is_super))
	    {

		/* ---------------------------------------------------------- */
		/* convert simplicial symbolic to simplicial numeric (L=I,D=I)*/
		/* ---------------------------------------------------------- */

		simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed,
			to_xtype, Common) ;

	    }
	    else if (L->xtype != CHOLMOD_PATTERN && L->is_super)
	    {

		/* ---------------------------------------------------------- */
		/* convert a supernodal LL' to simplicial numeric */
		/* ---------------------------------------------------------- */

		ll_super_to_simplicial_numeric (L, to_packed, to_ll, Common) ;

	    }
	    else if (L->xtype == CHOLMOD_PATTERN && L->is_super)
	    {

		/* ---------------------------------------------------------- */
		/* convert a supernodal symbolic to simplicial numeric (L=D=I)*/
		/* ---------------------------------------------------------- */

		any_to_simplicial_symbolic (L, to_ll, Common) ;
		/* if the following fails, it leaves the factor in simplicial
		 * symbolic form */
		simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed,
			to_xtype, Common) ;

	    }
	    else
	    {

		/* ---------------------------------------------------------- */
		/* change a simplicial numeric factor */
		/* ---------------------------------------------------------- */

		/* change LL' to LDL', LDL' to LL', or leave as-is.  pack the
		 * columns of L, or leave as-is.  Ensure the columns are
		 * monotonic, or leave as-is. */

		change_simplicial_numeric (L, to_ll, to_packed, to_monotonic,
			Common) ;
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* return result */
    /* ---------------------------------------------------------------------- */

    return (Common->status >= CHOLMOD_OK) ;
}
Exemple #24
0
void RenderingObject::RegisterMaterialChanged(const Delegate<void(RenderableChangedFlags)>& val)
{
	RETURN_IF_NULL(mMesh);
	mMesh->OnMeshChanged += val;
}
Exemple #25
0
int DestroyView(HVIEW view)
{
	RETURN_IF_NULL(view);

	return 1;
}
cholmod_sparse *CHOLMOD(aat)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* input matrix; C=A*A' is constructed */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    int mode,		/* >0: numerical, 0: pattern, <0: pattern (no diag)
			 * -2: pattern only, no diagonal, add 50% + n extra
			 * space to C */
    /* --------------- */
    cholmod_common *Common
)
{
    double fjt ;
    double *Ax, *Fx, *Cx, *W ;
    Int *Ap, *Anz, *Ai, *Fp, *Fi, *Cp, *Ci, *Flag ;
    cholmod_sparse *C, *F ;
    Int packed, j, i, pa, paend, pf, pfend, n, mark, cnz, t, p, values, diag,
	extra ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (NULL) ;
    RETURN_IF_NULL (A, NULL) ;
    values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ;
    RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN,
	    values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ;
    if (A->stype)
    {
	ERROR (CHOLMOD_INVALID, "matrix cannot be symmetric") ;
	return (NULL) ;
    }
    Common->status = CHOLMOD_OK ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    diag = (mode >= 0) ;
    n = A->nrow ;
    CHOLMOD(allocate_work) (n, MAX (A->ncol, A->nrow), values ? n : 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (NULL) ;	    /* out of memory */
    }
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ;

    /* get the A matrix */
    Ap  = A->p ;
    Anz = A->nz ;
    Ai  = A->i ;
    Ax  = A->x ;
    packed = A->packed ;

    /* get workspace */
    W = Common->Xwork ;		/* size n, unused if values is FALSE */
    Flag = Common->Flag ;	/* size n, Flag [0..n-1] < mark on input*/

    /* ---------------------------------------------------------------------- */
    /* F = A' or A(:,f)' */
    /* ---------------------------------------------------------------------- */

    /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/
    F = CHOLMOD(ptranspose) (A, values, NULL, fset, fsize, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (NULL) ;	    /* out of memory */
    }

    Fp = F->p ;
    Fi = F->i ;
    Fx = F->x ;

    /* ---------------------------------------------------------------------- */
    /* count the number of entries in the result C */
    /* ---------------------------------------------------------------------- */

    cnz = 0 ;
    for (j = 0 ; j < n ; j++)
    {
	/* clear the Flag array */
	mark = CHOLMOD(clear_flag) (Common) ;

	/* exclude the diagonal, if requested */
	if (!diag)
	{
	    Flag [j] = mark ;
	}

	/* for each nonzero F(t,j) in column j, do: */
	pfend = Fp [j+1] ;
	for (pf = Fp [j] ; pf < pfend ; pf++)
	{
	    /* F(t,j) is nonzero */
	    t = Fi [pf] ;

	    /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
	    pa = Ap [t] ;
	    paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ;
	    for ( ; pa < paend ; pa++)
	    {
		i = Ai [pa] ;
		if (Flag [i] != mark)
		{
		    Flag [i] = mark ;
		    cnz++ ;
		}
	    }
	}
	if (cnz < 0)
	{
	    break ;	    /* integer overflow case */
	}
    }

    extra = (mode == -2) ? (cnz/2 + n) : 0 ;

    mark = CHOLMOD(clear_flag) (Common) ;

    /* ---------------------------------------------------------------------- */
    /* check for integer overflow */
    /* ---------------------------------------------------------------------- */

    if (cnz < 0 || (cnz + extra) < 0)
    {
	ERROR (CHOLMOD_TOO_LARGE, "problem too large") ;
	CHOLMOD(clear_flag) (Common) ;
	CHOLMOD(free_sparse) (&F, Common) ;
	return (NULL) ;	    /* problem too large */
    }

    /* ---------------------------------------------------------------------- */
    /* allocate C */
    /* ---------------------------------------------------------------------- */

    C = CHOLMOD(allocate_sparse) (n, n, cnz + extra, FALSE, TRUE, 0,
	    values ? A->xtype : CHOLMOD_PATTERN, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	CHOLMOD(free_sparse) (&F, Common) ;
	return (NULL) ;	    /* out of memory */
    }

    Cp = C->p ;
    Ci = C->i ;
    Cx = C->x ;

    /* ---------------------------------------------------------------------- */
    /* C = A*A' */
    /* ---------------------------------------------------------------------- */

    cnz = 0 ;

    if (values)
    {

	/* pattern and values */
	for (j = 0 ; j < n ; j++)
	{
	    /* clear the Flag array */
	    mark = CHOLMOD(clear_flag) (Common) ;

	    /* start column j of C */
	    Cp [j] = cnz ;

	    /* for each nonzero F(t,j) in column j, do: */
	    pfend = Fp [j+1] ;
	    for (pf = Fp [j] ; pf < pfend ; pf++)
	    {
		/* F(t,j) is nonzero */
		t = Fi [pf] ;
		fjt = Fx [pf] ;

		/* add the nonzero pattern of A(:,t) to the pattern of C(:,j)
		 * and scatter the values into W */
		pa = Ap [t] ;
		paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ;
		for ( ; pa < paend ; pa++)
		{
		    i = Ai [pa] ;
		    if (Flag [i] != mark)
		    {
			Flag [i] = mark ;
			Ci [cnz++] = i ;
		    }
		    W [i] += Ax [pa] * fjt ;
		}
	    }

	    /* gather the values into C(:,j) */
	    for (p = Cp [j] ; p < cnz ; p++)
	    {
		i = Ci [p] ;
		Cx [p] = W [i] ;
		W [i] = 0 ;
	    }
	}

    }
    else
    {

	/* pattern only */
	for (j = 0 ; j < n ; j++)
	{
	    /* clear the Flag array */
	    mark = CHOLMOD(clear_flag) (Common) ;

	    /* exclude the diagonal, if requested */
	    if (!diag)
	    {
		Flag [j] = mark ;
	    }

	    /* start column j of C */
	    Cp [j] = cnz ;

	    /* for each nonzero F(t,j) in column j, do: */
	    pfend = Fp [j+1] ;
	    for (pf = Fp [j] ; pf < pfend ; pf++)
	    {
		/* F(t,j) is nonzero */
		t = Fi [pf] ;

		/* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */
		pa = Ap [t] ;
		paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ;
		for ( ; pa < paend ; pa++)
		{
		    i = Ai [pa] ;
		    if (Flag [i] != mark)
		    {
			Flag [i] = mark ;
			Ci [cnz++] = i ;
		    }
		}
	    }
	}
    }

    Cp [n] = cnz ;
    ASSERT (IMPLIES (mode != -2, MAX (1,cnz) == C->nzmax)) ;

    /* ---------------------------------------------------------------------- */
    /* clear workspace and free temporary matrices and return result */
    /* ---------------------------------------------------------------------- */

    CHOLMOD(free_sparse) (&F, Common) ;
    CHOLMOD(clear_flag) (Common) ;
    ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ;
    DEBUG (i = CHOLMOD(dump_sparse) (C, "aat", Common)) ;
    ASSERT (IMPLIES (mode < 0, i == 0)) ;
    return (C) ;
}
Exemple #27
0
int CHOLMOD(analyze_ordering)
(
    /* ---- input ---- */
    cholmod_sparse *A,	/* matrix to analyze */
    int ordering,	/* ordering method used */
    Int *Perm,		/* size n, fill-reducing permutation to analyze */
    Int *fset,		/* subset of 0:(A->ncol)-1 */
    size_t fsize,	/* size of fset */
    /* ---- output --- */
    Int *Parent,	/* size n, elimination tree */
    Int *Post,		/* size n, postordering of elimination tree */
    Int *ColCount,	/* size n, nnz in each column of L */
    /* ---- workspace  */
    Int *First,		/* size n workspace for cholmod_postorder */
    Int *Level,		/* size n workspace for cholmod_postorder */
    /* --------------- */
    cholmod_common *Common
)
{
    cholmod_sparse *A1, *A2, *S, *F ;
    Int n, ok, do_rowcolcounts ;

    /* check inputs */
    RETURN_IF_NULL_COMMON (FALSE) ;
    RETURN_IF_NULL (A, FALSE) ;

    n = A->nrow ;

    do_rowcolcounts = (ColCount != NULL) ;

    /* permute A according to Perm and fset */
    ok = permute_matrices (A, ordering, Perm, fset, fsize, do_rowcolcounts,
	    &A1, &A2, &S, &F, Common) ;

    /* find etree of S (symmetric upper/lower case) or F (unsym case) */
    /* workspace: symmmetric: Iwork (nrow), unsym: Iwork (nrow+ncol) */
    ok = ok && CHOLMOD(etree) (A->stype ? S:F, Parent, Common) ;

    /* postorder the etree (required by cholmod_rowcolcounts) */
    /* workspace: Iwork (2*nrow) */
    ok = ok && (CHOLMOD(postorder) (Parent, n, NULL, Post, Common) == n) ;

    /* cholmod_postorder doesn't set Common->status if it returns < n */
    Common->status = (!ok && Common->status == CHOLMOD_OK) ?
	CHOLMOD_INVALID : Common->status ;

    /* analyze LL'=S or SS' or S(:,f)*S(:,f)' */
    /* workspace:
     *	if symmetric:   Flag (nrow), Iwork (2*nrow)
     *	if unsymmetric: Flag (nrow), Iwork (2*nrow+ncol), Head (nrow+1)
     */
    if (do_rowcolcounts)
    {
	ok = ok && CHOLMOD(rowcolcounts) (A->stype ? F:S, fset, fsize, Parent,
	    Post, NULL, ColCount, First, Level, Common) ;
    }

    /* free temporary matrices and return result */
    CHOLMOD(free_sparse) (&A1, Common) ;
    CHOLMOD(free_sparse) (&A2, Common) ;
    return (ok) ;
}
Exemple #28
0
cholmod_sparse *CHOLMOD(triplet_to_sparse)
(
    /* ---- input ---- */
    cholmod_triplet *T,	/* matrix to copy */
    size_t nzmax,	/* allocate at least this much space in output matrix */
    /* --------------- */
    cholmod_common *Common
)
{
    cholmod_sparse *R, *A = NULL ;
    Int *Wj, *Rp, *Ri, *Rnz, *Ti, *Tj ;
    Int i, j, p, k, stype, nrow, ncol, nz, ok ;
    size_t anz = 0 ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    RETURN_IF_NULL_COMMON (NULL) ;
    RETURN_IF_NULL (T, NULL) ;
    Ti = T->i ;
    Tj = T->j ;
    RETURN_IF_NULL (Ti, NULL) ;
    RETURN_IF_NULL (Tj, NULL) ;
    RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ;
    stype = SIGN (T->stype) ;
    if (stype && T->nrow != T->ncol)
    {
	/* inputs invalid */
	ERROR (CHOLMOD_INVALID, "matrix invalid") ;
	return (NULL) ;
    }
    Common->status = CHOLMOD_OK ;
    DEBUG (CHOLMOD(dump_triplet) (T, "T", Common)) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    nrow = T->nrow ;
    ncol = T->ncol ;
    nz = T->nnz ;

    /* ---------------------------------------------------------------------- */
    /* allocate workspace */
    /* ---------------------------------------------------------------------- */

    CHOLMOD(allocate_work) (0, MAX (nrow, ncol), 0, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	return (NULL) ;	    /* out of memory */
    }

    /* ---------------------------------------------------------------------- */
    /* allocate temporary matrix R */
    /* ---------------------------------------------------------------------- */

    R = CHOLMOD(allocate_sparse) (ncol, nrow, nz, FALSE, FALSE, -stype,
	    T->xtype, Common) ;

    if (Common->status < CHOLMOD_OK)
    {
	return (NULL) ;	    /* out of memory */
    }

    Rp = R->p ;
    Ri = R->i ;
    Rnz = R->nz ;

    /* ---------------------------------------------------------------------- */
    /* count the entries in each row of A (also counting duplicates) */
    /* ---------------------------------------------------------------------- */

    for (i = 0 ; i < nrow ; i++)
    {
	Rnz [i] = 0 ;	
    }

    if (stype > 0)
    {
	for (k = 0 ; k < nz ; k++)
	{
	    i = Ti [k] ;
	    j = Tj [k] ;
	    if (i < 0 || i >= nrow || j < 0 || j >= ncol)
	    {
		ERROR (CHOLMOD_INVALID, "index out of range") ;
		break ;
	    }
	    /* A will be symmetric with just the upper triangular part stored.
	     * Create a matrix R that is lower triangular.  Entries in the
	     * upper part of R are transposed to the lower part. */
	    Rnz [MIN (i,j)]++ ;
	}
    }
    else if (stype < 0)
    {
	for (k = 0 ; k < nz ; k++)
	{
	    i = Ti [k] ;
	    j = Tj [k] ;
	    if (i < 0 || i >= nrow || j < 0 || j >= ncol)
	    {
		ERROR (CHOLMOD_INVALID, "index out of range") ;
		break ;
	    }
	    /* A will be symmetric with just the lower triangular part stored.
	     * Create a matrix R that is upper triangular.  Entries in the
	     * lower part of R are transposed to the upper part. */
	    Rnz [MAX (i,j)]++ ;
	}
    }
    else
    {
	for (k = 0 ; k < nz ; k++)
	{
	    i = Ti [k] ;
	    j = Tj [k] ;
	    if (i < 0 || i >= nrow || j < 0 || j >= ncol)
	    {
		ERROR (CHOLMOD_INVALID, "index out of range") ;
		break ;
	    }
	    /* constructing an unsymmetric matrix */
	    Rnz [i]++ ;
	}
    }

    if (Common->status < CHOLMOD_OK)
    {
	/* triplet matrix is invalid */
	CHOLMOD(free_sparse) (&R, Common) ;
	return (NULL) ;
    }

    /* ---------------------------------------------------------------------- */
    /* construct the row pointers */
    /* ---------------------------------------------------------------------- */

    p = 0 ;
    for (i = 0 ; i < nrow ; i++)
    {
	Rp [i] = p ;
	p += Rnz [i] ;
    }
    Rp [nrow] = p ;

    /* use Wj (i/l/l) as temporary row pointers */
    Wj = Common->Iwork ;	/* size MAX (nrow,ncol) FUTURE WORK: (i/l/l) */
    for (i = 0 ; i < nrow ; i++)
    {
	Wj [i] = Rp [i] ;
    }

    /* ---------------------------------------------------------------------- */
    /* construct triplet matrix, using template routine */
    /* ---------------------------------------------------------------------- */

    switch (T->xtype)
    {
	case CHOLMOD_PATTERN:
	    anz = p_cholmod_triplet_to_sparse (T, R, Common) ;
	    break ;

	case CHOLMOD_REAL:
	    anz = r_cholmod_triplet_to_sparse (T, R, Common) ;
	    break ;

	case CHOLMOD_COMPLEX:
	    anz = c_cholmod_triplet_to_sparse (T, R, Common) ;
	    break ;

	case CHOLMOD_ZOMPLEX:
	    anz = z_cholmod_triplet_to_sparse (T, R, Common) ;
	    break ;
    }

    /* ---------------------------------------------------------------------- */
    /* A = R' (array transpose, not complex conjugate transpose) */
    /* ---------------------------------------------------------------------- */

    /* workspace: Iwork (R->nrow), which is A->ncol */

    ASSERT (CHOLMOD(dump_sparse) (R, "R", Common) >= 0) ;

    A = CHOLMOD(allocate_sparse) (nrow, ncol, MAX (anz, nzmax), TRUE, TRUE,
	stype, T->xtype, Common) ;

    if (stype)
    {
	ok = CHOLMOD(transpose_sym) (R, 1, NULL, A, Common) ;
    }
    else
    {
	ok = CHOLMOD(transpose_unsym) (R, 1, NULL, NULL, 0, A, Common) ; 
    }

    CHOLMOD(free_sparse) (&R, Common) ;
    if (Common->status < CHOLMOD_OK)
    {
	CHOLMOD(free_sparse) (&A, Common) ;
    }

    /* ---------------------------------------------------------------------- */
    /* return result */
    /* ---------------------------------------------------------------------- */

    ASSERT (CHOLMOD(dump_sparse) (A, "A = triplet(T) result", Common) >= 0) ;
    return (A) ;
}
Exemple #29
0
void
OGLTR_DrawGlyphList(JNIEnv *env, OGLContext *oglc, OGLSDOps *dstOps,
                    jint totalGlyphs, jboolean usePositions,
                    jboolean subPixPos, jboolean rgbOrder, jint lcdContrast,
                    jfloat glyphListOrigX, jfloat glyphListOrigY,
                    unsigned char *images, unsigned char *positions)
{
    int glyphCounter;

    J2dTraceLn(J2D_TRACE_INFO, "OGLTR_DrawGlyphList");

    RETURN_IF_NULL(oglc);
    RETURN_IF_NULL(dstOps);
    RETURN_IF_NULL(images);
    if (usePositions) {
        RETURN_IF_NULL(positions);
    }

    glyphMode = MODE_NOT_INITED;
    isCachedDestValid = JNI_FALSE;

    for (glyphCounter = 0; glyphCounter < totalGlyphs; glyphCounter++) {
        jint x, y;
        jfloat glyphx, glyphy;
        jboolean grayscale, ok;
        GlyphInfo *ginfo = (GlyphInfo *)jlong_to_ptr(NEXT_LONG(images));

        if (ginfo == NULL) {
            // this shouldn't happen, but if it does we'll just break out...
            J2dRlsTraceLn(J2D_TRACE_ERROR,
                          "OGLTR_DrawGlyphList: glyph info is null");
            break;
        }

        grayscale = (ginfo->rowBytes == ginfo->width);

        if (usePositions) {
            jfloat posx = NEXT_FLOAT(positions);
            jfloat posy = NEXT_FLOAT(positions);
            glyphx = glyphListOrigX + posx + ginfo->topLeftX;
            glyphy = glyphListOrigY + posy + ginfo->topLeftY;
            FLOOR_ASSIGN(x, glyphx);
            FLOOR_ASSIGN(y, glyphy);
        } else {
            glyphx = glyphListOrigX + ginfo->topLeftX;
            glyphy = glyphListOrigY + ginfo->topLeftY;
            FLOOR_ASSIGN(x, glyphx);
            FLOOR_ASSIGN(y, glyphy);
            glyphListOrigX += ginfo->advanceX;
            glyphListOrigY += ginfo->advanceY;
        }

        if (ginfo->image == NULL) {
            continue;
        }

        if (grayscale) {
            // grayscale or monochrome glyph data
            if (cacheStatus != CACHE_LCD &&
                ginfo->width <= OGLTR_CACHE_CELL_WIDTH &&
                ginfo->height <= OGLTR_CACHE_CELL_HEIGHT)
            {
                ok = OGLTR_DrawGrayscaleGlyphViaCache(oglc, ginfo, x, y);
            } else {
                ok = OGLTR_DrawGrayscaleGlyphNoCache(oglc, ginfo, x, y);
            }
        } else {
            // LCD-optimized glyph data
            jint rowBytesOffset = 0;

            if (subPixPos) {
                jint frac = (jint)((glyphx - x) * 3);
                if (frac != 0) {
                    rowBytesOffset = 3 - frac;
                    x += 1;
                }
            }

            if (rowBytesOffset == 0 &&
                cacheStatus != CACHE_GRAY &&
                ginfo->width <= OGLTR_CACHE_CELL_WIDTH &&
                ginfo->height <= OGLTR_CACHE_CELL_HEIGHT)
            {
                ok = OGLTR_DrawLCDGlyphViaCache(oglc, dstOps,
                                                ginfo, x, y,
                                                glyphCounter, totalGlyphs,
                                                rgbOrder, lcdContrast);
            } else {
                ok = OGLTR_DrawLCDGlyphNoCache(oglc, dstOps,
                                               ginfo, x, y,
                                               rowBytesOffset,
                                               rgbOrder, lcdContrast);
            }
        }

        if (!ok) {
            break;
        }
    }

    OGLTR_DisableGlyphModeState();
}
Exemple #30
0
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) ;
}