// testface: given cube at lattice (i, j, k), and four corners of face,
// if surface crosses face, compute other four corners of adjacent cube
// and add new cube to cube stack
void IsoSurfacePolygonizer::testFace(int i, int j, int k, const StackedCube &oldCube, CubeFace face, CubeCorner c1, CubeCorner c2, CubeCorner c3, CubeCorner c4) {
static int facebit[6] = {2, 2, 1, 1, 0, 0};
int bit = facebit[face];
bool c1Positive = oldCube.m_corners[c1]->m_positive;
// test if no surface crossing, cube out of bounds, or already visited:
if(oldCube.m_corners[c2]->m_positive == c1Positive
&& oldCube.m_corners[c3]->m_positive == c1Positive
&& oldCube.m_corners[c4]->m_positive == c1Positive) {
return;
}
// create new cube:
StackedCube newCube(i, j, k,0);
if(!addToDoneSet(newCube.m_key)) {
return;
}
newCube.m_corners[FLIP(c1, bit)] = oldCube.m_corners[c1];
newCube.m_corners[FLIP(c2, bit)] = oldCube.m_corners[c2];
newCube.m_corners[FLIP(c3, bit)] = oldCube.m_corners[c3];
newCube.m_corners[FLIP(c4, bit)] = oldCube.m_corners[c4];
for(int n = 0; n < ARRAYSIZE(newCube.m_corners); n++) {
if(newCube.m_corners[n] == NULL) {
newCube.m_corners[n] = getCorner(i+BIT(n,2), j+BIT(n,1), k+BIT(n,0));
}
}
if( !m_boundingBox.contains(*newCube.m_corners[LBN])
|| !m_boundingBox.contains(*newCube.m_corners[RTF])) {
return;
}
pushCube(newCube);
}
/**
* Implement glCopyPixels for the front color buffer (or back buffer Pixmap)
* for the color buffer. Don't support zooming, pixel transfer, etc.
* We do support copying from one window to another, ala glXMakeCurrentRead.
*/
static void
intelCopyPixels( GLcontext *ctx,
GLint srcx, GLint srcy, GLsizei width, GLsizei height,
GLint destx, GLint desty, GLenum type )
{
#if 0
const XMesaContext xmesa = XMESA_CONTEXT(ctx);
const SWcontext *swrast = SWRAST_CONTEXT( ctx );
XMesaDisplay *dpy = xmesa->xm_visual->display;
const XMesaDrawable drawBuffer = xmesa->xm_draw_buffer->buffer;
const XMesaDrawable readBuffer = xmesa->xm_read_buffer->buffer;
const XMesaGC gc = xmesa->xm_draw_buffer->gc;
ASSERT(dpy);
ASSERT(gc);
if (drawBuffer && /* buffer != 0 means it's a Window or Pixmap */
readBuffer &&
type == GL_COLOR &&
(swrast->_RasterMask & ~CLIP_BIT) == 0 && /* no blend, z-test, etc */
ctx->_ImageTransferState == 0 && /* no color tables, scale/bias, etc */
ctx->Pixel.ZoomX == 1.0 && /* no zooming */
ctx->Pixel.ZoomY == 1.0) {
/* Note: we don't do any special clipping work here. We could,
* but X will do it for us.
*/
srcy = FLIP(xmesa->xm_read_buffer, srcy) - height + 1;
desty = FLIP(xmesa->xm_draw_buffer, desty) - height + 1;
XCopyArea(dpy, readBuffer, drawBuffer, gc,
srcx, srcy, width, height, destx, desty);
}
#else
_swrast_CopyPixels(ctx, srcx, srcy, width, height, destx, desty, type );
#endif
}
static void _remove(ptst_t *ptst, node_t *a, int dir1, int dir2, qnode_t **pqn)
{
node_t *b = FOLLOW(a, dir1), *c = FOLLOW(b, dir2);
assert(FOLLOW(b, FLIP(dir2)) == NULL);
assert(!IS_BLUE(a));
assert(!IS_BLUE(b));
UPDATE(a, dir1, c);
UPDATE(b, FLIP(dir2), c);
b->p = a;
MK_BLUE(b);
gc_free(ptst, b, gc_id);
UNLOCK(a, pqn[0]);
UNLOCK(b, pqn[1]);
}
void
xmesa_get_tile_rgba(struct pipe_context *pipe, struct pipe_surface *ps,
uint x, uint y, uint w, uint h, float *p)
{
struct xmesa_surface *xms = xmesa_surface(ps);
struct xmesa_renderbuffer *xrb = xms->xrb;
if (xrb) {
/* this is a front/back color buffer */
GLubyte tmp[MAX_WIDTH * 4];
GLuint i, j;
uint w0 = w;
GET_CURRENT_CONTEXT(ctx);
CLIP_TILE;
FLIP(y);
for (i = 0; i < h; i++) {
xrb->St.Base.GetRow(ctx, &xrb->St.Base, w, x, y - i, tmp);
for (j = 0; j < w * 4; j++) {
p[j] = UBYTE_TO_FLOAT(tmp[j]);
}
p += w0 * 4;
}
}
else {
/* other softpipe surface */
softpipe_get_tile_rgba(ps, x, y, w, h, p);
}
}
void
xmesa_put_tile_rgba(struct pipe_context *pipe, struct pipe_surface *ps,
uint x, uint y, uint w, uint h, const float *p)
{
struct xmesa_surface *xms = xmesa_surface(ps);
struct xmesa_renderbuffer *xrb = xms->xrb;
if (xrb) {
/* this is a front/back color buffer */
GLubyte tmp[MAX_WIDTH * 4];
GLuint i, j;
uint w0 = w;
GET_CURRENT_CONTEXT(ctx);
CLIP_TILE;
FLIP(y);
for (i = 0; i < h; i++) {
for (j = 0; j < w * 4; j++) {
UNCLAMPED_FLOAT_TO_UBYTE(tmp[j], p[j]);
}
xrb->St.Base.PutRow(ctx, &xrb->St.Base, w, x, y - i, tmp, NULL);
p += w0 * 4;
}
#if 0 /* debug: flush */
{
XMesaContext xm = XMESA_CONTEXT(ctx);
XSync(xm->display, 0);
}
#endif
}
else {
/* other softpipe surface */
softpipe_put_tile_rgba(ps, x, y, w, h, p);
}
}
InputType blet_event_handler (Pos *pos, GtkboardEvent *event, MoveInfo *move_info_p)
{
static byte move[32];
byte *mp = move;
int val, k, x, y;
if (event->type != GTKBOARD_BUTTON_RELEASE)
return INPUT_NOTYET;
x = event->x;
y = event->y;
if (x > 0 && x < board_wid - 1 && y > 0 && y < board_heit - 1)
{
move_info_p->help_message = "You must click on one of the balls.";
return INPUT_ILLEGAL;
}
val = pos->board [y * board_wid + x];
for (k=0; k < 4; k++)
{
int newx = x + incx[k], newy = y + incy[k];
if (!ISINBOARD(newx, newy)) continue;
if (pos->board[newy * board_wid + newx] == val)
{
move_info_p->help_message = "Both neighbors must be of the opposite color.";
return INPUT_ILLEGAL;
}
if (pos->board[newy * board_wid + newx] == BLET_EMPTY) continue;
*mp++ = newx; *mp++ = newy; *mp++ = val;
}
*mp++ = x; *mp++ = y; *mp++ = FLIP(val);
*mp++ = -1;
move_info_p->move = move;
return INPUT_LEGAL;
}
static node_t *rotate(ptst_t *ptst, node_t *a, int dir1,
int dir2, node_t **pc, qnode_t *pqn[])
{
node_t *b = FOLLOW(a, dir1), *c = FOLLOW(b, dir2);
node_t *bp = gc_alloc(ptst, gc_id), *cp = gc_alloc(ptst, gc_id);
qnode_t c_qn;
LOCK(c, &c_qn);
memcpy(bp, b, sizeof(*b));
memcpy(cp, c, sizeof(*c));
mcs_init(&bp->lock);
mcs_init(&cp->lock);
LOCK(bp, pqn[3]);
LOCK(cp, pqn[2]);
assert(!IS_BLUE(a));
assert(!IS_BLUE(b));
assert(!IS_BLUE(c));
UPDATE(cp, FLIP(dir2), bp);
UPDATE(bp, dir2, FOLLOW(c, FLIP(dir2)));
UPDATE(a, dir1, cp);
b->p = a;
MK_BLUE(b);
c->p = cp;
MK_BLUE(c);
gc_free(ptst, b, gc_id);
gc_free(ptst, c, gc_id);
UNLOCK(a, pqn[0]);
UNLOCK(b, pqn[1]);
UNLOCK(c, &c_qn);
*pc = bp;
return cp;
}
PRIVATE Int finish_permutation
(
Int n1,
Int nx,
Int Xdeg [ ],
const Int Xuser [ ],
Int Xperm [ ],
Int *p_max_deg
)
{
Int nempty, x, deg, s, max_deg, k ;
nempty = 0 ;
s = n1 ;
max_deg = 0 ;
DEBUG0 (("n1 "ID" nempty "ID"\n", n1, nempty)) ;
for (k = 0 ; k < nx ; k++)
{
x = (Xuser != (Int *) NULL) ? Xuser [k] : k ;
DEBUG0 (("finish perm k "ID" x "ID" nx "ID"\n", k, x, nx)) ;
deg = Xdeg [x] ;
if (deg == 0)
{
/* this row/col is empty in the pruned submatrix */
ASSERT (s < nx - nempty) ;
DEBUG0 (("empty k "ID"\n", k)) ;
nempty++ ;
Xperm [nx - nempty] = x ;
}
else if (deg > 0)
{
/* this row/col is nonempty in the pruned submatrix */
ASSERT (s < nx - nempty) ;
Xperm [s++] = x ;
max_deg = MAX (max_deg, deg) ;
}
else
{
/* This is a singleton row/column - it is already ordered.
* Just clear the flag. */
Xdeg [x] = FLIP (deg) ;
}
}
ASSERT (s == nx - nempty) ;
*p_max_deg = max_deg ;
return (nempty) ;
}
int CHOLMOD(updown_mark)
(
/* ---- input ---- */
int update, /* TRUE for update, FALSE for downdate */
cholmod_sparse *C, /* the incoming sparse update */
Int *colmark, /* Int array of size n. See cholmod_updown.c */
/* ---- in/out --- */
cholmod_factor *L, /* factor to modify */
cholmod_dense *X, /* solution to Lx=b (size n-by-1) */
cholmod_dense *DeltaB, /* change in b, zero on output */
Int *rowmark, /* Int array of size n. See cholmod_updown.c */
/* --------------- */
cholmod_common *Common
)
{
double xj, fl ;
double *Lx, *W, *Xx, *Nx ;
Int *Li, *Lp, *Lnz, *Cp, *Ci, *Cnz, *Head, *Flag, *Stack, *Lnext, *Iwork,
*Set_ps1 [32], *Set_ps2 [32], *ps1, *ps2 ;
size_t maxrank ;
Path_type OrderedPath [32], Path [32] ;
Int n, wdim, k1, k2, npaths, i, j, row, packed, ccol, p, cncol, do_solve,
mark, jj, j2, kk, nextj, p1, p2, c, use_rowmark, use_colmark, newlnz,
k, newpath, path_order, w_order, scattered, path, newparent, pp1, pp2,
smax, maxrow, row1, nsets, s, p3, newlnz1, Set [32], top, len, lnz, m,
botrow ;
DEBUG (Int oldparent) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
RETURN_IF_NULL_COMMON (FALSE) ;
RETURN_IF_NULL (C, FALSE) ;
RETURN_IF_NULL (L, FALSE) ;
RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (C, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
n = L->n ;
cncol = C->ncol ;
Common->modfl = 0 ;
if (!(C->sorted))
{
ERROR (CHOLMOD_INVALID, "C must have sorted columns") ;
return (FALSE) ;
}
if (n != (Int) (C->nrow))
{
ERROR (CHOLMOD_INVALID, "C and L dimensions do not match") ;
return (FALSE) ;
}
do_solve = (X != NULL) && (DeltaB != NULL) ;
if (do_solve)
{
RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ;
Xx = X->x ;
Nx = DeltaB->x ;
if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n ||
DeltaB->ncol != 1 || Xx == NULL || Nx == NULL)
{
ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ;
return (FALSE) ;
}
}
else
{
Xx = NULL ;
Nx = NULL ;
}
Common->status = CHOLMOD_OK ;
fl = 0 ;
use_rowmark = (rowmark != NULL) ;
use_colmark = (colmark != NULL) ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
/* Note: cholmod_rowadd and cholmod_rowdel use the second n doubles in
* Common->Xwork for Cx, and then perform a rank-1 update here, which uses
* the first n doubles in Common->Xwork. Both the rowadd and rowdel
* routines allocate enough workspace so that Common->Xwork isn't destroyed
* below. Also, both cholmod_rowadd and cholmod_rowdel use the second n
* ints in Common->Iwork for Ci.
*/
/* make sure maxrank is in the proper range */
maxrank = CHOLMOD(maxrank) (n, Common) ;
k = MIN (cncol, (Int) maxrank) ; /* maximum k is wdim */
wdim = Power2 [k] ; /* number of columns needed in W */
ASSERT (wdim <= (Int) maxrank) ;
PRINT1 (("updown wdim final "ID" k "ID"\n", wdim, k)) ;
CHOLMOD(allocate_work) (n, n, wdim * n, Common) ;
if (Common->status < CHOLMOD_OK || maxrank == 0)
{
/* out of memory, L is returned unchanged */
return (FALSE) ;
}
/* ---------------------------------------------------------------------- */
/* convert to simplicial numeric LDL' factor, if not already */
/* ---------------------------------------------------------------------- */
if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll)
{
/* can only update/downdate a simplicial LDL' factorization */
CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L,
Common) ;
if (Common->status < CHOLMOD_OK)
{
/* out of memory, L is returned unchanged */
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
mark = CHOLMOD(clear_flag) (Common) ;
PRINT1 (("updown, rank %ld update %d\n", (long) C->ncol, update)) ;
DEBUG (CHOLMOD(dump_factor) (L, "input L for updown", Common)) ;
ASSERT (CHOLMOD(dump_sparse) (C, "input C for updown", Common) >= 0) ;
Ci = C->i ;
Cp = C->p ;
Cnz = C->nz ;
packed = C->packed ;
ASSERT (IMPLIES (!packed, Cnz != NULL)) ;
/* ---------------------------------------------------------------------- */
/* quick return */
/* ---------------------------------------------------------------------- */
if (cncol <= 0 || n == 0)
{
/* nothing to do */
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* get L */
/* ---------------------------------------------------------------------- */
Li = L->i ;
Lx = L->x ;
Lp = L->p ;
Lnz = L->nz ;
Lnext = L->next ;
ASSERT (Lnz != NULL) ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Flag = Common->Flag ; /* size n, Flag [i] <= mark must hold */
Head = Common->Head ; /* size n, Head [i] == EMPTY must hold */
W = Common->Xwork ; /* size n-by-wdim, zero on input and output*/
/* note that Iwork [n .. 2*n-1] (i/i/l) may be in use in rowadd/rowdel: */
Iwork = Common->Iwork ;
Stack = Iwork ; /* size n, uninitialized (i/i/l) */
/* ---------------------------------------------------------------------- */
/* entire rank-cncol update, done as a sequence of rank-k updates */
/* ---------------------------------------------------------------------- */
ps1 = NULL ;
ps2 = NULL ;
for (k1 = 0 ; k1 < cncol ; k1 += k)
{
/* ------------------------------------------------------------------ */
/* get the next k columns of C for the update/downdate */
/* ------------------------------------------------------------------ */
/* the last update/downdate might be less than rank-k */
if (k > cncol - k1)
{
k = cncol - k1 ;
wdim = Power2 [k] ;
}
k2 = k1 + k - 1 ;
/* workspaces are in the following state, on input and output */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
/* ------------------------------------------------------------------ */
/* create a zero-length path for each column of W */
/* ------------------------------------------------------------------ */
nextj = n ;
path = 0 ;
for (ccol = k1 ; ccol <= k2 ; ccol++)
{
PRINT1 (("Column ["ID"]: "ID"\n", path, ccol)) ;
ASSERT (ccol >= 0 && ccol <= cncol) ;
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
/* get the row index j of the first entry in C (:,ccol) */
if (pp2 > pp1)
{
/* Column ccol of C has at least one entry. */
j = Ci [pp1] ;
}
else
{
/* Column ccol of C is empty. Pretend it has one entry in
* the last column with numerical value of zero. */
j = n-1 ;
}
ASSERT (j >= 0 && j < n) ;
/* find first column to work on */
nextj = MIN (nextj, j) ;
Path [path].ccol = ccol ; /* which column of C this path is for */
Path [path].start = EMPTY ; /* paths for C have zero length */
Path [path].end = EMPTY ;
Path [path].parent = EMPTY ; /* no parent yet */
Path [path].rank = 1 ; /* one column of W */
Path [path].c = EMPTY ; /* no child of this path (case A) */
Path [path].next = Head [j] ; /* this path is pending at col j */
Path [path].pending = j ; /* this path is pending at col j */
Head [j] = path ; /* this path is pending at col j */
PRINT1(("Path "ID" starts: start "ID" end "ID" parent "ID" c "ID""
"j "ID" ccol "ID"\n", path, Path [path].start,
Path [path].end, Path [path].parent,
Path [path].c, j, ccol)) ;
path++ ;
}
/* we start with paths 0 to k-1. Next one (now unused) is npaths */
npaths = k ;
j = nextj ;
ASSERT (j < n) ;
scattered = FALSE ;
/* ------------------------------------------------------------------ */
/* symbolic update of columns of L */
/* ------------------------------------------------------------------ */
while (j < n)
{
ASSERT (j >= 0 && j < n && Lnz [j] > 0) ;
/* the old column, Li [p1..p2-1]. D (j,j) is stored in Lx [p1] */
p1 = Lp [j] ;
newlnz = Lnz [j] ;
p2 = p1 + newlnz ;
#ifndef NDEBUG
PRINT1 (("\n=========Column j="ID" p1 "ID" p2 "ID" lnz "ID" \n",
j, p1, p2, newlnz)) ;
dump_col ("Old", j, p1, p2, Li, Lx, n, Common) ;
oldparent = (Lnz [j] > 1) ? (Li [p1 + 1]) : EMPTY ;
ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ;
ASSERT (!scattered) ;
PRINT1 (("Col "ID": Checking paths, npaths: "ID"\n", j, npaths)) ;
for (kk = 0 ; kk < npaths ; kk++)
{
Int kk2, found, j3 = Path [kk].pending ;
PRINT2 (("Path "ID" pending at "ID".\n", kk, j3)) ;
if (j3 != EMPTY)
{
/* Path kk must be somewhere in link list for column j3 */
ASSERT (Head [j3] != EMPTY) ;
PRINT3 ((" List at "ID": ", j3)) ;
found = FALSE ;
for (kk2 = Head [j3] ; kk2 != EMPTY ; kk2 = Path [kk2].next)
{
PRINT3 ((""ID" ", kk2)) ;
ASSERT (Path [kk2].pending == j3) ;
found = found || (kk2 == kk) ;
}
PRINT3 (("\n")) ;
ASSERT (found) ;
}
}
PRINT1 (("\nCol "ID": Paths at this column, head "ID"\n",
j, Head [j]));
ASSERT (Head [j] != EMPTY) ;
for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next)
{
PRINT1 (("path "ID": (c="ID" j="ID") npaths "ID"\n",
kk, Path[kk].c, j, npaths)) ;
ASSERT (kk >= 0 && kk < npaths) ;
ASSERT (Path [kk].pending == j) ;
}
#endif
/* -------------------------------------------------------------- */
/* update/downdate of forward solve, Lx=b */
/* -------------------------------------------------------------- */
if (do_solve)
{
xj = Xx [j] ;
if (IS_NONZERO (xj))
{
xj = Xx [j] ;
/* This is first time column j has been seen for entire */
/* rank-k update/downdate. */
/* DeltaB += Lold (j:botrow-1,j) * X (j) */
Nx [j] += xj ; /* diagonal of L */
botrow = (use_rowmark) ? (rowmark [j]) : n ;
for (p = p1 + 1 ; p < p2 ; p++)
{
i = Li [p] ;
if (i >= botrow)
{
break ;
}
Nx [i] += Lx [p] * xj ;
}
/* clear X[j] to flag col j of Lold as having been seen. If
* X (j) was initially zero, then the above code is never
* executed for column j. This is safe, since if xj=0 the
* code above does not do anything anyway. */
Xx [j] = 0.0 ;
}
}
/* -------------------------------------------------------------- */
/* start a new path at this column if two or more paths merge */
/* -------------------------------------------------------------- */
/* get the first old path at column j */
path = Head [j] ;
newpath =
/* start a new path if paths have merged */
(Path [path].next != EMPTY)
/* or if j is the first node on a path (case A). */
|| (Path [path].c == EMPTY) ;
if (newpath)
{
path = npaths++ ;
ASSERT (npaths <= 3*k) ;
Path [path].ccol = EMPTY ; /* no single col of C for this path*/
Path [path].start = j ; /* path starts at this column j */
Path [path].end = EMPTY ; /* don't know yet where it ends */
Path [path].parent = EMPTY ;/* don't know parent path yet */
Path [path].rank = 0 ; /* rank is sum of child path ranks */
PRINT1 (("Path "ID" starts: start "ID" end "ID" parent "ID"\n",
path, Path [path].start, Path [path].end, Path [path].parent)) ;
}
/* -------------------------------------------------------------- */
/* for each path kk pending at column j */
/* -------------------------------------------------------------- */
/* make a list of the sets that need to be merged into column j */
nsets = 0 ;
for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next)
{
/* ---------------------------------------------------------- */
/* path kk is at (c,j) */
/* ---------------------------------------------------------- */
c = Path [kk].c ;
ASSERT (c < j) ;
PRINT1 (("TUPLE on path "ID" (c="ID" j="ID")\n", kk, c, j)) ;
ASSERT (Path [kk].pending == j) ;
if (newpath)
{
/* finalize path kk and find rank of this path */
Path [kk].end = c ; /* end of old path is previous node c */
Path [kk].parent = path ; /* parent is this path */
Path [path].rank += Path [kk].rank ; /* sum up ranks */
Path [kk].pending = EMPTY ;
PRINT1 (("Path "ID" done:start "ID" end "ID" parent "ID"\n",
kk, Path [kk].start, Path [kk].end, Path [kk].parent)) ;
}
if (c == EMPTY)
{
/* ------------------------------------------------------ */
/* CASE A: first node in path */
/* ------------------------------------------------------ */
/* update: add pattern of incoming column */
/* Column ccol of C is in Ci [pp1 ... pp2-1] */
ccol = Path [kk].ccol ;
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
PRINT1 (("Case A, ccol = "ID" len "ID"\n", ccol, pp2-pp1)) ;
ASSERT (IMPLIES (pp2 > pp1, Ci [pp1] == j)) ;
if (!scattered)
{
/* scatter the original pattern of column j of L */
for (p = p1 ; p < p2 ; p++)
{
Flag [Li [p]] = mark ;
}
scattered = TRUE ;
}
/* scatter column ccol of C (skip first entry, j) */
newlnz1 = newlnz ;
for (p = pp1 + 1 ; p < pp2 ; p++)
{
row = Ci [p] ;
if (Flag [row] < mark)
{
/* this is a new entry in Lj' */
Flag [row] = mark ;
newlnz++ ;
}
}
if (newlnz1 != newlnz)
{
/* column ccol of C adds something to column j of L */
Set [nsets++] = FLIP (ccol) ;
}
}
else if (Head [c] == 1)
{
/* ------------------------------------------------------ */
/* CASE B: c is old, but changed, child of j */
/* CASE C: new child of j */
/* ------------------------------------------------------ */
/* Head [c] is 1 if col c of L has new entries,
* EMPTY otherwise */
Flag [c] = 0 ;
Head [c] = EMPTY ;
/* update: add Lc' */
/* column c of L is in Li [pp1 .. pp2-1] */
pp1 = Lp [c] ;
pp2 = pp1 + Lnz [c] ;
PRINT1 (("Case B/C: c = "ID"\n", c)) ;
DEBUG (dump_col ("Child", c, pp1, pp2, Li, Lx, n, Common)) ;
ASSERT (j == Li [pp1 + 1]) ; /* j is new parent of c */
if (!scattered)
{
/* scatter the original pattern of column j of L */
for (p = p1 ; p < p2 ; p++)
{
Flag [Li [p]] = mark ;
}
scattered = TRUE ;
}
/* scatter column c of L (skip first two entries, c and j)*/
newlnz1 = newlnz ;
for (p = pp1 + 2 ; p < pp2 ; p++)
{
row = Li [p] ;
if (Flag [row] < mark)
{
/* this is a new entry in Lj' */
Flag [row] = mark ;
newlnz++ ;
}
}
PRINT2 (("\n")) ;
if (newlnz1 != newlnz)
{
/* column c of L adds something to column j of L */
Set [nsets++] = c ;
}
}
}
/* -------------------------------------------------------------- */
/* update the pattern of column j of L */
/* -------------------------------------------------------------- */
/* Column j of L will be in Li/Lx [p1 .. p3-1] */
p3 = p1 + newlnz ;
ASSERT (IMPLIES (nsets == 0, newlnz == Lnz [j])) ;
PRINT1 (("p1 "ID" p2 "ID" p3 "ID" nsets "ID"\n", p1, p2, p3,nsets));
/* -------------------------------------------------------------- */
/* ensure we have enough space for the longer column */
/* -------------------------------------------------------------- */
if (nsets > 0 && p3 > Lp [Lnext [j]])
{
PRINT1 (("Col realloc: j "ID" newlnz "ID"\n", j, newlnz)) ;
if (!CHOLMOD(reallocate_column) (j, newlnz, L, Common))
{
/* out of memory, L is now simplicial symbolic */
CHOLMOD(clear_flag) (Common) ;
for (j = 0 ; j <= n ; j++)
{
Head [j] = EMPTY ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
return (FALSE) ;
}
/* L->i and L->x may have moved. Column j has moved too */
Li = L->i ;
Lx = L->x ;
p1 = Lp [j] ;
p2 = p1 + Lnz [j] ;
p3 = p1 + newlnz ;
}
/* -------------------------------------------------------------- */
/* create set pointers */
/* -------------------------------------------------------------- */
for (s = 0 ; s < nsets ; s++)
{
/* Pattern of Set s is *(Set_ps1 [s] ... Set_ps2 [s]-1) */
c = Set [s] ;
if (c < EMPTY)
{
/* column ccol of C, skip first entry (j) */
ccol = FLIP (c) ;
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
ASSERT (pp2 - pp1 > 1) ;
Set_ps1 [s] = &(Ci [pp1 + 1]) ;
Set_ps2 [s] = &(Ci [pp2]) ;
PRINT1 (("set "ID" is ccol "ID"\n", s, ccol)) ;
}
else
{
/* column c of L, skip first two entries (c and j) */
pp1 = Lp [c] ;
pp2 = pp1 + Lnz [c] ;
ASSERT (Lnz [c] > 2) ;
Set_ps1 [s] = &(Li [pp1 + 2]) ;
Set_ps2 [s] = &(Li [pp2]) ;
PRINT1 (("set "ID" is L "ID"\n", s, c)) ;
}
DEBUG (dump_set (s, Set_ps1, Set_ps2, j, n, Common)) ;
}
/* -------------------------------------------------------------- */
/* multiset merge */
/* -------------------------------------------------------------- */
/* Merge the sets into a single sorted set, Lj'. Before the merge
* starts, column j is located in Li/Lx [p1 ... p2-1] and the
* space Li/Lx [p2 ... p3-1] is empty. p1 is Lp [j], p2 is
* Lp [j] + Lnz [j] (the old length of the column), and p3 is
* Lp [j] + newlnz (the new and longer length of the column).
*
* The sets 0 to nsets-1 are defined by the Set_ps1 and Set_ps2
* pointers. Set s is located in *(Set_ps1 [s] ... Set_ps2 [s]-1).
* It may be a column of C, or a column of L. All row indices i in
* the sets are in the range i > j and i < n. All sets are sorted.
*
* The merge into column j of L is done in place.
*
* During the merge, p2 and p3 are updated. Li/Lx [p1..p2-1]
* reflects the indices of the old column j of L that are yet to
* be merged into the new column. Entries in their proper place in
* the new column j of L are located in Li/Lx [p3 ... p1+newlnz-1].
* The merge finishes when p2 == p3.
*
* During the merge, set s consumed as it is merged into column j of
* L. Its unconsumed contents are *(Set_ps1 [s] ... Set_ps2 [s]-1).
* When a set is completely consumed, it is removed from the set of
* sets, and nsets is decremented.
*
* The multiset merge and 2-set merge finishes when p2 == p3.
*/
PRINT1 (("Multiset merge p3 "ID" p2 "ID" nsets "ID"\n",
p3, p2, nsets)) ;
while (p3 > p2 && nsets > 1)
{
#ifndef NDEBUG
PRINT2 (("\nMultiset merge. nsets = "ID"\n", nsets)) ;
PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n",
p1, p2, p3)) ;
for (p = p1 + 1 ; p < p2 ; p++)
{
PRINT2 ((" p: "ID" source row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
PRINT2 (("---\n")) ;
for (p = p3 ; p < p1 + newlnz ; p++)
{
PRINT2 ((" p: "ID" target row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
for (s = 0 ; s < nsets ; s++)
{
dump_set (s, Set_ps1, Set_ps2, j, n, Common) ;
}
#endif
/* get the entry at the tail end of source column Lj */
row1 = Li [p2 - 1] ;
ASSERT (row1 >= j && p2 >= p1) ;
/* find the largest row in all the sets */
maxrow = row1 ;
smax = EMPTY ;
for (s = nsets-1 ; s >= 0 ; s--)
{
ASSERT (Set_ps1 [s] < Set_ps2 [s]) ;
row = *(Set_ps2 [s] - 1) ;
if (row == maxrow)
{
/* skip past this entry in set s (it is a duplicate) */
Set_ps2 [s]-- ;
if (Set_ps1 [s] == Set_ps2 [s])
{
/* nothing more in this set */
nsets-- ;
Set_ps1 [s] = Set_ps1 [nsets] ;
Set_ps2 [s] = Set_ps2 [nsets] ;
if (smax == nsets)
{
/* Set smax redefined; it is now this set */
smax = s ;
}
}
}
else if (row > maxrow)
{
maxrow = row ;
smax = s ;
}
}
ASSERT (maxrow > j) ;
/* move the row onto the stack of the target column */
if (maxrow == row1)
{
/* next entry is in Lj, move to the bottom of Lj' */
ASSERT (smax == EMPTY) ;
p2-- ;
p3-- ;
Li [p3] = maxrow ;
Lx [p3] = Lx [p2] ;
}
else
{
/* new entry in Lj' */
ASSERT (smax >= 0 && smax < nsets) ;
Set_ps2 [smax]-- ;
p3-- ;
Li [p3] = maxrow ;
Lx [p3] = 0.0 ;
if (Set_ps1 [smax] == Set_ps2 [smax])
{
/* nothing more in this set */
nsets-- ;
Set_ps1 [smax] = Set_ps1 [nsets] ;
Set_ps2 [smax] = Set_ps2 [nsets] ;
PRINT1 (("Set "ID" now empty\n", smax)) ;
}
}
}
/* -------------------------------------------------------------- */
/* 2-set merge: */
/* -------------------------------------------------------------- */
/* This the same as the multi-set merge, except there is only one
* set s = 0 left. The source column j and the set 0 are being
* merged into the target column j. */
if (nsets > 0)
{
ps1 = Set_ps1 [0] ;
ps2 = Set_ps2 [0] ;
}
while (p3 > p2)
{
#ifndef NDEBUG
PRINT2 (("\n2-set merge.\n")) ;
ASSERT (nsets == 1) ;
PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n",
p1, p2, p3)) ;
for (p = p1 + 1 ; p < p2 ; p++)
{
PRINT2 ((" p: "ID" source row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
PRINT2 (("---\n")) ;
for (p = p3 ; p < p1 + newlnz ; p++)
{
PRINT2 ((" p: "ID" target row "ID" %g\n",
p, Li[p], Lx[p])) ;
ASSERT (Li [p] > j && Li [p] < n) ;
}
dump_set (0, Set_ps1, Set_ps2, j, n, Common) ;
#endif
if (p2 == p1 + 1)
{
/* the top of Lj is empty; copy the set and quit */
while (p3 > p2)
{
/* new entry in Lj' */
row = *(--ps2) ;
p3-- ;
Li [p3] = row ;
Lx [p3] = 0.0 ;
}
}
else
{
/* get the entry at the tail end of Lj */
row1 = Li [p2 - 1] ;
ASSERT (row1 > j && row1 < n) ;
/* get the entry at the tail end of the incoming set */
ASSERT (ps1 < ps2) ;
row = *(ps2-1) ;
ASSERT (row > j && row1 < n) ;
/* move the larger of the two entries to the target set */
if (row1 >= row)
{
/* next entry is in Lj, move to the bottom */
if (row1 == row)
{
/* skip past this entry in the set */
ps2-- ;
}
p2-- ;
p3-- ;
Li [p3] = row1 ;
Lx [p3] = Lx [p2] ;
}
else
{
/* new entry in Lj' */
ps2-- ;
p3-- ;
Li [p3] = row ;
Lx [p3] = 0.0 ;
}
}
}
/* -------------------------------------------------------------- */
/* The new column j of L is now in Li/Lx [p1 ... p2-1] */
/* -------------------------------------------------------------- */
p2 = p1 + newlnz ;
DEBUG (dump_col ("After merge: ", j, p1, p2, Li, Lx, n, Common)) ;
fl += Path [path].rank * (6 + 4 * (double) newlnz) ;
/* -------------------------------------------------------------- */
/* clear Flag; original pattern of column j L no longer marked */
/* -------------------------------------------------------------- */
mark = CHOLMOD(clear_flag) (Common) ;
scattered = FALSE ;
/* -------------------------------------------------------------- */
/* find the new parent */
/* -------------------------------------------------------------- */
newparent = (newlnz > 1) ? (Li [p1 + 1]) : EMPTY ;
PRINT1 (("\nNew parent, Lnz: "ID": "ID" "ID"\n",
j, newparent,newlnz));
ASSERT (oldparent == EMPTY || newparent <= oldparent) ;
/* -------------------------------------------------------------- */
/* go to the next node in the path */
/* -------------------------------------------------------------- */
/* path moves to (j,nextj) unless j is a root */
nextj = (newparent == EMPTY) ? n : newparent ;
/* place path at head of list for nextj, or terminate the path */
PRINT1 (("\n j = "ID" nextj = "ID"\n\n", j, nextj)) ;
Path [path].c = j ;
if (nextj < n)
{
/* put path on link list of pending paths at column nextj */
Path [path].next = Head [nextj] ;
Path [path].pending = nextj ;
Head [nextj] = path ;
PRINT1 (("Path "ID" continues to ("ID","ID"). Rank "ID"\n",
path, Path [path].c, nextj, Path [path].rank)) ;
}
else
{
/* path has ended here, at a root */
Path [path].next = EMPTY ;
Path [path].pending = EMPTY ;
Path [path].end = j ;
PRINT1 (("Path "ID" ends at root ("ID"). Rank "ID"\n",
path, Path [path].end, Path [path].rank)) ;
}
/* The link list Head [j] can now be emptied. Set Head [j] to 1
* if column j has changed (it is no longer used as a link list). */
PRINT1 (("column "ID", oldlnz = "ID"\n", j, Lnz [j])) ;
Head [j] = (Lnz [j] != newlnz) ? 1 : EMPTY ;
Lnz [j] = newlnz ;
PRINT1 (("column "ID", newlnz = "ID"\n", j, newlnz)) ;
DEBUG (dump_col ("New", j, p1, p2, Li, Lx, n, Common)) ;
/* move to the next column */
if (k == Path [path].rank)
{
/* only one path left */
j = nextj ;
}
else
{
/* The current path is moving from column j to column nextj
* (nextj is n if the path has ended). However, there may be
* other paths pending in columns j+1 to nextj-1. There are
* two methods for looking for the next column with a pending
* update. The first one looks at all columns j+1 to nextj-1
* for a non-empty link list. This can be costly if j and
* nextj differ by a large amount (it can be O(n), but this
* entire routine may take Omega(1) time). The second method
* looks at all paths and finds the smallest column at which any
* path is pending. It takes O(# of paths), which is bounded
* by 23: one for each column of C (up to 8), and then 15 for a
* balanced binary tree with 8 leaves. However, if j and
* nextj differ by a tiny amount (nextj is often j+1 near
* the end of the matrix), looking at columns j+1 to nextj
* would be faster. Both methods give the same answer. */
if (nextj - j < npaths)
{
/* there are fewer columns to search than paths */
PRINT1 (("check j="ID" to nextj="ID"\n", j, nextj)) ;
for (j2 = j + 1 ; j2 < nextj ; j2++)
{
PRINT1 (("check j="ID" "ID"\n", j2, Head [j2])) ;
if (Head [j2] != EMPTY)
{
PRINT1 (("found, j="ID"\n", j2)) ;
ASSERT (Path [Head [j2]].pending == j2) ;
break ;
}
}
}
else
{
/* there are fewer paths than columns to search */
j2 = nextj ;
for (kk = 0 ; kk < npaths ; kk++)
{
jj = Path [kk].pending ;
PRINT2 (("Path "ID" pending at "ID"\n", kk, jj)) ;
if (jj != EMPTY) j2 = MIN (j2, jj) ;
}
}
j = j2 ;
}
}
/* ensure workspaces are back to the values required on input */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ;
/* ------------------------------------------------------------------ */
/* depth-first-search of tree to order the paths */
/* ------------------------------------------------------------------ */
/* create lists of child paths */
PRINT1 (("\n\nDFS search:\n\n")) ;
for (path = 0 ; path < npaths ; path++)
{
Path [path].c = EMPTY ; /* first child of path */
Path [path].next = EMPTY ; /* next sibling of path */
Path [path].order = EMPTY ; /* path is not ordered yet */
Path [path].wfirst = EMPTY ; /* 1st column of W not found yet */
#ifndef NDEBUG
j = Path [path].start ;
PRINT1 (("Path "ID" : start "ID" end "ID" parent "ID" ccol "ID"\n",
path, j, Path [path].end, Path [path].parent, Path [path].ccol)) ;
for ( ; ; )
{
PRINT1 ((" column "ID"\n", j)) ;
ASSERT (j == EMPTY || (j >= 0 && j < n)) ;
if (j == Path [path].end)
{
break ;
}
ASSERT (j >= 0 && j < n) ;
j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ;
}
#endif
}
for (path = 0 ; path < npaths ; path++)
{
p = Path [path].parent ; /* add path to child list of parent */
if (p != EMPTY)
{
ASSERT (p < npaths) ;
Path [path].next = Path [p].c ;
Path [p].c = path ;
}
}
path_order = k ;
w_order = 0 ;
for (path = npaths-1 ; path >= 0 ; path--)
{
if (Path [path].order == EMPTY)
{
/* this path is the root of a subtree of Tbar */
PRINT1 (("Root path "ID"\n", path)) ;
ASSERT (path >= k) ;
dfs (Path, k, path, &path_order, &w_order, 0, npaths) ;
}
}
ASSERT (path_order == npaths) ;
ASSERT (w_order == k) ;
/* reorder the paths */
for (path = 0 ; path < npaths ; path++)
{
/* old order is path, new order is Path [path].order */
OrderedPath [Path [path].order] = Path [path] ;
}
#ifndef NDEBUG
for (path = 0 ; path < npaths ; path++)
{
PRINT1 (("Ordered Path "ID": start "ID" end "ID" wfirst "ID" rank "
""ID" ccol "ID"\n", path, OrderedPath [path].start,
OrderedPath [path].end, OrderedPath [path].wfirst,
OrderedPath [path].rank, OrderedPath [path].ccol)) ;
if (path < k)
{
ASSERT (OrderedPath [path].ccol >= 0) ;
}
else
{
ASSERT (OrderedPath [path].ccol == EMPTY) ;
}
}
#endif
/* ------------------------------------------------------------------ */
/* numeric update/downdate for all paths */
/* ------------------------------------------------------------------ */
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
switch (wdim)
{
case 1:
updown_1_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
case 2:
updown_2_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
case 4:
updown_4_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
case 8:
updown_8_r (update, C, k, L, W, OrderedPath, npaths, Common) ;
break ;
}
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ;
}
/* ---------------------------------------------------------------------- */
/* update/downdate the forward solve */
/* ---------------------------------------------------------------------- */
if (do_solve)
{
/* We now have DeltaB += Lold (:,j) * X (j) for all columns j in union
* of all paths seen during the entire rank-cncol update/downdate. For
* each j in path, do DeltaB -= Lnew (:,j)*DeltaB(j)
* in topological order. */
#ifndef NDEBUG
PRINT1 (("\ndo_solve, DeltaB + Lold(:,Path)*X(Path):\n")) ;
for (i = 0 ; i < n ; i++)
{
PRINT1 (("do_solve: "ID" %30.20e\n", i, Nx [i])) ;
}
#endif
/* Note that the downdate, if it deleted entries, would need to compute
* the Stack prior to doing any downdates. */
/* find the union of all the paths in the new L */
top = n ; /* "top" is stack pointer, not a row or column index */
for (ccol = 0 ; ccol < cncol ; ccol++)
{
/* -------------------------------------------------------------- */
/* j = first row index of C (:,ccol) */
/* -------------------------------------------------------------- */
pp1 = Cp [ccol] ;
pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ;
if (pp2 > pp1)
{
/* Column ccol of C has at least one entry. */
j = Ci [pp1] ;
}
else
{
/* Column ccol of C is empty */
j = n-1 ;
}
PRINT1 (("\ndo_solve: ccol= "ID"\n", ccol)) ;
ASSERT (j >= 0 && j < n) ;
len = 0 ;
/* -------------------------------------------------------------- */
/* find the new rowmark */
/* -------------------------------------------------------------- */
/* Each column of C can redefine the region of L that takes part in
* the update/downdate of the triangular solve Lx=b. If
* i = colmark [ccol] for column C(:,ccol), then i = rowmark [j] is
* redefined for all columns along the path modified by C(:,ccol).
* If more than one column modifies any given column j of L, then
* the rowmark of j is determined by the colmark of the least-
* numbered column that affects column j. That is, if both
* C(:,ccol1) and C(:,ccol2) affect column j of L, then
* rowmark [j] = colmark [MIN (ccol1, ccol2)].
*
* rowmark [j] is not modified if rowmark or colmark are NULL,
* or if colmark [ccol] is EMPTY.
*/
botrow = (use_colmark && use_rowmark) ? (colmark [ccol]) : EMPTY ;
/* -------------------------------------------------------------- */
/* traverse from j towards root, stopping if node already visited */
/* -------------------------------------------------------------- */
while (j != EMPTY && Flag [j] < mark)
{
PRINT1 (("do_solve: subpath j= "ID"\n", j)) ;
ASSERT (j >= 0 && j < n) ;
Stack [len++] = j ; /* place j on the stack */
Flag [j] = mark ; /* flag j as visited */
/* redefine the parts of column j of L that take part in
* the triangular solve. */
if (botrow != EMPTY)
{
/* update rowmark to keep track of botrow for col j */
rowmark [j] = botrow ;
}
/* go up the tree, to the parent of j */
j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ;
}
/* -------------------------------------------------------------- */
/* move the path down to the bottom of the stack */
/* -------------------------------------------------------------- */
ASSERT (len <= top) ;
while (len > 0)
{
Stack [--top] = Stack [--len] ;
}
}
#ifndef NDEBUG
/* Union of paths now in Stack [top..n-1] in topological order */
PRINT1 (("\nTopological order:\n")) ;
for (i = top ; i < n ; i++)
{
PRINT1 (("column "ID" in full path\n", Stack [i])) ;
}
#endif
/* Do the forward solve for the full path part of L */
for (m = top ; m < n ; m++)
{
j = Stack [m] ;
ASSERT (j >= 0 && j < n) ;
PRINT1 (("do_solve: path j= "ID"\n", j)) ;
p1 = Lp [j] ;
lnz = Lnz [j] ;
p2 = p1 + lnz ;
xj = Nx [j] ;
/* copy new solution onto old one, for all cols in full path */
Xx [j] = xj ;
Nx [j] = 0. ;
/* DeltaB -= Lnew (j+1:botrow-1,j) * deltab(j) */
botrow = (use_rowmark) ? (rowmark [j]) : n ;
for (p = p1 + 1 ; p < p2 ; p++)
{
i = Li [p] ;
if (i >= botrow)
{
break ;
}
Nx [i] -= Lx [p] * xj ;
}
}
/* clear the Flag */
mark = CHOLMOD(clear_flag) (Common) ;
}
/* ---------------------------------------------------------------------- */
/* successful update/downdate */
/* ---------------------------------------------------------------------- */
Common->modfl = fl ;
DEBUG (for (j = 0 ; j < n ; j++) ASSERT (IMPLIES (do_solve, Nx[j] == 0.))) ;
ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ;
DEBUG (CHOLMOD(dump_factor) (L, "output L for updown", Common)) ;
return (TRUE) ;
}
PRIVATE Int find_user_singletons /* returns # singletons found */
(
/* input, not modified: */
Int n_row,
Int n_col,
const Int Ap [ ], /* size n_col+1 */
const Int Ai [ ], /* size nz = Ap [n_col] */
const Int Quser [ ], /* size n_col if present */
/* input, modified on output: */
Int Cdeg [ ], /* size n_col */
Int Rdeg [ ], /* size n_row */
/* output, not defined on input */
Int Cperm [ ], /* size n_col */
Int Rperm [ ], /* size n_row */
Int *p_n1r, /* # of row singletons */
Int *p_n1c, /* # of col singletons */
/* workspace, not defined on input or output */
Int Rp [ ], /* size n_row+1 */
Int Ri [ ], /* size nz */
Int W [ ] /* size n_row */
)
{
Int n1, col, row, p, p2, pivcol, pivrow, found, k, n1r, n1c ;
n1 = 0 ;
n1r = 0 ;
n1c = 0 ;
*p_n1r = 0 ;
*p_n1c = 0 ;
/* find singletons in the user column permutation, Quser */
pivcol = Quser [0] ;
found = (Cdeg [pivcol] == 1) ;
DEBUG0 (("Is first col: "ID" a col singleton?: "ID"\n", pivcol, found)) ;
if (!found)
{
/* the first column is not a column singleton, check for a row
* singleton in the first column. */
for (p = Ap [pivcol] ; p < Ap [pivcol+1] ; p++)
{
if (Rdeg [Ai [p]] == 1)
{
DEBUG0 (("Row singleton in first col: "ID" row: "ID"\n",
pivcol, Ai [p])) ;
found = TRUE ;
break ;
}
}
}
if (!found)
{
/* no singletons in the leading part of A (:,Quser) */
return (0) ;
}
/* there is at least one row or column singleton. Look for more. */
create_row_form (n_row, n_col, Ap, Ai, Rdeg, Rp, Ri, W) ;
n1 = 0 ;
for (k = 0 ; k < n_col ; k++)
{
pivcol = Quser [k] ;
pivrow = EMPTY ;
/* ------------------------------------------------------------------ */
/* check if col is a column singleton, or contains a row singleton */
/* ------------------------------------------------------------------ */
found = (Cdeg [pivcol] == 1) ;
if (found)
{
/* -------------------------------------------------------------- */
/* pivcol is a column singleton */
/* -------------------------------------------------------------- */
DEBUG0 (("Found a col singleton: k "ID" pivcol "ID"\n", k, pivcol));
/* find the pivrow to match with this pivcol */
#ifndef NDEBUG
/* there can only be one pivrow, since the degree of pivcol is 1 */
{
Int deg = 0 ;
p2 = Ap [pivcol+1] ;
for (p = Ap [pivcol] ; p < p2 ; p++)
{
row = Ai [p] ;
DEBUG1 (("row: "ID"\n", row)) ;
if (Rdeg [row] >= 0)
{
/* this is a live index in this column vector */
deg++ ;
}
}
ASSERT (deg == 1) ;
}
#endif
p2 = Ap [pivcol+1] ;
for (p = Ap [pivcol] ; p < p2 ; p++)
{
row = Ai [p] ;
DEBUG1 (("row: "ID"\n", row)) ;
if (Rdeg [row] >= 0)
{
/* this is a live index in this pivcol vector */
pivrow = row ;
break ;
}
}
DEBUG1 (("Pivot row: "ID"\n", pivrow)) ;
ASSERT (pivrow != EMPTY) ;
DEBUG1 (("deg "ID"\n", Rdeg [pivrow])) ;
ASSERT (Rdeg [pivrow] >= 0) ;
/* decrement the degrees after removing this col singleton */
DEBUG1 (("p1 "ID"\n", Rp [pivrow])) ;
DEBUG1 (("p2 "ID"\n", Rp [pivrow+1])) ;
p2 = Rp [pivrow+1] ;
for (p = Rp [pivrow] ; p < p2 ; p++)
{
col = Ri [p] ;
DEBUG1 ((" col: "ID" deg: "ID"\n", col, Cdeg [col])) ;
if (Cdeg [col] < 0) continue ;
ASSERT (Cdeg [col] > 0) ;
Cdeg [col]-- ;
ASSERT (Cdeg [col] >= 0) ;
}
/* flag the pivcol and pivrow by FLIP'ing the degrees */
Cdeg [pivcol] = FLIP (1) ;
Rdeg [pivrow] = FLIP (Rdeg [pivrow]) ;
n1c++ ;
}
else
{
/* -------------------------------------------------------------- */
/* pivcol may contain a row singleton */
/* -------------------------------------------------------------- */
p2 = Ap [pivcol+1] ;
for (p = Ap [pivcol] ; p < p2 ; p++)
{
pivrow = Ai [p] ;
if (Rdeg [pivrow] == 1)
{
DEBUG0 (("Row singleton in pivcol: "ID" row: "ID"\n",
pivcol, pivrow)) ;
found = TRUE ;
break ;
}
}
if (!found)
{
DEBUG0 (("End of user singletons\n")) ;
break ;
}
#ifndef NDEBUG
/* there can only be one pivrow, since the degree of pivcol is 1 */
{
Int deg = 0 ;
p2 = Rp [pivrow+1] ;
for (p = Rp [pivrow] ; p < p2 ; p++)
{
col = Ri [p] ;
DEBUG1 (("col: "ID" cdeg::: "ID"\n", col, Cdeg [col])) ;
if (Cdeg [col] >= 0)
{
/* this is a live index in this column vector */
ASSERT (col == pivcol) ;
deg++ ;
}
}
ASSERT (deg == 1) ;
}
#endif
DEBUG1 (("Pivot row: "ID"\n", pivrow)) ;
DEBUG1 (("pivcol deg "ID"\n", Cdeg [pivcol])) ;
ASSERT (Cdeg [pivcol] > 1) ;
/* decrement the degrees after removing this row singleton */
DEBUG1 (("p1 "ID"\n", Ap [pivcol])) ;
DEBUG1 (("p2 "ID"\n", Ap [pivcol+1])) ;
p2 = Ap [pivcol+1] ;
for (p = Ap [pivcol] ; p < p2 ; p++)
{
row = Ai [p] ;
DEBUG1 ((" row: "ID" deg: "ID"\n", row, Rdeg [row])) ;
if (Rdeg [row] < 0) continue ;
ASSERT (Rdeg [row] > 0) ;
Rdeg [row]-- ;
ASSERT (Rdeg [row] >= 0) ;
}
/* flag the pivcol and pivrow by FLIP'ing the degrees */
Cdeg [pivcol] = FLIP (Cdeg [pivcol]) ;
Rdeg [pivrow] = FLIP (1) ;
n1r++ ;
}
/* keep track of the pivot row and column */
Cperm [k] = pivcol ;
Rperm [k] = pivrow ;
n1++ ;
#ifndef NDEBUG
dump_mat ("col", "row", n_col, n_row, Ap, Ai, Cdeg, Rdeg) ;
dump_mat ("row", "col", n_row, n_col, Rp, Ri, Rdeg, Cdeg) ;
#endif
}
DEBUGm4 (("User singletons found: "ID"\n", n1)) ;
ASSERT (n1 > 0) ;
*p_n1r = n1r ;
*p_n1c = n1c ;
return (n1) ;
}
PRIVATE int order_singletons /* return new number of singletons */
(
Int k, /* the number of singletons so far */
Int head,
Int tail,
Int Next [ ],
Int Xdeg [ ], Int Xperm [ ], const Int Xp [ ], const Int Xi [ ],
Int Ydeg [ ], Int Yperm [ ], const Int Yp [ ], const Int Yi [ ]
#ifndef NDEBUG
, char *xname, char *yname, Int nx, Int ny
#endif
)
{
Int xpivot, x, y, ypivot, p, p2, deg ;
#ifndef NDEBUG
Int i, k1 = k ;
dump_singletons (head, tail, Next, xname, Xdeg, nx) ;
dump_mat (xname, yname, nx, ny, Xp, Xi, Xdeg, Ydeg) ;
dump_mat (yname, xname, ny, nx, Yp, Yi, Ydeg, Xdeg) ;
#endif
while (head != EMPTY)
{
/* remove the singleton at the head of the queue */
xpivot = head ;
DEBUG1 (("------ Order %s singleton: "ID"\n", xname, xpivot)) ;
head = Next [xpivot] ;
if (head == EMPTY) tail = EMPTY ;
#ifndef NDEBUG
if (k % 100 == 0) dump_singletons (head, tail, Next, xname, Xdeg, nx) ;
#endif
ASSERT (Xdeg [xpivot] >= 0) ;
if (Xdeg [xpivot] != 1)
{
/* This row/column x is empty. The matrix is singular.
* x will be ordered last in Xperm. */
DEBUG1 (("empty %s, after singletons removed\n", xname)) ;
continue ;
}
/* find the ypivot to match with this xpivot */
#ifndef NDEBUG
/* there can only be one ypivot, since the degree of x is 1 */
deg = 0 ;
p2 = Xp [xpivot+1] ;
for (p = Xp [xpivot] ; p < p2 ; p++)
{
y = Xi [p] ;
DEBUG1 (("%s: "ID"\n", yname, y)) ;
if (Ydeg [y] >= 0)
{
/* this is a live index in this xpivot vector */
deg++ ;
}
}
ASSERT (deg == 1) ;
#endif
ypivot = EMPTY ;
p2 = Xp [xpivot+1] ;
for (p = Xp [xpivot] ; p < p2 ; p++)
{
y = Xi [p] ;
DEBUG1 (("%s: "ID"\n", yname, y)) ;
if (Ydeg [y] >= 0)
{
/* this is a live index in this xpivot vector */
ypivot = y ;
break ;
}
}
DEBUG1 (("Pivot %s: "ID"\n", yname, ypivot)) ;
ASSERT (ypivot != EMPTY) ;
DEBUG1 (("deg "ID"\n", Ydeg [ypivot])) ;
ASSERT (Ydeg [ypivot] >= 0) ;
/* decrement the degrees after removing this singleton */
DEBUG1 (("p1 "ID"\n", Yp [ypivot])) ;
DEBUG1 (("p2 "ID"\n", Yp [ypivot+1])) ;
p2 = Yp [ypivot+1] ;
for (p = Yp [ypivot] ; p < p2 ; p++)
{
x = Yi [p] ;
DEBUG1 ((" %s: "ID" deg: "ID"\n", xname, x, Xdeg [x])) ;
if (Xdeg [x] < 0) continue ;
ASSERT (Xdeg [x] > 0) ;
if (x == xpivot) continue ;
deg = --(Xdeg [x]) ;
ASSERT (Xdeg [x] >= 0) ;
if (deg == 1)
{
/* this is a new singleton, put at the end of the queue */
Next [x] = EMPTY ;
if (head == EMPTY)
{
head = x ;
}
else
{
ASSERT (tail != EMPTY) ;
Next [tail] = x ;
}
tail = x ;
DEBUG1 ((" New %s singleton: "ID"\n", xname, x)) ;
#ifndef NDEBUG
if (k % 100 == 0)
{
dump_singletons (head, tail, Next, xname, Xdeg, nx) ;
}
#endif
}
}
/* flag the xpivot and ypivot by FLIP'ing the degrees */
Xdeg [xpivot] = FLIP (1) ;
Ydeg [ypivot] = FLIP (Ydeg [ypivot]) ;
/* keep track of the pivot row and column */
Xperm [k] = xpivot ;
Yperm [k] = ypivot ;
k++ ;
#ifndef NDEBUG
if (k % 1000 == 0)
{
dump_mat (xname, yname, nx, ny, Xp, Xi, Xdeg, Ydeg) ;
dump_mat (yname, xname, ny, nx, Yp, Yi, Ydeg, Xdeg) ;
}
#endif
}
#ifndef NDEBUG
DEBUGm4 (("%s singletons: k = "ID"\n", xname, k)) ;
for (i = k1 ; i < k ; i++)
{
DEBUG1 ((" %s: "ID" %s: "ID"\n", xname, Xperm [i], yname, Yperm [i])) ;
}
ASSERT (k > 0) ;
#endif
return (k) ;
}
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 */
}
size_t TRILINOS_KLU_kernel /* final size of LU on output */
(
/* input, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers for A */
Int Ai [ ], /* size nz = Ap [n], row indices for A */
Entry Ax [ ], /* size nz, values of A */
Int Q [ ], /* size n, optional input permutation */
size_t lusize, /* initial size of LU on input */
/* output, not defined on input */
Int Pinv [ ], /* size n, inverse row permutation, where Pinv [i] = k if
* row i is the kth pivot row */
Int P [ ], /* size n, row permutation, where P [k] = i if row i is the
* kth pivot row. */
Unit **p_LU, /* LU array, size lusize on input */
Entry Udiag [ ], /* size n, diagonal of U */
Int Llen [ ], /* size n, column length of L */
Int Ulen [ ], /* size n, column length of U */
Int Lip [ ], /* size n, column pointers for L */
Int Uip [ ], /* size n, column pointers for U */
Int *lnz, /* size of L*/
Int *unz, /* size of U*/
/* workspace, not defined on input */
Entry X [ ], /* size n, undefined on input, zero on output */
/* workspace, not defined on input or output */
Int Stack [ ], /* size n */
Int Flag [ ], /* size n */
Int Ap_pos [ ], /* size n */
/* other workspace: */
Int Lpend [ ], /* size n workspace, for pruning only */
/* inputs, not modified on output */
Int k1, /* the block of A is from k1 to k2-1 */
Int PSinv [ ], /* inverse of P from symbolic factorization */
double Rs [ ], /* scale factors for A */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ],
/* --------------- */
TRILINOS_KLU_common *Common
)
{
Entry pivot ;
double abs_pivot, xsize, nunits, tol, memgrow ;
Entry *Ux ;
Int *Li, *Ui ;
Unit *LU ; /* LU factors (pattern and values) */
Int k, p, i, j, pivrow, kbar, diagrow, firstrow, lup, top, scale, len ;
size_t newlusize ;
#ifndef NDEBUG
Entry *Lx ;
#endif
ASSERT (Common != NULL) ;
scale = Common->scale ;
tol = Common->tol ;
memgrow = Common->memgrow ;
*lnz = 0 ;
*unz = 0 ;
/* ---------------------------------------------------------------------- */
/* get initial Li, Lx, Ui, and Ux */
/* ---------------------------------------------------------------------- */
PRINTF (("input: lusize %d \n", lusize)) ;
ASSERT (lusize > 0) ;
LU = *p_LU ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
firstrow = 0 ;
lup = 0 ;
for (k = 0 ; k < n ; k++)
{
/* X [k] = 0 ; */
CLEAR (X [k]) ;
Flag [k] = EMPTY ;
Lpend [k] = EMPTY ; /* flag k as not pruned */
}
/* ---------------------------------------------------------------------- */
/* mark all rows as non-pivotal and determine initial diagonal mapping */
/* ---------------------------------------------------------------------- */
/* PSinv does the symmetric permutation, so don't do it here */
for (k = 0 ; k < n ; k++)
{
P [k] = k ;
Pinv [k] = FLIP (k) ; /* mark all rows as non-pivotal */
}
/* initialize the construction of the off-diagonal matrix */
Offp [0] = 0 ;
/* P [k] = row means that UNFLIP (Pinv [row]) = k, and visa versa.
* If row is pivotal, then Pinv [row] >= 0. A row is initially "flipped"
* (Pinv [k] < EMPTY), and then marked "unflipped" when it becomes
* pivotal. */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
PRINTF (("Initial P [%d] = %d\n", k, P [k])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* factorize */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n ; k++)
{
PRINTF (("\n\n==================================== k: %d\n", k)) ;
/* ------------------------------------------------------------------ */
/* determine if LU factors have grown too big */
/* ------------------------------------------------------------------ */
/* (n - k) entries for L and k entries for U */
nunits = DUNITS (Int, n - k) + DUNITS (Int, k) +
DUNITS (Entry, n - k) + DUNITS (Entry, k) ;
/* LU can grow by at most 'nunits' entries if the column is dense */
PRINTF (("lup %d lusize %g lup+nunits: %g\n", lup, (double) lusize,
lup+nunits));
xsize = ((double) lup) + nunits ;
if (xsize > (double) lusize)
{
/* check here how much to grow */
xsize = (memgrow * ((double) lusize) + 4*n + 1) ;
if (INT_OVERFLOW (xsize))
{
PRINTF (("Matrix is too large (Int overflow)\n")) ;
Common->status = TRILINOS_KLU_TOO_LARGE ;
return (lusize) ;
}
newlusize = memgrow * lusize + 2*n + 1 ;
/* Future work: retry mechanism in case of malloc failure */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
Common->nrealloc++ ;
*p_LU = LU ;
if (Common->status == TRILINOS_KLU_OUT_OF_MEMORY)
{
PRINTF (("Matrix is too large (LU)\n")) ;
return (lusize) ;
}
lusize = newlusize ;
PRINTF (("inc LU to %d done\n", lusize)) ;
}
/* ------------------------------------------------------------------ */
/* start the kth column of L and U */
/* ------------------------------------------------------------------ */
Lip [k] = lup ;
/* ------------------------------------------------------------------ */
/* compute the nonzero pattern of the kth column of L and U */
/* ------------------------------------------------------------------ */
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] < k) ;
/* ASSERT (X [i] == 0) ; */
ASSERT (IS_ZERO (X [i])) ;
}
#endif
top = lsolve_symbolic (n, k, Ap, Ai, Q, Pinv, Stack, Flag,
Lpend, Ap_pos, LU, lup, Llen, Lip, k1, PSinv) ;
#ifndef NDEBUG
PRINTF (("--- in U:\n")) ;
for (p = top ; p < n ; p++)
{
PRINTF (("pattern of X for U: %d : %d pivot row: %d\n",
p, Stack [p], Pinv [Stack [p]])) ;
ASSERT (Flag [Stack [p]] == k) ;
}
PRINTF (("--- in L:\n")) ;
Li = (Int *) (LU + Lip [k]);
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("pattern of X in L: %d : %d pivot row: %d\n",
p, Li [p], Pinv [Li [p]])) ;
ASSERT (Flag [Li [p]] == k) ;
}
p = 0 ;
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] <= k) ;
if (Flag [i] == k) p++ ;
}
#endif
/* ------------------------------------------------------------------ */
/* get the column of the matrix to factorize and scatter into X */
/* ------------------------------------------------------------------ */
construct_column (k, Ap, Ai, Ax, Q, X,
k1, PSinv, Rs, scale, Offp, Offi, Offx) ;
/* ------------------------------------------------------------------ */
/* compute the numerical values of the kth column (s = L \ A (:,k)) */
/* ------------------------------------------------------------------ */
lsolve_numeric (Pinv, LU, Stack, Lip, top, n, Llen, X) ;
#ifndef NDEBUG
for (p = top ; p < n ; p++)
{
PRINTF (("X for U %d : ", Stack [p])) ;
PRINT_ENTRY (X [Stack [p]]) ;
}
Li = (Int *) (LU + Lip [k]) ;
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("X for L %d : ", Li [p])) ;
PRINT_ENTRY (X [Li [p]]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* partial pivoting with diagonal preference */
/* ------------------------------------------------------------------ */
/* determine what the "diagonal" is */
diagrow = P [k] ; /* might already be pivotal */
PRINTF (("k %d, diagrow = %d, UNFLIP (diagrow) = %d\n",
k, diagrow, UNFLIP (diagrow))) ;
/* find a pivot and scale the pivot column */
if (!lpivot (diagrow, &pivrow, &pivot, &abs_pivot, tol, X, LU, Lip,
Llen, k, n, Pinv, &firstrow, Common))
{
/* matrix is structurally or numerically singular */
Common->status = TRILINOS_KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (lusize) ;
}
}
/* we now have a valid pivot row, even if the column has NaN's or
* has no entries on or below the diagonal at all. */
PRINTF (("\nk %d : Pivot row %d : ", k, pivrow)) ;
PRINT_ENTRY (pivot) ;
ASSERT (pivrow >= 0 && pivrow < n) ;
ASSERT (Pinv [pivrow] < 0) ;
/* set the Uip pointer */
Uip [k] = Lip [k] + UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
/* move the lup pointer to the position where indices of U
* should be stored */
lup += UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
Ulen [k] = n - top ;
/* extract Stack [top..n-1] to Ui and the values to Ux and clear X */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = top, i = 0 ; p < n ; p++, i++)
{
j = Stack [p] ;
Ui [i] = Pinv [j] ;
Ux [i] = X [j] ;
CLEAR (X [j]) ;
}
/* position the lu index at the starting point for next column */
lup += UNITS (Int, Ulen [k]) + UNITS (Entry, Ulen [k]) ;
/* U(k,k) = pivot */
Udiag [k] = pivot ;
/* ------------------------------------------------------------------ */
/* log the pivot permutation */
/* ------------------------------------------------------------------ */
ASSERT (UNFLIP (Pinv [diagrow]) < n) ;
ASSERT (P [UNFLIP (Pinv [diagrow])] == diagrow) ;
if (pivrow != diagrow)
{
/* an off-diagonal pivot has been chosen */
Common->noffdiag++ ;
PRINTF ((">>>>>>>>>>>>>>>>> pivrow %d k %d off-diagonal\n",
pivrow, k)) ;
if (Pinv [diagrow] < 0)
{
/* the former diagonal row index, diagrow, has not yet been
* chosen as a pivot row. Log this diagrow as the "diagonal"
* entry in the column kbar for which the chosen pivot row,
* pivrow, was originally logged as the "diagonal" */
kbar = FLIP (Pinv [pivrow]) ;
P [kbar] = diagrow ;
Pinv [diagrow] = FLIP (kbar) ;
}
}
P [k] = pivrow ;
Pinv [pivrow] = k ;
#ifndef NDEBUG
for (i = 0 ; i < n ; i++) { ASSERT (IS_ZERO (X [i])) ;}
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of U: %d : ", k, Ui [p])) ;
PRINT_ENTRY (Ux [p]) ;
}
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of L: %d : ", k, Li [p])) ;
PRINT_ENTRY (Lx [p]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* symmetric pruning */
/* ------------------------------------------------------------------ */
prune (Lpend, Pinv, k, pivrow, LU, Uip, Lip, Ulen, Llen) ;
*lnz += Llen [k] + 1 ; /* 1 added to lnz for diagonal */
*unz += Ulen [k] + 1 ; /* 1 added to unz for diagonal */
}
/* ---------------------------------------------------------------------- */
/* finalize column pointers for L and U, and put L in the pivotal order */
/* ---------------------------------------------------------------------- */
for (p = 0 ; p < n ; p++)
{
Li = (Int *) (LU + Lip [p]) ;
for (i = 0 ; i < Llen [p] ; i++)
{
Li [i] = Pinv [Li [i]] ;
}
}
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
PRINTF (("P [%d] = %d Pinv [%d] = %d\n", i, P [i], i, Pinv [i])) ;
}
for (i = 0 ; i < n ; i++)
{
ASSERT (Pinv [i] >= 0 && Pinv [i] < n) ;
ASSERT (P [i] >= 0 && P [i] < n) ;
ASSERT (P [Pinv [i]] == i) ;
ASSERT (IS_ZERO (X [i])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* shrink the LU factors to just the required size */
/* ---------------------------------------------------------------------- */
newlusize = lup ;
ASSERT ((size_t) newlusize <= lusize) ;
/* this cannot fail, since the block is descreasing in size */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
*p_LU = LU ;
return (newlusize) ;
}
GLOBAL void AMD_dump (
Int n, /* A is n-by-n */
Int Pe [ ], /* pe [0..n-1]: index in iw of start of row i */
Int Iw [ ], /* workspace of size iwlen, iwlen [0..pfree-1]
* holds the matrix on input */
Int Len [ ], /* len [0..n-1]: length for row i */
Int iwlen, /* length of iw */
Int pfree, /* iw [pfree ... iwlen-1] is empty on input */
Int Nv [ ], /* nv [0..n-1] */
Int Next [ ], /* next [0..n-1] */
Int Last [ ], /* last [0..n-1] */
Int Head [ ], /* head [0..n-1] */
Int Elen [ ], /* size n */
Int Degree [ ], /* size n */
Int W [ ], /* size n */
Int nel
)
{
Int i, pe, elen, nv, len, e, p, k, j, deg, w, cnt, ilast ;
if (AMD_debug < 0) return ;
ASSERT (pfree <= iwlen) ;
AMD_DEBUG3 (("\nAMD dump, pfree: "ID"\n", pfree)) ;
for (i = 0 ; i < n ; i++)
{
pe = Pe [i] ;
elen = Elen [i] ;
nv = Nv [i] ;
len = Len [i] ;
w = W [i] ;
if (elen >= EMPTY)
{
if (nv == 0)
{
AMD_DEBUG3 (("\nI "ID": nonprincipal: ", i)) ;
ASSERT (elen == EMPTY) ;
if (pe == EMPTY)
{
AMD_DEBUG3 ((" dense node\n")) ;
ASSERT (w == 1) ;
}
else
{
ASSERT (pe < EMPTY) ;
AMD_DEBUG3 ((" i "ID" -> parent "ID"\n", i, FLIP (Pe[i])));
}
}
else
{
AMD_DEBUG3 (("\nI "ID": active principal supervariable:\n",i));
AMD_DEBUG3 ((" nv(i): "ID" Flag: %d\n", nv, (nv < 0))) ;
ASSERT (elen >= 0) ;
ASSERT (nv > 0 && pe >= 0) ;
p = pe ;
AMD_DEBUG3 ((" e/s: ")) ;
if (elen == 0) AMD_DEBUG3 ((" : ")) ;
ASSERT (pe + len <= pfree) ;
for (k = 0 ; k < len ; k++)
{
j = Iw [p] ;
AMD_DEBUG3 ((" "ID"", j)) ;
ASSERT (j >= 0 && j < n) ;
if (k == elen-1) AMD_DEBUG3 ((" : ")) ;
p++ ;
}
AMD_DEBUG3 (("\n")) ;
}
}
else
{
e = i ;
if (w == 0)
{
AMD_DEBUG3 (("\nE "ID": absorbed element: w "ID"\n", e, w)) ;
ASSERT (nv > 0 && pe < 0) ;
AMD_DEBUG3 ((" e "ID" -> parent "ID"\n", e, FLIP (Pe [e]))) ;
}
else
{
AMD_DEBUG3 (("\nE "ID": unabsorbed element: w "ID"\n", e, w)) ;
ASSERT (nv > 0 && pe >= 0) ;
p = pe ;
AMD_DEBUG3 ((" : ")) ;
ASSERT (pe + len <= pfree) ;
for (k = 0 ; k < len ; k++)
{
j = Iw [p] ;
AMD_DEBUG3 ((" "ID"", j)) ;
ASSERT (j >= 0 && j < n) ;
p++ ;
}
AMD_DEBUG3 (("\n")) ;
}
}
}
/* this routine cannot be called when the hash buckets are non-empty */
AMD_DEBUG3 (("\nDegree lists:\n")) ;
if (nel >= 0)
{
cnt = 0 ;
for (deg = 0 ; deg < n ; deg++)
{
if (Head [deg] == EMPTY) continue ;
ilast = EMPTY ;
AMD_DEBUG3 ((ID": \n", deg)) ;
for (i = Head [deg] ; i != EMPTY ; i = Next [i])
{
AMD_DEBUG3 ((" "ID" : next "ID" last "ID" deg "ID"\n",
i, Next [i], Last [i], Degree [i])) ;
ASSERT (i >= 0 && i < n && ilast == Last [i] &&
deg == Degree [i]) ;
cnt += Nv [i] ;
ilast = i ;
}
AMD_DEBUG3 (("\n")) ;
}
ASSERT (cnt == n - nel) ;
}
}
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) ;
}
GLOBAL Int UMF_row_search
(
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic,
Int cdeg0, /* length of column in Front */
Int cdeg1, /* length of column outside Front */
const Int Pattern [ ], /* pattern of column, Pattern [0..cdeg1 -1] */
const Int Pos [ ], /* Pos [Pattern [0..cdeg1 -1]] = 0..cdeg1 -1 */
Int pivrow [2], /* pivrow [IN] and pivrow [OUT] */
Int rdeg [2], /* rdeg [IN] and rdeg [OUT] */
Int W_i [ ], /* pattern of pivrow [IN], */
/* either Fcols or Woi */
Int W_o [ ], /* pattern of pivrow [OUT], */
/* either Wio or Woo */
Int prior_pivrow [2], /* the two other rows just scanned, if any */
const Entry Wxy [ ], /* numerical values Wxy [0..cdeg1-1],
either Wx or Wy */
Int pivcol, /* the candidate column being searched */
Int freebie [ ]
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double maxval, toler, toler2, value, pivot [2] ;
Int i, row, deg, col, *Frpos, fnrows, *E, j, ncols, *Cols, *Rows,
e, f, Wrpflag, *Fcpos, fncols, tpi, max_rdeg, nans_in_col, was_offdiag,
diag_row, prefer_diagonal, *Wrp, found, *Diagonal_map ;
Tuple *tp, *tpend, *tp1, *tp2 ;
Unit *Memory, *p ;
Element *ep ;
Int *Row_tuples, *Row_degree, *Row_tlen ;
#ifndef NDEBUG
Int *Col_degree ;
DEBUG2 (("Row_search:\n")) ;
for (i = 0 ; i < cdeg1 ; i++)
{
row = Pattern [i] ;
DEBUG4 ((" row: "ID"\n", row)) ;
ASSERT (row >= 0 && row < Numeric->n_row) ;
ASSERT (i == Pos [row]) ;
}
/* If row is not in Pattern [0..cdeg1-1], then Pos [row] == EMPTY */
if (UMF_debug > 0 || Numeric->n_row < 1000)
{
Int cnt = cdeg1 ;
DEBUG4 (("Scan all rows:\n")) ;
for (row = 0 ; row < Numeric->n_row ; row++)
{
if (Pos [row] < 0)
{
cnt++ ;
}
else
{
DEBUG4 ((" row: "ID" pos "ID"\n", row, Pos [row])) ;
}
}
ASSERT (cnt == Numeric->n_row) ;
}
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro only */
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
ASSERT (NON_PIVOTAL_COL (pivcol)) ;
#endif
pivot [IN] = 0. ;
pivot [OUT] = 0. ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
Row_degree = Numeric->Rperm ;
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Wrp = Work->Wrp ;
Frpos = Work->Frpos ;
E = Work->E ;
Memory = Numeric->Memory ;
fnrows = Work->fnrows ;
prefer_diagonal = Symbolic->prefer_diagonal ;
Diagonal_map = Work->Diagonal_map ;
if (Diagonal_map)
{
diag_row = Diagonal_map [pivcol] ;
was_offdiag = diag_row < 0 ;
if (was_offdiag)
{
/* the "diagonal" entry in this column was permuted here by an
* earlier pivot choice. The tighter off-diagonal tolerance will
* be used instead of the symmetric tolerance. */
diag_row = FLIP (diag_row) ;
}
ASSERT (diag_row >= 0 && diag_row < Numeric->n_row) ;
}
else
{
diag_row = EMPTY ; /* unused */
was_offdiag = EMPTY ; /* unused */
}
/* pivot row degree cannot exceed max_rdeg */
max_rdeg = Work->fncols_max ;
/* ---------------------------------------------------------------------- */
/* scan pivot column for candidate rows */
/* ---------------------------------------------------------------------- */
maxval = 0.0 ;
nans_in_col = FALSE ;
for (i = 0 ; i < cdeg1 ; i++)
{
APPROX_ABS (value, Wxy [i]) ;
if (SCALAR_IS_NAN (value))
{
nans_in_col = TRUE ;
maxval = value ;
break ;
}
/* This test can now ignore the NaN case: */
maxval = MAX (maxval, value) ;
}
/* if maxval is zero, the matrix is numerically singular */
toler = Numeric->relpt * maxval ;
toler2 = Numeric->relpt2 * maxval ;
toler2 = was_offdiag ? toler : toler2 ;
DEBUG5 (("Row_search begins [ maxval %g toler %g %g\n",
maxval, toler, toler2)) ;
if (SCALAR_IS_NAN (toler) || SCALAR_IS_NAN (toler2))
{
nans_in_col = TRUE ;
}
if (!nans_in_col)
{
/* look for the diagonal entry, if it exists */
found = FALSE ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (prefer_diagonal)
{
ASSERT (diag_row != EMPTY) ;
i = Pos [diag_row] ;
if (i >= 0)
{
double a ;
ASSERT (i < cdeg1) ;
ASSERT (diag_row == Pattern [i]) ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler2)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler2)
{
/* found it! */
DEBUG3 (("Symmetric pivot: "ID" "ID"\n", pivcol, diag_row));
found = TRUE ;
if (Frpos [diag_row] >= 0 && Frpos [diag_row] < fnrows)
{
pivrow [IN] = diag_row ;
pivrow [OUT] = EMPTY ;
}
else
{
pivrow [IN] = EMPTY ;
pivrow [OUT] = diag_row ;
}
}
}
}
/* either no diagonal found, or we didn't look for it */
if (!found)
{
if (cdeg0 > 0)
{
/* this is a column in the front */
for (i = 0 ; i < cdeg0 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
ASSERT (Frpos [row] >= 0 && Frpos [row] < fnrows) ;
ASSERT (Frpos [row] == i) ;
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN]
/* break ties by picking the largest entry: */
|| (deg == rdeg [IN] && a > pivot [IN])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [IN] && row == diag_row) */
)
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
pivot [IN] = a ;
}
}
}
for ( ; i < cdeg1 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
ASSERT (Frpos [row] == i) ;
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT]
/* break ties by picking the largest entry: */
|| (deg == rdeg [OUT] && a > pivot [OUT])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [OUT] && row == diag_row) */
)
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
pivot [OUT] = a ;
}
}
}
}
else
{
/* this column is not in the front */
for (i = 0 ; i < cdeg1 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN]
/* break ties by picking the largest entry: */
|| (deg == rdeg [IN] && a > pivot [IN])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [IN] && row == diag_row) */
)
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
pivot [IN] = a ;
}
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT]
/* break ties by picking the largest entry: */
|| (deg == rdeg[OUT] && a > pivot [OUT])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg[OUT] && row == diag_row) */
)
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
pivot [OUT] = a ;
}
}
}
}
}
}
}
/* ---------------------------------------------------------------------- */
/* NaN handling */
/* ---------------------------------------------------------------------- */
/* if cdeg1 > 0 then we must have found a pivot row ... unless NaN's */
/* exist. Try with no numerical tests if no pivot found. */
if (cdeg1 > 0 && pivrow [IN] == EMPTY && pivrow [OUT] == EMPTY)
{
/* cleanup for the NaN case */
DEBUG0 (("Found a NaN in pivot column!\n")) ;
/* grab the first entry in the pivot column, ignoring degree, */
/* numerical stability, and symmetric preference */
row = Pattern [0] ;
deg = Row_degree [row] ;
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
pivrow [IN] = row ;
rdeg [IN] = deg ;
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
}
/* We are now guaranteed to have a pivot, no matter how broken */
/* (non-IEEE compliant) the underlying numerical operators are. */
/* This is particularly a problem for Microsoft compilers (they do */
/* not handle NaN's properly). Now try to find a sparser pivot, if */
/* possible. */
for (i = 1 ; i < cdeg1 ; i++)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN] || (deg == rdeg [IN] && row == diag_row))
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
}
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT] || (deg == rdeg [OUT] && row == diag_row))
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
}
}
}
}
/* We found a pivot if there are entries (even zero ones) in pivot col */
ASSERT (IMPLIES (cdeg1 > 0, pivrow[IN] != EMPTY || pivrow[OUT] != EMPTY)) ;
/* If there are no entries in the pivot column, then no pivot is found */
ASSERT (IMPLIES (cdeg1 == 0, pivrow[IN] == EMPTY && pivrow[OUT] == EMPTY)) ;
/* ---------------------------------------------------------------------- */
/* check for singular matrix */
/* ---------------------------------------------------------------------- */
if (cdeg1 == 0)
{
if (fnrows > 0)
{
/*
Get the pivrow [OUT][IN] from the current front.
The frontal matrix looks like this:
pivcol[OUT]
|
v
x x x x 0 <- so grab this row as the pivrow [OUT][IN].
x x x x 0
x x x x 0
0 0 0 0 0
The current frontal matrix has some rows in it. The degree
of the pivcol[OUT] is zero. The column is empty, and the
current front does not contribute to it.
*/
pivrow [IN] = Work->Frows [0] ;
DEBUGm4 (("Got zero pivrow[OUT][IN] "ID" from current front\n",
pivrow [IN])) ;
}
else
{
/*
Get a pivot row from the row-merge tree, use as
pivrow [OUT][OUT]. pivrow [IN] remains EMPTY.
This can only happen if the current front is 0-by-0.
*/
Int *Front_leftmostdesc, *Front_1strow, *Front_new1strow, row1,
row2, fleftmost, nfr, n_row, frontid ;
ASSERT (Work->fncols == 0) ;
Front_leftmostdesc = Symbolic->Front_leftmostdesc ;
Front_1strow = Symbolic->Front_1strow ;
Front_new1strow = Work->Front_new1strow ;
nfr = Symbolic->nfr ;
n_row = Numeric->n_row ;
frontid = Work->frontid ;
DEBUGm4 (("Note: pivcol: "ID" is empty front "ID"\n",
pivcol, frontid)) ;
#ifndef NDEBUG
DEBUG1 (("Calling dump rowmerge\n")) ;
UMF_dump_rowmerge (Numeric, Symbolic, Work) ;
#endif
/* Row-merge set is the non-pivotal rows in the range */
/* Front_new1strow [Front_leftmostdesc [frontid]] to */
/* Front_1strow [frontid+1] - 1. */
/* If this is empty, then use the empty rows, in the range */
/* Front_new1strow [nfr] to n_row-1. */
/* If this too is empty, then pivrow [OUT] will be empty. */
/* In both cases, update Front_new1strow [...]. */
fleftmost = Front_leftmostdesc [frontid] ;
row1 = Front_new1strow [fleftmost] ;
row2 = Front_1strow [frontid+1] - 1 ;
DEBUG1 (("Leftmost: "ID" Rows ["ID" to "ID"] srch ["ID" to "ID"]\n",
fleftmost, Front_1strow [frontid], row2, row1, row2)) ;
/* look in the range row1 ... row2 */
for (row = row1 ; row <= row2 ; row++)
{
DEBUG3 ((" Row: "ID"\n", row)) ;
if (NON_PIVOTAL_ROW (row))
{
/* found it */
DEBUG3 ((" Row: "ID" found\n", row)) ;
ASSERT (Frpos [row] == EMPTY) ;
pivrow [OUT] = row ;
DEBUGm4 (("got row merge pivrow %d\n", pivrow [OUT])) ;
break ;
}
}
Front_new1strow [fleftmost] = row ;
if (pivrow [OUT] == EMPTY)
{
/* not found, look in empty row set in "dummy" front */
row1 = Front_new1strow [nfr] ;
row2 = n_row-1 ;
DEBUG3 (("Empty: "ID" Rows ["ID" to "ID"] srch["ID" to "ID"]\n",
nfr, Front_1strow [nfr], row2, row1, row2)) ;
/* look in the range row1 ... row2 */
for (row = row1 ; row <= row2 ; row++)
{
DEBUG3 ((" Empty Row: "ID"\n", row)) ;
if (NON_PIVOTAL_ROW (row))
{
/* found it */
DEBUG3 ((" Empty Row: "ID" found\n", row)) ;
ASSERT (Frpos [row] == EMPTY) ;
pivrow [OUT] = row ;
DEBUGm4 (("got dummy row pivrow %d\n", pivrow [OUT])) ;
break ;
}
}
Front_new1strow [nfr] = row ;
}
if (pivrow [OUT] == EMPTY)
{
/* Row-merge set is empty. We can just discard */
/* the candidate pivot column. */
DEBUG0 (("Note: row-merge set empty\n")) ;
DEBUGm4 (("got no pivrow \n")) ;
return (UMFPACK_WARNING_singular_matrix) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* construct the candidate row in the front, if any */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
/* check Wrp */
ASSERT (Work->Wrpflag > 0) ;
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
#ifndef NDEBUG
DEBUG4 (("pivrow [IN]: "ID"\n", pivrow [IN])) ;
UMF_dump_rowcol (0, Numeric, Work, pivrow [IN], TRUE) ;
#endif
if (pivrow [IN] != EMPTY)
{
/* the row merge candidate row is not pivrow [IN] */
freebie [IN] = (pivrow [IN] == prior_pivrow [IN]) && (cdeg1 > 0) ;
ASSERT (cdeg1 >= 0) ;
if (!freebie [IN])
{
/* include current front in the degree of this row */
Fcpos = Work->Fcpos ;
fncols = Work->fncols ;
Wrpflag = Work->Wrpflag ;
/* -------------------------------------------------------------- */
/* construct the pattern of the IN row */
/* -------------------------------------------------------------- */
#ifndef NDEBUG
/* check Fcols */
DEBUG5 (("ROW ASSEMBLE: rdeg "ID"\nREDUCE ROW "ID"\n",
fncols, pivrow [IN])) ;
for (j = 0 ; j < fncols ; j++)
{
col = Work->Fcols [j] ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (Fcpos [col] >= 0) ;
}
if (UMF_debug > 0 || Work->n_col < 1000)
{
Int cnt = fncols ;
for (col = 0 ; col < Work->n_col ; col++)
{
if (Fcpos [col] < 0) cnt++ ;
}
ASSERT (cnt == Work->n_col) ;
}
#endif
rdeg [IN] = fncols ;
ASSERT (pivrow [IN] >= 0 && pivrow [IN] < Work->n_row) ;
ASSERT (NON_PIVOTAL_ROW (pivrow [IN])) ;
/* add the pivot column itself */
ASSERT (Wrp [pivcol] != Wrpflag) ;
if (Fcpos [pivcol] < 0)
{
DEBUG3 (("Adding pivot col to pivrow [IN] pattern\n")) ;
if (rdeg [IN] >= max_rdeg)
{
/* :: pattern change (in) :: */
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [pivcol] = Wrpflag ;
W_i [rdeg [IN]++] = pivcol ;
}
tpi = Row_tuples [pivrow [IN]] ;
if (tpi)
{
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [pivrow [IN]] ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
if (Rows [f] == EMPTY)
{
continue ; /* row already assembled */
}
ASSERT (pivrow [IN] == Rows [f]) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= EMPTY && col < Work->n_col) ;
if ((col >= 0) && (Wrp [col] != Wrpflag)
&& Fcpos [col] <0)
{
ASSERT (NON_PIVOTAL_COL (col)) ;
if (rdeg [IN] >= max_rdeg)
{
/* :: pattern change (rdeg in failure) :: */
DEBUGm4 (("rdeg [IN] >= max_rdeg failure\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [col] = Wrpflag ;
W_i [rdeg [IN]++] = col ;
}
}
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [pivrow [IN]] = tp2 - tp1 ;
}
#ifndef NDEBUG
DEBUG4 (("Reduced IN row:\n")) ;
for (j = 0 ; j < fncols ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n",
j, Work->Fcols [j], Fcpos [Work->Fcols [j]])) ;
ASSERT (Fcpos [Work->Fcols [j]] >= 0) ;
}
for (j = fncols ; j < rdeg [IN] ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n", j, W_i [j], Wrp [W_i [j]]));
ASSERT (W_i [j] >= 0 && W_i [j] < Work->n_col) ;
ASSERT (Wrp [W_i [j]] == Wrpflag) ;
}
/* mark the end of the pattern in case we scan it by mistake */
/* Note that this means W_i must be of size >= fncols_max + 1 */
W_i [rdeg [IN]] = EMPTY ;
#endif
/* rdeg [IN] is now the exact degree of the IN row */
/* clear Work->Wrp. */
Work->Wrpflag++ ;
/* All Wrp [0..n_col] is now < Wrpflag */
}
}
#ifndef NDEBUG
/* check Wrp */
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
/* ---------------------------------------------------------------------- */
/* construct the candidate row not in the front, if any */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG4 (("pivrow [OUT]: "ID"\n", pivrow [OUT])) ;
UMF_dump_rowcol (0, Numeric, Work, pivrow [OUT], TRUE) ;
#endif
/* If this is a candidate row from the row merge set, force it to be */
/* scanned (ignore prior_pivrow [OUT]). */
if (pivrow [OUT] != EMPTY)
{
freebie [OUT] = (pivrow [OUT] == prior_pivrow [OUT]) && cdeg1 > 0 ;
ASSERT (cdeg1 >= 0) ;
if (!freebie [OUT])
{
Wrpflag = Work->Wrpflag ;
/* -------------------------------------------------------------- */
/* construct the pattern of the row */
/* -------------------------------------------------------------- */
rdeg [OUT] = 0 ;
ASSERT (pivrow [OUT] >= 0 && pivrow [OUT] < Work->n_row) ;
ASSERT (NON_PIVOTAL_ROW (pivrow [OUT])) ;
/* add the pivot column itself */
ASSERT (Wrp [pivcol] != Wrpflag) ;
DEBUG3 (("Adding pivot col to pivrow [OUT] pattern\n")) ;
if (rdeg [OUT] >= max_rdeg)
{
/* :: pattern change (out) :: */
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [pivcol] = Wrpflag ;
W_o [rdeg [OUT]++] = pivcol ;
tpi = Row_tuples [pivrow [OUT]] ;
if (tpi)
{
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [pivrow [OUT]] ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
if (Rows [f] == EMPTY)
{
continue ; /* row already assembled */
}
ASSERT (pivrow [OUT] == Rows [f]) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= EMPTY && col < Work->n_col) ;
if ((col >= 0) && (Wrp [col] != Wrpflag))
{
ASSERT (NON_PIVOTAL_COL (col)) ;
if (rdeg [OUT] >= max_rdeg)
{
/* :: pattern change (rdeg out failure) :: */
DEBUGm4 (("rdeg [OUT] failure\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [col] = Wrpflag ;
W_o [rdeg [OUT]++] = col ;
}
}
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [pivrow [OUT]] = tp2 - tp1 ;
}
#ifndef NDEBUG
DEBUG4 (("Reduced row OUT:\n")) ;
for (j = 0 ; j < rdeg [OUT] ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n", j, W_o [j], Wrp [W_o [j]])) ;
ASSERT (W_o [j] >= 0 && W_o [j] < Work->n_col) ;
ASSERT (Wrp [W_o [j]] == Wrpflag) ;
}
/* mark the end of the pattern in case we scan it by mistake */
/* Note that this means W_o must be of size >= fncols_max + 1 */
W_o [rdeg [OUT]] = EMPTY ;
#endif
/* rdeg [OUT] is now the exact degree of the row */
/* clear Work->Wrp. */
Work->Wrpflag++ ;
/* All Wrp [0..n] is now < Wrpflag */
}
}
DEBUG5 (("Row_search end ] \n")) ;
#ifndef NDEBUG
/* check Wrp */
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
return (UMFPACK_OK) ;
}
int process_sof0(void)
{
iceenv.max_samp_y = iceenv.max_samp_x = 0;
memcpy((void*)&iceenv.sof0, (void*)(iceenv.buffer + iceenv.buf_pos), sizeof(struct jpeg_sof0));
iceenv.buf_pos += sizeof(struct jpeg_sof0);
if (iceenv.sof0.num_components != 1 && iceenv.sof0.num_components != 3)
return ERR_INVALID_NUMBER_OF_COMP;
iceenv.sof0.width = FLIP(iceenv.sof0.width);
iceenv.sof0.height = FLIP(iceenv.sof0.height);
struct jpeg_sof0_component_info comp_info[3];
//comp_info[0] = comp_info[1] = comp_info[2] = 0;
int i;
// for (i = 0; i < sof0.num_components; i++)
// {
// comp_info[i] = (struct jpeg_sof0_component_info*)malloc(sizeof(struct jpeg_sof0_component_info));
// }
iceenv.components = (struct jpeg_component*) malloc(sizeof(struct jpeg_component) * iceenv.sof0.num_components);
for (i = 0; i < iceenv.sof0.num_components; i++)
{
memcpy((void*)&comp_info[i], (void*)(iceenv.buffer + iceenv.buf_pos), sizeof(struct jpeg_sof0_component_info));
iceenv.buf_pos += sizeof(struct jpeg_sof0_component_info);
iceenv.components[i].qt_table = comp_info[i].qt_table;
iceenv.components[i].sx = UPR4(comp_info[i].sampling_factors);
iceenv.components[i].sy = LWR4(comp_info[i].sampling_factors);
iceenv.components[i].prev_dc = 0;
// Update maximum sampling factors
if (iceenv.components[i].sx > iceenv.max_samp_x)
iceenv.max_samp_x = iceenv.components[i].sx;
if (iceenv.components[i].sy > iceenv.max_samp_y)
iceenv.max_samp_y = iceenv.components[i].sy;
}
iceenv.mcu_width = iceenv.max_samp_x << 3;
iceenv.mcu_height = iceenv.max_samp_y << 3;
iceenv.num_mcu_x = (iceenv.sof0.width + iceenv.mcu_width - 1) / iceenv.mcu_width;
iceenv.num_mcu_y = (iceenv.sof0.height + iceenv.mcu_height - 1) / iceenv.mcu_height;
for (i = 0; i < iceenv.sof0.num_components; i++)
{
iceenv.components[i].width = (iceenv.sof0.width * iceenv.components[i].sx + iceenv.max_samp_x - 1) / iceenv.max_samp_x;
iceenv.components[i].height = (iceenv.sof0.height * iceenv.components[i].sy + iceenv.max_samp_y - 1) / iceenv.max_samp_y;
iceenv.components[i].stride = iceenv.num_mcu_x * (iceenv.components[i].sx << 3);
iceenv.components[i].pixels = (byte*)malloc(iceenv.components[i].stride * (iceenv.num_mcu_y * (iceenv.components[i].sy << 3)) * sizeof(byte));
}
#ifdef _JPEG_DEBUG
printf("Hmax = %d, Vmax = %d\n", iceenv.max_samp_x, iceenv.max_samp_y);
#endif
return ERR_OK;
}
template <typename Entry> int spqr_1colamd // TRUE if OK, FALSE otherwise
(
// inputs, not modified
int ordering, // all available, except 0:fixed and 3:given
// treated as 1:natural
double tol, // only accept singletons above tol
Long bncols, // number of columns of B
cholmod_sparse *A, // m-by-n sparse matrix
// outputs, neither allocated nor defined on input
Long **p_Q1fill, // size n+bncols, fill-reducing
// or natural ordering
Long **p_R1p, // size n1rows+1, R1p [k] = # of nonzeros in kth
// row of R1. NULL if n1cols == 0.
Long **p_P1inv, // size m, singleton row inverse permutation.
// If row i of A is the kth singleton row, then
// P1inv [i] = k. NULL if n1cols is zero.
cholmod_sparse **p_Y, // on output, only the first n-n1cols+1 entries of
// Y->p are defined (if Y is not NULL), where
// Y = [A B] or Y = [A2 B2]. If B is empty and
// there are no column singletons, Y is NULL
Long *p_n1cols, // number of column singletons found
Long *p_n1rows, // number of corresponding rows found
// workspace and parameters
cholmod_common *cc
)
{
Long *Q1fill, *Degree, *Qrows, *W, *Winv, *ATp, *ATj, *R1p, *P1inv, *Yp,
*Ap, *Ai, *Work ;
Entry *Ax ;
Long p, d, j, i, k, n1cols, n1rows, row, col, pend, n2rows, n2cols = EMPTY,
nz2, kk, p2, col2, ynz, fill_reducing_ordering, m, n, xtype, worksize ;
cholmod_sparse *AT, *Y ;
// -------------------------------------------------------------------------
// get inputs
// -------------------------------------------------------------------------
xtype = spqr_type <Entry> ( ) ;
m = A->nrow ;
n = A->ncol ;
Ap = (Long *) A->p ;
Ai = (Long *) A->i ;
Ax = (Entry *) A->x ;
// set outputs to NULL in case of early return
*p_Q1fill = NULL ;
*p_R1p = NULL ;
*p_P1inv = NULL ;
*p_Y = NULL ;
*p_n1cols = EMPTY ;
*p_n1rows = EMPTY ;
// -------------------------------------------------------------------------
// allocate result Q1fill (Y, R1p, P1inv allocated later)
// -------------------------------------------------------------------------
Q1fill = (Long *) cholmod_l_malloc (n+bncols, sizeof (Long), cc) ;
// -------------------------------------------------------------------------
// allocate workspace
// -------------------------------------------------------------------------
fill_reducing_ordering = !
((ordering == SPQR_ORDERING_FIXED) ||
(ordering == SPQR_ORDERING_GIVEN) ||
(ordering == SPQR_ORDERING_NATURAL)) ;
worksize = ((fill_reducing_ordering) ? 3:2) * n ;
Work = (Long *) cholmod_l_malloc (worksize, sizeof (Long), cc) ;
Degree = Work ; // size n
Qrows = Work + n ; // size n
Winv = Qrows ; // Winv and Qrows not needed at the same time
W = Qrows + n ; // size n if fill-reducing ordering, else size 0
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
return (FALSE) ;
}
// -------------------------------------------------------------------------
// initialze queue with empty columns, and columns with just one entry
// -------------------------------------------------------------------------
n1cols = 0 ;
n1rows = 0 ;
for (j = 0 ; j < n ; j++)
{
p = Ap [j] ;
d = Ap [j+1] - p ;
if (d == 0)
{
// j is a dead column singleton
PR (("initial dead %ld\n", j)) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = EMPTY ;
n1cols++ ;
Degree [j] = EMPTY ;
}
else if (d == 1 && spqr_abs (Ax [p], cc) > tol)
{
// j is a column singleton, live or dead
PR (("initial live %ld %ld\n", j, Ai [p])) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = Ai [p] ; // this might be a duplicate
n1cols++ ;
Degree [j] = EMPTY ;
}
else
{
// j has degree > 1, it is not (yet) a singleton
Degree [j] = d ;
}
}
// Degree [j] = EMPTY if j is in the singleton queue, or the Degree [j] > 1
// is the degree of column j otherwise
// -------------------------------------------------------------------------
// create AT = spones (A')
// -------------------------------------------------------------------------
AT = cholmod_l_transpose (A, 0, cc) ; // [
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
return (FALSE) ;
}
ATp = (Long *) AT->p ;
ATj = (Long *) AT->i ;
// -------------------------------------------------------------------------
// remove column singletons via breadth-first-search
// -------------------------------------------------------------------------
for (k = 0 ; k < n1cols ; k++)
{
// ---------------------------------------------------------------------
// get a new singleton from the queue
// ---------------------------------------------------------------------
col = Q1fill [k] ;
row = Qrows [k] ;
PR (("\n---- singleton col %ld row %ld\n", col, row)) ;
ASSERT (Degree [col] == EMPTY) ;
if (row == EMPTY || ATp [row] < 0)
{
// -----------------------------------------------------------------
// col is a dead column singleton; remove duplicate row index
// -----------------------------------------------------------------
Qrows [k] = EMPTY ;
row = EMPTY ;
PR (("dead: %ld\n", col)) ;
}
else
{
// -----------------------------------------------------------------
// col is a live col singleton; remove its row from matrix
// -----------------------------------------------------------------
n1rows++ ;
p = ATp [row] ;
ATp [row] = FLIP (p) ; // flag the singleton row
pend = UNFLIP (ATp [row+1]) ;
PR (("live: %ld row %ld\n", col, row)) ;
for ( ; p < pend ; p++)
{
// look for new column singletons after row is removed
j = ATj [p] ;
d = Degree [j] ;
if (d == EMPTY)
{
// j is already in the singleton queue
continue ;
}
ASSERT (d >= 1) ;
ASSERT2 (spqrDebug_listcount (j, Q1fill, n1cols, 0) == 0) ;
d-- ;
Degree [j] = d ;
if (d == 0)
{
// a new dead col singleton
PR (("newly dead %ld\n", j)) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = EMPTY ;
n1cols++ ;
Degree [j] = EMPTY ;
}
else if (d == 1)
{
// a new live col singleton; find its single live row
for (p2 = Ap [j] ; p2 < Ap [j+1] ; p2++)
{
i = Ai [p2] ;
if (ATp [i] >= 0 && spqr_abs (Ax [p2], cc) > tol)
{
// i might appear in Qrows [k+1:n1cols-1]
PR (("newly live %ld\n", j)) ;
ASSERT2 (spqrDebug_listcount (i,Qrows,k+1,1) == 0) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = i ;
n1cols++ ;
Degree [j] = EMPTY ;
break ;
}
}
}
}
}
// Q1fill [0:k] and Qrows [0:k] have no duplicates
ASSERT2 (spqrDebug_listcount (col, Q1fill, n1cols, 0) == 1) ;
ASSERT2 (IMPLIES (row >= 0, spqrDebug_listcount
(row, Qrows, k+1, 1) == 1)) ;
}
// -------------------------------------------------------------------------
// Degree flags the column singletons, ATp flags their rows
// -------------------------------------------------------------------------
#ifndef NDEBUG
k = 0 ;
for (j = 0 ; j < n ; j++)
{
PR (("j %ld Degree[j] %ld\n", j, Degree [j])) ;
if (Degree [j] > 0) k++ ; // j is not a column singleton
}
PR (("k %ld n %ld n1cols %ld\n", k, n, n1cols)) ;
ASSERT (k == n - n1cols) ;
for (k = 0 ; k < n1cols ; k++)
{
col = Q1fill [k] ;
ASSERT (Degree [col] <= 0) ;
}
k = 0 ;
for (i = 0 ; i < m ; i++)
{
if (ATp [i] >= 0) k++ ; // i is not a row of a col singleton
}
ASSERT (k == m - n1rows) ;
for (k = 0 ; k < n1cols ; k++)
{
row = Qrows [k] ;
ASSERT (IMPLIES (row != EMPTY, ATp [row] < 0)) ;
}
#endif
// -------------------------------------------------------------------------
// find the row ordering
// -------------------------------------------------------------------------
if (n1cols == 0)
{
// ---------------------------------------------------------------------
// no singletons in the matrix; no R1 matrix, no P1inv permutation
// ---------------------------------------------------------------------
ASSERT (n1rows == 0) ;
R1p = NULL ;
P1inv = NULL ;
}
else
{
// ---------------------------------------------------------------------
// construct the row singleton permutation
// ---------------------------------------------------------------------
// allocate result arrays R1p and P1inv
R1p = (Long *) cholmod_l_malloc (n1rows+1, sizeof (Long), cc) ;
P1inv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free_sparse (&AT, cc) ;
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
return (FALSE) ;
}
#ifndef NDEBUG
for (i = 0 ; i < m ; i++) P1inv [i] = EMPTY ;
#endif
kk = 0 ;
for (k = 0 ; k < n1cols ; k++)
{
i = Qrows [k] ;
PR (("singleton col %ld row %ld\n", Q1fill [k], i)) ;
if (i != EMPTY)
{
// row i is the kk-th singleton row
ASSERT (ATp [i] < 0) ;
ASSERT (P1inv [i] == EMPTY) ;
P1inv [i] = kk ;
// also find # of entries in row kk of R1
R1p [kk] = UNFLIP (ATp [i+1]) - UNFLIP (ATp [i]) ;
kk++ ;
}
}
ASSERT (kk == n1rows) ;
for (i = 0 ; i < m ; i++)
{
if (ATp [i] >= 0)
{
// row i is not a singleton row
ASSERT (P1inv [i] == EMPTY) ;
P1inv [i] = kk ;
kk++ ;
}
}
ASSERT (kk == m) ;
}
// Qrows is no longer needed.
// -------------------------------------------------------------------------
// complete the column ordering
// -------------------------------------------------------------------------
if (!fill_reducing_ordering)
{
// ---------------------------------------------------------------------
// natural ordering
// ---------------------------------------------------------------------
if (n1cols == 0)
{
// no singletons, so natural ordering is 0:n-1 for now
for (k = 0 ; k < n ; k++)
{
Q1fill [k] = k ;
}
}
else
{
// singleton columns appear first, then non column singletons
k = n1cols ;
for (j = 0 ; j < n ; j++)
{
if (Degree [j] > 0)
{
// column j is not a column singleton
Q1fill [k++] = j ;
}
}
ASSERT (k == n) ;
}
}
else
{
// ---------------------------------------------------------------------
// fill-reducing ordering of pruned submatrix
// ---------------------------------------------------------------------
if (n1cols == 0)
{
// -----------------------------------------------------------------
// no singletons found; do fill-reducing on entire matrix
// -----------------------------------------------------------------
n2cols = n ;
n2rows = m ;
}
else
{
// -----------------------------------------------------------------
// create the pruned matrix for fill-reducing by removing singletons
// -----------------------------------------------------------------
// find the mapping of original columns to pruned columns
n2cols = 0 ;
for (j = 0 ; j < n ; j++)
{
if (Degree [j] > 0)
{
// column j is not a column singleton
W [j] = n2cols++ ;
PR (("W [%ld] = %ld\n", j, W [j])) ;
}
else
{
// column j is a column singleton
W [j] = EMPTY ;
PR (("W [%ld] = %ld (j is col singleton)\n", j, W [j])) ;
}
}
ASSERT (n2cols == n - n1cols) ;
// W is now a mapping of the original columns to the columns in the
// pruned matrix. W [col] == EMPTY if col is a column singleton.
// Otherwise col2 = W [j] is a column of the pruned matrix.
// -----------------------------------------------------------------
// delete row and column singletons from A'
// -----------------------------------------------------------------
// compact A' by removing row and column singletons
nz2 = 0 ;
n2rows = 0 ;
for (i = 0 ; i < m ; i++)
{
p = ATp [i] ;
if (p >= 0)
{
// row i is not a row of a column singleton
ATp [n2rows++] = nz2 ;
pend = UNFLIP (ATp [i+1]) ;
for (p = ATp [i] ; p < pend ; p++)
{
j = ATj [p] ;
ASSERT (W [j] >= 0 && W [j] < n-n1cols) ;
ATj [nz2++] = W [j] ;
}
}
}
ATp [n2rows] = nz2 ;
ASSERT (n2rows == m - n1rows) ;
}
// ---------------------------------------------------------------------
// fill-reducing ordering of the transpose of the pruned A' matrix
// ---------------------------------------------------------------------
PR (("n1cols %ld n1rows %ld n2cols %ld n2rows %ld\n",
n1cols, n1rows, n2cols, n2rows)) ;
ASSERT ((Long) AT->nrow == n) ;
ASSERT ((Long) AT->ncol == m) ;
AT->nrow = n2cols ;
AT->ncol = n2rows ;
// save the current CHOLMOD settings
Long save [6] ;
save [0] = cc->supernodal ;
save [1] = cc->nmethods ;
save [2] = cc->postorder ;
save [3] = cc->method [0].ordering ;
save [4] = cc->method [1].ordering ;
save [5] = cc->method [2].ordering ;
// follow the ordering with a postordering of the column etree
cc->postorder = TRUE ;
// 8:best: best of COLAMD(A), AMD(A'A), and METIS (if available)
if (ordering == SPQR_ORDERING_BEST)
{
ordering = SPQR_ORDERING_CHOLMOD ;
cc->nmethods = 2 ;
cc->method [0].ordering = CHOLMOD_COLAMD ;
cc->method [1].ordering = CHOLMOD_AMD ;
#ifndef NPARTITION
cc->nmethods = 3 ;
cc->method [2].ordering = CHOLMOD_METIS ;
#endif
}
// 9:bestamd: best of COLAMD(A) and AMD(A'A)
if (ordering == SPQR_ORDERING_BESTAMD)
{
// if METIS is not installed, this option is the same as 8:best
ordering = SPQR_ORDERING_CHOLMOD ;
cc->nmethods = 2 ;
cc->method [0].ordering = CHOLMOD_COLAMD ;
cc->method [1].ordering = CHOLMOD_AMD ;
}
#ifdef NPARTITION
if (ordering == SPQR_ORDERING_METIS)
{
// METIS not installed; use default ordering
ordering = SPQR_ORDERING_DEFAULT ;
}
#endif
if (ordering == SPQR_ORDERING_DEFAULT)
{
// Version 1.2.0: just use COLAMD
ordering = SPQR_ORDERING_COLAMD ;
#if 0
// Version 1.1.2 and earlier:
if (n2rows <= 2*n2cols)
{
// just use COLAMD; do not try AMD or METIS
ordering = SPQR_ORDERING_COLAMD ;
}
else
{
#ifndef NPARTITION
// use CHOLMOD's default ordering: try AMD and then METIS
// if AMD gives high fill-in, and take the best ordering found
ordering = SPQR_ORDERING_CHOLMOD ;
cc->nmethods = 0 ;
#else
// METIS is not installed, so just use AMD
ordering = SPQR_ORDERING_AMD ;
#endif
}
#endif
}
if (ordering == SPQR_ORDERING_AMD)
{
// use CHOLMOD's interface to AMD to order A'*A
cholmod_l_amd (AT, NULL, 0, (Long *) (Q1fill + n1cols), cc) ;
}
#ifndef NPARTITION
else if (ordering == SPQR_ORDERING_METIS)
{
// use CHOLMOD's interface to METIS to order A'*A (if installed)
cholmod_l_metis (AT, NULL, 0, TRUE,
(Long *) (Q1fill + n1cols), cc) ;
}
#endif
else if (ordering == SPQR_ORDERING_CHOLMOD)
{
// use CHOLMOD's internal ordering (defined by cc) to order AT
PR (("Using CHOLMOD, nmethods %d\n", cc->nmethods)) ;
cc->supernodal = CHOLMOD_SIMPLICIAL ;
cc->postorder = TRUE ;
cholmod_factor *Sc ;
Sc = cholmod_l_analyze_p2 (FALSE, AT, NULL, NULL, 0, cc) ;
if (Sc != NULL)
{
// copy perm from Sc->Perm [0:n2cols-1] to Q1fill (n1cols:n)
Long *Sc_perm = (Long *) Sc->Perm ;
for (k = 0 ; k < n2cols ; k++)
{
Q1fill [k + n1cols] = Sc_perm [k] ;
}
// CHOLMOD selected an ordering; determine the ordering used
switch (Sc->ordering)
{
case CHOLMOD_AMD: ordering = SPQR_ORDERING_AMD ;break;
case CHOLMOD_COLAMD: ordering = SPQR_ORDERING_COLAMD ;break;
case CHOLMOD_METIS: ordering = SPQR_ORDERING_METIS ;break;
}
}
cholmod_l_free_factor (&Sc, cc) ;
PR (("CHOLMOD used method %d : ordering: %d\n", cc->selected,
cc->method [cc->selected].ordering)) ;
}
else // SPQR_ORDERING_DEFAULT or SPQR_ORDERING_COLAMD
{
// use CHOLMOD's interface to COLAMD to order AT
ordering = SPQR_ORDERING_COLAMD ;
cholmod_l_colamd (AT, NULL, 0, TRUE,
(Long *) (Q1fill + n1cols), cc) ;
}
cc->SPQR_istat [7] = ordering ;
// restore the CHOLMOD settings
cc->supernodal = save [0] ;
cc->nmethods = save [1] ;
cc->postorder = save [2] ;
cc->method [0].ordering = save [3] ;
cc->method [1].ordering = save [4] ;
cc->method [2].ordering = save [5] ;
AT->nrow = n ;
AT->ncol = m ;
}
// -------------------------------------------------------------------------
// free AT
// -------------------------------------------------------------------------
cholmod_l_free_sparse (&AT, cc) ; // ]
// -------------------------------------------------------------------------
// check if the method succeeded
// -------------------------------------------------------------------------
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
return (FALSE) ;
}
// -------------------------------------------------------------------------
// map the fill-reducing ordering ordering back to A
// -------------------------------------------------------------------------
if (n1cols > 0 && fill_reducing_ordering)
{
// Winv is workspace of size n2cols <= n
#ifndef NDEBUG
for (j = 0 ; j < n2cols ; j++) Winv [j] = EMPTY ;
#endif
for (j = 0 ; j < n ; j++)
{
// j is a column of A. col2 = W [j] is either EMPTY, or it is
// the corresponding column of the pruned matrix
col2 = W [j] ;
if (col2 != EMPTY)
{
ASSERT (col2 >= 0 && col2 < n2cols) ;
Winv [col2] = j ;
}
}
for (k = n1cols ; k < n ; k++)
{
// col2 is a column of the pruned matrix
col2 = Q1fill [k] ;
// j is the corresonding column of the A matrix
j = Winv [col2] ;
ASSERT (j >= 0 && j < n) ;
Q1fill [k] = j ;
}
}
// -------------------------------------------------------------------------
// identity permutation of the columns of B
// -------------------------------------------------------------------------
for (k = n ; k < n+bncols ; k++)
{
// tack on the identity permutation for columns of B
Q1fill [k] = k ;
}
// -------------------------------------------------------------------------
// find column pointers for Y = [A2 B2]; columns of A2
// -------------------------------------------------------------------------
if (n1cols == 0 && bncols == 0)
{
// A will be factorized instead of Y
Y = NULL ;
}
else
{
// Y has no entries yet; nnz(Y) will be determined later
Y = cholmod_l_allocate_sparse (m-n1rows, n-n1cols+bncols, 0,
FALSE, TRUE, 0, xtype, cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
return (FALSE) ;
}
Yp = (Long *) Y->p ;
ynz = 0 ;
PR (("1c wrapup: n1cols %ld n %ld\n", n1cols, n)) ;
for (k = n1cols ; k < n ; k++)
{
j = Q1fill [k] ;
d = Degree [j] ;
ASSERT (d >= 1 && d <= m) ;
Yp [k-n1cols] = ynz ;
ynz += d ;
}
Yp [n-n1cols] = ynz ;
}
// -------------------------------------------------------------------------
// free workspace and return results
// -------------------------------------------------------------------------
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
*p_Q1fill = Q1fill ;
*p_R1p = R1p ;
*p_P1inv = P1inv ;
*p_Y = Y ;
*p_n1cols = n1cols ;
*p_n1rows = n1rows ;
return (TRUE) ;
}
VOID ClipCheat ( PLAYERp pp, char *cheat_string )
{
FLIP ( pp->Flags, PF_CLIP_CHEAT );
sprintf ( ds, "NO CLIP MODE %s", TEST ( pp->Flags, PF_CLIP_CHEAT ) ? "ON" : "OFF" );
PutStringInfo ( pp, ds );
}
