GLOBAL double UMF_symbolic_usage
(
Int n_row,
Int n_col,
Int nchains,
Int nfr,
Int esize, /* zero if no dense rows. Otherwise, equal to the
* number of non-singleton, non-empty columns */
Int prefer_diagonal
)
{
double units ;
units =
DUNITS (SymbolicType, 1) /* Symbolic structure */
+ 2 * DUNITS (Int, n_col+1) /* Cperm_init, Cdeg */
+ 2 * DUNITS (Int, n_row+1) /* Rperm_init, Rdeg */
+ 3 * DUNITS (Int, nchains+1) /* Chain_ */
+ 4 * DUNITS (Int, nfr+1) ; /* Front_ */
/* if dense rows are present */
units += DUNITS (Int, esize) ; /* Esize */
/* for diagonal pivoting */
if (prefer_diagonal)
{
units += DUNITS (Int, n_col+1) ; /* Diagonal_map */
}
return (units) ;
}
size_t KLU_kernel_factor /* 0 if failure, size of LU if OK */
(
/* inputs, not modified */
Int n, /* A is n-by-n. n must be > 0. */
Int Ap [ ], /* size n+1, column pointers for A */
Int Ai [ ], /* size nz = Ap [n], row indices for A */
Entry Ax [ ], /* size nz, values of A */
Int Q [ ], /* size n, optional column permutation */
double Lsize, /* estimate of number of nonzeros in L */
/* outputs, not defined on input */
Unit **p_LU, /* row indices and values of L and U */
Entry Udiag [ ], /* size n, diagonal of U */
Int Llen [ ], /* size n, column length of L */
Int Ulen [ ], /* size n, column length of U */
Int Lip [ ], /* size n, column pointers for L */
Int Uip [ ], /* size n, column pointers for U */
Int P [ ], /* row permutation, size n */
Int *lnz, /* size of L */
Int *unz, /* size of U */
/* workspace, undefined on input */
Entry *X, /* size n double's, zero on output */
Int *Work, /* size 5n Int's */
/* inputs, not modified on output */
Int k1, /* the block of A is from k1 to k2-1 */
Int PSinv [ ], /* inverse of P from symbolic factorization */
double Rs [ ], /* scale factors for A */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ],
/* --------------- */
KLU_common *Common
)
{
double maxlnz, dunits ;
Unit *LU ;
Int *Pinv, *Lpend, *Stack, *Flag, *Ap_pos, *W ;
Int lsize, usize, anz, ok ;
size_t lusize ;
ASSERT (Common != NULL) ;
/* ---------------------------------------------------------------------- */
/* get control parameters, or use defaults */
/* ---------------------------------------------------------------------- */
n = MAX (1, n) ;
anz = Ap [n+k1] - Ap [k1] ;
if (Lsize <= 0)
{
Lsize = -Lsize ;
Lsize = MAX (Lsize, 1.0) ;
lsize = Lsize * anz + n ;
}
else
{
lsize = Lsize ;
}
usize = lsize ;
lsize = MAX (n+1, lsize) ;
usize = MAX (n+1, usize) ;
maxlnz = (((double) n) * ((double) n) + ((double) n)) / 2. ;
maxlnz = MIN (maxlnz, ((double) INT_MAX)) ;
lsize = MIN (maxlnz, lsize) ;
usize = MIN (maxlnz, usize) ;
PRINTF (("Welcome to klu: n %d anz %d k1 %d lsize %d usize %d maxlnz %g\n",
n, anz, k1, lsize, usize, maxlnz)) ;
/* ---------------------------------------------------------------------- */
/* allocate workspace and outputs */
/* ---------------------------------------------------------------------- */
/* return arguments are not yet assigned */
*p_LU = (Unit *) NULL ;
/* these computations are safe from size_t overflow */
W = Work ;
Pinv = (Int *) W ; W += n ;
Stack = (Int *) W ; W += n ;
Flag = (Int *) W ; W += n ;
Lpend = (Int *) W ; W += n ;
Ap_pos = (Int *) W ; W += n ;
dunits = DUNITS (Int, lsize) + DUNITS (Entry, lsize) +
DUNITS (Int, usize) + DUNITS (Entry, usize) ;
lusize = (size_t) dunits ;
ok = !INT_OVERFLOW (dunits) ;
LU = ok ? KLU_malloc (lusize, sizeof (Unit), Common) : NULL ;
if (LU == NULL)
{
/* out of memory, or problem too large */
Common->status = KLU_OUT_OF_MEMORY ;
lusize = 0 ;
return (lusize) ;
}
/* ---------------------------------------------------------------------- */
/* factorize */
/* ---------------------------------------------------------------------- */
/* with pruning, and non-recursive depth-first-search */
lusize = KLU_kernel (n, Ap, Ai, Ax, Q, lusize,
Pinv, P, &LU, Udiag, Llen, Ulen, Lip, Uip, lnz, unz,
X, Stack, Flag, Ap_pos, Lpend,
k1, PSinv, Rs, Offp, Offi, Offx, Common) ;
/* ---------------------------------------------------------------------- */
/* return LU factors, or return nothing if an error occurred */
/* ---------------------------------------------------------------------- */
if (Common->status < KLU_OK)
{
LU = KLU_free (LU, lusize, sizeof (Unit), Common) ;
lusize = 0 ;
}
*p_LU = LU ;
PRINTF ((" in klu noffdiag %d\n", Common->noffdiag)) ;
return (lusize) ;
}
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_tuple_lengths /* return memory usage */
(
NumericType *Numeric,
WorkType *Work,
double *p_dusage /* output argument */
)
{
/* ---------------------------------------------------------------------- */
/* local variables */
/* ---------------------------------------------------------------------- */
double dusage ;
Int e, nrows, ncols, nel, i, *Rows, *Cols, row, col, n_row, n_col, *E,
*Row_degree, *Row_tlen, *Col_degree, *Col_tlen, usage, n1 ;
Element *ep ;
Unit *p ;
/* ---------------------------------------------------------------------- */
/* get parameters */
/* ---------------------------------------------------------------------- */
E = Work->E ;
Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro only */
Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro only */
Row_tlen = Numeric->Uilen ;
Col_tlen = Numeric->Lilen ;
n_row = Work->n_row ;
n_col = Work->n_col ;
n1 = Work->n1 ;
nel = Work->nel ;
DEBUG3 (("TUPLE_LENGTHS: n_row "ID" n_col "ID" nel "ID"\n",
n_row, n_col, nel)) ;
ASSERT (nel < Work->elen) ;
/* tuple list lengths already initialized to zero */
/* ---------------------------------------------------------------------- */
/* scan each element: count tuple list lengths (include element 0) */
/* ---------------------------------------------------------------------- */
for (e = 1 ; e <= nel ; e++) /* for all elements, in any order */
{
if (E [e])
{
#ifndef NDEBUG
UMF_dump_element (Numeric, Work, e, FALSE) ;
#endif
p = Numeric->Memory + E [e] ;
GET_ELEMENT_PATTERN (ep, p, Cols, Rows, ncols) ;
nrows = ep->nrows ;
for (i = 0 ; i < nrows ; i++)
{
row = Rows [i] ;
ASSERT (row == EMPTY || (row >= n1 && row < n_row)) ;
if (row >= n1)
{
ASSERT (NON_PIVOTAL_ROW (row)) ;
Row_tlen [row] ++ ;
}
}
for (i = 0 ; i < ncols ; i++)
{
col = Cols [i] ;
ASSERT (col == EMPTY || (col >= n1 && col < n_col)) ;
if (col >= n1)
{
ASSERT (NON_PIVOTAL_COL (col)) ;
Col_tlen [col] ++ ;
}
}
}
}
/* note: tuple lengths are now modified, but the tuple lists are not */
/* updated to reflect that fact. */
/* ---------------------------------------------------------------------- */
/* determine the required memory to hold all the tuple lists */
/* ---------------------------------------------------------------------- */
DEBUG0 (("UMF_build_tuples_usage\n")) ;
usage = 0 ;
dusage = 0 ;
ASSERT (Col_tlen && Col_degree) ;
for (col = n1 ; col < n_col ; col++)
{
if (NON_PIVOTAL_COL (col))
{
usage += 1 + UNITS (Tuple, TUPLES (Col_tlen [col])) ;
dusage += 1 + DUNITS (Tuple, TUPLES (Col_tlen [col])) ;
DEBUG0 ((" col: "ID" tlen "ID" usage so far: "ID"\n",
col, Col_tlen [col], usage)) ;
}
}
ASSERT (Row_tlen && Row_degree) ;
for (row = n1 ; row < n_row ; row++)
{
if (NON_PIVOTAL_ROW (row))
{
usage += 1 + UNITS (Tuple, TUPLES (Row_tlen [row])) ;
dusage += 1 + DUNITS (Tuple, TUPLES (Row_tlen [row])) ;
DEBUG0 ((" row: "ID" tlen "ID" usage so far: "ID"\n",
row, Row_tlen [row], usage)) ;
}
}
DEBUG0 (("UMF_build_tuples_usage "ID" %g\n", usage, dusage)) ;
*p_dusage = dusage ;
return (usage) ;
}
size_t TRILINOS_KLU_kernel /* final size of LU on output */
(
/* input, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers for A */
Int Ai [ ], /* size nz = Ap [n], row indices for A */
Entry Ax [ ], /* size nz, values of A */
Int Q [ ], /* size n, optional input permutation */
size_t lusize, /* initial size of LU on input */
/* output, not defined on input */
Int Pinv [ ], /* size n, inverse row permutation, where Pinv [i] = k if
* row i is the kth pivot row */
Int P [ ], /* size n, row permutation, where P [k] = i if row i is the
* kth pivot row. */
Unit **p_LU, /* LU array, size lusize on input */
Entry Udiag [ ], /* size n, diagonal of U */
Int Llen [ ], /* size n, column length of L */
Int Ulen [ ], /* size n, column length of U */
Int Lip [ ], /* size n, column pointers for L */
Int Uip [ ], /* size n, column pointers for U */
Int *lnz, /* size of L*/
Int *unz, /* size of U*/
/* workspace, not defined on input */
Entry X [ ], /* size n, undefined on input, zero on output */
/* workspace, not defined on input or output */
Int Stack [ ], /* size n */
Int Flag [ ], /* size n */
Int Ap_pos [ ], /* size n */
/* other workspace: */
Int Lpend [ ], /* size n workspace, for pruning only */
/* inputs, not modified on output */
Int k1, /* the block of A is from k1 to k2-1 */
Int PSinv [ ], /* inverse of P from symbolic factorization */
double Rs [ ], /* scale factors for A */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ],
/* --------------- */
TRILINOS_KLU_common *Common
)
{
Entry pivot ;
double abs_pivot, xsize, nunits, tol, memgrow ;
Entry *Ux ;
Int *Li, *Ui ;
Unit *LU ; /* LU factors (pattern and values) */
Int k, p, i, j, pivrow, kbar, diagrow, firstrow, lup, top, scale, len ;
size_t newlusize ;
#ifndef NDEBUG
Entry *Lx ;
#endif
ASSERT (Common != NULL) ;
scale = Common->scale ;
tol = Common->tol ;
memgrow = Common->memgrow ;
*lnz = 0 ;
*unz = 0 ;
/* ---------------------------------------------------------------------- */
/* get initial Li, Lx, Ui, and Ux */
/* ---------------------------------------------------------------------- */
PRINTF (("input: lusize %d \n", lusize)) ;
ASSERT (lusize > 0) ;
LU = *p_LU ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
firstrow = 0 ;
lup = 0 ;
for (k = 0 ; k < n ; k++)
{
/* X [k] = 0 ; */
CLEAR (X [k]) ;
Flag [k] = EMPTY ;
Lpend [k] = EMPTY ; /* flag k as not pruned */
}
/* ---------------------------------------------------------------------- */
/* mark all rows as non-pivotal and determine initial diagonal mapping */
/* ---------------------------------------------------------------------- */
/* PSinv does the symmetric permutation, so don't do it here */
for (k = 0 ; k < n ; k++)
{
P [k] = k ;
Pinv [k] = FLIP (k) ; /* mark all rows as non-pivotal */
}
/* initialize the construction of the off-diagonal matrix */
Offp [0] = 0 ;
/* P [k] = row means that UNFLIP (Pinv [row]) = k, and visa versa.
* If row is pivotal, then Pinv [row] >= 0. A row is initially "flipped"
* (Pinv [k] < EMPTY), and then marked "unflipped" when it becomes
* pivotal. */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
PRINTF (("Initial P [%d] = %d\n", k, P [k])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* factorize */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n ; k++)
{
PRINTF (("\n\n==================================== k: %d\n", k)) ;
/* ------------------------------------------------------------------ */
/* determine if LU factors have grown too big */
/* ------------------------------------------------------------------ */
/* (n - k) entries for L and k entries for U */
nunits = DUNITS (Int, n - k) + DUNITS (Int, k) +
DUNITS (Entry, n - k) + DUNITS (Entry, k) ;
/* LU can grow by at most 'nunits' entries if the column is dense */
PRINTF (("lup %d lusize %g lup+nunits: %g\n", lup, (double) lusize,
lup+nunits));
xsize = ((double) lup) + nunits ;
if (xsize > (double) lusize)
{
/* check here how much to grow */
xsize = (memgrow * ((double) lusize) + 4*n + 1) ;
if (INT_OVERFLOW (xsize))
{
PRINTF (("Matrix is too large (Int overflow)\n")) ;
Common->status = TRILINOS_KLU_TOO_LARGE ;
return (lusize) ;
}
newlusize = memgrow * lusize + 2*n + 1 ;
/* Future work: retry mechanism in case of malloc failure */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
Common->nrealloc++ ;
*p_LU = LU ;
if (Common->status == TRILINOS_KLU_OUT_OF_MEMORY)
{
PRINTF (("Matrix is too large (LU)\n")) ;
return (lusize) ;
}
lusize = newlusize ;
PRINTF (("inc LU to %d done\n", lusize)) ;
}
/* ------------------------------------------------------------------ */
/* start the kth column of L and U */
/* ------------------------------------------------------------------ */
Lip [k] = lup ;
/* ------------------------------------------------------------------ */
/* compute the nonzero pattern of the kth column of L and U */
/* ------------------------------------------------------------------ */
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] < k) ;
/* ASSERT (X [i] == 0) ; */
ASSERT (IS_ZERO (X [i])) ;
}
#endif
top = lsolve_symbolic (n, k, Ap, Ai, Q, Pinv, Stack, Flag,
Lpend, Ap_pos, LU, lup, Llen, Lip, k1, PSinv) ;
#ifndef NDEBUG
PRINTF (("--- in U:\n")) ;
for (p = top ; p < n ; p++)
{
PRINTF (("pattern of X for U: %d : %d pivot row: %d\n",
p, Stack [p], Pinv [Stack [p]])) ;
ASSERT (Flag [Stack [p]] == k) ;
}
PRINTF (("--- in L:\n")) ;
Li = (Int *) (LU + Lip [k]);
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("pattern of X in L: %d : %d pivot row: %d\n",
p, Li [p], Pinv [Li [p]])) ;
ASSERT (Flag [Li [p]] == k) ;
}
p = 0 ;
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] <= k) ;
if (Flag [i] == k) p++ ;
}
#endif
/* ------------------------------------------------------------------ */
/* get the column of the matrix to factorize and scatter into X */
/* ------------------------------------------------------------------ */
construct_column (k, Ap, Ai, Ax, Q, X,
k1, PSinv, Rs, scale, Offp, Offi, Offx) ;
/* ------------------------------------------------------------------ */
/* compute the numerical values of the kth column (s = L \ A (:,k)) */
/* ------------------------------------------------------------------ */
lsolve_numeric (Pinv, LU, Stack, Lip, top, n, Llen, X) ;
#ifndef NDEBUG
for (p = top ; p < n ; p++)
{
PRINTF (("X for U %d : ", Stack [p])) ;
PRINT_ENTRY (X [Stack [p]]) ;
}
Li = (Int *) (LU + Lip [k]) ;
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("X for L %d : ", Li [p])) ;
PRINT_ENTRY (X [Li [p]]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* partial pivoting with diagonal preference */
/* ------------------------------------------------------------------ */
/* determine what the "diagonal" is */
diagrow = P [k] ; /* might already be pivotal */
PRINTF (("k %d, diagrow = %d, UNFLIP (diagrow) = %d\n",
k, diagrow, UNFLIP (diagrow))) ;
/* find a pivot and scale the pivot column */
if (!lpivot (diagrow, &pivrow, &pivot, &abs_pivot, tol, X, LU, Lip,
Llen, k, n, Pinv, &firstrow, Common))
{
/* matrix is structurally or numerically singular */
Common->status = TRILINOS_KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (lusize) ;
}
}
/* we now have a valid pivot row, even if the column has NaN's or
* has no entries on or below the diagonal at all. */
PRINTF (("\nk %d : Pivot row %d : ", k, pivrow)) ;
PRINT_ENTRY (pivot) ;
ASSERT (pivrow >= 0 && pivrow < n) ;
ASSERT (Pinv [pivrow] < 0) ;
/* set the Uip pointer */
Uip [k] = Lip [k] + UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
/* move the lup pointer to the position where indices of U
* should be stored */
lup += UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
Ulen [k] = n - top ;
/* extract Stack [top..n-1] to Ui and the values to Ux and clear X */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = top, i = 0 ; p < n ; p++, i++)
{
j = Stack [p] ;
Ui [i] = Pinv [j] ;
Ux [i] = X [j] ;
CLEAR (X [j]) ;
}
/* position the lu index at the starting point for next column */
lup += UNITS (Int, Ulen [k]) + UNITS (Entry, Ulen [k]) ;
/* U(k,k) = pivot */
Udiag [k] = pivot ;
/* ------------------------------------------------------------------ */
/* log the pivot permutation */
/* ------------------------------------------------------------------ */
ASSERT (UNFLIP (Pinv [diagrow]) < n) ;
ASSERT (P [UNFLIP (Pinv [diagrow])] == diagrow) ;
if (pivrow != diagrow)
{
/* an off-diagonal pivot has been chosen */
Common->noffdiag++ ;
PRINTF ((">>>>>>>>>>>>>>>>> pivrow %d k %d off-diagonal\n",
pivrow, k)) ;
if (Pinv [diagrow] < 0)
{
/* the former diagonal row index, diagrow, has not yet been
* chosen as a pivot row. Log this diagrow as the "diagonal"
* entry in the column kbar for which the chosen pivot row,
* pivrow, was originally logged as the "diagonal" */
kbar = FLIP (Pinv [pivrow]) ;
P [kbar] = diagrow ;
Pinv [diagrow] = FLIP (kbar) ;
}
}
P [k] = pivrow ;
Pinv [pivrow] = k ;
#ifndef NDEBUG
for (i = 0 ; i < n ; i++) { ASSERT (IS_ZERO (X [i])) ;}
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of U: %d : ", k, Ui [p])) ;
PRINT_ENTRY (Ux [p]) ;
}
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of L: %d : ", k, Li [p])) ;
PRINT_ENTRY (Lx [p]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* symmetric pruning */
/* ------------------------------------------------------------------ */
prune (Lpend, Pinv, k, pivrow, LU, Uip, Lip, Ulen, Llen) ;
*lnz += Llen [k] + 1 ; /* 1 added to lnz for diagonal */
*unz += Ulen [k] + 1 ; /* 1 added to unz for diagonal */
}
/* ---------------------------------------------------------------------- */
/* finalize column pointers for L and U, and put L in the pivotal order */
/* ---------------------------------------------------------------------- */
for (p = 0 ; p < n ; p++)
{
Li = (Int *) (LU + Lip [p]) ;
for (i = 0 ; i < Llen [p] ; i++)
{
Li [i] = Pinv [Li [i]] ;
}
}
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
PRINTF (("P [%d] = %d Pinv [%d] = %d\n", i, P [i], i, Pinv [i])) ;
}
for (i = 0 ; i < n ; i++)
{
ASSERT (Pinv [i] >= 0 && Pinv [i] < n) ;
ASSERT (P [i] >= 0 && P [i] < n) ;
ASSERT (P [Pinv [i]] == i) ;
ASSERT (IS_ZERO (X [i])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* shrink the LU factors to just the required size */
/* ---------------------------------------------------------------------- */
newlusize = lup ;
ASSERT ((size_t) newlusize <= lusize) ;
/* this cannot fail, since the block is descreasing in size */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
*p_LU = LU ;
return (newlusize) ;
}
