static void
gssvx (superlu_options_t *p1, SuperMatrix *p2, int *p3, int *p4, int *p5,
char *p6, double *p7, double *p8, SuperMatrix *p9, SuperMatrix *p10,
void *p11, int p12, SuperMatrix *p13, SuperMatrix *p14,
double *p15, double *p16, double *p17, double *p18, GlobalLU_t *pGlu,
mem_usage_t *p19, SuperLUStat_t *p20, int *p21)
{dgssvx(p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, p18, pGlu, p19, p20, p21);}
void SuperLUSolver<double>::solver_driver(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, slu_memusage_t *mem_usage, SuperLUStat_t *stat,
int *info)
{
dgssvx(options, A, perm_c, perm_r, etree, equed, R, C, L, U, work, lwork, B, X, recip_pivot_growth, rcond, ferr, berr, (mem_usage_t*)mem_usage, stat, info);
}
main(int argc, char *argv[])
{
/*
* Purpose
* =======
*
* The driver program DLINSOLX2.
*
* This example illustrates how to use DGSSVX to solve systems repeatedly
* with the same sparsity pattern of matrix A.
* In this case, the column permutation vector perm_c is computed once.
* The following data structures will be reused in the subsequent call to
* DGSSVX: perm_c, etree
*
*/
char equed[1];
yes_no_t equil;
trans_t trans;
SuperMatrix A, A1, L, U;
SuperMatrix B, B1, X;
NCformat *Astore;
NCformat *Ustore;
SCformat *Lstore;
double *a, *a1;
int *asub, *xa, *asub1, *xa1;
int *perm_r; /* row permutations from partial pivoting */
int *perm_c; /* column permutation vector */
int *etree;
void *work;
int info, lwork, nrhs, ldx;
int i, j, m, n, nnz;
double *rhsb, *rhsb1, *rhsx, *xact;
double *R, *C;
double *ferr, *berr;
double u, rpg, rcond;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
extern void parse_command_line();
#if ( DEBUGlevel>=1 )
CHECK_MALLOC("Enter main()");
#endif
/* Defaults */
lwork = 0;
nrhs = 1;
equil = YES;
u = 1.0;
trans = NOTRANS;
/* Set the default input options:
options.Fact = DOFACT;
options.Equil = YES;
options.ColPerm = COLAMD;
options.DiagPivotThresh = 1.0;
options.Trans = NOTRANS;
options.IterRefine = NOREFINE;
options.SymmetricMode = NO;
options.PivotGrowth = NO;
options.ConditionNumber = NO;
options.PrintStat = YES;
*/
set_default_options(&options);
/* Can use command line input to modify the defaults. */
parse_command_line(argc, argv, &lwork, &u, &equil, &trans);
options.Equil = equil;
options.DiagPivotThresh = u;
options.Trans = trans;
if ( lwork > 0 ) {
work = SUPERLU_MALLOC(lwork);
if ( !work ) {
ABORT("DLINSOLX: cannot allocate work[]");
}
}
/* Read matrix A from a file in Harwell-Boeing format.*/
dreadhb(&m, &n, &nnz, &a, &asub, &xa);
if ( !(a1 = doubleMalloc(nnz)) ) ABORT("Malloc fails for a1[].");
if ( !(asub1 = intMalloc(nnz)) ) ABORT("Malloc fails for asub1[].");
if ( !(xa1 = intMalloc(n+1)) ) ABORT("Malloc fails for xa1[].");
for (i = 0; i < nnz; ++i) {
a1[i] = a[i];
asub1[i] = asub[i];
}
for (i = 0; i < n+1; ++i) xa1[i] = xa[i];
dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);
Astore = A.Store;
printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
if ( !(rhsb = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
if ( !(rhsb1 = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb1[].");
if ( !(rhsx = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[].");
dCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_D, SLU_GE);
dCreate_Dense_Matrix(&X, m, nrhs, rhsx, m, SLU_DN, SLU_D, SLU_GE);
xact = doubleMalloc(n * nrhs);
ldx = n;
dGenXtrue(n, nrhs, xact, ldx);
dFillRHS(trans, nrhs, xact, ldx, &A, &B);
for (j = 0; j < nrhs; ++j)
for (i = 0; i < m; ++i) rhsb1[i+j*m] = rhsb[i+j*m];
if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");
if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[].");
if ( !(R = (double *) SUPERLU_MALLOC(A.nrow * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for R[].");
if ( !(C = (double *) SUPERLU_MALLOC(A.ncol * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for C[].");
if ( !(ferr = (double *) SUPERLU_MALLOC(nrhs * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for ferr[].");
if ( !(berr = (double *) SUPERLU_MALLOC(nrhs * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for berr[].");
/* Initialize the statistics variables. */
StatInit(&stat);
/* ------------------------------------------------------------
WE SOLVE THE LINEAR SYSTEM FOR THE FIRST TIME: AX = B
------------------------------------------------------------*/
dgssvx(&options, &A, perm_c, perm_r, etree, equed, R, C,
&L, &U, work, lwork, &B, &X, &rpg, &rcond, ferr, berr,
&mem_usage, &stat, &info);
printf("First system: dgssvx() returns info %d\n", info);
if ( info == 0 || info == n+1 ) {
/* This is how you could access the solution matrix. */
double *sol = (double*) ((DNformat*) X.Store)->nzval;
if ( options.PivotGrowth ) printf("Recip. pivot growth = %e\n", rpg);
if ( options.ConditionNumber )
printf("Recip. condition number = %e\n", rcond);
Lstore = (SCformat *) L.Store;
Ustore = (NCformat *) U.Store;
printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
printf("FILL ratio = %.1f\n", (float)(Lstore->nnz + Ustore->nnz - n)/nnz);
printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
if ( options.IterRefine ) {
printf("Iterative Refinement:\n");
printf("%8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR");
for (i = 0; i < nrhs; ++i)
printf("%8d%8d%16e%16e\n", i+1, stat.RefineSteps, ferr[i], berr[i]);
}
fflush(stdout);
} else if ( info > 0 && lwork == -1 ) {
printf("** Estimated memory: %d bytes\n", info - n);
}
if ( options.PrintStat ) StatPrint(&stat);
StatFree(&stat);
Destroy_CompCol_Matrix(&A);
Destroy_Dense_Matrix(&B);
if ( lwork >= 0 ) { /* Deallocate storage associated with L and U. */
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&U);
}
/* ------------------------------------------------------------
NOW WE SOLVE ANOTHER LINEAR SYSTEM: A1*X = B1
ONLY THE SPARSITY PATTERN OF A1 IS THE SAME AS THAT OF A.
------------------------------------------------------------*/
options.Fact = SamePattern;
StatInit(&stat); /* Initialize the statistics variables. */
dCreate_CompCol_Matrix(&A1, m, n, nnz, a1, asub1, xa1,
SLU_NC, SLU_D, SLU_GE);
dCreate_Dense_Matrix(&B1, m, nrhs, rhsb1, m, SLU_DN, SLU_D, SLU_GE);
dgssvx(&options, &A1, perm_c, perm_r, etree, equed, R, C,
&L, &U, work, lwork, &B1, &X, &rpg, &rcond, ferr, berr,
&mem_usage, &stat, &info);
printf("\nSecond system: dgssvx() returns info %d\n", info);
if ( info == 0 || info == n+1 ) {
/* This is how you could access the solution matrix. */
double *sol = (double*) ((DNformat*) X.Store)->nzval;
if ( options.PivotGrowth ) printf("Recip. pivot growth = %e\n", rpg);
if ( options.ConditionNumber )
printf("Recip. condition number = %e\n", rcond);
Lstore = (SCformat *) L.Store;
Ustore = (NCformat *) U.Store;
printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
if ( options.IterRefine ) {
printf("Iterative Refinement:\n");
printf("%8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR");
for (i = 0; i < nrhs; ++i)
printf("%8d%8d%16e%16e\n", i+1, stat.RefineSteps, ferr[i], berr[i]);
}
fflush(stdout);
} else if ( info > 0 && lwork == -1 ) {
printf("** Estimated memory: %d bytes\n", info - n);
}
if ( options.PrintStat ) StatPrint(&stat);
StatFree(&stat);
SUPERLU_FREE (xact);
SUPERLU_FREE (etree);
SUPERLU_FREE (perm_r);
SUPERLU_FREE (perm_c);
SUPERLU_FREE (R);
SUPERLU_FREE (C);
SUPERLU_FREE (ferr);
SUPERLU_FREE (berr);
Destroy_CompCol_Matrix(&A1);
Destroy_Dense_Matrix(&B1);
Destroy_Dense_Matrix(&X);
if ( lwork >= 0 ) {
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&U);
}
#if ( DEBUGlevel>=1 )
CHECK_MALLOC("Exit main()");
#endif
}
PetscErrorCode MatSolve_SuperLU_Private(Mat A,Vec b,Vec x)
{
Mat_SuperLU *lu = (Mat_SuperLU*)A->spptr;
PetscScalar *barray,*xarray;
PetscErrorCode ierr;
PetscInt info,i,n=x->map->n;
PetscReal ferr,berr;
PetscFunctionBegin;
if ( lu->lwork == -1 ) {
PetscFunctionReturn(0);
}
lu->B.ncol = 1; /* Set the number of right-hand side */
if (lu->options.Equil && !lu->rhs_dup){
/* superlu overwrites b when Equil is used, thus create rhs_dup to keep user's b unchanged */
ierr = PetscMalloc(n*sizeof(PetscScalar),&lu->rhs_dup);CHKERRQ(ierr);
}
if (lu->options.Equil){
/* Copy b into rsh_dup */
ierr = VecGetArray(b,&barray);CHKERRQ(ierr);
ierr = PetscMemcpy(lu->rhs_dup,barray,n*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = VecRestoreArray(b,&barray);CHKERRQ(ierr);
barray = lu->rhs_dup;
} else {
ierr = VecGetArray(b,&barray);CHKERRQ(ierr);
}
ierr = VecGetArray(x,&xarray);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
((DNformat*)lu->B.Store)->nzval = (doublecomplex*)barray;
((DNformat*)lu->X.Store)->nzval = (doublecomplex*)xarray;
#else
((DNformat*)lu->B.Store)->nzval = barray;
((DNformat*)lu->X.Store)->nzval = xarray;
#endif
lu->options.Fact = FACTORED; /* Indicate the factored form of A is supplied. */
if (A->factortype == MAT_FACTOR_LU){
#if defined(PETSC_USE_COMPLEX)
zgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr,
&lu->mem_usage, &lu->stat, &info);
#else
dgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr,
&lu->mem_usage, &lu->stat, &info);
#endif
} else if (A->factortype == MAT_FACTOR_ILU){
#if defined(PETSC_USE_COMPLEX)
zgsisx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond,
&lu->mem_usage, &lu->stat, &info);
#else
dgsisx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond,
&lu->mem_usage, &lu->stat, &info);
#endif
} else {
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Factor type not supported");
}
if (!lu->options.Equil){
ierr = VecRestoreArray(b,&barray);CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xarray);CHKERRQ(ierr);
if ( !info || info == lu->A.ncol+1 ) {
if ( lu->options.IterRefine ) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Iterative Refinement:\n");
ierr = PetscPrintf(PETSC_COMM_SELF," %8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR");
for (i = 0; i < 1; ++i)
ierr = PetscPrintf(PETSC_COMM_SELF," %8d%8d%16e%16e\n", i+1, lu->stat.RefineSteps, ferr, berr);
}
} else if ( info > 0 ){
if ( lu->lwork == -1 ) {
ierr = PetscPrintf(PETSC_COMM_SELF," ** Estimated memory: %D bytes\n", info - lu->A.ncol);
} else {
ierr = PetscPrintf(PETSC_COMM_SELF," Warning: gssvx() returns info %D\n",info);
}
} else if (info < 0){
SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB, "info = %D, the %D-th argument in gssvx() had an illegal value", info,-info);
}
if ( lu->options.PrintStat ) {
ierr = PetscPrintf(PETSC_COMM_SELF,"MatSolve__SuperLU():\n");
StatPrint(&lu->stat);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatLUFactorNumeric_SuperLU(Mat F,Mat A,const MatFactorInfo *info)
{
Mat_SuperLU *lu = (Mat_SuperLU*)F->spptr;
Mat_SeqAIJ *aa;
PetscErrorCode ierr;
PetscInt sinfo;
PetscReal ferr, berr;
NCformat *Ustore;
SCformat *Lstore;
PetscFunctionBegin;
if (lu->flg == SAME_NONZERO_PATTERN){ /* successing numerical factorization */
lu->options.Fact = SamePattern;
/* Ref: ~SuperLU_3.0/EXAMPLE/dlinsolx2.c */
Destroy_SuperMatrix_Store(&lu->A);
if (lu->options.Equil){
ierr = MatCopy_SeqAIJ(A,lu->A_dup,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
if ( lu->lwork >= 0 ) {
Destroy_SuperNode_Matrix(&lu->L);
Destroy_CompCol_Matrix(&lu->U);
lu->options.Fact = SamePattern;
}
}
/* Create the SuperMatrix for lu->A=A^T:
Since SuperLU likes column-oriented matrices,we pass it the transpose,
and then solve A^T X = B in MatSolve(). */
if (lu->options.Equil){
aa = (Mat_SeqAIJ*)(lu->A_dup)->data;
} else {
aa = (Mat_SeqAIJ*)(A)->data;
}
#if defined(PETSC_USE_COMPLEX)
zCreate_CompCol_Matrix(&lu->A,A->cmap->n,A->rmap->n,aa->nz,(doublecomplex*)aa->a,aa->j,aa->i,
SLU_NC,SLU_Z,SLU_GE);
#else
dCreate_CompCol_Matrix(&lu->A,A->cmap->n,A->rmap->n,aa->nz,aa->a,aa->j,aa->i,
SLU_NC,SLU_D,SLU_GE);
#endif
/* Numerical factorization */
lu->B.ncol = 0; /* Indicate not to solve the system */
if (F->factortype == MAT_FACTOR_LU){
#if defined(PETSC_USE_COMPLEX)
zgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr,
&lu->mem_usage, &lu->stat, &sinfo);
#else
dgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr,
&lu->mem_usage, &lu->stat, &sinfo);
#endif
} else if (F->factortype == MAT_FACTOR_ILU){
/* Compute the incomplete factorization, condition number and pivot growth */
#if defined(PETSC_USE_COMPLEX)
zgsisx(&lu->options, &lu->A, lu->perm_c, lu->perm_r,lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond,
&lu->mem_usage, &lu->stat, &sinfo);
#else
dgsisx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
&lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond,
&lu->mem_usage, &lu->stat, &sinfo);
#endif
} else {
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Factor type not supported");
}
if ( !sinfo || sinfo == lu->A.ncol+1 ) {
if ( lu->options.PivotGrowth )
ierr = PetscPrintf(PETSC_COMM_SELF," Recip. pivot growth = %e\n", lu->rpg);
if ( lu->options.ConditionNumber )
ierr = PetscPrintf(PETSC_COMM_SELF," Recip. condition number = %e\n", lu->rcond);
} else if ( sinfo > 0 ){
if ( lu->lwork == -1 ) {
ierr = PetscPrintf(PETSC_COMM_SELF," ** Estimated memory: %D bytes\n", sinfo - lu->A.ncol);
} else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot in row %D",sinfo);
} else { /* sinfo < 0 */
SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB, "info = %D, the %D-th argument in gssvx() had an illegal value", sinfo,-sinfo);
}
if ( lu->options.PrintStat ) {
ierr = PetscPrintf(PETSC_COMM_SELF,"MatLUFactorNumeric_SuperLU():\n");
StatPrint(&lu->stat);
Lstore = (SCformat *) lu->L.Store;
Ustore = (NCformat *) lu->U.Store;
ierr = PetscPrintf(PETSC_COMM_SELF," No of nonzeros in factor L = %D\n", Lstore->nnz);
ierr = PetscPrintf(PETSC_COMM_SELF," No of nonzeros in factor U = %D\n", Ustore->nnz);
ierr = PetscPrintf(PETSC_COMM_SELF," No of nonzeros in L+U = %D\n", Lstore->nnz + Ustore->nnz - lu->A.ncol);
ierr = PetscPrintf(PETSC_COMM_SELF," L\\U MB %.3f\ttotal MB needed %.3f\n",
lu->mem_usage.for_lu/1e6, lu->mem_usage.total_needed/1e6);
}
lu->flg = SAME_NONZERO_PATTERN;
F->ops->solve = MatSolve_SuperLU;
F->ops->solvetranspose = MatSolveTranspose_SuperLU;
F->ops->matsolve = MatMatSolve_SuperLU;
PetscFunctionReturn(0);
}
bool SparseMatrix::solveSLUx (Vector& B, Real* rcond)
{
int ierr = ncol+1;
if (!factored) this->optimiseSLU();
#ifdef HAS_SUPERLU_MT
if (!slu) {
// Create a new SuperLU matrix
slu = new SuperLUdata(numThreads);
slu->equed = NOEQUIL;
slu->perm_c = new int[ncol];
slu->perm_r = new int[nrow];
slu->C = new Real[ncol];
slu->R = new Real[nrow];
slu->opts->etree = new int[ncol];
slu->opts->colcnt_h = new int[ncol];
slu->opts->part_super_h = new int[ncol];
memset(slu->opts->colcnt_h, 0, ncol*sizeof(int));
memset(slu->opts->part_super_h, 0, ncol*sizeof(int));
memset(slu->opts->etree, 0, ncol*sizeof(int));
dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
&A.front(), &JA.front(), &IA.front(),
SLU_NC, SLU_D, SLU_GE);
// Get column permutation vector perm_c[], according to permc_spec:
// permc_spec = 0: natural ordering
// permc_spec = 1: minimum degree ordering on structure of A'*A
// permc_spec = 2: minimum degree ordering on structure of A'+A
// permc_spec = 3: approximate minimum degree for unsymmetric matrices
int permc_spec = 1;
get_perm_c(permc_spec, &slu->A, slu->perm_c);
}
else if (factored)
slu->opts->fact = FACTORED; // Re-use previous factorization
else
slu->opts->refact = YES; // Re-use previous ordering
// Create right-hand-side and solution vector(s)
Vector X(B.size());
SuperMatrix Bmat, Xmat;
const size_t nrhs = B.size() / nrow;
dCreate_Dense_Matrix(&Bmat, nrow, nrhs, B.ptr(), nrow,
SLU_DN, SLU_D, SLU_GE);
dCreate_Dense_Matrix(&Xmat, nrow, nrhs, X.ptr(), nrow,
SLU_DN, SLU_D, SLU_GE);
Real ferr[nrhs], berr[nrhs];
superlu_memusage_t mem_usage;
// Invoke the expert driver
pdgssvx(numThreads, slu->opts, &slu->A, slu->perm_c, slu->perm_r,
&slu->equed, slu->R, slu->C, &slu->L, &slu->U, &Bmat, &Xmat,
&slu->rpg, &slu->rcond, ferr, berr, &mem_usage, &ierr);
B.swap(X);
if (ierr > 0)
std::cerr <<"SuperLU_MT Failure "<< ierr << std::endl;
else if (!factored)
{
factored = true;
if (rcond)
*rcond = slu->rcond;
}
Destroy_SuperMatrix_Store(&Bmat);
Destroy_SuperMatrix_Store(&Xmat);
#elif defined(HAS_SUPERLU)
if (!slu) {
// Create a new SuperLU matrix
slu = new SuperLUdata(1);
slu->perm_c = new int[ncol];
slu->perm_r = new int[nrow];
slu->etree = new int[ncol];
slu->C = new Real[ncol];
slu->R = new Real[nrow];
dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
&A.front(), &JA.front(), &IA.front(),
SLU_NC, SLU_D, SLU_GE);
}
else if (factored)
slu->opts->Fact = FACTORED; // Re-use previous factorization
else {
Destroy_SuperMatrix_Store(&slu->A);
Destroy_SuperNode_Matrix(&slu->L);
Destroy_CompCol_Matrix(&slu->U);
dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
&A.front(), &JA.front(), &IA.front(),
SLU_NC, SLU_D, SLU_GE);
}
// Create right-hand-side vector and solution vector
Vector X(B.size());
SuperMatrix Bmat, Xmat;
const size_t nrhs = B.size() / nrow;
dCreate_Dense_Matrix(&Bmat, nrow, nrhs, B.ptr(), nrow,
SLU_DN, SLU_D, SLU_GE);
dCreate_Dense_Matrix(&Xmat, nrow, nrhs, X.ptr(), nrow,
SLU_DN, SLU_D, SLU_GE);
slu->opts->ConditionNumber = printSLUstat || rcond ? YES : NO;
slu->opts->PivotGrowth = printSLUstat ? YES : NO;
void* work = 0;
int lwork = 0;
Real ferr[nrhs], berr[nrhs];
mem_usage_t mem_usage;
SuperLUStat_t stat;
StatInit(&stat);
// Invoke the expert driver
#if SUPERLU_VERSION == 5
GlobalLU_t Glu;
dgssvx(slu->opts, &slu->A, slu->perm_c, slu->perm_r, slu->etree, slu->equed,
slu->R, slu->C, &slu->L, &slu->U, work, lwork, &Bmat, &Xmat,
&slu->rpg, &slu->rcond, ferr, berr, &Glu, &mem_usage, &stat, &ierr);
#else
dgssvx(slu->opts, &slu->A, slu->perm_c, slu->perm_r, slu->etree, slu->equed,
slu->R, slu->C, &slu->L, &slu->U, work, lwork, &Bmat, &Xmat,
&slu->rpg, &slu->rcond, ferr, berr, &mem_usage, &stat, &ierr);
#endif
B.swap(X);
if (ierr > 0)
std::cerr <<"SuperLU Failure "<< ierr << std::endl;
else if (!factored)
{
factored = true;
if (rcond)
*rcond = slu->rcond;
}
if (printSLUstat)
{
StatPrint(&stat);
IFEM::cout <<"Reciprocal condition number = "<< slu->rcond
<<"\nReciprocal pivot growth = "<< slu->rpg << std::endl;
}
StatFree(&stat);
Destroy_SuperMatrix_Store(&Bmat);
Destroy_SuperMatrix_Store(&Xmat);
#else
std::cerr <<"SparseMatrix::solve: SuperLU solver not available"<< std::endl;
#endif
return ierr == 0;
}
int main(int argc, char *argv[])
{
/*
* Purpose
* =======
*
* DDRIVE is the main test program for the DOUBLE linear
* equation driver routines DGSSV and DGSSVX.
*
* The program is invoked by a shell script file -- dtest.csh.
* The output from the tests are written into a file -- dtest.out.
*
* =====================================================================
*/
double *a, *a_save;
int *asub, *asub_save;
int *xa, *xa_save;
SuperMatrix A, B, X, L, U;
SuperMatrix ASAV, AC;
GlobalLU_t Glu; /* Not needed on return. */
mem_usage_t mem_usage;
int *perm_r; /* row permutation from partial pivoting */
int *perm_c, *pc_save; /* column permutation */
int *etree;
double zero = 0.0;
double *R, *C;
double *ferr, *berr;
double *rwork;
double *wwork;
void *work;
int info, lwork, nrhs, panel_size, relax;
int m, n, nnz;
double *xact;
double *rhsb, *solx, *bsav;
int ldb, ldx;
double rpg, rcond;
int i, j, k1;
double rowcnd, colcnd, amax;
int maxsuper, rowblk, colblk;
int prefact, nofact, equil, iequed;
int nt, nrun, nfail, nerrs, imat, fimat, nimat;
int nfact, ifact, itran;
int kl, ku, mode, lda;
int zerot, izero, ioff;
double u;
double anorm, cndnum;
double *Afull;
double result[NTESTS];
superlu_options_t options;
fact_t fact;
trans_t trans;
SuperLUStat_t stat;
static char matrix_type[8];
static char equed[1], path[4], sym[1], dist[1];
FILE *fp;
/* Fixed set of parameters */
int iseed[] = {1988, 1989, 1990, 1991};
static char equeds[] = {'N', 'R', 'C', 'B'};
static fact_t facts[] = {FACTORED, DOFACT, SamePattern,
SamePattern_SameRowPerm};
static trans_t transs[] = {NOTRANS, TRANS, CONJ};
/* Some function prototypes */
extern int dgst01(int, int, SuperMatrix *, SuperMatrix *,
SuperMatrix *, int *, int *, double *);
extern int dgst02(trans_t, int, int, int, SuperMatrix *, double *,
int, double *, int, double *resid);
extern int dgst04(int, int, double *, int,
double *, int, double rcond, double *resid);
extern int dgst07(trans_t, int, int, SuperMatrix *, double *, int,
double *, int, double *, int,
double *, double *, double *);
extern int dlatb4_slu(char *, int *, int *, int *, char *, int *, int *,
double *, int *, double *, char *);
extern int dlatms_slu(int *, int *, char *, int *, char *, double *d,
int *, double *, double *, int *, int *,
char *, double *, int *, double *, int *);
extern int sp_dconvert(int, int, double *, int, int, int,
double *a, int *, int *, int *);
/* Executable statements */
strcpy(path, "DGE");
nrun = 0;
nfail = 0;
nerrs = 0;
/* Defaults */
lwork = 0;
n = 1;
nrhs = 1;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
u = 1.0;
strcpy(matrix_type, "LA");
parse_command_line(argc, argv, matrix_type, &n,
&panel_size, &relax, &nrhs, &maxsuper,
&rowblk, &colblk, &lwork, &u, &fp);
if ( lwork > 0 ) {
work = SUPERLU_MALLOC(lwork);
if ( !work ) {
fprintf(stderr, "expert: cannot allocate %d bytes\n", lwork);
exit (-1);
}
}
/* Set the default input options. */
set_default_options(&options);
options.DiagPivotThresh = u;
options.PrintStat = NO;
options.PivotGrowth = YES;
options.ConditionNumber = YES;
options.IterRefine = SLU_DOUBLE;
if ( strcmp(matrix_type, "LA") == 0 ) {
/* Test LAPACK matrix suite. */
m = n;
lda = SUPERLU_MAX(n, 1);
nnz = n * n; /* upper bound */
fimat = 1;
nimat = NTYPES;
Afull = doubleCalloc(lda * n);
dallocateA(n, nnz, &a, &asub, &xa);
} else {
/* Read a sparse matrix */
fimat = nimat = 0;
dreadhb(fp, &m, &n, &nnz, &a, &asub, &xa);
}
dallocateA(n, nnz, &a_save, &asub_save, &xa_save);
rhsb = doubleMalloc(m * nrhs);
bsav = doubleMalloc(m * nrhs);
solx = doubleMalloc(n * nrhs);
ldb = m;
ldx = n;
dCreate_Dense_Matrix(&B, m, nrhs, rhsb, ldb, SLU_DN, SLU_D, SLU_GE);
dCreate_Dense_Matrix(&X, n, nrhs, solx, ldx, SLU_DN, SLU_D, SLU_GE);
xact = doubleMalloc(n * nrhs);
etree = intMalloc(n);
perm_r = intMalloc(n);
perm_c = intMalloc(n);
pc_save = intMalloc(n);
R = (double *) SUPERLU_MALLOC(m*sizeof(double));
C = (double *) SUPERLU_MALLOC(n*sizeof(double));
ferr = (double *) SUPERLU_MALLOC(nrhs*sizeof(double));
berr = (double *) SUPERLU_MALLOC(nrhs*sizeof(double));
j = SUPERLU_MAX(m,n) * SUPERLU_MAX(4,nrhs);
rwork = (double *) SUPERLU_MALLOC(j*sizeof(double));
for (i = 0; i < j; ++i) rwork[i] = 0.;
if ( !R ) ABORT("SUPERLU_MALLOC fails for R");
if ( !C ) ABORT("SUPERLU_MALLOC fails for C");
if ( !ferr ) ABORT("SUPERLU_MALLOC fails for ferr");
if ( !berr ) ABORT("SUPERLU_MALLOC fails for berr");
if ( !rwork ) ABORT("SUPERLU_MALLOC fails for rwork");
wwork = doubleCalloc( SUPERLU_MAX(m,n) * SUPERLU_MAX(4,nrhs) );
for (i = 0; i < n; ++i) perm_c[i] = pc_save[i] = i;
options.ColPerm = MY_PERMC;
for (imat = fimat; imat <= nimat; ++imat) { /* All matrix types */
if ( imat ) {
/* Skip types 5, 6, or 7 if the matrix size is too small. */
zerot = (imat >= 5 && imat <= 7);
if ( zerot && n < imat-4 )
continue;
/* Set up parameters with DLATB4 and generate a test matrix
with DLATMS. */
dlatb4_slu(path, &imat, &n, &n, sym, &kl, &ku, &anorm, &mode,
&cndnum, dist);
dlatms_slu(&n, &n, dist, iseed, sym, &rwork[0], &mode, &cndnum,
&anorm, &kl, &ku, "No packing", Afull, &lda,
&wwork[0], &info);
if ( info ) {
printf(FMT3, "DLATMS", info, izero, n, nrhs, imat, nfail);
continue;
}
/* For types 5-7, zero one or more columns of the matrix
to test that INFO is returned correctly. */
if ( zerot ) {
if ( imat == 5 ) izero = 1;
else if ( imat == 6 ) izero = n;
else izero = n / 2 + 1;
ioff = (izero - 1) * lda;
if ( imat < 7 ) {
for (i = 0; i < n; ++i) Afull[ioff + i] = zero;
} else {
for (j = 0; j < n - izero + 1; ++j)
for (i = 0; i < n; ++i)
Afull[ioff + i + j*lda] = zero;
}
} else {
izero = 0;
}
/* Convert to sparse representation. */
sp_dconvert(n, n, Afull, lda, kl, ku, a, asub, xa, &nnz);
} else {
izero = 0;
zerot = 0;
}
dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);
/* Save a copy of matrix A in ASAV */
dCreate_CompCol_Matrix(&ASAV, m, n, nnz, a_save, asub_save, xa_save,
SLU_NC, SLU_D, SLU_GE);
dCopy_CompCol_Matrix(&A, &ASAV);
/* Form exact solution. */
dGenXtrue(n, nrhs, xact, ldx);
StatInit(&stat);
for (iequed = 0; iequed < 4; ++iequed) {
*equed = equeds[iequed];
if (iequed == 0) nfact = 4;
else nfact = 1; /* Only test factored, pre-equilibrated matrix */
for (ifact = 0; ifact < nfact; ++ifact) {
fact = facts[ifact];
options.Fact = fact;
for (equil = 0; equil < 2; ++equil) {
options.Equil = equil;
prefact = ( options.Fact == FACTORED ||
options.Fact == SamePattern_SameRowPerm );
/* Need a first factor */
nofact = (options.Fact != FACTORED); /* Not factored */
/* Restore the matrix A. */
dCopy_CompCol_Matrix(&ASAV, &A);
if ( zerot ) {
if ( prefact ) continue;
} else if ( options.Fact == FACTORED ) {
if ( equil || iequed ) {
/* Compute row and column scale factors to
equilibrate matrix A. */
dgsequ(&A, R, C, &rowcnd, &colcnd, &amax, &info);
/* Force equilibration. */
if ( !info && n > 0 ) {
if ( strncmp(equed, "R", 1)==0 ) {
rowcnd = 0.;
colcnd = 1.;
} else if ( strncmp(equed, "C", 1)==0 ) {
rowcnd = 1.;
colcnd = 0.;
} else if ( strncmp(equed, "B", 1)==0 ) {
rowcnd = 0.;
colcnd = 0.;
}
}
/* Equilibrate the matrix. */
dlaqgs(&A, R, C, rowcnd, colcnd, amax, equed);
}
}
if ( prefact ) { /* Need a factor for the first time */
/* Save Fact option. */
fact = options.Fact;
options.Fact = DOFACT;
/* Preorder the matrix, obtain the column etree. */
sp_preorder(&options, &A, perm_c, etree, &AC);
/* Factor the matrix AC. */
dgstrf(&options, &AC, relax, panel_size,
etree, work, lwork, perm_c, perm_r, &L, &U,
&Glu, &stat, &info);
if ( info ) {
printf("** First factor: info %d, equed %c\n",
info, *equed);
if ( lwork == -1 ) {
printf("** Estimated memory: %d bytes\n",
info - n);
exit(0);
}
}
Destroy_CompCol_Permuted(&AC);
/* Restore Fact option. */
options.Fact = fact;
} /* if .. first time factor */
for (itran = 0; itran < NTRAN; ++itran) {
trans = transs[itran];
options.Trans = trans;
/* Restore the matrix A. */
dCopy_CompCol_Matrix(&ASAV, &A);
/* Set the right hand side. */
dFillRHS(trans, nrhs, xact, ldx, &A, &B);
dCopy_Dense_Matrix(m, nrhs, rhsb, ldb, bsav, ldb);
/*----------------
* Test dgssv
*----------------*/
if ( options.Fact == DOFACT && itran == 0) {
/* Not yet factored, and untransposed */
dCopy_Dense_Matrix(m, nrhs, rhsb, ldb, solx, ldx);
dgssv(&options, &A, perm_c, perm_r, &L, &U, &X,
&stat, &info);
if ( info && info != izero ) {
printf(FMT3, "dgssv",
info, izero, n, nrhs, imat, nfail);
} else {
/* Reconstruct matrix from factors and
compute residual. */
dgst01(m, n, &A, &L, &U, perm_c, perm_r,
&result[0]);
nt = 1;
if ( izero == 0 ) {
/* Compute residual of the computed
solution. */
dCopy_Dense_Matrix(m, nrhs, rhsb, ldb,
wwork, ldb);
dgst02(trans, m, n, nrhs, &A, solx,
ldx, wwork,ldb, &result[1]);
nt = 2;
}
/* Print information about the tests that
did not pass the threshold. */
for (i = 0; i < nt; ++i) {
if ( result[i] >= THRESH ) {
printf(FMT1, "dgssv", n, i,
result[i]);
++nfail;
}
}
nrun += nt;
} /* else .. info == 0 */
/* Restore perm_c. */
for (i = 0; i < n; ++i) perm_c[i] = pc_save[i];
if (lwork == 0) {
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&U);
}
} /* if .. end of testing dgssv */
/*----------------
* Test dgssvx
*----------------*/
/* Equilibrate the matrix if fact = FACTORED and
equed = 'R', 'C', or 'B'. */
if ( options.Fact == FACTORED &&
(equil || iequed) && n > 0 ) {
dlaqgs(&A, R, C, rowcnd, colcnd, amax, equed);
}
/* Solve the system and compute the condition number
and error bounds using dgssvx. */
dgssvx(&options, &A, perm_c, perm_r, etree,
equed, R, C, &L, &U, work, lwork, &B, &X, &rpg,
&rcond, ferr, berr, &Glu,
&mem_usage, &stat, &info);
if ( info && info != izero ) {
printf(FMT3, "dgssvx",
info, izero, n, nrhs, imat, nfail);
if ( lwork == -1 ) {
printf("** Estimated memory: %.0f bytes\n",
mem_usage.total_needed);
exit(0);
}
} else {
if ( !prefact ) {
/* Reconstruct matrix from factors and
compute residual. */
dgst01(m, n, &A, &L, &U, perm_c, perm_r,
&result[0]);
k1 = 0;
} else {
k1 = 1;
}
if ( !info ) {
/* Compute residual of the computed solution.*/
dCopy_Dense_Matrix(m, nrhs, bsav, ldb,
wwork, ldb);
dgst02(trans, m, n, nrhs, &ASAV, solx, ldx,
wwork, ldb, &result[1]);
/* Check solution from generated exact
solution. */
dgst04(n, nrhs, solx, ldx, xact, ldx, rcond,
&result[2]);
/* Check the error bounds from iterative
refinement. */
dgst07(trans, n, nrhs, &ASAV, bsav, ldb,
solx, ldx, xact, ldx, ferr, berr,
&result[3]);
/* Print information about the tests that did
not pass the threshold. */
for (i = k1; i < NTESTS; ++i) {
if ( result[i] >= THRESH ) {
printf(FMT2, "dgssvx",
options.Fact, trans, *equed,
n, imat, i, result[i]);
++nfail;
}
}
nrun += NTESTS;
} /* if .. info == 0 */
} /* else .. end of testing dgssvx */
} /* for itran ... */
if ( lwork == 0 ) {
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&U);
}
} /* for equil ... */
} /* for ifact ... */
} /* for iequed ... */
#if 0
if ( !info ) {
PrintPerf(&L, &U, &mem_usage, rpg, rcond, ferr, berr, equed);
}
#endif
Destroy_SuperMatrix_Store(&A);
Destroy_SuperMatrix_Store(&ASAV);
StatFree(&stat);
} /* for imat ... */
/* Print a summary of the results. */
PrintSumm("DGE", nfail, nrun, nerrs);
if ( strcmp(matrix_type, "LA") == 0 ) SUPERLU_FREE (Afull);
SUPERLU_FREE (rhsb);
SUPERLU_FREE (bsav);
SUPERLU_FREE (solx);
SUPERLU_FREE (xact);
SUPERLU_FREE (etree);
SUPERLU_FREE (perm_r);
SUPERLU_FREE (perm_c);
SUPERLU_FREE (pc_save);
SUPERLU_FREE (R);
SUPERLU_FREE (C);
SUPERLU_FREE (ferr);
SUPERLU_FREE (berr);
SUPERLU_FREE (rwork);
SUPERLU_FREE (wwork);
Destroy_SuperMatrix_Store(&B);
Destroy_SuperMatrix_Store(&X);
#if 0
Destroy_CompCol_Matrix(&A);
Destroy_CompCol_Matrix(&ASAV);
#else
SUPERLU_FREE(a); SUPERLU_FREE(asub); SUPERLU_FREE(xa);
SUPERLU_FREE(a_save); SUPERLU_FREE(asub_save); SUPERLU_FREE(xa_save);
#endif
if ( lwork > 0 ) {
SUPERLU_FREE (work);
Destroy_SuperMatrix_Store(&L);
Destroy_SuperMatrix_Store(&U);
}
return 0;
}
void RKWidget::step ( const size_t nStep )
{
DNformat *Bstore;
DNformat *Xstore;
double temp;
if(unstable) return;
samset = false;
if( dirty ) {
if(aexist) {
Destroy_CompCol_Matrix(&A);
if ( lwork == 0 ) {
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&Up);
} else if ( lwork > 0 ) {
SUPERLU_FREE(work);
}
// these may be freed in dgssvx or Destroy_CompCol_Matrix I think
aexist = false;
}
a = new double[nvar*N_];
xa = new int[N_+1];
asub = new int[nvar*N_];
updateCoef(method);
if(nblock == 1) {
// load with coef[] ???
fillA();
} else if (nup+ndn == 0) {
// solve seperate independent blocks???
} else {
// load block system
blockFillA();
}
dCreate_CompCol_Matrix(&A, N_, N_, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);
aexist = true;
/* Initialize the statistics variables. */
StatInit(&stat);
dPrint_CompCol_Matrix("A matrix", &A);
options.Fact = DOFACT;
//options.ColPerm=NATURAL;
options.ColPerm=COLAMD;
options.PivotGrowth = NO;
options.ConditionNumber = NO;
/* ONLY PERFORM THE LU DECOMPOSITION */
B.ncol = 0; /* Indicate not to solve the system */
dgssvx(&options, &A, perm_c, perm_r, etree, equed, R, C,
&L, &Up, work, lwork, &B, &X, &rpg, &rcond, ferr, berr,
&mem_usage, &stat, &info);
//dPrint_CompCol_Matrix("A matrix", &A);
printf("LU factorization: dgssvx() returns info %d\n", info);
if ( info == 0 || info == N_+1 ) {
if ( options.PivotGrowth ) printf("Recip. pivot growth = %e\n", rpg);
if ( options.ConditionNumber )
printf("Recip. condition number = %e\n", rcond);
printf("L\\U_ MB %.3f\ttotal MB needed %.3f\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
fflush(stdout);
options.Fact = FACTORED; /* Indicate the factored form of A is supplied. */
B.ncol = 1;
dirty = false;
} else if ( info > 0 && lwork == -1 ) {
printf("** Estimated memory: %d bytes\n", info - n);
}
if ( options.PrintStat ) StatPrint(&stat);
StatFree(&stat);
}
for ( size_t n = 0; n < nStep; n++ ) {
for( int ns = 0; ns < nStage; ns++ ) {
///set B matrix
Bstore= (DNformat *)B.Store;
rhsb=(double*)Bstore->nzval;
if (nup+ndn == 0) {
// solve seperate independent blocks???
std::cout << "Discontinuous Galerkin Not Implimented\n";
return;
} else {
fillB(ns);
}
///solve factored system
StatInit(&stat);
options.Fact = FACTORED;
dgssvx(&options, &A, perm_c, perm_r, etree, equed, R, C,
&L, &Up, work, lwork, &B, &X, &rpg, &rcond, ferr, berr,
&mem_usage, &stat, &info);
//if( n == 1 ) printf("Triangular solve: dgssvx() returns info %d\n", info);
///update U_
if ( info == 0 || info == N_+1 ) {
/* This is how you could access the solution matrix. */
Xstore = (DNformat *)X.Store;
rhsx = (double*)(Xstore->nzval);
for ( size_t i = 0; i < N_ ; i++ ) {
if(rhsx[i]> 1e16) unstable = true;
b_k[i+N_*ns]=rhsx[i];
}
} else {
std::cout << "ERROR: Matrix Solution Failed info = " << info << std::endl;
}
StatFree(&stat);
}
for(int j=0 ; j<nStage; j++) {
temp=b_b[j];
if( temp != 0 ) {
for(size_t i = 0; i < N_ ; i++ ) {
U_[i] += temp*b_k[i+j*N_];
}
}
}
cStep++;
totCFL += CFL;
}
}
static bool slm_solve(void* context, real_t* B, real_t* x)
{
slm_t* mat = context;
SuperMatrix* A = mat->A;
// Copy B to the rhs vector.
DNformat* rhs = mat->rhs.Store;
double* Bi = rhs->nzval;
for (int i = 0; i < mat->N; ++i)
Bi[i] = (double)B[i];
if (mat->cperm == NULL)
{
mat->cperm = intMalloc(mat->N);
mat->rperm = intMalloc(mat->N);
}
else if (mat->options.Fact != FACTORED)
{
// Jettison the existing factorization.
Destroy_SuperNode_Matrix(&mat->L);
Destroy_CompCol_Matrix(&mat->U);
}
// Do the solve.
int info = 0, lwork = 0;
void* work = NULL;
double ferr, berr;
GlobalLU_t glu; // "Global data structure" for SuperLU for helping with factorizations.
double recip_pivot_growth = 1.0, rcond = 1.0;
mem_usage_t mem_usage;
if (mat->ilu_params == NULL)
{
// Factorize if necessary.
if (mat->options.Fact == DOFACT)
{
int rhs_ncol = mat->rhs.ncol;
mat->rhs.ncol = 0;
polymec_suspend_fpe();
dgssvx(&mat->options, A, mat->cperm, mat->rperm, mat->etree, &mat->equil,
mat->R, mat->C, &mat->L, &mat->U, work, lwork, &mat->rhs, &mat->X,
&recip_pivot_growth, &rcond, &ferr, &berr, &glu, &mem_usage, &mat->stat, &info);
polymec_restore_fpe();
mat->rhs.ncol = rhs_ncol;
if ((info == 0) || (info == A->ncol+1))
{
if (mat->equil != 'N')
{
if (mat->equil == 'R')
log_debug("slm_solve: performed row equilibration.");
else if (mat->equil == 'C')
log_debug("slm_solve: performed column equilibration.");
else if (mat->equil == 'B')
log_debug("slm_solve: performed row/column equilibration.");
}
log_debug("slm_solve: L has %d nonzeros, U has %d.",
((SCformat*)mat->L.Store)->nnz, ((NCformat*)mat->U.Store)->nnz);
#ifndef NDEBUG
log_debug("slm_solve: recip pivot growth = %g, condition number = %g.",
recip_pivot_growth, rcond);
if (recip_pivot_growth < 0.01)
{
log_detail("slm_solve: WARNING: recip pivot growth for ILU factorization << 1.");
log_detail("slm_solve: WARNING: Stability of LU factorization could be poor.");
}
#endif
// Reuse the factorization.
mat->options.Fact = FACTORED;
}
else
log_debug("slm_solve: LU factorization failed.");
}
// Solve the factored system.
if ((info == 0) || (info == A->ncol+1))
{
polymec_suspend_fpe();
dgssvx(&mat->options, A, mat->cperm, mat->rperm, mat->etree, &mat->equil,
mat->R, mat->C, &mat->L, &mat->U, work, lwork, &mat->rhs,
&mat->X, &recip_pivot_growth, &rcond, &ferr, &berr, &glu, &mem_usage,
&mat->stat, &info);
polymec_restore_fpe();
}
}
else
{
// Incomplete LU factorization.
// Factorize if necessary.
if (mat->options.Fact == DOFACT)
{
int rhs_ncol = mat->rhs.ncol;
mat->rhs.ncol = 0;
polymec_suspend_fpe();
dgsisx(&mat->options, A, mat->cperm, mat->rperm, mat->etree, &mat->equil,
mat->R, mat->C, &mat->L, &mat->U, NULL, 0, &mat->rhs, &mat->X,
&recip_pivot_growth, &rcond, &glu, &mem_usage, &mat->stat, &info);
polymec_restore_fpe();
mat->rhs.ncol = rhs_ncol;
if ((info == 0) || (info == A->ncol+1))
{
if (mat->equil != 'N')
{
if (mat->equil == 'R')
log_debug("slm_solve: performed row equilibration.");
else if (mat->equil == 'C')
log_debug("slm_solve: performed column equilibration.");
else if (mat->equil == 'B')
log_debug("slm_solve: performed row/column equilibration.");
}
#ifndef NDEBUG
log_debug("slm_solve: recip pivot growth = %g, condition number = %g.",
recip_pivot_growth, rcond);
if (recip_pivot_growth < 0.01)
{
log_detail("slm_solve: WARNING: recip pivot growth for ILU factorization << 1.");
log_detail("slm_solve: WARNING: Stability of LU factorization could be poor.");
}
#endif
// Reuse the factorization.
mat->options.Fact = FACTORED;
}
else
log_debug("slm_solve: incomplete LU factorization failed.");
}
// Solve the factored system.
if ((info == 0) || (info == A->ncol+1))
{
polymec_suspend_fpe();
dgsisx(&mat->options, A, mat->cperm, mat->rperm, mat->etree, &mat->equil,
mat->R, mat->C, &mat->L, &mat->U, NULL, 0, &mat->rhs, &mat->X,
&recip_pivot_growth, &rcond, &glu, &mem_usage, &mat->stat, &info);
polymec_restore_fpe();
}
}
bool success = ((info == 0) || (info == A->ncol+1));
if (success)
{
// Copy the output vector to x.
double* X = ((DNformat*)mat->X.Store)->nzval;
for (int i = 0; i < mat->N; ++i)
x[i] = (real_t)X[i];
}
else
{
ASSERT(info > 0);
if (mat->ilu_params == NULL)
{
log_debug("slm_solve: LU solve failed.");
log_debug("slm_solve: (U is singular: U(%d, %d) = 0.)", info-1, info-1);
}
else
{
log_debug("slm_solve: ILU solve failed.");
if (info < A->ncol)
log_debug("slm_solve: (number of zero pivots in U = %d.)", info);
else if (info == (A->ncol + 1))
log_debug("slm_solve: (U is nonsingular but rcond = %g.)", rcond);
else
log_debug("slm_solve: (Memory allocation failure.)");
}
}
return success;
}
