void SubMtx_fillRowZV (int irow)
{
double *rowvec = ZV_entries ();
double *entries;
int ii, ipivot, jrow, kk, m;
int *pivotsizes;
SubMtx_blockDiagonalInfo (&pivotsizes);
for (jrow = ipivot = kk = 0; jrow <= irow; ipivot++)
{
m = pivotsizes[ipivot];
if (jrow <= irow && irow < jrow + m)
for (ii = jrow; ii < irow; ii++)
{
rowvec[2*ii] = entries[2*kk];
rowvec[2*ii+1] = entries[2*kk+1];
}
jrow += m;
}
}
/*
-------------------------------------------------------
purpose -- to find matrix entry (irow,jcol) if present.
return value --
if entry (irow,jcol) is not present then
*pReal and *pImag are 0.0
return value is -1
else entry (irow,jcol) is present then
(*pReal,*pImag) is the matrix entry
return value is offset into entries array
endif
created -- 98may01, cca
-------------------------------------------------------
*/
int
SubMtx_complexEntry (
SubMtx *mtx,
int irow,
int jcol,
double *pReal,
double *pImag
) {
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || irow < 0 || irow >= mtx->nrow || jcol < 0
|| jcol >= mtx->ncol || pReal == NULL || pImag == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_complexEntry(%p,%d,%d,%p,%p)"
"\n bad input\n", mtx, irow, jcol, pReal, pImag) ;
exit(-1) ;
}
if ( ! SUBMTX_IS_COMPLEX(mtx) ) {
fprintf(stderr,
"\n fatal error in SubMtx_complexEntry(%p,%d,%d,%p,%p)"
"\n bad type %d, must be SPOOLES_COMPLEX\n",
mtx, irow, jcol, pReal, pImag, mtx->type) ;
exit(-1) ;
}
*pReal = *pImag = 0 ;
switch ( mtx->mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS : {
double *entries ;
int inc1, inc2, ncol, nrow, offset ;
SubMtx_denseInfo(mtx, &nrow, &ncol, &inc1, &inc2, &entries) ;
if ( irow < 0 || irow >= nrow || jcol < 0 || jcol >= ncol ) {
return(-1) ;
}
offset = irow*inc1 + jcol*inc2 ;
*pReal = entries[2*offset] ;
*pImag = entries[2*offset+1] ;
return(offset) ;
} break ;
case SUBMTX_SPARSE_ROWS : {
double *entries ;
int ii, jj, nent, nrow, offset, *indices, *sizes ;
SubMtx_sparseRowsInfo(mtx, &nrow, &nent, &sizes, &indices, &entries) ;
if ( irow < 0 || irow >= nrow ) {
return(-1) ;
}
for ( ii = offset = 0 ; ii < irow ; ii++ ) {
offset += sizes[ii] ;
}
for ( ii = 0, jj = offset ; ii < sizes[irow] ; ii++, jj++ ) {
if ( indices[jj] == jcol ) {
*pReal = entries[2*jj] ;
*pImag = entries[2*jj+1] ;
return(jj) ;
}
}
return(-1) ;
} break ;
case SUBMTX_SPARSE_COLUMNS : {
double *entries ;
int ii, jj, nent, ncol, offset, *indices, *sizes ;
SubMtx_sparseColumnsInfo(mtx, &ncol, &nent,
&sizes, &indices, &entries) ;
if ( jcol < 0 || jcol >= ncol ) {
return(-1) ;
}
for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
offset += sizes[ii] ;
}
for ( ii = 0, jj = offset ; ii < sizes[jcol] ; ii++, jj++ ) {
if ( indices[jj] == irow ) {
*pReal = entries[2*jj] ;
*pImag = entries[2*jj+1] ;
return(jj) ;
}
}
return(-1) ;
} break ;
case SUBMTX_SPARSE_TRIPLES : {
double *entries ;
int ii, nent, *colids, *rowids ;
SubMtx_sparseTriplesInfo(mtx, &nent, &rowids, &colids, &entries) ;
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( irow == rowids[ii] && jcol == colids[ii] ) {
*pReal = entries[2*ii] ;
*pImag = entries[2*ii+1] ;
return(ii) ;
}
}
return(-1) ;
} break ;
case SUBMTX_DENSE_SUBROWS : {
double *entries ;
int ii, joff, nent, nrow, offset, *firstlocs, *sizes ;
SubMtx_denseSubrowsInfo(mtx, &nrow, &nent,
&firstlocs, &sizes, &entries) ;
if ( irow < 0 || irow >= nrow || sizes[irow] == 0 ) {
return(-1) ;
}
for ( ii = offset = 0 ; ii < irow ; ii++ ) {
offset += sizes[ii] ;
}
if ( 0 <= (joff = jcol - firstlocs[irow]) && joff < sizes[irow] ) {
offset += joff ;
*pReal = entries[2*offset] ;
*pImag = entries[2*offset+1] ;
return(offset) ;
}
return(-1) ;
} break ;
case SUBMTX_DENSE_SUBCOLUMNS : {
double *entries ;
int ii, ioff, nent, ncol, offset, *firstlocs, *sizes ;
SubMtx_denseSubcolumnsInfo(mtx, &ncol, &nent,
&firstlocs, &sizes, &entries) ;
if ( jcol < 0 || jcol >= ncol || sizes[jcol] == 0 ) {
return(-1) ;
}
for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
offset += sizes[ii] ;
}
if ( 0 <= (ioff = irow - firstlocs[jcol]) && ioff < sizes[jcol] ) {
offset += ioff ;
*pReal = entries[2*offset] ;
*pImag = entries[2*offset+1] ;
return(offset) ;
}
return(-1) ;
} break ;
case SUBMTX_DIAGONAL : {
double *entries ;
int ncol ;
if ( irow < 0 || jcol < 0 || irow != jcol ) {
return(-1) ;
}
SubMtx_diagonalInfo(mtx, &ncol, &entries) ;
if ( irow >= ncol || jcol >= ncol ) {
return(-1) ;
}
*pReal = entries[2*irow] ;
*pImag = entries[2*irow+1] ;
return(irow) ;
} break ;
case SUBMTX_BLOCK_DIAGONAL_SYM : {
double *entries ;
int ii, ipivot, jrow, kk, m, ncol, nent, size ;
int *pivotsizes ;
if ( irow < 0 || jcol < 0 ) {
return(-1) ;
}
if ( irow > jcol ) {
ii = irow ;
irow = jcol ;
jcol = ii ;
}
SubMtx_blockDiagonalInfo(mtx, &ncol, &nent, &pivotsizes, &entries) ;
if ( irow >= ncol || jcol >= ncol ) {
return(-1) ;
}
for ( jrow = ipivot = kk = 0 ; jrow <= irow ; ipivot++ ) {
size = m = pivotsizes[ipivot] ;
for ( ii = 0 ; ii < m ; ii++, jrow++ ) {
if ( jrow == irow ) {
if ( jcol - irow > m - ii - 1 ) {
return(-1) ;
} else {
kk += jcol - irow ;
*pReal = entries[2*kk] ;
*pImag = entries[2*kk+1] ;
return(kk) ;
}
} else {
kk += size-- ;
}
}
}
return(kk) ;
} break ;
case SUBMTX_BLOCK_DIAGONAL_HERM : {
double sign ;
double *entries ;
int ii, ipivot, jrow, kk, m, ncol, nent, size ;
int *pivotsizes ;
if ( irow < 0 || jcol < 0 ) {
return(-1) ;
}
if ( irow > jcol ) {
ii = irow ;
irow = jcol ;
jcol = ii ;
sign = -1.0 ;
} else {
sign = 1.0 ;
}
SubMtx_blockDiagonalInfo(mtx, &ncol, &nent, &pivotsizes, &entries) ;
if ( irow >= ncol || jcol >= ncol ) {
return(-1) ;
}
for ( jrow = ipivot = kk = 0 ; jrow <= irow ; ipivot++ ) {
size = m = pivotsizes[ipivot] ;
for ( ii = 0 ; ii < m ; ii++, jrow++ ) {
if ( jrow == irow ) {
if ( jcol - irow > m - ii - 1 ) {
return(-1) ;
} else {
kk += jcol - irow ;
*pReal = entries[2*kk] ;
*pImag = sign*entries[2*kk+1] ;
return(kk) ;
}
} else {
kk += size-- ;
}
}
}
return(kk) ;
} break ;
default :
fprintf(stderr,
"\n fatal error in SubMtx_complexEntry(%p,%d,%d,%p,%p)"
"\n bad mode %d", mtx, irow, jcol, pReal, pImag, mtx->mode) ;
exit(-1) ;
break ;
}
return(-1) ; }
/*
-------------------------------------------------------------
compute the inertia of a symmetric matrix
fill *pnnegative with the number of negative eigenvalues of A
fill *pnzero with the number of zero eigenvalues of A
fill *pnpositive with the number of positive eigenvalues of A
created -- 98may04, cca
-------------------------------------------------------------
*/
void
FrontMtx_inertia (
FrontMtx *frontmtx,
int *pnnegative,
int *pnzero,
int *pnpositive
) {
SubMtx *mtx ;
double arm, areal, bimag, breal, creal, mid, val ;
double *entries ;
int ii, ipivot, irow, J, nent, nfront, nJ,
nnegative, npositive, nzero ;
int *pivotsizes ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL
|| pnnegative == NULL || pnzero == NULL || pnpositive == NULL ) {
fprintf(stderr, "\n fatal error in FrontMtx_inertia(%p,%p,%p,%p)"
"\n bad input\n",
frontmtx, pnnegative, pnzero, pnpositive) ;
fflush(stdout) ;
}
if ( FRONTMTX_IS_REAL(frontmtx) && ! FRONTMTX_IS_SYMMETRIC(frontmtx) ) {
fprintf(stderr, "\n fatal error in FrontMtx_inertia(%p,%p,%p,%p)"
"\n matrix is real and not symmetric \n",
frontmtx, pnnegative, pnzero, pnpositive) ;
fflush(stdout) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx)
&& ! FRONTMTX_IS_HERMITIAN(frontmtx) ) {
fprintf(stderr, "\n fatal error in FrontMtx_inertia(%p,%p,%p,%p)"
"\n matrix is complex and not hermitian \n",
frontmtx, pnnegative, pnzero, pnpositive) ;
fflush(stdout) ;
}
nfront = frontmtx->nfront ;
nnegative = nzero = npositive = 0 ;
for ( J = 0 ; J < nfront ; J++ ) {
mtx = FrontMtx_diagMtx(frontmtx, J) ;
if ( mtx != NULL ) {
if ( ! FRONTMTX_IS_PIVOTING(frontmtx) ) {
/*
-----------
no pivoting
-----------
*/
SubMtx_diagonalInfo(mtx, &nJ, &entries) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
if ( entries[ii] < 0.0 ) {
nnegative++ ;
} else if ( entries[ii] > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
}
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
if ( entries[2*ii] < 0.0 ) {
nnegative++ ;
} else if ( entries[2*ii] > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
}
}
} else {
/*
--------
pivoting
--------
*/
SubMtx_blockDiagonalInfo(mtx, &nJ, &nent,
&pivotsizes, &entries) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
for ( irow = ipivot = ii = 0 ; irow < nJ ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
val = entries[ii] ;
if ( val < 0.0 ) {
nnegative++ ;
} else if ( val > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
irow++ ;
ii++ ;
} else {
areal = entries[ii] ;
breal = entries[ii+1] ;
creal = entries[ii+2] ;
mid = 0.5*(areal + creal) ;
arm = sqrt(0.25*(areal - creal)*(areal - creal)
+ breal*breal) ;
val = mid + arm ;
if ( val < 0.0 ) {
nnegative++ ;
} else if ( val > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
val = mid - arm ;
if ( val < 0.0 ) {
nnegative++ ;
} else if ( val > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
irow += 2 ;
ii += 3 ;
}
}
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
for ( irow = ipivot = ii = 0 ; irow < nJ ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
val = entries[2*ii] ;
if ( val < 0.0 ) {
nnegative++ ;
} else if ( val > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
irow++ ;
ii++ ;
} else {
areal = entries[2*ii] ;
breal = entries[2*ii+2] ;
bimag = entries[2*ii+3] ;
creal = entries[2*ii+4] ;
mid = 0.5*(areal + creal) ;
arm = sqrt(0.25*(areal - creal)*(areal - creal)
+ breal*breal + bimag*bimag) ;
val = mid + arm ;
if ( val < 0.0 ) {
nnegative++ ;
} else if ( val > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
val = mid - arm ;
if ( val < 0.0 ) {
nnegative++ ;
} else if ( val > 0.0 ) {
npositive++ ;
} else {
nzero++ ;
}
irow += 2 ;
ii += 3 ;
}
}
}
}
}
}
*pnnegative = nnegative ;
*pnzero = nzero ;
*pnpositive = npositive ;
return ;
}
/*
-------------------------------------------------
purpose -- to return a pointer to the location of
matrix entry (irow,jcol) if present.
if entry (irow,jcol) is not present then
*ppValue is NULL
else entry (irow,jcol) is present then
*ppValue is the location of the matrix entry
endif
created -- 98may01, cca
-------------------------------------------------
*/
void
SubMtx_locationOfRealEntry (
SubMtx *mtx,
int irow,
int jcol,
double **ppValue
) {
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || irow < 0 || irow >= mtx->nrow || jcol < 0
|| jcol >= mtx->ncol || ppValue == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_locationOfRealEntry(%p,%d,%d,%p)"
"\n bad input\n", mtx, irow, jcol, ppValue) ;
exit(-1) ;
}
if ( ! SUBMTX_IS_REAL(mtx) ) {
fprintf(stderr,
"\n fatal error in SubMtx_locationOfRealEntry(%p,%d,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL\n",
mtx, irow, jcol, ppValue, mtx->type) ;
exit(-1) ;
}
*ppValue = NULL ;
switch ( mtx->mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS : {
double *entries ;
int inc1, inc2, ncol, nrow, offset ;
SubMtx_denseInfo(mtx, &nrow, &ncol, &inc1, &inc2, &entries) ;
if ( irow >= 0 && irow < nrow && jcol >= 0 && jcol < ncol ) {
offset = irow*inc1 + jcol*inc2 ;
*ppValue = entries + offset ;
}
} break ;
case SUBMTX_SPARSE_ROWS : {
double *entries ;
int ii, jj, nent, nrow, offset, *indices, *sizes ;
SubMtx_sparseRowsInfo(mtx, &nrow, &nent, &sizes, &indices, &entries);
if ( irow >= 0 && irow < nrow ) {
for ( ii = offset = 0 ; ii < irow ; ii++ ) {
offset += sizes[ii] ;
}
for ( ii = 0, jj = offset ; ii < sizes[irow] ; ii++, jj++ ) {
if ( indices[jj] == jcol ) {
*ppValue = entries + jj ;
break ;
}
}
}
} break ;
case SUBMTX_SPARSE_COLUMNS : {
double *entries ;
int ii, jj, nent, ncol, offset, *indices, *sizes ;
SubMtx_sparseColumnsInfo(mtx, &ncol, &nent,
&sizes, &indices, &entries) ;
if ( jcol >= 0 && jcol < ncol ) {
for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
offset += sizes[ii] ;
}
for ( ii = 0, jj = offset ; ii < sizes[jcol] ; ii++, jj++ ) {
if ( indices[jj] == irow ) {
*ppValue = entries + jj ;
break ;
}
}
}
} break ;
case SUBMTX_SPARSE_TRIPLES : {
double *entries ;
int ii, nent, *colids, *rowids ;
SubMtx_sparseTriplesInfo(mtx, &nent, &rowids, &colids, &entries) ;
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( irow == rowids[ii] && jcol == colids[ii] ) {
*ppValue = entries + ii ;
break ;
}
}
} break ;
case SUBMTX_DENSE_SUBROWS : {
double *entries ;
int ii, joff, nent, nrow, offset, *firstlocs, *sizes ;
SubMtx_denseSubrowsInfo(mtx, &nrow, &nent,
&firstlocs, &sizes, &entries) ;
if ( irow >= 0 && irow < nrow && sizes[irow] != 0 ) {
for ( ii = offset = 0 ; ii < irow ; ii++ ) {
offset += sizes[ii] ;
}
if ( 0 <= (joff = jcol - firstlocs[irow])
&& joff < sizes[irow] ) {
offset += joff ;
*ppValue = entries + offset ;
break ;
}
}
} break ;
case SUBMTX_DENSE_SUBCOLUMNS : {
double *entries ;
int ii, ioff, nent, ncol, offset, *firstlocs, *sizes ;
SubMtx_denseSubcolumnsInfo(mtx, &ncol, &nent,
&firstlocs, &sizes, &entries) ;
if ( jcol >= 0 && jcol < ncol && sizes[jcol] != 0 ) {
for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
offset += sizes[jcol] ;
}
if ( 0 <= (ioff = irow - firstlocs[jcol])
&& ioff < sizes[jcol] ) {
offset += ioff ;
*ppValue = entries + offset ;
break ;
}
}
} break ;
case SUBMTX_DIAGONAL : {
double *entries ;
int ncol ;
if ( irow >= 0 && jcol >= 0 && irow == jcol ) {
SubMtx_diagonalInfo(mtx, &ncol, &entries) ;
if ( irow < ncol && jcol < ncol ) {
*ppValue = entries + irow ;
}
}
} break ;
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM : {
double *entries ;
int ii, ipivot, jrow, kk, m, ncol, nent, size ;
int *pivotsizes ;
if ( irow >= 0 && jcol >= 0 ) {
SubMtx_blockDiagonalInfo(mtx, &ncol, &nent,
&pivotsizes, &entries) ;
if ( irow < ncol && jcol < ncol ) {
for ( jrow = ipivot = kk = 0 ; jrow <= irow ; ipivot++ ) {
size = m = pivotsizes[ipivot] ;
for ( ii = 0 ; ii < m ; ii++, jrow++ ) {
if ( jrow == irow ) {
if ( jrow - irow > m - ii ) {
kk = -1 ;
} else {
kk += jrow - irow ;
}
} else {
kk += size-- ;
}
}
}
if ( kk != -1 ) {
*ppValue = entries + kk ;
}
}
}
} break ;
default :
fprintf(stderr,
"\n fatal error in SubMtx_locationOfRealEntry(%p,%d,%d,%p)"
"\n bad mode %d", mtx, irow, jcol, ppValue, mtx->mode) ;
exit(-1) ;
break ;
}
return ; }