GLOBAL Int UMF_mem_alloc_element
(
NumericType *Numeric,
Int nrows,
Int ncols,
Int **Rows,
Int **Cols,
Entry **C,
Int *size,
Element **epout
)
{
Element *ep ;
Unit *p ;
Int i ;
ASSERT (Numeric != (NumericType *) NULL) ;
ASSERT (Numeric->Memory != (Unit *) NULL) ;
*size = GET_ELEMENT_SIZE (nrows, ncols) ;
if (INT_OVERFLOW (DGET_ELEMENT_SIZE (nrows, ncols) + 1))
{
/* :: allocate element, int overflow :: */
return (0) ; /* problem is too large */
}
i = UMF_mem_alloc_tail_block (Numeric, *size) ;
(*size)++ ;
if (!i)
{
DEBUG0 (("alloc element failed - out of memory\n")) ;
return (0) ; /* out of memory */
}
p = Numeric->Memory + i ;
ep = (Element *) p ;
DEBUG2 (("alloc_element done ("ID" x "ID"): p: "ID" i "ID"\n",
nrows, ncols, (Int) (p-Numeric->Memory), i)) ;
/* Element data structure, in order: */
p += UNITS (Element, 1) ; /* (1) Element header */
*Cols = (Int *) p ; /* (2) col [0..ncols-1] indices */
*Rows = *Cols + ncols ; /* (3) row [0..nrows-1] indices */
p += UNITS (Int, ncols + nrows) ;
*C = (Entry *) p ; /* (4) C [0..nrows-1, 0..ncols-1] */
ep->nrows = nrows ; /* initialize the header information */
ep->ncols = ncols ;
ep->nrowsleft = nrows ;
ep->ncolsleft = ncols ;
ep->cdeg = 0 ;
ep->rdeg = 0 ;
ep->next = EMPTY ;
DEBUG2 (("new block size: "ID" ", GET_BLOCK_SIZE (Numeric->Memory + i))) ;
DEBUG2 (("Element size needed "ID"\n", GET_ELEMENT_SIZE (nrows, ncols))) ;
*epout = ep ;
/* return the offset into Numeric->Memory */
return (i) ;
}
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_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 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) ;
}
