예제 #1
0
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")) ;
}
예제 #2
0
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) ;
}
예제 #3
0
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_init_front
(
    NumericType *Numeric,
    WorkType *Work
)
{
    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int i, j, fnr_curr, row, col, *Frows, *Fcols,
	*Fcpos, *Frpos, fncols, fnrows, *Wrow, fnr2, fnc2, rrdeg, ccdeg, *Wm,
	fnrows_extended ;
    Entry *Fcblock, *Fl, *Wy, *Wx ;

    /* ---------------------------------------------------------------------- */
    /* get current frontal matrix and check for frontal growth */
    /* ---------------------------------------------------------------------- */

#ifndef NDEBUG
    DEBUG0 (("INIT FRONT\n")) ;
    DEBUG1 (("CURR before init:\n")) ;
    UMF_dump_current_front (Numeric, Work, FALSE) ;
#endif
    if (Work->do_grow)
    {
	fnr2 = UMF_FRONTAL_GROWTH * Work->fnrows_new + 2 ;
	fnc2 = UMF_FRONTAL_GROWTH * Work->fncols_new + 2 ;
	if (!UMF_grow_front (Numeric, fnr2, fnc2, Work,
	    Work->pivrow_in_front ? 2 : 0))
	{
	    /* :: out of memory in umf_init_front :: */
	    DEBUGm4 (("out of memory: init front\n")) ;
	    return (FALSE) ;
	}
    }
#ifndef NDEBUG
    DEBUG1 (("CURR after grow:\n")) ;
    UMF_dump_current_front (Numeric, Work, FALSE) ;
    DEBUG1 (("fnrows new "ID" fncols new "ID"\n",
	Work->fnrows_new, Work->fncols_new)) ;
#endif
    ASSERT (Work->fnpiv == 0) ;
    fnr_curr = Work->fnr_curr ;
    ASSERT (Work->fnrows_new + 1 <= fnr_curr) ;
    ASSERT (Work->fncols_new + 1 <= Work->fnc_curr) ;
    ASSERT (fnr_curr >= 0) ;
    ASSERT (fnr_curr % 2 == 1) ;

    /* ---------------------------------------------------------------------- */
    /* get parameters */
    /* ---------------------------------------------------------------------- */

    /* current front is defined by pivot row and column */

    Frows = Work->Frows ;
    Fcols = Work->Fcols ;
    Frpos = Work->Frpos ;
    Fcpos = Work->Fcpos ;

    Work->fnzeros = 0 ;

    ccdeg = Work->ccdeg ;
    rrdeg = Work->rrdeg ;

    fnrows = Work->fnrows ;
    fncols = Work->fncols ;

    /* if both pivrow and pivcol are in front, then we extend the old one */
    /* in UMF_extend_front, rather than starting a new one here. */
    ASSERT (! (Work->pivrow_in_front && Work->pivcol_in_front)) ;

    /* ---------------------------------------------------------------------- */
    /* place pivot column pattern in frontal matrix */
    /* ---------------------------------------------------------------------- */

    Fl = Work->Flblock ;

    if (Work->pivcol_in_front)
    {
	/* Append the pivot column extension.
	 * Note that all we need to do is increment the size, since the
	 * candidate pivot column pattern is already in place in
	 * Frows [0 ... fnrows-1] (the old pattern), and
	 * Frows [fnrows ... fnrows + Work->ccdeg - 1] (the new
	 * pattern).  Frpos is also properly defined. */
	/* make a list of the new rows to scan */
	Work->fscan_row = fnrows ;	/* only scan the new rows */
	Work->NewRows = Work->Wrp ;
	Wy = Work->Wy ;
	for (i = 0 ; i < fnrows ; i++)
	{
	    Fl [i] = Wy [i] ;
	}
	fnrows_extended = fnrows + ccdeg ;
	for (i = fnrows ; i < fnrows_extended ; i++)
	{
	    Fl [i] = Wy [i] ;
	    /* flip the row, since Wrp must be < 0 */
	    row = Frows [i] ;
	    Work->NewRows [i] = FLIP (row) ;
	}
	fnrows = fnrows_extended ;
    }
    else
    {
	/* this is a completely new column */
	Work->fscan_row = 0 ;			/* scan all the rows */
	Work->NewRows = Frows ;
	Wm = Work->Wm ;
	Wx = Work->Wx ;
	for (i = 0 ; i < ccdeg ; i++)
	{
	    Fl [i] = Wx [i] ;
	    row = Wm [i] ;
	    Frows [i] = row ;
	    Frpos [row] = i ;
	}
	fnrows = ccdeg ;
    }

    Work->fnrows = fnrows ;

#ifndef NDEBUG
    DEBUG3 (("New Pivot col "ID" now in front, length "ID"\n",
	Work->pivcol, fnrows)) ;
    for (i = 0 ; i < fnrows ; i++)
    {
	DEBUG4 ((" "ID": row "ID"\n", i, Frows [i])) ;
	ASSERT (Frpos [Frows [i]] == i) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* place pivot row pattern in frontal matrix */
    /* ---------------------------------------------------------------------- */

    Wrow = Work->Wrow ;
    if (Work->pivrow_in_front)
    {
	/* append the pivot row extension */
	Work->fscan_col = fncols ;	/* only scan the new columns */
	Work->NewCols = Work->Wp ;
#ifndef NDEBUG
	for (j = 0 ; j < fncols ; j++)
	{
	    col = Fcols [j] ;
	    ASSERT (col >= 0 && col < Work->n_col) ;
	    ASSERT (Fcpos [col] == j * fnr_curr) ;
	}
#endif
	/* Wrow == Fcol for the IN_IN case, and for the OUT_IN case when
	 * the pivrow [IN][IN] happens to be the same as pivrow [OUT][IN].
	 * See UMF_local_search for more details. */
	ASSERT (IMPLIES (Work->pivcol_in_front, Wrow == Fcols)) ;
	if (Wrow == Fcols)
	{
	    for (j = fncols ; j < rrdeg ; j++)
	    {
		col = Wrow [j] ;
		/* Fcols [j] = col ; not needed */
		/* flip the col index, since Wp must be < 0 */
		Work->NewCols [j] = FLIP (col) ;
		Fcpos [col] = j * fnr_curr ;
	    }
	}
	else
	{
	    for (j = fncols ; j < rrdeg ; j++)
	    {
		col = Wrow [j] ;
		Fcols [j] = col ;
		/* flip the col index, since Wp must be < 0 */
		Work->NewCols [j] = FLIP (col) ;
		Fcpos [col] = j * fnr_curr ;
	    }
	}
    }
    else
    {
	/* this is a completely new row */
	Work->fscan_col = 0 ;			/* scan all the columns */
	Work->NewCols = Fcols ;
	for (j = 0 ; j < rrdeg ; j++)
	{
	    col = Wrow [j] ;
	    Fcols [j] = col ;
	    Fcpos [col] = j * fnr_curr ;
	}
    }

    DEBUGm1 (("rrdeg "ID" fncols "ID"\n", rrdeg, fncols)) ;
    fncols = rrdeg ;
    Work->fncols = fncols ;

    /* ---------------------------------------------------------------------- */
    /* clear the frontal matrix */
    /* ---------------------------------------------------------------------- */

    ASSERT (fnrows == Work->fnrows_new + 1) ;
    ASSERT (fncols == Work->fncols_new + 1) ;

    Fcblock = Work->Fcblock ;
    ASSERT (Fcblock != (Entry *) NULL) ;

    zero_init_front (fncols, fnrows, Fcblock, fnr_curr) ;

#ifndef NDEBUG
    DEBUG3 (("New Pivot row "ID" now in front, length "ID" fnr_curr "ID"\n",
		Work->pivrow, fncols, fnr_curr)) ;
    for (j = 0 ; j < fncols ; j++)
    {
	DEBUG4 (("col "ID" position "ID"\n", j, Fcols [j])) ;
	ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ;
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* current workspace usage: */
    /* ---------------------------------------------------------------------- */

    /* Fcblock [0..fnr_curr-1, 0..fnc_curr-1]: space for the new frontal
     * matrix.  Fcblock (i,j) is located at Fcblock [i+j*fnr_curr] */

    return (TRUE) ;

}
예제 #5
0
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) ;
}
예제 #6
0
GLOBAL Int UMF_kernel
(
    const Int Ap [ ],
    const Int Ai [ ],
    const double Ax [ ],
#ifdef COMPLEX
    const double Az [ ],
#endif
    NumericType *Numeric,
    WorkType *Work,
    SymbolicType *Symbolic
)
{

    /* ---------------------------------------------------------------------- */
    /* local variables */
    /* ---------------------------------------------------------------------- */

    Int j, f1, f2, chain, nchains, *Chain_start, status, fixQ, evaporate,
	*Front_npivcol, jmax, nb, drop ;

    /* ---------------------------------------------------------------------- */
    /* initialize memory space and load the matrix. Optionally scale. */
    /* ---------------------------------------------------------------------- */

    if (!UMF_kernel_init (Ap, Ai, Ax,
#ifdef COMPLEX
	Az,
#endif
	Numeric, Work, Symbolic))
    {
	/* UMF_kernel_init is guaranteed to succeed, since UMFPACK_numeric */
	/* either allocates enough space or if not, UMF_kernel does not get */
	/* called.  So running out of memory here is a fatal error, and means */
	/* that the user changed Ap and/or Ai since the call to */
	/* UMFPACK_*symbolic. */
	DEBUGm4 (("kernel init failed\n")) ;
	return (UMFPACK_ERROR_different_pattern) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the symbolic factorization */
    /* ---------------------------------------------------------------------- */

    nchains = Symbolic->nchains ;
    Chain_start = Symbolic->Chain_start ;
    Front_npivcol = Symbolic->Front_npivcol ;
    nb = Symbolic->nb ;
    fixQ = Symbolic->fixQ ;
    drop = Numeric->droptol > 0.0 ;

#ifndef NDEBUG
    for (chain = 0 ; chain < nchains ; chain++)
    {
	Int i ;
	f1 = Chain_start [chain] ;
	f2 = Chain_start [chain+1] - 1 ;
	DEBUG1 (("\nCHain: "ID" start "ID" end "ID"\n", chain, f1, f2)) ;
	for (i = f1 ; i <= f2 ; i++)
	{
	    DEBUG1 (("Front "ID", npivcol "ID"\n", i, Front_npivcol [i])) ;
	}
    }
#endif

    /* ---------------------------------------------------------------------- */
    /* factorize each chain of frontal matrices */
    /* ---------------------------------------------------------------------- */

    for (chain = 0 ; chain < nchains ; chain++)
    {
	f1 = Chain_start [chain] ;
	f2 = Chain_start [chain+1] - 1 ;

	/* ------------------------------------------------------------------ */
	/* get the initial frontal matrix size for this chain */
	/* ------------------------------------------------------------------ */

	DO (UMF_start_front (chain, Numeric, Work, Symbolic)) ;

	/* ------------------------------------------------------------------ */
	/* factorize each front in the chain */
	/* ------------------------------------------------------------------ */

	for (Work->frontid = f1 ; Work->frontid <= f2 ; Work->frontid++)
	{

	    /* -------------------------------------------------------------- */
	    /* Initialize the pivot column candidate set  */
	    /* -------------------------------------------------------------- */

	    Work->ncand = Front_npivcol [Work->frontid] ;
	    Work->lo = Work->nextcand ;
	    Work->hi = Work->nextcand + Work->ncand - 1 ;
	    jmax = MIN (MAX_CANDIDATES, Work->ncand) ;
	    DEBUGm1 ((">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Starting front "
		ID", npivcol: "ID"\n", Work->frontid, Work->ncand)) ;
	    if (fixQ)
	    {
		/* do not modify the column order */
		jmax = 1 ;
	    }
	    DEBUGm1 (("Initial candidates: ")) ;
	    for (j = 0 ; j < jmax ; j++)
	    {
		DEBUGm1 ((" "ID, Work->nextcand)) ;
		ASSERT (Work->nextcand <= Work->hi) ;
		Work->Candidates [j] = Work->nextcand++ ;
	    }
	    Work->nCandidates = jmax ;
	    DEBUGm1 (("\n")) ;

	    /* -------------------------------------------------------------- */
	    /* Assemble and factorize the current frontal matrix */
	    /* -------------------------------------------------------------- */

	    while (Work->ncand > 0)
	    {

		/* ---------------------------------------------------------- */
		/* get the pivot row and column */
		/* ---------------------------------------------------------- */

		status = UMF_local_search (Numeric, Work, Symbolic) ;
		if (status == UMFPACK_ERROR_different_pattern)
		{
		    /* :: pattern change detected in umf_local_search :: */
		    /* input matrix has changed since umfpack_*symbolic */
		    DEBUGm4 (("local search failed\n")) ;
		    return (UMFPACK_ERROR_different_pattern) ;
		}
		if (status == UMFPACK_WARNING_singular_matrix)
		{
		    /* no pivot found, discard and try again */
		    continue ;
		}

		/* ---------------------------------------------------------- */
		/* update if front not extended or too many zeros in L,U */
		/* ---------------------------------------------------------- */

		if (Work->do_update)
		{
		    UMF_blas3_update (Work) ;
		    if (drop)
		    {
			DO (UMF_store_lu_drop (Numeric, Work)) ;
		    }
		    else
		    {
			DO (UMF_store_lu (Numeric, Work)) ;
		    }
		}

		/* ---------------------------------------------------------- */
		/* extend the frontal matrix, or start a new one */
		/* ---------------------------------------------------------- */

		if (Work->do_extend)
		{
		    /* extend the current front */
		    DO (UMF_extend_front (Numeric, Work)) ;
		}
		else
		{
		    /* finish the current front (if any) and start a new one */
		    DO (UMF_create_element (Numeric, Work, Symbolic)) ;
		    DO (UMF_init_front (Numeric, Work)) ;
		}

		/* ---------------------------------------------------------- */
		/* Numerical & symbolic assembly into current frontal matrix */
		/* ---------------------------------------------------------- */

		if (fixQ)
		{
		    UMF_assemble_fixq (Numeric, Work) ;
		}
		else
		{
		    UMF_assemble (Numeric, Work) ;
		}

		/* ---------------------------------------------------------- */
		/* scale the pivot column */
		/* ---------------------------------------------------------- */

		UMF_scale_column (Numeric, Work) ;

		/* ---------------------------------------------------------- */
		/* Numerical update if enough pivots accumulated */
		/* ---------------------------------------------------------- */

		evaporate = Work->fnrows == 0 || Work->fncols == 0 ;
		if (Work->fnpiv >= nb || evaporate)
		{
		    UMF_blas3_update (Work) ;
		    if (drop)
		    {
			DO (UMF_store_lu_drop (Numeric, Work)) ;
		    }
		    else
		    {
			DO (UMF_store_lu (Numeric, Work)) ;
		    }

		}

		Work->pivrow_in_front = FALSE ;
		Work->pivcol_in_front = FALSE ;

		/* ---------------------------------------------------------- */
		/* If front is empty, evaporate it */
		/* ---------------------------------------------------------- */

		if (evaporate)
		{
		    /* This does not create an element, just evaporates it.
		     * It ensures that a front is not 0-by-c or r-by-0.  No
		     * memory is allocated, so it is guaranteed to succeed. */
		    (void) UMF_create_element (Numeric, Work, Symbolic) ;
		    Work->fnrows = 0 ;
		    Work->fncols = 0 ;
		}
	    }
	}

	/* ------------------------------------------------------------------
	 * Wrapup the current frontal matrix.  This is the last in a chain
	 * in the column elimination tree.  The next frontal matrix
	 * cannot overlap with the current one, which will be its sibling
	 * in the column etree.
	 * ------------------------------------------------------------------ */

	UMF_blas3_update (Work) ;
	if (drop)
	{
	    DO (UMF_store_lu_drop (Numeric, Work)) ;
	}
	else
	{
	    DO (UMF_store_lu (Numeric, Work)) ;
	}
	Work->fnrows_new = Work->fnrows ;
	Work->fncols_new = Work->fncols ;
	DO (UMF_create_element (Numeric, Work, Symbolic)) ;

	/* ------------------------------------------------------------------ */
	/* current front is now empty */
	/* ------------------------------------------------------------------ */

	Work->fnrows = 0 ;
	Work->fncols = 0 ;
    }

    /* ---------------------------------------------------------------------- */
    /* end the last Lchain and Uchain and finalize the LU factors */
    /* ---------------------------------------------------------------------- */

    UMF_kernel_wrapup (Numeric, Symbolic, Work) ;

    /* note that the matrix may be singular (this is OK) */
    return (UMFPACK_OK) ;
}