static void construct_column
(
/* inputs, not modified on output */
Int k, /* the column of A (or the column of the block) to get */
Int Ap [ ],
Int Ai [ ],
Entry Ax [ ],
Int Q [ ], /* column pre-ordering */
/* zero on input, modified on output */
Entry X [ ],
/* ---- the following are only used in the TRILINOS_BTF case --- */
/* 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 */
Int scale, /* 0: no scaling, nonzero: scale the rows with Rs */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ]
)
{
Entry aik ;
Int i, p, pend, oldcol, kglobal, poff, oldrow ;
/* ---------------------------------------------------------------------- */
/* Scale and scatter the column into X. */
/* ---------------------------------------------------------------------- */
kglobal = k + k1 ; /* column k of the block is col kglobal of A */
poff = Offp [kglobal] ; /* start of off-diagonal column */
oldcol = Q [kglobal] ;
pend = Ap [oldcol+1] ;
if (scale <= 0)
{
/* no scaling */
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
i = PSinv [oldrow] - k1 ;
aik = Ax [p] ;
if (i < 0)
{
/* this is an entry in the off-diagonal part */
Offi [poff] = oldrow ;
Offx [poff] = aik ;
poff++ ;
}
else
{
/* (i,k) is an entry in the block. scatter into X */
X [i] = aik ;
}
}
}
else
{
/* row scaling */
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
i = PSinv [oldrow] - k1 ;
aik = Ax [p] ;
SCALE_DIV (aik, Rs [oldrow]) ;
if (i < 0)
{
/* this is an entry in the off-diagonal part */
Offi [poff] = oldrow ;
Offx [poff] = aik ;
poff++ ;
}
else
{
/* (i,k) is an entry in the block. scatter into X */
X [i] = aik ;
}
}
}
Offp [kglobal+1] = poff ; /* start of the next col of off-diag part */
}
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_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) ;
}
