/* ************************************************************
PROCEDURE sptotril - For sparse x=vec(X), lets
z = vec( tril(X) + triu(X,1)' ). If skew = 1 then
z = vec( tril(X) - triu(X)' ).
INPUT
xir, xpr, pxjc0, xjc1 - sparse input vector, *pxjc0 points to
first nonzero of vectorized matrix X.
first - subscript of X(1,1) in long vector x.
n - order of n x n matrix X.
skew - if 1, then set SUBTRACT triu(X,1)' and set diag(z)=all-0.
iwsize - n + xnnz + 1+nnz(triu(X,1)) + log_2(1+nnz(triu(X,1))).
Observe that nnz(triu(X,1)) <= MIN(n*(n-1)/2, xnnz), and
xnnz <= MIN(n^2, xjc1-*pxjc0). Thus
iwsize <= n*(2*n+1)+log_2(1+n*(n-1)/2).
OUTPUT
zir - length znnz int array, subscripts of z := vec(tril(x)+triu(x,1)').
zpr - length znnz vector, nonzeros of z.
WORK
cwork - length nnz(triu(X,1)) <= n*(n-1)/2 char array.
iwork - length iwsize integer working array
ypr - length xnnz vector; xnnz <= n^2.
RETURNS znnz
************************************************************ */
int sptotril(int *zir, double *zpr, const int *xir, const double *xpr,
int *pxjc0, const int xjc1, const int first, const int n,
const bool skew, int iwsize, char *cwork, int *iwork,
double *ypr)
{
int xjc0, xnnz, trilnnz, triujc0;
int *triujc, *yir;
/* ------------------------------------------------------------
Let iwork[0:n-2] point to row-starts for storing triu(X,1)
row-wise. Let xnnz be nnz(X). Update *pxjc0 to point beyond this
block
------------------------------------------------------------ */
xjc0 = *pxjc0;
xnnz = sptriujcT(iwork, xir, xjc0, xjc1, first, n);
*pxjc0 = xjc0 + xnnz;
/* ------------------------------------------------------------
Partition integer working array
------------------------------------------------------------ */
triujc = iwork;
yir = iwork + (n-1);
iwork = yir + xnnz;
iwsize -= n-1 + xnnz;
/* ------------------------------------------------------------
------------------------------------------------------------ */
if(n > 1)
triujc0 = triujc[0];
else
triujc0 = xnnz; /* 1 x 1 matrix --> triu(X)=[] */
trilnnz = sptrilandtriu(yir, ypr, triujc, xir,xpr,xjc0,xjc1, first,n, skew);
if(!skew)
return spadd(zir,zpr, yir,ypr, trilnnz, yir+triujc0,ypr+triujc0,
xnnz-triujc0, iwsize, cwork, iwork);
else
return spsub(zir,zpr, yir,ypr, trilnnz, yir+triujc0,ypr+triujc0,
xnnz-triujc0, iwsize, cwork, iwork);
}
/* ************************************************************
PROCEDURE precorrect - Apply corrections from affecting supernode
(skipping subnodes with non-positive diagonal) on supernodal
diagonal block in L-factor.
INPUT
ljc - start of columns in lpr.
d - Length neqns vector. The diagonal in L*diag(d)*L'. Only
d[firstk:nextk-1] will be used.
irInv - For row-indices Jir of affected supernode, Jir[m-irInv[i]] == i.
nextj - Last subnode of affected supernode is nextj-1.
firstk, nextk - subnodes of affecting supernode are firstk:nextk-1.
Kir - unfinished row indices of affecting supernode
mk - number of unfinished nonzeros in affecting supernode
fwsiz - Allocated length of fwork.
UPDATED
lpr - For each column k=firstk:nextk-1, and the affected columns j
in node, DO L(:,j) -= (ljk / lkk) * L(:,k),
and store the definitive j-th row of L, viz. ljk /= lkk.
WORKING ARRAYS
relind - length mk integer array
fwork - length fwsiz vector, for storing -Xk * inv(LABK) * Xk'.
RETURNS ncolup, number of columns updated by snode k.
if -1, then fwsiz is too small.
************************************************************ */
mwIndex precorrect(double *lpr, const mwIndex *ljc,const double *d, const mwIndex *irInv,
const mwIndex nextj, const mwIndex *Kir, const mwIndex mk,
const mwIndex firstk, const mwIndex nextk,
mwIndex *relind, const mwIndex fwsiz, double *fwork)
{
mwIndex i,j,k,ncolup,mj;
double *xj;
/* ------------------------------------------------------------
j = first subscript in k (== 1st affected column)
i = last subscript in k
ncolup = number of nz-rows in k corresponding to columns in node.
mj = number of nonzeros in l(:,j), the 1st affected column
------------------------------------------------------------ */
j = Kir[0];
i = Kir[mk-1];
if(i < nextj)
ncolup = mk;
else
for(ncolup = 1; Kir[ncolup] < nextj; ncolup++);
mj = ljc[j+1] - ljc[j];
/* ------------------------------------------------------------
If nz-structure of k is a single block in structure of node,
(i.e. irInv[Kir[0]] - irInv[Kir[mk-1]] == mk-1). The subnodes
of "node" must then be consecutive and at the start.
Thus, we use dense computations :
------------------------------------------------------------ */
if(irInv[j] - irInv[i] < mk){
xj = lpr + ljc[j];
for(k = firstk; k < nextk; k++)
if(d[k] > 0.0) /* Skip pivot when d[k] <= 0 */
suboutprod(xj, mj, ncolup, lpr + ljc[k+1] - mk, d[k], mk);
}
else{
/* ------------------------------------------------------------
Otherwise, the nz-indices of k are scattered within the structure of node.
Let relind be the position of these nz's in node, COUNTED FROM THE BOTTOM.
------------------------------------------------------------*/
for(i = 0; i < mk; i++)
relind[i] = irInv[Kir[i]];
/* ------------------------------------------------------------
If k is a single column, then perform update directly in lpr:
------------------------------------------------------------ */
if(nextk - firstk == 1){
if(d[firstk] > 0.0) /* Skip pivot when d[k] <= 0 */
spsuboutprod(ljc+j,lpr,mj, ncolup, lpr + ljc[nextk]-mk,
d[firstk],mk, relind);
}
else{
/* ------------------------------------------------------------
Multiple columns in affecting snode:
1. compute the complete modification, and store it in fwork:
fwork = -Xk * inv(LABK) * Xk'
------------------------------------------------------------ */
if(fwsiz + ncolup*(ncolup-1)/2 < mk * ncolup )
return (mwIndex)-1;
for(k = firstk; k < nextk; k++) /* find 1st positive diag */
if(d[k] > 0.0)
break;
if(k < nextk){ /* if any positive diag: */
isminoutprod(fwork, ncolup, lpr + ljc[k+1] - mk, d[k], mk);
for(++k; k < nextk; k++) /* remaining cols */
if(d[k] > 0.0) /* Skip pivot when d[k] <= 0 */
suboutprod(fwork, mk, ncolup, lpr + ljc[k+1] - mk, d[k], mk);
/* ------------------------------------------------------------
2. subtract fwork from the sparse columns of node, using relind.
------------------------------------------------------------ */
spadd(ljc+j,lpr,mj, ncolup, fwork,mk, relind);
} /* end exists positive diag */
} /* end multiple affecting cols */
} /* end of scattered case */
/* ------------------------------------------------------------
RETURN number of columns updated, i.e. #subnodes in k that we finished.
------------------------------------------------------------ */
return ncolup;
}