GLOBAL Int UMF_build_tuples
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int e, nrows, ncols, nel, *Rows, *Cols, row, col, n_row, n_col, *E,
*Row_tuples, *Row_degree, *Row_tlen,
*Col_tuples, *Col_degree, *Col_tlen, n1 ;
Element *ep ;
Unit *p ;
Tuple tuple, *tp ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
E = Work->E ;
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
n_row = Work->n_row ;
n_col = Work->n_col ;
nel = Work->nel ;
n1 = Work->n1 ;
DEBUG3 (("BUILD_TUPLES: n_row "ID" n_col "ID" nel "ID"\n",
n_row, n_col, nel)) ;
/* ---------------------------------------------------------------------- */
/* allocate space for the tuple lists */
/* ---------------------------------------------------------------------- */
/* Garbage collection and memory reallocation have already attempted to */
/* ensure that there is enough memory for all the tuple lists. If */
/* memory allocation fails here, then there is nothing more to be done. */
for (row = n1 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row))
{
Row_tuples [row] = UMF_mem_alloc_tail_block (Numeric,
UNITS (Tuple, TUPLES (Row_tlen [row]))) ;
if (!Row_tuples [row])
{
/* :: out of memory for row tuples :: */
DEBUGm4 (("out of memory: build row tuples\n")) ;
return (FALSE) ; /* out of memory for row tuples */
}
Row_tlen [row] = 0 ;
}
}
/* push on stack in reverse order, so column tuples are in the order */
/* that they will be deleted. */
for (col = n_col-1 ; col >= n1 ; col--)
{
if (NON_PIVOTAL_COL (col))
{
Col_tuples [col] = UMF_mem_alloc_tail_block (Numeric,
UNITS (Tuple, TUPLES (Col_tlen [col]))) ;
if (!Col_tuples [col])
{
/* :: out of memory for col tuples :: */
DEBUGm4 (("out of memory: build col tuples\n")) ;
return (FALSE) ; /* out of memory for col tuples */
}
Col_tlen [col] = 0 ;
}
}
#ifndef NDEBUG
UMF_dump_memory (Numeric) ;
#endif
/* ---------------------------------------------------------------------- */
/* create the tuple lists (exclude element 0) */
/* ---------------------------------------------------------------------- */
/* for all elements, in order of creation */
for (e = 1 ; e <= nel ; e++)
{
DEBUG9 (("Adding tuples for element: "ID" at "ID"\n", e, E [e])) ;
ASSERT (E [e]) ; /* no external fragmentation */
p = Numeric->Memory + E [e] ;
GET_ELEMENT_PATTERN (ep, p, Cols, Rows, ncols) ;
nrows = ep->nrows ;
ASSERT (e != 0) ;
ASSERT (e == 0 || nrows == ep->nrowsleft) ;
ASSERT (e == 0 || ncols == ep->ncolsleft) ;
tuple.e = e ;
for (tuple.f = 0 ; tuple.f < ncols ; tuple.f++)
{
col = Cols [tuple.f] ;
ASSERT (col >= n1 && col < n_col) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
ASSERT (Col_tuples [col]) ;
tp = ((Tuple *) (Numeric->Memory + Col_tuples [col]))
+ Col_tlen [col]++ ;
*tp = tuple ;
#ifndef NDEBUG
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
}
for (tuple.f = 0 ; tuple.f < nrows ; tuple.f++)
{
row = Rows [tuple.f] ;
ASSERT (row >= n1 && row < n_row) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
ASSERT (Row_tuples [row]) ;
tp = ((Tuple *) (Numeric->Memory + Row_tuples [row]))
+ Row_tlen [row]++ ;
*tp = tuple ;
#ifndef NDEBUG
UMF_dump_rowcol (0, Numeric, Work, row, FALSE) ;
#endif
}
}
/* ---------------------------------------------------------------------- */
/* the tuple lists are now valid, and can be scanned */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_dump_memory (Numeric) ;
UMF_dump_matrix (Numeric, Work, FALSE) ;
#endif
DEBUG3 (("BUILD_TUPLES: done\n")) ;
return (TRUE) ;
}
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_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) ;
}
