int
ilu_zsnode_dfs(
const int jcol, /* in - start of the supernode */
const int kcol, /* in - end of the supernode */
const int *asub, /* in */
const int *xa_begin, /* in */
const int *xa_end, /* in */
int *marker, /* modified */
GlobalLU_t *Glu /* modified */
)
{
register int i, k, nextl;
int nsuper, krow, kmark, mem_error;
int *xsup, *supno;
int *lsub, *xlsub;
int nzlmax;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
nzlmax = Glu->nzlmax;
nsuper = ++supno[jcol]; /* Next available supernode number */
nextl = xlsub[jcol];
for (i = jcol; i <= kcol; i++)
{
/* For each nonzero in A[*,i] */
for (k = xa_begin[i]; k < xa_end[i]; k++)
{
krow = asub[k];
kmark = marker[krow];
if ( kmark != kcol )
{ /* First time visit krow */
marker[krow] = kcol;
lsub[nextl++] = krow;
if ( nextl >= nzlmax )
{
if ( (mem_error = zLUMemXpand(jcol, nextl, LSUB, &nzlmax,
Glu)) != 0)
return (mem_error);
lsub = Glu->lsub;
}
}
}
supno[i] = nsuper;
}
/* Supernode > 1 */
if ( jcol < kcol )
for (i = jcol+1; i <= kcol; i++) xlsub[i] = nextl;
xsup[nsuper+1] = kcol + 1;
supno[kcol+1] = nsuper;
xlsub[kcol+1] = nextl;
return 0;
}
void
zgstrf (char *refact, SuperMatrix *A, double diag_pivot_thresh,
double drop_tol, int relax, int panel_size, int *etree,
void *work, int lwork, int *perm_r, int *perm_c,
SuperMatrix *L, SuperMatrix *U, int *info)
{
/*
* Purpose
* =======
*
* ZGSTRF computes an LU factorization of a general sparse m-by-n
* 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).
*
* See supermatrix.h for the definition of 'SuperMatrix' structure.
*
* Arguments
* =========
*
* refact (input) char*
* Specifies whether we want to use perm_r from a previous factor.
* = 'Y': re-use perm_r; perm_r is input, and may be modified due to
* different pivoting determined by diagonal threshold.
* = 'N': perm_r is determined by partial pivoting, and output.
*
* A (input) SuperMatrix*
* Original matrix A, permuted by columns, of dimension
* (A->nrow, A->ncol). The type of A can be:
* Stype = SLU_NCP; Dtype = SLU_Z; Mtype = SLU_GE.
*
* diag_pivot_thresh (input) double
* Diagonal pivoting threshold. At step j of the Gaussian elimination,
* if abs(A_jj) >= thresh * (max_(i>=j) abs(A_ij)), use A_jj as pivot.
* 0 <= thresh <= 1. The default value of thresh 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.
*
* 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.
*
* panel_size (input) int
* A panel consists of at most panel_size consecutive columns.
*
* etree (input) int*, dimension (A->ncol)
* Elimination tree of A'*A.
* 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.
* On input, the columns of A should be permuted so that the
* etree is in a certain postorder.
*
* work (input/output) void*, size (lwork) (in bytes)
* User-supplied work space and space for the output data structures.
* Not referenced if lwork = 0;
*
* 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
* *info; no other side effects.
*
* 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 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.
*
* 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 searching for diagonal, perm_c[*] is applied to the
* row subscripts of A, so that diagonal threshold pivoting
* can find the diagonal of A, rather than that of A*Pc.
*
* 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 = SLU_SC, Dtype = SLU_Z, Mtype = SLU_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 = SLU_NC,
* Dtype = SLU_Z, Mtype = SLU_TRU.
*
* 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. If lwork = -1, it is
* the estimated amount of space needed, plus A->ncol.
*
* ======================================================================
*
* Local Working Arrays:
* ======================
* m = number of rows in the matrix
* n = number of columns in the matrix
*
* xprune[0:n-1]: xprune[*] points to locations in subscript
* vector lsub[*]. For column i, xprune[i] denotes the point where
* structural pruning begins. I.e. only xlsub[i],..,xprune[i]-1 need
* to be traversed for symbolic factorization.
*
* marker[0:3*m-1]: marker[i] = j means that node i has been
* reached when working on column j.
* Storage: relative to original row subscripts
* NOTE: There are 3 of them: marker/marker1 are used for panel dfs,
* see zpanel_dfs.c; marker2 is used for inner-factorization,
* see zcolumn_dfs.c.
*
* parent[0:m-1]: parent vector used during dfs
* Storage: relative to new row subscripts
*
* xplore[0:m-1]: xplore[i] gives the location of the next (dfs)
* 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.
* The maximum size of segrep[] is n.
*
* repfnz[0:W*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 the 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 nonzeros row indices below
* the panel diagonal. These are filled in during zpanel_dfs(), and are
* used later in the inner LU factorization within the panel.
* panel_lsub[]/dense[] pair forms the SPA data structure.
* NOTE: There are W of them.
*
* dense[0:W*m-1]: sparse accumulating (SPA) vector for intermediate values;
* NOTE: there are W of them.
*
* tempv[0:*]: real temporary used for dense numeric kernels;
* The size of this array is defined by NUM_TEMPV() in zsp_defs.h.
*
*/
/* Local working arrays */
NCPformat *Astore;
int *iperm_r; /* inverse of perm_r; not used if refact = 'N' */
int *iperm_c; /* inverse of perm_c */
int *iwork;
doublecomplex *zwork;
int *segrep, *repfnz, *parent, *xplore;
int *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
int *xprune;
int *marker;
doublecomplex *dense, *tempv;
int *relax_end;
doublecomplex *a;
int *asub;
int *xa_begin, *xa_end;
int *xsup, *supno;
int *xlsub, *xlusup, *xusub;
int nzlumax;
static GlobalLU_t Glu; /* persistent to facilitate multiple factors. */
/* Local scalars */
int pivrow; /* pivotal row number in the original matrix A */
int nseg1; /* no of segments in U-column above panel row jcol */
int nseg; /* no of segments in each U-column */
register int jcol;
register int kcol; /* end column of a relaxed snode */
register int icol;
register int i, k, jj, new_next, iinfo;
int m, n, min_mn, jsupno, fsupc, nextlu, nextu;
int w_def; /* upper bound on panel width */
int usepr, iperm_r_allocated = 0;
int nnzL, nnzU;
extern SuperLUStat_t SuperLUStat;
int *panel_histo = SuperLUStat.panel_histo;
flops_t *ops = SuperLUStat.ops;
iinfo = 0;
m = A->nrow;
n = A->ncol;
min_mn = SUPERLU_MIN(m, n);
Astore = A->Store;
a = Astore->nzval;
asub = Astore->rowind;
xa_begin = Astore->colbeg;
xa_end = Astore->colend;
/* Allocate storage common to the factor routines */
*info = zLUMemInit(refact, work, lwork, m, n, Astore->nnz,
panel_size, L, U, &Glu, &iwork, &zwork);
if ( *info ) return;
xsup = Glu.xsup;
supno = Glu.supno;
xlsub = Glu.xlsub;
xlusup = Glu.xlusup;
xusub = Glu.xusub;
SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
&repfnz, &panel_lsub, &xprune, &marker);
zSetRWork(m, panel_size, zwork, &dense, &tempv);
usepr = lsame_(refact, "Y");
if ( usepr ) {
/* Compute the inverse of perm_r */
iperm_r = (int *) intMalloc(m);
for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
iperm_r_allocated = 1;
}
iperm_c = (int *) intMalloc(n);
for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
/* Identify relaxed snodes */
relax_end = (int *) intMalloc(n);
relax_snode(n, etree, relax, marker, relax_end);
ifill (perm_r, m, EMPTY);
ifill (marker, m * NO_MARKER, EMPTY);
supno[0] = -1;
xsup[0] = xlsub[0] = xusub[0] = xlusup[0] = 0;
w_def = panel_size;
/*
* Work on one "panel" at a time. A panel is one of the following:
* (a) a relaxed supernode at the bottom of the etree, or
* (b) panel_size contiguous columns, defined by the user
*/
for (jcol = 0; jcol < min_mn; ) {
if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
kcol = relax_end[jcol]; /* end of the relaxed snode */
panel_histo[kcol-jcol+1]++;
/* --------------------------------------
* Factorize the relaxed supernode(jcol:kcol)
* -------------------------------------- */
/* Determine the union of the row structure of the snode */
if ( (*info = zsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
xprune, marker, &Glu)) != 0 )
return;
nextu = xusub[jcol];
nextlu = xlusup[jcol];
jsupno = supno[jcol];
fsupc = xsup[jsupno];
new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
nzlumax = Glu.nzlumax;
while ( new_next > nzlumax ) {
if ( *info = zLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, &Glu) )
return;
}
for (icol = jcol; icol<= kcol; icol++) {
xusub[icol+1] = nextu;
/* Scatter into SPA dense[*] */
for (k = xa_begin[icol]; k < xa_end[icol]; k++)
dense[asub[k]] = a[k];
/* Numeric update within the snode */
zsnode_bmod(icol, jsupno, fsupc, dense, tempv, &Glu);
if ( *info = zpivotL(icol, diag_pivot_thresh, &usepr, perm_r,
iperm_r, iperm_c, &pivrow, &Glu) )
if ( iinfo == 0 ) iinfo = *info;
#ifdef DEBUG
zprint_lu_col("[1]: ", icol, pivrow, xprune, &Glu);
#endif
}
jcol = icol;
} else { /* Work on one panel of panel_size columns */
/* Adjust panel_size so that a panel won't overlap with the next
* relaxed snode.
*/
panel_size = w_def;
for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
if ( relax_end[k] != EMPTY ) {
panel_size = k - jcol;
break;
}
if ( k == min_mn ) panel_size = min_mn - jcol;
panel_histo[panel_size]++;
/* symbolic factor on a panel of columns */
zpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
dense, panel_lsub, segrep, repfnz, xprune,
marker, parent, xplore, &Glu);
/* numeric sup-panel updates in topological order */
zpanel_bmod(m, panel_size, jcol, nseg1, dense,
tempv, segrep, repfnz, &Glu);
/* Sparse LU within the panel, and below panel diagonal */
for ( jj = jcol; jj < jcol + panel_size; jj++) {
k = (jj - jcol) * m; /* column index for w-wide arrays */
nseg = nseg1; /* Begin after all the panel segments */
if ((*info = zcolumn_dfs(m, jj, perm_r, &nseg, &panel_lsub[k],
segrep, &repfnz[k], xprune, marker,
parent, xplore, &Glu)) != 0) return;
/* Numeric updates */
if ((*info = zcolumn_bmod(jj, (nseg - nseg1), &dense[k],
tempv, &segrep[nseg1], &repfnz[k],
jcol, &Glu)) != 0) return;
/* Copy the U-segments to ucol[*] */
if ((*info = zcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
perm_r, &dense[k], &Glu)) != 0)
return;
if ( *info = zpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
iperm_r, iperm_c, &pivrow, &Glu) )
if ( iinfo == 0 ) iinfo = *info;
/* Prune columns (0:jj-1) using column jj */
zpruneL(jj, perm_r, pivrow, nseg, segrep,
&repfnz[k], xprune, &Glu);
/* Reset repfnz[] for this column */
resetrep_col (nseg, segrep, &repfnz[k]);
#ifdef DEBUG
zprint_lu_col("[2]: ", jj, pivrow, xprune, &Glu);
#endif
}
jcol += panel_size; /* Move to the next panel */
} /* else */
} /* for */
*info = iinfo;
if ( m > n ) {
k = 0;
for (i = 0; i < m; ++i)
if ( perm_r[i] == EMPTY ) {
perm_r[i] = n + k;
++k;
}
}
countnz(min_mn, xprune, &nnzL, &nnzU, &Glu);
fixupL(min_mn, perm_r, &Glu);
zLUWorkFree(iwork, zwork, &Glu); /* Free work space and compress storage */
if ( lsame_(refact, "Y") ) {
/* L and U structures may have changed due to possibly different
pivoting, although the storage is available.
There could also be memory expansions, so the array locations
may have changed, */
((SCformat *)L->Store)->nnz = nnzL;
((SCformat *)L->Store)->nsuper = Glu.supno[n];
((SCformat *)L->Store)->nzval = Glu.lusup;
((SCformat *)L->Store)->nzval_colptr = Glu.xlusup;
((SCformat *)L->Store)->rowind = Glu.lsub;
((SCformat *)L->Store)->rowind_colptr = Glu.xlsub;
((NCformat *)U->Store)->nnz = nnzU;
((NCformat *)U->Store)->nzval = Glu.ucol;
((NCformat *)U->Store)->rowind = Glu.usub;
((NCformat *)U->Store)->colptr = Glu.xusub;
} else {
zCreate_SuperNode_Matrix(L, A->nrow, A->ncol, nnzL, Glu.lusup,
Glu.xlusup, Glu.lsub, Glu.xlsub, Glu.supno,
Glu.xsup, SLU_SC, SLU_Z, SLU_TRLU);
zCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU, Glu.ucol,
Glu.usub, Glu.xusub, SLU_NC, SLU_Z, SLU_TRU);
}
ops[FACT] += ops[TRSV] + ops[GEMV];
if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
SUPERLU_FREE (iperm_c);
SUPERLU_FREE (relax_end);
}
int
ilu_zcopy_to_ucol(
int jcol, /* in */
int nseg, /* in */
int *segrep, /* in */
int *repfnz, /* in */
int *perm_r, /* in */
doublecomplex *dense, /* modified - reset to zero on return */
int drop_rule,/* in */
milu_t milu, /* in */
double drop_tol, /* in */
int quota, /* maximum nonzero entries allowed */
doublecomplex *sum, /* out - the sum of dropped entries */
int *nnzUj, /* in - out */
GlobalLU_t *Glu, /* modified */
double *work /* working space with minimum size n,
* used by the second dropping rule */
)
{
/*
* Gather from SPA dense[*] to global ucol[*].
*/
int ksub, krep, ksupno;
int i, k, kfnz, segsze;
int fsupc, isub, irow;
int jsupno, nextu;
int new_next, mem_error;
int *xsup, *supno;
int *lsub, *xlsub;
doublecomplex *ucol;
int *usub, *xusub;
int nzumax;
int m; /* number of entries in the nonzero U-segments */
register double d_max = 0.0, d_min = 1.0 / dmach("Safe minimum");
register double tmp;
doublecomplex zero = {0.0, 0.0};
int i_1 = 1;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
ucol = (doublecomplex *) Glu->ucol;
usub = Glu->usub;
xusub = Glu->xusub;
nzumax = Glu->nzumax;
*sum = zero;
if (drop_rule == NODROP) {
drop_tol = -1.0, quota = Glu->n;
}
jsupno = supno[jcol];
nextu = xusub[jcol];
k = nseg - 1;
for (ksub = 0; ksub < nseg; ksub++) {
krep = segrep[k--];
ksupno = supno[krep];
if ( ksupno != jsupno ) { /* Should go into ucol[] */
kfnz = repfnz[krep];
if ( kfnz != EMPTY ) { /* Nonzero U-segment */
fsupc = xsup[ksupno];
isub = xlsub[fsupc] + kfnz - fsupc;
segsze = krep - kfnz + 1;
new_next = nextu + segsze;
while ( new_next > nzumax ) {
if ((mem_error = zLUMemXpand(jcol, nextu, UCOL, &nzumax,
Glu)) != 0)
return (mem_error);
ucol = Glu->ucol;
if ((mem_error = zLUMemXpand(jcol, nextu, USUB, &nzumax,
Glu)) != 0)
return (mem_error);
usub = Glu->usub;
lsub = Glu->lsub;
}
for (i = 0; i < segsze; i++) {
irow = lsub[isub++];
tmp = z_abs1(&dense[irow]);
/* first dropping rule */
if (quota > 0 && tmp >= drop_tol) {
if (tmp > d_max) d_max = tmp;
if (tmp < d_min) d_min = tmp;
usub[nextu] = perm_r[irow];
ucol[nextu] = dense[irow];
nextu++;
} else {
switch (milu) {
case SMILU_1:
case SMILU_2:
z_add(sum, sum, &dense[irow]);
break;
case SMILU_3:
/* *sum += fabs(dense[irow]);*/
sum->r += tmp;
break;
case SILU:
default:
break;
}
#ifdef DEBUG
num_drop_U++;
#endif
}
dense[irow] = zero;
}
}
}
} /* for each segment... */
xusub[jcol + 1] = nextu; /* Close U[*,jcol] */
m = xusub[jcol + 1] - xusub[jcol];
/* second dropping rule */
if (drop_rule & DROP_SECONDARY && m > quota) {
register double tol = d_max;
register int m0 = xusub[jcol] + m - 1;
if (quota > 0) {
if (drop_rule & DROP_INTERP) {
d_max = 1.0 / d_max; d_min = 1.0 / d_min;
tol = 1.0 / (d_max + (d_min - d_max) * quota / m);
} else {
i_1 = xusub[jcol];
for (i = 0; i < m; ++i, ++i_1) work[i] = z_abs1(&ucol[i_1]);
tol = dqselect(m, work, quota);
#if 0
A = &ucol[xusub[jcol]];
for (i = 0; i < m; i++) work[i] = i;
qsort(work, m, sizeof(int), _compare_);
tol = fabs(usub[xusub[jcol] + work[quota]]);
#endif
}
}
for (i = xusub[jcol]; i <= m0; ) {
if (z_abs1(&ucol[i]) <= tol) {
switch (milu) {
case SMILU_1:
case SMILU_2:
z_add(sum, sum, &ucol[i]);
break;
case SMILU_3:
sum->r += tmp;
break;
case SILU:
default:
break;
}
ucol[i] = ucol[m0];
usub[i] = usub[m0];
m0--;
m--;
#ifdef DEBUG
num_drop_U++;
#endif
xusub[jcol + 1]--;
continue;
}
i++;
}
}
if (milu == SMILU_2) {
sum->r = z_abs1(sum); sum->i = 0.0;
}
if (milu == SMILU_3) sum->i = 0.0;
*nnzUj += m;
return 0;
}
/*! \brief
*
* <pre>
* Purpose
* =======
* "column_dfs" performs a symbolic factorization on column jcol, and
* decide the supernode boundary.
*
* This routine does not use numeric values, but only use the RHS
* row indices to start the dfs.
*
* A supernode representative is the last column of a supernode.
* The nonzeros in U[*,j] are segments that end at supernodal
* representatives. The routine returns a list of such supernodal
* representatives in topological order of the dfs that generates them.
* The location of the first nonzero in each such supernodal segment
* (supernodal entry location) is also returned.
*
* Local parameters
* ================
* nseg: no of segments in current U[*,j]
* jsuper: jsuper=EMPTY if column j does not belong to the same
* supernode as j-1. Otherwise, jsuper=nsuper.
*
* marker2: A-row --> A-row/col (0/1)
* repfnz: SuperA-col --> PA-row
* parent: SuperA-col --> SuperA-col
* xplore: SuperA-col --> index to L-structure
*
* Return value
* ============
* 0 success;
* > 0 number of bytes allocated when run out of space.
* </pre>
*/
int
zcolumn_dfs(
const int m, /* in - number of rows in the matrix */
const int jcol, /* in */
int *perm_r, /* in */
int *nseg, /* modified - with new segments appended */
int *lsub_col, /* in - defines the RHS vector to start the dfs */
int *segrep, /* modified - with new segments appended */
int *repfnz, /* modified */
int *xprune, /* modified */
int *marker, /* modified */
int *parent, /* working array */
int *xplore, /* working array */
GlobalLU_t *Glu /* modified */
)
{
int jcolp1, jcolm1, jsuper, nsuper, nextl;
int k, krep, krow, kmark, kperm;
int *marker2; /* Used for small panel LU */
int fsupc; /* First column of a snode */
int myfnz; /* First nonz column of a U-segment */
int chperm, chmark, chrep, kchild;
int xdfs, maxdfs, kpar, oldrep;
int jptr, jm1ptr;
int ito, ifrom, istop; /* Used to compress row subscripts */
int mem_error;
int *xsup, *supno, *lsub, *xlsub;
int nzlmax;
static int first = 1, maxsuper;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
nzlmax = Glu->nzlmax;
if ( first ) {
maxsuper = sp_ienv(3);
first = 0;
}
jcolp1 = jcol + 1;
jcolm1 = jcol - 1;
nsuper = supno[jcol];
jsuper = nsuper;
nextl = xlsub[jcol];
marker2 = &marker[2*m];
/* For each nonzero in A[*,jcol] do dfs */
for (k = 0; lsub_col[k] != EMPTY; k++) {
krow = lsub_col[k];
lsub_col[k] = EMPTY;
kmark = marker2[krow];
/* krow was visited before, go to the next nonz */
if ( kmark == jcol ) continue;
/* For each unmarked nbr krow of jcol
* krow is in L: place it in structure of L[*,jcol]
*/
marker2[krow] = jcol;
kperm = perm_r[krow];
if ( kperm == EMPTY ) {
lsub[nextl++] = krow; /* krow is indexed into A */
if ( nextl >= nzlmax ) {
mem_error = zLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu);
if ( mem_error )
return (mem_error);
lsub = Glu->lsub;
}
if ( kmark != jcolm1 ) jsuper = EMPTY;/* Row index subset testing */
} else {
/* krow is in U: if its supernode-rep krep
* has been explored, update repfnz[*]
*/
krep = xsup[supno[kperm]+1] - 1;
myfnz = repfnz[krep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > kperm ) repfnz[krep] = kperm;
/* continue; */
}
else {
/* Otherwise, perform dfs starting at krep */
oldrep = EMPTY;
parent[krep] = oldrep;
repfnz[krep] = kperm;
xdfs = xlsub[krep];
maxdfs = xprune[krep];
do {
/*
* For each unmarked kchild of krep
*/
while ( xdfs < maxdfs ) {
kchild = lsub[xdfs];
xdfs++;
chmark = marker2[kchild];
if ( chmark != jcol ) { /* Not reached yet */
marker2[kchild] = jcol;
chperm = perm_r[kchild];
/* Case kchild is in L: place it in L[*,k] */
if ( chperm == EMPTY ) {
lsub[nextl++] = kchild;
if ( nextl >= nzlmax ) {
mem_error = zLUMemXpand(jcol,nextl,LSUB,&nzlmax,Glu) ;
if ( mem_error )
return (mem_error);
lsub = Glu->lsub;
}
if ( chmark != jcolm1 ) jsuper = EMPTY;
} else {
/* Case kchild is in U:
* chrep = its supernode-rep. If its rep has
* been explored, update its repfnz[*]
*/
chrep = xsup[supno[chperm]+1] - 1;
myfnz = repfnz[chrep];
if ( myfnz != EMPTY ) { /* Visited before */
if ( myfnz > chperm )
repfnz[chrep] = chperm;
} else {
/* Continue dfs at super-rep of kchild */
xplore[krep] = xdfs;
oldrep = krep;
krep = chrep; /* Go deeper down G(L^t) */
parent[krep] = oldrep;
repfnz[krep] = chperm;
xdfs = xlsub[krep];
maxdfs = xprune[krep];
} /* else */
} /* else */
} /* if */
} /* while */
/* krow has no more unexplored nbrs;
* place supernode-rep krep in postorder DFS.
* backtrack dfs to its parent
*/
segrep[*nseg] = krep;
++(*nseg);
kpar = parent[krep]; /* Pop from stack, mimic recursion */
if ( kpar == EMPTY ) break; /* dfs done */
krep = kpar;
xdfs = xplore[krep];
maxdfs = xprune[krep];
} while ( kpar != EMPTY ); /* Until empty stack */
} /* else */
} /* else */
} /* for each nonzero ... */
/* Check to see if j belongs in the same supernode as j-1 */
if ( jcol == 0 ) { /* Do nothing for column 0 */
nsuper = supno[0] = 0;
} else {
fsupc = xsup[nsuper];
jptr = xlsub[jcol]; /* Not compressed yet */
jm1ptr = xlsub[jcolm1];
#ifdef T2_SUPER
if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = EMPTY;
#endif
/* Make sure the number of columns in a supernode doesn't
exceed threshold. */
if ( jcol - fsupc >= maxsuper ) jsuper = EMPTY;
/* If jcol starts a new supernode, reclaim storage space in
* lsub from the previous supernode. Note we only store
* the subscript set of the first and last columns of
* a supernode. (first for num values, last for pruning)
*/
if ( jsuper == EMPTY ) { /* starts a new supernode */
if ( (fsupc < jcolm1-1) ) { /* >= 3 columns in nsuper */
#ifdef CHK_COMPRESS
printf(" Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
#endif
ito = xlsub[fsupc+1];
xlsub[jcolm1] = ito;
istop = ito + jptr - jm1ptr;
xprune[jcolm1] = istop; /* Initialize xprune[jcol-1] */
xlsub[jcol] = istop;
for (ifrom = jm1ptr; ifrom < nextl; ++ifrom, ++ito)
lsub[ito] = lsub[ifrom];
nextl = ito; /* = istop + length(jcol) */
}
nsuper++;
supno[jcol] = nsuper;
} /* if a new supernode */
} /* else: jcol > 0 */
/* Tidy up the pointers before exit */
xsup[nsuper+1] = jcolp1;
supno[jcolp1] = nsuper;
xprune[jcol] = nextl; /* Initialize upper bound for pruning */
xlsub[jcolp1] = nextl;
return 0;
}
void
zgsitrf(superlu_options_t *options, SuperMatrix *A, int relax, int panel_size,
int *etree, void *work, int lwork, int *perm_c, int *perm_r,
SuperMatrix *L, SuperMatrix *U,
GlobalLU_t *Glu, /* persistent to facilitate multiple factorizations */
SuperLUStat_t *stat, int *info)
{
/* Local working arrays */
NCPformat *Astore;
int *iperm_r = NULL; /* inverse of perm_r; used when
options->Fact == SamePattern_SameRowPerm */
int *iperm_c; /* inverse of perm_c */
int *swap, *iswap; /* swap is used to store the row permutation
during the factorization. Initially, it is set
to iperm_c (row indeces of Pc*A*Pc').
iswap is the inverse of swap. After the
factorization, it is equal to perm_r. */
int *iwork;
doublecomplex *zwork;
int *segrep, *repfnz, *parent, *xplore;
int *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
int *marker, *marker_relax;
doublecomplex *dense, *tempv;
double *dtempv;
int *relax_end, *relax_fsupc;
doublecomplex *a;
int *asub;
int *xa_begin, *xa_end;
int *xsup, *supno;
int *xlsub, *xlusup, *xusub;
int nzlumax;
double *amax;
doublecomplex drop_sum;
double alpha, omega; /* used in MILU, mimicing DRIC */
double *dwork2; /* used by the second dropping rule */
/* Local scalars */
fact_t fact = options->Fact;
double diag_pivot_thresh = options->DiagPivotThresh;
double drop_tol = options->ILU_DropTol; /* tau */
double fill_ini = options->ILU_FillTol; /* tau^hat */
double gamma = options->ILU_FillFactor;
int drop_rule = options->ILU_DropRule;
milu_t milu = options->ILU_MILU;
double fill_tol;
int pivrow; /* pivotal row number in the original matrix A */
int nseg1; /* no of segments in U-column above panel row jcol */
int nseg; /* no of segments in each U-column */
register int jcol;
register int kcol; /* end column of a relaxed snode */
register int icol;
register int i, k, jj, new_next, iinfo;
int m, n, min_mn, jsupno, fsupc, nextlu, nextu;
int w_def; /* upper bound on panel width */
int usepr, iperm_r_allocated = 0;
int nnzL, nnzU;
int *panel_histo = stat->panel_histo;
flops_t *ops = stat->ops;
int last_drop;/* the last column which the dropping rules applied */
int quota;
int nnzAj; /* number of nonzeros in A(:,1:j) */
int nnzLj, nnzUj;
double tol_L = drop_tol, tol_U = drop_tol;
doublecomplex zero = {0.0, 0.0};
double one = 1.0;
/* Executable */
iinfo = 0;
m = A->nrow;
n = A->ncol;
min_mn = SUPERLU_MIN(m, n);
Astore = A->Store;
a = Astore->nzval;
asub = Astore->rowind;
xa_begin = Astore->colbeg;
xa_end = Astore->colend;
/* Allocate storage common to the factor routines */
*info = zLUMemInit(fact, work, lwork, m, n, Astore->nnz, panel_size,
gamma, L, U, Glu, &iwork, &zwork);
if ( *info ) return;
xsup = Glu->xsup;
supno = Glu->supno;
xlsub = Glu->xlsub;
xlusup = Glu->xlusup;
xusub = Glu->xusub;
SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
&repfnz, &panel_lsub, &marker_relax, &marker);
zSetRWork(m, panel_size, zwork, &dense, &tempv);
usepr = (fact == SamePattern_SameRowPerm);
if ( usepr ) {
/* Compute the inverse of perm_r */
iperm_r = (int *) intMalloc(m);
for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
iperm_r_allocated = 1;
}
iperm_c = (int *) intMalloc(n);
for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
swap = (int *)intMalloc(n);
for (k = 0; k < n; k++) swap[k] = iperm_c[k];
iswap = (int *)intMalloc(n);
for (k = 0; k < n; k++) iswap[k] = perm_c[k];
amax = (double *) SUPERLU_MALLOC(panel_size * sizeof(double));
if (drop_rule & DROP_SECONDARY)
dwork2 = SUPERLU_MALLOC(n * sizeof(double));
else
dwork2 = NULL;
nnzAj = 0;
nnzLj = 0;
nnzUj = 0;
last_drop = SUPERLU_MAX(min_mn - 2 * sp_ienv(7), (int)(min_mn * 0.95));
alpha = pow((double)n, -1.0 / options->ILU_MILU_Dim);
/* Identify relaxed snodes */
relax_end = (int *) intMalloc(n);
relax_fsupc = (int *) intMalloc(n);
if ( options->SymmetricMode == YES )
ilu_heap_relax_snode(n, etree, relax, marker, relax_end, relax_fsupc);
else
ilu_relax_snode(n, etree, relax, marker, relax_end, relax_fsupc);
ifill (perm_r, m, EMPTY);
ifill (marker, m * NO_MARKER, EMPTY);
supno[0] = -1;
xsup[0] = xlsub[0] = xusub[0] = xlusup[0] = 0;
w_def = panel_size;
/* Mark the rows used by relaxed supernodes */
ifill (marker_relax, m, EMPTY);
i = mark_relax(m, relax_end, relax_fsupc, xa_begin, xa_end,
asub, marker_relax);
#if ( PRNTlevel >= 1)
printf("%d relaxed supernodes.\n", i);
#endif
/*
* Work on one "panel" at a time. A panel is one of the following:
* (a) a relaxed supernode at the bottom of the etree, or
* (b) panel_size contiguous columns, defined by the user
*/
for (jcol = 0; jcol < min_mn; ) {
if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
kcol = relax_end[jcol]; /* end of the relaxed snode */
panel_histo[kcol-jcol+1]++;
/* Drop small rows in the previous supernode. */
if (jcol > 0 && jcol < last_drop) {
int first = xsup[supno[jcol - 1]];
int last = jcol - 1;
int quota;
/* Compute the quota */
if (drop_rule & DROP_PROWS)
quota = gamma * Astore->nnz / m * (m - first) / m
* (last - first + 1);
else if (drop_rule & DROP_COLUMN) {
int i;
quota = 0;
for (i = first; i <= last; i++)
quota += xa_end[i] - xa_begin[i];
quota = gamma * quota * (m - first) / m;
} else if (drop_rule & DROP_AREA)
quota = gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
- nnzLj;
else
quota = m * n;
fill_tol = pow(fill_ini, 1.0 - 0.5 * (first + last) / min_mn);
/* Drop small rows */
dtempv = (double *) tempv;
i = ilu_zdrop_row(options, first, last, tol_L, quota, &nnzLj,
&fill_tol, Glu, dtempv, dwork2, 0);
/* Reset the parameters */
if (drop_rule & DROP_DYNAMIC) {
if (gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
< nnzLj)
tol_L = SUPERLU_MIN(1.0, tol_L * 2.0);
else
tol_L = SUPERLU_MAX(drop_tol, tol_L * 0.5);
}
if (fill_tol < 0) iinfo -= (int)fill_tol;
#ifdef DEBUG
num_drop_L += i * (last - first + 1);
#endif
}
/* --------------------------------------
* Factorize the relaxed supernode(jcol:kcol)
* -------------------------------------- */
/* Determine the union of the row structure of the snode */
if ( (*info = ilu_zsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
marker, Glu)) != 0 )
return;
nextu = xusub[jcol];
nextlu = xlusup[jcol];
jsupno = supno[jcol];
fsupc = xsup[jsupno];
new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
nzlumax = Glu->nzlumax;
while ( new_next > nzlumax ) {
if ((*info = zLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu)))
return;
}
for (icol = jcol; icol <= kcol; icol++) {
xusub[icol+1] = nextu;
amax[0] = 0.0;
/* Scatter into SPA dense[*] */
for (k = xa_begin[icol]; k < xa_end[icol]; k++) {
register double tmp = z_abs1 (&a[k]);
if (tmp > amax[0]) amax[0] = tmp;
dense[asub[k]] = a[k];
}
nnzAj += xa_end[icol] - xa_begin[icol];
if (amax[0] == 0.0) {
amax[0] = fill_ini;
#if ( PRNTlevel >= 1)
printf("Column %d is entirely zero!\n", icol);
fflush(stdout);
#endif
}
/* Numeric update within the snode */
zsnode_bmod(icol, jsupno, fsupc, dense, tempv, Glu, stat);
if (usepr) pivrow = iperm_r[icol];
fill_tol = pow(fill_ini, 1.0 - (double)icol / (double)min_mn);
if ( (*info = ilu_zpivotL(icol, diag_pivot_thresh, &usepr,
perm_r, iperm_c[icol], swap, iswap,
marker_relax, &pivrow,
amax[0] * fill_tol, milu, zero,
Glu, stat)) ) {
iinfo++;
marker[pivrow] = kcol;
}
}
jcol = kcol + 1;
} else { /* Work on one panel of panel_size columns */
/* Adjust panel_size so that a panel won't overlap with the next
* relaxed snode.
*/
panel_size = w_def;
for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
if ( relax_end[k] != EMPTY ) {
panel_size = k - jcol;
break;
}
if ( k == min_mn ) panel_size = min_mn - jcol;
panel_histo[panel_size]++;
/* symbolic factor on a panel of columns */
ilu_zpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
dense, amax, panel_lsub, segrep, repfnz,
marker, parent, xplore, Glu);
/* numeric sup-panel updates in topological order */
zpanel_bmod(m, panel_size, jcol, nseg1, dense,
tempv, segrep, repfnz, Glu, stat);
/* Sparse LU within the panel, and below panel diagonal */
for (jj = jcol; jj < jcol + panel_size; jj++) {
k = (jj - jcol) * m; /* column index for w-wide arrays */
nseg = nseg1; /* Begin after all the panel segments */
nnzAj += xa_end[jj] - xa_begin[jj];
if ((*info = ilu_zcolumn_dfs(m, jj, perm_r, &nseg,
&panel_lsub[k], segrep, &repfnz[k],
marker, parent, xplore, Glu)))
return;
/* Numeric updates */
if ((*info = zcolumn_bmod(jj, (nseg - nseg1), &dense[k],
tempv, &segrep[nseg1], &repfnz[k],
jcol, Glu, stat)) != 0) return;
/* Make a fill-in position if the column is entirely zero */
if (xlsub[jj + 1] == xlsub[jj]) {
register int i, row;
int nextl;
int nzlmax = Glu->nzlmax;
int *lsub = Glu->lsub;
int *marker2 = marker + 2 * m;
/* Allocate memory */
nextl = xlsub[jj] + 1;
if (nextl >= nzlmax) {
int error = zLUMemXpand(jj, nextl, LSUB, &nzlmax, Glu);
if (error) { *info = error; return; }
lsub = Glu->lsub;
}
xlsub[jj + 1]++;
assert(xlusup[jj]==xlusup[jj+1]);
xlusup[jj + 1]++;
((doublecomplex *) Glu->lusup)[xlusup[jj]] = zero;
/* Choose a row index (pivrow) for fill-in */
for (i = jj; i < n; i++)
if (marker_relax[swap[i]] <= jj) break;
row = swap[i];
marker2[row] = jj;
lsub[xlsub[jj]] = row;
#ifdef DEBUG
printf("Fill col %d.\n", jj);
fflush(stdout);
#endif
}
/* Computer the quota */
if (drop_rule & DROP_PROWS)
quota = gamma * Astore->nnz / m * jj / m;
else if (drop_rule & DROP_COLUMN)
quota = gamma * (xa_end[jj] - xa_begin[jj]) *
(jj + 1) / m;
else if (drop_rule & DROP_AREA)
quota = gamma * 0.9 * nnzAj * 0.5 - nnzUj;
else
quota = m;
/* Copy the U-segments to ucol[*] and drop small entries */
if ((*info = ilu_zcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
perm_r, &dense[k], drop_rule,
milu, amax[jj - jcol] * tol_U,
quota, &drop_sum, &nnzUj, Glu,
dwork2)) != 0)
return;
/* Reset the dropping threshold if required */
if (drop_rule & DROP_DYNAMIC) {
if (gamma * 0.9 * nnzAj * 0.5 < nnzLj)
tol_U = SUPERLU_MIN(1.0, tol_U * 2.0);
else
tol_U = SUPERLU_MAX(drop_tol, tol_U * 0.5);
}
if (drop_sum.r != 0.0 && drop_sum.i != 0.0)
{
omega = SUPERLU_MIN(2.0*(1.0-alpha)/z_abs1(&drop_sum), 1.0);
zd_mult(&drop_sum, &drop_sum, omega);
}
if (usepr) pivrow = iperm_r[jj];
fill_tol = pow(fill_ini, 1.0 - (double)jj / (double)min_mn);
if ( (*info = ilu_zpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
iperm_c[jj], swap, iswap,
marker_relax, &pivrow,
amax[jj - jcol] * fill_tol, milu,
drop_sum, Glu, stat)) ) {
iinfo++;
marker[m + pivrow] = jj;
marker[2 * m + pivrow] = jj;
}
/* Reset repfnz[] for this column */
resetrep_col (nseg, segrep, &repfnz[k]);
/* Start a new supernode, drop the previous one */
if (jj > 0 && supno[jj] > supno[jj - 1] && jj < last_drop) {
int first = xsup[supno[jj - 1]];
int last = jj - 1;
int quota;
/* Compute the quota */
if (drop_rule & DROP_PROWS)
quota = gamma * Astore->nnz / m * (m - first) / m
* (last - first + 1);
else if (drop_rule & DROP_COLUMN) {
int i;
quota = 0;
for (i = first; i <= last; i++)
quota += xa_end[i] - xa_begin[i];
quota = gamma * quota * (m - first) / m;
} else if (drop_rule & DROP_AREA)
quota = gamma * nnzAj * (1.0 - 0.5 * (last + 1.0)
/ m) - nnzLj;
else
quota = m * n;
fill_tol = pow(fill_ini, 1.0 - 0.5 * (first + last) /
(double)min_mn);
/* Drop small rows */
dtempv = (double *) tempv;
i = ilu_zdrop_row(options, first, last, tol_L, quota,
&nnzLj, &fill_tol, Glu, dtempv, dwork2,
1);
/* Reset the parameters */
if (drop_rule & DROP_DYNAMIC) {
if (gamma * nnzAj * (1.0 - 0.5 * (last + 1.0) / m)
< nnzLj)
tol_L = SUPERLU_MIN(1.0, tol_L * 2.0);
else
tol_L = SUPERLU_MAX(drop_tol, tol_L * 0.5);
}
if (fill_tol < 0) iinfo -= (int)fill_tol;
#ifdef DEBUG
num_drop_L += i * (last - first + 1);
#endif
} /* if start a new supernode */
} /* for */
jcol += panel_size; /* Move to the next panel */
} /* else */
} /* for */
*info = iinfo;
if ( m > n ) {
k = 0;
for (i = 0; i < m; ++i)
if ( perm_r[i] == EMPTY ) {
perm_r[i] = n + k;
++k;
}
}
ilu_countnz(min_mn, &nnzL, &nnzU, Glu);
fixupL(min_mn, perm_r, Glu);
zLUWorkFree(iwork, zwork, Glu); /* Free work space and compress storage */
if ( fact == SamePattern_SameRowPerm ) {
/* L and U structures may have changed due to possibly different
pivoting, even though the storage is available.
There could also be memory expansions, so the array locations
may have changed, */
((SCformat *)L->Store)->nnz = nnzL;
((SCformat *)L->Store)->nsuper = Glu->supno[n];
((SCformat *)L->Store)->nzval = (doublecomplex *) Glu->lusup;
((SCformat *)L->Store)->nzval_colptr = Glu->xlusup;
((SCformat *)L->Store)->rowind = Glu->lsub;
((SCformat *)L->Store)->rowind_colptr = Glu->xlsub;
((NCformat *)U->Store)->nnz = nnzU;
((NCformat *)U->Store)->nzval = (doublecomplex *) Glu->ucol;
((NCformat *)U->Store)->rowind = Glu->usub;
((NCformat *)U->Store)->colptr = Glu->xusub;
} else {
zCreate_SuperNode_Matrix(L, A->nrow, min_mn, nnzL,
(doublecomplex *) Glu->lusup, Glu->xlusup,
Glu->lsub, Glu->xlsub, Glu->supno, Glu->xsup,
SLU_SC, SLU_Z, SLU_TRLU);
zCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU,
(doublecomplex *) Glu->ucol, Glu->usub, Glu->xusub,
SLU_NC, SLU_Z, SLU_TRU);
}
ops[FACT] += ops[TRSV] + ops[GEMV];
stat->expansions = --(Glu->num_expansions);
if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
SUPERLU_FREE (iperm_c);
SUPERLU_FREE (relax_end);
SUPERLU_FREE (swap);
SUPERLU_FREE (iswap);
SUPERLU_FREE (relax_fsupc);
SUPERLU_FREE (amax);
if ( dwork2 ) SUPERLU_FREE (dwork2);
}
/* Return value: 0 - successful return
* > 0 - number of bytes allocated when run out of space
*/
int
zcolumn_bmod (
const int jcol, /* in */
const int nseg, /* in */
doublecomplex *dense, /* in */
doublecomplex *tempv, /* working array */
int *segrep, /* in */
int *repfnz, /* in */
int fpanelc, /* in -- first column in the current panel */
GlobalLU_t *Glu, /* modified */
SuperLUStat_t *stat /* output */
)
{
/*
* Purpose:
* ========
* Performs numeric block updates (sup-col) in topological order.
* It features: col-col, 2cols-col, 3cols-col, and sup-col updates.
* Special processing on the supernodal portion of L\U[*,j]
*
*/
#ifdef _CRAY
_fcd ftcs1 = _cptofcd("L", strlen("L")),
ftcs2 = _cptofcd("N", strlen("N")),
ftcs3 = _cptofcd("U", strlen("U"));
#endif
int incx = 1, incy = 1;
doublecomplex alpha, beta;
/* krep = representative of current k-th supernode
* fsupc = first supernodal column
* nsupc = no of columns in supernode
* nsupr = no of rows in supernode (used as leading dimension)
* luptr = location of supernodal LU-block in storage
* kfnz = first nonz in the k-th supernodal segment
* no_zeros = no of leading zeros in a supernodal U-segment
*/
doublecomplex ukj, ukj1, ukj2;
int luptr, luptr1, luptr2;
int fsupc, nsupc, nsupr, segsze;
int nrow; /* No of rows in the matrix of matrix-vector */
int jcolp1, jsupno, k, ksub, krep, krep_ind, ksupno;
register int lptr, kfnz, isub, irow, i;
register int no_zeros, new_next;
int ufirst, nextlu;
int fst_col; /* First column within small LU update */
int d_fsupc; /* Distance between the first column of the current
panel and the first column of the current snode. */
int *xsup, *supno;
int *lsub, *xlsub;
doublecomplex *lusup;
int *xlusup;
int nzlumax;
doublecomplex *tempv1;
doublecomplex zero = {0.0, 0.0};
doublecomplex one = {1.0, 0.0};
doublecomplex none = {-1.0, 0.0};
doublecomplex comp_temp, comp_temp1;
int mem_error;
flops_t *ops = stat->ops;
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
lusup = Glu->lusup;
xlusup = Glu->xlusup;
nzlumax = Glu->nzlumax;
jcolp1 = jcol + 1;
jsupno = supno[jcol];
/*
* For each nonz supernode segment of U[*,j] in topological order
*/
k = nseg - 1;
for (ksub = 0; ksub < nseg; ksub++) {
krep = segrep[k];
k--;
ksupno = supno[krep];
if ( jsupno != ksupno ) { /* Outside the rectangular supernode */
fsupc = xsup[ksupno];
fst_col = SUPERLU_MAX ( fsupc, fpanelc );
/* Distance from the current supernode to the current panel;
d_fsupc=0 if fsupc > fpanelc. */
d_fsupc = fst_col - fsupc;
luptr = xlusup[fst_col] + d_fsupc;
lptr = xlsub[fsupc] + d_fsupc;
kfnz = repfnz[krep];
kfnz = SUPERLU_MAX ( kfnz, fpanelc );
segsze = krep - kfnz + 1;
nsupc = krep - fst_col + 1;
nsupr = xlsub[fsupc+1] - xlsub[fsupc]; /* Leading dimension */
nrow = nsupr - d_fsupc - nsupc;
krep_ind = lptr + nsupc - 1;
ops[TRSV] += 4 * segsze * (segsze - 1);
ops[GEMV] += 8 * nrow * segsze;
/*
* Case 1: Update U-segment of size 1 -- col-col update
*/
if ( segsze == 1 ) {
ukj = dense[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
zz_mult(&comp_temp, &ukj, &lusup[luptr]);
z_sub(&dense[irow], &dense[irow], &comp_temp);
luptr++;
}
} else if ( segsze <= 3 ) {
ukj = dense[lsub[krep_ind]];
luptr += nsupr*(nsupc-1) + nsupc-1;
ukj1 = dense[lsub[krep_ind - 1]];
luptr1 = luptr - nsupr;
if ( segsze == 2 ) { /* Case 2: 2cols-col update */
zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
z_sub(&ukj, &ukj, &comp_temp);
dense[lsub[krep_ind]] = ukj;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
luptr++;
luptr1++;
zz_mult(&comp_temp, &ukj, &lusup[luptr]);
zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
z_add(&comp_temp, &comp_temp, &comp_temp1);
z_sub(&dense[irow], &dense[irow], &comp_temp);
}
} else { /* Case 3: 3cols-col update */
ukj2 = dense[lsub[krep_ind - 2]];
luptr2 = luptr1 - nsupr;
zz_mult(&comp_temp, &ukj2, &lusup[luptr2-1]);
z_sub(&ukj1, &ukj1, &comp_temp);
zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
z_add(&comp_temp, &comp_temp, &comp_temp1);
z_sub(&ukj, &ukj, &comp_temp);
dense[lsub[krep_ind]] = ukj;
dense[lsub[krep_ind-1]] = ukj1;
for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
irow = lsub[i];
luptr++;
luptr1++;
luptr2++;
zz_mult(&comp_temp, &ukj, &lusup[luptr]);
zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
z_add(&comp_temp, &comp_temp, &comp_temp1);
zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
z_add(&comp_temp, &comp_temp, &comp_temp1);
z_sub(&dense[irow], &dense[irow], &comp_temp);
}
}
} else {
/*
* Case: sup-col update
* Perform a triangular solve and block update,
* then scatter the result of sup-col update to dense
*/
no_zeros = kfnz - fst_col;
/* Copy U[*,j] segment from dense[*] to tempv[*] */
isub = lptr + no_zeros;
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
tempv[i] = dense[irow];
++isub;
}
/* Dense triangular solve -- start effective triangle */
luptr += nsupr * no_zeros + no_zeros;
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
CTRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr],
&nsupr, tempv, &incx );
#else
ztrsv_( "L", "N", "U", &segsze, &lusup[luptr],
&nsupr, tempv, &incx );
#endif
luptr += segsze; /* Dense matrix-vector */
tempv1 = &tempv[segsze];
alpha = one;
beta = zero;
#ifdef _CRAY
CGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tempv, &incx, &beta, tempv1, &incy );
#else
zgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr],
&nsupr, tempv, &incx, &beta, tempv1, &incy );
#endif
#else
zlsolve ( nsupr, segsze, &lusup[luptr], tempv );
luptr += segsze; /* Dense matrix-vector */
tempv1 = &tempv[segsze];
zmatvec (nsupr, nrow , segsze, &lusup[luptr], tempv, tempv1);
#endif
/* Scatter tempv[] into SPA dense[] as a temporary storage */
isub = lptr + no_zeros;
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
dense[irow] = tempv[i];
tempv[i] = zero;
++isub;
}
/* Scatter tempv1[] into SPA dense[] */
for (i = 0; i < nrow; i++) {
irow = lsub[isub];
z_sub(&dense[irow], &dense[irow], &tempv1[i]);
tempv1[i] = zero;
++isub;
}
}
} /* if jsupno ... */
} /* for each segment... */
/*
* Process the supernodal portion of L\U[*,j]
*/
nextlu = xlusup[jcol];
fsupc = xsup[jsupno];
/* Copy the SPA dense into L\U[*,j] */
new_next = nextlu + xlsub[fsupc+1] - xlsub[fsupc];
while ( new_next > nzlumax ) {
if (mem_error = zLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu))
return (mem_error);
lusup = Glu->lusup;
lsub = Glu->lsub;
}
for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
irow = lsub[isub];
lusup[nextlu] = dense[irow];
dense[irow] = zero;
++nextlu;
}
xlusup[jcolp1] = nextlu; /* Close L\U[*,jcol] */
/* For more updates within the panel (also within the current supernode),
* should start from the first column of the panel, or the first column
* of the supernode, whichever is bigger. There are 2 cases:
* 1) fsupc < fpanelc, then fst_col := fpanelc
* 2) fsupc >= fpanelc, then fst_col := fsupc
*/
fst_col = SUPERLU_MAX ( fsupc, fpanelc );
if ( fst_col < jcol ) {
/* Distance between the current supernode and the current panel.
d_fsupc=0 if fsupc >= fpanelc. */
d_fsupc = fst_col - fsupc;
lptr = xlsub[fsupc] + d_fsupc;
luptr = xlusup[fst_col] + d_fsupc;
nsupr = xlsub[fsupc+1] - xlsub[fsupc]; /* Leading dimension */
nsupc = jcol - fst_col; /* Excluding jcol */
nrow = nsupr - d_fsupc - nsupc;
/* Points to the beginning of jcol in snode L\U(jsupno) */
ufirst = xlusup[jcol] + d_fsupc;
ops[TRSV] += 4 * nsupc * (nsupc - 1);
ops[GEMV] += 8 * nrow * nsupc;
#ifdef USE_VENDOR_BLAS
#ifdef _CRAY
CTRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr],
&nsupr, &lusup[ufirst], &incx );
#else
ztrsv_( "L", "N", "U", &nsupc, &lusup[luptr],
&nsupr, &lusup[ufirst], &incx );
#endif
alpha = none; beta = one; /* y := beta*y + alpha*A*x */
#ifdef _CRAY
CGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
#else
zgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
#endif
#else
zlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
zmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc],
&lusup[ufirst], tempv );
/* Copy updates from tempv[*] into lusup[*] */
isub = ufirst + nsupc;
for (i = 0; i < nrow; i++) {
z_sub(&lusup[isub], &lusup[isub], &tempv[i]);
tempv[i] = zero;
++isub;
}
#endif
} /* if fst_col < jcol ... */
return 0;
}
void
zgstrf (superlu_options_t *options, SuperMatrix *A, double drop_tol,
int relax, int panel_size, int *etree, void *work, int lwork,
int *perm_c, int *perm_r, SuperMatrix *L, SuperMatrix *U,
SuperLUStat_t *stat, int *info)
{
/* Local working arrays */
NCPformat *Astore;
int *iperm_r = NULL; /* inverse of perm_r; used when
options->Fact == SamePattern_SameRowPerm */
int *iperm_c; /* inverse of perm_c */
int *iwork;
doublecomplex *zwork;
int *segrep, *repfnz, *parent, *xplore;
int *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
int *xprune;
int *marker;
doublecomplex *dense, *tempv;
int *relax_end;
doublecomplex *a;
int *asub;
int *xa_begin, *xa_end;
int *xsup, *supno;
int *xlsub, *xlusup, *xusub;
int nzlumax;
static GlobalLU_t Glu; /* persistent to facilitate multiple factors. */
/* Local scalars */
fact_t fact = options->Fact;
double diag_pivot_thresh = options->DiagPivotThresh;
int pivrow; /* pivotal row number in the original matrix A */
int nseg1; /* no of segments in U-column above panel row jcol */
int nseg; /* no of segments in each U-column */
register int jcol;
register int kcol; /* end column of a relaxed snode */
register int icol;
register int i, k, jj, new_next, iinfo;
int m, n, min_mn, jsupno, fsupc, nextlu, nextu;
int w_def; /* upper bound on panel width */
int usepr, iperm_r_allocated = 0;
int nnzL, nnzU;
int *panel_histo = stat->panel_histo;
flops_t *ops = stat->ops;
iinfo = 0;
m = A->nrow;
n = A->ncol;
min_mn = SUPERLU_MIN(m, n);
Astore = A->Store;
a = Astore->nzval;
asub = Astore->rowind;
xa_begin = Astore->colbeg;
xa_end = Astore->colend;
/* Allocate storage common to the factor routines */
*info = zLUMemInit(fact, work, lwork, m, n, Astore->nnz,
panel_size, L, U, &Glu, &iwork, &zwork);
if ( *info ) return;
xsup = Glu.xsup;
supno = Glu.supno;
xlsub = Glu.xlsub;
xlusup = Glu.xlusup;
xusub = Glu.xusub;
SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
&repfnz, &panel_lsub, &xprune, &marker);
zSetRWork(m, panel_size, zwork, &dense, &tempv);
usepr = (fact == SamePattern_SameRowPerm);
if ( usepr ) {
/* Compute the inverse of perm_r */
iperm_r = (int *) intMalloc(m);
for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
iperm_r_allocated = 1;
}
iperm_c = (int *) intMalloc(n);
for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
/* Identify relaxed snodes */
relax_end = (int *) intMalloc(n);
if ( options->SymmetricMode == YES ) {
heap_relax_snode(n, etree, relax, marker, relax_end);
} else {
relax_snode(n, etree, relax, marker, relax_end);
}
ifill (perm_r, m, EMPTY);
ifill (marker, m * NO_MARKER, EMPTY);
supno[0] = -1;
xsup[0] = xlsub[0] = xusub[0] = xlusup[0] = 0;
w_def = panel_size;
/*
* Work on one "panel" at a time. A panel is one of the following:
* (a) a relaxed supernode at the bottom of the etree, or
* (b) panel_size contiguous columns, defined by the user
*/
for (jcol = 0; jcol < min_mn; ) {
if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
kcol = relax_end[jcol]; /* end of the relaxed snode */
panel_histo[kcol-jcol+1]++;
/* --------------------------------------
* Factorize the relaxed supernode(jcol:kcol)
* -------------------------------------- */
/* Determine the union of the row structure of the snode */
if ( (*info = zsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
xprune, marker, &Glu)) != 0 )
return;
nextu = xusub[jcol];
nextlu = xlusup[jcol];
jsupno = supno[jcol];
fsupc = xsup[jsupno];
new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
nzlumax = Glu.nzlumax;
while ( new_next > nzlumax ) {
*info = zLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, &Glu);
if ( (*info) )
return;
}
for (icol = jcol; icol<= kcol; icol++) {
xusub[icol+1] = nextu;
/* Scatter into SPA dense[*] */
for (k = xa_begin[icol]; k < xa_end[icol]; k++)
dense[asub[k]] = a[k];
/* Numeric update within the snode */
zsnode_bmod(icol, jsupno, fsupc, dense, tempv, &Glu, stat);
*info = zpivotL(icol, diag_pivot_thresh, &usepr, perm_r,iperm_r, iperm_c, &pivrow, &Glu, stat);
if ( (*info) )
if ( iinfo == 0 ) iinfo = *info;
#ifdef DEBUG
zprint_lu_col("[1]: ", icol, pivrow, xprune, &Glu);
#endif
}
jcol = icol;
} else { /* Work on one panel of panel_size columns */
/* Adjust panel_size so that a panel won't overlap with the next
* relaxed snode.
*/
panel_size = w_def;
for (k = jcol + 1; k < SUPERLU_MIN(jcol+panel_size, min_mn); k++)
if ( relax_end[k] != EMPTY ) {
panel_size = k - jcol;
break;
}
if ( k == min_mn ) panel_size = min_mn - jcol;
panel_histo[panel_size]++;
/* symbolic factor on a panel of columns */
zpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
dense, panel_lsub, segrep, repfnz, xprune,
marker, parent, xplore, &Glu);
/* numeric sup-panel updates in topological order */
zpanel_bmod(m, panel_size, jcol, nseg1, dense,
tempv, segrep, repfnz, &Glu, stat);
/* Sparse LU within the panel, and below panel diagonal */
for ( jj = jcol; jj < jcol + panel_size; jj++) {
k = (jj - jcol) * m; /* column index for w-wide arrays */
nseg = nseg1; /* Begin after all the panel segments */
if ((*info = zcolumn_dfs(m, jj, perm_r, &nseg, &panel_lsub[k],
segrep, &repfnz[k], xprune, marker,
parent, xplore, &Glu)) != 0) return;
/* Numeric updates */
if ((*info = zcolumn_bmod(jj, (nseg - nseg1), &dense[k],
tempv, &segrep[nseg1], &repfnz[k],
jcol, &Glu, stat)) != 0) return;
/* Copy the U-segments to ucol[*] */
if ((*info = zcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
perm_r, &dense[k], &Glu)) != 0)
return;
*info = zpivotL(jj, diag_pivot_thresh, &usepr, perm_r,iperm_r, iperm_c, &pivrow, &Glu, stat);
if ( (*info) )
if ( iinfo == 0 ) iinfo = *info;
/* Prune columns (0:jj-1) using column jj */
zpruneL(jj, perm_r, pivrow, nseg, segrep,
&repfnz[k], xprune, &Glu);
/* Reset repfnz[] for this column */
resetrep_col (nseg, segrep, &repfnz[k]);
#ifdef DEBUG
zprint_lu_col("[2]: ", jj, pivrow, xprune, &Glu);
#endif
}
jcol += panel_size; /* Move to the next panel */
} /* else */
} /* for */
*info = iinfo;
if ( m > n ) {
k = 0;
for (i = 0; i < m; ++i)
if ( perm_r[i] == EMPTY ) {
perm_r[i] = n + k;
++k;
}
}
countnz(min_mn, xprune, &nnzL, &nnzU, &Glu);
fixupL(min_mn, perm_r, &Glu);
zLUWorkFree(iwork, zwork, &Glu); /* Free work space and compress storage */
if ( fact == SamePattern_SameRowPerm ) {
/* L and U structures may have changed due to possibly different
pivoting, even though the storage is available.
There could also be memory expansions, so the array locations
may have changed, */
((SCformat *)L->Store)->nnz = nnzL;
((SCformat *)L->Store)->nsuper = Glu.supno[n];
((SCformat *)L->Store)->nzval = Glu.lusup;
((SCformat *)L->Store)->nzval_colptr = Glu.xlusup;
((SCformat *)L->Store)->rowind = Glu.lsub;
((SCformat *)L->Store)->rowind_colptr = Glu.xlsub;
((NCformat *)U->Store)->nnz = nnzU;
((NCformat *)U->Store)->nzval = Glu.ucol;
((NCformat *)U->Store)->rowind = Glu.usub;
((NCformat *)U->Store)->colptr = Glu.xusub;
} else {
zCreate_SuperNode_Matrix(L, A->nrow, min_mn, nnzL, Glu.lusup,
Glu.xlusup, Glu.lsub, Glu.xlsub, Glu.supno,
Glu.xsup, SLU_SC, SLU_Z, SLU_TRLU);
zCreate_CompCol_Matrix(U, min_mn, min_mn, nnzU, Glu.ucol,
Glu.usub, Glu.xusub, SLU_NC, SLU_Z, SLU_TRU);
}
ops[FACT] += ops[TRSV] + ops[GEMV];
if ( iperm_r_allocated ) SUPERLU_FREE (iperm_r);
SUPERLU_FREE (iperm_c);
SUPERLU_FREE (relax_end);
}
int
zcopy_to_ucol(
int jcol, /* in */
int nseg, /* in */
int *segrep, /* in */
int *repfnz, /* in */
int *perm_r, /* in */
doublecomplex *dense, /* modified - reset to zero on return */
GlobalLU_t *Glu /* modified */
)
{
/*
* Gather from SPA dense[*] to global ucol[*].
*/
int ksub, krep, ksupno;
int i, k, kfnz, segsze;
int fsupc, isub, irow;
int jsupno, nextu;
int new_next, mem_error;
int *xsup, *supno;
int *lsub, *xlsub;
doublecomplex *ucol;
int *usub, *xusub;
int nzumax;
doublecomplex zero = {0.0, 0.0};
xsup = Glu->xsup;
supno = Glu->supno;
lsub = Glu->lsub;
xlsub = Glu->xlsub;
ucol = (doublecomplex *) Glu->ucol;
usub = Glu->usub;
xusub = Glu->xusub;
nzumax = Glu->nzumax;
jsupno = supno[jcol];
nextu = xusub[jcol];
k = nseg - 1;
for (ksub = 0; ksub < nseg; ksub++) {
krep = segrep[k--];
ksupno = supno[krep];
if ( ksupno != jsupno ) { /* Should go into ucol[] */
kfnz = repfnz[krep];
if ( kfnz != EMPTY ) { /* Nonzero U-segment */
fsupc = xsup[ksupno];
isub = xlsub[fsupc] + kfnz - fsupc;
segsze = krep - kfnz + 1;
new_next = nextu + segsze;
while ( new_next > nzumax ) {
if (mem_error = zLUMemXpand(jcol, nextu, UCOL, &nzumax, Glu))
return (mem_error);
ucol = (doublecomplex *) Glu->ucol;
if (mem_error = zLUMemXpand(jcol, nextu, USUB, &nzumax, Glu))
return (mem_error);
usub = Glu->usub;
lsub = Glu->lsub;
}
for (i = 0; i < segsze; i++) {
irow = lsub[isub];
usub[nextu] = perm_r[irow];
ucol[nextu] = dense[irow];
dense[irow] = zero;
nextu++;
isub++;
}
}
}
} /* for each segment... */
xusub[jcol + 1] = nextu; /* Close U[*,jcol] */
return 0;
}
