int NewNsuper(const int pnum, mutex_t *lock, int *data)
{
register int i;
#ifdef PROFILE
double t = SuperLU_timer_();
#endif
#if ( MACH==SUN )
mutex_lock(lock);
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_mutex_lock(lock);
#elif ( MACH==SGI || MACH==ORIGIN )
#pragma critical lock(lock)
#elif ( MACH==CRAY_PVP )
#pragma _CRI guard (*lock)
#endif
{
i = ++(*data);
}
#if ( MACH==SUN )
mutex_unlock(lock);
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_mutex_unlock(lock);
#elif ( MACH==CRAY_PVP )
#pragma _CRI endguard (*lock)
#endif
#ifdef PROFILE
Gstat->procstat[pnum].cs_time += SuperLU_timer_() - t;
#endif
return i;
}
main()
{
/* Parameters */
#define NMAX 100
#define ITS 10000
int i, j;
double alpha, avg, t1, t2, tnotim;
double x[NMAX], y[NMAX];
double SuperLU_timer_();
/* Initialize X and Y */
for (i = 0; i < NMAX; ++i) {
x[i] = 1.0 / (double)(i+1);
y[i] = (double)(NMAX - i) / (double)NMAX;
}
alpha = 0.315;
/* Time 1,000,000 DAXPY operations */
t1 = SuperLU_timer_();
for (j = 0; j < ITS; ++j) {
for (i = 0; i < NMAX; ++i)
y[i] += alpha * x[i];
alpha = -alpha;
}
t2 = SuperLU_timer_();
printf("Time for 1,000,000 DAXPY ops = %10.3g seconds\n", t2-t1);
if ( t2-t1 > 0. )
printf("DAXPY performance rate = %10.3g mflops\n", 2./(t2-t1));
else
printf("*** Error: Time for operations was zero\n");
tnotim = t2 - t1;
/* Time 1,000,000 DAXPY operations with SuperLU_timer_()
in the outer loop */
t1 = SuperLU_timer_();
for (j = 0; j < ITS; ++j) {
for (i = 0; i < NMAX; ++i)
y[i] += alpha * x[i];
alpha = -alpha;
t2 = SuperLU_timer_();
}
/* Compute the time in milliseconds used by an average call to
SuperLU_timer_(). */
printf("Including DSECND, time = %10.3g seconds\n", t2-t1);
avg = ( (t2 - t1) - tnotim )*1000. / (double)ITS;
printf("Average time for DSECND = %10.3g milliseconds\n", avg);
/* Compute the equivalent number of floating point operations used
by an average call to DSECND. */
if ( tnotim > 0. )
printf("Equivalent floating point ops = %10.3g ops\n",
1000.*avg / tnotim);
mysub(NMAX, x, y);
return 0;
}
int NewNsuper(const int pnum, pxgstrf_shared_t *pxgstrf_shared, int *data)
{
register int i;
mutex_t *lock = &pxgstrf_shared->lu_locks[NSUPER_LOCK];
Gstat_t *Gstat = pxgstrf_shared->Gstat;
#ifdef PROFILE
double t = SuperLU_timer_();
#endif
#if ( MACH==SUN )
mutex_lock(lock);
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_mutex_lock(lock);
#elif ( MACH==SGI || MACH==ORIGIN )
#pragma critical lock(lock)
#elif ( MACH==CRAY_PVP )
#pragma _CRI guard (*lock)
#elif ( MACH==OPENMP )
#pragma omp critical ( NSUPER_LOCK )
#endif
{
i = ++(*data);
}
#if ( MACH==SUN )
mutex_unlock(lock);
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_mutex_unlock(lock);
#elif ( MACH==CRAY_PVP )
#pragma _CRI endguard (*lock)
#endif
#ifdef PROFILE
Gstat->procstat[pnum].cs_time += SuperLU_timer_() - t;
#endif
return i;
}
void
pzgstrs_Bglobal(int_t n, LUstruct_t *LUstruct, gridinfo_t *grid,
doublecomplex *B, int_t ldb, int nrhs,
SuperLUStat_t *stat, int *info)
{
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
LocalLU_t *Llu = LUstruct->Llu;
doublecomplex alpha = {1.0, 0.0};
doublecomplex zero = {0.0, 0.0};
doublecomplex *lsum; /* Local running sum of the updates to B-components */
doublecomplex *x; /* X component at step k. */
doublecomplex *lusup, *dest;
doublecomplex *recvbuf, *tempv;
doublecomplex *rtemp; /* Result of full matrix-vector multiply. */
int_t **Ufstnz_br_ptr = Llu->Ufstnz_br_ptr;
int_t *Urbs, *Urbs1; /* Number of row blocks in each block column of U. */
Ucb_indptr_t **Ucb_indptr;/* Vertical linked list pointing to Uindex[] */
int_t **Ucb_valptr; /* Vertical linked list pointing to Unzval[] */
int_t kcol, krow, mycol, myrow;
int_t i, ii, il, j, jj, k, lb, ljb, lk, lptr, luptr;
int_t nb, nlb, nub, nsupers;
int_t *xsup, *lsub, *usub;
int_t *ilsum; /* Starting position of each supernode in lsum (LOCAL)*/
int Pc, Pr, iam;
int knsupc, nsupr;
int ldalsum; /* Number of lsum entries locally owned. */
int maxrecvsz, p, pi;
int_t **Lrowind_bc_ptr;
doublecomplex **Lnzval_bc_ptr;
MPI_Status status;
#if defined (ISEND_IRECV) || defined (BSEND)
MPI_Request *send_req, recv_req;
#endif
/*-- Counts used for L-solve --*/
int_t *fmod; /* Modification count for L-solve. */
int_t **fsendx_plist = Llu->fsendx_plist;
int_t nfrecvx = Llu->nfrecvx; /* Number of X components to be recv'd. */
int_t *frecv; /* Count of modifications to be recv'd from
processes in this row. */
int_t nfrecvmod = 0; /* Count of total modifications to be recv'd. */
int_t nleaf = 0, nroot = 0;
/*-- Counts used for U-solve --*/
int_t *bmod; /* Modification count for L-solve. */
int_t **bsendx_plist = Llu->bsendx_plist;
int_t nbrecvx = Llu->nbrecvx; /* Number of X components to be recv'd. */
int_t *brecv; /* Count of modifications to be recv'd from
processes in this row. */
int_t nbrecvmod = 0; /* Count of total modifications to be recv'd. */
double t;
#if ( DEBUGlevel>=2 )
int_t Ublocks = 0;
#endif
int_t *mod_bit = Llu->mod_bit; /* flag contribution from each row block */
t = SuperLU_timer_();
/* Test input parameters. */
*info = 0;
if ( n < 0 ) *info = -1;
else if ( nrhs < 0 ) *info = -9;
if ( *info ) {
pxerr_dist("PZGSTRS_BGLOBAL", grid, -*info);
return;
}
/*
* Initialization.
*/
iam = grid->iam;
Pc = grid->npcol;
Pr = grid->nprow;
myrow = MYROW( iam, grid );
mycol = MYCOL( iam, grid );
nsupers = Glu_persist->supno[n-1] + 1;
xsup = Glu_persist->xsup;
Lrowind_bc_ptr = Llu->Lrowind_bc_ptr;
Lnzval_bc_ptr = Llu->Lnzval_bc_ptr;
nlb = CEILING( nsupers, Pr ); /* Number of local block rows. */
stat->ops[SOLVE] = 0.0;
Llu->SolveMsgSent = 0;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pzgstrs_Bglobal()");
#endif
/* Save the count to be altered so it can be used by
subsequent call to PDGSTRS_BGLOBAL. */
if ( !(fmod = intMalloc_dist(nlb)) )
ABORT("Calloc fails for fmod[].");
for (i = 0; i < nlb; ++i) fmod[i] = Llu->fmod[i];
if ( !(frecv = intMalloc_dist(nlb)) )
ABORT("Malloc fails for frecv[].");
Llu->frecv = frecv;
#if defined (ISEND_IRECV) || defined (BSEND)
k = SUPERLU_MAX( Llu->nfsendx, Llu->nbsendx ) + nlb;
if ( !(send_req = (MPI_Request*) SUPERLU_MALLOC(k*sizeof(MPI_Request))) )
ABORT("Malloc fails for send_req[].");
#endif
#ifdef _CRAY
ftcs1 = _cptofcd("L", strlen("L"));
ftcs2 = _cptofcd("N", strlen("N"));
ftcs3 = _cptofcd("U", strlen("U"));
#endif
/* Obtain ilsum[] and ldalsum for process column 0. */
ilsum = Llu->ilsum;
ldalsum = Llu->ldalsum;
/* Allocate working storage. */
knsupc = sp_ienv_dist(3);
maxrecvsz = knsupc * nrhs + SUPERLU_MAX( XK_H, LSUM_H );
if ( !(lsum = doublecomplexCalloc_dist(((size_t)ldalsum) * nrhs
+ nlb * LSUM_H)) )
ABORT("Calloc fails for lsum[].");
if ( !(x = doublecomplexMalloc_dist(((size_t)ldalsum) * nrhs
+ nlb * XK_H)) )
ABORT("Malloc fails for x[].");
if ( !(recvbuf = doublecomplexMalloc_dist(maxrecvsz)) )
ABORT("Malloc fails for recvbuf[].");
if ( !(rtemp = doublecomplexCalloc_dist(maxrecvsz)) )
ABORT("Malloc fails for rtemp[].");
/*---------------------------------------------------
* Forward solve Ly = b.
*---------------------------------------------------*/
/*
* Copy B into X on the diagonal processes.
*/
ii = 0;
for (k = 0; k < nsupers; ++k) {
knsupc = SuperSize( k );
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
il = LSUM_BLK( lk );
lsum[il - LSUM_H].r = k;/* Block number prepended in the header. */
lsum[il - LSUM_H].i = 0;
kcol = PCOL( k, grid );
if ( mycol == kcol ) { /* Diagonal process. */
jj = X_BLK( lk );
x[jj - XK_H].r = k; /* Block number prepended in the header. */
x[jj - XK_H].i = 0;
RHS_ITERATE(j)
for (i = 0; i < knsupc; ++i) /* X is stored in blocks. */
x[i + jj + j*knsupc] = B[i + ii + j*ldb];
}
}
void
*pzgstrf_thread(void *arg)
{
/*
* -- SuperLU MT routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley,
* and Xerox Palo Alto Research Center.
* September 10, 2007
*
*
* Purpose
* =======
*
* This is the slave process, representing the main scheduling loop to
* perform the factorization. Each process executes a copy of the
* following code ... (SPMD paradigm)
*
* Working arrays local to each process
* ======================================
* marker[0:3*m-1]: marker[i] == j means node i has been reached when
* working on column j.
* Storage: relative to original row subscripts
*
* THERE ARE 3 OF THEM:
* marker[0 : m-1]: used by pzgstrf_factor_snode() and
* pzgstrf_panel_dfs();
* marker[m : 2m-1]: used by pzgstrf_panel_dfs() and
* pxgstrf_super_bnd_dfs();
* values in [0 : n-1] when used by pzgstrf_panel_dfs()
* values in [n : 2n-1] when used by pxgstrf_super_bnd_dfs()
* marker[2m : 3m-1]: used by pzgstrf_column_dfs() in inner-factor
*
* parent[0:n-1]: parent vector used during dfs
* Storage: relative to new row subscripts
*
* xplore[0:2m-1]: xplore[i] gives the location of the next (dfs)
* unexplored neighbor of i in lsub[*]; xplore[n+i] gives the
* location of the last unexplored neighbor of i in lsub[*].
*
* segrep[0:nseg-1]: contains the list of supernodal representatives
* in topological order of the dfs. A supernode representative is the
* last column of a supernode.
*
* repfnz[0:m-1]: for a nonzero segment U[*,j] that ends at a
* supernodal representative r, repfnz[r] is the location of the first
* nonzero in this segment. It is also used during the dfs:
* repfnz[r]>0 indicates that supernode r has been explored.
* NOTE: There are w of them, each used for one column of a panel.
*
* panel_lsub[0:w*m-1]: temporary for the nonzero row indices below
* the panel diagonal. These are filled in during pzgstrf_panel_dfs(),
* and are used later in the inner LU factorization.
* panel_lsub[]/dense[] pair forms the SPA data structure.
* NOTE: There are w of them.
*
* dense[0:w*m-1]: sparse accumulator (SPA) for intermediate values;
* NOTE: there are w of them.
*
* tempv[0:m-1]: real temporary used for dense numeric kernels;
*
*
* Scheduling algorithm (For each process ...)
* ====================
* Shared task Q <-- { relaxed s-nodes (CANGO) };
*
* WHILE (not finished)
*
* panel = Scheduler(Q); (see pxgstrf_scheduler.c for policy)
*
* IF (panel == RELAXED_SNODE)
* factor_relax_snode(panel);
* ELSE
* * pzgstrf_panel_dfs()
* - skip all BUSY s-nodes (or panels)
*
* * dpanel_bmod()
* - updates from DONE s-nodes
* - wait for BUSY s-nodes to become DONE
*
* * inner-factor()
* - identical as it is in the sequential algorithm,
* except that pruning() will interact with the
* pzgstrf_panel_dfs() of other panels.
* ENDIF
*
* END WHILE;
*
*/
#if ( MACH==SGI || MACH==ORIGIN )
#if ( MACH==SGI )
int pnum = mpc_my_threadnum();
#elif ( MACH==ORIGIN )
int pnum = mp_my_threadnum();
#endif
pzgstrf_threadarg_t *thr_arg = &((pzgstrf_threadarg_t *)arg)[pnum];
#else
pzgstrf_threadarg_t *thr_arg = arg;
int pnum = thr_arg->pnum;
#endif
/* Unpack the options argument */
superlumt_options_t *superlumt_options = thr_arg->superlumt_options;
pxgstrf_shared_t *pxgstrf_shared= thr_arg->pxgstrf_shared;
int panel_size = superlumt_options->panel_size;
double diag_pivot_thresh = superlumt_options->diag_pivot_thresh;
yes_no_t *usepr = &superlumt_options->usepr; /* may be modified */
int *etree = superlumt_options->etree;
int *super_bnd = superlumt_options->part_super_h;
int *perm_r = superlumt_options->perm_r;
int *inv_perm_c= pxgstrf_shared->inv_perm_c;
int *inv_perm_r= pxgstrf_shared->inv_perm_r;
int *xprune = pxgstrf_shared->xprune;
int *ispruned = pxgstrf_shared->ispruned;
SuperMatrix *A = pxgstrf_shared->A;
GlobalLU_t *Glu = pxgstrf_shared->Glu;
Gstat_t *Gstat = pxgstrf_shared->Gstat;
int *info = &thr_arg->info;
/* Local working arrays */
int *iwork;
doublecomplex *dwork;
int *segrep, *repfnz, *parent, *xplore;
int *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
int *marker, *marker1, *marker2;
int *lbusy; /* "Local busy" array, indicates which descendants
were busy when this panel's computation began.
Those columns (s-nodes) are treated specially
during pzgstrf_panel_dfs() and dpanel_bmod(). */
int *spa_marker; /* size n-by-w */
int *w_lsub_end; /* record the end of each column in panel_lsub */
doublecomplex *dense, *tempv;
int *lsub, *xlsub, *xlsub_end;
/* Local scalars */
register int m, n, k, jj, jcolm1, itemp, singular;
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 */
int w, bcol, jcol;
#ifdef PROFILE
double *utime = Gstat->utime;
double t1, t2, t, stime;
register float flopcnt;
#endif
#ifdef PREDICT_OPT
flops_t *ops = Gstat->ops;
register float pdiv;
#endif
#if ( DEBUGlevel>=1 )
printf("(%d) thr_arg-> pnum %d, info %d\n", pnum, thr_arg->pnum, thr_arg->info);
#endif
singular = 0;
m = A->nrow;
n = A->ncol;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
xlsub_end = Glu->xlsub_end;
/* Allocate and initialize the per-process working storage. */
if ( (*info = pzgstrf_WorkInit(m, panel_size, &iwork, &dwork)) ) {
*info += pzgstrf_memory_use(Glu->nzlmax, Glu->nzumax, Glu->nzlumax);
return 0;
}
pxgstrf_SetIWork(m, panel_size, iwork, &segrep, &parent, &xplore,
&repfnz, &panel_lsub, &marker, &lbusy);
pzgstrf_SetRWork(m, panel_size, dwork, &dense, &tempv);
/* New data structures to facilitate parallel algorithm */
spa_marker = intMalloc(m * panel_size);
w_lsub_end = intMalloc(panel_size);
ifill (spa_marker, m * panel_size, EMPTY);
ifill (marker, m * NO_MARKER, EMPTY);
ifill (lbusy, m, EMPTY);
jcol = EMPTY;
marker1 = marker + m;
marker2 = marker + 2*m;
#ifdef PROFILE
stime = SuperLU_timer_();
#endif
/* -------------------------
Main loop: repeatedly ...
------------------------- */
while ( pxgstrf_shared->tasks_remain > 0 ) {
#ifdef PROFILE
TIC(t);
#endif
/* Get a panel from the scheduler. */
pxgstrf_scheduler(pnum, n, etree, &jcol, &bcol, pxgstrf_shared);
#if ( DEBUGlevel>=1 )
if ( jcol>=LOCOL && jcol<=HICOL ) {
printf("(%d) Scheduler(): jcol %d, bcol %d, tasks_remain %d\n",
pnum, jcol, bcol, pxgstrf_shared->tasks_remain);
fflush(stdout);
}
#endif
#ifdef PROFILE
TOC(t2, t);
Gstat->procstat[pnum].skedtime += t2;
#endif
if ( jcol != EMPTY ) {
w = pxgstrf_shared->pan_status[jcol].size;
#if ( DEBUGlevel>=3 )
printf("P%2d got panel %5d-%5d\ttime %.4f\tpanels_left %d\n",
pnum, jcol, jcol+w-1, SuperLU_timer_(),
pxgstrf_shared->tasks_remain);
fflush(stdout);
#endif
/* Nondomain panels */
#ifdef PROFILE
flopcnt = Gstat->procstat[pnum].fcops;
Gstat->panstat[jcol].pnum = pnum;
TIC(t1);
Gstat->panstat[jcol].starttime = t1;
#endif
if ( pxgstrf_shared->pan_status[jcol].type == RELAXED_SNODE ) {
#ifdef PREDICT_OPT
pdiv = Gstat->procstat[pnum].fcops;
#endif
/* A relaxed supernode at the bottom of the etree */
pzgstrf_factor_snode
(pnum, jcol, A, diag_pivot_thresh, usepr,
perm_r, inv_perm_r, inv_perm_c, xprune, marker,
panel_lsub, dense, tempv, pxgstrf_shared, info);
if ( *info ) {
if ( *info > n ) return 0;
else if ( singular == 0 || *info < singular )
singular = *info;
#if ( DEBUGlevel>=1 )
printf("(%d) After pzgstrf_factor_snode(): singular=%d\n", pnum, singular);
#endif
}
/* Release the whole relaxed supernode */
for (jj = jcol; jj < jcol + w; ++jj)
pxgstrf_shared->spin_locks[jj] = 0;
#ifdef PREDICT_OPT
pdiv = Gstat->procstat[pnum].fcops - pdiv;
cp_panel[jcol].pdiv = pdiv;
#endif
} else { /* Regular panel */
#ifdef PROFILE
TIC(t);
#endif
pxgstrf_mark_busy_descends(pnum, jcol, etree, pxgstrf_shared,
&bcol, lbusy);
/* Symbolic factor on a panel of columns */
pzgstrf_panel_dfs
(pnum, m, w, jcol, A, perm_r, xprune,ispruned,lbusy,
&nseg1, panel_lsub, w_lsub_end, segrep, repfnz,
marker, spa_marker, parent, xplore, dense, Glu);
#if ( DEBUGlevel>=2 )
if ( jcol==BADPAN )
printf("(%d) After pzgstrf_panel_dfs(): nseg1 %d, w_lsub_end %d\n",
pnum, nseg1, w_lsub_end[0]);
#endif
#ifdef PROFILE
TOC(t2, t);
utime[DFS] += t2;
#endif
/* Numeric sup-panel updates in topological order.
* On return, the update values are temporarily stored in
* the n-by-w SPA dense[m,w].
*/
pzgstrf_panel_bmod
(pnum, m, w, jcol, bcol, inv_perm_r, etree,
&nseg1, segrep, repfnz, panel_lsub, w_lsub_end,
spa_marker, dense, tempv, pxgstrf_shared);
/*
* All "busy" descendants are "done" now --
* Find the set of row subscripts in the preceeding column
* "jcol-1" of the current panel. Column "jcol-1" is
* usually taken by a process other than myself.
* This row-subscripts information will be used by myself
* during column dfs to detect whether "jcol" belongs
* to the same supernode as "jcol-1".
*
* ACCORDING TO PROFILE, THE AMOUNT OF TIME SPENT HERE
* IS NEGLIGIBLE.
*/
jcolm1 = jcol - 1;
itemp = xlsub_end[jcolm1];
for (k = xlsub[jcolm1]; k < itemp; ++k)
marker2[lsub[k]] = jcolm1;
#ifdef PREDICT_OPT
pdiv = Gstat->procstat[pnum].fcops;
#endif
/* Inner-factorization, using sup-col algorithm */
for ( jj = jcol; jj < jcol + w; jj++) {
k = (jj - jcol) * m; /* index into w-wide arrays */
nseg = nseg1; /* begin after all the panel segments */
#ifdef PROFILE
TIC(t);
#endif
/* Allocate storage for the current H-supernode. */
if ( Glu->dynamic_snode_bound && super_bnd[jj] ) {
/* jj starts a supernode in H */
pxgstrf_super_bnd_dfs
(pnum, m, n, jj, super_bnd[jj], A, perm_r,
inv_perm_r, xprune, ispruned, marker1, parent,
xplore, pxgstrf_shared);
}
if ( (*info = pzgstrf_column_dfs
(pnum, m, jj, jcol, perm_r, ispruned,
&panel_lsub[k],w_lsub_end[jj-jcol],
super_bnd, &nseg, segrep,
&repfnz[k], xprune, marker2,
parent, xplore, pxgstrf_shared)) )
return 0;
#ifdef PROFILE
TOC(t2, t);
utime[DFS] += t2;
#endif
/* On return, the L supernode is gathered into the
global storage. */
if ( (*info = pzgstrf_column_bmod
(pnum, jj, jcol, (nseg - nseg1),
&segrep[nseg1], &repfnz[k],
&dense[k], tempv, pxgstrf_shared, Gstat)) )
return 0;
if ( (*info = pzgstrf_pivotL
(pnum, jj, diag_pivot_thresh, usepr,
perm_r, inv_perm_r, inv_perm_c,
&pivrow, Glu, Gstat)) )
if ( singular == 0 || *info < singular ) {
singular = *info;
#if ( DEBUGlevel>=1 )
printf("(%d) After pzgstrf_pivotL(): singular=%d\n", pnum, singular);
#endif
}
/* release column "jj", so that the other processes
waiting for this column can proceed */
pxgstrf_shared->spin_locks[jj] = 0;
/* copy the U-segments to ucol[*] */
if ( (*info = pzgstrf_copy_to_ucol
(pnum,jj,nseg,segrep,&repfnz[k],
perm_r, &dense[k], pxgstrf_shared)) )
return 0;
/* Prune columns [0:jj-1] using column jj */
pxgstrf_pruneL(jj, perm_r, pivrow, nseg, segrep,
&repfnz[k], xprune, ispruned, Glu);
/* Reset repfnz[] for this column */
pxgstrf_resetrep_col (nseg, segrep, &repfnz[k]);
#if ( DEBUGlevel>=2 )
/* if (jj >= LOCOL && jj <= HICOL) {*/
if ( jj==BADCOL ) {
dprint_lu_col(pnum, "panel:", jcol, jj, w, pivrow, xprune, Glu);
dcheck_zero_vec(pnum, "after pzgstrf_copy_to_ucol() dense_col[]", n, &dense[k]);
}
#endif
} /* for jj ... */
#ifdef PREDICT_OPT
pdiv = Gstat->procstat[pnum].fcops - pdiv;
cp_panel[jcol].pdiv = pdiv;
#endif
} /* else regular panel ... */
STATE( jcol ) = DONE; /* Release panel jcol. */
#ifdef PROFILE
TOC(Gstat->panstat[jcol].fctime, t1);
Gstat->panstat[jcol].flopcnt += Gstat->procstat[pnum].fcops - flopcnt;
/*if ( Glu->tasks_remain < P ) {
flops_last_P_panels += Gstat->panstat[jcol].flopcnt;
printf("Panel %d, flops %e\n", jcol, Gstat->panstat[jcol].flopcnt);
fflush(stdout);
} */
#endif
}
#ifdef PROFILE
else { /* No panel from the task queue - wait and try again */
Gstat->procstat[pnum].skedwaits++;
}
#endif
} /* while there are more panels */
*info = singular;
/* Free work space and compress storage */
pzgstrf_WorkFree(iwork, dwork, Glu);
SUPERLU_FREE (spa_marker);
SUPERLU_FREE (w_lsub_end);
#ifdef PROFILE
Gstat->procstat[pnum].fctime = SuperLU_timer_() - stime;
#endif
return 0;
}
/*! \brief
*
* <pre>
* Purpose
* =======
*
* GET_PERM_C_DIST obtains a permutation matrix Pc, by applying the multiple
* minimum degree ordering code by Joseph Liu to matrix A'*A or A+A',
* or using approximate minimum degree column ordering by Davis et. al.
* The LU factorization of A*Pc tends to have less fill than the LU
* factorization of A.
*
* Arguments
* =========
*
* ispec (input) colperm_t
* Specifies what type of column permutation to use to reduce fill.
* = NATURAL: natural ordering (i.e., Pc = I)
* = MMD_AT_PLUS_A: minimum degree ordering on structure of A'+A
* = MMD_ATA: minimum degree ordering on structure of A'*A
* = METIS_AT_PLUS_A: MeTis on A'+A
*
* A (input) 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; Dtype = SLU_D; Mtype = SLU_GE.
* In the future, more general A can be handled.
*
* perm_c (output) int*
* 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.
* </pre>
*/
void
get_perm_c_dist(int_t pnum, int_t ispec, SuperMatrix *A, int_t *perm_c)
{
NCformat *Astore = A->Store;
int_t m, n, bnz = 0, *b_colptr, *b_rowind, i;
int_t delta, maxint, nofsub, *invp;
int_t *dhead, *qsize, *llist, *marker;
double t, SuperLU_timer_();
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(pnum, "Enter get_perm_c_dist()");
#endif
m = A->nrow;
n = A->ncol;
t = SuperLU_timer_();
switch ( ispec ) {
case NATURAL: /* Natural ordering */
for (i = 0; i < n; ++i) perm_c[i] = i;
#if ( PRNTlevel>=1 )
if ( !pnum ) printf(".. Use natural column ordering\n");
#endif
return;
case MMD_AT_PLUS_A: /* Minimum degree ordering on A'+A */
if ( m != n ) ABORT("Matrix is not square");
at_plus_a_dist(n, Astore->nnz, Astore->colptr, Astore->rowind,
&bnz, &b_colptr, &b_rowind);
t = SuperLU_timer_() - t;
/*printf("Form A'+A time = %8.3f\n", t);*/
#if ( PRNTlevel>=1 )
if ( !pnum ) printf(".. Use minimum degree ordering on A'+A.\n");
#endif
break;
case MMD_ATA: /* Minimum degree ordering on A'*A */
getata_dist(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
&bnz, &b_colptr, &b_rowind);
t = SuperLU_timer_() - t;
/*printf("Form A'*A time = %8.3f\n", t);*/
#if ( PRNTlevel>=1 )
if ( !pnum ) printf(".. Use minimum degree ordering on A'*A\n");
#endif
break;
case METIS_AT_PLUS_A: /* METIS ordering on A'+A */
if ( m != n ) ABORT("Matrix is not square");
at_plus_a_dist(n, Astore->nnz, Astore->colptr, Astore->rowind,
&bnz, &b_colptr, &b_rowind);
if ( bnz ) { /* non-empty adjacency structure */
get_metis(n, bnz, b_colptr, b_rowind, perm_c);
} else { /* e.g., diagonal matrix */
for (i = 0; i < n; ++i) perm_c[i] = i;
SUPERLU_FREE(b_colptr);
/* b_rowind is not allocated in this case */
}
#if ( PRNTlevel>=1 )
if ( !pnum ) printf(".. Use METIS ordering on A'+A\n");
#endif
return;
default:
ABORT("Invalid ISPEC");
}
if ( bnz ) {
t = SuperLU_timer_();
/* Initialize and allocate storage for GENMMD. */
delta = 0; /* DELTA is a parameter to allow the choice of nodes
whose degree <= min-degree + DELTA. */
maxint = 2147483647; /* 2**31 - 1 */
invp = (int_t *) SUPERLU_MALLOC((n+delta)*sizeof(int_t));
if ( !invp ) ABORT("SUPERLU_MALLOC fails for invp.");
dhead = (int_t *) SUPERLU_MALLOC((n+delta)*sizeof(int_t));
if ( !dhead ) ABORT("SUPERLU_MALLOC fails for dhead.");
qsize = (int_t *) SUPERLU_MALLOC((n+delta)*sizeof(int_t));
if ( !qsize ) ABORT("SUPERLU_MALLOC fails for qsize.");
llist = (int_t *) SUPERLU_MALLOC(n*sizeof(int_t));
if ( !llist ) ABORT("SUPERLU_MALLOC fails for llist.");
marker = (int_t *) SUPERLU_MALLOC(n*sizeof(int_t));
if ( !marker ) ABORT("SUPERLU_MALLOC fails for marker.");
/* Transform adjacency list into 1-based indexing required by GENMMD.*/
for (i = 0; i <= n; ++i) ++b_colptr[i];
for (i = 0; i < bnz; ++i) ++b_rowind[i];
genmmd_dist_(&n, b_colptr, b_rowind, perm_c, invp, &delta, dhead,
qsize, llist, marker, &maxint, &nofsub);
/* Transform perm_c into 0-based indexing. */
for (i = 0; i < n; ++i) --perm_c[i];
SUPERLU_FREE(invp);
SUPERLU_FREE(dhead);
SUPERLU_FREE(qsize);
SUPERLU_FREE(llist);
SUPERLU_FREE(marker);
SUPERLU_FREE(b_rowind);
t = SuperLU_timer_() - t;
/* printf("call GENMMD time = %8.3f\n", t);*/
} else { /* Empty adjacency structure */
for (i = 0; i < n; ++i) perm_c[i] = i;
}
SUPERLU_FREE(b_colptr);
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(pnum, "Exit get_perm_c_dist()");
#endif
} /* get_perm_c_dist */
void
pxgstrf_scheduler(const int pnum, const int n, const int *etree,
int *cur_pan, int *bcol, pxgstrf_shared_t *pxgstrf_shared)
{
/*
* -- SuperLU MT routine (version 1.0) --
* Univ. of California Berkeley, Xerox Palo Alto Research Center,
* and Lawrence Berkeley National Lab.
* August 15, 1997
*
* Purpose
* =======
*
* pxgstrf_scheduler() gets a panel for the processor to work on.
* It schedules a panel in decreasing order of priority:
* (1) the current panel's parent, if it can be done without pipelining
* (2) any other panel in the queue that can be done without pipelining
* ("CANGO" status)
* (3) any other panel in the queue that can be done with pipelining
* ("CANPIPE" status)
*
* Arguments
* =========
* pnum (input) int
* Processor number.
*
* n (input) int
* Column dimension of the matrix.
*
* etree (input) int*
* Elimination tree of A'*A, size n.
* Note: etree is a vector of parent pointers for a forest whose
* vertices are the integers 0 to n-1; etree[root] = n.
*
* cur_pan (input/output) int*
* On entry, the current panel just finished by this processor;
* On exit, [0, n-1]: the new panel to work on;
* EMPTY: failed to get any work, will try later;
* n: all panels are taken; ready to terminate.
*
* taskq (input/output) queue_t*
* Global work queue.
*
* fb_cols (input/output) int*
* The farthest busy descendant of each (leading column of the) panel.
*
* bcol (output) int*
* The most distant busy descendant of cur_pan in the *linear*
* pipeline of busy descendants. If all proper descendants of
* cur_pan are done, bcol is returned equal to cur_pan.
*
* Defining terms
* ==============
* o parent(panel) = etree(last column in the panel)
* o the kids of a panel = collective kids of all columns in the panel
* kids[REP] = SUM_{j in panel} ( kids[j] )
* o linear pipeline - what does it mean in the panel context?
* if ukids[REP] = 0, then the panel becomes a leaf (CANGO)
* if ukids[REP] = 1 && ukids[firstcol] = 1, then the panel can
* be taken with pipelining (CANPIPE)
*
* NOTES
* =====
* o When a "busy" panel finishes, if its parent has only one remaining
* undone child there is no check to see if the parent should change
* from "unready" to "canpipe". Thus a few potential pipelinings will
* be lost, but checking out this pipeline opportunity may be costly.
*
*/
register int dad, dad_ukids, jcol, w, j;
int *fb_cols = pxgstrf_shared->fb_cols;
queue_t *taskq = &pxgstrf_shared->taskq;
Gstat_t *Gstat = pxgstrf_shared->Gstat;
#ifdef PROFILE
double t;
#endif
jcol = *cur_pan;
if ( jcol != EMPTY ) {
#ifdef DOMAINS
if ( in_domain[jcol] == TREE_DOMAIN )
dad = etree[jcol];
else
#endif
dad = DADPANEL (jcol);
}
/* w_top = sp_ienv(1)/2;
if ( w_top == 0 ) w_top = 1;*/
#ifdef PROFILE
TIC(t);
#endif
#if ( MACH==SUN )
mutex_lock( &pxgstrf_shared->lu_locks[SCHED_LOCK] );
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_mutex_lock( &pxgstrf_shared->lu_locks[SCHED_LOCK] );
#elif ( MACH==SGI || MACH==ORIGIN )
#pragma critical lock(pxgstrf_shared->lu_locks[SCHED_LOCK])
#elif ( MACH==CRAY_PVP )
#pragma _CRI guard SCHED_LOCK
#elif ( MACH==OPENMP )
#pragma omp critical ( SCHED_LOCK )
#endif
{ /* ---- START CRITICAL SECTION ---- */
/* Update the status of the current panel and its parent, so that
* the other processors waiting on it can proceed.
* If all siblings are done, and dad is not busy, then take dad.
*/
if ( jcol != EMPTY ) { /* jcol was just finished by this processor */
dad_ukids = --pxgstrf_shared->pan_status[dad].ukids;
#ifdef DEBUG
printf("(%d) DONE %d in Scheduler(), dad %d, STATE %d, dad_ukids %d\n",
pnum, jcol, dad, STATE(dad), dad_ukids);
#endif
if ( dad_ukids == 0 && STATE( dad ) > BUSY ) { /* dad not started */
jcol = dad;
#ifdef DEBUG
printf("(%d) Scheduler[1] Got dad %d, STATE %d\n",
pnum, jcol, STATE(dad));
#endif
#ifdef PROFILE
++(Gstat->panhows[DADPAN]);
#endif
} else {
/* Try to get a panel from the task Q. */
while ( 1 ) {
/*>>if ( (j = Dequeue(taskq, &item)) == EMPTY ) {*/
if ( taskq->count <= 0 ) {
jcol = EMPTY;
break;
} else {
jcol = taskq->queue[taskq->head++];
--taskq->count;
if ( STATE( jcol ) >= CANGO ) { /* CANGO or CANPIPE */
#ifdef DEBUG
printf("(%d) Dequeue[1] Got %d, STATE %d, Qcount %d\n",
pnum, jcol, STATE(jcol), j);
#endif
#ifdef PROFILE
if (STATE( jcol ) == CANGO) ++(Gstat->panhows[NOPIPE]);
else ++(Gstat->panhows[PIPE]);
#endif
break;
}
}
} /* while */
}
} else {
/*
* jcol was EMPTY; Try to get a panel from the task Q.
*/
while ( 1 ) {
/*>>if ( (j = Dequeue(taskq, &item)) == EMPTY ) {*/
if ( taskq->count <= 0 ) {
jcol = EMPTY;
break;
} else {
jcol = taskq->queue[taskq->head++];
--taskq->count;
if ( STATE( jcol ) >= CANGO ) { /* CANGO or CANPIPE */
#ifdef DEBUG
printf("(%d) Dequeue[2] Got %d, STATE %d, Qcount %d\n",
pnum, jcol, STATE(jcol), j);
#endif
#ifdef PROFILE
if (STATE( jcol ) == CANGO) ++(Gstat->panhows[NOPIPE]);
else ++(Gstat->panhows[PIPE]);
#endif
break;
}
}
} /* while */
}
/*
* Update the status of the new panel "jcol" and its parent "dad".
*/
if ( jcol != EMPTY ) {
--pxgstrf_shared->tasks_remain;
#ifdef DOMAINS
if ( in_domain[jcol] == TREE_DOMAIN ) {
/* Dequeue the first descendant of this domain */
*bcol = taskq->queue[taskq->head++];
--taskq->count;
} else
#endif
{
STATE( jcol ) = BUSY;
w = pxgstrf_shared->pan_status[jcol].size;
for (j = jcol; j < jcol+w; ++j) pxgstrf_shared->spin_locks[j] = 1;
dad = DADPANEL (jcol);
if ( dad < n && pxgstrf_shared->pan_status[dad].ukids == 1 ) {
STATE( dad ) = CANPIPE;
/*>> j = Enqueue(taskq, dad);*/
taskq->queue[taskq->tail++] = dad;
++taskq->count;
#ifdef DEBUG
printf("(%d) Enqueue() %d's dad %d ->CANPIPE, Qcount %d\n",
pnum, jcol, dad, j);
#endif
}
#ifdef PROFILE
Gstat->procstat[pnum].panels++;
#endif
/* Find the farthest busy descendant of the new panel
and its parent.*/
*bcol = fb_cols[jcol];
#ifdef DEBUG
printf("(%d) Scheduler[2] fb_cols[%d]=%d, STATE %d\n",
pnum, jcol, *bcol, STATE( *bcol ));
#endif
while ( STATE( *bcol ) == DONE ) *bcol = DADPANEL (*bcol);
fb_cols[dad] = *bcol;
} /* else regular_panel */
} /* if jcol != empty */
*cur_pan = jcol;
#ifdef DEBUG
printf("(%d) Exit C.S. tasks_remain %d, cur_pan %d\n",
pnum, pxgstrf_shared->tasks_remain, jcol);
#endif
} /* ---- END CRITICAL SECTION ---- */
#if ( MACH==SUN )
/* Exit C.S. */
mutex_unlock( &pxgstrf_shared->lu_locks[SCHED_LOCK] );
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_mutex_unlock( &pxgstrf_shared->lu_locks[SCHED_LOCK] );
#elif ( MACH==CRAY_PVP )
#pragma _CRI endguard SCHED_LOCK
#endif
#ifdef PROFILE
Gstat->procstat[pnum].cs_time += SuperLU_timer_() - t;
#endif
return;
}
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();
}
float
ddistribute(fact_t fact, int_t n, SuperMatrix *A,
Glu_freeable_t *Glu_freeable,
LUstruct_t *LUstruct, gridinfo_t *grid)
{
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
LocalLU_t *Llu = LUstruct->Llu;
int_t bnnz, fsupc, fsupc1, i, ii, irow, istart, j, jb, jj, k,
len, len1, nsupc;
int_t ljb; /* local block column number */
int_t nrbl; /* number of L blocks in current block column */
int_t nrbu; /* number of U blocks in current block column */
int_t gb; /* global block number; 0 < gb <= nsuper */
int_t lb; /* local block number; 0 < lb <= ceil(NSUPERS/Pr) */
int iam, jbrow, kcol, mycol, myrow, pc, pr;
int_t mybufmax[NBUFFERS];
NCPformat *Astore;
double *a;
int_t *asub;
int_t *xa_begin, *xa_end;
int_t *xsup = Glu_persist->xsup; /* supernode and column mapping */
int_t *supno = Glu_persist->supno;
int_t *lsub, *xlsub, *usub, *xusub;
int_t nsupers;
int_t next_lind; /* next available position in index[*] */
int_t next_lval; /* next available position in nzval[*] */
int_t *index; /* indices consist of headers and row subscripts */
int *index1; /* temporary pointer to array of int */
double *lusup, *uval; /* nonzero values in L and U */
double **Lnzval_bc_ptr; /* size ceil(NSUPERS/Pc) */
int_t **Lrowind_bc_ptr; /* size ceil(NSUPERS/Pc) */
double **Unzval_br_ptr; /* size ceil(NSUPERS/Pr) */
int_t **Ufstnz_br_ptr; /* size ceil(NSUPERS/Pr) */
/*-- Counts to be used in factorization. --*/
int *ToRecv, *ToSendD, **ToSendR;
/*-- Counts to be used in lower triangular solve. --*/
int_t *fmod; /* Modification count for L-solve. */
int_t **fsendx_plist; /* Column process list to send down Xk. */
int_t nfrecvx = 0; /* Number of Xk I will receive. */
int_t nfsendx = 0; /* Number of Xk I will send */
int_t kseen;
/*-- Counts to be used in upper triangular solve. --*/
int_t *bmod; /* Modification count for U-solve. */
int_t **bsendx_plist; /* Column process list to send down Xk. */
int_t nbrecvx = 0; /* Number of Xk I will receive. */
int_t nbsendx = 0; /* Number of Xk I will send */
int_t *ilsum; /* starting position of each supernode in
the full array (local) */
/*-- Auxiliary arrays; freed on return --*/
int_t *rb_marker; /* block hit marker; size ceil(NSUPERS/Pr) */
int_t *Urb_length; /* U block length; size ceil(NSUPERS/Pr) */
int_t *Urb_indptr; /* pointers to U index[]; size ceil(NSUPERS/Pr) */
int_t *Urb_fstnz; /* # of fstnz in a block row; size ceil(NSUPERS/Pr) */
int_t *Ucbs; /* number of column blocks in a block row */
int_t *Lrb_length; /* L block length; size ceil(NSUPERS/Pr) */
int_t *Lrb_number; /* global block number; size ceil(NSUPERS/Pr) */
int_t *Lrb_indptr; /* pointers to L index[]; size ceil(NSUPERS/Pr) */
int_t *Lrb_valptr; /* pointers to L nzval[]; size ceil(NSUPERS/Pr) */
double *dense, *dense_col; /* SPA */
double zero = 0.0;
int_t ldaspa; /* LDA of SPA */
int_t iword, dword;
float mem_use = 0.0;
#if ( PRNTlevel>=1 )
int_t nLblocks = 0, nUblocks = 0;
#endif
#if ( PROFlevel>=1 )
double t, t_u, t_l;
int_t u_blks;
#endif
/* Initialization. */
iam = grid->iam;
myrow = MYROW( iam, grid );
mycol = MYCOL( iam, grid );
for (i = 0; i < NBUFFERS; ++i) mybufmax[i] = 0;
nsupers = supno[n-1] + 1;
Astore = A->Store;
a = Astore->nzval;
asub = Astore->rowind;
xa_begin = Astore->colbeg;
xa_end = Astore->colend;
#if ( PRNTlevel>=1 )
iword = sizeof(int_t);
dword = sizeof(double);
#endif
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter ddistribute()");
#endif
if ( fact == SamePattern_SameRowPerm ) {
/* ---------------------------------------------------------------
* REUSE THE L AND U DATA STRUCTURES FROM A PREVIOUS FACTORIZATION.
* --------------------------------------------------------------- */
#if ( PROFlevel>=1 )
t_l = t_u = 0; u_blks = 0;
#endif
/* We can propagate the new values of A into the existing
L and U data structures. */
ilsum = Llu->ilsum;
ldaspa = Llu->ldalsum;
if ( !(dense = doubleCalloc_dist(((size_t)ldaspa) * sp_ienv_dist(3))) )
ABORT("Calloc fails for SPA dense[].");
nrbu = CEILING( nsupers, grid->nprow ); /* No. of local block rows */
if ( !(Urb_length = intCalloc_dist(nrbu)) )
ABORT("Calloc fails for Urb_length[].");
if ( !(Urb_indptr = intMalloc_dist(nrbu)) )
ABORT("Malloc fails for Urb_indptr[].");
Lrowind_bc_ptr = Llu->Lrowind_bc_ptr;
Lnzval_bc_ptr = Llu->Lnzval_bc_ptr;
Ufstnz_br_ptr = Llu->Ufstnz_br_ptr;
Unzval_br_ptr = Llu->Unzval_br_ptr;
#if ( PRNTlevel>=1 )
mem_use += 2.0*nrbu*iword + ldaspa*sp_ienv_dist(3)*dword;
#endif
#if ( PROFlevel>=1 )
t = SuperLU_timer_();
#endif
/* Initialize Uval to zero. */
for (lb = 0; lb < nrbu; ++lb) {
Urb_indptr[lb] = BR_HEADER; /* Skip header in U index[]. */
index = Ufstnz_br_ptr[lb];
if ( index ) {
uval = Unzval_br_ptr[lb];
len = index[1];
for (i = 0; i < len; ++i) uval[i] = zero;
} /* if index != NULL */
} /* for lb ... */
for (jb = 0; jb < nsupers; ++jb) { /* Loop through each block column */
pc = PCOL( jb, grid );
if ( mycol == pc ) { /* Block column jb in my process column */
fsupc = FstBlockC( jb );
nsupc = SuperSize( jb );
/* Scatter A into SPA (for L), or into U directly. */
for (j = fsupc, dense_col = dense; j < FstBlockC(jb+1); ++j) {
for (i = xa_begin[j]; i < xa_end[j]; ++i) {
irow = asub[i];
gb = BlockNum( irow );
if ( myrow == PROW( gb, grid ) ) {
lb = LBi( gb, grid );
if ( gb < jb ) { /* in U */
index = Ufstnz_br_ptr[lb];
uval = Unzval_br_ptr[lb];
while ( (k = index[Urb_indptr[lb]]) < jb ) {
/* Skip nonzero values in this block */
Urb_length[lb] += index[Urb_indptr[lb]+1];
/* Move pointer to the next block */
Urb_indptr[lb] += UB_DESCRIPTOR
+ SuperSize( k );
}
/*assert(k == jb);*/
/* start fstnz */
istart = Urb_indptr[lb] + UB_DESCRIPTOR;
len = Urb_length[lb];
fsupc1 = FstBlockC( gb+1 );
k = j - fsupc;
/* Sum the lengths of the leading columns */
for (jj = 0; jj < k; ++jj)
len += fsupc1 - index[istart++];
/*assert(irow>=index[istart]);*/
uval[len + irow - index[istart]] = a[i];
} else { /* in L; put in SPA first */
irow = ilsum[lb] + irow - FstBlockC( gb );
dense_col[irow] = a[i];
}
}
} /* for i ... */
dense_col += ldaspa;
} /* for j ... */
#if ( PROFlevel>=1 )
t_u += SuperLU_timer_() - t;
t = SuperLU_timer_();
#endif
/* Gather the values of A from SPA into Lnzval[]. */
ljb = LBj( jb, grid ); /* Local block number */
index = Lrowind_bc_ptr[ljb];
if ( index ) {
nrbl = index[0]; /* Number of row blocks. */
len = index[1]; /* LDA of lusup[]. */
lusup = Lnzval_bc_ptr[ljb];
next_lind = BC_HEADER;
next_lval = 0;
for (jj = 0; jj < nrbl; ++jj) {
gb = index[next_lind++];
len1 = index[next_lind++]; /* Rows in the block. */
lb = LBi( gb, grid );
for (bnnz = 0; bnnz < len1; ++bnnz) {
irow = index[next_lind++]; /* Global index. */
irow = ilsum[lb] + irow - FstBlockC( gb );
k = next_lval++;
for (j = 0, dense_col = dense; j < nsupc; ++j) {
lusup[k] = dense_col[irow];
dense_col[irow] = zero;
k += len;
dense_col += ldaspa;
}
} /* for bnnz ... */
} /* for jj ... */
} /* if index ... */
#if ( PROFlevel>=1 )
t_l += SuperLU_timer_() - t;
#endif
} /* if mycol == pc */
} /* for jb ... */
SUPERLU_FREE(dense);
SUPERLU_FREE(Urb_length);
SUPERLU_FREE(Urb_indptr);
#if ( PROFlevel>=1 )
if ( !iam ) printf(".. 2nd distribute time: L %.2f\tU %.2f\tu_blks %d\tnrbu %d\n",
t_l, t_u, u_blks, nrbu);
#endif
} else {
/* --------------------------------------------------
* FIRST TIME CREATING THE L AND U DATA STRUCTURE.
* -------------------------------------------------- */
#if ( PROFlevel>=1 )
t_l = t_u = 0; u_blks = 0;
#endif
/* No L and U data structures are available yet.
We need to set up the L and U data structures and propagate
the values of A into them. */
lsub = Glu_freeable->lsub; /* compressed L subscripts */
xlsub = Glu_freeable->xlsub;
usub = Glu_freeable->usub; /* compressed U subscripts */
xusub = Glu_freeable->xusub;
if ( !(ToRecv = SUPERLU_MALLOC(nsupers * sizeof(int))) )
ABORT("Malloc fails for ToRecv[].");
for (i = 0; i < nsupers; ++i) ToRecv[i] = 0;
k = CEILING( nsupers, grid->npcol );/* Number of local column blocks */
if ( !(ToSendR = (int **) SUPERLU_MALLOC(k*sizeof(int*))) )
ABORT("Malloc fails for ToSendR[].");
j = k * grid->npcol;
if ( !(index1 = SUPERLU_MALLOC(j * sizeof(int))) )
ABORT("Malloc fails for index[].");
#if ( PRNTlevel>=1 )
mem_use += (float) k*sizeof(int_t*) + (j + nsupers)*iword;
#endif
for (i = 0; i < j; ++i) index1[i] = EMPTY;
for (i = 0,j = 0; i < k; ++i, j += grid->npcol) ToSendR[i] = &index1[j];
k = CEILING( nsupers, grid->nprow ); /* Number of local block rows */
/* Pointers to the beginning of each block row of U. */
if ( !(Unzval_br_ptr =
(double**)SUPERLU_MALLOC(k * sizeof(double*))) )
ABORT("Malloc fails for Unzval_br_ptr[].");
if ( !(Ufstnz_br_ptr = (int_t**)SUPERLU_MALLOC(k * sizeof(int_t*))) )
ABORT("Malloc fails for Ufstnz_br_ptr[].");
if ( !(ToSendD = SUPERLU_MALLOC(k * sizeof(int))) )
ABORT("Malloc fails for ToSendD[].");
for (i = 0; i < k; ++i) ToSendD[i] = NO;
if ( !(ilsum = intMalloc_dist(k+1)) )
ABORT("Malloc fails for ilsum[].");
/* Auxiliary arrays used to set up U block data structures.
They are freed on return. */
if ( !(rb_marker = intCalloc_dist(k)) )
ABORT("Calloc fails for rb_marker[].");
if ( !(Urb_length = intCalloc_dist(k)) )
ABORT("Calloc fails for Urb_length[].");
if ( !(Urb_indptr = intMalloc_dist(k)) )
ABORT("Malloc fails for Urb_indptr[].");
if ( !(Urb_fstnz = intCalloc_dist(k)) )
ABORT("Calloc fails for Urb_fstnz[].");
if ( !(Ucbs = intCalloc_dist(k)) )
ABORT("Calloc fails for Ucbs[].");
#if ( PRNTlevel>=1 )
mem_use += 2.0*k*sizeof(int_t*) + (7.0*k+1)*iword;
#endif
/* Compute ldaspa and ilsum[]. */
ldaspa = 0;
ilsum[0] = 0;
for (gb = 0; gb < nsupers; ++gb) {
if ( myrow == PROW( gb, grid ) ) {
i = SuperSize( gb );
ldaspa += i;
lb = LBi( gb, grid );
ilsum[lb + 1] = ilsum[lb] + i;
}
}
/* ------------------------------------------------------------
COUNT NUMBER OF ROW BLOCKS AND THE LENGTH OF EACH BLOCK IN U.
THIS ACCOUNTS FOR ONE-PASS PROCESSING OF G(U).
------------------------------------------------------------*/
/* Loop through each supernode column. */
for (jb = 0; jb < nsupers; ++jb) {
pc = PCOL( jb, grid );
fsupc = FstBlockC( jb );
nsupc = SuperSize( jb );
/* Loop through each column in the block. */
for (j = fsupc; j < fsupc + nsupc; ++j) {
/* usub[*] contains only "first nonzero" in each segment. */
for (i = xusub[j]; i < xusub[j+1]; ++i) {
irow = usub[i]; /* First nonzero of the segment. */
gb = BlockNum( irow );
kcol = PCOL( gb, grid );
ljb = LBj( gb, grid );
if ( mycol == kcol && mycol != pc ) ToSendR[ljb][pc] = YES;
pr = PROW( gb, grid );
lb = LBi( gb, grid );
if ( mycol == pc ) {
if ( myrow == pr ) {
ToSendD[lb] = YES;
/* Count nonzeros in entire block row. */
Urb_length[lb] += FstBlockC( gb+1 ) - irow;
if (rb_marker[lb] <= jb) {/* First see the block */
rb_marker[lb] = jb + 1;
Urb_fstnz[lb] += nsupc;
++Ucbs[lb]; /* Number of column blocks
in block row lb. */
#if ( PRNTlevel>=1 )
++nUblocks;
#endif
}
ToRecv[gb] = 1;
} else ToRecv[gb] = 2; /* Do I need 0, 1, 2 ? */
}
} /* for i ... */
} /* for j ... */
} /* for jb ... */
/* Set up the initial pointers for each block row in U. */
nrbu = CEILING( nsupers, grid->nprow );/* Number of local block rows */
for (lb = 0; lb < nrbu; ++lb) {
len = Urb_length[lb];
rb_marker[lb] = 0; /* Reset block marker. */
if ( len ) {
/* Add room for descriptors */
len1 = Urb_fstnz[lb] + BR_HEADER + Ucbs[lb] * UB_DESCRIPTOR;
if ( !(index = intMalloc_dist(len1+1)) )
ABORT("Malloc fails for Uindex[].");
Ufstnz_br_ptr[lb] = index;
if ( !(Unzval_br_ptr[lb] = doubleMalloc_dist(len)) )
ABORT("Malloc fails for Unzval_br_ptr[*][].");
mybufmax[2] = SUPERLU_MAX( mybufmax[2], len1 );
mybufmax[3] = SUPERLU_MAX( mybufmax[3], len );
index[0] = Ucbs[lb]; /* Number of column blocks */
index[1] = len; /* Total length of nzval[] */
index[2] = len1; /* Total length of index[] */
index[len1] = -1; /* End marker */
} else {
Ufstnz_br_ptr[lb] = NULL;
Unzval_br_ptr[lb] = NULL;
}
Urb_length[lb] = 0; /* Reset block length. */
Urb_indptr[lb] = BR_HEADER; /* Skip header in U index[]. */
Urb_fstnz[lb] = BR_HEADER;
} /* for lb ... */
SUPERLU_FREE(Ucbs);
#if ( PROFlevel>=1 )
t = SuperLU_timer_() - t;
if ( !iam) printf(".. Phase 2 - setup U strut time: %.2f\t\n", t);
#endif
#if ( PRNTlevel>=1 )
mem_use -= 2.0*k * iword;
#endif
/* Auxiliary arrays used to set up L block data structures.
They are freed on return.
k is the number of local row blocks. */
if ( !(Lrb_length = intCalloc_dist(k)) )
ABORT("Calloc fails for Lrb_length[].");
if ( !(Lrb_number = intMalloc_dist(k)) )
ABORT("Malloc fails for Lrb_number[].");
if ( !(Lrb_indptr = intMalloc_dist(k)) )
ABORT("Malloc fails for Lrb_indptr[].");
if ( !(Lrb_valptr = intMalloc_dist(k)) )
ABORT("Malloc fails for Lrb_valptr[].");
if (!(dense=doubleCalloc_dist(SUPERLU_MAX(1,((size_t)ldaspa)
*sp_ienv_dist(3)))))
ABORT("Calloc fails for SPA dense[].");
/* These counts will be used for triangular solves. */
if ( !(fmod = intCalloc_dist(k)) )
ABORT("Calloc fails for fmod[].");
if ( !(bmod = intCalloc_dist(k)) )
ABORT("Calloc fails for bmod[].");
#if ( PRNTlevel>=1 )
mem_use += 6.0*k*iword + ldaspa*sp_ienv_dist(3)*dword;
#endif
k = CEILING( nsupers, grid->npcol );/* Number of local block columns */
/* Pointers to the beginning of each block column of L. */
if ( !(Lnzval_bc_ptr = (double**)SUPERLU_MALLOC(k * sizeof(double*))) )
ABORT("Malloc fails for Lnzval_bc_ptr[].");
if ( !(Lrowind_bc_ptr = (int_t**)SUPERLU_MALLOC(k * sizeof(int_t*))) )
ABORT("Malloc fails for Lrowind_bc_ptr[].");
Lrowind_bc_ptr[k-1] = NULL;
/* These lists of processes will be used for triangular solves. */
if ( !(fsendx_plist = (int_t **) SUPERLU_MALLOC(k*sizeof(int_t*))) )
ABORT("Malloc fails for fsendx_plist[].");
len = k * grid->nprow;
if ( !(index = intMalloc_dist(len)) )
ABORT("Malloc fails for fsendx_plist[0]");
for (i = 0; i < len; ++i) index[i] = EMPTY;
for (i = 0, j = 0; i < k; ++i, j += grid->nprow)
fsendx_plist[i] = &index[j];
if ( !(bsendx_plist = (int_t **) SUPERLU_MALLOC(k*sizeof(int_t*))) )
ABORT("Malloc fails for bsendx_plist[].");
if ( !(index = intMalloc_dist(len)) )
ABORT("Malloc fails for bsendx_plist[0]");
for (i = 0; i < len; ++i) index[i] = EMPTY;
for (i = 0, j = 0; i < k; ++i, j += grid->nprow)
bsendx_plist[i] = &index[j];
#if ( PRNTlevel>=1 )
mem_use += 4.0*k*sizeof(int_t*) + 2.0*len*iword;
#endif
/*------------------------------------------------------------
PROPAGATE ROW SUBSCRIPTS AND VALUES OF A INTO L AND U BLOCKS.
THIS ACCOUNTS FOR ONE-PASS PROCESSING OF A, L AND U.
------------------------------------------------------------*/
for (jb = 0; jb < nsupers; ++jb) {
pc = PCOL( jb, grid );
if ( mycol == pc ) { /* Block column jb in my process column */
fsupc = FstBlockC( jb );
nsupc = SuperSize( jb );
ljb = LBj( jb, grid ); /* Local block number */
/* Scatter A into SPA. */
for (j = fsupc, dense_col = dense; j < FstBlockC( jb+1 ); ++j){
for (i = xa_begin[j]; i < xa_end[j]; ++i) {
irow = asub[i];
gb = BlockNum( irow );
if ( myrow == PROW( gb, grid ) ) {
lb = LBi( gb, grid );
irow = ilsum[lb] + irow - FstBlockC( gb );
dense_col[irow] = a[i];
}
}
dense_col += ldaspa;
}
jbrow = PROW( jb, grid );
#if ( PROFlevel>=1 )
t = SuperLU_timer_();
#endif
/*------------------------------------------------
* SET UP U BLOCKS.
*------------------------------------------------*/
kseen = 0;
dense_col = dense;
/* Loop through each column in the block column. */
for (j = fsupc; j < FstBlockC( jb+1 ); ++j) {
istart = xusub[j];
/* NOTE: Only the first nonzero index of the segment
is stored in usub[]. */
for (i = istart; i < xusub[j+1]; ++i) {
irow = usub[i]; /* First nonzero in the segment. */
gb = BlockNum( irow );
pr = PROW( gb, grid );
if ( pr != jbrow &&
myrow == jbrow && /* diag. proc. owning jb */
bsendx_plist[ljb][pr] == EMPTY ) {
bsendx_plist[ljb][pr] = YES;
++nbsendx;
}
if ( myrow == pr ) {
lb = LBi( gb, grid ); /* Local block number */
index = Ufstnz_br_ptr[lb];
uval = Unzval_br_ptr[lb];
fsupc1 = FstBlockC( gb+1 );
if (rb_marker[lb] <= jb) { /* First time see
the block */
rb_marker[lb] = jb + 1;
Urb_indptr[lb] = Urb_fstnz[lb];;
index[Urb_indptr[lb]] = jb; /* Descriptor */
Urb_indptr[lb] += UB_DESCRIPTOR;
/* Record the first location in index[] of the
next block */
Urb_fstnz[lb] = Urb_indptr[lb] + nsupc;
len = Urb_indptr[lb];/* Start fstnz in index */
index[len-1] = 0;
for (k = 0; k < nsupc; ++k)
index[len+k] = fsupc1;
if ( gb != jb )/* Exclude diagonal block. */
++bmod[lb];/* Mod. count for back solve */
if ( kseen == 0 && myrow != jbrow ) {
++nbrecvx;
kseen = 1;
}
} else { /* Already saw the block */
len = Urb_indptr[lb];/* Start fstnz in index */
}
jj = j - fsupc;
index[len+jj] = irow;
/* Load the numerical values */
k = fsupc1 - irow; /* No. of nonzeros in segment */
index[len-1] += k; /* Increment block length in
Descriptor */
irow = ilsum[lb] + irow - FstBlockC( gb );
for (ii = 0; ii < k; ++ii) {
uval[Urb_length[lb]++] = dense_col[irow + ii];
dense_col[irow + ii] = zero;
}
} /* if myrow == pr ... */
} /* for i ... */
dense_col += ldaspa;
} /* for j ... */
#if ( PROFlevel>=1 )
t_u += SuperLU_timer_() - t;
t = SuperLU_timer_();
#endif
/*------------------------------------------------
* SET UP L BLOCKS.
*------------------------------------------------*/
/* Count number of blocks and length of each block. */
nrbl = 0;
len = 0; /* Number of row subscripts I own. */
kseen = 0;
istart = xlsub[fsupc];
for (i = istart; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
gb = BlockNum( irow ); /* Global block number */
pr = PROW( gb, grid ); /* Process row owning this block */
if ( pr != jbrow &&
myrow == jbrow && /* diag. proc. owning jb */
fsendx_plist[ljb][pr] == EMPTY /* first time */ ) {
fsendx_plist[ljb][pr] = YES;
++nfsendx;
}
if ( myrow == pr ) {
lb = LBi( gb, grid ); /* Local block number */
if (rb_marker[lb] <= jb) { /* First see this block */
rb_marker[lb] = jb + 1;
Lrb_length[lb] = 1;
Lrb_number[nrbl++] = gb;
if ( gb != jb ) /* Exclude diagonal block. */
++fmod[lb]; /* Mod. count for forward solve */
if ( kseen == 0 && myrow != jbrow ) {
++nfrecvx;
kseen = 1;
}
#if ( PRNTlevel>=1 )
++nLblocks;
#endif
} else {
++Lrb_length[lb];
}
++len;
}
} /* for i ... */
if ( nrbl ) { /* Do not ensure the blocks are sorted! */
/* Set up the initial pointers for each block in
index[] and nzval[]. */
/* Add room for descriptors */
len1 = len + BC_HEADER + nrbl * LB_DESCRIPTOR;
if ( !(index = intMalloc_dist(len1)) )
ABORT("Malloc fails for index[]");
Lrowind_bc_ptr[ljb] = index;
if (!(Lnzval_bc_ptr[ljb] = doubleMalloc_dist(((size_t)len)*nsupc))) {
fprintf(stderr, "col block " IFMT " ", jb);
ABORT("Malloc fails for Lnzval_bc_ptr[*][]");
}
mybufmax[0] = SUPERLU_MAX( mybufmax[0], len1 );
mybufmax[1] = SUPERLU_MAX( mybufmax[1], len*nsupc );
mybufmax[4] = SUPERLU_MAX( mybufmax[4], len );
index[0] = nrbl; /* Number of row blocks */
index[1] = len; /* LDA of the nzval[] */
next_lind = BC_HEADER;
next_lval = 0;
for (k = 0; k < nrbl; ++k) {
gb = Lrb_number[k];
lb = LBi( gb, grid );
len = Lrb_length[lb];
Lrb_length[lb] = 0; /* Reset vector of block length */
index[next_lind++] = gb; /* Descriptor */
index[next_lind++] = len;
Lrb_indptr[lb] = next_lind;
Lrb_valptr[lb] = next_lval;
next_lind += len;
next_lval += len;
}
/* Propagate the compressed row subscripts to Lindex[], and
the initial values of A from SPA into Lnzval[]. */
lusup = Lnzval_bc_ptr[ljb];
len = index[1]; /* LDA of lusup[] */
for (i = istart; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
gb = BlockNum( irow );
if ( myrow == PROW( gb, grid ) ) {
lb = LBi( gb, grid );
k = Lrb_indptr[lb]++; /* Random access a block */
index[k] = irow;
k = Lrb_valptr[lb]++;
irow = ilsum[lb] + irow - FstBlockC( gb );
for (j = 0, dense_col = dense; j < nsupc; ++j) {
lusup[k] = dense_col[irow];
dense_col[irow] = 0.0;
k += len;
dense_col += ldaspa;
}
}
} /* for i ... */
} else {
Lrowind_bc_ptr[ljb] = NULL;
Lnzval_bc_ptr[ljb] = NULL;
} /* if nrbl ... */
#if ( PROFlevel>=1 )
t_l += SuperLU_timer_() - t;
#endif
} /* if mycol == pc */
} /* for jb ... */
Llu->Lrowind_bc_ptr = Lrowind_bc_ptr;
Llu->Lnzval_bc_ptr = Lnzval_bc_ptr;
Llu->Ufstnz_br_ptr = Ufstnz_br_ptr;
Llu->Unzval_br_ptr = Unzval_br_ptr;
Llu->ToRecv = ToRecv;
Llu->ToSendD = ToSendD;
Llu->ToSendR = ToSendR;
Llu->fmod = fmod;
Llu->fsendx_plist = fsendx_plist;
Llu->nfrecvx = nfrecvx;
Llu->nfsendx = nfsendx;
Llu->bmod = bmod;
Llu->bsendx_plist = bsendx_plist;
Llu->nbrecvx = nbrecvx;
Llu->nbsendx = nbsendx;
Llu->ilsum = ilsum;
Llu->ldalsum = ldaspa;
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. # L blocks " IFMT "\t# U blocks " IFMT "\n",
nLblocks, nUblocks);
#endif
SUPERLU_FREE(rb_marker);
SUPERLU_FREE(Urb_fstnz);
SUPERLU_FREE(Urb_length);
SUPERLU_FREE(Urb_indptr);
SUPERLU_FREE(Lrb_length);
SUPERLU_FREE(Lrb_number);
SUPERLU_FREE(Lrb_indptr);
SUPERLU_FREE(Lrb_valptr);
SUPERLU_FREE(dense);
k = CEILING( nsupers, grid->nprow );/* Number of local block rows */
if ( !(Llu->mod_bit = intMalloc_dist(k)) )
ABORT("Malloc fails for mod_bit[].");
/* Find the maximum buffer size. */
MPI_Allreduce(mybufmax, Llu->bufmax, NBUFFERS, mpi_int_t,
MPI_MAX, grid->comm);
#if ( PROFlevel>=1 )
if ( !iam ) printf(".. 1st distribute time:\n "
"\tL\t%.2f\n\tU\t%.2f\n"
"\tu_blks %d\tnrbu %d\n--------\n",
t_l, t_u, u_blks, nrbu);
#endif
} /* else fact != SamePattern_SameRowPerm */
#if ( DEBUGlevel>=1 )
/* Memory allocated but not freed:
ilsum, fmod, fsendx_plist, bmod, bsendx_plist */
CHECK_MALLOC(iam, "Exit ddistribute()");
#endif
return (mem_use);
} /* DDISTRIBUTE */
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
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_t
pddistribute(fact_t fact, int_t n, SuperMatrix *A,
ScalePermstruct_t *ScalePermstruct,
Glu_freeable_t *Glu_freeable, LUstruct_t *LUstruct,
gridinfo_t *grid)
/*
* -- Distributed SuperLU routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley.
* March 15, 2003
*
*
* Purpose
* =======
* Distribute the matrix onto the 2D process mesh.
*
* Arguments
* =========
*
* fact (input) fact_t
* Specifies whether or not the L and U structures will be re-used.
* = SamePattern_SameRowPerm: L and U structures are input, and
* unchanged on exit.
* = DOFACT or SamePattern: L and U structures are computed and output.
*
* n (input) int
* Dimension of the matrix.
*
* A (input) SuperMatrix*
* The distributed input matrix A of dimension (A->nrow, A->ncol).
* A may be overwritten by diag(R)*A*diag(C)*Pc^T.
* The type of A can be: Stype = NR; Dtype = SLU_D; Mtype = GE.
*
* ScalePermstruct (input) ScalePermstruct_t*
* The data structure to store the scaling and permutation vectors
* describing the transformations performed to the original matrix A.
*
* Glu_freeable (input) *Glu_freeable_t
* The global structure describing the graph of L and U.
*
* LUstruct (input) LUstruct_t*
* Data structures for L and U factors.
*
* grid (input) gridinfo_t*
* The 2D process mesh.
*
* Return value
* ============
* > 0, working storage required (in bytes).
*
*/
{
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
LocalLU_t *Llu = LUstruct->Llu;
int_t bnnz, fsupc, i, irow, istart, j, jb, jj, k, len, len1, nsupc;
int_t ljb; /* local block column number */
int_t nrbl; /* number of L blocks in current block column */
int_t nrbu; /* number of U blocks in current block column */
int_t gb; /* global block number; 0 < gb <= nsuper */
int_t lb; /* local block number; 0 < lb <= ceil(NSUPERS/Pr) */
int iam, jbrow, kcol, mycol, myrow, pc, pr;
int_t mybufmax[NBUFFERS];
#if 0
NCPformat *Astore;
#else /* XSL ==> */
NRformat_loc *Astore;
#endif
double *a;
int_t *asub, *xa;
#if 0
int_t *xa_begin, *xa_end;
#endif
int_t *xsup = Glu_persist->xsup; /* supernode and column mapping */
int_t *supno = Glu_persist->supno;
int_t *lsub, *xlsub, *usub, *xusub;
int_t nsupers;
int_t next_lind; /* next available position in index[*] */
int_t next_lval; /* next available position in nzval[*] */
int_t *index; /* indices consist of headers and row subscripts */
double *lusup, *uval; /* nonzero values in L and U */
double **Lnzval_bc_ptr; /* size ceil(NSUPERS/Pc) */
int_t **Lrowind_bc_ptr; /* size ceil(NSUPERS/Pc) */
double **Unzval_br_ptr; /* size ceil(NSUPERS/Pr) */
int_t **Ufstnz_br_ptr; /* size ceil(NSUPERS/Pr) */
/*-- Counts to be used in factorization. --*/
int_t *ToRecv, *ToSendD, **ToSendR;
/*-- Counts to be used in lower triangular solve. --*/
int_t *fmod; /* Modification count for L-solve. */
int_t **fsendx_plist; /* Column process list to send down Xk. */
int_t nfrecvx = 0; /* Number of Xk I will receive. */
int_t kseen;
/*-- Counts to be used in upper triangular solve. --*/
int_t *bmod; /* Modification count for U-solve. */
int_t **bsendx_plist; /* Column process list to send down Xk. */
int_t nbrecvx = 0; /* Number of Xk I will receive. */
int_t *ilsum; /* starting position of each supernode in
the full array (local) */
/*-- Auxiliary arrays; freed on return --*/
int_t *rb_marker; /* block hit marker; size ceil(NSUPERS/Pr) */
int_t *Urb_length; /* U block length; size ceil(NSUPERS/Pr) */
int_t *Urb_indptr; /* pointers to U index[]; size ceil(NSUPERS/Pr) */
int_t *Urb_fstnz; /* # of fstnz in a block row; size ceil(NSUPERS/Pr) */
int_t *Ucbs; /* number of column blocks in a block row */
int_t *Lrb_length; /* L block length; size ceil(NSUPERS/Pr) */
int_t *Lrb_number; /* global block number; size ceil(NSUPERS/Pr) */
int_t *Lrb_indptr; /* pointers to L index[]; size ceil(NSUPERS/Pr) */
int_t *Lrb_valptr; /* pointers to L nzval[]; size ceil(NSUPERS/Pr) */
double *dense, *dense_col; /* SPA */
double zero = 0.0;
int_t ldaspa; /* LDA of SPA */
int_t mem_use = 0, iword, dword;
#if ( PRNTlevel>=1 )
int_t nLblocks = 0, nUblocks = 0;
#endif
#if ( PROFlevel>=1 )
double t, t_u, t_l;
int_t u_blks;
#endif
/* Initialization. */
iam = grid->iam;
myrow = MYROW( iam, grid );
mycol = MYCOL( iam, grid );
for (i = 0; i < NBUFFERS; ++i) mybufmax[i] = 0;
nsupers = supno[n-1] + 1;
Astore = (NRformat_loc *) A->Store;
#if ( PRNTlevel>=1 )
iword = sizeof(int_t);
dword = sizeof(double);
#endif
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pddistribute()");
#endif
dReDistribute_A(A, ScalePermstruct, Glu_freeable, xsup, supno,
grid, &xa, &asub, &a);
if ( fact == SamePattern_SameRowPerm ) {
#if ( PROFlevel>=1 )
t_l = t_u = 0; u_blks = 0;
#endif
/* We can propagate the new values of A into the existing
L and U data structures. */
ilsum = Llu->ilsum;
ldaspa = Llu->ldalsum;
if ( !(dense = doubleCalloc_dist(ldaspa * sp_ienv_dist(3))) )
ABORT("Calloc fails for SPA dense[].");
nrbu = CEILING( nsupers, grid->nprow ); /* Number of local block rows */
if ( !(Urb_length = intCalloc_dist(nrbu)) )
ABORT("Calloc fails for Urb_length[].");
if ( !(Urb_indptr = intMalloc_dist(nrbu)) )
ABORT("Malloc fails for Urb_indptr[].");
for (lb = 0; lb < nrbu; ++lb)
Urb_indptr[lb] = BR_HEADER; /* Skip header in U index[]. */
Lrowind_bc_ptr = Llu->Lrowind_bc_ptr;
Lnzval_bc_ptr = Llu->Lnzval_bc_ptr;
Ufstnz_br_ptr = Llu->Ufstnz_br_ptr;
Unzval_br_ptr = Llu->Unzval_br_ptr;
#if ( PRNTlevel>=1 )
mem_use += 2*nrbu*iword + ldaspa*sp_ienv_dist(3)*dword;
#endif
for (jb = 0; jb < nsupers; ++jb) { /* Loop through each block column */
pc = PCOL( jb, grid );
if ( mycol == pc ) { /* Block column jb in my process column */
fsupc = FstBlockC( jb );
nsupc = SuperSize( jb );
/* Scatter A into SPA. */
for (j = fsupc, dense_col = dense; j < FstBlockC(jb+1); ++j) {
for (i = xa[j]; i < xa[j+1]; ++i) {
irow = asub[i];
gb = BlockNum( irow );
if ( myrow == PROW( gb, grid ) ) {
lb = LBi( gb, grid );
irow = ilsum[lb] + irow - FstBlockC( gb );
dense_col[irow] = a[i];
}
}
dense_col += ldaspa;
}
#if ( PROFlevel>=1 )
t = SuperLU_timer_();
#endif
/* Gather the values of A from SPA into Unzval[]. */
for (lb = 0; lb < nrbu; ++lb) {
index = Ufstnz_br_ptr[lb];
if ( index && index[Urb_indptr[lb]] == jb ) {
uval = Unzval_br_ptr[lb];
len = Urb_indptr[lb] + UB_DESCRIPTOR;
gb = lb * grid->nprow + myrow;/* Global block number */
k = FstBlockC( gb+1 );
irow = ilsum[lb] - FstBlockC( gb );
for (jj = 0, dense_col = dense; jj < nsupc; ++jj) {
j = index[len+jj];
for (i = j; i < k; ++i) {
uval[Urb_length[lb]++] = dense_col[irow+i];
dense_col[irow+i] = zero;
}
dense_col += ldaspa;
}
Urb_indptr[lb] += UB_DESCRIPTOR + nsupc;
} /* if index != NULL */
} /* for lb ... */
#if ( PROFlevel>=1 )
t_u += SuperLU_timer_() - t;
t = SuperLU_timer_();
#endif
/* Gather the values of A from SPA into Lnzval[]. */
ljb = LBj( jb, grid ); /* Local block number */
index = Lrowind_bc_ptr[ljb];
if ( index ) {
nrbl = index[0]; /* Number of row blocks. */
len = index[1]; /* LDA of lusup[]. */
lusup = Lnzval_bc_ptr[ljb];
next_lind = BC_HEADER;
next_lval = 0;
for (jj = 0; jj < nrbl; ++jj) {
gb = index[next_lind++];
len1 = index[next_lind++]; /* Rows in the block. */
lb = LBi( gb, grid );
for (bnnz = 0; bnnz < len1; ++bnnz) {
irow = index[next_lind++]; /* Global index. */
irow = ilsum[lb] + irow - FstBlockC( gb );
k = next_lval++;
for (j = 0, dense_col = dense; j < nsupc; ++j) {
lusup[k] = dense_col[irow];
dense_col[irow] = zero;
k += len;
dense_col += ldaspa;
}
} /* for bnnz ... */
} /* for jj ... */
} /* if index ... */
#if ( PROFlevel>=1 )
t_l += SuperLU_timer_() - t;
#endif
} /* if mycol == pc */
} /* for jb ... */
SUPERLU_FREE(dense);
SUPERLU_FREE(Urb_length);
SUPERLU_FREE(Urb_indptr);
#if ( PROFlevel>=1 )
if ( !iam ) printf(".. 2nd distribute time: L %.2f\tU %.2f\tu_blks %d\tnrbu %d\n",
t_l, t_u, u_blks, nrbu);
#endif
} else {
/* ------------------------------------------------------------
FIRST TIME CREATING THE L AND U DATA STRUCTURES.
------------------------------------------------------------*/
#if ( PROFlevel>=1 )
t_l = t_u = 0; u_blks = 0;
#endif
/* We first need to set up the L and U data structures and then
* propagate the values of A into them.
*/
lsub = Glu_freeable->lsub; /* compressed L subscripts */
xlsub = Glu_freeable->xlsub;
usub = Glu_freeable->usub; /* compressed U subscripts */
xusub = Glu_freeable->xusub;
if ( !(ToRecv = intCalloc_dist(nsupers)) )
ABORT("Calloc fails for ToRecv[].");
k = CEILING( nsupers, grid->npcol );/* Number of local column blocks */
if ( !(ToSendR = (int_t **) SUPERLU_MALLOC(k*sizeof(int_t*))) )
ABORT("Malloc fails for ToSendR[].");
j = k * grid->npcol;
if ( !(index = intMalloc_dist(j)) )
ABORT("Malloc fails for index[].");
#if ( PRNTlevel>=1 )
mem_use = k*sizeof(int_t*) + (j + nsupers)*iword;
#endif
for (i = 0; i < j; ++i) index[i] = EMPTY;
for (i = 0,j = 0; i < k; ++i, j += grid->npcol) ToSendR[i] = &index[j];
k = CEILING( nsupers, grid->nprow ); /* Number of local block rows */
/* Pointers to the beginning of each block row of U. */
if ( !(Unzval_br_ptr =
(double**)SUPERLU_MALLOC(k * sizeof(double*))) )
ABORT("Malloc fails for Unzval_br_ptr[].");
if ( !(Ufstnz_br_ptr = (int_t**)SUPERLU_MALLOC(k * sizeof(int_t*))) )
ABORT("Malloc fails for Ufstnz_br_ptr[].");
if ( !(ToSendD = intCalloc_dist(k)) )
ABORT("Malloc fails for ToSendD[].");
if ( !(ilsum = intMalloc_dist(k+1)) )
ABORT("Malloc fails for ilsum[].");
/* Auxiliary arrays used to set up U block data structures.
They are freed on return. */
if ( !(rb_marker = intCalloc_dist(k)) )
ABORT("Calloc fails for rb_marker[].");
if ( !(Urb_length = intCalloc_dist(k)) )
ABORT("Calloc fails for Urb_length[].");
if ( !(Urb_indptr = intMalloc_dist(k)) )
ABORT("Malloc fails for Urb_indptr[].");
if ( !(Urb_fstnz = intCalloc_dist(k)) )
ABORT("Calloc fails for Urb_fstnz[].");
if ( !(Ucbs = intCalloc_dist(k)) )
ABORT("Calloc fails for Ucbs[].");
#if ( PRNTlevel>=1 )
mem_use = 2*k*sizeof(int_t*) + (7*k+1)*iword;
#endif
/* Compute ldaspa and ilsum[]. */
ldaspa = 0;
ilsum[0] = 0;
for (gb = 0; gb < nsupers; ++gb) {
if ( myrow == PROW( gb, grid ) ) {
i = SuperSize( gb );
ldaspa += i;
lb = LBi( gb, grid );
ilsum[lb + 1] = ilsum[lb] + i;
}
}
/* ------------------------------------------------------------
COUNT NUMBER OF ROW BLOCKS AND THE LENGTH OF EACH BLOCK IN U.
THIS ACCOUNTS FOR ONE-PASS PROCESSING OF G(U).
------------------------------------------------------------*/
/* Loop through each supernode column. */
for (jb = 0; jb < nsupers; ++jb) {
pc = PCOL( jb, grid );
fsupc = FstBlockC( jb );
nsupc = SuperSize( jb );
/* Loop through each column in the block. */
for (j = fsupc; j < fsupc + nsupc; ++j) {
/* usub[*] contains only "first nonzero" in each segment. */
for (i = xusub[j]; i < xusub[j+1]; ++i) {
irow = usub[i]; /* First nonzero of the segment. */
gb = BlockNum( irow );
kcol = PCOL( gb, grid );
ljb = LBj( gb, grid );
if ( mycol == kcol && mycol != pc ) ToSendR[ljb][pc] = YES;
pr = PROW( gb, grid );
lb = LBi( gb, grid );
if ( mycol == pc ) {
if ( myrow == pr ) {
ToSendD[lb] = YES;
/* Count nonzeros in entire block row. */
Urb_length[lb] += FstBlockC( gb+1 ) - irow;
if (rb_marker[lb] <= jb) {/* First see the block */
rb_marker[lb] = jb + 1;
Urb_fstnz[lb] += nsupc;
++Ucbs[lb]; /* Number of column blocks
in block row lb. */
#if ( PRNTlevel>=1 )
++nUblocks;
#endif
}
ToRecv[gb] = 1;
} else ToRecv[gb] = 2; /* Do I need 0, 1, 2 ? */
}
} /* for i ... */
} /* for j ... */
} /* for jb ... */
/* Set up the initial pointers for each block row in U. */
nrbu = CEILING( nsupers, grid->nprow );/* Number of local block rows */
for (lb = 0; lb < nrbu; ++lb) {
len = Urb_length[lb];
rb_marker[lb] = 0; /* Reset block marker. */
if ( len ) {
/* Add room for descriptors */
len1 = Urb_fstnz[lb] + BR_HEADER + Ucbs[lb] * UB_DESCRIPTOR;
if ( !(index = intMalloc_dist(len1+1)) )
ABORT("Malloc fails for Uindex[].");
Ufstnz_br_ptr[lb] = index;
if ( !(Unzval_br_ptr[lb] = doubleMalloc_dist(len)) )
ABORT("Malloc fails for Unzval_br_ptr[*][].");
mybufmax[2] = SUPERLU_MAX( mybufmax[2], len1 );
mybufmax[3] = SUPERLU_MAX( mybufmax[3], len );
index[0] = Ucbs[lb]; /* Number of column blocks */
index[1] = len; /* Total length of nzval[] */
index[2] = len1; /* Total length of index[] */
index[len1] = -1; /* End marker */
} else {
Ufstnz_br_ptr[lb] = NULL;
Unzval_br_ptr[lb] = NULL;
}
Urb_length[lb] = 0; /* Reset block length. */
Urb_indptr[lb] = BR_HEADER; /* Skip header in U index[]. */
} /* for lb ... */
SUPERLU_FREE(Urb_fstnz);
SUPERLU_FREE(Ucbs);
#if ( PRNTlevel>=1 )
mem_use -= 2*k * iword;
#endif
/* Auxiliary arrays used to set up L block data structures.
They are freed on return.
k is the number of local row blocks. */
if ( !(Lrb_length = intCalloc_dist(k)) )
ABORT("Calloc fails for Lrb_length[].");
if ( !(Lrb_number = intMalloc_dist(k)) )
ABORT("Malloc fails for Lrb_number[].");
if ( !(Lrb_indptr = intMalloc_dist(k)) )
ABORT("Malloc fails for Lrb_indptr[].");
if ( !(Lrb_valptr = intMalloc_dist(k)) )
ABORT("Malloc fails for Lrb_valptr[].");
if ( !(dense = doubleCalloc_dist(ldaspa * sp_ienv_dist(3))) )
ABORT("Calloc fails for SPA dense[].");
/* These counts will be used for triangular solves. */
if ( !(fmod = intCalloc_dist(k)) )
ABORT("Calloc fails for fmod[].");
if ( !(bmod = intCalloc_dist(k)) )
ABORT("Calloc fails for bmod[].");
/* ------------------------------------------------ */
#if ( PRNTlevel>=1 )
mem_use += 6*k*iword + ldaspa*sp_ienv_dist(3)*dword;
#endif
k = CEILING( nsupers, grid->npcol );/* Number of local block columns */
/* Pointers to the beginning of each block column of L. */
if ( !(Lnzval_bc_ptr =
(double**)SUPERLU_MALLOC(k * sizeof(double*))) )
ABORT("Malloc fails for Lnzval_bc_ptr[].");
if ( !(Lrowind_bc_ptr = (int_t**)SUPERLU_MALLOC(k * sizeof(int_t*))) )
ABORT("Malloc fails for Lrowind_bc_ptr[].");
Lrowind_bc_ptr[k-1] = NULL;
/* These lists of processes will be used for triangular solves. */
if ( !(fsendx_plist = (int_t **) SUPERLU_MALLOC(k*sizeof(int_t*))) )
ABORT("Malloc fails for fsendx_plist[].");
len = k * grid->nprow;
if ( !(index = intMalloc_dist(len)) )
ABORT("Malloc fails for fsendx_plist[0]");
for (i = 0; i < len; ++i) index[i] = EMPTY;
for (i = 0, j = 0; i < k; ++i, j += grid->nprow)
fsendx_plist[i] = &index[j];
if ( !(bsendx_plist = (int_t **) SUPERLU_MALLOC(k*sizeof(int_t*))) )
ABORT("Malloc fails for bsendx_plist[].");
if ( !(index = intMalloc_dist(len)) )
ABORT("Malloc fails for bsendx_plist[0]");
for (i = 0; i < len; ++i) index[i] = EMPTY;
for (i = 0, j = 0; i < k; ++i, j += grid->nprow)
bsendx_plist[i] = &index[j];
/* -------------------------------------------------------------- */
#if ( PRNTlevel>=1 )
mem_use += 4*k*sizeof(int_t*) + 2*len*iword;
#endif
/*------------------------------------------------------------
PROPAGATE ROW SUBSCRIPTS AND VALUES OF A INTO L AND U BLOCKS.
THIS ACCOUNTS FOR ONE-PASS PROCESSING OF A, L AND U.
------------------------------------------------------------*/
for (jb = 0; jb < nsupers; ++jb) {
pc = PCOL( jb, grid );
if ( mycol == pc ) { /* Block column jb in my process column */
fsupc = FstBlockC( jb );
nsupc = SuperSize( jb );
ljb = LBj( jb, grid ); /* Local block number */
/* Scatter A into SPA. */
for (j = fsupc, dense_col = dense; j < FstBlockC(jb+1); ++j) {
for (i = xa[j]; i < xa[j+1]; ++i) {
irow = asub[i];
gb = BlockNum( irow );
if ( myrow == PROW( gb, grid ) ) {
lb = LBi( gb, grid );
irow = ilsum[lb] + irow - FstBlockC( gb );
dense_col[irow] = a[i];
}
}
dense_col += ldaspa;
}
jbrow = PROW( jb, grid );
#if ( PROFlevel>=1 )
t = SuperLU_timer_();
#endif
/*------------------------------------------------
* SET UP U BLOCKS.
*------------------------------------------------*/
kseen = 0;
/* Loop through each column in the block column. */
for (j = fsupc; j < FstBlockC( jb+1 ); ++j) {
istart = xusub[j];
for (i = istart; i < xusub[j+1]; ++i) {
irow = usub[i]; /* First nonzero in the segment. */
gb = BlockNum( irow );
pr = PROW( gb, grid );
if ( pr != jbrow )
bsendx_plist[ljb][pr] = YES;
if ( myrow == pr ) {
lb = LBi( gb, grid ); /* Local block number */
index = Ufstnz_br_ptr[lb];
if (rb_marker[lb] <= jb) {/* First see the block */
rb_marker[lb] = jb + 1;
index[Urb_indptr[lb]] = jb; /* Descriptor */
Urb_indptr[lb] += UB_DESCRIPTOR;
len = Urb_indptr[lb];
for (k = 0; k < nsupc; ++k)
index[len+k] = FstBlockC( gb+1 );
if ( gb != jb )/* Exclude diagonal block. */
++bmod[lb];/* Mod. count for back solve */
if ( kseen == 0 && myrow != jbrow ) {
++nbrecvx;
kseen = 1;
}
} else {
len = Urb_indptr[lb];/* Start fstnz in index */
}
jj = j - fsupc;
index[len+jj] = irow;
} /* if myrow == pr ... */
} /* for i ... */
} /* for j ... */
/* Figure out how many nonzeros in each block, and gather
the initial values of A from SPA into Uval. */
for (lb = 0; lb < nrbu; ++lb) {
if ( rb_marker[lb] == jb + 1 ) { /* Not an empty block. */
index = Ufstnz_br_ptr[lb];
uval = Unzval_br_ptr[lb];
len = Urb_indptr[lb];
gb = lb * grid->nprow + myrow;/* Global block number */
k = FstBlockC( gb+1 );
irow = ilsum[lb] - FstBlockC( gb );
for (jj=0, bnnz=0, dense_col=dense; jj < nsupc; ++jj) {
j = index[len+jj]; /* First nonzero in segment. */
bnnz += k - j;
for (i = j; i < k; ++i) {
uval[Urb_length[lb]++] = dense_col[irow + i];
dense_col[irow + i] = zero;
}
dense_col += ldaspa;
}
index[len-1] = bnnz; /* Set block length in Descriptor */
Urb_indptr[lb] += nsupc;
}
} /* for lb ... */
#if ( PROFlevel>=1 )
t_u += SuperLU_timer_() - t;
t = SuperLU_timer_();
#endif
/*------------------------------------------------
* SET UP L BLOCKS.
*------------------------------------------------*/
/* Count number of blocks and length of each block. */
nrbl = 0;
len = 0; /* Number of row subscripts I own. */
kseen = 0;
istart = xlsub[fsupc];
for (i = istart; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
gb = BlockNum( irow ); /* Global block number */
pr = PROW( gb, grid ); /* Process row owning this block */
if ( pr != jbrow )
fsendx_plist[ljb][pr] = YES;
if ( myrow == pr ) {
lb = LBi( gb, grid ); /* Local block number */
if (rb_marker[lb] <= jb) { /* First see this block */
rb_marker[lb] = jb + 1;
Lrb_length[lb] = 1;
Lrb_number[nrbl++] = gb;
if ( gb != jb ) /* Exclude diagonal block. */
++fmod[lb]; /* Mod. count for forward solve */
if ( kseen == 0 && myrow != jbrow ) {
++nfrecvx;
kseen = 1;
}
#if ( PRNTlevel>=1 )
++nLblocks;
#endif
} else {
++Lrb_length[lb];
}
++len;
}
} /* for i ... */
if ( nrbl ) { /* Do not ensure the blocks are sorted! */
/* Set up the initial pointers for each block in
index[] and nzval[]. */
/* Add room for descriptors */
len1 = len + BC_HEADER + nrbl * LB_DESCRIPTOR;
if ( !(index = intMalloc_dist(len1)) )
ABORT("Malloc fails for index[]");
Lrowind_bc_ptr[ljb] = index;
if (!(Lnzval_bc_ptr[ljb] =
doubleMalloc_dist(len*nsupc))) {
fprintf(stderr, "col block %d ", jb);
ABORT("Malloc fails for Lnzval_bc_ptr[*][]");
}
mybufmax[0] = SUPERLU_MAX( mybufmax[0], len1 );
mybufmax[1] = SUPERLU_MAX( mybufmax[1], len*nsupc );
mybufmax[4] = SUPERLU_MAX( mybufmax[4], len );
index[0] = nrbl; /* Number of row blocks */
index[1] = len; /* LDA of the nzval[] */
next_lind = BC_HEADER;
next_lval = 0;
for (k = 0; k < nrbl; ++k) {
gb = Lrb_number[k];
lb = LBi( gb, grid );
len = Lrb_length[lb];
Lrb_length[lb] = 0; /* Reset vector of block length */
index[next_lind++] = gb; /* Descriptor */
index[next_lind++] = len;
Lrb_indptr[lb] = next_lind;
Lrb_valptr[lb] = next_lval;
next_lind += len;
next_lval += len;
}
/* Propagate the compressed row subscripts to Lindex[],
and the initial values of A from SPA into Lnzval[]. */
lusup = Lnzval_bc_ptr[ljb];
len = index[1]; /* LDA of lusup[] */
for (i = istart; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
gb = BlockNum( irow );
if ( myrow == PROW( gb, grid ) ) {
lb = LBi( gb, grid );
k = Lrb_indptr[lb]++; /* Random access a block */
index[k] = irow;
k = Lrb_valptr[lb]++;
irow = ilsum[lb] + irow - FstBlockC( gb );
for (j = 0, dense_col = dense; j < nsupc; ++j) {
lusup[k] = dense_col[irow];
dense_col[irow] = zero;
k += len;
dense_col += ldaspa;
}
}
} /* for i ... */
} else {
Lrowind_bc_ptr[ljb] = NULL;
Lnzval_bc_ptr[ljb] = NULL;
} /* if nrbl ... */
#if ( PROFlevel>=1 )
t_l += SuperLU_timer_() - t;
#endif
} /* if mycol == pc */
} /* for jb ... */
Llu->Lrowind_bc_ptr = Lrowind_bc_ptr;
Llu->Lnzval_bc_ptr = Lnzval_bc_ptr;
Llu->Ufstnz_br_ptr = Ufstnz_br_ptr;
Llu->Unzval_br_ptr = Unzval_br_ptr;
Llu->ToRecv = ToRecv;
Llu->ToSendD = ToSendD;
Llu->ToSendR = ToSendR;
Llu->fmod = fmod;
Llu->fsendx_plist = fsendx_plist;
Llu->nfrecvx = nfrecvx;
Llu->bmod = bmod;
Llu->bsendx_plist = bsendx_plist;
Llu->nbrecvx = nbrecvx;
Llu->ilsum = ilsum;
Llu->ldalsum = ldaspa;
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. # L blocks %d\t# U blocks %d\n",
nLblocks, nUblocks);
#endif
SUPERLU_FREE(rb_marker);
SUPERLU_FREE(Urb_length);
SUPERLU_FREE(Urb_indptr);
SUPERLU_FREE(Lrb_length);
SUPERLU_FREE(Lrb_number);
SUPERLU_FREE(Lrb_indptr);
SUPERLU_FREE(Lrb_valptr);
SUPERLU_FREE(dense);
/* Find the maximum buffer size. */
MPI_Allreduce(mybufmax, Llu->bufmax, NBUFFERS, mpi_int_t,
MPI_MAX, grid->comm);
#if ( PROFlevel>=1 )
if ( !iam ) printf(".. 1st distribute time: L %.2f\tU %.2f\tu_blks %d\tnrbu %d\n",
t_l, t_u, u_blks, nrbu);
#endif
} /* else fact != SamePattern_SameRowPerm */
SUPERLU_FREE(xa);
SUPERLU_FREE(asub);
SUPERLU_FREE(a);
#if ( DEBUGlevel>=1 )
/* Memory allocated but not freed:
ilsum, fmod, fsendx_plist, bmod, bsendx_plist */
CHECK_MALLOC(iam, "Exit pddistribute()");
#endif
return (mem_use);
} /* PDDISTRIBUTE */
void
pzgstrs(int_t n, LUstruct_t *LUstruct,
ScalePermstruct_t *ScalePermstruct,
gridinfo_t *grid, doublecomplex *B,
int_t m_loc, int_t fst_row, int_t ldb, int nrhs,
SOLVEstruct_t *SOLVEstruct,
SuperLUStat_t *stat, int *info)
{
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
LocalLU_t *Llu = LUstruct->Llu;
doublecomplex alpha = {1.0, 0.0};
doublecomplex zero = {0.0, 0.0};
doublecomplex *lsum; /* Local running sum of the updates to B-components */
doublecomplex *x; /* X component at step k. */
/* NOTE: x and lsum are of same size. */
doublecomplex *lusup, *dest;
doublecomplex *recvbuf, *tempv;
doublecomplex *rtemp; /* Result of full matrix-vector multiply. */
int_t **Ufstnz_br_ptr = Llu->Ufstnz_br_ptr;
int_t *Urbs, *Urbs1; /* Number of row blocks in each block column of U. */
Ucb_indptr_t **Ucb_indptr;/* Vertical linked list pointing to Uindex[] */
int_t **Ucb_valptr; /* Vertical linked list pointing to Unzval[] */
int_t iam, kcol, krow, mycol, myrow;
int_t i, ii, il, j, jj, k, lb, ljb, lk, lptr, luptr;
int_t nb, nlb, nub, nsupers;
int_t *xsup, *supno, *lsub, *usub;
int_t *ilsum; /* Starting position of each supernode in lsum (LOCAL)*/
int_t Pc, Pr;
int knsupc, nsupr;
int ldalsum; /* Number of lsum entries locally owned. */
int maxrecvsz, p, pi;
int_t **Lrowind_bc_ptr;
doublecomplex **Lnzval_bc_ptr;
MPI_Status status;
MPI_Request *send_req, recv_req;
pxgstrs_comm_t *gstrs_comm = SOLVEstruct->gstrs_comm;
/*-- Counts used for L-solve --*/
int_t *fmod; /* Modification count for L-solve --
Count the number of local block products to
be summed into lsum[lk]. */
int_t **fsendx_plist = Llu->fsendx_plist;
int_t nfrecvx = Llu->nfrecvx; /* Number of X components to be recv'd. */
int_t *frecv; /* Count of lsum[lk] contributions to be received
from processes in this row.
It is only valid on the diagonal processes. */
int_t nfrecvmod = 0; /* Count of total modifications to be recv'd. */
int_t nleaf = 0, nroot = 0;
/*-- Counts used for U-solve --*/
int_t *bmod; /* Modification count for U-solve. */
int_t **bsendx_plist = Llu->bsendx_plist;
int_t nbrecvx = Llu->nbrecvx; /* Number of X components to be recv'd. */
int_t *brecv; /* Count of modifications to be recv'd from
processes in this row. */
int_t nbrecvmod = 0; /* Count of total modifications to be recv'd. */
double t;
#if ( DEBUGlevel>=2 )
int_t Ublocks = 0;
#endif
int_t *mod_bit = Llu->mod_bit; /* flag contribution from each row block */
t = SuperLU_timer_();
/* Test input parameters. */
*info = 0;
if ( n < 0 ) *info = -1;
else if ( nrhs < 0 ) *info = -9;
if ( *info ) {
pxerbla("PZGSTRS", grid, -*info);
return;
}
/*
* Initialization.
*/
iam = grid->iam;
Pc = grid->npcol;
Pr = grid->nprow;
myrow = MYROW( iam, grid );
mycol = MYCOL( iam, grid );
xsup = Glu_persist->xsup;
supno = Glu_persist->supno;
nsupers = supno[n-1] + 1;
Lrowind_bc_ptr = Llu->Lrowind_bc_ptr;
Lnzval_bc_ptr = Llu->Lnzval_bc_ptr;
nlb = CEILING( nsupers, Pr ); /* Number of local block rows. */
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pzgstrs()");
#endif
stat->ops[SOLVE] = 0.0;
Llu->SolveMsgSent = 0;
/* Save the count to be altered so it can be used by
subsequent call to PDGSTRS. */
if ( !(fmod = intMalloc_dist(nlb)) )
ABORT("Calloc fails for fmod[].");
for (i = 0; i < nlb; ++i) fmod[i] = Llu->fmod[i];
if ( !(frecv = intMalloc_dist(nlb)) )
ABORT("Malloc fails for frecv[].");
Llu->frecv = frecv;
k = SUPERLU_MAX( Llu->nfsendx, Llu->nbsendx ) + nlb;
if ( !(send_req = (MPI_Request*) SUPERLU_MALLOC(k*sizeof(MPI_Request))) )
ABORT("Malloc fails for send_req[].");
#ifdef _CRAY
ftcs1 = _cptofcd("L", strlen("L"));
ftcs2 = _cptofcd("N", strlen("N"));
ftcs3 = _cptofcd("U", strlen("U"));
#endif
/* Obtain ilsum[] and ldalsum for process column 0. */
ilsum = Llu->ilsum;
ldalsum = Llu->ldalsum;
/* Allocate working storage. */
knsupc = sp_ienv_dist(3);
maxrecvsz = knsupc * nrhs + SUPERLU_MAX( XK_H, LSUM_H );
if ( !(lsum = doublecomplexCalloc_dist(((size_t)ldalsum)*nrhs + nlb*LSUM_H)) )
ABORT("Calloc fails for lsum[].");
if ( !(x = doublecomplexMalloc_dist(ldalsum * nrhs + nlb * XK_H)) )
ABORT("Malloc fails for x[].");
if ( !(recvbuf = doublecomplexMalloc_dist(maxrecvsz)) )
ABORT("Malloc fails for recvbuf[].");
if ( !(rtemp = doublecomplexCalloc_dist(maxrecvsz)) )
ABORT("Malloc fails for rtemp[].");
/*---------------------------------------------------
* Forward solve Ly = b.
*---------------------------------------------------*/
/* Redistribute B into X on the diagonal processes. */
pzReDistribute_B_to_X(B, m_loc, nrhs, ldb, fst_row, ilsum, x,
ScalePermstruct, Glu_persist, grid, SOLVEstruct);
/* Set up the headers in lsum[]. */
ii = 0;
for (k = 0; k < nsupers; ++k) {
knsupc = SuperSize( k );
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
il = LSUM_BLK( lk );
lsum[il - LSUM_H].r = k;/* Block number prepended in the header.*/
lsum[il - LSUM_H].i = 0;
}
ii += knsupc;
}
/*
* Compute frecv[] and nfrecvmod counts on the diagonal processes.
*/
{
superlu_scope_t *scp = &grid->rscp;
#if 1
for (k = 0; k < nlb; ++k) mod_bit[k] = 0;
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* local block number */
kcol = PCOL( k, grid );
if ( mycol != kcol && fmod[lk] )
mod_bit[lk] = 1; /* contribution from off-diagonal */
}
}
/*PrintInt10("mod_bit", nlb, mod_bit);*/
#if ( PROFlevel>=2 )
t_reduce_tmp = SuperLU_timer_();
#endif
/* Every process receives the count, but it is only useful on the
diagonal processes. */
MPI_Allreduce( mod_bit, frecv, nlb, mpi_int_t, MPI_SUM, scp->comm );
#if ( PROFlevel>=2 )
t_reduce += SuperLU_timer_() - t_reduce_tmp;
#endif
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* local block number */
kcol = PCOL( k, grid );
if ( mycol == kcol ) { /* diagonal process */
nfrecvmod += frecv[lk];
if ( !frecv[lk] && !fmod[lk] ) ++nleaf;
}
}
}
#else /* old */
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
kcol = PCOL( k, grid ); /* Root process in this row scope. */
if ( mycol != kcol && fmod[lk] )
i = 1; /* Contribution from non-diagonal process. */
else i = 0;
MPI_Reduce( &i, &frecv[lk], 1, mpi_int_t,
MPI_SUM, kcol, scp->comm );
if ( mycol == kcol ) { /* Diagonal process. */
nfrecvmod += frecv[lk];
if ( !frecv[lk] && !fmod[lk] ) ++nleaf;
#if ( DEBUGlevel>=2 )
printf("(%2d) frecv[%4d] %2d\n", iam, k, frecv[lk]);
assert( frecv[lk] < Pc );
#endif
}
}
}
#endif
}
/* ---------------------------------------------------------
Solve the leaf nodes first by all the diagonal processes.
--------------------------------------------------------- */
#if ( DEBUGlevel>=2 )
printf("(%2d) nleaf %4d\n", iam, nleaf);
#endif
for (k = 0; k < nsupers && nleaf; ++k) {
krow = PROW( k, grid );
kcol = PCOL( k, grid );
if ( myrow == krow && mycol == kcol ) { /* Diagonal process */
knsupc = SuperSize( k );
lk = LBi( k, grid );
if ( frecv[lk]==0 && fmod[lk]==0 ) {
fmod[lk] = -1; /* Do not solve X[k] in the future. */
ii = X_BLK( lk );
lk = LBj( k, grid ); /* Local block number, column-wise. */
lsub = Lrowind_bc_ptr[lk];
lusup = Lnzval_bc_ptr[lk];
nsupr = lsub[1];
#ifdef _CRAY
CTRSM(ftcs1, ftcs1, ftcs2, ftcs3, &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#elif defined (USE_VENDOR_BLAS)
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc, 1, 1, 1, 1);
#else
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#endif
stat->ops[SOLVE] += 4 * knsupc * (knsupc - 1) * nrhs
+ 10 * knsupc * nrhs; /* complex division */
--nleaf;
#if ( DEBUGlevel>=2 )
printf("(%2d) Solve X[%2d]\n", iam, k);
#endif
/*
* Send Xk to process column Pc[k].
*/
for (p = 0; p < Pr; ++p) {
if ( fsendx_plist[lk][p] != EMPTY ) {
pi = PNUM( p, kcol, grid );
MPI_Isend( &x[ii - XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm,
&send_req[Llu->SolveMsgSent++]);
#if 0
MPI_Send( &x[ii - XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm );
#endif
#if ( DEBUGlevel>=2 )
printf("(%2d) Sent X[%2.0f] to P %2d\n",
iam, x[ii-XK_H], pi);
#endif
}
}
/*
* Perform local block modifications: lsum[i] -= L_i,k * X[k]
*/
nb = lsub[0] - 1;
lptr = BC_HEADER + LB_DESCRIPTOR + knsupc;
luptr = knsupc; /* Skip diagonal block L(k,k). */
zlsum_fmod(lsum, x, &x[ii], rtemp, nrhs, knsupc, k,
fmod, nb, lptr, luptr, xsup, grid, Llu,
send_req, stat);
}
} /* if diagonal process ... */
} /* for k ... */
/* -----------------------------------------------------------
Compute the internal nodes asynchronously by all processes.
----------------------------------------------------------- */
#if ( DEBUGlevel>=2 )
printf("(%2d) nfrecvx %4d, nfrecvmod %4d, nleaf %4d\n",
iam, nfrecvx, nfrecvmod, nleaf);
#endif
while ( nfrecvx || nfrecvmod ) { /* While not finished. */
/* Receive a message. */
MPI_Recv( recvbuf, maxrecvsz, SuperLU_MPI_DOUBLE_COMPLEX,
MPI_ANY_SOURCE, MPI_ANY_TAG, grid->comm, &status );
k = (*recvbuf).r;
#if ( DEBUGlevel>=2 )
printf("(%2d) Recv'd block %d, tag %2d\n", iam, k, status.MPI_TAG);
#endif
switch ( status.MPI_TAG ) {
case Xk:
--nfrecvx;
lk = LBj( k, grid ); /* Local block number, column-wise. */
lsub = Lrowind_bc_ptr[lk];
lusup = Lnzval_bc_ptr[lk];
if ( lsub ) {
nb = lsub[0];
lptr = BC_HEADER;
luptr = 0;
knsupc = SuperSize( k );
/*
* Perform local block modifications: lsum[i] -= L_i,k * X[k]
*/
zlsum_fmod(lsum, x, &recvbuf[XK_H], rtemp, nrhs, knsupc, k,
fmod, nb, lptr, luptr, xsup, grid, Llu,
send_req, stat);
} /* if lsub */
break;
case LSUM: /* Receiver must be a diagonal process */
--nfrecvmod;
lk = LBi( k, grid ); /* Local block number, row-wise. */
ii = X_BLK( lk );
knsupc = SuperSize( k );
tempv = &recvbuf[LSUM_H];
RHS_ITERATE(j) {
for (i = 0; i < knsupc; ++i)
z_add(&x[i + ii + j*knsupc],
&x[i + ii + j*knsupc],
&tempv[i + j*knsupc]);
}
if ( (--frecv[lk])==0 && fmod[lk]==0 ) {
fmod[lk] = -1; /* Do not solve X[k] in the future. */
lk = LBj( k, grid ); /* Local block number, column-wise. */
lsub = Lrowind_bc_ptr[lk];
lusup = Lnzval_bc_ptr[lk];
nsupr = lsub[1];
#ifdef _CRAY
CTRSM(ftcs1, ftcs1, ftcs2, ftcs3, &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#elif defined (USE_VENDOR_BLAS)
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc, 1, 1, 1, 1);
#else
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#endif
stat->ops[SOLVE] += 4 * knsupc * (knsupc - 1) * nrhs
+ 10 * knsupc * nrhs; /* complex division */
#if ( DEBUGlevel>=2 )
printf("(%2d) Solve X[%2d]\n", iam, k);
#endif
/*
* Send Xk to process column Pc[k].
*/
kcol = PCOL( k, grid );
for (p = 0; p < Pr; ++p) {
if ( fsendx_plist[lk][p] != EMPTY ) {
pi = PNUM( p, kcol, grid );
MPI_Isend( &x[ii-XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm,
&send_req[Llu->SolveMsgSent++]);
#if 0
MPI_Send( &x[ii - XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm );
#endif
#if ( DEBUGlevel>=2 )
printf("(%2d) Sent X[%2.0f] to P %2d\n",
iam, x[ii-XK_H], pi);
#endif
}
}
/*
* Perform local block modifications.
*/
nb = lsub[0] - 1;
lptr = BC_HEADER + LB_DESCRIPTOR + knsupc;
luptr = knsupc; /* Skip diagonal block L(k,k). */
zlsum_fmod(lsum, x, &x[ii], rtemp, nrhs, knsupc, k,
fmod, nb, lptr, luptr, xsup, grid, Llu,
send_req, stat);
} /* if */
break;
#if ( DEBUGlevel>=2 )
default:
printf("(%2d) Recv'd wrong message tag %4d\n", status.MPI_TAG);
break;
#endif
} /* switch */
} /* while not finished ... */
#if ( PRNTlevel>=2 )
t = SuperLU_timer_() - t;
if ( !iam ) printf(".. L-solve time\t%8.2f\n", t);
t = SuperLU_timer_();
#endif
#if ( DEBUGlevel==2 )
{
printf("(%d) .. After L-solve: y =\n", iam);
for (i = 0, k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
kcol = PCOL( k, grid );
if ( myrow == krow && mycol == kcol ) { /* Diagonal process */
knsupc = SuperSize( k );
lk = LBi( k, grid );
ii = X_BLK( lk );
for (j = 0; j < knsupc; ++j)
printf("\t(%d)\t%4d\t%.10f\n", iam, xsup[k]+j, x[ii+j]);
fflush(stdout);
}
MPI_Barrier( grid->comm );
}
}
#endif
SUPERLU_FREE(fmod);
SUPERLU_FREE(frecv);
SUPERLU_FREE(rtemp);
/*for (i = 0; i < Llu->SolveMsgSent; ++i) MPI_Request_free(&send_req[i]);*/
for (i = 0; i < Llu->SolveMsgSent; ++i) MPI_Wait(&send_req[i], &status);
Llu->SolveMsgSent = 0;
MPI_Barrier( grid->comm );
/*---------------------------------------------------
* Back solve Ux = y.
*
* The Y components from the forward solve is already
* on the diagonal processes.
*---------------------------------------------------*/
/* Save the count to be altered so it can be used by
subsequent call to PZGSTRS. */
if ( !(bmod = intMalloc_dist(nlb)) )
ABORT("Calloc fails for bmod[].");
for (i = 0; i < nlb; ++i) bmod[i] = Llu->bmod[i];
if ( !(brecv = intMalloc_dist(nlb)) )
ABORT("Malloc fails for brecv[].");
Llu->brecv = brecv;
/*
* Compute brecv[] and nbrecvmod counts on the diagonal processes.
*/
{
superlu_scope_t *scp = &grid->rscp;
#if 1
for (k = 0; k < nlb; ++k) mod_bit[k] = 0;
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* local block number */
kcol = PCOL( k, grid ); /* root process in this row scope */
if ( mycol != kcol && bmod[lk] )
mod_bit[lk] = 1; /* Contribution from off-diagonal */
}
}
/* Every process receives the count, but it is only useful on the
diagonal processes. */
MPI_Allreduce( mod_bit, brecv, nlb, mpi_int_t, MPI_SUM, scp->comm );
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* local block number */
kcol = PCOL( k, grid ); /* root process in this row scope. */
if ( mycol == kcol ) { /* diagonal process */
nbrecvmod += brecv[lk];
if ( !brecv[lk] && !bmod[lk] ) ++nroot;
#if ( DEBUGlevel>=2 )
printf("(%2d) brecv[%4d] %2d\n", iam, k, brecv[lk]);
assert( brecv[lk] < Pc );
#endif
}
}
}
#else /* old */
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
kcol = PCOL( k, grid ); /* Root process in this row scope. */
if ( mycol != kcol && bmod[lk] )
i = 1; /* Contribution from non-diagonal process. */
else i = 0;
MPI_Reduce( &i, &brecv[lk], 1, mpi_int_t,
MPI_SUM, kcol, scp->comm );
if ( mycol == kcol ) { /* Diagonal process. */
nbrecvmod += brecv[lk];
if ( !brecv[lk] && !bmod[lk] ) ++nroot;
#if ( DEBUGlevel>=2 )
printf("(%2d) brecv[%4d] %2d\n", iam, k, brecv[lk]);
assert( brecv[lk] < Pc );
#endif
}
}
}
#endif
}
/* Re-initialize lsum to zero. Each block header is already in place. */
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
knsupc = SuperSize( k );
lk = LBi( k, grid );
il = LSUM_BLK( lk );
dest = &lsum[il];
RHS_ITERATE(j) {
for (i = 0; i < knsupc; ++i) dest[i + j*knsupc] = zero;
}
}
}
void
get_perm_c(int ispec, SuperMatrix *A, int *perm_c)
/*
* Purpose
* =======
*
* GET_PERM_C obtains a permutation matrix Pc, by applying the multiple
* minimum degree ordering code by Joseph Liu to matrix A'*A or A+A'.
* or using approximate minimum degree column ordering by Davis et. al.
* The LU factorization of A*Pc tends to have less fill than the LU
* factorization of A.
*
* Arguments
* =========
*
* ispec (input) int
* Specifies the type of column ordering to reduce fill:
* = 1: minimum degree on the structure of A^T * A
* = 2: minimum degree on the structure of A^T + A
* = 3: approximate minimum degree for unsymmetric matrices
* If ispec == 0, the natural ordering (i.e., Pc = I) is returned.
*
* A (input) 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; Dtype = _D; Mtype = GE. In the future,
* more general A can be handled.
*
* perm_c (output) int*
* 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.
*
*/
{
NCformat *Astore = A->Store;
int m, n, bnz = 0, *b_colptr, i;
int delta, maxint, nofsub, *invp;
int *b_rowind, *dhead, *qsize, *llist, *marker;
double t, SuperLU_timer_();
m = A->nrow;
n = A->ncol;
t = SuperLU_timer_();
switch ( ispec ) {
case 0: /* Natural ordering */
for (i = 0; i < n; ++i) perm_c[i] = i;
#if ( PRNTlevel>=1 )
printf("Use natural column ordering.\n");
#endif
return;
case 1: /* Minimum degree ordering on A'*A */
getata(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
&bnz, &b_colptr, &b_rowind);
#if ( PRNTlevel>=1 )
printf("Use minimum degree ordering on A'*A.\n");
#endif
t = SuperLU_timer_() - t;
/*printf("Form A'*A time = %8.3f\n", t);*/
break;
case 2: /* Minimum degree ordering on A'+A */
if ( m != n ) ABORT("Matrix is not square");
at_plus_a(n, Astore->nnz, Astore->colptr, Astore->rowind,
&bnz, &b_colptr, &b_rowind);
#if ( PRNTlevel>=1 )
printf("Use minimum degree ordering on A'+A.\n");
#endif
t = SuperLU_timer_() - t;
/*printf("Form A'+A time = %8.3f\n", t);*/
break;
case 3: /* Approximate minimum degree column ordering. */
get_colamd(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
perm_c);
#if ( PRNTlevel>=1 )
printf(".. Use approximate minimum degree column ordering.\n");
#endif
return;
default:
ABORT("Invalid ISPEC");
}
if ( bnz != 0 ) {
t = SuperLU_timer_();
/* Initialize and allocate storage for GENMMD. */
delta = 1; /* DELTA is a parameter to allow the choice of nodes
whose degree <= min-degree + DELTA. */
maxint = 2147483647; /* 2**31 - 1 */
invp = (int *) SUPERLU_MALLOC((n+delta)*sizeof(int));
if ( !invp ) ABORT("SUPERLU_MALLOC fails for invp.");
dhead = (int *) SUPERLU_MALLOC((n+delta)*sizeof(int));
if ( !dhead ) ABORT("SUPERLU_MALLOC fails for dhead.");
qsize = (int *) SUPERLU_MALLOC((n+delta)*sizeof(int));
if ( !qsize ) ABORT("SUPERLU_MALLOC fails for qsize.");
llist = (int *) SUPERLU_MALLOC(n*sizeof(int));
if ( !llist ) ABORT("SUPERLU_MALLOC fails for llist.");
marker = (int *) SUPERLU_MALLOC(n*sizeof(int));
if ( !marker ) ABORT("SUPERLU_MALLOC fails for marker.");
/* Transform adjacency list into 1-based indexing required by GENMMD.*/
for (i = 0; i <= n; ++i) ++b_colptr[i];
for (i = 0; i < bnz; ++i) ++b_rowind[i];
genmmd_(&n, b_colptr, b_rowind, perm_c, invp, &delta, dhead,
qsize, llist, marker, &maxint, &nofsub);
/* Transform perm_c into 0-based indexing. */
for (i = 0; i < n; ++i) --perm_c[i];
SUPERLU_FREE(invp);
SUPERLU_FREE(dhead);
SUPERLU_FREE(qsize);
SUPERLU_FREE(llist);
SUPERLU_FREE(marker);
SUPERLU_FREE(b_rowind);
t = SuperLU_timer_() - t;
/* printf("call GENMMD time = %8.3f\n", t);*/
} else { /* Empty adjacency structure */
for (i = 0; i < n; ++i) perm_c[i] = i;
}
SUPERLU_FREE(b_colptr);
}
void
pdgssvx_ABglobal(superlu_options_t_Distributed *options, SuperMatrix *A,
ScalePermstruct_t *ScalePermstruct,
double B[], int ldb, int nrhs, gridinfo_t *grid,
LUstruct_t *LUstruct, double *berr,
SuperLUStat_t *stat, int *info)
{
/*
* -- Distributed SuperLU routine (version 1.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley.
* September 1, 1999
*
*
* Purpose
* =======
*
* pdgssvx_ABglobal solves a system of linear equations A*X=B,
* by using Gaussian elimination with "static pivoting" to
* compute the LU factorization of A.
*
* Static pivoting is a technique that combines the numerical stability
* of partial pivoting with the scalability of Cholesky (no pivoting),
* to run accurately and efficiently on large numbers of processors.
*
* See our paper at http://www.nersc.gov/~xiaoye/SuperLU/ for a detailed
* description of the parallel algorithms.
*
* Here are the options for using this code:
*
* 1. Independent of all the other options specified below, the
* user must supply
*
* - B, the matrix of right hand sides, and its dimensions ldb and nrhs
* - grid, a structure describing the 2D processor mesh
* - options->IterRefine, which determines whether or not to
* improve the accuracy of the computed solution using
* iterative refinement
*
* On output, B is overwritten with the solution X.
*
* 2. Depending on options->Fact, the user has several options
* for solving A*X=B. The standard option is for factoring
* A "from scratch". (The other options, described below,
* are used when A is sufficiently similar to a previously
* solved problem to save time by reusing part or all of
* the previous factorization.)
*
* - options->Fact = DOFACT: A is factored "from scratch"
*
* In this case the user must also supply
*
* - A, the input matrix
*
* as well as the following options, which are described in more
* detail below:
*
* - options->Equil, to specify how to scale the rows and columns
* of A to "equilibrate" it (to try to reduce its
* condition number and so improve the
* accuracy of the computed solution)
*
* - options->RowPerm, to specify how to permute the rows of A
* (typically to control numerical stability)
*
* - options->ColPerm, to specify how to permute the columns of A
* (typically to control fill-in and enhance
* parallelism during factorization)
*
* - options->ReplaceTinyPivot, to specify how to deal with tiny
* pivots encountered during factorization
* (to control numerical stability)
*
* The outputs returned include
*
* - ScalePermstruct, modified to describe how the input matrix A
* was equilibrated and permuted:
* - ScalePermstruct->DiagScale, indicates whether the rows and/or
* columns of A were scaled
* - ScalePermstruct->R, array of row scale factors
* - ScalePermstruct->C, array of column scale factors
* - ScalePermstruct->perm_r, row permutation vector
* - ScalePermstruct->perm_c, column permutation vector
*
* (part of ScalePermstruct may also need to be supplied on input,
* depending on options->RowPerm and options->ColPerm as described
* later).
*
* - A, the input matrix A overwritten by the scaled and permuted matrix
* Pc*Pr*diag(R)*A*diag(C)
* where
* Pr and Pc are row and columns permutation matrices determined
* by ScalePermstruct->perm_r and ScalePermstruct->perm_c,
* respectively, and
* diag(R) and diag(C) are diagonal scaling matrices determined
* by ScalePermstruct->DiagScale, ScalePermstruct->R and
* ScalePermstruct->C
*
* - LUstruct, which contains the L and U factorization of A1 where
*
* A1 = Pc*Pr*diag(R)*A*diag(C)*Pc^T = L*U
*
* (Note that A1 = Aout * Pc^T, where Aout is the matrix stored
* in A on output.)
*
* 3. The second value of options->Fact assumes that a matrix with the same
* sparsity pattern as A has already been factored:
*
* - options->Fact = SamePattern: A is factored, assuming that it has
* the same nonzero pattern as a previously factored matrix. In this
* case the algorithm saves time by reusing the previously computed
* column permutation vector stored in ScalePermstruct->perm_c
* and the "elimination tree" of A stored in LUstruct->etree.
*
* In this case the user must still specify the following options
* as before:
*
* - options->Equil
* - options->RowPerm
* - options->ReplaceTinyPivot
*
* but not options->ColPerm, whose value is ignored. This is because the
* previous column permutation from ScalePermstruct->perm_c is used as
* input. The user must also supply
*
* - A, the input matrix
* - ScalePermstruct->perm_c, the column permutation
* - LUstruct->etree, the elimination tree
*
* The outputs returned include
*
* - A, the input matrix A overwritten by the scaled and permuted matrix
* as described above
* - ScalePermstruct, modified to describe how the input matrix A was
* equilibrated and row permuted
* - LUstruct, modified to contain the new L and U factors
*
* 4. The third value of options->Fact assumes that a matrix B with the same
* sparsity pattern as A has already been factored, and where the
* row permutation of B can be reused for A. This is useful when A and B
* have similar numerical values, so that the same row permutation
* will make both factorizations numerically stable. This lets us reuse
* all of the previously computed structure of L and U.
*
* - options->Fact = SamePattern_SameRowPerm: A is factored,
* assuming not only the same nonzero pattern as the previously
* factored matrix B, but reusing B's row permutation.
*
* In this case the user must still specify the following options
* as before:
*
* - options->Equil
* - options->ReplaceTinyPivot
*
* but not options->RowPerm or options->ColPerm, whose values are ignored.
* This is because the permutations from ScalePermstruct->perm_r and
* ScalePermstruct->perm_c are used as input.
*
* The user must also supply
*
* - A, the input matrix
* - ScalePermstruct->DiagScale, how the previous matrix was row and/or
* column scaled
* - ScalePermstruct->R, the row scalings of the previous matrix, if any
* - ScalePermstruct->C, the columns scalings of the previous matrix,
* if any
* - ScalePermstruct->perm_r, the row permutation of the previous matrix
* - ScalePermstruct->perm_c, the column permutation of the previous
* matrix
* - all of LUstruct, the previously computed information about L and U
* (the actual numerical values of L and U stored in
* LUstruct->Llu are ignored)
*
* The outputs returned include
*
* - A, the input matrix A overwritten by the scaled and permuted matrix
* as described above
* - ScalePermstruct, modified to describe how the input matrix A was
* equilibrated
* (thus ScalePermstruct->DiagScale, R and C may be modified)
* - LUstruct, modified to contain the new L and U factors
*
* 5. The fourth and last value of options->Fact assumes that A is
* identical to a matrix that has already been factored on a previous
* call, and reuses its entire LU factorization
*
* - options->Fact = Factored: A is identical to a previously
* factorized matrix, so the entire previous factorization
* can be reused.
*
* In this case all the other options mentioned above are ignored
* (options->Equil, options->RowPerm, options->ColPerm,
* options->ReplaceTinyPivot)
*
* The user must also supply
*
* - A, the unfactored matrix, only in the case that iterative refinment
* is to be done (specifically A must be the output A from
* the previous call, so that it has been scaled and permuted)
* - all of ScalePermstruct
* - all of LUstruct, including the actual numerical values of L and U
*
* all of which are unmodified on output.
*
* Arguments
* =========
*
* options (input) superlu_options_t_Distributed*
* The structure defines the input parameters to control
* how the LU decomposition 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, how the matrix A should
* be factorized based on the previous history.
*
* = DOFACT: The matrix A will be factorized from scratch.
* Inputs: A
* options->Equil, RowPerm, ColPerm, ReplaceTinyPivot
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* all of ScalePermstruct
* all of LUstruct
*
* = SamePattern: the matrix A will be factorized assuming
* that a factorization of a matrix with the same sparsity
* pattern was performed prior to this one. Therefore, this
* factorization will reuse column permutation vector
* ScalePermstruct->perm_c and the elimination tree
* LUstruct->etree
* Inputs: A
* options->Equil, RowPerm, ReplaceTinyPivot
* ScalePermstruct->perm_c
* LUstruct->etree
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* rest of ScalePermstruct (DiagScale, R, C, perm_r)
* rest of LUstruct (GLU_persist, Llu)
*
* = SamePattern_SameRowPerm: the matrix A will be factorized
* assuming that a factorization of a matrix with the same
* sparsity pattern and similar numerical values was performed
* prior to this one. Therefore, this factorization will reuse
* both row and column scaling factors R and C, and the
* both row and column permutation vectors perm_r and perm_c,
* distributed data structure set up from the previous symbolic
* factorization.
* Inputs: A
* options->Equil, ReplaceTinyPivot
* all of ScalePermstruct
* all of LUstruct
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* modified LUstruct->Llu
* = FACTORED: the matrix A is already factored.
* Inputs: all of ScalePermstruct
* all of LUstruct
*
* o Equil (yes_no_t)
* Specifies whether to equilibrate the system.
* = NO: no equilibration.
* = YES: scaling factors are computed to equilibrate the system:
* diag(R)*A*diag(C)*inv(diag(C))*X = diag(R)*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.
*
* o RowPerm (rowperm_t)
* Specifies how to permute rows of the matrix A.
* = NATURAL: use the natural ordering.
* = LargeDiag: use the Duff/Koster algorithm to permute rows of
* the original matrix to make the diagonal large
* relative to the off-diagonal.
* = MY_PERMR: use the ordering given in ScalePermstruct->perm_r
* input by the user.
*
* o ColPerm (colperm_t)
* Specifies what type of column permutation to use to reduce fill.
* = NATURAL: natural ordering.
* = MMD_AT_PLUS_A: minimum degree ordering on structure of A'+A.
* = MMD_ATA: minimum degree ordering on structure of A'*A.
* = COLAMD: approximate minimum degree column ordering.
* = MY_PERMC: the ordering given in ScalePermstruct->perm_c.
*
* o ReplaceTinyPivot (yes_no_t)
* = NO: do not modify pivots
* = YES: replace tiny pivots by sqrt(epsilon)*norm(A) during
* LU factorization.
*
* o IterRefine (IterRefine_t)
* Specifies how to perform iterative refinement.
* = NO: no iterative refinement.
* = DOUBLE: accumulate residual in double precision.
* = EXTRA: accumulate residual in extra precision.
*
* NOTE: all options must be indentical on all processes when
* calling this routine.
*
* A (input/output) SuperMatrix*
* On entry, matrix A in A*X=B, of dimension (A->nrow, A->ncol).
* The number of linear equations is A->nrow. The type of A must be:
* Stype = NC; Dtype = D; Mtype = GE. That is, A is stored in
* compressed column format (also known as Harwell-Boeing format).
* See supermatrix.h for the definition of 'SuperMatrix'.
* This routine only handles square A, however, the LU factorization
* routine pdgstrf can factorize rectangular matrices.
* On exit, A may be overwtirren by Pc*Pr*diag(R)*A*diag(C),
* depending on ScalePermstruct->DiagScale, options->RowPerm and
* options->colpem:
* if ScalePermstruct->DiagScale != NOEQUIL, A is overwritten by
* diag(R)*A*diag(C).
* if options->RowPerm != NATURAL, A is further overwritten by
* Pr*diag(R)*A*diag(C).
* if options->ColPerm != NATURAL, A is further overwritten by
* Pc*Pr*diag(R)*A*diag(C).
* If all the above condition are true, the LU decomposition is
* performed on the matrix Pc*Pr*diag(R)*A*diag(C)*Pc^T.
*
* NOTE: Currently, A must reside in all processes when calling
* this routine.
*
* ScalePermstruct (input/output) ScalePermstruct_t*
* The data structure to store the scaling and permutation vectors
* describing the transformations performed to the matrix A.
* It contains the following fields:
*
* o DiagScale (DiagScale_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 options->Fact = FACTORED or SamePattern_SameRowPerm,
* DiagScale is an input argument; otherwise it is an output
* argument.
*
* o perm_r (int*)
* Row permutation vector, which defines the permutation matrix Pr;
* perm_r[i] = j means row i of A is in position j in Pr*A.
* If options->RowPerm = MY_PERMR, or
* options->Fact = SamePattern_SameRowPerm, perm_r is an
* input argument; otherwise it is an output argument.
*
* o perm_c (int*)
* Column permutation vector, which defines the
* permutation matrix Pc; perm_c[i] = j means column i of A is
* in position j in A*Pc.
* If options->ColPerm = MY_PERMC or options->Fact = SamePattern
* or options->Fact = SamePattern_SameRowPerm, perm_c is an
* input argument; otherwise, it is an output 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.
*
* o R (double*) dimension (A->nrow)
* The row scale factors for A.
* If DiagScale = ROW or BOTH, A is multiplied on the left by
* diag(R).
* If DiagScale = NOEQUIL or COL, R is not defined.
* If options->Fact = FACTORED or SamePattern_SameRowPerm, R is
* an input argument; otherwise, R is an output argument.
*
* o C (double*) dimension (A->ncol)
* The column scale factors for A.
* If DiagScale = COL or BOTH, A is multiplied on the right by
* diag(C).
* If DiagScale = NOEQUIL or ROW, C is not defined.
* If options->Fact = FACTORED or SamePattern_SameRowPerm, C is
* an input argument; otherwise, C is an output argument.
*
* B (input/output) double*
* On entry, the right-hand side matrix of dimension (A->nrow, nrhs).
* On exit, the solution matrix if info = 0;
*
* NOTE: Currently, B must reside in all processes when calling
* this routine.
*
* ldb (input) int (global)
* The leading dimension of matrix B.
*
* nrhs (input) int (global)
* The number of right-hand sides.
* If nrhs = 0, only LU decomposition is performed, the forward
* and back substitutions are skipped.
*
* grid (input) gridinfo_t*
* The 2D process mesh. It contains the MPI communicator, the number
* of process rows (NPROW), the number of process columns (NPCOL),
* and my process rank. It is an input argument to all the
* parallel routines.
* Grid can be initialized by subroutine SUPERLU_GRIDINIT.
* See superlu_ddefs.h for the definition of 'gridinfo_t'.
*
* LUstruct (input/output) LUstruct_t*
* The data structures to store the distributed L and U factors.
* It contains the following fields:
*
* o etree (int*) dimension (A->ncol)
* Elimination tree of Pc*(A'+A)*Pc' or Pc*A'*A*Pc', dimension A->ncol.
* It is computed in sp_colorder() during the first factorization,
* and is reused in the subsequent factorizations of the matrices
* with the same nonzero pattern.
* On exit of sp_colorder(), the columns of A are permuted so that
* the etree is in a certain postorder. This postorder is reflected
* in ScalePermstruct->perm_c.
* 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.
*
* o Glu_persist (Glu_persist_t*)
* Global data structure (xsup, supno) replicated on all processes,
* describing the supernode partition in the factored matrices
* L and U:
* xsup[s] is the leading column of the s-th supernode,
* supno[i] is the supernode number to which column i belongs.
*
* o Llu (LocalLU_t*)
* The distributed data structures to store L and U factors.
* See superlu_ddefs.h for the definition of 'LocalLU_t'.
*
* berr (output) double*, dimension (nrhs)
* 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).
*
* 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, 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.
*
*
* See superlu_ddefs.h for the definitions of various data types.
*
*/
SuperMatrix AC;
NCformat *Astore;
NCPformat *ACstore;
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
Glu_freeable_t *Glu_freeable;
/* The nonzero structures of L and U factors, which are
replicated on all processrs.
(lsub, xlsub) contains the compressed subscript of
supernodes in L.
(usub, xusub) contains the compressed subscript of
nonzero segments in U.
If options->Fact != SamePattern_SameRowPerm, they are
computed by SYMBFACT routine, and then used by DDISTRIBUTE
routine. They will be freed after DDISTRIBUTE routine.
If options->Fact == SamePattern_SameRowPerm, these
structures are not used. */
fact_t Fact;
double *a;
int_t *perm_r; /* row permutations from partial pivoting */
int_t *perm_c; /* column permutation vector */
int_t *etree; /* elimination tree */
int_t *colptr, *rowind;
int_t colequ, Equil, factored, job, notran, rowequ;
int_t i, iinfo, j, irow, m, n, nnz, permc_spec, dist_mem_use;
int iam;
int ldx; /* LDA for matrix X (global). */
char equed[1], norm[1];
double *C, *R, *C1, *R1, amax, anorm, colcnd, rowcnd;
double *X, *b_col, *b_work, *x_col;
double t;
static mem_usage_t_Distributed num_mem_usage, symb_mem_usage;
#if ( PRNTlevel>= 2 )
double dmin, dsum, dprod;
#endif
/* Test input parameters. */
*info = 0;
Fact = options->Fact;
if ( Fact < 0 || Fact > FACTORED )
*info = -1;
else if ( options->RowPerm < 0 || options->RowPerm > MY_PERMR )
*info = -1;
else if ( options->ColPerm < 0 || options->ColPerm > MY_PERMC )
*info = -1;
else if ( options->IterRefine < 0 || options->IterRefine > EXTRA )
*info = -1;
else if ( options->IterRefine == EXTRA ) {
*info = -1;
fprintf(stderr, "Extra precise iterative refinement yet to support.");
} else if ( A->nrow != A->ncol || A->nrow < 0 ||
A->Stype != SLU_NC || A->Dtype != SLU_D || A->Mtype != SLU_GE )
*info = -2;
else if ( ldb < A->nrow )
*info = -5;
else if ( nrhs < 0 )
*info = -6;
if ( *info ) {
i = -(*info);
pxerbla("pdgssvx_ABglobal", grid, -*info);
return;
}
/* Initialization */
factored = (Fact == FACTORED);
Equil = (!factored && options->Equil == YES);
notran = (options->Trans == NOTRANS);
iam = grid->iam;
job = 5;
m = A->nrow;
n = A->ncol;
Astore = A->Store;
nnz = Astore->nnz;
a = Astore->nzval;
colptr = Astore->colptr;
rowind = Astore->rowind;
if ( factored || (Fact == SamePattern_SameRowPerm && Equil) ) {
rowequ = (ScalePermstruct->DiagScale == ROW) ||
(ScalePermstruct->DiagScale == BOTH);
colequ = (ScalePermstruct->DiagScale == COL) ||
(ScalePermstruct->DiagScale == BOTH);
} else rowequ = colequ = FALSE;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pdgssvx_ABglobal()");
#endif
perm_r = ScalePermstruct->perm_r;
perm_c = ScalePermstruct->perm_c;
etree = LUstruct->etree;
R = ScalePermstruct->R;
C = ScalePermstruct->C;
if ( Equil ) {
/* Allocate storage if not done so before. */
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
if ( !(R = (double *) doubleMalloc_dist(m)) )
ABORT("Malloc fails for R[].");
if ( !(C = (double *) doubleMalloc_dist(n)) )
ABORT("Malloc fails for C[].");
ScalePermstruct->R = R;
ScalePermstruct->C = C;
break;
case ROW:
if ( !(C = (double *) doubleMalloc_dist(n)) )
ABORT("Malloc fails for C[].");
ScalePermstruct->C = C;
break;
case COL:
if ( !(R = (double *) doubleMalloc_dist(m)) )
ABORT("Malloc fails for R[].");
ScalePermstruct->R = R;
break;
}
}
/* ------------------------------------------------------------
Diagonal scaling to equilibrate the matrix.
------------------------------------------------------------*/
if ( Equil ) {
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter equil");
#endif
t = SuperLU_timer_();
if ( Fact == SamePattern_SameRowPerm ) {
/* Reuse R and C. */
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
break;
case ROW:
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
a[i] *= R[irow]; /* Scale rows. */
}
}
break;
case COL:
for (j = 0; j < n; ++j)
for (i = colptr[j]; i < colptr[j+1]; ++i)
a[i] *= C[j]; /* Scale columns. */
break;
case BOTH:
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
a[i] *= R[irow] * C[j]; /* Scale rows and columns. */
}
}
break;
}
} else {
if ( !iam ) {
/* Compute row and column scalings to equilibrate matrix A. */
dgsequ_dist(A, R, C, &rowcnd, &colcnd, &amax, &iinfo);
MPI_Bcast( &iinfo, 1, mpi_int_t, 0, grid->comm );
if ( iinfo == 0 ) {
MPI_Bcast( R, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C, n, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &rowcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &colcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &amax, 1, MPI_DOUBLE, 0, grid->comm );
} else {
if ( iinfo > 0 ) {
if ( iinfo <= m )
fprintf(stderr, "The %d-th row of A is exactly zero\n",
iinfo);
else fprintf(stderr, "The %d-th column of A is exactly zero\n",
iinfo-n);
exit(-1);
}
}
} else {
MPI_Bcast( &iinfo, 1, mpi_int_t, 0, grid->comm );
if ( iinfo == 0 ) {
MPI_Bcast( R, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C, n, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &rowcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &colcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &amax, 1, MPI_DOUBLE, 0, grid->comm );
} else {
ABORT("DGSEQU failed\n");
}
}
/* Equilibrate matrix A. */
dlaqgs_dist(A, R, C, rowcnd, colcnd, amax, equed);
if ( lsame_(equed, "R") ) {
ScalePermstruct->DiagScale = rowequ = ROW;
} else if ( lsame_(equed, "C") ) {
ScalePermstruct->DiagScale = colequ = COL;
} else if ( lsame_(equed, "B") ) {
ScalePermstruct->DiagScale = BOTH;
rowequ = ROW;
colequ = COL;
} else ScalePermstruct->DiagScale = NOEQUIL;
#if ( PRNTlevel>=1 )
if ( !iam ) {
printf(".. equilibrated? *equed = %c\n", *equed);
/*fflush(stdout);*/
}
#endif
} /* if Fact ... */
stat->utime[EQUIL] = SuperLU_timer_() - t;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Exit equil");
#endif
} /* if Equil ... */
/* ------------------------------------------------------------
Permute rows of A.
------------------------------------------------------------*/
if ( options->RowPerm != NO ) {
t = SuperLU_timer_();
if ( Fact == SamePattern_SameRowPerm /* Reuse perm_r. */
|| options->RowPerm == MY_PERMR ) { /* Use my perm_r. */
/* for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {*/
for (i = 0; i < colptr[n]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
/* }*/
}
} else if ( !factored ) {
if ( job == 5 ) {
/* Allocate storage for scaling factors. */
if ( !(R1 = (double *) SUPERLU_MALLOC(m * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for R1[]");
if ( !(C1 = (double *) SUPERLU_MALLOC(n * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for C1[]");
}
if ( !iam ) {
/* Process 0 finds a row permutation for large diagonal. */
dldperm(job, m, nnz, colptr, rowind, a, perm_r, R1, C1);
MPI_Bcast( perm_r, m, mpi_int_t, 0, grid->comm );
if ( job == 5 && Equil ) {
MPI_Bcast( R1, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C1, n, MPI_DOUBLE, 0, grid->comm );
}
} else {
MPI_Bcast( perm_r, m, mpi_int_t, 0, grid->comm );
if ( job == 5 && Equil ) {
MPI_Bcast( R1, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C1, n, MPI_DOUBLE, 0, grid->comm );
}
}
#if ( PRNTlevel>=2 )
dmin = dlamch_("Overflow");
dsum = 0.0;
dprod = 1.0;
#endif
if ( job == 5 ) {
if ( Equil ) {
for (i = 0; i < n; ++i) {
R1[i] = exp(R1[i]);
C1[i] = exp(C1[i]);
}
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
a[i] *= R1[irow] * C1[j]; /* Scale the matrix. */
rowind[i] = perm_r[irow];
#if ( PRNTlevel>=2 )
if ( rowind[i] == j ) /* New diagonal */
dprod *= fabs(a[i]);
#endif
}
}
/* Multiply together the scaling factors. */
if ( rowequ ) for (i = 0; i < m; ++i) R[i] *= R1[i];
else for (i = 0; i < m; ++i) R[i] = R1[i];
if ( colequ ) for (i = 0; i < n; ++i) C[i] *= C1[i];
else for (i = 0; i < n; ++i) C[i] = C1[i];
ScalePermstruct->DiagScale = BOTH;
rowequ = colequ = 1;
} else { /* No equilibration. */
/* for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {*/
for (i = colptr[0]; i < colptr[n]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
}
/* }*/
}
SUPERLU_FREE (R1);
SUPERLU_FREE (C1);
} else { /* job = 2,3,4 */
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
#if ( PRNTlevel>=2 )
if ( rowind[i] == j ) { /* New diagonal */
if ( job == 2 || job == 3 )
dmin = SUPERLU_MIN(dmin, fabs(a[i]));
else if ( job == 4 )
dsum += fabs(a[i]);
else if ( job == 5 )
dprod *= fabs(a[i]);
}
#endif
}
}
}
#if ( PRNTlevel>=2 )
if ( job == 2 || job == 3 ) {
if ( !iam ) printf("\tsmallest diagonal %e\n", dmin);
} else if ( job == 4 ) {
if ( !iam ) printf("\tsum of diagonal %e\n", dsum);
} else if ( job == 5 ) {
if ( !iam ) printf("\t product of diagonal %e\n", dprod);
}
#endif
} /* else !factored */
t = SuperLU_timer_() - t;
stat->utime[ROWPERM] = t;
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. LDPERM job %d\t time: %.2f\n", job, t);
#endif
} /* if options->RowPerm ... */
if ( !factored || options->IterRefine ) {
/* Compute norm(A), which will be used to adjust small diagonal. */
if ( notran ) *(unsigned char *)norm = '1';
else *(unsigned char *)norm = 'I';
anorm = dlangs_dist(norm, A);
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. anorm %e\n", anorm);
#endif
}
/* ------------------------------------------------------------
Perform the LU factorization.
------------------------------------------------------------*/
if ( !factored ) {
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 && Fact == DOFACT )
/* Use an ordering provided by SuperLU */
get_perm_c_dist(iam, permc_spec, A, perm_c);
/* Compute the elimination tree of Pc*(A'+A)*Pc' or Pc*A'*A*Pc'
(a.k.a. column etree), depending on the choice of ColPerm.
Adjust perm_c[] to be consistent with a postorder of etree.
Permute columns of A to form A*Pc'. */
sp_colorder(options, A, perm_c, etree, &AC);
/* Form Pc*A*Pc' to preserve the diagonal of the matrix Pr*A. */
ACstore = AC.Store;
for (j = 0; j < n; ++j)
for (i = ACstore->colbeg[j]; i < ACstore->colend[j]; ++i) {
irow = ACstore->rowind[i];
ACstore->rowind[i] = perm_c[irow];
}
stat->utime[COLPERM] = SuperLU_timer_() - t;
/* Perform a symbolic factorization on matrix A and set up the
nonzero data structures which are suitable for supernodal GENP. */
if ( Fact != SamePattern_SameRowPerm ) {
#if ( PRNTlevel>=1 )
if ( !iam )
printf(".. symbfact(): relax %4d, maxsuper %4d, fill %4d\n",
sp_ienv_dist(2), sp_ienv_dist(3), sp_ienv_dist(6));
#endif
t = SuperLU_timer_();
if ( !(Glu_freeable = (Glu_freeable_t *)
SUPERLU_MALLOC(sizeof(Glu_freeable_t))) )
ABORT("Malloc fails for Glu_freeable.");
iinfo = symbfact(iam, &AC, perm_c, etree,
Glu_persist, Glu_freeable);
stat->utime[SYMBFAC] = SuperLU_timer_() - t;
if ( iinfo < 0 ) {
QuerySpace_dist(n, -iinfo, Glu_freeable, &symb_mem_usage);
#if ( PRNTlevel>=1 )
if ( !iam ) {
printf("\tNo of supers %ld\n", Glu_persist->supno[n-1]+1);
printf("\tSize of G(L) %ld\n", Glu_freeable->xlsub[n]);
printf("\tSize of G(U) %ld\n", Glu_freeable->xusub[n]);
printf("\tint %d, short %d, float %d, double %d\n",
sizeof(int_t), sizeof(short), sizeof(float),
sizeof(double));
printf("\tSYMBfact (MB):\tL\\U %.2f\ttotal %.2f\texpansions %d\n",
symb_mem_usage.for_lu*1e-6,
symb_mem_usage.total*1e-6,
symb_mem_usage.expansions);
}
#endif
} else {
if ( !iam ) {
fprintf(stderr, "symbfact() error returns %d\n", iinfo);
exit(-1);
}
}
}
/* Distribute the L and U factors onto the process grid. */
t = SuperLU_timer_();
dist_mem_use = ddistribute(Fact, n, &AC, Glu_freeable, LUstruct, grid);
stat->utime[DIST] = SuperLU_timer_() - t;
/* Deallocate storage used in symbolic factor. */
if ( Fact != SamePattern_SameRowPerm ) {
iinfo = symbfact_SubFree(Glu_freeable);
SUPERLU_FREE(Glu_freeable);
}
/* Perform numerical factorization in parallel. */
t = SuperLU_timer_();
pdgstrf(options, m, n, anorm, LUstruct, grid, stat, info);
stat->utime[FACT] = SuperLU_timer_() - t;
#if ( PRNTlevel>=1 )
{
int_t TinyPivots;
float for_lu, total, max, avg, temp;
dQuerySpace_dist(n, LUstruct, grid, &num_mem_usage);
MPI_Reduce( &num_mem_usage.for_lu, &for_lu,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
MPI_Reduce( &num_mem_usage.total, &total,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
temp = SUPERLU_MAX(symb_mem_usage.total,
symb_mem_usage.for_lu +
(float)dist_mem_use + num_mem_usage.for_lu);
temp = SUPERLU_MAX(temp, num_mem_usage.total);
MPI_Reduce( &temp, &max,
1, MPI_FLOAT, MPI_MAX, 0, grid->comm );
MPI_Reduce( &temp, &avg,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
MPI_Allreduce( &stat->TinyPivots, &TinyPivots, 1, mpi_int_t,
MPI_SUM, grid->comm );
stat->TinyPivots = TinyPivots;
if ( !iam ) {
printf("\tNUMfact (MB) all PEs:\tL\\U\t%.2f\tall\t%.2f\n",
for_lu*1e-6, total*1e-6);
printf("\tAll space (MB):"
"\t\ttotal\t%.2f\tAvg\t%.2f\tMax\t%.2f\n",
avg*1e-6, avg/grid->nprow/grid->npcol*1e-6, max*1e-6);
printf("\tNumber of tiny pivots: %10d\n", stat->TinyPivots);
}
}
#endif
#if ( PRNTlevel>=2 )
if ( !iam ) printf(".. pdgstrf INFO = %d\n", *info);
#endif
} else if ( options->IterRefine ) { /* options->Fact==FACTORED */
/* Permute columns of A to form A*Pc' using the existing perm_c.
* NOTE: rows of A were previously permuted to Pc*A.
*/
sp_colorder(options, A, perm_c, NULL, &AC);
} /* if !factored ... */
/* ------------------------------------------------------------
Compute the solution matrix X.
------------------------------------------------------------*/
if ( nrhs ) {
if ( !(b_work = doubleMalloc_dist(n)) )
ABORT("Malloc fails for b_work[]");
/* ------------------------------------------------------------
Scale the right-hand side if equilibration was performed.
------------------------------------------------------------*/
if ( notran ) {
if ( rowequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) b_col[i] *= R[i];
b_col += ldb;
}
}
} else if ( colequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) b_col[i] *= C[i];
b_col += ldb;
}
}
/* ------------------------------------------------------------
Permute the right-hand side to form Pr*B.
------------------------------------------------------------*/
if ( options->RowPerm != NO ) {
if ( notran ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) b_work[perm_r[i]] = b_col[i];
for (i = 0; i < m; ++i) b_col[i] = b_work[i];
b_col += ldb;
}
}
}
/* ------------------------------------------------------------
Permute the right-hand side to form Pc*B.
------------------------------------------------------------*/
if ( notran ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) b_work[perm_c[i]] = b_col[i];
for (i = 0; i < m; ++i) b_col[i] = b_work[i];
b_col += ldb;
}
}
/* Save a copy of the right-hand side. */
ldx = ldb;
if ( !(X = doubleMalloc_dist(((size_t)ldx) * nrhs)) )
ABORT("Malloc fails for X[]");
x_col = X; b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < ldb; ++i) x_col[i] = b_col[i];
x_col += ldx; b_col += ldb;
}
/* ------------------------------------------------------------
Solve the linear system.
------------------------------------------------------------*/
pdgstrs_Bglobal(n, LUstruct, grid, X, ldb, nrhs, stat, info);
/* ------------------------------------------------------------
Use iterative refinement to improve the computed solution and
compute error bounds and backward error estimates for it.
------------------------------------------------------------*/
if ( options->IterRefine ) {
/* Improve the solution by iterative refinement. */
t = SuperLU_timer_();
pdgsrfs_ABXglobal(n, &AC, anorm, LUstruct, grid, B, ldb,
X, ldx, nrhs, berr, stat, info);
stat->utime[REFINE] = SuperLU_timer_() - t;
}
/* Permute the solution matrix X <= Pc'*X. */
for (j = 0; j < nrhs; j++) {
b_col = &B[j*ldb];
x_col = &X[j*ldx];
for (i = 0; i < n; ++i) b_col[i] = x_col[perm_c[i]];
}
/* Transform the solution matrix X to a solution of the original system
before the equilibration. */
if ( notran ) {
if ( colequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < n; ++i) b_col[i] *= C[i];
b_col += ldb;
}
}
} else if ( rowequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < n; ++i) b_col[i] *= R[i];
b_col += ldb;
}
}
SUPERLU_FREE(b_work);
SUPERLU_FREE(X);
} /* end if nrhs != 0 */
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. DiagScale = %d\n", ScalePermstruct->DiagScale);
#endif
/* Deallocate storage. */
if ( Equil && Fact != SamePattern_SameRowPerm ) {
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
SUPERLU_FREE(R);
SUPERLU_FREE(C);
break;
case ROW:
SUPERLU_FREE(C);
break;
case COL:
SUPERLU_FREE(R);
break;
}
}
if ( !factored || (factored && options->IterRefine) )
Destroy_CompCol_Permuted_dist(&AC);
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Exit pdgssvx_ABglobal()");
#endif
}
void
pcgstrf(superlumt_options_t *superlumt_options, SuperMatrix *A, int *perm_r,
SuperMatrix *L, SuperMatrix *U, Gstat_t *Gstat, 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
* =======
*
* PCGSTRF computes an LU factorization of a general sparse nrow-by-ncol
* matrix A using partial pivoting with row interchanges. The factorization
* has the form
* Pr * A = L * U
* where Pr is a row permutation matrix, L is lower triangular with unit
* diagonal elements (lower trapezoidal if A->nrow > A->ncol), and U is
* upper triangular (upper trapezoidal if A->nrow < A->ncol).
*
* Arguments
* =========
*
* superlumt_options (input) superlumt_options_t*
* The structure defines the parameters to control how the sparse
* LU factorization is performed. The following fields must be set
* by the user:
*
* o nprocs (int)
* Number of processes to be spawned and used for factorization.
*
* 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)
* 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 Gaussian elimination,
* if abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
* use A_jj as pivot. 0 <= diag_pivot_thresh <= 1. The default
* value is 1.0, 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 perm_c (int*)
* 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.
*
* o perm_r (int*)
* Column permutation vector of size A->nrow.
* If superlumt_options->usepr = NO, this is an output argument.
*
* 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) SuperMatrix*
* Original matrix A, permuted by columns, of dimension
* (A->nrow, A->ncol). The type of A can be:
* Stype = NCP; Dtype = _D; Mtype = GE.
*
* perm_r (input/output) int*, dimension A->nrow
* Row permutation vector which defines the permutation matrix Pr,
* perm_r[i] = j means row i of A is in position j in Pr*A.
* 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.
*
* L (output) SuperMatrix*
* The factor L from the factorization Pr*A=L*U; use compressed row
* subscripts storage for supernodes, i.e., L has type:
* Stype = SCP, Dtype = _D, Mtype = TRLU.
*
* U (output) SuperMatrix*
* The factor U from the factorization Pr*A*Pc=L*U. Use column-wise
* storage scheme, i.e., U has types: Stype = NCP, Dtype = _D,
* Mtype = TRU.
*
* Gstat (output) Gstat_t*
* Record all the statistics about the factorization;
* See Gstat_t structure defined in slu_mt_util.h.
*
* 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,
* and division by zero will occur if it is used to solve a
* system of equations.
* > A->ncol: number of bytes allocated when memory allocation
* failure occurred, plus A->ncol.
*
*/
pcgstrf_threadarg_t *pcgstrf_threadarg;
pxgstrf_shared_t pxgstrf_shared;
register int nprocs = superlumt_options->nprocs;
register int i, iinfo;
double *utime = Gstat->utime;
double usrtime, wtime;
double usertimer_();
#if ( MACH==SUN )
thread_t *thread_id;
#elif ( MACH==DEC || MACH==PTHREAD )
pthread_t *thread_id;
void *status;
#endif
void *pcgstrf_thread(void *);
/* --------------------------------------------------------------
Initializes the parallel data structures for pcgstrf_thread().
--------------------------------------------------------------*/
pcgstrf_threadarg = pcgstrf_thread_init(A, L, U, superlumt_options,
&pxgstrf_shared, Gstat, info);
if ( *info ) return;
/* Start timing factorization. */
usrtime = usertimer_();
wtime = SuperLU_timer_();
/* ------------------------------------------------------------
On a SUN multiprocessor system, use Solaris thread.
------------------------------------------------------------*/
#if ( MACH==SUN )
/* Create nproc threads for concurrent factorization. */
thread_id = (thread_t *) SUPERLU_MALLOC(nprocs * sizeof(thread_t));
for (i = 1; i < nprocs; ++i) {
#if ( PRNTlevel==1 )
printf(".. Create unbound threads: i %d, nprocs %d\n", i, nprocs);
#endif
if ( (iinfo = thr_create(NULL, 0,
pcgstrf_thread, &(pcgstrf_threadarg[i]),
0, &thread_id[i])) )
{
fprintf(stderr, "thr_create: %d\n", iinfo);
SUPERLU_ABORT("thr_creat()");
}
}
pcgstrf_thread( &(pcgstrf_threadarg[0]) );
/* Wait for all threads to terminate. */
for (i = 1; i < nprocs; i++) thr_join(thread_id[i], 0, 0);
SUPERLU_FREE (thread_id);
/* _SOLARIS_2 */
/* ------------------------------------------------------------
On a DEC multiprocessor system, use pthread.
------------------------------------------------------------*/
#elif ( MACH==DEC ) /* Use DECthreads ... */
/* Create nproc threads for concurrent factorization. */
thread_id = (pthread_t *) SUPERLU_MALLOC(nprocs * sizeof(pthread_t));
for (i = 0; i < nprocs; ++i) {
if ( iinfo = pthread_create(&thread_id[i],
NULL,
pcgstrf_thread,
&(pcgstrf_threadarg[i])) ) {
fprintf(stderr, "pthread_create: %d\n", iinfo);
SUPERLU_ABORT("pthread_create()");
}
/* pthread_bind_to_cpu_np(thread_id[i], i);*/
}
/* Wait for all threads to terminate. */
for (i = 0; i < nprocs; i++)
pthread_join(thread_id[i], &status);
SUPERLU_FREE (thread_id);
/* _DEC */
/* ------------------------------------------------------------
On a SGI Power Challenge or Origin multiprocessor system,
use parallel C.
------------------------------------------------------------*/
#elif ( MACH==SGI || MACH==ORIGIN ) /* Use parallel C ... */
if ( getenv("MP_SET_NUMTHREADS") ) {
i = atoi(getenv("MP_SET_NUMTHREADS"));
if ( nprocs > i ) {
printf("nprocs=%d > environment allowed: MP_SET_NUMTHREADS=%d\n",
nprocs, i);
exit(-1);
}
}
#pragma parallel
#pragma shared (pcgstrf_threadarg)
/*#pragma numthreads (max = nprocs)*/
#pragma numthreads (nprocs)
{
pcgstrf_thread( pcgstrf_threadarg );
}
/* _SGI or _ORIGIN */
/* ------------------------------------------------------------
On a Cray PVP multiprocessor system, use microtasking.
------------------------------------------------------------*/
#elif ( MACH==CRAY_PVP ) /* Use C microtasking. */
if ( getenv("NCPUS") ) {
i = atoi(getenv("NCPUS"));
if ( nprocs > i ) {
printf("nprocs=%d > environment allowed: NCPUS=%d\n",
nprocs, i);
exit(-1);
}
}
#pragma _CRI taskloop private (i,nprocs) shared (pcgstrf_threadarg)
/* Stand-alone task loop */
for (i = 0; i < nprocs; ++i) {
pcgstrf_thread( &(pcgstrf_threadarg[i]) );
}
/* _CRAY_PVP */
/* ------------------------------------------------------------
Use POSIX threads.
------------------------------------------------------------*/
#elif ( MACH==PTHREAD ) /* Use pthread ... */
/* Create nproc threads for concurrent factorization. */
thread_id = (pthread_t *) SUPERLU_MALLOC(nprocs * sizeof(pthread_t));
for (i = 0; i < nprocs; ++i) {
if ( iinfo = pthread_create(&thread_id[i],
NULL,
pcgstrf_thread,
&(pcgstrf_threadarg[i])) ) {
fprintf(stderr, "pthread_create: %d\n", iinfo);
SUPERLU_ABORT("pthread_create()");
}
}
/* Wait for all threads to terminate. */
for (i = 0; i < nprocs; i++)
pthread_join(thread_id[i], &status);
SUPERLU_FREE (thread_id);
/* _PTHREAD */
/* ------------------------------------------------------------
Use openMP.
------------------------------------------------------------*/
#elif ( MACH==OPENMP ) /* Use openMP ... */
#pragma omp parallel for shared (pcgstrf_threadarg) private (i)
/* Stand-alone task loop */
for (i = 0; i < nprocs; ++i) {
pcgstrf_thread( &(pcgstrf_threadarg[i]) );
}
/* _OPENMP */
/* ------------------------------------------------------------
On all other systems, use single processor.
------------------------------------------------------------*/
#else
printf("pcgstrf() is not parallelized on this machine.\n");
printf("pcgstrf() will be run on single processor.\n");
pcgstrf_thread( &(pcgstrf_threadarg[0]) );
#endif
wtime = SuperLU_timer_() - wtime;
usrtime = usertimer_() - usrtime;
utime[FACT] = wtime;
#if ( PRNTlevel==1 )
printf(".. pcgstrf_thread() returns info %d, usrtime %.2f, wtime %.2f\n",
*info, usrtime, wtime);
#endif
/* check_mem_leak("after pcgstrf_thread()"); */
/* ------------------------------------------------------------
Clean up and free storage after multithreaded factorization.
------------------------------------------------------------*/
pcgstrf_thread_finalize(pcgstrf_threadarg, &pxgstrf_shared,
A, perm_r, L, U);
}
void
pzgstrs(int_t n, LUstruct_t *LUstruct,
ScalePermstruct_t *ScalePermstruct,
gridinfo_t *grid, doublecomplex *B,
int_t m_loc, int_t fst_row, int_t ldb, int nrhs,
SOLVEstruct_t *SOLVEstruct,
SuperLUStat_t *stat, int *info)
{
/*
* Purpose
* =======
*
* PZGSTRS solves a system of distributed linear equations
* A*X = B with a general N-by-N matrix A using the LU factorization
* computed by PZGSTRF.
* If the equilibration, and row and column permutations were performed,
* the LU factorization was performed for A1 where
* A1 = Pc*Pr*diag(R)*A*diag(C)*Pc^T = L*U
* and the linear system solved is
* A1 * Y = Pc*Pr*B1, where B was overwritten by B1 = diag(R)*B, and
* the permutation to B1 by Pc*Pr is applied internally in this routine.
*
* Arguments
* =========
*
* n (input) int (global)
* The order of the system of linear equations.
*
* LUstruct (input) LUstruct_t*
* The distributed data structures storing L and U factors.
* The L and U factors are obtained from PZGSTRF for
* the possibly scaled and permuted matrix A.
* See superlu_zdefs.h for the definition of 'LUstruct_t'.
* A may be scaled and permuted into A1, so that
* A1 = Pc*Pr*diag(R)*A*diag(C)*Pc^T = L*U
*
* grid (input) gridinfo_t*
* The 2D process mesh. It contains the MPI communicator, the number
* of process rows (NPROW), the number of process columns (NPCOL),
* and my process rank. It is an input argument to all the
* parallel routines.
* Grid can be initialized by subroutine SUPERLU_GRIDINIT.
* See superlu_defs.h for the definition of 'gridinfo_t'.
*
* B (input/output) doublecomplex*
* On entry, the distributed right-hand side matrix of the possibly
* equilibrated system. That is, B may be overwritten by diag(R)*B.
* On exit, the distributed solution matrix Y of the possibly
* equilibrated system if info = 0, where Y = Pc*diag(C)^(-1)*X,
* and X is the solution of the original system.
*
* m_loc (input) int (local)
* The local row dimension of matrix B.
*
* fst_row (input) int (global)
* The row number of B's first row in the global matrix.
*
* ldb (input) int (local)
* The leading dimension of matrix B.
*
* nrhs (input) int (global)
* Number of right-hand sides.
*
* SOLVEstruct (output) SOLVEstruct_t* (global)
* Contains the information for the communication during the
* solution phase.
*
* stat (output) SuperLUStat_t*
* Record the statistics about the triangular solves.
* 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
*
*/
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
LocalLU_t *Llu = LUstruct->Llu;
doublecomplex alpha = {1.0, 0.0};
doublecomplex zero = {0.0, 0.0};
doublecomplex *lsum; /* Local running sum of the updates to B-components */
doublecomplex *x; /* X component at step k. */
/* NOTE: x and lsum are of same size. */
doublecomplex *lusup, *dest;
doublecomplex *recvbuf, *tempv;
doublecomplex *rtemp; /* Result of full matrix-vector multiply. */
int_t **Ufstnz_br_ptr = Llu->Ufstnz_br_ptr;
int_t *Urbs, *Urbs1; /* Number of row blocks in each block column of U. */
Ucb_indptr_t **Ucb_indptr;/* Vertical linked list pointing to Uindex[] */
int_t **Ucb_valptr; /* Vertical linked list pointing to Unzval[] */
int_t iam, kcol, krow, mycol, myrow;
int_t i, ii, il, j, jj, k, lb, ljb, lk, lptr, luptr;
int_t nb, nlb, nub, nsupers;
int_t *xsup, *supno, *lsub, *usub;
int_t *ilsum; /* Starting position of each supernode in lsum (LOCAL)*/
int_t Pc, Pr;
int knsupc, nsupr;
int ldalsum; /* Number of lsum entries locally owned. */
int maxrecvsz, p, pi;
int_t **Lrowind_bc_ptr;
doublecomplex **Lnzval_bc_ptr;
MPI_Status status;
#ifdef ISEND_IRECV
MPI_Request *send_req, recv_req;
#endif
pxgstrs_comm_t *gstrs_comm = SOLVEstruct->gstrs_comm;
/*-- Counts used for L-solve --*/
int_t *fmod; /* Modification count for L-solve --
Count the number of local block products to
be summed into lsum[lk]. */
int_t **fsendx_plist = Llu->fsendx_plist;
int_t nfrecvx = Llu->nfrecvx; /* Number of X components to be recv'd. */
int_t *frecv; /* Count of lsum[lk] contributions to be received
from processes in this row.
It is only valid on the diagonal processes. */
int_t nfrecvmod = 0; /* Count of total modifications to be recv'd. */
int_t nleaf = 0, nroot = 0;
/*-- Counts used for U-solve --*/
int_t *bmod; /* Modification count for U-solve. */
int_t **bsendx_plist = Llu->bsendx_plist;
int_t nbrecvx = Llu->nbrecvx; /* Number of X components to be recv'd. */
int_t *brecv; /* Count of modifications to be recv'd from
processes in this row. */
int_t nbrecvmod = 0; /* Count of total modifications to be recv'd. */
double t;
#if ( DEBUGlevel>=2 )
int_t Ublocks = 0;
#endif
t = SuperLU_timer_();
/* Test input parameters. */
*info = 0;
if ( n < 0 ) *info = -1;
else if ( nrhs < 0 ) *info = -9;
if ( *info ) {
pxerbla("PZGSTRS", grid, -*info);
return;
}
/*
* Initialization.
*/
iam = grid->iam;
Pc = grid->npcol;
Pr = grid->nprow;
myrow = MYROW( iam, grid );
mycol = MYCOL( iam, grid );
xsup = Glu_persist->xsup;
supno = Glu_persist->supno;
nsupers = supno[n-1] + 1;
Lrowind_bc_ptr = Llu->Lrowind_bc_ptr;
Lnzval_bc_ptr = Llu->Lnzval_bc_ptr;
nlb = CEILING( nsupers, Pr ); /* Number of local block rows. */
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pzgstrs()");
#endif
stat->ops[SOLVE] = 0.0;
Llu->SolveMsgSent = 0;
/* Save the count to be altered so it can be used by
subsequent call to PDGSTRS. */
if ( !(fmod = intMalloc_dist(nlb)) )
ABORT("Calloc fails for fmod[].");
for (i = 0; i < nlb; ++i) fmod[i] = Llu->fmod[i];
if ( !(frecv = intMalloc_dist(nlb)) )
ABORT("Malloc fails for frecv[].");
Llu->frecv = frecv;
#ifdef ISEND_IRECV
k = SUPERLU_MAX( Llu->nfsendx, Llu->nbsendx ) + nlb;
if ( !(send_req = (MPI_Request*) SUPERLU_MALLOC(k*sizeof(MPI_Request))) )
ABORT("Malloc fails for send_req[].");
#endif
#ifdef _CRAY
ftcs1 = _cptofcd("L", strlen("L"));
ftcs2 = _cptofcd("N", strlen("N"));
ftcs3 = _cptofcd("U", strlen("U"));
#endif
/* Obtain ilsum[] and ldalsum for process column 0. */
ilsum = Llu->ilsum;
ldalsum = Llu->ldalsum;
/* Allocate working storage. */
knsupc = sp_ienv_dist(3);
maxrecvsz = knsupc * nrhs + SUPERLU_MAX( XK_H, LSUM_H );
if ( !(lsum = doublecomplexCalloc_dist(((size_t)ldalsum)*nrhs + nlb*LSUM_H)) )
ABORT("Calloc fails for lsum[].");
if ( !(x = doublecomplexMalloc_dist(ldalsum * nrhs + nlb * XK_H)) )
ABORT("Malloc fails for x[].");
if ( !(recvbuf = doublecomplexMalloc_dist(maxrecvsz)) )
ABORT("Malloc fails for recvbuf[].");
if ( !(rtemp = doublecomplexCalloc_dist(maxrecvsz)) )
ABORT("Malloc fails for rtemp[].");
/*---------------------------------------------------
* Forward solve Ly = b.
*---------------------------------------------------*/
/* Redistribute B into X on the diagonal processes. */
pzReDistribute_B_to_X(B, m_loc, nrhs, ldb, fst_row, ilsum, x,
ScalePermstruct, Glu_persist, grid, SOLVEstruct);
/* Set up the headers in lsum[]. */
ii = 0;
for (k = 0; k < nsupers; ++k) {
knsupc = SuperSize( k );
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
il = LSUM_BLK( lk );
lsum[il - LSUM_H].r = k;/* Block number prepended in the header.*/
lsum[il - LSUM_H].i = 0;
}
ii += knsupc;
}
/*
* Compute frecv[] and nfrecvmod counts on the diagonal processes.
*/
{
superlu_scope_t *scp = &grid->rscp;
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
kcol = PCOL( k, grid ); /* Root process in this row scope. */
if ( mycol != kcol && fmod[lk] )
i = 1; /* Contribution from non-diagonal process. */
else i = 0;
MPI_Reduce( &i, &frecv[lk], 1, mpi_int_t,
MPI_SUM, kcol, scp->comm );
if ( mycol == kcol ) { /* Diagonal process. */
nfrecvmod += frecv[lk];
if ( !frecv[lk] && !fmod[lk] ) ++nleaf;
#if ( DEBUGlevel>=2 )
printf("(%2d) frecv[%4d] %2d\n", iam, k, frecv[lk]);
assert( frecv[lk] < Pc );
#endif
}
}
}
}
/* ---------------------------------------------------------
Solve the leaf nodes first by all the diagonal processes.
--------------------------------------------------------- */
#if ( DEBUGlevel>=2 )
printf("(%2d) nleaf %4d\n", iam, nleaf);
#endif
for (k = 0; k < nsupers && nleaf; ++k) {
krow = PROW( k, grid );
kcol = PCOL( k, grid );
if ( myrow == krow && mycol == kcol ) { /* Diagonal process */
knsupc = SuperSize( k );
lk = LBi( k, grid );
if ( frecv[lk]==0 && fmod[lk]==0 ) {
fmod[lk] = -1; /* Do not solve X[k] in the future. */
ii = X_BLK( lk );
lk = LBj( k, grid ); /* Local block number, column-wise. */
lsub = Lrowind_bc_ptr[lk];
lusup = Lnzval_bc_ptr[lk];
nsupr = lsub[1];
#ifdef _CRAY
CTRSM(ftcs1, ftcs1, ftcs2, ftcs3, &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#elif defined (USE_VENDOR_BLAS)
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc, 1, 1, 1, 1);
#else
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#endif
stat->ops[SOLVE] += 4 * knsupc * (knsupc - 1) * nrhs
+ 10 * knsupc * nrhs; /* complex division */
--nleaf;
#if ( DEBUGlevel>=2 )
printf("(%2d) Solve X[%2d]\n", iam, k);
#endif
/*
* Send Xk to process column Pc[k].
*/
for (p = 0; p < Pr; ++p) {
if ( fsendx_plist[lk][p] != EMPTY ) {
pi = PNUM( p, kcol, grid );
#ifdef ISEND_IRECV
MPI_Isend( &x[ii - XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm,
&send_req[Llu->SolveMsgSent++]);
#else
MPI_Send( &x[ii - XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm );
#endif
#if ( DEBUGlevel>=2 )
printf("(%2d) Sent X[%2.0f] to P %2d\n",
iam, x[ii-XK_H], pi);
#endif
}
}
/*
* Perform local block modifications: lsum[i] -= L_i,k * X[k]
*/
nb = lsub[0] - 1;
lptr = BC_HEADER + LB_DESCRIPTOR + knsupc;
luptr = knsupc; /* Skip diagonal block L(k,k). */
zlsum_fmod(lsum, x, &x[ii], rtemp, nrhs, knsupc, k,
fmod, nb, lptr, luptr, xsup, grid, Llu,
send_req, stat);
}
} /* if diagonal process ... */
} /* for k ... */
/* -----------------------------------------------------------
Compute the internal nodes asynchronously by all processes.
----------------------------------------------------------- */
#if ( DEBUGlevel>=2 )
printf("(%2d) nfrecvx %4d, nfrecvmod %4d, nleaf %4d\n",
iam, nfrecvx, nfrecvmod, nleaf);
#endif
while ( nfrecvx || nfrecvmod ) { /* While not finished. */
/* Receive a message. */
#ifdef ISEND_IRECV
/* -MPI- FATAL: Remote protocol queue full */
MPI_Irecv( recvbuf, maxrecvsz, SuperLU_MPI_DOUBLE_COMPLEX,
MPI_ANY_SOURCE, MPI_ANY_TAG, grid->comm, &recv_req );
MPI_Wait( &recv_req, &status );
#else
MPI_Recv( recvbuf, maxrecvsz, SuperLU_MPI_DOUBLE_COMPLEX,
MPI_ANY_SOURCE, MPI_ANY_TAG, grid->comm, &status );
#endif
k = (*recvbuf).r;
#if ( DEBUGlevel>=2 )
printf("(%2d) Recv'd block %d, tag %2d\n", iam, k, status.MPI_TAG);
#endif
switch ( status.MPI_TAG ) {
case Xk:
--nfrecvx;
lk = LBj( k, grid ); /* Local block number, column-wise. */
lsub = Lrowind_bc_ptr[lk];
lusup = Lnzval_bc_ptr[lk];
if ( lsub ) {
nb = lsub[0];
lptr = BC_HEADER;
luptr = 0;
knsupc = SuperSize( k );
/*
* Perform local block modifications: lsum[i] -= L_i,k * X[k]
*/
zlsum_fmod(lsum, x, &recvbuf[XK_H], rtemp, nrhs, knsupc, k,
fmod, nb, lptr, luptr, xsup, grid, Llu,
send_req, stat);
} /* if lsub */
break;
case LSUM: /* Receiver must be a diagonal process */
--nfrecvmod;
lk = LBi( k, grid ); /* Local block number, row-wise. */
ii = X_BLK( lk );
knsupc = SuperSize( k );
tempv = &recvbuf[LSUM_H];
RHS_ITERATE(j) {
for (i = 0; i < knsupc; ++i)
z_add(&x[i + ii + j*knsupc],
&x[i + ii + j*knsupc],
&tempv[i + j*knsupc]);
}
if ( (--frecv[lk])==0 && fmod[lk]==0 ) {
fmod[lk] = -1; /* Do not solve X[k] in the future. */
lk = LBj( k, grid ); /* Local block number, column-wise. */
lsub = Lrowind_bc_ptr[lk];
lusup = Lnzval_bc_ptr[lk];
nsupr = lsub[1];
#ifdef _CRAY
CTRSM(ftcs1, ftcs1, ftcs2, ftcs3, &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#elif defined (USE_VENDOR_BLAS)
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc, 1, 1, 1, 1);
#else
ztrsm_("L", "L", "N", "U", &knsupc, &nrhs, &alpha,
lusup, &nsupr, &x[ii], &knsupc);
#endif
stat->ops[SOLVE] += 4 * knsupc * (knsupc - 1) * nrhs
+ 10 * knsupc * nrhs; /* complex division */
#if ( DEBUGlevel>=2 )
printf("(%2d) Solve X[%2d]\n", iam, k);
#endif
/*
* Send Xk to process column Pc[k].
*/
kcol = PCOL( k, grid );
for (p = 0; p < Pr; ++p) {
if ( fsendx_plist[lk][p] != EMPTY ) {
pi = PNUM( p, kcol, grid );
#ifdef ISEND_IRECV
MPI_Isend( &x[ii-XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm,
&send_req[Llu->SolveMsgSent++]);
#else
MPI_Send( &x[ii - XK_H], knsupc * nrhs + XK_H,
SuperLU_MPI_DOUBLE_COMPLEX, pi, Xk, grid->comm );
#endif
#if ( DEBUGlevel>=2 )
printf("(%2d) Sent X[%2.0f] to P %2d\n",
iam, x[ii-XK_H], pi);
#endif
}
}
/*
* Perform local block modifications.
*/
nb = lsub[0] - 1;
lptr = BC_HEADER + LB_DESCRIPTOR + knsupc;
luptr = knsupc; /* Skip diagonal block L(k,k). */
zlsum_fmod(lsum, x, &x[ii], rtemp, nrhs, knsupc, k,
fmod, nb, lptr, luptr, xsup, grid, Llu,
send_req, stat);
} /* if */
break;
#if ( DEBUGlevel>=2 )
default:
printf("(%2d) Recv'd wrong message tag %4d\n", status.MPI_TAG);
break;
#endif
} /* switch */
} /* while not finished ... */
#if ( PRNTlevel>=2 )
t = SuperLU_timer_() - t;
if ( !iam ) printf(".. L-solve time\t%8.2f\n", t);
t = SuperLU_timer_();
#endif
#if ( DEBUGlevel==2 )
{
printf("(%d) .. After L-solve: y =\n", iam);
for (i = 0, k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
kcol = PCOL( k, grid );
if ( myrow == krow && mycol == kcol ) { /* Diagonal process */
knsupc = SuperSize( k );
lk = LBi( k, grid );
ii = X_BLK( lk );
for (j = 0; j < knsupc; ++j)
printf("\t(%d)\t%4d\t%.10f\n", iam, xsup[k]+j, x[ii+j]);
fflush(stdout);
}
MPI_Barrier( grid->comm );
}
}
#endif
SUPERLU_FREE(fmod);
SUPERLU_FREE(frecv);
SUPERLU_FREE(rtemp);
#ifdef ISEND_IRECV
for (i = 0; i < Llu->SolveMsgSent; ++i) MPI_Request_free(&send_req[i]);
Llu->SolveMsgSent = 0;
#endif
/*---------------------------------------------------
* Back solve Ux = y.
*
* The Y components from the forward solve is already
* on the diagonal processes.
*---------------------------------------------------*/
/* Save the count to be altered so it can be used by
subsequent call to PZGSTRS. */
if ( !(bmod = intMalloc_dist(nlb)) )
ABORT("Calloc fails for bmod[].");
for (i = 0; i < nlb; ++i) bmod[i] = Llu->bmod[i];
if ( !(brecv = intMalloc_dist(nlb)) )
ABORT("Malloc fails for brecv[].");
Llu->brecv = brecv;
/*
* Compute brecv[] and nbrecvmod counts on the diagonal processes.
*/
{
superlu_scope_t *scp = &grid->rscp;
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
lk = LBi( k, grid ); /* Local block number. */
kcol = PCOL( k, grid ); /* Root process in this row scope. */
if ( mycol != kcol && bmod[lk] )
i = 1; /* Contribution from non-diagonal process. */
else i = 0;
MPI_Reduce( &i, &brecv[lk], 1, mpi_int_t,
MPI_SUM, kcol, scp->comm );
if ( mycol == kcol ) { /* Diagonal process. */
nbrecvmod += brecv[lk];
if ( !brecv[lk] && !bmod[lk] ) ++nroot;
#if ( DEBUGlevel>=2 )
printf("(%2d) brecv[%4d] %2d\n", iam, k, brecv[lk]);
assert( brecv[lk] < Pc );
#endif
}
}
}
}
/* Re-initialize lsum to zero. Each block header is already in place. */
for (k = 0; k < nsupers; ++k) {
krow = PROW( k, grid );
if ( myrow == krow ) {
knsupc = SuperSize( k );
lk = LBi( k, grid );
il = LSUM_BLK( lk );
dest = &lsum[il];
RHS_ITERATE(j) {
for (i = 0; i < knsupc; ++i) dest[i + j*knsupc] = zero;
}
}
}
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
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_bmod1D_mv2(
const int pnum, /* process number */
const int n, /* number of rows in the matrix */
const int w, /* current panel width */
const int jcol, /* leading column of the current panel */
const int fsupc,/* leading column of the updating s-node */
const int krep, /* last column of the updating s-node */
const int nsupc,/* number of columns in the updating s-node */
int nsupr, /* number of rows in the updating supernode */
int nrow, /* number of rows below the diagonal block of
the updating supernode */
int *repfnz, /* in */
int *panel_lsub,/* modified */
int *w_lsub_end,/* modified */
int *spa_marker,/* modified; size n-by-w */
float *dense, /* modified */
float *tempv, /* working array - zeros on entry/exit */
GlobalLU_t *Glu,/* modified */
Gstat_t *Gstat /* 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: col-col, 2cols-col, 3cols-col, and sup-col updates.
* Results are returned in SPA dense[*,w].
*
*/
float zero = 0.0;
float one = 1.0;
#if ( MACH==CRAY_PVP )
_fcd ftcs1 = _cptofcd("L", strlen("L")),
ftcs2 = _cptofcd("N", strlen("N")),
ftcs3 = _cptofcd("U", strlen("U"));
#endif
#ifdef USE_VENDOR_BLAS
int incx = 1, incy = 1;
float alpha = one, beta = zero;
#endif
float ukj, ukj1, ukj2;
int luptr, luptr1, luptr2;
int segsze;
register int lptr; /* start of row subscripts of the updating supernode */
register int i, j, kfnz, krep_ind, isub, irow, no_zeros, twocols;
register int jj; /* index through each column in the panel */
int kfnz2[2], jj2[2]; /* detect two identical columns */
int *repfnz_col, *repfnz_col1; /* repfnz[] for a column in the panel */
float *dense_col, *dense_col1; /* dense[] for a column in the panel */
float *tri[2], *matvec[2];
int *col_marker, *col_marker1; /* each column of the spa_marker[*,w] */
int *col_lsub, *col_lsub1; /* each column of the panel_lsub[*,w] */
int *lsub, *xlsub_end;
float *lusup;
int *xlusup;
register float flopcnt;
#ifdef TIMING
double *utime = Gstat->utime;
double f_time;
#endif
lsub = Glu->lsub;
xlsub_end = Glu->xlsub_end;
lusup = Glu->lusup;
xlusup = Glu->xlusup;
lptr = Glu->xlsub[fsupc];
krep_ind = lptr + nsupc - 1;
twocols = 0;
tri[0] = tempv;
tri[1] = tempv + n;
#ifdef DEBUG
if (jcol == BADPAN && krep == BADREP) {
printf("(%d) dbmod1D[1] jcol %d, fsupc %d, krep %d, nsupc %d, nsupr %d, nrow %d\n",
pnum, jcol, fsupc, krep, nsupc, nsupr, nrow);
PrintInt10("lsub[xlsub[2774]", nsupr, &lsub[lptr]);
}
#endif
/* -----------------------------------------------
* Sequence through each column in the panel ...
* ----------------------------------------------- */
repfnz_col= repfnz;
dense_col = dense;
col_marker= spa_marker;
col_lsub = panel_lsub;
for (jj = jcol; jj < jcol + w; ++jj, col_marker += n, col_lsub += n,
repfnz_col += n, dense_col += n) {
kfnz = repfnz_col[krep];
if ( kfnz == EMPTY ) continue; /* skip any zero segment */
segsze = krep - kfnz + 1;
luptr = xlusup[fsupc];
flopcnt = segsze * (segsze - 1) + 2 * nrow * segsze;
Gstat->procstat[pnum].fcops += flopcnt;
/* Case 1: Update U-segment of size 1 -- col-col update */
if ( segsze == 1 ) {
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
ukj = dense_col[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc;
#ifdef DEBUG
if (krep == BADCOL && jj == -1) {
printf("(%d) dbmod1D[segsze=1]: k %d, j %d, ukj %.10e\n",
pnum, lsub[krep_ind], jj, ukj);
PrintInt10("segsze=1", nsupr, &lsub[lptr]);
}
#endif
for (i = lptr + nsupc; i < xlsub_end[fsupc]; i++) {
irow = lsub[i];
dense_col[irow] -= ukj * lusup[luptr];
++luptr;
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
}
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
} else if ( segsze <= 3 ) {
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
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 ) {
ukj -= ukj1 * lusup[luptr1];
dense_col[lsub[krep_ind]] = ukj;
/*#pragma ivdep*/
for (i = lptr + nsupc; i < xlsub_end[fsupc]; ++i) {
irow = lsub[i];
++luptr; ++luptr1;
dense_col[irow] -= (ukj * lusup[luptr]
+ ukj1 * lusup[luptr1]);
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
}
} else {
ukj2 = dense_col[lsub[krep_ind - 2]];
luptr2 = luptr1 - nsupr;
ukj1 -= ukj2 * lusup[luptr2-1];
ukj = ukj - ukj1*lusup[luptr1] - ukj2*lusup[luptr2];
dense_col[lsub[krep_ind]] = ukj;
dense_col[lsub[krep_ind-1]] = ukj1;
for (i = lptr + nsupc; i < xlsub_end[fsupc]; ++i) {
irow = lsub[i];
++luptr; ++luptr1; ++luptr2;
dense_col[irow] -= (ukj * lusup[luptr]
+ ukj1*lusup[luptr1] + ukj2*lusup[luptr2]);
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
}
}
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
} else { /* segsze >= 4 */
if ( twocols == 1 ) {
jj2[1] = jj; /* got two columns */
twocols = 0;
for (j = 0; j < 2; ++j) { /* Do two tri-solves */
i = n * (jj2[j] - jcol);
repfnz_col1 = &repfnz[i];
dense_col1 = &dense[i];
kfnz2[j] = repfnz_col1[krep];
no_zeros = kfnz2[j] - fsupc;
segsze = krep - kfnz2[j] + 1;
matvec[j] = tri[j] + segsze;
/* Gather U[*,j] segment from dense[*] to tri[*]. */
isub = lptr + no_zeros;
for (i = 0; i < segsze; ++i) {
irow = lsub[isub];
tri[j][i] = dense_col1[irow]; /* Gather */
++isub;
}
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
/* start effective triangle */
luptr = xlusup[fsupc] + nsupr * no_zeros + no_zeros;
#ifdef USE_VENDOR_BLAS
#if ( MACH==CRAY_PVP )
STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr],
&nsupr, tri[j], &incx );
#else
strsv_( "L", "N", "U", &segsze, &lusup[luptr],
&nsupr, tri[j], &incx );
#endif
#else
slsolve ( nsupr, segsze, &lusup[luptr], tri[j] );
#endif
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
} /* end for j ... two tri-solves */
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
if ( kfnz2[0] < kfnz2[1] ) { /* First column is bigger */
no_zeros = kfnz2[0] - fsupc;
segsze = kfnz2[1] - kfnz2[0];
luptr = xlusup[fsupc] + nsupr * no_zeros + nsupc;
#ifdef USE_VENDOR_BLAS
#if ( MACH==CRAY_PVP )
SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tri[0], &incx, &beta, matvec[0], &incy );
#else
sgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tri[0], &incx, &beta, matvec[0], &incy );
#endif
#else
smatvec (nsupr, nrow, segsze, &lusup[luptr],
tri[0], matvec[0]);
#endif
} else if ( kfnz2[0] > kfnz2[1] ) {
no_zeros = kfnz2[1] - fsupc;
segsze = kfnz2[0] - kfnz2[1];
luptr = xlusup[fsupc] + nsupr * no_zeros + nsupc;
#ifdef USE_VENDOR_BLAS
#if ( MACH==CRAY_PVP )
SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tri[1], &incx, &beta, matvec[1], &incy );
#else
sgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tri[1], &incx, &beta, matvec[1], &incy );
#endif
#else
smatvec (nsupr, nrow, segsze, &lusup[luptr],
tri[1], matvec[1]);
#endif
}
/* Do matrix-vector multiply with two destinations */
kfnz = SUPERLU_MAX( kfnz2[0], kfnz2[1] );
no_zeros = kfnz - fsupc;
segsze = krep - kfnz + 1;
luptr = xlusup[fsupc] + nsupr * no_zeros + nsupc;
#if ( MACH==DEC )
sgemv2_(&nsupr, &nrow, &segsze, &lusup[luptr],
&tri[0][kfnz-kfnz2[0]], &tri[1][kfnz-kfnz2[1]],
matvec[0], matvec[1]);
/*#elif ( MACH==CRAY_PVP )
SGEMV2(&nsupr, &nrow, &segsze, &lusup[luptr],
&tri[0][kfnz-kfnz2[0]], &tri[1][kfnz-kfnz2[1]],
matvec[0], matvec[1]);*/
#else
//smatvec2(nsupr, nrow, segsze, &lusup[luptr],
// &tri[0][kfnz-kfnz2[0]], &tri[1][kfnz-kfnz2[1]],
// matvec[0], matvec[1]);
#endif
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
for (j = 0; j < 2; ++j) {
i = n * (jj2[j] - jcol);
dense_col1 = &dense[i];
col_marker1 = &spa_marker[i];
col_lsub1 = &panel_lsub[i];
no_zeros = kfnz2[j] - fsupc;
segsze = krep - kfnz2[j] + 1;
/* Scatter tri[*] into SPA dense[*]. */
isub = lptr + no_zeros;
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
dense_col1[irow] = tri[j][i]; /* Scatter */
tri[j][i] = zero;
++isub;
#ifdef DEBUG
if (jj == -1 && krep == 3423)
printf("(%d) dbmod1D[scatter] jj %d, dense_col[%d] %e\n",
pnum, jj, irow, dense_col[irow]);
#endif
}
/* Scatter matvec[*] into SPA dense[*]. */
/*#pragma ivdep*/
for (i = 0; i < nrow; i++) {
irow = lsub[isub];
dense_col1[irow] -= matvec[j][i]; /* Scatter-add */
#ifdef SCATTER_FOUND
if ( col_marker1[irow] != jj2[j] ) {
col_marker1[irow] = jj2[j];
col_lsub1[w_lsub_end[jj2[j]-jcol]++] = irow;
}
#endif
matvec[j][i] = zero;
++isub;
}
} /* end for two destination update */
} else { /* wait for a second column */
jj2[0] = jj;
twocols = 1;
}
} /* else segsze >= 4 */
} /* for jj ... */
if ( twocols == 1 ) { /* one more column left */
i = n * (jj2[0] - jcol);
repfnz_col1 = &repfnz[i];
dense_col1 = &dense[i];
col_marker1 = &spa_marker[i];
col_lsub1 = &panel_lsub[i];
kfnz = repfnz_col1[krep];
no_zeros = kfnz - fsupc;
segsze = krep - kfnz + 1;
/* Gather U[*,j] segment from dense[*] to tri[*]. */
isub = lptr + no_zeros;
for (i = 0; i < segsze; ++i) {
irow = lsub[isub];
tri[0][i] = dense_col1[irow]; /* Gather */
++isub;
}
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
/* start effective triangle */
luptr = xlusup[fsupc] + nsupr * no_zeros + no_zeros;
#ifdef USE_VENDOR_BLAS
#if ( MACH==CRAY_PVP )
STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr],
&nsupr, tri[0], &incx );
#else
strsv_( "L", "N", "U", &segsze, &lusup[luptr],
&nsupr, tri[0], &incx );
#endif
#else
slsolve ( nsupr, segsze, &lusup[luptr], tri[0] );
#endif
luptr += segsze; /* Dense matrix-vector */
matvec[0] = tri[0] + segsze;
#ifdef USE_VENDOR_BLAS
#if ( MACH==CRAY_PVP )
SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tri[0], &incx, &beta, matvec[0], &incy );
#else
sgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tri[0], &incx, &beta, matvec[0], &incy );
#endif
#else
smatvec (nsupr, nrow, segsze, &lusup[luptr], tri[0], matvec[0]);
#endif
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
/* Scatter tri[*] into SPA dense[*]. */
isub = lptr + no_zeros;
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
dense_col1[irow] = tri[0][i]; /* Scatter */
tri[0][i] = zero;
++isub;
#ifdef DEBUG
if (jj == -1 && krep == 3423)
printf("(%d) dbmod1D[scatter] jj %d, dense_col[%d] %e\n",
pnum, jj, irow, dense_col[irow]);
#endif
}
/* Scatter matvec[*] into SPA dense[*]. */
for (i = 0; i < nrow; i++) {
irow = lsub[isub];
dense_col1[irow] -= matvec[0][i]; /* Scatter-add */
#ifdef SCATTER_FOUND
if ( col_marker1[irow] != jj2[0] ) {
col_marker1[irow] = jj2[0];
col_lsub1[w_lsub_end[jj2[0]-jcol]++] = irow;
}
#endif
matvec[0][i] = zero;
++isub;
}
} /* if twocols == 1 */
}
void
pdgssvx(superlu_options_t *options, SuperMatrix *A,
ScalePermstruct_t *ScalePermstruct,
double B[], int ldb, int nrhs, gridinfo_t *grid,
LUstruct_t *LUstruct, SOLVEstruct_t *SOLVEstruct, double *berr,
SuperLUStat_t *stat, int *info)
{
/*
* -- Distributed SuperLU routine (version 2.2) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley.
* November 1, 2007
* Feburary 20, 2008
*
*
* Purpose
* =======
*
* PDGSSVX solves a system of linear equations A*X=B,
* by using Gaussian elimination with "static pivoting" to
* compute the LU factorization of A.
*
* Static pivoting is a technique that combines the numerical stability
* of partial pivoting with the scalability of Cholesky (no pivoting),
* to run accurately and efficiently on large numbers of processors.
* See our paper at http://www.nersc.gov/~xiaoye/SuperLU/ for a detailed
* description of the parallel algorithms.
*
* The input matrices A and B are distributed by block rows.
* Here is a graphical illustration (0-based indexing):
*
* A B
* 0 --------------- ------
* | | | |
* | | P0 | |
* | | | |
* --------------- ------
* - fst_row->| | | |
* | | | | |
* m_loc | | P1 | |
* | | | | |
* - | | | |
* --------------- ------
* | . | |. |
* | . | |. |
* | . | |. |
* --------------- ------
*
* where, fst_row is the row number of the first row,
* m_loc is the number of rows local to this processor
* These are defined in the 'SuperMatrix' structure, see supermatrix.h.
*
*
* Here are the options for using this code:
*
* 1. Independent of all the other options specified below, the
* user must supply
*
* - B, the matrix of right-hand sides, distributed by block rows,
* and its dimensions ldb (local) and nrhs (global)
* - grid, a structure describing the 2D processor mesh
* - options->IterRefine, which determines whether or not to
* improve the accuracy of the computed solution using
* iterative refinement
*
* On output, B is overwritten with the solution X.
*
* 2. Depending on options->Fact, the user has four options
* for solving A*X=B. The standard option is for factoring
* A "from scratch". (The other options, described below,
* are used when A is sufficiently similar to a previously
* solved problem to save time by reusing part or all of
* the previous factorization.)
*
* - options->Fact = DOFACT: A is factored "from scratch"
*
* In this case the user must also supply
*
* o A, the input matrix
*
* as well as the following options to determine what matrix to
* factorize.
*
* o options->Equil, to specify how to scale the rows and columns
* of A to "equilibrate" it (to try to reduce its
* condition number and so improve the
* accuracy of the computed solution)
*
* o options->RowPerm, to specify how to permute the rows of A
* (typically to control numerical stability)
*
* o options->ColPerm, to specify how to permute the columns of A
* (typically to control fill-in and enhance
* parallelism during factorization)
*
* o options->ReplaceTinyPivot, to specify how to deal with tiny
* pivots encountered during factorization
* (to control numerical stability)
*
* The outputs returned include
*
* o ScalePermstruct, modified to describe how the input matrix A
* was equilibrated and permuted:
* . ScalePermstruct->DiagScale, indicates whether the rows and/or
* columns of A were scaled
* . ScalePermstruct->R, array of row scale factors
* . ScalePermstruct->C, array of column scale factors
* . ScalePermstruct->perm_r, row permutation vector
* . ScalePermstruct->perm_c, column permutation vector
*
* (part of ScalePermstruct may also need to be supplied on input,
* depending on options->RowPerm and options->ColPerm as described
* later).
*
* o A, the input matrix A overwritten by the scaled and permuted
* matrix diag(R)*A*diag(C)*Pc^T, where
* Pc is the row permutation matrix determined by
* ScalePermstruct->perm_c
* diag(R) and diag(C) are diagonal scaling matrices determined
* by ScalePermstruct->DiagScale, ScalePermstruct->R and
* ScalePermstruct->C
*
* o LUstruct, which contains the L and U factorization of A1 where
*
* A1 = Pc*Pr*diag(R)*A*diag(C)*Pc^T = L*U
*
* (Note that A1 = Pc*Pr*Aout, where Aout is the matrix stored
* in A on output.)
*
* 3. The second value of options->Fact assumes that a matrix with the same
* sparsity pattern as A has already been factored:
*
* - options->Fact = SamePattern: A is factored, assuming that it has
* the same nonzero pattern as a previously factored matrix. In
* this case the algorithm saves time by reusing the previously
* computed column permutation vector stored in
* ScalePermstruct->perm_c and the "elimination tree" of A
* stored in LUstruct->etree
*
* In this case the user must still specify the following options
* as before:
*
* o options->Equil
* o options->RowPerm
* o options->ReplaceTinyPivot
*
* but not options->ColPerm, whose value is ignored. This is because the
* previous column permutation from ScalePermstruct->perm_c is used as
* input. The user must also supply
*
* o A, the input matrix
* o ScalePermstruct->perm_c, the column permutation
* o LUstruct->etree, the elimination tree
*
* The outputs returned include
*
* o A, the input matrix A overwritten by the scaled and permuted
* matrix as described above
* o ScalePermstruct, modified to describe how the input matrix A was
* equilibrated and row permuted
* o LUstruct, modified to contain the new L and U factors
*
* 4. The third value of options->Fact assumes that a matrix B with the same
* sparsity pattern as A has already been factored, and where the
* row permutation of B can be reused for A. This is useful when A and B
* have similar numerical values, so that the same row permutation
* will make both factorizations numerically stable. This lets us reuse
* all of the previously computed structure of L and U.
*
* - options->Fact = SamePattern_SameRowPerm: A is factored,
* assuming not only the same nonzero pattern as the previously
* factored matrix B, but reusing B's row permutation.
*
* In this case the user must still specify the following options
* as before:
*
* o options->Equil
* o options->ReplaceTinyPivot
*
* but not options->RowPerm or options->ColPerm, whose values are
* ignored. This is because the permutations from ScalePermstruct->perm_r
* and ScalePermstruct->perm_c are used as input.
*
* The user must also supply
*
* o A, the input matrix
* o ScalePermstruct->DiagScale, how the previous matrix was row
* and/or column scaled
* o ScalePermstruct->R, the row scalings of the previous matrix,
* if any
* o ScalePermstruct->C, the columns scalings of the previous matrix,
* if any
* o ScalePermstruct->perm_r, the row permutation of the previous
* matrix
* o ScalePermstruct->perm_c, the column permutation of the previous
* matrix
* o all of LUstruct, the previously computed information about
* L and U (the actual numerical values of L and U
* stored in LUstruct->Llu are ignored)
*
* The outputs returned include
*
* o A, the input matrix A overwritten by the scaled and permuted
* matrix as described above
* o ScalePermstruct, modified to describe how the input matrix A was
* equilibrated (thus ScalePermstruct->DiagScale,
* R and C may be modified)
* o LUstruct, modified to contain the new L and U factors
*
* 5. The fourth and last value of options->Fact assumes that A is
* identical to a matrix that has already been factored on a previous
* call, and reuses its entire LU factorization
*
* - options->Fact = Factored: A is identical to a previously
* factorized matrix, so the entire previous factorization
* can be reused.
*
* In this case all the other options mentioned above are ignored
* (options->Equil, options->RowPerm, options->ColPerm,
* options->ReplaceTinyPivot)
*
* The user must also supply
*
* o A, the unfactored matrix, only in the case that iterative
* refinment is to be done (specifically A must be the output
* A from the previous call, so that it has been scaled and permuted)
* o all of ScalePermstruct
* o all of LUstruct, including the actual numerical values of
* L and U
*
* all of which are unmodified on output.
*
* Arguments
* =========
*
* options (input) superlu_options_t* (global)
* The structure defines the input parameters to control
* how the LU decomposition 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, how the matrix A should
* be factorized based on the previous history.
*
* = DOFACT: The matrix A will be factorized from scratch.
* Inputs: A
* options->Equil, RowPerm, ColPerm, ReplaceTinyPivot
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* all of ScalePermstruct
* all of LUstruct
*
* = SamePattern: the matrix A will be factorized assuming
* that a factorization of a matrix with the same sparsity
* pattern was performed prior to this one. Therefore, this
* factorization will reuse column permutation vector
* ScalePermstruct->perm_c and the elimination tree
* LUstruct->etree
* Inputs: A
* options->Equil, RowPerm, ReplaceTinyPivot
* ScalePermstruct->perm_c
* LUstruct->etree
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* rest of ScalePermstruct (DiagScale, R, C, perm_r)
* rest of LUstruct (GLU_persist, Llu)
*
* = SamePattern_SameRowPerm: the matrix A will be factorized
* assuming that a factorization of a matrix with the same
* sparsity pattern and similar numerical values was performed
* prior to this one. Therefore, this factorization will reuse
* both row and column scaling factors R and C, and the
* both row and column permutation vectors perm_r and perm_c,
* distributed data structure set up from the previous symbolic
* factorization.
* Inputs: A
* options->Equil, ReplaceTinyPivot
* all of ScalePermstruct
* all of LUstruct
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* modified LUstruct->Llu
* = FACTORED: the matrix A is already factored.
* Inputs: all of ScalePermstruct
* all of LUstruct
*
* o Equil (yes_no_t)
* Specifies whether to equilibrate the system.
* = NO: no equilibration.
* = YES: scaling factors are computed to equilibrate the system:
* diag(R)*A*diag(C)*inv(diag(C))*X = diag(R)*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.
*
* o RowPerm (rowperm_t)
* Specifies how to permute rows of the matrix A.
* = NATURAL: use the natural ordering.
* = LargeDiag: use the Duff/Koster algorithm to permute rows of
* the original matrix to make the diagonal large
* relative to the off-diagonal.
* = MY_PERMR: use the ordering given in ScalePermstruct->perm_r
* input by the user.
*
* o ColPerm (colperm_t)
* Specifies what type of column permutation to use to reduce fill.
* = NATURAL: natural ordering.
* = MMD_AT_PLUS_A: minimum degree ordering on structure of A'+A.
* = MMD_ATA: minimum degree ordering on structure of A'*A.
* = MY_PERMC: the ordering given in ScalePermstruct->perm_c.
*
* o ReplaceTinyPivot (yes_no_t)
* = NO: do not modify pivots
* = YES: replace tiny pivots by sqrt(epsilon)*norm(A) during
* LU factorization.
*
* o IterRefine (IterRefine_t)
* Specifies how to perform iterative refinement.
* = NO: no iterative refinement.
* = DOUBLE: accumulate residual in double precision.
* = EXTRA: accumulate residual in extra precision.
*
* NOTE: all options must be indentical on all processes when
* calling this routine.
*
* A (input/output) SuperMatrix* (local)
* On entry, matrix A in A*X=B, of dimension (A->nrow, A->ncol).
* The number of linear equations is A->nrow. The type of A must be:
* Stype = SLU_NR_loc; Dtype = SLU_D; Mtype = SLU_GE.
* That is, A is stored in distributed compressed row format.
* See supermatrix.h for the definition of 'SuperMatrix'.
* This routine only handles square A, however, the LU factorization
* routine PDGSTRF can factorize rectangular matrices.
* On exit, A may be overwtirren by diag(R)*A*diag(C)*Pc^T,
* depending on ScalePermstruct->DiagScale and options->ColPerm:
* if ScalePermstruct->DiagScale != NOEQUIL, A is overwritten by
* diag(R)*A*diag(C).
* if options->ColPerm != NATURAL, A is further overwritten by
* diag(R)*A*diag(C)*Pc^T.
* If all the above condition are true, the LU decomposition is
* performed on the matrix Pc*Pr*diag(R)*A*diag(C)*Pc^T.
*
* ScalePermstruct (input/output) ScalePermstruct_t* (global)
* The data structure to store the scaling and permutation vectors
* describing the transformations performed to the matrix A.
* It contains the following fields:
*
* o DiagScale (DiagScale_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 options->Fact = FACTORED or SamePattern_SameRowPerm,
* DiagScale is an input argument; otherwise it is an output
* argument.
*
* o perm_r (int*)
* Row permutation vector, which defines the permutation matrix Pr;
* perm_r[i] = j means row i of A is in position j in Pr*A.
* If options->RowPerm = MY_PERMR, or
* options->Fact = SamePattern_SameRowPerm, perm_r is an
* input argument; otherwise it is an output argument.
*
* o perm_c (int*)
* Column permutation vector, which defines the
* permutation matrix Pc; perm_c[i] = j means column i of A is
* in position j in A*Pc.
* If options->ColPerm = MY_PERMC or options->Fact = SamePattern
* or options->Fact = SamePattern_SameRowPerm, perm_c is an
* input argument; otherwise, it is an output 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.
*
* o R (double*) dimension (A->nrow)
* The row scale factors for A.
* If DiagScale = ROW or BOTH, A is multiplied on the left by
* diag(R).
* If DiagScale = NOEQUIL or COL, R is not defined.
* If options->Fact = FACTORED or SamePattern_SameRowPerm, R is
* an input argument; otherwise, R is an output argument.
*
* o C (double*) dimension (A->ncol)
* The column scale factors for A.
* If DiagScale = COL or BOTH, A is multiplied on the right by
* diag(C).
* If DiagScale = NOEQUIL or ROW, C is not defined.
* If options->Fact = FACTORED or SamePattern_SameRowPerm, C is
* an input argument; otherwise, C is an output argument.
*
* B (input/output) double* (local)
* On entry, the right-hand side matrix of dimension (m_loc, nrhs),
* where, m_loc is the number of rows stored locally on my
* process and is defined in the data structure of matrix A.
* On exit, the solution matrix if info = 0;
*
* ldb (input) int (local)
* The leading dimension of matrix B.
*
* nrhs (input) int (global)
* The number of right-hand sides.
* If nrhs = 0, only LU decomposition is performed, the forward
* and back substitutions are skipped.
*
* grid (input) gridinfo_t* (global)
* The 2D process mesh. It contains the MPI communicator, the number
* of process rows (NPROW), the number of process columns (NPCOL),
* and my process rank. It is an input argument to all the
* parallel routines.
* Grid can be initialized by subroutine SUPERLU_GRIDINIT.
* See superlu_ddefs.h for the definition of 'gridinfo_t'.
*
* LUstruct (input/output) LUstruct_t*
* The data structures to store the distributed L and U factors.
* It contains the following fields:
*
* o etree (int*) dimension (A->ncol) (global)
* Elimination tree of Pc*(A'+A)*Pc' or Pc*A'*A*Pc'.
* It is computed in sp_colorder() during the first factorization,
* and is reused in the subsequent factorizations of the matrices
* with the same nonzero pattern.
* On exit of sp_colorder(), the columns of A are permuted so that
* the etree is in a certain postorder. This postorder is reflected
* in ScalePermstruct->perm_c.
* 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.
*
* o Glu_persist (Glu_persist_t*) (global)
* Global data structure (xsup, supno) replicated on all processes,
* describing the supernode partition in the factored matrices
* L and U:
* xsup[s] is the leading column of the s-th supernode,
* supno[i] is the supernode number to which column i belongs.
*
* o Llu (LocalLU_t*) (local)
* The distributed data structures to store L and U factors.
* See superlu_ddefs.h for the definition of 'LocalLU_t'.
*
* SOLVEstruct (input/output) SOLVEstruct_t*
* The data structure to hold the communication pattern used
* in the phases of triangular solution and iterative refinement.
* This pattern should be intialized only once for repeated solutions.
* If options->SolveInitialized = YES, it is an input argument.
* If options->SolveInitialized = NO and nrhs != 0, it is an output
* argument. See superlu_ddefs.h for the definition of 'SOLVEstruct_t'.
*
* berr (output) double*, dimension (nrhs) (global)
* 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).
*
* 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, 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.
*
* See superlu_ddefs.h for the definitions of varioous data types.
*
*/
NRformat_loc *Astore;
SuperMatrix GA; /* Global A in NC format */
NCformat *GAstore;
double *a_GA;
SuperMatrix GAC; /* Global A in NCP format (add n end pointers) */
NCPformat *GACstore;
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
Glu_freeable_t *Glu_freeable;
/* The nonzero structures of L and U factors, which are
replicated on all processrs.
(lsub, xlsub) contains the compressed subscript of
supernodes in L.
(usub, xusub) contains the compressed subscript of
nonzero segments in U.
If options->Fact != SamePattern_SameRowPerm, they are
computed by SYMBFACT routine, and then used by PDDISTRIBUTE
routine. They will be freed after PDDISTRIBUTE routine.
If options->Fact == SamePattern_SameRowPerm, these
structures are not used. */
fact_t Fact;
double *a;
int_t *colptr, *rowind;
int_t *perm_r; /* row permutations from partial pivoting */
int_t *perm_c; /* column permutation vector */
int_t *etree; /* elimination tree */
int_t *rowptr, *colind; /* Local A in NR*/
int_t *rowind_loc, *colptr_loc;
int_t colequ, Equil, factored, job, notran, rowequ, need_value;
int_t i, iinfo, j, irow, m, n, nnz, permc_spec, dist_mem_use;
int_t nnz_loc, m_loc, fst_row, icol;
int iam;
int ldx; /* LDA for matrix X (local). */
char equed[1], norm[1];
double *C, *R, *C1, *R1, amax, anorm, colcnd, rowcnd;
double *X, *b_col, *b_work, *x_col;
double t;
static mem_usage_t num_mem_usage, symb_mem_usage;
#if ( PRNTlevel>= 2 )
double dmin, dsum, dprod;
#endif
int_t procs;
/* Structures needed for parallel symbolic factorization */
int_t *sizes, *fstVtxSep, parSymbFact;
int noDomains, nprocs_num;
MPI_Comm symb_comm; /* communicator for symbolic factorization */
int col, key; /* parameters for creating a new communicator */
Pslu_freeable_t Pslu_freeable;
float flinfo;
/* Initialization. */
m = A->nrow;
n = A->ncol;
Astore = (NRformat_loc *) A->Store;
nnz_loc = Astore->nnz_loc;
m_loc = Astore->m_loc;
fst_row = Astore->fst_row;
a = (double *) Astore->nzval;
rowptr = Astore->rowptr;
colind = Astore->colind;
sizes = NULL;
fstVtxSep = NULL;
symb_comm = MPI_COMM_NULL;
/* Test the input parameters. */
*info = 0;
Fact = options->Fact;
if ( Fact < 0 || Fact > FACTORED )
*info = -1;
else if ( options->RowPerm < 0 || options->RowPerm > MY_PERMR )
*info = -1;
else if ( options->ColPerm < 0 || options->ColPerm > MY_PERMC )
*info = -1;
else if ( options->IterRefine < 0 || options->IterRefine > EXTRA )
*info = -1;
else if ( options->IterRefine == EXTRA ) {
*info = -1;
fprintf(stderr, "Extra precise iterative refinement yet to support.");
} else if ( A->nrow != A->ncol || A->nrow < 0 || A->Stype != SLU_NR_loc
|| A->Dtype != SLU_D || A->Mtype != SLU_GE )
*info = -2;
else if ( ldb < m_loc )
*info = -5;
else if ( nrhs < 0 )
*info = -6;
if ( *info ) {
i = -(*info);
pxerbla("pdgssvx", grid, -*info);
return;
}
factored = (Fact == FACTORED);
Equil = (!factored && options->Equil == YES);
notran = (options->Trans == NOTRANS);
iam = grid->iam;
job = 5;
if ( factored || (Fact == SamePattern_SameRowPerm && Equil) ) {
rowequ = (ScalePermstruct->DiagScale == ROW) ||
(ScalePermstruct->DiagScale == BOTH);
colequ = (ScalePermstruct->DiagScale == COL) ||
(ScalePermstruct->DiagScale == BOTH);
} else rowequ = colequ = FALSE;
/* The following arrays are replicated on all processes. */
perm_r = ScalePermstruct->perm_r;
perm_c = ScalePermstruct->perm_c;
etree = LUstruct->etree;
R = ScalePermstruct->R;
C = ScalePermstruct->C;
/********/
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pdgssvx()");
#endif
/* Not factored & ask for equilibration */
if ( Equil && Fact != SamePattern_SameRowPerm ) {
/* Allocate storage if not done so before. */
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
if ( !(R = (double *) doubleMalloc_dist(m)) )
ABORT("Malloc fails for R[].");
if ( !(C = (double *) doubleMalloc_dist(n)) )
ABORT("Malloc fails for C[].");
ScalePermstruct->R = R;
ScalePermstruct->C = C;
break;
case ROW:
if ( !(C = (double *) doubleMalloc_dist(n)) )
ABORT("Malloc fails for C[].");
ScalePermstruct->C = C;
break;
case COL:
if ( !(R = (double *) doubleMalloc_dist(m)) )
ABORT("Malloc fails for R[].");
ScalePermstruct->R = R;
break;
}
}
/* ------------------------------------------------------------
Diagonal scaling to equilibrate the matrix.
------------------------------------------------------------*/
if ( Equil ) {
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter equil");
#endif
t = SuperLU_timer_();
if ( Fact == SamePattern_SameRowPerm ) {
/* Reuse R and C. */
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
break;
case ROW:
irow = fst_row;
for (j = 0; j < m_loc; ++j) {
for (i = rowptr[j]; i < rowptr[j+1]; ++i) {
a[i] *= R[irow]; /* Scale rows. */
}
++irow;
}
break;
case COL:
for (j = 0; j < m_loc; ++j)
for (i = rowptr[j]; i < rowptr[j+1]; ++i){
icol = colind[i];
a[i] *= C[icol]; /* Scale columns. */
}
break;
case BOTH:
irow = fst_row;
for (j = 0; j < m_loc; ++j) {
for (i = rowptr[j]; i < rowptr[j+1]; ++i) {
icol = colind[i];
a[i] *= R[irow] * C[icol]; /* Scale rows and cols. */
}
++irow;
}
break;
}
} else { /* Compute R & C from scratch */
/* Compute the row and column scalings. */
pdgsequ(A, R, C, &rowcnd, &colcnd, &amax, &iinfo, grid);
/* Equilibrate matrix A if it is badly-scaled. */
pdlaqgs(A, R, C, rowcnd, colcnd, amax, equed);
if ( lsame_(equed, "R") ) {
ScalePermstruct->DiagScale = rowequ = ROW;
} else if ( lsame_(equed, "C") ) {
ScalePermstruct->DiagScale = colequ = COL;
} else if ( lsame_(equed, "B") ) {
ScalePermstruct->DiagScale = BOTH;
rowequ = ROW;
colequ = COL;
} else ScalePermstruct->DiagScale = NOEQUIL;
#if ( PRNTlevel>=1 )
if ( !iam ) {
printf(".. equilibrated? *equed = %c\n", *equed);
/*fflush(stdout);*/
}
#endif
} /* if Fact ... */
stat->utime[EQUIL] = SuperLU_timer_() - t;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Exit equil");
#endif
} /* if Equil ... */
if ( !factored ) { /* Skip this if already factored. */
/*
* Gather A from the distributed compressed row format to
* global A in compressed column format.
* Numerical values are gathered only when a row permutation
* for large diagonal is sought after.
*/
if ( Fact != SamePattern_SameRowPerm ) {
need_value = (options->RowPerm == LargeDiag);
pdCompRow_loc_to_CompCol_global(need_value, A, grid, &GA);
GAstore = (NCformat *) GA.Store;
colptr = GAstore->colptr;
rowind = GAstore->rowind;
nnz = GAstore->nnz;
if ( need_value ) a_GA = (double *) GAstore->nzval;
else assert(GAstore->nzval == NULL);
}
/* ------------------------------------------------------------
Find the row permutation for A.
------------------------------------------------------------*/
if ( options->RowPerm != NO ) {
t = SuperLU_timer_();
if ( Fact != SamePattern_SameRowPerm ) {
if ( options->RowPerm == MY_PERMR ) { /* Use user's perm_r. */
/* Permute the global matrix GA for symbfact() */
for (i = 0; i < colptr[n]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
}
} else { /* options->RowPerm == LargeDiag */
/* Get a new perm_r[] */
if ( job == 5 ) {
/* Allocate storage for scaling factors. */
if ( !(R1 = doubleMalloc_dist(m)) )
ABORT("SUPERLU_MALLOC fails for R1[]");
if ( !(C1 = doubleMalloc_dist(n)) )
ABORT("SUPERLU_MALLOC fails for C1[]");
}
if ( !iam ) {
/* Process 0 finds a row permutation */
dldperm(job, m, nnz, colptr, rowind, a_GA,
perm_r, R1, C1);
MPI_Bcast( perm_r, m, mpi_int_t, 0, grid->comm );
if ( job == 5 && Equil ) {
MPI_Bcast( R1, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C1, n, MPI_DOUBLE, 0, grid->comm );
}
} else {
MPI_Bcast( perm_r, m, mpi_int_t, 0, grid->comm );
if ( job == 5 && Equil ) {
MPI_Bcast( R1, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C1, n, MPI_DOUBLE, 0, grid->comm );
}
}
#if ( PRNTlevel>=2 )
dmin = dlamch_("Overflow");
dsum = 0.0;
dprod = 1.0;
#endif
if ( job == 5 ) {
if ( Equil ) {
for (i = 0; i < n; ++i) {
R1[i] = exp(R1[i]);
C1[i] = exp(C1[i]);
}
/* Scale the distributed matrix */
irow = fst_row;
for (j = 0; j < m_loc; ++j) {
for (i = rowptr[j]; i < rowptr[j+1]; ++i) {
icol = colind[i];
a[i] *= R1[irow] * C1[icol];
#if ( PRNTlevel>=2 )
if ( perm_r[irow] == icol ) { /* New diagonal */
if ( job == 2 || job == 3 )
dmin = SUPERLU_MIN(dmin, fabs(a[i]));
else if ( job == 4 )
dsum += fabs(a[i]);
else if ( job == 5 )
dprod *= fabs(a[i]);
}
#endif
}
++irow;
}
/* Multiply together the scaling factors. */
if ( rowequ ) for (i = 0; i < m; ++i) R[i] *= R1[i];
else for (i = 0; i < m; ++i) R[i] = R1[i];
if ( colequ ) for (i = 0; i < n; ++i) C[i] *= C1[i];
else for (i = 0; i < n; ++i) C[i] = C1[i];
ScalePermstruct->DiagScale = BOTH;
rowequ = colequ = 1;
} /* end Equil */
/* Now permute global A to prepare for symbfact() */
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
}
}
SUPERLU_FREE (R1);
SUPERLU_FREE (C1);
} else { /* job = 2,3,4 */
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
} /* end for i ... */
} /* end for j ... */
} /* end else job ... */
#if ( PRNTlevel>=2 )
if ( job == 2 || job == 3 ) {
if ( !iam ) printf("\tsmallest diagonal %e\n", dmin);
} else if ( job == 4 ) {
if ( !iam ) printf("\tsum of diagonal %e\n", dsum);
} else if ( job == 5 ) {
if ( !iam ) printf("\t product of diagonal %e\n", dprod);
}
#endif
} /* end if options->RowPerm ... */
t = SuperLU_timer_() - t;
stat->utime[ROWPERM] = t;
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. LDPERM job %d\t time: %.2f\n", job, t);
#endif
} /* end if Fact ... */
} else { /* options->RowPerm == NOROWPERM */
for (i = 0; i < m; ++i) perm_r[i] = i;
}
#if ( DEBUGlevel>=2 )
if ( !iam ) PrintInt10("perm_r", m, perm_r);
#endif
} /* end if (!factored) */
if ( !factored || options->IterRefine ) {
/* Compute norm(A), which will be used to adjust small diagonal. */
if ( notran ) *(unsigned char *)norm = '1';
else *(unsigned char *)norm = 'I';
anorm = pdlangs(norm, A, grid);
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. anorm %e\n", anorm);
#endif
}
/* ------------------------------------------------------------
Perform the LU factorization.
------------------------------------------------------------*/
if ( !factored ) {
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 = METIS_AT_PLUS_A: METIS on structure of A'+A
* permc_spec = PARMETIS: parallel METIS on structure of A'+A
* permc_spec = MY_PERMC: the ordering already supplied in perm_c[]
*/
permc_spec = options->ColPerm;
parSymbFact = options->ParSymbFact;
#if ( PRNTlevel>=1 )
if ( parSymbFact && permc_spec != PARMETIS )
if ( !iam ) printf(".. Parallel symbolic factorization"
" only works wth ParMetis!\n");
#endif
if ( parSymbFact == YES || permc_spec == PARMETIS ) {
nprocs_num = grid->nprow * grid->npcol;
noDomains = (int) ( pow(2, ((int) LOG2( nprocs_num ))));
/* create a new communicator for the first noDomains processors in
grid->comm */
key = iam;
if (iam < noDomains) col = 0;
else col = MPI_UNDEFINED;
MPI_Comm_split (grid->comm, col, key, &symb_comm );
permc_spec = PARMETIS; /* only works with PARMETIS */
}
if ( permc_spec != MY_PERMC && Fact == DOFACT ) {
if ( permc_spec == PARMETIS ) {
/* Get column permutation vector in perm_c. *
* This routine takes as input the distributed input matrix A *
* and does not modify it. It also allocates memory for *
* sizes[] and fstVtxSep[] arrays, that contain information *
* on the separator tree computed by ParMETIS. */
flinfo = get_perm_c_parmetis(A, perm_r, perm_c, nprocs_num,
noDomains, &sizes, &fstVtxSep,
grid, &symb_comm);
if (flinfo > 0)
ABORT("ERROR in get perm_c parmetis.");
} else {
get_perm_c_dist(iam, permc_spec, &GA, perm_c);
}
}
stat->utime[COLPERM] = SuperLU_timer_() - t;
/* Compute the elimination tree of Pc*(A'+A)*Pc' or Pc*A'*A*Pc'
(a.k.a. column etree), depending on the choice of ColPerm.
Adjust perm_c[] to be consistent with a postorder of etree.
Permute columns of A to form A*Pc'. */
if ( Fact != SamePattern_SameRowPerm ) {
if ( parSymbFact == NO ) {
int_t *GACcolbeg, *GACcolend, *GACrowind;
sp_colorder(options, &GA, perm_c, etree, &GAC);
/* Form Pc*A*Pc' to preserve the diagonal of the matrix GAC. */
GACstore = (NCPformat *) GAC.Store;
GACcolbeg = GACstore->colbeg;
GACcolend = GACstore->colend;
GACrowind = GACstore->rowind;
for (j = 0; j < n; ++j) {
for (i = GACcolbeg[j]; i < GACcolend[j]; ++i) {
irow = GACrowind[i];
GACrowind[i] = perm_c[irow];
}
}
/* Perform a symbolic factorization on Pc*Pr*A*Pc' and set up
the nonzero data structures for L & U. */
#if ( PRNTlevel>=1 )
if ( !iam )
printf(".. symbfact(): relax %4d, maxsuper %4d, fill %4d\n",
sp_ienv_dist(2), sp_ienv_dist(3), sp_ienv_dist(6));
#endif
t = SuperLU_timer_();
if ( !(Glu_freeable = (Glu_freeable_t *)
SUPERLU_MALLOC(sizeof(Glu_freeable_t))) )
ABORT("Malloc fails for Glu_freeable.");
/* Every process does this. */
iinfo = symbfact(options, iam, &GAC, perm_c, etree,
Glu_persist, Glu_freeable);
stat->utime[SYMBFAC] = SuperLU_timer_() - t;
if ( iinfo < 0 ) { /* Successful return */
QuerySpace_dist(n, -iinfo, Glu_freeable, &symb_mem_usage);
#if ( PRNTlevel>=1 )
if ( !iam ) {
printf("\tNo of supers %ld\n", Glu_persist->supno[n-1]+1);
printf("\tSize of G(L) %ld\n", Glu_freeable->xlsub[n]);
printf("\tSize of G(U) %ld\n", Glu_freeable->xusub[n]);
printf("\tint %d, short %d, float %d, double %d\n",
sizeof(int_t), sizeof(short), sizeof(float),
sizeof(double));
printf("\tSYMBfact (MB):\tL\\U %.2f\ttotal %.2f\texpansions %d\n",
symb_mem_usage.for_lu*1e-6,
symb_mem_usage.total*1e-6,
symb_mem_usage.expansions);
}
#endif
} else {
if ( !iam ) {
fprintf(stderr,"symbfact() error returns %d\n",iinfo);
exit(-1);
}
}
} /* end if serial symbolic factorization */
else { /* parallel symbolic factorization */
t = SuperLU_timer_();
flinfo = symbfact_dist(nprocs_num, noDomains, A, perm_c, perm_r,
sizes, fstVtxSep, &Pslu_freeable,
&(grid->comm), &symb_comm,
&symb_mem_usage);
stat->utime[SYMBFAC] = SuperLU_timer_() - t;
if (flinfo > 0)
ABORT("Insufficient memory for parallel symbolic factorization.");
}
} /* end if Fact ... */
#if ( PRNTlevel>=1 )
if (!iam) printf("\tSYMBfact time: %.2f\n", stat->utime[SYMBFAC]);
#endif
if (sizes) SUPERLU_FREE (sizes);
if (fstVtxSep) SUPERLU_FREE (fstVtxSep);
if (symb_comm != MPI_COMM_NULL)
MPI_Comm_free (&symb_comm);
if (parSymbFact == NO || Fact == SamePattern_SameRowPerm) {
/* Apply column permutation to the original distributed A */
for (j = 0; j < nnz_loc; ++j) colind[j] = perm_c[colind[j]];
/* Distribute Pc*Pr*diag(R)*A*diag(C)*Pc' into L and U storage.
NOTE: the row permutation Pc*Pr is applied internally in the
distribution routine. */
t = SuperLU_timer_();
dist_mem_use = pddistribute(Fact, n, A, ScalePermstruct,
Glu_freeable, LUstruct, grid);
stat->utime[DIST] = SuperLU_timer_() - t;
/* Deallocate storage used in symbolic factorization. */
if ( Fact != SamePattern_SameRowPerm ) {
iinfo = symbfact_SubFree(Glu_freeable);
SUPERLU_FREE(Glu_freeable);
}
} else {
/* Distribute Pc*Pr*diag(R)*A*diag(C)*Pc' into L and U storage.
NOTE: the row permutation Pc*Pr is applied internally in the
distribution routine. */
/* Apply column permutation to the original distributed A */
for (j = 0; j < nnz_loc; ++j) colind[j] = perm_c[colind[j]];
t = SuperLU_timer_();
dist_mem_use = ddist_psymbtonum(Fact, n, A, ScalePermstruct,
&Pslu_freeable, LUstruct, grid);
if (dist_mem_use > 0)
ABORT ("Not enough memory available for dist_psymbtonum\n");
stat->utime[DIST] = SuperLU_timer_() - t;
}
#if ( PRNTlevel>=1 )
if (!iam) printf ("\tDISTRIBUTE time %8.2f\n", stat->utime[DIST]);
#endif
/* Perform numerical factorization in parallel. */
t = SuperLU_timer_();
pdgstrf(options, m, n, anorm, LUstruct, grid, stat, info);
stat->utime[FACT] = SuperLU_timer_() - t;
#if ( PRNTlevel>=1 )
{
int_t TinyPivots;
float for_lu, total, max, avg, temp;
dQuerySpace_dist(n, LUstruct, grid, &num_mem_usage);
MPI_Reduce( &num_mem_usage.for_lu, &for_lu,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
MPI_Reduce( &num_mem_usage.total, &total,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
temp = SUPERLU_MAX(symb_mem_usage.total,
symb_mem_usage.for_lu +
(float)dist_mem_use + num_mem_usage.for_lu);
if (parSymbFact == TRUE)
/* The memory used in the redistribution routine
includes the memory used for storing the symbolic
structure and the memory allocated for numerical
factorization */
temp = SUPERLU_MAX(symb_mem_usage.total,
(float)dist_mem_use);
temp = SUPERLU_MAX(temp, num_mem_usage.total);
MPI_Reduce( &temp, &max,
1, MPI_FLOAT, MPI_MAX, 0, grid->comm );
MPI_Reduce( &temp, &avg,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
MPI_Allreduce( &stat->TinyPivots, &TinyPivots, 1, mpi_int_t,
MPI_SUM, grid->comm );
stat->TinyPivots = TinyPivots;
if ( !iam ) {
printf("\tNUMfact (MB) all PEs:\tL\\U\t%.2f\tall\t%.2f\n",
for_lu*1e-6, total*1e-6);
printf("\tAll space (MB):"
"\t\ttotal\t%.2f\tAvg\t%.2f\tMax\t%.2f\n",
avg*1e-6, avg/grid->nprow/grid->npcol*1e-6, max*1e-6);
printf("\tNumber of tiny pivots: %10d\n", stat->TinyPivots);
}
}
#endif
/* Destroy GA */
if ( Fact != SamePattern_SameRowPerm )
Destroy_CompCol_Matrix_dist(&GA);
} /* end if (!factored) */
/* ------------------------------------------------------------
Compute the solution matrix X.
------------------------------------------------------------*/
if ( nrhs ) {
if ( !(b_work = doubleMalloc_dist(n)) )
ABORT("Malloc fails for b_work[]");
/* ------------------------------------------------------------
Scale the right-hand side if equilibration was performed.
------------------------------------------------------------*/
if ( notran ) {
if ( rowequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
irow = fst_row;
for (i = 0; i < m_loc; ++i) {
b_col[i] *= R[irow];
++irow;
}
b_col += ldb;
}
}
} else if ( colequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
irow = fst_row;
for (i = 0; i < m_loc; ++i) {
b_col[i] *= C[irow];
++irow;
}
b_col += ldb;
}
}
/* Save a copy of the right-hand side. */
ldx = ldb;
if ( !(X = doubleMalloc_dist(((size_t)ldx) * nrhs)) )
ABORT("Malloc fails for X[]");
x_col = X; b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m_loc; ++i) x_col[i] = b_col[i];
x_col += ldx; b_col += ldb;
}
/* ------------------------------------------------------------
Solve the linear system.
------------------------------------------------------------*/
if ( options->SolveInitialized == NO ) {
dSolveInit(options, A, perm_r, perm_c, nrhs, LUstruct, grid,
SOLVEstruct);
}
pdgstrs(n, LUstruct, ScalePermstruct, grid, X, m_loc,
fst_row, ldb, nrhs, SOLVEstruct, stat, info);
/* ------------------------------------------------------------
Use iterative refinement to improve the computed solution and
compute error bounds and backward error estimates for it.
------------------------------------------------------------*/
if ( options->IterRefine ) {
/* Improve the solution by iterative refinement. */
int_t *it, *colind_gsmv = SOLVEstruct->A_colind_gsmv;
SOLVEstruct_t *SOLVEstruct1; /* Used by refinement. */
t = SuperLU_timer_();
if ( options->RefineInitialized == NO || Fact == DOFACT ) {
/* All these cases need to re-initialize gsmv structure */
if ( options->RefineInitialized )
pdgsmv_finalize(SOLVEstruct->gsmv_comm);
pdgsmv_init(A, SOLVEstruct->row_to_proc, grid,
SOLVEstruct->gsmv_comm);
/* Save a copy of the transformed local col indices
in colind_gsmv[]. */
if ( colind_gsmv ) SUPERLU_FREE(colind_gsmv);
if ( !(it = intMalloc_dist(nnz_loc)) )
ABORT("Malloc fails for colind_gsmv[]");
colind_gsmv = SOLVEstruct->A_colind_gsmv = it;
for (i = 0; i < nnz_loc; ++i) colind_gsmv[i] = colind[i];
options->RefineInitialized = YES;
} else if ( Fact == SamePattern ||
Fact == SamePattern_SameRowPerm ) {
double at;
int_t k, jcol, p;
/* Swap to beginning the part of A corresponding to the
local part of X, as was done in pdgsmv_init() */
for (i = 0; i < m_loc; ++i) { /* Loop through each row */
k = rowptr[i];
for (j = rowptr[i]; j < rowptr[i+1]; ++j) {
jcol = colind[j];
p = SOLVEstruct->row_to_proc[jcol];
if ( p == iam ) { /* Local */
at = a[k]; a[k] = a[j]; a[j] = at;
++k;
}
}
}
/* Re-use the local col indices of A obtained from the
previous call to pdgsmv_init() */
for (i = 0; i < nnz_loc; ++i) colind[i] = colind_gsmv[i];
}
if ( nrhs == 1 ) { /* Use the existing solve structure */
SOLVEstruct1 = SOLVEstruct;
} else { /* For nrhs > 1, since refinement is performed for RHS
one at a time, the communication structure for pdgstrs
is different than the solve with nrhs RHS.
So we use SOLVEstruct1 for the refinement step.
*/
if ( !(SOLVEstruct1 = (SOLVEstruct_t *)
SUPERLU_MALLOC(sizeof(SOLVEstruct_t))) )
ABORT("Malloc fails for SOLVEstruct1");
/* Copy the same stuff */
SOLVEstruct1->row_to_proc = SOLVEstruct->row_to_proc;
SOLVEstruct1->inv_perm_c = SOLVEstruct->inv_perm_c;
SOLVEstruct1->num_diag_procs = SOLVEstruct->num_diag_procs;
SOLVEstruct1->diag_procs = SOLVEstruct->diag_procs;
SOLVEstruct1->diag_len = SOLVEstruct->diag_len;
SOLVEstruct1->gsmv_comm = SOLVEstruct->gsmv_comm;
SOLVEstruct1->A_colind_gsmv = SOLVEstruct->A_colind_gsmv;
/* Initialize the *gstrs_comm for 1 RHS. */
if ( !(SOLVEstruct1->gstrs_comm = (pxgstrs_comm_t *)
SUPERLU_MALLOC(sizeof(pxgstrs_comm_t))) )
ABORT("Malloc fails for gstrs_comm[]");
pxgstrs_init(n, m_loc, 1, fst_row, perm_r, perm_c, grid,
Glu_persist, SOLVEstruct1);
}
pdgsrfs(n, A, anorm, LUstruct, ScalePermstruct, grid,
B, ldb, X, ldx, nrhs, SOLVEstruct1, berr, stat, info);
/* Deallocate the storage associated with SOLVEstruct1 */
if ( nrhs > 1 ) {
pxgstrs_finalize(SOLVEstruct1->gstrs_comm);
SUPERLU_FREE(SOLVEstruct1);
}
stat->utime[REFINE] = SuperLU_timer_() - t;
}
/* Permute the solution matrix B <= Pc'*X. */
pdPermute_Dense_Matrix(fst_row, m_loc, SOLVEstruct->row_to_proc,
SOLVEstruct->inv_perm_c,
X, ldx, B, ldb, nrhs, grid);
#if ( DEBUGlevel>=2 )
printf("\n (%d) .. After pdPermute_Dense_Matrix(): b =\n", iam);
for (i = 0; i < m_loc; ++i)
printf("\t(%d)\t%4d\t%.10f\n", iam, i+fst_row, B[i]);
#endif
/* Transform the solution matrix X to a solution of the original
system before the equilibration. */
if ( notran ) {
if ( colequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
irow = fst_row;
for (i = 0; i < m_loc; ++i) {
b_col[i] *= C[irow];
++irow;
}
b_col += ldb;
}
}
} else if ( rowequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
irow = fst_row;
for (i = 0; i < m_loc; ++i) {
b_col[i] *= R[irow];
++irow;
}
b_col += ldb;
}
}
SUPERLU_FREE(b_work);
SUPERLU_FREE(X);
} /* end if nrhs != 0 */
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. DiagScale = %d\n", ScalePermstruct->DiagScale);
#endif
/* Deallocate R and/or C if it was not used. */
if ( Equil && Fact != SamePattern_SameRowPerm ) {
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
SUPERLU_FREE(R);
SUPERLU_FREE(C);
break;
case ROW:
SUPERLU_FREE(C);
break;
case COL:
SUPERLU_FREE(R);
break;
}
}
if ( !factored && Fact != SamePattern_SameRowPerm && !parSymbFact)
Destroy_CompCol_Permuted_dist(&GAC);
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Exit pdgssvx()");
#endif
}
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
psgstrf_bmod1D(
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 fsupc, /* leading column of the updating supernode */
const int krep, /* last column of the updating supernode */
const int nsupc, /* number of columns in the updating s-node */
int nsupr, /* number of rows in the updating supernode */
int nrow, /* number of rows below the diagonal block of
the updating supernode */
int *repfnz, /* in */
int *panel_lsub, /* modified */
int *w_lsub_end, /* modified */
int *spa_marker, /* modified; size n-by-w */
float *dense, /* modified */
float *tempv, /* working array - zeros on entry/exit */
GlobalLU_t *Glu, /* modified */
Gstat_t *Gstat /* 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: col-col, 2cols-col, 3cols-col, and sup-col updates.
* Results are returned in SPA dense[*,w].
*
*/
#if ( MACH==CRAY_PVP )
_fcd ftcs1 = _cptofcd("L", strlen("L")),
ftcs2 = _cptofcd("N", strlen("N")),
ftcs3 = _cptofcd("U", strlen("U"));
#endif
#ifdef USE_VENDOR_BLAS
int incx = 1, incy = 1;
float alpha, beta;
#endif
float ukj, ukj1, ukj2;
int luptr, luptr1, luptr2;
int segsze;
register int lptr; /* start of row subscripts of the updating supernode */
register int i, krep_ind, kfnz, isub, irow, no_zeros;
register int jj; /* index through each column in the panel */
int *repfnz_col; /* repfnz[] for a column in the panel */
float *dense_col; /* dense[] for a column in the panel */
float *tempv1; /* used to store matrix-vector result */
int *col_marker; /* each column of the spa_marker[*,w] */
int *col_lsub; /* each column of the panel_lsub[*,w] */
int *lsub, *xlsub_end;
float *lusup;
int *xlusup;
register float flopcnt;
float zero = 0.0;
float one = 1.0;
#ifdef TIMING
double *utime = Gstat->utime;
double f_time;
#endif
lsub = Glu->lsub;
xlsub_end = Glu->xlsub_end;
lusup = Glu->lusup;
xlusup = Glu->xlusup;
lptr = Glu->xlsub[fsupc];
krep_ind = lptr + nsupc - 1;
/* Pointers to each column of the w-wide arrays. */
repfnz_col= repfnz;
dense_col = dense;
col_marker= spa_marker;
col_lsub = panel_lsub;
#if ( DEBUGlevel>=2 )
if (jcol == BADPAN && krep == BADREP) {
printf("(%d) psgstrf_bmod1D[1] jcol %d, fsupc %d, krep %d, nsupc %d, nsupr %d, nrow %d\n",
pnum, jcol, fsupc, krep, nsupc, nsupr, nrow);
PrintInt10("lsub[xlsub[2774]]", nsupr, &lsub[lptr]);
}
#endif
/*
* Sequence through each column in the panel ...
*/
for (jj = jcol; jj < jcol + w; ++jj, col_marker += m, col_lsub += m,
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];
/* Calculate flops: tri-solve + mat-vector */
flopcnt = segsze * (segsze - 1) + 2 * nrow * segsze;
Gstat->procstat[pnum].fcops += flopcnt;
/* Case 1: Update U-segment of size 1 -- col-col update */
if ( segsze == 1 ) {
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
ukj = dense_col[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc;
#if ( DEBUGlevel>=2 )
if (krep == BADCOL && jj == -1) {
printf("(%d) psgstrf_bmod1D[segsze=1]: k %d, j %d, ukj %.10e\n",
pnum, lsub[krep_ind], jj, ukj);
PrintInt10("segsze=1", nsupr, &lsub[lptr]);
}
#endif
for (i = lptr + nsupc; i < xlsub_end[fsupc]; i++) {
irow = lsub[i];
dense_col[irow] -= ukj * lusup[luptr];
++luptr;
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
}
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
} else if ( segsze <= 3 ) {
#ifdef TIMING
f_time = SuperLU_timer_();
#endif
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 ) {
ukj -= ukj1 * lusup[luptr1];
dense_col[lsub[krep_ind]] = ukj;
for (i = lptr + nsupc; i < xlsub_end[fsupc]; ++i) {
irow = lsub[i];
++luptr; ++luptr1;
dense_col[irow] -= (ukj * lusup[luptr]
+ ukj1 * lusup[luptr1]);
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
}
} else {
ukj2 = dense_col[lsub[krep_ind - 2]];
luptr2 = luptr1 - nsupr;
ukj1 -= ukj2 * lusup[luptr2-1];
ukj = ukj - ukj1*lusup[luptr1] - ukj2*lusup[luptr2];
dense_col[lsub[krep_ind]] = ukj;
dense_col[lsub[krep_ind-1]] = ukj1;
for (i = lptr + nsupc; i < xlsub_end[fsupc]; ++i) {
irow = lsub[i];
++luptr; ++luptr1; ++luptr2;
dense_col[irow] -= (ukj * lusup[luptr]
+ ukj1*lusup[luptr1] + ukj2*lusup[luptr2]);
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
}
}
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#endif
} else { /* segsze >= 4 */
/*
* Perform a triangular solve and matrix-vector update,
* then scatter the result of sup-col update to dense[*].
*/
no_zeros = kfnz - fsupc;
/* Gather 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;
/*#pragma ivdep*/
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 TIMING
f_time = SuperLU_timer_();
#endif
#ifdef USE_VENDOR_BLAS
#if ( MACH==CRAY_PVP )
STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr],
&nsupr, tempv, &incx );
#else
strsv_( "L", "N", "U", &segsze, &lusup[luptr],
&nsupr, tempv, &incx );
#endif
luptr += segsze; /* Dense matrix-vector */
tempv1 = &tempv[segsze];
alpha = one;
beta = zero;
#if ( MACH==CRAY_PVP )
SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tempv, &incx, &beta, tempv1, &incy );
#else
sgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tempv, &incx, &beta, tempv1, &incy );
#endif /* _CRAY_PVP */
#else
slsolve ( nsupr, segsze, &lusup[luptr], tempv );
luptr += segsze; /* Dense matrix-vector */
tempv1 = &tempv[segsze];
smatvec (nsupr, nrow, segsze, &lusup[luptr], tempv, tempv1);
#endif
#ifdef TIMING
utime[FLOAT] += SuperLU_timer_() - f_time;
#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;
/*#pragma ivdep*/
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
dense_col[irow] = tempv[i]; /* Scatter */
tempv[i] = zero;
isub++;
#if ( DEBUGlevel>=2 )
if (jj == -1 && krep == 3423)
printf("(%d) psgstrf_bmod1D[scatter] jj %d, dense_col[%d] %e\n",
pnum, jj, irow, dense_col[irow]);
#endif
}
/* Scatter the update from tempv1[*] into SPA dense[*] */
/*#pragma ivdep*/
for (i = 0; i < nrow; i++) {
irow = lsub[isub];
dense_col[irow] -= tempv1[i]; /* Scatter-add */
#ifdef SCATTER_FOUND
if ( col_marker[irow] != jj ) {
col_marker[irow] = jj;
col_lsub[w_lsub_end[jj-jcol]++] = irow;
}
#endif
tempv1[i] = zero;
isub++;
}
} /* else segsze >= 4 ... */
} /* for jj ... */
}
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
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();
}
int main()
{
/* Parameters */
#define NMAX 1000
#define ITS 100000
int i, j, iters;
double alpha, avg, t1, t2, tnotim;
double x[NMAX], y[NMAX];
double SuperLU_timer_();
/* Initialize X and Y */
for (i = 0; i < NMAX; ++i) {
x[i] = 1.0 / (double)(i+1);
y[i] = (double)(NMAX - i) / (double)NMAX;
}
alpha = 0.315;
/* Time DAXPY operations */
iters = ITS;
tnotim = 0.0;
while ( tnotim <= 0.0 ) {
t1 = SuperLU_timer_();
for (j = 0; j < iters; ++j) {
for (i = 0; i < NMAX; ++i) y[i] += alpha * x[i];
alpha = -alpha;
_dummy = y[j%NMAX];
}
t2 = SuperLU_timer_();
tnotim = t2 - t1;
if ( tnotim > 0. ){
float ops = 2.0 * iters * NMAX * 1e-9;
printf("Time for %d DAXPYs = %10.6g seconds\n",
iters, tnotim);
printf("DAXPY performance rate = %10.6g Gflops\n", ops/tnotim);
} else {
/* this makes sure we dont keep trying forever */
if ( iters > 100000000 ) {
printf("*** Error: Time for operations was zero.\n"
"\tThe timer may not be working correctly.\n");
/*exit(9);*/
}
iters *= 10;
}
}
/* Force gcc not to optimize away the previous loop (DCS) */
printf("y[0]=%g\n", y[0]) ;
t1 = SuperLU_timer_();
for (j = 0; j < ITS; ++j) {
for (i = 0; i < NMAX; ++i)
y[i] += alpha * x[i];
alpha = -alpha;
}
t2 = SuperLU_timer_();
tnotim = t2 - t1;
/* Time 1,000,000 DAXPY operations with SuperLU_timer_()
in the outer loop */
t1 = SuperLU_timer_();
for (j = 0; j < ITS; ++j) {
for (i = 0; i < NMAX; ++i)
y[i] += alpha * x[i];
alpha = -alpha;
t2 = SuperLU_timer_();
}
/* Compute the time in milliseconds used by an average call to
SuperLU_timer_(). */
printf("Including DSECND, time = %10.3g seconds\n", t2-t1);
avg = ( (t2 - t1) - tnotim )*1000. / (double)ITS;
printf("Average time for DSECND = %10.3g milliseconds\n", avg);
/* Compute the equivalent number of floating point operations used
by an average call to DSECND. */
if ( tnotim > 0. )
printf("Equivalent floating point ops = %10.3g ops\n",
1000.*avg / tnotim);
mysub(NMAX, x, y);
return 0;
}
/*! \brief
*
* <pre>
* Purpose
* =======
*
* pzgssvx_ABglobal solves a system of linear equations A*X=B,
* by using Gaussian elimination with "static pivoting" to
* compute the LU factorization of A.
*
* Static pivoting is a technique that combines the numerical stability
* of partial pivoting with the scalability of Cholesky (no pivoting),
* to run accurately and efficiently on large numbers of processors.
*
* See our paper at http://www.nersc.gov/~xiaoye/SuperLU/ for a detailed
* description of the parallel algorithms.
*
* Here are the options for using this code:
*
* 1. Independent of all the other options specified below, the
* user must supply
*
* - B, the matrix of right hand sides, and its dimensions ldb and nrhs
* - grid, a structure describing the 2D processor mesh
* - options->IterRefine, which determines whether or not to
* improve the accuracy of the computed solution using
* iterative refinement
*
* On output, B is overwritten with the solution X.
*
* 2. Depending on options->Fact, the user has several options
* for solving A*X=B. The standard option is for factoring
* A "from scratch". (The other options, described below,
* are used when A is sufficiently similar to a previously
* solved problem to save time by reusing part or all of
* the previous factorization.)
*
* - options->Fact = DOFACT: A is factored "from scratch"
*
* In this case the user must also supply
*
* - A, the input matrix
*
* as well as the following options, which are described in more
* detail below:
*
* - options->Equil, to specify how to scale the rows and columns
* of A to "equilibrate" it (to try to reduce its
* condition number and so improve the
* accuracy of the computed solution)
*
* - options->RowPerm, to specify how to permute the rows of A
* (typically to control numerical stability)
*
* - options->ColPerm, to specify how to permute the columns of A
* (typically to control fill-in and enhance
* parallelism during factorization)
*
* - options->ReplaceTinyPivot, to specify how to deal with tiny
* pivots encountered during factorization
* (to control numerical stability)
*
* The outputs returned include
*
* - ScalePermstruct, modified to describe how the input matrix A
* was equilibrated and permuted:
* - ScalePermstruct->DiagScale, indicates whether the rows and/or
* columns of A were scaled
* - ScalePermstruct->R, array of row scale factors
* - ScalePermstruct->C, array of column scale factors
* - ScalePermstruct->perm_r, row permutation vector
* - ScalePermstruct->perm_c, column permutation vector
*
* (part of ScalePermstruct may also need to be supplied on input,
* depending on options->RowPerm and options->ColPerm as described
* later).
*
* - A, the input matrix A overwritten by the scaled and permuted matrix
* Pc*Pr*diag(R)*A*diag(C)
* where
* Pr and Pc are row and columns permutation matrices determined
* by ScalePermstruct->perm_r and ScalePermstruct->perm_c,
* respectively, and
* diag(R) and diag(C) are diagonal scaling matrices determined
* by ScalePermstruct->DiagScale, ScalePermstruct->R and
* ScalePermstruct->C
*
* - LUstruct, which contains the L and U factorization of A1 where
*
* A1 = Pc*Pr*diag(R)*A*diag(C)*Pc^T = L*U
*
* (Note that A1 = Aout * Pc^T, where Aout is the matrix stored
* in A on output.)
*
* 3. The second value of options->Fact assumes that a matrix with the same
* sparsity pattern as A has already been factored:
*
* - options->Fact = SamePattern: A is factored, assuming that it has
* the same nonzero pattern as a previously factored matrix. In this
* case the algorithm saves time by reusing the previously computed
* column permutation vector stored in ScalePermstruct->perm_c
* and the "elimination tree" of A stored in LUstruct->etree.
*
* In this case the user must still specify the following options
* as before:
*
* - options->Equil
* - options->RowPerm
* - options->ReplaceTinyPivot
*
* but not options->ColPerm, whose value is ignored. This is because the
* previous column permutation from ScalePermstruct->perm_c is used as
* input. The user must also supply
*
* - A, the input matrix
* - ScalePermstruct->perm_c, the column permutation
* - LUstruct->etree, the elimination tree
*
* The outputs returned include
*
* - A, the input matrix A overwritten by the scaled and permuted matrix
* as described above
* - ScalePermstruct, modified to describe how the input matrix A was
* equilibrated and row permuted
* - LUstruct, modified to contain the new L and U factors
*
* 4. The third value of options->Fact assumes that a matrix B with the same
* sparsity pattern as A has already been factored, and where the
* row permutation of B can be reused for A. This is useful when A and B
* have similar numerical values, so that the same row permutation
* will make both factorizations numerically stable. This lets us reuse
* all of the previously computed structure of L and U.
*
* - options->Fact = SamePattern_SameRowPerm: A is factored,
* assuming not only the same nonzero pattern as the previously
* factored matrix B, but reusing B's row permutation.
*
* In this case the user must still specify the following options
* as before:
*
* - options->Equil
* - options->ReplaceTinyPivot
*
* but not options->RowPerm or options->ColPerm, whose values are ignored.
* This is because the permutations from ScalePermstruct->perm_r and
* ScalePermstruct->perm_c are used as input.
*
* The user must also supply
*
* - A, the input matrix
* - ScalePermstruct->DiagScale, how the previous matrix was row and/or
* column scaled
* - ScalePermstruct->R, the row scalings of the previous matrix, if any
* - ScalePermstruct->C, the columns scalings of the previous matrix,
* if any
* - ScalePermstruct->perm_r, the row permutation of the previous matrix
* - ScalePermstruct->perm_c, the column permutation of the previous
* matrix
* - all of LUstruct, the previously computed information about L and U
* (the actual numerical values of L and U stored in
* LUstruct->Llu are ignored)
*
* The outputs returned include
*
* - A, the input matrix A overwritten by the scaled and permuted matrix
* as described above
* - ScalePermstruct, modified to describe how the input matrix A was
* equilibrated
* (thus ScalePermstruct->DiagScale, R and C may be modified)
* - LUstruct, modified to contain the new L and U factors
*
* 5. The fourth and last value of options->Fact assumes that A is
* identical to a matrix that has already been factored on a previous
* call, and reuses its entire LU factorization
*
* - options->Fact = Factored: A is identical to a previously
* factorized matrix, so the entire previous factorization
* can be reused.
*
* In this case all the other options mentioned above are ignored
* (options->Equil, options->RowPerm, options->ColPerm,
* options->ReplaceTinyPivot)
*
* The user must also supply
*
* - A, the unfactored matrix, only in the case that iterative refinment
* is to be done (specifically A must be the output A from
* the previous call, so that it has been scaled and permuted)
* - all of ScalePermstruct
* - all of LUstruct, including the actual numerical values of L and U
*
* all of which are unmodified on output.
*
* Arguments
* =========
*
* options (input) superlu_options_t*
* The structure defines the input parameters to control
* how the LU decomposition 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, how the matrix A should
* be factorized based on the previous history.
*
* = DOFACT: The matrix A will be factorized from scratch.
* Inputs: A
* options->Equil, RowPerm, ColPerm, ReplaceTinyPivot
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* all of ScalePermstruct
* all of LUstruct
*
* = SamePattern: the matrix A will be factorized assuming
* that a factorization of a matrix with the same sparsity
* pattern was performed prior to this one. Therefore, this
* factorization will reuse column permutation vector
* ScalePermstruct->perm_c and the elimination tree
* LUstruct->etree
* Inputs: A
* options->Equil, RowPerm, ReplaceTinyPivot
* ScalePermstruct->perm_c
* LUstruct->etree
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* rest of ScalePermstruct (DiagScale, R, C, perm_r)
* rest of LUstruct (GLU_persist, Llu)
*
* = SamePattern_SameRowPerm: the matrix A will be factorized
* assuming that a factorization of a matrix with the same
* sparsity pattern and similar numerical values was performed
* prior to this one. Therefore, this factorization will reuse
* both row and column scaling factors R and C, and the
* both row and column permutation vectors perm_r and perm_c,
* distributed data structure set up from the previous symbolic
* factorization.
* Inputs: A
* options->Equil, ReplaceTinyPivot
* all of ScalePermstruct
* all of LUstruct
* Outputs: modified A
* (possibly row and/or column scaled and/or
* permuted)
* modified LUstruct->Llu
* = FACTORED: the matrix A is already factored.
* Inputs: all of ScalePermstruct
* all of LUstruct
*
* o Equil (yes_no_t)
* Specifies whether to equilibrate the system.
* = NO: no equilibration.
* = YES: scaling factors are computed to equilibrate the system:
* diag(R)*A*diag(C)*inv(diag(C))*X = diag(R)*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.
*
* o RowPerm (rowperm_t)
* Specifies how to permute rows of the matrix A.
* = NATURAL: use the natural ordering.
* = LargeDiag: use the Duff/Koster algorithm to permute rows of
* the original matrix to make the diagonal large
* relative to the off-diagonal.
* = MY_PERMR: use the ordering given in ScalePermstruct->perm_r
* input by the user.
*
* o ColPerm (colperm_t)
* Specifies what type of column permutation to use to reduce fill.
* = NATURAL: natural ordering.
* = MMD_AT_PLUS_A: minimum degree ordering on structure of A'+A.
* = MMD_ATA: minimum degree ordering on structure of A'*A.
* = MY_PERMC: the ordering given in ScalePermstruct->perm_c.
*
* o ReplaceTinyPivot (yes_no_t)
* = NO: do not modify pivots
* = YES: replace tiny pivots by sqrt(epsilon)*norm(A) during
* LU factorization.
*
* o IterRefine (IterRefine_t)
* Specifies how to perform iterative refinement.
* = NO: no iterative refinement.
* = SLU_DOUBLE: accumulate residual in double precision.
* = SLU_EXTRA: accumulate residual in extra precision.
*
* NOTE: all options must be indentical on all processes when
* calling this routine.
*
* A (input/output) SuperMatrix*
* On entry, matrix A in A*X=B, of dimension (A->nrow, A->ncol).
* The number of linear equations is A->nrow. The type of A must be:
* Stype = SLU_NC; Dtype = SLU_Z; Mtype = SLU_GE. That is, A is stored in
* compressed column format (also known as Harwell-Boeing format).
* See supermatrix.h for the definition of 'SuperMatrix'.
* This routine only handles square A, however, the LU factorization
* routine pzgstrf can factorize rectangular matrices.
* On exit, A may be overwritten by Pc*Pr*diag(R)*A*diag(C),
* depending on ScalePermstruct->DiagScale, options->RowPerm and
* options->colpem:
* if ScalePermstruct->DiagScale != NOEQUIL, A is overwritten by
* diag(R)*A*diag(C).
* if options->RowPerm != NATURAL, A is further overwritten by
* Pr*diag(R)*A*diag(C).
* if options->ColPerm != NATURAL, A is further overwritten by
* Pc*Pr*diag(R)*A*diag(C).
* If all the above condition are true, the LU decomposition is
* performed on the matrix Pc*Pr*diag(R)*A*diag(C)*Pc^T.
*
* NOTE: Currently, A must reside in all processes when calling
* this routine.
*
* ScalePermstruct (input/output) ScalePermstruct_t*
* The data structure to store the scaling and permutation vectors
* describing the transformations performed to the matrix A.
* It contains the following fields:
*
* o DiagScale (DiagScale_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 options->Fact = FACTORED or SamePattern_SameRowPerm,
* DiagScale is an input argument; otherwise it is an output
* argument.
*
* o perm_r (int*)
* Row permutation vector, which defines the permutation matrix Pr;
* perm_r[i] = j means row i of A is in position j in Pr*A.
* If options->RowPerm = MY_PERMR, or
* options->Fact = SamePattern_SameRowPerm, perm_r is an
* input argument; otherwise it is an output argument.
*
* o perm_c (int*)
* Column permutation vector, which defines the
* permutation matrix Pc; perm_c[i] = j means column i of A is
* in position j in A*Pc.
* If options->ColPerm = MY_PERMC or options->Fact = SamePattern
* or options->Fact = SamePattern_SameRowPerm, perm_c is an
* input argument; otherwise, it is an output 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.
*
* o R (double*) dimension (A->nrow)
* The row scale factors for A.
* If DiagScale = ROW or BOTH, A is multiplied on the left by
* diag(R).
* If DiagScale = NOEQUIL or COL, R is not defined.
* If options->Fact = FACTORED or SamePattern_SameRowPerm, R is
* an input argument; otherwise, R is an output argument.
*
* o C (double*) dimension (A->ncol)
* The column scale factors for A.
* If DiagScale = COL or BOTH, A is multiplied on the right by
* diag(C).
* If DiagScale = NOEQUIL or ROW, C is not defined.
* If options->Fact = FACTORED or SamePattern_SameRowPerm, C is
* an input argument; otherwise, C is an output argument.
*
* B (input/output) doublecomplex*
* On entry, the right-hand side matrix of dimension (A->nrow, nrhs).
* On exit, the solution matrix if info = 0;
*
* NOTE: Currently, B must reside in all processes when calling
* this routine.
*
* ldb (input) int (global)
* The leading dimension of matrix B.
*
* nrhs (input) int (global)
* The number of right-hand sides.
* If nrhs = 0, only LU decomposition is performed, the forward
* and back substitutions are skipped.
*
* grid (input) gridinfo_t*
* The 2D process mesh. It contains the MPI communicator, the number
* of process rows (NPROW), the number of process columns (NPCOL),
* and my process rank. It is an input argument to all the
* parallel routines.
* Grid can be initialized by subroutine SUPERLU_GRIDINIT.
* See superlu_zdefs.h for the definition of 'gridinfo_t'.
*
* LUstruct (input/output) LUstruct_t*
* The data structures to store the distributed L and U factors.
* It contains the following fields:
*
* o etree (int*) dimension (A->ncol)
* Elimination tree of Pc*(A'+A)*Pc' or Pc*A'*A*Pc', dimension A->ncol.
* It is computed in sp_colorder() during the first factorization,
* and is reused in the subsequent factorizations of the matrices
* with the same nonzero pattern.
* On exit of sp_colorder(), the columns of A are permuted so that
* the etree is in a certain postorder. This postorder is reflected
* in ScalePermstruct->perm_c.
* 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.
*
* o Glu_persist (Glu_persist_t*)
* Global data structure (xsup, supno) replicated on all processes,
* describing the supernode partition in the factored matrices
* L and U:
* xsup[s] is the leading column of the s-th supernode,
* supno[i] is the supernode number to which column i belongs.
*
* o Llu (LocalLU_t*)
* The distributed data structures to store L and U factors.
* See superlu_ddefs.h for the definition of 'LocalLU_t'.
*
* berr (output) double*, dimension (nrhs)
* 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).
*
* 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, 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.
*
*
* See superlu_zdefs.h for the definitions of various data types.
* </pre>
*/
void
pzgssvx_ABglobal(superlu_options_t *options, SuperMatrix *A,
ScalePermstruct_t *ScalePermstruct,
doublecomplex B[], int ldb, int nrhs, gridinfo_t *grid,
LUstruct_t *LUstruct, double *berr,
SuperLUStat_t *stat, int *info)
{
SuperMatrix AC;
NCformat *Astore;
NCPformat *ACstore;
Glu_persist_t *Glu_persist = LUstruct->Glu_persist;
Glu_freeable_t *Glu_freeable;
/* The nonzero structures of L and U factors, which are
replicated on all processrs.
(lsub, xlsub) contains the compressed subscript of
supernodes in L.
(usub, xusub) contains the compressed subscript of
nonzero segments in U.
If options->Fact != SamePattern_SameRowPerm, they are
computed by SYMBFACT routine, and then used by DDISTRIBUTE
routine. They will be freed after DDISTRIBUTE routine.
If options->Fact == SamePattern_SameRowPerm, these
structures are not used. */
fact_t Fact;
doublecomplex *a;
int_t *perm_r; /* row permutations from partial pivoting */
int_t *perm_c; /* column permutation vector */
int_t *etree; /* elimination tree */
int_t *colptr, *rowind;
int_t colequ, Equil, factored, job, notran, rowequ;
int_t i, iinfo, j, irow, m, n, nnz, permc_spec, dist_mem_use;
int iam;
int ldx; /* LDA for matrix X (global). */
char equed[1], norm[1];
double *C, *R, *C1, *R1, amax, anorm, colcnd, rowcnd;
doublecomplex *X, *b_col, *b_work, *x_col;
double t;
static mem_usage_t num_mem_usage, symb_mem_usage;
#if ( PRNTlevel>= 2 )
double dmin, dsum, dprod;
#endif
/* Test input parameters. */
*info = 0;
Fact = options->Fact;
if ( Fact < 0 || Fact > FACTORED )
*info = -1;
else if ( options->RowPerm < 0 || options->RowPerm > MY_PERMR )
*info = -1;
else if ( options->ColPerm < 0 || options->ColPerm > MY_PERMC )
*info = -1;
else if ( options->IterRefine < 0 || options->IterRefine > SLU_EXTRA )
*info = -1;
else if ( options->IterRefine == SLU_EXTRA ) {
*info = -1;
fprintf(stderr, "Extra precise iterative refinement yet to support.");
} else if ( A->nrow != A->ncol || A->nrow < 0 ||
A->Stype != SLU_NC || A->Dtype != SLU_Z || A->Mtype != SLU_GE )
*info = -2;
else if ( ldb < A->nrow )
*info = -5;
else if ( nrhs < 0 )
*info = -6;
if ( *info ) {
i = -(*info);
pxerbla("pzgssvx_ABglobal", grid, -*info);
return;
}
/* Initialization */
factored = (Fact == FACTORED);
Equil = (!factored && options->Equil == YES);
notran = (options->Trans == NOTRANS);
iam = grid->iam;
job = 5;
m = A->nrow;
n = A->ncol;
Astore = A->Store;
nnz = Astore->nnz;
a = Astore->nzval;
colptr = Astore->colptr;
rowind = Astore->rowind;
if ( factored || (Fact == SamePattern_SameRowPerm && Equil) ) {
rowequ = (ScalePermstruct->DiagScale == ROW) ||
(ScalePermstruct->DiagScale == BOTH);
colequ = (ScalePermstruct->DiagScale == COL) ||
(ScalePermstruct->DiagScale == BOTH);
} else rowequ = colequ = FALSE;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter pzgssvx_ABglobal()");
#endif
perm_r = ScalePermstruct->perm_r;
perm_c = ScalePermstruct->perm_c;
etree = LUstruct->etree;
R = ScalePermstruct->R;
C = ScalePermstruct->C;
if ( Equil && Fact != SamePattern_SameRowPerm ) {
/* Allocate storage if not done so before. */
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
if ( !(R = (double *) doubleMalloc_dist(m)) )
ABORT("Malloc fails for R[].");
if ( !(C = (double *) doubleMalloc_dist(n)) )
ABORT("Malloc fails for C[].");
ScalePermstruct->R = R;
ScalePermstruct->C = C;
break;
case ROW:
if ( !(C = (double *) doubleMalloc_dist(n)) )
ABORT("Malloc fails for C[].");
ScalePermstruct->C = C;
break;
case COL:
if ( !(R = (double *) doubleMalloc_dist(m)) )
ABORT("Malloc fails for R[].");
ScalePermstruct->R = R;
break;
}
}
/* ------------------------------------------------------------
Diagonal scaling to equilibrate the matrix.
------------------------------------------------------------*/
if ( Equil ) {
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Enter equil");
#endif
t = SuperLU_timer_();
if ( Fact == SamePattern_SameRowPerm ) {
/* Reuse R and C. */
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
break;
case ROW:
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
zd_mult(&a[i], &a[i], R[i]); /* Scale rows. */
}
}
break;
case COL:
for (j = 0; j < n; ++j)
for (i = colptr[j]; i < colptr[j+1]; ++i)
zd_mult(&a[i], &a[i], C[j]); /* Scale columns. */
break;
case BOTH:
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
zd_mult(&a[i], &a[i], R[irow]); /* Scale rows. */
zd_mult(&a[i], &a[i], C[j]); /* Scale columns. */
}
}
break;
}
} else {
if ( !iam ) {
/* Compute row and column scalings to equilibrate matrix A. */
zgsequ_dist(A, R, C, &rowcnd, &colcnd, &amax, &iinfo);
MPI_Bcast( &iinfo, 1, mpi_int_t, 0, grid->comm );
if ( iinfo == 0 ) {
MPI_Bcast( R, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C, n, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &rowcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &colcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &amax, 1, MPI_DOUBLE, 0, grid->comm );
} else {
if ( iinfo > 0 ) {
if ( iinfo <= m )
fprintf(stderr, "The %d-th row of A is exactly zero\n",
iinfo);
else fprintf(stderr, "The %d-th column of A is exactly zero\n",
iinfo-n);
exit(-1);
}
}
} else {
MPI_Bcast( &iinfo, 1, mpi_int_t, 0, grid->comm );
if ( iinfo == 0 ) {
MPI_Bcast( R, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C, n, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &rowcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &colcnd, 1, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( &amax, 1, MPI_DOUBLE, 0, grid->comm );
} else {
ABORT("ZGSEQU failed\n");
}
}
/* Equilibrate matrix A. */
zlaqgs_dist(A, R, C, rowcnd, colcnd, amax, equed);
if ( lsame_(equed, "R") ) {
ScalePermstruct->DiagScale = rowequ = ROW;
} else if ( lsame_(equed, "C") ) {
ScalePermstruct->DiagScale = colequ = COL;
} else if ( lsame_(equed, "B") ) {
ScalePermstruct->DiagScale = BOTH;
rowequ = ROW;
colequ = COL;
} else ScalePermstruct->DiagScale = NOEQUIL;
#if ( PRNTlevel>=1 )
if ( !iam ) {
printf(".. equilibrated? *equed = %c\n", *equed);
/*fflush(stdout);*/
}
#endif
} /* if Fact ... */
stat->utime[EQUIL] = SuperLU_timer_() - t;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Exit equil");
#endif
} /* end if Equil ... */
/* ------------------------------------------------------------
Permute rows of A.
------------------------------------------------------------*/
if ( options->RowPerm != NO ) {
t = SuperLU_timer_();
if ( Fact == SamePattern_SameRowPerm /* Reuse perm_r. */
|| options->RowPerm == MY_PERMR ) { /* Use my perm_r. */
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
}
}
} else if ( !factored ) {
if ( job == 5 ) {
/* Allocate storage for scaling factors. */
if ( !(R1 = (double *) SUPERLU_MALLOC(m * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for R1[]");
if ( !(C1 = (double *) SUPERLU_MALLOC(n * sizeof(double))) )
ABORT("SUPERLU_MALLOC fails for C1[]");
}
if ( !iam ) {
/* Process 0 finds a row permutation for large diagonal. */
zldperm(job, m, nnz, colptr, rowind, a, perm_r, R1, C1);
MPI_Bcast( perm_r, m, mpi_int_t, 0, grid->comm );
if ( job == 5 && Equil ) {
MPI_Bcast( R1, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C1, n, MPI_DOUBLE, 0, grid->comm );
}
} else {
MPI_Bcast( perm_r, m, mpi_int_t, 0, grid->comm );
if ( job == 5 && Equil ) {
MPI_Bcast( R1, m, MPI_DOUBLE, 0, grid->comm );
MPI_Bcast( C1, n, MPI_DOUBLE, 0, grid->comm );
}
}
#if ( PRNTlevel>=2 )
dmin = dlamch_("Overflow");
dsum = 0.0;
dprod = 1.0;
#endif
if ( job == 5 ) {
if ( Equil ) {
for (i = 0; i < n; ++i) {
R1[i] = exp(R1[i]);
C1[i] = exp(C1[i]);
}
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
zd_mult(&a[i], &a[i], R1[irow]); /* Scale rows. */
zd_mult(&a[i], &a[i], C1[j]); /* Scale columns. */
rowind[i] = perm_r[irow];
#if ( PRNTlevel>=2 )
if ( rowind[i] == j ) /* New diagonal */
dprod *= slud_z_abs1(&a[i]);
#endif
}
}
/* Multiply together the scaling factors. */
if ( rowequ ) for (i = 0; i < m; ++i) R[i] *= R1[i];
else for (i = 0; i < m; ++i) R[i] = R1[i];
if ( colequ ) for (i = 0; i < n; ++i) C[i] *= C1[i];
else for (i = 0; i < n; ++i) C[i] = C1[i];
ScalePermstruct->DiagScale = BOTH;
rowequ = colequ = 1;
} else { /* No equilibration. */
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
}
}
}
SUPERLU_FREE (R1);
SUPERLU_FREE (C1);
} else { /* job = 2,3,4 */
for (j = 0; j < n; ++j) {
for (i = colptr[j]; i < colptr[j+1]; ++i) {
irow = rowind[i];
rowind[i] = perm_r[irow];
#if ( PRNTlevel>=2 )
if ( rowind[i] == j ) { /* New diagonal */
if ( job == 2 || job == 3 )
dmin = SUPERLU_MIN(dmin, slud_z_abs1(&a[i]));
else if ( job == 4 )
dsum += slud_z_abs1(&a[i]);
else if ( job == 5 )
dprod *= slud_z_abs1(&a[i]);
}
#endif
}
}
}
#if ( PRNTlevel>=2 )
if ( job == 2 || job == 3 ) {
if ( !iam ) printf("\tsmallest diagonal %e\n", dmin);
} else if ( job == 4 ) {
if ( !iam ) printf("\tsum of diagonal %e\n", dsum);
} else if ( job == 5 ) {
if ( !iam ) printf("\t product of diagonal %e\n", dprod);
}
#endif
} /* else !factored */
t = SuperLU_timer_() - t;
stat->utime[ROWPERM] = t;
} else { /* options->RowPerm == NOROWPERM */
for (i = 0; i < m; ++i) perm_r[i] = i;
}
if ( !factored || options->IterRefine ) {
/* Compute norm(A), which will be used to adjust small diagonal. */
if ( notran ) *(unsigned char *)norm = '1';
else *(unsigned char *)norm = 'I';
anorm = zlangs_dist(norm, A);
}
/* ------------------------------------------------------------
Perform the LU factorization.
------------------------------------------------------------*/
if ( !factored ) {
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 = MY_PERMC: the ordering already supplied in perm_c[]
*/
permc_spec = options->ColPerm;
if ( permc_spec != MY_PERMC && Fact == DOFACT )
/* Use an ordering provided by SuperLU */
get_perm_c_dist(iam, permc_spec, A, perm_c);
/* Compute the elimination tree of Pc*(A'+A)*Pc' or Pc*A'*A*Pc'
(a.k.a. column etree), depending on the choice of ColPerm.
Adjust perm_c[] to be consistent with a postorder of etree.
Permute columns of A to form A*Pc'. */
sp_colorder(options, A, perm_c, etree, &AC);
/* Form Pc*A*Pc' to preserve the diagonal of the matrix Pr*A. */
ACstore = AC.Store;
for (j = 0; j < n; ++j)
for (i = ACstore->colbeg[j]; i < ACstore->colend[j]; ++i) {
irow = ACstore->rowind[i];
ACstore->rowind[i] = perm_c[irow];
}
stat->utime[COLPERM] = SuperLU_timer_() - t;
/* Perform a symbolic factorization on matrix A and set up the
nonzero data structures which are suitable for supernodal GENP. */
if ( Fact != SamePattern_SameRowPerm ) {
#if ( PRNTlevel>=1 )
if ( !iam )
printf(".. symbfact(): relax %4d, maxsuper %4d, fill %4d\n",
sp_ienv_dist(2), sp_ienv_dist(3), sp_ienv_dist(6));
#endif
t = SuperLU_timer_();
if ( !(Glu_freeable = (Glu_freeable_t *)
SUPERLU_MALLOC(sizeof(Glu_freeable_t))) )
ABORT("Malloc fails for Glu_freeable.");
iinfo = symbfact(options, iam, &AC, perm_c, etree,
Glu_persist, Glu_freeable);
stat->utime[SYMBFAC] = SuperLU_timer_() - t;
if ( iinfo < 0 ) {
QuerySpace_dist(n, -iinfo, Glu_freeable, &symb_mem_usage);
#if ( PRNTlevel>=1 )
if ( !iam ) {
printf("\tNo of supers %ld\n", Glu_persist->supno[n-1]+1);
printf("\tSize of G(L) %ld\n", Glu_freeable->xlsub[n]);
printf("\tSize of G(U) %ld\n", Glu_freeable->xusub[n]);
printf("\tint %d, short %d, float %d, double %d\n",
sizeof(int_t), sizeof(short), sizeof(float),
sizeof(double));
printf("\tSYMBfact (MB):\tL\\U %.2f\ttotal %.2f\texpansions %d\n",
symb_mem_usage.for_lu*1e-6,
symb_mem_usage.total*1e-6,
symb_mem_usage.expansions);
}
#endif
} else {
if ( !iam ) {
fprintf(stderr, "symbfact() error returns %d\n", iinfo);
exit(-1);
}
}
}
/* Distribute the L and U factors onto the process grid. */
t = SuperLU_timer_();
dist_mem_use = zdistribute(Fact, n, &AC, Glu_freeable, LUstruct, grid);
stat->utime[DIST] = SuperLU_timer_() - t;
/* Deallocate storage used in symbolic factor. */
if ( Fact != SamePattern_SameRowPerm ) {
iinfo = symbfact_SubFree(Glu_freeable);
SUPERLU_FREE(Glu_freeable);
}
/* Perform numerical factorization in parallel. */
t = SuperLU_timer_();
pzgstrf(options, m, n, anorm, LUstruct, grid, stat, info);
stat->utime[FACT] = SuperLU_timer_() - t;
#if ( PRNTlevel>=1 )
{
int_t TinyPivots;
float for_lu, total, max, avg, temp;
zQuerySpace_dist(n, LUstruct, grid, &num_mem_usage);
MPI_Reduce( &num_mem_usage.for_lu, &for_lu,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
MPI_Reduce( &num_mem_usage.total, &total,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
temp = SUPERLU_MAX(symb_mem_usage.total,
symb_mem_usage.for_lu +
(float)dist_mem_use + num_mem_usage.for_lu);
temp = SUPERLU_MAX(temp, num_mem_usage.total);
MPI_Reduce( &temp, &max,
1, MPI_FLOAT, MPI_MAX, 0, grid->comm );
MPI_Reduce( &temp, &avg,
1, MPI_FLOAT, MPI_SUM, 0, grid->comm );
MPI_Allreduce( &stat->TinyPivots, &TinyPivots, 1, mpi_int_t,
MPI_SUM, grid->comm );
stat->TinyPivots = TinyPivots;
if ( !iam ) {
printf("\tNUMfact (MB) all PEs:\tL\\U\t%.2f\tall\t%.2f\n",
for_lu*1e-6, total*1e-6);
printf("\tAll space (MB):"
"\t\ttotal\t%.2f\tAvg\t%.2f\tMax\t%.2f\n",
avg*1e-6, avg/grid->nprow/grid->npcol*1e-6, max*1e-6);
printf("\tNumber of tiny pivots: %10d\n", stat->TinyPivots);
}
}
#endif
#if ( PRNTlevel>=2 )
if ( !iam ) printf(".. pzgstrf INFO = %d\n", *info);
#endif
} else if ( options->IterRefine ) { /* options->Fact==FACTORED */
/* Permute columns of A to form A*Pc' using the existing perm_c.
* NOTE: rows of A were previously permuted to Pc*A.
*/
sp_colorder(options, A, perm_c, NULL, &AC);
} /* if !factored ... */
/* ------------------------------------------------------------
Compute the solution matrix X.
------------------------------------------------------------*/
if ( nrhs ) {
if ( !(b_work = doublecomplexMalloc_dist(n)) )
ABORT("Malloc fails for b_work[]");
/* ------------------------------------------------------------
Scale the right-hand side if equilibration was performed.
------------------------------------------------------------*/
if ( notran ) {
if ( rowequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) zd_mult(&b_col[i], &b_col[i], R[i]);
b_col += ldb;
}
}
} else if ( colequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) zd_mult(&b_col[i], &b_col[i], C[i]);
b_col += ldb;
}
}
/* ------------------------------------------------------------
Permute the right-hand side to form Pr*B.
------------------------------------------------------------*/
if ( options->RowPerm != NO ) {
if ( notran ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) b_work[perm_r[i]] = b_col[i];
for (i = 0; i < m; ++i) b_col[i] = b_work[i];
b_col += ldb;
}
}
}
/* ------------------------------------------------------------
Permute the right-hand side to form Pc*B.
------------------------------------------------------------*/
if ( notran ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < m; ++i) b_work[perm_c[i]] = b_col[i];
for (i = 0; i < m; ++i) b_col[i] = b_work[i];
b_col += ldb;
}
}
/* Save a copy of the right-hand side. */
ldx = ldb;
if ( !(X = doublecomplexMalloc_dist(((size_t)ldx) * nrhs)) )
ABORT("Malloc fails for X[]");
x_col = X; b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < ldb; ++i) x_col[i] = b_col[i];
x_col += ldx; b_col += ldb;
}
/* ------------------------------------------------------------
Solve the linear system.
------------------------------------------------------------*/
pzgstrs_Bglobal(n, LUstruct, grid, X, ldb, nrhs, stat, info);
/* ------------------------------------------------------------
Use iterative refinement to improve the computed solution and
compute error bounds and backward error estimates for it.
------------------------------------------------------------*/
if ( options->IterRefine ) {
/* Improve the solution by iterative refinement. */
t = SuperLU_timer_();
pzgsrfs_ABXglobal(n, &AC, anorm, LUstruct, grid, B, ldb,
X, ldx, nrhs, berr, stat, info);
stat->utime[REFINE] = SuperLU_timer_() - t;
}
/* Permute the solution matrix X <= Pc'*X. */
for (j = 0; j < nrhs; j++) {
b_col = &B[j*ldb];
x_col = &X[j*ldx];
for (i = 0; i < n; ++i) b_col[i] = x_col[perm_c[i]];
}
/* Transform the solution matrix X to a solution of the original system
before the equilibration. */
if ( notran ) {
if ( colequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < n; ++i) zd_mult(&b_col[i], &b_col[i], C[i]);
b_col += ldb;
}
}
} else if ( rowequ ) {
b_col = B;
for (j = 0; j < nrhs; ++j) {
for (i = 0; i < n; ++i) zd_mult(&b_col[i], &b_col[i], R[i]);
b_col += ldb;
}
}
SUPERLU_FREE(b_work);
SUPERLU_FREE(X);
} /* end if nrhs != 0 */
#if ( PRNTlevel>=1 )
if ( !iam ) printf(".. DiagScale = %d\n", ScalePermstruct->DiagScale);
#endif
/* Deallocate R and/or C if it is not used. */
if ( Equil && Fact != SamePattern_SameRowPerm ) {
switch ( ScalePermstruct->DiagScale ) {
case NOEQUIL:
SUPERLU_FREE(R);
SUPERLU_FREE(C);
break;
case ROW:
SUPERLU_FREE(C);
break;
case COL:
SUPERLU_FREE(R);
break;
}
}
if ( !factored || (factored && options->IterRefine) )
Destroy_CompCol_Permuted_dist(&AC);
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(iam, "Exit pzgssvx_ABglobal()");
#endif
}
void
psgstrf_init(int nprocs, fact_t fact, trans_t trans, yes_no_t refact,
int panel_size, int relax,
float diag_pivot_thresh, yes_no_t usepr, double drop_tol,
int *perm_c, int *perm_r, void *work, int lwork,
SuperMatrix *A, SuperMatrix *AC,
superlumt_options_t *superlumt_options, Gstat_t *Gstat)
{
/*
* -- SuperLU MT routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley,
* and Xerox Palo Alto Research Center.
* September 10, 2007
*
* Purpose
* =======
*
* psgstrf_init() initializes the option structure superlumt_options, using
* the user-input parameters. These options control how the factorization
* will be performed by routine psgstf().
*
* In addition, it calls sp_colorder() to compute a postordered etree[],
* colcnt_h[] and super_part_h, and permute the columns of A using the
* permutation vector perm_c[]. See sp_colorder.c for details.
*
* Arguments
* =========
*
* nprocs (input) int
* Number of processes used to perform LU factorization by psgstrf().
*
* fact (input) fact_t
* Specifies whether or not the factored form of the matrix is supplied.
*
* trans (input) 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)
*
* refact (input) yes_no_t
* Specifies whether we want to use perm_r from a previous factor.
*
* panel_size (input) int
* A panel consists of at most panel_size consecutive columns.
*
* relax (input) 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.
*
* diag_pivot_thresh (input) 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. 0 <= diag_pivot_thresh <= 1. The default
* value is 1, corresponding to partial pivoting.
*
* drop_tol (input) 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.
*
* perm_c (input) int*, dimension A->ncol
* Column permutation vector, which defines the
* permutation matrix Pc; perm_c[i] = j means column i of A is
* in position j in A*Pc.
* When search for diagonal, perm_c[*] is applied to the
* row subscripts of A, so that diagonal threshold pivoting
* can find the diagonal of A, instead of that of A*Pc.
*
* perm_r (input/output) int*, dimension A->nrow
* Row permutation vector which defines the permutation matrix Pr,
* perm_r[i] = j means row i of A is in position j in Pr*A.
* If usepr = NO, perm_r is output argument;
* If 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.
*
* work (input) void* of size lwork
* User-supplied work space and space for the output data structures.
* Not referenced if lwork = 0;
*
* lwork (input) 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) 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 = NC or NCP; Dtype = _D; Mtype = GE. In the future, more
* general A can be handled.
*
* AC (output) SuperMatrix*
* The resulting matrix after applied the column permutation
* perm_c[] to matrix A. The type of AC can be:
* Stype = NCP; Dtype = _D; Mtype = GE.
*
* superlumt_options (output) superlumt_options_t*
* The structure defines the parameters to control how the sparse
* LU factorization is performed, and will be input to psgstrf().
*
* Gstat (output) Gstat_t*
* Record the time used in ssp_colorder phase.
*
*/
double t;
superlumt_options->nprocs = nprocs;
superlumt_options->refact = refact;
superlumt_options->panel_size = panel_size;
superlumt_options->relax = relax;
superlumt_options->diag_pivot_thresh = diag_pivot_thresh;
superlumt_options->usepr = usepr;
superlumt_options->drop_tol = drop_tol;
superlumt_options->SymmetricMode = NO;
superlumt_options->PrintStat = NO;
/*
* The following should be retained for repeated factorizations.
*/
superlumt_options->perm_c = perm_c;
superlumt_options->perm_r = perm_r;
superlumt_options->work = work;
superlumt_options->lwork = lwork;
t = SuperLU_timer_();
sp_colorder(A, perm_c, superlumt_options, AC);
Gstat->utime[ETREE] = SuperLU_timer_() - t;
#if ( DEBUGlevel==1 )
printf("** psgstrf_init() called\n");
#endif
}
int main(int argc, char *argv[])
{
void smatvec_mult(float alpha, float x[], float beta, float y[]);
void spsolve(int n, float x[], float y[]);
extern int sfgmr( int n,
void (*matvec_mult)(float, float [], float, float []),
void (*psolve)(int n, float [], float[]),
float *rhs, float *sol, double tol, int restrt, int *itmax,
FILE *fits);
extern int sfill_diag(int n, NCformat *Astore);
char equed[1] = {'B'};
yes_no_t equil;
trans_t trans;
SuperMatrix A, L, U;
SuperMatrix B, X;
NCformat *Astore;
NCformat *Ustore;
SCformat *Lstore;
GlobalLU_t Glu; /* facilitate multiple factorizations with
SamePattern_SameRowPerm */
float *a;
int *asub, *xa;
int *etree;
int *perm_c; /* column permutation vector */
int *perm_r; /* row permutations from partial pivoting */
int nrhs, ldx, lwork, info, m, n, nnz;
float *rhsb, *rhsx, *xact;
float *work = NULL;
float *R, *C;
float u, rpg, rcond;
float zero = 0.0;
float one = 1.0;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
FILE *fp = stdin;
int restrt, iter, maxit, i;
double resid;
float *x, *b;
#ifdef DEBUG
extern int num_drop_L, num_drop_U;
#endif
#if ( DEBUGlevel>=1 )
CHECK_MALLOC("Enter main()");
#endif
/* Defaults */
lwork = 0;
nrhs = 1;
trans = NOTRANS;
/* Set the default input options:
options.Fact = DOFACT;
options.Equil = YES;
options.ColPerm = COLAMD;
options.DiagPivotThresh = 0.1; //different from complete LU
options.Trans = NOTRANS;
options.IterRefine = NOREFINE;
options.SymmetricMode = NO;
options.PivotGrowth = NO;
options.ConditionNumber = NO;
options.PrintStat = YES;
options.RowPerm = LargeDiag;
options.ILU_DropTol = 1e-4;
options.ILU_FillTol = 1e-2;
options.ILU_FillFactor = 10.0;
options.ILU_DropRule = DROP_BASIC | DROP_AREA;
options.ILU_Norm = INF_NORM;
options.ILU_MILU = SILU;
*/
ilu_set_default_options(&options);
/* Modify the defaults. */
options.PivotGrowth = YES; /* Compute reciprocal pivot growth */
options.ConditionNumber = YES;/* Compute reciprocal condition number */
if ( lwork > 0 ) {
work = SUPERLU_MALLOC(lwork);
if ( !work ) ABORT("Malloc fails for work[].");
}
/* Read matrix A from a file in Harwell-Boeing format.*/
if (argc < 2)
{
printf("Usage:\n%s [OPTION] < [INPUT] > [OUTPUT]\nOPTION:\n"
"-h -hb:\n\t[INPUT] is a Harwell-Boeing format matrix.\n"
"-r -rb:\n\t[INPUT] is a Rutherford-Boeing format matrix.\n"
"-t -triplet:\n\t[INPUT] is a triplet format matrix.\n",
argv[0]);
return 0;
}
else
{
switch (argv[1][1])
{
case 'H':
case 'h':
printf("Input a Harwell-Boeing format matrix:\n");
sreadhb(fp, &m, &n, &nnz, &a, &asub, &xa);
break;
case 'R':
case 'r':
printf("Input a Rutherford-Boeing format matrix:\n");
sreadrb(&m, &n, &nnz, &a, &asub, &xa);
break;
case 'T':
case 't':
printf("Input a triplet format matrix:\n");
sreadtriple(&m, &n, &nnz, &a, &asub, &xa);
break;
default:
printf("Unrecognized format.\n");
return 0;
}
}
sCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa,
SLU_NC, SLU_S, SLU_GE);
Astore = A.Store;
sfill_diag(n, Astore);
printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
fflush(stdout);
/* Generate the right-hand side */
if ( !(rhsb = floatMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
if ( !(rhsx = floatMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[].");
sCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_S, SLU_GE);
sCreate_Dense_Matrix(&X, m, nrhs, rhsx, 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 ( !(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[].");
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[].");
info = 0;
#ifdef DEBUG
num_drop_L = 0;
num_drop_U = 0;
#endif
/* Initialize the statistics variables. */
StatInit(&stat);
/* Compute the incomplete factorization and compute the condition number
and pivot growth using dgsisx. */
B.ncol = 0; /* not to perform triangular solution */
sgsisx(&options, &A, perm_c, perm_r, etree, equed, R, C, &L, &U, work,
lwork, &B, &X, &rpg, &rcond, &Glu, &mem_usage, &stat, &info);
/* Set RHS for GMRES. */
if (!(b = floatMalloc(m))) ABORT("Malloc fails for b[].");
if (*equed == 'R' || *equed == 'B') {
for (i = 0; i < n; ++i) b[i] = rhsb[i] * R[i];
} else {
for (i = 0; i < m; i++) b[i] = rhsb[i];
}
printf("sgsisx(): info %d, equed %c\n", info, equed[0]);
if (info > 0 || rcond < 1e-8 || rpg > 1e8)
printf("WARNING: This preconditioner might be unstable.\n");
if ( info == 0 || info == n+1 ) {
if ( options.PivotGrowth == YES )
printf("Recip. pivot growth = %e\n", rpg);
if ( options.ConditionNumber == YES )
printf("Recip. condition number = %e\n", rcond);
} else if ( info > 0 && lwork == -1 ) {
printf("** Estimated memory: %d bytes\n", info - n);
}
Lstore = (SCformat *) L.Store;
Ustore = (NCformat *) U.Store;
printf("n(A) = %d, nnz(A) = %d\n", n, Astore->nnz);
printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
printf("Fill ratio: nnz(F)/nnz(A) = %.3f\n",
((double)(Lstore->nnz) + (double)(Ustore->nnz) - (double)n)
/ (double)Astore->nnz);
printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
fflush(stdout);
/* Set the global variables. */
GLOBAL_A = &A;
GLOBAL_L = &L;
GLOBAL_U = &U;
GLOBAL_STAT = &stat;
GLOBAL_PERM_C = perm_c;
GLOBAL_PERM_R = perm_r;
GLOBAL_OPTIONS = &options;
GLOBAL_R = R;
GLOBAL_C = C;
GLOBAL_MEM_USAGE = &mem_usage;
/* Set the options to do solve-only. */
options.Fact = FACTORED;
options.PivotGrowth = NO;
options.ConditionNumber = NO;
/* Set the variables used by GMRES. */
restrt = SUPERLU_MIN(n / 3 + 1, 50);
maxit = 1000;
iter = maxit;
resid = 1e-8;
if (!(x = floatMalloc(n))) ABORT("Malloc fails for x[].");
if (info <= n + 1)
{
int i_1 = 1;
double maxferr = 0.0, nrmA, nrmB, res, t;
float temp;
extern float snrm2_(int *, float [], int *);
extern void saxpy_(int *, float *, float [], int *, float [], int *);
/* Initial guess */
for (i = 0; i < n; i++) x[i] = zero;
t = SuperLU_timer_();
/* Call GMRES */
sfgmr(n, smatvec_mult, spsolve, b, x, resid, restrt, &iter, stdout);
t = SuperLU_timer_() - t;
/* Output the result. */
nrmA = snrm2_(&(Astore->nnz), (float *)((DNformat *)A.Store)->nzval,
&i_1);
nrmB = snrm2_(&m, b, &i_1);
sp_sgemv("N", -1.0, &A, x, 1, 1.0, b, 1);
res = snrm2_(&m, b, &i_1);
resid = res / nrmB;
printf("||A||_F = %.1e, ||B||_2 = %.1e, ||B-A*X||_2 = %.1e, "
"relres = %.1e\n", nrmA, nrmB, res, resid);
if (iter >= maxit)
{
if (resid >= 1.0) iter = -180;
else if (resid > 1e-8) iter = -111;
}
printf("iteration: %d\nresidual: %.1e\nGMRES time: %.2f seconds.\n",
iter, resid, t);
/* Scale the solution back if equilibration was performed. */
if (*equed == 'C' || *equed == 'B')
for (i = 0; i < n; i++) x[i] *= C[i];
for (i = 0; i < m; i++) {
maxferr = SUPERLU_MAX(maxferr, fabs(x[i] - xact[i]));
}
printf("||X-X_true||_oo = %.1e\n", maxferr);
}
#ifdef DEBUG
printf("%d entries in L and %d entries in U dropped.\n",
num_drop_L, num_drop_U);
#endif
fflush(stdout);
if ( options.PrintStat ) StatPrint(&stat);
StatFree(&stat);
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);
Destroy_CompCol_Matrix(&A);
Destroy_SuperMatrix_Store(&B);
Destroy_SuperMatrix_Store(&X);
if ( lwork >= 0 ) {
Destroy_SuperNode_Matrix(&L);
Destroy_CompCol_Matrix(&U);
}
SUPERLU_FREE(b);
SUPERLU_FREE(x);
#if ( DEBUGlevel>=1 )
CHECK_MALLOC("Exit main()");
#endif
return 0;
}
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);
}
}
