GLOBAL Int UMF_mem_alloc_head_block
(
NumericType *Numeric,
Int nunits
)
{
Int p, usage ;
DEBUG2 (("GET BLOCK: from head, size "ID" ", nunits)) ;
ASSERT (Numeric != (NumericType *) NULL) ;
ASSERT (Numeric->Memory != (Unit *) NULL) ;
#ifndef NDEBUG
if (UMF_allocfail)
{
/* pretend to fail, to test garbage_collection */
DEBUGm2 (("UMF_mem_alloc_head_block: pretend to fail\n")) ;
UMF_allocfail = FALSE ; /* don't fail the next time */
return (0) ;
}
#endif
if (nunits > (Numeric->itail - Numeric->ihead))
{
DEBUG2 ((" failed\n")) ;
return (0) ;
}
/* return p as an offset from Numeric->Memory */
p = Numeric->ihead ;
Numeric->ihead += nunits ;
DEBUG2 (("p: "ID"\n", p)) ;
usage = Numeric->ihead + Numeric->tail_usage ;
Numeric->max_usage = MAX (Numeric->max_usage, usage) ;
return (p) ;
}
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")) ;
}
PRIVATE Int two_by_two /* returns # unmatched weak diagonals */
(
/* input, not modified */
Int n2, /* C is n2-by-n2 */
Int Cp [ ], /* size n2+1, column pointers for C */
Int Ci [ ], /* size snz = Cp [n2], row indices for C */
Int Degree [ ], /* Degree [i] = degree of row i of C+C' */
/* input, not defined on output */
Int Next [ ], /* Next [k] == IS_WEAK if k is a weak diagonal */
Int Ri [ ], /* Ri [i] is the length of row i in C */
/* output, not defined on input */
Int P [ ],
/* workspace, not defined on input or output */
Int Rp [ ],
Int Head [ ]
)
{
Int deg, newcol, row, col, p, p2, unmatched, k, j, j2, j_best, best, jdiff,
jdiff_best, jdeg, jdeg_best, cp, cp1, cp2, rp, rp1, rp2, maxdeg,
mindeg ;
/* ---------------------------------------------------------------------- */
/* place weak diagonals in the degree lists */
/* ---------------------------------------------------------------------- */
for (deg = 0 ; deg < n2 ; deg++)
{
Head [deg] = EMPTY ;
}
maxdeg = 0 ;
mindeg = Int_MAX ;
for (newcol = n2-1 ; newcol >= 0 ; newcol--)
{
if (Next [newcol] == IS_WEAK)
{
/* add this column to the list of weak nodes */
DEBUGm1 ((" newcol "ID" has a weak diagonal deg "ID"\n",
newcol, deg)) ;
deg = Degree [newcol] ;
ASSERT (deg >= 0 && deg < n2) ;
Next [newcol] = Head [deg] ;
Head [deg] = newcol ;
maxdeg = MAX (maxdeg, deg) ;
mindeg = MIN (mindeg, deg) ;
}
}
/* ---------------------------------------------------------------------- */
/* construct R = C' (C = strong entries in pruned submatrix) */
/* ---------------------------------------------------------------------- */
/* Ri [0..n2-1] is the length of each row of R */
/* use P as temporary pointer into the row form of R [ */
Rp [0] = 0 ;
for (row = 0 ; row < n2 ; row++)
{
Rp [row+1] = Rp [row] + Ri [row] ;
P [row] = Rp [row] ;
}
/* Ri no longer needed for row counts */
/* all entries in C are strong */
for (col = 0 ; col < n2 ; col++)
{
p2 = Cp [col+1] ;
for (p = Cp [col] ; p < p2 ; p++)
{
/* place the column index in row = Ci [p] */
Ri [P [Ci [p]]++] = col ;
}
}
/* contents of P no longer needed ] */
#ifndef NDEBUG
DEBUG0 (("==================R: row form of strong entries in A:\n")) ;
UMF_dump_col_matrix ((double *) NULL,
#ifdef COMPLEX
(double *) NULL,
#endif
Ri, Rp, n2, n2, Rp [n2]) ;
#endif
ASSERT (AMD_valid (n2, n2, Rp, Ri) == AMD_OK) ;
/* ---------------------------------------------------------------------- */
/* for each weak diagonal, find a pair of strong off-diagonal entries */
/* ---------------------------------------------------------------------- */
for (row = 0 ; row < n2 ; row++)
{
P [row] = EMPTY ;
}
unmatched = 0 ;
best = EMPTY ;
jdiff = EMPTY ;
jdeg = EMPTY ;
for (deg = mindeg ; deg <= maxdeg ; deg++)
{
/* find the next weak diagonal of lowest degree */
DEBUGm2 (("---------------------------------- Deg: "ID"\n", deg)) ;
for (k = Head [deg] ; k != EMPTY ; k = Next [k])
{
DEBUGm2 (("k: "ID"\n", k)) ;
if (P [k] == EMPTY)
{
/* C (k,k) is a weak diagonal entry. Find an index j != k such
* that C (j,k) and C (k,j) are both strong, and also such
* that Degree [j] is minimized. In case of a tie, pick
* the smallest index j. C and R contain the pattern of
* strong entries only.
*
* Note that row k of R and column k of C are both sorted. */
DEBUGm4 (("===== Weak diagonal k = "ID"\n", k)) ;
DEBUG1 (("Column k of C:\n")) ;
for (p = Cp [k] ; p < Cp [k+1] ; p++)
{
DEBUG1 ((" "ID": deg "ID"\n", Ci [p], Degree [Ci [p]]));
}
DEBUG1 (("Row k of R (strong entries only):\n")) ;
for (p = Rp [k] ; p < Rp [k+1] ; p++)
{
DEBUG1 ((" "ID": deg "ID"\n", Ri [p], Degree [Ri [p]]));
}
/* no (C (k,j), C (j,k)) pair exists yet */
j_best = EMPTY ;
jdiff_best = Int_MAX ;
jdeg_best = Int_MAX ;
/* pointers into column k (including values) */
cp1 = Cp [k] ;
cp2 = Cp [k+1] ;
cp = cp1 ;
/* pointers into row k (strong entries only, no values) */
rp1 = Rp [k] ;
rp2 = Rp [k+1] ;
rp = rp1 ;
/* while entries searched in column k and row k */
while (TRUE)
{
if (cp >= cp2)
{
/* no more entries in this column */
break ;
}
/* get C (j,k), which is strong */
j = Ci [cp] ;
if (rp >= rp2)
{
/* no more entries in this column */
break ;
}
/* get R (k,j2), which is strong */
j2 = Ri [rp] ;
if (j < j2)
{
/* C (j,k) is strong, but R (k,j) is not strong */
cp++ ;
continue ;
}
if (j2 < j)
{
/* C (k,j2) is strong, but R (j2,k) is not strong */
rp++ ;
continue ;
}
/* j == j2: C (j,k) is strong and R (k,j) is strong */
best = FALSE ;
if (P [j] == EMPTY)
{
/* j has not yet been matched */
jdeg = Degree [j] ;
jdiff = SCALAR_ABS (k-j) ;
DEBUG1 (("Try candidate j "ID" deg "ID" diff "ID
"\n", j, jdeg, jdiff)) ;
if (j_best == EMPTY)
{
/* this is the first candidate seen */
DEBUG1 ((" first\n")) ;
best = TRUE ;
}
else
{
if (jdeg < jdeg_best)
{
/* the degree of j is best seen so far. */
DEBUG1 ((" least degree\n")) ;
best = TRUE ;
}
else if (jdeg == jdeg_best)
{
/* degree of j and j_best are the same */
/* tie break by nearest node number */
if (jdiff < jdiff_best)
{
DEBUG1 ((" tie degree, closer\n")) ;
best = TRUE ;
}
else if (jdiff == jdiff_best)
{
/* |j-k| = |j_best-k|. For any given k
* and j_best there is only one other j
* than can be just as close as j_best.
* Tie break by picking the smaller of
* j and j_best */
DEBUG1 ((" tie degree, as close\n"));
best = j < j_best ;
}
}
else
{
/* j has higher degree than best so far */
best = FALSE ;
}
}
}
if (best)
{
/* j is best match for k */
/* found a strong pair, A (j,k) and A (k,j) */
DEBUG1 ((" --- Found pair k: "ID" j: " ID
" jdeg: "ID" jdiff: "ID"\n",
k, j, jdeg, jdiff)) ;
ASSERT (jdiff != EMPTY) ;
ASSERT (jdeg != EMPTY) ;
j_best = j ;
jdeg_best = jdeg ;
jdiff_best = jdiff ;
}
/* get the next entries in column k and row k */
cp++ ;
rp++ ;
}
/* save the pair (j,k), if we found one */
if (j_best != EMPTY)
{
j = j_best ;
DEBUGm4 ((" --- best pair j: "ID" for k: "ID"\n", j, k)) ;
P [k] = j ;
P [j] = k ;
}
else
{
/* no match was found for k */
unmatched++ ;
}
}
}
}
/* ---------------------------------------------------------------------- */
/* finalize the row permutation, P */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n2 ; k++)
{
if (P [k] == EMPTY)
{
P [k] = k ;
}
}
ASSERT (UMF_is_permutation (P, Rp, n2, n2)) ;
return (unmatched) ;
}
GLOBAL Int UMF_mem_alloc_tail_block
(
NumericType *Numeric,
Int nunits
)
{
Int bigsize, usage ;
Unit *p, *pnext, *pbig ;
ASSERT (Numeric != (NumericType *) NULL) ;
ASSERT (Numeric->Memory != (Unit *) NULL) ;
#ifndef NDEBUG
if (UMF_allocfail)
{
/* pretend to fail, to test garbage_collection */
DEBUGm2 (("UMF_mem_alloc_tail_block: pretend to fail\n")) ;
UMF_allocfail = FALSE ; /* don't fail the next time */
return (0) ;
}
DEBUG2 (("UMF_mem_alloc_tail_block, size: "ID" + 1 = "ID": ",
nunits, nunits+1)) ;
#endif
bigsize = 0 ;
pbig = (Unit *) NULL ;
ASSERT (nunits > 0) ; /* size must be positive */
if (Numeric->ibig != EMPTY)
{
ASSERT (Numeric->ibig > Numeric->itail) ;
ASSERT (Numeric->ibig < Numeric->size) ;
pbig = Numeric->Memory + Numeric->ibig ;
bigsize = -pbig->header.size ;
ASSERT (bigsize > 0) ; /* Numeric->ibig is free */
ASSERT (pbig->header.prevsize >= 0) ; /* prev. is not free */
}
if (pbig && bigsize >= nunits)
{
/* use the biggest block, somewhere in middle of memory */
p = pbig ;
pnext = p + 1 + bigsize ;
/* next is in range */
ASSERT (pnext < Numeric->Memory + Numeric->size) ;
/* prevsize of next = this size */
ASSERT (pnext->header.prevsize == bigsize) ;
/* next is not free */
ASSERT (pnext->header.size > 0) ;
bigsize -= nunits + 1 ;
if (bigsize < 4)
{
/* internal fragmentation would be too small */
/* allocate the entire free block */
p->header.size = -p->header.size ;
DEBUG2 (("GET BLOCK: p: "ID" size: "ID", all of big: "ID" size: "
ID"\n", (Int) (p-Numeric->Memory), nunits, Numeric->ibig,
p->header.size)) ;
/* no more biggest block */
Numeric->ibig = EMPTY ;
}
else
{
/* allocate just the first nunits Units of the free block */
p->header.size = nunits ;
/* make a new free block */
Numeric->ibig += nunits + 1 ;
pbig = Numeric->Memory + Numeric->ibig ;
pbig->header.size = -bigsize ;
pbig->header.prevsize = nunits ;
pnext->header.prevsize = bigsize ;
DEBUG2 (("GET BLOCK: p: "ID" size: "ID", some of big: "ID" left: "
ID"\n", (Int) (p-Numeric->Memory), nunits, Numeric->ibig,
bigsize)) ;
}
}
else
{
/* allocate from the top of tail */
pnext = Numeric->Memory + Numeric->itail ;
DEBUG2 (("GET BLOCK: from tail ")) ;
if ((nunits + 1) > (Numeric->itail - Numeric->ihead))
{
DEBUG2 (("\n")) ;
return (0) ;
}
Numeric->itail -= (nunits + 1) ;
p = Numeric->Memory + Numeric->itail ;
p->header.size = nunits ;
p->header.prevsize = 0 ;
pnext->header.prevsize = nunits ;
DEBUG2 (("p: "ID" size: "ID", new tail "ID"\n",
(Int) (p-Numeric->Memory), nunits, Numeric->itail)) ;
}
Numeric->tail_usage += p->header.size + 1 ;
usage = Numeric->ihead + Numeric->tail_usage ;
Numeric->max_usage = MAX (Numeric->max_usage, usage) ;
#ifndef NDEBUG
UMF_debug -= 10 ;
UMF_dump_memory (Numeric) ;
UMF_debug += 10 ;
#endif
/* p points to the header. Add one to point to the usable block itself. */
/* return the offset into Numeric->Memory */
return ((p - Numeric->Memory) + 1) ;
}
GLOBAL void UMF_2by2
(
/* input, not modified: */
Int n, /* A is n-by-n */
const Int Ap [ ], /* size n+1 */
const Int Ai [ ], /* size nz = Ap [n] */
const double Ax [ ], /* size nz if present */
#ifdef COMPLEX
const double Az [ ], /* size nz if present */
#endif
double tol, /* tolerance for determining whether or not an
* entry is numerically acceptable. If tol <= 0
* then all numerical values ignored. */
Int scale, /* scaling to perform (none, sum, or max) */
Int Cperm1 [ ], /* singleton permutations */
#ifndef NDEBUG
Int Rperm1 [ ], /* not needed, since Rperm1 = Cperm1 for submatrix S */
#endif
Int InvRperm1 [ ], /* inverse of Rperm1 */
Int n1, /* number of singletons */
Int nempty, /* number of empty rows/cols */
/* input, contents undefined on output: */
Int Degree [ ], /* Degree [j] is the number of off-diagonal
* entries in row/column j of S+S', where
* where S = A (Cperm1 [n1..], Rperm1 [n1..]).
* Note that S is not used, nor formed. */
/* output: */
Int P [ ], /* P [k] = i means original row i is kth row in S(P,:)
* where S = A (Cperm1 [n1..], Rperm1 [n1..]) */
Int *p_nweak,
Int *p_unmatched,
/* workspace (not defined on input or output): */
Int Ri [ ], /* of size >= max (nz, n) */
Int Rp [ ], /* of size n+1 */
double Rs [ ], /* of size n if present. Rs = sum (abs (A),2) or
* max (abs (A),2), the sum or max of each row. Unused
* if scale is equal to UMFPACK_SCALE_NONE. */
Int Head [ ], /* of size n. Head pointers for bucket sort */
Int Next [ ], /* of size n. Next pointers for bucket sort */
Int Ci [ ], /* size nz */
Int Cp [ ] /* size n+1 */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry aij ;
double cmax, value, rs, ctol, dvalue ;
Int k, p, row, col, do_values, do_sum, do_max, do_scale, nweak, weak,
p1, p2, dfound, unmatched, n2, oldrow, newrow, oldcol, newcol, pp ;
#ifdef COMPLEX
Int split = SPLIT (Az) ;
#endif
#ifndef NRECIPROCAL
Int do_recip = FALSE ;
#endif
#ifndef NDEBUG
/* UMF_debug += 99 ; */
DEBUGm3 (("\n ==================================UMF_2by2: tol %g\n", tol)) ;
ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ;
for (k = n1 ; k < n - nempty ; k++)
{
ASSERT (Cperm1 [k] == Rperm1 [k]) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* determine scaling options */
/* ---------------------------------------------------------------------- */
/* use the values, but only if they are present */
/* ignore the values if tol <= 0 */
do_values = (tol > 0) && (Ax != (double *) NULL) ;
if (do_values && (Rs != (double *) NULL))
{
do_sum = (scale == UMFPACK_SCALE_SUM) ;
do_max = (scale == UMFPACK_SCALE_MAX) ;
}
else
{
/* no scaling */
do_sum = FALSE ;
do_max = FALSE ;
}
do_scale = do_max || do_sum ;
DEBUGm3 (("do_values "ID" do_sum "ID" do_max "ID" do_scale "ID"\n",
do_values, do_sum, do_max, do_scale)) ;
/* ---------------------------------------------------------------------- */
/* compute the row scaling, if requested */
/* ---------------------------------------------------------------------- */
/* see also umf_kernel_init */
if (do_scale)
{
#ifndef NRECIPROCAL
double rsmin ;
#endif
for (row = 0 ; row < n ; row++)
{
Rs [row] = 0.0 ;
}
for (col = 0 ; col < n ; col++)
{
p2 = Ap [col+1] ;
for (p = Ap [col] ; p < p2 ; p++)
{
row = Ai [p] ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
rs = Rs [row] ;
if (!SCALAR_IS_NAN (rs))
{
if (SCALAR_IS_NAN (value))
{
/* if any entry in a row is NaN, then the scale factor
* for the row is NaN. It will be set to 1 later. */
Rs [row] = value ;
}
else if (do_max)
{
Rs [row] = MAX (rs, value) ;
}
else
{
Rs [row] += value ;
}
}
}
}
#ifndef NRECIPROCAL
rsmin = Rs [0] ;
if (SCALAR_IS_ZERO (rsmin) || SCALAR_IS_NAN (rsmin))
{
rsmin = 1.0 ;
}
#endif
for (row = 0 ; row < n ; row++)
{
/* do not scale an empty row, or a row with a NaN */
rs = Rs [row] ;
if (SCALAR_IS_ZERO (rs) || SCALAR_IS_NAN (rs))
{
Rs [row] = 1.0 ;
}
#ifndef NRECIPROCAL
rsmin = MIN (rsmin, Rs [row]) ;
#endif
}
#ifndef NRECIPROCAL
/* multiply by the reciprocal if Rs is not too small */
do_recip = (rsmin >= RECIPROCAL_TOLERANCE) ;
if (do_recip)
{
/* invert the scale factors */
for (row = 0 ; row < n ; row++)
{
Rs [row] = 1.0 / Rs [row] ;
}
}
#endif
}
/* ---------------------------------------------------------------------- */
/* compute the max in each column and find diagonal */
/* ---------------------------------------------------------------------- */
nweak = 0 ;
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
ASSERT (Rperm1 [k] >= 0 && Rperm1 [k] < n) ;
ASSERT (InvRperm1 [Rperm1 [k]] == k) ;
}
#endif
n2 = n - n1 - nempty ;
/* use Ri to count the number of strong entries in each row */
for (row = 0 ; row < n2 ; row++)
{
Ri [row] = 0 ;
}
pp = 0 ;
ctol = 0 ;
dvalue = 1 ;
/* construct C = pruned submatrix, strong values only, column form */
for (k = n1 ; k < n - nempty ; k++)
{
oldcol = Cperm1 [k] ;
newcol = k - n1 ;
Next [newcol] = EMPTY ;
DEBUGm1 (("Column "ID" newcol "ID" oldcol "ID"\n", k, newcol, oldcol)) ;
Cp [newcol] = pp ;
dfound = FALSE ;
p1 = Ap [oldcol] ;
p2 = Ap [oldcol+1] ;
if (do_values)
{
cmax = 0 ;
dvalue = 0 ;
if (!do_scale)
{
/* no scaling */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
/* if either cmax or value is NaN, define cmax as NaN */
if (!SCALAR_IS_NAN (cmax))
{
if (SCALAR_IS_NAN (value))
{
cmax = value ;
}
else
{
cmax = MAX (cmax, value) ;
}
}
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
dvalue = value ;
dfound = TRUE ;
ASSERT (newrow == newcol) ;
}
}
}
#ifndef NRECIPROCAL
else if (do_recip)
{
/* multiply by the reciprocal */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value *= Rs [oldrow] ;
/* if either cmax or value is NaN, define cmax as NaN */
if (!SCALAR_IS_NAN (cmax))
{
if (SCALAR_IS_NAN (value))
{
cmax = value ;
}
else
{
cmax = MAX (cmax, value) ;
}
}
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
dvalue = value ;
dfound = TRUE ;
ASSERT (newrow == newcol) ;
}
}
}
#endif
else
{
/* divide instead */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value /= Rs [oldrow] ;
/* if either cmax or value is NaN, define cmax as NaN */
if (!SCALAR_IS_NAN (cmax))
{
if (SCALAR_IS_NAN (value))
{
cmax = value ;
}
else
{
cmax = MAX (cmax, value) ;
}
}
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
dvalue = value ;
dfound = TRUE ;
ASSERT (newrow == newcol) ;
}
}
}
ctol = tol * cmax ;
DEBUGm1 ((" cmax col "ID" %g ctol %g\n", oldcol, cmax, ctol)) ;
}
else
{
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
Ci [pp++] = newrow ;
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
ASSERT (newrow == newcol) ;
dfound = TRUE ;
}
/* count the entries in each column */
Ri [newrow]++ ;
}
}
/* ------------------------------------------------------------------ */
/* flag the weak diagonals */
/* ------------------------------------------------------------------ */
if (!dfound)
{
/* no diagonal entry present */
weak = TRUE ;
}
else
{
/* diagonal entry is present, check its value */
weak = (do_values) ? WEAK (dvalue, ctol) : FALSE ;
}
if (weak)
{
/* flag this column as weak */
DEBUG0 (("Weak!\n")) ;
Next [newcol] = IS_WEAK ;
nweak++ ;
}
/* ------------------------------------------------------------------ */
/* count entries in each row that are not numerically weak */
/* ------------------------------------------------------------------ */
if (do_values)
{
if (!do_scale)
{
/* no scaling */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
newrow = InvRperm1 [oldrow] - n1 ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
weak = WEAK (value, ctol) ;
if (!weak)
{
DEBUG0 ((" strong: row "ID": %g\n", oldrow, value)) ;
Ci [pp++] = newrow ;
Ri [newrow]++ ;
}
}
}
#ifndef NRECIPROCAL
else if (do_recip)
{
/* multiply by the reciprocal */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
newrow = InvRperm1 [oldrow] - n1 ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value *= Rs [oldrow] ;
weak = WEAK (value, ctol) ;
if (!weak)
{
DEBUG0 ((" strong: row "ID": %g\n", oldrow, value)) ;
Ci [pp++] = newrow ;
Ri [newrow]++ ;
}
}
}
#endif
else
{
/* divide instead */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
newrow = InvRperm1 [oldrow] - n1 ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value /= Rs [oldrow] ;
weak = WEAK (value, ctol) ;
if (!weak)
{
DEBUG0 ((" strong: row "ID": %g\n", oldrow, value)) ;
Ci [pp++] = newrow ;
Ri [newrow]++ ;
}
}
}
}
}
Cp [n2] = pp ;
ASSERT (AMD_valid (n2, n2, Cp, Ci) == AMD_OK) ;
if (nweak == 0)
{
/* nothing to do, quick return */
DEBUGm2 (("\n =============================UMF_2by2: quick return\n")) ;
for (k = 0 ; k < n ; k++)
{
P [k] = k ;
}
*p_nweak = 0 ;
*p_unmatched = 0 ;
return ;
}
#ifndef NDEBUG
for (k = 0 ; k < n2 ; k++)
{
P [k] = EMPTY ;
}
for (k = 0 ; k < n2 ; k++)
{
ASSERT (Degree [k] >= 0 && Degree [k] < n2) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* find the 2-by-2 permutation */
/* ---------------------------------------------------------------------- */
/* The matrix S is now mapped to the index range 0 to n2-1. We have
* S = A (Rperm [n1 .. n-nempty-1], Cperm [n1 .. n-nempty-1]), and then
* C = pattern of strong entries in S. A weak diagonal k in S is marked
* with Next [k] = IS_WEAK. */
unmatched = two_by_two (n2, Cp, Ci, Degree, Next, Ri, P, Rp, Head) ;
/* ---------------------------------------------------------------------- */
*p_nweak = nweak ;
*p_unmatched = unmatched ;
#ifndef NDEBUG
DEBUGm4 (("UMF_2by2: weak "ID" unmatched "ID"\n", nweak, unmatched)) ;
for (row = 0 ; row < n ; row++)
{
DEBUGm2 (("P ["ID"] = "ID"\n", row, P [row])) ;
}
DEBUGm2 (("\n =============================UMF_2by2: done\n\n")) ;
#endif
}
GLOBAL Int UMF_store_lu_drop
#else
GLOBAL Int UMF_store_lu
#endif
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry pivot_value ;
#ifdef DROP
double droptol ;
#endif
Entry *D, *Lval, *Uval, *Fl1, *Fl2, *Fu1, *Fu2,
*Flublock, *Flblock, *Fublock ;
Int i, k, fnr_curr, fnrows, fncols, row, col, pivrow, pivcol, *Frows,
*Fcols, *Lpattern, *Upattern, *Lpos, *Upos, llen, ulen, fnc_curr, fnpiv,
uilen, lnz, unz, nb, *Lilen,
*Uilen, *Lip, *Uip, *Li, *Ui, pivcol_position, newLchain, newUchain,
pivrow_position, p, size, lip, uip, lnzi, lnzx, unzx, lnz2i, lnz2x,
unz2i, unz2x, zero_pivot, *Pivrow, *Pivcol, kk,
Lnz [MAXNB] ;
#ifndef NDEBUG
Int *Col_degree, *Row_degree ;
#endif
#ifdef DROP
Int all_lnz, all_unz ;
droptol = Numeric->droptol ;
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
fnrows = Work->fnrows ;
fncols = Work->fncols ;
fnpiv = Work->fnpiv ;
Lpos = Numeric->Lpos ;
Upos = Numeric->Upos ;
Lilen = Numeric->Lilen ;
Uilen = Numeric->Uilen ;
Lip = Numeric->Lip ;
Uip = Numeric->Uip ;
D = Numeric->D ;
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
fnr_curr = Work->fnr_curr ;
fnc_curr = Work->fnc_curr ;
Frows = Work->Frows ;
Fcols = Work->Fcols ;
#ifndef NDEBUG
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
#endif
Lpattern = Work->Lpattern ;
llen = Work->llen ;
Upattern = Work->Upattern ;
ulen = Work->ulen ;
nb = Work->nb ;
#ifndef NDEBUG
DEBUG1 (("\nSTORE LU: fnrows "ID
" fncols "ID"\n", fnrows, fncols)) ;
DEBUG2 (("\nFrontal matrix, including all space:\n"
"fnr_curr "ID" fnc_curr "ID" nb "ID"\n"
"fnrows "ID" fncols "ID" fnpiv "ID"\n",
fnr_curr, fnc_curr, nb, fnrows, fncols, fnpiv)) ;
DEBUG2 (("\nJust the active part:\n")) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (Work->Fcblock, fnr_curr, fnrows, fncols) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Work->Flblock, fnr_curr, fnrows, fnpiv);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Work->Fublock, fnc_curr, fncols, fnpiv) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Work->Flublock, nb, fnpiv, fnpiv) ;
DEBUG7 (("Current frontal matrix: (prior to store LU)\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
Pivrow = Work->Pivrow ;
Pivcol = Work->Pivcol ;
/* ---------------------------------------------------------------------- */
/* store the columns of L */
/* ---------------------------------------------------------------------- */
for (kk = 0 ; kk < fnpiv ; kk++)
{
/* ------------------------------------------------------------------ */
/* one more pivot row and column is being stored into L and U */
/* ------------------------------------------------------------------ */
k = Work->npiv + kk ;
/* ------------------------------------------------------------------ */
/* find the kth pivot row and pivot column */
/* ------------------------------------------------------------------ */
pivrow = Pivrow [kk] ;
pivcol = Pivcol [kk] ;
#ifndef NDEBUG
ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
DEBUGm4 ((
"\n -------------------------------------------------------------"
"Store LU: step " ID"\n", k)) ;
ASSERT (k < MIN (Work->n_row, Work->n_col)) ;
DEBUG2 (("Store column of L, k = "ID", llen "ID"\n", k, llen)) ;
for (i = 0 ; i < llen ; i++)
{
row = Lpattern [i] ;
ASSERT (row >= 0 && row < Work->n_row) ;
DEBUG2 ((" Lpattern["ID"] "ID" Lpos "ID, i, row, Lpos [row])) ;
if (row == pivrow) DEBUG2 ((" <- pivot row")) ;
DEBUG2 (("\n")) ;
ASSERT (i == Lpos [row]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* remove pivot row from L */
/* ------------------------------------------------------------------ */
/* remove pivot row index from current column of L */
/* if a new Lchain starts, then all entries are removed later */
DEBUG2 (("Removing pivrow from Lpattern, k = "ID"\n", k)) ;
ASSERT (!NON_PIVOTAL_ROW (pivrow)) ;
pivrow_position = Lpos [pivrow] ;
if (pivrow_position != EMPTY)
{
/* place the last entry in the column in the */
/* position of the pivot row index */
ASSERT (pivrow == Lpattern [pivrow_position]) ;
row = Lpattern [--llen] ;
/* ASSERT (NON_PIVOTAL_ROW (row)) ; */
Lpattern [pivrow_position] = row ;
Lpos [row] = pivrow_position ;
Lpos [pivrow] = EMPTY ;
}
/* ------------------------------------------------------------------ */
/* store the pivot value, for the diagonal matrix D */
/* ------------------------------------------------------------------ */
/* kk-th column of LU block */
Fl1 = Flublock + kk * nb ;
/* kk-th column of L in the L block */
Fl2 = Flblock + kk * fnr_curr ;
/* kk-th pivot in frontal matrix located in Flublock [kk, kk] */
pivot_value = Fl1 [kk] ;
D [k] = pivot_value ;
zero_pivot = IS_ZERO (pivot_value) ;
DEBUG4 (("Pivot D["ID"]=", k)) ;
EDEBUG4 (pivot_value) ;
DEBUG4 (("\n")) ;
/* ------------------------------------------------------------------ */
/* count nonzeros in kth column of L */
/* ------------------------------------------------------------------ */
lnz = 0 ;
lnz2i = 0 ;
lnz2x = llen ;
#ifdef DROP
all_lnz = 0 ;
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
x = Fl1 [i] ;
if (IS_ZERO (x)) continue ;
all_lnz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
lnz++ ;
if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
double s ;
x = Fl2 [i] ;
if (IS_ZERO (x)) continue ;
all_lnz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
lnz++ ;
if (Lpos [Frows [i]] == EMPTY) lnz2i++ ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
if (IS_ZERO (Fl1 [i])) continue ;
lnz++ ;
if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ;
}
for (i = 0 ; i < fnrows ; i++)
{
if (IS_ZERO (Fl2 [i])) continue ;
lnz++ ;
if (Lpos [Frows [i]] == EMPTY) lnz2i++ ;
}
#endif
lnz2x += lnz2i ;
/* determine if we start a new Lchain or continue the old one */
if (llen == 0 || zero_pivot)
{
/* llen == 0 means there is no prior Lchain */
/* D [k] == 0 means the pivot column is empty */
newLchain = TRUE ;
}
else
{
newLchain =
/* storage for starting a new Lchain */
UNITS (Entry, lnz) + UNITS (Int, lnz)
<=
/* storage for continuing a prior Lchain */
UNITS (Entry, lnz2x) + UNITS (Int, lnz2i) ;
}
if (newLchain)
{
/* start a new chain for column k of L */
DEBUG2 (("Start new Lchain, k = "ID"\n", k)) ;
pivrow_position = EMPTY ;
/* clear the prior Lpattern */
for (i = 0 ; i < llen ; i++)
{
row = Lpattern [i] ;
Lpos [row] = EMPTY ;
}
llen = 0 ;
lnzi = lnz ;
lnzx = lnz ;
}
else
{
/* continue the prior Lchain */
DEBUG2 (("Continue Lchain, k = "ID"\n", k)) ;
lnzi = lnz2i ;
lnzx = lnz2x ;
}
/* ------------------------------------------------------------------ */
/* allocate space for the column of L */
/* ------------------------------------------------------------------ */
size = UNITS (Int, lnzi) + UNITS (Entry, lnzx) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0)
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n"));
}
#endif
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
Int r2, c2 ;
/* Do garbage collection, realloc, and try again. */
/* Note that there are pivot rows/columns in current front. */
if (Work->do_grow)
{
/* full compaction of current frontal matrix, since
* UMF_grow_front will be called next anyway. */
r2 = fnrows ;
c2 = fncols ;
}
else
{
/* partial compaction. */
r2 = MAX (fnrows, Work->fnrows_new + 1) ;
c2 = MAX (fncols, Work->fncols_new + 1) ;
}
DEBUGm3 (("get_memory from umf_store_lu:\n")) ;
if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE))
{
DEBUGm4 (("out of memory: store LU (1)\n")) ;
return (FALSE) ; /* out of memory */
}
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
DEBUGm4 (("out of memory: store LU (2)\n")) ;
return (FALSE) ; /* out of memory */
}
/* garbage collection may have moved the current front */
fnc_curr = Work->fnc_curr ;
fnr_curr = Work->fnr_curr ;
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
Fl1 = Flublock + kk * nb ;
Fl2 = Flblock + kk * fnr_curr ;
}
/* ------------------------------------------------------------------ */
/* store the column of L */
/* ------------------------------------------------------------------ */
lip = p ;
Li = (Int *) (Numeric->Memory + p) ;
p += UNITS (Int, lnzi) ;
Lval = (Entry *) (Numeric->Memory + p) ;
p += UNITS (Entry, lnzx) ;
for (i = 0 ; i < lnzx ; i++)
{
CLEAR (Lval [i]) ;
}
/* store the numerical entries */
if (newLchain)
{
/* flag the first column in the Lchain by negating Lip [k] */
lip = -lip ;
ASSERT (llen == 0) ;
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl1 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Pivrow [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Frows [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl1 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Pivrow [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl2 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Frows [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
#endif
}
else
{
ASSERT (llen > 0) ;
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl1 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Pivrow [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Frows [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl1 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Pivrow [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl2 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Frows [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
#endif
}
DEBUG4 (("llen "ID" lnzx "ID"\n", llen, lnzx)) ;
ASSERT (llen == lnzx) ;
ASSERT (lnz <= llen) ;
DEBUG4 (("lnz "ID" \n", lnz)) ;
#ifdef DROP
DEBUG4 (("all_lnz "ID" \n", all_lnz)) ;
ASSERT (lnz <= all_lnz) ;
Numeric->lnz += lnz ;
Numeric->all_lnz += all_lnz ;
Lnz [kk] = all_lnz ;
#else
Numeric->lnz += lnz ;
Numeric->all_lnz += lnz ;
Lnz [kk] = lnz ;
#endif
Numeric->nLentries += lnzx ;
Work->llen = llen ;
Numeric->isize += lnzi ;
/* ------------------------------------------------------------------ */
/* the pivot column is fully assembled and scaled, and is now the */
/* k-th column of L */
/* ------------------------------------------------------------------ */
Lpos [pivrow] = pivrow_position ; /* not aliased */
Lip [pivcol] = lip ; /* aliased with Col_tuples */
Lilen [pivcol] = lnzi ; /* aliased with Col_tlen */
}
/* ---------------------------------------------------------------------- */
/* store the rows of U */
/* ---------------------------------------------------------------------- */
for (kk = 0 ; kk < fnpiv ; kk++)
{
/* ------------------------------------------------------------------ */
/* one more pivot row and column is being stored into L and U */
/* ------------------------------------------------------------------ */
k = Work->npiv + kk ;
/* ------------------------------------------------------------------ */
/* find the kth pivot row and pivot column */
/* ------------------------------------------------------------------ */
pivrow = Pivrow [kk] ;
pivcol = Pivcol [kk] ;
#ifndef NDEBUG
ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
DEBUG2 (("Store row of U, k = "ID", ulen "ID"\n", k, ulen)) ;
for (i = 0 ; i < ulen ; i++)
{
col = Upattern [i] ;
DEBUG2 ((" Upattern["ID"] "ID, i, col)) ;
if (col == pivcol) DEBUG2 ((" <- pivot col")) ;
DEBUG2 (("\n")) ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (i == Upos [col]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* get the pivot value, for the diagonal matrix D */
/* ------------------------------------------------------------------ */
zero_pivot = IS_ZERO (D [k]) ;
/* ------------------------------------------------------------------ */
/* count the nonzeros in the row of U */
/* ------------------------------------------------------------------ */
/* kk-th row of U in the LU block */
Fu1 = Flublock + kk ;
/* kk-th row of U in the U block */
Fu2 = Fublock + kk * fnc_curr ;
unz = 0 ;
unz2i = 0 ;
unz2x = ulen ;
DEBUG2 (("unz2x is "ID", lnzx "ID"\n", unz2x, lnzx)) ;
/* if row k does not end a Uchain, pivcol not included in ulen */
ASSERT (!NON_PIVOTAL_COL (pivcol)) ;
pivcol_position = Upos [pivcol] ;
if (pivcol_position != EMPTY)
{
unz2x-- ;
DEBUG2 (("(exclude pivcol) unz2x is now "ID"\n", unz2x)) ;
}
ASSERT (unz2x >= 0) ;
#ifdef DROP
all_unz = 0 ;
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
x = Fu1 [i*nb] ;
if (IS_ZERO (x)) continue ;
all_unz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
unz++ ;
if (Upos [Pivcol [i]] == EMPTY) unz2i++ ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
double s ;
x = Fu2 [i] ;
if (IS_ZERO (x)) continue ;
all_unz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
unz++ ;
if (Upos [Fcols [i]] == EMPTY) unz2i++ ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
if (IS_ZERO (Fu1 [i*nb])) continue ;
unz++ ;
if (Upos [Pivcol [i]] == EMPTY) unz2i++ ;
}
for (i = 0 ; i < fncols ; i++)
{
if (IS_ZERO (Fu2 [i])) continue ;
unz++ ;
if (Upos [Fcols [i]] == EMPTY) unz2i++ ;
}
#endif
unz2x += unz2i ;
ASSERT (IMPLIES (k == 0, ulen == 0)) ;
/* determine if we start a new Uchain or continue the old one */
if (ulen == 0 || zero_pivot)
{
/* ulen == 0 means there is no prior Uchain */
/* D [k] == 0 means the matrix is singular (pivot row might */
/* not be empty, however, but start a new Uchain to prune zero */
/* entries for the deg > 0 test in UMF_u*solve) */
newUchain = TRUE ;
}
else
{
newUchain =
/* approximate storage for starting a new Uchain */
UNITS (Entry, unz) + UNITS (Int, unz)
<=
/* approximate storage for continuing a prior Uchain */
UNITS (Entry, unz2x) + UNITS (Int, unz2i) ;
/* this would be exact, except for the Int to Unit rounding, */
/* because the Upattern is stored only at the end of the Uchain */
}
/* ------------------------------------------------------------------ */
/* allocate space for the row of U */
/* ------------------------------------------------------------------ */
size = 0 ;
if (newUchain)
{
/* store the pattern of the last row in the prior Uchain */
size += UNITS (Int, ulen) ;
unzx = unz ;
}
else
{
unzx = unz2x ;
}
size += UNITS (Entry, unzx) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0)
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n"));
}
#endif
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
Int r2, c2 ;
/* Do garbage collection, realloc, and try again. */
/* Note that there are pivot rows/columns in current front. */
if (Work->do_grow)
{
/* full compaction of current frontal matrix, since
* UMF_grow_front will be called next anyway. */
r2 = fnrows ;
c2 = fncols ;
}
else
{
/* partial compaction. */
r2 = MAX (fnrows, Work->fnrows_new + 1) ;
c2 = MAX (fncols, Work->fncols_new + 1) ;
}
DEBUGm3 (("get_memory from umf_store_lu:\n")) ;
if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE))
{
/* :: get memory, column of L :: */
DEBUGm4 (("out of memory: store LU (1)\n")) ;
return (FALSE) ; /* out of memory */
}
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
/* :: out of memory, column of U :: */
DEBUGm4 (("out of memory: store LU (2)\n")) ;
return (FALSE) ; /* out of memory */
}
/* garbage collection may have moved the current front */
fnc_curr = Work->fnc_curr ;
fnr_curr = Work->fnr_curr ;
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
Fu1 = Flublock + kk ;
Fu2 = Fublock + kk * fnc_curr ;
}
/* ------------------------------------------------------------------ */
/* store the row of U */
/* ------------------------------------------------------------------ */
uip = p ;
if (newUchain)
{
/* starting a new Uchain - flag this by negating Uip [k] */
uip = -uip ;
DEBUG2 (("Start new Uchain, k = "ID"\n", k)) ;
pivcol_position = EMPTY ;
/* end the prior Uchain */
/* save the current Upattern, and then */
/* clear it and start a new Upattern */
DEBUG2 (("Ending prior chain, k-1 = "ID"\n", k-1)) ;
uilen = ulen ;
Ui = (Int *) (Numeric->Memory + p) ;
Numeric->isize += ulen ;
p += UNITS (Int, ulen) ;
for (i = 0 ; i < ulen ; i++)
{
col = Upattern [i] ;
ASSERT (col >= 0 && col < Work->n_col) ;
Upos [col] = EMPTY ;
Ui [i] = col ;
}
ulen = 0 ;
}
else
{
/* continue the prior Uchain */
DEBUG2 (("Continue Uchain, k = "ID"\n", k)) ;
ASSERT (k > 0) ;
/* remove pivot col index from current row of U */
/* if a new Uchain starts, then all entries are removed later */
DEBUG2 (("Removing pivcol from Upattern, k = "ID"\n", k)) ;
if (pivcol_position != EMPTY)
{
/* place the last entry in the row in the */
/* position of the pivot col index */
ASSERT (pivcol == Upattern [pivcol_position]) ;
col = Upattern [--ulen] ;
ASSERT (col >= 0 && col < Work->n_col) ;
Upattern [pivcol_position] = col ;
Upos [col] = pivcol_position ;
Upos [pivcol] = EMPTY ;
}
/* this row continues the Uchain. Keep track of how much */
/* to trim from the k-th length to get the length of the */
/* (k-1)st row of U */
uilen = unz2i ;
}
Uval = (Entry *) (Numeric->Memory + p) ;
/* p += UNITS (Entry, unzx), no need to increment p */
for (i = 0 ; i < unzx ; i++)
{
CLEAR (Uval [i]) ;
}
if (newUchain)
{
ASSERT (ulen == 0) ;
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu1 [i*nb] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Pivcol [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Fcols [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu1 [i*nb] ;
if (IS_ZERO (x)) continue ;
col2 = Pivcol [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu2 [i] ;
if (IS_ZERO (x)) continue ;
col2 = Fcols [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
#endif
}
else
{
ASSERT (ulen > 0) ;
/* store the numerical entries and find new nonzeros */
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu1 [i*nb] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Pivcol [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Fcols [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu1 [i*nb] ;
if (IS_ZERO (x)) continue ;
col2 = Pivcol [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu2 [i] ;
if (IS_ZERO (x)) continue ;
col2 = Fcols [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
#endif
}
ASSERT (ulen == unzx) ;
ASSERT (unz <= ulen) ;
DEBUG4 (("unz "ID" \n", unz)) ;
#ifdef DROP
DEBUG4 (("all_unz "ID" \n", all_unz)) ;
ASSERT (unz <= all_unz) ;
Numeric->unz += unz ;
Numeric->all_unz += all_unz ;
/* count the "true" flops, based on LU pattern only */
Numeric->flops += DIV_FLOPS * Lnz [kk] /* scale pivot column */
+ MULTSUB_FLOPS * (Lnz [kk] * all_unz) ; /* outer product */
#else
Numeric->unz += unz ;
Numeric->all_unz += unz ;
/* count the "true" flops, based on LU pattern only */
Numeric->flops += DIV_FLOPS * Lnz [kk] /* scale pivot column */
+ MULTSUB_FLOPS * (Lnz [kk] * unz) ; /* outer product */
#endif
Numeric->nUentries += unzx ;
Work->ulen = ulen ;
DEBUG1 (("Work->ulen = "ID" at end of pivot step, k: "ID"\n", ulen, k));
/* ------------------------------------------------------------------ */
/* the pivot row is the k-th row of U */
/* ------------------------------------------------------------------ */
Upos [pivcol] = pivcol_position ; /* not aliased */
Uip [pivrow] = uip ; /* aliased with Row_tuples */
Uilen [pivrow] = uilen ; /* aliased with Row_tlen */
}
/* ---------------------------------------------------------------------- */
/* no more pivots in frontal working array */
/* ---------------------------------------------------------------------- */
Work->npiv += fnpiv ;
Work->fnpiv = 0 ;
Work->fnzeros = 0 ;
return (TRUE) ;
}
GLOBAL Int UMF_grow_front
(
NumericType *Numeric,
Int fnr2, /* desired size is fnr2-by-fnc2 */
Int fnc2,
WorkType *Work,
Int do_what /* -1: UMF_start_front
* 0: UMF_init_front, do not recompute Fcpos
* 1: UMF_extend_front
* 2: UMF_init_front, recompute Fcpos */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double s ;
Entry *Fcold, *Fcnew ;
Int j, i, col, *Fcpos, *Fcols, fnrows_max, fncols_max, fnr_curr, nb,
fnrows_new, fncols_new, fnr_min, fnc_min, minsize,
newsize, fnrows, fncols, *E, eloc ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
if (do_what != -1) UMF_debug++ ;
DEBUG0 (("\n\n====================GROW FRONT: do_what: "ID"\n", do_what)) ;
if (do_what != -1) UMF_debug-- ;
ASSERT (Work->do_grow) ;
ASSERT (Work->fnpiv == 0) ;
#endif
Fcols = Work->Fcols ;
Fcpos = Work->Fcpos ;
E = Work->E ;
/* ---------------------------------------------------------------------- */
/* The current front is too small, find the new size */
/* ---------------------------------------------------------------------- */
/* maximum size of frontal matrix for this chain */
nb = Work->nb ;
fnrows_max = Work->fnrows_max + nb ;
fncols_max = Work->fncols_max + nb ;
ASSERT (fnrows_max >= 0 && (fnrows_max % 2) == 1) ;
DEBUG0 (("Max size: "ID"-by-"ID" (incl. "ID" pivot block\n",
fnrows_max, fncols_max, nb)) ;
/* current dimensions of frontal matrix: fnr-by-fnc */
DEBUG0 (("Current : "ID"-by-"ID" (excl "ID" pivot blocks)\n",
Work->fnr_curr, Work->fnc_curr, nb)) ;
ASSERT (Work->fnr_curr >= 0) ;
ASSERT ((Work->fnr_curr % 2 == 1) || Work->fnr_curr == 0) ;
/* required dimensions of frontal matrix: fnr_min-by-fnc_min */
fnrows_new = Work->fnrows_new + 1 ;
fncols_new = Work->fncols_new + 1 ;
ASSERT (fnrows_new >= 0) ;
if (fnrows_new % 2 == 0) fnrows_new++ ;
fnrows_new += nb ;
fncols_new += nb ;
fnr_min = MIN (fnrows_new, fnrows_max) ;
fnc_min = MIN (fncols_new, fncols_max) ;
minsize = fnr_min * fnc_min ;
if (INT_OVERFLOW ((double) fnr_min * (double) fnc_min * sizeof (Entry)))
{
/* :: the minimum front size is bigger than the integer maximum :: */
return (FALSE) ;
}
ASSERT (fnr_min >= 0) ;
ASSERT (fnr_min % 2 == 1) ;
DEBUG0 (("Min : "ID"-by-"ID"\n", fnr_min, fnc_min)) ;
/* grow the front to fnr2-by-fnc2, but no bigger than the maximum,
* and no smaller than the minumum. */
DEBUG0 (("Desired : ("ID"+"ID")-by-("ID"+"ID")\n", fnr2, nb, fnc2, nb)) ;
fnr2 += nb ;
fnc2 += nb ;
ASSERT (fnr2 >= 0) ;
if (fnr2 % 2 == 0) fnr2++ ;
fnr2 = MAX (fnr2, fnr_min) ;
fnc2 = MAX (fnc2, fnc_min) ;
fnr2 = MIN (fnr2, fnrows_max) ;
fnc2 = MIN (fnc2, fncols_max) ;
DEBUG0 (("Try : "ID"-by-"ID"\n", fnr2, fnc2)) ;
ASSERT (fnr2 >= 0) ;
ASSERT (fnr2 % 2 == 1) ;
s = ((double) fnr2) * ((double) fnc2) ;
if (INT_OVERFLOW (s * sizeof (Entry)))
{
/* :: frontal matrix size int overflow :: */
/* the desired front size is bigger than the integer maximum */
/* compute a such that a*a*s < Int_MAX / sizeof (Entry) */
double a = 0.9 * sqrt ((Int_MAX / sizeof (Entry)) / s) ;
fnr2 = MAX (fnr_min, a * fnr2) ;
fnc2 = MAX (fnc_min, a * fnc2) ;
/* the new frontal size is a*r*a*c = a*a*s */
newsize = fnr2 * fnc2 ;
ASSERT (fnr2 >= 0) ;
if (fnr2 % 2 == 0) fnr2++ ;
fnc2 = newsize / fnr2 ;
}
fnr2 = MAX (fnr2, fnr_min) ;
fnc2 = MAX (fnc2, fnc_min) ;
newsize = fnr2 * fnc2 ;
ASSERT (fnr2 >= 0) ;
ASSERT (fnr2 % 2 == 1) ;
ASSERT (fnr2 >= fnr_min) ;
ASSERT (fnc2 >= fnc_min) ;
ASSERT (newsize >= minsize) ;
/* ---------------------------------------------------------------------- */
/* free the current front if it is empty of any numerical values */
/* ---------------------------------------------------------------------- */
if (E [0] && do_what != 1)
{
/* free the current front, if it exists and has nothing in it */
DEBUG0 (("Freeing empty front\n")) ;
UMF_mem_free_tail_block (Numeric, E [0]) ;
E [0] = 0 ;
Work->Flublock = (Entry *) NULL ;
Work->Flblock = (Entry *) NULL ;
Work->Fublock = (Entry *) NULL ;
Work->Fcblock = (Entry *) NULL ;
}
/* ---------------------------------------------------------------------- */
/* allocate the new front, doing garbage collection if necessary */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0) /* a double relop, but ignore NaN case */
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage collection (grow)\n")) ;
}
#endif
DEBUG0 (("Attempt size: "ID"-by-"ID"\n", fnr2, fnc2)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
if (!eloc)
{
/* Do garbage collection, realloc, and try again. Compact the current
* contribution block in the front to fnrows-by-fncols. Note that
* there are no pivot rows/columns in current front. Do not recompute
* Fcpos in UMF_garbage_collection. */
DEBUGm3 (("get_memory from umf_grow_front\n")) ;
if (!UMF_get_memory (Numeric, Work, 1 + UNITS (Entry, newsize),
Work->fnrows, Work->fncols, FALSE))
{
/* :: out of memory in umf_grow_front :: */
return (FALSE) ; /* out of memory */
}
DEBUG0 (("Attempt size: "ID"-by-"ID" again\n", fnr2, fnc2)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
}
/* try again with something smaller */
while ((fnr2 != fnr_min || fnc2 != fnc_min) && !eloc)
{
fnr2 = MIN (fnr2 - 2, fnr2 * UMF_REALLOC_REDUCTION) ;
fnc2 = MIN (fnc2 - 2, fnc2 * UMF_REALLOC_REDUCTION) ;
ASSERT (fnr_min >= 0) ;
ASSERT (fnr_min % 2 == 1) ;
fnr2 = MAX (fnr_min, fnr2) ;
fnc2 = MAX (fnc_min, fnc2) ;
ASSERT (fnr2 >= 0) ;
if (fnr2 % 2 == 0) fnr2++ ;
newsize = fnr2 * fnc2 ;
DEBUGm3 (("Attempt smaller size: "ID"-by-"ID" minsize "ID"-by-"ID"\n",
fnr2, fnc2, fnr_min, fnc_min)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
}
/* try again with the smallest possible size */
if (!eloc)
{
fnr2 = fnr_min ;
fnc2 = fnc_min ;
newsize = minsize ;
DEBUG0 (("Attempt minsize: "ID"-by-"ID"\n", fnr2, fnc2)) ;
eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ;
}
if (!eloc)
{
/* out of memory */
return (FALSE) ;
}
ASSERT (fnr2 >= 0) ;
ASSERT (fnr2 % 2 == 1) ;
ASSERT (fnr2 >= fnr_min && fnc2 >= fnc_min) ;
/* ---------------------------------------------------------------------- */
/* copy the old frontal matrix into the new one */
/* ---------------------------------------------------------------------- */
/* old contribution block (if any) */
fnr_curr = Work->fnr_curr ; /* garbage collection can change fn*_curr */
ASSERT (fnr_curr >= 0) ;
ASSERT ((fnr_curr % 2 == 1) || fnr_curr == 0) ;
fnrows = Work->fnrows ;
fncols = Work->fncols ;
Fcold = Work->Fcblock ;
/* remove nb from the sizes */
fnr2 -= nb ;
fnc2 -= nb ;
/* new frontal matrix */
Work->Flublock = (Entry *) (Numeric->Memory + eloc) ;
Work->Flblock = Work->Flublock + nb * nb ;
Work->Fublock = Work->Flblock + nb * fnr2 ;
Work->Fcblock = Work->Fublock + nb * fnc2 ;
Fcnew = Work->Fcblock ;
if (E [0])
{
/* copy the old contribution block into the new one */
for (j = 0 ; j < fncols ; j++)
{
col = Fcols [j] ;
DEBUG1 (("copy col "ID" \n",col)) ;
ASSERT (col >= 0 && col < Work->n_col) ;
for (i = 0 ; i < fnrows ; i++)
{
Fcnew [i] = Fcold [i] ;
}
Fcnew += fnr2 ;
Fcold += fnr_curr ;
DEBUG1 (("new offset col "ID" "ID"\n",col, j * fnr2)) ;
Fcpos [col] = j * fnr2 ;
}
}
else if (do_what == 2)
{
/* just find the new column offsets */
for (j = 0 ; j < fncols ; j++)
{
col = Fcols [j] ;
DEBUG1 (("new offset col "ID" "ID"\n",col, j * fnr2)) ;
Fcpos [col] = j * fnr2 ;
}
}
/* free the old frontal matrix */
UMF_mem_free_tail_block (Numeric, E [0]) ;
/* ---------------------------------------------------------------------- */
/* new frontal matrix size */
/* ---------------------------------------------------------------------- */
E [0] = eloc ;
Work->fnr_curr = fnr2 ; /* C block is fnr2-by-fnc2 */
Work->fnc_curr = fnc2 ;
Work->fcurr_size = newsize ; /* including LU, L, U, and C blocks */
Work->do_grow = FALSE ; /* the front has just been grown */
ASSERT (Work->fnr_curr >= 0) ;
ASSERT (Work->fnr_curr % 2 == 1) ;
DEBUG0 (("Newly grown front: "ID"+"ID" by "ID"+"ID"\n", Work->fnr_curr,
nb, Work->fnc_curr, nb)) ;
return (TRUE) ;
}
GLOBAL Int UMF_start_front /* returns TRUE if successful, FALSE otherwise */
(
Int chain,
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic
)
{
Int fnrows_max, fncols_max, fnr2, fnc2, fsize, fcurr_size, maxfrsize,
overflow, nb, f, cdeg ;
double maxbytes ;
nb = Symbolic->nb ;
fnrows_max = Symbolic->Chain_maxrows [chain] ;
fncols_max = Symbolic->Chain_maxcols [chain] ;
DEBUGm2 (("Start Front for chain "ID". fnrows_max "ID" fncols_max "ID"\n",
chain, fnrows_max, fncols_max)) ;
Work->fnrows_max = fnrows_max ;
Work->fncols_max = fncols_max ;
Work->any_skip = FALSE ;
maxbytes = sizeof (Entry) *
(double) (fnrows_max + nb) * (double) (fncols_max + nb) ;
fcurr_size = Work->fcurr_size ;
if (Symbolic->prefer_diagonal)
{
/* Get a rough upper bound on the degree of the first pivot column in
* this front. Note that Col_degree is not maintained if diagonal
* pivoting is preferred. For most matrices, the first pivot column
* of the first frontal matrix of a new chain has only one tuple in
* it anyway, so this bound is exact in that case. */
Int col, tpi, e, *E, *Col_tuples, *Col_tlen, *Cols ;
Tuple *tp, *tpend ;
Unit *Memory, *p ;
Element *ep ;
E = Work->E ;
Memory = Numeric->Memory ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
col = Work->nextcand ;
tpi = Col_tuples [col] ;
tp = (Tuple *) Memory + tpi ;
tpend = tp + Col_tlen [col] ;
cdeg = 0 ;
DEBUGm3 (("\n=============== start front: col "ID" tlen "ID"\n",
col, Col_tlen [col])) ;
for ( ; tp < tpend ; tp++)
{
DEBUG1 (("Tuple ("ID","ID")\n", tp->e, tp->f)) ;
e = tp->e ;
if (!E [e]) continue ;
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
if (Cols [f] == EMPTY) continue ;
DEBUG1 ((" nrowsleft "ID"\n", ep->nrowsleft)) ;
cdeg += ep->nrowsleft ;
}
#ifndef NDEBUG
DEBUGm3 (("start front cdeg: "ID" col "ID"\n", cdeg, col)) ;
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
/* cdeg is now the rough upper bound on the degree of the next pivot
* column. */
/* If AMD was called, we know the maximum number of nonzeros in any
* column of L. Use this as an upper bound for cdeg, but add 2 to
* account for a small amount of off-diagonal pivoting. */
if (Symbolic->amd_dmax > 0)
{
cdeg = MIN (cdeg, Symbolic->amd_dmax) ;
}
/* Increase it to account for larger columns later on.
* Also ensure that it's larger than zero. */
cdeg += 2 ;
/* cdeg cannot be larger than fnrows_max */
cdeg = MIN (cdeg, fnrows_max) ;
}
else
{
/* don't do the above cdeg computation */
cdeg = 0 ;
}
DEBUGm2 (("fnrows max "ID" fncols_max "ID"\n", fnrows_max, fncols_max)) ;
/* the current frontal matrix is empty */
ASSERT (Work->fnrows == 0 && Work->fncols == 0 && Work->fnpiv == 0) ;
/* maximum row dimension is always odd, to avoid bad cache effects */
ASSERT (fnrows_max >= 0) ;
ASSERT (fnrows_max % 2 == 1) ;
/* ----------------------------------------------------------------------
* allocate working array for current frontal matrix:
* minimum size: 1-by-1
* maximum size: fnrows_max-by-fncols_max
* desired size:
*
* if Numeric->front_alloc_init >= 0:
*
* for unsymmetric matrices:
* Numeric->front_alloc_init * (fnrows_max-by-fncols_max)
*
* for symmetric matrices (diagonal pivoting preference, actually):
* Numeric->front_alloc_init * (fnrows_max-by-fncols_max), or
* cdeg*cdeg, whichever is smaller.
*
* if Numeric->front_alloc_init < 0:
* allocate a front of size -Numeric->front_alloc_init.
*
* Allocate the whole thing if it's small (less than 2*nb^2). Make sure the
* leading dimension of the frontal matrix is odd.
*
* Also allocate the nb-by-nb LU block, the dr-by-nb L block, and the
* nb-by-dc U block.
* ---------------------------------------------------------------------- */
/* get the maximum front size, avoiding integer overflow */
overflow = INT_OVERFLOW (maxbytes) ;
if (overflow)
{
/* :: int overflow, max front size :: */
maxfrsize = Int_MAX / sizeof (Entry) ;
}
else
{
maxfrsize = (fnrows_max + nb) * (fncols_max + nb) ;
}
ASSERT (!INT_OVERFLOW ((double) maxfrsize * sizeof (Entry))) ;
if (Numeric->front_alloc_init < 0)
{
/* allocate a front of -Numeric->front_alloc_init entries */
fsize = -Numeric->front_alloc_init ;
fsize = MAX (1, fsize) ;
}
else
{
if (INT_OVERFLOW (Numeric->front_alloc_init * maxbytes))
{
/* :: int overflow, requested front size :: */
fsize = Int_MAX / sizeof (Entry) ;
}
else
{
fsize = Numeric->front_alloc_init * maxfrsize ;
}
if (cdeg > 0)
{
/* diagonal pivoting is in use. cdeg was computed above */
Int fsize2 ;
/* add the L and U blocks */
cdeg += nb ;
if (INT_OVERFLOW (((double) cdeg * (double) cdeg) * sizeof (Entry)))
{
/* :: int overflow, symmetric front size :: */
fsize2 = Int_MAX / sizeof (Entry) ;
}
else
{
fsize2 = MAX (cdeg * cdeg, fcurr_size) ;
}
fsize = MIN (fsize, fsize2) ;
}
}
fsize = MAX (fsize, 2*nb*nb) ;
/* fsize and maxfrsize are now safe from integer overflow. They both
* include the size of the pivot blocks. */
ASSERT (!INT_OVERFLOW ((double) fsize * sizeof (Entry))) ;
Work->fnrows_new = 0 ;
Work->fncols_new = 0 ;
/* desired size is fnr2-by-fnc2 (includes L and U blocks): */
DEBUGm2 ((" fsize "ID" fcurr_size "ID"\n", fsize, fcurr_size)) ;
DEBUGm2 ((" maxfrsize "ID" fnr_curr "ID" fnc_curr "ID"\n", maxfrsize,
Work->fnr_curr, Work->fnc_curr)) ;
if (fsize >= maxfrsize && !overflow)
{
/* max working array is small, allocate all of it */
fnr2 = fnrows_max + nb ;
fnc2 = fncols_max + nb ;
fsize = maxfrsize ;
DEBUGm1 ((" sufficient for ("ID"+"ID")-by-("ID"+"ID")\n",
fnrows_max, nb, fncols_max, nb)) ;
}
else
{
/* allocate a smaller working array */
if (fnrows_max <= fncols_max)
{
fnr2 = (Int) sqrt ((double) fsize) ;
/* make sure fnr2 is odd */
fnr2 = MAX (fnr2, 1) ;
if (fnr2 % 2 == 0) fnr2++ ;
fnr2 = MIN (fnr2, fnrows_max + nb) ;
fnc2 = fsize / fnr2 ;
}
else
{
fnc2 = (Int) sqrt ((double) fsize) ;
fnc2 = MIN (fnc2, fncols_max + nb) ;
fnr2 = fsize / fnc2 ;
/* make sure fnr2 is odd */
fnr2 = MAX (fnr2, 1) ;
if (fnr2 % 2 == 0)
{
fnr2++ ;
fnc2 = fsize / fnr2 ;
}
}
DEBUGm1 ((" smaller "ID"-by-"ID"\n", fnr2, fnc2)) ;
}
fnr2 = MIN (fnr2, fnrows_max + nb) ;
fnc2 = MIN (fnc2, fncols_max + nb) ;
ASSERT (fnr2 % 2 == 1) ;
ASSERT (fnr2 * fnc2 <= fsize) ;
fnr2 -= nb ;
fnc2 -= nb ;
ASSERT (fnr2 >= 0) ;
ASSERT (fnc2 >= 0) ;
if (fsize > fcurr_size)
{
DEBUGm1 ((" Grow front \n")) ;
Work->do_grow = TRUE ;
if (!UMF_grow_front (Numeric, fnr2, fnc2, Work, -1))
{
/* since the minimum front size is 1-by-1, it would be nearly
* impossible to run out of memory here. */
DEBUGm4 (("out of memory: start front\n")) ;
return (FALSE) ;
}
}
else
{
/* use the existing front */
DEBUGm1 ((" existing front ok\n")) ;
Work->fnr_curr = fnr2 ;
Work->fnc_curr = fnc2 ;
Work->Flblock = Work->Flublock + nb * nb ;
Work->Fublock = Work->Flblock + nb * fnr2 ;
Work->Fcblock = Work->Fublock + nb * fnc2 ;
}
ASSERT (Work->Flblock == Work->Flublock + Work->nb*Work->nb) ;
ASSERT (Work->Fublock == Work->Flblock + Work->fnr_curr*Work->nb) ;
ASSERT (Work->Fcblock == Work->Fublock + Work->nb*Work->fnc_curr) ;
return (TRUE) ;
}
GLOBAL Int UMF_create_element
(
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int j, col, row, *Fcols, *Frows, fnrows, fncols, *Cols, len, needunits, t1,
t2, size, e, i, *E, *Fcpos, *Frpos, *Rows, eloc, fnr_curr, f,
got_memory, *Row_tuples, *Row_degree, *Row_tlen, *Col_tuples, max_mark,
*Col_degree, *Col_tlen, nn, n_row, n_col, r2, c2, do_Fcpos ;
Entry *C, *Fcol ;
Element *ep ;
Unit *p, *Memory ;
Tuple *tp, *tp1, *tp2, tuple, *tpend ;
#ifndef NDEBUG
DEBUG2 (("FRONTAL WRAPUP\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
ASSERT (Work->fnpiv == 0) ;
ASSERT (Work->fnzeros == 0) ;
Row_degree = Numeric->Rperm ;
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Col_degree = Numeric->Cperm ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
n_row = Work->n_row ;
n_col = Work->n_col ;
nn = MAX (n_row, n_col) ;
Fcols = Work->Fcols ;
Frows = Work->Frows ;
Fcpos = Work->Fcpos ;
Frpos = Work->Frpos ;
Memory = Numeric->Memory ;
fncols = Work->fncols ;
fnrows = Work->fnrows ;
tp = (Tuple *) NULL ;
tp1 = (Tuple *) NULL ;
tp2 = (Tuple *) NULL ;
/* ---------------------------------------------------------------------- */
/* add the current frontal matrix to the degrees of each column */
/* ---------------------------------------------------------------------- */
if (!Symbolic->fixQ)
{
/* but only if the column ordering is not fixed */
#pragma ivdep
for (j = 0 ; j < fncols ; j++)
{
/* add the current frontal matrix to the degree */
ASSERT (Fcols [j] >= 0 && Fcols [j] < n_col) ;
Col_degree [Fcols [j]] += fnrows ;
}
}
/* ---------------------------------------------------------------------- */
/* add the current frontal matrix to the degrees of each row */
/* ---------------------------------------------------------------------- */
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
/* add the current frontal matrix to the degree */
ASSERT (Frows [i] >= 0 && Frows [i] < n_row) ;
Row_degree [Frows [i]] += fncols ;
}
/* ---------------------------------------------------------------------- */
/* Reset the external degree counters */
/* ---------------------------------------------------------------------- */
E = Work->E ;
max_mark = MAX_MARK (nn) ;
if (!Work->pivcol_in_front)
{
/* clear the external column degrees. no more Usons of current front */
Work->cdeg0 += (nn + 1) ;
if (Work->cdeg0 >= max_mark)
{
/* guard against integer overflow. This is very rare */
DEBUG1 (("Integer overflow, cdeg\n")) ;
Work->cdeg0 = 1 ;
#pragma ivdep
for (e = 1 ; e <= Work->nel ; e++)
{
if (E [e])
{
ep = (Element *) (Memory + E [e]) ;
ep->cdeg = 0 ;
}
}
}
}
if (!Work->pivrow_in_front)
{
/* clear the external row degrees. no more Lsons of current front */
Work->rdeg0 += (nn + 1) ;
if (Work->rdeg0 >= max_mark)
{
/* guard against integer overflow. This is very rare */
DEBUG1 (("Integer overflow, rdeg\n")) ;
Work->rdeg0 = 1 ;
#pragma ivdep
for (e = 1 ; e <= Work->nel ; e++)
{
if (E [e])
{
ep = (Element *) (Memory + E [e]) ;
ep->rdeg = 0 ;
}
}
}
}
/* ---------------------------------------------------------------------- */
/* clear row/col offsets */
/* ---------------------------------------------------------------------- */
if (!Work->pivrow_in_front)
{
#pragma ivdep
for (j = 0 ; j < fncols ; j++)
{
Fcpos [Fcols [j]] = EMPTY ;
}
}
if (!Work->pivcol_in_front)
{
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
Frpos [Frows [i]] = EMPTY ;
}
}
if (fncols <= 0 || fnrows <= 0)
{
/* no element to create */
DEBUG2 (("Element evaporation\n")) ;
Work->prior_element = EMPTY ;
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* create element for later assembly */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0)
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage collection (create)\n"));
}
#endif
needunits = 0 ;
got_memory = FALSE ;
eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C,
&needunits, &ep) ;
/* if UMF_get_memory needs to be called */
if (Work->do_grow)
{
/* full compaction of current frontal matrix, since UMF_grow_front will
* be called next anyway. */
r2 = fnrows ;
c2 = fncols ;
do_Fcpos = FALSE ;
}
else
{
/* partial compaction. */
r2 = MAX (fnrows, Work->fnrows_new + 1) ;
c2 = MAX (fncols, Work->fncols_new + 1) ;
/* recompute Fcpos if pivot row is in the front */
do_Fcpos = Work->pivrow_in_front ;
}
if (!eloc)
{
/* Do garbage collection, realloc, and try again. */
/* Compact the current front if it needs to grow anyway. */
/* Note that there are no pivot rows or columns in the current front */
DEBUGm3 (("get_memory from umf_create_element, 1\n")) ;
if (!UMF_get_memory (Numeric, Work, needunits, r2, c2, do_Fcpos))
{
/* :: out of memory in umf_create_element (1) :: */
DEBUGm4 (("out of memory: create element (1)\n")) ;
return (FALSE) ; /* out of memory */
}
got_memory = TRUE ;
Memory = Numeric->Memory ;
eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C,
&needunits, &ep) ;
ASSERT (eloc >= 0) ;
if (!eloc)
{
/* :: out of memory in umf_create_element (2) :: */
DEBUGm4 (("out of memory: create element (2)\n")) ;
return (FALSE) ; /* out of memory */
}
}
e = ++(Work->nel) ; /* get the name of this new frontal matrix */
Work->prior_element = e ;
DEBUG8 (("wrapup e "ID" nel "ID"\n", e, Work->nel)) ;
ASSERT (e > 0 && e < Work->elen) ;
ASSERT (E [e] == 0) ;
E [e] = eloc ;
if (Work->pivcol_in_front)
{
/* the new element is a Uson of the next frontal matrix */
ep->cdeg = Work->cdeg0 ;
}
if (Work->pivrow_in_front)
{
/* the new element is an Lson of the next frontal matrix */
ep->rdeg = Work->rdeg0 ;
}
/* ---------------------------------------------------------------------- */
/* copy frontal matrix into the new element */
/* ---------------------------------------------------------------------- */
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
Rows [i] = Frows [i] ;
}
#pragma ivdep
for (i = 0 ; i < fncols ; i++)
{
Cols [i] = Fcols [i] ;
}
Fcol = Work->Fcblock ;
DEBUG0 (("copy front "ID" by "ID"\n", fnrows, fncols)) ;
fnr_curr = Work->fnr_curr ;
ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ;
for (j = 0 ; j < fncols ; j++)
{
copy_column (fnrows, Fcol, C) ;
Fcol += fnr_curr ;
C += fnrows ;
}
DEBUG8 (("element copied\n")) ;
/* ---------------------------------------------------------------------- */
/* add tuples for the new element */
/* ---------------------------------------------------------------------- */
tuple.e = e ;
if (got_memory)
{
/* ------------------------------------------------------------------ */
/* UMF_get_memory ensures enough space exists for each new tuple */
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each column */
for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++)
{
col = Fcols [tuple.f] ;
ASSERT (col >= 0 && col < n_col) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
ASSERT (Col_tuples [col]) ;
tp = ((Tuple *) (Memory + Col_tuples [col])) + Col_tlen [col]++ ;
*tp = tuple ;
}
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each row */
for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++)
{
row = Frows [tuple.f] ;
ASSERT (row >= 0 && row < n_row) ;
ASSERT (NON_PIVOTAL_ROW (row)) ;
ASSERT (Row_tuples [row]) ;
tp = ((Tuple *) (Memory + Row_tuples [row])) + Row_tlen [row]++ ;
*tp = tuple ;
}
}
else
{
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each column */
/* ------------------------------------------------------------------ */
/* might not have enough space for each tuple */
for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++)
{
col = Fcols [tuple.f] ;
ASSERT (col >= 0 && col < n_col) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
t1 = Col_tuples [col] ;
DEBUG1 (("Placing on col:"ID" , tuples at "ID"\n",
col, Col_tuples [col])) ;
size = 0 ;
len = 0 ;
if (t1)
{
p = Memory + t1 ;
tp = (Tuple *) p ;
size = GET_BLOCK_SIZE (p) ;
len = Col_tlen [col] ;
tp2 = tp + len ;
}
needunits = UNITS (Tuple, len + 1) ;
DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n",
len, size, needunits));
if (needunits > size && t1)
{
/* prune the tuples */
tp1 = tp ;
tp2 = tp ;
tpend = tp + len ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e]) continue ; /* element already deallocated */
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
;
if (Cols [f] == EMPTY) continue ; /* already assembled */
ASSERT (col == Cols [f]) ;
*tp2++ = *tp ; /* leave the tuple in the list */
}
len = tp2 - tp1 ;
Col_tlen [col] = len ;
needunits = UNITS (Tuple, len + 1) ;
}
if (needunits > size)
{
/* no room exists - reallocate elsewhere */
DEBUG1 (("REALLOCATE Col: "ID", size "ID" to "ID"\n",
col, size, 2*needunits)) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0) /* a double relop, but ignore NaN case */
{
double rrr = ((double) (rand ( ))) /
(((double) RAND_MAX) + 1) ;
DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random gar. (col tuple)\n")) ;
}
#endif
needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ;
t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ;
if (!t2)
{
/* :: get memory in umf_create_element (1) :: */
/* get memory, reconstruct all tuple lists, and return */
/* Compact the current front if it needs to grow anyway. */
/* Note: no pivot rows or columns in the current front */
DEBUGm4 (("get_memory from umf_create_element, 1\n")) ;
return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos));
}
Col_tuples [col] = t2 ;
tp2 = (Tuple *) (Memory + t2) ;
if (t1)
{
for (i = 0 ; i < len ; i++)
{
*tp2++ = *tp1++ ;
}
UMF_mem_free_tail_block (Numeric, t1) ;
}
}
/* place the new (e,f) tuple in the element list of the column */
Col_tlen [col]++ ;
*tp2 = tuple ;
}
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each row */
/* ------------------------------------------------------------------ */
for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++)
{
row = Frows [tuple.f] ;
ASSERT (row >= 0 && row < n_row) ;
ASSERT (NON_PIVOTAL_ROW (row)) ;
t1 = Row_tuples [row] ;
DEBUG1 (("Placing on row:"ID" , tuples at "ID"\n",
row, Row_tuples [row])) ;
size = 0 ;
len = 0 ;
if (t1)
{
p = Memory + t1 ;
tp = (Tuple *) p ;
size = GET_BLOCK_SIZE (p) ;
len = Row_tlen [row] ;
tp2 = tp + len ;
}
needunits = UNITS (Tuple, len + 1) ;
DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n",
len, size, needunits)) ;
if (needunits > size && t1)
{
/* prune the tuples */
tp1 = tp ;
tp2 = tp ;
tpend = tp + len ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
Rows = Cols + (ep->ncols) ;
if (Rows [f] == EMPTY) continue ; /* already assembled */
ASSERT (row == Rows [f]) ;
*tp2++ = *tp ; /* leave the tuple in the list */
}
len = tp2 - tp1 ;
Row_tlen [row] = len ;
needunits = UNITS (Tuple, len + 1) ;
}
if (needunits > size)
{
/* no room exists - reallocate elsewhere */
DEBUG1 (("REALLOCATE Row: "ID", size "ID" to "ID"\n",
row, size, 2*needunits)) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0) /* a double relop, but ignore NaN case */
{
double rrr = ((double) (rand ( ))) /
(((double) RAND_MAX) + 1) ;
DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random gar. (row tuple)\n")) ;
}
#endif
needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ;
t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ;
if (!t2)
{
/* :: get memory in umf_create_element (2) :: */
/* get memory, reconstruct all tuple lists, and return */
/* Compact the current front if it needs to grow anyway. */
/* Note: no pivot rows or columns in the current front */
DEBUGm4 (("get_memory from umf_create_element, 2\n")) ;
return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos));
}
Row_tuples [row] = t2 ;
tp2 = (Tuple *) (Memory + t2) ;
if (t1)
{
for (i = 0 ; i < len ; i++)
{
*tp2++ = *tp1++ ;
}
UMF_mem_free_tail_block (Numeric, t1) ;
}
}
/* place the new (e,f) tuple in the element list of the row */
Row_tlen [row]++ ;
*tp2 = tuple ;
}
}
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG1 (("Done extending\nFINAL: element row pattern: len="ID"\n", fncols));
for (j = 0 ; j < fncols ; j++) DEBUG1 ((""ID"\n", Fcols [j])) ;
DEBUG1 (("FINAL: element col pattern: len="ID"\n", fnrows)) ;
for (j = 0 ; j < fnrows ; j++) DEBUG1 ((""ID"\n", Frows [j])) ;
for (j = 0 ; j < fncols ; j++)
{
col = Fcols [j] ;
ASSERT (col >= 0 && col < n_col) ;
UMF_dump_rowcol (1, Numeric, Work, col, !Symbolic->fixQ) ;
}
for (j = 0 ; j < fnrows ; j++)
{
row = Frows [j] ;
ASSERT (row >= 0 && row < n_row) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
}
if (n_row < 1000 && n_col < 1000)
{
UMF_dump_memory (Numeric) ;
}
DEBUG1 (("New element, after filling with stuff: "ID"\n", e)) ;
UMF_dump_element (Numeric, Work, e, TRUE) ;
if (nn < 1000)
{
DEBUG4 (("Matrix dump, after New element: "ID"\n", e)) ;
UMF_dump_matrix (Numeric, Work, TRUE) ;
}
DEBUG3 (("FRONTAL WRAPUP DONE\n")) ;
#endif
return (TRUE) ;
}
