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) ;
}
GLOBAL Int UMF_singletons
(
/* 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 */
Int strategy, /* strategy requested by user */
Int do_singletons, /* if false, then do not look for singletons */
/* output, not defined on input: */
Int Cdeg [ ], /* size n_col */
Int Cperm [ ], /* size n_col */
Int Rdeg [ ], /* size n_row */
Int Rperm [ ], /* size n_row */
Int InvRperm [ ], /* size n_row, the inverse of Rperm */
Int *p_n1, /* # of col and row singletons */
Int *p_n1c, /* # of col singletons */
Int *p_n1r, /* # of row singletons */
Int *p_nempty_col, /* # of empty columns in pruned submatrix */
Int *p_nempty_row, /* # of empty columns in pruned submatrix */
Int *p_is_sym, /* TRUE if pruned submatrix is square and has been
* symmetrically permuted by Cperm and Rperm */
Int *p_max_rdeg, /* maximum Rdeg in pruned submatrix */
/* workspace, not defined on input or output */
Int Rp [ ], /* size n_row+1 */
Int Ri [ ], /* size nz */
Int W [ ], /* size n_row */
Int Next [ ] /* size MAX (n_row, n_col) */
)
{
Int n1, s, col, row, p, p1, p2, cdeg, last_row, is_sym, k,
nempty_row, nempty_col, max_cdeg, max_rdeg, n1c, n1r ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_dump_start ( ) ;
DEBUGm4 (("Starting umf_singletons\n")) ;
#endif
/* ---------------------------------------------------------------------- */
/* scan the columns, check for errors and count row degrees */
/* ---------------------------------------------------------------------- */
if (Ap [0] != 0 || Ap [n_col] < 0)
{
return (UMFPACK_ERROR_invalid_matrix) ;
}
for (row = 0 ; row < n_row ; row++)
{
Rdeg [row] = 0 ;
}
for (col = 0 ; col < n_col ; col++)
{
p1 = Ap [col] ;
p2 = Ap [col+1] ;
cdeg = p2 - p1 ;
if (cdeg < 0)
{
return (UMFPACK_ERROR_invalid_matrix) ;
}
last_row = EMPTY ;
for (p = p1 ; p < p2 ; p++)
{
row = Ai [p] ;
if (row <= last_row || row >= n_row)
{
return (UMFPACK_ERROR_invalid_matrix) ;
}
Rdeg [row]++ ;
last_row = row ;
}
Cdeg [col] = cdeg ;
}
/* ---------------------------------------------------------------------- */
/* find singletons */
/* ---------------------------------------------------------------------- */
if (!do_singletons)
{
/* do not look for singletons at all */
n1 = 0 ;
n1r = 0 ;
n1c = 0 ;
}
else if (Quser != (Int *) NULL)
{
/* user has provided an input column ordering */
if (strategy == UMFPACK_STRATEGY_UNSYMMETRIC)
{
/* look for singletons, but respect the user's input permutation */
n1 = find_user_singletons (n_row, n_col, Ap, Ai, Quser,
Cdeg, Rdeg, Cperm, Rperm, &n1r, &n1c, Rp, Ri, W) ;
}
else
{
/* do not look for singletons if Quser given and strategy is
* not unsymmetric */
n1 = 0 ;
n1r = 0 ;
n1c = 0 ;
}
}
else
{
/* look for singletons anywhere */
n1 = find_any_singletons (n_row, n_col, Ap, Ai,
Cdeg, Rdeg, Cperm, Rperm, &n1r, &n1c, Rp, Ri, W, Next) ;
}
/* ---------------------------------------------------------------------- */
/* eliminate empty columns and complete the column permutation */
/* ---------------------------------------------------------------------- */
nempty_col = finish_permutation (n1, n_col, Cdeg, Quser, Cperm, &max_cdeg) ;
/* ---------------------------------------------------------------------- */
/* eliminate empty rows and complete the row permutation */
/* ---------------------------------------------------------------------- */
if (Quser != (Int *) NULL && strategy == UMFPACK_STRATEGY_SYMMETRIC)
{
/* rows should be symmetrically permuted according to Quser */
ASSERT (n_row == n_col) ;
nempty_row = finish_permutation (n1, n_row, Rdeg, Quser, Rperm,
&max_rdeg) ;
}
else
{
/* rows should not be symmetrically permuted according to Quser */
nempty_row = finish_permutation (n1, n_row, Rdeg, (Int *) NULL, Rperm,
&max_rdeg) ;
}
/* ---------------------------------------------------------------------- */
/* compute the inverse of Rperm */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n_row ; k++)
{
ASSERT (Rperm [k] >= 0 && Rperm [k] < n_row) ;
InvRperm [Rperm [k]] = k ;
}
/* ---------------------------------------------------------------------- */
/* see if pruned submatrix is square and has been symmetrically permuted */
/* ---------------------------------------------------------------------- */
/* The prior version of this code (with a "break" statement; UMFPACK 5.2)
* causes UMFPACK to fail when optimization is enabled with gcc version
* 4.2.4 in a 64-bit Linux environment. The bug is a compiler bug, not a
* an UMFPACK bug. It is fixed in gcc version 4.3.2. However, as a
* workaround for the compiler, the code below has been "fixed". */
if (n_row == n_col && nempty_row == nempty_col)
{
/* is_sym is true if the submatrix is square, and
* Rperm [n1..n_row-nempty_row-1] = Cperm [n1..n_col-nempty_col-1] */
is_sym = TRUE ;
for (s = n1 ; /* replaced the break with this test: */ is_sym &&
/* the remainder of this test is unchanged from v5.2.0: */
s < n_col - nempty_col ; s++)
{
if (Cperm [s] != Rperm [s])
{
is_sym = FALSE ;
/* removed a break statement here, which is OK but it tickles
* the gcc 4.2.{3,4} compiler bug */
}
}
}
else
{
is_sym = FALSE ;
}
DEBUGm4 (("Submatrix square and symmetrically permuted? "ID"\n", is_sym)) ;
DEBUGm4 (("singletons "ID" row "ID" col "ID"\n", n1, n1r, n1c)) ;
DEBUGm4 (("Empty cols "ID" rows "ID"\n", nempty_col, nempty_row)) ;
*p_n1 = n1 ;
*p_n1r = n1r ;
*p_n1c = n1c ;
*p_is_sym = is_sym ;
*p_nempty_col = nempty_col ;
*p_nempty_row = nempty_row ;
*p_max_rdeg = max_rdeg ;
return (UMFPACK_OK) ;
}
GLOBAL Int UMFPACK_numeric
(
const Int Ap [ ],
const Int Ai [ ],
const double Ax [ ],
#ifdef COMPLEX
const double Az [ ],
#endif
void *SymbolicHandle,
void **NumericHandle,
const double Control [UMFPACK_CONTROL],
double User_Info [UMFPACK_INFO]
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double Info2 [UMFPACK_INFO], alloc_init, relpt, relpt2, droptol,
front_alloc_init, stats [2] ;
double *Info ;
WorkType WorkSpace, *Work ;
NumericType *Numeric ;
SymbolicType *Symbolic ;
Int n_row, n_col, n_inner, newsize, i, status, *inew, npiv, ulen, scale ;
Unit *mnew ;
/* ---------------------------------------------------------------------- */
/* get the amount of time used by the process so far */
/* ---------------------------------------------------------------------- */
umfpack_tic (stats) ;
/* ---------------------------------------------------------------------- */
/* initialize and check inputs */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_dump_start ( ) ;
init_count = UMF_malloc_count ;
DEBUGm4 (("\nUMFPACK numeric: U transpose version\n")) ;
#endif
/* If front_alloc_init negative then allocate that size of front in
* UMF_start_front. If alloc_init negative, then allocate that initial
* size of Numeric->Memory. */
relpt = GET_CONTROL (UMFPACK_PIVOT_TOLERANCE,
UMFPACK_DEFAULT_PIVOT_TOLERANCE) ;
relpt2 = GET_CONTROL (UMFPACK_SYM_PIVOT_TOLERANCE,
UMFPACK_DEFAULT_SYM_PIVOT_TOLERANCE) ;
alloc_init = GET_CONTROL (UMFPACK_ALLOC_INIT, UMFPACK_DEFAULT_ALLOC_INIT) ;
front_alloc_init = GET_CONTROL (UMFPACK_FRONT_ALLOC_INIT,
UMFPACK_DEFAULT_FRONT_ALLOC_INIT) ;
scale = GET_CONTROL (UMFPACK_SCALE, UMFPACK_DEFAULT_SCALE) ;
droptol = GET_CONTROL (UMFPACK_DROPTOL, UMFPACK_DEFAULT_DROPTOL) ;
relpt = MAX (0.0, MIN (relpt, 1.0)) ;
relpt2 = MAX (0.0, MIN (relpt2, 1.0)) ;
droptol = MAX (0.0, droptol) ;
front_alloc_init = MIN (1.0, front_alloc_init) ;
if (scale != UMFPACK_SCALE_NONE && scale != UMFPACK_SCALE_MAX)
{
scale = UMFPACK_DEFAULT_SCALE ;
}
if (User_Info != (double *) NULL)
{
/* return Info in user's array */
Info = User_Info ;
/* clear the parts of Info that are set by UMFPACK_numeric */
for (i = UMFPACK_NUMERIC_SIZE ; i <= UMFPACK_MAX_FRONT_NCOLS ; i++)
{
Info [i] = EMPTY ;
}
for (i = UMFPACK_NUMERIC_DEFRAG ; i < UMFPACK_IR_TAKEN ; i++)
{
Info [i] = EMPTY ;
}
}
else
{
/* no Info array passed - use local one instead */
Info = Info2 ;
for (i = 0 ; i < UMFPACK_INFO ; i++)
{
Info [i] = EMPTY ;
}
}
Symbolic = (SymbolicType *) SymbolicHandle ;
Numeric = (NumericType *) NULL ;
if (!UMF_valid_symbolic (Symbolic))
{
Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_Symbolic_object ;
return (UMFPACK_ERROR_invalid_Symbolic_object) ;
}
/* compute alloc_init automatically for AMD or other symmetric ordering */
if (/* Symbolic->ordering == UMFPACK_ORDERING_AMD */ alloc_init >= 0
&& Symbolic->amd_lunz > 0)
{
alloc_init = (Symbolic->nz + Symbolic->amd_lunz) / Symbolic->lunz_bound;
alloc_init = MIN (1.0, alloc_init) ;
alloc_init *= UMF_REALLOC_INCREASE ;
}
n_row = Symbolic->n_row ;
n_col = Symbolic->n_col ;
n_inner = MIN (n_row, n_col) ;
/* check for integer overflow in Numeric->Memory minimum size */
if (INT_OVERFLOW (Symbolic->dnum_mem_init_usage * sizeof (Unit)))
{
/* :: int overflow, initial Numeric->Memory size :: */
/* There's no hope to allocate a Numeric object big enough simply to
* hold the initial matrix, so return an out-of-memory condition */
DEBUGm4 (("out of memory: numeric int overflow\n")) ;
Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
return (UMFPACK_ERROR_out_of_memory) ;
}
Info [UMFPACK_STATUS] = UMFPACK_OK ;
Info [UMFPACK_NROW] = n_row ;
Info [UMFPACK_NCOL] = n_col ;
Info [UMFPACK_SIZE_OF_UNIT] = (double) (sizeof (Unit)) ;
if (!Ap || !Ai || !Ax || !NumericHandle)
{
Info [UMFPACK_STATUS] = UMFPACK_ERROR_argument_missing ;
return (UMFPACK_ERROR_argument_missing) ;
}
Info [UMFPACK_NZ] = Ap [n_col] ;
*NumericHandle = (void *) NULL ;
/* ---------------------------------------------------------------------- */
/* allocate the Work object */
/* ---------------------------------------------------------------------- */
/* (1) calls UMF_malloc 15 or 17 times, to obtain temporary workspace of
* size c+1 Entry's and 2*(n_row+1) + 3*(n_col+1) + (n_col+n_inner+1) +
* (nn+1) + * 3*(c+1) + 2*(r+1) + max(r,c) + (nfr+1) integers plus 2*nn
* more integers if diagonal pivoting is to be done. r is the maximum
* number of rows in any frontal matrix, c is the maximum number of columns
* in any frontal matrix, n_inner is min (n_row,n_col), nn is
* max (n_row,n_col), and nfr is the number of frontal matrices. For a
* square matrix, this is c+1 Entry's and about 8n + 3c + 2r + max(r,c) +
* nfr integers, plus 2n more for diagonal pivoting.
*/
Work = &WorkSpace ;
Work->n_row = n_row ;
Work->n_col = n_col ;
Work->nfr = Symbolic->nfr ;
Work->nb = Symbolic->nb ;
Work->n1 = Symbolic->n1 ;
if (!work_alloc (Work, Symbolic))
{
DEBUGm4 (("out of memory: numeric work\n")) ;
Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
error (&Numeric, Work) ;
return (UMFPACK_ERROR_out_of_memory) ;
}
ASSERT (UMF_malloc_count == init_count + 16 + 2*Symbolic->prefer_diagonal) ;
/* ---------------------------------------------------------------------- */
/* allocate Numeric object */
/* ---------------------------------------------------------------------- */
/* (2) calls UMF_malloc 10 or 11 times, for a total space of
* sizeof (NumericType) bytes, 4*(n_row+1) + 4*(n_row+1) integers, and
* (n_inner+1) Entry's, plus n_row Entry's if row scaling is to be done.
* sizeof (NumericType) is a small constant. Next, it calls UMF_malloc
* once, for the variable-sized part of the Numeric object
* (Numeric->Memory). The size of this object is the larger of
* (Control [UMFPACK_ALLOC_INIT]) * (the approximate upper bound computed
* by UMFPACK_symbolic), and the minimum required to start the numerical
* factorization. * This request is reduced if it fails.
*/
if (!numeric_alloc (&Numeric, Symbolic, alloc_init, scale))
{
DEBUGm4 (("out of memory: initial numeric\n")) ;
Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
error (&Numeric, Work) ;
return (UMFPACK_ERROR_out_of_memory) ;
}
DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
init_count, UMF_malloc_count)) ;
ASSERT (UMF_malloc_count == init_count
+ (16 + 2*Symbolic->prefer_diagonal)
+ (11 + (scale != UMFPACK_SCALE_NONE))) ;
/* set control parameters */
Numeric->relpt = relpt ;
Numeric->relpt2 = relpt2 ;
Numeric->droptol = droptol ;
Numeric->alloc_init = alloc_init ;
Numeric->front_alloc_init = front_alloc_init ;
Numeric->scale = scale ;
DEBUG0 (("umf relpt %g %g init %g %g inc %g red %g\n",
relpt, relpt2, alloc_init, front_alloc_init,
UMF_REALLOC_INCREASE, UMF_REALLOC_REDUCTION)) ;
/* ---------------------------------------------------------------------- */
/* scale and factorize */
/* ---------------------------------------------------------------------- */
/* (3) During numerical factorization (inside UMF_kernel), the variable-size
* block of memory is increased in size via a call to UMF_realloc if it is
* found to be too small. During factorization, this block holds the
* pattern and values of L and U at the top end, and the elements
* (contibution blocks) and the current frontal matrix (Work->F*) at the
* bottom end. The peak size of the variable-sized object is estimated in
* UMFPACK_*symbolic (Info [UMFPACK_VARIABLE_PEAK_ESTIMATE]), although this
* upper bound can be very loose. The size of the Symbolic object
* (which is currently allocated) is in Info [UMFPACK_SYMBOLIC_SIZE], and
* is between 2*n and 13*n integers.
*/
DEBUG0 (("Calling umf_kernel\n")) ;
status = UMF_kernel (Ap, Ai, Ax,
#ifdef COMPLEX
Az,
#endif
Numeric, Work, Symbolic) ;
Info [UMFPACK_STATUS] = status ;
if (status < UMFPACK_OK)
{
/* out of memory, or pattern has changed */
error (&Numeric, Work) ;
return (status) ;
}
Info [UMFPACK_FORCED_UPDATES] = Work->nforced ;
Info [UMFPACK_VARIABLE_INIT] = Numeric->init_usage ;
if (Symbolic->prefer_diagonal)
{
Info [UMFPACK_NOFF_DIAG] = Work->noff_diagonal ;
}
DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
init_count, UMF_malloc_count)) ;
npiv = Numeric->npiv ; /* = n_inner for nonsingular matrices */
ulen = Numeric->ulen ; /* = 0 for square nonsingular matrices */
/* ---------------------------------------------------------------------- */
/* free Work object */
/* ---------------------------------------------------------------------- */
/* (4) After numerical factorization all of the objects allocated in step
* (1) are freed via UMF_free, except that one object of size n_col+1 is
* kept if there are off-diagonal nonzeros in the last pivot row (can only
* occur for singular or rectangular matrices). This is Work->Upattern,
* which is transfered to Numeric->Upattern if ulen > 0.
*/
DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
init_count, UMF_malloc_count)) ;
free_work (Work) ;
DEBUG0 (("malloc: init_count "ID" UMF_malloc_count "ID"\n",
init_count, UMF_malloc_count)) ;
DEBUG0 (("Numeric->ulen: "ID" scale: "ID"\n", ulen, scale)) ;
ASSERT (UMF_malloc_count == init_count + (ulen > 0) +
(11 + (scale != UMFPACK_SCALE_NONE))) ;
/* ---------------------------------------------------------------------- */
/* reduce Lpos, Lilen, Lip, Upos, Uilen and Uip to size npiv+1 */
/* ---------------------------------------------------------------------- */
/* (5) Six components of the Numeric object are reduced in size if the
* matrix is singular or rectangular. The original size is 3*(n_row+1) +
* 3*(n_col+1) integers. The new size is 6*(npiv+1) integers. For
* square non-singular matrices, these two sizes are the same.
*/
if (npiv < n_row)
{
/* reduce Lpos, Uilen, and Uip from size n_row+1 to size npiv */
inew = (Int *) UMF_realloc (Numeric->Lpos, npiv+1, sizeof (Int)) ;
if (inew)
{
Numeric->Lpos = inew ;
}
inew = (Int *) UMF_realloc (Numeric->Uilen, npiv+1, sizeof (Int)) ;
if (inew)
{
Numeric->Uilen = inew ;
}
inew = (Int *) UMF_realloc (Numeric->Uip, npiv+1, sizeof (Int)) ;
if (inew)
{
Numeric->Uip = inew ;
}
}
if (npiv < n_col)
{
/* reduce Upos, Lilen, and Lip from size n_col+1 to size npiv */
inew = (Int *) UMF_realloc (Numeric->Upos, npiv+1, sizeof (Int)) ;
if (inew)
{
Numeric->Upos = inew ;
}
inew = (Int *) UMF_realloc (Numeric->Lilen, npiv+1, sizeof (Int)) ;
if (inew)
{
Numeric->Lilen = inew ;
}
inew = (Int *) UMF_realloc (Numeric->Lip, npiv+1, sizeof (Int)) ;
if (inew)
{
Numeric->Lip = inew ;
}
}
/* ---------------------------------------------------------------------- */
/* reduce Numeric->Upattern from size n_col+1 to size ulen+1 */
/* ---------------------------------------------------------------------- */
/* (6) The size of Numeric->Upattern (formerly Work->Upattern) is reduced
* from size n_col+1 to size ulen + 1. If ulen is zero, the object does
* not exist. */
DEBUG4 (("ulen: "ID" Upattern "ID"\n", ulen, (Int) Numeric->Upattern)) ;
ASSERT (IMPLIES (ulen == 0, Numeric->Upattern == (Int *) NULL)) ;
if (ulen > 0 && ulen < n_col)
{
inew = (Int *) UMF_realloc (Numeric->Upattern, ulen+1, sizeof (Int)) ;
if (inew)
{
Numeric->Upattern = inew ;
}
}
/* ---------------------------------------------------------------------- */
/* reduce Numeric->Memory to hold just the LU factors at the head */
/* ---------------------------------------------------------------------- */
/* (7) The variable-sized block (Numeric->Memory) is reduced to hold just L
* and U, via a call to UMF_realloc, since the frontal matrices are no
* longer needed.
*/
newsize = Numeric->ihead ;
if (newsize < Numeric->size)
{
mnew = (Unit *) UMF_realloc (Numeric->Memory, newsize, sizeof (Unit)) ;
if (mnew)
{
/* realloc succeeded (how can it fail since the size is reduced?) */
Numeric->Memory = mnew ;
Numeric->size = newsize ;
}
}
Numeric->ihead = Numeric->size ;
Numeric->itail = Numeric->ihead ;
Numeric->tail_usage = 0 ;
Numeric->ibig = EMPTY ;
/* UMF_mem_alloc_tail_block can no longer be called (no tail marker) */
/* ---------------------------------------------------------------------- */
/* report the results and return the Numeric object */
/* ---------------------------------------------------------------------- */
UMF_set_stats (
Info,
Symbolic,
(double) Numeric->max_usage, /* actual peak Numeric->Memory */
(double) Numeric->size, /* actual final Numeric->Memory */
Numeric->flops, /* actual "true flops" */
(double) Numeric->lnz + n_inner, /* actual nz in L */
(double) Numeric->unz + Numeric->nnzpiv, /* actual nz in U */
(double) Numeric->maxfrsize, /* actual largest front size */
(double) ulen, /* actual Numeric->Upattern size */
(double) npiv, /* actual # pivots found */
(double) Numeric->maxnrows, /* actual largest #rows in front */
(double) Numeric->maxncols, /* actual largest #cols in front */
scale != UMFPACK_SCALE_NONE,
Symbolic->prefer_diagonal,
ACTUAL) ;
Info [UMFPACK_ALLOC_INIT_USED] = Numeric->alloc_init ;
Info [UMFPACK_NUMERIC_DEFRAG] = Numeric->ngarbage ;
Info [UMFPACK_NUMERIC_REALLOC] = Numeric->nrealloc ;
Info [UMFPACK_NUMERIC_COSTLY_REALLOC] = Numeric->ncostly ;
Info [UMFPACK_COMPRESSED_PATTERN] = Numeric->isize ;
Info [UMFPACK_LU_ENTRIES] = Numeric->nLentries + Numeric->nUentries +
Numeric->npiv ;
Info [UMFPACK_UDIAG_NZ] = Numeric->nnzpiv ;
Info [UMFPACK_RSMIN] = Numeric->rsmin ;
Info [UMFPACK_RSMAX] = Numeric->rsmax ;
Info [UMFPACK_WAS_SCALED] = Numeric->scale ;
/* nz in L and U with no dropping of small entries */
Info [UMFPACK_ALL_LNZ] = Numeric->all_lnz + n_inner ;
Info [UMFPACK_ALL_UNZ] = Numeric->all_unz + Numeric->nnzpiv ;
Info [UMFPACK_NZDROPPED] =
(Numeric->all_lnz - Numeric->lnz)
+ (Numeric->all_unz - Numeric->unz) ;
/* estimate of the reciprocal of the condition number. */
if (SCALAR_IS_ZERO (Numeric->min_udiag)
|| SCALAR_IS_ZERO (Numeric->max_udiag)
|| SCALAR_IS_NAN (Numeric->min_udiag)
|| SCALAR_IS_NAN (Numeric->max_udiag))
{
/* rcond is zero if there is any zero or NaN on the diagonal */
Numeric->rcond = 0.0 ;
}
else
{
/* estimate of the recipricol of the condition number. */
/* This is NaN if diagonal is zero-free, but has one or more NaN's. */
Numeric->rcond = Numeric->min_udiag / Numeric->max_udiag ;
}
Info [UMFPACK_UMIN] = Numeric->min_udiag ;
Info [UMFPACK_UMAX] = Numeric->max_udiag ;
Info [UMFPACK_RCOND] = Numeric->rcond ;
if (Numeric->nnzpiv < n_inner
|| SCALAR_IS_ZERO (Numeric->rcond) || SCALAR_IS_NAN (Numeric->rcond))
{
/* there are zeros and/or NaN's on the diagonal of U */
DEBUG0 (("Warning, matrix is singular in umfpack_numeric\n")) ;
DEBUG0 (("nnzpiv "ID" n_inner "ID" rcond %g\n", Numeric->nnzpiv,
n_inner, Numeric->rcond)) ;
status = UMFPACK_WARNING_singular_matrix ;
Info [UMFPACK_STATUS] = status ;
}
Numeric->valid = NUMERIC_VALID ;
*NumericHandle = (void *) Numeric ;
/* Numeric has 11 to 13 objects */
ASSERT (UMF_malloc_count == init_count + 11 +
+ (ulen > 0) /* Numeric->Upattern */
+ (scale != UMFPACK_SCALE_NONE)) ; /* Numeric->Rs */
/* ---------------------------------------------------------------------- */
/* get the time used by UMFPACK_numeric */
/* ---------------------------------------------------------------------- */
umfpack_toc (stats) ;
Info [UMFPACK_NUMERIC_WALLTIME] = stats [0] ;
Info [UMFPACK_NUMERIC_TIME] = stats [1] ;
/* return UMFPACK_OK or UMFPACK_WARNING_singular_matrix */
return (status) ;
}
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 Int UMF_create_element
(
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int j, col, row, *Fcols, *Frows, fnrows, fncols, *Cols, len, needunits, t1,
t2, size, e, i, *E, *Fcpos, *Frpos, *Rows, eloc, fnr_curr, f,
got_memory, *Row_tuples, *Row_degree, *Row_tlen, *Col_tuples, max_mark,
*Col_degree, *Col_tlen, nn, n_row, n_col, r2, c2, do_Fcpos ;
Entry *C, *Fcol ;
Element *ep ;
Unit *p, *Memory ;
Tuple *tp, *tp1, *tp2, tuple, *tpend ;
#ifndef NDEBUG
DEBUG2 (("FRONTAL WRAPUP\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
ASSERT (Work->fnpiv == 0) ;
ASSERT (Work->fnzeros == 0) ;
Row_degree = Numeric->Rperm ;
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Col_degree = Numeric->Cperm ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
n_row = Work->n_row ;
n_col = Work->n_col ;
nn = MAX (n_row, n_col) ;
Fcols = Work->Fcols ;
Frows = Work->Frows ;
Fcpos = Work->Fcpos ;
Frpos = Work->Frpos ;
Memory = Numeric->Memory ;
fncols = Work->fncols ;
fnrows = Work->fnrows ;
tp = (Tuple *) NULL ;
tp1 = (Tuple *) NULL ;
tp2 = (Tuple *) NULL ;
/* ---------------------------------------------------------------------- */
/* add the current frontal matrix to the degrees of each column */
/* ---------------------------------------------------------------------- */
if (!Symbolic->fixQ)
{
/* but only if the column ordering is not fixed */
#pragma ivdep
for (j = 0 ; j < fncols ; j++)
{
/* add the current frontal matrix to the degree */
ASSERT (Fcols [j] >= 0 && Fcols [j] < n_col) ;
Col_degree [Fcols [j]] += fnrows ;
}
}
/* ---------------------------------------------------------------------- */
/* add the current frontal matrix to the degrees of each row */
/* ---------------------------------------------------------------------- */
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
/* add the current frontal matrix to the degree */
ASSERT (Frows [i] >= 0 && Frows [i] < n_row) ;
Row_degree [Frows [i]] += fncols ;
}
/* ---------------------------------------------------------------------- */
/* Reset the external degree counters */
/* ---------------------------------------------------------------------- */
E = Work->E ;
max_mark = MAX_MARK (nn) ;
if (!Work->pivcol_in_front)
{
/* clear the external column degrees. no more Usons of current front */
Work->cdeg0 += (nn + 1) ;
if (Work->cdeg0 >= max_mark)
{
/* guard against integer overflow. This is very rare */
DEBUG1 (("Integer overflow, cdeg\n")) ;
Work->cdeg0 = 1 ;
#pragma ivdep
for (e = 1 ; e <= Work->nel ; e++)
{
if (E [e])
{
ep = (Element *) (Memory + E [e]) ;
ep->cdeg = 0 ;
}
}
}
}
if (!Work->pivrow_in_front)
{
/* clear the external row degrees. no more Lsons of current front */
Work->rdeg0 += (nn + 1) ;
if (Work->rdeg0 >= max_mark)
{
/* guard against integer overflow. This is very rare */
DEBUG1 (("Integer overflow, rdeg\n")) ;
Work->rdeg0 = 1 ;
#pragma ivdep
for (e = 1 ; e <= Work->nel ; e++)
{
if (E [e])
{
ep = (Element *) (Memory + E [e]) ;
ep->rdeg = 0 ;
}
}
}
}
/* ---------------------------------------------------------------------- */
/* clear row/col offsets */
/* ---------------------------------------------------------------------- */
if (!Work->pivrow_in_front)
{
#pragma ivdep
for (j = 0 ; j < fncols ; j++)
{
Fcpos [Fcols [j]] = EMPTY ;
}
}
if (!Work->pivcol_in_front)
{
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
Frpos [Frows [i]] = EMPTY ;
}
}
if (fncols <= 0 || fnrows <= 0)
{
/* no element to create */
DEBUG2 (("Element evaporation\n")) ;
Work->prior_element = EMPTY ;
return (TRUE) ;
}
/* ---------------------------------------------------------------------- */
/* create element for later assembly */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0)
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage collection (create)\n"));
}
#endif
needunits = 0 ;
got_memory = FALSE ;
eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C,
&needunits, &ep) ;
/* if UMF_get_memory needs to be called */
if (Work->do_grow)
{
/* full compaction of current frontal matrix, since UMF_grow_front will
* be called next anyway. */
r2 = fnrows ;
c2 = fncols ;
do_Fcpos = FALSE ;
}
else
{
/* partial compaction. */
r2 = MAX (fnrows, Work->fnrows_new + 1) ;
c2 = MAX (fncols, Work->fncols_new + 1) ;
/* recompute Fcpos if pivot row is in the front */
do_Fcpos = Work->pivrow_in_front ;
}
if (!eloc)
{
/* Do garbage collection, realloc, and try again. */
/* Compact the current front if it needs to grow anyway. */
/* Note that there are no pivot rows or columns in the current front */
DEBUGm3 (("get_memory from umf_create_element, 1\n")) ;
if (!UMF_get_memory (Numeric, Work, needunits, r2, c2, do_Fcpos))
{
/* :: out of memory in umf_create_element (1) :: */
DEBUGm4 (("out of memory: create element (1)\n")) ;
return (FALSE) ; /* out of memory */
}
got_memory = TRUE ;
Memory = Numeric->Memory ;
eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C,
&needunits, &ep) ;
ASSERT (eloc >= 0) ;
if (!eloc)
{
/* :: out of memory in umf_create_element (2) :: */
DEBUGm4 (("out of memory: create element (2)\n")) ;
return (FALSE) ; /* out of memory */
}
}
e = ++(Work->nel) ; /* get the name of this new frontal matrix */
Work->prior_element = e ;
DEBUG8 (("wrapup e "ID" nel "ID"\n", e, Work->nel)) ;
ASSERT (e > 0 && e < Work->elen) ;
ASSERT (E [e] == 0) ;
E [e] = eloc ;
if (Work->pivcol_in_front)
{
/* the new element is a Uson of the next frontal matrix */
ep->cdeg = Work->cdeg0 ;
}
if (Work->pivrow_in_front)
{
/* the new element is an Lson of the next frontal matrix */
ep->rdeg = Work->rdeg0 ;
}
/* ---------------------------------------------------------------------- */
/* copy frontal matrix into the new element */
/* ---------------------------------------------------------------------- */
#pragma ivdep
for (i = 0 ; i < fnrows ; i++)
{
Rows [i] = Frows [i] ;
}
#pragma ivdep
for (i = 0 ; i < fncols ; i++)
{
Cols [i] = Fcols [i] ;
}
Fcol = Work->Fcblock ;
DEBUG0 (("copy front "ID" by "ID"\n", fnrows, fncols)) ;
fnr_curr = Work->fnr_curr ;
ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ;
for (j = 0 ; j < fncols ; j++)
{
copy_column (fnrows, Fcol, C) ;
Fcol += fnr_curr ;
C += fnrows ;
}
DEBUG8 (("element copied\n")) ;
/* ---------------------------------------------------------------------- */
/* add tuples for the new element */
/* ---------------------------------------------------------------------- */
tuple.e = e ;
if (got_memory)
{
/* ------------------------------------------------------------------ */
/* UMF_get_memory ensures enough space exists for each new tuple */
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each column */
for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++)
{
col = Fcols [tuple.f] ;
ASSERT (col >= 0 && col < n_col) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
ASSERT (Col_tuples [col]) ;
tp = ((Tuple *) (Memory + Col_tuples [col])) + Col_tlen [col]++ ;
*tp = tuple ;
}
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each row */
for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++)
{
row = Frows [tuple.f] ;
ASSERT (row >= 0 && row < n_row) ;
ASSERT (NON_PIVOTAL_ROW (row)) ;
ASSERT (Row_tuples [row]) ;
tp = ((Tuple *) (Memory + Row_tuples [row])) + Row_tlen [row]++ ;
*tp = tuple ;
}
}
else
{
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each column */
/* ------------------------------------------------------------------ */
/* might not have enough space for each tuple */
for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++)
{
col = Fcols [tuple.f] ;
ASSERT (col >= 0 && col < n_col) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
t1 = Col_tuples [col] ;
DEBUG1 (("Placing on col:"ID" , tuples at "ID"\n",
col, Col_tuples [col])) ;
size = 0 ;
len = 0 ;
if (t1)
{
p = Memory + t1 ;
tp = (Tuple *) p ;
size = GET_BLOCK_SIZE (p) ;
len = Col_tlen [col] ;
tp2 = tp + len ;
}
needunits = UNITS (Tuple, len + 1) ;
DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n",
len, size, needunits));
if (needunits > size && t1)
{
/* prune the tuples */
tp1 = tp ;
tp2 = tp ;
tpend = tp + len ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e]) continue ; /* element already deallocated */
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
;
if (Cols [f] == EMPTY) continue ; /* already assembled */
ASSERT (col == Cols [f]) ;
*tp2++ = *tp ; /* leave the tuple in the list */
}
len = tp2 - tp1 ;
Col_tlen [col] = len ;
needunits = UNITS (Tuple, len + 1) ;
}
if (needunits > size)
{
/* no room exists - reallocate elsewhere */
DEBUG1 (("REALLOCATE Col: "ID", size "ID" to "ID"\n",
col, size, 2*needunits)) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0) /* a double relop, but ignore NaN case */
{
double rrr = ((double) (rand ( ))) /
(((double) RAND_MAX) + 1) ;
DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random gar. (col tuple)\n")) ;
}
#endif
needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ;
t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ;
if (!t2)
{
/* :: get memory in umf_create_element (1) :: */
/* get memory, reconstruct all tuple lists, and return */
/* Compact the current front if it needs to grow anyway. */
/* Note: no pivot rows or columns in the current front */
DEBUGm4 (("get_memory from umf_create_element, 1\n")) ;
return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos));
}
Col_tuples [col] = t2 ;
tp2 = (Tuple *) (Memory + t2) ;
if (t1)
{
for (i = 0 ; i < len ; i++)
{
*tp2++ = *tp1++ ;
}
UMF_mem_free_tail_block (Numeric, t1) ;
}
}
/* place the new (e,f) tuple in the element list of the column */
Col_tlen [col]++ ;
*tp2 = tuple ;
}
/* ------------------------------------------------------------------ */
/* place (e,f) in the element list of each row */
/* ------------------------------------------------------------------ */
for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++)
{
row = Frows [tuple.f] ;
ASSERT (row >= 0 && row < n_row) ;
ASSERT (NON_PIVOTAL_ROW (row)) ;
t1 = Row_tuples [row] ;
DEBUG1 (("Placing on row:"ID" , tuples at "ID"\n",
row, Row_tuples [row])) ;
size = 0 ;
len = 0 ;
if (t1)
{
p = Memory + t1 ;
tp = (Tuple *) p ;
size = GET_BLOCK_SIZE (p) ;
len = Row_tlen [row] ;
tp2 = tp + len ;
}
needunits = UNITS (Tuple, len + 1) ;
DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n",
len, size, needunits)) ;
if (needunits > size && t1)
{
/* prune the tuples */
tp1 = tp ;
tp2 = tp ;
tpend = tp + len ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
Rows = Cols + (ep->ncols) ;
if (Rows [f] == EMPTY) continue ; /* already assembled */
ASSERT (row == Rows [f]) ;
*tp2++ = *tp ; /* leave the tuple in the list */
}
len = tp2 - tp1 ;
Row_tlen [row] = len ;
needunits = UNITS (Tuple, len + 1) ;
}
if (needunits > size)
{
/* no room exists - reallocate elsewhere */
DEBUG1 (("REALLOCATE Row: "ID", size "ID" to "ID"\n",
row, size, 2*needunits)) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0) /* a double relop, but ignore NaN case */
{
double rrr = ((double) (rand ( ))) /
(((double) RAND_MAX) + 1) ;
DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random gar. (row tuple)\n")) ;
}
#endif
needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ;
t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ;
if (!t2)
{
/* :: get memory in umf_create_element (2) :: */
/* get memory, reconstruct all tuple lists, and return */
/* Compact the current front if it needs to grow anyway. */
/* Note: no pivot rows or columns in the current front */
DEBUGm4 (("get_memory from umf_create_element, 2\n")) ;
return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos));
}
Row_tuples [row] = t2 ;
tp2 = (Tuple *) (Memory + t2) ;
if (t1)
{
for (i = 0 ; i < len ; i++)
{
*tp2++ = *tp1++ ;
}
UMF_mem_free_tail_block (Numeric, t1) ;
}
}
/* place the new (e,f) tuple in the element list of the row */
Row_tlen [row]++ ;
*tp2 = tuple ;
}
}
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG1 (("Done extending\nFINAL: element row pattern: len="ID"\n", fncols));
for (j = 0 ; j < fncols ; j++) DEBUG1 ((""ID"\n", Fcols [j])) ;
DEBUG1 (("FINAL: element col pattern: len="ID"\n", fnrows)) ;
for (j = 0 ; j < fnrows ; j++) DEBUG1 ((""ID"\n", Frows [j])) ;
for (j = 0 ; j < fncols ; j++)
{
col = Fcols [j] ;
ASSERT (col >= 0 && col < n_col) ;
UMF_dump_rowcol (1, Numeric, Work, col, !Symbolic->fixQ) ;
}
for (j = 0 ; j < fnrows ; j++)
{
row = Frows [j] ;
ASSERT (row >= 0 && row < n_row) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
}
if (n_row < 1000 && n_col < 1000)
{
UMF_dump_memory (Numeric) ;
}
DEBUG1 (("New element, after filling with stuff: "ID"\n", e)) ;
UMF_dump_element (Numeric, Work, e, TRUE) ;
if (nn < 1000)
{
DEBUG4 (("Matrix dump, after New element: "ID"\n", e)) ;
UMF_dump_matrix (Numeric, Work, TRUE) ;
}
DEBUG3 (("FRONTAL WRAPUP DONE\n")) ;
#endif
return (TRUE) ;
}
GLOBAL Int UMF_build_tuples
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int e, nrows, ncols, nel, *Rows, *Cols, row, col, n_row, n_col, *E,
*Row_tuples, *Row_degree, *Row_tlen,
*Col_tuples, *Col_degree, *Col_tlen, n1 ;
Element *ep ;
Unit *p ;
Tuple tuple, *tp ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
E = Work->E ;
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
n_row = Work->n_row ;
n_col = Work->n_col ;
nel = Work->nel ;
n1 = Work->n1 ;
DEBUG3 (("BUILD_TUPLES: n_row "ID" n_col "ID" nel "ID"\n",
n_row, n_col, nel)) ;
/* ---------------------------------------------------------------------- */
/* allocate space for the tuple lists */
/* ---------------------------------------------------------------------- */
/* Garbage collection and memory reallocation have already attempted to */
/* ensure that there is enough memory for all the tuple lists. If */
/* memory allocation fails here, then there is nothing more to be done. */
for (row = n1 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row))
{
Row_tuples [row] = UMF_mem_alloc_tail_block (Numeric,
UNITS (Tuple, TUPLES (Row_tlen [row]))) ;
if (!Row_tuples [row])
{
/* :: out of memory for row tuples :: */
DEBUGm4 (("out of memory: build row tuples\n")) ;
return (FALSE) ; /* out of memory for row tuples */
}
Row_tlen [row] = 0 ;
}
}
/* push on stack in reverse order, so column tuples are in the order */
/* that they will be deleted. */
for (col = n_col-1 ; col >= n1 ; col--)
{
if (NON_PIVOTAL_COL (col))
{
Col_tuples [col] = UMF_mem_alloc_tail_block (Numeric,
UNITS (Tuple, TUPLES (Col_tlen [col]))) ;
if (!Col_tuples [col])
{
/* :: out of memory for col tuples :: */
DEBUGm4 (("out of memory: build col tuples\n")) ;
return (FALSE) ; /* out of memory for col tuples */
}
Col_tlen [col] = 0 ;
}
}
#ifndef NDEBUG
UMF_dump_memory (Numeric) ;
#endif
/* ---------------------------------------------------------------------- */
/* create the tuple lists (exclude element 0) */
/* ---------------------------------------------------------------------- */
/* for all elements, in order of creation */
for (e = 1 ; e <= nel ; e++)
{
DEBUG9 (("Adding tuples for element: "ID" at "ID"\n", e, E [e])) ;
ASSERT (E [e]) ; /* no external fragmentation */
p = Numeric->Memory + E [e] ;
GET_ELEMENT_PATTERN (ep, p, Cols, Rows, ncols) ;
nrows = ep->nrows ;
ASSERT (e != 0) ;
ASSERT (e == 0 || nrows == ep->nrowsleft) ;
ASSERT (e == 0 || ncols == ep->ncolsleft) ;
tuple.e = e ;
for (tuple.f = 0 ; tuple.f < ncols ; tuple.f++)
{
col = Cols [tuple.f] ;
ASSERT (col >= n1 && col < n_col) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
ASSERT (Col_tuples [col]) ;
tp = ((Tuple *) (Numeric->Memory + Col_tuples [col]))
+ Col_tlen [col]++ ;
*tp = tuple ;
#ifndef NDEBUG
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
}
for (tuple.f = 0 ; tuple.f < nrows ; tuple.f++)
{
row = Rows [tuple.f] ;
ASSERT (row >= n1 && row < n_row) ;
ASSERT (NON_PIVOTAL_COL (col)) ;
ASSERT (Row_tuples [row]) ;
tp = ((Tuple *) (Numeric->Memory + Row_tuples [row]))
+ Row_tlen [row]++ ;
*tp = tuple ;
#ifndef NDEBUG
UMF_dump_rowcol (0, Numeric, Work, row, FALSE) ;
#endif
}
}
/* ---------------------------------------------------------------------- */
/* the tuple lists are now valid, and can be scanned */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_dump_memory (Numeric) ;
UMF_dump_matrix (Numeric, Work, FALSE) ;
#endif
DEBUG3 (("BUILD_TUPLES: done\n")) ;
return (TRUE) ;
}
GLOBAL Int UMF_extend_front
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int j, i, *Frows, row, col, *Wrow, fnr2, fnc2, *Frpos, *Fcpos, *Fcols,
fnrows_extended, rrdeg, ccdeg, fncols_extended, fnr_curr, fnc_curr,
fnrows, fncols, pos, fnpiv, *Wm ;
Entry *Wx, *Wy, *Fu, *Fl ;
/* ---------------------------------------------------------------------- */
/* get current frontal matrix and check for frontal growth */
/* ---------------------------------------------------------------------- */
fnpiv = Work->fnpiv ;
#ifndef NDEBUG
DEBUG2 (("EXTEND FRONT\n")) ;
DEBUG2 (("Work->fnpiv "ID"\n", fnpiv)) ;
ASSERT (Work->Flblock == Work->Flublock + Work->nb*Work->nb) ;
ASSERT (Work->Fublock == Work->Flblock + Work->fnr_curr*Work->nb) ;
ASSERT (Work->Fcblock == Work->Fublock + Work->nb*Work->fnc_curr) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (Work->Fcblock, Work->fnr_curr, Work->fnrows, Work->fncols) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Work->Flblock, Work->fnr_curr, Work->fnrows, fnpiv);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Work->Fublock, Work->fnc_curr, Work->fncols, fnpiv) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Work->Flublock, Work->nb, fnpiv, fnpiv) ;
#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, 1))
{
DEBUGm4 (("out of memory: extend front\n")) ;
return (FALSE) ;
}
}
fnr_curr = Work->fnr_curr ;
fnc_curr = Work->fnc_curr ;
ASSERT (Work->fnrows_new + 1 <= fnr_curr) ;
ASSERT (Work->fncols_new + 1 <= fnc_curr) ;
ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
Frows = Work->Frows ;
Frpos = Work->Frpos ;
Fcols = Work->Fcols ;
Fcpos = Work->Fcpos ;
fnrows = Work->fnrows ;
fncols = Work->fncols ;
rrdeg = Work->rrdeg ;
ccdeg = Work->ccdeg ;
/* scan starts at the first new column in Fcols */
/* also scan the pivot column if it was not in the front */
Work->fscan_col = fncols ;
Work->NewCols = Fcols ;
/* scan1 starts at the first new row in Frows */
/* also scan the pivot row if it was not in the front */
Work->fscan_row = fnrows ;
Work->NewRows = Frows ;
/* ---------------------------------------------------------------------- */
/* extend row pattern of the front with the new pivot column */
/* ---------------------------------------------------------------------- */
fnrows_extended = fnrows ;
fncols_extended = fncols ;
#ifndef NDEBUG
DEBUG2 (("Pivot col, before extension: "ID"\n", fnrows)) ;
for (i = 0 ; i < fnrows ; i++)
{
DEBUG2 ((" "ID": row "ID"\n", i, Frows [i])) ;
ASSERT (Frpos [Frows [i]] == i) ;
}
DEBUG2 (("Extending pivot column: pivcol_in_front: "ID"\n",
Work->pivcol_in_front)) ;
#endif
Fl = Work->Flblock + fnpiv * fnr_curr ;
if (Work->pivcol_in_front)
{
/* extended pattern and position already in Frows, Frpos. Values above
* the diagonal are already in LU block. Values on and below the
* diagonal are in Wy [0 .. fnrows_extended-1]. Copy into the L
* block. */
fnrows_extended += ccdeg ;
Wy = Work->Wy ;
for (i = 0 ; i < fnrows_extended ; i++)
{
Fl [i] = Wy [i] ;
#ifndef NDEBUG
row = Frows [i] ;
DEBUG2 ((" "ID": row "ID" ", i, row)) ;
EDEBUG2 (Fl [i]) ;
if (row == Work->pivrow) DEBUG2 ((" <- pivrow")) ;
DEBUG2 (("\n")) ;
if (i == fnrows - 1) DEBUG2 ((" :::::::\n")) ;
ASSERT (row >= 0 && row < Work->n_row) ;
ASSERT (Frpos [row] == i) ;
#endif
}
}
else
{
/* extended pattern,values is in (Wm,Wx), not yet in the front */
Entry *F ;
Fu = Work->Flublock + fnpiv * Work->nb ;
Wm = Work->Wm ;
Wx = Work->Wx ;
F = Fu ;
for (i = 0 ; i < fnpiv ; i++)
{
CLEAR_AND_INCREMENT (F) ;
}
F = Fl ;
for (i = 0 ; i < fnrows ; i++)
{
CLEAR_AND_INCREMENT (F) ;
}
for (i = 0 ; i < ccdeg ; i++)
{
row = Wm [i] ;
#ifndef NDEBUG
DEBUG2 ((" "ID": row "ID" (ext) ", fnrows_extended, row)) ;
EDEBUG2 (Wx [i]) ;
if (row == Work->pivrow) DEBUG2 ((" <- pivrow")) ;
DEBUG2 (("\n")) ;
ASSERT (row >= 0 && row < Work->n_row) ;
#endif
pos = Frpos [row] ;
if (pos < 0)
{
pos = fnrows_extended++ ;
Frows [pos] = row ;
Frpos [row] = pos ;
}
Fl [pos] = Wx [i] ;
}
}
ASSERT (fnrows_extended <= fnr_curr) ;
/* ---------------------------------------------------------------------- */
/* extend the column pattern of the front with the new pivot row */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG6 (("Pivot row, before extension: "ID"\n", fncols)) ;
for (j = 0 ; j < fncols ; j++)
{
DEBUG7 ((" "ID": col "ID"\n", j, Fcols [j])) ;
ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ;
}
DEBUG6 (("Extending pivot row:\n")) ;
#endif
if (Work->pivrow_in_front)
{
if (Work->pivcol_in_front)
{
ASSERT (Fcols == Work->Wrow) ;
for (j = fncols ; j < rrdeg ; j++)
{
#ifndef NDEBUG
col = Fcols [j] ;
DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ;
ASSERT (col != Work->pivcol) ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (Fcpos [col] < 0) ;
#endif
Fcpos [Fcols [j]] = j * fnr_curr ;
}
}
else
{
/* OUT-IN option: pivcol not in front, but pivrow is in front */
Wrow = Work->Wrow ;
ASSERT (IMPLIES (Work->pivcol_in_front, Wrow == Fcols)) ;
if (Wrow == Fcols)
{
/* Wrow and Fcols are equivalenced */
for (j = fncols ; j < rrdeg ; j++)
{
col = Wrow [j] ;
DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ;
ASSERT (Fcpos [col] < 0) ;
/* Fcols [j] = col ; not needed */
Fcpos [col] = j * fnr_curr ;
}
}
else
{
for (j = fncols ; j < rrdeg ; j++)
{
col = Wrow [j] ;
DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ;
ASSERT (Fcpos [col] < 0) ;
Fcols [j] = col ;
Fcpos [col] = j * fnr_curr ;
}
}
}
fncols_extended = rrdeg ;
}
else
{
ASSERT (Fcols != Work->Wrow) ;
Wrow = Work->Wrow ;
for (j = 0 ; j < rrdeg ; j++)
{
col = Wrow [j] ;
ASSERT (col >= 0 && col < Work->n_col) ;
if (Fcpos [col] < 0)
{
DEBUG2 ((" col:: "ID" (ext)\n", col)) ;
Fcols [fncols_extended] = col ;
Fcpos [col] = fncols_extended * fnr_curr ;
fncols_extended++ ;
}
}
}
/* ---------------------------------------------------------------------- */
/* pivot row and column have been extended */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
ASSERT (fncols_extended <= fnc_curr) ;
ASSERT (fnrows_extended <= fnr_curr) ;
DEBUG6 (("Pivot col, after ext: "ID" "ID"\n", fnrows,fnrows_extended)) ;
for (i = 0 ; i < fnrows_extended ; i++)
{
row = Frows [i] ;
DEBUG7 ((" "ID": row "ID" pos "ID" old: %d", i, row, Frpos [row],
i < fnrows)) ;
if (row == Work->pivrow ) DEBUG7 ((" <-- pivrow")) ;
DEBUG7 (("\n")) ;
ASSERT (Frpos [Frows [i]] == i) ;
}
DEBUG6 (("Pivot row position: "ID"\n", Frpos [Work->pivrow])) ;
ASSERT (Frpos [Work->pivrow] >= 0) ;
ASSERT (Frpos [Work->pivrow] < fnrows_extended) ;
DEBUG6 (("Pivot row, after ext: "ID" "ID"\n", fncols,fncols_extended)) ;
for (j = 0 ; j < fncols_extended ; j++)
{
col = Fcols [j] ;
DEBUG7 ((" "ID": col "ID" pos "ID" old: %d", j, col, Fcpos [col],
j < fncols)) ;
if (col == Work->pivcol ) DEBUG7 ((" <-- pivcol")) ;
DEBUG7 (("\n")) ;
ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ;
}
DEBUG6 (("Pivot col position: "ID"\n", Fcpos [Work->pivcol])) ;
ASSERT (Fcpos [Work->pivcol] >= 0) ;
ASSERT (Fcpos [Work->pivcol] < fncols_extended * fnr_curr) ;
#endif
/* ---------------------------------------------------------------------- */
/* Zero the newly extended frontal matrix */
/* ---------------------------------------------------------------------- */
zero_front (Work->Flblock, Work->Fublock, Work->Fcblock,
fnrows, fncols, fnr_curr, fnc_curr,
fnpiv, fnrows_extended, fncols_extended) ;
/* ---------------------------------------------------------------------- */
/* finalize extended row and column pattern of the frontal matrix */
/* ---------------------------------------------------------------------- */
Work->fnrows = fnrows_extended ;
Work->fncols = fncols_extended ;
ASSERT (fnrows_extended == Work->fnrows_new + 1) ;
ASSERT (fncols_extended == Work->fncols_new + 1) ;
return (TRUE) ;
}
GLOBAL void UMF_2by2
(
/* input, not modified: */
Int n, /* A is n-by-n */
const Int Ap [ ], /* size n+1 */
const Int Ai [ ], /* size nz = Ap [n] */
const double Ax [ ], /* size nz if present */
#ifdef COMPLEX
const double Az [ ], /* size nz if present */
#endif
double tol, /* tolerance for determining whether or not an
* entry is numerically acceptable. If tol <= 0
* then all numerical values ignored. */
Int scale, /* scaling to perform (none, sum, or max) */
Int Cperm1 [ ], /* singleton permutations */
#ifndef NDEBUG
Int Rperm1 [ ], /* not needed, since Rperm1 = Cperm1 for submatrix S */
#endif
Int InvRperm1 [ ], /* inverse of Rperm1 */
Int n1, /* number of singletons */
Int nempty, /* number of empty rows/cols */
/* input, contents undefined on output: */
Int Degree [ ], /* Degree [j] is the number of off-diagonal
* entries in row/column j of S+S', where
* where S = A (Cperm1 [n1..], Rperm1 [n1..]).
* Note that S is not used, nor formed. */
/* output: */
Int P [ ], /* P [k] = i means original row i is kth row in S(P,:)
* where S = A (Cperm1 [n1..], Rperm1 [n1..]) */
Int *p_nweak,
Int *p_unmatched,
/* workspace (not defined on input or output): */
Int Ri [ ], /* of size >= max (nz, n) */
Int Rp [ ], /* of size n+1 */
double Rs [ ], /* of size n if present. Rs = sum (abs (A),2) or
* max (abs (A),2), the sum or max of each row. Unused
* if scale is equal to UMFPACK_SCALE_NONE. */
Int Head [ ], /* of size n. Head pointers for bucket sort */
Int Next [ ], /* of size n. Next pointers for bucket sort */
Int Ci [ ], /* size nz */
Int Cp [ ] /* size n+1 */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry aij ;
double cmax, value, rs, ctol, dvalue ;
Int k, p, row, col, do_values, do_sum, do_max, do_scale, nweak, weak,
p1, p2, dfound, unmatched, n2, oldrow, newrow, oldcol, newcol, pp ;
#ifdef COMPLEX
Int split = SPLIT (Az) ;
#endif
#ifndef NRECIPROCAL
Int do_recip = FALSE ;
#endif
#ifndef NDEBUG
/* UMF_debug += 99 ; */
DEBUGm3 (("\n ==================================UMF_2by2: tol %g\n", tol)) ;
ASSERT (AMD_valid (n, n, Ap, Ai) == AMD_OK) ;
for (k = n1 ; k < n - nempty ; k++)
{
ASSERT (Cperm1 [k] == Rperm1 [k]) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* determine scaling options */
/* ---------------------------------------------------------------------- */
/* use the values, but only if they are present */
/* ignore the values if tol <= 0 */
do_values = (tol > 0) && (Ax != (double *) NULL) ;
if (do_values && (Rs != (double *) NULL))
{
do_sum = (scale == UMFPACK_SCALE_SUM) ;
do_max = (scale == UMFPACK_SCALE_MAX) ;
}
else
{
/* no scaling */
do_sum = FALSE ;
do_max = FALSE ;
}
do_scale = do_max || do_sum ;
DEBUGm3 (("do_values "ID" do_sum "ID" do_max "ID" do_scale "ID"\n",
do_values, do_sum, do_max, do_scale)) ;
/* ---------------------------------------------------------------------- */
/* compute the row scaling, if requested */
/* ---------------------------------------------------------------------- */
/* see also umf_kernel_init */
if (do_scale)
{
#ifndef NRECIPROCAL
double rsmin ;
#endif
for (row = 0 ; row < n ; row++)
{
Rs [row] = 0.0 ;
}
for (col = 0 ; col < n ; col++)
{
p2 = Ap [col+1] ;
for (p = Ap [col] ; p < p2 ; p++)
{
row = Ai [p] ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
rs = Rs [row] ;
if (!SCALAR_IS_NAN (rs))
{
if (SCALAR_IS_NAN (value))
{
/* if any entry in a row is NaN, then the scale factor
* for the row is NaN. It will be set to 1 later. */
Rs [row] = value ;
}
else if (do_max)
{
Rs [row] = MAX (rs, value) ;
}
else
{
Rs [row] += value ;
}
}
}
}
#ifndef NRECIPROCAL
rsmin = Rs [0] ;
if (SCALAR_IS_ZERO (rsmin) || SCALAR_IS_NAN (rsmin))
{
rsmin = 1.0 ;
}
#endif
for (row = 0 ; row < n ; row++)
{
/* do not scale an empty row, or a row with a NaN */
rs = Rs [row] ;
if (SCALAR_IS_ZERO (rs) || SCALAR_IS_NAN (rs))
{
Rs [row] = 1.0 ;
}
#ifndef NRECIPROCAL
rsmin = MIN (rsmin, Rs [row]) ;
#endif
}
#ifndef NRECIPROCAL
/* multiply by the reciprocal if Rs is not too small */
do_recip = (rsmin >= RECIPROCAL_TOLERANCE) ;
if (do_recip)
{
/* invert the scale factors */
for (row = 0 ; row < n ; row++)
{
Rs [row] = 1.0 / Rs [row] ;
}
}
#endif
}
/* ---------------------------------------------------------------------- */
/* compute the max in each column and find diagonal */
/* ---------------------------------------------------------------------- */
nweak = 0 ;
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
ASSERT (Rperm1 [k] >= 0 && Rperm1 [k] < n) ;
ASSERT (InvRperm1 [Rperm1 [k]] == k) ;
}
#endif
n2 = n - n1 - nempty ;
/* use Ri to count the number of strong entries in each row */
for (row = 0 ; row < n2 ; row++)
{
Ri [row] = 0 ;
}
pp = 0 ;
ctol = 0 ;
dvalue = 1 ;
/* construct C = pruned submatrix, strong values only, column form */
for (k = n1 ; k < n - nempty ; k++)
{
oldcol = Cperm1 [k] ;
newcol = k - n1 ;
Next [newcol] = EMPTY ;
DEBUGm1 (("Column "ID" newcol "ID" oldcol "ID"\n", k, newcol, oldcol)) ;
Cp [newcol] = pp ;
dfound = FALSE ;
p1 = Ap [oldcol] ;
p2 = Ap [oldcol+1] ;
if (do_values)
{
cmax = 0 ;
dvalue = 0 ;
if (!do_scale)
{
/* no scaling */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
/* if either cmax or value is NaN, define cmax as NaN */
if (!SCALAR_IS_NAN (cmax))
{
if (SCALAR_IS_NAN (value))
{
cmax = value ;
}
else
{
cmax = MAX (cmax, value) ;
}
}
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
dvalue = value ;
dfound = TRUE ;
ASSERT (newrow == newcol) ;
}
}
}
#ifndef NRECIPROCAL
else if (do_recip)
{
/* multiply by the reciprocal */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value *= Rs [oldrow] ;
/* if either cmax or value is NaN, define cmax as NaN */
if (!SCALAR_IS_NAN (cmax))
{
if (SCALAR_IS_NAN (value))
{
cmax = value ;
}
else
{
cmax = MAX (cmax, value) ;
}
}
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
dvalue = value ;
dfound = TRUE ;
ASSERT (newrow == newcol) ;
}
}
}
#endif
else
{
/* divide instead */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value /= Rs [oldrow] ;
/* if either cmax or value is NaN, define cmax as NaN */
if (!SCALAR_IS_NAN (cmax))
{
if (SCALAR_IS_NAN (value))
{
cmax = value ;
}
else
{
cmax = MAX (cmax, value) ;
}
}
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
dvalue = value ;
dfound = TRUE ;
ASSERT (newrow == newcol) ;
}
}
}
ctol = tol * cmax ;
DEBUGm1 ((" cmax col "ID" %g ctol %g\n", oldcol, cmax, ctol)) ;
}
else
{
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
ASSERT (oldrow >= 0 && oldrow < n) ;
newrow = InvRperm1 [oldrow] - n1 ;
ASSERT (newrow >= -n1 && newrow < n2) ;
if (newrow < 0) continue ;
Ci [pp++] = newrow ;
if (oldrow == oldcol)
{
/* we found the diagonal entry in this column */
ASSERT (newrow == newcol) ;
dfound = TRUE ;
}
/* count the entries in each column */
Ri [newrow]++ ;
}
}
/* ------------------------------------------------------------------ */
/* flag the weak diagonals */
/* ------------------------------------------------------------------ */
if (!dfound)
{
/* no diagonal entry present */
weak = TRUE ;
}
else
{
/* diagonal entry is present, check its value */
weak = (do_values) ? WEAK (dvalue, ctol) : FALSE ;
}
if (weak)
{
/* flag this column as weak */
DEBUG0 (("Weak!\n")) ;
Next [newcol] = IS_WEAK ;
nweak++ ;
}
/* ------------------------------------------------------------------ */
/* count entries in each row that are not numerically weak */
/* ------------------------------------------------------------------ */
if (do_values)
{
if (!do_scale)
{
/* no scaling */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
newrow = InvRperm1 [oldrow] - n1 ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
weak = WEAK (value, ctol) ;
if (!weak)
{
DEBUG0 ((" strong: row "ID": %g\n", oldrow, value)) ;
Ci [pp++] = newrow ;
Ri [newrow]++ ;
}
}
}
#ifndef NRECIPROCAL
else if (do_recip)
{
/* multiply by the reciprocal */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
newrow = InvRperm1 [oldrow] - n1 ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value *= Rs [oldrow] ;
weak = WEAK (value, ctol) ;
if (!weak)
{
DEBUG0 ((" strong: row "ID": %g\n", oldrow, value)) ;
Ci [pp++] = newrow ;
Ri [newrow]++ ;
}
}
}
#endif
else
{
/* divide instead */
for (p = p1 ; p < p2 ; p++)
{
oldrow = Ai [p] ;
newrow = InvRperm1 [oldrow] - n1 ;
if (newrow < 0) continue ;
ASSIGN (aij, Ax, Az, p, split) ;
APPROX_ABS (value, aij) ;
value /= Rs [oldrow] ;
weak = WEAK (value, ctol) ;
if (!weak)
{
DEBUG0 ((" strong: row "ID": %g\n", oldrow, value)) ;
Ci [pp++] = newrow ;
Ri [newrow]++ ;
}
}
}
}
}
Cp [n2] = pp ;
ASSERT (AMD_valid (n2, n2, Cp, Ci) == AMD_OK) ;
if (nweak == 0)
{
/* nothing to do, quick return */
DEBUGm2 (("\n =============================UMF_2by2: quick return\n")) ;
for (k = 0 ; k < n ; k++)
{
P [k] = k ;
}
*p_nweak = 0 ;
*p_unmatched = 0 ;
return ;
}
#ifndef NDEBUG
for (k = 0 ; k < n2 ; k++)
{
P [k] = EMPTY ;
}
for (k = 0 ; k < n2 ; k++)
{
ASSERT (Degree [k] >= 0 && Degree [k] < n2) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* find the 2-by-2 permutation */
/* ---------------------------------------------------------------------- */
/* The matrix S is now mapped to the index range 0 to n2-1. We have
* S = A (Rperm [n1 .. n-nempty-1], Cperm [n1 .. n-nempty-1]), and then
* C = pattern of strong entries in S. A weak diagonal k in S is marked
* with Next [k] = IS_WEAK. */
unmatched = two_by_two (n2, Cp, Ci, Degree, Next, Ri, P, Rp, Head) ;
/* ---------------------------------------------------------------------- */
*p_nweak = nweak ;
*p_unmatched = unmatched ;
#ifndef NDEBUG
DEBUGm4 (("UMF_2by2: weak "ID" unmatched "ID"\n", nweak, unmatched)) ;
for (row = 0 ; row < n ; row++)
{
DEBUGm2 (("P ["ID"] = "ID"\n", row, P [row])) ;
}
DEBUGm2 (("\n =============================UMF_2by2: done\n\n")) ;
#endif
}
GLOBAL Int UMF_start_front /* returns TRUE if successful, FALSE otherwise */
(
Int chain,
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic
)
{
Int fnrows_max, fncols_max, fnr2, fnc2, fsize, fcurr_size, maxfrsize,
overflow, nb, f, cdeg ;
double maxbytes ;
nb = Symbolic->nb ;
fnrows_max = Symbolic->Chain_maxrows [chain] ;
fncols_max = Symbolic->Chain_maxcols [chain] ;
DEBUGm2 (("Start Front for chain "ID". fnrows_max "ID" fncols_max "ID"\n",
chain, fnrows_max, fncols_max)) ;
Work->fnrows_max = fnrows_max ;
Work->fncols_max = fncols_max ;
Work->any_skip = FALSE ;
maxbytes = sizeof (Entry) *
(double) (fnrows_max + nb) * (double) (fncols_max + nb) ;
fcurr_size = Work->fcurr_size ;
if (Symbolic->prefer_diagonal)
{
/* Get a rough upper bound on the degree of the first pivot column in
* this front. Note that Col_degree is not maintained if diagonal
* pivoting is preferred. For most matrices, the first pivot column
* of the first frontal matrix of a new chain has only one tuple in
* it anyway, so this bound is exact in that case. */
Int col, tpi, e, *E, *Col_tuples, *Col_tlen, *Cols ;
Tuple *tp, *tpend ;
Unit *Memory, *p ;
Element *ep ;
E = Work->E ;
Memory = Numeric->Memory ;
Col_tuples = Numeric->Lip ;
Col_tlen = Numeric->Lilen ;
col = Work->nextcand ;
tpi = Col_tuples [col] ;
tp = (Tuple *) Memory + tpi ;
tpend = tp + Col_tlen [col] ;
cdeg = 0 ;
DEBUGm3 (("\n=============== start front: col "ID" tlen "ID"\n",
col, Col_tlen [col])) ;
for ( ; tp < tpend ; tp++)
{
DEBUG1 (("Tuple ("ID","ID")\n", tp->e, tp->f)) ;
e = tp->e ;
if (!E [e]) continue ;
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
if (Cols [f] == EMPTY) continue ;
DEBUG1 ((" nrowsleft "ID"\n", ep->nrowsleft)) ;
cdeg += ep->nrowsleft ;
}
#ifndef NDEBUG
DEBUGm3 (("start front cdeg: "ID" col "ID"\n", cdeg, col)) ;
UMF_dump_rowcol (1, Numeric, Work, col, FALSE) ;
#endif
/* cdeg is now the rough upper bound on the degree of the next pivot
* column. */
/* If AMD was called, we know the maximum number of nonzeros in any
* column of L. Use this as an upper bound for cdeg, but add 2 to
* account for a small amount of off-diagonal pivoting. */
if (Symbolic->amd_dmax > 0)
{
cdeg = MIN (cdeg, Symbolic->amd_dmax) ;
}
/* Increase it to account for larger columns later on.
* Also ensure that it's larger than zero. */
cdeg += 2 ;
/* cdeg cannot be larger than fnrows_max */
cdeg = MIN (cdeg, fnrows_max) ;
}
else
{
/* don't do the above cdeg computation */
cdeg = 0 ;
}
DEBUGm2 (("fnrows max "ID" fncols_max "ID"\n", fnrows_max, fncols_max)) ;
/* the current frontal matrix is empty */
ASSERT (Work->fnrows == 0 && Work->fncols == 0 && Work->fnpiv == 0) ;
/* maximum row dimension is always odd, to avoid bad cache effects */
ASSERT (fnrows_max >= 0) ;
ASSERT (fnrows_max % 2 == 1) ;
/* ----------------------------------------------------------------------
* allocate working array for current frontal matrix:
* minimum size: 1-by-1
* maximum size: fnrows_max-by-fncols_max
* desired size:
*
* if Numeric->front_alloc_init >= 0:
*
* for unsymmetric matrices:
* Numeric->front_alloc_init * (fnrows_max-by-fncols_max)
*
* for symmetric matrices (diagonal pivoting preference, actually):
* Numeric->front_alloc_init * (fnrows_max-by-fncols_max), or
* cdeg*cdeg, whichever is smaller.
*
* if Numeric->front_alloc_init < 0:
* allocate a front of size -Numeric->front_alloc_init.
*
* Allocate the whole thing if it's small (less than 2*nb^2). Make sure the
* leading dimension of the frontal matrix is odd.
*
* Also allocate the nb-by-nb LU block, the dr-by-nb L block, and the
* nb-by-dc U block.
* ---------------------------------------------------------------------- */
/* get the maximum front size, avoiding integer overflow */
overflow = INT_OVERFLOW (maxbytes) ;
if (overflow)
{
/* :: int overflow, max front size :: */
maxfrsize = Int_MAX / sizeof (Entry) ;
}
else
{
maxfrsize = (fnrows_max + nb) * (fncols_max + nb) ;
}
ASSERT (!INT_OVERFLOW ((double) maxfrsize * sizeof (Entry))) ;
if (Numeric->front_alloc_init < 0)
{
/* allocate a front of -Numeric->front_alloc_init entries */
fsize = -Numeric->front_alloc_init ;
fsize = MAX (1, fsize) ;
}
else
{
if (INT_OVERFLOW (Numeric->front_alloc_init * maxbytes))
{
/* :: int overflow, requested front size :: */
fsize = Int_MAX / sizeof (Entry) ;
}
else
{
fsize = Numeric->front_alloc_init * maxfrsize ;
}
if (cdeg > 0)
{
/* diagonal pivoting is in use. cdeg was computed above */
Int fsize2 ;
/* add the L and U blocks */
cdeg += nb ;
if (INT_OVERFLOW (((double) cdeg * (double) cdeg) * sizeof (Entry)))
{
/* :: int overflow, symmetric front size :: */
fsize2 = Int_MAX / sizeof (Entry) ;
}
else
{
fsize2 = MAX (cdeg * cdeg, fcurr_size) ;
}
fsize = MIN (fsize, fsize2) ;
}
}
fsize = MAX (fsize, 2*nb*nb) ;
/* fsize and maxfrsize are now safe from integer overflow. They both
* include the size of the pivot blocks. */
ASSERT (!INT_OVERFLOW ((double) fsize * sizeof (Entry))) ;
Work->fnrows_new = 0 ;
Work->fncols_new = 0 ;
/* desired size is fnr2-by-fnc2 (includes L and U blocks): */
DEBUGm2 ((" fsize "ID" fcurr_size "ID"\n", fsize, fcurr_size)) ;
DEBUGm2 ((" maxfrsize "ID" fnr_curr "ID" fnc_curr "ID"\n", maxfrsize,
Work->fnr_curr, Work->fnc_curr)) ;
if (fsize >= maxfrsize && !overflow)
{
/* max working array is small, allocate all of it */
fnr2 = fnrows_max + nb ;
fnc2 = fncols_max + nb ;
fsize = maxfrsize ;
DEBUGm1 ((" sufficient for ("ID"+"ID")-by-("ID"+"ID")\n",
fnrows_max, nb, fncols_max, nb)) ;
}
else
{
/* allocate a smaller working array */
if (fnrows_max <= fncols_max)
{
fnr2 = (Int) sqrt ((double) fsize) ;
/* make sure fnr2 is odd */
fnr2 = MAX (fnr2, 1) ;
if (fnr2 % 2 == 0) fnr2++ ;
fnr2 = MIN (fnr2, fnrows_max + nb) ;
fnc2 = fsize / fnr2 ;
}
else
{
fnc2 = (Int) sqrt ((double) fsize) ;
fnc2 = MIN (fnc2, fncols_max + nb) ;
fnr2 = fsize / fnc2 ;
/* make sure fnr2 is odd */
fnr2 = MAX (fnr2, 1) ;
if (fnr2 % 2 == 0)
{
fnr2++ ;
fnc2 = fsize / fnr2 ;
}
}
DEBUGm1 ((" smaller "ID"-by-"ID"\n", fnr2, fnc2)) ;
}
fnr2 = MIN (fnr2, fnrows_max + nb) ;
fnc2 = MIN (fnc2, fncols_max + nb) ;
ASSERT (fnr2 % 2 == 1) ;
ASSERT (fnr2 * fnc2 <= fsize) ;
fnr2 -= nb ;
fnc2 -= nb ;
ASSERT (fnr2 >= 0) ;
ASSERT (fnc2 >= 0) ;
if (fsize > fcurr_size)
{
DEBUGm1 ((" Grow front \n")) ;
Work->do_grow = TRUE ;
if (!UMF_grow_front (Numeric, fnr2, fnc2, Work, -1))
{
/* since the minimum front size is 1-by-1, it would be nearly
* impossible to run out of memory here. */
DEBUGm4 (("out of memory: start front\n")) ;
return (FALSE) ;
}
}
else
{
/* use the existing front */
DEBUGm1 ((" existing front ok\n")) ;
Work->fnr_curr = fnr2 ;
Work->fnc_curr = fnc2 ;
Work->Flblock = Work->Flublock + nb * nb ;
Work->Fublock = Work->Flblock + nb * fnr2 ;
Work->Fcblock = Work->Fublock + nb * fnc2 ;
}
ASSERT (Work->Flblock == Work->Flublock + Work->nb*Work->nb) ;
ASSERT (Work->Fublock == Work->Flblock + Work->fnr_curr*Work->nb) ;
ASSERT (Work->Fcblock == Work->Fublock + Work->nb*Work->fnc_curr) ;
return (TRUE) ;
}
GLOBAL Int UMF_row_search
(
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic,
Int cdeg0, /* length of column in Front */
Int cdeg1, /* length of column outside Front */
const Int Pattern [ ], /* pattern of column, Pattern [0..cdeg1 -1] */
const Int Pos [ ], /* Pos [Pattern [0..cdeg1 -1]] = 0..cdeg1 -1 */
Int pivrow [2], /* pivrow [IN] and pivrow [OUT] */
Int rdeg [2], /* rdeg [IN] and rdeg [OUT] */
Int W_i [ ], /* pattern of pivrow [IN], */
/* either Fcols or Woi */
Int W_o [ ], /* pattern of pivrow [OUT], */
/* either Wio or Woo */
Int prior_pivrow [2], /* the two other rows just scanned, if any */
const Entry Wxy [ ], /* numerical values Wxy [0..cdeg1-1],
either Wx or Wy */
Int pivcol, /* the candidate column being searched */
Int freebie [ ]
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double maxval, toler, toler2, value, pivot [2] ;
Int i, row, deg, col, *Frpos, fnrows, *E, j, ncols, *Cols, *Rows,
e, f, Wrpflag, *Fcpos, fncols, tpi, max_rdeg, nans_in_col, was_offdiag,
diag_row, prefer_diagonal, *Wrp, found, *Diagonal_map ;
Tuple *tp, *tpend, *tp1, *tp2 ;
Unit *Memory, *p ;
Element *ep ;
Int *Row_tuples, *Row_degree, *Row_tlen ;
#ifndef NDEBUG
Int *Col_degree ;
DEBUG2 (("Row_search:\n")) ;
for (i = 0 ; i < cdeg1 ; i++)
{
row = Pattern [i] ;
DEBUG4 ((" row: "ID"\n", row)) ;
ASSERT (row >= 0 && row < Numeric->n_row) ;
ASSERT (i == Pos [row]) ;
}
/* If row is not in Pattern [0..cdeg1-1], then Pos [row] == EMPTY */
if (UMF_debug > 0 || Numeric->n_row < 1000)
{
Int cnt = cdeg1 ;
DEBUG4 (("Scan all rows:\n")) ;
for (row = 0 ; row < Numeric->n_row ; row++)
{
if (Pos [row] < 0)
{
cnt++ ;
}
else
{
DEBUG4 ((" row: "ID" pos "ID"\n", row, Pos [row])) ;
}
}
ASSERT (cnt == Numeric->n_row) ;
}
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro only */
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
ASSERT (NON_PIVOTAL_COL (pivcol)) ;
#endif
pivot [IN] = 0. ;
pivot [OUT] = 0. ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
Row_degree = Numeric->Rperm ;
Row_tuples = Numeric->Uip ;
Row_tlen = Numeric->Uilen ;
Wrp = Work->Wrp ;
Frpos = Work->Frpos ;
E = Work->E ;
Memory = Numeric->Memory ;
fnrows = Work->fnrows ;
prefer_diagonal = Symbolic->prefer_diagonal ;
Diagonal_map = Work->Diagonal_map ;
if (Diagonal_map)
{
diag_row = Diagonal_map [pivcol] ;
was_offdiag = diag_row < 0 ;
if (was_offdiag)
{
/* the "diagonal" entry in this column was permuted here by an
* earlier pivot choice. The tighter off-diagonal tolerance will
* be used instead of the symmetric tolerance. */
diag_row = FLIP (diag_row) ;
}
ASSERT (diag_row >= 0 && diag_row < Numeric->n_row) ;
}
else
{
diag_row = EMPTY ; /* unused */
was_offdiag = EMPTY ; /* unused */
}
/* pivot row degree cannot exceed max_rdeg */
max_rdeg = Work->fncols_max ;
/* ---------------------------------------------------------------------- */
/* scan pivot column for candidate rows */
/* ---------------------------------------------------------------------- */
maxval = 0.0 ;
nans_in_col = FALSE ;
for (i = 0 ; i < cdeg1 ; i++)
{
APPROX_ABS (value, Wxy [i]) ;
if (SCALAR_IS_NAN (value))
{
nans_in_col = TRUE ;
maxval = value ;
break ;
}
/* This test can now ignore the NaN case: */
maxval = MAX (maxval, value) ;
}
/* if maxval is zero, the matrix is numerically singular */
toler = Numeric->relpt * maxval ;
toler2 = Numeric->relpt2 * maxval ;
toler2 = was_offdiag ? toler : toler2 ;
DEBUG5 (("Row_search begins [ maxval %g toler %g %g\n",
maxval, toler, toler2)) ;
if (SCALAR_IS_NAN (toler) || SCALAR_IS_NAN (toler2))
{
nans_in_col = TRUE ;
}
if (!nans_in_col)
{
/* look for the diagonal entry, if it exists */
found = FALSE ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (prefer_diagonal)
{
ASSERT (diag_row != EMPTY) ;
i = Pos [diag_row] ;
if (i >= 0)
{
double a ;
ASSERT (i < cdeg1) ;
ASSERT (diag_row == Pattern [i]) ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler2)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler2)
{
/* found it! */
DEBUG3 (("Symmetric pivot: "ID" "ID"\n", pivcol, diag_row));
found = TRUE ;
if (Frpos [diag_row] >= 0 && Frpos [diag_row] < fnrows)
{
pivrow [IN] = diag_row ;
pivrow [OUT] = EMPTY ;
}
else
{
pivrow [IN] = EMPTY ;
pivrow [OUT] = diag_row ;
}
}
}
}
/* either no diagonal found, or we didn't look for it */
if (!found)
{
if (cdeg0 > 0)
{
/* this is a column in the front */
for (i = 0 ; i < cdeg0 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
ASSERT (Frpos [row] >= 0 && Frpos [row] < fnrows) ;
ASSERT (Frpos [row] == i) ;
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN]
/* break ties by picking the largest entry: */
|| (deg == rdeg [IN] && a > pivot [IN])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [IN] && row == diag_row) */
)
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
pivot [IN] = a ;
}
}
}
for ( ; i < cdeg1 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
ASSERT (Frpos [row] == i) ;
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT]
/* break ties by picking the largest entry: */
|| (deg == rdeg [OUT] && a > pivot [OUT])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [OUT] && row == diag_row) */
)
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
pivot [OUT] = a ;
}
}
}
}
else
{
/* this column is not in the front */
for (i = 0 ; i < cdeg1 ; i++)
{
double a ;
APPROX_ABS (a, Wxy [i]) ;
ASSERT (!SCALAR_IS_NAN (a)) ;
ASSERT (!SCALAR_IS_NAN (toler)) ;
if (SCALAR_IS_NONZERO (a) && a >= toler)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
#ifndef NDEBUG
DEBUG6 ((ID" candidate row "ID" deg "ID" absval %g\n",
i, row, deg, a)) ;
UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ;
#endif
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN]
/* break ties by picking the largest entry: */
|| (deg == rdeg [IN] && a > pivot [IN])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg [IN] && row == diag_row) */
)
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
pivot [IN] = a ;
}
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT]
/* break ties by picking the largest entry: */
|| (deg == rdeg[OUT] && a > pivot [OUT])
/* break ties by picking the diagonal entry: */
/* || (deg == rdeg[OUT] && row == diag_row) */
)
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
pivot [OUT] = a ;
}
}
}
}
}
}
}
/* ---------------------------------------------------------------------- */
/* NaN handling */
/* ---------------------------------------------------------------------- */
/* if cdeg1 > 0 then we must have found a pivot row ... unless NaN's */
/* exist. Try with no numerical tests if no pivot found. */
if (cdeg1 > 0 && pivrow [IN] == EMPTY && pivrow [OUT] == EMPTY)
{
/* cleanup for the NaN case */
DEBUG0 (("Found a NaN in pivot column!\n")) ;
/* grab the first entry in the pivot column, ignoring degree, */
/* numerical stability, and symmetric preference */
row = Pattern [0] ;
deg = Row_degree [row] ;
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
pivrow [IN] = row ;
rdeg [IN] = deg ;
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
}
/* We are now guaranteed to have a pivot, no matter how broken */
/* (non-IEEE compliant) the underlying numerical operators are. */
/* This is particularly a problem for Microsoft compilers (they do */
/* not handle NaN's properly). Now try to find a sparser pivot, if */
/* possible. */
for (i = 1 ; i < cdeg1 ; i++)
{
row = Pattern [i] ;
deg = Row_degree [row] ;
if (Frpos [row] >= 0 && Frpos [row] < fnrows)
{
/* row is in the current front */
DEBUG4 ((" in front\n")) ;
if (deg < rdeg [IN] || (deg == rdeg [IN] && row == diag_row))
{
/* best row in front, so far */
pivrow [IN] = row ;
rdeg [IN] = deg ;
}
}
else
{
/* row is not in the current front */
DEBUG4 ((" NOT in front\n")) ;
if (deg < rdeg [OUT] || (deg == rdeg [OUT] && row == diag_row))
{
/* best row not in front, so far */
pivrow [OUT] = row ;
rdeg [OUT] = deg ;
}
}
}
}
/* We found a pivot if there are entries (even zero ones) in pivot col */
ASSERT (IMPLIES (cdeg1 > 0, pivrow[IN] != EMPTY || pivrow[OUT] != EMPTY)) ;
/* If there are no entries in the pivot column, then no pivot is found */
ASSERT (IMPLIES (cdeg1 == 0, pivrow[IN] == EMPTY && pivrow[OUT] == EMPTY)) ;
/* ---------------------------------------------------------------------- */
/* check for singular matrix */
/* ---------------------------------------------------------------------- */
if (cdeg1 == 0)
{
if (fnrows > 0)
{
/*
Get the pivrow [OUT][IN] from the current front.
The frontal matrix looks like this:
pivcol[OUT]
|
v
x x x x 0 <- so grab this row as the pivrow [OUT][IN].
x x x x 0
x x x x 0
0 0 0 0 0
The current frontal matrix has some rows in it. The degree
of the pivcol[OUT] is zero. The column is empty, and the
current front does not contribute to it.
*/
pivrow [IN] = Work->Frows [0] ;
DEBUGm4 (("Got zero pivrow[OUT][IN] "ID" from current front\n",
pivrow [IN])) ;
}
else
{
/*
Get a pivot row from the row-merge tree, use as
pivrow [OUT][OUT]. pivrow [IN] remains EMPTY.
This can only happen if the current front is 0-by-0.
*/
Int *Front_leftmostdesc, *Front_1strow, *Front_new1strow, row1,
row2, fleftmost, nfr, n_row, frontid ;
ASSERT (Work->fncols == 0) ;
Front_leftmostdesc = Symbolic->Front_leftmostdesc ;
Front_1strow = Symbolic->Front_1strow ;
Front_new1strow = Work->Front_new1strow ;
nfr = Symbolic->nfr ;
n_row = Numeric->n_row ;
frontid = Work->frontid ;
DEBUGm4 (("Note: pivcol: "ID" is empty front "ID"\n",
pivcol, frontid)) ;
#ifndef NDEBUG
DEBUG1 (("Calling dump rowmerge\n")) ;
UMF_dump_rowmerge (Numeric, Symbolic, Work) ;
#endif
/* Row-merge set is the non-pivotal rows in the range */
/* Front_new1strow [Front_leftmostdesc [frontid]] to */
/* Front_1strow [frontid+1] - 1. */
/* If this is empty, then use the empty rows, in the range */
/* Front_new1strow [nfr] to n_row-1. */
/* If this too is empty, then pivrow [OUT] will be empty. */
/* In both cases, update Front_new1strow [...]. */
fleftmost = Front_leftmostdesc [frontid] ;
row1 = Front_new1strow [fleftmost] ;
row2 = Front_1strow [frontid+1] - 1 ;
DEBUG1 (("Leftmost: "ID" Rows ["ID" to "ID"] srch ["ID" to "ID"]\n",
fleftmost, Front_1strow [frontid], row2, row1, row2)) ;
/* look in the range row1 ... row2 */
for (row = row1 ; row <= row2 ; row++)
{
DEBUG3 ((" Row: "ID"\n", row)) ;
if (NON_PIVOTAL_ROW (row))
{
/* found it */
DEBUG3 ((" Row: "ID" found\n", row)) ;
ASSERT (Frpos [row] == EMPTY) ;
pivrow [OUT] = row ;
DEBUGm4 (("got row merge pivrow %d\n", pivrow [OUT])) ;
break ;
}
}
Front_new1strow [fleftmost] = row ;
if (pivrow [OUT] == EMPTY)
{
/* not found, look in empty row set in "dummy" front */
row1 = Front_new1strow [nfr] ;
row2 = n_row-1 ;
DEBUG3 (("Empty: "ID" Rows ["ID" to "ID"] srch["ID" to "ID"]\n",
nfr, Front_1strow [nfr], row2, row1, row2)) ;
/* look in the range row1 ... row2 */
for (row = row1 ; row <= row2 ; row++)
{
DEBUG3 ((" Empty Row: "ID"\n", row)) ;
if (NON_PIVOTAL_ROW (row))
{
/* found it */
DEBUG3 ((" Empty Row: "ID" found\n", row)) ;
ASSERT (Frpos [row] == EMPTY) ;
pivrow [OUT] = row ;
DEBUGm4 (("got dummy row pivrow %d\n", pivrow [OUT])) ;
break ;
}
}
Front_new1strow [nfr] = row ;
}
if (pivrow [OUT] == EMPTY)
{
/* Row-merge set is empty. We can just discard */
/* the candidate pivot column. */
DEBUG0 (("Note: row-merge set empty\n")) ;
DEBUGm4 (("got no pivrow \n")) ;
return (UMFPACK_WARNING_singular_matrix) ;
}
}
}
/* ---------------------------------------------------------------------- */
/* construct the candidate row in the front, if any */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
/* check Wrp */
ASSERT (Work->Wrpflag > 0) ;
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
#ifndef NDEBUG
DEBUG4 (("pivrow [IN]: "ID"\n", pivrow [IN])) ;
UMF_dump_rowcol (0, Numeric, Work, pivrow [IN], TRUE) ;
#endif
if (pivrow [IN] != EMPTY)
{
/* the row merge candidate row is not pivrow [IN] */
freebie [IN] = (pivrow [IN] == prior_pivrow [IN]) && (cdeg1 > 0) ;
ASSERT (cdeg1 >= 0) ;
if (!freebie [IN])
{
/* include current front in the degree of this row */
Fcpos = Work->Fcpos ;
fncols = Work->fncols ;
Wrpflag = Work->Wrpflag ;
/* -------------------------------------------------------------- */
/* construct the pattern of the IN row */
/* -------------------------------------------------------------- */
#ifndef NDEBUG
/* check Fcols */
DEBUG5 (("ROW ASSEMBLE: rdeg "ID"\nREDUCE ROW "ID"\n",
fncols, pivrow [IN])) ;
for (j = 0 ; j < fncols ; j++)
{
col = Work->Fcols [j] ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (Fcpos [col] >= 0) ;
}
if (UMF_debug > 0 || Work->n_col < 1000)
{
Int cnt = fncols ;
for (col = 0 ; col < Work->n_col ; col++)
{
if (Fcpos [col] < 0) cnt++ ;
}
ASSERT (cnt == Work->n_col) ;
}
#endif
rdeg [IN] = fncols ;
ASSERT (pivrow [IN] >= 0 && pivrow [IN] < Work->n_row) ;
ASSERT (NON_PIVOTAL_ROW (pivrow [IN])) ;
/* add the pivot column itself */
ASSERT (Wrp [pivcol] != Wrpflag) ;
if (Fcpos [pivcol] < 0)
{
DEBUG3 (("Adding pivot col to pivrow [IN] pattern\n")) ;
if (rdeg [IN] >= max_rdeg)
{
/* :: pattern change (in) :: */
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [pivcol] = Wrpflag ;
W_i [rdeg [IN]++] = pivcol ;
}
tpi = Row_tuples [pivrow [IN]] ;
if (tpi)
{
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [pivrow [IN]] ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
if (Rows [f] == EMPTY)
{
continue ; /* row already assembled */
}
ASSERT (pivrow [IN] == Rows [f]) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= EMPTY && col < Work->n_col) ;
if ((col >= 0) && (Wrp [col] != Wrpflag)
&& Fcpos [col] <0)
{
ASSERT (NON_PIVOTAL_COL (col)) ;
if (rdeg [IN] >= max_rdeg)
{
/* :: pattern change (rdeg in failure) :: */
DEBUGm4 (("rdeg [IN] >= max_rdeg failure\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [col] = Wrpflag ;
W_i [rdeg [IN]++] = col ;
}
}
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [pivrow [IN]] = tp2 - tp1 ;
}
#ifndef NDEBUG
DEBUG4 (("Reduced IN row:\n")) ;
for (j = 0 ; j < fncols ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n",
j, Work->Fcols [j], Fcpos [Work->Fcols [j]])) ;
ASSERT (Fcpos [Work->Fcols [j]] >= 0) ;
}
for (j = fncols ; j < rdeg [IN] ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n", j, W_i [j], Wrp [W_i [j]]));
ASSERT (W_i [j] >= 0 && W_i [j] < Work->n_col) ;
ASSERT (Wrp [W_i [j]] == Wrpflag) ;
}
/* mark the end of the pattern in case we scan it by mistake */
/* Note that this means W_i must be of size >= fncols_max + 1 */
W_i [rdeg [IN]] = EMPTY ;
#endif
/* rdeg [IN] is now the exact degree of the IN row */
/* clear Work->Wrp. */
Work->Wrpflag++ ;
/* All Wrp [0..n_col] is now < Wrpflag */
}
}
#ifndef NDEBUG
/* check Wrp */
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
/* ---------------------------------------------------------------------- */
/* construct the candidate row not in the front, if any */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
DEBUG4 (("pivrow [OUT]: "ID"\n", pivrow [OUT])) ;
UMF_dump_rowcol (0, Numeric, Work, pivrow [OUT], TRUE) ;
#endif
/* If this is a candidate row from the row merge set, force it to be */
/* scanned (ignore prior_pivrow [OUT]). */
if (pivrow [OUT] != EMPTY)
{
freebie [OUT] = (pivrow [OUT] == prior_pivrow [OUT]) && cdeg1 > 0 ;
ASSERT (cdeg1 >= 0) ;
if (!freebie [OUT])
{
Wrpflag = Work->Wrpflag ;
/* -------------------------------------------------------------- */
/* construct the pattern of the row */
/* -------------------------------------------------------------- */
rdeg [OUT] = 0 ;
ASSERT (pivrow [OUT] >= 0 && pivrow [OUT] < Work->n_row) ;
ASSERT (NON_PIVOTAL_ROW (pivrow [OUT])) ;
/* add the pivot column itself */
ASSERT (Wrp [pivcol] != Wrpflag) ;
DEBUG3 (("Adding pivot col to pivrow [OUT] pattern\n")) ;
if (rdeg [OUT] >= max_rdeg)
{
/* :: pattern change (out) :: */
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [pivcol] = Wrpflag ;
W_o [rdeg [OUT]++] = pivcol ;
tpi = Row_tuples [pivrow [OUT]] ;
if (tpi)
{
tp = (Tuple *) (Memory + tpi) ;
tp1 = tp ;
tp2 = tp ;
tpend = tp + Row_tlen [pivrow [OUT]] ;
for ( ; tp < tpend ; tp++)
{
e = tp->e ;
ASSERT (e > 0 && e <= Work->nel) ;
if (!E [e])
{
continue ; /* element already deallocated */
}
f = tp->f ;
p = Memory + E [e] ;
ep = (Element *) p ;
p += UNITS (Element, 1) ;
Cols = (Int *) p ;
ncols = ep->ncols ;
Rows = Cols + ncols ;
if (Rows [f] == EMPTY)
{
continue ; /* row already assembled */
}
ASSERT (pivrow [OUT] == Rows [f]) ;
for (j = 0 ; j < ncols ; j++)
{
col = Cols [j] ;
ASSERT (col >= EMPTY && col < Work->n_col) ;
if ((col >= 0) && (Wrp [col] != Wrpflag))
{
ASSERT (NON_PIVOTAL_COL (col)) ;
if (rdeg [OUT] >= max_rdeg)
{
/* :: pattern change (rdeg out failure) :: */
DEBUGm4 (("rdeg [OUT] failure\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
Wrp [col] = Wrpflag ;
W_o [rdeg [OUT]++] = col ;
}
}
*tp2++ = *tp ; /* leave the tuple in the list */
}
Row_tlen [pivrow [OUT]] = tp2 - tp1 ;
}
#ifndef NDEBUG
DEBUG4 (("Reduced row OUT:\n")) ;
for (j = 0 ; j < rdeg [OUT] ; j++)
{
DEBUG6 ((" "ID" "ID" "ID"\n", j, W_o [j], Wrp [W_o [j]])) ;
ASSERT (W_o [j] >= 0 && W_o [j] < Work->n_col) ;
ASSERT (Wrp [W_o [j]] == Wrpflag) ;
}
/* mark the end of the pattern in case we scan it by mistake */
/* Note that this means W_o must be of size >= fncols_max + 1 */
W_o [rdeg [OUT]] = EMPTY ;
#endif
/* rdeg [OUT] is now the exact degree of the row */
/* clear Work->Wrp. */
Work->Wrpflag++ ;
/* All Wrp [0..n] is now < Wrpflag */
}
}
DEBUG5 (("Row_search end ] \n")) ;
#ifndef NDEBUG
/* check Wrp */
if (UMF_debug > 0 || Work->n_col < 1000)
{
for (i = 0 ; i < Work->n_col ; i++)
{
ASSERT (Wrp [i] < Work->Wrpflag) ;
}
}
#endif
return (UMFPACK_OK) ;
}
GLOBAL void UMF_set_stats
(
double Info [ ],
SymbolicType *Symbolic,
double max_usage, /* peak size of Numeric->Memory, in Units */
double num_mem_size, /* final size of Numeric->Memory, in Units */
double flops, /* "true flops" */
double lnz, /* nz in L */
double unz, /* nz in U */
double maxfrsize, /* largest front size */
double ulen, /* size of Numeric->Upattern */
double npiv, /* number of pivots found */
double maxnrows, /* largest #rows in front */
double maxncols, /* largest #cols in front */
Int scale, /* true if scaling the rows of A */
Int prefer_diagonal, /* true if diagonal pivoting (only square A) */
Int what /* ESTIMATE or ACTUAL */
)
{
double sym_size, work_usage, nn, n_row, n_col, n_inner, num_On_size1,
num_On_size2, num_usage, sym_maxncols, sym_maxnrows, elen, n1 ;
n_col = Symbolic->n_col ;
n_row = Symbolic->n_row ;
n1 = Symbolic->n1 ;
nn = MAX (n_row, n_col) ;
n_inner = MIN (n_row, n_col) ;
sym_maxncols = MIN (Symbolic->maxncols + Symbolic->nb, n_col) ;
sym_maxnrows = MIN (Symbolic->maxnrows + Symbolic->nb, n_row) ;
elen = (n_col - n1) + (n_row - n1) + MIN (n_col - n1, n_row - n1) + 1 ;
/* final Symbolic object size */
sym_size = UMF_symbolic_usage (Symbolic->n_row, Symbolic->n_col,
Symbolic->nchains, Symbolic->nfr, Symbolic->esize, prefer_diagonal) ;
/* size of O(n) part of Numeric object during factorization, */
/* except Numeric->Memory and Numeric->Upattern */
num_On_size1 =
DUNITS (NumericType, 1) /* Numeric structure */
+ DUNITS (Entry, n_inner+1) /* D */
+ 4 * DUNITS (Int, n_row+1) /* Rperm, Lpos, Uilen, Uip */
+ 4 * DUNITS (Int, n_col+1) /* Cperm, Upos, Lilen, Lip */
+ (scale ? DUNITS (Entry, n_row) : 0) ; /* Rs, row scale factors */
/* size of O(n) part of Numeric object after factorization, */
/* except Numeric->Memory and Numeric->Upattern */
num_On_size2 =
DUNITS (NumericType, 1) /* Numeric structure */
+ DUNITS (Entry, n_inner+1) /* D */
+ DUNITS (Int, n_row+1) /* Rperm */
+ DUNITS (Int, n_col+1) /* Cperm */
+ 6 * DUNITS (Int, npiv+1) /* Lpos, Uilen, Uip, Upos, Lilen, Lip */
+ (scale ? DUNITS (Entry, n_row) : 0) ; /* Rs, row scale factors */
DEBUG1 (("num O(n) size2: %g\n", num_On_size2)) ;
/* peak size of Numeric->Memory, including LU factors, current frontal
* matrix, elements, and tuple lists. */
Info [UMFPACK_VARIABLE_PEAK + what] = max_usage ;
/* final size of Numeric->Memory (LU factors only) */
Info [UMFPACK_VARIABLE_FINAL + what] = num_mem_size ;
/* final size of Numeric object, including Numeric->Memory and ->Upattern */
Info [UMFPACK_NUMERIC_SIZE + what] =
num_On_size2
+ num_mem_size /* final Numeric->Memory size */
+ DUNITS (Int, ulen+1) ;/* Numeric->Upattern (from Work->Upattern) */
DEBUG1 (("num mem size: %g\n", num_mem_size)) ;
DEBUG1 (("ulen units %g\n", DUNITS (Int, ulen))) ;
DEBUG1 (("numeric size %g\n", Info [UMFPACK_NUMERIC_SIZE + what])) ;
/* largest front size (working array size, or actual size used) */
Info [UMFPACK_MAX_FRONT_SIZE + what] = maxfrsize ;
Info [UMFPACK_MAX_FRONT_NROWS + what] = maxnrows ;
Info [UMFPACK_MAX_FRONT_NCOLS + what] = maxncols ;
DEBUGm4 (("maxnrows %g maxncols %g\n", maxnrows, maxncols)) ;
DEBUGm4 (("maxfrsize %g\n", maxfrsize)) ;
/* UMF_kernel usage, from work_alloc routine in umf_kernel.c */
work_usage =
/* Work-> arrays, except for current frontal matrix which is allocated
* inside Numeric->Memory. */
2 * DUNITS (Entry, sym_maxnrows + 1) /* Wx, Wy */
+ 2 * DUNITS (Int, n_row+1) /* Frpos, Lpattern */
+ 2 * DUNITS (Int, n_col+1) /* Fcpos, Upattern */
+ DUNITS (Int, nn + 1) /* Wp */
+ DUNITS (Int, MAX (n_col, sym_maxnrows) + 1) /* Wrp */
+ 2 * DUNITS (Int, sym_maxnrows + 1) /* Frows, Wm */
+ 3 * DUNITS (Int, sym_maxncols + 1) /* Fcols, Wio, Woi */
+ DUNITS (Int, MAX (sym_maxnrows, sym_maxncols) + 1) /* Woo */
+ DUNITS (Int, elen) /* E */
+ DUNITS (Int, Symbolic->nfr + 1) /* Front_new1strow */
+ ((n_row == n_col) ? (2 * DUNITS (Int, nn)) : 0) ; /* Diag map,imap */
/* Peak memory for just UMFPACK_numeric. */
num_usage =
sym_size /* size of Symbolic object */
+ num_On_size1 /* O(n) part of Numeric object (excl. Upattern) */
+ work_usage /* Work-> arrays (including Upattern) */
+ max_usage ; /* peak size of Numeric->Memory */
/* peak memory usage for both UMFPACK_*symbolic and UMFPACK_numeric. */
Info [UMFPACK_PEAK_MEMORY + what] =
MAX (Symbolic->peak_sym_usage, num_usage) ;
Info [UMFPACK_FLOPS + what] = flops ;
Info [UMFPACK_LNZ + what] = lnz ;
Info [UMFPACK_UNZ + what] = unz ;
}
GLOBAL Int UMF_kernel
(
const Int Ap [ ],
const Int Ai [ ],
const double Ax [ ],
#ifdef COMPLEX
const double Az [ ],
#endif
NumericType *Numeric,
WorkType *Work,
SymbolicType *Symbolic
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int j, f1, f2, chain, nchains, *Chain_start, status, fixQ, evaporate,
*Front_npivcol, jmax, nb, drop ;
/* ---------------------------------------------------------------------- */
/* initialize memory space and load the matrix. Optionally scale. */
/* ---------------------------------------------------------------------- */
if (!UMF_kernel_init (Ap, Ai, Ax,
#ifdef COMPLEX
Az,
#endif
Numeric, Work, Symbolic))
{
/* UMF_kernel_init is guaranteed to succeed, since UMFPACK_numeric */
/* either allocates enough space or if not, UMF_kernel does not get */
/* called. So running out of memory here is a fatal error, and means */
/* that the user changed Ap and/or Ai since the call to */
/* UMFPACK_*symbolic. */
DEBUGm4 (("kernel init failed\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
/* ---------------------------------------------------------------------- */
/* get the symbolic factorization */
/* ---------------------------------------------------------------------- */
nchains = Symbolic->nchains ;
Chain_start = Symbolic->Chain_start ;
Front_npivcol = Symbolic->Front_npivcol ;
nb = Symbolic->nb ;
fixQ = Symbolic->fixQ ;
drop = Numeric->droptol > 0.0 ;
#ifndef NDEBUG
for (chain = 0 ; chain < nchains ; chain++)
{
Int i ;
f1 = Chain_start [chain] ;
f2 = Chain_start [chain+1] - 1 ;
DEBUG1 (("\nCHain: "ID" start "ID" end "ID"\n", chain, f1, f2)) ;
for (i = f1 ; i <= f2 ; i++)
{
DEBUG1 (("Front "ID", npivcol "ID"\n", i, Front_npivcol [i])) ;
}
}
#endif
/* ---------------------------------------------------------------------- */
/* factorize each chain of frontal matrices */
/* ---------------------------------------------------------------------- */
for (chain = 0 ; chain < nchains ; chain++)
{
f1 = Chain_start [chain] ;
f2 = Chain_start [chain+1] - 1 ;
/* ------------------------------------------------------------------ */
/* get the initial frontal matrix size for this chain */
/* ------------------------------------------------------------------ */
DO (UMF_start_front (chain, Numeric, Work, Symbolic)) ;
/* ------------------------------------------------------------------ */
/* factorize each front in the chain */
/* ------------------------------------------------------------------ */
for (Work->frontid = f1 ; Work->frontid <= f2 ; Work->frontid++)
{
/* -------------------------------------------------------------- */
/* Initialize the pivot column candidate set */
/* -------------------------------------------------------------- */
Work->ncand = Front_npivcol [Work->frontid] ;
Work->lo = Work->nextcand ;
Work->hi = Work->nextcand + Work->ncand - 1 ;
jmax = MIN (MAX_CANDIDATES, Work->ncand) ;
DEBUGm1 ((">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Starting front "
ID", npivcol: "ID"\n", Work->frontid, Work->ncand)) ;
if (fixQ)
{
/* do not modify the column order */
jmax = 1 ;
}
DEBUGm1 (("Initial candidates: ")) ;
for (j = 0 ; j < jmax ; j++)
{
DEBUGm1 ((" "ID, Work->nextcand)) ;
ASSERT (Work->nextcand <= Work->hi) ;
Work->Candidates [j] = Work->nextcand++ ;
}
Work->nCandidates = jmax ;
DEBUGm1 (("\n")) ;
/* -------------------------------------------------------------- */
/* Assemble and factorize the current frontal matrix */
/* -------------------------------------------------------------- */
while (Work->ncand > 0)
{
/* ---------------------------------------------------------- */
/* get the pivot row and column */
/* ---------------------------------------------------------- */
status = UMF_local_search (Numeric, Work, Symbolic) ;
if (status == UMFPACK_ERROR_different_pattern)
{
/* :: pattern change detected in umf_local_search :: */
/* input matrix has changed since umfpack_*symbolic */
DEBUGm4 (("local search failed\n")) ;
return (UMFPACK_ERROR_different_pattern) ;
}
if (status == UMFPACK_WARNING_singular_matrix)
{
/* no pivot found, discard and try again */
continue ;
}
/* ---------------------------------------------------------- */
/* update if front not extended or too many zeros in L,U */
/* ---------------------------------------------------------- */
if (Work->do_update)
{
UMF_blas3_update (Work) ;
if (drop)
{
DO (UMF_store_lu_drop (Numeric, Work)) ;
}
else
{
DO (UMF_store_lu (Numeric, Work)) ;
}
}
/* ---------------------------------------------------------- */
/* extend the frontal matrix, or start a new one */
/* ---------------------------------------------------------- */
if (Work->do_extend)
{
/* extend the current front */
DO (UMF_extend_front (Numeric, Work)) ;
}
else
{
/* finish the current front (if any) and start a new one */
DO (UMF_create_element (Numeric, Work, Symbolic)) ;
DO (UMF_init_front (Numeric, Work)) ;
}
/* ---------------------------------------------------------- */
/* Numerical & symbolic assembly into current frontal matrix */
/* ---------------------------------------------------------- */
if (fixQ)
{
UMF_assemble_fixq (Numeric, Work) ;
}
else
{
UMF_assemble (Numeric, Work) ;
}
/* ---------------------------------------------------------- */
/* scale the pivot column */
/* ---------------------------------------------------------- */
UMF_scale_column (Numeric, Work) ;
/* ---------------------------------------------------------- */
/* Numerical update if enough pivots accumulated */
/* ---------------------------------------------------------- */
evaporate = Work->fnrows == 0 || Work->fncols == 0 ;
if (Work->fnpiv >= nb || evaporate)
{
UMF_blas3_update (Work) ;
if (drop)
{
DO (UMF_store_lu_drop (Numeric, Work)) ;
}
else
{
DO (UMF_store_lu (Numeric, Work)) ;
}
}
Work->pivrow_in_front = FALSE ;
Work->pivcol_in_front = FALSE ;
/* ---------------------------------------------------------- */
/* If front is empty, evaporate it */
/* ---------------------------------------------------------- */
if (evaporate)
{
/* This does not create an element, just evaporates it.
* It ensures that a front is not 0-by-c or r-by-0. No
* memory is allocated, so it is guaranteed to succeed. */
(void) UMF_create_element (Numeric, Work, Symbolic) ;
Work->fnrows = 0 ;
Work->fncols = 0 ;
}
}
}
/* ------------------------------------------------------------------
* Wrapup the current frontal matrix. This is the last in a chain
* in the column elimination tree. The next frontal matrix
* cannot overlap with the current one, which will be its sibling
* in the column etree.
* ------------------------------------------------------------------ */
UMF_blas3_update (Work) ;
if (drop)
{
DO (UMF_store_lu_drop (Numeric, Work)) ;
}
else
{
DO (UMF_store_lu (Numeric, Work)) ;
}
Work->fnrows_new = Work->fnrows ;
Work->fncols_new = Work->fncols ;
DO (UMF_create_element (Numeric, Work, Symbolic)) ;
/* ------------------------------------------------------------------ */
/* current front is now empty */
/* ------------------------------------------------------------------ */
Work->fnrows = 0 ;
Work->fncols = 0 ;
}
/* ---------------------------------------------------------------------- */
/* end the last Lchain and Uchain and finalize the LU factors */
/* ---------------------------------------------------------------------- */
UMF_kernel_wrapup (Numeric, Symbolic, Work) ;
/* note that the matrix may be singular (this is OK) */
return (UMFPACK_OK) ;
}
GLOBAL Int UMFPACK_get_numeric
(
Int Lp [ ],
Int Lj [ ],
double Lx [ ],
#ifdef COMPLEX
double Lz [ ],
#endif
Int Up [ ],
Int Ui [ ],
double Ux [ ],
#ifdef COMPLEX
double Uz [ ],
#endif
Int P [ ],
Int Q [ ],
double Dx [ ],
#ifdef COMPLEX
double Dz [ ],
#endif
Int *p_do_recip,
double Rs [ ],
void *NumericHandle
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
NumericType *Numeric ;
Int getL, getU, *Rperm, *Cperm, k, nn, n_row, n_col, *Wi, *Pattern,
n_inner ;
double *Rs1 ;
Entry *D ;
#ifndef NDEBUG
init_count = UMF_malloc_count ;
#endif
Wi = (Int *) NULL ;
Pattern = (Int *) NULL ;
/* ---------------------------------------------------------------------- */
/* check input parameters */
/* ---------------------------------------------------------------------- */
Numeric = (NumericType *) NumericHandle ;
if (!UMF_valid_numeric (Numeric))
{
return (UMFPACK_ERROR_invalid_Numeric_object) ;
}
n_row = Numeric->n_row ;
n_col = Numeric->n_col ;
nn = MAX (n_row, n_col) ;
n_inner = MIN (n_row, n_col) ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
getL = Lp && Lj && Lx ;
getU = Up && Ui && Ux ;
if (getL || getU)
{
Wi = (Int *) UMF_malloc (nn, sizeof (Int)) ;
Pattern = (Int *) UMF_malloc (nn, sizeof (Int)) ;
if (!Wi || !Pattern)
{
(void) UMF_free ((void *) Wi) ;
(void) UMF_free ((void *) Pattern) ;
ASSERT (UMF_malloc_count == init_count) ;
DEBUGm4 (("out of memory: get numeric\n")) ;
return (UMFPACK_ERROR_out_of_memory) ;
}
ASSERT (UMF_malloc_count == init_count + 2) ;
}
/* ---------------------------------------------------------------------- */
/* get contents of Numeric */
/* ---------------------------------------------------------------------- */
if (P != (Int *) NULL)
{
Rperm = Numeric->Rperm ;
for (k = 0 ; k < n_row ; k++)
{
P [k] = Rperm [k] ;
}
}
if (Q != (Int *) NULL)
{
Cperm = Numeric->Cperm ;
for (k = 0 ; k < n_col ; k++)
{
Q [k] = Cperm [k] ;
}
}
if (getL)
{
get_L (Lp, Lj, Lx,
#ifdef COMPLEX
Lz,
#endif
Numeric, Pattern, Wi) ;
}
if (getU)
{
get_U (Up, Ui, Ux,
#ifdef COMPLEX
Uz,
#endif
Numeric, Pattern, Wi) ;
}
if (Dx != (double *) NULL)
{
D = Numeric->D ;
#ifdef COMPLEX
if (SPLIT (Dz))
{
for (k = 0 ; k < n_inner ; k++)
{
Dx [k] = REAL_COMPONENT (D [k]) ;
Dz [k] = IMAG_COMPONENT (D [k]) ;
}
}
else
{
for (k = 0 ; k < n_inner ; k++)
{
Dx [2*k ] = REAL_COMPONENT (D [k]) ;
Dx [2*k+1] = IMAG_COMPONENT (D [k]) ;
}
}
#else
{
D = Numeric->D ;
for (k = 0 ; k < n_inner ; k++)
{
Dx [k] = D [k] ;
}
}
#endif
}
/* return the flag stating whether the scale factors are to be multiplied,
* or divided. If do_recip is TRUE, multiply. Otherwise, divided.
* If NRECIPROCAL is defined at compile time, the scale factors are always
* to be used by dividing.
*/
if (p_do_recip != (Int *) NULL)
{
#ifndef NRECIPROCAL
*p_do_recip = Numeric->do_recip ;
#else
*p_do_recip = FALSE ;
#endif
}
if (Rs != (double *) NULL)
{
Rs1 = Numeric->Rs ;
if (Rs1 == (double *) NULL)
{
/* R is the identity matrix. */
for (k = 0 ; k < n_row ; k++)
{
Rs [k] = 1.0 ;
}
}
else
{
for (k = 0 ; k < n_row ; k++)
{
Rs [k] = Rs1 [k] ;
}
}
}
/* ---------------------------------------------------------------------- */
/* free the workspace */
/* ---------------------------------------------------------------------- */
(void) UMF_free ((void *) Wi) ;
(void) UMF_free ((void *) Pattern) ;
ASSERT (UMF_malloc_count == init_count) ;
return (UMFPACK_OK) ;
}
GLOBAL Int UMFPACK_get_determinant
(
double *Mx,
#ifdef COMPLEX
double *Mz,
#endif
double *Ex,
void *NumericHandle,
double User_Info [UMFPACK_INFO]
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry d_mantissa, d_tmp ;
double d_exponent, Info2 [UMFPACK_INFO], one [2] = {1.0, 0.0}, d_sign ;
Entry *D ;
double *Info, *Rs ;
NumericType *Numeric ;
Int i, n, itmp, npiv, *Wi, *Rperm, *Cperm, do_scale ;
#ifndef NRECIPROCAL
Int do_recip ;
#endif
/* ---------------------------------------------------------------------- */
/* check input parameters */
/* ---------------------------------------------------------------------- */
if (User_Info != (double *) NULL)
{
/* return Info in user's array */
Info = User_Info ;
}
else
{
/* no Info array passed - use local one instead */
Info = Info2 ;
for (i = 0 ; i < UMFPACK_INFO ; i++)
{
Info [i] = EMPTY ;
}
}
Info [UMFPACK_STATUS] = UMFPACK_OK ;
Numeric = (NumericType *) NumericHandle ;
if (!UMF_valid_numeric (Numeric))
{
Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_Numeric_object ;
return (UMFPACK_ERROR_invalid_Numeric_object) ;
}
if (Numeric->n_row != Numeric->n_col)
{
/* only square systems can be handled */
Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_system ;
return (UMFPACK_ERROR_invalid_system) ;
}
if (Mx == (double *) NULL)
{
Info [UMFPACK_STATUS] = UMFPACK_ERROR_argument_missing ;
return (UMFPACK_ERROR_argument_missing) ;
}
n = Numeric->n_row ;
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
Wi = (Int *) UMF_malloc (n, sizeof (Int)) ;
if (!Wi)
{
DEBUGm4 (("out of memory: get determinant\n")) ;
Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ;
return (UMFPACK_ERROR_out_of_memory) ;
}
/* ---------------------------------------------------------------------- */
/* compute the determinant */
/* ---------------------------------------------------------------------- */
Rs = Numeric->Rs ; /* row scale factors */
do_scale = (Rs != (double *) NULL) ;
#ifndef NRECIPROCAL
do_recip = Numeric->do_recip ;
#endif
d_mantissa = ((Entry *) one) [0] ;
d_exponent = 0.0 ;
D = Numeric->D ;
/* compute product of diagonal entries of U */
for (i = 0 ; i < n ; i++)
{
MULT (d_tmp, d_mantissa, D [i]) ;
d_mantissa = d_tmp ;
if (!rescale_determinant (&d_mantissa, &d_exponent))
{
/* the determinant is zero or NaN */
Info [UMFPACK_STATUS] = UMFPACK_WARNING_singular_matrix ;
/* no need to compute the determinant of R */
do_scale = FALSE ;
break ;
}
}
/* compute product of diagonal entries of R (or its inverse) */
if (do_scale)
{
for (i = 0 ; i < n ; i++)
{
#ifndef NRECIPROCAL
if (do_recip)
{
/* compute determinant of R inverse */
SCALE_DIV (d_mantissa, Rs [i]) ;
}
else
#endif
{
/* compute determinant of R */
SCALE (d_mantissa, Rs [i]) ;
}
if (!rescale_determinant (&d_mantissa, &d_exponent))
{
/* the determinant is zero or NaN. This is very unlikey to
* occur here, since the scale factors for a tiny or zero row
* are set to 1. */
Info [UMFPACK_STATUS] = UMFPACK_WARNING_singular_matrix ;
break ;
}
}
}
/* ---------------------------------------------------------------------- */
/* determine if P and Q are odd or even permutations */
/* ---------------------------------------------------------------------- */
npiv = 0 ;
Rperm = Numeric->Rperm ;
for (i = 0 ; i < n ; i++)
{
Wi [i] = Rperm [i] ;
}
for (i = 0 ; i < n ; i++)
{
while (Wi [i] != i)
{
itmp = Wi [Wi [i]] ;
Wi [Wi [i]] = Wi [i] ;
Wi [i] = itmp ;
npiv++ ;
}
}
Cperm = Numeric->Cperm ;
for (i = 0 ; i < n ; i++)
{
Wi [i] = Cperm [i] ;
}
for (i = 0 ; i < n ; i++)
{
while (Wi [i] != i)
{
itmp = Wi [Wi [i]] ;
Wi [Wi [i]] = Wi [i] ;
Wi [i] = itmp ;
npiv++ ;
}
}
/* if npiv is odd, the sign is -1. if it is even, the sign is +1 */
d_sign = (npiv % 2) ? -1. : 1. ;
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
(void) UMF_free ((void *) Wi) ;
/* ---------------------------------------------------------------------- */
/* compute the magnitude and exponent of the determinant */
/* ---------------------------------------------------------------------- */
if (Ex == (double *) NULL)
{
/* Ex is not provided, so return the entire determinant in d_mantissa */
SCALE (d_mantissa, pow (10.0, d_exponent)) ;
}
else
{
Ex [0] = d_exponent ;
}
Mx [0] = d_sign * REAL_COMPONENT (d_mantissa) ;
#ifdef COMPLEX
if (SPLIT (Mz))
{
Mz [0] = d_sign * IMAG_COMPONENT (d_mantissa) ;
}
else
{
Mx [1] = d_sign * IMAG_COMPONENT (d_mantissa) ;
}
#endif
/* determine if the determinant has (or will) overflow or underflow */
if (d_exponent + 1.0 > log10 (DBL_MAX))
{
Info [UMFPACK_STATUS] = UMFPACK_WARNING_determinant_overflow ;
}
else if (d_exponent - 1.0 < log10 (DBL_MIN))
{
Info [UMFPACK_STATUS] = UMFPACK_WARNING_determinant_underflow ;
}
return (UMFPACK_OK) ;
}
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_store_lu_drop
#else
GLOBAL Int UMF_store_lu
#endif
(
NumericType *Numeric,
WorkType *Work
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry pivot_value ;
#ifdef DROP
double droptol ;
#endif
Entry *D, *Lval, *Uval, *Fl1, *Fl2, *Fu1, *Fu2,
*Flublock, *Flblock, *Fublock ;
Int i, k, fnr_curr, fnrows, fncols, row, col, pivrow, pivcol, *Frows,
*Fcols, *Lpattern, *Upattern, *Lpos, *Upos, llen, ulen, fnc_curr, fnpiv,
uilen, lnz, unz, nb, *Lilen,
*Uilen, *Lip, *Uip, *Li, *Ui, pivcol_position, newLchain, newUchain,
pivrow_position, p, size, lip, uip, lnzi, lnzx, unzx, lnz2i, lnz2x,
unz2i, unz2x, zero_pivot, *Pivrow, *Pivcol, kk,
Lnz [MAXNB] ;
#ifndef NDEBUG
Int *Col_degree, *Row_degree ;
#endif
#ifdef DROP
Int all_lnz, all_unz ;
droptol = Numeric->droptol ;
#endif
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
fnrows = Work->fnrows ;
fncols = Work->fncols ;
fnpiv = Work->fnpiv ;
Lpos = Numeric->Lpos ;
Upos = Numeric->Upos ;
Lilen = Numeric->Lilen ;
Uilen = Numeric->Uilen ;
Lip = Numeric->Lip ;
Uip = Numeric->Uip ;
D = Numeric->D ;
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
fnr_curr = Work->fnr_curr ;
fnc_curr = Work->fnc_curr ;
Frows = Work->Frows ;
Fcols = Work->Fcols ;
#ifndef NDEBUG
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */
#endif
Lpattern = Work->Lpattern ;
llen = Work->llen ;
Upattern = Work->Upattern ;
ulen = Work->ulen ;
nb = Work->nb ;
#ifndef NDEBUG
DEBUG1 (("\nSTORE LU: fnrows "ID
" fncols "ID"\n", fnrows, fncols)) ;
DEBUG2 (("\nFrontal matrix, including all space:\n"
"fnr_curr "ID" fnc_curr "ID" nb "ID"\n"
"fnrows "ID" fncols "ID" fnpiv "ID"\n",
fnr_curr, fnc_curr, nb, fnrows, fncols, fnpiv)) ;
DEBUG2 (("\nJust the active part:\n")) ;
DEBUG7 (("C block: ")) ;
UMF_dump_dense (Work->Fcblock, fnr_curr, fnrows, fncols) ;
DEBUG7 (("L block: ")) ;
UMF_dump_dense (Work->Flblock, fnr_curr, fnrows, fnpiv);
DEBUG7 (("U' block: ")) ;
UMF_dump_dense (Work->Fublock, fnc_curr, fncols, fnpiv) ;
DEBUG7 (("LU block: ")) ;
UMF_dump_dense (Work->Flublock, nb, fnpiv, fnpiv) ;
DEBUG7 (("Current frontal matrix: (prior to store LU)\n")) ;
UMF_dump_current_front (Numeric, Work, TRUE) ;
#endif
Pivrow = Work->Pivrow ;
Pivcol = Work->Pivcol ;
/* ---------------------------------------------------------------------- */
/* store the columns of L */
/* ---------------------------------------------------------------------- */
for (kk = 0 ; kk < fnpiv ; kk++)
{
/* ------------------------------------------------------------------ */
/* one more pivot row and column is being stored into L and U */
/* ------------------------------------------------------------------ */
k = Work->npiv + kk ;
/* ------------------------------------------------------------------ */
/* find the kth pivot row and pivot column */
/* ------------------------------------------------------------------ */
pivrow = Pivrow [kk] ;
pivcol = Pivcol [kk] ;
#ifndef NDEBUG
ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
DEBUGm4 ((
"\n -------------------------------------------------------------"
"Store LU: step " ID"\n", k)) ;
ASSERT (k < MIN (Work->n_row, Work->n_col)) ;
DEBUG2 (("Store column of L, k = "ID", llen "ID"\n", k, llen)) ;
for (i = 0 ; i < llen ; i++)
{
row = Lpattern [i] ;
ASSERT (row >= 0 && row < Work->n_row) ;
DEBUG2 ((" Lpattern["ID"] "ID" Lpos "ID, i, row, Lpos [row])) ;
if (row == pivrow) DEBUG2 ((" <- pivot row")) ;
DEBUG2 (("\n")) ;
ASSERT (i == Lpos [row]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* remove pivot row from L */
/* ------------------------------------------------------------------ */
/* remove pivot row index from current column of L */
/* if a new Lchain starts, then all entries are removed later */
DEBUG2 (("Removing pivrow from Lpattern, k = "ID"\n", k)) ;
ASSERT (!NON_PIVOTAL_ROW (pivrow)) ;
pivrow_position = Lpos [pivrow] ;
if (pivrow_position != EMPTY)
{
/* place the last entry in the column in the */
/* position of the pivot row index */
ASSERT (pivrow == Lpattern [pivrow_position]) ;
row = Lpattern [--llen] ;
/* ASSERT (NON_PIVOTAL_ROW (row)) ; */
Lpattern [pivrow_position] = row ;
Lpos [row] = pivrow_position ;
Lpos [pivrow] = EMPTY ;
}
/* ------------------------------------------------------------------ */
/* store the pivot value, for the diagonal matrix D */
/* ------------------------------------------------------------------ */
/* kk-th column of LU block */
Fl1 = Flublock + kk * nb ;
/* kk-th column of L in the L block */
Fl2 = Flblock + kk * fnr_curr ;
/* kk-th pivot in frontal matrix located in Flublock [kk, kk] */
pivot_value = Fl1 [kk] ;
D [k] = pivot_value ;
zero_pivot = IS_ZERO (pivot_value) ;
DEBUG4 (("Pivot D["ID"]=", k)) ;
EDEBUG4 (pivot_value) ;
DEBUG4 (("\n")) ;
/* ------------------------------------------------------------------ */
/* count nonzeros in kth column of L */
/* ------------------------------------------------------------------ */
lnz = 0 ;
lnz2i = 0 ;
lnz2x = llen ;
#ifdef DROP
all_lnz = 0 ;
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
x = Fl1 [i] ;
if (IS_ZERO (x)) continue ;
all_lnz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
lnz++ ;
if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
double s ;
x = Fl2 [i] ;
if (IS_ZERO (x)) continue ;
all_lnz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
lnz++ ;
if (Lpos [Frows [i]] == EMPTY) lnz2i++ ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
if (IS_ZERO (Fl1 [i])) continue ;
lnz++ ;
if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ;
}
for (i = 0 ; i < fnrows ; i++)
{
if (IS_ZERO (Fl2 [i])) continue ;
lnz++ ;
if (Lpos [Frows [i]] == EMPTY) lnz2i++ ;
}
#endif
lnz2x += lnz2i ;
/* determine if we start a new Lchain or continue the old one */
if (llen == 0 || zero_pivot)
{
/* llen == 0 means there is no prior Lchain */
/* D [k] == 0 means the pivot column is empty */
newLchain = TRUE ;
}
else
{
newLchain =
/* storage for starting a new Lchain */
UNITS (Entry, lnz) + UNITS (Int, lnz)
<=
/* storage for continuing a prior Lchain */
UNITS (Entry, lnz2x) + UNITS (Int, lnz2i) ;
}
if (newLchain)
{
/* start a new chain for column k of L */
DEBUG2 (("Start new Lchain, k = "ID"\n", k)) ;
pivrow_position = EMPTY ;
/* clear the prior Lpattern */
for (i = 0 ; i < llen ; i++)
{
row = Lpattern [i] ;
Lpos [row] = EMPTY ;
}
llen = 0 ;
lnzi = lnz ;
lnzx = lnz ;
}
else
{
/* continue the prior Lchain */
DEBUG2 (("Continue Lchain, k = "ID"\n", k)) ;
lnzi = lnz2i ;
lnzx = lnz2x ;
}
/* ------------------------------------------------------------------ */
/* allocate space for the column of L */
/* ------------------------------------------------------------------ */
size = UNITS (Int, lnzi) + UNITS (Entry, lnzx) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0)
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n"));
}
#endif
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
Int r2, c2 ;
/* Do garbage collection, realloc, and try again. */
/* Note that there are pivot rows/columns in current front. */
if (Work->do_grow)
{
/* full compaction of current frontal matrix, since
* UMF_grow_front will be called next anyway. */
r2 = fnrows ;
c2 = fncols ;
}
else
{
/* partial compaction. */
r2 = MAX (fnrows, Work->fnrows_new + 1) ;
c2 = MAX (fncols, Work->fncols_new + 1) ;
}
DEBUGm3 (("get_memory from umf_store_lu:\n")) ;
if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE))
{
DEBUGm4 (("out of memory: store LU (1)\n")) ;
return (FALSE) ; /* out of memory */
}
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
DEBUGm4 (("out of memory: store LU (2)\n")) ;
return (FALSE) ; /* out of memory */
}
/* garbage collection may have moved the current front */
fnc_curr = Work->fnc_curr ;
fnr_curr = Work->fnr_curr ;
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
Fl1 = Flublock + kk * nb ;
Fl2 = Flblock + kk * fnr_curr ;
}
/* ------------------------------------------------------------------ */
/* store the column of L */
/* ------------------------------------------------------------------ */
lip = p ;
Li = (Int *) (Numeric->Memory + p) ;
p += UNITS (Int, lnzi) ;
Lval = (Entry *) (Numeric->Memory + p) ;
p += UNITS (Entry, lnzx) ;
for (i = 0 ; i < lnzx ; i++)
{
CLEAR (Lval [i]) ;
}
/* store the numerical entries */
if (newLchain)
{
/* flag the first column in the Lchain by negating Lip [k] */
lip = -lip ;
ASSERT (llen == 0) ;
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl1 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Pivrow [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Frows [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl1 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Pivrow [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl2 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Frows [i] ;
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
Li [pos] = row2 ;
Lval [pos] = x ;
}
#endif
}
else
{
ASSERT (llen > 0) ;
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl1 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Pivrow [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
double s ;
Int row2, pos ;
x = Fl2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
row2 = Frows [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl1 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Pivrow [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
for (i = 0 ; i < fnrows ; i++)
{
Entry x ;
Int row2, pos ;
x = Fl2 [i] ;
if (IS_ZERO (x)) continue ;
row2 = Frows [i] ;
pos = Lpos [row2] ;
if (pos == EMPTY)
{
pos = llen++ ;
Lpattern [pos] = row2 ;
Lpos [row2] = pos ;
*Li++ = row2 ;
}
Lval [pos] = x ;
}
#endif
}
DEBUG4 (("llen "ID" lnzx "ID"\n", llen, lnzx)) ;
ASSERT (llen == lnzx) ;
ASSERT (lnz <= llen) ;
DEBUG4 (("lnz "ID" \n", lnz)) ;
#ifdef DROP
DEBUG4 (("all_lnz "ID" \n", all_lnz)) ;
ASSERT (lnz <= all_lnz) ;
Numeric->lnz += lnz ;
Numeric->all_lnz += all_lnz ;
Lnz [kk] = all_lnz ;
#else
Numeric->lnz += lnz ;
Numeric->all_lnz += lnz ;
Lnz [kk] = lnz ;
#endif
Numeric->nLentries += lnzx ;
Work->llen = llen ;
Numeric->isize += lnzi ;
/* ------------------------------------------------------------------ */
/* the pivot column is fully assembled and scaled, and is now the */
/* k-th column of L */
/* ------------------------------------------------------------------ */
Lpos [pivrow] = pivrow_position ; /* not aliased */
Lip [pivcol] = lip ; /* aliased with Col_tuples */
Lilen [pivcol] = lnzi ; /* aliased with Col_tlen */
}
/* ---------------------------------------------------------------------- */
/* store the rows of U */
/* ---------------------------------------------------------------------- */
for (kk = 0 ; kk < fnpiv ; kk++)
{
/* ------------------------------------------------------------------ */
/* one more pivot row and column is being stored into L and U */
/* ------------------------------------------------------------------ */
k = Work->npiv + kk ;
/* ------------------------------------------------------------------ */
/* find the kth pivot row and pivot column */
/* ------------------------------------------------------------------ */
pivrow = Pivrow [kk] ;
pivcol = Pivcol [kk] ;
#ifndef NDEBUG
ASSERT (pivrow >= 0 && pivrow < Work->n_row) ;
ASSERT (pivcol >= 0 && pivcol < Work->n_col) ;
DEBUG2 (("Store row of U, k = "ID", ulen "ID"\n", k, ulen)) ;
for (i = 0 ; i < ulen ; i++)
{
col = Upattern [i] ;
DEBUG2 ((" Upattern["ID"] "ID, i, col)) ;
if (col == pivcol) DEBUG2 ((" <- pivot col")) ;
DEBUG2 (("\n")) ;
ASSERT (col >= 0 && col < Work->n_col) ;
ASSERT (i == Upos [col]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* get the pivot value, for the diagonal matrix D */
/* ------------------------------------------------------------------ */
zero_pivot = IS_ZERO (D [k]) ;
/* ------------------------------------------------------------------ */
/* count the nonzeros in the row of U */
/* ------------------------------------------------------------------ */
/* kk-th row of U in the LU block */
Fu1 = Flublock + kk ;
/* kk-th row of U in the U block */
Fu2 = Fublock + kk * fnc_curr ;
unz = 0 ;
unz2i = 0 ;
unz2x = ulen ;
DEBUG2 (("unz2x is "ID", lnzx "ID"\n", unz2x, lnzx)) ;
/* if row k does not end a Uchain, pivcol not included in ulen */
ASSERT (!NON_PIVOTAL_COL (pivcol)) ;
pivcol_position = Upos [pivcol] ;
if (pivcol_position != EMPTY)
{
unz2x-- ;
DEBUG2 (("(exclude pivcol) unz2x is now "ID"\n", unz2x)) ;
}
ASSERT (unz2x >= 0) ;
#ifdef DROP
all_unz = 0 ;
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
x = Fu1 [i*nb] ;
if (IS_ZERO (x)) continue ;
all_unz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
unz++ ;
if (Upos [Pivcol [i]] == EMPTY) unz2i++ ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
double s ;
x = Fu2 [i] ;
if (IS_ZERO (x)) continue ;
all_unz++ ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
unz++ ;
if (Upos [Fcols [i]] == EMPTY) unz2i++ ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
if (IS_ZERO (Fu1 [i*nb])) continue ;
unz++ ;
if (Upos [Pivcol [i]] == EMPTY) unz2i++ ;
}
for (i = 0 ; i < fncols ; i++)
{
if (IS_ZERO (Fu2 [i])) continue ;
unz++ ;
if (Upos [Fcols [i]] == EMPTY) unz2i++ ;
}
#endif
unz2x += unz2i ;
ASSERT (IMPLIES (k == 0, ulen == 0)) ;
/* determine if we start a new Uchain or continue the old one */
if (ulen == 0 || zero_pivot)
{
/* ulen == 0 means there is no prior Uchain */
/* D [k] == 0 means the matrix is singular (pivot row might */
/* not be empty, however, but start a new Uchain to prune zero */
/* entries for the deg > 0 test in UMF_u*solve) */
newUchain = TRUE ;
}
else
{
newUchain =
/* approximate storage for starting a new Uchain */
UNITS (Entry, unz) + UNITS (Int, unz)
<=
/* approximate storage for continuing a prior Uchain */
UNITS (Entry, unz2x) + UNITS (Int, unz2i) ;
/* this would be exact, except for the Int to Unit rounding, */
/* because the Upattern is stored only at the end of the Uchain */
}
/* ------------------------------------------------------------------ */
/* allocate space for the row of U */
/* ------------------------------------------------------------------ */
size = 0 ;
if (newUchain)
{
/* store the pattern of the last row in the prior Uchain */
size += UNITS (Int, ulen) ;
unzx = unz ;
}
else
{
unzx = unz2x ;
}
size += UNITS (Entry, unzx) ;
#ifndef NDEBUG
UMF_allocfail = FALSE ;
if (UMF_gprob > 0)
{
double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ;
DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ;
UMF_allocfail = rrr < UMF_gprob ;
if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n"));
}
#endif
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
Int r2, c2 ;
/* Do garbage collection, realloc, and try again. */
/* Note that there are pivot rows/columns in current front. */
if (Work->do_grow)
{
/* full compaction of current frontal matrix, since
* UMF_grow_front will be called next anyway. */
r2 = fnrows ;
c2 = fncols ;
}
else
{
/* partial compaction. */
r2 = MAX (fnrows, Work->fnrows_new + 1) ;
c2 = MAX (fncols, Work->fncols_new + 1) ;
}
DEBUGm3 (("get_memory from umf_store_lu:\n")) ;
if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE))
{
/* :: get memory, column of L :: */
DEBUGm4 (("out of memory: store LU (1)\n")) ;
return (FALSE) ; /* out of memory */
}
p = UMF_mem_alloc_head_block (Numeric, size) ;
if (!p)
{
/* :: out of memory, column of U :: */
DEBUGm4 (("out of memory: store LU (2)\n")) ;
return (FALSE) ; /* out of memory */
}
/* garbage collection may have moved the current front */
fnc_curr = Work->fnc_curr ;
fnr_curr = Work->fnr_curr ;
Flublock = Work->Flublock ;
Flblock = Work->Flblock ;
Fublock = Work->Fublock ;
Fu1 = Flublock + kk ;
Fu2 = Fublock + kk * fnc_curr ;
}
/* ------------------------------------------------------------------ */
/* store the row of U */
/* ------------------------------------------------------------------ */
uip = p ;
if (newUchain)
{
/* starting a new Uchain - flag this by negating Uip [k] */
uip = -uip ;
DEBUG2 (("Start new Uchain, k = "ID"\n", k)) ;
pivcol_position = EMPTY ;
/* end the prior Uchain */
/* save the current Upattern, and then */
/* clear it and start a new Upattern */
DEBUG2 (("Ending prior chain, k-1 = "ID"\n", k-1)) ;
uilen = ulen ;
Ui = (Int *) (Numeric->Memory + p) ;
Numeric->isize += ulen ;
p += UNITS (Int, ulen) ;
for (i = 0 ; i < ulen ; i++)
{
col = Upattern [i] ;
ASSERT (col >= 0 && col < Work->n_col) ;
Upos [col] = EMPTY ;
Ui [i] = col ;
}
ulen = 0 ;
}
else
{
/* continue the prior Uchain */
DEBUG2 (("Continue Uchain, k = "ID"\n", k)) ;
ASSERT (k > 0) ;
/* remove pivot col index from current row of U */
/* if a new Uchain starts, then all entries are removed later */
DEBUG2 (("Removing pivcol from Upattern, k = "ID"\n", k)) ;
if (pivcol_position != EMPTY)
{
/* place the last entry in the row in the */
/* position of the pivot col index */
ASSERT (pivcol == Upattern [pivcol_position]) ;
col = Upattern [--ulen] ;
ASSERT (col >= 0 && col < Work->n_col) ;
Upattern [pivcol_position] = col ;
Upos [col] = pivcol_position ;
Upos [pivcol] = EMPTY ;
}
/* this row continues the Uchain. Keep track of how much */
/* to trim from the k-th length to get the length of the */
/* (k-1)st row of U */
uilen = unz2i ;
}
Uval = (Entry *) (Numeric->Memory + p) ;
/* p += UNITS (Entry, unzx), no need to increment p */
for (i = 0 ; i < unzx ; i++)
{
CLEAR (Uval [i]) ;
}
if (newUchain)
{
ASSERT (ulen == 0) ;
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu1 [i*nb] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Pivcol [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Fcols [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu1 [i*nb] ;
if (IS_ZERO (x)) continue ;
col2 = Pivcol [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu2 [i] ;
if (IS_ZERO (x)) continue ;
col2 = Fcols [i] ;
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
Uval [pos] = x ;
}
#endif
}
else
{
ASSERT (ulen > 0) ;
/* store the numerical entries and find new nonzeros */
#ifdef DROP
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu1 [i*nb] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Pivcol [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
double s ;
Int col2, pos ;
x = Fu2 [i] ;
APPROX_ABS (s, x) ;
if (s <= droptol) continue ;
col2 = Fcols [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
#else
for (i = kk + 1 ; i < fnpiv ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu1 [i*nb] ;
if (IS_ZERO (x)) continue ;
col2 = Pivcol [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
for (i = 0 ; i < fncols ; i++)
{
Entry x ;
Int col2, pos ;
x = Fu2 [i] ;
if (IS_ZERO (x)) continue ;
col2 = Fcols [i] ;
pos = Upos [col2] ;
if (pos == EMPTY)
{
pos = ulen++ ;
Upattern [pos] = col2 ;
Upos [col2] = pos ;
}
Uval [pos] = x ;
}
#endif
}
ASSERT (ulen == unzx) ;
ASSERT (unz <= ulen) ;
DEBUG4 (("unz "ID" \n", unz)) ;
#ifdef DROP
DEBUG4 (("all_unz "ID" \n", all_unz)) ;
ASSERT (unz <= all_unz) ;
Numeric->unz += unz ;
Numeric->all_unz += all_unz ;
/* count the "true" flops, based on LU pattern only */
Numeric->flops += DIV_FLOPS * Lnz [kk] /* scale pivot column */
+ MULTSUB_FLOPS * (Lnz [kk] * all_unz) ; /* outer product */
#else
Numeric->unz += unz ;
Numeric->all_unz += unz ;
/* count the "true" flops, based on LU pattern only */
Numeric->flops += DIV_FLOPS * Lnz [kk] /* scale pivot column */
+ MULTSUB_FLOPS * (Lnz [kk] * unz) ; /* outer product */
#endif
Numeric->nUentries += unzx ;
Work->ulen = ulen ;
DEBUG1 (("Work->ulen = "ID" at end of pivot step, k: "ID"\n", ulen, k));
/* ------------------------------------------------------------------ */
/* the pivot row is the k-th row of U */
/* ------------------------------------------------------------------ */
Upos [pivcol] = pivcol_position ; /* not aliased */
Uip [pivrow] = uip ; /* aliased with Row_tuples */
Uilen [pivrow] = uilen ; /* aliased with Row_tlen */
}
/* ---------------------------------------------------------------------- */
/* no more pivots in frontal working array */
/* ---------------------------------------------------------------------- */
Work->npiv += fnpiv ;
Work->fnpiv = 0 ;
Work->fnzeros = 0 ;
return (TRUE) ;
}
GLOBAL Int UMFPACK_transpose
(
Int n_row,
Int n_col,
const Int Ap [ ], /* size n_col+1 */
const Int Ai [ ], /* size nz = Ap [n_col] */
const double Ax [ ], /* size nz, if present */
#ifdef COMPLEX
const double Az [ ], /* size nz, if present */
#endif
const Int P [ ], /* P [k] = i means original row i is kth row in A(P,Q)*/
/* P is identity if not present */
/* size n_row, if present */
const Int Q [ ], /* Q [k] = j means original col j is kth col in A(P,Q)*/
/* Q is identity if not present */
/* size n_col, if present */
Int Rp [ ], /* size n_row+1 */
Int Ri [ ], /* size nz */
double Rx [ ] /* size nz, if present */
#ifdef COMPLEX
, double Rz [ ] /* size nz, if present */
, Int do_conjugate /* if true, then to conjugate transpose */
/* otherwise, do array transpose */
#endif
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Int status, *W, nn ;
#ifndef NDEBUG
init_count = UMF_malloc_count ;
UMF_dump_start ( ) ;
#endif
/* ---------------------------------------------------------------------- */
/* allocate workspace */
/* ---------------------------------------------------------------------- */
nn = MAX (n_row, n_col) ;
nn = MAX (nn, 1) ;
W = (Int *) UMF_malloc (nn, sizeof (Int)) ;
if (!W)
{
DEBUGm4 (("out of memory: transpose work\n")) ;
ASSERT (UMF_malloc_count == init_count) ;
return (UMFPACK_ERROR_out_of_memory) ;
}
ASSERT (UMF_malloc_count == init_count + 1) ;
/* ---------------------------------------------------------------------- */
/* C = (A (P,Q))' or (A (P,Q)).' */
/* ---------------------------------------------------------------------- */
status = UMF_transpose (n_row, n_col, Ap, Ai, Ax, P, Q, n_col, Rp, Ri, Rx,
W, TRUE
#ifdef COMPLEX
, Az, Rz, do_conjugate
#endif
) ;
/* ---------------------------------------------------------------------- */
/* free the workspace */
/* ---------------------------------------------------------------------- */
(void) UMF_free ((void *) W) ;
ASSERT (UMF_malloc_count == init_count) ;
return (status) ;
}
PRIVATE Int two_by_two /* returns # unmatched weak diagonals */
(
/* input, not modified */
Int n2, /* C is n2-by-n2 */
Int Cp [ ], /* size n2+1, column pointers for C */
Int Ci [ ], /* size snz = Cp [n2], row indices for C */
Int Degree [ ], /* Degree [i] = degree of row i of C+C' */
/* input, not defined on output */
Int Next [ ], /* Next [k] == IS_WEAK if k is a weak diagonal */
Int Ri [ ], /* Ri [i] is the length of row i in C */
/* output, not defined on input */
Int P [ ],
/* workspace, not defined on input or output */
Int Rp [ ],
Int Head [ ]
)
{
Int deg, newcol, row, col, p, p2, unmatched, k, j, j2, j_best, best, jdiff,
jdiff_best, jdeg, jdeg_best, cp, cp1, cp2, rp, rp1, rp2, maxdeg,
mindeg ;
/* ---------------------------------------------------------------------- */
/* place weak diagonals in the degree lists */
/* ---------------------------------------------------------------------- */
for (deg = 0 ; deg < n2 ; deg++)
{
Head [deg] = EMPTY ;
}
maxdeg = 0 ;
mindeg = Int_MAX ;
for (newcol = n2-1 ; newcol >= 0 ; newcol--)
{
if (Next [newcol] == IS_WEAK)
{
/* add this column to the list of weak nodes */
DEBUGm1 ((" newcol "ID" has a weak diagonal deg "ID"\n",
newcol, deg)) ;
deg = Degree [newcol] ;
ASSERT (deg >= 0 && deg < n2) ;
Next [newcol] = Head [deg] ;
Head [deg] = newcol ;
maxdeg = MAX (maxdeg, deg) ;
mindeg = MIN (mindeg, deg) ;
}
}
/* ---------------------------------------------------------------------- */
/* construct R = C' (C = strong entries in pruned submatrix) */
/* ---------------------------------------------------------------------- */
/* Ri [0..n2-1] is the length of each row of R */
/* use P as temporary pointer into the row form of R [ */
Rp [0] = 0 ;
for (row = 0 ; row < n2 ; row++)
{
Rp [row+1] = Rp [row] + Ri [row] ;
P [row] = Rp [row] ;
}
/* Ri no longer needed for row counts */
/* all entries in C are strong */
for (col = 0 ; col < n2 ; col++)
{
p2 = Cp [col+1] ;
for (p = Cp [col] ; p < p2 ; p++)
{
/* place the column index in row = Ci [p] */
Ri [P [Ci [p]]++] = col ;
}
}
/* contents of P no longer needed ] */
#ifndef NDEBUG
DEBUG0 (("==================R: row form of strong entries in A:\n")) ;
UMF_dump_col_matrix ((double *) NULL,
#ifdef COMPLEX
(double *) NULL,
#endif
Ri, Rp, n2, n2, Rp [n2]) ;
#endif
ASSERT (AMD_valid (n2, n2, Rp, Ri) == AMD_OK) ;
/* ---------------------------------------------------------------------- */
/* for each weak diagonal, find a pair of strong off-diagonal entries */
/* ---------------------------------------------------------------------- */
for (row = 0 ; row < n2 ; row++)
{
P [row] = EMPTY ;
}
unmatched = 0 ;
best = EMPTY ;
jdiff = EMPTY ;
jdeg = EMPTY ;
for (deg = mindeg ; deg <= maxdeg ; deg++)
{
/* find the next weak diagonal of lowest degree */
DEBUGm2 (("---------------------------------- Deg: "ID"\n", deg)) ;
for (k = Head [deg] ; k != EMPTY ; k = Next [k])
{
DEBUGm2 (("k: "ID"\n", k)) ;
if (P [k] == EMPTY)
{
/* C (k,k) is a weak diagonal entry. Find an index j != k such
* that C (j,k) and C (k,j) are both strong, and also such
* that Degree [j] is minimized. In case of a tie, pick
* the smallest index j. C and R contain the pattern of
* strong entries only.
*
* Note that row k of R and column k of C are both sorted. */
DEBUGm4 (("===== Weak diagonal k = "ID"\n", k)) ;
DEBUG1 (("Column k of C:\n")) ;
for (p = Cp [k] ; p < Cp [k+1] ; p++)
{
DEBUG1 ((" "ID": deg "ID"\n", Ci [p], Degree [Ci [p]]));
}
DEBUG1 (("Row k of R (strong entries only):\n")) ;
for (p = Rp [k] ; p < Rp [k+1] ; p++)
{
DEBUG1 ((" "ID": deg "ID"\n", Ri [p], Degree [Ri [p]]));
}
/* no (C (k,j), C (j,k)) pair exists yet */
j_best = EMPTY ;
jdiff_best = Int_MAX ;
jdeg_best = Int_MAX ;
/* pointers into column k (including values) */
cp1 = Cp [k] ;
cp2 = Cp [k+1] ;
cp = cp1 ;
/* pointers into row k (strong entries only, no values) */
rp1 = Rp [k] ;
rp2 = Rp [k+1] ;
rp = rp1 ;
/* while entries searched in column k and row k */
while (TRUE)
{
if (cp >= cp2)
{
/* no more entries in this column */
break ;
}
/* get C (j,k), which is strong */
j = Ci [cp] ;
if (rp >= rp2)
{
/* no more entries in this column */
break ;
}
/* get R (k,j2), which is strong */
j2 = Ri [rp] ;
if (j < j2)
{
/* C (j,k) is strong, but R (k,j) is not strong */
cp++ ;
continue ;
}
if (j2 < j)
{
/* C (k,j2) is strong, but R (j2,k) is not strong */
rp++ ;
continue ;
}
/* j == j2: C (j,k) is strong and R (k,j) is strong */
best = FALSE ;
if (P [j] == EMPTY)
{
/* j has not yet been matched */
jdeg = Degree [j] ;
jdiff = SCALAR_ABS (k-j) ;
DEBUG1 (("Try candidate j "ID" deg "ID" diff "ID
"\n", j, jdeg, jdiff)) ;
if (j_best == EMPTY)
{
/* this is the first candidate seen */
DEBUG1 ((" first\n")) ;
best = TRUE ;
}
else
{
if (jdeg < jdeg_best)
{
/* the degree of j is best seen so far. */
DEBUG1 ((" least degree\n")) ;
best = TRUE ;
}
else if (jdeg == jdeg_best)
{
/* degree of j and j_best are the same */
/* tie break by nearest node number */
if (jdiff < jdiff_best)
{
DEBUG1 ((" tie degree, closer\n")) ;
best = TRUE ;
}
else if (jdiff == jdiff_best)
{
/* |j-k| = |j_best-k|. For any given k
* and j_best there is only one other j
* than can be just as close as j_best.
* Tie break by picking the smaller of
* j and j_best */
DEBUG1 ((" tie degree, as close\n"));
best = j < j_best ;
}
}
else
{
/* j has higher degree than best so far */
best = FALSE ;
}
}
}
if (best)
{
/* j is best match for k */
/* found a strong pair, A (j,k) and A (k,j) */
DEBUG1 ((" --- Found pair k: "ID" j: " ID
" jdeg: "ID" jdiff: "ID"\n",
k, j, jdeg, jdiff)) ;
ASSERT (jdiff != EMPTY) ;
ASSERT (jdeg != EMPTY) ;
j_best = j ;
jdeg_best = jdeg ;
jdiff_best = jdiff ;
}
/* get the next entries in column k and row k */
cp++ ;
rp++ ;
}
/* save the pair (j,k), if we found one */
if (j_best != EMPTY)
{
j = j_best ;
DEBUGm4 ((" --- best pair j: "ID" for k: "ID"\n", j, k)) ;
P [k] = j ;
P [j] = k ;
}
else
{
/* no match was found for k */
unmatched++ ;
}
}
}
}
/* ---------------------------------------------------------------------- */
/* finalize the row permutation, P */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n2 ; k++)
{
if (P [k] == EMPTY)
{
P [k] = k ;
}
}
ASSERT (UMF_is_permutation (P, Rp, n2, n2)) ;
return (unmatched) ;
}
GLOBAL Int UMF_solve
(
Int sys,
const Int Ap [ ],
const Int Ai [ ],
const double Ax [ ],
double Xx [ ],
const double Bx [ ],
#ifdef COMPLEX
const double Az [ ],
double Xz [ ],
const double Bz [ ],
#endif
NumericType *Numeric,
Int irstep,
double Info [UMFPACK_INFO],
Int Pattern [ ], /* size n */
double SolveWork [ ] /* if irstep>0 real: size 5*n. complex:10*n */
/* otherwise real: size n. complex: 4*n */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
Entry axx, wi, xj, zi, xi, aij, bi ;
double omega [3], d, z2i, yi, flops ;
Entry *W, *Z, *S, *X ;
double *Z2, *Y, *B2, *Rs ;
Int *Rperm, *Cperm, i, n, p, step, j, nz, status, p2, do_scale ;
#ifdef COMPLEX
Int AXsplit ;
Int Bsplit ;
#endif
#ifndef NRECIPROCAL
Int do_recip = Numeric->do_recip ;
#endif
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
#ifndef NDEBUG
UMF_dump_lu (Numeric) ;
ASSERT (Numeric && Xx && Bx && Pattern && SolveWork && Info) ;
#endif
nz = 0 ;
omega [0] = 0. ;
omega [1] = 0. ;
omega [2] = 0. ;
Rperm = Numeric->Rperm ;
Cperm = Numeric->Cperm ;
Rs = Numeric->Rs ; /* row scale factors */
do_scale = (Rs != (double *) NULL) ;
flops = 0 ;
Info [UMFPACK_SOLVE_FLOPS] = 0 ;
Info [UMFPACK_IR_TAKEN] = 0 ;
Info [UMFPACK_IR_ATTEMPTED] = 0 ;
/* UMFPACK_solve does not call this routine if A is rectangular */
ASSERT (Numeric->n_row == Numeric->n_col) ;
n = Numeric->n_row ;
if (Numeric->nnzpiv < n
|| SCALAR_IS_ZERO (Numeric->rcond) || SCALAR_IS_NAN (Numeric->rcond))
{
/* Note that systems involving just L return UMFPACK_OK, even if */
/* A is singular (L is always has a unit diagonal). */
DEBUGm4 (("Note, matrix is singular in umf_solve\n")) ;
status = UMFPACK_WARNING_singular_matrix ;
irstep = 0 ;
}
else
{
status = UMFPACK_OK ;
}
irstep = MAX (0, irstep) ; /* make sure irstep is >= 0 */
W = (Entry *) SolveWork ; /* Entry W [0..n-1] */
Z = (Entry *) NULL ; /* unused if no iterative refinement */
S = (Entry *) NULL ;
Y = (double *) NULL ;
Z2 = (double *) NULL ;
B2 = (double *) NULL ;
#ifdef COMPLEX
if (irstep > 0)
{
if (!Ap || !Ai || !Ax)
{
return (UMFPACK_ERROR_argument_missing) ;
}
/* A, B, and X in split format if Az, Bz, and Xz present */
AXsplit = SPLIT (Az) || SPLIT(Xz);
Z = (Entry *) (SolveWork + 4*n) ; /* Entry Z [0..n-1] */
S = (Entry *) (SolveWork + 6*n) ; /* Entry S [0..n-1] */
Y = (double *) (SolveWork + 8*n) ; /* double Y [0..n-1] */
B2 = (double *) (SolveWork + 9*n) ; /* double B2 [0..n-1] */
Z2 = (double *) Z ; /* double Z2 [0..n-1], equiv. to Z */
}
else
{
/* A is ignored, only look at X for split/packed cases */
AXsplit = SPLIT(Xz);
}
Bsplit = SPLIT (Bz);
if (AXsplit)
{
X = (Entry *) (SolveWork + 2*n) ; /* Entry X [0..n-1] */
}
else
{
X = (Entry *) Xx ; /* Entry X [0..n-1] */
}
#else
X = (Entry *) Xx ; /* Entry X [0..n-1] */
if (irstep > 0)
{
if (!Ap || !Ai || !Ax)
{
return (UMFPACK_ERROR_argument_missing) ;
}
Z = (Entry *) (SolveWork + n) ; /* Entry Z [0..n-1] */
S = (Entry *) (SolveWork + 2*n) ; /* Entry S [0..n-1] */
Y = (double *) (SolveWork + 3*n) ; /* double Y [0..n-1] */
B2 = (double *) (SolveWork + 4*n) ; /* double B2 [0..n-1] */
Z2 = (double *) Z ; /* double Z2 [0..n-1], equiv. to Z */
}
#endif
/* ---------------------------------------------------------------------- */
/* determine which system to solve */
/* ---------------------------------------------------------------------- */
if (sys == UMFPACK_A)
{
/* ------------------------------------------------------------------ */
/* solve A x = b with optional iterative refinement */
/* ------------------------------------------------------------------ */
if (irstep > 0)
{
/* -------------------------------------------------------------- */
/* using iterative refinement: compute Y and B2 */
/* -------------------------------------------------------------- */
nz = Ap [n] ;
Info [UMFPACK_NZ] = nz ;
/* A is stored by column */
/* Y (i) = ||R A_i||, 1-norm of row i of R A */
for (i = 0 ; i < n ; i++)
{
Y [i] = 0. ;
}
flops += (ABS_FLOPS + 1) * nz ;
p2 = Ap [n] ;
for (p = 0 ; p < p2 ; p++)
{
/* Y [Ai [p]] += ABS (Ax [p]) ; */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
Y [Ai [p]] += d ;
}
/* B2 = abs (B) */
flops += ABS_FLOPS * n ;
for (i = 0 ; i < n ; i++)
{
/* B2 [i] = ABS (B [i]) ; */
ASSIGN (bi, Bx, Bz, i, Bsplit) ;
ABS (B2 [i], bi) ;
}
/* scale Y and B2. */
if (do_scale)
{
/* Y = R Y */
/* B2 = R B2 */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
Y [i] *= Rs [i] ;
B2 [i] *= Rs [i] ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
Y [i] /= Rs [i] ;
B2 [i] /= Rs [i] ;
}
}
flops += 2 * n ;
}
}
for (step = 0 ; step <= irstep ; step++)
{
/* -------------------------------------------------------------- */
/* Solve A x = b (step 0): */
/* x = Q (U \ (L \ (P R b))) */
/* and then perform iterative refinement (step > 0): */
/* x = x + Q (U \ (L \ (P R (b - A x)))) */
/* -------------------------------------------------------------- */
if (step == 0)
{
if (do_scale)
{
/* W = P R b, using X as workspace, since Z is not
* allocated if irstep = 0. */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
SCALE (X [i], Rs [i]) ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
SCALE_DIV (X [i], Rs [i]) ;
}
}
flops += SCALE_FLOPS * n ;
for (i = 0 ; i < n ; i++)
{
W [i] = X [Rperm [i]] ;
}
}
else
{
/* W = P b, since the row scaling R = I */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [Rperm [i]] ; */
ASSIGN (W [i], Bx, Bz, Rperm [i], Bsplit) ;
}
}
}
else
{
for (i = 0 ; i < n ; i++)
{
/* Z [i] = B [i] ; */
ASSIGN (Z [i], Bx, Bz, i, Bsplit) ;
}
flops += MULTSUB_FLOPS * nz ;
for (i = 0 ; i < n ; i++)
{
xi = X [i] ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* Z [Ai [p]] -= Ax [p] * xi ; */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
MULT_SUB (Z [Ai [p]], aij, xi) ;
}
}
/* scale, Z = R Z */
if (do_scale)
{
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE (Z [i], Rs [i]) ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE_DIV (Z [i], Rs [i]) ;
}
}
flops += SCALE_FLOPS * n ;
}
for (i = 0 ; i < n ; i++)
{
W [i] = Z [Rperm [i]] ;
}
}
flops += UMF_lsolve (Numeric, W, Pattern) ;
flops += UMF_usolve (Numeric, W, Pattern) ;
if (step == 0)
{
for (i = 0 ; i < n ; i++)
{
X [Cperm [i]] = W [i] ;
}
}
else
{
flops += ASSEMBLE_FLOPS * n ;
for (i = 0 ; i < n ; i++)
{
/* X [Cperm [i]] += W [i] ; */
ASSEMBLE (X [Cperm [i]], W [i]) ;
}
}
/* -------------------------------------------------------------- */
/* sparse backward error estimate */
/* -------------------------------------------------------------- */
if (irstep > 0)
{
/* ---------------------------------------------------------- */
/* A is stored by column */
/* W (i) = R (b - A x)_i, residual */
/* Z2 (i) = R (|A||x|)_i */
/* ---------------------------------------------------------- */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [i] ; */
ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
Z2 [i] = 0. ;
}
flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ;
for (j = 0 ; j < n ; j++)
{
xj = X [j] ;
p2 = Ap [j+1] ;
for (p = Ap [j] ; p < p2 ; p++)
{
i = Ai [p] ;
/* axx = Ax [p] * xj ; */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
MULT (axx, aij, xj) ;
/* W [i] -= axx ; */
DECREMENT (W [i], axx) ;
/* Z2 [i] += ABS (axx) ; */
ABS (d, axx) ;
Z2 [i] += d ;
}
}
/* scale W and Z2 */
if (do_scale)
{
/* Z2 = R Z2 */
/* W = R W */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE (W [i], Rs [i]) ;
Z2 [i] *= Rs [i] ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE_DIV (W [i], Rs [i]) ;
Z2 [i] /= Rs [i] ;
}
}
flops += (SCALE_FLOPS + 1) * n ;
}
flops += (2*ABS_FLOPS + 5) * n ;
if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info))
{
/* iterative refinement is done */
break ;
}
}
}
}
else if (sys == UMFPACK_At)
{
/* ------------------------------------------------------------------ */
/* solve A' x = b with optional iterative refinement */
/* ------------------------------------------------------------------ */
/* A' is the complex conjugate transpose */
if (irstep > 0)
{
/* -------------------------------------------------------------- */
/* using iterative refinement: compute Y */
/* -------------------------------------------------------------- */
nz = Ap [n] ;
Info [UMFPACK_NZ] = nz ;
/* A' is stored by row */
/* Y (i) = ||(A' R)_i||, 1-norm of row i of A' R */
if (do_scale)
{
flops += (ABS_FLOPS + 2) * nz ;
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
yi = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* yi += ABS (Ax [p]) * Rs [Ai [p]] ; */
/* note that abs (aij) is the same as
* abs (conj (aij)) */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
yi += (d * Rs [Ai [p]]) ;
}
Y [i] = yi ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
yi = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* yi += ABS (Ax [p]) / Rs [Ai [p]] ; */
/* note that abs (aij) is the same as
* abs (conj (aij)) */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
yi += (d / Rs [Ai [p]]) ;
}
Y [i] = yi ;
}
}
}
else
{
/* no scaling */
flops += (ABS_FLOPS + 1) * nz ;
for (i = 0 ; i < n ; i++)
{
yi = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* yi += ABS (Ax [p]) ; */
/* note that abs (aij) is the same as
* abs (conj (aij)) */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
yi += d ;
}
Y [i] = yi ;
}
}
/* B2 = abs (B) */
for (i = 0 ; i < n ; i++)
{
/* B2 [i] = ABS (B [i]) ; */
ASSIGN (bi, Bx, Bz, i, Bsplit) ;
ABS (B2 [i], bi) ;
}
}
for (step = 0 ; step <= irstep ; step++)
{
/* -------------------------------------------------------------- */
/* Solve A' x = b (step 0): */
/* x = R P' (L' \ (U' \ (Q' b))) */
/* and then perform iterative refinement (step > 0): */
/* x = x + R P' (L' \ (U' \ (Q' (b - A' x)))) */
/* -------------------------------------------------------------- */
if (step == 0)
{
/* W = Q' b */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [Cperm [i]] ; */
ASSIGN (W [i], Bx, Bz, Cperm [i], Bsplit) ;
}
}
else
{
/* Z = b - A' x */
for (i = 0 ; i < n ; i++)
{
/* Z [i] = B [i] ; */
ASSIGN (Z [i], Bx, Bz, i, Bsplit) ;
}
flops += MULTSUB_FLOPS * nz ;
for (i = 0 ; i < n ; i++)
{
zi = Z [i] ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* zi -= conjugate (Ax [p]) * X [Ai [p]] ; */
ASSIGN (aij, Ax, Az, p, Bsplit) ;
MULT_SUB_CONJ (zi, X [Ai [p]], aij) ;
}
Z [i] = zi ;
}
/* W = Q' Z */
for (i = 0 ; i < n ; i++)
{
W [i] = Z [Cperm [i]] ;
}
}
flops += UMF_uhsolve (Numeric, W, Pattern) ;
flops += UMF_lhsolve (Numeric, W, Pattern) ;
if (step == 0)
{
/* X = R P' W */
/* do not use Z, since it isn't allocated if irstep = 0 */
/* X = P' W */
for (i = 0 ; i < n ; i++)
{
X [Rperm [i]] = W [i] ;
}
if (do_scale)
{
/* X = R X */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE (X [i], Rs [i]) ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE_DIV (X [i], Rs [i]) ;
}
}
flops += SCALE_FLOPS * n ;
}
}
else
{
/* Z = P' W */
for (i = 0 ; i < n ; i++)
{
Z [Rperm [i]] = W [i] ;
}
if (do_scale)
{
/* Z = R Z */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE (Z [i], Rs [i]) ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE_DIV (Z [i], Rs [i]) ;
}
}
flops += SCALE_FLOPS * n ;
}
flops += ASSEMBLE_FLOPS * n ;
/* X += Z */
for (i = 0 ; i < n ; i++)
{
/* X [i] += Z [i] ; was +=W[i] in v4.3, which is wrong */
ASSEMBLE (X [i], Z [i]) ; /* bug fix, v4.3.1 */
}
}
/* -------------------------------------------------------------- */
/* sparse backward error estimate */
/* -------------------------------------------------------------- */
if (irstep > 0)
{
/* ---------------------------------------------------------- */
/* A' is stored by row */
/* W (i) = (b - A' x)_i, residual */
/* Z2 (i) = (|A'||x|)_i */
/* ---------------------------------------------------------- */
flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ;
for (i = 0 ; i < n ; i++)
{
/* wi = B [i] ; */
ASSIGN (wi, Bx, Bz, i, Bsplit) ;
z2i = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* axx = conjugate (Ax [p]) * X [Ai [p]] ; */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
MULT_CONJ (axx, X [Ai [p]], aij) ;
/* wi -= axx ; */
DECREMENT (wi, axx) ;
/* z2i += ABS (axx) ; */
ABS (d, axx) ;
z2i += d ;
}
W [i] = wi ;
Z2 [i] = z2i ;
}
flops += (2*ABS_FLOPS + 5) * n ;
if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info))
{
/* iterative refinement is done */
break ;
}
}
}
}
else if (sys == UMFPACK_Aat)
{
/* ------------------------------------------------------------------ */
/* solve A.' x = b with optional iterative refinement */
/* ------------------------------------------------------------------ */
/* A' is the array transpose */
if (irstep > 0)
{
/* -------------------------------------------------------------- */
/* using iterative refinement: compute Y */
/* -------------------------------------------------------------- */
nz = Ap [n] ;
Info [UMFPACK_NZ] = nz ;
/* A.' is stored by row */
/* Y (i) = ||(A.' R)_i||, 1-norm of row i of A.' R */
if (do_scale)
{
flops += (ABS_FLOPS + 2) * nz ;
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
yi = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* yi += ABS (Ax [p]) * Rs [Ai [p]] ; */
/* note that A.' is the array transpose,
* so no conjugate */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
yi += (d * Rs [Ai [p]]) ;
}
Y [i] = yi ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
yi = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* yi += ABS (Ax [p]) / Rs [Ai [p]] ; */
/* note that A.' is the array transpose,
* so no conjugate */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
yi += (d / Rs [Ai [p]]) ;
}
Y [i] = yi ;
}
}
}
else
{
/* no scaling */
flops += (ABS_FLOPS + 1) * nz ;
for (i = 0 ; i < n ; i++)
{
yi = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* yi += ABS (Ax [p]) */
/* note that A.' is the array transpose,
* so no conjugate */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
ABS (d, aij) ;
yi += d ;
}
Y [i] = yi ;
}
}
/* B2 = abs (B) */
for (i = 0 ; i < n ; i++)
{
/* B2 [i] = ABS (B [i]) ; */
ASSIGN (bi, Bx, Bz, i, Bsplit) ;
ABS (B2 [i], bi) ;
}
}
for (step = 0 ; step <= irstep ; step++)
{
/* -------------------------------------------------------------- */
/* Solve A.' x = b (step 0): */
/* x = R P' (L.' \ (U.' \ (Q' b))) */
/* and then perform iterative refinement (step > 0): */
/* x = x + R P' (L.' \ (U.' \ (Q' (b - A.' x)))) */
/* -------------------------------------------------------------- */
if (step == 0)
{
/* W = Q' b */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [Cperm [i]] ; */
ASSIGN (W [i], Bx, Bz, Cperm [i], Bsplit) ;
}
}
else
{
/* Z = b - A.' x */
for (i = 0 ; i < n ; i++)
{
/* Z [i] = B [i] ; */
ASSIGN (Z [i], Bx, Bz, i, Bsplit) ;
}
flops += MULTSUB_FLOPS * nz ;
for (i = 0 ; i < n ; i++)
{
zi = Z [i] ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* zi -= Ax [p] * X [Ai [p]] ; */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
MULT_SUB (zi, aij, X [Ai [p]]) ;
}
Z [i] = zi ;
}
/* W = Q' Z */
for (i = 0 ; i < n ; i++)
{
W [i] = Z [Cperm [i]] ;
}
}
flops += UMF_utsolve (Numeric, W, Pattern) ;
flops += UMF_ltsolve (Numeric, W, Pattern) ;
if (step == 0)
{
/* X = R P' W */
/* do not use Z, since it isn't allocated if irstep = 0 */
/* X = P' W */
for (i = 0 ; i < n ; i++)
{
X [Rperm [i]] = W [i] ;
}
if (do_scale)
{
/* X = R X */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE (X [i], Rs [i]) ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE_DIV (X [i], Rs [i]) ;
}
}
flops += SCALE_FLOPS * n ;
}
}
else
{
/* Z = P' W */
for (i = 0 ; i < n ; i++)
{
Z [Rperm [i]] = W [i] ;
}
if (do_scale)
{
/* Z = R Z */
#ifndef NRECIPROCAL
if (do_recip)
{
/* multiply by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE (Z [i], Rs [i]) ;
}
}
else
#endif
{
/* divide by the scale factors */
for (i = 0 ; i < n ; i++)
{
SCALE_DIV (Z [i], Rs [i]) ;
}
}
flops += SCALE_FLOPS * n ;
}
flops += ASSEMBLE_FLOPS * n ;
/* X += Z */
for (i = 0 ; i < n ; i++)
{
/* X [i] += Z [i] ; was +=W[i] in v4.3, which is wrong */
ASSEMBLE (X [i], Z [i]) ; /* bug fix, v4.3.1 */
}
}
/* -------------------------------------------------------------- */
/* sparse backward error estimate */
/* -------------------------------------------------------------- */
if (irstep > 0)
{
/* ---------------------------------------------------------- */
/* A.' is stored by row */
/* W (i) = (b - A.' x)_i, residual */
/* Z (i) = (|A.'||x|)_i */
/* ---------------------------------------------------------- */
flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ;
for (i = 0 ; i < n ; i++)
{
/* wi = B [i] ; */
ASSIGN (wi, Bx, Bz, i, Bsplit) ;
z2i = 0. ;
p2 = Ap [i+1] ;
for (p = Ap [i] ; p < p2 ; p++)
{
/* axx = Ax [p] * X [Ai [p]] ; */
ASSIGN (aij, Ax, Az, p, AXsplit) ;
MULT (axx, aij, X [Ai [p]]) ;
/* wi -= axx ; */
DECREMENT (wi, axx) ;
/* z2i += ABS (axx) ; */
ABS (d, axx) ;
z2i += d ;
}
W [i] = wi ;
Z2 [i] = z2i ;
}
flops += (2*ABS_FLOPS + 5) * n ;
if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info))
{
/* iterative refinement is done */
break ;
}
}
}
}
else if (sys == UMFPACK_Pt_L)
{
/* ------------------------------------------------------------------ */
/* Solve P'Lx=b: x = L \ Pb */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [Rperm [i]] ; */
ASSIGN (X [i], Bx, Bz, Rperm [i], Bsplit) ;
}
flops = UMF_lsolve (Numeric, X, Pattern) ;
status = UMFPACK_OK ;
}
else if (sys == UMFPACK_L)
{
/* ------------------------------------------------------------------ */
/* Solve Lx=b: x = L \ b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [i] ; */
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_lsolve (Numeric, X, Pattern) ;
status = UMFPACK_OK ;
}
else if (sys == UMFPACK_Lt_P)
{
/* ------------------------------------------------------------------ */
/* Solve L'Px=b: x = P' (L' \ b) */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [i] ; */
ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_lhsolve (Numeric, W, Pattern) ;
for (i = 0 ; i < n ; i++)
{
X [Rperm [i]] = W [i] ;
}
status = UMFPACK_OK ;
}
else if (sys == UMFPACK_Lat_P)
{
/* ------------------------------------------------------------------ */
/* Solve L.'Px=b: x = P' (L.' \ b) */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [i] ; */
ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_ltsolve (Numeric, W, Pattern) ;
for (i = 0 ; i < n ; i++)
{
X [Rperm [i]] = W [i] ;
}
status = UMFPACK_OK ;
}
else if (sys == UMFPACK_Lt)
{
/* ------------------------------------------------------------------ */
/* Solve L'x=b: x = L' \ b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [i] ; */
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_lhsolve (Numeric, X, Pattern) ;
status = UMFPACK_OK ;
}
else if (sys == UMFPACK_Lat)
{
/* ------------------------------------------------------------------ */
/* Solve L.'x=b: x = L.' \ b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [i] ; */
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_ltsolve (Numeric, X, Pattern) ;
status = UMFPACK_OK ;
}
else if (sys == UMFPACK_U_Qt)
{
/* ------------------------------------------------------------------ */
/* Solve UQ'x=b: x = Q (U \ b) */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* W [i] = B [i] ; */
ASSIGN (W [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_usolve (Numeric, W, Pattern) ;
for (i = 0 ; i < n ; i++)
{
X [Cperm [i]] = W [i] ;
}
}
else if (sys == UMFPACK_U)
{
/* ------------------------------------------------------------------ */
/* Solve Ux=b: x = U \ b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [i] ; */
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_usolve (Numeric, X, Pattern) ;
}
else if (sys == UMFPACK_Q_Ut)
{
/* ------------------------------------------------------------------ */
/* Solve QU'x=b: x = U' \ Q'b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [Cperm [i]] ; */
ASSIGN (X [i], Bx, Bz, Cperm [i], Bsplit) ;
}
flops = UMF_uhsolve (Numeric, X, Pattern) ;
}
else if (sys == UMFPACK_Q_Uat)
{
/* ------------------------------------------------------------------ */
/* Solve QU.'x=b: x = U.' \ Q'b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [Cperm [i]] ; */
ASSIGN (X [i], Bx, Bz, Cperm [i], Bsplit) ;
}
flops = UMF_utsolve (Numeric, X, Pattern) ;
}
else if (sys == UMFPACK_Ut)
{
/* ------------------------------------------------------------------ */
/* Solve U'x=b: x = U' \ b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [i] ; */
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_uhsolve (Numeric, X, Pattern) ;
}
else if (sys == UMFPACK_Uat)
{
/* ------------------------------------------------------------------ */
/* Solve U'x=b: x = U' \ b */
/* ------------------------------------------------------------------ */
for (i = 0 ; i < n ; i++)
{
/* X [i] = B [i] ; */
ASSIGN (X [i], Bx, Bz, i, Bsplit) ;
}
flops = UMF_utsolve (Numeric, X, Pattern) ;
}
else
{
return (UMFPACK_ERROR_invalid_system) ;
}
#ifdef COMPLEX
/* copy the solution back, from Entry X [ ] to double Xx [ ] and Xz [ ] */
if (AXsplit)
{
for (i = 0 ; i < n ; i++)
{
Xx [i] = REAL_COMPONENT (X [i]) ;
Xz [i] = IMAG_COMPONENT (X [i]) ;
}
}
#endif
/* return UMFPACK_OK, or UMFPACK_WARNING_singular_matrix */
/* Note that systems involving just L will return UMFPACK_OK */
Info [UMFPACK_SOLVE_FLOPS] = flops ;
return (status) ;
}