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_garbage_collection
(
NumericType *Numeric,
WorkType *Work,
Int drnew, /* compact current front to drnew-by-dcnew */
Int dcnew,
Int do_Fcpos
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int size, e, n_row, n_col, nrows, ncols, nrowsleft, ncolsleft, prevsize,
csize, size2, i2, j2, i, j, cdeg, rdeg, *E, row, col,
*Rows, *Cols, *Rows2, *Cols2, nel, e2, *Row_tuples, *Col_tuples,
*Row_degree, *Col_degree ;
Entry *C, *C1, *C3, *C2 ;
Unit *psrc, *pdest, *p, *pnext ;
Element *epsrc, *epdest ;
#ifndef NDEBUG
Int nmark ;
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
Row_tuples = Numeric->Uip ;
Col_tuples = Numeric->Lip ;
E = Work->E ;
n_row = Work->n_row ;
n_col = Work->n_col ;
/* note that the tuple lengths (Col_tlen and Row_tlen) are updated, but */
/* the tuple lists themselves are stale and are about to be destroyed */
/* and recreated. Do not attempt to scan them until they are recreated. */
#ifndef NDEBUG
DEBUGm1 (("::::GARBAGE COLLECTION::::\n")) ;
UMF_dump_memory (Numeric) ;
#endif
Numeric->ngarbage++ ;
/* ---------------------------------------------------------------------- */
/* delete the tuple lists by marking the blocks as free */
/* ---------------------------------------------------------------------- */
/* do not modify Row_tlen and Col_tlen */
/* those are needed for UMF_build_tuples */
for (row = 0 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row) && Row_tuples [row])
{
DEBUG2 (("row "ID" tuples "ID"\n", row, Row_tuples [row])) ;
p = Numeric->Memory + Row_tuples [row] - 1 ;
DEBUG2 (("Freeing tuple list row "ID", p-S "ID", size "ID"\n",
row, (Int) (p-Numeric->Memory), p->header.size)) ;
ASSERT (p->header.size > 0) ;
ASSERT (p >= Numeric->Memory + Numeric->itail) ;
ASSERT (p < Numeric->Memory + Numeric->size) ;
p->header.size = -p->header.size ;
Row_tuples [row] = 0 ;
}
}
for (col = 0 ; col < n_col ; col++)
{
if (NON_PIVOTAL_COL (col) && Col_tuples [col])
{
DEBUG2 (("col "ID" tuples "ID"\n", col, Col_tuples [col])) ;
p = Numeric->Memory + Col_tuples [col] - 1 ;
DEBUG2 (("Freeing tuple list col "ID", p-S "ID", size "ID"\n",
col, (Int) (p-Numeric->Memory), p->header.size)) ;
ASSERT (p->header.size > 0) ;
ASSERT (p >= Numeric->Memory + Numeric->itail) ;
ASSERT (p < Numeric->Memory + Numeric->size) ;
p->header.size = -p->header.size ;
Col_tuples [col] = 0 ;
}
}
/* ---------------------------------------------------------------------- */
/* mark the elements, and compress the name space */
/* ---------------------------------------------------------------------- */
nel = Work->nel ;
ASSERT (nel < Work->elen) ;
#ifndef NDEBUG
nmark = 0 ;
UMF_dump_current_front (Numeric, Work, FALSE) ;
DEBUGm1 (("E [0] "ID" \n", E [0])) ;
ASSERT (IMPLIES (E [0],
Work->Flublock == (Entry *) (Numeric->Memory + E [0]))) ;
ASSERT (IMPLIES (Work->Flublock,
Work->Flublock == (Entry *) (Numeric->Memory + E [0]))) ;
ASSERT ((E [0] != 0) == (Work->Flublock != (Entry *) NULL)) ;
#endif
e2 = 0 ;
for (e = 0 ; e <= nel ; e++) /* for all elements in order of creation */
{
if (E [e])
{
psrc = Numeric->Memory + E [e] ;
psrc-- ; /* get the header of this block */
if (e > 0)
{
e2++ ; /* do not renumber element zero */
}
ASSERT (psrc->header.size > 0) ;
psrc->header.size = e2 ; /* store the new name in the header */
#ifndef NDEBUG
nmark++ ;
#endif
DEBUG7 ((ID":: Mark e "ID" at psrc-S "ID", new e "ID"\n",
nmark, e, (Int) (psrc-Numeric->Memory), e2)) ;
E [e] = 0 ;
if (e == Work->prior_element)
{
Work->prior_element = e2 ;
}
}
}
/* all 1..e2 are now in use (element zero may or may not be in use) */
Work->nel = e2 ;
nel = Work->nel ;
#ifndef NDEBUG
for (e = 0 ; e < Work->elen ; e++)
{
ASSERT (!E [e]) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* compress the elements */
/* ---------------------------------------------------------------------- */
/* point to tail marker block of size 1 + header */
psrc = Numeric->Memory + Numeric->size - 2 ;
pdest = psrc ;
prevsize = psrc->header.prevsize ;
DEBUG7 (("Starting the compression:\n")) ;
while (prevsize > 0)
{
/* ------------------------------------------------------------------ */
/* move up to the next element above the current header, and */
/* get the element name and size */
/* (if it is an element, the name will be positive) */
/* ------------------------------------------------------------------ */
size = prevsize ;
psrc -= (size + 1) ;
e = psrc->header.size ;
prevsize = psrc->header.prevsize ;
/* top block at tail has prevsize of 0 */
/* a free block will have a negative size, so skip it */
/* otherwise, if size >= 0, it holds the element name, not the size */
DEBUG8 (("psrc-S: "ID" prevsize: "ID" size: "ID,
(Int) (psrc-Numeric->Memory), prevsize, size)) ;
if (e == 0)
{
/* -------------------------------------------------------------- */
/* this is the current frontal matrix */
/* -------------------------------------------------------------- */
Entry *F1, *F2, *Fsrc, *Fdst ;
Int c, r, k, dr, dc, gap, gap1, gap2, nb ;
/* shift the frontal matrix down */
F1 = (Entry *) (psrc + 1) ;
/* get the size of the current front. r and c could be zero */
k = Work->fnpiv ;
dr = Work->fnr_curr ;
dc = Work->fnc_curr ;
r = Work->fnrows ;
c = Work->fncols ;
nb = Work->nb ;
ASSERT ((dr >= 0 && (dr % 2) == 1) || dr == 0) ;
ASSERT (drnew >= 0) ;
if (drnew % 2 == 0)
{
/* make sure leading frontal matrix dimension is always odd */
drnew++ ;
}
drnew = MIN (dr, drnew) ;
ASSERT ((drnew >= 0 && (drnew % 2) == 1) || drnew == 0) ;
pnext = pdest ;
#ifndef NDEBUG
DEBUGm2 (("move front: dr "ID" dc "ID" r "ID" drnew "ID" c "ID
" dcnew " ID" k "ID"\n", dr, dc, r, drnew, c, dcnew, k)) ;
DEBUG7 (("\n")) ;
DEBUG7 ((ID":: Move current frontal matrix from: psrc-S: "ID" \n",
nmark, (Int) (psrc-Numeric->Memory))) ;
nmark-- ;
ASSERT (E [e] == 0) ;
ASSERT (Work->Flublock == F1) ;
ASSERT (Work->Flblock == Work->Flublock + nb*nb) ;
ASSERT (Work->Fublock == Work->Flblock + dr*nb) ;
ASSERT (Work->Fcblock == Work->Fublock + nb*dc) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (Work->Fcblock, dr, r, c) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Work->Flblock, dr, r, k);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Work->Fublock, dc, c, k) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Work->Flublock, nb, k, k) ;
ASSERT (r <= drnew && c <= dcnew && drnew <= dr && dcnew <= dc) ;
#endif
/* compact frontal matrix to drnew-by-dcnew before moving it */
/* do not compact the LU block (nb-by-nb) */
/* compact the columns of L (from dr-by-nb to drnew-by-nb) */
Fsrc = Work->Flblock ;
Fdst = Work->Flblock ;
ASSERT (Fdst == F1 + nb*nb) ;
gap1 = dr - r ;
gap2 = drnew - r ;
ASSERT (gap1 >= 0) ;
for (j = 0 ; j < k ; j++)
{
for (i = 0 ; i < r ; i++)
{
*Fdst++ = *Fsrc++ ;
}
Fsrc += gap1 ;
Fdst += gap2 ;
}
ASSERT (Fdst == F1 + nb*nb + drnew*k) ;
Fdst += drnew * (nb - k) ;
/* compact the rows of U (U' from dc-by-nb to dcnew-by-nb) */
Fsrc = Work->Fublock ;
ASSERT (Fdst == F1 + nb*nb + drnew*nb) ;
gap1 = dc - c ;
gap2 = dcnew - c ;
for (i = 0 ; i < k ; i++)
{
for (j = 0 ; j < c ; j++)
{
*Fdst++ = *Fsrc++ ;
}
Fsrc += gap1 ;
Fdst += gap2 ;
}
ASSERT (Fdst == F1 + nb*nb + drnew*nb + dcnew*k) ;
Fdst += dcnew * (nb - k) ;
/* compact the columns of C (from dr-by-dc to drnew-by-dcnew) */
Fsrc = Work->Fcblock ;
ASSERT (Fdst == F1 + nb*nb + drnew*nb + nb*dcnew) ;
gap1 = dr - r ;
gap2 = drnew - r ;
for (j = 0 ; j < c ; j++)
{
for (i = 0 ; i < r ; i++)
{
*Fdst++ = *Fsrc++ ;
}
Fsrc += gap1 ;
Fdst += gap2 ;
}
ASSERT (Fdst == F1 + nb*nb + drnew*nb + nb*dcnew + drnew*c) ;
/* recompute Fcpos, if necessary */
if (do_Fcpos)
{
Int *Fcols, *Fcpos ;
Fcols = Work->Fcols ;
Fcpos = Work->Fcpos ;
for (j = 0 ; j < c ; j++)
{
col = Fcols [j] ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (Fcpos [col] == j * dr) ;
Fcpos [col] = j * drnew ;
}
#ifndef NDEBUG
{
Int cnt = 0 ;
for (j = 0 ; j < Work->n_col ; j++)
{
if (Fcpos [j] != EMPTY) cnt++ ;
}
DEBUGm2 (("Recompute Fcpos cnt "ID" c "ID"\n", cnt, c)) ;
ASSERT (cnt == c) ;
}
#endif
}
#ifndef NDEBUG
DEBUGm2 (("Compacted front, drnew "ID" dcnew "ID"\n", drnew, dcnew)) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (F1 + nb*nb + drnew*nb + nb*dcnew, drnew, r, c) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (F1 + nb*nb, drnew, r, k) ;
DEBUG7 (("U block: ")) ;
UMF_dump_dense (F1 + nb*nb + drnew*nb, nb, k, c) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (F1, nb, k, k) ;
#endif
/* Compacted dimensions of the new frontal matrix. */
Work->fnr_curr = drnew ;
Work->fnc_curr = dcnew ;
Work->fcurr_size = (drnew + nb) * (dcnew + nb) ;
size = UNITS (Entry, Work->fcurr_size) ;
/* make sure the object doesn't evaporate. The front can have
* zero size (Work->fcurr_size = 0), but the size of the memory
* block containing it cannot have zero size. */
size = MAX (1, size) ;
/* get the destination of frontal matrix */
pnext->header.prevsize = size ;
pdest -= (size + 1) ;
F2 = (Entry *) (pdest + 1) ;
ASSERT ((unsigned Int) psrc + 1 + size <= (unsigned Int) pnext) ;
ASSERT (psrc <= pdest) ;
ASSERT (F1 <= F2) ;
/* move the C block first */
Fsrc = F1 + nb*nb + drnew*nb + nb*dcnew + drnew*c ;
Fdst = F2 + nb*nb + drnew*nb + nb*dcnew + drnew*c ;
gap = drnew - r ;
for (j = c-1 ; j >= 0 ; j--)
{
Fsrc -= gap ;
Fdst -= gap ;
/* move column j of C */
for (i = r-1 ; i >= 0 ; i--)
{
*--Fdst = *--Fsrc ;
}
}
ASSERT (Fsrc == F1 + nb*nb + drnew*nb + nb*dcnew) ;
ASSERT (Fdst == F2 + nb*nb + drnew*nb + nb*dcnew) ;
/* move the U block */
Fsrc -= dcnew * (nb - k) ;
Fdst -= dcnew * (nb - k) ;
ASSERT (Fsrc == F1 + nb*nb + drnew*nb + dcnew*k) ;
ASSERT (Fdst == F2 + nb*nb + drnew*nb + dcnew*k) ;
gap = dcnew - c ;
for (i = k-1 ; i >= 0 ; i--)
{
Fsrc -= gap ;
Fdst -= gap ;
for (j = c-1 ; j >= 0 ; j--)
{
*--Fdst = *--Fsrc ;
}
}
ASSERT (Fsrc == F1 + nb*nb + drnew*nb) ;
ASSERT (Fdst == F2 + nb*nb + drnew*nb) ;
/* move the L block */
Fsrc -= drnew * (nb - k) ;
Fdst -= drnew * (nb - k) ;
ASSERT (Fsrc == F1 + nb*nb + drnew*k) ;
ASSERT (Fdst == F2 + nb*nb + drnew*k) ;
gap = drnew - r ;
for (j = k-1 ; j >= 0 ; j--)
{
Fsrc -= gap ;
Fdst -= gap ;
for (i = r-1 ; i >= 0 ; i--)
{
*--Fdst = *--Fsrc ;
}
}
ASSERT (Fsrc == F1 + nb*nb) ;
ASSERT (Fdst == F2 + nb*nb) ;
/* move the LU block */
Fsrc -= nb * (nb - k) ;
Fdst -= nb * (nb - k) ;
ASSERT (Fsrc == F1 + nb*k) ;
ASSERT (Fdst == F2 + nb*k) ;
gap = nb - k ;
for (j = k-1 ; j >= 0 ; j--)
{
Fsrc -= gap ;
Fdst -= gap ;
for (i = k-1 ; i >= 0 ; i--)
{
*--Fdst = *--Fsrc ;
}
}
ASSERT (Fsrc == F1) ;
ASSERT (Fdst == F2) ;
E [0] = (pdest + 1) - Numeric->Memory ;
Work->Flublock = (Entry *) (Numeric->Memory + E [0]) ;
ASSERT (Work->Flublock == F2) ;
Work->Flblock = Work->Flublock + nb * nb ;
Work->Fublock = Work->Flblock + drnew * nb ;
Work->Fcblock = Work->Fublock + nb * dcnew ;
pdest->header.prevsize = 0 ;
pdest->header.size = size ;
#ifndef NDEBUG
DEBUG7 (("After moving compressed current frontal matrix:\n")) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (Work->Fcblock, drnew, r, c) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Work->Flblock, drnew, r, k);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Work->Fublock, dcnew, c, k) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Work->Flublock, nb, k, k) ;
#endif
}
else if (e > 0)
{
/* -------------------------------------------------------------- */
/* this is an element, compress and move from psrc down to pdest */
/* -------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG7 (("\n")) ;
DEBUG7 ((ID":: Move element "ID": from: "ID" \n",
nmark, e, (Int) (psrc-Numeric->Memory))) ;
nmark-- ;
ASSERT (e <= nel) ;
ASSERT (E [e] == 0) ;
#endif
/* -------------------------------------------------------------- */
/* get the element scalars, and pointers to C, Rows, and Cols: */
/* -------------------------------------------------------------- */
p = psrc + 1 ;
GET_ELEMENT (epsrc, p, Cols, Rows, ncols, nrows, C) ;
nrowsleft = epsrc->nrowsleft ;
ncolsleft = epsrc->ncolsleft ;
cdeg = epsrc->cdeg ;
rdeg = epsrc->rdeg ;
#ifndef NDEBUG
DEBUG7 ((" nrows "ID" nrowsleft "ID"\n", nrows, nrowsleft)) ;
DEBUG7 ((" ncols "ID" ncolsleft "ID"\n", ncols, ncolsleft)) ;
DEBUG8 ((" Rows:")) ;
for (i = 0 ; i < nrows ; i++) DEBUG8 ((" "ID, Rows [i])) ;
DEBUG8 (("\n Cols:")) ;
for (j = 0 ; j < ncols ; j++) DEBUG8 ((" "ID, Cols [j])) ;
DEBUG8 (("\n")) ;
#endif
/* -------------------------------------------------------------- */
/* determine the layout of the new element */
/* -------------------------------------------------------------- */
csize = nrowsleft * ncolsleft ;
size2 = UNITS (Element, 1)
+ UNITS (Int, nrowsleft + ncolsleft)
+ UNITS (Entry, csize) ;
DEBUG7 (("Old size "ID" New size "ID"\n", size, size2)) ;
pnext = pdest ;
pnext->header.prevsize = size2 ;
pdest -= (size2 + 1) ;
ASSERT (size2 <= size) ;
ASSERT ((unsigned Int) psrc + 1 + size <= (unsigned Int) pnext) ;
ASSERT (psrc <= pdest) ;
p = pdest + 1 ;
epdest = (Element *) p ;
p += UNITS (Element, 1) ;
Cols2 = (Int *) p ;
Rows2 = Cols2 + ncolsleft ;
p += UNITS (Int, nrowsleft + ncolsleft) ;
C2 = (Entry *) p ;
ASSERT (epdest >= epsrc) ;
ASSERT (Rows2 >= Rows) ;
ASSERT (Cols2 >= Cols) ;
ASSERT (C2 >= C) ;
ASSERT (p + UNITS (Entry, csize) == pnext) ;
/* -------------------------------------------------------------- */
/* move the contribution block */
/* -------------------------------------------------------------- */
/* overlap = psrc + size + 1 > pdest ; */
if (nrowsleft < nrows || ncolsleft < ncols)
{
/* ---------------------------------------------------------- */
/* compress contribution block in place prior to moving it */
/* ---------------------------------------------------------- */
DEBUG7 (("Compress C in place prior to move:\n"));
#ifndef NDEBUG
UMF_dump_dense (C, nrows, nrows, ncols) ;
#endif
C1 = C ;
C3 = C ;
for (j = 0 ; j < ncols ; j++)
{
if (Cols [j] >= 0)
{
for (i = 0 ; i < nrows ; i++)
{
if (Rows [i] >= 0)
{
*C3++ = C1 [i] ;
}
}
}
C1 += nrows ;
}
ASSERT (C3-C == csize) ;
DEBUG8 (("Newly compressed contrib. block (all in use):\n")) ;
#ifndef NDEBUG
UMF_dump_dense (C, nrowsleft, nrowsleft, ncolsleft) ;
#endif
}
/* shift the contribution block down */
C += csize ;
C2 += csize ;
for (i = 0 ; i < csize ; i++)
{
*--C2 = *--C ;
}
/* -------------------------------------------------------------- */
/* move the row indices */
/* -------------------------------------------------------------- */
i2 = nrowsleft ;
for (i = nrows - 1 ; i >= 0 ; i--)
{
ASSERT (Rows2+i2 >= Rows+i) ;
if (Rows [i] >= 0)
{
Rows2 [--i2] = Rows [i] ;
}
}
ASSERT (i2 == 0) ;
j2 = ncolsleft ;
for (j = ncols - 1 ; j >= 0 ; j--)
{
ASSERT (Cols2+j2 >= Cols+j) ;
if (Cols [j] >= 0)
{
Cols2 [--j2] = Cols [j] ;
}
}
ASSERT (j2 == 0) ;
/* -------------------------------------------------------------- */
/* construct the new header */
/* -------------------------------------------------------------- */
/* E [0...e] is now valid */
E [e] = (pdest + 1) - Numeric->Memory ;
epdest = (Element *) (pdest + 1) ;
epdest->next = EMPTY ; /* destroys the son list */
epdest->ncols = ncolsleft ;
epdest->nrows = nrowsleft ;
epdest->ncolsleft = ncolsleft ;
epdest->nrowsleft = nrowsleft ;
epdest->rdeg = rdeg ;
epdest->cdeg = cdeg ;
ASSERT (size2 <= size) ;
pdest->header.prevsize = 0 ;
pdest->header.size = size2 ;
DEBUG7 (("After moving it:\n")) ;
#ifndef NDEBUG
UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif
}
#ifndef NDEBUG
else
{
DEBUG8 ((" free\n")) ;
}
#endif
DEBUG7 (("psrc "ID" tail "ID"\n",
(Int) (psrc-Numeric->Memory), Numeric->itail)) ;
}
ASSERT (psrc == Numeric->Memory + Numeric->itail) ;
ASSERT (nmark == 0) ;
/* ---------------------------------------------------------------------- */
/* final tail pointer */
/* ---------------------------------------------------------------------- */
ASSERT (pdest >= Numeric->Memory + Numeric->itail) ;
Numeric->itail = pdest - Numeric->Memory ;
pdest->header.prevsize = 0 ;
Numeric->ibig = EMPTY ;
Numeric->tail_usage = Numeric->size - Numeric->itail ;
/* ---------------------------------------------------------------------- */
/* clear the unused E [nel+1 .. Work->elen - 1] */
/* ---------------------------------------------------------------------- */
for (e = nel+1 ; e < Work->elen ; e++)
{
E [e] = 0 ;
}
#ifndef NDEBUG
UMF_dump_packed_memory (Numeric, Work) ;
#endif
DEBUG8 (("::::GARBAGE COLLECTION DONE::::\n")) ;
}
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 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 void UMF_assemble
#else
GLOBAL void UMF_assemble_fixq
#endif
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int e, i, row, col, i2, nrows, ncols, f, tpi, extcdeg, extrdeg, rdeg0,
cdeg0, son_list, next, nrows_to_assemble,
ncols_to_assemble, ngetrows, j, j2,
nrowsleft, /* number of rows remaining in S */
ncolsleft, /* number of columns remaining in S */
prior_Lson, prior_Uson, *E, *Cols, *Rows, *Wm, *Woo,
*Row_tuples, *Row_degree, *Row_tlen,
*Col_tuples, *Col_tlen ;
Unit *Memory, *p ;
Element *ep ;
Tuple *tp, *tp1, *tp2, *tpend ;
Entry
*S, /* a pointer into the contribution block of a son */
*Fcblock, /* current contribution block */
*Fcol ; /* a column of FC */
Int *Frpos,
*Fcpos,
fnrows, /* number of rows in contribution block in F */
fncols ; /* number of columns in contribution block in F */
#if !defined (FIXQ) || !defined (NDEBUG)
Int *Col_degree ;
#endif
#ifndef NDEBUG
Int n_row, n_col ;
n_row = Work->n_row ;
n_col = Work->n_col ;
DEBUG3 (("::Assemble SCANS 1-4\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
#if !defined (FIXQ) || !defined (NDEBUG)
Col_degree = Numeric->Cperm ; /* not updated if FIXQ is true */
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
fncols = Work->fncols ;
fnrows = Work->fnrows ;
Fcpos = Work->Fcpos ;
Frpos = Work->Frpos ;
Row_degree = Numeric->Rperm ;
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
E = Work->E ;
Memory = Numeric->Memory ;
Wm = Work->Wm ;
Woo = Work->Woo ;
rdeg0 = Work->rdeg0 ;
cdeg0 = Work->cdeg0 ;
#ifndef NDEBUG
DEBUG6 (("============================================\n")) ;
DEBUG6 (("Degree update, assembly.\n")) ;
DEBUG6 (("pivot row pattern: fncols="ID"\n", fncols)) ;
for (j = 0 ; j < fncols ; j++)
{
col = Work->Fcols [j] ;
DEBUG6 ((ID" ", col)) ;
ASSERT (Fcpos [col] == j * Work->fnr_curr) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
}
ASSERT (Fcpos [Work->pivcol] >= 0) ;
DEBUG6 (("pivcol: "ID" pos "ID" fnr_curr "ID" fncols "ID"\n",
Work->pivcol, Fcpos [Work->pivcol], Work->fnr_curr, fncols)) ;
ASSERT (Fcpos [Work->pivcol] < fncols * Work->fnr_curr) ;
DEBUG6 (("\npivot col pattern: fnrows="ID"\n", fnrows)) ;
for (i = 0 ; i < fnrows ; i++)
{
row = Work->Frows [i] ;
DEBUG6 ((ID" ", row)) ;
ASSERT (Frpos [row] == i) ;
ASSERT (NON_PIVOTAL_ROW (row)) ;
}
DEBUG6 (("\n")) ;
ASSERT (Frpos [Work->pivrow] >= 0) ;
ASSERT (Frpos [Work->pivrow] < fnrows) ;
ASSERT (Work->Flublock == (Entry *) (Numeric->Memory + E [0])) ;
ASSERT (Work->Fcblock == Work->Flublock + Work->nb *
(Work->nb + Work->fnr_curr + Work->fnc_curr)) ;
#endif
Fcblock = Work->Fcblock ;
/* ---------------------------------------------------------------------- */
/* determine the largest actual frontal matrix size (for Info only) */
/* ---------------------------------------------------------------------- */
ASSERT (fnrows == Work->fnrows_new + 1) ;
ASSERT (fncols == Work->fncols_new + 1) ;
Numeric->maxnrows = MAX (Numeric->maxnrows, fnrows) ;
Numeric->maxncols = MAX (Numeric->maxncols, fncols) ;
/* this is safe from integer overflow, since the current frontal matrix
* is already allocated. */
Numeric->maxfrsize = MAX (Numeric->maxfrsize, fnrows * fncols) ;
/* ---------------------------------------------------------------------- */
/* assemble from prior elements into the current frontal matrix */
/* ---------------------------------------------------------------------- */
DEBUG2 (("New assemble start [prior_element:"ID"\n", Work->prior_element)) ;
/* Currently no rows or columns are marked. No elements are scanned, */
/* that is, (ep->next == EMPTY) is true for all elements */
son_list = 0 ; /* start creating son_list [ */
/* ---------------------------------------------------------------------- */
/* determine if most recent element is Lson or Uson of current front */
/* ---------------------------------------------------------------------- */
if (!Work->do_extend)
{
prior_Uson = ( Work->pivcol_in_front && !Work->pivrow_in_front) ;
prior_Lson = (!Work->pivcol_in_front && Work->pivrow_in_front) ;
if (prior_Uson || prior_Lson)
{
e = Work->prior_element ;
if (e != EMPTY)
{
ASSERT (E [e]) ;
p = Memory + E [e] ;
ep = (Element *) p ;
ep->next = son_list ;
son_list = e ;
#ifndef NDEBUG
DEBUG2 (("e "ID" is Prior son "ID" "ID"\n",
e, prior_Uson, prior_Lson)) ;
UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif
ASSERT (E [e]) ;
}
}
}
Work->prior_element = EMPTY ;
/* ---------------------------------------------------------------------- */
/* SCAN1-row: scan the element lists of each new row in the pivot col */
/* and compute the external column degree for each frontal */
/* ---------------------------------------------------------------------- */
for (i2 = Work->fscan_row ; i2 < fnrows ; i2++)
{
/* Get a row */
row = Work->NewRows [i2] ;
if (row < 0) row = FLIP (row) ;
ASSERT (row >= 0 && row < n_row) ;
DEBUG6 (("SCAN1-row: "ID"\n", row)) ;
#ifndef NDEBUG
UMF_dump_rowcol (0, Numeric, Work, row, FALSE) ;
#endif
ASSERT (NON_PIVOTAL_ROW (row)) ;
tpi = Row_tuples [row] ;
if (!tpi) continue ;
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [row] ;
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) ;
Rows = ((Int *) p) + ep->ncols ;
if (Rows [f] == EMPTY) continue ; /* row already assembled */
ASSERT (row == Rows [f]) ;
if (ep->cdeg < cdeg0)
{
/* first time seen in scan1-row */
ep->cdeg = ep->nrowsleft + cdeg0 ;
DEBUG6 (("e "ID" First seen: cdeg: "ID" ", e, ep->cdeg-cdeg0)) ;
ASSERT (ep->ncolsleft > 0 && ep->nrowsleft > 0) ;
}
ep->cdeg-- ; /* decrement external column degree */
DEBUG6 (("e "ID" New ext col deg: "ID"\n", e, ep->cdeg - cdeg0)) ;
/* this element is not yet in the new son list */
if (ep->cdeg == cdeg0 && ep->next == EMPTY)
{
/* A new LUson or Uson has been found */
ep->next = son_list ;
son_list = e ;
}
ASSERT (ep->cdeg >= cdeg0) ;
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [row] = tp2 - tp1 ;
}
/* ---------------------------------------------------------------------- */
/* SCAN1-col: scan the element lists of each new col in the pivot row */
/* and compute the external row degree for each frontal */
/* ---------------------------------------------------------------------- */
for (j2 = Work->fscan_col ; j2 < fncols ; j2++)
{
/* Get a column */
col = Work->NewCols [j2] ;
if (col < 0) col = FLIP (col) ;
ASSERT (col >= 0 && col < n_col) ;
DEBUG6 (("SCAN 1-col: "ID"\n", col)) ;
#ifndef NDEBUG
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
ASSERT (NON_PIVOTAL_COL (col)) ;
tpi = Col_tuples [col] ;
if (!tpi) continue ;
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Col_tlen [col] ;
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 ; /* column already assembled */
ASSERT (col == Cols [f]) ;
if (ep->rdeg < rdeg0)
{
/* first time seen in scan1-col */
ep->rdeg = ep->ncolsleft + rdeg0 ;
DEBUG6 (("e "ID" First seen: rdeg: "ID" ", e, ep->rdeg-rdeg0)) ;
ASSERT (ep->ncolsleft > 0 && ep->nrowsleft > 0) ;
}
ep->rdeg-- ; /* decrement external row degree */
DEBUG6 (("e "ID" New ext row degree: "ID"\n", e, ep->rdeg-rdeg0)) ;
if (ep->rdeg == rdeg0 && ep->next == EMPTY)
{
/* A new LUson or Lson has been found */
ep->next = son_list ;
son_list = e ;
}
ASSERT (ep->rdeg >= rdeg0) ;
*tp2++ = *tp ; /* leave the tuple in the list */
}
Col_tlen [col] = tp2 - tp1 ;
}
/* ---------------------------------------------------------------------- */
/* assemble new sons via full scans */
/* ---------------------------------------------------------------------- */
next = EMPTY ;
for (e = son_list ; e > 0 ; e = next)
{
ASSERT (e > 0 && e <= Work->nel && E [e]) ;
p = Memory + E [e] ;
DEBUG2 (("New son: "ID"\n", e)) ;
#ifndef NDEBUG
UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif
GET_ELEMENT (ep, p, Cols, Rows, ncols, nrows, S) ;
nrowsleft = ep->nrowsleft ;
ncolsleft = ep->ncolsleft ;
next = ep->next ;
ep->next = EMPTY ;
extrdeg = (ep->rdeg < rdeg0) ? ncolsleft : (ep->rdeg - rdeg0) ;
extcdeg = (ep->cdeg < cdeg0) ? nrowsleft : (ep->cdeg - cdeg0) ;
ncols_to_assemble = ncolsleft - extrdeg ;
nrows_to_assemble = nrowsleft - extcdeg ;
DEBUG2 (("extrdeg "ID" extcdeg "ID"\n", extrdeg, extcdeg)) ;
if (extrdeg == 0 && extcdeg == 0)
{
/* -------------------------------------------------------------- */
/* this is an LUson - assemble an entire contribution block */
/* -------------------------------------------------------------- */
DEBUG6 (("LUson found: "ID"\n", e)) ;
if (nrows == nrowsleft)
{
/* ---------------------------------------------------------- */
/* no rows assembled out of this LUson yet */
/* ---------------------------------------------------------- */
/* compute the compressed column offset vector*/
/* [ use Wm [0..nrows-1] for offsets */
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
Row_degree [row] -= ncolsleft ;
Wm [i] = Frpos [row] ;
}
if (ncols == ncolsleft)
{
/* ------------------------------------------------------ */
/* no rows or cols assembled out of LUson yet */
/* ------------------------------------------------------ */
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
/* Fcol [Wm [i]] += S [i] ; */
ASSEMBLE (Fcol [Wm [i]], S [i]) ;
}
S += nrows ;
}
}
else
{
/* ------------------------------------------------------ */
/* only cols have been assembled out of LUson */
/* ------------------------------------------------------ */
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
if (col >= 0)
{
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
/* Fcol [Wm [i]] += S [i] ; */
ASSEMBLE (Fcol [Wm [i]], S [i]) ;
}
}
S += nrows ;
}
}
/* ] done using Wm [0..nrows-1] for offsets */
}
else
{
/* ---------------------------------------------------------- */
/* some rows have been assembled out of this LUson */
/* ---------------------------------------------------------- */
/* compute the compressed column offset vector*/
/* [ use Woo,Wm [0..nrowsleft-1] for offsets */
ngetrows = 0 ;
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
if (row >= 0)
{
Row_degree [row] -= ncolsleft ;
Woo [ngetrows] = i ;
Wm [ngetrows++] = Frpos [row] ;
}
}
ASSERT (ngetrows == nrowsleft) ;
if (ncols == ncolsleft)
{
/* ------------------------------------------------------ */
/* only rows have been assembled out of this LUson */
/* ------------------------------------------------------ */
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrowsleft ; i++)
{
/* Fcol [Wm [i]] += S [Woo [i]] ; */
ASSEMBLE (Fcol [Wm [i]], S [Woo [i]]) ;
}
S += nrows ;
}
}
else
{
/* ------------------------------------------------------ */
/* both rows and columns have been assembled out of LUson */
/* ------------------------------------------------------ */
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
if (col >= 0)
{
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrowsleft ; i++)
{
/* Fcol [Wm [i]] += S [Woo [i]] ; */
ASSEMBLE (Fcol [Wm [i]], S [Woo [i]]) ;
}
}
S += nrows ;
}
}
/* ] done using Woo,Wm [0..nrowsleft-1] */
}
/* deallocate the element: remove from ordered list */
UMF_mem_free_tail_block (Numeric, E [e]) ;
E [e] = 0 ;
}
else if (extcdeg == 0)
{
/* -------------------------------------------------------------- */
/* this is a Uson - assemble all possible columns */
/* -------------------------------------------------------------- */
DEBUG6 (("New USON: "ID"\n", e)) ;
ASSERT (extrdeg > 0) ;
DEBUG6 (("New uson "ID" cols to do "ID"\n", e, ncols_to_assemble)) ;
if (ncols_to_assemble > 0)
{
Int skip = FALSE ;
if (ncols_to_assemble * 16 < ncols && nrows == 1)
{
/* this is a tall and thin frontal matrix consisting of
* only one column (most likely an original column). Do
* not assemble it. It cannot be the pivot column, since
* the pivot column element would be an LU son, not an Lson,
* of the current frontal matrix. */
ASSERT (nrowsleft == 1) ;
ASSERT (Rows [0] >= 0 && Rows [0] < Work->n_row) ;
skip = TRUE ;
Work->any_skip = TRUE ;
}
if (!skip)
{
if (nrows == nrowsleft)
{
/* -------------------------------------------------- */
/* no rows have been assembled out of this Uson yet */
/* -------------------------------------------------- */
/* compute the compressed column offset vector */
/* [ use Wm [0..nrows-1] for offsets */
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
ASSERT (row >= 0 && row < n_row) ;
Row_degree [row] -= ncols_to_assemble ;
Wm [i] = Frpos [row] ;
}
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
if ((col >= 0) && (Fcpos [col] >= 0))
{
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
/* Fcol [Wm [i]] += S [i] ; */
ASSEMBLE (Fcol [Wm [i]], S [i]) ;
}
/* flag the column as assembled from Uson */
Cols [j] = EMPTY ;
}
S += nrows ;
}
/* ] done using Wm [0..nrows-1] for offsets */
}
else
{
/* -------------------------------------------------- */
/* some rows have been assembled out of this Uson */
/* -------------------------------------------------- */
/* compute the compressed column offset vector*/
/* [ use Woo,Wm [0..nrows-1] for offsets */
ngetrows = 0 ;
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
if (row >= 0)
{
Row_degree [row] -= ncols_to_assemble ;
ASSERT (row < n_row && Frpos [row] >= 0) ;
Woo [ngetrows] = i ;
Wm [ngetrows++] = Frpos [row] ;
}
}
ASSERT (ngetrows == nrowsleft) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
if ((col >= 0) && (Fcpos [col] >= 0))
{
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrowsleft ; i++)
{
/* Fcol [Wm [i]] += S [Woo [i]] ; */
ASSEMBLE (Fcol [Wm [i]], S [Woo [i]]) ;
}
/* flag the column as assembled from Uson */
Cols [j] = EMPTY ;
}
S += nrows ;
}
/* ] done using Woo,Wm */
}
ep->ncolsleft = extrdeg ;
}
}
}
else
{
/* -------------------------------------------------------------- */
/* this is an Lson - assemble all possible rows */
/* -------------------------------------------------------------- */
DEBUG6 (("New LSON: "ID"\n", e)) ;
ASSERT (extrdeg == 0 && extcdeg > 0) ;
DEBUG6 (("New lson "ID" rows to do "ID"\n", e, nrows_to_assemble)) ;
if (nrows_to_assemble > 0)
{
Int skip = FALSE ;
if (nrows_to_assemble * 16 < nrows && ncols == 1)
{
/* this is a tall and thin frontal matrix consisting of
* only one column (most likely an original column). Do
* not assemble it. It cannot be the pivot column, since
* the pivot column element would be an LU son, not an Lson,
* of the current frontal matrix. */
ASSERT (ncolsleft == 1) ;
ASSERT (Cols [0] >= 0 && Cols [0] < Work->n_col) ;
Work->any_skip = TRUE ;
skip = TRUE ;
}
if (!skip)
{
/* compute the compressed column offset vector */
/* [ use Woo,Wm [0..nrows-1] for offsets */
ngetrows = 0 ;
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
if ((row >= 0) && (Frpos [row] >= 0))
{
ASSERT (row < n_row) ;
Row_degree [row] -= ncolsleft ;
Woo [ngetrows] = i ;
Wm [ngetrows++] = Frpos [row] ;
/* flag the row as assembled from the Lson */
Rows [i] = EMPTY ;
}
}
ASSERT (nrowsleft - ngetrows == extcdeg) ;
ASSERT (ngetrows == nrows_to_assemble) ;
if (ncols == ncolsleft)
{
/* -------------------------------------------------- */
/* no columns assembled out this Lson yet */
/* -------------------------------------------------- */
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= 0 && col < n_col) ;
#ifndef FIXQ
Col_degree [col] -= nrows_to_assemble ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrows_to_assemble ; i++)
{
/* Fcol [Wm [i]] += S [Woo [i]] ; */
ASSEMBLE (Fcol [Wm [i]], S [Woo [i]]) ;
}
S += nrows ;
}
}
else
{
/* -------------------------------------------------- */
/* some columns have been assembled out of this Lson */
/* -------------------------------------------------- */
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col < n_col) ;
if (col >= 0)
{
#ifndef FIXQ
Col_degree [col] -= nrows_to_assemble ;
#endif
Fcol = Fcblock + Fcpos [col] ;
#pragma ivdep
for (i = 0 ; i < nrows_to_assemble ; i++)
{
/* Fcol [Wm [i]] += S [Woo [i]] ; */
ASSEMBLE (Fcol [Wm [i]], S [Woo [i]]) ;
}
}
S += nrows ;
}
}
/* ] done using Woo,Wm */
ep->nrowsleft = extcdeg ;
}
}
}
}
/* Note that garbage collection, and build tuples */
/* both destroy the son list. */
/* ] son_list now empty */
/* ---------------------------------------------------------------------- */
/* If frontal matrix extended, assemble old L/Usons from new rows/cols */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* SCAN2-row: assemble rows of old Lsons from the new rows */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG7 (("Current frontal matrix: (prior to scan2-row)\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
/* rescan the pivot row */
if (Work->any_skip)
{
row_assemble (Work->pivrow, Numeric, Work) ;
}
if (Work->do_scan2row)
{
for (i2 = Work->fscan_row ; i2 < fnrows ; i2++)
{
/* Get a row */
row = Work->NewRows [i2] ;
if (row < 0) row = FLIP (row) ;
ASSERT (row >= 0 && row < n_row) ;
if (!(row == Work->pivrow && Work->any_skip))
{
/* assemble it */
row_assemble (row, Numeric, Work) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* SCAN2-col: assemble columns of old Usons from the new columns */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG7 (("Current frontal matrix: (prior to scan2-col)\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
/* rescan the pivot col */
if (Work->any_skip)
{
col_assemble (Work->pivcol, Numeric, Work) ;
}
if (Work->do_scan2col)
{
for (j2 = Work->fscan_col ; j2 < fncols ; j2++)
{
/* Get a column */
col = Work->NewCols [j2] ;
if (col < 0) col = FLIP (col) ;
ASSERT (col >= 0 && col < n_col) ;
if (!(col == Work->pivcol && Work->any_skip))
{
/* assemble it */
col_assemble (col, Numeric, Work) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* done. the remainder of this routine is used only when in debug mode */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
/* ---------------------------------------------------------------------- */
/* when debugging: make sure the assembly did everything that it could */
/* ---------------------------------------------------------------------- */
DEBUG3 (("::Assemble done\n")) ;
for (i2 = 0 ; i2 < fnrows ; i2++)
{
/* Get a row */
row = Work->Frows [i2] ;
ASSERT (row >= 0 && row < n_row) ;
DEBUG6 (("DEBUG SCAN 1: "ID"\n", row)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
ASSERT (NON_PIVOTAL_ROW (row)) ;
tpi = Row_tuples [row] ;
if (!tpi) continue ;
tp = (Tuple *) (Memory + tpi) ;
tpend = tp + Row_tlen [row] ;
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 = ((Int *) p) + ep->ncols ;
if (Rows [f] == EMPTY) continue ; /* row already assembled */
ASSERT (row == Rows [f]) ;
extrdeg = (ep->rdeg < rdeg0) ? ep->ncolsleft : (ep->rdeg - rdeg0) ;
extcdeg = (ep->cdeg < cdeg0) ? ep->nrowsleft : (ep->cdeg - cdeg0) ;
DEBUG6 ((
"e "ID" After assembly ext row deg: "ID" ext col degree "ID"\n",
e, extrdeg, extcdeg)) ;
if (Work->any_skip)
{
/* no Lsons in any row, except for very tall and thin ones */
ASSERT (extrdeg >= 0) ;
if (extrdeg == 0)
{
/* this is an unassemble Lson */
ASSERT (ep->ncols == 1) ;
ASSERT (ep->ncolsleft == 1) ;
col = Cols [0] ;
ASSERT (col != Work->pivcol) ;
}
}
else
{
/* no Lsons in any row */
ASSERT (extrdeg > 0) ;
/* Uson external row degree is = number of cols left */
ASSERT (IMPLIES (extcdeg == 0, extrdeg == ep->ncolsleft)) ;
}
}
}
/* ---------------------------------------------------------------------- */
for (j2 = 0 ; j2 < fncols ; j2++)
{
/* Get a column */
col = Work->Fcols [j2] ;
ASSERT (col >= 0 && col < n_col) ;
DEBUG6 (("DEBUG SCAN 2: "ID"\n", col)) ;
#ifndef FIXQ
UMF_dump_rowcol (1, Numeric, Work, col, TRUE) ;
#else
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
ASSERT (NON_PIVOTAL_COL (col)) ;
tpi = Col_tuples [col] ;
if (!tpi) continue ;
tp = (Tuple *) (Memory + tpi) ;
tpend = tp + Col_tlen [col] ;
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 = ((Int *) p) + ep->ncols ;
if (Cols [f] == EMPTY) continue ; /* column already assembled */
ASSERT (col == Cols [f]) ;
extrdeg = (ep->rdeg < rdeg0) ? ep->ncolsleft : (ep->rdeg - rdeg0) ;
extcdeg = (ep->cdeg < cdeg0) ? ep->nrowsleft : (ep->cdeg - cdeg0) ;
DEBUG6 (("e "ID" After assembly ext col deg: "ID"\n", e, extcdeg)) ;
if (Work->any_skip)
{
/* no Usons in any column, except for very tall and thin ones */
ASSERT (extcdeg >= 0) ;
if (extcdeg == 0)
{
/* this is an unassemble Uson */
ASSERT (ep->nrows == 1) ;
ASSERT (ep->nrowsleft == 1) ;
row = Rows [0] ;
ASSERT (row != Work->pivrow) ;
}
}
else
{
/* no Usons in any column */
ASSERT (extcdeg > 0) ;
/* Lson external column degree is = number of rows left */
ASSERT (IMPLIES (extrdeg == 0, extcdeg == ep->nrowsleft)) ;
}
}
}
#endif /* NDEBUG */
}
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) ;
}
PRIVATE void col_assemble
(
Int col,
NumericType *Numeric,
WorkType *Work
)
{
Entry *S, *Fcblock, *Fcol ;
Int tpi, e, *E, *Fcpos, *Frpos, *Row_degree, *Col_tuples, *Col_tlen, cdeg0,
f, nrows, ncols, *Rows, *Cols, row, nrowsleft, i ;
Tuple *tp, *tp1, *tp2, *tpend ;
Unit *Memory, *p ;
Element *ep ;
#if !defined (FIXQ) || !defined (NDEBUG)
Int *Col_degree ;
Col_degree = Numeric->Cperm ;
#endif
Col_tuples = Numeric->Lip ;
tpi = Col_tuples [col] ;
if (!tpi) return ;
Memory = Numeric->Memory ;
E = Work->E ;
Fcpos = Work->Fcpos ;
Frpos = Work->Frpos ;
Row_degree = Numeric->Rperm ;
Col_tlen = Numeric->Lilen ;
E = Work->E ;
Memory = Numeric->Memory ;
cdeg0 = Work->cdeg0 ;
Fcblock = Work->Fcblock ;
DEBUG6 (("SCAN2-col: "ID"\n", col)) ;
#ifndef NDEBUG
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
ASSERT (NON_PIVOTAL_COL (col)) ;
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Col_tlen [col] ;
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 ; /* col already assembled */
ASSERT (col == Cols [f] && col >= 0 && col < Work->n_col) ;
if (ep->cdeg == cdeg0)
{
/* ------------------------------------------------------ */
/* this is an old Uson - assemble just one col */
/* ------------------------------------------------------ */
/* flag the col as assembled from the Uson */
Cols [f] = EMPTY ;
nrows = ep->nrows ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
p += UNITS (Int, ncols + nrows) ;
S = ((Entry *) p) + f * nrows ;
DEBUG6 (("Old USON: "ID"\n", e)) ;
#ifndef NDEBUG
UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif
nrowsleft = ep->nrowsleft ;
Fcol = Fcblock + Fcpos [col] ;
DEBUG6 (("USON found (in scan2-col): "ID"\n", e)) ;
#ifndef FIXQ
Col_degree [col] -= nrowsleft ;
#endif
if (nrows == nrowsleft)
{
/* -------------------------------------------------- */
/* no rows assembled out of this Uson yet */
/* -------------------------------------------------- */
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
ASSERT (row >= 0 && row < Work->n_row) ;
Row_degree [row]-- ;
/* Fcol [Frpos [row]] += S [i] ; */
ASSEMBLE (Fcol [Frpos [row]], S [i]) ;
}
}
else
{
/* -------------------------------------------------- */
/* some rows have been assembled out of this Uson */
/* -------------------------------------------------- */
#pragma ivdep
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
if (row >= 0)
{
ASSERT (row < Work->n_row) ;
Row_degree [row]-- ;
/* Fcol [Frpos [row]] += S [i] ; */
ASSEMBLE (Fcol [Frpos [row]], S [i]) ;
}
}
}
ep->ncolsleft-- ;
ASSERT (ep->ncolsleft > 0) ;
}
else
{
*tp2++ = *tp ; /* leave the tuple in the list */
}
}
Col_tlen [col] = tp2 - tp1 ;
#ifndef NDEBUG
DEBUG7 (("Column assembled in scan2-col: "ID"\n", col)) ;
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
DEBUG7 (("Current frontal matrix: after scan2-col\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
}
GLOBAL Int UMF_row_search
(
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic,
Int cdeg0, /* length of column in Front */
Int cdeg1, /* length of column outside Front */
const Int Pattern [ ], /* pattern of column, Pattern [0..cdeg1 -1] */
const Int Pos [ ], /* Pos [Pattern [0..cdeg1 -1]] = 0..cdeg1 -1 */
Int pivrow [2], /* pivrow [IN] and pivrow [OUT] */
Int rdeg [2], /* rdeg [IN] and rdeg [OUT] */
Int W_i [ ], /* pattern of pivrow [IN], */
/* either Fcols or Woi */
Int W_o [ ], /* pattern of pivrow [OUT], */
/* either Wio or Woo */
Int prior_pivrow [2], /* the two other rows just scanned, if any */
const Entry Wxy [ ], /* numerical values Wxy [0..cdeg1-1],
either Wx or Wy */
Int pivcol, /* the candidate column being searched */
Int freebie [ ]
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double maxval, toler, toler2, value, pivot [2] ;
Int i, row, deg, col, *Frpos, fnrows, *E, j, ncols, *Cols, *Rows,
e, f, Wrpflag, *Fcpos, fncols, tpi, max_rdeg, nans_in_col, was_offdiag,
diag_row, prefer_diagonal, *Wrp, found, *Diagonal_map ;
Tuple *tp, *tpend, *tp1, *tp2 ;
Unit *Memory, *p ;
Element *ep ;
Int *Row_tuples, *Row_degree, *Row_tlen ;
#ifndef NDEBUG
Int *Col_degree ;
DEBUG2 (("Row_search:\n")) ;
for (i = 0 ; i < cdeg1 ; i++)
{
row = Pattern [i] ;
DEBUG4 ((" row: "ID"\n", row)) ;
ASSERT (row >= 0 && row < Numeric->n_row) ;
ASSERT (i == Pos [row]) ;
}
/* If row is not in Pattern [0..cdeg1-1], then Pos [row] == EMPTY */
if (UMF_debug > 0 || Numeric->n_row < 1000)
{
Int cnt = cdeg1 ;
DEBUG4 (("Scan all rows:\n")) ;
for (row = 0 ; row < Numeric->n_row ; row++)
{
if (Pos [row] < 0)
{
cnt++ ;
}
else
{
DEBUG4 ((" row: "ID" pos "ID"\n", row, Pos [row])) ;
}
}
ASSERT (cnt == Numeric->n_row) ;
}
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro only */
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
ASSERT (NON_PIVOTAL_COL (pivcol)) ;
#endif
pivot [IN] = 0. ;
pivot [OUT] = 0. ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
Row_degree = Numeric->Rperm ;
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Wrp = Work->Wrp ;
Frpos = Work->Frpos ;
E = Work->E ;
Memory = Numeric->Memory ;
fnrows = Work->fnrows ;
prefer_diagonal = Symbolic->prefer_diagonal ;
Diagonal_map = Work->Diagonal_map ;
if (Diagonal_map)
{
diag_row = Diagonal_map [pivcol] ;
was_offdiag = diag_row < 0 ;
if (was_offdiag)
{
/* the "diagonal" entry in this column was permuted here by an
* earlier pivot choice. The tighter off-diagonal tolerance will
* be used instead of the symmetric tolerance. */
diag_row = FLIP (diag_row) ;
}
ASSERT (diag_row >= 0 && diag_row < Numeric->n_row) ;
}
else
{
diag_row = EMPTY ; /* unused */
was_offdiag = EMPTY ; /* unused */
}
/* pivot row degree cannot exceed max_rdeg */
max_rdeg = Work->fncols_max ;
/* ---------------------------------------------------------------------- */
/* scan pivot column for candidate rows */
/* ---------------------------------------------------------------------- */
maxval = 0.0 ;
nans_in_col = FALSE ;
for (i = 0 ; i < cdeg1 ; i++)
{
APPROX_ABS (value, Wxy [i]) ;
if (SCALAR_IS_NAN (value))
{
nans_in_col = TRUE ;
maxval = value ;
break ;
}
/* This test can now ignore the NaN case: */
maxval = MAX (maxval, value) ;
}
/* if maxval is zero, the matrix is numerically singular */
toler = Numeric->relpt * maxval ;
toler2 = Numeric->relpt2 * maxval ;
toler2 = was_offdiag ? toler : toler2 ;
DEBUG5 (("Row_search begins [ maxval %g toler %g %g\n",
maxval, toler, toler2)) ;
if (SCALAR_IS_NAN (toler) || SCALAR_IS_NAN (toler2))
{
nans_in_col = TRUE ;
}
if (!nans_in_col)
{
/* look for the diagonal entry, if it exists */
found = FALSE ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (prefer_diagonal)
{
ASSERT (diag_row != EMPTY) ;
i = Pos [diag_row] ;
if (i >= 0)
{
double a ;
ASSERT (i < cdeg1) ;
ASSERT (diag_row == Pattern [i]) ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler2)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler2)
{
/* found it! */
DEBUG3 (("Symmetric pivot: "ID" "ID"\n", pivcol, diag_row));
found = TRUE ;
if (Frpos [diag_row] >= 0 && Frpos [diag_row] < fnrows)
{
pivrow [IN] = diag_row ;
pivrow [OUT] = EMPTY ;
}
else
{
pivrow [IN] = EMPTY ;
pivrow [OUT] = diag_row ;
}
}
}
}
/* either no diagonal found, or we didn't look for it */
if (!found)
{
if (cdeg0 > 0)
{
/* this is a column in the front */
for (i = 0 ; i < cdeg0 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
ASSERT (Frpos [row] >= 0 && Frpos [row] < fnrows) ;
ASSERT (Frpos [row] == i) ;
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN]
/* break ties by picking the largest entry: */
|| (deg == rdeg [IN] && a > pivot [IN])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [IN] && row == diag_row) */
)
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
pivot [IN] = a ;
}
}
}
for ( ; i < cdeg1 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
ASSERT (Frpos [row] == i) ;
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT]
/* break ties by picking the largest entry: */
|| (deg == rdeg [OUT] && a > pivot [OUT])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [OUT] && row == diag_row) */
)
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
pivot [OUT] = a ;
}
}
}
}
else
{
/* this column is not in the front */
for (i = 0 ; i < cdeg1 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN]
/* break ties by picking the largest entry: */
|| (deg == rdeg [IN] && a > pivot [IN])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [IN] && row == diag_row) */
)
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
pivot [IN] = a ;
}
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT]
/* break ties by picking the largest entry: */
|| (deg == rdeg[OUT] && a > pivot [OUT])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg[OUT] && row == diag_row) */
)
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
pivot [OUT] = a ;
}
}
}
}
}
}
}
/* ---------------------------------------------------------------------- */
/* NaN handling */
/* ---------------------------------------------------------------------- */
/* if cdeg1 > 0 then we must have found a pivot row ... unless NaN's */
/* exist. Try with no numerical tests if no pivot found. */
if (cdeg1 > 0 && pivrow [IN] == EMPTY && pivrow [OUT] == EMPTY)
{
/* cleanup for the NaN case */
DEBUG0 (("Found a NaN in pivot column!\n")) ;
/* grab the first entry in the pivot column, ignoring degree, */
/* numerical stability, and symmetric preference */
row = Pattern [0] ;
deg = Row_degree [row] ;
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
pivrow [IN] = row ;
rdeg [IN] = deg ;
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
}
/* We are now guaranteed to have a pivot, no matter how broken */
/* (non-IEEE compliant) the underlying numerical operators are. */
/* This is particularly a problem for Microsoft compilers (they do */
/* not handle NaN's properly). Now try to find a sparser pivot, if */
/* possible. */
for (i = 1 ; i < cdeg1 ; i++)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN] || (deg == rdeg [IN] && row == diag_row))
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
}
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT] || (deg == rdeg [OUT] && row == diag_row))
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
}
}
}
}
/* We found a pivot if there are entries (even zero ones) in pivot col */
ASSERT (IMPLIES (cdeg1 > 0, pivrow[IN] != EMPTY || pivrow[OUT] != EMPTY)) ;
/* If there are no entries in the pivot column, then no pivot is found */
ASSERT (IMPLIES (cdeg1 == 0, pivrow[IN] == EMPTY && pivrow[OUT] == EMPTY)) ;
/* ---------------------------------------------------------------------- */
/* check for singular matrix */
/* ---------------------------------------------------------------------- */
if (cdeg1 == 0)
{
if (fnrows > 0)
{
/*
Get the pivrow [OUT][IN] from the current front.
The frontal matrix looks like this:
pivcol[OUT]
|
v
x x x x 0 <- so grab this row as the pivrow [OUT][IN].
x x x x 0
x x x x 0
0 0 0 0 0
The current frontal matrix has some rows in it. The degree
of the pivcol[OUT] is zero. The column is empty, and the
current front does not contribute to it.
*/
pivrow [IN] = Work->Frows [0] ;
DEBUGm4 (("Got zero pivrow[OUT][IN] "ID" from current front\n",
pivrow [IN])) ;
}
else
{
/*
Get a pivot row from the row-merge tree, use as
pivrow [OUT][OUT]. pivrow [IN] remains EMPTY.
This can only happen if the current front is 0-by-0.
*/
Int *Front_leftmostdesc, *Front_1strow, *Front_new1strow, row1,
row2, fleftmost, nfr, n_row, frontid ;
ASSERT (Work->fncols == 0) ;
Front_leftmostdesc = Symbolic->Front_leftmostdesc ;
Front_1strow = Symbolic->Front_1strow ;
Front_new1strow = Work->Front_new1strow ;
nfr = Symbolic->nfr ;
n_row = Numeric->n_row ;
frontid = Work->frontid ;
DEBUGm4 (("Note: pivcol: "ID" is empty front "ID"\n",
pivcol, frontid)) ;
#ifndef NDEBUG
DEBUG1 (("Calling dump rowmerge\n")) ;
UMF_dump_rowmerge (Numeric, Symbolic, Work) ;
#endif
/* Row-merge set is the non-pivotal rows in the range */
/* Front_new1strow [Front_leftmostdesc [frontid]] to */
/* Front_1strow [frontid+1] - 1. */
/* If this is empty, then use the empty rows, in the range */
/* Front_new1strow [nfr] to n_row-1. */
/* If this too is empty, then pivrow [OUT] will be empty. */
/* In both cases, update Front_new1strow [...]. */
fleftmost = Front_leftmostdesc [frontid] ;
row1 = Front_new1strow [fleftmost] ;
row2 = Front_1strow [frontid+1] - 1 ;
DEBUG1 (("Leftmost: "ID" Rows ["ID" to "ID"] srch ["ID" to "ID"]\n",
fleftmost, Front_1strow [frontid], row2, row1, row2)) ;
/* look in the range row1 ... row2 */
for (row = row1 ; row <= row2 ; row++)
{
DEBUG3 ((" Row: "ID"\n", row)) ;
if (NON_PIVOTAL_ROW (row))
{
/* found it */
DEBUG3 ((" Row: "ID" found\n", row)) ;
ASSERT (Frpos [row] == EMPTY) ;
pivrow [OUT] = row ;
DEBUGm4 (("got row merge pivrow %d\n", pivrow [OUT])) ;
break ;
}
}
Front_new1strow [fleftmost] = row ;
if (pivrow [OUT] == EMPTY)
{
/* not found, look in empty row set in "dummy" front */
row1 = Front_new1strow [nfr] ;
row2 = n_row-1 ;
DEBUG3 (("Empty: "ID" Rows ["ID" to "ID"] srch["ID" to "ID"]\n",
nfr, Front_1strow [nfr], row2, row1, row2)) ;
/* look in the range row1 ... row2 */
for (row = row1 ; row <= row2 ; row++)
{
DEBUG3 ((" Empty Row: "ID"\n", row)) ;
if (NON_PIVOTAL_ROW (row))
{
/* found it */
DEBUG3 ((" Empty Row: "ID" found\n", row)) ;
ASSERT (Frpos [row] == EMPTY) ;
pivrow [OUT] = row ;
DEBUGm4 (("got dummy row pivrow %d\n", pivrow [OUT])) ;
break ;
}
}
Front_new1strow [nfr] = row ;
}
if (pivrow [OUT] == EMPTY)
{
/* Row-merge set is empty. We can just discard */
/* the candidate pivot column. */
DEBUG0 (("Note: row-merge set empty\n")) ;
DEBUGm4 (("got no pivrow \n")) ;
return (UMFPACK_WARNING_singular_matrix) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* construct the candidate row in the front, if any */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
/* check Wrp */
ASSERT (Work->Wrpflag > 0) ;
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
#ifndef NDEBUG
DEBUG4 (("pivrow [IN]: "ID"\n", pivrow [IN])) ;
UMF_dump_rowcol (0, Numeric, Work, pivrow [IN], TRUE) ;
#endif
if (pivrow [IN] != EMPTY)
{
/* the row merge candidate row is not pivrow [IN] */
freebie [IN] = (pivrow [IN] == prior_pivrow [IN]) && (cdeg1 > 0) ;
ASSERT (cdeg1 >= 0) ;
if (!freebie [IN])
{
/* include current front in the degree of this row */
Fcpos = Work->Fcpos ;
fncols = Work->fncols ;
Wrpflag = Work->Wrpflag ;
/* -------------------------------------------------------------- */
/* construct the pattern of the IN row */
/* -------------------------------------------------------------- */
#ifndef NDEBUG
/* check Fcols */
DEBUG5 (("ROW ASSEMBLE: rdeg "ID"\nREDUCE ROW "ID"\n",
fncols, pivrow [IN])) ;
for (j = 0 ; j < fncols ; j++)
{
col = Work->Fcols [j] ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (Fcpos [col] >= 0) ;
}
if (UMF_debug > 0 || Work->n_col < 1000)
{
Int cnt = fncols ;
for (col = 0 ; col < Work->n_col ; col++)
{
if (Fcpos [col] < 0) cnt++ ;
}
ASSERT (cnt == Work->n_col) ;
}
#endif
rdeg [IN] = fncols ;
ASSERT (pivrow [IN] >= 0 && pivrow [IN] < Work->n_row) ;
ASSERT (NON_PIVOTAL_ROW (pivrow [IN])) ;
/* add the pivot column itself */
ASSERT (Wrp [pivcol] != Wrpflag) ;
if (Fcpos [pivcol] < 0)
{
DEBUG3 (("Adding pivot col to pivrow [IN] pattern\n")) ;
if (rdeg [IN] >= max_rdeg)
{
/* :: pattern change (in) :: */
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [pivcol] = Wrpflag ;
W_i [rdeg [IN]++] = pivcol ;
}
tpi = Row_tuples [pivrow [IN]] ;
if (tpi)
{
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [pivrow [IN]] ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
if (Rows [f] == EMPTY)
{
continue ; /* row already assembled */
}
ASSERT (pivrow [IN] == Rows [f]) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= EMPTY && col < Work->n_col) ;
if ((col >= 0) && (Wrp [col] != Wrpflag)
&& Fcpos [col] <0)
{
ASSERT (NON_PIVOTAL_COL (col)) ;
if (rdeg [IN] >= max_rdeg)
{
/* :: pattern change (rdeg in failure) :: */
DEBUGm4 (("rdeg [IN] >= max_rdeg failure\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [col] = Wrpflag ;
W_i [rdeg [IN]++] = col ;
}
}
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [pivrow [IN]] = tp2 - tp1 ;
}
#ifndef NDEBUG
DEBUG4 (("Reduced IN row:\n")) ;
for (j = 0 ; j < fncols ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n",
j, Work->Fcols [j], Fcpos [Work->Fcols [j]])) ;
ASSERT (Fcpos [Work->Fcols [j]] >= 0) ;
}
for (j = fncols ; j < rdeg [IN] ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n", j, W_i [j], Wrp [W_i [j]]));
ASSERT (W_i [j] >= 0 && W_i [j] < Work->n_col) ;
ASSERT (Wrp [W_i [j]] == Wrpflag) ;
}
/* mark the end of the pattern in case we scan it by mistake */
/* Note that this means W_i must be of size >= fncols_max + 1 */
W_i [rdeg [IN]] = EMPTY ;
#endif
/* rdeg [IN] is now the exact degree of the IN row */
/* clear Work->Wrp. */
Work->Wrpflag++ ;
/* All Wrp [0..n_col] is now < Wrpflag */
}
}
#ifndef NDEBUG
/* check Wrp */
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
/* ---------------------------------------------------------------------- */
/* construct the candidate row not in the front, if any */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG4 (("pivrow [OUT]: "ID"\n", pivrow [OUT])) ;
UMF_dump_rowcol (0, Numeric, Work, pivrow [OUT], TRUE) ;
#endif
/* If this is a candidate row from the row merge set, force it to be */
/* scanned (ignore prior_pivrow [OUT]). */
if (pivrow [OUT] != EMPTY)
{
freebie [OUT] = (pivrow [OUT] == prior_pivrow [OUT]) && cdeg1 > 0 ;
ASSERT (cdeg1 >= 0) ;
if (!freebie [OUT])
{
Wrpflag = Work->Wrpflag ;
/* -------------------------------------------------------------- */
/* construct the pattern of the row */
/* -------------------------------------------------------------- */
rdeg [OUT] = 0 ;
ASSERT (pivrow [OUT] >= 0 && pivrow [OUT] < Work->n_row) ;
ASSERT (NON_PIVOTAL_ROW (pivrow [OUT])) ;
/* add the pivot column itself */
ASSERT (Wrp [pivcol] != Wrpflag) ;
DEBUG3 (("Adding pivot col to pivrow [OUT] pattern\n")) ;
if (rdeg [OUT] >= max_rdeg)
{
/* :: pattern change (out) :: */
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [pivcol] = Wrpflag ;
W_o [rdeg [OUT]++] = pivcol ;
tpi = Row_tuples [pivrow [OUT]] ;
if (tpi)
{
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [pivrow [OUT]] ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
if (Rows [f] == EMPTY)
{
continue ; /* row already assembled */
}
ASSERT (pivrow [OUT] == Rows [f]) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= EMPTY && col < Work->n_col) ;
if ((col >= 0) && (Wrp [col] != Wrpflag))
{
ASSERT (NON_PIVOTAL_COL (col)) ;
if (rdeg [OUT] >= max_rdeg)
{
/* :: pattern change (rdeg out failure) :: */
DEBUGm4 (("rdeg [OUT] failure\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [col] = Wrpflag ;
W_o [rdeg [OUT]++] = col ;
}
}
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [pivrow [OUT]] = tp2 - tp1 ;
}
#ifndef NDEBUG
DEBUG4 (("Reduced row OUT:\n")) ;
for (j = 0 ; j < rdeg [OUT] ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n", j, W_o [j], Wrp [W_o [j]])) ;
ASSERT (W_o [j] >= 0 && W_o [j] < Work->n_col) ;
ASSERT (Wrp [W_o [j]] == Wrpflag) ;
}
/* mark the end of the pattern in case we scan it by mistake */
/* Note that this means W_o must be of size >= fncols_max + 1 */
W_o [rdeg [OUT]] = EMPTY ;
#endif
/* rdeg [OUT] is now the exact degree of the row */
/* clear Work->Wrp. */
Work->Wrpflag++ ;
/* All Wrp [0..n] is now < Wrpflag */
}
}
DEBUG5 (("Row_search end ] \n")) ;
#ifndef NDEBUG
/* check Wrp */
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
return (UMFPACK_OK) ;
}
GLOBAL void UMF_scale_column
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry pivot_value ;
Entry *Fcol, *Flublock, *Flblock, *Fublock, *Fcblock ;
Int k, k1, fnr_curr, fnrows, fncols, *Frpos, *Fcpos, pivrow, pivcol,
*Frows, *Fcols, fnc_curr, fnpiv, *Row_tuples, nb,
*Col_tuples, *Rperm, *Cperm, fspos, col2, row2 ;
#ifndef NDEBUG
Int *Col_degree, *Row_degree ;
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
fnrows = Work->fnrows ;
fncols = Work->fncols ;
fnpiv = Work->fnpiv ;
/* ---------------------------------------------------------------------- */
Rperm = Numeric->Rperm ;
Cperm = Numeric->Cperm ;
/* ---------------------------------------------------------------------- */
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
Fcblock = Work->Fcblock ;
fnr_curr = Work->fnr_curr ;
fnc_curr = Work->fnc_curr ;
Frpos = Work->Frpos ;
Fcpos = Work->Fcpos ;
Frows = Work->Frows ;
Fcols = Work->Fcols ;
pivrow = Work->pivrow ;
pivcol = Work->pivcol ;
ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
#ifndef NDEBUG
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
#endif
Row_tuples = Numeric->Uip ;
Col_tuples = Numeric->Lip ;
nb = Work->nb ;
#ifndef NDEBUG
ASSERT (fnrows == Work->fnrows_new + 1) ;
ASSERT (fncols == Work->fncols_new + 1) ;
DEBUG1 (("SCALE COL: 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 (Fcblock, fnr_curr, fnrows, fncols) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Flblock, fnr_curr, fnrows, fnpiv);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Fublock, fnc_curr, fncols, fnpiv) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Flublock, nb, fnpiv, fnpiv) ;
#endif
/* ====================================================================== */
/* === Shift pivot row and column ======================================= */
/* ====================================================================== */
/* ---------------------------------------------------------------------- */
/* move pivot column into place */
/* ---------------------------------------------------------------------- */
/* Note that the pivot column is already in place. Just shift the last
* column into the position vacated by the pivot column. */
fspos = Fcpos [pivcol] ;
/* one less column in the contribution block */
fncols = --(Work->fncols) ;
if (fspos != fncols * fnr_curr)
{
Int fs = fspos / fnr_curr ;
DEBUG6 (("Shift pivot column in front\n")) ;
DEBUG6 (("fspos: "ID" flpos: "ID"\n", fspos, fncols * fnr_curr)) ;
/* ------------------------------------------------------------------ */
/* move Fe => Fs */
/* ------------------------------------------------------------------ */
/* column of the contribution block: */
{
/* Fs: current position of pivot column in contribution block */
/* Fe: position of last column in contribution block */
Int i ;
Entry *Fs, *Fe ;
Fs = Fcblock + fspos ;
Fe = Fcblock + fncols * fnr_curr ;
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
Fs [i] = Fe [i] ;
}
}
/* column of the U2 block */
{
/* Fs: current position of pivot column in U block */
/* Fe: last column in U block */
Int i ;
Entry *Fs, *Fe ;
Fs = Fublock + fs ;
Fe = Fublock + fncols ;
#pragma ivdep
for (i = 0 ; i < fnpiv ; i++)
{
Fs [i * fnc_curr] = Fe [i * fnc_curr] ;
}
}
/* move column Fe to Fs in the Fcols pattern */
col2 = Fcols [fncols] ;
Fcols [fs] = col2 ;
Fcpos [col2] = fspos ;
}
/* pivot column is no longer in the frontal matrix */
Fcpos [pivcol] = EMPTY ;
#ifndef NDEBUG
DEBUG2 (("\nFrontal matrix after col swap, 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 (Fcblock, fnr_curr, fnrows, fncols) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Flblock, fnr_curr, fnrows, fnpiv+1);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Fublock, fnc_curr, fncols, fnpiv) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Flublock, nb, fnpiv, fnpiv+1) ;
#endif
/* ---------------------------------------------------------------------- */
/* move pivot row into place */
/* ---------------------------------------------------------------------- */
fspos = Frpos [pivrow] ;
/* one less row in the contribution block */
fnrows = --(Work->fnrows) ;
DEBUG6 (("Swap/shift pivot row in front:\n")) ;
DEBUG6 (("fspos: "ID" flpos: "ID"\n", fspos, fnrows)) ;
if (fspos == fnrows)
{
/* ------------------------------------------------------------------ */
/* move Fs => Fd */
/* ------------------------------------------------------------------ */
DEBUG6 (("row case 1\n")) ;
/* row of the contribution block: */
{
Int j ;
Entry *Fd, *Fs ;
Fd = Fublock + fnpiv * fnc_curr ;
Fs = Fcblock + fspos ;
#pragma ivdep
for (j = 0 ; j < fncols ; j++)
{
Fd [j] = Fs [j * fnr_curr] ;
}
}
/* row of the L2 block: */
if (Work->pivrow_in_front)
{
Int j ;
Entry *Fd, *Fs ;
Fd = Flublock + fnpiv ;
Fs = Flblock + fspos ;
#pragma ivdep
for (j = 0 ; j <= fnpiv ; j++)
{
Fd [j * nb] = Fs [j * fnr_curr] ;
}
}
else
{
Int j ;
Entry *Fd, *Fs ;
Fd = Flublock + fnpiv ;
Fs = Flblock + fspos ;
#pragma ivdep
for (j = 0 ; j < fnpiv ; j++)
{
ASSERT (IS_ZERO (Fs [j * fnr_curr])) ;
CLEAR (Fd [j * nb]) ;
}
Fd [fnpiv * nb] = Fs [fnpiv * fnr_curr] ;
}
}
else
{
/* ------------------------------------------------------------------ */
/* move Fs => Fd */
/* move Fe => Fs */
/* ------------------------------------------------------------------ */
DEBUG6 (("row case 2\n")) ;
/* this is the most common case, by far */
/* row of the contribution block: */
{
/* Fd: destination of pivot row on U block */
/* Fs: current position of pivot row in contribution block */
/* Fe: position of last row in contribution block */
Entry *Fd, *Fs, *Fe ;
Fd = Fublock + fnpiv * fnc_curr ;
Fs = Fcblock + fspos ;
Fe = Fcblock + fnrows ;
shift_pivot_row (Fd, Fs, Fe, fncols, fnr_curr) ;
}
/* row of the L2 block: */
if (Work->pivrow_in_front)
{
/* Fd: destination of pivot row in LU block */
/* Fs: current position of pivot row in L block */
/* Fe: last row in L block */
Int j ;
Entry *Fd, *Fs, *Fe ;
Fd = Flublock + fnpiv ;
Fs = Flblock + fspos ;
Fe = Flblock + fnrows ;
#pragma ivdep
for (j = 0 ; j <= fnpiv ; j++)
{
Fd [j * nb] = Fs [j * fnr_curr] ;
Fs [j * fnr_curr] = Fe [j * fnr_curr] ;
}
}
else
{
Int j ;
Entry *Fd, *Fs, *Fe ;
Fd = Flublock + fnpiv ;
Fs = Flblock + fspos ;
Fe = Flblock + fnrows ;
#pragma ivdep
for (j = 0 ; j < fnpiv ; j++)
{
ASSERT (IS_ZERO (Fs [j * fnr_curr])) ;
CLEAR (Fd [j * nb]) ;
Fs [j * fnr_curr] = Fe [j * fnr_curr] ;
}
Fd [fnpiv * nb] = Fs [fnpiv * fnr_curr] ;
Fs [fnpiv * fnr_curr] = Fe [fnpiv * fnr_curr] ;
}
/* move row Fe to Fs in the Frows pattern */
row2 = Frows [fnrows] ;
Frows [fspos] = row2 ;
Frpos [row2] = fspos ;
}
/* pivot row is no longer in the frontal matrix */
Frpos [pivrow] = EMPTY ;
#ifndef NDEBUG
DEBUG2 (("\nFrontal matrix after row swap, including all space:\n"
"fnr_curr "ID" fnc_curr "ID" nb "ID"\n"
"fnrows "ID" fncols "ID" fnpiv "ID"\n",
Work->fnr_curr, Work->fnc_curr, Work->nb,
Work->fnrows, Work->fncols, Work->fnpiv)) ;
DEBUG2 (("\nJust the active part:\n")) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (Fcblock, fnr_curr, fnrows, fncols) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Flblock, fnr_curr, fnrows, fnpiv+1);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Fublock, fnc_curr, fncols, fnpiv+1) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Flublock, nb, fnpiv+1, fnpiv+1) ;
#endif
/* ---------------------------------------------------------------------- */
/* Frpos [row] >= 0 for each row in pivot column pattern. */
/* offset into pattern is given by: */
/* Frpos [row] == offset - 1 */
/* Frpos [pivrow] is EMPTY */
/* Fcpos [col] >= 0 for each col in pivot row pattern. */
/* Fcpos [col] == (offset - 1) * fnr_curr */
/* Fcpos [pivcol] is EMPTY */
/* Fcols [0..fncols-1] is the pivot row pattern (excl pivot cols) */
/* Frows [0..fnrows-1] is the pivot col pattern (excl pivot rows) */
/* ====================================================================== */
/* === scale pivot column =============================================== */
/* ====================================================================== */
/* pivot column (except for pivot entry itself) */
Fcol = Flblock + fnpiv * fnr_curr ;
/* fnpiv-th pivot in frontal matrix located in Flublock (fnpiv, fnpiv) */
pivot_value = Flublock [fnpiv + fnpiv * nb] ;
/* this is the kth global pivot */
k = Work->npiv + fnpiv ;
DEBUG4 (("Pivot value: ")) ;
EDEBUG4 (pivot_value) ;
DEBUG4 (("\n")) ;
UMF_scale (fnrows, pivot_value, Fcol) ;
/* ---------------------------------------------------------------------- */
/* deallocate the pivot row and pivot column tuples */
/* ---------------------------------------------------------------------- */
UMF_mem_free_tail_block (Numeric, Row_tuples [pivrow]) ;
UMF_mem_free_tail_block (Numeric, Col_tuples [pivcol]) ;
Row_tuples [pivrow] = 0 ;
Col_tuples [pivcol] = 0 ;
DEBUG5 (("number of pivots prior to this one: "ID"\n", k)) ;
ASSERT (NON_PIVOTAL_ROW (pivrow)) ;
ASSERT (NON_PIVOTAL_COL (pivcol)) ;
/* save row and column inverse permutation */
k1 = ONES_COMPLEMENT (k) ;
Rperm [pivrow] = k1 ; /* aliased with Row_degree */
Cperm [pivcol] = k1 ; /* aliased with Col_degree */
ASSERT (!NON_PIVOTAL_ROW (pivrow)) ;
ASSERT (!NON_PIVOTAL_COL (pivcol)) ;
/* ---------------------------------------------------------------------- */
/* Keep track of the pivot order. This is the kth pivot row and column. */
/* ---------------------------------------------------------------------- */
/* keep track of pivot rows and columns in the LU, L, and U blocks */
ASSERT (fnpiv < MAXNB) ;
Work->Pivrow [fnpiv] = pivrow ;
Work->Pivcol [fnpiv] = pivcol ;
/* ====================================================================== */
/* === one step in the factorization is done ============================ */
/* ====================================================================== */
/* One more step is done, except for pending updates to the U and C blocks
* of this frontal matrix. Those are saved up, and applied by
* UMF_blas3_update when enough pivots have accumulated. Also, the
* LU factors for these pending pivots have not yet been stored. */
Work->fnpiv++ ;
#ifndef NDEBUG
DEBUG7 (("Current frontal matrix: (after pivcol scale)\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
}
GLOBAL Int UMF_tuple_lengths /* return memory usage */
(
NumericType *Numeric,
WorkType *Work,
double *p_dusage /* output argument */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double dusage ;
Int e, nrows, ncols, nel, i, *Rows, *Cols, row, col, n_row, n_col, *E,
*Row_degree, *Row_tlen, *Col_degree, *Col_tlen, usage, n1 ;
Element *ep ;
Unit *p ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
E = Work->E ;
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro only */
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro only */
Row_tlen = Numeric->Uilen ;
Col_tlen = Numeric->Lilen ;
n_row = Work->n_row ;
n_col = Work->n_col ;
n1 = Work->n1 ;
nel = Work->nel ;
DEBUG3 (("TUPLE_LENGTHS: n_row "ID" n_col "ID" nel "ID"\n",
n_row, n_col, nel)) ;
ASSERT (nel < Work->elen) ;
/* tuple list lengths already initialized to zero */
/* ---------------------------------------------------------------------- */
/* scan each element: count tuple list lengths (include element 0) */
/* ---------------------------------------------------------------------- */
for (e = 1 ; e <= nel ; e++) /* for all elements, in any order */
{
if (E [e])
{
#ifndef NDEBUG
UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif
p = Numeric->Memory + E [e] ;
GET_ELEMENT_PATTERN (ep, p, Cols, Rows, ncols) ;
nrows = ep->nrows ;
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
ASSERT (row == EMPTY || (row >= n1 && row < n_row)) ;
if (row >= n1)
{
ASSERT (NON_PIVOTAL_ROW (row)) ;
Row_tlen [row] ++ ;
}
}
for (i = 0 ; i < ncols ; i++)
{
col = Cols [i] ;
ASSERT (col == EMPTY || (col >= n1 && col < n_col)) ;
if (col >= n1)
{
ASSERT (NON_PIVOTAL_COL (col)) ;
Col_tlen [col] ++ ;
}
}
}
}
/* note: tuple lengths are now modified, but the tuple lists are not */
/* updated to reflect that fact. */
/* ---------------------------------------------------------------------- */
/* determine the required memory to hold all the tuple lists */
/* ---------------------------------------------------------------------- */
DEBUG0 (("UMF_build_tuples_usage\n")) ;
usage = 0 ;
dusage = 0 ;
ASSERT (Col_tlen && Col_degree) ;
for (col = n1 ; col < n_col ; col++)
{
if (NON_PIVOTAL_COL (col))
{
usage += 1 + UNITS (Tuple, TUPLES (Col_tlen [col])) ;
dusage += 1 + DUNITS (Tuple, TUPLES (Col_tlen [col])) ;
DEBUG0 ((" col: "ID" tlen "ID" usage so far: "ID"\n",
col, Col_tlen [col], usage)) ;
}
}
ASSERT (Row_tlen && Row_degree) ;
for (row = n1 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row))
{
usage += 1 + UNITS (Tuple, TUPLES (Row_tlen [row])) ;
dusage += 1 + DUNITS (Tuple, TUPLES (Row_tlen [row])) ;
DEBUG0 ((" row: "ID" tlen "ID" usage so far: "ID"\n",
row, Row_tlen [row], usage)) ;
}
}
DEBUG0 (("UMF_build_tuples_usage "ID" %g\n", usage, dusage)) ;
*p_dusage = dusage ;
return (usage) ;
}
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) ;
}
