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")) ;
}
Beispiel #2
0
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 */
}
Beispiel #3
0
PRIVATE void row_assemble
(
    Int row,
    NumericType *Numeric,
    WorkType *Work
)
{

    Entry *S, *Fcblock, *Frow ;
    Int tpi, e, *E, *Fcpos, *Frpos, *Row_degree, *Row_tuples, *Row_tlen, rdeg0,
	f, nrows, ncols, *Rows, *Cols, col, ncolsleft, j ;
    Tuple *tp, *tp1, *tp2, *tpend ;
    Unit *Memory, *p ;
    Element *ep ;

#ifndef FIXQ
    Int *Col_degree ;
    Col_degree = Numeric->Cperm ;
#endif

    Row_tuples = Numeric->Uip ;
    tpi = Row_tuples [row] ;
    if (!tpi) return ;

    Memory = Numeric->Memory ;
    E = Work->E ;
    Fcpos = Work->Fcpos ;
    Frpos = Work->Frpos ;
    Row_degree = Numeric->Rperm ;
    Row_tlen   = Numeric->Uilen ;
    E = Work->E ;
    Memory = Numeric->Memory ;
    rdeg0 = Work->rdeg0 ;
    Fcblock = Work->Fcblock ;

#ifndef NDEBUG
    DEBUG6 (("SCAN2-row: "ID"\n", row)) ;
    UMF_dump_rowcol (0, Numeric, Work, row, FALSE) ;
#endif

    ASSERT (NON_PIVOTAL_ROW (row)) ;

    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) ;
	Cols = (Int *) p ;
	Rows = Cols + ep->ncols ;
	if (Rows [f] == EMPTY) continue ;   /* row already assembled */
	ASSERT (row == Rows [f] && row >= 0 && row < Work->n_row) ;

	if (ep->rdeg == rdeg0)
	{
	    /* ------------------------------------------------------ */
	    /* this is an old Lson - assemble just one row */
	    /* ------------------------------------------------------ */

	    /* flag the row as assembled from the Lson */
	    Rows [f] = EMPTY ;

	    nrows = ep->nrows ;
	    ncols = ep->ncols ;

	    p += UNITS (Int, ncols + nrows) ;
	    S = ((Entry *) p) + f ;

	    DEBUG6 (("Old LSON: "ID"\n", e)) ;
#ifndef NDEBUG
	    UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif

	    ncolsleft = ep->ncolsleft ;

	    Frow = Fcblock + Frpos [row] ;
	    DEBUG6 (("LSON found (in scan2-row): "ID"\n", e)) ;

	    Row_degree [row] -= ncolsleft ;

	    if (ncols == ncolsleft)
	    {
		/* -------------------------------------------------- */
		/* no columns assembled out this Lson yet */
		/* -------------------------------------------------- */

#pragma ivdep
		for (j = 0 ; j < ncols ; j++)
		{
		    col = Cols [j] ;
		    ASSERT (col >= 0 && col < Work->n_col) ;
#ifndef FIXQ
		    Col_degree [col] -- ;
#endif
		    /* Frow [Fcpos [col]] += *S ; */
		    ASSEMBLE (Frow [Fcpos [col]], *S) ;
		    S += nrows ;
		}

	    }
	    else
	    {
		/* -------------------------------------------------- */
		/* some columns have been assembled out of this Lson */
		/* -------------------------------------------------- */

#pragma ivdep
		for (j = 0 ; j < ncols ; j++)
		{
		    col = Cols [j] ;
		    if (col >= 0)
		    {
			ASSERT (col < Work->n_col) ;
#ifndef FIXQ
			Col_degree [col] -- ;
#endif
			/* Frow [Fcpos [col]] += *S ; */
			ASSEMBLE (Frow [Fcpos [col]], *S) ;
		    }
		    S += nrows ;
		}

	    }
	    ep->nrowsleft-- ;
	    ASSERT (ep->nrowsleft > 0) ;
	}
	else
	{
	    *tp2++ = *tp ;	/* leave the tuple in the list */
	}
    }
    Row_tlen [row] = tp2 - tp1 ;

#ifndef NDEBUG
    DEBUG7 (("row assembled in scan2-row: "ID"\n", row)) ;
    UMF_dump_rowcol (0, Numeric, Work, row, FALSE) ;
    DEBUG7 (("Current frontal matrix: (scan 1b)\n")) ;
    UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
}
Beispiel #4
0
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

}
Beispiel #5
0
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) ;
}
Beispiel #6
0
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) ;
}