void tlin::factorize(SuperMatrix *A, SuperFactors *&F, superlu_options_t *opt) {
assert(A->nrow == A->ncol);
int n = A->nrow;
if (!F) F = (SuperFactors *)SUPERLU_MALLOC(sizeof(SuperFactors));
if (!opt) opt = &defaultOpt;
F->perm_c = intMalloc(n);
get_perm_c(3, A, F->perm_c);
SuperMatrix AC;
int *etree = intMalloc(n);
sp_preorder(opt, A, F->perm_c, etree, &AC);
F->L = (SuperMatrix *)SUPERLU_MALLOC(sizeof(SuperMatrix));
F->U = (SuperMatrix *)SUPERLU_MALLOC(sizeof(SuperMatrix));
F->perm_r = intMalloc(n);
SuperLUStat_t stat;
StatInit(&stat);
int result;
dgstrf(opt, &AC, sp_ienv(1), sp_ienv(2), etree, NULL, 0, F->perm_c, F->perm_r,
F->L, F->U, &stat, &result);
StatFree(&stat);
Destroy_CompCol_Permuted(&AC);
SUPERLU_FREE(etree);
if (result != 0) freeF(F), F = 0;
}
/*! \brief Set up pointers for real working arrays.
*/
void
sSetRWork(int m, int panel_size, float *dworkptr,
float **dense, float **tempv)
{
float zero = 0.0;
int maxsuper = SUPERLU_MAX( sp_ienv(3), sp_ienv(7) ),
rowblk = sp_ienv(4);
*dense = dworkptr;
*tempv = *dense + panel_size*m;
sfill (*dense, m * panel_size, zero);
sfill (*tempv, NUM_TEMPV(m,panel_size,maxsuper,rowblk), zero);
}
/*! \brief Set up pointers for real working arrays.
*/
void
zSetRWork(int m, int panel_size, doublecomplex *dworkptr,
doublecomplex **dense, doublecomplex **tempv)
{
doublecomplex zero = {0.0, 0.0};
int maxsuper = SUPERLU_MAX( sp_ienv(3), sp_ienv(7) ),
rowblk = sp_ienv(4);
*dense = dworkptr;
*tempv = *dense + panel_size*m;
zfill (*dense, m * panel_size, zero);
zfill (*tempv, NUM_TEMPV(m,panel_size,maxsuper,rowblk), zero);
}
/*! \brief
*
* <pre>
* mem_usage consists of the following fields:
* - for_lu (float)
* The amount of space used in bytes for the L\U data structures.
* - total_needed (float)
* The amount of space needed in bytes to perform factorization.
* </pre>
*/
int sQuerySpace(SuperMatrix *L, SuperMatrix *U, mem_usage_t *mem_usage)
{
SCformat *Lstore;
NCformat *Ustore;
register int n, iword, dword, panel_size = sp_ienv(1);
Lstore = L->Store;
Ustore = U->Store;
n = L->ncol;
iword = sizeof(int);
dword = sizeof(float);
/* For LU factors */
mem_usage->for_lu = (float)( (4.0*n + 3.0) * iword +
Lstore->nzval_colptr[n] * dword +
Lstore->rowind_colptr[n] * iword );
mem_usage->for_lu += (float)( (n + 1.0) * iword +
Ustore->colptr[n] * (dword + iword) );
/* Working storage to support factorization */
mem_usage->total_needed = mem_usage->for_lu +
(float)( (2.0 * panel_size + 4.0 + NO_MARKER) * n * iword +
(panel_size + 1.0) * n * dword );
return 0;
} /* sQuerySpace */
/*! \brief
*
* <pre>
* mem_usage consists of the following fields:
* - for_lu (float)
* The amount of space used in bytes for the L\U data structures.
* - total_needed (float)
* The amount of space needed in bytes to perform factorization.
* </pre>
*/
int ilu_sQuerySpace(SuperMatrix *L, SuperMatrix *U, mem_usage_t *mem_usage)
{
SCformat *Lstore;
NCformat *Ustore;
register int n, panel_size = sp_ienv(1);
register float iword, dword;
Lstore = L->Store;
Ustore = U->Store;
n = L->ncol;
iword = sizeof(int);
dword = sizeof(double);
/* For LU factors */
mem_usage->for_lu = (float)( (4.0f * n + 3.0f) * iword +
Lstore->nzval_colptr[n] * dword +
Lstore->rowind_colptr[n] * iword );
mem_usage->for_lu += (float)( (n + 1.0f) * iword +
Ustore->colptr[n] * (dword + iword) );
/* Working storage to support factorization.
ILU needs 5*n more integers than LU */
mem_usage->total_needed = mem_usage->for_lu +
(float)( (2.0f * panel_size + 9.0f + NO_MARKER) * n * iword +
(panel_size + 1.0f) * n * dword );
return 0;
} /* ilu_sQuerySpace */
/*! \brief Allocate known working storage. Returns 0 if success, otherwise
returns the number of bytes allocated so far when failure occurred. */
int
sLUWorkInit(int m, int n, int panel_size, int **iworkptr,
float **dworkptr, GlobalLU_t *Glu)
{
int isize, dsize, extra;
float *old_ptr;
int maxsuper = SUPERLU_MAX( sp_ienv(3), sp_ienv(7) ),
rowblk = sp_ienv(4);
isize = ( (2 * panel_size + 3 + NO_MARKER ) * m + n ) * sizeof(int);
dsize = (m * panel_size +
NUM_TEMPV(m,panel_size,maxsuper,rowblk)) * sizeof(float);
if ( Glu->MemModel == SYSTEM )
*iworkptr = (int *) intCalloc(isize/sizeof(int));
else
*iworkptr = (int *) suser_malloc(isize, TAIL, Glu);
if ( ! *iworkptr ) {
fprintf(stderr, "sLUWorkInit: malloc fails for local iworkptr[]\n");
return (isize + n);
}
if ( Glu->MemModel == SYSTEM )
*dworkptr = (float *) SUPERLU_MALLOC(dsize);
else {
*dworkptr = (float *) suser_malloc(dsize, TAIL, Glu);
if ( NotDoubleAlign(*dworkptr) ) {
old_ptr = *dworkptr;
*dworkptr = (float*) DoubleAlign(*dworkptr);
*dworkptr = (float*) ((double*)*dworkptr - 1);
extra = (char*)old_ptr - (char*)*dworkptr;
#ifdef DEBUG
printf("sLUWorkInit: not aligned, extra %d\n", extra);
#endif
Glu->stack.top2 -= extra;
Glu->stack.used += extra;
}
}
if ( ! *dworkptr ) {
fprintf(stderr, "malloc fails for local dworkptr[].");
return (isize + dsize + n);
}
return 0;
}
void
StatInit(SuperLUStat_t *stat)
{
register int i, w, panel_size, relax;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
w = SUPERLU_MAX(panel_size, relax);
stat->panel_histo = intCalloc(w+1);
stat->utime = (double *) SUPERLU_MALLOC(NPHASES * sizeof(double));
if (!stat->utime) ABORT("SUPERLU_MALLOC fails for stat->utime");
stat->ops = (flops_t *) SUPERLU_MALLOC(NPHASES * sizeof(flops_t));
if (!stat->ops) ABORT("SUPERLU_MALLOC fails for stat->ops");
for (i = 0; i < NPHASES; ++i) {
stat->utime[i] = 0.;
stat->ops[i] = 0.;
}
}
//! \brief The constructor initializes the default input options.
explicit SuperLUdata(int numThreads = 0) :
A{}, L{}, U{}
{
equed[0] = 0;
R = C = 0;
perm_r = perm_c = etree = 0;
rcond = rpg = 0.0;
if (numThreads > 0)
{
opts = new sluop_t;
#ifdef HAS_SUPERLU_MT
opts->nprocs = numThreads;
opts->fact = DOFACT;
opts->trans = NOTRANS;
opts->refact = NO;
opts->panel_size = sp_ienv(1);
opts->relax = sp_ienv(2);
opts->diag_pivot_thresh = 1.0;
opts->drop_tol = 0.0;
opts->ColPerm = MMD_ATA;
opts->usepr = NO;
opts->SymmetricMode = NO;
opts->PrintStat = NO;
opts->perm_c = 0;
opts->perm_r = 0;
opts->work = 0;
opts->lwork = 0;
opts->etree = 0;
opts->colcnt_h = 0;
opts->part_super_h = 0;
#else
set_default_options(opts);
opts->SymmetricMode = YES;
opts->ColPerm = MMD_AT_PLUS_A;
opts->DiagPivotThresh = 0.001;
#endif
}
else
opts = 0;
}
main(int argc, char *argv[])
{
/*
* Purpose
* =======
*
* SDRIVE is the main test program for the FLOAT linear
* equation driver routines SGSSV and SGSSVX.
*
* The program is invoked by a shell script file -- stest.csh.
* The output from the tests are written into a file -- stest.out.
*
* =====================================================================
*/
float *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;
float zero = 0.0;
float *R, *C;
float *ferr, *berr;
float *rwork;
float *wwork;
void *work;
int info, lwork, nrhs, panel_size, relax;
int m, n, nnz;
float *xact;
float *rhsb, *solx, *bsav;
int ldb, ldx;
float rpg, rcond;
int i, j, k1;
float 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;
float anorm, cndnum;
float *Afull;
float 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 sgst01(int, int, SuperMatrix *, SuperMatrix *,
SuperMatrix *, int *, int *, float *);
extern int sgst02(trans_t, int, int, int, SuperMatrix *, float *,
int, float *, int, float *resid);
extern int sgst04(int, int, float *, int,
float *, int, float rcond, float *resid);
extern int sgst07(trans_t, int, int, SuperMatrix *, float *, int,
float *, int, float *, int,
float *, float *, float *);
extern int slatb4_slu(char *, int *, int *, int *, char *, int *, int *,
float *, int *, float *, char *);
extern int slatms_slu(int *, int *, char *, int *, char *, float *d,
int *, float *, float *, int *, int *,
char *, float *, int *, float *, int *);
extern int sp_sconvert(int, int, float *, int, int, int,
float *a, int *, int *, int *);
/* Executable statements */
strcpy(path, "SGE");
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_SINGLE;
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 = floatCalloc(lda * n);
sallocateA(n, nnz, &a, &asub, &xa);
} else {
/* Read a sparse matrix */
fimat = nimat = 0;
sreadhb(fp, &m, &n, &nnz, &a, &asub, &xa);
}
sallocateA(n, nnz, &a_save, &asub_save, &xa_save);
rhsb = floatMalloc(m * nrhs);
bsav = floatMalloc(m * nrhs);
solx = floatMalloc(n * nrhs);
ldb = m;
ldx = n;
sCreate_Dense_Matrix(&B, m, nrhs, rhsb, ldb, SLU_DN, SLU_S, SLU_GE);
sCreate_Dense_Matrix(&X, n, nrhs, solx, ldx, SLU_DN, SLU_S, SLU_GE);
xact = floatMalloc(n * nrhs);
etree = intMalloc(n);
perm_r = intMalloc(n);
perm_c = intMalloc(n);
pc_save = intMalloc(n);
R = (float *) SUPERLU_MALLOC(m*sizeof(float));
C = (float *) SUPERLU_MALLOC(n*sizeof(float));
ferr = (float *) SUPERLU_MALLOC(nrhs*sizeof(float));
berr = (float *) SUPERLU_MALLOC(nrhs*sizeof(float));
j = SUPERLU_MAX(m,n) * SUPERLU_MAX(4,nrhs);
rwork = (float *) SUPERLU_MALLOC(j*sizeof(float));
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 = floatCalloc( 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 SLATB4 and generate a test matrix
with SLATMS. */
slatb4_slu(path, &imat, &n, &n, sym, &kl, &ku, &anorm, &mode,
&cndnum, dist);
slatms_slu(&n, &n, dist, iseed, sym, &rwork[0], &mode, &cndnum,
&anorm, &kl, &ku, "No packing", Afull, &lda,
&wwork[0], &info);
if ( info ) {
printf(FMT3, "SLATMS", 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_sconvert(n, n, Afull, lda, kl, ku, a, asub, xa, &nnz);
} else {
izero = 0;
zerot = 0;
}
sCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_S, SLU_GE);
/* Save a copy of matrix A in ASAV */
sCreate_CompCol_Matrix(&ASAV, m, n, nnz, a_save, asub_save, xa_save,
SLU_NC, SLU_S, SLU_GE);
sCopy_CompCol_Matrix(&A, &ASAV);
/* Form exact solution. */
sGenXtrue(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. */
sCopy_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. */
sgsequ(&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. */
slaqgs(&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. */
sgstrf(&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. */
sCopy_CompCol_Matrix(&ASAV, &A);
/* Set the right hand side. */
sFillRHS(trans, nrhs, xact, ldx, &A, &B);
sCopy_Dense_Matrix(m, nrhs, rhsb, ldb, bsav, ldb);
/*----------------
* Test sgssv
*----------------*/
if ( options.Fact == DOFACT && itran == 0) {
/* Not yet factored, and untransposed */
sCopy_Dense_Matrix(m, nrhs, rhsb, ldb, solx, ldx);
sgssv(&options, &A, perm_c, perm_r, &L, &U, &X,
&stat, &info);
if ( info && info != izero ) {
printf(FMT3, "sgssv",
info, izero, n, nrhs, imat, nfail);
} else {
/* Reconstruct matrix from factors and
compute residual. */
sgst01(m, n, &A, &L, &U, perm_c, perm_r,
&result[0]);
nt = 1;
if ( izero == 0 ) {
/* Compute residual of the computed
solution. */
sCopy_Dense_Matrix(m, nrhs, rhsb, ldb,
wwork, ldb);
sgst02(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, "sgssv", 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 sgssv */
/*----------------
* Test sgssvx
*----------------*/
/* Equilibrate the matrix if fact = FACTORED and
equed = 'R', 'C', or 'B'. */
if ( options.Fact == FACTORED &&
(equil || iequed) && n > 0 ) {
slaqgs(&A, R, C, rowcnd, colcnd, amax, equed);
}
/* Solve the system and compute the condition number
and error bounds using sgssvx. */
sgssvx(&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, "sgssvx",
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. */
sgst01(m, n, &A, &L, &U, perm_c, perm_r,
&result[0]);
k1 = 0;
} else {
k1 = 1;
}
if ( !info ) {
/* Compute residual of the computed solution.*/
sCopy_Dense_Matrix(m, nrhs, bsav, ldb,
wwork, ldb);
sgst02(trans, m, n, nrhs, &ASAV, solx, ldx,
wwork, ldb, &result[1]);
/* Check solution from generated exact
solution. */
sgst04(n, nrhs, solx, ldx, xact, ldx, rcond,
&result[2]);
/* Check the error bounds from iterative
refinement. */
sgst07(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, "sgssvx",
options.Fact, trans, *equed,
n, imat, i, result[i]);
++nfail;
}
}
nrun += NTESTS;
} /* if .. info == 0 */
} /* else .. end of testing sgssvx */
} /* 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("SGE", 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
c_fortran_zgssv_(int *iopt, int *n, int *nnz, int *nrhs,
doublecomplex *values, int *rowind, int *colptr,
doublecomplex *b, int *ldb,
fptr *f_factors, /* a handle containing the address
pointing to the factored matrices */
int *info)
{
/*
* This routine can be called from Fortran.
*
* iopt (input) int
* Specifies the operation:
* = 1, performs LU decomposition for the first time
* = 2, performs triangular solve
* = 3, free all the storage in the end
*
* f_factors (input/output) fptr*
* If iopt == 1, it is an output and contains the pointer pointing to
* the structure of the factored matrices.
* Otherwise, it it an input.
*
*/
SuperMatrix A, AC, B;
SuperMatrix *L, *U;
int *perm_r; /* row permutations from partial pivoting */
int *perm_c; /* column permutation vector */
int *etree; /* column elimination tree */
SCformat *Lstore;
NCformat *Ustore;
int i, panel_size, permc_spec, relax;
trans_t trans;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
trans = TRANS;
if ( *iopt == 1 ) { /* LU decomposition */
/* Set the default input options. */
set_default_options(&options);
/* Initialize the statistics variables. */
StatInit(&stat);
/* Adjust to 0-based indexing */
for (i = 0; i < *nnz; ++i) --rowind[i];
for (i = 0; i <= *n; ++i) --colptr[i];
zCreate_CompCol_Matrix(&A, *n, *n, *nnz, values, rowind, colptr,
SLU_NC, SLU_Z, SLU_GE);
L = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
U = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
if ( !(perm_r = intMalloc(*n)) ) ABORT("Malloc fails for perm_r[].");
if ( !(perm_c = intMalloc(*n)) ) ABORT("Malloc fails for perm_c[].");
if ( !(etree = intMalloc(*n)) ) ABORT("Malloc fails for etree[].");
/*
* Get column permutation vector perm_c[], according to permc_spec:
* permc_spec = 0: natural ordering
* permc_spec = 1: minimum degree on structure of A'*A
* permc_spec = 2: minimum degree on structure of A'+A
* permc_spec = 3: approximate minimum degree for unsymmetric matrices
*/
permc_spec = options.ColPerm;
get_perm_c(permc_spec, &A, perm_c);
sp_preorder(&options, &A, perm_c, etree, &AC);
panel_size = sp_ienv(1);
relax = sp_ienv(2);
zgstrf(&options, &AC, relax, panel_size, etree,
NULL, 0, perm_c, perm_r, L, U, &stat, info);
if ( *info == 0 ) {
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);
zQuerySpace(L, U, &mem_usage);
printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
} else {
printf("zgstrf() error returns INFO= %d\n", *info);
if ( *info <= *n ) { /* factorization completes */
zQuerySpace(L, U, &mem_usage);
printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
}
}
/* Restore to 1-based indexing */
for (i = 0; i < *nnz; ++i) ++rowind[i];
for (i = 0; i <= *n; ++i) ++colptr[i];
/* Save the LU factors in the factors handle */
LUfactors = (factors_t*) SUPERLU_MALLOC(sizeof(factors_t));
LUfactors->L = L;
LUfactors->U = U;
LUfactors->perm_c = perm_c;
LUfactors->perm_r = perm_r;
*f_factors = (fptr) LUfactors;
/* Free un-wanted storage */
SUPERLU_FREE(etree);
Destroy_SuperMatrix_Store(&A);
Destroy_CompCol_Permuted(&AC);
StatFree(&stat);
} else if ( *iopt == 2 ) { /* Triangular solve */
/* Initialize the statistics variables. */
StatInit(&stat);
/* Extract the LU factors in the factors handle */
LUfactors = (factors_t*) *f_factors;
L = LUfactors->L;
U = LUfactors->U;
perm_c = LUfactors->perm_c;
perm_r = LUfactors->perm_r;
zCreate_Dense_Matrix(&B, *n, *nrhs, b, *ldb, SLU_DN, SLU_Z, SLU_GE);
/* Solve the system A*X=B, overwriting B with X. */
zgstrs (trans, L, U, perm_c, perm_r, &B, &stat, info);
Destroy_SuperMatrix_Store(&B);
StatFree(&stat);
} else if ( *iopt == 3 ) { /* Free storage */
/* Free the LU factors in the factors handle */
LUfactors = (factors_t*) *f_factors;
SUPERLU_FREE (LUfactors->perm_r);
SUPERLU_FREE (LUfactors->perm_c);
Destroy_SuperNode_Matrix(LUfactors->L);
Destroy_CompCol_Matrix(LUfactors->U);
SUPERLU_FREE (LUfactors->L);
SUPERLU_FREE (LUfactors->U);
SUPERLU_FREE (LUfactors);
} else {
fprintf(stderr,"Invalid iopt=%d passed to c_fortran_zgssv()\n",*iopt);
exit(-1);
}
}
main(int argc, char *argv[])
{
char fact[1], equed[1], trans[1], refact[1];
SuperMatrix A, L, U;
SuperMatrix B, X;
NCformat *Astore;
NCformat *Ustore;
SCformat *Lstore;
complex *a;
int *asub, *xa;
int *perm_r; /* row permutations from partial pivoting */
int *perm_c; /* column permutation vector */
int *etree;
void *work;
factor_param_t iparam;
int info, lwork, nrhs, ldx, panel_size, relax;
int m, n, nnz, permc_spec;
complex *rhsb, *rhsx, *xact;
float *R, *C;
float *ferr, *berr;
float u, rpg, rcond;
int i, firstfact;
mem_usage_t mem_usage;
void parse_command_line();
/* Defaults */
lwork = 0;
*fact = 'E';
*equed = 'N';
*trans = 'N';
*refact = 'N';
nrhs = 1;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
u = 1.0;
parse_command_line(argc, argv, &lwork, &panel_size, &relax, &u,
fact, trans, refact);
firstfact = lsame_(fact, "F") || lsame_(refact, "Y");
iparam.panel_size = panel_size;
iparam.relax = relax;
iparam.diag_pivot_thresh = u;
iparam.drop_tol = -1;
if ( lwork > 0 ) {
work = SUPERLU_MALLOC(lwork);
if ( !work ) {
ABORT("CLINSOLX: cannot allocate work[]");
}
}
creadhb(&m, &n, &nnz, &a, &asub, &xa);
cCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_C, SLU_GE);
Astore = A.Store;
printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
if ( !(rhsb = complexMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
if ( !(rhsx = complexMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[].");
cCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_C, SLU_GE);
cCreate_Dense_Matrix(&X, m, nrhs, rhsx, m, SLU_DN, SLU_C, SLU_GE);
xact = complexMalloc(n * nrhs);
ldx = n;
cGenXtrue(n, nrhs, xact, ldx);
cFillRHS(trans, nrhs, xact, ldx, &A, &B);
if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[].");
if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");
if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
/*
* Get column permutation vector perm_c[], according to permc_spec:
* permc_spec = 0: natural ordering
* permc_spec = 1: minimum degree on structure of A'*A
* permc_spec = 2: minimum degree on structure of A'+A
* permc_spec = 3: approximate minimum degree for unsymmetric matrices
*/
permc_spec = 1;
get_perm_c(permc_spec, &A, perm_c);
if ( !(R = (float *) SUPERLU_MALLOC(A.nrow * sizeof(float))) )
ABORT("SUPERLU_MALLOC fails for R[].");
if ( !(C = (float *) SUPERLU_MALLOC(A.ncol * sizeof(float))) )
ABORT("SUPERLU_MALLOC fails for C[].");
if ( !(ferr = (float *) SUPERLU_MALLOC(nrhs * sizeof(float))) )
ABORT("SUPERLU_MALLOC fails for ferr[].");
if ( !(berr = (float *) SUPERLU_MALLOC(nrhs * sizeof(float))) )
ABORT("SUPERLU_MALLOC fails for berr[].");
/* Solve the system and compute the condition number
and error bounds using dgssvx. */
cgssvx(fact, trans, refact, &A, &iparam, perm_c, perm_r, etree,
equed, R, C, &L, &U, work, lwork, &B, &X, &rpg, &rcond,
ferr, berr, &mem_usage, &info);
printf("cgssvx(): info %d\n", info);
if ( info == 0 || info == n+1 ) {
printf("Recip. pivot growth = %e\n", rpg);
printf("Recip. condition number = %e\n", rcond);
printf("%8s%16s%16s\n", "rhs", "FERR", "BERR");
for (i = 0; i < nrhs; ++i) {
printf("%8d%16e%16e\n", i+1, ferr[i], berr[i]);
}
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\texpansions %d\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6,
mem_usage.expansions);
fflush(stdout);
} else if ( info > 0 && lwork == -1 ) {
printf("** Estimated memory: %d bytes\n", info - n);
}
SUPERLU_FREE (rhsb);
SUPERLU_FREE (rhsx);
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(&A);
Destroy_SuperMatrix_Store(&B);
Destroy_SuperMatrix_Store(&X);
if ( lwork >= 0 ) {
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&U);
}
}
int main ( int argc, char *argv[] )
/******************************************************************************/
/*
Purpose:
MAIN is the main program for PSLINSOL.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
10 February 2014
Author:
Xiaoye Li
*/
{
SuperMatrix A;
NCformat *Astore;
float *a;
int *asub, *xa;
int *perm_r; /* row permutations from partial pivoting */
int *perm_c; /* column permutation vector */
SuperMatrix L; /* factor L */
SCPformat *Lstore;
SuperMatrix U; /* factor U */
NCPformat *Ustore;
SuperMatrix B;
int nrhs, ldx, info, m, n, nnz, b;
int nprocs; /* maximum number of processors to use. */
int panel_size, relax, maxsup;
int permc_spec;
trans_t trans;
float *xact, *rhs;
superlu_memusage_t superlu_memusage;
void parse_command_line();
timestamp ( );
printf ( "\n" );
printf ( "PSLINSOL:\n" );
printf ( " C/OpenMP version\n" );
printf ( " Call the OpenMP version of SuperLU to solve a linear system.\n" );
nrhs = 1;
trans = NOTRANS;
nprocs = 1;
n = 1000;
b = 1;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
maxsup = sp_ienv(3);
/*
Check for any commandline input.
*/
parse_command_line ( argc, argv, &nprocs, &n, &b, &panel_size,
&relax, &maxsup );
#if ( PRNTlevel>=1 || DEBUGlevel>=1 )
cpp_defs();
#endif
#define HB
#if defined( DEN )
m = n;
nnz = n * n;
sband(n, n, nnz, &a, &asub, &xa);
#elif defined( BAND )
m = n;
nnz = (2*b+1) * n;
sband(n, b, nnz, &a, &asub, &xa);
#elif defined( BD )
nb = 5;
bs = 200;
m = n = bs * nb;
nnz = bs * bs * nb;
sblockdiag(nb, bs, nnz, &a, &asub, &xa);
#elif defined( HB )
sreadhb(&m, &n, &nnz, &a, &asub, &xa);
#else
sreadmt(&m, &n, &nnz, &a, &asub, &xa);
#endif
sCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_S, SLU_GE);
Astore = A.Store;
printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
if (!(rhs = floatMalloc(m * nrhs))) SUPERLU_ABORT("Malloc fails for rhs[].");
sCreate_Dense_Matrix(&B, m, nrhs, rhs, m, SLU_DN, SLU_S, SLU_GE);
xact = floatMalloc(n * nrhs);
ldx = n;
sGenXtrue(n, nrhs, xact, ldx);
sFillRHS(trans, nrhs, xact, ldx, &A, &B);
if (!(perm_r = intMalloc(m))) SUPERLU_ABORT("Malloc fails for perm_r[].");
if (!(perm_c = intMalloc(n))) SUPERLU_ABORT("Malloc fails for perm_c[].");
/*
* 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
*/
permc_spec = 1;
get_perm_c(permc_spec, &A, perm_c);
psgssv(nprocs, &A, perm_c, perm_r, &L, &U, &B, &info);
if ( info == 0 ) {
sinf_norm_error(nrhs, &B, xact); /* Inf. norm of the error */
Lstore = (SCPformat *) L.Store;
Ustore = (NCPformat *) U.Store;
printf("#NZ in factor L = %d\n", Lstore->nnz);
printf("#NZ in factor U = %d\n", Ustore->nnz);
printf("#NZ in L+U = %d\n", Lstore->nnz + Ustore->nnz - L.ncol);
superlu_sQuerySpace(nprocs, &L, &U, panel_size, &superlu_memusage);
printf("L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n",
superlu_memusage.for_lu/1024/1024,
superlu_memusage.total_needed/1024/1024,
superlu_memusage.expansions);
}
SUPERLU_FREE (rhs);
SUPERLU_FREE (xact);
SUPERLU_FREE (perm_r);
SUPERLU_FREE (perm_c);
Destroy_CompCol_Matrix(&A);
Destroy_SuperMatrix_Store(&B);
Destroy_SuperNode_SCP(&L);
Destroy_CompCol_NCP(&U);
/*
Terminate.
*/
printf ( "\n" );
printf ( "PSLINSOL:\n" );
printf ( " Normal end of execution.\n" );
printf ( "\n" );
timestamp ( );
return 0;
}
/* Here is a driver inspired by A. Sheffer's "cow flattener". */
static NLboolean __nlFactorize_SUPERLU(__NLContext *context, NLint *permutation) {
/* OpenNL Context */
__NLSparseMatrix* M = (context->least_squares)? &context->MtM: &context->M;
NLuint n = context->n;
NLuint nnz = __nlSparseMatrixNNZ(M); /* number of non-zero coeffs */
/* Compressed Row Storage matrix representation */
NLint *xa = __NL_NEW_ARRAY(NLint, n+1);
NLfloat *rhs = __NL_NEW_ARRAY(NLfloat, n);
NLfloat *a = __NL_NEW_ARRAY(NLfloat, nnz);
NLint *asub = __NL_NEW_ARRAY(NLint, nnz);
NLint *etree = __NL_NEW_ARRAY(NLint, n);
/* SuperLU variables */
SuperMatrix At, AtP;
NLint info, panel_size, relax;
superlu_options_t options;
/* Temporary variables */
NLuint i, jj, count;
__nl_assert(!(M->storage & __NL_SYMMETRIC));
__nl_assert(M->storage & __NL_ROWS);
__nl_assert(M->m == M->n);
/* Convert M to compressed column format */
for(i=0, count=0; i<n; i++) {
__NLRowColumn *Ri = M->row + i;
xa[i] = count;
for(jj=0; jj<Ri->size; jj++, count++) {
a[count] = Ri->coeff[jj].value;
asub[count] = Ri->coeff[jj].index;
}
}
xa[n] = nnz;
/* Free M, don't need it anymore at this point */
__nlSparseMatrixClear(M);
/* Create superlu A matrix transposed */
sCreate_CompCol_Matrix(
&At, n, n, nnz, a, asub, xa,
SLU_NC, /* Colum wise, no supernode */
SLU_S, /* floats */
SLU_GE /* general storage */
);
/* Set superlu options */
set_default_options(&options);
options.ColPerm = MY_PERMC;
options.Fact = DOFACT;
StatInit(&(context->slu.stat));
panel_size = sp_ienv(1); /* sp_ienv give us the defaults */
relax = sp_ienv(2);
/* Compute permutation and permuted matrix */
context->slu.perm_r = __NL_NEW_ARRAY(NLint, n);
context->slu.perm_c = __NL_NEW_ARRAY(NLint, n);
if ((permutation == NULL) || (*permutation == -1)) {
get_perm_c(3, &At, context->slu.perm_c);
if (permutation)
memcpy(permutation, context->slu.perm_c, sizeof(NLint)*n);
}
else
memcpy(context->slu.perm_c, permutation, sizeof(NLint)*n);
sp_preorder(&options, &At, context->slu.perm_c, etree, &AtP);
/* Decompose into L and U */
sgstrf(&options, &AtP, relax, panel_size,
etree, NULL, 0, context->slu.perm_c, context->slu.perm_r,
&(context->slu.L), &(context->slu.U), &(context->slu.stat), &info);
/* Cleanup */
Destroy_SuperMatrix_Store(&At);
Destroy_CompCol_Permuted(&AtP);
__NL_DELETE_ARRAY(etree);
__NL_DELETE_ARRAY(xa);
__NL_DELETE_ARRAY(rhs);
__NL_DELETE_ARRAY(a);
__NL_DELETE_ARRAY(asub);
context->slu.alloc_slu = NL_TRUE;
return (info == 0);
}
void
cpanel_bmod (
const int m, /* in - number of rows in the matrix */
const int w, /* in */
const int jcol, /* in */
const int nseg, /* in */
complex *dense, /* out, of size n by w */
complex *tempv, /* working array */
int *segrep, /* in */
int *repfnz, /* in, of size n by w */
GlobalLU_t *Glu, /* modified */
SuperLUStat_t *stat /* output */
)
{
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
_fcd ftcs1 = _cptofcd("L", strlen("L")),
ftcs2 = _cptofcd("N", strlen("N")),
ftcs3 = _cptofcd("U", strlen("U"));
#endif
int incx = 1, incy = 1;
complex alpha, beta;
#endif
register int k, ksub;
int fsupc, nsupc, nsupr, nrow;
int krep, krep_ind;
complex ukj, ukj1, ukj2;
int luptr, luptr1, luptr2;
int segsze;
int block_nrow; /* no of rows in a block row */
register int lptr; /* Points to the row subscripts of a supernode */
int kfnz, irow, no_zeros;
register int isub, isub1, i;
register int jj; /* Index through each column in the panel */
int *xsup, *supno;
int *lsub, *xlsub;
complex *lusup;
int *xlusup;
int *repfnz_col; /* repfnz[] for a column in the panel */
complex *dense_col; /* dense[] for a column in the panel */
complex *tempv1; /* Used in 1-D update */
complex *TriTmp, *MatvecTmp; /* used in 2-D update */
complex zero = {0.0, 0.0};
complex one = {1.0, 0.0};
complex comp_temp, comp_temp1;
register int ldaTmp;
register int r_ind, r_hi;
static int first = 1, maxsuper, rowblk, colblk;
flops_t *ops = stat->ops;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
lusup = Glu->lusup;
xlusup = Glu->xlusup;
if ( first ) {
maxsuper = SUPERLU_MAX( sp_ienv(3), sp_ienv(7) );
rowblk = sp_ienv(4);
colblk = sp_ienv(5);
first = 0;
}
ldaTmp = maxsuper + rowblk;
/*
* For each nonz supernode segment of U[*,j] in topological order
*/
k = nseg - 1;
for (ksub = 0; ksub < nseg; ksub++) { /* for each updating supernode */
/* krep = representative of current k-th supernode
* fsupc = first supernodal column
* nsupc = no of columns in a supernode
* nsupr = no of rows in a supernode
*/
krep = segrep[k--];
fsupc = xsup[supno[krep]];
nsupc = krep - fsupc + 1;
nsupr = xlsub[fsupc+1] - xlsub[fsupc];
nrow = nsupr - nsupc;
lptr = xlsub[fsupc];
krep_ind = lptr + nsupc - 1;
repfnz_col = repfnz;
dense_col = dense;
if ( nsupc >= colblk && nrow > rowblk ) { /* 2-D block update */
TriTmp = tempv;
/* Sequence through each column in panel -- triangular solves */
for (jj = jcol; jj < jcol + w; jj++,
repfnz_col += m, dense_col += m, TriTmp += ldaTmp ) {
kfnz = repfnz_col[krep];
if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
segsze = krep - kfnz + 1;
luptr = xlusup[fsupc];
ops[TRSV] += 4 * segsze * (segsze - 1);
ops[GEMV] += 8 * nrow * segsze;
/* Case 1: Update U-segment of size 1 -- col-col update */
if ( segsze == 1 ) {
ukj = dense_col[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; i++) {
irow = lsub[i];
cc_mult(&comp_temp, &ukj, &lusup[luptr]);
c_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
++luptr;
}
} else if ( segsze <= 3 ) {
ukj = dense_col[lsub[krep_ind]];
ukj1 = dense_col[lsub[krep_ind - 1]];
luptr += nsupr*(nsupc-1) + nsupc-1;
luptr1 = luptr - nsupr;
if ( segsze == 2 ) {
cc_mult(&comp_temp, &ukj1, &lusup[luptr1]);
c_sub(&ukj, &ukj, &comp_temp);
dense_col[lsub[krep_ind]] = ukj;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
luptr++; luptr1++;
cc_mult(&comp_temp, &ukj, &lusup[luptr]);
cc_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
c_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
}
} else {
ukj2 = dense_col[lsub[krep_ind - 2]];
luptr2 = luptr1 - nsupr;
cc_mult(&comp_temp, &ukj2, &lusup[luptr2-1]);
c_sub(&ukj1, &ukj1, &comp_temp);
cc_mult(&comp_temp, &ukj1, &lusup[luptr1]);
cc_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
c_sub(&ukj, &ukj, &comp_temp);
dense_col[lsub[krep_ind]] = ukj;
dense_col[lsub[krep_ind-1]] = ukj1;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
luptr++; luptr1++; luptr2++;
cc_mult(&comp_temp, &ukj, &lusup[luptr]);
cc_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
cc_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
c_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
}
}
} else { /* segsze >= 4 */
/* Copy U[*,j] segment from dense[*] to TriTmp[*], which
holds the result of triangular solves. */
no_zeros = kfnz - fsupc;
isub = lptr + no_zeros;
for (i = 0; i < segsze; ++i) {
irow = lsub[isub];
TriTmp[i] = dense_col[irow]; /* Gather */
++isub;
}
/* start effective triangle */
luptr += nsupr * no_zeros + no_zeros;
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
CTRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr],
&nsupr, TriTmp, &incx );
#else
ctrsv_( "L", "N", "U", &segsze, &lusup[luptr],
&nsupr, TriTmp, &incx );
#endif
#else
clsolve ( nsupr, segsze, &lusup[luptr], TriTmp );
#endif
} /* else ... */
} /* for jj ... end tri-solves */
/* Block row updates; push all the way into dense[*] block */
for ( r_ind = 0; r_ind < nrow; r_ind += rowblk ) {
r_hi = SUPERLU_MIN(nrow, r_ind + rowblk);
block_nrow = SUPERLU_MIN(rowblk, r_hi - r_ind);
luptr = xlusup[fsupc] + nsupc + r_ind;
isub1 = lptr + nsupc + r_ind;
repfnz_col = repfnz;
TriTmp = tempv;
dense_col = dense;
/* Sequence through each column in panel -- matrix-vector */
for (jj = jcol; jj < jcol + w; jj++,
repfnz_col += m, dense_col += m, TriTmp += ldaTmp) {
kfnz = repfnz_col[krep];
if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
segsze = krep - kfnz + 1;
if ( segsze <= 3 ) continue; /* skip unrolled cases */
/* Perform a block update, and scatter the result of
matrix-vector to dense[]. */
no_zeros = kfnz - fsupc;
luptr1 = luptr + nsupr * no_zeros;
MatvecTmp = &TriTmp[maxsuper];
#ifdef USE_VENDOR_BLAS
alpha = one;
beta = zero;
#ifdef _CRAY
CGEMV(ftcs2, &block_nrow, &segsze, &alpha, &lusup[luptr1],
&nsupr, TriTmp, &incx, &beta, MatvecTmp, &incy);
#else
cgemv_("N", &block_nrow, &segsze, &alpha, &lusup[luptr1],
&nsupr, TriTmp, &incx, &beta, MatvecTmp, &incy);
#endif
#else
cmatvec(nsupr, block_nrow, segsze, &lusup[luptr1],
TriTmp, MatvecTmp);
#endif
/* Scatter MatvecTmp[*] into SPA dense[*] temporarily
* such that MatvecTmp[*] can be re-used for the
* the next blok row update. dense[] will be copied into
* global store after the whole panel has been finished.
*/
isub = isub1;
for (i = 0; i < block_nrow; i++) {
irow = lsub[isub];
c_sub(&dense_col[irow], &dense_col[irow],
&MatvecTmp[i]);
MatvecTmp[i] = zero;
++isub;
}
} /* for jj ... */
} /* for each block row ... */
/* Scatter the triangular solves into SPA dense[*] */
repfnz_col = repfnz;
TriTmp = tempv;
dense_col = dense;
for (jj = jcol; jj < jcol + w; jj++,
repfnz_col += m, dense_col += m, TriTmp += ldaTmp) {
kfnz = repfnz_col[krep];
if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
segsze = krep - kfnz + 1;
if ( segsze <= 3 ) continue; /* skip unrolled cases */
no_zeros = kfnz - fsupc;
isub = lptr + no_zeros;
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
dense_col[irow] = TriTmp[i];
TriTmp[i] = zero;
++isub;
}
} /* for jj ... */
} else { /* 1-D block modification */
/* Sequence through each column in the panel */
for (jj = jcol; jj < jcol + w; jj++,
repfnz_col += m, dense_col += m) {
kfnz = repfnz_col[krep];
if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
segsze = krep - kfnz + 1;
luptr = xlusup[fsupc];
ops[TRSV] += 4 * segsze * (segsze - 1);
ops[GEMV] += 8 * nrow * segsze;
/* Case 1: Update U-segment of size 1 -- col-col update */
if ( segsze == 1 ) {
ukj = dense_col[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; i++) {
irow = lsub[i];
cc_mult(&comp_temp, &ukj, &lusup[luptr]);
c_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
++luptr;
}
} else if ( segsze <= 3 ) {
ukj = dense_col[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc-1;
ukj1 = dense_col[lsub[krep_ind - 1]];
luptr1 = luptr - nsupr;
if ( segsze == 2 ) {
cc_mult(&comp_temp, &ukj1, &lusup[luptr1]);
c_sub(&ukj, &ukj, &comp_temp);
dense_col[lsub[krep_ind]] = ukj;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
++luptr; ++luptr1;
cc_mult(&comp_temp, &ukj, &lusup[luptr]);
cc_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
c_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
}
} else {
ukj2 = dense_col[lsub[krep_ind - 2]];
luptr2 = luptr1 - nsupr;
cc_mult(&comp_temp, &ukj2, &lusup[luptr2-1]);
c_sub(&ukj1, &ukj1, &comp_temp);
cc_mult(&comp_temp, &ukj1, &lusup[luptr1]);
cc_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
c_sub(&ukj, &ukj, &comp_temp);
dense_col[lsub[krep_ind]] = ukj;
dense_col[lsub[krep_ind-1]] = ukj1;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
++luptr; ++luptr1; ++luptr2;
cc_mult(&comp_temp, &ukj, &lusup[luptr]);
cc_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
cc_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
c_add(&comp_temp, &comp_temp, &comp_temp1);
c_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
}
}
} else { /* segsze >= 4 */
/*
* Perform a triangular solve and block update,
* then scatter the result of sup-col update to dense[].
*/
no_zeros = kfnz - fsupc;
/* Copy U[*,j] segment from dense[*] to tempv[*]:
* The result of triangular solve is in tempv[*];
* The result of matrix vector update is in dense_col[*]
*/
isub = lptr + no_zeros;
for (i = 0; i < segsze; ++i) {
irow = lsub[isub];
tempv[i] = dense_col[irow]; /* Gather */
++isub;
}
/* start effective triangle */
luptr += nsupr * no_zeros + no_zeros;
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
CTRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr],
&nsupr, tempv, &incx );
#else
ctrsv_( "L", "N", "U", &segsze, &lusup[luptr],
&nsupr, tempv, &incx );
#endif
luptr += segsze; /* Dense matrix-vector */
tempv1 = &tempv[segsze];
alpha = one;
beta = zero;
#ifdef _CRAY
CGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tempv, &incx, &beta, tempv1, &incy );
#else
cgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tempv, &incx, &beta, tempv1, &incy );
#endif
#else
clsolve ( nsupr, segsze, &lusup[luptr], tempv );
luptr += segsze; /* Dense matrix-vector */
tempv1 = &tempv[segsze];
cmatvec (nsupr, nrow, segsze, &lusup[luptr], tempv, tempv1);
#endif
/* Scatter tempv[*] into SPA dense[*] temporarily, such
* that tempv[*] can be used for the triangular solve of
* the next column of the panel. They will be copied into
* ucol[*] after the whole panel has been finished.
*/
isub = lptr + no_zeros;
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
dense_col[irow] = tempv[i];
tempv[i] = zero;
isub++;
}
/* Scatter the update from tempv1[*] into SPA dense[*] */
/* Start dense rectangular L */
for (i = 0; i < nrow; i++) {
irow = lsub[isub];
c_sub(&dense_col[irow], &dense_col[irow], &tempv1[i]);
tempv1[i] = zero;
++isub;
}
} /* else segsze>=4 ... */
} /* for each column in the panel... */
} /* else 1-D update ... */
} /* for each updating supernode ... */
}
void
dgssv(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
SuperMatrix *L, SuperMatrix *U, SuperMatrix *B,
SuperLUStat_t *stat, int *info )
{
DNformat *Bstore;
SuperMatrix *AA;/* A in SLU_NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int lwork = 0, *etree, i;
/* Set default values for some parameters */
double drop_tol = 0.;
int panel_size; /* panel size */
int relax; /* no of columns in a relaxed snodes */
int permc_spec;
trans_t trans = NOTRANS;
double *utime;
double t; /* Temporary time */
/* Test the input parameters ... */
*info = 0;
Bstore = B->Store;
if ( options->Fact != DOFACT ) *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 ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != SLU_DN || B->Dtype != SLU_D || B->Mtype != SLU_GE )
*info = -7;
if ( *info != 0 ) {
i = -(*info);
xerbla_("dgssv", &i);
return;
}
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);
trans = TRANS;
} else {
if ( A->Stype == SLU_NC ) AA = A;
}
t = SuperLU_timer_();
/*
* Get 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_() - t;
etree = intMalloc(A->ncol);
t = SuperLU_timer_();
sp_preorder(options, AA, perm_c, etree, &AC);
utime[ETREE] = SuperLU_timer_() - t;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
/*printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
relax, panel_size, sp_ienv(3), sp_ienv(4));*/
t = SuperLU_timer_();
/* Compute the LU factorization of A. */
dgstrf(options, &AC, drop_tol, relax, panel_size,
etree, NULL, lwork, perm_c, perm_r, L, U, stat, info);
utime[FACT] = SuperLU_timer_() - t;
t = SuperLU_timer_();
if ( *info == 0 ) {
/* Solve the system A*X=B, overwriting B with X. */
dgstrs (trans, L, U, perm_c, perm_r, B, stat, info);
}
utime[SOLVE] = SuperLU_timer_() - t;
SUPERLU_FREE (etree);
Destroy_CompCol_Permuted(&AC);
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
}
void
pzgssv(int nprocs, SuperMatrix *A, int *perm_c, int *perm_r,
SuperMatrix *L, SuperMatrix *U, SuperMatrix *B, 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
* =======
*
* PZGSSV solves the system of linear equations A*X=B, using the parallel
* LU factorization routine PZGSTRF. It performs the following steps:
*
* 1. If A is stored column-wise (A->Stype = NC):
*
* 1.1. Permute the columns of A, forming A*Pc, where Pc is a
* permutation matrix.
* For more details of this step, see sp_preorder.c.
*
* 1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
* by Gaussian elimination with partial pivoting.
* L is unit lower triangular with offdiagonal entries
* bounded by 1 in magnitude, and U is upper triangular.
*
* 1.3. Solve the system of equations A*X=B using the factored
* form of A.
*
* 2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
* to the tranpose of A:
*
* 2.1. Permute columns of tranpose(A) (rows of A),
* forming transpose(A)*Pc, where Pc is a permutation matrix.
* For more details of this step, see sp_preorder.c.
*
* 2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
* determined by Gaussian elimination with partial pivoting.
* L is unit lower triangular with offdiagonal entries
* bounded by 1 in magnitude, and U is upper triangular.
*
* 2.3. Solve the system of equations A*X=B using the factored
* form of A.
*
* 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 pzgstrf(). There is a single thread of
* control to call pzgstrf(), and all threads spawned by pzgstrf()
* are terminated before returning from pzgstrf().
*
* A (input) 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.
*
* 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 (output) int*,
* If A->Stype=NR, 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.
*
* 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).
* Use 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, the solution matrix if info = 0;
*
* info (output) int*
* = 0: successful exit
* > 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 could not be computed.
* > A->ncol: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
trans_t trans;
NCformat *Astore;
DNformat *Bstore;
SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int i, n, panel_size, relax;
fact_t fact;
yes_no_t refact, usepr;
double diag_pivot_thresh, drop_tol;
void *work;
int lwork;
superlumt_options_t superlumt_options;
Gstat_t Gstat;
double t; /* Temporary time */
double *utime;
flops_t *ops, flopcnt;
/* ------------------------------------------------------------
Test the input parameters.
------------------------------------------------------------*/
Astore = A->Store;
Bstore = B->Store;
*info = 0;
if ( nprocs <= 0 ) *info = -1;
else if ( A->nrow != A->ncol || A->nrow < 0 ||
(A->Stype != SLU_NC && A->Stype != SLU_NR) ||
A->Dtype != SLU_Z || A->Mtype != SLU_GE )
*info = -2;
else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(1, A->nrow) )*info = -7;
if ( *info != 0 ) {
i = -(*info);
xerbla_("pzgssv", &i);
return;
}
#if 0
/* Use the best sequential code.
if this part is commented out, we will use the parallel code
run on one processor. */
if ( nprocs == 1 ) {
return;
}
#endif
fact = EQUILIBRATE;
refact = NO;
trans = NOTRANS;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
diag_pivot_thresh = 1.0;
usepr = NO;
drop_tol = 0.0;
work = NULL;
lwork = 0;
/* ------------------------------------------------------------
Allocate storage and initialize statistics variables.
------------------------------------------------------------*/
n = A->ncol;
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) );
zCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
Astore->nzval, Astore->colind, Astore->rowptr,
SLU_NC, A->Dtype, A->Mtype);
trans = TRANS;
} else if ( A->Stype == SLU_NC ) AA = A;
/* ------------------------------------------------------------
Initialize the option structure superlumt_options using the
user-input parameters;
Apply perm_c to the columns of original A to form AC.
------------------------------------------------------------*/
pzgstrf_init(nprocs, fact, trans, refact, panel_size, relax,
diag_pivot_thresh, usepr, drop_tol, perm_c, perm_r,
work, lwork, AA, &AC, &superlumt_options, &Gstat);
/* ------------------------------------------------------------
Compute the LU factorization of A.
The following routine will create nprocs threads.
------------------------------------------------------------*/
pzgstrf(&superlumt_options, &AC, perm_r, L, U, &Gstat, info);
flopcnt = 0;
for (i = 0; i < nprocs; ++i) flopcnt += Gstat.procstat[i].fcops;
ops[FACT] = flopcnt;
#if ( PRNTlevel==1 )
printf("nprocs = %d, flops %e, Mflops %.2f\n",
nprocs, flopcnt, flopcnt/utime[FACT]*1e-6);
printf("Parameters: w %d, relax %d, maxsuper %d, rowblk %d, colblk %d\n",
sp_ienv(1), sp_ienv(2), sp_ienv(3), sp_ienv(4), sp_ienv(5));
fflush(stdout);
#endif
/* ------------------------------------------------------------
Solve the system A*X=B, overwriting B with X.
------------------------------------------------------------*/
if ( *info == 0 ) {
t = SuperLU_timer_();
zgstrs (trans, L, U, perm_r, perm_c, B, &Gstat, info);
utime[SOLVE] = SuperLU_timer_() - t;
ops[SOLVE] = ops[TRISOLVE];
}
/* ------------------------------------------------------------
Deallocate storage after factorization.
------------------------------------------------------------*/
pxgstrf_finalize(&superlumt_options, &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
sgstrf (superlu_options_t *options, SuperMatrix *A,
int relax, int panel_size, int *etree, void *work, int lwork,
int *perm_c, int *perm_r, SuperMatrix *L, SuperMatrix *U,
GlobalLU_t *Glu, /* persistent to facilitate multiple factorizations */
SuperLUStat_t *stat, int *info)
{
/* Local working arrays */
NCPformat *Astore;
int *iperm_r = NULL; /* inverse of perm_r; used when
options->Fact == SamePattern_SameRowPerm */
int *iperm_c; /* inverse of perm_c */
int *iwork;
float *swork;
int *segrep, *repfnz, *parent, *xplore;
int *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
int *xprune;
int *marker;
float *dense, *tempv;
int *relax_end;
float *a;
int *asub;
int *xa_begin, *xa_end;
int *xsup, *supno;
int *xlsub, *xlusup, *xusub;
int nzlumax;
float fill_ratio = sp_ienv(6); /* estimated fill ratio */
/* Local scalars */
fact_t fact = options->Fact;
double diag_pivot_thresh = options->DiagPivotThresh;
int pivrow; /* pivotal row number in the original matrix A */
int nseg1; /* no of segments in U-column above panel row jcol */
int nseg; /* no of segments in each U-column */
register int jcol;
register int kcol; /* end column of a relaxed snode */
register int icol;
register int i, k, jj, new_next, iinfo;
int m, n, min_mn, jsupno, fsupc, nextlu, nextu;
int w_def; /* upper bound on panel width */
int usepr, iperm_r_allocated = 0;
int nnzL, nnzU;
int *panel_histo = stat->panel_histo;
flops_t *ops = stat->ops;
iinfo = 0;
m = A->nrow;
n = A->ncol;
min_mn = SUPERLU_MIN(m, n);
Astore = A->Store;
a = Astore->nzval;
asub = Astore->rowind;
xa_begin = Astore->colbeg;
xa_end = Astore->colend;
/* Allocate storage common to the factor routines */
*info = sLUMemInit(fact, work, lwork, m, n, Astore->nnz,
panel_size, fill_ratio, L, U, Glu, &iwork, &swork);
if ( *info ) return;
xsup = Glu->xsup;
supno = Glu->supno;
xlsub = Glu->xlsub;
xlusup = Glu->xlusup;
xusub = Glu->xusub;
SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
&repfnz, &panel_lsub, &xprune, &marker);
sSetRWork(m, panel_size, swork, &dense, &tempv);
usepr = (fact == SamePattern_SameRowPerm);
if ( usepr ) {
/* Compute the inverse of perm_r */
iperm_r = (int *) intMalloc(m);
for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
iperm_r_allocated = 1;
}
iperm_c = (int *) intMalloc(n);
for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
/* Identify relaxed snodes */
relax_end = (int *) intMalloc(n);
if ( options->SymmetricMode == YES ) {
heap_relax_snode(n, etree, relax, marker, relax_end);
} else {
relax_snode(n, etree, relax, marker, relax_end);
}
ifill (perm_r, m, EMPTY);
ifill (marker, m * NO_MARKER, EMPTY);
supno[0] = -1;
xsup[0] = xlsub[0] = xusub[0] = xlusup[0] = 0;
w_def = panel_size;
/*
* Work on one "panel" at a time. A panel is one of the following:
* (a) a relaxed supernode at the bottom of the etree, or
* (b) panel_size contiguous columns, defined by the user
*/
for (jcol = 0; jcol < min_mn; ) {
if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
kcol = relax_end[jcol]; /* end of the relaxed snode */
panel_histo[kcol-jcol+1]++;
/* --------------------------------------
* Factorize the relaxed supernode(jcol:kcol)
* -------------------------------------- */
/* Determine the union of the row structure of the snode */
if ( (*info = ssnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
xprune, marker, Glu)) != 0 )
return;
nextu = xusub[jcol];
nextlu = xlusup[jcol];
jsupno = supno[jcol];
fsupc = xsup[jsupno];
new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
nzlumax = Glu->nzlumax;
while ( new_next > nzlumax ) {
if ( (*info = sLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu)) )
return;
}
for (icol = jcol; icol<= kcol; icol++) {
xusub[icol+1] = nextu;
/* Scatter into SPA dense[*] */
for (k = xa_begin[icol]; k < xa_end[icol]; k++)
dense[asub[k]] = a[k];
/* Numeric update within the snode */
ssnode_bmod(icol, jsupno, fsupc, dense, tempv, Glu, stat);
if ( (*info = spivotL(icol, diag_pivot_thresh, &usepr, perm_r,
iperm_r, iperm_c, &pivrow, Glu, stat)) )
if ( iinfo == 0 ) iinfo = *info;
#ifdef DEBUG
sprint_lu_col("[1]: ", icol, pivrow, xprune, Glu);
#endif
}
jcol = icol;
} else { /* Work on one panel of panel_size columns */
/* Adjust panel_size so that a panel won't overlap with the next
* relaxed snode.
*/
panel_size = w_def;
for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
if ( relax_end[k] != EMPTY ) {
panel_size = k - jcol;
break;
}
if ( k == min_mn ) panel_size = min_mn - jcol;
panel_histo[panel_size]++;
/* symbolic factor on a panel of columns */
spanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
dense, panel_lsub, segrep, repfnz, xprune,
marker, parent, xplore, Glu);
/* numeric sup-panel updates in topological order */
spanel_bmod(m, panel_size, jcol, nseg1, dense,
tempv, segrep, repfnz, Glu, stat);
/* Sparse LU within the panel, and below panel diagonal */
for ( jj = jcol; jj < jcol + panel_size; jj++) {
k = (jj - jcol) * m; /* column index for w-wide arrays */
nseg = nseg1; /* Begin after all the panel segments */
if ((*info = scolumn_dfs(m, jj, perm_r, &nseg, &panel_lsub[k],
segrep, &repfnz[k], xprune, marker,
parent, xplore, Glu)) != 0) return;
/* Numeric updates */
if ((*info = scolumn_bmod(jj, (nseg - nseg1), &dense[k],
tempv, &segrep[nseg1], &repfnz[k],
jcol, Glu, stat)) != 0) return;
/* Copy the U-segments to ucol[*] */
if ((*info = scopy_to_ucol(jj, nseg, segrep, &repfnz[k],
perm_r, &dense[k], Glu)) != 0)
return;
if ( (*info = spivotL(jj, diag_pivot_thresh, &usepr, perm_r,
iperm_r, iperm_c, &pivrow, Glu, stat)) )
if ( iinfo == 0 ) iinfo = *info;
/* Prune columns (0:jj-1) using column jj */
spruneL(jj, perm_r, pivrow, nseg, segrep,
&repfnz[k], xprune, Glu);
/* Reset repfnz[] for this column */
resetrep_col (nseg, segrep, &repfnz[k]);
#ifdef DEBUG
sprint_lu_col("[2]: ", jj, pivrow, xprune, Glu);
#endif
}
jcol += panel_size; /* Move to the next panel */
} /* else */
} /* for */
*info = iinfo;
if ( m > n ) {
k = 0;
for (i = 0; i < m; ++i)
if ( perm_r[i] == EMPTY ) {
perm_r[i] = n + k;
++k;
}
}
countnz(min_mn, xprune, &nnzL, &nnzU, Glu);
fixupL(min_mn, perm_r, Glu);
sLUWorkFree(iwork, swork, Glu); /* Free work space and compress storage */
if ( fact == SamePattern_SameRowPerm ) {
/* L and U structures may have changed due to possibly different
pivoting, even though the storage is available.
There could also be memory expansions, so the array locations
may have changed, */
((SCformat *)L->Store)->nnz = nnzL;
((SCformat *)L->Store)->nsuper = Glu->supno[n];
((SCformat *)L->Store)->nzval = Glu->lusup;
((SCformat *)L->Store)->nzval_colptr = Glu->xlusup;
((SCformat *)L->Store)->rowind = Glu->lsub;
((SCformat *)L->Store)->rowind_colptr = Glu->xlsub;
((NCformat *)U->Store)->nnz = nnzU;
((NCformat *)U->Store)->nzval = Glu->ucol;
((NCformat *)U->Store)->rowind = Glu->usub;
((NCformat *)U->Store)->colptr = Glu->xusub;
} else {
sCreate_SuperNode_Matrix(L, A->nrow, min_mn, nnzL, Glu->lusup,
Glu->xlusup, Glu->lsub, Glu->xlsub, Glu->supno,
Glu->xsup, SLU_SC, SLU_S, SLU_TRLU);
sCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU, Glu->ucol,
Glu->usub, Glu->xusub, SLU_NC, SLU_S, SLU_TRU);
}
ops[FACT] += ops[TRSV] + ops[GEMV];
stat->expansions = --(Glu->num_expansions);
if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
SUPERLU_FREE (iperm_c);
SUPERLU_FREE (relax_end);
}
void
sgssvx(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
int *etree, char *equed, float *R, float *C,
SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
SuperMatrix *B, SuperMatrix *X, float *recip_pivot_growth,
float *rcond, float *ferr, float *berr,
mem_usage_t *mem_usage, SuperLUStat_t *stat, int *info )
{
DNformat *Bstore, *Xstore;
float *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;
float amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
int relax, panel_size;
float diag_pivot_thresh;
double t0; /* temporary time */
double *utime;
/* External functions */
extern float slangs(char *, SuperMatrix *);
Bstore = B->Store;
Xstore = X->Store;
Bmat = Bstore->nzval;
Xmat = 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 = lsame_(equed, "R") || lsame_(equed, "B");
colequ = lsame_(equed, "C") || lsame_(equed, "B");
smlnum = slamch_("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 (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_S || A->Mtype != SLU_GE )
*info = -2;
else if (options->Fact == FACTORED &&
!(rowequ || colequ || 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 ) *info = -13;
else if ( B->ncol > 0 ) { /* no checking if B->ncol=0 */
if ( Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != SLU_DN || B->Dtype != SLU_S ||
B->Mtype != SLU_GE )
*info = -13;
}
if ( X->ncol < 0 ) *info = -14;
else if ( X->ncol > 0 ) { /* no checking if X->ncol=0 */
if ( Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
(B->ncol != 0 && B->ncol != X->ncol) ||
X->Stype != SLU_DN ||
X->Dtype != SLU_S || X->Mtype != SLU_GE )
*info = -14;
}
}
}
if (*info != 0) {
i = -(*info);
xerbla_("sgssvx", &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) );
sCreate_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 && equil ) {
t0 = SuperLU_timer_();
/* Compute row and column scalings to equilibrate the matrix A. */
sgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
slaqgs(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;
}
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_();
sgstrf(options, &AC, 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 = sPivotGrowth(*info, AA, perm_c, L, U);
}
return;
}
/* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
*recip_pivot_growth = sPivotGrowth(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 = slangs(norm, AA);
sgscon(norm, L, U, anorm, rcond, stat, info);
utime[RCOND] = 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];
}
/* 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_();
sgstrs (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 ) {
sgsrfs(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 < slamch_("E") ) *info = A->ncol + 1;
}
if ( nofact ) {
sQuerySpace(L, U, mem_usage);
Destroy_CompCol_Permuted(&AC);
}
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
}
int HYPRE_ParCSR_SuperLUSetup(HYPRE_Solver solver, HYPRE_ParCSRMatrix A_csr,
HYPRE_ParVector b, HYPRE_ParVector x )
{
#ifdef HAVE_SUPERLU
int startRow, endRow, nrows, *partition, *AdiagI, *AdiagJ, nnz;
int irow, colNum, index, *cscI, *cscJ, jcol, *colLengs;
int *etree, permcSpec, lwork, panelSize, relax, info;
double *AdiagA, *cscA, diagPivotThresh, dropTol;
char refact[1];
hypre_CSRMatrix *Adiag;
HYPRE_SuperLU *sluPtr;
SuperMatrix sluAmat, auxAmat;
superlu_options_t slu_options;
SuperLUStat_t slu_stat;
/* ---------------------------------------------------------------- */
/* get matrix information */
/* ---------------------------------------------------------------- */
sluPtr = (HYPRE_SuperLU *) solver;
assert ( sluPtr != NULL );
HYPRE_ParCSRMatrixGetRowPartitioning( A_csr, &partition );
startRow = partition[0];
endRow = partition[1] - 1;
nrows = endRow - startRow + 1;
free( partition );
if ( startRow != 0 )
{
printf("HYPRE_ParCSR_SuperLUSetup ERROR - start row != 0.\n");
return -1;
}
/* ---------------------------------------------------------------- */
/* get hypre matrix */
/* ---------------------------------------------------------------- */
Adiag = hypre_ParCSRMatrixDiag((hypre_ParCSRMatrix *) A_csr);
AdiagI = hypre_CSRMatrixI(Adiag);
AdiagJ = hypre_CSRMatrixJ(Adiag);
AdiagA = hypre_CSRMatrixData(Adiag);
nnz = AdiagI[nrows];
/* ---------------------------------------------------------------- */
/* convert the csr matrix into csc matrix */
/* ---------------------------------------------------------------- */
colLengs = (int *) malloc(nrows * sizeof(int));
for ( irow = 0; irow < nrows; irow++ ) colLengs[irow] = 0;
for ( irow = 0; irow < nrows; irow++ )
for ( jcol = AdiagI[irow]; jcol < AdiagI[irow+1]; jcol++ )
colLengs[AdiagJ[jcol]]++;
cscJ = (int *) malloc( (nrows+1) * sizeof(int) );
cscI = (int *) malloc( nnz * sizeof(int) );
cscA = (double *) malloc( nnz * sizeof(double) );
cscJ[0] = 0;
nnz = 0;
for ( jcol = 1; jcol <= nrows; jcol++ )
{
nnz += colLengs[jcol-1];
cscJ[jcol] = nnz;
}
for ( irow = 0; irow < nrows; irow++ )
{
for ( jcol = AdiagI[irow]; jcol < AdiagI[irow+1]; jcol++ )
{
colNum = AdiagJ[jcol];
index = cscJ[colNum]++;
cscI[index] = irow;
cscA[index] = AdiagA[jcol];
}
}
cscJ[0] = 0;
nnz = 0;
for ( jcol = 1; jcol <= nrows; jcol++ )
{
nnz += colLengs[jcol-1];
cscJ[jcol] = nnz;
}
free(colLengs);
/* ---------------------------------------------------------------- */
/* create SuperMatrix */
/* ---------------------------------------------------------------- */
dCreate_CompCol_Matrix(&sluAmat,nrows,nrows,cscJ[nrows],cscA,cscI,
cscJ, SLU_NC, SLU_D, SLU_GE);
etree = (int *) malloc(nrows * sizeof(int));
sluPtr->permC_ = (int *) malloc(nrows * sizeof(int));
sluPtr->permR_ = (int *) malloc(nrows * sizeof(int));
permcSpec = 0;
get_perm_c(permcSpec, &sluAmat, sluPtr->permC_);
slu_options.Fact = DOFACT;
slu_options.SymmetricMode = NO;
sp_preorder(&slu_options, &sluAmat, sluPtr->permC_, etree, &auxAmat);
diagPivotThresh = 1.0;
dropTol = 0.0;
panelSize = sp_ienv(1);
relax = sp_ienv(2);
StatInit(&slu_stat);
lwork = 0;
slu_options.ColPerm = MY_PERMC;
slu_options.DiagPivotThresh = diagPivotThresh;
dgstrf(&slu_options, &auxAmat, dropTol, relax, panelSize,
etree, NULL, lwork, sluPtr->permC_, sluPtr->permR_,
&(sluPtr->SLU_Lmat), &(sluPtr->SLU_Umat), &slu_stat, &info);
Destroy_CompCol_Permuted(&auxAmat);
Destroy_CompCol_Matrix(&sluAmat);
free(etree);
sluPtr->factorized_ = 1;
StatFree(&slu_stat);
return 0;
#else
printf("HYPRE_ParCSR_SuperLUSetup ERROR - SuperLU not enabled.\n");
*solver = (HYPRE_Solver) NULL;
return -1;
#endif
}
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
psgssvx(int nprocs, superlumt_options_t *superlumt_options, SuperMatrix *A,
int *perm_c, int *perm_r, equed_t *equed, float *R, float *C,
SuperMatrix *L, SuperMatrix *U,
SuperMatrix *B, SuperMatrix *X, float *recip_pivot_growth,
float *rcond, float *ferr, float *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
* =======
*
* psgssvx() solves the system of linear equations A*X=B or A'*X=B, using
* the LU factorization from sgstrf(). 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 ssp_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 ssp_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 psgstrf(). There is a single thread of
* control to call psgstrf(), and all threads spawned by psgstrf()
* are terminated before returning from psgstrf().
*
* 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 (float)
* 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) float*
* 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) float*
* 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) float*, 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) float*, 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;
float *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;
float 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 float slangs(char *, SuperMatrix *);
extern double slamch_(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 = slamch_("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_S || 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_S ||
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_S || X->Mtype != SLU_GE )
*info = -12;
}
}
if (*info != 0) {
i = -(*info);
xerbla_("psgssvx", &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) );
sCreate_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. */
sgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
slaqgs(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_();
psgstrf(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 = sPivotGrowth(*info, AA, perm_c, L, U);
}
} else {
/* ------------------------------------------------------------
Compute the reciprocal pivot growth factor *recip_pivot_growth.
------------------------------------------------------------*/
*recip_pivot_growth = sPivotGrowth(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 = slangs(norm, AA);
sgscon(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_();
sgstrs(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_();
sgsrfs(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 < slamch_("E") ) *info = A->ncol + 1;
}
superlu_sQuerySpace(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
sgssv(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
SuperMatrix *L, SuperMatrix *U, SuperMatrix *B,
SuperLUStat_t *stat, int *info )
{
/*
* Purpose
* =======
*
* SGSSV solves the system of linear equations A*X=B, using the
* LU factorization from SGSTRF. It performs the following steps:
*
* 1. If A is stored column-wise (A->Stype = SLU_NC):
*
* 1.1. Permute the columns of A, forming A*Pc, where Pc
* is a permutation matrix. For more details of this step,
* see sp_preorder.c.
*
* 1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
* by Gaussian elimination with partial pivoting.
* L is unit lower triangular with offdiagonal entries
* bounded by 1 in magnitude, and U is upper triangular.
*
* 1.3. Solve the system of equations A*X=B using the factored
* form of A.
*
* 2. If A is stored row-wise (A->Stype = SLU_NR), apply the
* above algorithm to the transpose of A:
*
* 2.1. Permute columns of transpose(A) (rows of A),
* forming transpose(A)*Pc, where Pc is a permutation matrix.
* For more details of this step, see sp_preorder.c.
*
* 2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
* determined by Gaussian elimination with partial pivoting.
* L is unit lower triangular with offdiagonal entries
* bounded by 1 in magnitude, and U is upper triangular.
*
* 2.3. Solve the system of equations A*X=B using the factored
* form of A.
*
* 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) SuperMatrix*
* Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
* of linear equations is A->nrow. Currently, the type of A can be:
* Stype = SLU_NC or SLU_NR; Dtype = SLU_S; Mtype = SLU_GE.
* In the future, more general A may be handled.
*
* 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.
* 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.
*
* If options->ColPerm = MY_PERMC or options->Fact = SamePattern or
* options->Fact = SamePattern_SameRowPerm, it is an input argument.
* 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.
* Otherwise, it is an output argument.
*
* 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->RowPerm = MY_PERMR or
* options->Fact = SamePattern_SameRowPerm, perm_r is an
* input argument.
* otherwise it is an output argument.
*
* 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_S, 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_S, Mtype = SLU_TRU.
*
* B (input/output) SuperMatrix*
* B has types: Stype = SLU_DN, Dtype = SLU_S, Mtype = SLU_GE.
* On entry, the right hand side matrix.
* On exit, the solution matrix if info = 0;
*
* stat (output) SuperLUStat_t*
* Record the statistics on runtime and doubleing-point operation count.
* See util.h for the definition of 'SuperLUStat_t'.
*
* info (output) int*
* = 0: successful exit
* > 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 could not be computed.
* > A->ncol: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
DNformat *Bstore;
SuperMatrix *AA = NULL;/* A in SLU_NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int lwork = 0, *etree, i;
/* Set default values for some parameters */
int panel_size; /* panel size */
int relax; /* no of columns in a relaxed snodes */
int permc_spec;
trans_t trans = NOTRANS;
double *utime;
double t; /* Temporary time */
/* Test the input parameters ... */
*info = 0;
Bstore = B->Store;
if ( options->Fact != DOFACT ) *info = -1;
else if ( A->nrow != A->ncol || A->nrow < 0 ||
(A->Stype != SLU_NC && A->Stype != SLU_NR) ||
A->Dtype != SLU_S || A->Mtype != SLU_GE )
*info = -2;
else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
B->Stype != SLU_DN || B->Dtype != SLU_S || B->Mtype != SLU_GE )
*info = -7;
if ( *info != 0 ) {
i = -(*info);
xerbla_("sgssv", &i);
return;
}
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) );
sCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
Astore->nzval, Astore->colind, Astore->rowptr,
SLU_NC, A->Dtype, A->Mtype);
trans = TRANS;
} else {
if ( A->Stype == SLU_NC ) AA = A;
}
t = SuperLU_timer_();
/*
* Get 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_() - t;
etree = intMalloc(A->ncol);
t = SuperLU_timer_();
sp_preorder(options, AA, perm_c, etree, &AC);
utime[ETREE] = SuperLU_timer_() - t;
panel_size = sp_ienv(1);
relax = sp_ienv(2);
/*printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
relax, panel_size, sp_ienv(3), sp_ienv(4));*/
t = SuperLU_timer_();
/* Compute the LU factorization of A. */
sgstrf(options, &AC, relax, panel_size,
etree, NULL, lwork, perm_c, perm_r, L, U, stat, info);
utime[FACT] = SuperLU_timer_() - t;
t = SuperLU_timer_();
if ( *info == 0 ) {
/* Solve the system A*X=B, overwriting B with X. */
sgstrs (trans, L, U, perm_c, perm_r, B, stat, info);
}
utime[SOLVE] = SuperLU_timer_() - t;
SUPERLU_FREE (etree);
Destroy_CompCol_Permuted(&AC);
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
}
void
cgsitrf(superlu_options_t *options, SuperMatrix *A, int relax, int panel_size,
int *etree, void *work, int lwork, int *perm_c, int *perm_r,
SuperMatrix *L, SuperMatrix *U, SuperLUStat_t *stat, int *info)
{
/* Local working arrays */
NCPformat *Astore;
int *iperm_r = NULL; /* inverse of perm_r; used when
options->Fact == SamePattern_SameRowPerm */
int *iperm_c; /* inverse of perm_c */
int *swap, *iswap; /* swap is used to store the row permutation
during the factorization. Initially, it is set
to iperm_c (row indeces of Pc*A*Pc').
iswap is the inverse of swap. After the
factorization, it is equal to perm_r. */
int *iwork;
complex *cwork;
int *segrep, *repfnz, *parent, *xplore;
int *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
int *marker, *marker_relax;
complex *dense, *tempv;
float *stempv;
int *relax_end, *relax_fsupc;
complex *a;
int *asub;
int *xa_begin, *xa_end;
int *xsup, *supno;
int *xlsub, *xlusup, *xusub;
int nzlumax;
float *amax;
complex drop_sum;
float alpha, omega; /* used in MILU, mimicing DRIC */
static GlobalLU_t Glu; /* persistent to facilitate multiple factors. */
float *swork2; /* used by the second dropping rule */
/* Local scalars */
fact_t fact = options->Fact;
double diag_pivot_thresh = options->DiagPivotThresh;
double drop_tol = options->ILU_DropTol; /* tau */
double fill_ini = options->ILU_FillTol; /* tau^hat */
double gamma = options->ILU_FillFactor;
int drop_rule = options->ILU_DropRule;
milu_t milu = options->ILU_MILU;
double fill_tol;
int pivrow; /* pivotal row number in the original matrix A */
int nseg1; /* no of segments in U-column above panel row jcol */
int nseg; /* no of segments in each U-column */
register int jcol;
register int kcol; /* end column of a relaxed snode */
register int icol;
register int i, k, jj, new_next, iinfo;
int m, n, min_mn, jsupno, fsupc, nextlu, nextu;
int w_def; /* upper bound on panel width */
int usepr, iperm_r_allocated = 0;
int nnzL, nnzU;
int *panel_histo = stat->panel_histo;
flops_t *ops = stat->ops;
int last_drop;/* the last column which the dropping rules applied */
int quota;
int nnzAj; /* number of nonzeros in A(:,1:j) */
int nnzLj, nnzUj;
double tol_L = drop_tol, tol_U = drop_tol;
complex zero = {0.0, 0.0};
float one = 1.0;
/* Executable */
iinfo = 0;
m = A->nrow;
n = A->ncol;
min_mn = SUPERLU_MIN(m, n);
Astore = A->Store;
a = Astore->nzval;
asub = Astore->rowind;
xa_begin = Astore->colbeg;
xa_end = Astore->colend;
/* Allocate storage common to the factor routines */
*info = cLUMemInit(fact, work, lwork, m, n, Astore->nnz, panel_size,
gamma, L, U, &Glu, &iwork, &cwork);
if ( *info ) return;
xsup = Glu.xsup;
supno = Glu.supno;
xlsub = Glu.xlsub;
xlusup = Glu.xlusup;
xusub = Glu.xusub;
SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
&repfnz, &panel_lsub, &marker_relax, &marker);
cSetRWork(m, panel_size, cwork, &dense, &tempv);
usepr = (fact == SamePattern_SameRowPerm);
if ( usepr ) {
/* Compute the inverse of perm_r */
iperm_r = (int *) intMalloc(m);
for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
iperm_r_allocated = 1;
}
iperm_c = (int *) intMalloc(n);
for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
swap = (int *)intMalloc(n);
for (k = 0; k < n; k++) swap[k] = iperm_c[k];
iswap = (int *)intMalloc(n);
for (k = 0; k < n; k++) iswap[k] = perm_c[k];
amax = (float *) floatMalloc(panel_size);
if (drop_rule & DROP_SECONDARY)
swork2 = (float *)floatMalloc(n);
else
swork2 = NULL;
nnzAj = 0;
nnzLj = 0;
nnzUj = 0;
last_drop = SUPERLU_MAX(min_mn - 2 * sp_ienv(7), (int)(min_mn * 0.95));
alpha = pow((double)n, -1.0 / options->ILU_MILU_Dim);
/* Identify relaxed snodes */
relax_end = (int *) intMalloc(n);
relax_fsupc = (int *) intMalloc(n);
if ( options->SymmetricMode == YES )
ilu_heap_relax_snode(n, etree, relax, marker, relax_end, relax_fsupc);
else
ilu_relax_snode(n, etree, relax, marker, relax_end, relax_fsupc);
ifill (perm_r, m, EMPTY);
ifill (marker, m * NO_MARKER, EMPTY);
supno[0] = -1;
xsup[0] = xlsub[0] = xusub[0] = xlusup[0] = 0;
w_def = panel_size;
/* Mark the rows used by relaxed supernodes */
ifill (marker_relax, m, EMPTY);
i = mark_relax(m, relax_end, relax_fsupc, xa_begin, xa_end,
asub, marker_relax);
#if ( PRNTlevel >= 1)
printf("%d relaxed supernodes.\n", i);
#endif
/*
* Work on one "panel" at a time. A panel is one of the following:
* (a) a relaxed supernode at the bottom of the etree, or
* (b) panel_size contiguous columns, defined by the user
*/
for (jcol = 0; jcol < min_mn; ) {
if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
kcol = relax_end[jcol]; /* end of the relaxed snode */
panel_histo[kcol-jcol+1]++;
/* Drop small rows in the previous supernode. */
if (jcol > 0 && jcol < last_drop) {
int first = xsup[supno[jcol - 1]];
int last = jcol - 1;
int quota;
/* Compute the quota */
if (drop_rule & DROP_PROWS)
quota = gamma * Astore->nnz / m * (m - first) / m
* (last - first + 1);
else if (drop_rule & DROP_COLUMN) {
int i;
quota = 0;
for (i = first; i <= last; i++)
quota += xa_end[i] - xa_begin[i];
quota = gamma * quota * (m - first) / m;
} else if (drop_rule & DROP_AREA)
quota = gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
- nnzLj;
else
quota = m * n;
fill_tol = pow(fill_ini, 1.0 - 0.5 * (first + last) / min_mn);
/* Drop small rows */
stempv = (float *) tempv;
i = ilu_cdrop_row(options, first, last, tol_L, quota, &nnzLj,
&fill_tol, &Glu, stempv, swork2, 0);
/* Reset the parameters */
if (drop_rule & DROP_DYNAMIC) {
if (gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
< nnzLj)
tol_L = SUPERLU_MIN(1.0, tol_L * 2.0);
else
tol_L = SUPERLU_MAX(drop_tol, tol_L * 0.5);
}
if (fill_tol < 0) iinfo -= (int)fill_tol;
#ifdef DEBUG
num_drop_L += i * (last - first + 1);
#endif
}
/* --------------------------------------
* Factorize the relaxed supernode(jcol:kcol)
* -------------------------------------- */
/* Determine the union of the row structure of the snode */
if ( (*info = ilu_csnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
marker, &Glu)) != 0 )
return;
nextu = xusub[jcol];
nextlu = xlusup[jcol];
jsupno = supno[jcol];
fsupc = xsup[jsupno];
new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
nzlumax = Glu.nzlumax;
while ( new_next > nzlumax ) {
if ((*info = cLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, &Glu)))
return;
}
for (icol = jcol; icol <= kcol; icol++) {
xusub[icol+1] = nextu;
amax[0] = 0.0;
/* Scatter into SPA dense[*] */
for (k = xa_begin[icol]; k < xa_end[icol]; k++) {
register float tmp = c_abs1 (&a[k]);
if (tmp > amax[0]) amax[0] = tmp;
dense[asub[k]] = a[k];
}
nnzAj += xa_end[icol] - xa_begin[icol];
if (amax[0] == 0.0) {
amax[0] = fill_ini;
#if ( PRNTlevel >= 1)
printf("Column %d is entirely zero!\n", icol);
fflush(stdout);
#endif
}
/* Numeric update within the snode */
csnode_bmod(icol, jsupno, fsupc, dense, tempv, &Glu, stat);
if (usepr) pivrow = iperm_r[icol];
fill_tol = pow(fill_ini, 1.0 - (double)icol / (double)min_mn);
if ( (*info = ilu_cpivotL(icol, diag_pivot_thresh, &usepr,
perm_r, iperm_c[icol], swap, iswap,
marker_relax, &pivrow,
amax[0] * fill_tol, milu, zero,
&Glu, stat)) ) {
iinfo++;
marker[pivrow] = kcol;
}
}
jcol = kcol + 1;
} else { /* Work on one panel of panel_size columns */
/* Adjust panel_size so that a panel won't overlap with the next
* relaxed snode.
*/
panel_size = w_def;
for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
if ( relax_end[k] != EMPTY ) {
panel_size = k - jcol;
break;
}
if ( k == min_mn ) panel_size = min_mn - jcol;
panel_histo[panel_size]++;
/* symbolic factor on a panel of columns */
ilu_cpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
dense, amax, panel_lsub, segrep, repfnz,
marker, parent, xplore, &Glu);
/* numeric sup-panel updates in topological order */
cpanel_bmod(m, panel_size, jcol, nseg1, dense,
tempv, segrep, repfnz, &Glu, stat);
/* Sparse LU within the panel, and below panel diagonal */
for (jj = jcol; jj < jcol + panel_size; jj++) {
k = (jj - jcol) * m; /* column index for w-wide arrays */
nseg = nseg1; /* Begin after all the panel segments */
nnzAj += xa_end[jj] - xa_begin[jj];
if ((*info = ilu_ccolumn_dfs(m, jj, perm_r, &nseg,
&panel_lsub[k], segrep, &repfnz[k],
marker, parent, xplore, &Glu)))
return;
/* Numeric updates */
if ((*info = ccolumn_bmod(jj, (nseg - nseg1), &dense[k],
tempv, &segrep[nseg1], &repfnz[k],
jcol, &Glu, stat)) != 0) return;
/* Make a fill-in position if the column is entirely zero */
if (xlsub[jj + 1] == xlsub[jj]) {
register int i, row;
int nextl;
int nzlmax = Glu.nzlmax;
int *lsub = Glu.lsub;
int *marker2 = marker + 2 * m;
/* Allocate memory */
nextl = xlsub[jj] + 1;
if (nextl >= nzlmax) {
int error = cLUMemXpand(jj, nextl, LSUB, &nzlmax, &Glu);
if (error) { *info = error; return; }
lsub = Glu.lsub;
}
xlsub[jj + 1]++;
assert(xlusup[jj]==xlusup[jj+1]);
xlusup[jj + 1]++;
Glu.lusup[xlusup[jj]] = zero;
/* Choose a row index (pivrow) for fill-in */
for (i = jj; i < n; i++)
if (marker_relax[swap[i]] <= jj) break;
row = swap[i];
marker2[row] = jj;
lsub[xlsub[jj]] = row;
#ifdef DEBUG
printf("Fill col %d.\n", jj);
fflush(stdout);
#endif
}
/* Computer the quota */
if (drop_rule & DROP_PROWS)
quota = gamma * Astore->nnz / m * jj / m;
else if (drop_rule & DROP_COLUMN)
quota = gamma * (xa_end[jj] - xa_begin[jj]) *
(jj + 1) / m;
else if (drop_rule & DROP_AREA)
quota = gamma * 0.9 * nnzAj * 0.5 - nnzUj;
else
quota = m;
/* Copy the U-segments to ucol[*] and drop small entries */
if ((*info = ilu_ccopy_to_ucol(jj, nseg, segrep, &repfnz[k],
perm_r, &dense[k], drop_rule,
milu, amax[jj - jcol] * tol_U,
quota, &drop_sum, &nnzUj, &Glu,
swork2)) != 0)
return;
/* Reset the dropping threshold if required */
if (drop_rule & DROP_DYNAMIC) {
if (gamma * 0.9 * nnzAj * 0.5 < nnzLj)
tol_U = SUPERLU_MIN(1.0, tol_U * 2.0);
else
tol_U = SUPERLU_MAX(drop_tol, tol_U * 0.5);
}
if (drop_sum.r != 0.0 && drop_sum.i != 0.0)
{
omega = SUPERLU_MIN(2.0*(1.0-alpha)/c_abs1(&drop_sum), 1.0);
cs_mult(&drop_sum, &drop_sum, omega);
}
if (usepr) pivrow = iperm_r[jj];
fill_tol = pow(fill_ini, 1.0 - (double)jj / (double)min_mn);
if ( (*info = ilu_cpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
iperm_c[jj], swap, iswap,
marker_relax, &pivrow,
amax[jj - jcol] * fill_tol, milu,
drop_sum, &Glu, stat)) ) {
iinfo++;
marker[m + pivrow] = jj;
marker[2 * m + pivrow] = jj;
}
/* Reset repfnz[] for this column */
resetrep_col (nseg, segrep, &repfnz[k]);
/* Start a new supernode, drop the previous one */
if (jj > 0 && supno[jj] > supno[jj - 1] && jj < last_drop) {
int first = xsup[supno[jj - 1]];
int last = jj - 1;
int quota;
/* Compute the quota */
if (drop_rule & DROP_PROWS)
quota = gamma * Astore->nnz / m * (m - first) / m
* (last - first + 1);
else if (drop_rule & DROP_COLUMN) {
int i;
quota = 0;
for (i = first; i <= last; i++)
quota += xa_end[i] - xa_begin[i];
quota = gamma * quota * (m - first) / m;
} else if (drop_rule & DROP_AREA)
quota = gamma * nnzAj * (1.0 - 0.5 * (last + 1.0)
/ m) - nnzLj;
else
quota = m * n;
fill_tol = pow(fill_ini, 1.0 - 0.5 * (first + last) /
(double)min_mn);
/* Drop small rows */
stempv = (float *) tempv;
i = ilu_cdrop_row(options, first, last, tol_L, quota,
&nnzLj, &fill_tol, &Glu, stempv, swork2,
1);
/* Reset the parameters */
if (drop_rule & DROP_DYNAMIC) {
if (gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
< nnzLj)
tol_L = SUPERLU_MIN(1.0, tol_L * 2.0);
else
tol_L = SUPERLU_MAX(drop_tol, tol_L * 0.5);
}
if (fill_tol < 0) iinfo -= (int)fill_tol;
#ifdef DEBUG
num_drop_L += i * (last - first + 1);
#endif
} /* if start a new supernode */
} /* for */
jcol += panel_size; /* Move to the next panel */
} /* else */
} /* for */
*info = iinfo;
if ( m > n ) {
k = 0;
for (i = 0; i < m; ++i)
if ( perm_r[i] == EMPTY ) {
perm_r[i] = n + k;
++k;
}
}
ilu_countnz(min_mn, &nnzL, &nnzU, &Glu);
fixupL(min_mn, perm_r, &Glu);
cLUWorkFree(iwork, cwork, &Glu); /* Free work space and compress storage */
if ( fact == SamePattern_SameRowPerm ) {
/* L and U structures may have changed due to possibly different
pivoting, even though the storage is available.
There could also be memory expansions, so the array locations
may have changed, */
((SCformat *)L->Store)->nnz = nnzL;
((SCformat *)L->Store)->nsuper = Glu.supno[n];
((SCformat *)L->Store)->nzval = Glu.lusup;
((SCformat *)L->Store)->nzval_colptr = Glu.xlusup;
((SCformat *)L->Store)->rowind = Glu.lsub;
((SCformat *)L->Store)->rowind_colptr = Glu.xlsub;
((NCformat *)U->Store)->nnz = nnzU;
((NCformat *)U->Store)->nzval = Glu.ucol;
((NCformat *)U->Store)->rowind = Glu.usub;
((NCformat *)U->Store)->colptr = Glu.xusub;
} else {
cCreate_SuperNode_Matrix(L, A->nrow, min_mn, nnzL, Glu.lusup,
Glu.xlusup, Glu.lsub, Glu.xlsub, Glu.supno,
Glu.xsup, SLU_SC, SLU_C, SLU_TRLU);
cCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU, Glu.ucol,
Glu.usub, Glu.xusub, SLU_NC, SLU_C, SLU_TRU);
}
ops[FACT] += ops[TRSV] + ops[GEMV];
stat->expansions = --(Glu.num_expansions);
if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
SUPERLU_FREE (iperm_c);
SUPERLU_FREE (relax_end);
SUPERLU_FREE (swap);
SUPERLU_FREE (iswap);
SUPERLU_FREE (relax_fsupc);
SUPERLU_FREE (amax);
if ( swork2 ) SUPERLU_FREE (swork2);
}
int
pzgstrf_column_dfs(
const int pnum, /* process number */
const int m, /* number of rows in the matrix */
const int jcol, /* current column in the panel */
const int fstcol, /* first column in the panel */
int *perm_r, /* row pivotings that are done so far */
int *ispruned, /* in */
int *col_lsub, /* the RHS vector to start the dfs */
int lsub_end, /* size of col_lsub[] */
int *super_bnd,/* supernode partition by upper bound */
int *nseg, /* modified - with new segments appended */
int *segrep, /* modified - with new segments appended */
int *repfnz, /* modified */
int *xprune, /* modified */
int *marker2, /* modified */
int *parent, /* working array */
int *xplore, /* working array */
pxgstrf_shared_t *pxgstrf_shared /* modified */
)
{
/*
* -- SuperLU MT routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley,
* and Xerox Palo Alto Research Center.
* September 10, 2007
*
* Purpose
* =======
* pzgstrf_column_dfs() performs a symbolic factorization on column jcol,
* and detects whether column jcol belongs in the same supernode as jcol-1.
*
* Local parameters
* ================
* A supernode representative is the last column of a supernode.
* The nonzeros in U[*,j] are segments that end at supernodal
* representatives. The routine returns a list of such supernodal
* representatives in topological order of the dfs that generates them.
* The location of the first nonzero in each such supernodal segment
* (supernodal entry location) is also returned.
*
* nseg: no of segments in current U[*,j]
* samesuper: samesuper=NO if column j does not belong in the same
* supernode as j-1. Otherwise, samesuper=YES.
*
* marker2: A-row --> A-row/col (0/1)
* repfnz: SuperA-col --> PA-row
* parent: SuperA-col --> SuperA-col
* xplore: SuperA-col --> index to L-structure
*
* Return value
* ============
* 0 success;
* > 0 number of bytes allocated when run out of space.
*
*/
GlobalLU_t *Glu = pxgstrf_shared->Glu; /* modified */
Gstat_t *Gstat = pxgstrf_shared->Gstat; /* modified */
register int jcolm1, jcolm1size, nextl, ifrom;
register int k, krep, krow, kperm, samesuper, nsuper;
register int no_lsub;
int fsupc; /* first column in a supernode */
int myfnz; /* first nonz column in a U-segment */
int chperm, chmark, chrep, kchild;
int xdfs, maxdfs, kpar;
int ito; /* Used to compress row subscripts */
int mem_error;
int *xsup, *xsup_end, *supno, *lsub, *xlsub, *xlsub_end;
static int first = 1, maxsuper;
if ( first ) {
maxsuper = sp_ienv(3);
first = 0;
}
/* Initialize pointers */
xsup = Glu->xsup;
xsup_end = Glu->xsup_end;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
xlsub_end = Glu->xlsub_end;
jcolm1 = jcol - 1;
nextl = lsub_end;
no_lsub = 0;
samesuper = YES;
/* Test whether the row structure of column jcol is contained
in that of column jcol-1. */
for (k = 0; k < lsub_end; ++k) {
krow = col_lsub[k];
if ( perm_r[krow] == EMPTY ) { /* krow is in L */
++no_lsub;
if (marker2[krow] != jcolm1)
samesuper = NO; /* row subset test */
marker2[krow] = jcol;
}
}
#if ( DEBUGlevel>=2 )
if (jcol == BADCOL)
printf("(%d) pzgstrf_column_dfs[1] %d, fstcol %d, lsub_end %d, no_lsub %d, samesuper? %d\n",
pnum, jcol, fstcol, lsub_end, no_lsub, samesuper);
#endif
/*
* For each nonzero in A[fstcol:n,jcol] perform DFS ...
*/
for (k = 0; k < lsub_end; ++k) {
krow = col_lsub[k];
/* if krow was visited before, go to the next nonzero */
if ( marker2[krow] == jcol ) continue;
marker2[krow] = jcol;
kperm = perm_r[krow];
#if ( DEBUGlevel>=3 )
if (jcol == BADCOL)
printf("(%d) pzgstrf_column_dfs[inner]: perm_r[krow=%d] %d\n", pnum, krow, kperm);
#endif
/* Ignore the nonzeros in U corresponding to the busy columns
during the panel DFS. */
/*if ( lbusy[kperm] != fstcol ) { xiaoye? */
if ( kperm >= fstcol ) {
/*
* krow is in U: if its supernode representative krep
* has been explored, update repfnz[*].
*/
krep = SUPER_REP(supno[kperm]);
myfnz = repfnz[krep];
#if ( DEBUGlevel>=3 )
if (jcol == BADCOL)
printf("(%d) pzgstrf_column_dfs[inner-U]: krep %d, myfnz %d, kperm %d\n",
pnum, krep, myfnz, kperm);
#endif
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > kperm ) repfnz[krep] = kperm;
/* continue; */
} else {
/* Otherwise, perform dfs starting at krep */
parent[krep] = EMPTY;
repfnz[krep] = kperm;
if ( ispruned[krep] ) {
if ( SINGLETON( supno[krep] ) )
xdfs = xlsub_end[krep];
else xdfs = xlsub[krep];
maxdfs = xprune[krep];
#ifdef PROFILE
Gstat->procstat[pnum].pruned++;
#endif
} else {
fsupc = SUPER_FSUPC( supno[krep] );
xdfs = xlsub[fsupc] + krep-fsupc+1;
maxdfs = xlsub_end[fsupc];
#ifdef PROFILE
Gstat->procstat[pnum].unpruned++;
#endif
}
do {
/*
* For each unmarked kchild of krep ...
*/
while ( xdfs < maxdfs ) {
kchild = lsub[xdfs];
xdfs++;
chmark = marker2[kchild];
if ( chmark != jcol ) { /* Not reached yet */
marker2[kchild] = jcol;
chperm = perm_r[kchild];
if ( chperm == EMPTY ) {
/* kchild is in L: place it in L[*,k]. */
++no_lsub;
col_lsub[nextl++] = kchild;
if (chmark != jcolm1) samesuper = NO;
} else {
/* kchild is in U: chrep = its supernode
* representative. If its rep has
* been explored, update its repfnz[*].
*/
chrep = SUPER_REP( supno[chperm] );
myfnz = repfnz[chrep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > chperm )
repfnz[chrep] = chperm;
} else {
/* Continue dfs at super-rep of kchild */
xplore[krep] = xdfs;
xplore[m + krep] = maxdfs;
parent[chrep] = krep;
krep = chrep; /* Go deeper down G(L^t) */
repfnz[krep] = chperm;
if ( ispruned[krep] ) {
if ( SINGLETON( supno[krep] ) )
xdfs = xlsub_end[krep];
else xdfs = xlsub[krep];
maxdfs = xprune[krep];
#ifdef PROFILE
Gstat->procstat[pnum].pruned++;
#endif
} else {
fsupc = SUPER_FSUPC( supno[krep] );
xdfs = xlsub[fsupc] + krep-fsupc+1;
maxdfs = xlsub_end[fsupc];
#ifdef PROFILE
Gstat->procstat[pnum].unpruned++;
#endif
}
}
} /* else */
} /* if */
} /* while */
/* krow has no more unexplored nbrs:
* place supernode-rep krep in postorder DFS,
* backtrack dfs to its parent.
*/
segrep[*nseg] = krep;
++(*nseg);
#if ( DEBUGlevel>=3 )
if (jcol == BADCOL)
printf("(%d) pzgstrf_column_dfs[inner-dfs] new nseg %d, repfnz[krep=%d] %d\n",
pnum, *nseg, krep, repfnz[krep]);
#endif
kpar = parent[krep]; /* Pop from stack, mimic recursion */
if ( kpar == EMPTY ) break; /* dfs done */
krep = kpar;
xdfs = xplore[krep];
maxdfs = xplore[m + krep];
} while ( kpar != EMPTY ); /* Do ... until empty stack */
} /* else myfnz ... */
} /* if kperm >= fstcol ... */
} /* for each nonzero ... */
#if ( DEBUGlevel>=3 )
if (jcol == BADCOL)
printf("(%d) pzgstrf_column_dfs[2]: nextl %d, samesuper? %d\n",
pnum, nextl, samesuper);
#endif
/* assert(no_lsub == nextl - no_usub);*/
/* ---------------------------------------------------------
Check to see if j belongs in the same supernode as j-1.
--------------------------------------------------------- */
/* Does it matter if jcol == 0? - xiaoye */
if ( samesuper == YES ) {
nsuper = supno[jcolm1];
jcolm1size = xlsub_end[jcolm1] - xlsub[jcolm1];
#if ( DEBUGlevel>=3 )
if (jcol == BADCOL)
printf("(%d) pzgstrf_column_dfs[YES] jcol-1 %d, jcolm1size %d, supno[%d] %d\n",
pnum, jcolm1, jcolm1size, jcolm1, nsuper);
#endif
if ( no_lsub != jcolm1size-1 )
samesuper = NO; /* Enforce T2 supernode */
else {
/* Make sure the number of columns in a supernode does not
exceed threshold. */
fsupc = xsup[nsuper];
if ( jcol - fsupc >= maxsuper )
samesuper = NO;
else {
/* start of a supernode in H (coarser partition) */
if ( super_bnd[jcol] != 0 ) samesuper = NO;
}
}
}
/* If jcol starts a new supernode, allocate storage for
* the subscript set of both first and last column of
* a previous supernode. (first for num values, last for pruning)
*/
if ( samesuper == NO ) { /* starts a new supernode */
nsuper = NewNsuper(pnum, pxgstrf_shared, &Glu->nsuper);
xsup[nsuper] = jcol;
/* Copy column jcol; also reserve space to store pruned graph */
if ((mem_error = Glu_alloc(pnum, jcol, 2*no_lsub, LSUB, &ito,
pxgstrf_shared)))
return mem_error;
xlsub[jcol] = ito;
lsub = Glu->lsub;
for (ifrom = 0; ifrom < nextl; ++ifrom) {
krow = col_lsub[ifrom];
if ( perm_r[krow] == EMPTY ) /* Filter U-subscript */
lsub[ito++] = krow;
}
k = ito;
xlsub_end[jcol] = k;
/* Make a copy in case it is a singleton supernode */
for (ifrom = xlsub[jcol]; ifrom < ito; ++ifrom)
lsub[k++] = lsub[ifrom];
} else { /* Supernode of size > 1: overwrite column jcol-1 */
k = xlsub_end[fsupc];
xlsub[jcol] = k;
xprune[fsupc] = k;
for (ifrom = 0; ifrom < nextl; ++ifrom) {
krow = col_lsub[ifrom];
if ( perm_r[krow] == EMPTY ) /* Filter U-subscript */
lsub[k++] = krow;
}
xlsub_end[jcol] = k;
}
#if ( DEBUGlevel>=3 )
if (jcol == BADCOL) {
printf("(%d) pzgstrf_column_dfs[3]: %d in prev s-node %d? %d\n",
pnum, jcol, fsupc, samesuper);
PrintInt10("lsub", xlsub_end[jcol]-xlsub[jcol], &lsub[xlsub[jcol]]);
}
#endif
/* Tidy up the pointers before exit */
xprune[jcol] = k; /* upper bound for pruning */
supno[jcol] = nsuper;
xsup_end[nsuper] = jcol + 1;
return 0;
}
/*! \brief
*
* <pre>
* Purpose
* =======
* ILU_SCOLUMN_DFS performs a symbolic factorization on column jcol, and
* decide the supernode boundary.
*
* This routine does not use numeric values, but only use the RHS
* row indices to start the dfs.
*
* A supernode representative is the last column of a supernode.
* The nonzeros in U[*,j] are segments that end at supernodal
* representatives. The routine returns a list of such supernodal
* representatives in topological order of the dfs that generates them.
* The location of the first nonzero in each such supernodal segment
* (supernodal entry location) is also returned.
*
* Local parameters
* ================
* nseg: no of segments in current U[*,j]
* jsuper: jsuper=EMPTY if column j does not belong to the same
* supernode as j-1. Otherwise, jsuper=nsuper.
*
* marker2: A-row --> A-row/col (0/1)
* repfnz: SuperA-col --> PA-row
* parent: SuperA-col --> SuperA-col
* xplore: SuperA-col --> index to L-structure
*
* Return value
* ============
* 0 success;
* > 0 number of bytes allocated when run out of space.
* </pre>
*/
int
ilu_scolumn_dfs(
const int m, /* in - number of rows in the matrix */
const int jcol, /* in */
int *perm_r, /* in */
int *nseg, /* modified - with new segments appended */
int *lsub_col, /* in - defines the RHS vector to start the
dfs */
int *segrep, /* modified - with new segments appended */
int *repfnz, /* modified */
int *marker, /* modified */
int *parent, /* working array */
int *xplore, /* working array */
GlobalLU_t *Glu /* modified */
)
{
int jcolp1, jcolm1, jsuper, nsuper, nextl;
int k, krep, krow, kmark, kperm;
int *marker2; /* Used for small panel LU */
int fsupc; /* First column of a snode */
int myfnz; /* First nonz column of a U-segment */
int chperm, chmark, chrep, kchild;
int xdfs, maxdfs, kpar, oldrep;
int jptr, jm1ptr;
int ito, ifrom; /* Used to compress row subscripts */
int mem_error;
int *xsup, *supno, *lsub, *xlsub;
int nzlmax;
static int first = 1, maxsuper;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
nzlmax = Glu->nzlmax;
if ( first ) {
maxsuper = sp_ienv(3);
first = 0;
}
jcolp1 = jcol + 1;
jcolm1 = jcol - 1;
nsuper = supno[jcol];
jsuper = nsuper;
nextl = xlsub[jcol];
marker2 = &marker[2*m];
/* For each nonzero in A[*,jcol] do dfs */
for (k = 0; lsub_col[k] != EMPTY; k++) {
krow = lsub_col[k];
lsub_col[k] = EMPTY;
kmark = marker2[krow];
/* krow was visited before, go to the next nonzero */
if ( kmark == jcol ) continue;
/* For each unmarked nbr krow of jcol
* krow is in L: place it in structure of L[*,jcol]
*/
marker2[krow] = jcol;
kperm = perm_r[krow];
if ( kperm == EMPTY ) {
lsub[nextl++] = krow; /* krow is indexed into A */
if ( nextl >= nzlmax ) {
if ((mem_error = sLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu)))
return (mem_error);
lsub = Glu->lsub;
}
if ( kmark != jcolm1 ) jsuper = EMPTY;/* Row index subset testing */
} else {
/* krow is in U: if its supernode-rep krep
* has been explored, update repfnz[*]
*/
krep = xsup[supno[kperm]+1] - 1;
myfnz = repfnz[krep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > kperm ) repfnz[krep] = kperm;
/* continue; */
}
else {
/* Otherwise, perform dfs starting at krep */
oldrep = EMPTY;
parent[krep] = oldrep;
repfnz[krep] = kperm;
xdfs = xlsub[xsup[supno[krep]]];
maxdfs = xlsub[krep + 1];
do {
/*
* For each unmarked kchild of krep
*/
while ( xdfs < maxdfs ) {
kchild = lsub[xdfs];
xdfs++;
chmark = marker2[kchild];
if ( chmark != jcol ) { /* Not reached yet */
marker2[kchild] = jcol;
chperm = perm_r[kchild];
/* Case kchild is in L: place it in L[*,k] */
if ( chperm == EMPTY ) {
lsub[nextl++] = kchild;
if ( nextl >= nzlmax ) {
if ( (mem_error = sLUMemXpand(jcol,nextl,
LSUB,&nzlmax,Glu)) )
return (mem_error);
lsub = Glu->lsub;
}
if ( chmark != jcolm1 ) jsuper = EMPTY;
} else {
/* Case kchild is in U:
* chrep = its supernode-rep. If its rep has
* been explored, update its repfnz[*]
*/
chrep = xsup[supno[chperm]+1] - 1;
myfnz = repfnz[chrep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > chperm )
repfnz[chrep] = chperm;
} else {
/* Continue dfs at super-rep of kchild */
xplore[krep] = xdfs;
oldrep = krep;
krep = chrep; /* Go deeper down G(L^t) */
parent[krep] = oldrep;
repfnz[krep] = chperm;
xdfs = xlsub[xsup[supno[krep]]];
maxdfs = xlsub[krep + 1];
} /* else */
} /* else */
} /* if */
} /* while */
/* krow has no more unexplored nbrs;
* place supernode-rep krep in postorder DFS.
* backtrack dfs to its parent
*/
segrep[*nseg] = krep;
++(*nseg);
kpar = parent[krep]; /* Pop from stack, mimic recursion */
if ( kpar == EMPTY ) break; /* dfs done */
krep = kpar;
xdfs = xplore[krep];
maxdfs = xlsub[krep + 1];
} while ( kpar != EMPTY ); /* Until empty stack */
} /* else */
} /* else */
} /* for each nonzero ... */
/* Check to see if j belongs in the same supernode as j-1 */
if ( jcol == 0 ) { /* Do nothing for column 0 */
nsuper = supno[0] = 0;
} else {
fsupc = xsup[nsuper];
jptr = xlsub[jcol]; /* Not compressed yet */
jm1ptr = xlsub[jcolm1];
if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = EMPTY;
/* Always start a new supernode for a singular column */
if ( nextl == jptr ) jsuper = EMPTY;
/* Make sure the number of columns in a supernode doesn't
exceed threshold. */
if ( jcol - fsupc >= maxsuper ) jsuper = EMPTY;
/* If jcol starts a new supernode, reclaim storage space in
* lsub from the previous supernode. Note we only store
* the subscript set of the first columns of the supernode.
*/
if ( jsuper == EMPTY ) { /* starts a new supernode */
if ( (fsupc < jcolm1) ) { /* >= 2 columns in nsuper */
#ifdef CHK_COMPRESS
printf(" Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
#endif
ito = xlsub[fsupc+1];
xlsub[jcolm1] = ito;
xlsub[jcol] = ito;
for (ifrom = jptr; ifrom < nextl; ++ifrom, ++ito)
lsub[ito] = lsub[ifrom];
nextl = ito;
}
nsuper++;
supno[jcol] = nsuper;
} /* if a new supernode */
} /* else: jcol > 0 */
/* Tidy up the pointers before exit */
xsup[nsuper+1] = jcolp1;
supno[jcolp1] = nsuper;
xlsub[jcolp1] = nextl;
return 0;
}
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);
}
}
void
psgstrf_panel_bmod(
const int pnum, /* process number */
const int m, /* number of rows in the matrix */
const int w, /* current panel width */
const int jcol, /* leading column of the current panel */
const int bcol, /* first column of the farthest busy snode*/
int *inv_perm_r,/* in; inverse of the row pivoting */
int *etree, /* in */
int *nseg, /* modified */
int *segrep, /* modified */
int *repfnz, /* modified, size n-by-w */
int *panel_lsub,/* modified */
int *w_lsub_end,/* modified */
int *spa_marker,/* modified; size n-by-w */
float *dense, /* modified, size n-by-w */
float *tempv, /* working array - zeros on input/output */
pxgstrf_shared_t *pxgstrf_shared /* modified */
)
{
/*
* -- SuperLU MT routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley,
* and Xerox Palo Alto Research Center.
* September 10, 2007
*
* Purpose
* =======
*
* Performs numeric block updates (sup-panel) in topological order.
* It features combined 1D and 2D blocking of the source updating s-node.
* It consists of two steps:
* (1) accumulates updates from "done" s-nodes.
* (2) accumulates updates from "busy" s-nodes.
*
* Before entering this routine, the nonzeros of the original A in
* this panel were already copied into the SPA dense[n,w].
*
* Updated/Output arguments
* ========================
* L[*,j:j+w-1] and U[*,j:j+w-1] are returned collectively in the
* m-by-w vector dense[*,w]. The locations of nonzeros in L[*,j:j+w-1]
* are given by lsub[*] and U[*,j:j+w-1] by (nseg,segrep,repfnz).
*
*/
GlobalLU_t *Glu = pxgstrf_shared->Glu; /* modified */
Gstat_t *Gstat = pxgstrf_shared->Gstat; /* modified */
register int j, k, ksub;
register int fsupc, nsupc, nsupr, nrow;
register int kcol, krep, ksupno, dadsupno;
register int jj; /* index through each column in the panel */
int *xsup, *xsup_end, *supno;
int *lsub, *xlsub, *xlsub_end;
int *repfnz_col; /* repfnz[] for a column in the panel */
float *dense_col; /* dense[] for a column in the panel */
int *col_marker; /* each column of the spa_marker[*,w] */
int *col_lsub; /* each column of the panel_lsub[*,w] */
static int first = 1, rowblk, colblk;
#ifdef PROFILE
double t1, t2; /* temporary time */
#endif
#ifdef PREDICT_OPT
register float pmod, max_child_eft = 0, sum_pmod = 0, min_desc_eft = 0;
register float pmod_eft;
register int kid, ndesc = 0;
#endif
#if ( DEBUGlevel>=2 )
int dbg_addr = 0*m;
#endif
if ( first ) {
rowblk = sp_ienv(4);
colblk = sp_ienv(5);
first = 0;
}
xsup = Glu->xsup;
xsup_end = Glu->xsup_end;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
xlsub_end = Glu->xlsub_end;
#if ( DEBUGlevel>=2 )
/*if (jcol >= LOCOL && jcol <= HICOL)
check_panel_dfs_list(pnum, "begin", jcol, *nseg, segrep);*/
if (jcol == BADPAN)
printf("(%d) Enter psgstrf_panel_bmod() jcol %d,BADCOL %d,dense_col[%d] %.10f\n",
pnum, jcol, BADCOL, BADROW, dense[dbg_addr+BADROW]);
#endif
/* --------------------------------------------------------------------
For each non-busy supernode segment of U[*,jcol] in topological order,
perform sup-panel update.
-------------------------------------------------------------------- */
k = *nseg - 1;
for (ksub = 0; ksub < *nseg; ++ksub) {
/*
* krep = representative of current k-th supernode
* fsupc = first supernodal column
* nsupc = no of columns in a supernode
* nsupr = no of rows in a supernode
*/
krep = segrep[k--];
fsupc = xsup[supno[krep]];
nsupc = krep - fsupc + 1;
nsupr = xlsub_end[fsupc] - xlsub[fsupc];
nrow = nsupr - nsupc;
#ifdef PREDICT_OPT
pmod = Gstat->procstat[pnum].fcops;
#endif
if ( nsupc >= colblk && nrow >= rowblk ) {
/* 2-D block update */
#ifdef GEMV2
psgstrf_bmod2D_mv2(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr,
nrow, repfnz, panel_lsub, w_lsub_end,
spa_marker, dense, tempv, Glu, Gstat);
#else
psgstrf_bmod2D(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr, nrow,
repfnz, panel_lsub, w_lsub_end, spa_marker,
dense, tempv, Glu, Gstat);
#endif
} else {
/* 1-D block update */
#ifdef GEMV2
psgstrf_bmod1D_mv2(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr,
nrow, repfnz, panel_lsub, w_lsub_end,
spa_marker, dense, tempv, Glu, Gstat);
#else
psgstrf_bmod1D(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr, nrow,
repfnz, panel_lsub, w_lsub_end, spa_marker,
dense, tempv, Glu, Gstat);
#endif
}
#ifdef PREDICT_OPT
pmod = Gstat->procstat[pnum].fcops - pmod;
kid = (Glu->pan_status[krep].size > 0) ?
krep : (krep + Glu->pan_status[krep].size);
desc_eft[ndesc].eft = cp_panel[kid].est + cp_panel[kid].pdiv;
desc_eft[ndesc++].pmod = pmod;
#endif
#if ( DEBUGlevel>=2 )
if (jcol == BADPAN)
printf("(%d) non-busy update: krep %d, repfnz %d, dense_col[%d] %.10e\n",
pnum, krep, repfnz[dbg_addr+krep], BADROW, dense[dbg_addr+BADROW]);
#endif
} /* for each updating supernode ... */
#if ( DEBUGlevel>=2 )
if (jcol == BADPAN)
printf("(%d) After non-busy update: dense_col[%d] %.10e\n",
pnum, BADROW, dense[dbg_addr+BADROW]);
#endif
/* ---------------------------------------------------------------------
* Now wait for the "busy" s-nodes to become "done" -- this amounts to
* climbing up the e-tree along the path starting from "bcol".
* Several points are worth noting:
*
* (1) There are two possible relations between supernodes and panels
* along the path of the e-tree:
* o |s-node| < |panel|
* want to climb up the e-tree one column at a time in order
* to achieve more concurrency
* o |s-node| > |panel|
* want to climb up the e-tree one panel at a time; this
* processor is stalled anyway while waiting for the panel.
*
* (2) Need to accommodate new fills, append them in panel_lsub[*,w].
* o use an n-by-w marker array, as part of the SPA (not scalable!)
*
* (3) Symbolically, need to find out repfnz[S, w], for each (busy)
* supernode S.
* o use dense[inv_perm_r[kcol]], filter all zeros
* o detect the first nonzero in each segment
* (at this moment, the boundary of the busy supernode/segment
* S has already been identified)
*
* --------------------------------------------------------------------- */
kcol = bcol;
while ( kcol < jcol ) {
/* Pointers to each column of the w-wide arrays. */
repfnz_col = repfnz;
dense_col = dense;
col_marker = spa_marker;
col_lsub = panel_lsub;
/* Wait for the supernode, and collect wait-time statistics. */
if ( pxgstrf_shared->spin_locks[kcol] ) {
#ifdef PROFILE
TIC(t1);
#endif
await( &pxgstrf_shared->spin_locks[kcol] );
#ifdef PROFILE
TOC(t2, t1);
Gstat->panstat[jcol].pipewaits++;
Gstat->panstat[jcol].spintime += t2;
Gstat->procstat[pnum].spintime += t2;
#ifdef DOPRINT
PRINT_SPIN_TIME(1);
#endif
#endif
}
/* Find leading column "fsupc" in the supernode that
contains column "kcol" */
ksupno = supno[kcol];
fsupc = kcol;
#if ( DEBUGlevel>=2 )
/*if (jcol >= LOCOL && jcol <= HICOL) */
if ( jcol==BADCOL )
printf("(%d) psgstrf_panel_bmod[1] kcol %d, ksupno %d, fsupc %d\n",
pnum, kcol, ksupno, fsupc);
#endif
/* Wait for the whole supernode to become "done" --
climb up e-tree one column at a time */
do {
krep = SUPER_REP( ksupno );
kcol = etree[kcol];
if ( kcol >= jcol ) break;
if ( pxgstrf_shared->spin_locks[kcol] ) {
#ifdef PROFILE
TIC(t1);
#endif
await ( &pxgstrf_shared->spin_locks[kcol] );
#ifdef PROFILE
TOC(t2, t1);
Gstat->panstat[jcol].pipewaits++;
Gstat->panstat[jcol].spintime += t2;
Gstat->procstat[pnum].spintime += t2;
#ifdef DOPRINT
PRINT_SPIN_TIME(2);
#endif
#endif
}
dadsupno = supno[kcol];
#if ( DEBUGlevel>=2 )
/*if (jcol >= LOCOL && jcol <= HICOL)*/
if ( jcol==BADCOL )
printf("(%d) psgstrf_panel_bmod[2] krep %d, dad=kcol %d, dadsupno %d\n",
pnum, krep, kcol, dadsupno);
#endif
} while ( dadsupno == ksupno );
/* Append the new segment into segrep[*]. After column_bmod(),
copy_to_ucol() will use them. */
segrep[*nseg] = krep;
++(*nseg);
/* Determine repfnz[krep, w] for each column in the panel */
for (jj = jcol; jj < jcol + w; ++jj, dense_col += m,
repfnz_col += m, col_marker += m, col_lsub += m) {
/*
* Note: relaxed supernode may not form a path on the e-tree,
* but its column numbers are contiguous.
*/
#ifdef SCATTER_FOUND
for (kcol = fsupc; kcol <= krep; ++kcol) {
if ( col_marker[inv_perm_r[kcol]] == jj ) {
repfnz_col[krep] = kcol;
/* Append new fills in panel_lsub[*,jj]. */
j = w_lsub_end[jj - jcol];
/*#pragma ivdep*/
for (k = xlsub[krep]; k < xlsub_end[krep]; ++k) {
ksub = lsub[k];
if ( col_marker[ksub] != jj ) {
col_marker[ksub] = jj;
col_lsub[j++] = ksub;
}
}
w_lsub_end[jj - jcol] = j;
break; /* found the leading nonzero in the segment */
}
}
#else
for (kcol = fsupc; kcol <= krep; ++kcol) {
if ( dense_col[inv_perm_r[kcol]] != 0.0 ) {
repfnz_col[krep] = kcol;
break; /* Found the leading nonzero in the U-segment */
}
}
/* In this case, we always treat the L-subscripts of the
busy s-node [kcol : krep] as the new fills, even if the
corresponding U-segment may be all zero. */
/* Append new fills in panel_lsub[*,jj]. */
j = w_lsub_end[jj - jcol];
/*#pragma ivdep*/
for (k = xlsub[krep]; k < xlsub_end[krep]; ++k) {
ksub = lsub[k];
if ( col_marker[ksub] != jj ) {
col_marker[ksub] = jj;
col_lsub[j++] = ksub;
}
}
w_lsub_end[jj - jcol] = j;
#endif
#if ( DEBUGlevel>=2 )
if (jj == BADCOL) {
printf("(%d) psgstrf_panel_bmod[fills]: jj %d, repfnz_col[%d] %d, inv_pr[%d] %d\n",
pnum, jj, krep, repfnz_col[krep], fsupc, inv_perm_r[fsupc]);
printf("(%d) psgstrf_panel_bmod[fills] xlsub %d, xlsub_end %d, #lsub[%d] %d\n",
pnum,xlsub[krep],xlsub_end[krep],krep, xlsub_end[krep]-xlsub[krep]);
}
#endif
} /* for jj ... */
#ifdef PREDICT_OPT
pmod = Gstat->procstat[pnum].fcops;
#endif
/* Perform sup-panel updates - use combined 1D + 2D updates. */
nsupc = krep - fsupc + 1;
nsupr = xlsub_end[fsupc] - xlsub[fsupc];
nrow = nsupr - nsupc;
if ( nsupc >= colblk && nrow >= rowblk ) {
/* 2-D block update */
#ifdef GEMV2
psgstrf_bmod2D_mv2(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr,
nrow, repfnz, panel_lsub, w_lsub_end,
spa_marker, dense, tempv, Glu, Gstat);
#else
psgstrf_bmod2D(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr, nrow,
repfnz, panel_lsub, w_lsub_end, spa_marker,
dense, tempv, Glu, Gstat);
#endif
} else {
/* 1-D block update */
#ifdef GEMV2
psgstrf_bmod1D_mv2(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr,
nrow, repfnz, panel_lsub, w_lsub_end,
spa_marker, dense, tempv, Glu, Gstat);
#else
psgstrf_bmod1D(pnum, m, w, jcol, fsupc, krep, nsupc, nsupr, nrow,
repfnz, panel_lsub, w_lsub_end, spa_marker,
dense, tempv, Glu, Gstat);
#endif
}
#ifdef PREDICT_OPT
pmod = Gstat->procstat[pnum].fcops - pmod;
kid = (pxgstrf_shared->pan_status[krep].size > 0) ?
krep : (krep + pxgstrf_shared->pan_status[krep].size);
desc_eft[ndesc].eft = cp_panel[kid].est + cp_panel[kid].pdiv;
desc_eft[ndesc++].pmod = pmod;
#endif
#if ( DEBUGlevel>=2 )
if (jcol == BADPAN)
printf("(%d) After busy update: dense_col[%d] %.10f\n",
pnum, BADROW, dense[dbg_addr+BADROW]);
#endif
/* Go to the parent of "krep" */
kcol = etree[krep];
} /* while kcol < jcol ... */
#if ( DEBUGlevel>=2 )
/*if (jcol >= LOCOL && jcol <= HICOL)*/
if ( jcol==BADCOL )
check_panel_dfs_list(pnum, "after-busy", jcol, *nseg, segrep);
#endif
#ifdef PREDICT_OPT
qsort(desc_eft, ndesc, sizeof(desc_eft_t), (int(*)())numcomp);
pmod_eft = 0;
for (j = 0; j < ndesc; ++j) {
pmod_eft = SUPERLU_MAX( pmod_eft, desc_eft[j].eft ) + desc_eft[j].pmod;
}
if ( ndesc == 0 ) {
/* No modifications from descendants */
pmod_eft = 0;
for (j = cp_firstkid[jcol]; j != EMPTY; j = cp_nextkid[j]) {
kid = (pxgstrf_shared->pan_status[j].size > 0) ?
j : (j + pxgstrf_shared->pan_status[j].size);
pmod_eft = SUPERLU_MAX( pmod_eft,
cp_panel[kid].est + cp_panel[kid].pdiv );
}
}
cp_panel[jcol].est = pmod_eft;
#endif
}
void
zgsisx(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,
mem_usage_t *mem_usage, SuperLUStat_t *stat, int *info)
{
DNformat *Bstore, *Xstore;
doublecomplex *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, 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;
/* External functions */
extern double zlangs(char *, SuperMatrix *);
Bstore = B->Store;
Xstore = X->Store;
Bmat = Bstore->nzval;
Xmat = 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);
mc64 = (options->RowPerm == LargeDiag);
if ( nofact ) {
*(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 && 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_Z || A->Mtype != SLU_GE )
*info = -2;
else if (options->Fact == FACTORED &&
!(rowequ || colequ || 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_Z ||
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_Z || X->Mtype != SLU_GE )
*info = -14;
}
}
if (*info != 0) {
i = -(*info);
xerbla_("zgsisx", &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) );
zCreate_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;
doublecomplex *nzval = (doublecomplex *)Astore->nzval;
int n = AA->nrow;
if ( mc64 ) {
*equed = 'B';
rowequ = colequ = 1;
t0 = SuperLU_timer_();
if ((perm = intMalloc(n)) == NULL)
ABORT("SUPERLU_MALLOC fails for perm[]");
info1 = zldperm(5, n, nnz, colptr, rowind, nzval, perm, R, C);
if (info1 > 0) { /* MC64 fails, call zgsequ() later */
mc64 = 0;
SUPERLU_FREE(perm);
perm = NULL;
} else {
for (i = 0; i < n; i++) {
R[i] = exp(R[i]);
C[i] = exp(C[i]);
}
/* permute and scale the matrix */
for (j = 0; j < n; j++) {
for (i = colptr[j]; i < colptr[j + 1]; i++) {
zd_mult(&nzval[i], &nzval[i], R[rowind[i]] * C[j]);
rowind[i] = perm[rowind[i]];
}
}
}
utime[EQUIL] = SuperLU_timer_() - t0;
}
if ( !mc64 & equil ) {
t0 = SuperLU_timer_();
/* Compute row and column scalings to equilibrate the matrix A. */
zgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
if ( info1 == 0 ) {
/* Equilibrate matrix A. */
zlaqgs(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;
}
}
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) {
zd_mult(&Bmat[i+j*ldb], &Bmat[i+j*ldb], R[i]);
}
}
} else if ( colequ ) {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
zd_mult(&Bmat[i+j*ldb], &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;
/* Compute the LU factorization of A*Pc. */
t0 = SuperLU_timer_();
zgsitrf(options, &AC, 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 ) return;
/* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
*recip_pivot_growth = zPivotGrowth(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 = zlangs(norm, AA);
zgscon(norm, L, U, anorm, rcond, stat, &info1);
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_();
zgstrs (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 < A->nrow; ++i) {
zd_mult(&Xmat[i+j*ldx], &Xmat[i+j*ldx], C[i]);
}
}
} else {
if ( rowequ ) {
if (perm) {
doublecomplex *tmp;
int n = A->nrow;
if ((tmp = doublecomplexMalloc(n)) == NULL)
ABORT("SUPERLU_MALLOC fails for tmp[]");
for (j = 0; j < nrhs; j++) {
for (i = 0; i < n; i++)
tmp[i] = Xmat[i + j * ldx]; /*dcopy*/
for (i = 0; i < n; i++)
zd_mult(&Xmat[i+j*ldx], &tmp[perm[i]], R[i]);
}
SUPERLU_FREE(tmp);
} else {
for (j = 0; j < nrhs; ++j)
for (i = 0; i < A->nrow; ++i) {
zd_mult(&Xmat[i+j*ldx], &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 < dlamch_("E") && *info == 0) *info = A->ncol + 1;
}
if (perm) SUPERLU_FREE(perm);
if ( nofact ) {
ilu_zQuerySpace(L, U, mem_usage);
Destroy_CompCol_Permuted(&AC);
}
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
}
int
dcolumn_dfs(
const int m, /* in - number of rows in the matrix */
const int jcol, /* in */
int *perm_r, /* in */
int *nseg, /* modified - with new segments appended */
int *lsub_col, /* in - defines the RHS vector to start the dfs */
int *segrep, /* modified - with new segments appended */
int *repfnz, /* modified */
int *xprune, /* modified */
int *marker, /* modified */
int *parent, /* working array */
int *xplore, /* working array */
GlobalLU_t *Glu /* modified */
)
{
/*
* Purpose
* =======
* "column_dfs" performs a symbolic factorization on column jcol, and
* decide the supernode boundary.
*
* This routine does not use numeric values, but only use the RHS
* row indices to start the dfs.
*
* A supernode representative is the last column of a supernode.
* The nonzeros in U[*,j] are segments that end at supernodal
* representatives. The routine returns a list of such supernodal
* representatives in topological order of the dfs that generates them.
* The location of the first nonzero in each such supernodal segment
* (supernodal entry location) is also returned.
*
* Local parameters
* ================
* nseg: no of segments in current U[*,j]
* jsuper: jsuper=NO if column j does not belong to the same
* supernode as j-1. Otherwise, jsuper=nsuper.
*
* marker2: A-row --> A-row/col (0/1)
* repfnz: SuperA-col --> PA-row
* parent: SuperA-col --> SuperA-col
* xplore: SuperA-col --> index to L-structure
*
* Return value
* ============
* 0 success;
* > 0 number of bytes allocated when run out of space.
*
*/
int jcolp1, jcolm1, jsuper, nsuper, nextl;
int k, krep, krow, kmark, kperm;
int *marker2; /* Used for small panel LU */
int fsupc; /* First column of a snode */
int myfnz; /* First nonz column of a U-segment */
int chperm, chmark, chrep, kchild;
int xdfs, maxdfs, kpar, oldrep;
int jptr, jm1ptr;
int ito, ifrom, istop; /* Used to compress row subscripts */
int mem_error;
int *xsup, *supno, *lsub, *xlsub;
int nzlmax;
static int first = 1, maxsuper;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
nzlmax = Glu->nzlmax;
if ( first ) {
maxsuper = sp_ienv(3);
first = 0;
}
jcolp1 = jcol + 1;
jcolm1 = jcol - 1;
nsuper = supno[jcol];
jsuper = nsuper;
nextl = xlsub[jcol];
marker2 = &marker[2*m];
/* For each nonzero in A[*,jcol] do dfs */
for (k = 0; lsub_col[k] != EMPTY; k++) {
krow = lsub_col[k];
lsub_col[k] = EMPTY;
kmark = marker2[krow];
/* krow was visited before, go to the next nonz */
if ( kmark == jcol ) continue;
/* For each unmarked nbr krow of jcol
* krow is in L: place it in structure of L[*,jcol]
*/
marker2[krow] = jcol;
kperm = perm_r[krow];
if ( kperm == EMPTY ) {
lsub[nextl++] = krow; /* krow is indexed into A */
if ( nextl >= nzlmax ) {
if ( mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
return (mem_error);
lsub = Glu->lsub;
}
if ( kmark != jcolm1 ) jsuper = NO; /* Row index subset testing */
} else {
/* krow is in U: if its supernode-rep krep
* has been explored, update repfnz[*]
*/
krep = xsup[supno[kperm]+1] - 1;
myfnz = repfnz[krep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > kperm ) repfnz[krep] = kperm;
/* continue; */
}
else {
/* Otherwise, perform dfs starting at krep */
oldrep = EMPTY;
parent[krep] = oldrep;
repfnz[krep] = kperm;
xdfs = xlsub[krep];
maxdfs = xprune[krep];
do {
/*
* For each unmarked kchild of krep
*/
while ( xdfs < maxdfs ) {
kchild = lsub[xdfs];
xdfs++;
chmark = marker2[kchild];
if ( chmark != jcol ) { /* Not reached yet */
marker2[kchild] = jcol;
chperm = perm_r[kchild];
/* Case kchild is in L: place it in L[*,k] */
if ( chperm == EMPTY ) {
lsub[nextl++] = kchild;
if ( nextl >= nzlmax ) {
if ( mem_error =
dLUMemXpand(jcol,nextl,LSUB,&nzlmax,Glu) )
return (mem_error);
lsub = Glu->lsub;
}
if ( chmark != jcolm1 ) jsuper = NO;
} else {
/* Case kchild is in U:
* chrep = its supernode-rep. If its rep has
* been explored, update its repfnz[*]
*/
chrep = xsup[supno[chperm]+1] - 1;
myfnz = repfnz[chrep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > chperm )
repfnz[chrep] = chperm;
} else {
/* Continue dfs at super-rep of kchild */
xplore[krep] = xdfs;
oldrep = krep;
krep = chrep; /* Go deeper down G(L^t) */
parent[krep] = oldrep;
repfnz[krep] = chperm;
xdfs = xlsub[krep];
maxdfs = xprune[krep];
} /* else */
} /* else */
} /* if */
} /* while */
/* krow has no more unexplored nbrs;
* place supernode-rep krep in postorder DFS.
* backtrack dfs to its parent
*/
segrep[*nseg] = krep;
++(*nseg);
kpar = parent[krep]; /* Pop from stack, mimic recursion */
if ( kpar == EMPTY ) break; /* dfs done */
krep = kpar;
xdfs = xplore[krep];
maxdfs = xprune[krep];
} while ( kpar != EMPTY ); /* Until empty stack */
} /* else */
} /* else */
} /* for each nonzero ... */
/* Check to see if j belongs in the same supernode as j-1 */
if ( jcol == 0 ) { /* Do nothing for column 0 */
nsuper = supno[0] = 0;
} else {
fsupc = xsup[nsuper];
jptr = xlsub[jcol]; /* Not compressed yet */
jm1ptr = xlsub[jcolm1];
#ifdef T2_SUPER
if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = NO;
#endif
/* Make sure the number of columns in a supernode doesn't
exceed threshold. */
if ( jcol - fsupc >= maxsuper ) jsuper = NO;
/* If jcol starts a new supernode, reclaim storage space in
* lsub from the previous supernode. Note we only store
* the subscript set of the first and last columns of
* a supernode. (first for num values, last for pruning)
*/
if ( jsuper == NO ) { /* starts a new supernode */
if ( (fsupc < jcolm1-1) ) { /* >= 3 columns in nsuper */
#ifdef CHK_COMPRESS
printf(" Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
#endif
ito = xlsub[fsupc+1];
xlsub[jcolm1] = ito;
istop = ito + jptr - jm1ptr;
xprune[jcolm1] = istop; /* Initialize xprune[jcol-1] */
xlsub[jcol] = istop;
for (ifrom = jm1ptr; ifrom < nextl; ++ifrom, ++ito)
lsub[ito] = lsub[ifrom];
nextl = ito; /* = istop + length(jcol) */
}
nsuper++;
supno[jcol] = nsuper;
} /* if a new supernode */
} /* else: jcol > 0 */
/* Tidy up the pointers before exit */
xsup[nsuper+1] = jcolp1;
supno[jcolp1] = nsuper;
xprune[jcol] = nextl; /* Initialize upper bound for pruning */
xlsub[jcolp1] = nextl;
return 0;
}
void
dgssv(SuperMatrix *A, int *perm_c, int *perm_r, SuperMatrix *L,
SuperMatrix *U, SuperMatrix *B, int *info )
{
/*
* Purpose
* =======
*
* DGSSV solves the system of linear equations A*X=B, using the
* LU factorization from DGSTRF. It performs the following steps:
*
* 1. If A is stored column-wise (A->Stype = SLU_NC):
*
* 1.1. Permute the columns of A, forming A*Pc, where Pc
* is a permutation matrix. For more details of this step,
* see sp_preorder.c.
*
* 1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
* by Gaussian elimination with partial pivoting.
* L is unit lower triangular with offdiagonal entries
* bounded by 1 in magnitude, and U is upper triangular.
*
* 1.3. Solve the system of equations A*X=B using the factored
* form of A.
*
* 2. If A is stored row-wise (A->Stype = SLU_NR), apply the
* above algorithm to the transpose of A:
*
* 2.1. Permute columns of transpose(A) (rows of A),
* forming transpose(A)*Pc, where Pc is a permutation matrix.
* For more details of this step, see sp_preorder.c.
*
* 2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
* determined by Gaussian elimination with partial pivoting.
* L is unit lower triangular with offdiagonal entries
* bounded by 1 in magnitude, and U is upper triangular.
*
* 2.3. Solve the system of equations A*X=B using the factored
* form of A.
*
* See supermatrix.h for the definition of 'SuperMatrix' structure.
*
* Arguments
* =========
*
* A (input) SuperMatrix*
* Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
* of 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.
*
* 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 (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.
*
* 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 = SC, Dtype = SLU_D, Mtype = 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 = TRU.
*
* B (input/output) SuperMatrix*
* B has types: Stype = SLU_DN, Dtype = SLU_D, Mtype = SLU_GE.
* On entry, the right hand side matrix.
* On exit, the solution matrix if info = 0;
*
* info (output) int*
* = 0: successful exit
* > 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 could not be computed.
* > A->ncol: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
double t1; /* Temporary time */
char refact[1], trans[1];
DNformat *Bstore;
SuperMatrix *AA;/* A in SLU_NC format used by the factorization routine.*/
SuperMatrix AC; /* Matrix postmultiplied by Pc */
int lwork = 0, *etree, i;
/* Set default values for some parameters */
double diag_pivot_thresh = 1.0;
double drop_tol = 0;
int panel_size; /* panel size */
int relax; /* no of columns in a relaxed snodes */
double *utime;
extern SuperLUStat_t SuperLUStat;
/* Test the input parameters ... */
*info = 0;
Bstore = B->Store;
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 = -1;
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 = -6;
if ( *info != 0 ) {
i = -(*info);
xerbla_("dgssv", &i);
return;
}
*refact = 'N';
*trans = 'N';
panel_size = sp_ienv(1);
relax = sp_ienv(2);
StatInit(panel_size, relax);
utime = SuperLUStat.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);
*trans = 'T';
} else if ( A->Stype == SLU_NC ) AA = A;
etree = intMalloc(A->ncol);
t1 = SuperLU_timer_();
sp_preorder(refact, AA, perm_c, etree, &AC);
utime[ETREE] = SuperLU_timer_() - t1;
/*printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
relax, panel_size, sp_ienv(3), sp_ienv(4));*/
t1 = SuperLU_timer_();
/* Compute the LU factorization of A. */
dgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
etree, NULL, lwork, perm_r, perm_c, L, U, info);
utime[FACT] = SuperLU_timer_() - t1;
t1 = SuperLU_timer_();
if ( *info == 0 ) {
/* Solve the system A*X=B, overwriting B with X. */
dgstrs (trans, L, U, perm_r, perm_c, B, info);
}
utime[SOLVE] = SuperLU_timer_() - t1;
SUPERLU_FREE (etree);
Destroy_CompCol_Permuted(&AC);
if ( A->Stype == SLU_NR ) {
Destroy_SuperMatrix_Store(AA);
SUPERLU_FREE(AA);
}
/*PrintStat( &SuperLUStat );*/
StatFree();
}
