PRIVATE Int find_user_singletons	/* returns # singletons found */
(
    /* input, not modified: */
    Int n_row,
    Int n_col,
    const Int Ap [ ],	    /* size n_col+1 */
    const Int Ai [ ],	    /* size nz = Ap [n_col] */
    const Int Quser [ ],    /* size n_col if present */

    /* input, modified on output: */
    Int Cdeg [ ],	    /* size n_col */
    Int Rdeg [ ],	    /* size n_row */

    /* output, not defined on input */
    Int Cperm [ ],	    /* size n_col */
    Int Rperm [ ],	    /* size n_row */
    Int *p_n1r,		    /* # of row singletons */
    Int *p_n1c,		    /* # of col singletons */

    /* workspace, not defined on input or output */
    Int Rp [ ],		    /* size n_row+1 */
    Int Ri [ ],		    /* size nz */
    Int W [ ]		    /* size n_row */
)
{
    Int n1, col, row, p, p2, pivcol, pivrow, found, k, n1r, n1c ;

    n1 = 0 ;
    n1r = 0 ;
    n1c = 0 ;
    *p_n1r = 0 ;
    *p_n1c = 0 ;

    /* find singletons in the user column permutation, Quser */
    pivcol = Quser [0] ;
    found = (Cdeg [pivcol] == 1) ;
    DEBUG0 (("Is first col: "ID" a col singleton?: "ID"\n", pivcol, found)) ;
    if (!found)
    {
	/* the first column is not a column singleton, check for a row
	 * singleton in the first column. */
	for (p = Ap [pivcol] ; p < Ap [pivcol+1] ; p++)
	{
	    if (Rdeg [Ai [p]] == 1)
	    {
		DEBUG0 (("Row singleton in first col: "ID" row: "ID"\n",
		    pivcol, Ai [p])) ;
		found = TRUE ;
		break ;
	    }
	}
    }

    if (!found)
    {
	/* no singletons in the leading part of A (:,Quser) */
	return (0) ;
    }

    /* there is at least one row or column singleton.  Look for more. */
    create_row_form (n_row, n_col, Ap, Ai, Rdeg, Rp, Ri, W) ;

    n1 = 0 ;

    for (k = 0 ; k < n_col ; k++)
    {
	pivcol = Quser [k] ;
	pivrow = EMPTY ;

	/* ------------------------------------------------------------------ */
	/* check if col is a column singleton, or contains a row singleton */
	/* ------------------------------------------------------------------ */

	found = (Cdeg [pivcol] == 1) ;

	if (found)
	{

	    /* -------------------------------------------------------------- */
	    /* pivcol is a column singleton */
	    /* -------------------------------------------------------------- */

	    DEBUG0 (("Found a col singleton: k "ID" pivcol "ID"\n", k, pivcol));

	    /* find the pivrow to match with this pivcol */
#ifndef NDEBUG
	    /* there can only be one pivrow, since the degree of pivcol is 1 */
	    {
		Int deg = 0 ;
		p2 = Ap [pivcol+1] ;
		for (p = Ap [pivcol] ; p < p2 ; p++)
		{
		    row = Ai [p] ;
		    DEBUG1 (("row: "ID"\n", row)) ;
		    if (Rdeg [row] >= 0)
		    {
			/* this is a live index in this column vector */
			deg++ ;
		    }
		}
		ASSERT (deg == 1) ;
	    }
#endif

	    p2 = Ap [pivcol+1] ;
	    for (p = Ap [pivcol] ; p < p2 ; p++)
	    {
		row = Ai [p] ;
		DEBUG1 (("row: "ID"\n", row)) ;
		if (Rdeg [row] >= 0)
		{
		    /* this is a live index in this pivcol vector */
		    pivrow = row ;
		    break ;
		}
	    }

	    DEBUG1 (("Pivot row: "ID"\n", pivrow)) ;
	    ASSERT (pivrow != EMPTY) ;
	    DEBUG1 (("deg "ID"\n", Rdeg [pivrow])) ;
	    ASSERT (Rdeg [pivrow] >= 0) ;

	    /* decrement the degrees after removing this col singleton */
	    DEBUG1 (("p1 "ID"\n", Rp [pivrow])) ;
	    DEBUG1 (("p2 "ID"\n", Rp [pivrow+1])) ;
	    p2 = Rp [pivrow+1] ;
	    for (p = Rp [pivrow] ; p < p2 ; p++)
	    {
		col = Ri [p] ;
		DEBUG1 (("    col: "ID" deg: "ID"\n", col, Cdeg [col])) ;
		if (Cdeg [col] < 0) continue ;
		ASSERT (Cdeg [col] > 0) ;
		Cdeg [col]-- ;
		ASSERT (Cdeg [col] >= 0) ;
	    }

	    /* flag the pivcol and pivrow by FLIP'ing the degrees */
	    Cdeg [pivcol] = FLIP (1) ;
	    Rdeg [pivrow] = FLIP (Rdeg [pivrow]) ;
	    n1c++ ;

	}
	else
	{

	    /* -------------------------------------------------------------- */
	    /* pivcol may contain a row singleton */
	    /* -------------------------------------------------------------- */

	    p2 = Ap [pivcol+1] ;
	    for (p = Ap [pivcol] ; p < p2 ; p++)
	    {
		pivrow = Ai [p] ;
		if (Rdeg [pivrow] == 1)
		{
		    DEBUG0 (("Row singleton in pivcol: "ID" row: "ID"\n",
			pivcol, pivrow)) ;
		    found = TRUE ;
		    break ;
		}
	    }

	    if (!found)
	    {
		DEBUG0 (("End of user singletons\n")) ;
		break ;
	    }

#ifndef NDEBUG
	    /* there can only be one pivrow, since the degree of pivcol is 1 */
	    {
		Int deg = 0 ;
		p2 = Rp [pivrow+1] ;
		for (p = Rp [pivrow] ; p < p2 ; p++)
		{
		    col = Ri [p] ;
		    DEBUG1 (("col: "ID" cdeg::: "ID"\n", col, Cdeg [col])) ;
		    if (Cdeg [col] >= 0)
		    {
			/* this is a live index in this column vector */
			ASSERT (col == pivcol) ;
			deg++ ;
		    }
		}
		ASSERT (deg == 1) ;
	    }
#endif

	    DEBUG1 (("Pivot row: "ID"\n", pivrow)) ;
	    DEBUG1 (("pivcol deg "ID"\n", Cdeg [pivcol])) ;
	    ASSERT (Cdeg [pivcol] > 1) ;

	    /* decrement the degrees after removing this row singleton */
	    DEBUG1 (("p1 "ID"\n", Ap [pivcol])) ;
	    DEBUG1 (("p2 "ID"\n", Ap [pivcol+1])) ;
	    p2 = Ap [pivcol+1] ;
	    for (p = Ap [pivcol] ; p < p2 ; p++)
	    {
		row = Ai [p] ;
		DEBUG1 (("    row: "ID" deg: "ID"\n", row, Rdeg [row])) ;
		if (Rdeg [row] < 0) continue ;
		ASSERT (Rdeg [row] > 0) ;
		Rdeg [row]-- ;
		ASSERT (Rdeg [row] >= 0) ;
	    }

	    /* flag the pivcol and pivrow by FLIP'ing the degrees */
	    Cdeg [pivcol] = FLIP (Cdeg [pivcol]) ;
	    Rdeg [pivrow] = FLIP (1) ;
	    n1r++ ;
	}

	/* keep track of the pivot row and column */
	Cperm [k] = pivcol ;
	Rperm [k] = pivrow ;
	n1++ ;

#ifndef NDEBUG
	dump_mat ("col", "row", n_col, n_row, Ap, Ai, Cdeg, Rdeg) ;
	dump_mat ("row", "col", n_row, n_col, Rp, Ri, Rdeg, Cdeg) ;
#endif

    }

    DEBUGm4 (("User singletons found: "ID"\n", n1)) ;
    ASSERT (n1 > 0) ;

    *p_n1r = n1r ;
    *p_n1c = n1c ;
    return (n1) ;
}
GLOBAL Int UMF_singletons
(

    /* input, not modified: */
    Int n_row,
    Int n_col,
    const Int Ap [ ],	    /* size n_col+1 */
    const Int Ai [ ],	    /* size nz = Ap [n_col] */
    const Int Quser [ ],    /* size n_col if present */
    Int strategy,	    /* strategy requested by user */
    Int do_singletons,      /* if false, then do not look for singletons */

    /* output, not defined on input: */
    Int Cdeg [ ],	/* size n_col */
    Int Cperm [ ],	/* size n_col */
    Int Rdeg [ ],	/* size n_row */
    Int Rperm [ ],	/* size n_row */
    Int InvRperm [ ],	/* size n_row, the inverse of Rperm */
    Int *p_n1,		/* # of col and row singletons */
    Int *p_n1c,		/* # of col singletons */
    Int *p_n1r,		/* # of row singletons */
    Int *p_nempty_col,	/* # of empty columns in pruned submatrix */
    Int *p_nempty_row,	/* # of empty columns in pruned submatrix */
    Int *p_is_sym,	/* TRUE if pruned submatrix is square and has been
			 * symmetrically permuted by Cperm and Rperm */
    Int *p_max_rdeg,	/* maximum Rdeg in pruned submatrix */

    /* workspace, not defined on input or output */
    Int Rp [ ],		/* size n_row+1 */
    Int Ri [ ],		/* size nz */
    Int W [ ],		/* size n_row */
    Int Next [ ]	/* size MAX (n_row, n_col) */
)
{
    Int n1, s, col, row, p, p1, p2, cdeg, last_row, is_sym, k,
	nempty_row, nempty_col, max_cdeg, max_rdeg, n1c, n1r ;

    /* ---------------------------------------------------------------------- */
    /* initializations */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    UMF_dump_start ( ) ;
    DEBUGm4 (("Starting umf_singletons\n")) ;
#endif

    /* ---------------------------------------------------------------------- */
    /* scan the columns, check for errors and count row degrees */
    /* ---------------------------------------------------------------------- */

    if (Ap [0] != 0 || Ap [n_col] < 0)
    {
	return (UMFPACK_ERROR_invalid_matrix) ;
    }
    for (row = 0 ; row < n_row ; row++)
    {
	Rdeg [row] = 0 ;
    }
    for (col = 0 ; col < n_col ; col++)
    {
	p1 = Ap [col] ;
	p2 = Ap [col+1] ;
	cdeg = p2 - p1 ;
	if (cdeg < 0)
	{
	    return (UMFPACK_ERROR_invalid_matrix) ;
	}
	last_row = EMPTY ;
	for (p = p1 ; p < p2 ; p++)
	{
	    row = Ai [p] ;
	    if (row <= last_row || row >= n_row)
	    {
		return (UMFPACK_ERROR_invalid_matrix) ;
	    }
	    Rdeg [row]++ ;
	    last_row = row ;
	}
	Cdeg [col] = cdeg ;
    }

    /* ---------------------------------------------------------------------- */
    /* find singletons */
    /* ---------------------------------------------------------------------- */

    if (!do_singletons)
    {
        /* do not look for singletons at all */
        n1 = 0 ;
        n1r = 0 ;
        n1c = 0 ;
    }
    else if (Quser != (Int *) NULL)
    {
	/* user has provided an input column ordering */
	if (strategy == UMFPACK_STRATEGY_UNSYMMETRIC)
	{
	    /* look for singletons, but respect the user's input permutation */
	    n1 = find_user_singletons (n_row, n_col, Ap, Ai, Quser,
		    Cdeg, Rdeg, Cperm, Rperm, &n1r, &n1c, Rp, Ri, W) ;
	}
	else
	{
	    /* do not look for singletons if Quser given and strategy is
	     * not unsymmetric */
	    n1 = 0 ;
	    n1r = 0 ;
	    n1c = 0 ;
	}
    }
    else
    {
	/* look for singletons anywhere */
	n1 = find_any_singletons (n_row, n_col, Ap, Ai,
		Cdeg, Rdeg, Cperm, Rperm, &n1r, &n1c, Rp, Ri, W, Next) ;
    }

    /* ---------------------------------------------------------------------- */
    /* eliminate empty columns and complete the column permutation */
    /* ---------------------------------------------------------------------- */

    nempty_col = finish_permutation (n1, n_col, Cdeg, Quser, Cperm, &max_cdeg) ;

    /* ---------------------------------------------------------------------- */
    /* eliminate empty rows and complete the row permutation */
    /* ---------------------------------------------------------------------- */

    if (Quser != (Int *) NULL && strategy == UMFPACK_STRATEGY_SYMMETRIC)
    {
	/* rows should be symmetrically permuted according to Quser */
	ASSERT (n_row == n_col) ;
	nempty_row = finish_permutation (n1, n_row, Rdeg, Quser, Rperm,
	    &max_rdeg) ;
    }
    else
    {
	/* rows should not be symmetrically permuted according to Quser */
	nempty_row = finish_permutation (n1, n_row, Rdeg, (Int *) NULL, Rperm,
	    &max_rdeg) ;
    }

    /* ---------------------------------------------------------------------- */
    /* compute the inverse of Rperm */
    /* ---------------------------------------------------------------------- */

    for (k = 0 ; k < n_row ; k++)
    {
	ASSERT (Rperm [k] >= 0 && Rperm [k] < n_row) ;
	InvRperm [Rperm [k]] = k ;
    }

    /* ---------------------------------------------------------------------- */
    /* see if pruned submatrix is square and has been symmetrically permuted */
    /* ---------------------------------------------------------------------- */

    /* The prior version of this code (with a "break" statement; UMFPACK 5.2)
     * causes UMFPACK to fail when optimization is enabled with gcc version
     * 4.2.4 in a 64-bit Linux environment.  The bug is a compiler bug, not a
     * an UMFPACK bug.  It is fixed in gcc version 4.3.2.  However, as a
     * workaround for the compiler, the code below has been "fixed". */

    if (n_row == n_col && nempty_row == nempty_col)
    {
	/* is_sym is true if the submatrix is square, and
	 * Rperm [n1..n_row-nempty_row-1] = Cperm [n1..n_col-nempty_col-1] */
	is_sym = TRUE ;
	for (s = n1 ; /* replaced the break with this test: */ is_sym &&
            /* the remainder of this test is unchanged from v5.2.0: */
            s < n_col - nempty_col ; s++)
	{
	    if (Cperm [s] != Rperm [s])
	    {
		is_sym = FALSE ;
		/* removed a break statement here, which is OK but it tickles
                 * the gcc 4.2.{3,4} compiler bug */
	    }
	}
    }
    else
    {
	is_sym = FALSE ;
    }

    DEBUGm4 (("Submatrix square and symmetrically permuted? "ID"\n", is_sym)) ;
    DEBUGm4 (("singletons "ID" row "ID" col "ID"\n", n1, n1r, n1c)) ;
    DEBUGm4 (("Empty cols "ID" rows "ID"\n", nempty_col, nempty_row)) ;
    *p_n1 = n1 ;
    *p_n1r = n1r ;
    *p_n1c = n1c ;
    *p_is_sym = is_sym ;
    *p_nempty_col = nempty_col ;
    *p_nempty_row = nempty_row ;
    *p_max_rdeg = max_rdeg ;
    return (UMFPACK_OK) ;
}
GLOBAL Int UMFPACK_numeric
(
    const Int Ap [ ],
    const Int Ai [ ],
    const double Ax [ ],
#ifdef COMPLEX
    const double Az [ ],
#endif
    void *SymbolicHandle,
    void **NumericHandle,
    const double Control [UMFPACK_CONTROL],
    double User_Info [UMFPACK_INFO]
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    double Info2 [UMFPACK_INFO], alloc_init, relpt, relpt2, droptol,
	front_alloc_init, stats [2] ;
    double *Info ;
    WorkType WorkSpace, *Work ;
    NumericType *Numeric ;
    SymbolicType *Symbolic ;
    Int n_row, n_col, n_inner, newsize, i, status, *inew, npiv, ulen, scale ;
    Unit *mnew ;

    /* ---------------------------------------------------------------------- */
    /* get the amount of time used by the process so far */
    /* ---------------------------------------------------------------------- */

    umfpack_tic (stats) ;

    /* ---------------------------------------------------------------------- */
    /* initialize and check inputs */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    UMF_dump_start ( ) ;
    init_count = UMF_malloc_count ;
    DEBUGm4 (("\nUMFPACK numeric: U transpose version\n")) ;
#endif

    /* If front_alloc_init negative then allocate that size of front in
     * UMF_start_front.  If alloc_init negative, then allocate that initial
     * size of Numeric->Memory. */

    relpt = GET_CONTROL (UMFPACK_PIVOT_TOLERANCE,
	UMFPACK_DEFAULT_PIVOT_TOLERANCE) ;
    relpt2 = GET_CONTROL (UMFPACK_SYM_PIVOT_TOLERANCE,
	UMFPACK_DEFAULT_SYM_PIVOT_TOLERANCE) ;
    alloc_init = GET_CONTROL (UMFPACK_ALLOC_INIT, UMFPACK_DEFAULT_ALLOC_INIT) ;
    front_alloc_init = GET_CONTROL (UMFPACK_FRONT_ALLOC_INIT,
	UMFPACK_DEFAULT_FRONT_ALLOC_INIT) ;
    scale = GET_CONTROL (UMFPACK_SCALE, UMFPACK_DEFAULT_SCALE) ;
    droptol = GET_CONTROL (UMFPACK_DROPTOL, UMFPACK_DEFAULT_DROPTOL) ;

    relpt   = MAX (0.0, MIN (relpt,  1.0)) ;
    relpt2  = MAX (0.0, MIN (relpt2, 1.0)) ;
    droptol = MAX (0.0, droptol) ;
    front_alloc_init = MIN (1.0, front_alloc_init) ;

    if (scale != UMFPACK_SCALE_NONE && scale != UMFPACK_SCALE_MAX)
    {
	scale = UMFPACK_DEFAULT_SCALE ;
    }

    if (User_Info != (double *) NULL)
    {
	/* return Info in user's array */
	Info = User_Info ;
	/* clear the parts of Info that are set by UMFPACK_numeric */
	for (i = UMFPACK_NUMERIC_SIZE ; i <= UMFPACK_MAX_FRONT_NCOLS ; i++)
	{
	    Info [i] = EMPTY ;
	}
	for (i = UMFPACK_NUMERIC_DEFRAG ; i < UMFPACK_IR_TAKEN ; i++)
	{
	    Info [i] = EMPTY ;
	}
    }
    else
    {
	/* no Info array passed - use local one instead */
	Info = Info2 ;
	for (i = 0 ; i < UMFPACK_INFO ; i++)
	{
	    Info [i] = EMPTY ;
	}
    }

    Symbolic = (SymbolicType *) SymbolicHandle ;
    Numeric = (NumericType *) NULL ;
    if (!UMF_valid_symbolic (Symbolic))
    {
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_Symbolic_object ;
	return (UMFPACK_ERROR_invalid_Symbolic_object) ;
    }

    /* compute alloc_init automatically for AMD or other symmetric ordering */
    if (/* Symbolic->ordering == UMFPACK_ORDERING_AMD */ alloc_init >= 0
        && Symbolic->amd_lunz > 0)
    {
	alloc_init = (Symbolic->nz + Symbolic->amd_lunz) / Symbolic->lunz_bound;
	alloc_init = MIN (1.0, alloc_init) ;
	alloc_init *= UMF_REALLOC_INCREASE ;
    }

    n_row = Symbolic->n_row ;
    n_col = Symbolic->n_col ;
    n_inner = MIN (n_row, n_col) ;

    /* check for integer overflow in Numeric->Memory minimum size */
    if (INT_OVERFLOW (Symbolic->dnum_mem_init_usage * sizeof (Unit)))
    {
	/* :: int overflow, initial Numeric->Memory size :: */
	/* There's no hope to allocate a Numeric object big enough simply to
	 * hold the initial matrix, so return an out-of-memory condition */
	DEBUGm4 (("out of memory: numeric int overflow\n")) ;
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
	return (UMFPACK_ERROR_out_of_memory) ;
    }

    Info [UMFPACK_STATUS] = UMFPACK_OK ;
    Info [UMFPACK_NROW] = n_row ;
    Info [UMFPACK_NCOL] = n_col ;
    Info [UMFPACK_SIZE_OF_UNIT] = (double) (sizeof (Unit)) ;

    if (!Ap || !Ai || !Ax || !NumericHandle)
    {
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_argument_missing ;
	return (UMFPACK_ERROR_argument_missing) ;
    }

    Info [UMFPACK_NZ] = Ap [n_col] ;
    *NumericHandle = (void *) NULL ;

    /* ---------------------------------------------------------------------- */
    /* allocate the Work object */
    /* ---------------------------------------------------------------------- */

    /* (1) calls UMF_malloc 15 or 17 times, to obtain temporary workspace of
     * size c+1 Entry's and 2*(n_row+1) + 3*(n_col+1) + (n_col+n_inner+1) +
     * (nn+1) + * 3*(c+1) + 2*(r+1) + max(r,c) + (nfr+1) integers plus 2*nn
     * more integers if diagonal pivoting is to be done.  r is the maximum
     * number of rows in any frontal matrix, c is the maximum number of columns
     * in any frontal matrix, n_inner is min (n_row,n_col), nn is
     * max (n_row,n_col), and nfr is the number of frontal matrices.  For a
     * square matrix, this is c+1 Entry's and about 8n + 3c + 2r + max(r,c) +
     * nfr integers, plus 2n more for diagonal pivoting.
     */

    Work = &WorkSpace ;
    Work->n_row = n_row ;
    Work->n_col = n_col ;
    Work->nfr = Symbolic->nfr ;
    Work->nb = Symbolic->nb ;
    Work->n1 = Symbolic->n1 ;

    if (!work_alloc (Work, Symbolic))
    {
	DEBUGm4 (("out of memory: numeric work\n")) ;
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
	error (&Numeric, Work) ;
	return (UMFPACK_ERROR_out_of_memory) ;
    }
    ASSERT (UMF_malloc_count == init_count + 16 + 2*Symbolic->prefer_diagonal) ;

    /* ---------------------------------------------------------------------- */
    /* allocate Numeric object */
    /* ---------------------------------------------------------------------- */

    /* (2) calls UMF_malloc 10 or 11 times, for a total space of
     * sizeof (NumericType) bytes, 4*(n_row+1) + 4*(n_row+1) integers, and
     * (n_inner+1) Entry's, plus n_row Entry's if row scaling is to be done.
     * sizeof (NumericType) is a small constant.  Next, it calls UMF_malloc
     * once, for the variable-sized part of the Numeric object
     * (Numeric->Memory).  The size of this object is the larger of
     * (Control [UMFPACK_ALLOC_INIT]) *  (the approximate upper bound computed
     * by UMFPACK_symbolic), and the minimum required to start the numerical
     * factorization.  * This request is reduced if it fails.
     */

    if (!numeric_alloc (&Numeric, Symbolic, alloc_init, scale))
    {
	DEBUGm4 (("out of memory: initial numeric\n")) ;
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
	error (&Numeric, Work) ;
	return (UMFPACK_ERROR_out_of_memory) ;
    }
    DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
	init_count, UMF_malloc_count)) ;
    ASSERT (UMF_malloc_count == init_count
	+ (16 + 2*Symbolic->prefer_diagonal)
	+ (11 + (scale != UMFPACK_SCALE_NONE))) ;

    /* set control parameters */
    Numeric->relpt = relpt ;
    Numeric->relpt2 = relpt2 ;
    Numeric->droptol = droptol ;
    Numeric->alloc_init = alloc_init ;
    Numeric->front_alloc_init = front_alloc_init ;
    Numeric->scale = scale ;

    DEBUG0 (("umf relpt %g %g init %g %g inc %g red %g\n",
	relpt, relpt2, alloc_init, front_alloc_init,
	UMF_REALLOC_INCREASE, UMF_REALLOC_REDUCTION)) ;

    /* ---------------------------------------------------------------------- */
    /* scale and factorize */
    /* ---------------------------------------------------------------------- */

    /* (3) During numerical factorization (inside UMF_kernel), the variable-size
     * block of memory is increased in size via a call to UMF_realloc if it is
     * found to be too small.  During factorization, this block holds the
     * pattern and values of L and U at the top end, and the elements
     * (contibution blocks) and the current frontal matrix (Work->F*) at the
     * bottom end.  The peak size of the variable-sized object is estimated in
     * UMFPACK_*symbolic (Info [UMFPACK_VARIABLE_PEAK_ESTIMATE]), although this
     * upper bound can be very loose.  The size of the Symbolic object
     * (which is currently allocated) is in Info [UMFPACK_SYMBOLIC_SIZE], and
     * is between 2*n and 13*n integers.
     */

    DEBUG0 (("Calling umf_kernel\n")) ;
    status = UMF_kernel (Ap, Ai, Ax,
#ifdef COMPLEX
	Az,
#endif
	Numeric, Work, Symbolic) ;

    Info [UMFPACK_STATUS] = status ;
    if (status < UMFPACK_OK)
    {
	/* out of memory, or pattern has changed */
	error (&Numeric, Work) ;
	return (status) ;
    }

    Info [UMFPACK_FORCED_UPDATES] = Work->nforced ;
    Info [UMFPACK_VARIABLE_INIT] = Numeric->init_usage ;
    if (Symbolic->prefer_diagonal)
    {
	Info [UMFPACK_NOFF_DIAG] = Work->noff_diagonal ;
    }

    DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
	init_count, UMF_malloc_count)) ;

    npiv = Numeric->npiv ;	/* = n_inner for nonsingular matrices */
    ulen = Numeric->ulen ;	/* = 0 for square nonsingular matrices */

    /* ---------------------------------------------------------------------- */
    /* free Work object */
    /* ---------------------------------------------------------------------- */

    /* (4) After numerical factorization all of the objects allocated in step
     * (1) are freed via UMF_free, except that one object of size n_col+1 is
     * kept if there are off-diagonal nonzeros in the last pivot row (can only
     * occur for singular or rectangular matrices).  This is Work->Upattern,
     * which is transfered to Numeric->Upattern if ulen > 0.
     */

    DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
	init_count, UMF_malloc_count)) ;

    free_work (Work) ;

    DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
	init_count, UMF_malloc_count)) ;
    DEBUG0 (("Numeric->ulen: "ID" scale: "ID"\n", ulen, scale)) ;
    ASSERT (UMF_malloc_count == init_count + (ulen > 0) +
	(11 + (scale != UMFPACK_SCALE_NONE))) ;

    /* ---------------------------------------------------------------------- */
    /* reduce Lpos, Lilen, Lip, Upos, Uilen and Uip to size npiv+1 */
    /* ---------------------------------------------------------------------- */

    /* (5) Six components of the Numeric object are reduced in size if the
     * matrix is singular or rectangular.   The original size is 3*(n_row+1) +
     * 3*(n_col+1) integers.  The new size is 6*(npiv+1) integers.  For
     * square non-singular matrices, these two sizes are the same.
     */

    if (npiv < n_row)
    {
	/* reduce Lpos, Uilen, and Uip from size n_row+1 to size npiv */
	inew = (Int *) UMF_realloc (Numeric->Lpos, npiv+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Lpos = inew ;
	}
	inew = (Int *) UMF_realloc (Numeric->Uilen, npiv+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Uilen = inew ;
	}
	inew = (Int *) UMF_realloc (Numeric->Uip, npiv+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Uip = inew ;
	}
    }

    if (npiv < n_col)
    {
	/* reduce Upos, Lilen, and Lip from size n_col+1 to size npiv */
	inew = (Int *) UMF_realloc (Numeric->Upos, npiv+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Upos = inew ;
	}
	inew = (Int *) UMF_realloc (Numeric->Lilen, npiv+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Lilen = inew ;
	}
	inew = (Int *) UMF_realloc (Numeric->Lip, npiv+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Lip = inew ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* reduce Numeric->Upattern from size n_col+1 to size ulen+1 */
    /* ---------------------------------------------------------------------- */

    /* (6) The size of Numeric->Upattern (formerly Work->Upattern) is reduced
     * from size n_col+1 to size ulen + 1.  If ulen is zero, the object does
     * not exist. */

    DEBUG4 (("ulen: "ID" Upattern "ID"\n", ulen, (Int) Numeric->Upattern)) ;
    ASSERT (IMPLIES (ulen == 0, Numeric->Upattern == (Int *) NULL)) ;
    if (ulen > 0 && ulen < n_col)
    {
	inew = (Int *) UMF_realloc (Numeric->Upattern, ulen+1, sizeof (Int)) ;
	if (inew)
	{
	    Numeric->Upattern = inew ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* reduce Numeric->Memory to hold just the LU factors at the head */
    /* ---------------------------------------------------------------------- */

    /* (7) The variable-sized block (Numeric->Memory) is reduced to hold just L
     * and U, via a call to UMF_realloc, since the frontal matrices are no
     * longer needed.
     */

    newsize = Numeric->ihead ;
    if (newsize < Numeric->size)
    {
	mnew = (Unit *) UMF_realloc (Numeric->Memory, newsize, sizeof (Unit)) ;
	if (mnew)
	{
	    /* realloc succeeded (how can it fail since the size is reduced?) */
	    Numeric->Memory = mnew ;
	    Numeric->size = newsize ;
	}
    }
    Numeric->ihead = Numeric->size ;
    Numeric->itail = Numeric->ihead ;
    Numeric->tail_usage = 0 ;
    Numeric->ibig = EMPTY ;
    /* UMF_mem_alloc_tail_block can no longer be called (no tail marker) */

    /* ---------------------------------------------------------------------- */
    /* report the results and return the Numeric object */
    /* ---------------------------------------------------------------------- */

    UMF_set_stats (
	Info,
	Symbolic,
	(double) Numeric->max_usage,	/* actual peak Numeric->Memory */
	(double) Numeric->size,		/* actual final Numeric->Memory */
	Numeric->flops,			/* actual "true flops" */
	(double) Numeric->lnz + n_inner,		/* actual nz in L */
	(double) Numeric->unz + Numeric->nnzpiv,	/* actual nz in U */
	(double) Numeric->maxfrsize,	/* actual largest front size */
	(double) ulen,			/* actual Numeric->Upattern size */
	(double) npiv,			/* actual # pivots found */
	(double) Numeric->maxnrows,	/* actual largest #rows in front */
	(double) Numeric->maxncols,	/* actual largest #cols in front */
	scale != UMFPACK_SCALE_NONE,
	Symbolic->prefer_diagonal,
	ACTUAL) ;

    Info [UMFPACK_ALLOC_INIT_USED] = Numeric->alloc_init ;
    Info [UMFPACK_NUMERIC_DEFRAG] = Numeric->ngarbage ;
    Info [UMFPACK_NUMERIC_REALLOC] = Numeric->nrealloc ;
    Info [UMFPACK_NUMERIC_COSTLY_REALLOC] = Numeric->ncostly ;
    Info [UMFPACK_COMPRESSED_PATTERN] = Numeric->isize ;
    Info [UMFPACK_LU_ENTRIES] = Numeric->nLentries + Numeric->nUentries +
	    Numeric->npiv ;
    Info [UMFPACK_UDIAG_NZ] = Numeric->nnzpiv ;
    Info [UMFPACK_RSMIN] = Numeric->rsmin ;
    Info [UMFPACK_RSMAX] = Numeric->rsmax ;
    Info [UMFPACK_WAS_SCALED] = Numeric->scale ;

    /* nz in L and U with no dropping of small entries */
    Info [UMFPACK_ALL_LNZ] = Numeric->all_lnz + n_inner ;
    Info [UMFPACK_ALL_UNZ] = Numeric->all_unz + Numeric->nnzpiv ;
    Info [UMFPACK_NZDROPPED] =
	  (Numeric->all_lnz - Numeric->lnz)
	+ (Numeric->all_unz - Numeric->unz) ;

    /* estimate of the reciprocal of the condition number. */
    if (SCALAR_IS_ZERO (Numeric->min_udiag)
     || SCALAR_IS_ZERO (Numeric->max_udiag)
     ||	SCALAR_IS_NAN (Numeric->min_udiag)
     ||	SCALAR_IS_NAN (Numeric->max_udiag))
    {
	/* rcond is zero if there is any zero or NaN on the diagonal */
	Numeric->rcond = 0.0 ;
    }
    else
    {
	/* estimate of the recipricol of the condition number. */
	/* This is NaN if diagonal is zero-free, but has one or more NaN's. */
	Numeric->rcond = Numeric->min_udiag / Numeric->max_udiag ;
    }
    Info [UMFPACK_UMIN]  = Numeric->min_udiag ;
    Info [UMFPACK_UMAX]  = Numeric->max_udiag ;
    Info [UMFPACK_RCOND] = Numeric->rcond ;

    if (Numeric->nnzpiv < n_inner
    || SCALAR_IS_ZERO (Numeric->rcond) || SCALAR_IS_NAN (Numeric->rcond))
    {
	/* there are zeros and/or NaN's on the diagonal of U */
	DEBUG0 (("Warning, matrix is singular in umfpack_numeric\n")) ;
	DEBUG0 (("nnzpiv "ID" n_inner "ID" rcond %g\n", Numeric->nnzpiv,
	    n_inner, Numeric->rcond)) ;
	status = UMFPACK_WARNING_singular_matrix ;
	Info [UMFPACK_STATUS] = status ;
    }

    Numeric->valid = NUMERIC_VALID ;
    *NumericHandle = (void *) Numeric ;

    /* Numeric has 11 to 13 objects */
    ASSERT (UMF_malloc_count == init_count + 11 +
	+ (ulen > 0)			    /* Numeric->Upattern */
	+ (scale != UMFPACK_SCALE_NONE)) ;  /* Numeric->Rs */

    /* ---------------------------------------------------------------------- */
    /* get the time used by UMFPACK_numeric */
    /* ---------------------------------------------------------------------- */

    umfpack_toc (stats) ;
    Info [UMFPACK_NUMERIC_WALLTIME] = stats [0] ;
    Info [UMFPACK_NUMERIC_TIME] = stats [1] ;

    /* return UMFPACK_OK or UMFPACK_WARNING_singular_matrix */
    return (status) ;

}
PRIVATE int order_singletons	/* return new number of singletons */
(
    Int k,	    /* the number of singletons so far */
    Int head,
    Int tail,
    Int Next [ ],
    Int Xdeg [ ], Int Xperm [ ], const Int Xp [ ], const Int Xi [ ],
    Int Ydeg [ ], Int Yperm [ ], const Int Yp [ ], const Int Yi [ ]
#ifndef NDEBUG
    , char *xname, char *yname, Int nx, Int ny
#endif
)
{
    Int xpivot, x, y, ypivot, p, p2, deg ;

#ifndef NDEBUG
    Int i, k1 = k ;
    dump_singletons (head, tail, Next, xname, Xdeg, nx) ;
    dump_mat (xname, yname, nx, ny, Xp, Xi, Xdeg, Ydeg) ;
    dump_mat (yname, xname, ny, nx, Yp, Yi, Ydeg, Xdeg) ;
#endif

    while (head != EMPTY)
    {
	/* remove the singleton at the head of the queue */
	xpivot = head ;
	DEBUG1 (("------ Order %s singleton: "ID"\n", xname, xpivot)) ;
	head = Next [xpivot] ;
	if (head == EMPTY) tail = EMPTY ;

#ifndef NDEBUG
	if (k % 100 == 0) dump_singletons (head, tail, Next, xname, Xdeg, nx) ;
#endif

	ASSERT (Xdeg [xpivot] >= 0) ;
	if (Xdeg [xpivot] != 1)
	{
	    /* This row/column x is empty.  The matrix is singular.
	     * x will be ordered last in Xperm. */
	    DEBUG1 (("empty %s, after singletons removed\n", xname)) ;
	    continue ;
	}

	/* find the ypivot to match with this xpivot */
#ifndef NDEBUG
	/* there can only be one ypivot, since the degree of x is 1 */
	deg = 0 ;
	p2 = Xp [xpivot+1] ;
	for (p = Xp [xpivot] ; p < p2 ; p++)
	{
	    y = Xi [p] ;
	    DEBUG1 (("%s: "ID"\n", yname, y)) ;
	    if (Ydeg [y] >= 0)
	    {
		/* this is a live index in this xpivot vector */
		deg++ ;
	    }
	}
	ASSERT (deg == 1) ;
#endif

	ypivot = EMPTY ;
	p2 = Xp [xpivot+1] ;
	for (p = Xp [xpivot] ; p < p2 ; p++)
	{
	    y = Xi [p] ;
	    DEBUG1 (("%s: "ID"\n", yname, y)) ;
	    if (Ydeg [y] >= 0)
	    {
		/* this is a live index in this xpivot vector */
		ypivot = y ;
		break ;
	    }
	}

	DEBUG1 (("Pivot %s: "ID"\n", yname, ypivot)) ;
	ASSERT (ypivot != EMPTY) ;
	DEBUG1 (("deg "ID"\n", Ydeg [ypivot])) ;
	ASSERT (Ydeg [ypivot] >= 0) ;

	/* decrement the degrees after removing this singleton */
	DEBUG1 (("p1 "ID"\n", Yp [ypivot])) ;
	DEBUG1 (("p2 "ID"\n", Yp [ypivot+1])) ;
	p2 = Yp [ypivot+1] ;
	for (p = Yp [ypivot] ; p < p2 ; p++)
	{
	    x = Yi [p] ;
	    DEBUG1 (("    %s: "ID" deg: "ID"\n", xname, x, Xdeg [x])) ;
	    if (Xdeg [x] < 0) continue ;
	    ASSERT (Xdeg [x] > 0) ;
	    if (x == xpivot) continue ;
	    deg = --(Xdeg [x]) ;
	    ASSERT (Xdeg [x] >= 0) ;
	    if (deg == 1)
	    {
		/* this is a new singleton, put at the end of the queue */
		Next [x] = EMPTY ;
		if (head == EMPTY)
		{
		    head = x ;
		}
		else
		{
		    ASSERT (tail != EMPTY) ;
		    Next [tail] = x ;
		}
		tail = x ;
		DEBUG1 ((" New %s singleton:  "ID"\n", xname, x)) ;
#ifndef NDEBUG
		if (k % 100 == 0)
		{
		    dump_singletons (head, tail, Next, xname, Xdeg, nx) ;
		}
#endif
	    }
	}

	/* flag the xpivot and ypivot by FLIP'ing the degrees */
	Xdeg [xpivot] = FLIP (1) ;
	Ydeg [ypivot] = FLIP (Ydeg [ypivot]) ;

	/* keep track of the pivot row and column */
	Xperm [k] = xpivot ;
	Yperm [k] = ypivot ;
	k++ ;

#ifndef NDEBUG
	if (k % 1000 == 0)
	{
	    dump_mat (xname, yname, nx, ny, Xp, Xi, Xdeg, Ydeg) ;
	    dump_mat (yname, xname, ny, nx, Yp, Yi, Ydeg, Xdeg) ;
	}
#endif
    }

#ifndef NDEBUG
    DEBUGm4 (("%s singletons: k = "ID"\n", xname, k)) ;
    for (i = k1 ; i < k ; i++)
    {
	DEBUG1 (("  %s: "ID" %s: "ID"\n", xname, Xperm [i], yname, Yperm [i])) ;
    }
    ASSERT (k > 0) ;
#endif

    return (k) ;
}
示例#5
0
GLOBAL Int UMF_create_element
(
    NumericType *Numeric,
    WorkType *Work,
    SymbolicType *Symbolic
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int j, col, row, *Fcols, *Frows, fnrows, fncols, *Cols, len, needunits, t1,
        t2, size, e, i, *E, *Fcpos, *Frpos, *Rows, eloc, fnr_curr, f,
        got_memory, *Row_tuples, *Row_degree, *Row_tlen, *Col_tuples, max_mark,
        *Col_degree, *Col_tlen, nn, n_row, n_col, r2, c2, do_Fcpos ;
    Entry *C, *Fcol ;
    Element *ep ;
    Unit *p, *Memory ;
    Tuple *tp, *tp1, *tp2, tuple, *tpend ;
#ifndef NDEBUG
    DEBUG2 (("FRONTAL WRAPUP\n")) ;
    UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    ASSERT (Work->fnpiv == 0) ;
    ASSERT (Work->fnzeros == 0) ;
    Row_degree = Numeric->Rperm ;
    Row_tuples = Numeric->Uip ;
    Row_tlen   = Numeric->Uilen ;
    Col_degree = Numeric->Cperm ;
    Col_tuples = Numeric->Lip ;
    Col_tlen   = Numeric->Lilen ;
    n_row = Work->n_row ;
    n_col = Work->n_col ;
    nn = MAX (n_row, n_col) ;
    Fcols = Work->Fcols ;
    Frows = Work->Frows ;
    Fcpos = Work->Fcpos ;
    Frpos = Work->Frpos ;
    Memory = Numeric->Memory ;
    fncols = Work->fncols ;
    fnrows = Work->fnrows ;

    tp = (Tuple *) NULL ;
    tp1 = (Tuple *) NULL ;
    tp2 = (Tuple *) NULL ;

    /* ---------------------------------------------------------------------- */
    /* add the current frontal matrix to the degrees of each column */
    /* ---------------------------------------------------------------------- */

    if (!Symbolic->fixQ)
    {
        /* but only if the column ordering is not fixed */
#pragma ivdep
        for (j = 0 ; j < fncols ; j++)
        {
            /* add the current frontal matrix to the degree */
            ASSERT (Fcols [j] >= 0 && Fcols [j] < n_col) ;
            Col_degree [Fcols [j]] += fnrows ;
        }
    }

    /* ---------------------------------------------------------------------- */
    /* add the current frontal matrix to the degrees of each row */
    /* ---------------------------------------------------------------------- */

#pragma ivdep
    for (i = 0 ; i < fnrows ; i++)
    {
        /* add the current frontal matrix to the degree */
        ASSERT (Frows [i] >= 0 && Frows [i] < n_row) ;
        Row_degree [Frows [i]] += fncols ;
    }

    /* ---------------------------------------------------------------------- */
    /* Reset the external degree counters */
    /* ---------------------------------------------------------------------- */

    E = Work->E ;
    max_mark = MAX_MARK (nn) ;

    if (!Work->pivcol_in_front)
    {
        /* clear the external column degrees. no more Usons of current front */
        Work->cdeg0 += (nn + 1) ;
        if (Work->cdeg0 >= max_mark)
        {
            /* guard against integer overflow.  This is very rare */
            DEBUG1 (("Integer overflow, cdeg\n")) ;
            Work->cdeg0 = 1 ;
#pragma ivdep
            for (e = 1 ; e <= Work->nel ; e++)
            {
                if (E [e])
                {
                    ep = (Element *) (Memory + E [e]) ;
                    ep->cdeg = 0 ;
                }
            }
        }
    }

    if (!Work->pivrow_in_front)
    {
        /* clear the external row degrees.  no more Lsons of current front */
        Work->rdeg0 += (nn + 1) ;
        if (Work->rdeg0 >= max_mark)
        {
            /* guard against integer overflow.  This is very rare */
            DEBUG1 (("Integer overflow, rdeg\n")) ;
            Work->rdeg0 = 1 ;
#pragma ivdep
            for (e = 1 ; e <= Work->nel ; e++)
            {
                if (E [e])
                {
                    ep = (Element *) (Memory + E [e]) ;
                    ep->rdeg = 0 ;
                }
            }
        }
    }

    /* ---------------------------------------------------------------------- */
    /* clear row/col offsets */
    /* ---------------------------------------------------------------------- */

    if (!Work->pivrow_in_front)
    {
#pragma ivdep
        for (j = 0 ; j < fncols ; j++)
        {
            Fcpos [Fcols [j]] = EMPTY ;
        }
    }

    if (!Work->pivcol_in_front)
    {
#pragma ivdep
        for (i = 0 ; i < fnrows ; i++)
        {
            Frpos [Frows [i]] = EMPTY ;
        }
    }

    if (fncols <= 0 || fnrows <= 0)
    {
        /* no element to create */
        DEBUG2 (("Element evaporation\n")) ;
        Work->prior_element = EMPTY ;
        return (TRUE) ;
    }

    /* ---------------------------------------------------------------------- */
    /* create element for later assembly */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    UMF_allocfail = FALSE ;
    if (UMF_gprob > 0)
    {
        double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
        DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
        UMF_allocfail = rrr < UMF_gprob ;
        if (UMF_allocfail) DEBUGm2 (("Random garbage collection (create)\n"));
    }
#endif

    needunits = 0 ;
    got_memory = FALSE ;
    eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C,
                                  &needunits, &ep) ;

    /* if UMF_get_memory needs to be called */
    if (Work->do_grow)
    {
        /* full compaction of current frontal matrix, since UMF_grow_front will
         * be called next anyway. */
        r2 = fnrows ;
        c2 = fncols ;
        do_Fcpos = FALSE ;
    }
    else
    {
        /* partial compaction. */
        r2 = MAX (fnrows, Work->fnrows_new + 1) ;
        c2 = MAX (fncols, Work->fncols_new + 1) ;
        /* recompute Fcpos if pivot row is in the front */
        do_Fcpos = Work->pivrow_in_front ;
    }

    if (!eloc)
    {
        /* Do garbage collection, realloc, and try again. */
        /* Compact the current front if it needs to grow anyway. */
        /* Note that there are no pivot rows or columns in the current front */
        DEBUGm3 (("get_memory from umf_create_element, 1\n")) ;
        if (!UMF_get_memory (Numeric, Work, needunits, r2, c2, do_Fcpos))
        {
            /* :: out of memory in umf_create_element (1) :: */
            DEBUGm4 (("out of memory: create element (1)\n")) ;
            return (FALSE) ;	/* out of memory */
        }
        got_memory = TRUE ;
        Memory = Numeric->Memory ;
        eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C,
                                      &needunits, &ep) ;
        ASSERT (eloc >= 0) ;
        if (!eloc)
        {
            /* :: out of memory in umf_create_element (2) :: */
            DEBUGm4 (("out of memory: create element (2)\n")) ;
            return (FALSE) ;	/* out of memory */
        }
    }

    e = ++(Work->nel) ;	/* get the name of this new frontal matrix */
    Work->prior_element = e ;
    DEBUG8 (("wrapup e "ID" nel "ID"\n", e, Work->nel)) ;

    ASSERT (e > 0 && e < Work->elen) ;
    ASSERT (E [e] == 0) ;
    E [e] = eloc ;

    if (Work->pivcol_in_front)
    {
        /* the new element is a Uson of the next frontal matrix */
        ep->cdeg = Work->cdeg0 ;
    }

    if (Work->pivrow_in_front)
    {
        /* the new element is an Lson of the next frontal matrix */
        ep->rdeg = Work->rdeg0 ;
    }

    /* ---------------------------------------------------------------------- */
    /* copy frontal matrix into the new element */
    /* ---------------------------------------------------------------------- */

#pragma ivdep
    for (i = 0 ; i < fnrows ; i++)
    {
        Rows [i] = Frows [i] ;
    }
#pragma ivdep
    for (i = 0 ; i < fncols ; i++)
    {
        Cols [i] = Fcols [i] ;
    }
    Fcol = Work->Fcblock ;
    DEBUG0 (("copy front "ID" by "ID"\n", fnrows, fncols)) ;
    fnr_curr = Work->fnr_curr ;
    ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ;
    for (j = 0 ; j < fncols ; j++)
    {
        copy_column (fnrows, Fcol, C) ;
        Fcol += fnr_curr ;
        C += fnrows ;
    }

    DEBUG8 (("element copied\n")) ;

    /* ---------------------------------------------------------------------- */
    /* add tuples for the new element */
    /* ---------------------------------------------------------------------- */

    tuple.e = e ;

    if (got_memory)
    {

        /* ------------------------------------------------------------------ */
        /* UMF_get_memory ensures enough space exists for each new tuple */
        /* ------------------------------------------------------------------ */

        /* place (e,f) in the element list of each column */
        for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++)
        {
            col = Fcols [tuple.f] ;
            ASSERT (col >= 0 && col < n_col) ;
            ASSERT (NON_PIVOTAL_COL (col)) ;
            ASSERT (Col_tuples [col]) ;
            tp = ((Tuple *) (Memory + Col_tuples [col])) + Col_tlen [col]++ ;
            *tp = tuple ;
        }

        /* ------------------------------------------------------------------ */

        /* place (e,f) in the element list of each row */
        for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++)
        {
            row = Frows [tuple.f] ;
            ASSERT (row >= 0 && row < n_row) ;
            ASSERT (NON_PIVOTAL_ROW (row)) ;
            ASSERT (Row_tuples [row]) ;
            tp = ((Tuple *) (Memory + Row_tuples [row])) + Row_tlen [row]++ ;
            *tp = tuple ;
        }

    }
    else
    {

        /* ------------------------------------------------------------------ */
        /* place (e,f) in the element list of each column */
        /* ------------------------------------------------------------------ */

        /* might not have enough space for each tuple */

        for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++)
        {
            col = Fcols [tuple.f] ;
            ASSERT (col >= 0 && col < n_col) ;
            ASSERT (NON_PIVOTAL_COL (col)) ;
            t1 = Col_tuples [col] ;
            DEBUG1 (("Placing on col:"ID" , tuples at "ID"\n",
                     col, Col_tuples [col])) ;

            size = 0 ;
            len = 0 ;

            if (t1)
            {
                p = Memory + t1 ;
                tp = (Tuple *) p ;
                size = GET_BLOCK_SIZE (p) ;
                len = Col_tlen [col] ;
                tp2 = tp + len ;
            }

            needunits = UNITS (Tuple, len + 1) ;
            DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n",
                     len, size, needunits));

            if (needunits > size && t1)
            {
                /* prune the tuples */
                tp1 = tp ;
                tp2 = tp ;
                tpend = tp + len ;
                for ( ; tp < tpend ; tp++)
                {
                    e = tp->e ;
                    ASSERT (e > 0 && e <= Work->nel) ;
                    if (!E [e]) continue ;   /* element already deallocated */
                    f = tp->f ;
                    p = Memory + E [e] ;
                    ep = (Element *) p ;
                    p += UNITS (Element, 1) ;
                    Cols = (Int *) p ;
                    ;
                    if (Cols [f] == EMPTY) continue ;	/* already assembled */
                    ASSERT (col == Cols [f]) ;
                    *tp2++ = *tp ;	/* leave the tuple in the list */
                }
                len = tp2 - tp1 ;
                Col_tlen [col] = len ;
                needunits = UNITS (Tuple, len + 1) ;
            }

            if (needunits > size)
            {
                /* no room exists - reallocate elsewhere */
                DEBUG1 (("REALLOCATE Col: "ID", size "ID" to "ID"\n",
                         col, size, 2*needunits)) ;

#ifndef NDEBUG
                UMF_allocfail = FALSE ;
                if (UMF_gprob > 0)  /* a double relop, but ignore NaN case */
                {
                    double rrr = ((double) (rand ( ))) /
                                 (((double) RAND_MAX) + 1) ;
                    DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
                    UMF_allocfail = rrr < UMF_gprob ;
                    if (UMF_allocfail) DEBUGm2 (("Random gar. (col tuple)\n")) ;
                }
#endif

                needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ;
                t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ;
                if (!t2)
                {
                    /* :: get memory in umf_create_element (1) :: */
                    /* get memory, reconstruct all tuple lists, and return */
                    /* Compact the current front if it needs to grow anyway. */
                    /* Note: no pivot rows or columns in the current front */
                    DEBUGm4 (("get_memory from umf_create_element, 1\n")) ;
                    return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos));
                }
                Col_tuples [col] = t2 ;
                tp2 = (Tuple *) (Memory + t2) ;
                if (t1)
                {
                    for (i = 0 ; i < len ; i++)
                    {
                        *tp2++ = *tp1++ ;
                    }
                    UMF_mem_free_tail_block (Numeric, t1) ;
                }
            }

            /* place the new (e,f) tuple in the element list of the column */
            Col_tlen [col]++ ;
            *tp2 = tuple ;
        }

        /* ------------------------------------------------------------------ */
        /* place (e,f) in the element list of each row */
        /* ------------------------------------------------------------------ */

        for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++)
        {
            row = Frows [tuple.f] ;
            ASSERT (row >= 0 && row < n_row) ;
            ASSERT (NON_PIVOTAL_ROW (row)) ;
            t1 = Row_tuples [row] ;
            DEBUG1 (("Placing on row:"ID" , tuples at "ID"\n",
                     row, Row_tuples [row])) ;

            size = 0 ;
            len = 0 ;
            if (t1)
            {
                p = Memory + t1 ;
                tp = (Tuple *) p ;
                size = GET_BLOCK_SIZE (p) ;
                len = Row_tlen [row] ;
                tp2 = tp + len ;
            }

            needunits = UNITS (Tuple, len + 1) ;
            DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n",
                     len, size, needunits)) ;

            if (needunits > size && t1)
            {
                /* prune the tuples */
                tp1 = tp ;
                tp2 = tp ;
                tpend = tp + len ;
                for ( ; tp < tpend ; tp++)
                {
                    e = tp->e ;
                    ASSERT (e > 0 && e <= Work->nel) ;
                    if (!E [e])
                    {
                        continue ;	/* element already deallocated */
                    }
                    f = tp->f ;
                    p = Memory + E [e] ;
                    ep = (Element *) p ;
                    p += UNITS (Element, 1) ;
                    Cols = (Int *) p ;
                    Rows = Cols + (ep->ncols) ;
                    if (Rows [f] == EMPTY) continue ;	/* already assembled */
                    ASSERT (row == Rows [f]) ;
                    *tp2++ = *tp ;	/* leave the tuple in the list */
                }
                len = tp2 - tp1 ;
                Row_tlen [row] = len ;
                needunits = UNITS (Tuple, len + 1) ;
            }

            if (needunits > size)
            {
                /* no room exists - reallocate elsewhere */
                DEBUG1 (("REALLOCATE Row: "ID", size "ID" to "ID"\n",
                         row, size, 2*needunits)) ;

#ifndef NDEBUG
                UMF_allocfail = FALSE ;
                if (UMF_gprob > 0)  /* a double relop, but ignore NaN case */
                {
                    double rrr = ((double) (rand ( ))) /
                                 (((double) RAND_MAX) + 1) ;
                    DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
                    UMF_allocfail = rrr < UMF_gprob ;
                    if (UMF_allocfail) DEBUGm2 (("Random gar. (row tuple)\n")) ;
                }
#endif

                needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ;
                t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ;
                if (!t2)
                {
                    /* :: get memory in umf_create_element (2) :: */
                    /* get memory, reconstruct all tuple lists, and return */
                    /* Compact the current front if it needs to grow anyway. */
                    /* Note: no pivot rows or columns in the current front */
                    DEBUGm4 (("get_memory from umf_create_element, 2\n")) ;
                    return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos));
                }
                Row_tuples [row] = t2 ;
                tp2 = (Tuple *) (Memory + t2) ;
                if (t1)
                {
                    for (i = 0 ; i < len ; i++)
                    {
                        *tp2++ = *tp1++ ;
                    }
                    UMF_mem_free_tail_block (Numeric, t1) ;
                }
            }

            /* place the new (e,f) tuple in the element list of the row */
            Row_tlen [row]++ ;
            *tp2 = tuple ;
        }

    }

    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    DEBUG1 (("Done extending\nFINAL: element row pattern: len="ID"\n", fncols));
    for (j = 0 ; j < fncols ; j++) DEBUG1 ((""ID"\n", Fcols [j])) ;
    DEBUG1 (("FINAL: element col pattern:  len="ID"\n", fnrows)) ;
    for (j = 0 ; j < fnrows ; j++) DEBUG1 ((""ID"\n", Frows [j])) ;
    for (j = 0 ; j < fncols ; j++)
    {
        col = Fcols [j] ;
        ASSERT (col >= 0 && col < n_col) ;
        UMF_dump_rowcol (1, Numeric, Work, col, !Symbolic->fixQ) ;
    }
    for (j = 0 ; j < fnrows ; j++)
    {
        row = Frows [j] ;
        ASSERT (row >= 0 && row < n_row) ;
        UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
    }
    if (n_row < 1000 && n_col < 1000)
    {
        UMF_dump_memory (Numeric) ;
    }
    DEBUG1 (("New element, after filling with stuff: "ID"\n", e)) ;
    UMF_dump_element (Numeric, Work, e, TRUE) ;
    if (nn < 1000)
    {
        DEBUG4 (("Matrix dump, after New element: "ID"\n", e)) ;
        UMF_dump_matrix (Numeric, Work, TRUE) ;
    }
    DEBUG3 (("FRONTAL WRAPUP DONE\n")) ;
#endif

    return (TRUE) ;
}
示例#6
0
GLOBAL Int UMF_build_tuples
(
    NumericType *Numeric,
    WorkType *Work
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int e, nrows, ncols, nel, *Rows, *Cols, row, col, n_row, n_col, *E,
	*Row_tuples, *Row_degree, *Row_tlen,
	*Col_tuples, *Col_degree, *Col_tlen, n1 ;
    Element *ep ;
    Unit *p ;
    Tuple tuple, *tp ;

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    E = Work->E ;
    Col_degree = Numeric->Cperm ;	/* for NON_PIVOTAL_COL macro */
    Row_degree = Numeric->Rperm ;	/* for NON_PIVOTAL_ROW macro */
    Row_tuples = Numeric->Uip ;
    Row_tlen   = Numeric->Uilen ;
    Col_tuples = Numeric->Lip ;
    Col_tlen   = Numeric->Lilen ;
    n_row = Work->n_row ;
    n_col = Work->n_col ;
    nel = Work->nel ;
    n1 = Work->n1 ;

    DEBUG3 (("BUILD_TUPLES: n_row "ID" n_col "ID" nel "ID"\n",
	n_row, n_col, nel)) ;

    /* ---------------------------------------------------------------------- */
    /* allocate space for the tuple lists */
    /* ---------------------------------------------------------------------- */

    /* Garbage collection and memory reallocation have already attempted to */
    /* ensure that there is enough memory for all the tuple lists.  If */
    /* memory allocation fails here, then there is nothing more to be done. */

    for (row = n1 ; row < n_row ; row++)
    {
	if (NON_PIVOTAL_ROW (row))
	{
	    Row_tuples [row] = UMF_mem_alloc_tail_block (Numeric,
		UNITS (Tuple, TUPLES (Row_tlen [row]))) ;
	    if (!Row_tuples [row])
	    {
		/* :: out of memory for row tuples :: */
		DEBUGm4 (("out of memory: build row tuples\n")) ;
		return (FALSE) ;	/* out of memory for row tuples */
	    }
	    Row_tlen [row] = 0 ;
	}
    }

    /* push on stack in reverse order, so column tuples are in the order */
    /* that they will be deleted. */
    for (col = n_col-1 ; col >= n1 ; col--)
    {
	if (NON_PIVOTAL_COL (col))
	{
	    Col_tuples [col] = UMF_mem_alloc_tail_block (Numeric,
		UNITS (Tuple, TUPLES (Col_tlen [col]))) ;
	    if (!Col_tuples [col])
	    {
		/* :: out of memory for col tuples :: */
		DEBUGm4 (("out of memory: build col tuples\n")) ;
		return (FALSE) ;	/* out of memory for col tuples */
	    }
	    Col_tlen [col] = 0 ;
	}
    }

#ifndef NDEBUG
    UMF_dump_memory (Numeric) ;
#endif

    /* ---------------------------------------------------------------------- */
    /* create the tuple lists (exclude element 0) */
    /* ---------------------------------------------------------------------- */

    /* for all elements, in order of creation */
    for (e = 1 ; e <= nel ; e++)
    {
	DEBUG9 (("Adding tuples for element: "ID" at "ID"\n", e, E [e])) ;
	ASSERT (E [e]) ;	/* no external fragmentation */
	p = Numeric->Memory + E [e] ;
	GET_ELEMENT_PATTERN (ep, p, Cols, Rows, ncols) ;
	nrows = ep->nrows ;
	ASSERT (e != 0) ;
	ASSERT (e == 0 || nrows == ep->nrowsleft) ;
	ASSERT (e == 0 || ncols == ep->ncolsleft) ;
	tuple.e = e ;
	for (tuple.f = 0 ; tuple.f < ncols ; tuple.f++)
	{
	    col = Cols [tuple.f] ;
	    ASSERT (col >= n1 && col < n_col) ;
	    ASSERT (NON_PIVOTAL_COL (col)) ;
	    ASSERT (Col_tuples [col]) ;
	    tp = ((Tuple *) (Numeric->Memory + Col_tuples [col]))
		+ Col_tlen [col]++ ;
	    *tp = tuple ;
#ifndef NDEBUG
	    UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
	}
	for (tuple.f = 0 ; tuple.f < nrows ; tuple.f++)
	{
	    row = Rows [tuple.f] ;
	    ASSERT (row >= n1 && row < n_row) ;
	    ASSERT (NON_PIVOTAL_COL (col)) ;
	    ASSERT (Row_tuples [row]) ;
	    tp = ((Tuple *) (Numeric->Memory + Row_tuples [row]))
		+ Row_tlen [row]++ ;
	    *tp = tuple ;
#ifndef NDEBUG
	    UMF_dump_rowcol (0, Numeric, Work, row, FALSE) ;
#endif
	}
    }

    /* ---------------------------------------------------------------------- */
    /* the tuple lists are now valid, and can be scanned */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    UMF_dump_memory (Numeric) ;
    UMF_dump_matrix (Numeric, Work, FALSE) ;
#endif
    DEBUG3 (("BUILD_TUPLES: done\n")) ;
    return (TRUE) ;
}
示例#7
0
GLOBAL Int UMF_extend_front
(
    NumericType *Numeric,
    WorkType *Work
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int j, i, *Frows, row, col, *Wrow, fnr2, fnc2, *Frpos, *Fcpos, *Fcols,
	fnrows_extended, rrdeg, ccdeg, fncols_extended, fnr_curr, fnc_curr,
	fnrows, fncols, pos, fnpiv, *Wm ;
    Entry *Wx, *Wy, *Fu, *Fl ;

    /* ---------------------------------------------------------------------- */
    /* get current frontal matrix and check for frontal growth */
    /* ---------------------------------------------------------------------- */

    fnpiv = Work->fnpiv ;

#ifndef NDEBUG
    DEBUG2 (("EXTEND FRONT\n")) ;
    DEBUG2 (("Work->fnpiv "ID"\n", fnpiv)) ;
    ASSERT (Work->Flblock  == Work->Flublock + Work->nb*Work->nb) ;
    ASSERT (Work->Fublock  == Work->Flblock  + Work->fnr_curr*Work->nb) ;
    ASSERT (Work->Fcblock  == Work->Fublock  + Work->nb*Work->fnc_curr) ;
    DEBUG7 (("C  block: ")) ;
    UMF_dump_dense (Work->Fcblock,  Work->fnr_curr, Work->fnrows, Work->fncols) ;
    DEBUG7 (("L  block: ")) ;
    UMF_dump_dense (Work->Flblock,  Work->fnr_curr, Work->fnrows, fnpiv);
    DEBUG7 (("U' block: ")) ;
    UMF_dump_dense (Work->Fublock,  Work->fnc_curr, Work->fncols, fnpiv) ;
    DEBUG7 (("LU block: ")) ;
    UMF_dump_dense (Work->Flublock, Work->nb, fnpiv, fnpiv) ;
#endif

    if (Work->do_grow)
    {
	fnr2 = UMF_FRONTAL_GROWTH * Work->fnrows_new + 2 ;
	fnc2 = UMF_FRONTAL_GROWTH * Work->fncols_new + 2 ;
	if (!UMF_grow_front (Numeric, fnr2, fnc2, Work, 1))
	{
	    DEBUGm4 (("out of memory: extend front\n")) ;
	    return (FALSE) ;
	}
    }

    fnr_curr = Work->fnr_curr ;
    fnc_curr = Work->fnc_curr ;
    ASSERT (Work->fnrows_new + 1 <= fnr_curr) ;
    ASSERT (Work->fncols_new + 1 <= fnc_curr) ;
    ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ;

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    Frows = Work->Frows ;
    Frpos = Work->Frpos ;
    Fcols = Work->Fcols ;
    Fcpos = Work->Fcpos ;
    fnrows = Work->fnrows ;
    fncols = Work->fncols ;
    rrdeg = Work->rrdeg ;
    ccdeg = Work->ccdeg ;

    /* scan starts at the first new column in Fcols */
    /* also scan the pivot column if it was not in the front */
    Work->fscan_col = fncols ;
    Work->NewCols = Fcols ;

    /* scan1 starts at the first new row in Frows */
    /* also scan the pivot row if it was not in the front */
    Work->fscan_row = fnrows ;
    Work->NewRows = Frows ;

    /* ---------------------------------------------------------------------- */
    /* extend row pattern of the front with the new pivot column */
    /* ---------------------------------------------------------------------- */

    fnrows_extended = fnrows ;
    fncols_extended = fncols ;

#ifndef NDEBUG
    DEBUG2 (("Pivot col, before extension: "ID"\n", fnrows)) ;
    for (i = 0 ; i < fnrows ; i++)
    {
	DEBUG2 ((" "ID": row "ID"\n", i, Frows [i])) ;
	ASSERT (Frpos [Frows [i]] == i) ;
    }
    DEBUG2 (("Extending pivot column: pivcol_in_front: "ID"\n",
	Work->pivcol_in_front)) ;
#endif

    Fl = Work->Flblock + fnpiv * fnr_curr ;

    if (Work->pivcol_in_front)
    {
	/* extended pattern and position already in Frows, Frpos.  Values above
	 * the diagonal are already in LU block.  Values on and below the
	 * diagonal are in Wy [0 .. fnrows_extended-1].  Copy into the L
	 * block. */
	fnrows_extended += ccdeg ;
	Wy = Work->Wy ;

	for (i = 0 ; i < fnrows_extended ; i++)
	{
	    Fl [i] = Wy [i] ;
#ifndef NDEBUG
	    row = Frows [i] ;
	    DEBUG2 ((" "ID": row "ID" ", i, row)) ;
	    EDEBUG2 (Fl [i]) ;
	    if (row == Work->pivrow) DEBUG2 ((" <- pivrow")) ;
	    DEBUG2 (("\n")) ;
	    if (i == fnrows - 1) DEBUG2 ((" :::::::\n")) ;
	    ASSERT (row >= 0 && row < Work->n_row) ;
	    ASSERT (Frpos [row] == i) ;
#endif
	}

    }
    else
    {
	/* extended pattern,values is in (Wm,Wx), not yet in the front */
	Entry *F ;
	Fu = Work->Flublock + fnpiv * Work->nb ;
	Wm = Work->Wm ;
	Wx = Work->Wx ;
	F = Fu ;
	for (i = 0 ; i < fnpiv ; i++)
	{
	    CLEAR_AND_INCREMENT (F) ;
	}
	F = Fl ;
	for (i = 0 ; i < fnrows ; i++)
	{
	    CLEAR_AND_INCREMENT (F) ;
	}
	for (i = 0 ; i < ccdeg ; i++)
	{
	    row = Wm [i] ;
#ifndef NDEBUG
	    DEBUG2 ((" "ID": row "ID" (ext) ", fnrows_extended, row)) ;
	    EDEBUG2 (Wx [i]) ;
	    if (row == Work->pivrow) DEBUG2 ((" <- pivrow")) ;
	    DEBUG2 (("\n")) ;
	    ASSERT (row >= 0 && row < Work->n_row) ;
#endif
	    pos = Frpos [row] ;
	    if (pos < 0)
	    {
		pos = fnrows_extended++ ;
		Frows [pos] = row ;
		Frpos [row] = pos ;
	    }
	    Fl [pos] = Wx [i] ;
	}
    }

    ASSERT (fnrows_extended <= fnr_curr) ;

    /* ---------------------------------------------------------------------- */
    /* extend the column pattern of the front with the new pivot row */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    DEBUG6 (("Pivot row, before extension: "ID"\n", fncols)) ;
    for (j = 0 ; j < fncols ; j++)
    {
	DEBUG7 ((" "ID": col "ID"\n", j, Fcols [j])) ;
	ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ;
    }
    DEBUG6 (("Extending pivot row:\n")) ;
#endif

    if (Work->pivrow_in_front)
    {
	if (Work->pivcol_in_front)
	{
	    ASSERT (Fcols == Work->Wrow) ;
	    for (j = fncols ; j < rrdeg ; j++)
	    {
#ifndef NDEBUG
		col = Fcols [j] ;
		DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ;
		ASSERT (col != Work->pivcol) ;
		ASSERT (col >= 0 && col < Work->n_col) ;
		ASSERT (Fcpos [col] < 0) ;
#endif
		Fcpos [Fcols [j]] = j * fnr_curr ;
	    }
	}
	else
	{
	    /* OUT-IN option: pivcol not in front, but pivrow is in front */
	    Wrow = Work->Wrow ;
	    ASSERT (IMPLIES (Work->pivcol_in_front, Wrow == Fcols)) ;
	    if (Wrow == Fcols)
	    {
		/* Wrow and Fcols are equivalenced */
		for (j = fncols ; j < rrdeg ; j++)
		{
		    col = Wrow [j] ;
		    DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ;
		    ASSERT (Fcpos [col] < 0) ;
		    /* Fcols [j] = col ;  not needed */
		    Fcpos [col] = j * fnr_curr ;
		}
	    }
	    else
	    {
		for (j = fncols ; j < rrdeg ; j++)
		{
		    col = Wrow [j] ;
		    DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ;
		    ASSERT (Fcpos [col] < 0) ;
		    Fcols [j] = col ;
		    Fcpos [col] = j * fnr_curr ;
		}
	    }
	}
	fncols_extended = rrdeg ;
    }
    else
    {
	ASSERT (Fcols != Work->Wrow) ;
	Wrow = Work->Wrow ;
	for (j = 0 ; j < rrdeg ; j++)
	{
	    col = Wrow [j] ;
	    ASSERT (col >= 0 && col < Work->n_col) ;
	    if (Fcpos [col] < 0)
	    {
		DEBUG2 ((" col:: "ID" (ext)\n", col)) ;
		Fcols [fncols_extended] = col ;
		Fcpos [col] = fncols_extended * fnr_curr ;
		fncols_extended++ ;
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* pivot row and column have been extended */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    ASSERT (fncols_extended <= fnc_curr) ;
    ASSERT (fnrows_extended <= fnr_curr) ;

    DEBUG6 (("Pivot col, after ext: "ID" "ID"\n", fnrows,fnrows_extended)) ;
    for (i = 0 ; i < fnrows_extended ; i++)
    {
	row = Frows [i] ;
	DEBUG7 ((" "ID": row "ID" pos "ID" old: %d", i, row, Frpos [row],
	    i < fnrows)) ;
	if (row == Work->pivrow ) DEBUG7 (("  <-- pivrow")) ;
	DEBUG7 (("\n")) ;
	ASSERT (Frpos [Frows [i]] == i) ;
    }

    DEBUG6 (("Pivot row position: "ID"\n", Frpos [Work->pivrow])) ;
    ASSERT (Frpos [Work->pivrow] >= 0) ;
    ASSERT (Frpos [Work->pivrow] < fnrows_extended) ;

    DEBUG6 (("Pivot row, after ext: "ID" "ID"\n", fncols,fncols_extended)) ;
    for (j = 0 ; j < fncols_extended ; j++)
    {
	col = Fcols [j] ;
	DEBUG7 ((" "ID": col "ID" pos "ID" old: %d", j, col, Fcpos [col],
	    j < fncols)) ;
	if (col == Work->pivcol ) DEBUG7 (("  <-- pivcol")) ;
	DEBUG7 (("\n")) ;
	ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ;
    }

    DEBUG6 (("Pivot col position: "ID"\n", Fcpos [Work->pivcol])) ;
    ASSERT (Fcpos [Work->pivcol] >= 0) ;
    ASSERT (Fcpos [Work->pivcol] < fncols_extended * fnr_curr) ;

#endif

    /* ---------------------------------------------------------------------- */
    /* Zero the newly extended frontal matrix */
    /* ---------------------------------------------------------------------- */

    zero_front (Work->Flblock, Work->Fublock, Work->Fcblock,
	fnrows, fncols, fnr_curr, fnc_curr,
	fnpiv, fnrows_extended, fncols_extended) ;

    /* ---------------------------------------------------------------------- */
    /* finalize extended row and column pattern of the frontal matrix */
    /* ---------------------------------------------------------------------- */

    Work->fnrows = fnrows_extended ;
    Work->fncols = fncols_extended ;

    ASSERT (fnrows_extended == Work->fnrows_new + 1) ;
    ASSERT (fncols_extended == Work->fncols_new + 1) ;

    return (TRUE) ;

}
GLOBAL void UMF_2by2
(
    /* input, not modified: */
    Int n,		    /* A is n-by-n */
    const Int Ap [ ],	    /* size n+1 */
    const Int Ai [ ],	    /* size nz = Ap [n] */
    const double Ax [ ],    /* size nz if present */
#ifdef COMPLEX
    const double Az [ ],    /* size nz if present */
#endif
    double tol,		/* tolerance for determining whether or not an
			 * entry is numerically acceptable.  If tol <= 0
			 * then all numerical values ignored. */
    Int scale,		/* scaling to perform (none, sum, or max) */
    Int Cperm1 [ ],	/* singleton permutations */
#ifndef NDEBUG
    Int Rperm1 [ ],	/* not needed, since Rperm1 = Cperm1 for submatrix S */
#endif
    Int InvRperm1 [ ],	/* inverse of Rperm1 */
    Int n1,		/* number of singletons */
    Int nempty,		/* number of empty rows/cols */

    /* input, contents undefined on output: */
    Int Degree [ ],	/* Degree [j] is the number of off-diagonal
			 * entries in row/column j of S+S', where
			 * where S = A (Cperm1 [n1..], Rperm1 [n1..]).
			 * Note that S is not used, nor formed. */

    /* output: */
    Int P [ ],		/* P [k] = i means original row i is kth row in S(P,:)
			 * where S = A (Cperm1 [n1..], Rperm1 [n1..]) */
    Int *p_nweak,
    Int *p_unmatched,

    /* workspace (not defined on input or output): */
    Int Ri [ ],		/* of size >= max (nz, n) */
    Int Rp [ ],		/* of size n+1 */
    double Rs [ ],	/* of size n if present.  Rs = sum (abs (A),2) or
			 * max (abs (A),2), the sum or max of each row.  Unused
			 * if scale is equal to UMFPACK_SCALE_NONE. */
    Int Head [ ],	/* of size n.  Head pointers for bucket sort */
    Int Next [ ],	/* of size n.  Next pointers for bucket sort */
    Int Ci [ ],		/* size nz */
    Int Cp [ ]		/* size n+1 */
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Entry aij ;
    double cmax, value, rs, ctol, dvalue ;
    Int k, p, row, col, do_values, do_sum, do_max, do_scale, nweak, weak,
	p1, p2, dfound, unmatched, n2, oldrow, newrow, oldcol, newcol, pp ;
#ifdef COMPLEX
    Int split = SPLIT (Az) ;
#endif
#ifndef NRECIPROCAL
    Int do_recip = FALSE ;
#endif

#ifndef NDEBUG
    /* UMF_debug += 99 ; */
    DEBUGm3 (("\n ==================================UMF_2by2: tol %g\n", tol)) ;
    ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ;
    for (k = n1 ; k < n - nempty ; k++)
    {
	ASSERT (Cperm1 [k] == Rperm1 [k]) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* determine scaling options */
    /* ---------------------------------------------------------------------- */

    /* use the values, but only if they are present */
    /* ignore the values if tol <= 0 */
    do_values = (tol > 0) && (Ax != (double *) NULL) ;
    if (do_values && (Rs != (double *) NULL))
    {
	do_sum = (scale == UMFPACK_SCALE_SUM) ;
	do_max = (scale == UMFPACK_SCALE_MAX) ;
    }
    else
    {
	/* no scaling */
	do_sum = FALSE ;
	do_max = FALSE ;
    }
    do_scale = do_max || do_sum ;
    DEBUGm3 (("do_values "ID" do_sum "ID" do_max "ID" do_scale "ID"\n",
	do_values, do_sum, do_max, do_scale)) ;

    /* ---------------------------------------------------------------------- */
    /* compute the row scaling, if requested */
    /* ---------------------------------------------------------------------- */

    /* see also umf_kernel_init */

    if (do_scale)
    {
#ifndef NRECIPROCAL
	double rsmin ;
#endif
	for (row = 0 ; row < n ; row++)
	{
	    Rs [row] = 0.0 ;
	}
	for (col = 0 ; col < n ; col++)
	{
	    p2 = Ap [col+1] ;
	    for (p = Ap [col] ; p < p2 ; p++)
	    {
		row = Ai [p] ;
		ASSIGN (aij, Ax, Az, p, split) ;
		APPROX_ABS (value, aij) ;
		rs = Rs [row] ;
		if (!SCALAR_IS_NAN (rs))
		{
		    if (SCALAR_IS_NAN (value))
		    {
			/* if any entry in a row is NaN, then the scale factor
			 * for the row is NaN.  It will be set to 1 later. */
			Rs [row] = value ;
		    }
		    else if (do_max)
		    {
			Rs [row] = MAX (rs, value) ;
		    }
		    else
		    {
			Rs [row] += value ;
		    }
		}
	    }
	}
#ifndef NRECIPROCAL
	rsmin = Rs [0] ;
	if (SCALAR_IS_ZERO (rsmin) || SCALAR_IS_NAN (rsmin))
	{
	    rsmin = 1.0 ;
	}
#endif
	for (row = 0 ; row < n ; row++)
	{
	    /* do not scale an empty row, or a row with a NaN */
	    rs = Rs [row] ;
	    if (SCALAR_IS_ZERO (rs) || SCALAR_IS_NAN (rs))
	    {
		Rs [row] = 1.0 ;
	    }
#ifndef NRECIPROCAL
	    rsmin = MIN (rsmin, Rs [row]) ;
#endif
	}

#ifndef NRECIPROCAL
	/* multiply by the reciprocal if Rs is not too small */
	do_recip = (rsmin >= RECIPROCAL_TOLERANCE) ;
	if (do_recip)
	{
	    /* invert the scale factors */
	    for (row = 0 ; row < n ; row++)
	    {
		Rs [row] = 1.0 / Rs [row] ;
	    }
	}
#endif
    }

    /* ---------------------------------------------------------------------- */
    /* compute the max in each column and find diagonal */
    /* ---------------------------------------------------------------------- */

    nweak = 0 ;

#ifndef NDEBUG
    for (k = 0 ; k < n ; k++)
    {
	ASSERT (Rperm1 [k] >= 0 && Rperm1 [k] < n) ;
	ASSERT (InvRperm1 [Rperm1 [k]] == k) ;
    }
#endif

    n2 = n - n1 - nempty ;

    /* use Ri to count the number of strong entries in each row */
    for (row = 0 ; row < n2 ; row++)
    {
	Ri [row] = 0 ;
    }

    pp = 0 ;
    ctol = 0 ;
    dvalue = 1 ;

    /* construct C = pruned submatrix, strong values only, column form */

    for (k = n1 ; k < n - nempty ; k++)
    {
	oldcol = Cperm1 [k] ;
	newcol = k - n1 ;
	Next [newcol] = EMPTY ;
	DEBUGm1 (("Column "ID" newcol "ID" oldcol "ID"\n", k, newcol, oldcol)) ;

	Cp [newcol] = pp ;

	dfound = FALSE ;
	p1 = Ap [oldcol] ;
	p2 = Ap [oldcol+1] ;
	if (do_values)
	{
	    cmax = 0 ;
	    dvalue = 0 ;

	    if (!do_scale)
	    {
		/* no scaling */
		for (p = p1 ; p < p2 ; p++)
		{
		    oldrow = Ai [p] ;
		    ASSERT (oldrow >= 0 && oldrow < n) ;
		    newrow = InvRperm1 [oldrow] - n1 ;
		    ASSERT (newrow >= -n1 && newrow < n2) ;
		    if (newrow < 0) continue ;
		    ASSIGN (aij, Ax, Az, p, split) ;
		    APPROX_ABS (value, aij) ;
		    /* if either cmax or value is NaN, define cmax as NaN */
		    if (!SCALAR_IS_NAN (cmax))
		    {
			if (SCALAR_IS_NAN (value))
			{
			    cmax = value ;
			}
			else
			{
			    cmax = MAX (cmax, value) ;
			}
		    }
		    if (oldrow == oldcol)
		    {
			/* we found the diagonal entry in this column */
			dvalue = value ;
			dfound = TRUE ;
			ASSERT (newrow == newcol) ;
		    }
		}
	    }
#ifndef NRECIPROCAL
	    else if (do_recip)
	    {
		/* multiply by the reciprocal */
		for (p = p1 ; p < p2 ; p++)
		{
		    oldrow = Ai [p] ;
		    ASSERT (oldrow >= 0 && oldrow < n) ;
		    newrow = InvRperm1 [oldrow] - n1 ;
		    ASSERT (newrow >= -n1 && newrow < n2) ;
		    if (newrow < 0) continue ;
		    ASSIGN (aij, Ax, Az, p, split) ;
		    APPROX_ABS (value, aij) ;
		    value *= Rs [oldrow] ;
		    /* if either cmax or value is NaN, define cmax as NaN */
		    if (!SCALAR_IS_NAN (cmax))
		    {
			if (SCALAR_IS_NAN (value))
			{
			    cmax = value ;
			}
			else
			{
			    cmax = MAX (cmax, value) ;
			}
		    }
		    if (oldrow == oldcol)
		    {
			/* we found the diagonal entry in this column */
			dvalue = value ;
			dfound = TRUE ;
			ASSERT (newrow == newcol) ;
		    }
		}
	    }
#endif
	    else
	    {
		/* divide instead */
		for (p = p1 ; p < p2 ; p++)
		{
		    oldrow = Ai [p] ;
		    ASSERT (oldrow >= 0 && oldrow < n) ;
		    newrow = InvRperm1 [oldrow] - n1 ;
		    ASSERT (newrow >= -n1 && newrow < n2) ;
		    if (newrow < 0) continue ;
		    ASSIGN (aij, Ax, Az, p, split) ;
		    APPROX_ABS (value, aij) ;
		    value /= Rs [oldrow] ;
		    /* if either cmax or value is NaN, define cmax as NaN */
		    if (!SCALAR_IS_NAN (cmax))
		    {
			if (SCALAR_IS_NAN (value))
			{
			    cmax = value ;
			}
			else
			{
			    cmax = MAX (cmax, value) ;
			}
		    }
		    if (oldrow == oldcol)
		    {
			/* we found the diagonal entry in this column */
			dvalue = value ;
			dfound = TRUE ;
			ASSERT (newrow == newcol) ;
		    }
		}
	    }

	    ctol = tol * cmax ;
	    DEBUGm1 (("    cmax col "ID" %g  ctol %g\n", oldcol, cmax, ctol)) ;
	}
	else
	{
	    for (p = p1 ; p < p2 ; p++)
	    {
		oldrow = Ai [p] ;
		ASSERT (oldrow >= 0 && oldrow < n) ;
		newrow = InvRperm1 [oldrow] - n1 ;
		ASSERT (newrow >= -n1 && newrow < n2) ;
		if (newrow < 0) continue ;
		Ci [pp++] = newrow ;
		if (oldrow == oldcol)
		{
		    /* we found the diagonal entry in this column */
		    ASSERT (newrow == newcol) ;
		    dfound = TRUE ;
		}
		/* count the entries in each column */
		Ri [newrow]++ ;
	    }
	}

	/* ------------------------------------------------------------------ */
	/* flag the weak diagonals */
	/* ------------------------------------------------------------------ */

	if (!dfound)
	{
	    /* no diagonal entry present */
	    weak = TRUE ;
	}
	else
	{
	    /* diagonal entry is present, check its value */
	    weak = (do_values) ?  WEAK (dvalue, ctol) : FALSE ;
	}
	if (weak)
	{
	    /* flag this column as weak */
	    DEBUG0 (("Weak!\n")) ;
	    Next [newcol] = IS_WEAK ;
	    nweak++ ;
	}

	/* ------------------------------------------------------------------ */
	/* count entries in each row that are not numerically weak */
	/* ------------------------------------------------------------------ */

	if (do_values)
	{
	    if (!do_scale)
	    {
		/* no scaling */
		for (p = p1 ; p < p2 ; p++)
		{
		    oldrow = Ai [p] ;
		    newrow = InvRperm1 [oldrow] - n1 ;
		    if (newrow < 0) continue ;
		    ASSIGN (aij, Ax, Az, p, split) ;
		    APPROX_ABS (value, aij) ;
		    weak = WEAK (value, ctol) ;
		    if (!weak)
		    {
			DEBUG0 (("    strong: row "ID": %g\n", oldrow, value)) ;
			Ci [pp++] = newrow ;
			Ri [newrow]++ ;
		    }
		}
	    }
#ifndef NRECIPROCAL
	    else if (do_recip)
	    {
		/* multiply by the reciprocal */
		for (p = p1 ; p < p2 ; p++)
		{
		    oldrow = Ai [p] ;
		    newrow = InvRperm1 [oldrow] - n1 ;
		    if (newrow < 0) continue ;
		    ASSIGN (aij, Ax, Az, p, split) ;
		    APPROX_ABS (value, aij) ;
		    value *= Rs [oldrow] ;
		    weak = WEAK (value, ctol) ;
		    if (!weak)
		    {
			DEBUG0 (("    strong: row "ID": %g\n", oldrow, value)) ;
			Ci [pp++] = newrow ;
			Ri [newrow]++ ;
		    }
		}
	    }
#endif
	    else
	    {
		/* divide instead */
		for (p = p1 ; p < p2 ; p++)
		{
		    oldrow = Ai [p] ;
		    newrow = InvRperm1 [oldrow] - n1 ;
		    if (newrow < 0) continue ;
		    ASSIGN (aij, Ax, Az, p, split) ;
		    APPROX_ABS (value, aij) ;
		    value /= Rs [oldrow] ;
		    weak = WEAK (value, ctol) ;
		    if (!weak)
		    {
			DEBUG0 (("    strong: row "ID": %g\n", oldrow, value)) ;
			Ci [pp++] = newrow ;
			Ri [newrow]++ ;
		    }
		}
	    }
	}
    }
    Cp [n2] = pp ;
    ASSERT (AMD_valid (n2, n2, Cp, Ci) == AMD_OK) ;

    if (nweak == 0)
    {
	/* nothing to do, quick return */
	DEBUGm2 (("\n =============================UMF_2by2: quick return\n")) ;
	for (k = 0 ; k < n ; k++)
	{
	    P [k] = k ;
	}
	*p_nweak = 0 ;
	*p_unmatched = 0 ;
	return ;
    }

#ifndef NDEBUG
    for (k = 0 ; k < n2 ; k++)
    {
	P [k] = EMPTY ;
    }
    for (k = 0 ; k < n2 ; k++)
    {
	ASSERT (Degree [k] >= 0 && Degree [k] < n2) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* find the 2-by-2 permutation */
    /* ---------------------------------------------------------------------- */

    /* The matrix S is now mapped to the index range 0 to n2-1.  We have
     * S = A (Rperm [n1 .. n-nempty-1], Cperm [n1 .. n-nempty-1]), and then
     * C = pattern of strong entries in S.  A weak diagonal k in S is marked
     * with Next [k] = IS_WEAK. */

    unmatched = two_by_two (n2, Cp, Ci, Degree, Next, Ri, P, Rp, Head) ;

    /* ---------------------------------------------------------------------- */

    *p_nweak = nweak ;
    *p_unmatched = unmatched ;

#ifndef NDEBUG
    DEBUGm4 (("UMF_2by2: weak "ID"  unmatched "ID"\n", nweak, unmatched)) ;
    for (row = 0 ; row < n ; row++)
    {
	DEBUGm2 (("P ["ID"] = "ID"\n", row, P [row])) ;
    }
    DEBUGm2 (("\n =============================UMF_2by2: done\n\n")) ;
#endif
}
示例#9
0
GLOBAL Int UMF_start_front    /* returns TRUE if successful, FALSE otherwise */
(
    Int chain,
    NumericType *Numeric,
    WorkType *Work,
    SymbolicType *Symbolic
)
{
    Int fnrows_max, fncols_max, fnr2, fnc2, fsize, fcurr_size, maxfrsize,
	overflow, nb, f, cdeg ;
    double maxbytes ;

    nb = Symbolic->nb ;
    fnrows_max = Symbolic->Chain_maxrows [chain] ;
    fncols_max = Symbolic->Chain_maxcols [chain] ;

    DEBUGm2 (("Start Front for chain "ID".  fnrows_max "ID" fncols_max "ID"\n",
	chain, fnrows_max, fncols_max)) ;

    Work->fnrows_max = fnrows_max ;
    Work->fncols_max = fncols_max ;
    Work->any_skip = FALSE ;

    maxbytes = sizeof (Entry) *
	(double) (fnrows_max + nb) * (double) (fncols_max + nb) ;
    fcurr_size = Work->fcurr_size ;

    if (Symbolic->prefer_diagonal)
    {
	/* Get a rough upper bound on the degree of the first pivot column in
	 * this front.  Note that Col_degree is not maintained if diagonal
	 * pivoting is preferred.  For most matrices, the first pivot column
	 * of the first frontal matrix of a new chain has only one tuple in
	 * it anyway, so this bound is exact in that case. */
	Int col, tpi, e, *E, *Col_tuples, *Col_tlen, *Cols ;
	Tuple *tp, *tpend ;
	Unit *Memory, *p ;
	Element *ep ;
	E = Work->E ;
	Memory = Numeric->Memory ;
	Col_tuples = Numeric->Lip ;
	Col_tlen = Numeric->Lilen ;
	col = Work->nextcand ;
	tpi = Col_tuples [col] ;
	tp = (Tuple *) Memory + tpi ;
	tpend = tp + Col_tlen [col] ;
	cdeg = 0 ;
	DEBUGm3 (("\n=============== start front: col "ID" tlen "ID"\n",
		col, Col_tlen [col])) ;
	for ( ; tp < tpend ; tp++)
	{
	    DEBUG1 (("Tuple ("ID","ID")\n", tp->e, tp->f)) ;
	    e = tp->e ;
	    if (!E [e]) continue ;
	    f = tp->f ;
	    p = Memory + E [e] ;
	    ep = (Element *) p ;
	    p += UNITS (Element, 1) ;
	    Cols = (Int *) p ;
	    if (Cols [f] == EMPTY) continue ;
	    DEBUG1 (("  nrowsleft "ID"\n", ep->nrowsleft)) ;
	    cdeg += ep->nrowsleft ;
	}
#ifndef NDEBUG
	DEBUGm3 (("start front cdeg: "ID" col "ID"\n", cdeg, col)) ;
	UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif

	/* cdeg is now the rough upper bound on the degree of the next pivot
	 * column. */

	/* If AMD was called, we know the maximum number of nonzeros in any
	 * column of L.  Use this as an upper bound for cdeg, but add 2 to
	 * account for a small amount of off-diagonal pivoting. */
	if (Symbolic->amd_dmax > 0)
	{
	    cdeg = MIN (cdeg, Symbolic->amd_dmax) ;
	}

	/* Increase it to account for larger columns later on.
	 * Also ensure that it's larger than zero. */
	cdeg += 2 ;

	/* cdeg cannot be larger than fnrows_max */
	cdeg = MIN (cdeg, fnrows_max) ;

    }
    else
    {
	/* don't do the above cdeg computation */
	cdeg = 0 ;
    }

    DEBUGm2 (("fnrows max "ID" fncols_max "ID"\n", fnrows_max, fncols_max)) ;

    /* the current frontal matrix is empty */
    ASSERT (Work->fnrows == 0 && Work->fncols == 0 && Work->fnpiv == 0) ;

    /* maximum row dimension is always odd, to avoid bad cache effects */
    ASSERT (fnrows_max >= 0) ;
    ASSERT (fnrows_max % 2 == 1) ;

    /* ----------------------------------------------------------------------
     * allocate working array for current frontal matrix:
     * minimum size: 1-by-1
     * maximum size: fnrows_max-by-fncols_max
     * desired size:
     *
     *   if Numeric->front_alloc_init >= 0:
     *
     *	    for unsymmetric matrices:
     *	    Numeric->front_alloc_init * (fnrows_max-by-fncols_max)
     *
     *	    for symmetric matrices (diagonal pivoting preference, actually):
     *	    Numeric->front_alloc_init * (fnrows_max-by-fncols_max), or
     *	    cdeg*cdeg, whichever is smaller.
     *
     *   if Numeric->front_alloc_init < 0:
     *	    allocate a front of size -Numeric->front_alloc_init.
     *
     * Allocate the whole thing if it's small (less than 2*nb^2).  Make sure the
     * leading dimension of the frontal matrix is odd.
     *
     * Also allocate the nb-by-nb LU block, the dr-by-nb L block, and the
     * nb-by-dc U block.
     * ---------------------------------------------------------------------- */

    /* get the maximum front size, avoiding integer overflow */
    overflow = INT_OVERFLOW (maxbytes) ;
    if (overflow)
    {
	/* :: int overflow, max front size :: */
	maxfrsize = Int_MAX / sizeof (Entry) ;
    }
    else
    {
	maxfrsize = (fnrows_max + nb) * (fncols_max + nb) ;
    }
    ASSERT (!INT_OVERFLOW ((double) maxfrsize * sizeof (Entry))) ;

    if (Numeric->front_alloc_init < 0)
    {
	/* allocate a front of -Numeric->front_alloc_init entries */
	fsize = -Numeric->front_alloc_init ;
	fsize = MAX (1, fsize) ;
    }
    else
    {
	if (INT_OVERFLOW (Numeric->front_alloc_init * maxbytes))
	{
	    /* :: int overflow, requested front size :: */
	    fsize = Int_MAX / sizeof (Entry) ;
	}
	else
	{
	    fsize = Numeric->front_alloc_init * maxfrsize ;
	}

	if (cdeg > 0)
	{
	    /* diagonal pivoting is in use.  cdeg was computed above */
	    Int fsize2 ;

	    /* add the L and U blocks */
	    cdeg += nb ;

	    if (INT_OVERFLOW (((double) cdeg * (double) cdeg) * sizeof (Entry)))
	    {
		/* :: int overflow, symmetric front size :: */
		fsize2 = Int_MAX / sizeof (Entry) ;
	    }
	    else
	    {
		fsize2 = MAX (cdeg * cdeg, fcurr_size) ;
	    }
	    fsize = MIN (fsize, fsize2) ;
	}
    }

    fsize = MAX (fsize, 2*nb*nb) ;

    /* fsize and maxfrsize are now safe from integer overflow.  They both
     * include the size of the pivot blocks. */
    ASSERT (!INT_OVERFLOW ((double) fsize * sizeof (Entry))) ;

    Work->fnrows_new = 0 ;
    Work->fncols_new = 0 ;

    /* desired size is fnr2-by-fnc2 (includes L and U blocks): */
    DEBUGm2 (("    fsize "ID"  fcurr_size "ID"\n", fsize, fcurr_size)) ;
    DEBUGm2 (("    maxfrsize "ID"  fnr_curr "ID" fnc_curr "ID"\n", maxfrsize,
	Work->fnr_curr, Work->fnc_curr)) ;

    if (fsize >= maxfrsize && !overflow)
    {
	/* max working array is small, allocate all of it */
	fnr2 = fnrows_max + nb ;
	fnc2 = fncols_max + nb ;
	fsize = maxfrsize ;
	DEBUGm1 (("   sufficient for ("ID"+"ID")-by-("ID"+"ID")\n",
	    fnrows_max, nb, fncols_max, nb)) ;
    }
    else
    {
	/* allocate a smaller working array */
	if (fnrows_max <= fncols_max)
	{
	    fnr2 = (Int) sqrt ((double) fsize) ;
	    /* make sure fnr2 is odd */
	    fnr2 = MAX (fnr2, 1) ;
	    if (fnr2 % 2 == 0) fnr2++ ;
	    fnr2 = MIN (fnr2, fnrows_max + nb) ;
	    fnc2 = fsize / fnr2 ;
	}
	else
	{
	    fnc2 = (Int) sqrt ((double) fsize) ;
	    fnc2 = MIN (fnc2, fncols_max + nb) ;
	    fnr2 = fsize / fnc2 ;
	    /* make sure fnr2 is odd */
	    fnr2 = MAX (fnr2, 1) ;
	    if (fnr2 % 2 == 0)
	    {
		fnr2++ ;
		fnc2 = fsize / fnr2 ;
	    }
	}
	DEBUGm1 (("   smaller "ID"-by-"ID"\n", fnr2, fnc2)) ;
    }
    fnr2 = MIN (fnr2, fnrows_max + nb) ;
    fnc2 = MIN (fnc2, fncols_max + nb) ;
    ASSERT (fnr2 % 2 == 1) ;
    ASSERT (fnr2 * fnc2 <= fsize) ;

    fnr2 -= nb ;
    fnc2 -= nb ;
    ASSERT (fnr2 >= 0) ;
    ASSERT (fnc2 >= 0) ;

    if (fsize > fcurr_size)
    {
	DEBUGm1 (("   Grow front \n")) ;
	Work->do_grow = TRUE ;
	if (!UMF_grow_front (Numeric, fnr2, fnc2, Work, -1))
	{
	    /* since the minimum front size is 1-by-1, it would be nearly
	     * impossible to run out of memory here. */
	    DEBUGm4 (("out of memory: start front\n")) ;
	    return (FALSE) ;
	}
    }
    else
    {
	/* use the existing front */
	DEBUGm1 (("   existing front ok\n")) ;
	Work->fnr_curr = fnr2 ;
	Work->fnc_curr = fnc2 ;
	Work->Flblock  = Work->Flublock + nb * nb ;
	Work->Fublock  = Work->Flblock  + nb * fnr2 ;
	Work->Fcblock  = Work->Fublock  + nb * fnc2 ;
    }
    ASSERT (Work->Flblock  == Work->Flublock + Work->nb*Work->nb) ;
    ASSERT (Work->Fublock  == Work->Flblock  + Work->fnr_curr*Work->nb) ;
    ASSERT (Work->Fcblock  == Work->Fublock  + Work->nb*Work->fnc_curr) ;
    return (TRUE) ;
}
示例#10
0
GLOBAL Int UMF_row_search
(
    NumericType *Numeric,
    WorkType *Work,
    SymbolicType *Symbolic,
    Int cdeg0,			/* length of column in Front */
    Int cdeg1,			/* length of column outside Front */
    const Int Pattern [ ],	/* pattern of column, Pattern [0..cdeg1 -1] */
    const Int Pos [ ],		/* Pos [Pattern [0..cdeg1 -1]] = 0..cdeg1 -1 */
    Int pivrow [2],		/* pivrow [IN] and pivrow [OUT] */
    Int rdeg [2],		/* rdeg [IN] and rdeg [OUT] */
    Int W_i [ ],		/* pattern of pivrow [IN], */
				/* either Fcols or Woi */
    Int W_o [ ],		/* pattern of pivrow [OUT], */
				/* either Wio or Woo */
    Int prior_pivrow [2],	/* the two other rows just scanned, if any */
    const Entry Wxy [ ],	/* numerical values Wxy [0..cdeg1-1],
				   either Wx or Wy */

    Int pivcol,			/* the candidate column being searched */
    Int freebie [ ]
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    double maxval, toler, toler2, value, pivot [2] ;
    Int i, row, deg, col, *Frpos, fnrows, *E, j, ncols, *Cols, *Rows,
	e, f, Wrpflag, *Fcpos, fncols, tpi, max_rdeg, nans_in_col, was_offdiag,
	diag_row, prefer_diagonal, *Wrp, found, *Diagonal_map ;
    Tuple *tp, *tpend, *tp1, *tp2 ;
    Unit *Memory, *p ;
    Element *ep ;
    Int *Row_tuples, *Row_degree, *Row_tlen ;

#ifndef NDEBUG
    Int *Col_degree ;
    DEBUG2 (("Row_search:\n")) ;
    for (i = 0 ; i < cdeg1 ; i++)
    {
	row = Pattern [i] ;
	DEBUG4 (("   row: "ID"\n", row)) ;
	ASSERT (row >= 0 && row < Numeric->n_row) ;
	ASSERT (i == Pos [row]) ;
    }
    /* If row is not in Pattern [0..cdeg1-1], then Pos [row] == EMPTY */
    if (UMF_debug > 0 || Numeric->n_row < 1000)
    {
	Int cnt = cdeg1 ;
	DEBUG4 (("Scan all rows:\n")) ;
	for (row = 0 ; row < Numeric->n_row ; row++)
	{
	    if (Pos [row] < 0)
	    {
		cnt++ ;
	    }
	    else
	    {
		DEBUG4 (("   row: "ID" pos "ID"\n", row, Pos [row])) ;
	    }
	}
	ASSERT (cnt == Numeric->n_row) ;
    }
    Col_degree = Numeric->Cperm ;   /* for NON_PIVOTAL_COL macro only */
    ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
    ASSERT (NON_PIVOTAL_COL (pivcol)) ;
#endif

    pivot [IN] = 0. ;
    pivot [OUT] = 0. ;

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    Row_degree = Numeric->Rperm ;
    Row_tuples = Numeric->Uip ;
    Row_tlen   = Numeric->Uilen ;
    Wrp = Work->Wrp ;
    Frpos = Work->Frpos ;
    E = Work->E ;
    Memory = Numeric->Memory ;
    fnrows = Work->fnrows ;

    prefer_diagonal = Symbolic->prefer_diagonal ;
    Diagonal_map = Work->Diagonal_map ;

    if (Diagonal_map)
    {
	diag_row = Diagonal_map [pivcol] ;
	was_offdiag = diag_row < 0 ;
	if (was_offdiag)
	{
	    /* the "diagonal" entry in this column was permuted here by an
	     * earlier pivot choice.  The tighter off-diagonal tolerance will
	     * be used instead of the symmetric tolerance. */
	    diag_row = FLIP (diag_row) ;
	}
	ASSERT (diag_row >= 0 && diag_row < Numeric->n_row) ;
    }
    else
    {
	diag_row = EMPTY ;	/* unused */
	was_offdiag = EMPTY ;	/* unused */
    }

    /* pivot row degree cannot exceed max_rdeg */
    max_rdeg = Work->fncols_max ;

    /* ---------------------------------------------------------------------- */
    /* scan pivot column for candidate rows */
    /* ---------------------------------------------------------------------- */

    maxval = 0.0 ;
    nans_in_col = FALSE ;

    for (i = 0 ; i < cdeg1 ; i++)
    {
	APPROX_ABS (value, Wxy [i]) ;
	if (SCALAR_IS_NAN (value))
	{
	    nans_in_col = TRUE ;
	    maxval = value ;
	    break ;
	}
	/* This test can now ignore the NaN case: */
	maxval = MAX (maxval, value) ;
    }

    /* if maxval is zero, the matrix is numerically singular */

    toler = Numeric->relpt * maxval ;
    toler2 = Numeric->relpt2 * maxval ;
    toler2 = was_offdiag ? toler : toler2 ;

    DEBUG5 (("Row_search begins [ maxval %g toler %g %g\n",
	maxval, toler, toler2)) ;
    if (SCALAR_IS_NAN (toler) || SCALAR_IS_NAN (toler2))
    {
	nans_in_col = TRUE ;
    }

    if (!nans_in_col)
    {

	/* look for the diagonal entry, if it exists */
	found = FALSE ;
	ASSERT (!SCALAR_IS_NAN (toler)) ;

	if (prefer_diagonal)
	{
	    ASSERT (diag_row != EMPTY) ;
	    i = Pos [diag_row] ;
	    if (i >= 0)
	    {
		double a ;
		ASSERT (i < cdeg1) ;
		ASSERT (diag_row == Pattern [i]) ;

		APPROX_ABS (a, Wxy [i]) ;

		ASSERT (!SCALAR_IS_NAN (a)) ;
		ASSERT (!SCALAR_IS_NAN (toler2)) ;

		if (SCALAR_IS_NONZERO (a) && a >= toler2)
		{
		    /* found it! */
		    DEBUG3 (("Symmetric pivot: "ID" "ID"\n", pivcol, diag_row));
		    found = TRUE ;
		    if (Frpos [diag_row] >= 0 && Frpos [diag_row] < fnrows)
		    {
			pivrow [IN] = diag_row ;
			pivrow [OUT] = EMPTY ;
		    }
		    else
		    {
			pivrow [IN] = EMPTY ;
			pivrow [OUT] = diag_row ;
		    }
		}
	    }
	}

	/* either no diagonal found, or we didn't look for it */
	if (!found)
	{
	    if (cdeg0 > 0)
	    {

		/* this is a column in the front */
		for (i = 0 ; i < cdeg0 ; i++)
		{
		    double a ;
		    APPROX_ABS (a, Wxy [i]) ;
		    ASSERT (!SCALAR_IS_NAN (a)) ;
		    ASSERT (!SCALAR_IS_NAN (toler)) ;
		    if (SCALAR_IS_NONZERO (a) && a >= toler)
		    {
			row = Pattern [i] ;
			deg = Row_degree [row] ;
#ifndef NDEBUG
			DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
			    i, row, deg, a)) ;
			UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
			ASSERT (Frpos [row] >= 0 && Frpos [row] < fnrows) ;
			ASSERT (Frpos [row] == i) ;
			/* row is in the current front */
			DEBUG4 ((" in front\n")) ;
			if (deg < rdeg [IN]
			    /* break ties by picking the largest entry: */
			       || (deg == rdeg [IN] && a > pivot [IN])
			    /* break ties by picking the diagonal entry: */
			    /* || (deg == rdeg [IN] && row == diag_row) */
			   )
			{
			    /* best row in front, so far */
			    pivrow [IN] = row ;
			    rdeg [IN] = deg ;
			    pivot [IN] = a ;
			}
		    }
		}
		for ( ; i < cdeg1 ; i++)
		{
		    double a ;
		    APPROX_ABS (a, Wxy [i]) ;
		    ASSERT (!SCALAR_IS_NAN (a)) ;
		    ASSERT (!SCALAR_IS_NAN (toler)) ;
		    if (SCALAR_IS_NONZERO (a) && a >= toler)
		    {
			row = Pattern [i] ;
			deg = Row_degree [row] ;
#ifndef NDEBUG
			DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
			    i, row, deg, a)) ;
			UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
			ASSERT (Frpos [row] == i) ;
			/* row is not in the current front */
			DEBUG4 ((" NOT in front\n")) ;
			if (deg < rdeg [OUT]
			    /* break ties by picking the largest entry: */
			       || (deg == rdeg [OUT] && a > pivot [OUT])
			    /* break ties by picking the diagonal entry: */
			    /* || (deg == rdeg [OUT] && row == diag_row) */
			   )
			{
			    /* best row not in front, so far */
			    pivrow [OUT] = row ;
			    rdeg [OUT] = deg ;
			    pivot [OUT] = a ;
			}
		    }
		}

	    }
	    else
	    {

		/* this column is not in the front */
		for (i = 0 ; i < cdeg1 ; i++)
		{
		    double a ;
		    APPROX_ABS (a, Wxy [i]) ;
		    ASSERT (!SCALAR_IS_NAN (a)) ;
		    ASSERT (!SCALAR_IS_NAN (toler)) ;
		    if (SCALAR_IS_NONZERO (a) && a >= toler)
		    {
			row = Pattern [i] ;
			deg = Row_degree [row] ;
#ifndef NDEBUG
			DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
			    i, row, deg, a)) ;
			UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
			if (Frpos [row] >= 0 && Frpos [row] < fnrows)
			{
			    /* row is in the current front */
			    DEBUG4 ((" in front\n")) ;
			    if (deg < rdeg [IN]
			    /* break ties by picking the largest entry: */
			       || (deg == rdeg [IN] && a > pivot [IN])
			    /* break ties by picking the diagonal entry: */
			    /* || (deg == rdeg [IN] && row == diag_row) */
			       )
			    {
				/* best row in front, so far */
				pivrow [IN] = row ;
				rdeg [IN] = deg ;
				pivot [IN] = a ;
			    }
			}
			else
			{
			    /* row is not in the current front */
			    DEBUG4 ((" NOT in front\n")) ;
			    if (deg < rdeg [OUT]
			    /* break ties by picking the largest entry: */
			       || (deg == rdeg[OUT] && a > pivot [OUT])
			    /* break ties by picking the diagonal entry: */
			    /* || (deg == rdeg[OUT] && row == diag_row) */
			       )
			    {
				/* best row not in front, so far */
				pivrow [OUT] = row ;
				rdeg [OUT] = deg ;
				pivot [OUT] = a ;
			    }
			}
		    }
		}
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* NaN handling */
    /* ---------------------------------------------------------------------- */

    /* if cdeg1 > 0 then we must have found a pivot row ... unless NaN's */
    /* exist.  Try with no numerical tests if no pivot found. */

    if (cdeg1 > 0 && pivrow [IN] == EMPTY && pivrow [OUT] == EMPTY)
    {
	/* cleanup for the NaN case */
	DEBUG0 (("Found a NaN in pivot column!\n")) ;

	/* grab the first entry in the pivot column, ignoring degree, */
	/* numerical stability, and symmetric preference */
	row = Pattern [0] ;
	deg = Row_degree [row] ;
	if (Frpos [row] >= 0 && Frpos [row] < fnrows)
	{
	    /* row is in the current front */
	    DEBUG4 ((" in front\n")) ;
	    pivrow [IN] = row ;
	    rdeg [IN] = deg ;
	}
	else
	{
	    /* row is not in the current front */
	    DEBUG4 ((" NOT in front\n")) ;
	    pivrow [OUT] = row ;
	    rdeg [OUT] = deg ;
	}

	/* We are now guaranteed to have a pivot, no matter how broken */
	/* (non-IEEE compliant) the underlying numerical operators are. */
	/* This is particularly a problem for Microsoft compilers (they do */
	/* not handle NaN's properly). Now try to find a sparser pivot, if */
	/* possible. */

	for (i = 1 ; i < cdeg1 ; i++)
	{
	    row = Pattern [i] ;
	    deg = Row_degree [row] ;

	    if (Frpos [row] >= 0 && Frpos [row] < fnrows)
	    {
		/* row is in the current front */
		DEBUG4 ((" in front\n")) ;
		if (deg < rdeg [IN] || (deg == rdeg [IN] && row == diag_row))
		{
		    /* best row in front, so far */
		    pivrow [IN] = row ;
		    rdeg [IN] = deg ;
		}
	    }
	    else
	    {
		/* row is not in the current front */
		DEBUG4 ((" NOT in front\n")) ;
		if (deg < rdeg [OUT] || (deg == rdeg [OUT] && row == diag_row))
		{
		    /* best row not in front, so far */
		    pivrow [OUT] = row ;
		    rdeg [OUT] = deg ;
		}
	    }
	}
    }

    /* We found a pivot if there are entries (even zero ones) in pivot col */
    ASSERT (IMPLIES (cdeg1 > 0, pivrow[IN] != EMPTY || pivrow[OUT] != EMPTY)) ;

    /* If there are no entries in the pivot column, then no pivot is found */
    ASSERT (IMPLIES (cdeg1 == 0, pivrow[IN] == EMPTY && pivrow[OUT] == EMPTY)) ;

    /* ---------------------------------------------------------------------- */
    /* check for singular matrix */
    /* ---------------------------------------------------------------------- */

    if (cdeg1  == 0)
    {
	if (fnrows > 0)
	{
	    /*
		Get the pivrow [OUT][IN] from the current front.
		The frontal matrix looks like this:

			pivcol[OUT]
			|
			v
		x x x x 0   <- so grab this row as the pivrow [OUT][IN].
		x x x x 0
		x x x x 0
		0 0 0 0 0

		The current frontal matrix has some rows in it.  The degree
		of the pivcol[OUT] is zero.  The column is empty, and the
		current front does not contribute to it.

	    */
	    pivrow [IN] = Work->Frows [0] ;
	    DEBUGm4 (("Got zero pivrow[OUT][IN] "ID" from current front\n",
		pivrow [IN])) ;
	}
	else
	{

	    /*
		Get a pivot row from the row-merge tree, use as
		pivrow [OUT][OUT].   pivrow [IN] remains EMPTY.
		This can only happen if the current front is 0-by-0.
	    */

	    Int *Front_leftmostdesc, *Front_1strow, *Front_new1strow, row1,
		row2, fleftmost, nfr, n_row, frontid ;

	    ASSERT (Work->fncols == 0) ;

	    Front_leftmostdesc = Symbolic->Front_leftmostdesc ;
	    Front_1strow = Symbolic->Front_1strow ;
	    Front_new1strow = Work->Front_new1strow ;
	    nfr = Symbolic->nfr ;
	    n_row = Numeric->n_row ;
	    frontid = Work->frontid ;

	    DEBUGm4 (("Note: pivcol: "ID" is empty front "ID"\n",
		pivcol, frontid)) ;
#ifndef NDEBUG
	    DEBUG1 (("Calling dump rowmerge\n")) ;
	    UMF_dump_rowmerge (Numeric, Symbolic, Work) ;
#endif

	    /* Row-merge set is the non-pivotal rows in the range */
	    /* Front_new1strow [Front_leftmostdesc [frontid]] to */
	    /* Front_1strow [frontid+1] - 1. */
	    /* If this is empty, then use the empty rows, in the range */
	    /* Front_new1strow [nfr] to n_row-1. */
	    /* If this too is empty, then pivrow [OUT] will be empty. */
	    /* In both cases, update Front_new1strow [...]. */

	    fleftmost = Front_leftmostdesc [frontid] ;
	    row1 = Front_new1strow [fleftmost] ;
	    row2 = Front_1strow [frontid+1] - 1 ;
	    DEBUG1 (("Leftmost: "ID" Rows ["ID" to "ID"] srch ["ID" to "ID"]\n",
		fleftmost, Front_1strow [frontid], row2, row1, row2)) ;

	    /* look in the range row1 ... row2 */
	    for (row = row1 ; row <= row2 ; row++)
	    {
		DEBUG3 (("   Row: "ID"\n", row)) ;
		if (NON_PIVOTAL_ROW (row))
		{
		    /* found it */
		    DEBUG3 (("   Row: "ID" found\n", row)) ;
		    ASSERT (Frpos [row] == EMPTY) ;
		    pivrow [OUT] = row ;
		    DEBUGm4 (("got row merge pivrow %d\n", pivrow [OUT])) ;
		    break ;
		}
	    }
	    Front_new1strow [fleftmost] = row ;

	    if (pivrow [OUT] == EMPTY)
	    {
		/* not found, look in empty row set in "dummy" front */
		row1 = Front_new1strow [nfr] ;
		row2 = n_row-1 ;
		DEBUG3 (("Empty: "ID" Rows ["ID" to "ID"] srch["ID" to "ID"]\n",
		    nfr, Front_1strow [nfr], row2, row1, row2)) ;

		/* look in the range row1 ... row2 */
		for (row = row1 ; row <= row2 ; row++)
		{
		    DEBUG3 (("   Empty Row: "ID"\n", row)) ;
		    if (NON_PIVOTAL_ROW (row))
		    {
			/* found it */
			DEBUG3 (("   Empty Row: "ID" found\n", row)) ;
			ASSERT (Frpos [row] == EMPTY) ;
			pivrow [OUT] = row ;
			DEBUGm4 (("got dummy row pivrow %d\n", pivrow [OUT])) ;
			break ;
		    }
		}
		Front_new1strow [nfr] = row ;
	    }

	    if (pivrow [OUT] == EMPTY)
	    {
		/* Row-merge set is empty.  We can just discard */
		/* the candidate pivot column. */
		DEBUG0 (("Note: row-merge set empty\n")) ;
		DEBUGm4 (("got no pivrow \n")) ;
		return (UMFPACK_WARNING_singular_matrix) ;
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* construct the candidate row in the front, if any */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    /* check Wrp */
    ASSERT (Work->Wrpflag > 0) ;
    if (UMF_debug > 0 || Work->n_col < 1000)
    {
	for (i = 0 ; i < Work->n_col ; i++)
	{
	    ASSERT (Wrp [i] < Work->Wrpflag) ;
	}
    }
#endif

#ifndef NDEBUG
    DEBUG4 (("pivrow [IN]: "ID"\n", pivrow [IN])) ;
    UMF_dump_rowcol (0, Numeric, Work, pivrow [IN], TRUE) ;
#endif

    if (pivrow [IN] != EMPTY)
    {

	/* the row merge candidate row is not pivrow [IN] */
	freebie [IN] = (pivrow [IN] == prior_pivrow [IN]) && (cdeg1  > 0) ;
	ASSERT (cdeg1  >= 0) ;

	if (!freebie [IN])
	{
	    /* include current front in the degree of this row */

	    Fcpos = Work->Fcpos ;
	    fncols = Work->fncols ;

	    Wrpflag = Work->Wrpflag ;

	    /* -------------------------------------------------------------- */
	    /* construct the pattern of the IN row */
	    /* -------------------------------------------------------------- */

#ifndef NDEBUG
	    /* check Fcols */
	    DEBUG5 (("ROW ASSEMBLE: rdeg "ID"\nREDUCE ROW "ID"\n",
		fncols, pivrow [IN])) ;
	    for (j = 0 ; j < fncols ; j++)
	    {
		col = Work->Fcols [j] ;
		ASSERT (col >= 0 && col < Work->n_col) ;
		ASSERT (Fcpos [col] >= 0) ;
	    }
	    if (UMF_debug > 0 || Work->n_col < 1000)
	    {
		Int cnt = fncols ;
		for (col = 0 ; col < Work->n_col ; col++)
		{
		    if (Fcpos [col] < 0) cnt++ ;
		}
		ASSERT (cnt == Work->n_col) ;
	    }
#endif

	    rdeg [IN] = fncols ;

	    ASSERT (pivrow [IN] >= 0 && pivrow [IN] < Work->n_row) ;
	    ASSERT (NON_PIVOTAL_ROW (pivrow [IN])) ;

	    /* add the pivot column itself */
	    ASSERT (Wrp [pivcol] != Wrpflag) ;
	    if (Fcpos [pivcol] < 0)
	    {
		DEBUG3 (("Adding pivot col to pivrow [IN] pattern\n")) ;
		if (rdeg [IN] >= max_rdeg)
		{
		    /* :: pattern change (in) :: */
		    return (UMFPACK_ERROR_different_pattern) ;
		}
		Wrp [pivcol] = Wrpflag ;
		W_i [rdeg [IN]++] = pivcol ;
	    }

	    tpi = Row_tuples [pivrow [IN]] ;
	    if (tpi)
	    {
		tp = (Tuple *) (Memory + tpi) ;
		tp1 = tp ;
		tp2 = tp ;
		tpend = tp + Row_tlen [pivrow [IN]] ;
		for ( ; tp < tpend ; tp++)
		{
		    e = tp->e ;
		    ASSERT (e > 0 && e <= Work->nel) ;
		    if (!E [e])
		    {
			continue ;	/* element already deallocated */
		    }
		    f = tp->f ;
		    p = Memory + E [e] ;
		    ep = (Element *) p ;
		    p += UNITS (Element, 1) ;
		    Cols = (Int *) p ;
		    ncols = ep->ncols ;
		    Rows = Cols + ncols ;
		    if (Rows [f] == EMPTY)
		    {
			continue ;	/* row already assembled */
		    }
		    ASSERT (pivrow [IN] == Rows [f]) ;

		    for (j = 0 ; j < ncols ; j++)
		    {
			col = Cols [j] ;
			ASSERT (col >= EMPTY && col < Work->n_col) ;
			if ((col >= 0) && (Wrp [col] != Wrpflag)
			    && Fcpos [col] <0)
			{
			    ASSERT (NON_PIVOTAL_COL (col)) ;
			    if (rdeg [IN] >= max_rdeg)
			    {
				/* :: pattern change (rdeg in failure) :: */
				DEBUGm4 (("rdeg [IN] >= max_rdeg failure\n")) ;
				return (UMFPACK_ERROR_different_pattern) ;
			    }
			    Wrp [col] = Wrpflag ;
			    W_i [rdeg [IN]++] = col ;
			}
		    }

		    *tp2++ = *tp ;	/* leave the tuple in the list */
		}
		Row_tlen [pivrow [IN]] = tp2 - tp1 ;
	    }

#ifndef NDEBUG
	    DEBUG4 (("Reduced IN row:\n")) ;
	    for (j = 0 ; j < fncols ; j++)
	    {
		DEBUG6 ((" "ID" "ID" "ID"\n",
		    j, Work->Fcols [j], Fcpos [Work->Fcols [j]])) ;
		ASSERT (Fcpos [Work->Fcols [j]] >= 0) ;
	    }
	    for (j = fncols ; j < rdeg [IN] ; j++)
	    {
		DEBUG6 ((" "ID" "ID" "ID"\n", j, W_i [j], Wrp [W_i [j]]));
		ASSERT (W_i [j] >= 0 && W_i [j] < Work->n_col) ;
		ASSERT (Wrp [W_i [j]] == Wrpflag) ;
	    }
	    /* mark the end of the pattern in case we scan it by mistake */
	    /* Note that this means W_i must be of size >= fncols_max + 1 */
	    W_i [rdeg [IN]] = EMPTY ;
#endif

	    /* rdeg [IN] is now the exact degree of the IN row */

	    /* clear Work->Wrp. */
	    Work->Wrpflag++ ;
	    /* All Wrp [0..n_col] is now < Wrpflag */
	}
    }

#ifndef NDEBUG
    /* check Wrp */
    if (UMF_debug > 0 || Work->n_col < 1000)
    {
	for (i = 0 ; i < Work->n_col ; i++)
	{
	    ASSERT (Wrp [i] < Work->Wrpflag) ;
	}
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* construct the candidate row not in the front, if any */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    DEBUG4 (("pivrow [OUT]: "ID"\n", pivrow [OUT])) ;
    UMF_dump_rowcol (0, Numeric, Work, pivrow [OUT], TRUE) ;
#endif

    /* If this is a candidate row from the row merge set, force it to be */
    /* scanned (ignore prior_pivrow [OUT]). */

    if (pivrow [OUT] != EMPTY)
    {
	freebie [OUT] = (pivrow [OUT] == prior_pivrow [OUT]) && cdeg1  > 0 ;
	ASSERT (cdeg1  >= 0) ;

	if (!freebie [OUT])
	{

	    Wrpflag = Work->Wrpflag ;

	    /* -------------------------------------------------------------- */
	    /* construct the pattern of the row */
	    /* -------------------------------------------------------------- */

	    rdeg [OUT] = 0 ;

	    ASSERT (pivrow [OUT] >= 0 && pivrow [OUT] < Work->n_row) ;
	    ASSERT (NON_PIVOTAL_ROW (pivrow [OUT])) ;

	    /* add the pivot column itself */
	    ASSERT (Wrp [pivcol] != Wrpflag) ;
	    DEBUG3 (("Adding pivot col to pivrow [OUT] pattern\n")) ;
	    if (rdeg [OUT] >= max_rdeg)
	    {
		/* :: pattern change (out) :: */
		return (UMFPACK_ERROR_different_pattern) ;
	    }
	    Wrp [pivcol] = Wrpflag ;
	    W_o [rdeg [OUT]++] = pivcol ;

	    tpi = Row_tuples [pivrow [OUT]] ;
	    if (tpi)
	    {
		tp = (Tuple *) (Memory + tpi) ;
		tp1 = tp ;
		tp2 = tp ;
		tpend = tp + Row_tlen [pivrow [OUT]] ;
		for ( ; tp < tpend ; tp++)
		{
		    e = tp->e ;
		    ASSERT (e > 0 && e <= Work->nel) ;
		    if (!E [e])
		    {
			continue ;	/* element already deallocated */
		    }
		    f = tp->f ;
		    p = Memory + E [e] ;
		    ep = (Element *) p ;
		    p += UNITS (Element, 1) ;
		    Cols = (Int *) p ;
		    ncols = ep->ncols ;
		    Rows = Cols + ncols ;
		    if (Rows [f] == EMPTY)
		    {
			continue ;	/* row already assembled */
		    }
		    ASSERT (pivrow [OUT] == Rows [f]) ;

		    for (j = 0 ; j < ncols ; j++)
		    {
			col = Cols [j] ;
			ASSERT (col >= EMPTY && col < Work->n_col) ;
			if ((col >= 0) && (Wrp [col] != Wrpflag))
			{
			    ASSERT (NON_PIVOTAL_COL (col)) ;
			    if (rdeg [OUT] >= max_rdeg)
			    {
				/* :: pattern change (rdeg out failure) :: */
				DEBUGm4 (("rdeg [OUT] failure\n")) ;
				return (UMFPACK_ERROR_different_pattern) ;
			    }
			    Wrp [col] = Wrpflag ;
			    W_o [rdeg [OUT]++] = col ;
			}
		    }
		    *tp2++ = *tp ;	/* leave the tuple in the list */
		}
		Row_tlen [pivrow [OUT]] = tp2 - tp1 ;
	    }

#ifndef NDEBUG
	    DEBUG4 (("Reduced row OUT:\n")) ;
	    for (j = 0 ; j < rdeg [OUT] ; j++)
	    {
		DEBUG6 ((" "ID" "ID" "ID"\n", j, W_o [j], Wrp [W_o [j]])) ;
		ASSERT (W_o [j] >= 0 && W_o [j] < Work->n_col) ;
		ASSERT (Wrp [W_o [j]] == Wrpflag) ;
	    }
	    /* mark the end of the pattern in case we scan it by mistake */
	    /* Note that this means W_o must be of size >= fncols_max + 1 */
	    W_o [rdeg [OUT]] = EMPTY ;
#endif

	    /* rdeg [OUT] is now the exact degree of the row */

	    /* clear Work->Wrp. */
	    Work->Wrpflag++ ;
	    /* All Wrp [0..n] is now < Wrpflag */

	}

    }
    DEBUG5 (("Row_search end ] \n")) ;

#ifndef NDEBUG
    /* check Wrp */
    if (UMF_debug > 0 || Work->n_col < 1000)
    {
	for (i = 0 ; i < Work->n_col ; i++)
	{
	    ASSERT (Wrp [i] < Work->Wrpflag) ;
	}
    }
#endif

    return (UMFPACK_OK) ;
}
示例#11
0
GLOBAL void UMF_set_stats
(
    double Info [ ],
    SymbolicType *Symbolic,
    double max_usage,		/* peak size of Numeric->Memory, in Units */
    double num_mem_size,	/* final size of Numeric->Memory, in Units */
    double flops,		/* "true flops" */
    double lnz,			/* nz in L */
    double unz,			/* nz in U */
    double maxfrsize,		/* largest front size */
    double ulen,		/* size of Numeric->Upattern */
    double npiv,		/* number of pivots found */
    double maxnrows,		/* largest #rows in front */
    double maxncols,		/* largest #cols in front */
    Int scale,			/* true if scaling the rows of A */
    Int prefer_diagonal,	/* true if diagonal pivoting (only square A) */
    Int what			/* ESTIMATE or ACTUAL */
)
{

    double sym_size, work_usage, nn, n_row, n_col, n_inner, num_On_size1,
	num_On_size2, num_usage, sym_maxncols, sym_maxnrows, elen, n1 ;

    n_col = Symbolic->n_col ;
    n_row = Symbolic->n_row ;
    n1 = Symbolic->n1 ;
    nn = MAX (n_row, n_col) ;
    n_inner = MIN (n_row, n_col) ;
    sym_maxncols = MIN (Symbolic->maxncols + Symbolic->nb, n_col) ;
    sym_maxnrows = MIN (Symbolic->maxnrows + Symbolic->nb, n_row) ;
    elen = (n_col - n1) + (n_row - n1) + MIN (n_col - n1, n_row - n1) + 1 ;

    /* final Symbolic object size */
    sym_size = UMF_symbolic_usage (Symbolic->n_row, Symbolic->n_col,
	Symbolic->nchains, Symbolic->nfr, Symbolic->esize, prefer_diagonal) ;

    /* size of O(n) part of Numeric object during factorization, */
    /* except Numeric->Memory and Numeric->Upattern */
    num_On_size1 =
	DUNITS (NumericType, 1)		/* Numeric structure */
	+ DUNITS (Entry, n_inner+1)	/* D */
	+ 4 * DUNITS (Int, n_row+1)	/* Rperm, Lpos, Uilen, Uip */
	+ 4 * DUNITS (Int, n_col+1)	/* Cperm, Upos, Lilen, Lip */
	+ (scale ? DUNITS (Entry, n_row) : 0) ;   /* Rs, row scale factors */

    /* size of O(n) part of Numeric object after factorization, */
    /* except Numeric->Memory and Numeric->Upattern */
    num_On_size2 =
	DUNITS (NumericType, 1)		/* Numeric structure */
	+ DUNITS (Entry, n_inner+1)	/* D */
	+ DUNITS (Int, n_row+1)		/* Rperm */
	+ DUNITS (Int, n_col+1)		/* Cperm */
	+ 6 * DUNITS (Int, npiv+1)	/* Lpos, Uilen, Uip, Upos, Lilen, Lip */
	+ (scale ? DUNITS (Entry, n_row) : 0) ;	    /* Rs, row scale factors */

    DEBUG1 (("num O(n) size2: %g\n", num_On_size2)) ;

    /* peak size of Numeric->Memory, including LU factors, current frontal
     * matrix, elements, and tuple lists.  */
    Info [UMFPACK_VARIABLE_PEAK + what] = max_usage ;

    /* final size of Numeric->Memory (LU factors only) */
    Info [UMFPACK_VARIABLE_FINAL + what] = num_mem_size ;

    /* final size of Numeric object, including Numeric->Memory and ->Upattern */
    Info [UMFPACK_NUMERIC_SIZE + what] =
	num_On_size2
	+ num_mem_size		/* final Numeric->Memory size */
	+ DUNITS (Int, ulen+1) ;/* Numeric->Upattern (from Work->Upattern) */

    DEBUG1 (("num mem size: %g\n", num_mem_size)) ;
    DEBUG1 (("ulen units %g\n", DUNITS (Int, ulen))) ;
    DEBUG1 (("numeric size %g\n", Info [UMFPACK_NUMERIC_SIZE + what])) ;

    /* largest front size (working array size, or actual size used) */
    Info [UMFPACK_MAX_FRONT_SIZE + what] = maxfrsize ;
    Info [UMFPACK_MAX_FRONT_NROWS + what] = maxnrows ;
    Info [UMFPACK_MAX_FRONT_NCOLS + what] = maxncols ;
    DEBUGm4 (("maxnrows %g maxncols %g\n", maxnrows, maxncols)) ;
    DEBUGm4 (("maxfrsize %g\n", maxfrsize)) ;

    /* UMF_kernel usage, from work_alloc routine in umf_kernel.c */
    work_usage =
	/* Work-> arrays, except for current frontal matrix which is allocated
	 * inside Numeric->Memory. */
	2 * DUNITS (Entry, sym_maxnrows + 1)	/* Wx, Wy */
	+ 2 * DUNITS (Int, n_row+1)		/* Frpos, Lpattern */
	+ 2 * DUNITS (Int, n_col+1)		/* Fcpos, Upattern */
	+ DUNITS (Int, nn + 1)			/* Wp */
	+ DUNITS (Int, MAX (n_col, sym_maxnrows) + 1)	/* Wrp */
	+ 2 * DUNITS (Int, sym_maxnrows + 1)	/* Frows, Wm */
	+ 3 * DUNITS (Int, sym_maxncols + 1)	/* Fcols, Wio, Woi */
	+ DUNITS (Int, MAX (sym_maxnrows, sym_maxncols) + 1)	/* Woo */
	+ DUNITS (Int, elen)			/* E */
	+ DUNITS (Int, Symbolic->nfr + 1)	/* Front_new1strow */
	+ ((n_row == n_col) ? (2 * DUNITS (Int, nn)) : 0) ;  /* Diag map,imap */

    /* Peak memory for just UMFPACK_numeric. */
    num_usage =
	sym_size	/* size of Symbolic object */
	+ num_On_size1	/* O(n) part of Numeric object (excl. Upattern) */
	+ work_usage	/* Work-> arrays (including Upattern) */
	+ max_usage ;	/* peak size of Numeric->Memory */

    /* peak memory usage for both UMFPACK_*symbolic and UMFPACK_numeric. */
    Info [UMFPACK_PEAK_MEMORY + what] =
	MAX (Symbolic->peak_sym_usage, num_usage) ;

    Info [UMFPACK_FLOPS + what] = flops ;
    Info [UMFPACK_LNZ + what] = lnz ;
    Info [UMFPACK_UNZ + what] = unz ;
}
示例#12
0
GLOBAL Int UMF_kernel
(
    const Int Ap [ ],
    const Int Ai [ ],
    const double Ax [ ],
#ifdef COMPLEX
    const double Az [ ],
#endif
    NumericType *Numeric,
    WorkType *Work,
    SymbolicType *Symbolic
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int j, f1, f2, chain, nchains, *Chain_start, status, fixQ, evaporate,
	*Front_npivcol, jmax, nb, drop ;

    /* ---------------------------------------------------------------------- */
    /* initialize memory space and load the matrix. Optionally scale. */
    /* ---------------------------------------------------------------------- */

    if (!UMF_kernel_init (Ap, Ai, Ax,
#ifdef COMPLEX
	Az,
#endif
	Numeric, Work, Symbolic))
    {
	/* UMF_kernel_init is guaranteed to succeed, since UMFPACK_numeric */
	/* either allocates enough space or if not, UMF_kernel does not get */
	/* called.  So running out of memory here is a fatal error, and means */
	/* that the user changed Ap and/or Ai since the call to */
	/* UMFPACK_*symbolic. */
	DEBUGm4 (("kernel init failed\n")) ;
	return (UMFPACK_ERROR_different_pattern) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the symbolic factorization */
    /* ---------------------------------------------------------------------- */

    nchains = Symbolic->nchains ;
    Chain_start = Symbolic->Chain_start ;
    Front_npivcol = Symbolic->Front_npivcol ;
    nb = Symbolic->nb ;
    fixQ = Symbolic->fixQ ;
    drop = Numeric->droptol > 0.0 ;

#ifndef NDEBUG
    for (chain = 0 ; chain < nchains ; chain++)
    {
	Int i ;
	f1 = Chain_start [chain] ;
	f2 = Chain_start [chain+1] - 1 ;
	DEBUG1 (("\nCHain: "ID" start "ID" end "ID"\n", chain, f1, f2)) ;
	for (i = f1 ; i <= f2 ; i++)
	{
	    DEBUG1 (("Front "ID", npivcol "ID"\n", i, Front_npivcol [i])) ;
	}
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* factorize each chain of frontal matrices */
    /* ---------------------------------------------------------------------- */

    for (chain = 0 ; chain < nchains ; chain++)
    {
	f1 = Chain_start [chain] ;
	f2 = Chain_start [chain+1] - 1 ;

	/* ------------------------------------------------------------------ */
	/* get the initial frontal matrix size for this chain */
	/* ------------------------------------------------------------------ */

	DO (UMF_start_front (chain, Numeric, Work, Symbolic)) ;

	/* ------------------------------------------------------------------ */
	/* factorize each front in the chain */
	/* ------------------------------------------------------------------ */

	for (Work->frontid = f1 ; Work->frontid <= f2 ; Work->frontid++)
	{

	    /* -------------------------------------------------------------- */
	    /* Initialize the pivot column candidate set  */
	    /* -------------------------------------------------------------- */

	    Work->ncand = Front_npivcol [Work->frontid] ;
	    Work->lo = Work->nextcand ;
	    Work->hi = Work->nextcand + Work->ncand - 1 ;
	    jmax = MIN (MAX_CANDIDATES, Work->ncand) ;
	    DEBUGm1 ((">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Starting front "
		ID", npivcol: "ID"\n", Work->frontid, Work->ncand)) ;
	    if (fixQ)
	    {
		/* do not modify the column order */
		jmax = 1 ;
	    }
	    DEBUGm1 (("Initial candidates: ")) ;
	    for (j = 0 ; j < jmax ; j++)
	    {
		DEBUGm1 ((" "ID, Work->nextcand)) ;
		ASSERT (Work->nextcand <= Work->hi) ;
		Work->Candidates [j] = Work->nextcand++ ;
	    }
	    Work->nCandidates = jmax ;
	    DEBUGm1 (("\n")) ;

	    /* -------------------------------------------------------------- */
	    /* Assemble and factorize the current frontal matrix */
	    /* -------------------------------------------------------------- */

	    while (Work->ncand > 0)
	    {

		/* ---------------------------------------------------------- */
		/* get the pivot row and column */
		/* ---------------------------------------------------------- */

		status = UMF_local_search (Numeric, Work, Symbolic) ;
		if (status == UMFPACK_ERROR_different_pattern)
		{
		    /* :: pattern change detected in umf_local_search :: */
		    /* input matrix has changed since umfpack_*symbolic */
		    DEBUGm4 (("local search failed\n")) ;
		    return (UMFPACK_ERROR_different_pattern) ;
		}
		if (status == UMFPACK_WARNING_singular_matrix)
		{
		    /* no pivot found, discard and try again */
		    continue ;
		}

		/* ---------------------------------------------------------- */
		/* update if front not extended or too many zeros in L,U */
		/* ---------------------------------------------------------- */

		if (Work->do_update)
		{
		    UMF_blas3_update (Work) ;
		    if (drop)
		    {
			DO (UMF_store_lu_drop (Numeric, Work)) ;
		    }
		    else
		    {
			DO (UMF_store_lu (Numeric, Work)) ;
		    }
		}

		/* ---------------------------------------------------------- */
		/* extend the frontal matrix, or start a new one */
		/* ---------------------------------------------------------- */

		if (Work->do_extend)
		{
		    /* extend the current front */
		    DO (UMF_extend_front (Numeric, Work)) ;
		}
		else
		{
		    /* finish the current front (if any) and start a new one */
		    DO (UMF_create_element (Numeric, Work, Symbolic)) ;
		    DO (UMF_init_front (Numeric, Work)) ;
		}

		/* ---------------------------------------------------------- */
		/* Numerical & symbolic assembly into current frontal matrix */
		/* ---------------------------------------------------------- */

		if (fixQ)
		{
		    UMF_assemble_fixq (Numeric, Work) ;
		}
		else
		{
		    UMF_assemble (Numeric, Work) ;
		}

		/* ---------------------------------------------------------- */
		/* scale the pivot column */
		/* ---------------------------------------------------------- */

		UMF_scale_column (Numeric, Work) ;

		/* ---------------------------------------------------------- */
		/* Numerical update if enough pivots accumulated */
		/* ---------------------------------------------------------- */

		evaporate = Work->fnrows == 0 || Work->fncols == 0 ;
		if (Work->fnpiv >= nb || evaporate)
		{
		    UMF_blas3_update (Work) ;
		    if (drop)
		    {
			DO (UMF_store_lu_drop (Numeric, Work)) ;
		    }
		    else
		    {
			DO (UMF_store_lu (Numeric, Work)) ;
		    }

		}

		Work->pivrow_in_front = FALSE ;
		Work->pivcol_in_front = FALSE ;

		/* ---------------------------------------------------------- */
		/* If front is empty, evaporate it */
		/* ---------------------------------------------------------- */

		if (evaporate)
		{
		    /* This does not create an element, just evaporates it.
		     * It ensures that a front is not 0-by-c or r-by-0.  No
		     * memory is allocated, so it is guaranteed to succeed. */
		    (void) UMF_create_element (Numeric, Work, Symbolic) ;
		    Work->fnrows = 0 ;
		    Work->fncols = 0 ;
		}
	    }
	}

	/* ------------------------------------------------------------------
	 * Wrapup the current frontal matrix.  This is the last in a chain
	 * in the column elimination tree.  The next frontal matrix
	 * cannot overlap with the current one, which will be its sibling
	 * in the column etree.
	 * ------------------------------------------------------------------ */

	UMF_blas3_update (Work) ;
	if (drop)
	{
	    DO (UMF_store_lu_drop (Numeric, Work)) ;
	}
	else
	{
	    DO (UMF_store_lu (Numeric, Work)) ;
	}
	Work->fnrows_new = Work->fnrows ;
	Work->fncols_new = Work->fncols ;
	DO (UMF_create_element (Numeric, Work, Symbolic)) ;

	/* ------------------------------------------------------------------ */
	/* current front is now empty */
	/* ------------------------------------------------------------------ */

	Work->fnrows = 0 ;
	Work->fncols = 0 ;
    }

    /* ---------------------------------------------------------------------- */
    /* end the last Lchain and Uchain and finalize the LU factors */
    /* ---------------------------------------------------------------------- */

    UMF_kernel_wrapup (Numeric, Symbolic, Work) ;

    /* note that the matrix may be singular (this is OK) */
    return (UMFPACK_OK) ;
}
示例#13
0
GLOBAL Int UMFPACK_get_numeric
(
    Int Lp [ ],
    Int Lj [ ],
    double Lx [ ],
#ifdef COMPLEX
    double Lz [ ],
#endif
    Int Up [ ],
    Int Ui [ ],
    double Ux [ ],
#ifdef COMPLEX
    double Uz [ ],
#endif
    Int P [ ],
    Int Q [ ],
    double Dx [ ],
#ifdef COMPLEX
    double Dz [ ],
#endif
    Int *p_do_recip,
    double Rs [ ],
    void *NumericHandle
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    NumericType *Numeric ;
    Int getL, getU, *Rperm, *Cperm, k, nn, n_row, n_col, *Wi, *Pattern,
	n_inner ;
    double *Rs1 ;
    Entry *D ;

#ifndef NDEBUG
    init_count = UMF_malloc_count ;
#endif

    Wi = (Int *) NULL ;
    Pattern = (Int *) NULL ;

    /* ---------------------------------------------------------------------- */
    /* check input parameters */
    /* ---------------------------------------------------------------------- */

    Numeric = (NumericType *) NumericHandle ;
    if (!UMF_valid_numeric (Numeric))
    {
	return (UMFPACK_ERROR_invalid_Numeric_object) ;
    }

    n_row = Numeric->n_row ;
    n_col = Numeric->n_col ;
    nn = MAX (n_row, n_col) ;
    n_inner = MIN (n_row, n_col) ;

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

    getL = Lp && Lj && Lx ;
    getU = Up && Ui && Ux ;

    if (getL || getU)
    {
	Wi = (Int *) UMF_malloc (nn, sizeof (Int)) ;
	Pattern = (Int *) UMF_malloc (nn, sizeof (Int)) ;
	if (!Wi || !Pattern)
	{
	    (void) UMF_free ((void *) Wi) ;
	    (void) UMF_free ((void *) Pattern) ;
	    ASSERT (UMF_malloc_count == init_count) ;
	    DEBUGm4 (("out of memory: get numeric\n")) ;
	    return (UMFPACK_ERROR_out_of_memory) ;
	}
	ASSERT (UMF_malloc_count == init_count + 2) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get contents of Numeric */
    /* ---------------------------------------------------------------------- */

    if (P != (Int *) NULL)
    {
	Rperm = Numeric->Rperm ;
	for (k = 0 ; k < n_row ; k++)
	{
	    P [k] = Rperm [k] ;
	}
    }

    if (Q != (Int *) NULL)
    {
	Cperm = Numeric->Cperm ;
	for (k = 0 ; k < n_col ; k++)
	{
	    Q [k] = Cperm [k] ;
	}
    }

    if (getL)
    {
	get_L (Lp, Lj, Lx,
#ifdef COMPLEX
	    Lz,
#endif
	    Numeric, Pattern, Wi) ;
    }

    if (getU)
    {
	get_U (Up, Ui, Ux,
#ifdef COMPLEX
	    Uz,
#endif
	    Numeric, Pattern, Wi) ;
    }

    if (Dx != (double *) NULL)
    {
	D = Numeric->D ;
#ifdef COMPLEX
	if (SPLIT (Dz))
	{
	    for (k = 0 ; k < n_inner ; k++)
	    {
		Dx [k] = REAL_COMPONENT (D [k]) ;
		Dz [k] = IMAG_COMPONENT (D [k]) ;
	    }
	}
	else
	{
	    for (k = 0 ; k < n_inner ; k++)
	    {
	        Dx [2*k  ] =  REAL_COMPONENT (D [k]) ;
	        Dx [2*k+1] =  IMAG_COMPONENT (D [k]) ;
	    }
	}
#else
	{
	    D = Numeric->D ;
	    for (k = 0 ; k < n_inner ; k++)
	    {
		Dx [k] = D [k] ;
	    }
	}
#endif
    }

    /* return the flag stating whether the scale factors are to be multiplied,
     * or divided.   If do_recip is TRUE, multiply.  Otherwise, divided.
     * If NRECIPROCAL is defined at compile time, the scale factors are always
     * to be used by dividing.
     */
    if (p_do_recip != (Int *) NULL)
    {
#ifndef NRECIPROCAL
	*p_do_recip = Numeric->do_recip ;
#else
	*p_do_recip = FALSE ;
#endif
    }

    if (Rs != (double *) NULL)
    {
	Rs1 = Numeric->Rs ;
	if (Rs1 == (double *) NULL)
	{
	    /* R is the identity matrix.  */
	    for (k = 0 ; k < n_row ; k++)
	    {
		Rs [k] = 1.0 ;
	    }
	}
	else
	{
	    for (k = 0 ; k < n_row ; k++)
	    {
		Rs [k] = Rs1 [k] ;
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* free the workspace */
    /* ---------------------------------------------------------------------- */

    (void) UMF_free ((void *) Wi) ;
    (void) UMF_free ((void *) Pattern) ;
    ASSERT (UMF_malloc_count == init_count) ;

    return (UMFPACK_OK) ;
}
GLOBAL Int UMFPACK_get_determinant
(
    double *Mx,
#ifdef COMPLEX
    double *Mz,
#endif
    double *Ex,
    void *NumericHandle,
    double User_Info [UMFPACK_INFO]
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Entry d_mantissa, d_tmp ;
    double d_exponent, Info2 [UMFPACK_INFO], one [2] = {1.0, 0.0}, d_sign ;
    Entry *D ;
    double *Info, *Rs ;
    NumericType *Numeric ;
    Int i, n, itmp, npiv, *Wi, *Rperm, *Cperm, do_scale ;

#ifndef NRECIPROCAL
    Int do_recip ;
#endif

    /* ---------------------------------------------------------------------- */
    /* check input parameters */
    /* ---------------------------------------------------------------------- */

    if (User_Info != (double *) NULL)
    {
	/* return Info in user's array */
	Info = User_Info ;
    }
    else
    {
	/* no Info array passed - use local one instead */
	Info = Info2 ;
	for (i = 0 ; i < UMFPACK_INFO ; i++)
	{
	    Info [i] = EMPTY ;
	}
    }

    Info [UMFPACK_STATUS] = UMFPACK_OK ;

    Numeric = (NumericType *) NumericHandle ;
    if (!UMF_valid_numeric (Numeric))
    {
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_Numeric_object ;
	return (UMFPACK_ERROR_invalid_Numeric_object) ;
    }

    if (Numeric->n_row != Numeric->n_col)
    {
	/* only square systems can be handled */
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_system ;
	return (UMFPACK_ERROR_invalid_system) ;
    }

    if (Mx == (double *) NULL)
    {
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_argument_missing ;
	return (UMFPACK_ERROR_argument_missing) ;
    }

    n = Numeric->n_row ;

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

    Wi = (Int *) UMF_malloc (n, sizeof (Int)) ;

    if (!Wi)
    {
	DEBUGm4 (("out of memory: get determinant\n")) ;
	Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
	return (UMFPACK_ERROR_out_of_memory) ;
    }

    /* ---------------------------------------------------------------------- */
    /* compute the determinant */
    /* ---------------------------------------------------------------------- */

    Rs = Numeric->Rs ;		/* row scale factors */
    do_scale = (Rs != (double *) NULL) ;

#ifndef NRECIPROCAL
    do_recip = Numeric->do_recip ;
#endif

    d_mantissa = ((Entry *) one) [0] ;
    d_exponent = 0.0 ;
    D = Numeric->D ;

    /* compute product of diagonal entries of U */
    for (i = 0 ; i < n ; i++)
    {
	MULT (d_tmp, d_mantissa, D [i]) ;
	d_mantissa = d_tmp ;

	if (!rescale_determinant (&d_mantissa, &d_exponent))
	{
	    /* the determinant is zero or NaN */
	    Info [UMFPACK_STATUS] = UMFPACK_WARNING_singular_matrix ;
	    /* no need to compute the determinant of R */
	    do_scale = FALSE ;
	    break ;
	}
    }

    /* compute product of diagonal entries of R (or its inverse) */
    if (do_scale)
    {
	for (i = 0 ; i < n ; i++)
	{
#ifndef NRECIPROCAL
	    if (do_recip)
	    {
		/* compute determinant of R inverse */
		SCALE_DIV (d_mantissa, Rs [i]) ;
	    }
	    else
#endif
	    {
		/* compute determinant of R */
		SCALE (d_mantissa, Rs [i]) ;
	    }
	    if (!rescale_determinant (&d_mantissa, &d_exponent))
	    {
		/* the determinant is zero or NaN.  This is very unlikey to
		 * occur here, since the scale factors for a tiny or zero row
		 * are set to 1. */
		Info [UMFPACK_STATUS] = UMFPACK_WARNING_singular_matrix ;
		break ;
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* determine if P and Q are odd or even permutations */
    /* ---------------------------------------------------------------------- */

    npiv = 0 ;
    Rperm = Numeric->Rperm ;

    for (i = 0 ; i < n ; i++)
    {
	Wi [i] = Rperm [i] ;
    }

    for (i = 0 ; i < n ; i++)
    {
	while (Wi [i] != i)
	{
	    itmp = Wi [Wi [i]] ;
	    Wi [Wi [i]] = Wi [i] ;
	    Wi [i] = itmp ;
	    npiv++ ;
	}
    }

    Cperm = Numeric->Cperm ;

    for (i = 0 ; i < n ; i++)
    {
	Wi [i] = Cperm [i] ;
    }

    for (i = 0 ; i < n ; i++)
    {
	while (Wi [i] != i)
	{
	    itmp = Wi [Wi [i]] ;
	    Wi [Wi [i]] = Wi [i] ;
	    Wi [i] = itmp ;
	    npiv++ ;
	}
    }

    /* if npiv is odd, the sign is -1.  if it is even, the sign is +1 */
    d_sign = (npiv % 2) ? -1. : 1. ;

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    (void) UMF_free ((void *) Wi) ;

    /* ---------------------------------------------------------------------- */
    /* compute the magnitude and exponent of the determinant */
    /* ---------------------------------------------------------------------- */

    if (Ex == (double *) NULL)
    {
	/* Ex is not provided, so return the entire determinant in d_mantissa */
	SCALE (d_mantissa, pow (10.0, d_exponent)) ;
    }
    else
    {
	Ex [0] = d_exponent ;
    }

    Mx [0] = d_sign * REAL_COMPONENT (d_mantissa) ;

#ifdef COMPLEX
    if (SPLIT (Mz))
    {
	Mz [0] = d_sign * IMAG_COMPONENT (d_mantissa) ;
    }
    else
    {
	Mx [1] = d_sign * IMAG_COMPONENT (d_mantissa) ;
    }
#endif

    /* determine if the determinant has (or will) overflow or underflow */
    if (d_exponent + 1.0 > log10 (DBL_MAX))
    {
	Info [UMFPACK_STATUS] = UMFPACK_WARNING_determinant_overflow ;
    }
    else if (d_exponent - 1.0 < log10 (DBL_MIN))
    {
	Info [UMFPACK_STATUS] = UMFPACK_WARNING_determinant_underflow ;
    }

    return (UMFPACK_OK) ;
}
GLOBAL Int UMF_init_front
(
    NumericType *Numeric,
    WorkType *Work
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int i, j, fnr_curr, row, col, *Frows, *Fcols,
	*Fcpos, *Frpos, fncols, fnrows, *Wrow, fnr2, fnc2, rrdeg, ccdeg, *Wm,
	fnrows_extended ;
    Entry *Fcblock, *Fl, *Wy, *Wx ;

    /* ---------------------------------------------------------------------- */
    /* get current frontal matrix and check for frontal growth */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    DEBUG0 (("INIT FRONT\n")) ;
    DEBUG1 (("CURR before init:\n")) ;
    UMF_dump_current_front (Numeric, Work, FALSE) ;
#endif
    if (Work->do_grow)
    {
	fnr2 = UMF_FRONTAL_GROWTH * Work->fnrows_new + 2 ;
	fnc2 = UMF_FRONTAL_GROWTH * Work->fncols_new + 2 ;
	if (!UMF_grow_front (Numeric, fnr2, fnc2, Work,
	    Work->pivrow_in_front ? 2 : 0))
	{
	    /* :: out of memory in umf_init_front :: */
	    DEBUGm4 (("out of memory: init front\n")) ;
	    return (FALSE) ;
	}
    }
#ifndef NDEBUG
    DEBUG1 (("CURR after grow:\n")) ;
    UMF_dump_current_front (Numeric, Work, FALSE) ;
    DEBUG1 (("fnrows new "ID" fncols new "ID"\n",
	Work->fnrows_new, Work->fncols_new)) ;
#endif
    ASSERT (Work->fnpiv == 0) ;
    fnr_curr = Work->fnr_curr ;
    ASSERT (Work->fnrows_new + 1 <= fnr_curr) ;
    ASSERT (Work->fncols_new + 1 <= Work->fnc_curr) ;
    ASSERT (fnr_curr >= 0) ;
    ASSERT (fnr_curr % 2 == 1) ;

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    /* current front is defined by pivot row and column */

    Frows = Work->Frows ;
    Fcols = Work->Fcols ;
    Frpos = Work->Frpos ;
    Fcpos = Work->Fcpos ;

    Work->fnzeros = 0 ;

    ccdeg = Work->ccdeg ;
    rrdeg = Work->rrdeg ;

    fnrows = Work->fnrows ;
    fncols = Work->fncols ;

    /* if both pivrow and pivcol are in front, then we extend the old one */
    /* in UMF_extend_front, rather than starting a new one here. */
    ASSERT (! (Work->pivrow_in_front && Work->pivcol_in_front)) ;

    /* ---------------------------------------------------------------------- */
    /* place pivot column pattern in frontal matrix */
    /* ---------------------------------------------------------------------- */

    Fl = Work->Flblock ;

    if (Work->pivcol_in_front)
    {
	/* Append the pivot column extension.
	 * Note that all we need to do is increment the size, since the
	 * candidate pivot column pattern is already in place in
	 * Frows [0 ... fnrows-1] (the old pattern), and
	 * Frows [fnrows ... fnrows + Work->ccdeg - 1] (the new
	 * pattern).  Frpos is also properly defined. */
	/* make a list of the new rows to scan */
	Work->fscan_row = fnrows ;	/* only scan the new rows */
	Work->NewRows = Work->Wrp ;
	Wy = Work->Wy ;
	for (i = 0 ; i < fnrows ; i++)
	{
	    Fl [i] = Wy [i] ;
	}
	fnrows_extended = fnrows + ccdeg ;
	for (i = fnrows ; i < fnrows_extended ; i++)
	{
	    Fl [i] = Wy [i] ;
	    /* flip the row, since Wrp must be < 0 */
	    row = Frows [i] ;
	    Work->NewRows [i] = FLIP (row) ;
	}
	fnrows = fnrows_extended ;
    }
    else
    {
	/* this is a completely new column */
	Work->fscan_row = 0 ;			/* scan all the rows */
	Work->NewRows = Frows ;
	Wm = Work->Wm ;
	Wx = Work->Wx ;
	for (i = 0 ; i < ccdeg ; i++)
	{
	    Fl [i] = Wx [i] ;
	    row = Wm [i] ;
	    Frows [i] = row ;
	    Frpos [row] = i ;
	}
	fnrows = ccdeg ;
    }

    Work->fnrows = fnrows ;

#ifndef NDEBUG
    DEBUG3 (("New Pivot col "ID" now in front, length "ID"\n",
	Work->pivcol, fnrows)) ;
    for (i = 0 ; i < fnrows ; i++)
    {
	DEBUG4 ((" "ID": row "ID"\n", i, Frows [i])) ;
	ASSERT (Frpos [Frows [i]] == i) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* place pivot row pattern in frontal matrix */
    /* ---------------------------------------------------------------------- */

    Wrow = Work->Wrow ;
    if (Work->pivrow_in_front)
    {
	/* append the pivot row extension */
	Work->fscan_col = fncols ;	/* only scan the new columns */
	Work->NewCols = Work->Wp ;
#ifndef NDEBUG
	for (j = 0 ; j < fncols ; j++)
	{
	    col = Fcols [j] ;
	    ASSERT (col >= 0 && col < Work->n_col) ;
	    ASSERT (Fcpos [col] == j * fnr_curr) ;
	}
#endif
	/* Wrow == Fcol for the IN_IN case, and for the OUT_IN case when
	 * the pivrow [IN][IN] happens to be the same as pivrow [OUT][IN].
	 * See UMF_local_search for more details. */
	ASSERT (IMPLIES (Work->pivcol_in_front, Wrow == Fcols)) ;
	if (Wrow == Fcols)
	{
	    for (j = fncols ; j < rrdeg ; j++)
	    {
		col = Wrow [j] ;
		/* Fcols [j] = col ; not needed */
		/* flip the col index, since Wp must be < 0 */
		Work->NewCols [j] = FLIP (col) ;
		Fcpos [col] = j * fnr_curr ;
	    }
	}
	else
	{
	    for (j = fncols ; j < rrdeg ; j++)
	    {
		col = Wrow [j] ;
		Fcols [j] = col ;
		/* flip the col index, since Wp must be < 0 */
		Work->NewCols [j] = FLIP (col) ;
		Fcpos [col] = j * fnr_curr ;
	    }
	}
    }
    else
    {
	/* this is a completely new row */
	Work->fscan_col = 0 ;			/* scan all the columns */
	Work->NewCols = Fcols ;
	for (j = 0 ; j < rrdeg ; j++)
	{
	    col = Wrow [j] ;
	    Fcols [j] = col ;
	    Fcpos [col] = j * fnr_curr ;
	}
    }

    DEBUGm1 (("rrdeg "ID" fncols "ID"\n", rrdeg, fncols)) ;
    fncols = rrdeg ;
    Work->fncols = fncols ;

    /* ---------------------------------------------------------------------- */
    /* clear the frontal matrix */
    /* ---------------------------------------------------------------------- */

    ASSERT (fnrows == Work->fnrows_new + 1) ;
    ASSERT (fncols == Work->fncols_new + 1) ;

    Fcblock = Work->Fcblock ;
    ASSERT (Fcblock != (Entry *) NULL) ;

    zero_init_front (fncols, fnrows, Fcblock, fnr_curr) ;

#ifndef NDEBUG
    DEBUG3 (("New Pivot row "ID" now in front, length "ID" fnr_curr "ID"\n",
		Work->pivrow, fncols, fnr_curr)) ;
    for (j = 0 ; j < fncols ; j++)
    {
	DEBUG4 (("col "ID" position "ID"\n", j, Fcols [j])) ;
	ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* current workspace usage: */
    /* ---------------------------------------------------------------------- */

    /* Fcblock [0..fnr_curr-1, 0..fnc_curr-1]: space for the new frontal
     * matrix.  Fcblock (i,j) is located at Fcblock [i+j*fnr_curr] */

    return (TRUE) ;

}
GLOBAL Int UMF_store_lu_drop
#else
GLOBAL Int UMF_store_lu
#endif
(
    NumericType *Numeric,
    WorkType *Work
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Entry pivot_value ;
#ifdef DROP
    double droptol ;
#endif
    Entry *D, *Lval, *Uval, *Fl1, *Fl2, *Fu1, *Fu2,
	*Flublock, *Flblock, *Fublock ;
    Int i, k, fnr_curr, fnrows, fncols, row, col, pivrow, pivcol, *Frows,
	*Fcols, *Lpattern, *Upattern, *Lpos, *Upos, llen, ulen, fnc_curr, fnpiv,
	uilen, lnz, unz, nb, *Lilen,
	*Uilen, *Lip, *Uip, *Li, *Ui, pivcol_position, newLchain, newUchain,
	pivrow_position, p, size, lip, uip, lnzi, lnzx, unzx, lnz2i, lnz2x,
	unz2i, unz2x, zero_pivot, *Pivrow, *Pivcol, kk,
	Lnz [MAXNB] ;

#ifndef NDEBUG
    Int *Col_degree, *Row_degree ;
#endif

#ifdef DROP
    Int all_lnz, all_unz ;
    droptol = Numeric->droptol ;
#endif

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    fnrows = Work->fnrows ;
    fncols = Work->fncols ;
    fnpiv = Work->fnpiv ;

    Lpos = Numeric->Lpos ;
    Upos = Numeric->Upos ;
    Lilen = Numeric->Lilen ;
    Uilen = Numeric->Uilen ;

    Lip = Numeric->Lip ;
    Uip = Numeric->Uip ;
    D = Numeric->D ;

    Flublock = Work->Flublock ;
    Flblock  = Work->Flblock ;
    Fublock  = Work->Fublock ;

    fnr_curr = Work->fnr_curr ;
    fnc_curr = Work->fnc_curr ;
    Frows = Work->Frows ;
    Fcols = Work->Fcols ;

#ifndef NDEBUG
    Col_degree = Numeric->Cperm ;	/* for NON_PIVOTAL_COL macro */
    Row_degree = Numeric->Rperm ;	/* for NON_PIVOTAL_ROW macro */
#endif

    Lpattern = Work->Lpattern ;
    llen = Work->llen ;
    Upattern = Work->Upattern ;
    ulen = Work->ulen ;

    nb = Work->nb ;

#ifndef NDEBUG
    DEBUG1 (("\nSTORE LU: fnrows "ID
	" fncols "ID"\n", fnrows, fncols)) ;

    DEBUG2 (("\nFrontal matrix, including all space:\n"
		"fnr_curr "ID" fnc_curr "ID" nb    "ID"\n"
		"fnrows   "ID" fncols   "ID" fnpiv "ID"\n",
		fnr_curr, fnc_curr, nb, fnrows, fncols, fnpiv)) ;

    DEBUG2 (("\nJust the active part:\n")) ;
    DEBUG7 (("C  block: ")) ;
    UMF_dump_dense (Work->Fcblock,  fnr_curr, fnrows, fncols) ;
    DEBUG7 (("L  block: ")) ;
    UMF_dump_dense (Work->Flblock,  fnr_curr, fnrows, fnpiv);
    DEBUG7 (("U' block: ")) ;
    UMF_dump_dense (Work->Fublock,  fnc_curr, fncols, fnpiv) ;
    DEBUG7 (("LU block: ")) ;
    UMF_dump_dense (Work->Flublock, nb, fnpiv, fnpiv) ;
    DEBUG7 (("Current frontal matrix: (prior to store LU)\n")) ;
    UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif

    Pivrow = Work->Pivrow ;
    Pivcol = Work->Pivcol ;

    /* ---------------------------------------------------------------------- */
    /* store the columns of L */
    /* ---------------------------------------------------------------------- */

    for (kk = 0 ; kk < fnpiv ; kk++)
    {

	/* ------------------------------------------------------------------ */
	/* one more pivot row and column is being stored into L and U */
	/* ------------------------------------------------------------------ */

	k = Work->npiv + kk ;

	/* ------------------------------------------------------------------ */
	/* find the kth pivot row and pivot column */
	/* ------------------------------------------------------------------ */

	pivrow = Pivrow [kk] ;
	pivcol = Pivcol [kk] ;

#ifndef NDEBUG
	ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
	ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;

	DEBUGm4 ((
	"\n -------------------------------------------------------------"
	"Store LU: step " ID"\n", k))  ;
	ASSERT (k < MIN (Work->n_row, Work->n_col)) ;
	DEBUG2 (("Store column of L, k = "ID", llen "ID"\n", k, llen)) ;
	for (i = 0 ; i < llen ; i++)
	{
	    row = Lpattern [i] ;
	    ASSERT (row >= 0 && row < Work->n_row) ;
	    DEBUG2 (("    Lpattern["ID"] "ID" Lpos "ID, i, row, Lpos [row])) ;
	    if (row == pivrow) DEBUG2 ((" <- pivot row")) ;
	    DEBUG2 (("\n")) ;
	    ASSERT (i == Lpos [row]) ;
	}
#endif

	/* ------------------------------------------------------------------ */
	/* remove pivot row from L */
	/* ------------------------------------------------------------------ */

	/* remove pivot row index from current column of L */
	/* if a new Lchain starts, then all entries are removed later */
	DEBUG2 (("Removing pivrow from Lpattern, k = "ID"\n", k)) ;
	ASSERT (!NON_PIVOTAL_ROW (pivrow)) ;
	pivrow_position = Lpos [pivrow] ;
	if (pivrow_position != EMPTY)
	{
	    /* place the last entry in the column in the */
	    /* position of the pivot row index */
	    ASSERT (pivrow == Lpattern [pivrow_position]) ;
	    row = Lpattern [--llen] ;
	    /* ASSERT (NON_PIVOTAL_ROW (row)) ; */
	    Lpattern [pivrow_position] = row ;
	    Lpos [row] = pivrow_position ;
	    Lpos [pivrow] = EMPTY ;
	}

	/* ------------------------------------------------------------------ */
	/* store the pivot value, for the diagonal matrix D */
	/* ------------------------------------------------------------------ */

	/* kk-th column of LU block */
	Fl1 = Flublock + kk * nb ;

	/* kk-th column of L in the L block */
	Fl2 = Flblock + kk * fnr_curr ;

	/* kk-th pivot in frontal matrix located in Flublock [kk, kk] */
	pivot_value = Fl1 [kk] ;

	D [k] = pivot_value ;
	zero_pivot = IS_ZERO (pivot_value) ;

	DEBUG4 (("Pivot D["ID"]=", k)) ;
	EDEBUG4 (pivot_value) ;
	DEBUG4 (("\n")) ;

	/* ------------------------------------------------------------------ */
	/* count nonzeros in kth column of L */
	/* ------------------------------------------------------------------ */

	lnz = 0 ;
	lnz2i = 0 ;
	lnz2x = llen ;

#ifdef DROP
	    all_lnz = 0 ;

	    for (i = kk + 1 ; i < fnpiv ; i++)
	    {
		Entry x ;
		double s ;
		x = Fl1 [i] ;
		if (IS_ZERO (x)) continue ;
		all_lnz++ ;
		APPROX_ABS (s, x) ;
		if (s <= droptol) continue ;
		lnz++ ;
		if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ;
	    }

	    for (i = 0 ; i < fnrows ; i++)
	    {
		Entry x ;
		double s ;
		x = Fl2 [i] ;
		if (IS_ZERO (x)) continue ;
		all_lnz++ ;
		APPROX_ABS (s, x) ;
		if (s <= droptol) continue ;
		lnz++ ;
		if (Lpos [Frows [i]] == EMPTY) lnz2i++ ;
	    }

#else

	    for (i = kk + 1 ; i < fnpiv ; i++)
	    {
		if (IS_ZERO (Fl1 [i])) continue ;
		lnz++ ;
		if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ;
	    }

	    for (i = 0 ; i < fnrows ; i++)
	    {
		if (IS_ZERO (Fl2 [i])) continue ;
		lnz++ ;
		if (Lpos [Frows [i]] == EMPTY) lnz2i++ ;
	    }

#endif

	lnz2x += lnz2i ;

	/* determine if we start a new Lchain or continue the old one */
	if (llen == 0 || zero_pivot)
	{
	    /* llen == 0 means there is no prior Lchain */
	    /* D [k] == 0 means the pivot column is empty */
	    newLchain = TRUE ;
	}
	else
	{
	    newLchain =
		    /* storage for starting a new Lchain */
		    UNITS (Entry, lnz) + UNITS (Int, lnz)
		<=
		    /* storage for continuing a prior Lchain */
		    UNITS (Entry, lnz2x) + UNITS (Int, lnz2i) ;
	}

	if (newLchain)
	{
	    /* start a new chain for column k of L */
	    DEBUG2 (("Start new Lchain, k = "ID"\n", k)) ;

	    pivrow_position = EMPTY ;

	    /* clear the prior Lpattern */
	    for (i = 0 ; i < llen ; i++)
	    {
		row = Lpattern [i] ;
		Lpos [row] = EMPTY ;
	    }
	    llen = 0 ;

	    lnzi = lnz ;
	    lnzx = lnz ;
	}
	else
	{
	    /* continue the prior Lchain */
	    DEBUG2 (("Continue  Lchain, k = "ID"\n", k)) ;
	    lnzi = lnz2i ;
	    lnzx = lnz2x ;
	}

	/* ------------------------------------------------------------------ */
	/* allocate space for the column of L */
	/* ------------------------------------------------------------------ */

	size = UNITS (Int, lnzi) + UNITS (Entry, lnzx) ;

#ifndef NDEBUG
	UMF_allocfail = FALSE ;
	if (UMF_gprob > 0)
	{
	    double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
	    DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
	    UMF_allocfail = rrr < UMF_gprob ;
	    if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n"));
	}
#endif

	p = UMF_mem_alloc_head_block (Numeric, size) ;
	if (!p)
	{
	    Int r2, c2 ;
	    /* Do garbage collection, realloc, and try again. */
	    /* Note that there are pivot rows/columns in current front. */
	    if (Work->do_grow)
	    {
		/* full compaction of current frontal matrix, since
		 * UMF_grow_front will be called next anyway. */
		r2 = fnrows ;
		c2 = fncols ;
	    }
	    else
	    {
		/* partial compaction. */
		r2 = MAX (fnrows, Work->fnrows_new + 1) ;
		c2 = MAX (fncols, Work->fncols_new + 1) ;
	    }
	    DEBUGm3 (("get_memory from umf_store_lu:\n")) ;
	    if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE))
	    {
		DEBUGm4 (("out of memory: store LU (1)\n")) ;
		return (FALSE) ;	/* out of memory */
	    }
	    p = UMF_mem_alloc_head_block (Numeric, size) ;
	    if (!p)
	    {
		DEBUGm4 (("out of memory: store LU (2)\n")) ;
		return (FALSE) ;	/* out of memory */
	    }
	    /* garbage collection may have moved the current front */
	    fnc_curr = Work->fnc_curr ;
	    fnr_curr = Work->fnr_curr ;
	    Flublock = Work->Flublock ;
	    Flblock  = Work->Flblock ;
	    Fublock  = Work->Fublock ;
	    Fl1 = Flublock + kk * nb ;
	    Fl2 = Flblock  + kk * fnr_curr ;
	}

	/* ------------------------------------------------------------------ */
	/* store the column of L */
	/* ------------------------------------------------------------------ */

	lip = p ;

	Li = (Int *) (Numeric->Memory + p) ;
	p += UNITS (Int, lnzi) ;
	Lval = (Entry *) (Numeric->Memory + p) ;
	p += UNITS (Entry, lnzx) ;

	for (i = 0 ; i < lnzx ; i++)
	{
	    CLEAR (Lval [i]) ;
	}

	/* store the numerical entries */

	if (newLchain)
	{
	    /* flag the first column in the Lchain by negating Lip [k] */
	    lip = -lip ;

	    ASSERT (llen == 0) ;

#ifdef DROP

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    double s ;
		    Int row2, pos ;
		    x = Fl1 [i] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    row2 = Pivrow [i] ;
		    pos = llen++ ;
		    Lpattern [pos] = row2 ;
		    Lpos [row2] = pos ;
		    Li [pos] = row2 ;
		    Lval [pos] = x ;
		}

		for (i = 0 ; i < fnrows ; i++)
		{
		    Entry x ;
		    double s ;
		    Int row2, pos ;
		    x = Fl2 [i] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    row2 = Frows [i] ;
		    pos = llen++ ;
		    Lpattern [pos] = row2 ;
		    Lpos [row2] = pos ;
		    Li [pos] = row2 ;
		    Lval [pos] = x ;
		}

#else

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    Int row2, pos ;
		    x = Fl1 [i] ;
		    if (IS_ZERO (x)) continue ;
		    row2 = Pivrow [i] ;
		    pos = llen++ ;
		    Lpattern [pos] = row2 ;
		    Lpos [row2] = pos ;
		    Li [pos] = row2 ;
		    Lval [pos] = x ;
		}

		for (i = 0 ; i < fnrows ; i++)
		{
		    Entry x ;
		    Int row2, pos ;
		    x = Fl2 [i] ;
		    if (IS_ZERO (x)) continue ;
		    row2 = Frows [i] ;
		    pos = llen++ ;
		    Lpattern [pos] = row2 ;
		    Lpos [row2] = pos ;
		    Li [pos] = row2 ;
		    Lval [pos] = x ;
		}

#endif

	}
	else
	{
	    ASSERT (llen > 0) ;

#ifdef DROP

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    double s ;
		    Int row2, pos ;
		    x = Fl1 [i] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    row2 = Pivrow [i] ;
		    pos = Lpos [row2] ;
		    if (pos == EMPTY)
		    {
			pos = llen++ ;
			Lpattern [pos] = row2 ;
			Lpos [row2] = pos ;
			*Li++ = row2 ;
		    }
		    Lval [pos] = x ;
		}

		for (i = 0 ; i < fnrows ; i++)
		{
		    Entry x ;
		    double s ;
		    Int row2, pos ;
		    x = Fl2 [i] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    row2 = Frows [i] ;
		    pos = Lpos [row2] ;
		    if (pos == EMPTY)
		    {
			pos = llen++ ;
			Lpattern [pos] = row2 ;
			Lpos [row2] = pos ;
			*Li++ = row2 ;
		    }
		    Lval [pos] = x ;
		}

#else

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    Int row2, pos ;
		    x = Fl1 [i] ;
		    if (IS_ZERO (x)) continue ;
		    row2 = Pivrow [i] ;
		    pos = Lpos [row2] ;
		    if (pos == EMPTY)
		    {
			pos = llen++ ;
			Lpattern [pos] = row2 ;
			Lpos [row2] = pos ;
			*Li++ = row2 ;
		    }
		    Lval [pos] = x ;
		}

		for (i = 0 ; i < fnrows ; i++)
		{
		    Entry x ;
		    Int row2, pos ;
		    x = Fl2 [i] ;
		    if (IS_ZERO (x)) continue ;
		    row2 = Frows [i] ;
		    pos = Lpos [row2] ;
		    if (pos == EMPTY)
		    {
			pos = llen++ ;
			Lpattern [pos] = row2 ;
			Lpos [row2] = pos ;
			*Li++ = row2 ;
		    }
		    Lval [pos] = x ;
		}

#endif

	}
	DEBUG4 (("llen "ID" lnzx "ID"\n", llen, lnzx)) ;
	ASSERT (llen == lnzx) ;
	ASSERT (lnz <= llen) ;
	DEBUG4 (("lnz "ID" \n", lnz)) ;

#ifdef DROP

	    DEBUG4 (("all_lnz "ID" \n", all_lnz)) ;
	    ASSERT (lnz <= all_lnz) ;
	    Numeric->lnz += lnz ;
	    Numeric->all_lnz += all_lnz ;
	    Lnz [kk] = all_lnz ;

#else

	    Numeric->lnz += lnz ;
	    Numeric->all_lnz += lnz ;
	    Lnz [kk] = lnz ;
#endif

	Numeric->nLentries += lnzx ;
	Work->llen = llen ;
	Numeric->isize += lnzi ;

	/* ------------------------------------------------------------------ */
	/* the pivot column is fully assembled and scaled, and is now the */
	/* k-th column of L */
	/* ------------------------------------------------------------------ */

	Lpos [pivrow] = pivrow_position ;	/* not aliased */
	Lip [pivcol] = lip ;			/* aliased with Col_tuples */
	Lilen [pivcol] = lnzi ;			/* aliased with Col_tlen */

    }

    /* ---------------------------------------------------------------------- */
    /* store the rows of U */
    /* ---------------------------------------------------------------------- */

    for (kk = 0 ; kk < fnpiv ; kk++)
    {

	/* ------------------------------------------------------------------ */
	/* one more pivot row and column is being stored into L and U */
	/* ------------------------------------------------------------------ */

	k = Work->npiv + kk ;

	/* ------------------------------------------------------------------ */
	/* find the kth pivot row and pivot column */
	/* ------------------------------------------------------------------ */

	pivrow = Pivrow [kk] ;
	pivcol = Pivcol [kk] ;

#ifndef NDEBUG
	ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
	ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;

	DEBUG2 (("Store row of U, k = "ID", ulen "ID"\n", k, ulen)) ;
	for (i = 0 ; i < ulen ; i++)
	{
	    col = Upattern [i] ;
	    DEBUG2 (("    Upattern["ID"] "ID, i, col)) ;
	    if (col == pivcol) DEBUG2 ((" <- pivot col")) ;
	    DEBUG2 (("\n")) ;
	    ASSERT (col >= 0 && col < Work->n_col) ;
	    ASSERT (i == Upos [col]) ;
	}
#endif

	/* ------------------------------------------------------------------ */
	/* get the pivot value, for the diagonal matrix D */
	/* ------------------------------------------------------------------ */

	zero_pivot = IS_ZERO (D [k]) ;

	/* ------------------------------------------------------------------ */
	/* count the nonzeros in the row of U */
	/* ------------------------------------------------------------------ */

	/* kk-th row of U in the LU block */
	Fu1 = Flublock + kk ;

	/* kk-th row of U in the U block */
	Fu2 = Fublock + kk * fnc_curr ;

	unz = 0 ;
	unz2i = 0 ;
	unz2x = ulen ;
	DEBUG2 (("unz2x is "ID", lnzx "ID"\n", unz2x, lnzx)) ;

	/* if row k does not end a Uchain, pivcol not included in ulen */
	ASSERT (!NON_PIVOTAL_COL (pivcol)) ;
	pivcol_position = Upos [pivcol] ;
	if (pivcol_position != EMPTY)
	{
	    unz2x-- ;
	    DEBUG2 (("(exclude pivcol) unz2x is now "ID"\n", unz2x)) ;
	}

	ASSERT (unz2x >= 0) ;

#ifdef DROP
	    all_unz = 0 ;

	    for (i = kk + 1 ; i < fnpiv ; i++)
	    {
		Entry x ;
		double s ;
		x = Fu1 [i*nb] ;
		if (IS_ZERO (x)) continue ;
		all_unz++ ;
		APPROX_ABS (s, x) ;
		if (s <= droptol) continue ;
		unz++ ;
		if (Upos [Pivcol [i]] == EMPTY) unz2i++ ;
	    }

	    for (i = 0 ; i < fncols ; i++)
	    {
		Entry x ;
		double s ;
		x = Fu2 [i] ;
		if (IS_ZERO (x)) continue ;
		all_unz++ ;
		APPROX_ABS (s, x) ;
		if (s <= droptol) continue ;
		unz++ ;
		if (Upos [Fcols [i]] == EMPTY) unz2i++ ;
	    }

#else

	    for (i = kk + 1 ; i < fnpiv ; i++)
	    {
		if (IS_ZERO (Fu1 [i*nb])) continue ;
		unz++ ;
		if (Upos [Pivcol [i]] == EMPTY) unz2i++ ;
	    }

	    for (i = 0 ; i < fncols ; i++)
	    {
		if (IS_ZERO (Fu2 [i])) continue ;
		unz++ ;
		if (Upos [Fcols [i]] == EMPTY) unz2i++ ;
	    }

#endif

	unz2x += unz2i ;

	ASSERT (IMPLIES (k == 0, ulen == 0)) ;

	/* determine if we start a new Uchain or continue the old one */
	if (ulen == 0 || zero_pivot)
	{
	    /* ulen == 0 means there is no prior Uchain */
	    /* D [k] == 0 means the matrix is singular (pivot row might */
	    /* not be empty, however, but start a new Uchain to prune zero */
	    /* entries for the deg > 0 test in UMF_u*solve) */
	    newUchain = TRUE ;
	}
	else
	{
	    newUchain =
		    /* approximate storage for starting a new Uchain */
		    UNITS (Entry, unz) + UNITS (Int, unz)
		<=
		    /* approximate storage for continuing a prior Uchain */
		    UNITS (Entry, unz2x) + UNITS (Int, unz2i) ;

	    /* this would be exact, except for the Int to Unit rounding, */
	    /* because the Upattern is stored only at the end of the Uchain */
	}

	/* ------------------------------------------------------------------ */
	/* allocate space for the row of U */
	/* ------------------------------------------------------------------ */

	size = 0 ;
	if (newUchain)
	{
	    /* store the pattern of the last row in the prior Uchain */
	    size += UNITS (Int, ulen) ;
	    unzx = unz ;
	}
	else
	{
	    unzx = unz2x ;
	}
	size += UNITS (Entry, unzx) ;

#ifndef NDEBUG
	UMF_allocfail = FALSE ;
	if (UMF_gprob > 0)
	{
	    double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
	    DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
	    UMF_allocfail = rrr < UMF_gprob ;
	    if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n"));
	}
#endif

	p = UMF_mem_alloc_head_block (Numeric, size) ;
	if (!p)
	{
	    Int r2, c2 ;
	    /* Do garbage collection, realloc, and try again. */
	    /* Note that there are pivot rows/columns in current front. */
	    if (Work->do_grow)
	    {
		/* full compaction of current frontal matrix, since
		 * UMF_grow_front will be called next anyway. */
		r2 = fnrows ;
		c2 = fncols ;
	    }
	    else
	    {
		/* partial compaction. */
		r2 = MAX (fnrows, Work->fnrows_new + 1) ;
		c2 = MAX (fncols, Work->fncols_new + 1) ;
	    }
	    DEBUGm3 (("get_memory from umf_store_lu:\n")) ;
	    if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE))
	    {
		/* :: get memory, column of L :: */
		DEBUGm4 (("out of memory: store LU (1)\n")) ;
		return (FALSE) ;	/* out of memory */
	    }
	    p = UMF_mem_alloc_head_block (Numeric, size) ;
	    if (!p)
	    {
		/* :: out of memory, column of U :: */
		DEBUGm4 (("out of memory: store LU (2)\n")) ;
		return (FALSE) ;	/* out of memory */
	    }
	    /* garbage collection may have moved the current front */
	    fnc_curr = Work->fnc_curr ;
	    fnr_curr = Work->fnr_curr ;
	    Flublock = Work->Flublock ;
	    Flblock  = Work->Flblock ;
	    Fublock  = Work->Fublock ;
	    Fu1 = Flublock + kk ;
	    Fu2 = Fublock  + kk * fnc_curr ;
	}

	/* ------------------------------------------------------------------ */
	/* store the row of U */
	/* ------------------------------------------------------------------ */

	uip = p ;

	if (newUchain)
	{
	    /* starting a new Uchain - flag this by negating Uip [k] */
	    uip = -uip ;
	    DEBUG2 (("Start new Uchain, k = "ID"\n", k)) ;

	    pivcol_position = EMPTY ;

	    /* end the prior Uchain */
	    /* save the current Upattern, and then */
	    /* clear it and start a new Upattern */
	    DEBUG2 (("Ending prior chain, k-1 = "ID"\n", k-1)) ;
	    uilen = ulen ;
	    Ui = (Int *) (Numeric->Memory + p) ;
	    Numeric->isize += ulen ;
	    p += UNITS (Int, ulen) ;
	    for (i = 0 ; i < ulen ; i++)
	    {
		col = Upattern [i] ;
		ASSERT (col >= 0 && col < Work->n_col) ;
		Upos [col] = EMPTY ;
		Ui [i] = col ;
	    }

	    ulen = 0 ;

	}
	else
	{
	    /* continue the prior Uchain */
	    DEBUG2 (("Continue  Uchain, k = "ID"\n", k)) ;
	    ASSERT (k > 0) ;

	    /* remove pivot col index from current row of U */
	    /* if a new Uchain starts, then all entries are removed later */
	    DEBUG2 (("Removing pivcol from Upattern, k = "ID"\n", k)) ;

	    if (pivcol_position != EMPTY)
	    {
		/* place the last entry in the row in the */
		/* position of the pivot col index */
		ASSERT (pivcol == Upattern [pivcol_position]) ;
		col = Upattern [--ulen] ;
		ASSERT (col >= 0 && col < Work->n_col) ;
		Upattern [pivcol_position] = col ;
		Upos [col] = pivcol_position ;
		Upos [pivcol] = EMPTY ;
	    }

	    /* this row continues the Uchain.  Keep track of how much */
	    /* to trim from the k-th length to get the length of the */
	    /* (k-1)st row of U */
	    uilen = unz2i ;

	}

	Uval = (Entry *) (Numeric->Memory + p) ;
	/* p += UNITS (Entry, unzx), no need to increment p */

	for (i = 0 ; i < unzx ; i++)
	{
	    CLEAR (Uval [i]) ;
	}

	if (newUchain)
	{
	    ASSERT (ulen == 0) ;

#ifdef DROP

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    double s ;
		    Int col2, pos ;
		    x = Fu1 [i*nb] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    col2 = Pivcol [i] ;
		    pos = ulen++ ;
		    Upattern [pos] = col2 ;
		    Upos [col2] = pos ;
		    Uval [pos] = x ;
		}

		for (i = 0 ; i < fncols ; i++)
		{
		    Entry x ;
		    double s ;
		    Int col2, pos ;
		    x = Fu2 [i] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    col2 = Fcols [i] ;
		    pos = ulen++ ;
		    Upattern [pos] = col2 ;
		    Upos [col2] = pos ;
		    Uval [pos] = x ;
		}

#else

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    Int col2, pos ;
		    x = Fu1 [i*nb] ;
		    if (IS_ZERO (x)) continue ;
		    col2 = Pivcol [i] ;
		    pos = ulen++ ;
		    Upattern [pos] = col2 ;
		    Upos [col2] = pos ;
		    Uval [pos] = x ;
		}

		for (i = 0 ; i < fncols ; i++)
		{
		    Entry x ;
		    Int col2, pos ;
		    x = Fu2 [i] ;
		    if (IS_ZERO (x)) continue ;
		    col2 = Fcols [i] ;
		    pos = ulen++ ;
		    Upattern [pos] = col2 ;
		    Upos [col2] = pos ;
		    Uval [pos] = x ;
		}

#endif

	}
	else
	{

	    ASSERT (ulen > 0) ;

	    /* store the numerical entries and find new nonzeros */

#ifdef DROP

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    double s ;
		    Int col2, pos ;
		    x = Fu1 [i*nb] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    col2 = Pivcol [i] ;
		    pos = Upos [col2] ;
		    if (pos == EMPTY)
		    {
			pos = ulen++ ;
			Upattern [pos] = col2 ;
			Upos [col2] = pos ;
		    }
		    Uval [pos] = x ;
		}

		for (i = 0 ; i < fncols ; i++)
		{
		    Entry x ;
		    double s ;
		    Int col2, pos ;
		    x = Fu2 [i] ;
		    APPROX_ABS (s, x) ;
		    if (s <= droptol) continue ;
		    col2 = Fcols [i] ;
		    pos = Upos [col2] ;
		    if (pos == EMPTY)
		    {
			pos = ulen++ ;
			Upattern [pos] = col2 ;
			Upos [col2] = pos ;
		    }
		    Uval [pos] = x ;
		}

#else

		for (i = kk + 1 ; i < fnpiv ; i++)
		{
		    Entry x ;
		    Int col2, pos ;
		    x = Fu1 [i*nb] ;
		    if (IS_ZERO (x)) continue ;
		    col2 = Pivcol [i] ;
		    pos = Upos [col2] ;
		    if (pos == EMPTY)
		    {
			pos = ulen++ ;
			Upattern [pos] = col2 ;
			Upos [col2] = pos ;
		    }
		    Uval [pos] = x ;
		}

		for (i = 0 ; i < fncols ; i++)
		{
		    Entry x ;
		    Int col2, pos ;
		    x = Fu2 [i] ;
		    if (IS_ZERO (x)) continue ;
		    col2 = Fcols [i] ;
		    pos = Upos [col2] ;
		    if (pos == EMPTY)
		    {
			pos = ulen++ ;
			Upattern [pos] = col2 ;
			Upos [col2] = pos ;
		    }
		    Uval [pos] = x ;
		}

#endif

	}

	ASSERT (ulen == unzx) ;
	ASSERT (unz <= ulen) ;
	DEBUG4 (("unz "ID" \n", unz)) ;

#ifdef DROP

	    DEBUG4 (("all_unz "ID" \n", all_unz)) ;
	    ASSERT (unz <= all_unz) ;
	    Numeric->unz += unz ;
	    Numeric->all_unz += all_unz ;
	    /* count the "true" flops, based on LU pattern only */
	    Numeric->flops += DIV_FLOPS * Lnz [kk]	/* scale pivot column */
		+ MULTSUB_FLOPS * (Lnz [kk] * all_unz) ;    /* outer product */

#else

	    Numeric->unz += unz ;
	    Numeric->all_unz += unz ;
	    /* count the "true" flops, based on LU pattern only */
	    Numeric->flops += DIV_FLOPS * Lnz [kk]	/* scale pivot column */
		+ MULTSUB_FLOPS * (Lnz [kk] * unz) ;    /* outer product */
#endif

	Numeric->nUentries += unzx ;
	Work->ulen = ulen ;
	DEBUG1 (("Work->ulen = "ID" at end of pivot step, k: "ID"\n", ulen, k));

	/* ------------------------------------------------------------------ */
	/* the pivot row is the k-th row of U */
	/* ------------------------------------------------------------------ */

	Upos [pivcol] = pivcol_position ;	/* not aliased */
	Uip [pivrow] = uip ;			/* aliased with Row_tuples */
	Uilen [pivrow] = uilen ;		/* aliased with Row_tlen */

    }

    /* ---------------------------------------------------------------------- */
    /* no more pivots in frontal working array */
    /* ---------------------------------------------------------------------- */

    Work->npiv += fnpiv ;
    Work->fnpiv = 0 ;
    Work->fnzeros = 0 ;
    return (TRUE) ;
}
GLOBAL Int UMFPACK_transpose
(
    Int n_row,
    Int n_col,
    const Int Ap [ ],	/* size n_col+1 */
    const Int Ai [ ],	/* size nz = Ap [n_col] */
    const double Ax [ ], /* size nz, if present */
#ifdef COMPLEX
    const double Az [ ], /* size nz, if present */
#endif

    const Int P [ ],	/* P [k] = i means original row i is kth row in A(P,Q)*/
			/* P is identity if not present */
			/* size n_row, if present */

    const Int Q [ ],	/* Q [k] = j means original col j is kth col in A(P,Q)*/
			/* Q is identity if not present */
			/* size n_col, if present */

    Int Rp [ ],		/* size n_row+1 */
    Int Ri [ ],		/* size nz */
    double Rx [ ]	/* size nz, if present */
#ifdef COMPLEX
    , double Rz [ ]	/* size nz, if present */
    , Int do_conjugate	/* if true, then to conjugate transpose */
			/* otherwise, do array transpose */
#endif
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int status, *W, nn ;

#ifndef NDEBUG
    init_count = UMF_malloc_count ;
    UMF_dump_start ( ) ;
#endif

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

    nn = MAX (n_row, n_col) ;
    nn = MAX (nn, 1) ;
    W = (Int *) UMF_malloc (nn, sizeof (Int)) ;
    if (!W)
    {
	DEBUGm4 (("out of memory: transpose work\n")) ;
	ASSERT (UMF_malloc_count == init_count) ;
	return (UMFPACK_ERROR_out_of_memory) ;
    }
    ASSERT (UMF_malloc_count == init_count + 1) ;

    /* ---------------------------------------------------------------------- */
    /* C = (A (P,Q))' or (A (P,Q)).' */
    /* ---------------------------------------------------------------------- */

    status = UMF_transpose (n_row, n_col, Ap, Ai, Ax, P, Q, n_col, Rp, Ri, Rx,
	W, TRUE
#ifdef COMPLEX
	, Az, Rz, do_conjugate
#endif
	) ;

    /* ---------------------------------------------------------------------- */
    /* free the workspace */
    /* ---------------------------------------------------------------------- */

    (void) UMF_free ((void *) W) ;
    ASSERT (UMF_malloc_count == init_count) ;

    return (status) ;
}
示例#18
0
PRIVATE Int two_by_two	    /* returns # unmatched weak diagonals */
(
    /* input, not modified */
    Int n2,		/* C is n2-by-n2 */
    Int Cp [ ],		/* size n2+1, column pointers for C */
    Int Ci [ ],		/* size snz = Cp [n2], row indices for C */
    Int Degree [ ],	/* Degree [i] = degree of row i of C+C' */

    /* input, not defined on output */
    Int Next [ ],	/* Next [k] == IS_WEAK if k is a weak diagonal */
    Int Ri [ ],		/* Ri [i] is the length of row i in C */

    /* output, not defined on input */
    Int P [ ],

    /* workspace, not defined on input or output */
    Int Rp [ ],
    Int Head [ ]
)
{
    Int deg, newcol, row, col, p, p2, unmatched, k, j, j2, j_best, best, jdiff,
	jdiff_best, jdeg, jdeg_best, cp, cp1, cp2, rp, rp1, rp2, maxdeg,
	mindeg ;

    /* ---------------------------------------------------------------------- */
    /* place weak diagonals in the degree lists */
    /* ---------------------------------------------------------------------- */

    for (deg = 0 ; deg < n2 ; deg++)
    {
	Head [deg] = EMPTY ;
    }

    maxdeg = 0 ;
    mindeg = Int_MAX ;
    for (newcol = n2-1 ; newcol >= 0 ; newcol--)
    {
	if (Next [newcol] == IS_WEAK)
	{
	    /* add this column to the list of weak nodes */
	    DEBUGm1 (("    newcol "ID" has a weak diagonal deg "ID"\n",
		newcol, deg)) ;
	    deg = Degree [newcol] ;
	    ASSERT (deg >= 0 && deg < n2) ;
	    Next [newcol] = Head [deg] ;
	    Head [deg] = newcol ;
	    maxdeg = MAX (maxdeg, deg) ;
	    mindeg = MIN (mindeg, deg) ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* construct R = C' (C = strong entries in pruned submatrix) */
    /* ---------------------------------------------------------------------- */

    /* Ri [0..n2-1] is the length of each row of R */
    /* use P as temporary pointer into the row form of R [ */
    Rp [0] = 0 ;
    for (row = 0 ; row < n2 ; row++)
    {
	Rp [row+1] = Rp [row] + Ri [row] ;
	P [row] = Rp [row] ;
    }
    /* Ri no longer needed for row counts */

    /* all entries in C are strong */
    for (col = 0 ; col < n2 ; col++)
    {
	p2 = Cp [col+1] ;
	for (p = Cp [col] ; p < p2 ; p++)
	{
	    /* place the column index in row = Ci [p] */
	    Ri [P [Ci [p]]++] = col ;
	}
    }

    /* contents of P no longer needed ] */

#ifndef NDEBUG
    DEBUG0 (("==================R: row form of strong entries in A:\n")) ;
    UMF_dump_col_matrix ((double *) NULL,
#ifdef COMPLEX
	    (double *) NULL,
#endif
	    Ri, Rp, n2, n2, Rp [n2]) ;
#endif
    ASSERT (AMD_valid (n2, n2, Rp, Ri) == AMD_OK) ;

    /* ---------------------------------------------------------------------- */
    /* for each weak diagonal, find a pair of strong off-diagonal entries */
    /* ---------------------------------------------------------------------- */

    for (row = 0 ; row < n2 ; row++)
    {
	P [row] = EMPTY ;
    }

    unmatched = 0 ;
    best = EMPTY ;
    jdiff = EMPTY ;
    jdeg = EMPTY ;

    for (deg = mindeg ; deg <= maxdeg ; deg++)
    {
	/* find the next weak diagonal of lowest degree */
	DEBUGm2 (("---------------------------------- Deg: "ID"\n", deg)) ;
	for (k = Head [deg] ; k != EMPTY ; k = Next [k])
	{
	    DEBUGm2 (("k: "ID"\n", k)) ;
	    if (P [k] == EMPTY)
	    {
		/* C (k,k) is a weak diagonal entry.  Find an index j != k such
		 * that C (j,k) and C (k,j) are both strong, and also such
		 * that Degree [j] is minimized.  In case of a tie, pick
		 * the smallest index j.  C and R contain the pattern of
		 * strong entries only.
		 *
		 * Note that row k of R and column k of C are both sorted. */

		DEBUGm4 (("===== Weak diagonal k = "ID"\n", k)) ;
		DEBUG1 (("Column k of C:\n")) ;
		for (p = Cp [k] ; p < Cp [k+1] ; p++)
		{
		    DEBUG1 (("    "ID": deg "ID"\n", Ci [p], Degree [Ci [p]]));
		}
		DEBUG1 (("Row k of R (strong entries only):\n")) ;
		for (p = Rp [k] ; p < Rp [k+1] ; p++)
		{
		    DEBUG1 (("    "ID": deg "ID"\n", Ri [p], Degree [Ri [p]]));
		}

		/* no (C (k,j), C (j,k)) pair exists yet */
		j_best = EMPTY ;
		jdiff_best = Int_MAX ;
		jdeg_best = Int_MAX ;

		/* pointers into column k (including values) */
		cp1 = Cp [k] ;
		cp2 = Cp [k+1] ;
		cp = cp1 ;

		/* pointers into row k (strong entries only, no values) */
		rp1 = Rp [k] ;
		rp2 = Rp [k+1] ;
		rp = rp1 ;

		/* while entries searched in column k and row k */
		while (TRUE)
		{

		    if (cp >= cp2)
		    {
			/* no more entries in this column */
			break ;
		    }

		    /* get C (j,k), which is strong */
		    j = Ci [cp] ;

		    if (rp >= rp2)
		    {
			/* no more entries in this column */
			break ;
		    }

		    /* get R (k,j2), which is strong */
		    j2 = Ri [rp] ;

		    if (j < j2)
		    {
			/* C (j,k) is strong, but R (k,j) is not strong */
			cp++ ;
			continue ;
		    }

		    if (j2 < j)
		    {
			/* C (k,j2) is strong, but R (j2,k) is not strong */
			rp++ ;
			continue ;
		    }

		    /* j == j2: C (j,k) is strong and R (k,j) is strong */

		    best = FALSE ;

		    if (P [j] == EMPTY)
		    {
			/* j has not yet been matched */
			jdeg = Degree [j] ;
			jdiff = SCALAR_ABS (k-j) ;

			DEBUG1 (("Try candidate j "ID" deg "ID" diff "ID
				    "\n", j, jdeg, jdiff)) ;

			if (j_best == EMPTY)
			{
			    /* this is the first candidate seen */
			    DEBUG1 (("   first\n")) ;
			    best = TRUE ;
			}
			else
			{
			    if (jdeg < jdeg_best)
			    {
				/* the degree of j is best seen so far. */
				DEBUG1 (("   least degree\n")) ;
				best = TRUE ;
			    }
			    else if (jdeg == jdeg_best)
			    {
				/* degree of j and j_best are the same */
				/* tie break by nearest node number */
				if (jdiff < jdiff_best)
				{
				    DEBUG1 (("   tie degree, closer\n")) ;
				    best = TRUE ;
				}
				else if (jdiff == jdiff_best)
				{
				    /* |j-k| = |j_best-k|.  For any given k
				     * and j_best there is only one other j
				     * than can be just as close as j_best.
				     * Tie break by picking the smaller of
				     * j and j_best */
				    DEBUG1 (("   tie degree, as close\n"));
				    best = j < j_best ;
				}
			    }
			    else
			    {
				/* j has higher degree than best so far */
				best = FALSE ;
			    }
			}
		    }

		    if (best)
		    {
			/* j is best match for k */
			/* found a strong pair, A (j,k) and A (k,j) */
			DEBUG1 ((" --- Found pair k: "ID" j: " ID
			    " jdeg: "ID" jdiff: "ID"\n",
			    k, j, jdeg, jdiff)) ;
			ASSERT (jdiff != EMPTY) ;
			ASSERT (jdeg != EMPTY) ;
			j_best = j ;
			jdeg_best = jdeg ;
			jdiff_best = jdiff ;
		    }

		    /* get the next entries in column k and row k */
		    cp++ ;
		    rp++ ;
		}

		/* save the pair (j,k), if we found one */
		if (j_best != EMPTY)
		{
		    j = j_best ;
		    DEBUGm4 ((" --- best pair j: "ID" for k: "ID"\n", j, k)) ;
		    P [k] = j ;
		    P [j] = k ;
		}
		else
		{
		    /* no match was found for k */
		    unmatched++ ;
		}
	    }
	}
    }

    /* ---------------------------------------------------------------------- */
    /* finalize the row permutation, P */
    /* ---------------------------------------------------------------------- */

    for (k = 0 ; k < n2 ; k++)
    {
	if (P [k] == EMPTY)
	{
	    P [k] = k ;
	}
    }
    ASSERT (UMF_is_permutation (P, Rp, n2, n2)) ;

    return (unmatched) ;
}
示例#19
0
GLOBAL Int UMF_solve
(
    Int sys,
    const Int Ap [ ],
    const Int Ai [ ],
    const double Ax [ ],
    double Xx [ ],
    const double Bx [ ],
#ifdef COMPLEX
    const double Az [ ],
    double Xz [ ],
    const double Bz [ ],
#endif
    NumericType *Numeric,
    Int irstep,
    double Info [UMFPACK_INFO],
    Int Pattern [ ],		/* size n */
    double SolveWork [ ]	/* if irstep>0 real:  size 5*n.  complex:10*n */
				/* otherwise   real:  size   n.  complex: 4*n */
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Entry axx, wi, xj, zi, xi, aij, bi ;
    double omega [3], d, z2i, yi, flops ;
    Entry *W, *Z, *S, *X ;
    double *Z2, *Y, *B2, *Rs ;
    Int *Rperm, *Cperm, i, n, p, step, j, nz, status, p2, do_scale ;
#ifdef COMPLEX
    Int AXsplit ;
    Int Bsplit ;
#endif
#ifndef NRECIPROCAL
    Int do_recip = Numeric->do_recip ;
#endif

    /* ---------------------------------------------------------------------- */
    /* initializations */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    UMF_dump_lu (Numeric) ;
    ASSERT (Numeric && Xx && Bx && Pattern && SolveWork && Info) ;
#endif

    nz = 0 ;
    omega [0] = 0. ;
    omega [1] = 0. ;
    omega [2] = 0. ;
    Rperm = Numeric->Rperm ;
    Cperm = Numeric->Cperm ;
    Rs = Numeric->Rs ;		/* row scale factors */
    do_scale = (Rs != (double *) NULL) ;
    flops = 0 ;
    Info [UMFPACK_SOLVE_FLOPS] = 0 ;
    Info [UMFPACK_IR_TAKEN] = 0 ;
    Info [UMFPACK_IR_ATTEMPTED] = 0 ;

    /* UMFPACK_solve does not call this routine if A is rectangular */
    ASSERT (Numeric->n_row == Numeric->n_col) ;
    n = Numeric->n_row ;
    if (Numeric->nnzpiv < n
	|| SCALAR_IS_ZERO (Numeric->rcond) || SCALAR_IS_NAN (Numeric->rcond))
    {
	/* Note that systems involving just L return UMFPACK_OK, even if */
	/* A is singular (L is always has a unit diagonal). */
	DEBUGm4 (("Note, matrix is singular in umf_solve\n")) ;
	status = UMFPACK_WARNING_singular_matrix ;
	irstep = 0 ;
    }
    else
    {
	status = UMFPACK_OK ;
    }
    irstep = MAX (0, irstep) ;			/* make sure irstep is >= 0 */

    W = (Entry *) SolveWork ;			/* Entry W [0..n-1] */

    Z = (Entry *) NULL ;	/* unused if no iterative refinement */
    S = (Entry *) NULL ;
    Y = (double *) NULL ;
    Z2 = (double *) NULL ;
    B2 = (double *) NULL ;

#ifdef COMPLEX
    if (irstep > 0)
    {
	if (!Ap || !Ai || !Ax)
	{
	    return (UMFPACK_ERROR_argument_missing) ;
	}
	/* A, B, and X in split format if Az, Bz, and Xz present */
	AXsplit = SPLIT (Az) || SPLIT(Xz);
	Z = (Entry *) (SolveWork + 4*n) ;	/* Entry Z [0..n-1] */
	S = (Entry *) (SolveWork + 6*n) ;	/* Entry S [0..n-1] */
	Y = (double *) (SolveWork + 8*n) ;	/* double Y [0..n-1] */
	B2 = (double *) (SolveWork + 9*n) ;	/* double B2 [0..n-1] */
	Z2 = (double *) Z ;		/* double Z2 [0..n-1], equiv. to Z */
    }
    else
    {
      /* A is ignored, only  look at X for split/packed cases */
      AXsplit = SPLIT(Xz);
    }
    Bsplit = SPLIT (Bz);

    if (AXsplit)
    {
	X = (Entry *) (SolveWork + 2*n) ;	/* Entry X [0..n-1] */
    }
    else
    {
	X = (Entry *) Xx ;			/* Entry X [0..n-1] */
    }
#else
    X = (Entry *) Xx ;				/* Entry X [0..n-1] */
    if (irstep > 0)
    {
	if (!Ap || !Ai || !Ax)
	{
	    return (UMFPACK_ERROR_argument_missing) ;
	}
	Z = (Entry *) (SolveWork + n) ;		/* Entry Z [0..n-1] */
	S = (Entry *) (SolveWork + 2*n) ;	/* Entry S [0..n-1] */
	Y = (double *) (SolveWork + 3*n) ;	/* double Y [0..n-1] */
	B2 = (double *) (SolveWork + 4*n) ;	/* double B2 [0..n-1] */
	Z2 = (double *) Z ;		/* double Z2 [0..n-1], equiv. to Z */
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* determine which system to solve */
    /* ---------------------------------------------------------------------- */

    if (sys == UMFPACK_A)
    {

	/* ------------------------------------------------------------------ */
	/* solve A x = b with optional iterative refinement */
	/* ------------------------------------------------------------------ */

	if (irstep > 0)
	{

	    /* -------------------------------------------------------------- */
	    /* using iterative refinement:  compute Y and B2 */
	    /* -------------------------------------------------------------- */

	    nz = Ap [n] ;
	    Info [UMFPACK_NZ] = nz ;

	    /* A is stored by column */
	    /* Y (i) = ||R A_i||, 1-norm of row i of R A */
	    for (i = 0 ; i < n ; i++)
	    {
		Y [i] = 0. ;
	    }
	    flops += (ABS_FLOPS + 1) * nz ;
	    p2 = Ap [n] ;
	    for (p = 0 ; p < p2 ; p++)
	    {
		/* Y [Ai [p]] += ABS (Ax [p]) ; */
	        ASSIGN (aij, Ax, Az, p, AXsplit) ;
		ABS (d, aij) ;
		Y [Ai [p]] += d ;
	    }

	    /* B2 = abs (B) */
	    flops += ABS_FLOPS * n ;
	    for (i = 0 ; i < n ; i++)
	    {
		/* B2 [i] = ABS (B [i]) ; */
		ASSIGN (bi, Bx, Bz, i, Bsplit) ;
		ABS (B2 [i], bi) ;
	    }

	    /* scale Y and B2. */
	    if (do_scale)
	    {
		/* Y = R Y */
		/* B2 = R B2 */
#ifndef NRECIPROCAL
		if (do_recip)
		{
		    /* multiply by the scale factors */
		    for (i = 0 ; i < n ; i++)
		    {
			Y [i]  *= Rs [i] ;
			B2 [i] *= Rs [i] ;
		    }
		}
		else
#endif
		{
		    /* divide by the scale factors */
		    for (i = 0 ; i < n ; i++)
		    {
			Y [i]  /= Rs [i] ;
			B2 [i] /= Rs [i] ;
		    }
		}

		flops += 2 * n ;
	    }

	}

	for (step = 0 ; step <= irstep ; step++)
	{

	    /* -------------------------------------------------------------- */
	    /* Solve A x = b (step 0): */
	    /*  x = Q (U \ (L \ (P R b))) */
	    /* and then perform iterative refinement (step > 0): */
	    /*  x = x + Q (U \ (L \ (P R (b - A x)))) */
	    /* -------------------------------------------------------------- */

	    if (step == 0)
	    {
		if (do_scale)
		{
		    /* W = P R b, using X as workspace, since Z is not
		     * allocated if irstep = 0. */
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
			    SCALE (X [i], Rs [i]) ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
			    SCALE_DIV (X [i], Rs [i]) ;
			}
		    }
		    flops += SCALE_FLOPS * n ;
		    for (i = 0 ; i < n ; i++)
		    {
			W [i] = X [Rperm [i]] ;
		    }
		}
		else
		{
		    /* W = P b, since the row scaling R = I */
		    for (i = 0 ; i < n ; i++)
		    {
			/* W [i] = B [Rperm [i]] ; */
			ASSIGN (W [i], Bx, Bz, Rperm [i], Bsplit) ;
		    }
		}
	    }
	    else
	    {
		for (i = 0 ; i < n ; i++)
		{
		    /* Z [i] = B [i] ; */
		    ASSIGN (Z [i], Bx, Bz, i, Bsplit) ;
		}
		flops += MULTSUB_FLOPS * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    xi = X [i] ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* Z [Ai [p]] -= Ax [p] * xi ; */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			MULT_SUB (Z [Ai [p]], aij, xi) ;
		    }
		}
		/* scale, Z = R Z */
		if (do_scale)
		{
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE (Z [i], Rs [i]) ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE_DIV (Z [i], Rs [i]) ;
			}
		    }
		    flops += SCALE_FLOPS * n ;
		}
		for (i = 0 ; i < n ; i++)
		{
		    W [i] = Z [Rperm [i]] ;
		}
	    }

	    flops += UMF_lsolve (Numeric, W, Pattern) ;
	    flops += UMF_usolve (Numeric, W, Pattern) ;

	    if (step == 0)
	    {
		for (i = 0 ; i < n ; i++)
		{
		    X [Cperm [i]] = W [i] ;
		}
	    }
	    else
	    {
		flops += ASSEMBLE_FLOPS * n ;
		for (i = 0 ; i < n ; i++)
		{
		    /* X [Cperm [i]] += W [i] ; */
		    ASSEMBLE (X [Cperm [i]], W [i]) ;
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* sparse backward error estimate */
	    /* -------------------------------------------------------------- */

	    if (irstep > 0)
	    {

		/* ---------------------------------------------------------- */
		/* A is stored by column */
		/* W (i) = R (b - A x)_i, residual */
		/* Z2 (i) = R (|A||x|)_i */
		/* ---------------------------------------------------------- */

		for (i = 0 ; i < n ; i++)
		{
		    /* W [i] = B [i] ; */
		    ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
		    Z2 [i] = 0. ;
		}
		flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ;
		for (j = 0 ; j < n ; j++)
		{
		    xj = X [j] ;
		    p2 = Ap [j+1] ;
		    for (p = Ap [j] ; p < p2 ; p++)
		    {
			i = Ai [p] ;

			/* axx = Ax [p] * xj ; */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			MULT (axx, aij, xj) ;

			/* W [i] -= axx ; */
			DECREMENT (W [i], axx) ;

			/* Z2 [i] += ABS (axx) ; */
			ABS (d, axx) ;
			Z2 [i] += d ;
		    }
		}

		/* scale W and Z2 */
		if (do_scale)
		{
		    /* Z2 = R Z2 */
		    /* W = R W */
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE (W [i], Rs [i]) ;
			    Z2 [i] *= Rs [i] ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE_DIV (W [i], Rs [i]) ;
			    Z2 [i] /= Rs [i] ;
			}
		    }
		    flops += (SCALE_FLOPS + 1) * n ;
		}

		flops += (2*ABS_FLOPS + 5) * n ;
		if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info))
		{
		    /* iterative refinement is done */
		    break ;
		}

	    }

	}

    }
    else if (sys == UMFPACK_At)
    {

	/* ------------------------------------------------------------------ */
	/* solve A' x = b with optional iterative refinement */
	/* ------------------------------------------------------------------ */

	/* A' is the complex conjugate transpose */

	if (irstep > 0)
	{

	    /* -------------------------------------------------------------- */
	    /* using iterative refinement:  compute Y */
	    /* -------------------------------------------------------------- */

	    nz = Ap [n] ;
	    Info [UMFPACK_NZ] = nz ;

	    /* A' is stored by row */
	    /* Y (i) = ||(A' R)_i||, 1-norm of row i of A' R */

	    if (do_scale)
	    {
		flops += (ABS_FLOPS + 2) * nz ;
#ifndef NRECIPROCAL
		if (do_recip)
		{
		    /* multiply by the scale factors */
		    for (i = 0 ; i < n ; i++)
		    {
			yi = 0. ;
			p2 = Ap [i+1] ;
			for (p = Ap [i] ; p < p2 ; p++)
			{
			    /* yi += ABS (Ax [p]) * Rs [Ai [p]] ; */
			    /* note that abs (aij) is the same as
			     * abs (conj (aij)) */
			    ASSIGN (aij, Ax, Az, p, AXsplit) ;
			    ABS (d, aij) ;
			    yi += (d * Rs [Ai [p]]) ;
			}
			Y [i] = yi ;
		    }
		}
		else
#endif
		{
		    /* divide by the scale factors */
		    for (i = 0 ; i < n ; i++)
		    {
			yi = 0. ;
			p2 = Ap [i+1] ;
			for (p = Ap [i] ; p < p2 ; p++)
			{
			    /* yi += ABS (Ax [p]) / Rs [Ai [p]] ; */
			    /* note that abs (aij) is the same as
			     * abs (conj (aij)) */
			    ASSIGN (aij, Ax, Az, p, AXsplit) ;
			    ABS (d, aij) ;
			    yi += (d / Rs [Ai [p]]) ;
			}
			Y [i] = yi ;
		    }
		}
	    }
	    else
	    {
		/* no scaling */
		flops += (ABS_FLOPS + 1) * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    yi = 0. ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* yi += ABS (Ax [p]) ; */
			/* note that abs (aij) is the same as
			 * abs (conj (aij)) */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			ABS (d, aij) ;
			yi += d ;
		    }
		    Y [i] = yi ;
		}
	    }

	    /* B2 = abs (B) */
	    for (i = 0 ; i < n ; i++)
	    {
		/* B2 [i] = ABS (B [i]) ; */
		ASSIGN (bi, Bx, Bz, i, Bsplit) ;
		ABS (B2 [i], bi) ;
	    }

	}

	for (step = 0 ; step <= irstep ; step++)
	{

	    /* -------------------------------------------------------------- */
	    /* Solve A' x = b (step 0): */
	    /*	x = R P' (L' \ (U' \ (Q' b))) */
	    /* and then perform iterative refinement (step > 0): */
	    /*	x = x + R P' (L' \ (U' \ (Q' (b - A' x)))) */
	    /* -------------------------------------------------------------- */

	    if (step == 0)
	    {
		/* W = Q' b */
		for (i = 0 ; i < n ; i++)
		{
		    /* W [i] = B [Cperm [i]] ; */
		    ASSIGN (W [i], Bx, Bz, Cperm [i], Bsplit) ;
		}
	    }
	    else
	    {
		/* Z = b - A' x */
		for (i = 0 ; i < n ; i++)
		{
		    /* Z [i] = B [i] ; */
		    ASSIGN (Z [i], Bx, Bz, i, Bsplit) ;
		}
		flops += MULTSUB_FLOPS * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    zi = Z [i] ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* zi -= conjugate (Ax [p]) * X [Ai [p]] ; */
			ASSIGN (aij, Ax, Az, p, Bsplit) ;
			MULT_SUB_CONJ (zi, X [Ai [p]], aij) ;
		    }
		    Z [i] = zi ;
		}
		/* W = Q' Z */
		for (i = 0 ; i < n ; i++)
		{
		    W [i] = Z [Cperm [i]] ;
		}
	    }

	    flops += UMF_uhsolve (Numeric, W, Pattern) ;
	    flops += UMF_lhsolve (Numeric, W, Pattern) ;

	    if (step == 0)
	    {

		/* X = R P' W */
		/* do not use Z, since it isn't allocated if irstep = 0 */

		/* X = P' W */
		for (i = 0 ; i < n ; i++)
		{
		    X [Rperm [i]] = W [i] ;
		}
		if (do_scale)
		{
		    /* X = R X */
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE (X [i], Rs [i]) ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE_DIV (X [i], Rs [i]) ;
			}
		    }
		    flops += SCALE_FLOPS * n ;
		}

	    }
	    else
	    {

		/* Z = P' W */
		for (i = 0 ; i < n ; i++)
		{
		    Z [Rperm [i]] = W [i] ;
		}
		if (do_scale)
		{
		    /* Z = R Z */
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE (Z [i], Rs [i]) ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE_DIV (Z [i], Rs [i]) ;
			}
		    }
		    flops += SCALE_FLOPS * n ;
		}

		flops += ASSEMBLE_FLOPS * n ;
		/* X += Z */
		for (i = 0 ; i < n ; i++)
		{
		    /* X [i] += Z [i] ; was +=W[i] in v4.3, which is wrong */
		    ASSEMBLE (X [i], Z [i]) ;	/* bug fix, v4.3.1 */
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* sparse backward error estimate */
	    /* -------------------------------------------------------------- */

	    if (irstep > 0)
	    {

		/* ---------------------------------------------------------- */
		/* A' is stored by row */
		/* W (i) = (b - A' x)_i, residual */
		/* Z2 (i) = (|A'||x|)_i */
		/* ---------------------------------------------------------- */

		flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    /* wi = B [i] ; */
		    ASSIGN (wi, Bx, Bz, i, Bsplit) ;
		    z2i = 0. ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* axx = conjugate (Ax [p]) * X [Ai [p]] ; */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			MULT_CONJ (axx, X [Ai [p]], aij) ;

			/* wi -= axx ; */
			DECREMENT (wi, axx) ;

			/* z2i += ABS (axx) ; */
			ABS (d, axx) ;
			z2i += d ;
		    }
		    W [i] = wi ;
		    Z2 [i] = z2i ;
		}

		flops += (2*ABS_FLOPS + 5) * n ;
		if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info))
		{
		    /* iterative refinement is done */
		    break ;
		}

	    }

	}

    }
    else if (sys == UMFPACK_Aat)
    {

	/* ------------------------------------------------------------------ */
	/* solve A.' x = b with optional iterative refinement */
	/* ------------------------------------------------------------------ */

	/* A' is the array transpose */

	if (irstep > 0)
	{

	    /* -------------------------------------------------------------- */
	    /* using iterative refinement:  compute Y */
	    /* -------------------------------------------------------------- */

	    nz = Ap [n] ;
	    Info [UMFPACK_NZ] = nz ;

	    /* A.' is stored by row */
	    /* Y (i) = ||(A.' R)_i||, 1-norm of row i of A.' R */

	    if (do_scale)
	    {
		flops += (ABS_FLOPS + 2) * nz ;
#ifndef NRECIPROCAL
		if (do_recip)
		{
		    /* multiply by the scale factors */
		    for (i = 0 ; i < n ; i++)
		    {
			yi = 0. ;
			p2 = Ap [i+1] ;
			for (p = Ap [i] ; p < p2 ; p++)
			{
			    /* yi += ABS (Ax [p]) * Rs [Ai [p]] ; */
			    /* note that A.' is the array transpose,
			     * so no conjugate */
			    ASSIGN (aij, Ax, Az, p, AXsplit) ;
			    ABS (d, aij) ;
			    yi += (d * Rs [Ai [p]]) ;
			}
			Y [i] = yi ;
		    }
		}
		else
#endif
		{
		    /* divide by the scale factors */
		    for (i = 0 ; i < n ; i++)
		    {
			yi = 0. ;
			p2 = Ap [i+1] ;
			for (p = Ap [i] ; p < p2 ; p++)
			{
			    /* yi += ABS (Ax [p]) / Rs [Ai [p]] ; */
			    /* note that A.' is the array transpose,
			     * so no conjugate */
			    ASSIGN (aij, Ax, Az, p, AXsplit) ;
			    ABS (d, aij) ;
			    yi += (d / Rs [Ai [p]]) ;
			}
			Y [i] = yi ;
		    }
		}
	    }
	    else
	    {
		/* no scaling */
		flops += (ABS_FLOPS + 1) * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    yi = 0. ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* yi += ABS (Ax [p]) */
			/* note that A.' is the array transpose,
			 * so no conjugate */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			ABS (d, aij) ;
			yi += d ;
		    }
		    Y [i] = yi ;
		}
	    }

	    /* B2 = abs (B) */
	    for (i = 0 ; i < n ; i++)
	    {
		/* B2 [i] = ABS (B [i]) ; */
		ASSIGN (bi, Bx, Bz, i, Bsplit) ;
		ABS (B2 [i], bi) ;
	    }

	}

	for (step = 0 ; step <= irstep ; step++)
	{

	    /* -------------------------------------------------------------- */
	    /* Solve A.' x = b (step 0): */
	    /*	x = R P' (L.' \ (U.' \ (Q' b))) */
	    /* and then perform iterative refinement (step > 0): */
	    /*	x = x + R P' (L.' \ (U.' \ (Q' (b - A.' x)))) */
	    /* -------------------------------------------------------------- */

	    if (step == 0)
	    {
		/* W = Q' b */
		for (i = 0 ; i < n ; i++)
		{
		    /* W [i] = B [Cperm [i]] ; */
		    ASSIGN (W [i], Bx, Bz, Cperm [i], Bsplit) ;
		}
	    }
	    else
	    {
		/* Z = b - A.' x */
		for (i = 0 ; i < n ; i++)
		{
		    /* Z [i] = B [i] ; */
		    ASSIGN (Z [i], Bx, Bz, i, Bsplit) ;
		}
		flops += MULTSUB_FLOPS * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    zi = Z [i] ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* zi -= Ax [p] * X [Ai [p]] ; */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			MULT_SUB (zi, aij, X [Ai [p]]) ;
		    }
		    Z [i] = zi ;
		}
		/* W = Q' Z */
		for (i = 0 ; i < n ; i++)
		{
		    W [i] = Z [Cperm [i]] ;
		}
	    }

	    flops += UMF_utsolve (Numeric, W, Pattern) ;
	    flops += UMF_ltsolve (Numeric, W, Pattern) ;

	    if (step == 0)
	    {

		/* X = R P' W */
		/* do not use Z, since it isn't allocated if irstep = 0 */

		/* X = P' W */
		for (i = 0 ; i < n ; i++)
		{
		    X [Rperm [i]] = W [i] ;
		}
		if (do_scale)
		{
		    /* X = R X */
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE (X [i], Rs [i]) ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE_DIV (X [i], Rs [i]) ;
			}
		    }
		    flops += SCALE_FLOPS * n ;
		}

	    }
	    else
	    {

		/* Z = P' W */
		for (i = 0 ; i < n ; i++)
		{
		    Z [Rperm [i]] = W [i] ;
		}
		if (do_scale)
		{
		    /* Z = R Z */
#ifndef NRECIPROCAL
		    if (do_recip)
		    {
			/* multiply by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE (Z [i], Rs [i]) ;
			}
		    }
		    else
#endif
		    {
			/* divide by the scale factors */
			for (i = 0 ; i < n ; i++)
			{
			    SCALE_DIV (Z [i], Rs [i]) ;
			}
		    }
		    flops += SCALE_FLOPS * n ;
		}

		flops += ASSEMBLE_FLOPS * n ;
		/* X += Z */
		for (i = 0 ; i < n ; i++)
		{
		    /* X [i] += Z [i] ; was +=W[i] in v4.3, which is wrong */
		    ASSEMBLE (X [i], Z [i]) ;	/* bug fix, v4.3.1 */
		}
	    }

	    /* -------------------------------------------------------------- */
	    /* sparse backward error estimate */
	    /* -------------------------------------------------------------- */

	    if (irstep > 0)
	    {

		/* ---------------------------------------------------------- */
		/* A.' is stored by row */
		/* W (i) = (b - A.' x)_i, residual */
		/* Z (i) = (|A.'||x|)_i */
		/* ---------------------------------------------------------- */

		flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ;
		for (i = 0 ; i < n ; i++)
		{
		    /* wi = B [i] ; */
		    ASSIGN (wi, Bx, Bz, i, Bsplit) ;
		    z2i = 0. ;
		    p2 = Ap [i+1] ;
		    for (p = Ap [i] ; p < p2 ; p++)
		    {
			/* axx = Ax [p] * X [Ai [p]] ; */
			ASSIGN (aij, Ax, Az, p, AXsplit) ;
			MULT (axx, aij, X [Ai [p]]) ;

			/* wi -= axx ; */
			DECREMENT (wi, axx) ;

			/* z2i += ABS (axx) ; */
			ABS (d, axx) ;
			z2i += d ;
		    }
		    W [i] = wi ;
		    Z2 [i] = z2i ;
		}

		flops += (2*ABS_FLOPS + 5) * n ;
		if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info))
		{
		    /* iterative refinement is done */
		    break ;
		}

	    }

	}

    }
    else if (sys == UMFPACK_Pt_L)
    {

	/* ------------------------------------------------------------------ */
	/* Solve P'Lx=b:  x = L \ Pb */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [Rperm [i]] ; */
	    ASSIGN (X [i], Bx, Bz, Rperm [i], Bsplit) ;
	}
	flops = UMF_lsolve (Numeric, X, Pattern) ;
	status = UMFPACK_OK ;

    }
    else if (sys == UMFPACK_L)
    {

	/* ------------------------------------------------------------------ */
	/* Solve Lx=b:  x = L \ b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [i] ; */
	    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_lsolve (Numeric, X, Pattern) ;
	status = UMFPACK_OK ;

    }
    else if (sys == UMFPACK_Lt_P)
    {

	/* ------------------------------------------------------------------ */
	/* Solve L'Px=b:  x = P' (L' \ b) */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* W [i] = B [i] ; */
	    ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_lhsolve (Numeric, W, Pattern) ;
	for (i = 0 ; i < n ; i++)
	{
	    X [Rperm [i]] = W [i] ;
	}
	status = UMFPACK_OK ;

    }
    else if (sys == UMFPACK_Lat_P)
    {

	/* ------------------------------------------------------------------ */
	/* Solve L.'Px=b:  x = P' (L.' \ b) */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* W [i] = B [i] ; */
	    ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_ltsolve (Numeric, W, Pattern) ;
	for (i = 0 ; i < n ; i++)
	{
	    X [Rperm [i]] = W [i] ;
	}
	status = UMFPACK_OK ;

    }
    else if (sys == UMFPACK_Lt)
    {

	/* ------------------------------------------------------------------ */
	/* Solve L'x=b:  x = L' \ b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [i] ; */
	    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_lhsolve (Numeric, X, Pattern) ;
	status = UMFPACK_OK ;

    }
    else if (sys == UMFPACK_Lat)
    {

	/* ------------------------------------------------------------------ */
	/* Solve L.'x=b:  x = L.' \ b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [i] ; */
	    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_ltsolve (Numeric, X, Pattern) ;
	status = UMFPACK_OK ;

    }
    else if (sys == UMFPACK_U_Qt)
    {

	/* ------------------------------------------------------------------ */
	/* Solve UQ'x=b:  x = Q (U \ b) */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* W [i] = B [i] ; */
	    ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_usolve (Numeric, W, Pattern) ;
	for (i = 0 ; i < n ; i++)
	{
	    X [Cperm [i]] = W [i] ;
	}

    }
    else if (sys == UMFPACK_U)
    {

	/* ------------------------------------------------------------------ */
	/* Solve Ux=b:  x = U \ b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [i] ; */
	    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_usolve (Numeric, X, Pattern) ;

    }
    else if (sys == UMFPACK_Q_Ut)
    {

	/* ------------------------------------------------------------------ */
	/* Solve QU'x=b:  x = U' \ Q'b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [Cperm [i]] ; */
	    ASSIGN (X [i], Bx, Bz, Cperm [i], Bsplit) ;
	}
	flops = UMF_uhsolve (Numeric, X, Pattern) ;

    }
    else if (sys == UMFPACK_Q_Uat)
    {

	/* ------------------------------------------------------------------ */
	/* Solve QU.'x=b:  x = U.' \ Q'b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [Cperm [i]] ; */
	    ASSIGN (X [i], Bx, Bz, Cperm [i], Bsplit) ;
	}
	flops = UMF_utsolve (Numeric, X, Pattern) ;

    }
    else if (sys == UMFPACK_Ut)
    {

	/* ------------------------------------------------------------------ */
	/* Solve U'x=b:  x = U' \ b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [i] ; */
	  ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_uhsolve (Numeric, X, Pattern) ;

    }
    else if (sys == UMFPACK_Uat)
    {

	/* ------------------------------------------------------------------ */
	/* Solve U'x=b:  x = U' \ b */
	/* ------------------------------------------------------------------ */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] = B [i] ; */
	    ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
	}
	flops = UMF_utsolve (Numeric, X, Pattern) ;

    }
    else
    {
	return (UMFPACK_ERROR_invalid_system) ;
    }

#ifdef COMPLEX
    /* copy the solution back, from Entry X [ ] to double Xx [ ] and Xz [ ] */
    if (AXsplit)
    {
	for (i = 0 ; i < n ; i++)
	{
	    Xx [i] = REAL_COMPONENT (X [i]) ;
	    Xz [i] = IMAG_COMPONENT (X [i]) ;
	}
    }
#endif

    /* return UMFPACK_OK, or UMFPACK_WARNING_singular_matrix */
    /* Note that systems involving just L will return UMFPACK_OK */
    Info [UMFPACK_SOLVE_FLOPS] = flops ;
    return (status) ;
}