/*
------------------------------------
purpose -- compute any updates to BJ
created -- 98mar26, cca
------------------------------------
*/
static void
computeForwardUpdates (
FrontMtx *frontmtx,
SubMtx *BJ,
int J,
IP *heads[],
char frontIsDone[],
SubMtx *p_mtx[],
int msglvl,
FILE *msgFile
) {
SubMtx *LJI, *UIJ, *YI ;
int I ;
IP *ip, *nextip ;
/*
-------------------------------
loop over the remaining updates
-------------------------------
*/
for ( ip = heads[J], heads[J] = NULL ;
ip != NULL ;
ip = nextip ) {
I = ip->val ; nextip = ip->next ;
if ( msglvl > 3 ) {
fprintf(msgFile,
"\n\n frontIsDone[%d] = %c, p_mtx[%d] = %p",
I, frontIsDone[I], I, p_mtx[I]) ;
fflush(msgFile) ;
}
if ( frontIsDone[I] == 'Y' ) {
if ( (YI = p_mtx[I]) != NULL ) {
/*
--------------------------------
Y_I exists and has been computed
--------------------------------
*/
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n before solve: YI = %p", YI) ;
SubMtx_writeForHumanEye(YI, msgFile) ;
fflush(msgFile) ;
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
if ( (LJI = FrontMtx_lowerMtx(frontmtx, J, I)) != NULL ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n LJI = %p", LJI) ;
SubMtx_writeForHumanEye(LJI, msgFile) ;
fflush(msgFile) ;
}
SubMtx_solveupd(BJ, LJI, YI) ;
}
} else {
if ( (UIJ = FrontMtx_upperMtx(frontmtx, I, J)) != NULL ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n UIJ = %p", UIJ) ;
SubMtx_writeForHumanEye(UIJ, msgFile) ;
fflush(msgFile) ;
}
if ( FRONTMTX_IS_SYMMETRIC(frontmtx) ) {
SubMtx_solveupdT(BJ, UIJ, YI) ;
} else if ( FRONTMTX_IS_HERMITIAN(frontmtx) ) {
SubMtx_solveupdH(BJ, UIJ, YI) ;
}
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n after update: BJ = %p", BJ) ;
SubMtx_writeForHumanEye(BJ, msgFile) ;
fflush(msgFile) ;
}
}
} else {
/*
------------------------
Y_I is not yet available
------------------------
*/
ip->next = heads[J] ;
heads[J] = ip ;
}
}
return ; }
/*
----------------------------------------------------------------
purpose -- for each L_{bnd{J},J} matrix, remove from hash table,
split into their L_{K,J} submatrices and insert
into the hash table.
created -- 98may04, cca
----------------------------------------------------------------
*/
void
FrontMtx_splitLowerMatrices (
FrontMtx *frontmtx,
int msglvl,
FILE *msgFile
) {
SubMtx *mtxLJ, *mtxLJJ, *mtxLKJ ;
SubMtxManager *manager ;
double *entLJ, *entLKJ ;
int count, first, ii, inc1, inc2, irow, jj, J, K, nbytes,
ncolLJ, ncolLKJ, nentLJ, nentLKJ, neqns, nfront, nJ,
nrowJ, nrowLJ, nrowLKJ, offset, v ;
int *colindLJ, *colindLKJ, *rowmap, *indicesLJ, *indicesLKJ,
*locmap, *rowindJ, *rowindLJ, *rowindLKJ, *sizesLJ,
*sizesLKJ ;
I2Ohash *lowerhash ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr,
"\n fatal error in FrontMtx_splitLowerMatrices(%p,%d,%p)"
"\n bad input\n", frontmtx, msglvl, msgFile) ;
spoolesFatal();
}
nfront = FrontMtx_nfront(frontmtx) ;
neqns = FrontMtx_neqns(frontmtx) ;
lowerhash = frontmtx->lowerhash ;
manager = frontmtx->manager ;
/*
--------------------------------
construct the row and local maps
--------------------------------
*/
rowmap = IVinit(neqns, -1) ;
locmap = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_rowIndices(frontmtx, J, &nrowJ, &rowindJ) ;
if ( nrowJ > 0 && rowindJ != NULL ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
v = rowindJ[ii] ;
rowmap[v] = J ;
locmap[v] = ii ;
}
}
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n rowmap[]") ;
IVfprintf(msgFile, neqns, rowmap) ;
fprintf(msgFile, "\n\n locmap[]") ;
IVfprintf(msgFile, neqns, locmap) ;
fflush(msgFile) ;
}
/*
---------------------------------------------
move the L_{J,J} matrices into the hash table
---------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtxLJJ = FrontMtx_lowerMtx(frontmtx, J, J)) != NULL ) {
I2Ohash_insert(frontmtx->lowerhash, J, J, mtxLJJ) ;
}
}
/*
------------------------------------------------------------
now split the L_{bnd{J},J} matrices into L_{K,J} matrices.
note: columns of L_{bnd{J},J} are assumed to be in ascending
order with respect to the column ordering of the matrix.
------------------------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
mtxLJ = FrontMtx_lowerMtx(frontmtx, nfront, J) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ### J = %d, mtxLJ = %p", J, mtxLJ) ;
fflush(msgFile) ;
}
if ( mtxLJ != NULL ) {
if ( msglvl > 2 ) {
SubMtx_writeForHumanEye(mtxLJ, msgFile) ;
fflush(msgFile) ;
}
SubMtx_columnIndices(mtxLJ, &ncolLJ, &colindLJ) ;
SubMtx_rowIndices(mtxLJ, &nrowLJ, &rowindLJ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n column indices for J") ;
IVfprintf(msgFile, ncolLJ, colindLJ) ;
fprintf(msgFile, "\n row indices for LJ") ;
IVfprintf(msgFile, nrowLJ, rowindLJ) ;
fflush(msgFile) ;
}
if ( (K = rowmap[rowindLJ[0]]) == rowmap[rowindLJ[nrowLJ-1]] ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front %d supports only %d", J, K) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------
L_{bnd{J},J} is one submatrix, bnd{J} \subseteq K
set row and column indices and change column id
-------------------------------------------------
*/
IVramp(ncolLJ, colindLJ, 0, 1) ;
for ( ii = 0 ; ii < nrowLJ ; ii++ ) {
rowindLJ[ii] = locmap[rowindLJ[ii]] ;
}
/*
mtxLJ->rowid = K ;
*/
SubMtx_setFields(mtxLJ, mtxLJ->type, mtxLJ->mode, K, J,
mtxLJ->nrow, mtxLJ->ncol, mtxLJ->nent) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ## inserting L(%d,%d) ", K, J) ;
SubMtx_writeForHumanEye(mtxLJ, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(lowerhash, K, J, (void *) mtxLJ) ;
} else {
/*
-----------------------------------
split L_{bnd{J},J} into submatrices
-----------------------------------
*/
nJ = FrontMtx_frontSize(frontmtx, J) ;
if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
SubMtx_denseInfo(mtxLJ,
&nrowLJ, &ncolLJ, &inc1, &inc2, &entLJ) ;
} else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
SubMtx_sparseRowsInfo(mtxLJ, &nrowLJ, &nentLJ,
&sizesLJ, &indicesLJ, &entLJ) ;
offset = 0 ;
count = sizesLJ[0] ;
}
first = 0 ;
K = rowmap[rowindLJ[0]] ;
for ( irow = 1 ; irow <= nrowLJ ; irow++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n irow = %d", irow) ;
if ( irow < nrowLJ ) {
fprintf(msgFile, ", rowmap[%d] = %d",
rowindLJ[irow], rowmap[rowindLJ[irow]]);
}
fflush(msgFile) ;
}
if ( irow == nrowLJ || K != rowmap[rowindLJ[irow]] ) {
nrowLKJ = irow - first ;
if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
nentLKJ = nJ*nrowLKJ ;
} else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
if ( count == 0 ) {
goto no_entries ;
}
nentLKJ = count ;
}
nbytes = SubMtx_nbytesNeeded(mtxLJ->type, mtxLJ->mode,
nrowLKJ, nJ, nentLKJ) ;
mtxLKJ = SubMtxManager_newObjectOfSizeNbytes(manager,
nbytes) ;
SubMtx_init(mtxLKJ, mtxLJ->type, mtxLJ->mode, K, J,
nrowLKJ, nJ, nentLKJ) ;
if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
SubMtx_denseInfo(mtxLKJ,
&nrowLKJ, &ncolLKJ, &inc1, &inc2, &entLKJ) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentLKJ, entLKJ, entLJ + first*nJ) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentLKJ, entLKJ, entLJ + 2*first*nJ) ;
}
} else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
SubMtx_sparseRowsInfo(mtxLKJ, &nrowLKJ, &nentLKJ,
&sizesLKJ, &indicesLKJ, &entLKJ) ;
IVcopy(nrowLKJ, sizesLKJ, sizesLJ + first) ;
IVcopy(nentLKJ, indicesLKJ, indicesLJ + offset) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentLKJ, entLKJ, entLJ + offset) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentLKJ, entLKJ, entLJ + 2*offset) ;
}
count = 0 ;
offset += nentLKJ ;
}
/*
-------------------------------------
initialize the row and column indices
-------------------------------------
*/
SubMtx_rowIndices(mtxLKJ, &nrowLKJ, &rowindLKJ) ;
for ( ii = 0, jj = first ; ii < nrowLKJ ; ii++, jj++ ) {
rowindLKJ[ii] = locmap[rowindLJ[jj]] ;
}
SubMtx_columnIndices(mtxLKJ, &ncolLKJ, &colindLKJ) ;
IVramp(ncolLKJ, colindLKJ, 0, 1) ;
/*
----------------------------------
insert L_{K,J} into the hash table
----------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n\n ## inserting L(%d,%d) ", K, J) ;
SubMtx_writeForHumanEye(mtxLKJ, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(lowerhash, K, J, (void *) mtxLKJ) ;
/*
-----------------------------------
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 = irow ;
if ( irow < nrowLJ ) {
K = rowmap[rowindLJ[irow]] ;
}
}
if ( irow < nrowLJ && SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
count += sizesLJ[irow] ;
}
}
/*
--------------------------------------------
give L_{bnd{J},J} back to the matrix manager
--------------------------------------------
*/
SubMtxManager_releaseObject(manager, mtxLJ) ;
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(rowmap) ;
IVfree(locmap) ;
return ; }
/*
--------------------------------------
visit front J during the forward solve
created -- 98mar27, cca
--------------------------------------
*/
void
FrontMtx_forwardVisit (
FrontMtx *frontmtx,
int J,
int nrhs,
int *owners,
int myid,
SubMtxManager *mtxmanager,
SubMtxList *aggList,
SubMtx *p_mtx[],
char frontIsDone[],
IP *heads[],
SubMtx *p_agg[],
char status[],
int msglvl,
FILE *msgFile
) {
char aggDone, updDone ;
SubMtx *BJ, *LJJ, *UJJ ;
int nJ ;
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) == 0 ) {
/*
-----------------------------------------------------
front has no eliminated rows or columns, quick return
-----------------------------------------------------
*/
if ( owners == NULL || owners[J] == myid ) {
frontIsDone[J] = 'Y' ;
}
status[J] = 'F' ;
return ;
}
if ( heads[J] != NULL ) {
/*
-------------------------------------
there are internal updates to perform
-------------------------------------
*/
if ( (BJ = p_agg[J]) == NULL ) {
/*
---------------------------
create the aggregate object
---------------------------
*/
BJ = p_agg[J] = initBJ(frontmtx->type, J, nJ, nrhs,
mtxmanager, msglvl, msgFile) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n BJ = %p", BJ) ;
fflush(msgFile) ;
SubMtx_writeForHumanEye(BJ, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------
compute any waiting updates
---------------------------
*/
computeForwardUpdates(frontmtx, BJ, J, heads, frontIsDone, p_mtx,
msglvl, msgFile) ;
}
if ( heads[J] == NULL ) {
updDone = 'Y' ;
} else {
updDone = 'N' ;
}
if ( aggList != NULL && owners[J] == myid ) {
/*
-----------------------
assemble any aggregates
-----------------------
*/
aggDone = 'N' ;
if ( (BJ = p_agg[J]) == NULL ) {
fprintf(stderr,
"\n 2. fatal error in forwardVisit(%d), BJ = NULL", J) ;
exit(-1) ;
}
assembleAggregates(J, BJ, aggList, mtxmanager,
msglvl, msgFile) ;
if ( SubMtxList_isCountZero(aggList, J) == 1 ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n aggregate count is zero") ;
fflush(msgFile) ;
}
assembleAggregates(J, BJ, aggList, mtxmanager,
msglvl, msgFile) ;
aggDone = 'Y' ;
}
} else {
aggDone = 'Y' ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n updDone = %c, aggDone = %c",
updDone, aggDone) ;
fflush(msgFile) ;
}
if ( updDone == 'Y' && aggDone == 'Y' ) {
BJ = p_agg[J] ;
if ( owners == NULL || owners[J] == myid ) {
/*
-------------------------------------
owned front, ready for interior solve
-------------------------------------
*/
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
LJJ = FrontMtx_lowerMtx(frontmtx, J, J) ;
if ( LJJ != NULL ) {
SubMtx_solve(LJJ, BJ) ;
}
} else {
UJJ = FrontMtx_upperMtx(frontmtx, J, J) ;
if ( UJJ != NULL ) {
if ( FRONTMTX_IS_SYMMETRIC(frontmtx) ) {
SubMtx_solveT(UJJ, BJ) ;
} else if ( FRONTMTX_IS_HERMITIAN(frontmtx) ) {
SubMtx_solveH(UJJ, BJ) ;
}
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n after forward solve") ;
SubMtx_writeForHumanEye(BJ, msgFile) ;
fflush(msgFile) ;
}
/*
------------------------------------------------
move YJ (stored in BJ) into p_mtx[],
signal front as done, and set status to finished
------------------------------------------------
*/
p_agg[J] = NULL ;
p_mtx[J] = BJ ;
frontIsDone[J] = 'Y' ;
} else if ( BJ != NULL ) {
/*
--------------------------------------
unowned front, put into aggregate list
--------------------------------------
*/
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n putting BJ into aggregate list") ;
fflush(msgFile) ;
}
SubMtxList_addObjectToList(aggList, BJ, J) ;
p_agg[J] = NULL ;
}
status[J] = 'F' ;
}
return ; }
/*
--------------------------------------------------
clear the data fields, releasing allocated storage
created -- 98may04, cca
--------------------------------------------------
*/
void
FrontMtx_clearData (
FrontMtx *frontmtx
) {
SubMtx *mtx ;
int ii, J, K, nadj, nfront ;
int *adj ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL ) {
fprintf(stderr, "\n fatal error in FrontMtx_clearData(%p)"
"\n bad input\n", frontmtx) ;
exit(-1) ;
}
nfront = frontmtx->nfront ;
/*
----------------------
free the owned storage
----------------------
*/
if ( frontmtx->frontsizesIV != NULL ) {
IV_free(frontmtx->frontsizesIV) ;
}
if ( frontmtx->rowadjIVL != NULL ) {
IVL_free(frontmtx->rowadjIVL) ;
}
if ( frontmtx->coladjIVL != NULL ) {
IVL_free(frontmtx->coladjIVL) ;
}
if ( frontmtx->p_mtxDJJ != NULL ) {
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtx = frontmtx->p_mtxDJJ[J]) != NULL ) {
SubMtx_free(mtx) ;
}
}
FREE(frontmtx->p_mtxDJJ) ;
}
if ( frontmtx->tree != NULL ) {
if ( frontmtx->frontETree == NULL
|| frontmtx->frontETree->tree != frontmtx->tree ) {
Tree_free(frontmtx->tree) ;
}
frontmtx->tree = NULL ;
}
if ( frontmtx->dataMode == FRONTMTX_1D_MODE ) {
if ( frontmtx->p_mtxUJJ != NULL ) {
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtx = frontmtx->p_mtxUJJ[J]) != NULL ) {
SubMtx_free(mtx) ;
}
}
FREE(frontmtx->p_mtxUJJ) ;
}
if ( frontmtx->p_mtxUJN != NULL ) {
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtx = frontmtx->p_mtxUJN[J]) != NULL ) {
SubMtx_free(mtx) ;
}
}
FREE(frontmtx->p_mtxUJN) ;
}
if ( frontmtx->p_mtxLJJ != NULL ) {
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtx = frontmtx->p_mtxLJJ[J]) != NULL ) {
SubMtx_free(mtx) ;
}
}
FREE(frontmtx->p_mtxLJJ) ;
}
if ( frontmtx->p_mtxLNJ != NULL ) {
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtx = frontmtx->p_mtxLNJ[J]) != NULL ) {
SubMtx_free(mtx) ;
}
}
FREE(frontmtx->p_mtxLNJ) ;
}
} else if ( frontmtx->dataMode == FRONTMTX_2D_MODE ) {
for ( J = 0 ; J < nfront ; J++ ) {
FrontMtx_upperAdjFronts(frontmtx, J, &nadj, &adj) ;
for ( ii = 0 ; ii < nadj ; ii++ ) {
K = adj[ii] ;
if ( (mtx = FrontMtx_upperMtx(frontmtx, J, K)) != NULL ) {
SubMtx_free(mtx) ;
}
}
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
for ( J = 0 ; J < nfront ; J++ ) {
FrontMtx_lowerAdjFronts(frontmtx, J, &nadj, &adj) ;
for ( ii = 0 ; ii < nadj ; ii++ ) {
K = adj[ii] ;
if ( (mtx = FrontMtx_lowerMtx(frontmtx, K, J)) != NULL ) {
SubMtx_free(mtx) ;
}
}
}
}
if ( frontmtx->lowerblockIVL != NULL ) {
IVL_free(frontmtx->lowerblockIVL) ;
}
if ( frontmtx->upperblockIVL != NULL ) {
IVL_free(frontmtx->upperblockIVL) ;
}
if ( frontmtx->lowerhash != NULL ) {
I2Ohash_free(frontmtx->lowerhash) ;
}
if ( frontmtx->upperhash != NULL ) {
I2Ohash_free(frontmtx->upperhash) ;
}
}
if ( frontmtx->lock != NULL ) {
/*
-------------------------
destroy and free the lock
-------------------------
*/
Lock_free(frontmtx->lock) ;
}
/*
----------------------
set the default fields
----------------------
*/
FrontMtx_setDefaultFields(frontmtx) ;
return ; }
