Exemplo n.º 1
0
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
}
Exemplo n.º 2
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) ;
}
Exemplo n.º 3
0
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) ;
}
Exemplo n.º 4
0
GLOBAL void UMF_scale
(
    Int n,
    Entry pivot,
    Entry X [ ]
)
{
    Entry x ;
    double s ;
    Int i ;

    /* ---------------------------------------------------------------------- */
    /* compute the approximate absolute value of the pivot, and select method */
    /* ---------------------------------------------------------------------- */

    APPROX_ABS (s, pivot) ;

    if (s < RECIPROCAL_TOLERANCE || IS_NAN (pivot))
    {
	/* ------------------------------------------------------------------ */
	/* tiny, or zero, pivot case */
	/* ------------------------------------------------------------------ */

	/* The pivot is tiny, or NaN.  Do not divide zero by the pivot value,
	 * and do not multiply by 1/pivot, either. */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] /= pivot ; */
	    x = X [i] ;

#ifndef NO_DIVIDE_BY_ZERO
	    if (IS_NONZERO (x))
	    {
		DIV (X [i], x, pivot) ;
	    }
#else
	    /* Do not divide by zero */
	    if (IS_NONZERO (x) && IS_NONZERO (pivot))
	    {
		DIV (X [i], x, pivot) ;
	    }
#endif

	}

    }
    else
    {

	/* ------------------------------------------------------------------ */
	/* normal case */
	/* ------------------------------------------------------------------ */

	/* The pivot is not tiny, and is not NaN.   Don't bother to check for
	 * zeros in the pivot column, X.  This is slightly more accurate than
	 * multiplying by 1/pivot (but slightly slower), particularly if the
	 * pivot column consists of only IEEE subnormals. */

	for (i = 0 ; i < n ; i++)
	{
	    /* X [i] /= pivot ; */
	    x = X [i] ;
	    DIV (X [i], x, pivot) ;
	}
    }
}