void
dgssvx(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
int *etree, char *equed, double *R, double *C,
SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth,
double *rcond, double *ferr, double *berr,
mem_usage_t *mem_usage, SuperLUStat_t *stat, int *info )
{
/*
* Purpose
* =======
*
* DGSSVX solves the system of linear equations A*X=B or A'*X=B, using
* the LU factorization from dgstrf(). Error bounds on the solution and
* a condition estimate are also provided. It performs the following steps:
*
* 1. If A is stored column-wise (A->Stype = SLU_NC):
*
* 1.1. If options->Equil = YES, scaling factors are computed to
* equilibrate the system:
* options->Trans = NOTRANS:
* diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
* options->Trans = TRANS:
* (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
* options->Trans = CONJ:
* (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
* Whether or not the system will be equilibrated depends on the
* scaling of the matrix A, but if equilibration is used, A is
* overwritten by diag(R)*A*diag(C) and B by diag(R)*B
* (if options->Trans=NOTRANS) or diag(C)*B (if options->Trans
* = TRANS or CONJ).
*
* 1.2. Permute columns of A, forming A*Pc, where Pc is a permutation
* matrix that usually preserves sparsity.
* For more details of this step, see sp_preorder.c.
*
* 1.3. If options->Fact != FACTORED, the LU decomposition is used to
* factor the matrix A (after equilibration if options->Equil = YES)
* as Pr*A*Pc = L*U, with Pr determined by partial pivoting.
*
* 1.4. Compute the reciprocal pivot growth factor.
*
* 1.5. If some U(i,i) = 0, so that U is exactly singular, then the
* routine returns with info = i. Otherwise, the factored form of
* A is used to estimate the condition number of the matrix A. If
* the reciprocal of the condition number is less than machine
* precision, info = A->ncol+1 is returned as a warning, but the
* routine still goes on to solve for X and computes error bounds
* as described below.
*
* 1.6. The system of equations is solved for X using the factored form
* of A.
*
* 1.7. If options->IterRefine != NOREFINE, iterative refinement is
* applied to improve the computed solution matrix and calculate
* error bounds and backward error estimates for it.
*
* 1.8. If equilibration was used, the matrix X is premultiplied by
* diag(C) (if options->Trans = NOTRANS) or diag(R)
* (if options->Trans = TRANS or CONJ) so that it solves the
* original system before equilibration.
*
* 2. If A is stored row-wise (A->Stype = SLU_NR), apply the above algorithm
* to the transpose of A:
*
* 2.1. If options->Equil = YES, scaling factors are computed to
* equilibrate the system:
* options->Trans = NOTRANS:
* diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
* options->Trans = TRANS:
* (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
* options->Trans = CONJ:
* (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
* Whether or not the system will be equilibrated depends on the
* scaling of the matrix A, but if equilibration is used, A' is
* overwritten by diag(R)*A'*diag(C) and B by diag(R)*B
* (if trans='N') or diag(C)*B (if trans = 'T' or 'C').
*
* 2.2. Permute columns of transpose(A) (rows of A),
* forming transpose(A)*Pc, where Pc is a permutation matrix that
* usually preserves sparsity.
* For more details of this step, see sp_preorder.c.
*
* 2.3. If options->Fact != FACTORED, the LU decomposition is used to
* factor the transpose(A) (after equilibration if
* options->Fact = YES) as Pr*transpose(A)*Pc = L*U with the
* permutation Pr determined by partial pivoting.
*
* 2.4. Compute the reciprocal pivot growth factor.
*
* 2.5. If some U(i,i) = 0, so that U is exactly singular, then the
* routine returns with info = i. Otherwise, the factored form
* of transpose(A) is used to estimate the condition number of the
* matrix A. If the reciprocal of the condition number
* is less than machine precision, info = A->nrow+1 is returned as
* a warning, but the routine still goes on to solve for X and
* computes error bounds as described below.
*
* 2.6. The system of equations is solved for X using the factored form
* of transpose(A).
*
* 2.7. If options->IterRefine != NOREFINE, iterative refinement is
* applied to improve the computed solution matrix and calculate
* error bounds and backward error estimates for it.
*
* 2.8. If equilibration was used, the matrix X is premultiplied by
* diag(C) (if options->Trans = NOTRANS) or diag(R)
* (if options->Trans = TRANS or CONJ) so that it solves the
* original system before equilibration.
*
* See supermatrix.h for the definition of 'SuperMatrix' structure.
*
* Arguments
* =========
*
* options (input) superlu_options_t*
* The structure defines the input parameters to control
* how the LU decomposition will be performed and how the
* system will be solved.
*
* A (input/output) SuperMatrix*
* Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
* of the linear equations is A->nrow. Currently, the type of A can be:
* Stype = SLU_NC or SLU_NR, Dtype = SLU_D, Mtype = SLU_GE.
* In the future, more general A may be handled.
*
* On entry, If options->Fact = FACTORED and equed is not 'N',
* then A must have been equilibrated by the scaling factors in
* R and/or C.
* On exit, A is not modified if options->Equil = NO, or if
* options->Equil = YES but equed = 'N' on exit.
* Otherwise, if options->Equil = YES and equed is not 'N',
* A is scaled as follows:
* If A->Stype = SLU_NC:
* equed = 'R': A := diag(R) * A
* equed = 'C': A := A * diag(C)
* equed = 'B': A := diag(R) * A * diag(C).
* If A->Stype = SLU_NR:
* equed = 'R': transpose(A) := diag(R) * transpose(A)
* equed = 'C': transpose(A) := transpose(A) * diag(C)
* equed = 'B': transpose(A) := diag(R) * transpose(A) * diag(C).
*
* perm_c (input/output) int*
* If A->Stype = SLU_NC, Column permutation vector of size A->ncol,
* which defines the permutation matrix Pc; perm_c[i] = j means
* column i of A is in position j in A*Pc.
* On exit, perm_c may be overwritten by the product of the input
* perm_c and a permutation that postorders the elimination tree
* of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
* is already in postorder.
*
* If A->Stype = SLU_NR, column permutation vector of size A->nrow,
* which describes permutation of columns of transpose(A)
* (rows of A) as described above.
*
* perm_r (input/output) int*
* If A->Stype = SLU_NC, row permutation vector of size A->nrow,
* which defines the permutation matrix Pr, and is determined
* by partial pivoting. perm_r[i] = j means row i of A is in
* position j in Pr*A.
*
* If A->Stype = SLU_NR, permutation vector of size A->ncol, which
* determines permutation of rows of transpose(A)
* (columns of A) as described above.
*
* If options->Fact = SamePattern_SameRowPerm, the pivoting routine
* will try to use the input perm_r, unless a certain threshold
* criterion is violated. In that case, perm_r is overwritten by a
* new permutation determined by partial pivoting or diagonal
* threshold pivoting.
* Otherwise, perm_r is output argument.
*
* etree (input/output) int*, dimension (A->ncol)
* Elimination tree of Pc'*A'*A*Pc.
* If options->Fact != FACTORED and options->Fact != DOFACT,
* etree is an input argument, otherwise it is an output argument.
* Note: etree is a vector of parent pointers for a forest whose
* vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
*
* equed (input/output) char*
* Specifies the form of equilibration that was done.
* = 'N': No equilibration.
* = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
* = 'C': Column equilibration, i.e., A was postmultiplied by diag(C).
* = 'B': Both row and column equilibration, i.e., A was replaced
* by diag(R)*A*diag(C).
* If options->Fact = FACTORED, equed is an input argument,
* otherwise it is an output argument.
*
* R (input/output) double*, dimension (A->nrow)
* The row scale factors for A or transpose(A).
* If equed = 'R' or 'B', A (if A->Stype = SLU_NC) or transpose(A)
* (if A->Stype = SLU_NR) is multiplied on the left by diag(R).
* If equed = 'N' or 'C', R is not accessed.
* If options->Fact = FACTORED, R is an input argument,
* otherwise, R is output.
* If options->zFact = FACTORED and equed = 'R' or 'B', each element
* of R must be positive.
*
* C (input/output) double*, dimension (A->ncol)
* The column scale factors for A or transpose(A).
* If equed = 'C' or 'B', A (if A->Stype = SLU_NC) or transpose(A)
* (if A->Stype = SLU_NR) is multiplied on the right by diag(C).
* If equed = 'N' or 'R', C is not accessed.
* If options->Fact = FACTORED, C is an input argument,
* otherwise, C is output.
* If options->Fact = FACTORED and equed = 'C' or 'B', each element
* of C must be positive.
*
* L (output) SuperMatrix*
* The factor L from the factorization
* Pr*A*Pc=L*U (if A->Stype SLU_= NC) or
* Pr*transpose(A)*Pc=L*U (if A->Stype = SLU_NR).
* Uses compressed row subscripts storage for supernodes, i.e.,
* L has types: Stype = SLU_SC, Dtype = SLU_D, Mtype = SLU_TRLU.
*
* U (output) SuperMatrix*
* The factor U from the factorization
* Pr*A*Pc=L*U (if A->Stype = SLU_NC) or
* Pr*transpose(A)*Pc=L*U (if A->Stype = SLU_NR).
* Uses column-wise storage scheme, i.e., U has types:
* Stype = SLU_NC, Dtype = SLU_D, Mtype = SLU_TRU.
*
* work (workspace/output) void*, size (lwork) (in bytes)
* User supplied workspace, should be large enough
* to hold data structures for factors L and U.
* On exit, if fact is not 'F', L and U point to this array.
*
* lwork (input) int
* Specifies the size of work array in bytes.
* = 0: allocate space internally by system malloc;
* > 0: use user-supplied work array of length lwork in bytes,
* returns error if space runs out.
* = -1: the routine guesses the amount of space needed without
* performing the factorization, and returns it in
* mem_usage->total_needed; no other side effects.
*
* See argument 'mem_usage' for memory usage statistics.
*
* B (input/output) SuperMatrix*
* B has types: Stype = SLU_DN, Dtype = SLU_D, Mtype = SLU_GE.
* On entry, the right hand side matrix.
* If B->ncol = 0, only LU decomposition is performed, the triangular
* solve is skipped.
* On exit,
* if equed = 'N', B is not modified; otherwise
* if A->Stype = SLU_NC:
* if options->Trans = NOTRANS and equed = 'R' or 'B',
* B is overwritten by diag(R)*B;
* if options->Trans = TRANS or CONJ and equed = 'C' of 'B',
* B is overwritten by diag(C)*B;
* if A->Stype = SLU_NR:
* if options->Trans = NOTRANS and equed = 'C' or 'B',
* B is overwritten by diag(C)*B;
* if options->Trans = TRANS or CONJ and equed = 'R' of 'B',
* B is overwritten by diag(R)*B.
*
* X (output) SuperMatrix*
* X has types: Stype = SLU_DN, Dtype = SLU_D, Mtype = SLU_GE.
* If info = 0 or info = A->ncol+1, X contains the solution matrix
* to the original system of equations. Note that A and B are modified
* on exit if equed is not 'N', and the solution to the equilibrated
* system is inv(diag(C))*X if options->Trans = NOTRANS and
* equed = 'C' or 'B', or inv(diag(R))*X if options->Trans = 'T' or 'C'
* and equed = 'R' or 'B'.
*
* recip_pivot_growth (output) double*
* The reciprocal pivot growth factor max_j( norm(A_j)/norm(U_j) ).
* The infinity norm is used. If recip_pivot_growth is much less
* than 1, the stability of the LU factorization could be poor.
*
* rcond (output) double*
* The estimate of the reciprocal condition number of the matrix A
* after equilibration (if done). If rcond is less than the machine
* precision (in particular, if rcond = 0), the matrix is singular
* to working precision. This condition is indicated by a return
* code of info > 0.
*
* FERR (output) double*, dimension (B->ncol)
* The estimated forward error bound for each solution vector
* X(j) (the j-th column of the solution matrix X).
* If XTRUE is the true solution corresponding to X(j), FERR(j)
* is an estimated upper bound for the magnitude of the largest
* element in (X(j) - XTRUE) divided by the magnitude of the
* largest element in X(j). The estimate is as reliable as
* the estimate for RCOND, and is almost always a slight
* overestimate of the true error.
* If options->IterRefine = NOREFINE, ferr = 1.0.
*
* BERR (output) double*, dimension (B->ncol)
* The componentwise relative backward error of each solution
* vector X(j) (i.e., the smallest relative change in
* any element of A or B that makes X(j) an exact solution).
* If options->IterRefine = NOREFINE, berr = 1.0.
*
* mem_usage (output) mem_usage_t*
* Record the memory usage statistics, consisting of following fields:
* - for_lu (float)
* The amount of space used in bytes for L\U data structures.
* - total_needed (float)
* The amount of space needed in bytes to perform factorization.
* - expansions (int)
* The number of memory expansions during the LU factorization.
*
* stat (output) SuperLUStat_t*
* Record the statistics on runtime and floating-point operation count.
* See util.h for the definition of 'SuperLUStat_t'.
*
* info (output) int*
* = 0: successful exit
* < 0: if info = -i, the i-th argument had an illegal value
* > 0: if info = i, and i is
* <= A->ncol: U(i,i) is exactly zero. The factorization has
* been completed, but the factor U is exactly
* singular, so the solution and error bounds
* could not be computed.
* = A->ncol+1: U is nonsingular, but RCOND is less than machine
* precision, meaning that the matrix is singular to
* working precision. Nevertheless, the solution and
* error bounds are computed because there are a number
* of situations where the computed solution can be more
* accurate than the value of RCOND would suggest.
* > A->ncol+1: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
DNformat *Bstore, *Xstore;
double *Bmat, *Xmat;
int ldb, ldx, nrhs;
SuperMatrix *AA;/* A in SLU_NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int colequ, equil, nofact, notran, rowequ, permc_spec;
trans_t trant;
char norm[1];
int i, j, info1;
double amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
int relax, panel_size;
double drop_tol;
double t0; /* temporary time */
double *utime;
/* External functions */
extern double dlangs(char *, SuperMatrix *);
extern double hypre_F90_NAME_LAPACK(dlamch,DLAMCH)(const char *);
Bstore = (DNformat*) B->Store;
Xstore = (DNformat*) X->Store;
Bmat = ( double*) Bstore->nzval;
Xmat = ( double*) Xstore->nzval;
ldb = Bstore->lda;
ldx = Xstore->lda;
nrhs = B->ncol;
*info = 0;
nofact = (options->Fact != FACTORED);
equil = (options->Equil == YES);
notran = (options->Trans == NOTRANS);
if ( nofact ) {
*(unsigned char *)equed = 'N';
rowequ = FALSE;
colequ = FALSE;
} else {
rowequ = superlu_lsame(equed, "R") || superlu_lsame(equed, "B");
colequ = superlu_lsame(equed, "C") || superlu_lsame(equed, "B");
smlnum = hypre_F90_NAME_LAPACK(dlamch,DLAMCH)("Safe minimum");
bignum = 1. / smlnum;
}
#if 0
printf("dgssvx: Fact=%4d, Trans=%4d, equed=%c\n",
options->Fact, options->Trans, *equed);
#endif
/* Test the input parameters */
if (!nofact && options->Fact != DOFACT && options->Fact != SamePattern &&
options->Fact != SamePattern_SameRowPerm &&
!notran && options->Trans != TRANS && options->Trans != CONJ &&
!equil && options->Equil != NO)
*info = -1;
else if ( A->nrow != A->ncol || A->nrow < 0 ||
(A->Stype != SLU_NC && A->Stype != SLU_NR) ||
A->Dtype != SLU_D || A->Mtype != SLU_GE )
*info = -2;
else if (options->Fact == FACTORED &&
!(rowequ || colequ || superlu_lsame(equed, "N")))
*info = -6;
else {
if (rowequ) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, R[j]);
rcmax = SUPERLU_MAX(rcmax, R[j]);
}
if (rcmin <= 0.) *info = -7;
else if ( A->nrow > 0)
rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else rowcnd = 1.;
}
if (colequ && *info == 0) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, C[j]);
rcmax = SUPERLU_MAX(rcmax, C[j]);
}
if (rcmin <= 0.) *info = -8;
else if (A->nrow > 0)
colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else colcnd = 1.;
}
if (*info == 0) {
if ( lwork < -1 ) *info = -12;
else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != SLU_DN || B->Dtype != SLU_D ||
B->Mtype != SLU_GE )
*info = -13;
else if ( X->ncol < 0 || Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
(B->ncol != 0 && B->ncol != X->ncol) ||
X->Stype != SLU_DN ||
X->Dtype != SLU_D || X->Mtype != SLU_GE )
*info = -14;
}
}
if (*info != 0) {
i = -(*info);
superlu_xerbla("dgssvx", &i);
return;
}
/* Initialization for factor parameters */
panel_size = sp_ienv(1);
relax = sp_ienv(2);
drop_tol = 0.0;
utime = stat->utime;
/* Convert A to SLU_NC format when necessary. */
if ( A->Stype == SLU_NR ) {
NRformat *Astore = (NRformat*) A->Store;
AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
(double*) Astore->nzval, Astore->colind, Astore->rowptr,
SLU_NC, A->Dtype, A->Mtype);
if ( notran ) { /* Reverse the transpose argument. */
trant = TRANS;
notran = 0;
} else {
trant = NOTRANS;
notran = 1;
}
} else { /* A->Stype == SLU_NC */
trant = options->Trans;
AA = A;
}
if ( nofact && equil ) {
t0 = SuperLU_timer_();
/* Compute row and column scalings to equilibrate the matrix A. */
dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
dlaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
rowequ = superlu_lsame(equed, "R") || superlu_lsame(equed, "B");
colequ = superlu_lsame(equed, "C") || superlu_lsame(equed, "B");
}
utime[EQUIL] = SuperLU_timer_() - t0;
}
if ( nrhs > 0 ) {
/* Scale the right hand side if equilibration was performed. */
if ( notran ) {
if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Bmat[i + j*ldb] *= R[i];
}
}
} else if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Bmat[i + j*ldb] *= C[i];
}
}
}
if ( nofact ) {
t0 = SuperLU_timer_();
/*
* Gnet column permutation vector perm_c[], according to permc_spec:
* permc_spec = NATURAL: natural ordering
* permc_spec = MMD_AT_PLUS_A: minimum degree on structure of A'+A
* permc_spec = MMD_ATA: minimum degree on structure of A'*A
* permc_spec = COLAMD: approximate minimum degree column ordering
* permc_spec = MY_PERMC: the ordering already supplied in perm_c[]
*/
permc_spec = options->ColPerm;
if ( permc_spec != MY_PERMC && options->Fact == DOFACT )
get_perm_c(permc_spec, AA, perm_c);
utime[COLPERM] = SuperLU_timer_() - t0;
t0 = SuperLU_timer_();
sp_preorder(options, AA, perm_c, etree, &AC);
utime[ETREE] = SuperLU_timer_() - t0;
/* printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
relax, panel_size, sp_ienv(3), sp_ienv(4));
fflush(stdout); */
/* Compute the LU factorization of A*Pc. */
t0 = SuperLU_timer_();
dgstrf(options, &AC, drop_tol, relax, panel_size,
etree, work, lwork, perm_c, perm_r, L, U, stat, info);
utime[FACT] = SuperLU_timer_() - t0;
if ( lwork == -1 ) {
mem_usage->total_needed = *info - A->ncol;
return;
}
}
if ( options->PivotGrowth ) {
if ( *info > 0 ) {
if ( *info <= A->ncol ) {
/* Compute the reciprocal pivot growth factor of the leading
rank-deficient *info columns of A. */
*recip_pivot_growth = dPivotGrowth(*info, AA, perm_c, L, U);
}
return;
}
/* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
*recip_pivot_growth = dPivotGrowth(A->ncol, AA, perm_c, L, U);
}
if ( options->ConditionNumber ) {
/* Estimate the reciprocal of the condition number of A. */
t0 = SuperLU_timer_();
if ( notran ) {
*(unsigned char *)norm = '1';
} else {
*(unsigned char *)norm = 'I';
}
anorm = dlangs(norm, AA);
dgscon(norm, L, U, anorm, rcond, stat, info);
utime[RCOND] = SuperLU_timer_() - t0;
}
if ( nrhs > 0 ) {
/* Compute the solution matrix X. */
for (j = 0; j < nrhs; j++) /* Save a copy of the right hand sides */
for (i = 0; i < B->nrow; i++)
Xmat[i + j*ldx] = Bmat[i + j*ldb];
t0 = SuperLU_timer_();
dgstrs (trant, L, U, perm_c, perm_r, X, stat, info);
utime[SOLVE] = SuperLU_timer_() - t0;
/* Use iterative refinement to improve the computed solution and compute
error bounds and backward error estimates for it. */
t0 = SuperLU_timer_();
if ( options->IterRefine != NOREFINE ) {
dgsrfs(trant, AA, L, U, perm_c, perm_r, equed, R, C, B,
X, ferr, berr, stat, info);
} else {
for (j = 0; j < nrhs; ++j) ferr[j] = berr[j] = 1.0;
}
utime[REFINE] = SuperLU_timer_() - t0;
/* Transform the solution matrix X to a solution of the original system. */
if ( notran ) {
if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= C[i];
}
}
} else if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= R[i];
}
}
} /* end if nrhs > 0 */
if ( options->ConditionNumber ) {
/* Set INFO = A->ncol+1 if the matrix is singular to working precision. */
if (*rcond < hypre_F90_NAME_LAPACK(dlamch,DLAMCH)("E")) *info=A->ncol+1;
}
if ( nofact ) {
dQuerySpace(L, U, mem_usage);
Destroy_CompCol_Permuted(&AC);
}
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
}
int dgst01(int m, int n, SuperMatrix *A, SuperMatrix *L,
SuperMatrix *U, int *perm_c, int *perm_r, double *resid)
{
/*
Purpose
=======
DGST01 reconstructs a matrix A from its L*U factorization and
computes the residual
norm(L*U - A) / ( N * norm(A) * EPS ),
where EPS is the machine epsilon.
Arguments
==========
M (input) INT
The number of rows of the matrix A. M >= 0.
N (input) INT
The number of columns of the matrix A. N >= 0.
A (input) SuperMatrix *, dimension (A->nrow, A->ncol)
The original M x N matrix A.
L (input) SuperMatrix *, dimension (L->nrow, L->ncol)
The factor matrix L.
U (input) SuperMatrix *, dimension (U->nrow, U->ncol)
The factor matrix U.
perm_c (input) INT array, dimension (N)
The column permutation from DGSTRF.
perm_r (input) INT array, dimension (M)
The pivot indices from DGSTRF.
RESID (output) DOUBLE*
norm(L*U - A) / ( N * norm(A) * EPS )
=====================================================================
*/
/* Local variables */
double zero = 0.0;
int i, j, k, arow, lptr,isub, urow, superno, fsupc, u_part;
double utemp, comp_temp;
double anorm, tnorm, cnorm;
double eps;
double *work;
SCformat *Lstore;
NCformat *Astore, *Ustore;
double *Aval, *Lval, *Uval;
int *colbeg, *colend;
/* Function prototypes */
extern double dlangs(char *, SuperMatrix *);
/* Quick exit if M = 0 or N = 0. */
if (m <= 0 || n <= 0) {
*resid = 0.f;
return 0;
}
work = (double *)doubleCalloc(m);
Astore = A->Store;
Aval = Astore->nzval;
Lstore = L->Store;
Lval = Lstore->nzval;
Ustore = U->Store;
Uval = Ustore->nzval;
colbeg = intMalloc(n);
colend = intMalloc(n);
for (i = 0; i < n; i++) {
colbeg[perm_c[i]] = Astore->colptr[i];
colend[perm_c[i]] = Astore->colptr[i+1];
}
/* Determine EPS and the norm of A. */
eps = dmach("Epsilon");
anorm = dlangs("1", A);
cnorm = 0.;
/* Compute the product L*U, one column at a time */
for (k = 0; k < n; ++k) {
/* The U part outside the rectangular supernode */
for (i = U_NZ_START(k); i < U_NZ_START(k+1); ++i) {
urow = U_SUB(i);
utemp = Uval[i];
superno = Lstore->col_to_sup[urow];
fsupc = L_FST_SUPC(superno);
u_part = urow - fsupc + 1;
lptr = L_SUB_START(fsupc) + u_part;
work[L_SUB(lptr-1)] -= utemp; /* L_ii = 1 */
for (j = L_NZ_START(urow) + u_part; j < L_NZ_START(urow+1); ++j) {
isub = L_SUB(lptr);
work[isub] -= Lval[j] * utemp;
++lptr;
}
}
/* The U part inside the rectangular supernode */
superno = Lstore->col_to_sup[k];
fsupc = L_FST_SUPC(superno);
urow = L_NZ_START(k);
for (i = fsupc; i <= k; ++i) {
utemp = Lval[urow++];
u_part = i - fsupc + 1;
lptr = L_SUB_START(fsupc) + u_part;
work[L_SUB(lptr-1)] -= utemp; /* L_ii = 1 */
for (j = L_NZ_START(i)+u_part; j < L_NZ_START(i+1); ++j) {
isub = L_SUB(lptr);
work[isub] -= Lval[j] * utemp;
++lptr;
}
}
/* Now compute A[k] - (L*U)[k] (Both matrices may be permuted.) */
for (i = colbeg[k]; i < colend[k]; ++i) {
arow = Astore->rowind[i];
work[perm_r[arow]] += Aval[i];
}
/* Now compute the 1-norm of the column vector work */
tnorm = 0.;
for (i = 0; i < m; ++i) {
tnorm += fabs(work[i]);
work[i] = zero;
}
cnorm = SUPERLU_MAX(tnorm, cnorm);
}
*resid = cnorm;
if (anorm <= 0.f) {
if (*resid != 0.f) {
*resid = 1.f / eps;
}
} else {
*resid = *resid / (float) n / anorm / eps;
}
SUPERLU_FREE(work);
SUPERLU_FREE(colbeg);
SUPERLU_FREE(colend);
return 0;
/* End of DGST01 */
} /* dgst01_ */
void
pdgssvx(int nprocs, superlumt_options_t *superlumt_options, SuperMatrix *A,
int *perm_c, int *perm_r, equed_t *equed, double *R, double *C,
SuperMatrix *L, SuperMatrix *U,
SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth,
double *rcond, double *ferr, double *berr,
superlu_memusage_t *superlu_memusage, int *info)
{
/*
* -- SuperLU MT routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley,
* and Xerox Palo Alto Research Center.
* September 10, 2007
*
* Purpose
* =======
*
* pdgssvx() solves the system of linear equations A*X=B or A'*X=B, using
* the LU factorization from dgstrf(). Error bounds on the solution and
* a condition estimate are also provided. It performs the following steps:
*
* 1. If A is stored column-wise (A->Stype = NC):
*
* 1.1. If fact = EQUILIBRATE, scaling factors are computed to equilibrate
* the system:
* trans = NOTRANS: diag(R)*A*diag(C)*inv(diag(C))*X = diag(R)*B
* trans = TRANS: (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
* trans = CONJ: (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
* Whether or not the system will be equilibrated depends on the
* scaling of the matrix A, but if equilibration is used, A is
* overwritten by diag(R)*A*diag(C) and B by diag(R)*B
* (if trans = NOTRANS) or diag(C)*B (if trans = TRANS or CONJ).
*
* 1.2. Permute columns of A, forming A*Pc, where Pc is a permutation matrix
* that usually preserves sparsity.
* For more details of this step, see dsp_colorder.c.
*
* 1.3. If fact = DOFACT or EQUILIBRATE, the LU decomposition is used to
* factor the matrix A (after equilibration if fact = EQUILIBRATE) as
* Pr*A*Pc = L*U, with Pr determined by partial pivoting.
*
* 1.4. Compute the reciprocal pivot growth factor.
*
* 1.5. If some U(i,i) = 0, so that U is exactly singular, then the routine
* returns with info = i. Otherwise, the factored form of A is used to
* estimate the condition number of the matrix A. If the reciprocal of
* the condition number is less than machine precision,
* info = A->ncol+1 is returned as a warning, but the routine still
* goes on to solve for X and computes error bounds as described below.
*
* 1.6. The system of equations is solved for X using the factored form
* of A.
*
* 1.7. Iterative refinement is applied to improve the computed solution
* matrix and calculate error bounds and backward error estimates
* for it.
*
* 1.8. If equilibration was used, the matrix X is premultiplied by
* diag(C) (if trans = NOTRANS) or diag(R) (if trans = TRANS or CONJ)
* so that it solves the original system before equilibration.
*
* 2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
* to the tranpose of A:
*
* 2.1. If fact = EQUILIBRATE, scaling factors are computed to equilibrate
* the system:
* trans = NOTRANS:diag(R)*A'*diag(C)*inv(diag(C))*X = diag(R)*B
* trans = TRANS: (diag(R)*A'*diag(C))**T *inv(diag(R))*X = diag(C)*B
* trans = CONJ: (diag(R)*A'*diag(C))**H *inv(diag(R))*X = diag(C)*B
* Whether or not the system will be equilibrated depends on the
* scaling of the matrix A, but if equilibration is used, A' is
* overwritten by diag(R)*A'*diag(C) and B by diag(R)*B
* (if trans = NOTRANS) or diag(C)*B (if trans = TRANS or CONJ).
*
* 2.2. Permute columns of transpose(A) (rows of A),
* forming transpose(A)*Pc, where Pc is a permutation matrix that
* usually preserves sparsity.
* For more details of this step, see dsp_colorder.c.
*
* 2.3. If fact = DOFACT or EQUILIBRATE, the LU decomposition is used to
* factor the matrix A (after equilibration if fact = EQUILIBRATE) as
* Pr*transpose(A)*Pc = L*U, with the permutation Pr determined by
* partial pivoting.
*
* 2.4. Compute the reciprocal pivot growth factor.
*
* 2.5. If some U(i,i) = 0, so that U is exactly singular, then the routine
* returns with info = i. Otherwise, the factored form of transpose(A)
* is used to estimate the condition number of the matrix A.
* If the reciprocal of the condition number is less than machine
* precision, info = A->nrow+1 is returned as a warning, but the
* routine still goes on to solve for X and computes error bounds
* as described below.
*
* 2.6. The system of equations is solved for X using the factored form
* of transpose(A).
*
* 2.7. Iterative refinement is applied to improve the computed solution
* matrix and calculate error bounds and backward error estimates
* for it.
*
* 2.8. If equilibration was used, the matrix X is premultiplied by
* diag(C) (if trans = NOTRANS) or diag(R) (if trans = TRANS or CONJ)
* so that it solves the original system before equilibration.
*
* See supermatrix.h for the definition of 'SuperMatrix' structure.
*
* Arguments
* =========
*
* nprocs (input) int
* Number of processes (or threads) to be spawned and used to perform
* the LU factorization by pdgstrf(). There is a single thread of
* control to call pdgstrf(), and all threads spawned by pdgstrf()
* are terminated before returning from pdgstrf().
*
* superlumt_options (input) superlumt_options_t*
* The structure defines the input parameters and data structure
* to control how the LU factorization will be performed.
* The following fields should be defined for this structure:
*
* o fact (fact_t)
* Specifies whether or not the factored form of the matrix
* A is supplied on entry, and if not, whether the matrix A should
* be equilibrated before it is factored.
* = FACTORED: On entry, L, U, perm_r and perm_c contain the
* factored form of A. If equed is not NOEQUIL, the matrix A has
* been equilibrated with scaling factors R and C.
* A, L, U, perm_r are not modified.
* = DOFACT: The matrix A will be factored, and the factors will be
* stored in L and U.
* = EQUILIBRATE: The matrix A will be equilibrated if necessary,
* then factored into L and U.
*
* o trans (trans_t)
* Specifies the form of the system of equations:
* = NOTRANS: A * X = B (No transpose)
* = TRANS: A**T * X = B (Transpose)
* = CONJ: A**H * X = B (Transpose)
*
* o refact (yes_no_t)
* Specifies whether this is first time or subsequent factorization.
* = NO: this factorization is treated as the first one;
* = YES: it means that a factorization was performed prior to this
* one. Therefore, this factorization will re-use some
* existing data structures, such as L and U storage, column
* elimination tree, and the symbolic information of the
* Householder matrix.
*
* o panel_size (int)
* A panel consists of at most panel_size consecutive columns.
*
* o relax (int)
* To control degree of relaxing supernodes. If the number
* of nodes (columns) in a subtree of the elimination tree is less
* than relax, this subtree is considered as one supernode,
* regardless of the row structures of those columns.
*
* o diag_pivot_thresh (double)
* Diagonal pivoting threshold. At step j of the Gaussian
* elimination, if
* abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
* use A_jj as pivot, else use A_ij with maximum magnitude.
* 0 <= diag_pivot_thresh <= 1. The default value is 1,
* corresponding to partial pivoting.
*
* o usepr (yes_no_t)
* Whether the pivoting will use perm_r specified by the user.
* = YES: use perm_r; perm_r is input, unchanged on exit.
* = NO: perm_r is determined by partial pivoting, and is output.
*
* o drop_tol (double) (NOT IMPLEMENTED)
* Drop tolerance parameter. At step j of the Gaussian elimination,
* if abs(A_ij)/(max_i abs(A_ij)) < drop_tol, drop entry A_ij.
* 0 <= drop_tol <= 1. The default value of drop_tol is 0,
* corresponding to not dropping any entry.
*
* o work (void*) of size lwork
* User-supplied work space and space for the output data structures.
* Not referenced if lwork = 0;
*
* o lwork (int)
* Specifies the length of work array.
* = 0: allocate space internally by system malloc;
* > 0: use user-supplied work array of length lwork in bytes,
* returns error if space runs out.
* = -1: the routine guesses the amount of space needed without
* performing the factorization, and returns it in
* superlu_memusage->total_needed; no other side effects.
*
* A (input/output) SuperMatrix*
* Matrix A in A*X=B, of dimension (A->nrow, A->ncol), where
* A->nrow = A->ncol. Currently, the type of A can be:
* Stype = NC or NR, Dtype = _D, Mtype = GE. In the future,
* more general A will be handled.
*
* On entry, If superlumt_options->fact = FACTORED and equed is not
* NOEQUIL, then A must have been equilibrated by the scaling factors
* in R and/or C. On exit, A is not modified
* if superlumt_options->fact = FACTORED or DOFACT, or
* if superlumt_options->fact = EQUILIBRATE and equed = NOEQUIL.
*
* On exit, if superlumt_options->fact = EQUILIBRATE and equed is not
* NOEQUIL, A is scaled as follows:
* If A->Stype = NC:
* equed = ROW: A := diag(R) * A
* equed = COL: A := A * diag(C)
* equed = BOTH: A := diag(R) * A * diag(C).
* If A->Stype = NR:
* equed = ROW: transpose(A) := diag(R) * transpose(A)
* equed = COL: transpose(A) := transpose(A) * diag(C)
* equed = BOTH: transpose(A) := diag(R) * transpose(A) * diag(C).
*
* perm_c (input/output) int*
* If A->Stype = NC, Column permutation vector of size A->ncol,
* which defines the permutation matrix Pc; perm_c[i] = j means
* column i of A is in position j in A*Pc.
* On exit, perm_c may be overwritten by the product of the input
* perm_c and a permutation that postorders the elimination tree
* of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
* is already in postorder.
*
* If A->Stype = NR, column permutation vector of size A->nrow,
* which describes permutation of columns of tranpose(A)
* (rows of A) as described above.
*
* perm_r (input/output) int*
* If A->Stype = NC, row permutation vector of size A->nrow,
* which defines the permutation matrix Pr, and is determined
* by partial pivoting. perm_r[i] = j means row i of A is in
* position j in Pr*A.
*
* If A->Stype = NR, permutation vector of size A->ncol, which
* determines permutation of rows of transpose(A)
* (columns of A) as described above.
*
* If superlumt_options->usepr = NO, perm_r is output argument;
* If superlumt_options->usepr = YES, the pivoting routine will try
* to use the input perm_r, unless a certain threshold criterion
* is violated. In that case, perm_r is overwritten by a new
* permutation determined by partial pivoting or diagonal
* threshold pivoting.
*
* equed (input/output) equed_t*
* Specifies the form of equilibration that was done.
* = NOEQUIL: No equilibration.
* = ROW: Row equilibration, i.e., A was premultiplied by diag(R).
* = COL: Column equilibration, i.e., A was postmultiplied by diag(C).
* = BOTH: Both row and column equilibration, i.e., A was replaced
* by diag(R)*A*diag(C).
* If superlumt_options->fact = FACTORED, equed is an input argument,
* otherwise it is an output argument.
*
* R (input/output) double*, dimension (A->nrow)
* The row scale factors for A or transpose(A).
* If equed = ROW or BOTH, A (if A->Stype = NC) or transpose(A)
* (if A->Stype = NR) is multiplied on the left by diag(R).
* If equed = NOEQUIL or COL, R is not accessed.
* If fact = FACTORED, R is an input argument; otherwise, R is output.
* If fact = FACTORED and equed = ROW or BOTH, each element of R must
* be positive.
*
* C (input/output) double*, dimension (A->ncol)
* The column scale factors for A or transpose(A).
* If equed = COL or BOTH, A (if A->Stype = NC) or trnspose(A)
* (if A->Stype = NR) is multiplied on the right by diag(C).
* If equed = NOEQUIL or ROW, C is not accessed.
* If fact = FACTORED, C is an input argument; otherwise, C is output.
* If fact = FACTORED and equed = COL or BOTH, each element of C must
* be positive.
*
* L (output) SuperMatrix*
* The factor L from the factorization
* Pr*A*Pc=L*U (if A->Stype = NC) or
* Pr*transpose(A)*Pc=L*U (if A->Stype = NR).
* Uses compressed row subscripts storage for supernodes, i.e.,
* L has types: Stype = SCP, Dtype = _D, Mtype = TRLU.
*
* U (output) SuperMatrix*
* The factor U from the factorization
* Pr*A*Pc=L*U (if A->Stype = NC) or
* Pr*transpose(A)*Pc=L*U (if A->Stype = NR).
* Uses column-wise storage scheme, i.e., U has types:
* Stype = NCP, Dtype = _D, Mtype = TRU.
*
* B (input/output) SuperMatrix*
* B has types: Stype = DN, Dtype = _D, Mtype = GE.
* On entry, the right hand side matrix.
* On exit,
* if equed = NOEQUIL, B is not modified; otherwise
* if A->Stype = NC:
* if trans = NOTRANS and equed = ROW or BOTH, B is overwritten
* by diag(R)*B;
* if trans = TRANS or CONJ and equed = COL of BOTH, B is
* overwritten by diag(C)*B;
* if A->Stype = NR:
* if trans = NOTRANS and equed = COL or BOTH, B is overwritten
* by diag(C)*B;
* if trans = TRANS or CONJ and equed = ROW of BOTH, B is
* overwritten by diag(R)*B.
*
* X (output) SuperMatrix*
* X has types: Stype = DN, Dtype = _D, Mtype = GE.
* If info = 0 or info = A->ncol+1, X contains the solution matrix
* to the original system of equations. Note that A and B are modified
* on exit if equed is not NOEQUIL, and the solution to the
* equilibrated system is inv(diag(C))*X if trans = NOTRANS and
* equed = COL or BOTH, or inv(diag(R))*X if trans = TRANS or CONJ
* and equed = ROW or BOTH.
*
* recip_pivot_growth (output) double*
* The reciprocal pivot growth factor computed as
* max_j ( max_i(abs(A_ij)) / max_i(abs(U_ij)) ).
* If recip_pivot_growth is much less than 1, the stability of the
* LU factorization could be poor.
*
* rcond (output) double*
* The estimate of the reciprocal condition number of the matrix A
* after equilibration (if done). If rcond is less than the machine
* precision (in particular, if rcond = 0), the matrix is singular
* to working precision. This condition is indicated by a return
* code of info > 0.
*
* ferr (output) double*, dimension (B->ncol)
* The estimated forward error bound for each solution vector
* X(j) (the j-th column of the solution matrix X).
* If XTRUE is the true solution corresponding to X(j), FERR(j)
* is an estimated upper bound for the magnitude of the largest
* element in (X(j) - XTRUE) divided by the magnitude of the
* largest element in X(j). The estimate is as reliable as
* the estimate for RCOND, and is almost always a slight
* overestimate of the true error.
*
* berr (output) double*, dimension (B->ncol)
* The componentwise relative backward error of each solution
* vector X(j) (i.e., the smallest relative change in
* any element of A or B that makes X(j) an exact solution).
*
* superlu_memusage (output) superlu_memusage_t*
* Record the memory usage statistics, consisting of following fields:
* - for_lu (float)
* The amount of space used in bytes for L\U data structures.
* - total_needed (float)
* The amount of space needed in bytes to perform factorization.
* - expansions (int)
* The number of memory expansions during the LU factorization.
*
* info (output) int*
* = 0: successful exit
* < 0: if info = -i, the i-th argument had an illegal value
* > 0: if info = i, and i is
* <= A->ncol: U(i,i) is exactly zero. The factorization has
* been completed, but the factor U is exactly
* singular, so the solution and error bounds
* could not be computed.
* = A->ncol+1: U is nonsingular, but RCOND is less than machine
* precision, meaning that the matrix is singular to
* working precision. Nevertheless, the solution and
* error bounds are computed because there are a number
* of situations where the computed solution can be more
* accurate than the value of RCOND would suggest.
* > A->ncol+1: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
NCformat *Astore;
DNformat *Bstore, *Xstore;
double *Bmat, *Xmat;
int ldb, ldx, nrhs;
SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int colequ, equil, dofact, notran, rowequ;
char norm[1];
trans_t trant;
int i, j, info1;
double amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
int n, relax, panel_size;
Gstat_t Gstat;
double t0; /* temporary time */
double *utime;
flops_t *ops, flopcnt;
/* External functions */
extern double dlangs(char *, SuperMatrix *);
extern double dlamch_(char *);
Astore = A->Store;
Bstore = B->Store;
Xstore = X->Store;
Bmat = Bstore->nzval;
Xmat = Xstore->nzval;
n = A->ncol;
ldb = Bstore->lda;
ldx = Xstore->lda;
nrhs = B->ncol;
superlumt_options->perm_c = perm_c;
superlumt_options->perm_r = perm_r;
*info = 0;
dofact = (superlumt_options->fact == DOFACT);
equil = (superlumt_options->fact == EQUILIBRATE);
notran = (superlumt_options->trans == NOTRANS);
if (dofact || equil) {
*equed = NOEQUIL;
rowequ = FALSE;
colequ = FALSE;
} else {
rowequ = (*equed == ROW) || (*equed == BOTH);
colequ = (*equed == COL) || (*equed == BOTH);
smlnum = dlamch_("Safe minimum");
bignum = 1. / smlnum;
}
/* ------------------------------------------------------------
Test the input parameters.
------------------------------------------------------------*/
if ( nprocs <= 0 ) *info = -1;
else if ( (!dofact && !equil && (superlumt_options->fact != FACTORED))
|| (!notran && (superlumt_options->trans != TRANS) &&
(superlumt_options->trans != CONJ))
|| (superlumt_options->refact != YES &&
superlumt_options->refact != NO)
|| (superlumt_options->usepr != YES &&
superlumt_options->usepr != NO)
|| superlumt_options->lwork < -1 )
*info = -2;
else if ( A->nrow != A->ncol || A->nrow < 0 ||
(A->Stype != SLU_NC && A->Stype != SLU_NR) ||
A->Dtype != SLU_D || A->Mtype != SLU_GE )
*info = -3;
else if ((superlumt_options->fact == FACTORED) &&
!(rowequ || colequ || (*equed == NOEQUIL))) *info = -6;
else {
if (rowequ) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, R[j]);
rcmax = SUPERLU_MAX(rcmax, R[j]);
}
if (rcmin <= 0.) *info = -7;
else if ( A->nrow > 0)
rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else rowcnd = 1.;
}
if (colequ && *info == 0) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, C[j]);
rcmax = SUPERLU_MAX(rcmax, C[j]);
}
if (rcmin <= 0.) *info = -8;
else if (A->nrow > 0)
colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else colcnd = 1.;
}
if (*info == 0) {
if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != SLU_DN || B->Dtype != SLU_D ||
B->Mtype != SLU_GE )
*info = -11;
else if ( X->ncol < 0 || Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->ncol != X->ncol || X->Stype != SLU_DN ||
X->Dtype != SLU_D || X->Mtype != SLU_GE )
*info = -12;
}
}
if (*info != 0) {
i = -(*info);
xerbla_("pdgssvx", &i);
return;
}
/* ------------------------------------------------------------
Allocate storage and initialize statistics variables.
------------------------------------------------------------*/
panel_size = superlumt_options->panel_size;
relax = superlumt_options->relax;
StatAlloc(n, nprocs, panel_size, relax, &Gstat);
StatInit(n, nprocs, &Gstat);
utime = Gstat.utime;
ops = Gstat.ops;
/* ------------------------------------------------------------
Convert A to NC format when necessary.
------------------------------------------------------------*/
if ( A->Stype == SLU_NR ) {
NRformat *Astore = A->Store;
AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
Astore->nzval, Astore->colind, Astore->rowptr,
SLU_NC, A->Dtype, A->Mtype);
if ( notran ) { /* Reverse the transpose argument. */
trant = TRANS;
notran = 0;
} else {
trant = NOTRANS;
notran = 1;
}
} else { /* A->Stype == NC */
trant = superlumt_options->trans;
AA = A;
}
/* ------------------------------------------------------------
Diagonal scaling to equilibrate the matrix.
------------------------------------------------------------*/
if ( equil ) {
t0 = SuperLU_timer_();
/* Compute row and column scalings to equilibrate the matrix A. */
dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
dlaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
rowequ = (*equed == ROW) || (*equed == BOTH);
colequ = (*equed == COL) || (*equed == BOTH);
}
utime[EQUIL] = SuperLU_timer_() - t0;
}
/* ------------------------------------------------------------
Scale the right hand side.
------------------------------------------------------------*/
if ( notran ) {
if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Bmat[i + j*ldb] *= R[i];
}
}
} else if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Bmat[i + j*ldb] *= C[i];
}
}
/* ------------------------------------------------------------
Perform the LU factorization.
------------------------------------------------------------*/
if ( dofact || equil ) {
/* Obtain column etree, the column count (colcnt_h) and supernode
partition (part_super_h) for the Householder matrix. */
t0 = SuperLU_timer_();
sp_colorder(AA, perm_c, superlumt_options, &AC);
utime[ETREE] = SuperLU_timer_() - t0;
#if ( PRNTlevel >= 2 )
printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
relax, panel_size, sp_ienv(3), sp_ienv(4));
fflush(stdout);
#endif
/* Compute the LU factorization of A*Pc. */
t0 = SuperLU_timer_();
pdgstrf(superlumt_options, &AC, perm_r, L, U, &Gstat, info);
utime[FACT] = SuperLU_timer_() - t0;
flopcnt = 0;
for (i = 0; i < nprocs; ++i) flopcnt += Gstat.procstat[i].fcops;
ops[FACT] = flopcnt;
if ( superlumt_options->lwork == -1 ) {
superlu_memusage->total_needed = *info - A->ncol;
return;
}
}
if ( *info > 0 ) {
if ( *info <= A->ncol ) {
/* Compute the reciprocal pivot growth factor of the leading
rank-deficient *info columns of A. */
*recip_pivot_growth = dPivotGrowth(*info, AA, perm_c, L, U);
}
} else {
/* ------------------------------------------------------------
Compute the reciprocal pivot growth factor *recip_pivot_growth.
------------------------------------------------------------*/
*recip_pivot_growth = dPivotGrowth(A->ncol, AA, perm_c, L, U);
/* ------------------------------------------------------------
Estimate the reciprocal of the condition number of A.
------------------------------------------------------------*/
t0 = SuperLU_timer_();
if ( notran ) {
*(unsigned char *)norm = '1';
} else {
*(unsigned char *)norm = 'I';
}
anorm = dlangs(norm, AA);
dgscon(norm, L, U, anorm, rcond, info);
utime[RCOND] = SuperLU_timer_() - t0;
/* ------------------------------------------------------------
Compute the solution matrix X.
------------------------------------------------------------*/
for (j = 0; j < nrhs; j++) /* Save a copy of the right hand sides */
for (i = 0; i < B->nrow; i++)
Xmat[i + j*ldx] = Bmat[i + j*ldb];
t0 = SuperLU_timer_();
dgstrs(trant, L, U, perm_r, perm_c, X, &Gstat, info);
utime[SOLVE] = SuperLU_timer_() - t0;
ops[SOLVE] = ops[TRISOLVE];
/* ------------------------------------------------------------
Use iterative refinement to improve the computed solution and
compute error bounds and backward error estimates for it.
------------------------------------------------------------*/
t0 = SuperLU_timer_();
dgsrfs(trant, AA, L, U, perm_r, perm_c, *equed,
R, C, B, X, ferr, berr, &Gstat, info);
utime[REFINE] = SuperLU_timer_() - t0;
/* ------------------------------------------------------------
Transform the solution matrix X to a solution of the original
system.
------------------------------------------------------------*/
if ( notran ) {
if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= C[i];
}
}
} else if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= R[i];
}
}
/* Set INFO = A->ncol+1 if the matrix is singular to
working precision.*/
if ( *rcond < dlamch_("E") ) *info = A->ncol + 1;
}
superlu_dQuerySpace(nprocs, L, U, panel_size, superlu_memusage);
/* ------------------------------------------------------------
Deallocate storage after factorization.
------------------------------------------------------------*/
if ( superlumt_options->refact == NO ) {
SUPERLU_FREE(superlumt_options->etree);
SUPERLU_FREE(superlumt_options->colcnt_h);
SUPERLU_FREE(superlumt_options->part_super_h);
}
if ( dofact || equil ) {
Destroy_CompCol_Permuted(&AC);
}
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
/* ------------------------------------------------------------
Print timings, then deallocate statistic variables.
------------------------------------------------------------*/
#ifdef PROFILE
{
SCPformat *Lstore = (SCPformat *) L->Store;
ParallelProfile(n, Lstore->nsuper+1, Gstat.num_panels, nprocs, &Gstat);
}
#endif
PrintStat(&Gstat);
StatFree(&Gstat);
}
void
dgssvx(char *fact, char *trans, char *refact,
SuperMatrix *A, factor_param_t *factor_params, int *perm_c,
int *perm_r, int *etree, char *equed, double *R, double *C,
SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth,
double *rcond, double *ferr, double *berr,
mem_usage_t *mem_usage, int *info )
{
/*
* Purpose
* =======
*
* DGSSVX solves the system of linear equations A*X=B or A'*X=B, using
* the LU factorization from dgstrf(). Error bounds on the solution and
* a condition estimate are also provided. It performs the following steps:
*
* 1. If A is stored column-wise (A->Stype = NC):
*
* 1.1. If fact = 'E', scaling factors are computed to equilibrate the
* system:
* trans = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
* trans = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
* trans = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
* Whether or not the system will be equilibrated depends on the
* scaling of the matrix A, but if equilibration is used, A is
* overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if trans='N')
* or diag(C)*B (if trans = 'T' or 'C').
*
* 1.2. Permute columns of A, forming A*Pc, where Pc is a permutation
* matrix that usually preserves sparsity.
* For more details of this step, see sp_preorder.c.
*
* 1.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
* matrix A (after equilibration if fact = 'E') as Pr*A*Pc = L*U,
* with Pr determined by partial pivoting.
*
* 1.4. Compute the reciprocal pivot growth factor.
*
* 1.5. If some U(i,i) = 0, so that U is exactly singular, then the
* routine returns with info = i. Otherwise, the factored form of
* A is used to estimate the condition number of the matrix A. If
* the reciprocal of the condition number is less than machine
* precision, info = A->ncol+1 is returned as a warning, but the
* routine still goes on to solve for X and computes error bounds
* as described below.
*
* 1.6. The system of equations is solved for X using the factored form
* of A.
*
* 1.7. Iterative refinement is applied to improve the computed solution
* matrix and calculate error bounds and backward error estimates
* for it.
*
* 1.8. If equilibration was used, the matrix X is premultiplied by
* diag(C) (if trans = 'N') or diag(R) (if trans = 'T' or 'C') so
* that it solves the original system before equilibration.
*
* 2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
* to the transpose of A:
*
* 2.1. If fact = 'E', scaling factors are computed to equilibrate the
* system:
* trans = 'N': diag(R)*A'*diag(C) *inv(diag(C))*X = diag(R)*B
* trans = 'T': (diag(R)*A'*diag(C))**T *inv(diag(R))*X = diag(C)*B
* trans = 'C': (diag(R)*A'*diag(C))**H *inv(diag(R))*X = diag(C)*B
* Whether or not the system will be equilibrated depends on the
* scaling of the matrix A, but if equilibration is used, A' is
* overwritten by diag(R)*A'*diag(C) and B by diag(R)*B
* (if trans='N') or diag(C)*B (if trans = 'T' or 'C').
*
* 2.2. Permute columns of transpose(A) (rows of A),
* forming transpose(A)*Pc, where Pc is a permutation matrix that
* usually preserves sparsity.
* For more details of this step, see sp_preorder.c.
*
* 2.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
* transpose(A) (after equilibration if fact = 'E') as
* Pr*transpose(A)*Pc = L*U with the permutation Pr determined by
* partial pivoting.
*
* 2.4. Compute the reciprocal pivot growth factor.
*
* 2.5. If some U(i,i) = 0, so that U is exactly singular, then the
* routine returns with info = i. Otherwise, the factored form
* of transpose(A) is used to estimate the condition number of the
* matrix A. If the reciprocal of the condition number
* is less than machine precision, info = A->nrow+1 is returned as
* a warning, but the routine still goes on to solve for X and
* computes error bounds as described below.
*
* 2.6. The system of equations is solved for X using the factored form
* of transpose(A).
*
* 2.7. Iterative refinement is applied to improve the computed solution
* matrix and calculate error bounds and backward error estimates
* for it.
*
* 2.8. If equilibration was used, the matrix X is premultiplied by
* diag(C) (if trans = 'N') or diag(R) (if trans = 'T' or 'C') so
* that it solves the original system before equilibration.
*
* See supermatrix.h for the definition of 'SuperMatrix' structure.
*
* Arguments
* =========
*
* fact (input) char*
* Specifies whether or not the factored form of the matrix
* A is supplied on entry, and if not, whether the matrix A should
* be equilibrated before it is factored.
* = 'F': On entry, L, U, perm_r and perm_c contain the factored
* form of A. If equed is not 'N', the matrix A has been
* equilibrated with scaling factors R and C.
* A, L, U, perm_r are not modified.
* = 'N': The matrix A will be factored, and the factors will be
* stored in L and U.
* = 'E': The matrix A will be equilibrated if necessary, then
* factored into L and U.
*
* trans (input) char*
* Specifies the form of the system of equations:
* = 'N': A * X = B (No transpose)
* = 'T': A**T * X = B (Transpose)
* = 'C': A**H * X = B (Transpose)
*
* refact (input) char*
* Specifies whether we want to re-factor the matrix.
* = 'N': Factor the matrix A.
* = 'Y': Matrix A was factored before, now we want to re-factor
* matrix A with perm_r and etree as inputs. Use
* the same storage for the L\U factors previously allocated,
* expand it if necessary. User should insure to use the same
* memory model. In this case, perm_r may be modified due to
* different pivoting determined by diagonal threshold.
* If fact = 'F', then refact is not accessed.
*
* A (input/output) SuperMatrix*
* Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
* of the linear equations is A->nrow. Currently, the type of A can be:
* Stype = NC or NR, Dtype = D_, Mtype = GE. In the future,
* more general A can be handled.
*
* On entry, If fact = 'F' and equed is not 'N', then A must have
* been equilibrated by the scaling factors in R and/or C.
* A is not modified if fact = 'F' or 'N', or if fact = 'E' and
* equed = 'N' on exit.
*
* On exit, if fact = 'E' and equed is not 'N', A is scaled as follows:
* If A->Stype = NC:
* equed = 'R': A := diag(R) * A
* equed = 'C': A := A * diag(C)
* equed = 'B': A := diag(R) * A * diag(C).
* If A->Stype = NR:
* equed = 'R': transpose(A) := diag(R) * transpose(A)
* equed = 'C': transpose(A) := transpose(A) * diag(C)
* equed = 'B': transpose(A) := diag(R) * transpose(A) * diag(C).
*
* factor_params (input) factor_param_t*
* The structure defines the input scalar parameters, consisting of
* the following fields. If factor_params = NULL, the default
* values are used for all the fields; otherwise, the values
* are given by the user.
* - panel_size (int): Panel size. A panel consists of at most
* panel_size consecutive columns. If panel_size = -1, use
* default value 8.
* - relax (int): To control degree of relaxing supernodes. If the
* number of nodes (columns) in a subtree of the elimination
* tree is less than relax, this subtree is considered as one
* supernode, regardless of the row structures of those columns.
* If relax = -1, use default value 8.
* - diag_pivot_thresh (double): Diagonal pivoting threshold.
* At step j of the Gaussian elimination, if
* abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
* then use A_jj as pivot. 0 <= diag_pivot_thresh <= 1.
* If diag_pivot_thresh = -1, use default value 1.0,
* which corresponds to standard partial pivoting.
* - drop_tol (double): Drop tolerance threshold. (NOT IMPLEMENTED)
* At step j of the Gaussian elimination, if
* abs(A_ij)/(max_i abs(A_ij)) < drop_tol,
* then drop entry A_ij. 0 <= drop_tol <= 1.
* If drop_tol = -1, use default value 0.0, which corresponds to
* standard Gaussian elimination.
*
* perm_c (input/output) int*
* If A->Stype = NC, Column permutation vector of size A->ncol,
* which defines the permutation matrix Pc; perm_c[i] = j means
* column i of A is in position j in A*Pc.
* On exit, perm_c may be overwritten by the product of the input
* perm_c and a permutation that postorders the elimination tree
* of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
* is already in postorder.
*
* If A->Stype = NR, column permutation vector of size A->nrow,
* which describes permutation of columns of transpose(A)
* (rows of A) as described above.
*
* perm_r (input/output) int*
* If A->Stype = NC, row permutation vector of size A->nrow,
* which defines the permutation matrix Pr, and is determined
* by partial pivoting. perm_r[i] = j means row i of A is in
* position j in Pr*A.
*
* If A->Stype = NR, permutation vector of size A->ncol, which
* determines permutation of rows of transpose(A)
* (columns of A) as described above.
*
* If refact is not 'Y', perm_r is output argument;
* If refact = 'Y', the pivoting routine will try to use the input
* perm_r, unless a certain threshold criterion is violated.
* In that case, perm_r is overwritten by a new permutation
* determined by partial pivoting or diagonal threshold pivoting.
*
* etree (input/output) int*, dimension (A->ncol)
* Elimination tree of Pc'*A'*A*Pc.
* If fact is not 'F' and refact = 'Y', etree is an input argument,
* otherwise it is an output argument.
* Note: etree is a vector of parent pointers for a forest whose
* vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
*
* equed (input/output) char*
* Specifies the form of equilibration that was done.
* = 'N': No equilibration.
* = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
* = 'C': Column equilibration, i.e., A was postmultiplied by diag(C).
* = 'B': Both row and column equilibration, i.e., A was replaced
* by diag(R)*A*diag(C).
* If fact = 'F', equed is an input argument, otherwise it is
* an output argument.
*
* R (input/output) double*, dimension (A->nrow)
* The row scale factors for A or transpose(A).
* If equed = 'R' or 'B', A (if A->Stype = NC) or transpose(A) (if
* A->Stype = NR) is multiplied on the left by diag(R).
* If equed = 'N' or 'C', R is not accessed.
* If fact = 'F', R is an input argument; otherwise, R is output.
* If fact = 'F' and equed = 'R' or 'B', each element of R must
* be positive.
*
* C (input/output) double*, dimension (A->ncol)
* The column scale factors for A or transpose(A).
* If equed = 'C' or 'B', A (if A->Stype = NC) or transpose(A) (if
* A->Stype = NR) is multiplied on the right by diag(C).
* If equed = 'N' or 'R', C is not accessed.
* If fact = 'F', C is an input argument; otherwise, C is output.
* If fact = 'F' and equed = 'C' or 'B', each element of C must
* be positive.
*
* L (output) SuperMatrix*
* The factor L from the factorization
* Pr*A*Pc=L*U (if A->Stype = NC) or
* Pr*transpose(A)*Pc=L*U (if A->Stype = NR).
* Uses compressed row subscripts storage for supernodes, i.e.,
* L has types: Stype = SC, Dtype = D_, Mtype = TRLU.
*
* U (output) SuperMatrix*
* The factor U from the factorization
* Pr*A*Pc=L*U (if A->Stype = NC) or
* Pr*transpose(A)*Pc=L*U (if A->Stype = NR).
* Uses column-wise storage scheme, i.e., U has types:
* Stype = NC, Dtype = D_, Mtype = TRU.
*
* work (workspace/output) void*, size (lwork) (in bytes)
* User supplied workspace, should be large enough
* to hold data structures for factors L and U.
* On exit, if fact is not 'F', L and U point to this array.
*
* lwork (input) int
* Specifies the size of work array in bytes.
* = 0: allocate space internally by system malloc;
* > 0: use user-supplied work array of length lwork in bytes,
* returns error if space runs out.
* = -1: the routine guesses the amount of space needed without
* performing the factorization, and returns it in
* mem_usage->total_needed; no other side effects.
*
* See argument 'mem_usage' for memory usage statistics.
*
* B (input/output) SuperMatrix*
* B has types: Stype = DN, Dtype = D_, Mtype = GE.
* On entry, the right hand side matrix.
* On exit,
* if equed = 'N', B is not modified; otherwise
* if A->Stype = NC:
* if trans = 'N' and equed = 'R' or 'B', B is overwritten by
* diag(R)*B;
* if trans = 'T' or 'C' and equed = 'C' of 'B', B is
* overwritten by diag(C)*B;
* if A->Stype = NR:
* if trans = 'N' and equed = 'C' or 'B', B is overwritten by
* diag(C)*B;
* if trans = 'T' or 'C' and equed = 'R' of 'B', B is
* overwritten by diag(R)*B.
*
* X (output) SuperMatrix*
* X has types: Stype = DN, Dtype = D_, Mtype = GE.
* If info = 0 or info = A->ncol+1, X contains the solution matrix
* to the original system of equations. Note that A and B are modified
* on exit if equed is not 'N', and the solution to the equilibrated
* system is inv(diag(C))*X if trans = 'N' and equed = 'C' or 'B',
* or inv(diag(R))*X if trans = 'T' or 'C' and equed = 'R' or 'B'.
*
* recip_pivot_growth (output) double*
* The reciprocal pivot growth factor max_j( norm(A_j)/norm(U_j) ).
* The infinity norm is used. If recip_pivot_growth is much less
* than 1, the stability of the LU factorization could be poor.
*
* rcond (output) double*
* The estimate of the reciprocal condition number of the matrix A
* after equilibration (if done). If rcond is less than the machine
* precision (in particular, if rcond = 0), the matrix is singular
* to working precision. This condition is indicated by a return
* code of info > 0.
*
* FERR (output) double*, dimension (B->ncol)
* The estimated forward error bound for each solution vector
* X(j) (the j-th column of the solution matrix X).
* If XTRUE is the true solution corresponding to X(j), FERR(j)
* is an estimated upper bound for the magnitude of the largest
* element in (X(j) - XTRUE) divided by the magnitude of the
* largest element in X(j). The estimate is as reliable as
* the estimate for RCOND, and is almost always a slight
* overestimate of the true error.
*
* BERR (output) double*, dimension (B->ncol)
* The componentwise relative backward error of each solution
* vector X(j) (i.e., the smallest relative change in
* any element of A or B that makes X(j) an exact solution).
*
* mem_usage (output) mem_usage_t*
* Record the memory usage statistics, consisting of following fields:
* - for_lu (float)
* The amount of space used in bytes for L\U data structures.
* - total_needed (float)
* The amount of space needed in bytes to perform factorization.
* - expansions (int)
* The number of memory expansions during the LU factorization.
*
* info (output) int*
* = 0: successful exit
* < 0: if info = -i, the i-th argument had an illegal value
* > 0: if info = i, and i is
* <= A->ncol: U(i,i) is exactly zero. The factorization has
* been completed, but the factor U is exactly
* singular, so the solution and error bounds
* could not be computed.
* = A->ncol+1: U is nonsingular, but RCOND is less than machine
* precision, meaning that the matrix is singular to
* working precision. Nevertheless, the solution and
* error bounds are computed because there are a number
* of situations where the computed solution can be more
* accurate than the value of RCOND would suggest.
* > A->ncol+1: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
DNformat *Bstore, *Xstore;
double *Bmat, *Xmat;
int ldb, ldx, nrhs;
SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int colequ, equil, nofact, notran, rowequ;
char trant[1], norm[1];
int i, j, info1;
double amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
int relax, panel_size;
double diag_pivot_thresh, drop_tol;
double t0; /* temporary time */
double *utime;
extern SuperLUStat_t SuperLUStat;
/* External functions */
extern double dlangs(char *, SuperMatrix *);
extern double dlamch_(char *);
Bstore = B->Store;
Xstore = X->Store;
Bmat = Bstore->nzval;
Xmat = Xstore->nzval;
ldb = Bstore->lda;
ldx = Xstore->lda;
nrhs = B->ncol;
#if 0
printf("dgssvx: fact=%c, trans=%c, refact=%c, equed=%c\n",
*fact, *trans, *refact, *equed);
#endif
*info = 0;
nofact = lsame_(fact, "N");
equil = lsame_(fact, "E");
notran = lsame_(trans, "N");
if (nofact || equil) {
*(unsigned char *)equed = 'N';
rowequ = FALSE;
colequ = FALSE;
} else {
rowequ = lsame_(equed, "R") || lsame_(equed, "B");
colequ = lsame_(equed, "C") || lsame_(equed, "B");
smlnum = dlamch_("Safe minimum");
bignum = 1. / smlnum;
}
/* Test the input parameters */
if (!nofact && !equil && !lsame_(fact, "F")) *info = -1;
else if (!notran && !lsame_(trans, "T") && !lsame_(trans, "C")) *info = -2;
else if ( !(lsame_(refact,"Y") || lsame_(refact, "N")) ) *info = -3;
else if ( A->nrow != A->ncol || A->nrow < 0 ||
(A->Stype != NC && A->Stype != NR) ||
A->Dtype != D_ || A->Mtype != GE )
*info = -4;
else if (lsame_(fact, "F") && !(rowequ || colequ || lsame_(equed, "N")))
*info = -9;
else {
if (rowequ) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, R[j]);
rcmax = SUPERLU_MAX(rcmax, R[j]);
}
if (rcmin <= 0.) *info = -10;
else if ( A->nrow > 0)
rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else rowcnd = 1.;
}
if (colequ && *info == 0) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, C[j]);
rcmax = SUPERLU_MAX(rcmax, C[j]);
}
if (rcmin <= 0.) *info = -11;
else if (A->nrow > 0)
colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else colcnd = 1.;
}
if (*info == 0) {
if ( lwork < -1 ) *info = -15;
else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != DN || B->Dtype != D_ ||
B->Mtype != GE )
*info = -16;
else if ( X->ncol < 0 || Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->ncol != X->ncol || X->Stype != DN ||
X->Dtype != D_ || X->Mtype != GE )
*info = -17;
}
}
if (*info != 0) {
i = -(*info);
xerbla_("dgssvx", &i);
return;
}
/* Default values for factor_params */
panel_size = sp_ienv(1);
relax = sp_ienv(2);
diag_pivot_thresh = 1.0;
drop_tol = 0.0;
if ( factor_params != NULL ) {
if ( factor_params->panel_size != -1 )
panel_size = factor_params->panel_size;
if ( factor_params->relax != -1 ) relax = factor_params->relax;
if ( factor_params->diag_pivot_thresh != -1 )
diag_pivot_thresh = factor_params->diag_pivot_thresh;
if ( factor_params->drop_tol != -1 )
drop_tol = factor_params->drop_tol;
}
StatInit(panel_size, relax);
utime = SuperLUStat.utime;
/* Convert A to NC format when necessary. */
if ( A->Stype == NR ) {
NRformat *Astore = A->Store;
AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
Astore->nzval, Astore->colind, Astore->rowptr,
NC, A->Dtype, A->Mtype);
if ( notran ) { /* Reverse the transpose argument. */
*trant = 'T';
notran = 0;
} else {
*trant = 'N';
notran = 1;
}
} else { /* A->Stype == NC */
*trant = *trans;
AA = A;
}
if ( equil ) {
t0 = SuperLU_timer_();
/* Compute row and column scalings to equilibrate the matrix A. */
dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
dlaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
rowequ = lsame_(equed, "R") || lsame_(equed, "B");
colequ = lsame_(equed, "C") || lsame_(equed, "B");
}
utime[EQUIL] = SuperLU_timer_() - t0;
}
/* Scale the right hand side if equilibration was performed. */
if ( notran ) {
if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Bmat[i + j*ldb] *= R[i];
}
}
} else if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Bmat[i + j*ldb] *= C[i];
}
}
if ( nofact || equil ) {
t0 = SuperLU_timer_();
sp_preorder(refact, AA, perm_c, etree, &AC);
utime[ETREE] = SuperLU_timer_() - t0;
/* printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
relax, panel_size, sp_ienv(3), sp_ienv(4));
fflush(stdout); */
/* Compute the LU factorization of A*Pc. */
t0 = SuperLU_timer_();
dgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
etree, work, lwork, perm_r, perm_c, L, U, info);
utime[FACT] = SuperLU_timer_() - t0;
if ( lwork == -1 ) {
mem_usage->total_needed = *info - A->ncol;
return;
}
}
if ( *info > 0 ) {
if ( *info <= A->ncol ) {
/* Compute the reciprocal pivot growth factor of the leading
rank-deficient *info columns of A. */
*recip_pivot_growth = dPivotGrowth(*info, AA, perm_c, L, U);
}
return;
}
/* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
*recip_pivot_growth = dPivotGrowth(A->ncol, AA, perm_c, L, U);
/* Estimate the reciprocal of the condition number of A. */
t0 = SuperLU_timer_();
if ( notran ) {
*(unsigned char *)norm = '1';
} else {
*(unsigned char *)norm = 'I';
}
anorm = dlangs(norm, AA);
dgscon(norm, L, U, anorm, rcond, info);
utime[RCOND] = SuperLU_timer_() - t0;
/* Compute the solution matrix X. */
for (j = 0; j < nrhs; j++) /* Save a copy of the right hand sides */
for (i = 0; i < B->nrow; i++)
Xmat[i + j*ldx] = Bmat[i + j*ldb];
t0 = SuperLU_timer_();
dgstrs (trant, L, U, perm_r, perm_c, X, info);
utime[SOLVE] = SuperLU_timer_() - t0;
/* Use iterative refinement to improve the computed solution and compute
error bounds and backward error estimates for it. */
t0 = SuperLU_timer_();
dgsrfs(trant, AA, L, U, perm_r, perm_c, equed, R, C, B,
X, ferr, berr, info);
utime[REFINE] = SuperLU_timer_() - t0;
/* Transform the solution matrix X to a solution of the original system. */
if ( notran ) {
if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= C[i];
}
}
} else if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= R[i];
}
}
/* Set INFO = A->ncol+1 if the matrix is singular to working precision. */
if ( *rcond < dlamch_("E") ) *info = A->ncol + 1;
dQuerySpace(L, U, panel_size, mem_usage);
if ( nofact || equil ) Destroy_CompCol_Permuted(&AC);
if ( A->Stype == NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
/* PrintStat( &SuperLUStat ); */
StatFree();
}
void
dgsisx(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
int *etree, char *equed, double *R, double *C,
SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
SuperMatrix *B, SuperMatrix *X,
double *recip_pivot_growth, double *rcond,
GlobalLU_t *Glu, mem_usage_t *mem_usage, SuperLUStat_t *stat, int *info)
{
DNformat *Bstore, *Xstore;
double *Bmat, *Xmat;
int ldb, ldx, nrhs, n;
SuperMatrix *AA;/* A in SLU_NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int colequ, equil, nofact, notran, rowequ, permc_spec, mc64;
trans_t trant;
char norm[1];
int i, j, info1;
double amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
int relax, panel_size;
double diag_pivot_thresh;
double t0; /* temporary time */
double *utime;
int *perm = NULL; /* permutation returned from MC64 */
/* External functions */
extern double dlangs(char *, SuperMatrix *);
Bstore = B->Store;
Xstore = X->Store;
Bmat = Bstore->nzval;
Xmat = Xstore->nzval;
ldb = Bstore->lda;
ldx = Xstore->lda;
nrhs = B->ncol;
n = B->nrow;
*info = 0;
nofact = (options->Fact != FACTORED);
equil = (options->Equil == YES);
notran = (options->Trans == NOTRANS);
mc64 = (options->RowPerm == LargeDiag);
if ( nofact ) {
*(unsigned char *)equed = 'N';
rowequ = FALSE;
colequ = FALSE;
} else {
rowequ = strncmp(equed, "R", 1)==0 || strncmp(equed, "B", 1)==0;
colequ = strncmp(equed, "C", 1)==0 || strncmp(equed, "B", 1)==0;
smlnum = dmach("Safe minimum"); /* lamch_("Safe minimum"); */
bignum = 1. / smlnum;
}
/* Test the input parameters */
if (options->Fact != DOFACT && options->Fact != SamePattern &&
options->Fact != SamePattern_SameRowPerm &&
options->Fact != FACTORED &&
options->Trans != NOTRANS && options->Trans != TRANS &&
options->Trans != CONJ &&
options->Equil != NO && options->Equil != YES)
*info = -1;
else if ( A->nrow != A->ncol || A->nrow < 0 ||
(A->Stype != SLU_NC && A->Stype != SLU_NR) ||
A->Dtype != SLU_D || A->Mtype != SLU_GE )
*info = -2;
else if ( options->Fact == FACTORED &&
!(rowequ || colequ || strncmp(equed, "N", 1)==0) )
*info = -6;
else {
if (rowequ) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, R[j]);
rcmax = SUPERLU_MAX(rcmax, R[j]);
}
if (rcmin <= 0.) *info = -7;
else if ( A->nrow > 0)
rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else rowcnd = 1.;
}
if (colequ && *info == 0) {
rcmin = bignum;
rcmax = 0.;
for (j = 0; j < A->nrow; ++j) {
rcmin = SUPERLU_MIN(rcmin, C[j]);
rcmax = SUPERLU_MAX(rcmax, C[j]);
}
if (rcmin <= 0.) *info = -8;
else if (A->nrow > 0)
colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
else colcnd = 1.;
}
if (*info == 0) {
if ( lwork < -1 ) *info = -12;
else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != SLU_DN || B->Dtype != SLU_D ||
B->Mtype != SLU_GE )
*info = -13;
else if ( X->ncol < 0 || Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
(B->ncol != 0 && B->ncol != X->ncol) ||
X->Stype != SLU_DN ||
X->Dtype != SLU_D || X->Mtype != SLU_GE )
*info = -14;
}
}
if (*info != 0) {
i = -(*info);
input_error("dgsisx", &i);
return;
}
/* Initialization for factor parameters */
panel_size = sp_ienv(1);
relax = sp_ienv(2);
diag_pivot_thresh = options->DiagPivotThresh;
utime = stat->utime;
/* Convert A to SLU_NC format when necessary. */
if ( A->Stype == SLU_NR ) {
NRformat *Astore = A->Store;
AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
Astore->nzval, Astore->colind, Astore->rowptr,
SLU_NC, A->Dtype, A->Mtype);
if ( notran ) { /* Reverse the transpose argument. */
trant = TRANS;
notran = 0;
} else {
trant = NOTRANS;
notran = 1;
}
} else { /* A->Stype == SLU_NC */
trant = options->Trans;
AA = A;
}
if ( nofact ) {
register int i, j;
NCformat *Astore = AA->Store;
int nnz = Astore->nnz;
int *colptr = Astore->colptr;
int *rowind = Astore->rowind;
double *nzval = (double *)Astore->nzval;
if ( mc64 ) {
t0 = SuperLU_timer_();
if ((perm = intMalloc(n)) == NULL)
ABORT("SUPERLU_MALLOC fails for perm[]");
info1 = dldperm(5, n, nnz, colptr, rowind, nzval, perm, R, C);
if (info1 != 0) { /* MC64 fails, call dgsequ() later */
mc64 = 0;
SUPERLU_FREE(perm);
perm = NULL;
} else {
if ( equil ) {
rowequ = colequ = 1;
for (i = 0; i < n; i++) {
R[i] = exp(R[i]);
C[i] = exp(C[i]);
}
/* scale the matrix */
for (j = 0; j < n; j++) {
for (i = colptr[j]; i < colptr[j + 1]; i++) {
nzval[i] *= R[rowind[i]] * C[j];
}
}
*equed = 'B';
}
/* permute the matrix */
for (j = 0; j < n; j++) {
for (i = colptr[j]; i < colptr[j + 1]; i++) {
/*nzval[i] *= R[rowind[i]] * C[j];*/
rowind[i] = perm[rowind[i]];
}
}
}
utime[EQUIL] = SuperLU_timer_() - t0;
}
if ( !mc64 & equil ) { /* Only perform equilibration, no row perm */
t0 = SuperLU_timer_();
/* Compute row and column scalings to equilibrate the matrix A. */
dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
dlaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
rowequ = strncmp(equed, "R", 1)==0 || strncmp(equed, "B", 1)==0;
colequ = strncmp(equed, "C", 1)==0 || strncmp(equed, "B", 1)==0;
}
utime[EQUIL] = SuperLU_timer_() - t0;
}
}
if ( nofact ) {
t0 = SuperLU_timer_();
/*
* Gnet column permutation vector perm_c[], according to permc_spec:
* permc_spec = NATURAL: natural ordering
* permc_spec = MMD_AT_PLUS_A: minimum degree on structure of A'+A
* permc_spec = MMD_ATA: minimum degree on structure of A'*A
* permc_spec = COLAMD: approximate minimum degree column ordering
* permc_spec = MY_PERMC: the ordering already supplied in perm_c[]
*/
permc_spec = options->ColPerm;
if ( permc_spec != MY_PERMC && options->Fact == DOFACT )
get_perm_c(permc_spec, AA, perm_c);
utime[COLPERM] = SuperLU_timer_() - t0;
t0 = SuperLU_timer_();
sp_preorder(options, AA, perm_c, etree, &AC);
utime[ETREE] = SuperLU_timer_() - t0;
/* Compute the LU factorization of A*Pc. */
t0 = SuperLU_timer_();
dgsitrf(options, &AC, relax, panel_size, etree, work, lwork,
perm_c, perm_r, L, U, Glu, stat, info);
utime[FACT] = SuperLU_timer_() - t0;
if ( lwork == -1 ) {
mem_usage->total_needed = *info - A->ncol;
return;
}
if ( mc64 ) { /* Fold MC64's perm[] into perm_r[]. */
NCformat *Astore = AA->Store;
int nnz = Astore->nnz, *rowind = Astore->rowind;
int *perm_tmp, *iperm;
if ((perm_tmp = intMalloc(2*n)) == NULL)
ABORT("SUPERLU_MALLOC fails for perm_tmp[]");
iperm = perm_tmp + n;
for (i = 0; i < n; ++i) perm_tmp[i] = perm_r[perm[i]];
for (i = 0; i < n; ++i) {
perm_r[i] = perm_tmp[i];
iperm[perm[i]] = i;
}
/* Restore A's original row indices. */
for (i = 0; i < nnz; ++i) rowind[i] = iperm[rowind[i]];
SUPERLU_FREE(perm); /* MC64 permutation */
SUPERLU_FREE(perm_tmp);
}
}
if ( options->PivotGrowth ) {
if ( *info > 0 ) return;
/* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
*recip_pivot_growth = dPivotGrowth(A->ncol, AA, perm_c, L, U);
}
if ( options->ConditionNumber ) {
/* Estimate the reciprocal of the condition number of A. */
t0 = SuperLU_timer_();
if ( notran ) {
*(unsigned char *)norm = '1';
} else {
*(unsigned char *)norm = 'I';
}
anorm = dlangs(norm, AA);
dgscon(norm, L, U, anorm, rcond, stat, &info1);
utime[RCOND] = SuperLU_timer_() - t0;
}
if ( nrhs > 0 ) { /* Solve the system */
double *rhs_work;
/* Scale and permute the right-hand side if equilibration
and permutation from MC64 were performed. */
if ( notran ) {
if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < n; ++i)
Bmat[i + j*ldb] *= R[i];
}
} else if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < n; ++i) {
Bmat[i + j*ldb] *= C[i];
}
}
/* Compute the solution matrix X. */
for (j = 0; j < nrhs; j++) /* Save a copy of the right hand sides */
for (i = 0; i < B->nrow; i++)
Xmat[i + j*ldx] = Bmat[i + j*ldb];
t0 = SuperLU_timer_();
dgstrs (trant, L, U, perm_c, perm_r, X, stat, &info1);
utime[SOLVE] = SuperLU_timer_() - t0;
/* Transform the solution matrix X to a solution of the original
system. */
if ( notran ) {
if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < n; ++i) {
Xmat[i + j*ldx] *= C[i];
}
}
} else { /* transposed system */
if ( rowequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
Xmat[i + j*ldx] *= R[i];
}
}
}
} /* end if nrhs > 0 */
if ( options->ConditionNumber ) {
/* The matrix is singular to working precision. */
/* if ( *rcond < dlamch_("E") && *info == 0) *info = A->ncol + 1; */
if ( *rcond < dmach("E") && *info == 0) *info = A->ncol + 1;
}
if ( nofact ) {
ilu_dQuerySpace(L, U, mem_usage);
Destroy_CompCol_Permuted(&AC);
}
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
}
int dgst02(trans_t trans, int m, int n, int nrhs, SuperMatrix *A,
double *x, int ldx, double *b, int ldb, double *resid)
{
/*
Purpose
=======
DGST02 computes the residual for a solution of a system of linear
equations A*x = b or A'*x = b:
RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
where EPS is the machine epsilon.
Arguments
=========
TRANS (input) trans_t
Specifies the form of the system of equations:
= NOTRANS: A *x = b
= TRANS : A'*x = b, where A' is the transpose of A
= CONJ : A'*x = b, where A' is the transpose of A
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
NRHS (input) INTEGER
The number of columns of B, the matrix of right hand sides.
NRHS >= 0.
A (input) SuperMatrix*, dimension (LDA,N)
The original M x N sparse matrix A.
X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
The computed solution vectors for the system of linear
equations.
LDX (input) INTEGER
The leading dimension of the array X. If TRANS = NOTRANS,
LDX >= max(1,N); if TRANS = TRANS or CONJ, LDX >= max(1,M).
B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
On entry, the right hand side vectors for the system of
linear equations.
On exit, B is overwritten with the difference B - A*X.
LDB (input) INTEGER
The leading dimension of the array B. IF TRANS = NOTRANS,
LDB >= max(1,M); if TRANS = TRANS or CONJ, LDB >= max(1,N).
RESID (output) DOUBLE PRECISION
The maximum over the number of right hand sides of
norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
=====================================================================
*/
/* Table of constant values */
double alpha = -1.;
double beta = 1.;
int c__1 = 1;
/* System generated locals */
double d__1, d__2;
/* Local variables */
int j;
int n1, n2;
double anorm, bnorm;
double xnorm;
double eps;
char transc[1];
/* Function prototypes */
extern int lsame_(char *, char *);
extern double dlangs(char *, SuperMatrix *);
extern double dasum_(int *, double *, int *);
extern double dlamch_(char *);
/* Function Body */
if ( m <= 0 || n <= 0 || nrhs == 0) {
*resid = 0.;
return 0;
}
if ( (trans == TRANS) || (trans == CONJ) ) {
n1 = n;
n2 = m;
*transc = 'T';
} else {
n1 = m;
n2 = n;
*transc = 'N';
}
/* Exit with RESID = 1/EPS if ANORM = 0. */
eps = dlamch_("Epsilon");
anorm = dlangs("1", A);
if (anorm <= 0.) {
*resid = 1. / eps;
return 0;
}
/* Compute B - A*X (or B - A'*X ) and store in B. */
sp_dgemm(transc, "N", n1, nrhs, n2, alpha, A, x, ldx, beta, b, ldb);
/* Compute the maximum over the number of right hand sides of
norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . */
*resid = 0.;
for (j = 0; j < nrhs; ++j) {
bnorm = dasum_(&n1, &b[j*ldb], &c__1);
xnorm = dasum_(&n2, &x[j*ldx], &c__1);
if (xnorm <= 0.) {
*resid = 1. / eps;
} else {
/* Computing MAX */
d__1 = *resid, d__2 = bnorm / anorm / xnorm / eps;
*resid = SUPERLU_MAX(d__1, d__2);
}
}
return 0;
} /* dgst02 */
static real_t slm_norm(void* context, char n)
{
slm_t* mat = context;
return (real_t)dlangs(&n, mat->A);
}