/*
---------------------------------
purpose -- for dense storage
*pnrow with mtx->nrow
*pncol with mtx->ncol
*pinc1 with row increment
*pinc2 with column increment
*pentries with mtx->entries
created -- 98may01, cca
---------------------------------
*/
void
SubMtx_denseInfo (
SubMtx *mtx,
int *pnrow,
int *pncol,
int *pinc1,
int *pinc2,
double **pentries
) {
double *dbuffer ;
int nint ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || pnrow == NULL || pncol == NULL
|| pinc1 == NULL || pinc2 == NULL || pentries == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_denseInfo(%p,%p,%p,%p,%p,%p)"
"\n bad input\n",
mtx, pnrow, pncol, pinc1, pinc2, pentries) ;
exit(-1) ;
}
if ( ! (SUBMTX_IS_REAL(mtx) || SUBMTX_IS_COMPLEX(mtx)) ) {
fprintf(stderr,
"\n fatal error in SubMtx_denseInfo(%p,%p,%p,%p,%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, pnrow, pncol, pinc1, pinc2, pentries, mtx->type) ;
exit(-1) ;
}
if ( ! (SUBMTX_IS_DENSE_ROWS(mtx) || SUBMTX_IS_DENSE_COLUMNS(mtx)) ) {
fprintf(stderr,
"\n fatal error in SubMtx_denseInfo(%p,%p,%p,%p,%p,%p)"
"\n bad mode %d"
"\n must be SUBMTX_DENSE_ROWS or SUBMTX_DENSE_COLUMNS\n",
mtx, pnrow, pncol, pinc1, pinc2, pentries, mtx->mode) ;
exit(-1) ;
}
*pnrow = mtx->nrow ;
*pncol = mtx->ncol ;
if ( SUBMTX_IS_DENSE_ROWS(mtx) ) {
*pinc1 = mtx->ncol ;
*pinc2 = 1 ;
} else {
*pinc1 = 1 ;
*pinc2 = mtx->nrow ;
}
dbuffer = mtx->wrkDV.vec ;
nint = 7 + mtx->nrow + mtx->ncol ;
if ( sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + (nint+1)/2 ;
}
return ; }
/*
-------------------------------------------------------------
purpose -- solve (A^H + I) X = B,
where
(1) X overwrites B
(2) A must be strict lower or upper triangular
(2) A, B and X are complex
(4) columns(A) = rows(X)
(5) rows(A) = rows(B)
(6) B has mode SUBMTX_DENSE_COLUMNS
(7) if A is SUBMTX_DENSE_SUBROWS or SUBMTX_SPARSE_ROWS
then A must be strict lower triangular
(8) if A is SUBMTX_DENSE_SUBCOLUMNS or SUBMTX_SPARSE_COLUMNS
then A must be strict upper triangular
created -- 98may01, cca
-------------------------------------------------------------
*/
void
SubMtx_solveH (
SubMtx *mtxA,
SubMtx *mtxB
) {
/*
---------------
check the input
---------------
*/
if ( mtxA == NULL || mtxB == NULL ) {
fprintf(stderr, "\n fatal error in SubMtx_solveH(%p,%p)"
"\n bad input\n", mtxA, mtxB) ;
spoolesFatal();
}
if ( ! SUBMTX_IS_COMPLEX(mtxB) ) {
fprintf(stderr, "\n fatal error in SubMtx_solveH(%p,%p)"
"\n mtxB has bad type %d\n", mtxA, mtxB, mtxB->type) ;
spoolesFatal();
}
if ( ! SUBMTX_IS_DENSE_COLUMNS(mtxB) ) {
fprintf(stderr, "\n fatal error in SubMtx_solveH(%p,%p)"
"\n mtxB has bad mode %d\n", mtxA, mtxB, mtxB->mode) ;
spoolesFatal();
}
if ( mtxA->nrow != mtxB->nrow ) {
fprintf(stderr, "\n fatal error in SubMtx_solveH(%p,%p)"
"\n mtxA->nrow = %d, mtxB->nrwo = %d\n",
mtxA, mtxB, mtxA->nrow, mtxB->nrow) ;
spoolesFatal();
}
/*
-------------------------
switch over the mode of A
-------------------------
*/
switch ( mtxA->mode ) {
case SUBMTX_DENSE_SUBROWS :
solveDenseSubrows(mtxA, mtxB) ;
break ;
case SUBMTX_SPARSE_ROWS :
solveSparseRows(mtxA, mtxB) ;
break ;
case SUBMTX_DENSE_SUBCOLUMNS :
solveDenseSubcolumns(mtxA, mtxB) ;
break ;
case SUBMTX_SPARSE_COLUMNS :
solveSparseColumns(mtxA, mtxB) ;
break ;
default :
fprintf(stderr, "\n fatal error in SubMtx_solveH(%p,%p)"
"\n bad mode %d\n", mtxA, mtxB, mtxA->mode) ;
spoolesFatal();
break ;
}
return ; }
/*
----------------------------------------------------------------
purpose -- for each U_{J,bnd{J}} matrix, remove from hash table,
split into their U_{J,K} submatrices and insert
into the hash table.
created -- 98may04, cca
----------------------------------------------------------------
*/
void
FrontMtx_splitUpperMatrices (
FrontMtx *frontmtx,
int msglvl,
FILE *msgFile
) {
SubMtx *mtxUJ, *mtxUJJ, *mtxUJK ;
SubMtxManager *manager ;
double *entUJ, *entUJK ;
int count, first, ii, inc1, inc2, jcol, jj, J, K, nbytes,
ncolJ, ncolUJ, ncolUJK, nentUJ, nentUJK, neqns, nfront,
nJ, nrowUJ, nrowUJK, offset, v ;
int *colindJ, *colindUJ, *colindUJK, *colmap, *indicesUJ,
*indicesUJK, *locmap, *rowindUJ, *rowindUJK, *sizesUJ,
*sizesUJK ;
I2Ohash *upperhash ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr,
"\n fatal error in FrontMtx_splitUpperMatrices(%p,%d,%p)"
"\n bad input\n", frontmtx, msglvl, msgFile) ;
spoolesFatal();
}
nfront = FrontMtx_nfront(frontmtx) ;
neqns = FrontMtx_neqns(frontmtx) ;
upperhash = frontmtx->upperhash ;
manager = frontmtx->manager ;
/*
-----------------------------------
construct the column and local maps
-----------------------------------
*/
colmap = IVinit(neqns, -1) ;
locmap = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
if ( ncolJ > 0 && colindJ != NULL ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
v = colindJ[ii] ;
colmap[v] = J ;
locmap[v] = ii ;
}
}
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n colmap[]") ;
IVfprintf(msgFile, neqns, colmap) ;
fprintf(msgFile, "\n\n locmap[]") ;
IVfprintf(msgFile, neqns, locmap) ;
fflush(msgFile) ;
}
/*
---------------------------------------------
move the U_{J,J} matrices into the hash table
---------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtxUJJ = FrontMtx_upperMtx(frontmtx, J, J)) != NULL ) {
I2Ohash_insert(frontmtx->upperhash, J, J, mtxUJJ) ;
}
}
/*
------------------------------------------------------------
now split the U_{J,bnd{J}} matrices into U_{J,K} matrices.
note: columns of U_{J,bnd{J}} are assumed to be in ascending
order with respect to the column ordering of the matrix.
------------------------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
mtxUJ = FrontMtx_upperMtx(frontmtx, J, nfront) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ### J = %d, mtxUJ = %p", J, mtxUJ) ;
fflush(msgFile) ;
}
if ( mtxUJ != NULL ) {
if ( msglvl > 2 ) {
SubMtx_writeForHumanEye(mtxUJ, msgFile) ;
fflush(msgFile) ;
}
SubMtx_columnIndices(mtxUJ, &ncolUJ, &colindUJ) ;
SubMtx_rowIndices(mtxUJ, &nrowUJ, &rowindUJ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n column indices for J") ;
IVfprintf(msgFile, ncolUJ, colindUJ) ;
fprintf(msgFile, "\n row indices for UJ") ;
IVfprintf(msgFile, nrowUJ, rowindUJ) ;
fflush(msgFile) ;
}
if ( (K = colmap[colindUJ[0]]) == colmap[colindUJ[ncolUJ-1]] ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front %d supports only %d", J, K) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------
U_{J,bnd{J}} is one submatrix, bnd{J} \subseteq K
set row and column indices and change column id
-------------------------------------------------
*/
IVramp(nrowUJ, rowindUJ, 0, 1) ;
for ( ii = 0 ; ii < ncolUJ ; ii++ ) {
colindUJ[ii] = locmap[colindUJ[ii]] ;
}
SubMtx_setFields(mtxUJ, mtxUJ->type, mtxUJ->mode, J, K,
mtxUJ->nrow, mtxUJ->ncol, mtxUJ->nent) ;
/*
mtxUJ->colid = K ;
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ## inserting U(%d,%d) ", J, K) ;
SubMtx_writeForHumanEye(mtxUJ, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(upperhash, J, K, (void *) mtxUJ) ;
} else {
/*
-----------------------------------
split U_{J,bnd{J}} into submatrices
-----------------------------------
*/
nJ = FrontMtx_frontSize(frontmtx, J) ;
if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
SubMtx_denseInfo(mtxUJ,
&nrowUJ, &ncolUJ, &inc1, &inc2, &entUJ) ;
} else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
SubMtx_sparseColumnsInfo(mtxUJ, &ncolUJ, &nentUJ,
&sizesUJ, &indicesUJ, &entUJ) ;
offset = 0 ;
count = sizesUJ[0] ;
}
first = 0 ;
K = colmap[colindUJ[0]] ;
for ( jcol = 1 ; jcol <= ncolUJ ; jcol++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n jcol = %d", jcol) ;
if ( jcol < ncolUJ ) {
fprintf(msgFile, ", colmap[%d] = %d",
colindUJ[jcol], colmap[colindUJ[jcol]]);
}
fflush(msgFile) ;
}
if ( jcol == ncolUJ || K != colmap[colindUJ[jcol]] ) {
ncolUJK = jcol - first ;
if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
nentUJK = nJ*ncolUJK ;
} else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
if ( count == 0 ) {
goto no_entries ;
}
nentUJK = count ;
}
nbytes = SubMtx_nbytesNeeded(mtxUJ->type, mtxUJ->mode,
nJ, ncolUJK, nentUJK) ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n ncolUJK %d, nentUJK %d, nbytes %d",
ncolUJK, nentUJK, nbytes) ;
fflush(msgFile) ;
}
mtxUJK = SubMtxManager_newObjectOfSizeNbytes(manager,
nbytes) ;
SubMtx_init(mtxUJK, mtxUJ->type, mtxUJ->mode, J, K,
nJ, ncolUJK, nentUJK) ;
if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
SubMtx_denseInfo(mtxUJK,
&nrowUJK, &ncolUJK, &inc1, &inc2, &entUJK) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentUJK, entUJK, entUJ + first*nJ) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentUJK, entUJK, entUJ + 2*first*nJ) ;
}
} else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
SubMtx_sparseColumnsInfo(mtxUJK, &ncolUJK, &nentUJK,
&sizesUJK, &indicesUJK, &entUJK) ;
IVcopy(ncolUJK, sizesUJK, sizesUJ + first) ;
IVcopy(nentUJK, indicesUJK, indicesUJ + offset) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentUJK, entUJK, entUJ + offset) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentUJK, entUJK, entUJ + 2*offset) ;
}
count = 0 ;
offset += nentUJK ;
}
/*
-------------------------------------
initialize the row and column indices
-------------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n setting row and column indices");
fflush(msgFile) ;
}
SubMtx_rowIndices(mtxUJK, &nrowUJK, &rowindUJK) ;
IVramp(nJ, rowindUJK, 0, 1) ;
SubMtx_columnIndices(mtxUJK, &ncolUJK, &colindUJK) ;
for ( ii = 0, jj = first ; ii < ncolUJK ; ii++, jj++ ) {
colindUJK[ii] = locmap[colindUJ[jj]] ;
}
/*
----------------------------------
insert U_{J,K} into the hash table
----------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n\n ## inserting U(%d,%d) ", J, K) ;
SubMtx_writeForHumanEye(mtxUJK, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(upperhash, J, K, (void *) mtxUJK) ;
/*
-----------------------------------
we jump to here if there were no
entries to be stored in the matrix.
-----------------------------------
*/
no_entries :
/*
----------------------------------------------------
reset first and K to new first location and front id
----------------------------------------------------
*/
first = jcol ;
if ( jcol < ncolUJ ) {
K = colmap[colindUJ[jcol]] ;
}
}
if ( jcol < ncolUJ && SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
count += sizesUJ[jcol] ;
}
}
/*
--------------------------------------------
give U_{J,bnd{J}} back to the matrix manager
--------------------------------------------
*/
SubMtxManager_releaseObject(manager, mtxUJ) ;
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(colmap) ;
IVfree(locmap) ;
return ; }