Int KLU_valid_LU (Int n, Int flag_test_start_ptr, Int Xip [ ],
Int Xlen [ ], Unit LU [ ])
{
Int *Xi ;
Entry *Xx ;
Int j, p1, p2, i, p, len ;
PRINTF (("\ncolumn oriented matrix, n = %d\n", n)) ;
if (n <= 0)
{
PRINTF (("n must be >= 0: %d\n", n)) ;
return (FALSE) ;
}
if (flag_test_start_ptr && Xip [0] != 0)
{
/* column pointers must start at Xip [0] = 0*/
PRINTF (("column 0 pointer bad\n")) ;
return (FALSE) ;
}
for (j = 0 ; j < n ; j++)
{
p1 = Xip [j] ;
PRINTF (("\nColumn of factor: %d p1: %d ", j, p1)) ;
if (j < n-1)
{
p2 = Xip [j+1] ;
PRINTF (("p2: %d ", p2)) ;
if (p1 > p2)
{
/* column pointers must be ascending */
PRINTF (("column %d pointer bad\n", j)) ;
return (FALSE) ;
}
}
PRINTF (("\n")) ;
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
i = Xi [p] ;
PRINTF (("row: %d", i)) ;
if (i < 0 || i >= n)
{
/* row index out of range */
PRINTF (("index out of range, col %d row %d\n", j, i)) ;
return (FALSE) ;
}
if (Xx != (Entry *) NULL)
{
PRINT_ENTRY (Xx [p]) ;
}
PRINTF (("\n")) ;
}
}
return (TRUE) ;
}
Int KLU_valid (Int n, Int Ap [ ], Int Ai [ ], Entry Ax [ ])
{
Int nz, j, p1, p2, i, p ;
PRINTF (("\ncolumn oriented matrix, n = %d\n", n)) ;
if (n <= 0)
{
PRINTF (("n must be >= 0: %d\n", n)) ;
return (FALSE) ;
}
nz = Ap [n] ;
if (Ap [0] != 0 || nz < 0)
{
/* column pointers must start at Ap [0] = 0, and Ap [n] must be >= 0 */
PRINTF (("column 0 pointer bad or nz < 0\n")) ;
return (FALSE) ;
}
for (j = 0 ; j < n ; j++)
{
p1 = Ap [j] ;
p2 = Ap [j+1] ;
PRINTF (("\nColumn: %d p1: %d p2: %d\n", j, p1, p2)) ;
if (p1 > p2)
{
/* column pointers must be ascending */
PRINTF (("column %d pointer bad\n", j)) ;
return (FALSE) ;
}
for (p = p1 ; p < p2 ; p++)
{
i = Ai [p] ;
PRINTF (("row: %d", i)) ;
if (i < 0 || i >= n)
{
/* row index out of range */
PRINTF (("index out of range, col %d row %d\n", j, i)) ;
return (FALSE) ;
}
if (Ax != (Entry *) NULL)
{
PRINT_ENTRY (Ax [p]) ;
}
PRINTF (("\n")) ;
}
}
return (TRUE) ;
}
PRIVATE void print_value
(
Int i,
const double Xx [ ],
const double Xz [ ], /* used for complex case only */
Int scalar /* if true, then print real part only */
)
{
Entry xi ;
/* if Xz is null, then X is in "merged" format (compatible with Entry, */
/* and ANSI C99 double _Complex type). */
PRINTF ((" "ID" :", INDEX (i))) ;
if (scalar)
{
PRINT_SCALAR (Xx [i]) ;
}
else
{
ASSIGN (xi, Xx, Xz, i, SPLIT (Xz)) ;
PRINT_ENTRY (xi) ;
}
PRINTF (("\n")) ;
}
GLOBAL Int UMFPACK_report_matrix
(
Int n_row,
Int n_col,
const Int Ap [ ],
const Int Ai [ ],
const double Ax [ ],
#ifdef COMPLEX
const double Az [ ],
#endif
Int col_form, /* 1: column form, 0: row form */
const double Control [UMFPACK_CONTROL]
)
{
Entry a ;
Int prl, i, k, length, ilast, p, nz, prl1, p1, p2, n, n_i, do_values ;
char *vector_kind, *index_kind ;
#ifdef COMPLEX
Int split = SPLIT (Az) ;
#endif
/* ---------------------------------------------------------------------- */
/* determine the form, and check if inputs exist */
/* ---------------------------------------------------------------------- */
prl = GET_CONTROL (UMFPACK_PRL, UMFPACK_DEFAULT_PRL) ;
if (prl <= 2)
{
return (UMFPACK_OK) ;
}
if (col_form)
{
vector_kind = "column" ; /* column vectors */
index_kind = "row" ; /* with row indices */
n = n_col ;
n_i = n_row ;
}
else
{
vector_kind = "row" ; /* row vectors */
index_kind = "column" ; /* with column indices */
n = n_row ;
n_i = n_col ;
}
PRINTF (("%s-form matrix, n_row "ID" n_col "ID", ",
vector_kind, n_row, n_col)) ;
if (n_row <= 0 || n_col <= 0)
{
PRINTF (("ERROR: n_row <= 0 or n_col <= 0\n\n")) ;
return (UMFPACK_ERROR_n_nonpositive) ;
}
if (!Ap)
{
PRINTF (("ERROR: Ap missing\n\n")) ;
return (UMFPACK_ERROR_argument_missing) ;
}
nz = Ap [n] ;
PRINTF (("nz = "ID". ", nz)) ;
if (nz < 0)
{
PRINTF (("ERROR: number of entries < 0\n\n")) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
if (Ap [0] != 0)
{
PRINTF (("ERROR: Ap ["ID"] = "ID" must be "ID"\n\n",
(Int) INDEX (0), INDEX (Ap [0]), (Int) INDEX (0))) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
if (!Ai)
{
PRINTF (("ERROR: Ai missing\n\n")) ;
return (UMFPACK_ERROR_argument_missing) ;
}
do_values = Ax != (double *) NULL ;
PRINTF4 (("\n")) ;
/* ---------------------------------------------------------------------- */
/* check the row/column pointers, Ap */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n ; k++)
{
if (Ap [k] < 0)
{
PRINTF (("ERROR: Ap ["ID"] < 0\n\n", INDEX (k))) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
if (Ap [k] > nz)
{
PRINTF (("ERROR: Ap ["ID"] > size of Ai\n\n", INDEX (k))) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
}
for (k = 0 ; k < n ; k++)
{
length = Ap [k+1] - Ap [k] ;
if (length < 0)
{
PRINTF (("ERROR: # entries in %s "ID" is < 0\n\n",
vector_kind, INDEX (k))) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
}
/* ---------------------------------------------------------------------- */
/* print each vector */
/* ---------------------------------------------------------------------- */
prl1 = prl ;
for (k = 0 ; k < n ; k++)
{
/* if prl is 4, print the first 10 entries of the first 10 vectors */
if (k < 10)
{
prl = prl1 ;
}
/* get the vector pointers */
p1 = Ap [k] ;
p2 = Ap [k+1] ;
length = p2 - p1 ;
PRINTF4 (("\n %s "ID": start: "ID" end: "ID" entries: "ID"\n",
vector_kind, INDEX (k), p1, p2-1, length)) ;
ilast = EMPTY ;
for (p = p1 ; p < p2 ; p++)
{
i = Ai [p] ;
PRINTF4 (("\t%s "ID" ", index_kind, INDEX (i))) ;
if (do_values && prl >= 4)
{
PRINTF ((":")) ;
ASSIGN (a, Ax, Az, p, split) ;
PRINT_ENTRY (a) ;
}
if (i < 0 || i >= n_i)
{
PRINTF ((" ERROR: %s index "ID" out of range in %s "ID"\n\n",
index_kind, INDEX (i), vector_kind, INDEX (k))) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
if (i <= ilast)
{
PRINTF ((" ERROR: %s index "ID" out of order (or duplicate) in "
"%s "ID"\n\n", index_kind, INDEX (i),
vector_kind, INDEX (k))) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
PRINTF4 (("\n")) ;
/* truncate printout, but continue to check matrix */
if (prl == 4 && (p - p1) == 9 && length > 10)
{
PRINTF4 (("\t...\n")) ;
prl-- ;
}
ilast = i ;
}
/* truncate printout, but continue to check matrix */
if (prl == 4 && k == 9 && n > 10)
{
PRINTF4 (("\n ...\n")) ;
prl-- ;
}
}
prl = prl1 ;
/* ---------------------------------------------------------------------- */
/* return the status of the matrix */
/* ---------------------------------------------------------------------- */
PRINTF4 ((" %s-form matrix ", vector_kind)) ;
PRINTF (("OK\n\n")) ;
return (UMFPACK_OK) ;
}
PRIVATE Int report_U
(
NumericType *Numeric,
Int Pattern [ ],
Int prl
)
{
/* ---------------------------------------------------------------------- */
Int k, deg, j, *ip, col, *Upos, *Uilen, k1, prl1, pos,
*Uip, n_col, ulen, p, newUchain, up, npiv, n1, *Ui ;
Entry *xp, *Uval ;
/* ---------------------------------------------------------------------- */
ASSERT (prl >= 3) ;
n_col = Numeric->n_col ;
npiv = Numeric->npiv ;
n1 = Numeric->n1 ;
Upos = Numeric->Upos ;
Uilen = Numeric->Uilen ;
Uip = Numeric->Uip ;
prl1 = prl ;
PRINTF4 ((
"\nU in Numeric object, in row-oriented compressed-pattern form:\n"
" Diagonal is stored separately.\n")) ;
ASSERT (Pattern != (Int *) NULL) ;
k1 = 12 ;
/* ---------------------------------------------------------------------- */
/* print the sparse part of U */
/* ---------------------------------------------------------------------- */
deg = Numeric->ulen ;
if (deg > 0)
{
/* make last pivot row of U (singular matrices only) */
for (j = 0 ; j < deg ; j++)
{
Pattern [j] = Numeric->Upattern [j] ;
}
}
PRINTF4 (("\n row "ID": length "ID". End of Uchain.\n", INDEX (npiv-1),
deg)) ;
for (k = npiv-1 ; k >= n1 ; k--)
{
/* ------------------------------------------------------------------ */
/* print row k of U */
/* ------------------------------------------------------------------ */
/* if prl is 3, print the first 10 entries of the first 10 columns */
if (k1 > 0)
{
prl = prl1 ;
}
up = Uip [k] ;
ulen = Uilen [k] ;
if (ulen < 0)
{
return (FALSE) ;
}
newUchain = (up < 0) ;
if (newUchain)
{
up = -up ;
p = up + UNITS (Int, ulen) ;
}
else
{
p = up ;
}
xp = (Entry *) (Numeric->Memory + p) ;
if (deg > 0 && (p + (Int) UNITS (Entry, deg) > Numeric->size))
{
return (FALSE) ;
}
for (j = 0 ; j < deg ; j++)
{
col = Pattern [j] ;
PRINTF4 (("\tcol "ID" :", INDEX (col))) ;
if (prl >= 4) PRINT_ENTRY (*xp) ;
if (col <= k || col >= n_col)
{
return (FALSE) ;
}
PRINTF4 (("\n")) ;
xp++ ;
/* truncate printout, but continue to check U */
if (prl == 4 && j == 9 && deg > 10)
{
PRINTF (("\t...\n")) ;
prl-- ;
}
}
/* ------------------------------------------------------------------ */
/* make row k-1 of U in Pattern [0..deg-1] */
/* ------------------------------------------------------------------ */
if (k1-- > 0)
{
prl = prl1 ;
}
else if (prl == 4)
{
PRINTF ((" ...\n")) ;
prl-- ;
}
if (k > 0)
{
PRINTF4 (("\n row "ID": ", INDEX (k-1))) ;
}
if (newUchain)
{
/* next row is a new Uchain */
if (k > 0)
{
deg = ulen ;
PRINTF4 (("length "ID". End of Uchain.\n", deg)) ;
if (up + (Int) UNITS (Int, ulen) > Numeric->size)
{
return (FALSE) ;
}
ip = (Int *) (Numeric->Memory + up) ;
for (j = 0 ; j < deg ; j++)
{
Pattern [j] = *ip++ ;
}
}
}
else
{
if (ulen > 0)
{
PRINTF4 (("remove "ID" entries. ", ulen)) ;
}
deg -= ulen ;
if (deg < 0)
{
return (FALSE) ;
}
pos = Upos [k] ;
if (pos != EMPTY)
{
/* add the pivot column */
PRINTF4 (("add column "ID" at position "ID". ",
INDEX (k), INDEX (pos))) ;
if (pos < 0 || pos > deg)
{
return (FALSE) ;
}
Pattern [deg++] = Pattern [pos] ;
Pattern [pos] = k ;
}
PRINTF4 (("length "ID".\n", deg)) ;
}
}
/* ---------------------------------------------------------------------- */
/* print the singleton rows of U */
/* ---------------------------------------------------------------------- */
for (k = n1 - 1 ; k >= 0 ; k--)
{
if (k1 > 0)
{
prl = prl1 ;
}
up = Uip [k] ;
deg = Uilen [k] ;
Ui = (Int *) (Numeric->Memory + up) ;
up += UNITS (Int, deg) ;
Uval = (Entry *) (Numeric->Memory + up) ;
if (k1-- > 0)
{
prl = prl1 ;
}
else if (prl == 4)
{
PRINTF ((" ...\n")) ;
prl-- ;
}
PRINTF4 (("\n row "ID":", INDEX (k))) ;
PRINTF4 ((" length "ID".\n", deg)) ;
for (j = 0 ; j < deg ; j++)
{
col = Ui [j] ;
PRINTF4 (("\tcol "ID" : ", INDEX (col))) ;
if (prl >= 4) PRINT_ENTRY (Uval [j]) ;
if (col <= k || col >= n_col)
{
return (FALSE) ;
}
PRINTF4 (("\n")) ;
/* truncate printout, but continue to check U */
if (prl == 4 && j == 9 && deg > 10)
{
PRINTF (("\t...\n")) ;
prl-- ;
}
}
}
prl = prl1 ;
PRINTF4 (("\n")) ;
return (TRUE) ;
}
PRIVATE Int report_L
(
NumericType *Numeric,
Int Pattern [ ],
Int prl
)
{
Int k, deg, *ip, j, row, n_row, *Lpos, *Lilen, valid, k1,
*Lip, newLchain, llen, prl1, pos, lp, p, npiv, n1, *Li ;
Entry *xp, *Lval ;
/* ---------------------------------------------------------------------- */
ASSERT (prl >= 3) ;
n_row = Numeric->n_row ;
npiv = Numeric->npiv ;
n1 = Numeric->n1 ;
Lpos = Numeric->Lpos ;
Lilen = Numeric->Lilen ;
Lip = Numeric->Lip ;
prl1 = prl ;
deg = 0 ;
PRINTF4 ((
"\nL in Numeric object, in column-oriented compressed-pattern form:\n"
" Diagonal entries are all equal to 1.0 (not stored)\n")) ;
ASSERT (Pattern != (Int *) NULL) ;
/* ---------------------------------------------------------------------- */
/* print L */
/* ---------------------------------------------------------------------- */
k1 = 12 ;
/* ---------------------------------------------------------------------- */
/* print the singleton columns of L */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n1 ; k++)
{
if (k1 > 0)
{
prl = prl1 ;
}
lp = Lip [k] ;
deg = Lilen [k] ;
Li = (Int *) (Numeric->Memory + lp) ;
lp += UNITS (Int, deg) ;
Lval = (Entry *) (Numeric->Memory + lp) ;
if (k1-- > 0)
{
prl = prl1 ;
}
else if (prl == 4)
{
PRINTF ((" ...\n")) ;
prl-- ;
}
PRINTF4 (("\n column "ID":", INDEX (k))) ;
PRINTF4 ((" length "ID".\n", deg)) ;
for (j = 0 ; j < deg ; j++)
{
row = Li [j] ;
PRINTF4 (("\trow "ID" : ", INDEX (row))) ;
if (prl >= 4) PRINT_ENTRY (Lval [j]) ;
if (row <= k || row >= n_row)
{
return (FALSE) ;
}
PRINTF4 (("\n")) ;
/* truncate printout, but continue to check L */
if (prl == 4 && j == 9 && deg > 10)
{
PRINTF (("\t...\n")) ;
prl-- ;
}
}
}
/* ---------------------------------------------------------------------- */
/* print the regular columns of L */
/* ---------------------------------------------------------------------- */
for (k = n1 ; k < npiv ; k++)
{
/* if prl is 4, print the first 10 entries of the first 10 columns */
if (k1 > 0)
{
prl = prl1 ;
}
lp = Lip [k] ;
newLchain = (lp < 0) ;
if (newLchain)
{
lp = -lp ;
deg = 0 ;
}
if (k1-- > 0)
{
prl = prl1 ;
}
else if (prl == 4)
{
PRINTF ((" ...\n")) ;
prl-- ;
}
PRINTF4 (("\n column "ID":", INDEX (k))) ;
/* ------------------------------------------------------------------ */
/* make column of L in Pattern [0..deg-1] */
/* ------------------------------------------------------------------ */
/* remove pivot row */
pos = Lpos [k] ;
if (pos != EMPTY)
{
PRINTF4 ((" remove row "ID" at position "ID".",
INDEX (Pattern [pos]), INDEX (pos))) ;
valid = (!newLchain) && (deg > 0) && (pos < deg) && (pos >= 0)
&& (Pattern [pos] == k) ;
if (!valid)
{
return (FALSE) ;
}
Pattern [pos] = Pattern [--deg] ;
}
/* concatenate the pattern */
llen = Lilen [k] ;
if (llen < 0)
{
return (FALSE) ;
}
p = lp + UNITS (Int, llen) ;
xp = (Entry *) (Numeric->Memory + p) ;
if ((llen > 0 || deg > 0)
&& (p + (Int) UNITS (Entry, deg) > Numeric->size))
{
return (FALSE) ;
}
if (llen > 0)
{
PRINTF4 ((" add "ID" entries.", llen)) ;
ip = (Int *) (Numeric->Memory + lp) ;
for (j = 0 ; j < llen ; j++)
{
Pattern [deg++] = *ip++ ;
}
}
/* ------------------------------------------------------------------ */
/* print column k of L */
/* ------------------------------------------------------------------ */
PRINTF4 ((" length "ID".", deg)) ;
if (newLchain)
{
PRINTF4 ((" Start of Lchain.")) ;
}
PRINTF4 (("\n")) ;
for (j = 0 ; j < deg ; j++)
{
row = Pattern [j] ;
PRINTF4 (("\trow "ID" : ", INDEX (row))) ;
if (prl >= 4) PRINT_ENTRY (*xp) ;
if (row <= k || row >= n_row)
{
return (FALSE) ;
}
PRINTF4 (("\n")) ;
xp++ ;
/* truncate printout, but continue to check L */
if (prl == 4 && j == 9 && deg > 10)
{
PRINTF (("\t...\n")) ;
prl-- ;
}
}
}
PRINTF4 (("\n")) ;
return (TRUE) ;
}
size_t TRILINOS_KLU_kernel /* final size of LU on output */
(
/* input, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers for A */
Int Ai [ ], /* size nz = Ap [n], row indices for A */
Entry Ax [ ], /* size nz, values of A */
Int Q [ ], /* size n, optional input permutation */
size_t lusize, /* initial size of LU on input */
/* output, not defined on input */
Int Pinv [ ], /* size n, inverse row permutation, where Pinv [i] = k if
* row i is the kth pivot row */
Int P [ ], /* size n, row permutation, where P [k] = i if row i is the
* kth pivot row. */
Unit **p_LU, /* LU array, size lusize on input */
Entry Udiag [ ], /* size n, diagonal of U */
Int Llen [ ], /* size n, column length of L */
Int Ulen [ ], /* size n, column length of U */
Int Lip [ ], /* size n, column pointers for L */
Int Uip [ ], /* size n, column pointers for U */
Int *lnz, /* size of L*/
Int *unz, /* size of U*/
/* workspace, not defined on input */
Entry X [ ], /* size n, undefined on input, zero on output */
/* workspace, not defined on input or output */
Int Stack [ ], /* size n */
Int Flag [ ], /* size n */
Int Ap_pos [ ], /* size n */
/* other workspace: */
Int Lpend [ ], /* size n workspace, for pruning only */
/* inputs, not modified on output */
Int k1, /* the block of A is from k1 to k2-1 */
Int PSinv [ ], /* inverse of P from symbolic factorization */
double Rs [ ], /* scale factors for A */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ],
/* --------------- */
TRILINOS_KLU_common *Common
)
{
Entry pivot ;
double abs_pivot, xsize, nunits, tol, memgrow ;
Entry *Ux ;
Int *Li, *Ui ;
Unit *LU ; /* LU factors (pattern and values) */
Int k, p, i, j, pivrow, kbar, diagrow, firstrow, lup, top, scale, len ;
size_t newlusize ;
#ifndef NDEBUG
Entry *Lx ;
#endif
ASSERT (Common != NULL) ;
scale = Common->scale ;
tol = Common->tol ;
memgrow = Common->memgrow ;
*lnz = 0 ;
*unz = 0 ;
/* ---------------------------------------------------------------------- */
/* get initial Li, Lx, Ui, and Ux */
/* ---------------------------------------------------------------------- */
PRINTF (("input: lusize %d \n", lusize)) ;
ASSERT (lusize > 0) ;
LU = *p_LU ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
firstrow = 0 ;
lup = 0 ;
for (k = 0 ; k < n ; k++)
{
/* X [k] = 0 ; */
CLEAR (X [k]) ;
Flag [k] = EMPTY ;
Lpend [k] = EMPTY ; /* flag k as not pruned */
}
/* ---------------------------------------------------------------------- */
/* mark all rows as non-pivotal and determine initial diagonal mapping */
/* ---------------------------------------------------------------------- */
/* PSinv does the symmetric permutation, so don't do it here */
for (k = 0 ; k < n ; k++)
{
P [k] = k ;
Pinv [k] = FLIP (k) ; /* mark all rows as non-pivotal */
}
/* initialize the construction of the off-diagonal matrix */
Offp [0] = 0 ;
/* P [k] = row means that UNFLIP (Pinv [row]) = k, and visa versa.
* If row is pivotal, then Pinv [row] >= 0. A row is initially "flipped"
* (Pinv [k] < EMPTY), and then marked "unflipped" when it becomes
* pivotal. */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
PRINTF (("Initial P [%d] = %d\n", k, P [k])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* factorize */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n ; k++)
{
PRINTF (("\n\n==================================== k: %d\n", k)) ;
/* ------------------------------------------------------------------ */
/* determine if LU factors have grown too big */
/* ------------------------------------------------------------------ */
/* (n - k) entries for L and k entries for U */
nunits = DUNITS (Int, n - k) + DUNITS (Int, k) +
DUNITS (Entry, n - k) + DUNITS (Entry, k) ;
/* LU can grow by at most 'nunits' entries if the column is dense */
PRINTF (("lup %d lusize %g lup+nunits: %g\n", lup, (double) lusize,
lup+nunits));
xsize = ((double) lup) + nunits ;
if (xsize > (double) lusize)
{
/* check here how much to grow */
xsize = (memgrow * ((double) lusize) + 4*n + 1) ;
if (INT_OVERFLOW (xsize))
{
PRINTF (("Matrix is too large (Int overflow)\n")) ;
Common->status = TRILINOS_KLU_TOO_LARGE ;
return (lusize) ;
}
newlusize = memgrow * lusize + 2*n + 1 ;
/* Future work: retry mechanism in case of malloc failure */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
Common->nrealloc++ ;
*p_LU = LU ;
if (Common->status == TRILINOS_KLU_OUT_OF_MEMORY)
{
PRINTF (("Matrix is too large (LU)\n")) ;
return (lusize) ;
}
lusize = newlusize ;
PRINTF (("inc LU to %d done\n", lusize)) ;
}
/* ------------------------------------------------------------------ */
/* start the kth column of L and U */
/* ------------------------------------------------------------------ */
Lip [k] = lup ;
/* ------------------------------------------------------------------ */
/* compute the nonzero pattern of the kth column of L and U */
/* ------------------------------------------------------------------ */
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] < k) ;
/* ASSERT (X [i] == 0) ; */
ASSERT (IS_ZERO (X [i])) ;
}
#endif
top = lsolve_symbolic (n, k, Ap, Ai, Q, Pinv, Stack, Flag,
Lpend, Ap_pos, LU, lup, Llen, Lip, k1, PSinv) ;
#ifndef NDEBUG
PRINTF (("--- in U:\n")) ;
for (p = top ; p < n ; p++)
{
PRINTF (("pattern of X for U: %d : %d pivot row: %d\n",
p, Stack [p], Pinv [Stack [p]])) ;
ASSERT (Flag [Stack [p]] == k) ;
}
PRINTF (("--- in L:\n")) ;
Li = (Int *) (LU + Lip [k]);
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("pattern of X in L: %d : %d pivot row: %d\n",
p, Li [p], Pinv [Li [p]])) ;
ASSERT (Flag [Li [p]] == k) ;
}
p = 0 ;
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] <= k) ;
if (Flag [i] == k) p++ ;
}
#endif
/* ------------------------------------------------------------------ */
/* get the column of the matrix to factorize and scatter into X */
/* ------------------------------------------------------------------ */
construct_column (k, Ap, Ai, Ax, Q, X,
k1, PSinv, Rs, scale, Offp, Offi, Offx) ;
/* ------------------------------------------------------------------ */
/* compute the numerical values of the kth column (s = L \ A (:,k)) */
/* ------------------------------------------------------------------ */
lsolve_numeric (Pinv, LU, Stack, Lip, top, n, Llen, X) ;
#ifndef NDEBUG
for (p = top ; p < n ; p++)
{
PRINTF (("X for U %d : ", Stack [p])) ;
PRINT_ENTRY (X [Stack [p]]) ;
}
Li = (Int *) (LU + Lip [k]) ;
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("X for L %d : ", Li [p])) ;
PRINT_ENTRY (X [Li [p]]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* partial pivoting with diagonal preference */
/* ------------------------------------------------------------------ */
/* determine what the "diagonal" is */
diagrow = P [k] ; /* might already be pivotal */
PRINTF (("k %d, diagrow = %d, UNFLIP (diagrow) = %d\n",
k, diagrow, UNFLIP (diagrow))) ;
/* find a pivot and scale the pivot column */
if (!lpivot (diagrow, &pivrow, &pivot, &abs_pivot, tol, X, LU, Lip,
Llen, k, n, Pinv, &firstrow, Common))
{
/* matrix is structurally or numerically singular */
Common->status = TRILINOS_KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (lusize) ;
}
}
/* we now have a valid pivot row, even if the column has NaN's or
* has no entries on or below the diagonal at all. */
PRINTF (("\nk %d : Pivot row %d : ", k, pivrow)) ;
PRINT_ENTRY (pivot) ;
ASSERT (pivrow >= 0 && pivrow < n) ;
ASSERT (Pinv [pivrow] < 0) ;
/* set the Uip pointer */
Uip [k] = Lip [k] + UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
/* move the lup pointer to the position where indices of U
* should be stored */
lup += UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
Ulen [k] = n - top ;
/* extract Stack [top..n-1] to Ui and the values to Ux and clear X */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = top, i = 0 ; p < n ; p++, i++)
{
j = Stack [p] ;
Ui [i] = Pinv [j] ;
Ux [i] = X [j] ;
CLEAR (X [j]) ;
}
/* position the lu index at the starting point for next column */
lup += UNITS (Int, Ulen [k]) + UNITS (Entry, Ulen [k]) ;
/* U(k,k) = pivot */
Udiag [k] = pivot ;
/* ------------------------------------------------------------------ */
/* log the pivot permutation */
/* ------------------------------------------------------------------ */
ASSERT (UNFLIP (Pinv [diagrow]) < n) ;
ASSERT (P [UNFLIP (Pinv [diagrow])] == diagrow) ;
if (pivrow != diagrow)
{
/* an off-diagonal pivot has been chosen */
Common->noffdiag++ ;
PRINTF ((">>>>>>>>>>>>>>>>> pivrow %d k %d off-diagonal\n",
pivrow, k)) ;
if (Pinv [diagrow] < 0)
{
/* the former diagonal row index, diagrow, has not yet been
* chosen as a pivot row. Log this diagrow as the "diagonal"
* entry in the column kbar for which the chosen pivot row,
* pivrow, was originally logged as the "diagonal" */
kbar = FLIP (Pinv [pivrow]) ;
P [kbar] = diagrow ;
Pinv [diagrow] = FLIP (kbar) ;
}
}
P [k] = pivrow ;
Pinv [pivrow] = k ;
#ifndef NDEBUG
for (i = 0 ; i < n ; i++) { ASSERT (IS_ZERO (X [i])) ;}
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of U: %d : ", k, Ui [p])) ;
PRINT_ENTRY (Ux [p]) ;
}
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of L: %d : ", k, Li [p])) ;
PRINT_ENTRY (Lx [p]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* symmetric pruning */
/* ------------------------------------------------------------------ */
prune (Lpend, Pinv, k, pivrow, LU, Uip, Lip, Ulen, Llen) ;
*lnz += Llen [k] + 1 ; /* 1 added to lnz for diagonal */
*unz += Ulen [k] + 1 ; /* 1 added to unz for diagonal */
}
/* ---------------------------------------------------------------------- */
/* finalize column pointers for L and U, and put L in the pivotal order */
/* ---------------------------------------------------------------------- */
for (p = 0 ; p < n ; p++)
{
Li = (Int *) (LU + Lip [p]) ;
for (i = 0 ; i < Llen [p] ; i++)
{
Li [i] = Pinv [Li [i]] ;
}
}
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
PRINTF (("P [%d] = %d Pinv [%d] = %d\n", i, P [i], i, Pinv [i])) ;
}
for (i = 0 ; i < n ; i++)
{
ASSERT (Pinv [i] >= 0 && Pinv [i] < n) ;
ASSERT (P [i] >= 0 && P [i] < n) ;
ASSERT (P [Pinv [i]] == i) ;
ASSERT (IS_ZERO (X [i])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* shrink the LU factors to just the required size */
/* ---------------------------------------------------------------------- */
newlusize = lup ;
ASSERT ((size_t) newlusize <= lusize) ;
/* this cannot fail, since the block is descreasing in size */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
*p_LU = LU ;
return (newlusize) ;
}
GLOBAL Int UMFPACK_report_triplet
(
Int n_row,
Int n_col,
Int nz,
const Int Ti [ ],
const Int Tj [ ],
const double Tx [ ],
#ifdef COMPLEX
const double Tz [ ],
#endif
const double Control [UMFPACK_CONTROL]
)
{
Entry t ;
Int prl, prl1, k, i, j, do_values ;
#ifdef COMPLEX
Int split = SPLIT (Tz) ;
#endif
prl = GET_CONTROL (UMFPACK_PRL, UMFPACK_DEFAULT_PRL) ;
if (prl <= 2)
{
return (UMFPACK_OK) ;
}
PRINTF (("triplet-form matrix, n_row = "ID", n_col = "ID" nz = "ID". ",
n_row, n_col, nz)) ;
if (!Ti || !Tj)
{
PRINTF (("ERROR: indices not present\n\n")) ;
return (UMFPACK_ERROR_argument_missing) ;
}
if (n_row <= 0 || n_col <= 0)
{
PRINTF (("ERROR: n_row or n_col is <= 0\n\n")) ;
return (UMFPACK_ERROR_n_nonpositive) ;
}
if (nz < 0)
{
PRINTF (("ERROR: nz is < 0\n\n")) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
PRINTF4 (("\n")) ;
do_values = Tx != (double *) NULL ;
prl1 = prl ;
for (k = 0 ; k < nz ; k++)
{
i = Ti [k] ;
j = Tj [k] ;
PRINTF4 ((" "ID" : "ID" "ID" ", INDEX (k), INDEX (i), INDEX (j))) ;
if (do_values && prl >= 4)
{
ASSIGN (t, Tx, Tz, k, split) ;
PRINT_ENTRY (t) ;
}
PRINTF4 (("\n")) ;
if (i < 0 || i >= n_row || j < 0 || j >= n_col)
{
/* invalid triplet */
PRINTF (("ERROR: invalid triplet\n\n")) ;
return (UMFPACK_ERROR_invalid_matrix) ;
}
if (prl == 4 && k == 9 && nz > 10)
{
PRINTF ((" ...\n")) ;
prl-- ;
}
}
prl = prl1 ;
PRINTF4 ((" triplet-form matrix ")) ;
PRINTF (("OK\n\n")) ;
return (UMFPACK_OK) ;
}
Int KLU_refactor /* returns TRUE if successful, FALSE otherwise */
(
/* inputs, not modified */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
double Ax [ ],
KLU_symbolic<Entry, Int> *Symbolic,
/* input/output */
KLU_numeric<Entry, Int> *Numeric,
KLU_common<Entry, Int> *Common
)
{
Entry ukk, ujk, s ;
Entry *Offx, *Lx, *Ux, *X, *Az, *Udiag ;
double *Rs ;
Int *P, *Q, *R, *Pnum, *Offp, *Offi, *Ui, *Li, *Pinv, *Lip, *Uip, *Llen,
*Ulen ;
Unit **LUbx ;
Unit *LU ;
Int k1, k2, nk, k, block, oldcol, pend, oldrow, n, p, newrow, scale,
nblocks, poff, i, j, up, ulen, llen, maxblock, nzoff ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
Common->status = KLU_OK ;
if (Numeric == NULL)
{
/* invalid Numeric object */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->numerical_rank = EMPTY ;
Common->singular_col = EMPTY ;
Az = (Entry *) Ax ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
n = Symbolic->n ;
P = Symbolic->P ;
Q = Symbolic->Q ;
R = Symbolic->R ;
nblocks = Symbolic->nblocks ;
maxblock = Symbolic->maxblock ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Numeric object */
/* ---------------------------------------------------------------------- */
Pnum = Numeric->Pnum ;
Offp = Numeric->Offp ;
Offi = Numeric->Offi ;
Offx = (Entry *) Numeric->Offx ;
LUbx = (Unit **) Numeric->LUbx ;
scale = Common->scale ;
if (scale > 0)
{
/* factorization was not scaled, but refactorization is scaled */
if (Numeric->Rs == NULL)
{
Numeric->Rs = (double *)KLU_malloc (n, sizeof (double), Common) ;
if (Common->status < KLU_OK)
{
Common->status = KLU_OUT_OF_MEMORY ;
return (FALSE) ;
}
}
}
else
{
/* no scaling for refactorization; ensure Numeric->Rs is freed. This
* does nothing if Numeric->Rs is already NULL. */
Numeric->Rs = (double *) KLU_free (Numeric->Rs, n, sizeof (double), Common) ;
}
Rs = Numeric->Rs ;
Pinv = Numeric->Pinv ;
X = (Entry *) Numeric->Xwork ;
Common->nrealloc = 0 ;
Udiag = (Entry *) Numeric->Udiag ;
nzoff = Symbolic->nzoff ;
/* ---------------------------------------------------------------------- */
/* check the input matrix compute the row scale factors, Rs */
/* ---------------------------------------------------------------------- */
/* do no scale, or check the input matrix, if scale < 0 */
if (scale >= 0)
{
/* check for out-of-range indices, but do not check for duplicates */
if (!KLU_scale (scale, n, Ap, Ai, Ax, Rs, NULL, Common))
{
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* clear workspace X */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < maxblock ; k++)
{
/* X [k] = 0 */
CLEAR (X [k]) ;
}
poff = 0 ;
/* ---------------------------------------------------------------------- */
/* factor each block */
/* ---------------------------------------------------------------------- */
if (scale <= 0)
{
/* ------------------------------------------------------------------ */
/* no scaling */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* ---------------------------------------------------------- */
/* singleton case */
/* ---------------------------------------------------------- */
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
Offx [poff] = Az [p] ;
poff++ ;
}
else
{
/* singleton */
s = Az [p] ;
}
}
Udiag [k1] = s ;
}
else
{
/* ---------------------------------------------------------- */
/* construct and factor the kth block */
/* ---------------------------------------------------------- */
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* ------------------------------------------------------ */
/* scatter kth column of the block into workspace X */
/* ------------------------------------------------------ */
oldcol = Q [k+k1] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
Offx [poff] = Az [p] ;
poff++ ;
}
else
{
/* (newrow,k) is an entry in the block */
X [newrow] = Az [p] ;
}
}
/* ------------------------------------------------------ */
/* compute kth column of U, and update kth column of A */
/* ------------------------------------------------------ */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (up = 0 ; up < ulen ; up++)
{
j = Ui [up] ;
ujk = X [j] ;
/* X [j] = 0 */
CLEAR (X [j]) ;
Ux [up] = ujk ;
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p = 0 ; p < llen ; p++)
{
/* X [Li [p]] -= Lx [p] * ujk */
MULT_SUB (X [Li [p]], Lx [p], ujk) ;
}
}
/* get the diagonal entry of U */
ukk = X [k] ;
/* X [k] = 0 */
CLEAR (X [k]) ;
/* singular case */
if (IS_ZERO (ukk))
{
/* matrix is numerically singular */
Common->status = 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 (FALSE) ;
}
}
Udiag [k+k1] = ukk ;
/* gather and divide by pivot to get kth column of L */
GET_POINTER (LU, Lip, Llen, Li, Lx, k, llen) ;
for (p = 0 ; p < llen ; p++)
{
i = Li [p] ;
DIV (Lx [p], X [i], ukk) ;
CLEAR (X [i]) ;
}
}
}
}
}
else
{
/* ------------------------------------------------------------------ */
/* scaling */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* ---------------------------------------------------------- */
/* singleton case */
/* ---------------------------------------------------------- */
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
/* Offx [poff] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (Offx [poff], Az [p], Rs [oldrow]) ;
poff++ ;
}
else
{
/* singleton */
/* s = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (s, Az [p], Rs [oldrow]) ;
}
}
Udiag [k1] = s ;
}
else
{
/* ---------------------------------------------------------- */
/* construct and factor the kth block */
/* ---------------------------------------------------------- */
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* ------------------------------------------------------ */
/* scatter kth column of the block into workspace X */
/* ------------------------------------------------------ */
oldcol = Q [k+k1] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal part */
/* Offx [poff] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (Offx [poff], Az [p], Rs [oldrow]);
poff++ ;
}
else
{
/* (newrow,k) is an entry in the block */
/* X [newrow] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (X [newrow], Az [p], Rs [oldrow]) ;
}
}
/* ------------------------------------------------------ */
/* compute kth column of U, and update kth column of A */
/* ------------------------------------------------------ */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (up = 0 ; up < ulen ; up++)
{
j = Ui [up] ;
ujk = X [j] ;
/* X [j] = 0 */
CLEAR (X [j]) ;
Ux [up] = ujk ;
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p = 0 ; p < llen ; p++)
{
/* X [Li [p]] -= Lx [p] * ujk */
MULT_SUB (X [Li [p]], Lx [p], ujk) ;
}
}
/* get the diagonal entry of U */
ukk = X [k] ;
/* X [k] = 0 */
CLEAR (X [k]) ;
/* singular case */
if (IS_ZERO (ukk))
{
/* matrix is numerically singular */
Common->status = 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 (FALSE) ;
}
}
Udiag [k+k1] = ukk ;
/* gather and divide by pivot to get kth column of L */
GET_POINTER (LU, Lip, Llen, Li, Lx, k, llen) ;
for (p = 0 ; p < llen ; p++)
{
i = Li [p] ;
DIV (Lx [p], X [i], ukk) ;
CLEAR (X [i]) ;
}
}
}
}
}
/* ---------------------------------------------------------------------- */
/* permute scale factors Rs according to pivotal row order */
/* ---------------------------------------------------------------------- */
if (scale > 0)
{
for (k = 0 ; k < n ; k++)
{
/* TODO : Check. REAL(X[k]) Can be just X[k] */
/* REAL (X [k]) = Rs [Pnum [k]] ; */
X [k] = Rs [Pnum [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Rs [k] = REAL (X [k]) ;
}
}
#ifndef NDEBUGKLU2
ASSERT (Offp [n] == poff) ;
ASSERT (Symbolic->nzoff == poff) ;
PRINTF (("\n------------------- Off diagonal entries, new:\n")) ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
if (Common->status == KLU_OK)
{
PRINTF (("\n ########### KLU_BTF_REFACTOR done, nblocks %d\n",nblocks));
for (block = 0 ; block < nblocks ; block++)
{
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF ((
"\n================KLU_refactor output: k1 %d k2 %d nk %d\n",
k1, k2, nk)) ;
if (nk == 1)
{
PRINTF (("singleton ")) ;
PRINT_ENTRY (Udiag [k1]) ;
}
else
{
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
LU = (Unit *) Numeric->LUbx [block] ;
PRINTF (("\n---- L block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, TRUE, Lip, Llen, LU)) ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
PRINTF (("\n---- U block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, FALSE, Uip, Ulen, LU)) ;
}
}
}
#endif
return (TRUE) ;
}
