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
}
GLOBAL Int UMF_get_memory
(
NumericType *Numeric,
WorkType *Work,
Int needunits,
Int r2, /* compact current front to r2-by-c2 */
Int c2,
Int do_Fcpos
)
{
double nsize, bsize, tsize ;
Int i, minsize, newsize, newmem, costly, row, col, *Row_tlen, *Col_tlen,
n_row, n_col, *Row_degree, *Col_degree ;
Unit *mnew, *p ;
/* ---------------------------------------------------------------------- */
/* get and check parameters */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG1 (("::::GET MEMORY::::\n")) ;
UMF_dump_memory (Numeric) ;
#endif
n_row = Work->n_row ;
n_col = Work->n_col ;
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_tlen = Numeric->Uilen ;
Col_tlen = Numeric->Lilen ;
/* ---------------------------------------------------------------------- */
/* initialize the tuple list lengths */
/* ---------------------------------------------------------------------- */
for (row = 0 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row))
{
Row_tlen [row] = 0 ;
}
}
for (col = 0 ; col < n_col ; col++)
{
if (NON_PIVOTAL_COL (col))
{
Col_tlen [col] = 0 ;
}
}
/* ---------------------------------------------------------------------- */
/* determine how much memory is needed for the tuples */
/* ---------------------------------------------------------------------- */
nsize = (double) needunits + 2 ;
needunits += UMF_tuple_lengths (Numeric, Work, &tsize) ;
nsize += tsize ;
needunits += 2 ; /* add 2, so that newmem >= 2 is true if realloc'd */
/* note: Col_tlen and Row_tlen are updated, but the tuple lists */
/* themselves are not. Do not attempt to scan the tuple lists. */
/* They are now stale, and are about to be destroyed and recreated. */
/* ---------------------------------------------------------------------- */
/* determine the desired new size of memory */
/* ---------------------------------------------------------------------- */
DEBUG0 (("UMF_get_memory: needunits: "ID"\n", needunits)) ;
minsize = Numeric->size + needunits ;
nsize += (double) Numeric->size ;
bsize = ((double) Int_MAX) / sizeof (Unit) - 1 ;
newsize = (Int) (UMF_REALLOC_INCREASE * ((double) minsize)) ;
nsize *= UMF_REALLOC_INCREASE ;
nsize += 1 ;
if (newsize < 0 || nsize > bsize)
{
/* :: realloc Numeric->Memory int overflow :: */
DEBUGm3 (("Realloc hit integer limit\n")) ;
newsize = (Int) bsize ; /* we cannot increase the size beyond bsize */
}
else
{
ASSERT (newsize <= nsize) ;
newsize = MAX (newsize, minsize) ;
}
newsize = MAX (newsize, Numeric->size) ;
DEBUG0 ((
"REALLOC MEMORY: needunits "ID" old size: "ID" new size: "ID" Units \n",
needunits, Numeric->size, newsize)) ;
/* Forget where the biggest free block is (we no longer need it) */
/* since garbage collection will occur shortly. */
Numeric->ibig = EMPTY ;
DEBUG0 (("Before realloc E [0] "ID"\n", Work->E [0])) ;
/* ---------------------------------------------------------------------- */
/* reallocate the memory, if possible, and make it bigger */
/* ---------------------------------------------------------------------- */
mnew = (Unit *) NULL ;
while (!mnew)
{
mnew = (Unit *) UMF_realloc (Numeric->Memory, newsize, sizeof (Unit)) ;
if (!mnew)
{
if (newsize == minsize) /* last realloc attempt failed */
{
/* We failed to get the minimum. Just stick with the */
/* current allocation and hope that garbage collection */
/* can recover enough space. */
mnew = Numeric->Memory ; /* no new memory available */
newsize = Numeric->size ;
}
else
{
/* otherwise, reduce the request and keep trying */
newsize = (Int) (UMF_REALLOC_REDUCTION * ((double) newsize)) ;
newsize = MAX (minsize, newsize) ;
}
}
}
ASSERT (mnew != (Unit *) NULL) ;
/* see if realloc had to copy, rather than just extend memory */
costly = (mnew != Numeric->Memory) ;
/* ---------------------------------------------------------------------- */
/* extend the tail portion of memory downwards */
/* ---------------------------------------------------------------------- */
Numeric->Memory = mnew ;
if (Work->E [0])
{
Int nb, dr, dc ;
nb = Work->nb ;
dr = Work->fnr_curr ;
dc = Work->fnc_curr ;
Work->Flublock = (Entry *) (Numeric->Memory + Work->E [0]) ;
Work->Flblock = Work->Flublock + nb * nb ;
Work->Fublock = Work->Flblock + dr * nb ;
Work->Fcblock = Work->Fublock + nb * dc ;
DEBUG0 (("after realloc E [0] "ID"\n", Work->E [0])) ;
}
ASSERT (IMPLIES (!(Work->E [0]), Work->Flublock == (Entry *) NULL)) ;
newmem = newsize - Numeric->size ;
ASSERT (newmem == 0 || newmem >= 2) ;
if (newmem >= 2)
{
/* reallocation succeeded */
/* point to the old tail marker block of size 1 + header */
p = Numeric->Memory + Numeric->size - 2 ;
/* create a new block out of the newly extended memory */
p->header.size = newmem - 1 ;
i = Numeric->size - 1 ;
p += newmem ;
/* create a new tail marker block */
p->header.prevsize = newmem - 1 ;
p->header.size = 1 ;
Numeric->size = newsize ;
/* free the new block */
UMF_mem_free_tail_block (Numeric, i) ;
Numeric->nrealloc++ ;
if (costly)
{
Numeric->ncostly++ ;
}
}
DEBUG1 (("Done with realloc memory\n")) ;
/* ---------------------------------------------------------------------- */
/* garbage collection on the tail of Numeric->memory (destroys tuples) */
/* ---------------------------------------------------------------------- */
UMF_garbage_collection (Numeric, Work, r2, c2, do_Fcpos) ;
/* ---------------------------------------------------------------------- */
/* rebuild the tuples */
/* ---------------------------------------------------------------------- */
return (UMF_build_tuples (Numeric, Work)) ;
}
GLOBAL void UMF_kernel_wrapup
(
NumericType *Numeric,
SymbolicType *Symbolic,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry pivot_value ;
double d ;
Entry *D ;
Int i, k, col, row, llen, ulen, *ip, *Rperm, *Cperm, *Lilen, npiv, lp,
*Uilen, *Lip, *Uip, *Cperm_init, up, pivrow, pivcol, *Lpos, *Upos, *Wr,
*Wc, *Wp, *Frpos, *Fcpos, *Row_degree, *Col_degree, *Rperm_init,
n_row, n_col, n_inner, zero_pivot, nan_pivot, n1 ;
#ifndef NDEBUG
UMF_dump_matrix (Numeric, Work, FALSE) ;
#endif
DEBUG0 (("Kernel complete, Starting Kernel wrapup\n")) ;
n_row = Symbolic->n_row ;
n_col = Symbolic->n_col ;
n_inner = MIN (n_row, n_col) ;
Rperm = Numeric->Rperm ;
Cperm = Numeric->Cperm ;
Lilen = Numeric->Lilen ;
Uilen = Numeric->Uilen ;
Upos = Numeric->Upos ;
Lpos = Numeric->Lpos ;
Lip = Numeric->Lip ;
Uip = Numeric->Uip ;
D = Numeric->D ;
npiv = Work->npiv ;
Numeric->npiv = npiv ;
Numeric->ulen = Work->ulen ;
ASSERT (n_row == Numeric->n_row) ;
ASSERT (n_col == Symbolic->n_col) ;
DEBUG0 (("Wrap-up: npiv "ID" ulen "ID"\n", npiv, Numeric->ulen)) ;
ASSERT (npiv <= n_inner) ;
/* this will be nonzero only if matrix is singular or rectangular */
ASSERT (IMPLIES (npiv == n_col, Work->ulen == 0)) ;
/* ---------------------------------------------------------------------- */
/* find the smallest and largest entries in D */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < npiv ; k++)
{
pivot_value = D [k] ;
ABS (d, pivot_value) ;
zero_pivot = SCALAR_IS_ZERO (d) ;
nan_pivot = SCALAR_IS_NAN (d) ;
if (!zero_pivot)
{
/* the pivot is nonzero, but might be Inf or NaN */
Numeric->nnzpiv++ ;
}
if (k == 0)
{
Numeric->min_udiag = d ;
Numeric->max_udiag = d ;
}
else
{
/* min (abs (diag (U))) behaves as follows: If any entry is zero,
then the result is zero (regardless of the presence of NaN's).
Otherwise, if any entry is NaN, then the result is NaN.
Otherwise, the result is the smallest absolute value on the
diagonal of U.
*/
if (SCALAR_IS_NONZERO (Numeric->min_udiag))
{
if (zero_pivot || nan_pivot)
{
Numeric->min_udiag = d ;
}
else if (!SCALAR_IS_NAN (Numeric->min_udiag))
{
/* d and min_udiag are both non-NaN */
Numeric->min_udiag = MIN (Numeric->min_udiag, d) ;
}
}
/*
max (abs (diag (U))) behaves as follows: If any entry is NaN
then the result is NaN. Otherise, the result is the largest
absolute value on the diagonal of U.
*/
if (nan_pivot)
{
Numeric->max_udiag = d ;
}
else if (!SCALAR_IS_NAN (Numeric->max_udiag))
{
/* d and max_udiag are both non-NaN */
Numeric->max_udiag = MAX (Numeric->max_udiag, d) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* check if matrix is singular or rectangular */
/* ---------------------------------------------------------------------- */
Col_degree = Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Rperm ; /* for NON_PIVOTAL_ROW macro */
if (npiv < n_row)
{
/* finalize the row permutation */
k = npiv ;
DEBUGm3 (("Singular pivot rows "ID" to "ID"\n", k, n_row-1)) ;
for (row = 0 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row))
{
Rperm [row] = ONES_COMPLEMENT (k) ;
DEBUGm3 (("Singular row "ID" is k: "ID" pivot row\n", row, k)) ;
ASSERT (!NON_PIVOTAL_ROW (row)) ;
Lpos [row] = EMPTY ;
Uip [row] = EMPTY ;
Uilen [row] = 0 ;
k++ ;
}
}
ASSERT (k == n_row) ;
}
if (npiv < n_col)
{
/* finalize the col permutation */
k = npiv ;
DEBUGm3 (("Singular pivot cols "ID" to "ID"\n", k, n_col-1)) ;
for (col = 0 ; col < n_col ; col++)
{
if (NON_PIVOTAL_COL (col))
{
Cperm [col] = ONES_COMPLEMENT (k) ;
DEBUGm3 (("Singular col "ID" is k: "ID" pivot row\n", col, k)) ;
ASSERT (!NON_PIVOTAL_COL (col)) ;
Upos [col] = EMPTY ;
Lip [col] = EMPTY ;
Lilen [col] = 0 ;
k++ ;
}
}
ASSERT (k == n_col) ;
}
if (npiv < n_inner)
{
/* finalize the diagonal of U */
DEBUGm3 (("Diag of U is zero, "ID" to "ID"\n", npiv, n_inner-1)) ;
for (k = npiv ; k < n_inner ; k++)
{
CLEAR (D [k]) ;
}
}
/* save the pattern of the last row of U */
if (Numeric->ulen > 0)
{
DEBUGm3 (("Last row of U is not empty\n")) ;
Numeric->Upattern = Work->Upattern ;
Work->Upattern = (Int *) NULL ;
}
DEBUG2 (("Nnzpiv: "ID" npiv "ID"\n", Numeric->nnzpiv, npiv)) ;
ASSERT (Numeric->nnzpiv <= npiv) ;
if (Numeric->nnzpiv < n_inner && !SCALAR_IS_NAN (Numeric->min_udiag))
{
/* the rest of the diagonal is zero, so min_udiag becomes 0,
* unless it is already NaN. */
Numeric->min_udiag = 0.0 ;
}
/* ---------------------------------------------------------------------- */
/* size n_row, n_col workspaces that can be used here: */
/* ---------------------------------------------------------------------- */
Frpos = Work->Frpos ; /* of size n_row+1 */
Fcpos = Work->Fcpos ; /* of size n_col+1 */
Wp = Work->Wp ; /* of size MAX(n_row,n_col)+1 */
/* Work->Upattern ; cannot be used (in Numeric) */
Wr = Work->Lpattern ; /* of size n_row+1 */
Wc = Work->Wrp ; /* of size n_col+1 or bigger */
/* ---------------------------------------------------------------------- */
/* construct Rperm from inverse permutations */
/* ---------------------------------------------------------------------- */
/* use Frpos for temporary copy of inverse row permutation [ */
for (pivrow = 0 ; pivrow < n_row ; pivrow++)
{
k = Rperm [pivrow] ;
ASSERT (k < 0) ;
k = ONES_COMPLEMENT (k) ;
ASSERT (k >= 0 && k < n_row) ;
Wp [k] = pivrow ;
Frpos [pivrow] = k ;
}
for (k = 0 ; k < n_row ; k++)
{
Rperm [k] = Wp [k] ;
}
/* ---------------------------------------------------------------------- */
/* construct Cperm from inverse permutation */
/* ---------------------------------------------------------------------- */
/* use Fcpos for temporary copy of inverse column permutation [ */
for (pivcol = 0 ; pivcol < n_col ; pivcol++)
{
k = Cperm [pivcol] ;
ASSERT (k < 0) ;
k = ONES_COMPLEMENT (k) ;
ASSERT (k >= 0 && k < n_col) ;
Wp [k] = pivcol ;
/* save a copy of the inverse column permutation in Fcpos */
Fcpos [pivcol] = k ;
}
for (k = 0 ; k < n_col ; k++)
{
Cperm [k] = Wp [k] ;
}
#ifndef NDEBUG
for (k = 0 ; k < n_col ; k++)
{
col = Cperm [k] ;
ASSERT (col >= 0 && col < n_col) ;
ASSERT (Fcpos [col] == k) ; /* col is the kth pivot */
}
for (k = 0 ; k < n_row ; k++)
{
row = Rperm [k] ;
ASSERT (row >= 0 && row < n_row) ;
ASSERT (Frpos [row] == k) ; /* row is the kth pivot */
}
#endif
#ifndef NDEBUG
UMF_dump_lu (Numeric) ;
#endif
/* ---------------------------------------------------------------------- */
/* permute Lpos, Upos, Lilen, Lip, Uilen, and Uip */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < npiv ; k++)
{
pivrow = Rperm [k] ;
Wr [k] = Uilen [pivrow] ;
Wp [k] = Uip [pivrow] ;
}
for (k = 0 ; k < npiv ; k++)
{
Uilen [k] = Wr [k] ;
Uip [k] = Wp [k] ;
}
for (k = 0 ; k < npiv ; k++)
{
pivrow = Rperm [k] ;
Wp [k] = Lpos [pivrow] ;
}
for (k = 0 ; k < npiv ; k++)
{
Lpos [k] = Wp [k] ;
}
for (k = 0 ; k < npiv ; k++)
{
pivcol = Cperm [k] ;
Wc [k] = Lilen [pivcol] ;
Wp [k] = Lip [pivcol] ;
}
for (k = 0 ; k < npiv ; k++)
{
Lilen [k] = Wc [k] ;
Lip [k] = Wp [k] ;
}
for (k = 0 ; k < npiv ; k++)
{
pivcol = Cperm [k] ;
Wp [k] = Upos [pivcol] ;
}
for (k = 0 ; k < npiv ; k++)
{
Upos [k] = Wp [k] ;
}
/* ---------------------------------------------------------------------- */
/* terminate the last Uchain and last Lchain */
/* ---------------------------------------------------------------------- */
Upos [npiv] = EMPTY ;
Lpos [npiv] = EMPTY ;
Uip [npiv] = EMPTY ;
Lip [npiv] = EMPTY ;
Uilen [npiv] = 0 ;
Lilen [npiv] = 0 ;
/* ---------------------------------------------------------------------- */
/* convert U to the new pivot order */
/* ---------------------------------------------------------------------- */
n1 = Symbolic->n1 ;
for (k = 0 ; k < n1 ; k++)
{
/* this is a singleton row of U */
ulen = Uilen [k] ;
DEBUG4 (("K "ID" New U. ulen "ID" Singleton 1\n", k, ulen)) ;
if (ulen > 0)
{
up = Uip [k] ;
ip = (Int *) (Numeric->Memory + up) ;
for (i = 0 ; i < ulen ; i++)
{
col = *ip ;
DEBUG4 ((" old col "ID" new col "ID"\n", col, Fcpos [col]));
ASSERT (col >= 0 && col < n_col) ;
*ip++ = Fcpos [col] ;
}
}
}
for (k = n1 ; k < npiv ; k++)
{
up = Uip [k] ;
if (up < 0)
{
/* this is the start of a new Uchain (with a pattern) */
ulen = Uilen [k] ;
DEBUG4 (("K "ID" New U. ulen "ID" End_Uchain 1\n", k, ulen)) ;
if (ulen > 0)
{
up = -up ;
ip = (Int *) (Numeric->Memory + up) ;
for (i = 0 ; i < ulen ; i++)
{
col = *ip ;
DEBUG4 ((" old col "ID" new col "ID"\n", col, Fcpos [col]));
ASSERT (col >= 0 && col < n_col) ;
*ip++ = Fcpos [col] ;
}
}
}
}
ulen = Numeric->ulen ;
if (ulen > 0)
{
/* convert last pivot row of U to the new pivot order */
DEBUG4 (("K "ID" (last)\n", k)) ;
for (i = 0 ; i < ulen ; i++)
{
col = Numeric->Upattern [i] ;
DEBUG4 ((" old col "ID" new col "ID"\n", col, Fcpos [col])) ;
Numeric->Upattern [i] = Fcpos [col] ;
}
}
/* Fcpos no longer needed ] */
/* ---------------------------------------------------------------------- */
/* convert L to the new pivot order */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n1 ; k++)
{
llen = Lilen [k] ;
DEBUG4 (("K "ID" New L. llen "ID" Singleton col\n", k, llen)) ;
if (llen > 0)
{
lp = Lip [k] ;
ip = (Int *) (Numeric->Memory + lp) ;
for (i = 0 ; i < llen ; i++)
{
row = *ip ;
DEBUG4 ((" old row "ID" new row "ID"\n", row, Frpos [row])) ;
ASSERT (row >= 0 && row < n_row) ;
*ip++ = Frpos [row] ;
}
}
}
for (k = n1 ; k < npiv ; k++)
{
llen = Lilen [k] ;
DEBUG4 (("K "ID" New L. llen "ID" \n", k, llen)) ;
if (llen > 0)
{
lp = Lip [k] ;
if (lp < 0)
{
/* this starts a new Lchain */
lp = -lp ;
}
ip = (Int *) (Numeric->Memory + lp) ;
for (i = 0 ; i < llen ; i++)
{
row = *ip ;
DEBUG4 ((" old row "ID" new row "ID"\n", row, Frpos [row])) ;
ASSERT (row >= 0 && row < n_row) ;
*ip++ = Frpos [row] ;
}
}
}
/* Frpos no longer needed ] */
/* ---------------------------------------------------------------------- */
/* combine symbolic and numeric permutations */
/* ---------------------------------------------------------------------- */
Cperm_init = Symbolic->Cperm_init ;
Rperm_init = Symbolic->Rperm_init ;
for (k = 0 ; k < n_row ; k++)
{
Rperm [k] = Rperm_init [Rperm [k]] ;
}
for (k = 0 ; k < n_col ; k++)
{
Cperm [k] = Cperm_init [Cperm [k]] ;
}
/* Work object will be freed immediately upon return (to UMF_kernel */
/* and then to UMFPACK_numeric). */
}
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 UMF_grow_front
(
NumericType *Numeric,
Int fnr2, /* desired size is fnr2-by-fnc2 */
Int fnc2,
WorkType *Work,
Int do_what /* -1: UMF_start_front
* 0: UMF_init_front, do not recompute Fcpos
* 1: UMF_extend_front
* 2: UMF_init_front, recompute Fcpos */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double s ;
Entry *Fcold, *Fcnew ;
Int j, i, col, *Fcpos, *Fcols, fnrows_max, fncols_max, fnr_curr, nb,
fnrows_new, fncols_new, fnr_min, fnc_min, minsize,
newsize, fnrows, fncols, *E, eloc ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
if (do_what != -1) UMF_debug++ ;
DEBUG0 (("\n\n====================GROW FRONT: do_what: "ID"\n", do_what)) ;
if (do_what != -1) UMF_debug-- ;
ASSERT (Work->do_grow) ;
ASSERT (Work->fnpiv == 0) ;
#endif
Fcols = Work->Fcols ;
Fcpos = Work->Fcpos ;
E = Work->E ;
/* ---------------------------------------------------------------------- */
/* The current front is too small, find the new size */
/* ---------------------------------------------------------------------- */
/* maximum size of frontal matrix for this chain */
nb = Work->nb ;
fnrows_max = Work->fnrows_max + nb ;
fncols_max = Work->fncols_max + nb ;
ASSERT (fnrows_max >= 0 && (fnrows_max % 2) == 1) ;
DEBUG0 (("Max size: "ID"-by-"ID" (incl. "ID" pivot block\n",
fnrows_max, fncols_max, nb)) ;
/* current dimensions of frontal matrix: fnr-by-fnc */
DEBUG0 (("Current : "ID"-by-"ID" (excl "ID" pivot blocks)\n",
Work->fnr_curr, Work->fnc_curr, nb)) ;
ASSERT (Work->fnr_curr >= 0) ;
ASSERT ((Work->fnr_curr % 2 == 1) || Work->fnr_curr == 0) ;
/* required dimensions of frontal matrix: fnr_min-by-fnc_min */
fnrows_new = Work->fnrows_new + 1 ;
fncols_new = Work->fncols_new + 1 ;
ASSERT (fnrows_new >= 0) ;
if (fnrows_new % 2 == 0) fnrows_new++ ;
fnrows_new += nb ;
fncols_new += nb ;
fnr_min = MIN (fnrows_new, fnrows_max) ;
fnc_min = MIN (fncols_new, fncols_max) ;
minsize = fnr_min * fnc_min ;
if (INT_OVERFLOW ((double) fnr_min * (double) fnc_min * sizeof (Entry)))
{
/* :: the minimum front size is bigger than the integer maximum :: */
return (FALSE) ;
}
ASSERT (fnr_min >= 0) ;
ASSERT (fnr_min % 2 == 1) ;
DEBUG0 (("Min : "ID"-by-"ID"\n", fnr_min, fnc_min)) ;
/* grow the front to fnr2-by-fnc2, but no bigger than the maximum,
* and no smaller than the minumum. */
DEBUG0 (("Desired : ("ID"+"ID")-by-("ID"+"ID")\n", fnr2, nb, fnc2, nb)) ;
fnr2 += nb ;
fnc2 += nb ;
ASSERT (fnr2 >= 0) ;
if (fnr2 % 2 == 0) fnr2++ ;
fnr2 = MAX (fnr2, fnr_min) ;
fnc2 = MAX (fnc2, fnc_min) ;
fnr2 = MIN (fnr2, fnrows_max) ;
fnc2 = MIN (fnc2, fncols_max) ;
DEBUG0 (("Try : "ID"-by-"ID"\n", fnr2, fnc2)) ;
ASSERT (fnr2 >= 0) ;
ASSERT (fnr2 % 2 == 1) ;
s = ((double) fnr2) * ((double) fnc2) ;
if (INT_OVERFLOW (s * sizeof (Entry)))
{
/* :: frontal matrix size int overflow :: */
/* the desired front size is bigger than the integer maximum */
/* compute a such that a*a*s < Int_MAX / sizeof (Entry) */
double a = 0.9 * sqrt ((Int_MAX / sizeof (Entry)) / s) ;
fnr2 = MAX (fnr_min, a * fnr2) ;
fnc2 = MAX (fnc_min, a * fnc2) ;
/* the new frontal size is a*r*a*c = a*a*s */
newsize = fnr2 * fnc2 ;
ASSERT (fnr2 >= 0) ;
if (fnr2 % 2 == 0) fnr2++ ;
fnc2 = newsize / fnr2 ;
}
fnr2 = MAX (fnr2, fnr_min) ;
fnc2 = MAX (fnc2, fnc_min) ;
newsize = fnr2 * fnc2 ;
ASSERT (fnr2 >= 0) ;
ASSERT (fnr2 % 2 == 1) ;
ASSERT (fnr2 >= fnr_min) ;
ASSERT (fnc2 >= fnc_min) ;
ASSERT (newsize >= minsize) ;
/* ---------------------------------------------------------------------- */
/* free the current front if it is empty of any numerical values */
/* ---------------------------------------------------------------------- */
if (E [0] && do_what != 1)
{
/* free the current front, if it exists and has nothing in it */
DEBUG0 (("Freeing empty front\n")) ;
UMF_mem_free_tail_block (Numeric, E [0]) ;
E [0] = 0 ;
Work->Flublock = (Entry *) NULL ;
Work->Flblock = (Entry *) NULL ;
Work->Fublock = (Entry *) NULL ;
Work->Fcblock = (Entry *) NULL ;
}
/* ---------------------------------------------------------------------- */
/* allocate the new front, doing garbage collection if necessary */
/* ---------------------------------------------------------------------- */
#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 garbage collection (grow)\n")) ;
}
#endif
DEBUG0 (("Attempt size: "ID"-by-"ID"\n", fnr2, fnc2)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
if (!eloc)
{
/* Do garbage collection, realloc, and try again. Compact the current
* contribution block in the front to fnrows-by-fncols. Note that
* there are no pivot rows/columns in current front. Do not recompute
* Fcpos in UMF_garbage_collection. */
DEBUGm3 (("get_memory from umf_grow_front\n")) ;
if (!UMF_get_memory (Numeric, Work, 1 + UNITS (Entry, newsize),
Work->fnrows, Work->fncols, FALSE))
{
/* :: out of memory in umf_grow_front :: */
return (FALSE) ; /* out of memory */
}
DEBUG0 (("Attempt size: "ID"-by-"ID" again\n", fnr2, fnc2)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
}
/* try again with something smaller */
while ((fnr2 != fnr_min || fnc2 != fnc_min) && !eloc)
{
fnr2 = MIN (fnr2 - 2, fnr2 * UMF_REALLOC_REDUCTION) ;
fnc2 = MIN (fnc2 - 2, fnc2 * UMF_REALLOC_REDUCTION) ;
ASSERT (fnr_min >= 0) ;
ASSERT (fnr_min % 2 == 1) ;
fnr2 = MAX (fnr_min, fnr2) ;
fnc2 = MAX (fnc_min, fnc2) ;
ASSERT (fnr2 >= 0) ;
if (fnr2 % 2 == 0) fnr2++ ;
newsize = fnr2 * fnc2 ;
DEBUGm3 (("Attempt smaller size: "ID"-by-"ID" minsize "ID"-by-"ID"\n",
fnr2, fnc2, fnr_min, fnc_min)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
}
/* try again with the smallest possible size */
if (!eloc)
{
fnr2 = fnr_min ;
fnc2 = fnc_min ;
newsize = minsize ;
DEBUG0 (("Attempt minsize: "ID"-by-"ID"\n", fnr2, fnc2)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
}
if (!eloc)
{
/* out of memory */
return (FALSE) ;
}
ASSERT (fnr2 >= 0) ;
ASSERT (fnr2 % 2 == 1) ;
ASSERT (fnr2 >= fnr_min && fnc2 >= fnc_min) ;
/* ---------------------------------------------------------------------- */
/* copy the old frontal matrix into the new one */
/* ---------------------------------------------------------------------- */
/* old contribution block (if any) */
fnr_curr = Work->fnr_curr ; /* garbage collection can change fn*_curr */
ASSERT (fnr_curr >= 0) ;
ASSERT ((fnr_curr % 2 == 1) || fnr_curr == 0) ;
fnrows = Work->fnrows ;
fncols = Work->fncols ;
Fcold = Work->Fcblock ;
/* remove nb from the sizes */
fnr2 -= nb ;
fnc2 -= nb ;
/* new frontal matrix */
Work->Flublock = (Entry *) (Numeric->Memory + eloc) ;
Work->Flblock = Work->Flublock + nb * nb ;
Work->Fublock = Work->Flblock + nb * fnr2 ;
Work->Fcblock = Work->Fublock + nb * fnc2 ;
Fcnew = Work->Fcblock ;
if (E [0])
{
/* copy the old contribution block into the new one */
for (j = 0 ; j < fncols ; j++)
{
col = Fcols [j] ;
DEBUG1 (("copy col "ID" \n",col)) ;
ASSERT (col >= 0 && col < Work->n_col) ;
for (i = 0 ; i < fnrows ; i++)
{
Fcnew [i] = Fcold [i] ;
}
Fcnew += fnr2 ;
Fcold += fnr_curr ;
DEBUG1 (("new offset col "ID" "ID"\n",col, j * fnr2)) ;
Fcpos [col] = j * fnr2 ;
}
}
else if (do_what == 2)
{
/* just find the new column offsets */
for (j = 0 ; j < fncols ; j++)
{
col = Fcols [j] ;
DEBUG1 (("new offset col "ID" "ID"\n",col, j * fnr2)) ;
Fcpos [col] = j * fnr2 ;
}
}
/* free the old frontal matrix */
UMF_mem_free_tail_block (Numeric, E [0]) ;
/* ---------------------------------------------------------------------- */
/* new frontal matrix size */
/* ---------------------------------------------------------------------- */
E [0] = eloc ;
Work->fnr_curr = fnr2 ; /* C block is fnr2-by-fnc2 */
Work->fnc_curr = fnc2 ;
Work->fcurr_size = newsize ; /* including LU, L, U, and C blocks */
Work->do_grow = FALSE ; /* the front has just been grown */
ASSERT (Work->fnr_curr >= 0) ;
ASSERT (Work->fnr_curr % 2 == 1) ;
DEBUG0 (("Newly grown front: "ID"+"ID" by "ID"+"ID"\n", Work->fnr_curr,
nb, Work->fnc_curr, nb)) ;
return (TRUE) ;
}
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) ;
}
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) ;
}
