/*
-----------------------------------------------------------
purpose -- for dense subrows, fill
*pnrow with # of rows
*pnent with # of matrix entries
*pfirstlocs with firstlocs[nrow], column of first nonzero
*psizes with sizes[nrow], number of nonzero columns
*pentries with entries[nent], matrix entries
created -- 98may01, cca
-----------------------------------------------------------
*/
void
SubMtx_denseSubrowsInfo (
SubMtx *mtx,
int *pnrow,
int *pnent,
int **pfirstlocs,
int **psizes,
double **pentries
) {
double *dbuffer ;
int nint ;
int *ibuffer ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || pnrow == NULL || pnent == NULL
|| pfirstlocs == NULL || psizes == NULL || pentries == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_denseSubrowsInfo(%p,%p,%p,%p,%p,%p)"
"\n bad input\n",
mtx, pnrow, pnent, pfirstlocs, psizes, pentries) ;
if ( mtx != NULL ) {
SubMtx_writeForHumanEye(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (SUBMTX_IS_REAL(mtx) || SUBMTX_IS_COMPLEX(mtx)) ) {
fprintf(stderr,
"\n fatal error in SubMtx_denseSubrowsInfo(%p,%p,%p,%p,%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, pnrow, pnent, pfirstlocs, psizes, pentries, mtx->type) ;
exit(-1) ;
}
if ( ! SUBMTX_IS_DENSE_SUBROWS(mtx) ) {
fprintf(stderr,
"\n fatal error in SubMtx_denseSubrowsInfo(%p,%p,%p,%p,%p,%p)"
"\n bad mode %d"
"\n must be SUBMTX_DENSE_SUBROWS\n",
mtx, pnrow, pnent, pfirstlocs, psizes, pentries, mtx->mode) ;
exit(-1) ;
}
*pnrow = mtx->nrow ;
*pnent = mtx->nent ;
dbuffer = mtx->wrkDV.vec ;
ibuffer = (int *) dbuffer ;
nint = 7 + mtx->nrow + mtx->ncol ;
*pfirstlocs = ibuffer + nint ;
nint += mtx->nrow ;
*psizes = ibuffer + nint ;
nint += mtx->nrow ;
if ( sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + (nint+1)/2 ;
}
return ; }
/*
---------------------------------
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 -- for sparse columns, fill
*pncol with # of columns
*pnent with # of matrix entries
*psizes with sizes[ncol], column sizes
*pindices with indices[nent], matrix row ids
*pentries with entries[nent], matrix entries
created -- 98may01, cca
----------------------------------------------
*/
void
SubMtx_sparseColumnsInfo (
SubMtx *mtx,
int *pncol,
int *pnent,
int **psizes,
int **pindices,
double **pentries
) {
double *dbuffer ;
int nint ;
int *ibuffer ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || pncol == NULL || pnent == NULL
|| psizes == NULL || pindices == NULL || pentries == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_sparseColumnsInfo(%p,%p,%p,%p,%p,%p)"
"\n bad input\n",
mtx, pncol, pnent, psizes, pindices, pentries) ;
exit(-1) ;
}
if ( ! (SUBMTX_IS_REAL(mtx) || SUBMTX_IS_COMPLEX(mtx)) ) {
fprintf(stderr,
"\n fatal error in SubMtx_sparseColumnsInfo(%p,%p,%p,%p,%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, pncol, pnent, psizes, pindices, pentries, mtx->type) ;
exit(-1) ;
}
if ( ! SUBMTX_IS_SPARSE_COLUMNS(mtx) ) {
fprintf(stderr,
"\n fatal error in SubMtx_sparseColumnsInfo(%p,%p,%p,%p,%p,%p)"
"\n bad mode %d"
"\n must be SUBMTX_SPARSE_COLUMNS\n",
mtx, pncol, pnent, psizes, pindices, pentries, mtx->mode) ;
exit(-1) ;
}
*pncol = mtx->ncol ;
*pnent = mtx->nent ;
dbuffer = mtx->wrkDV.vec ;
ibuffer = (int *) dbuffer ;
nint = 7 + mtx->nrow + mtx->ncol ;
*psizes = ibuffer + nint ;
nint += mtx->ncol ;
*pindices = ibuffer + nint ;
nint += mtx->nent ;
if ( sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + (nint+1)/2 ;
}
return ; }
/*
------------------------------------------------------
purpose -- for a block diagonal symmetric matrix, fill
*pncol with # of columns
*pnent with # of entries
*ppivotsizes with pivotsizes[ncol]
*pentries with entries[nent], matrix entries
created -- 98may01, cca
------------------------------------------------------
*/
void
SubMtx_blockDiagonalInfo (
SubMtx *mtx,
int *pncol,
int *pnent,
int **ppivotsizes,
double **pentries
) {
double *dbuffer ;
int nint ;
int *ibuffer ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL
|| pncol == NULL || pnent == NULL
|| ppivotsizes == NULL || pentries == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_blockDiagonalInfo(%p,%p,%p,%p,%p)"
"\n bad input\n",
mtx, pncol, pnent, ppivotsizes, pentries) ;
exit(-1) ;
}
if ( ! (SUBMTX_IS_REAL(mtx) || SUBMTX_IS_COMPLEX(mtx)) ) {
fprintf(stderr,
"\n fatal error in SubMtx_blockDiagonalInfo(%p,%p,%p,%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, pncol, pnent, ppivotsizes, pentries, mtx->type) ;
exit(-1) ;
}
if ( ! (SUBMTX_IS_BLOCK_DIAGONAL_SYM(mtx)
|| SUBMTX_IS_BLOCK_DIAGONAL_HERM(mtx)) ) {
fprintf(stderr,
"\n fatal error in SubMtx_blockDiagonalInfo(%p,%p,%p,%p,%p)"
"\n bad mode %d"
"\n must be SUBMTX_BLOCK_DIAGONAL_SYM or SUBMTX_BLOCK_DIAGONAL_HERM \n",
mtx, pncol, pnent, ppivotsizes, pentries, mtx->mode) ;
exit(-1) ;
}
*pncol = mtx->ncol ;
*pnent = mtx->nent ;
dbuffer = mtx->wrkDV.vec ;
ibuffer = (int *) dbuffer ;
nint = 7 + 2*mtx->nrow ;
*ppivotsizes = ibuffer + nint ;
nint += mtx->nrow ;
if ( sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
*pentries = dbuffer + (nint+1)/2 ;
}
return ; }
/*
--------------------------------------------------------
purpose -- assemble any aggregates in the aggregate list
created -- 98mar26, cca
--------------------------------------------------------
*/
static void
assembleAggregates (
int J,
SubMtx *BJ,
SubMtxList *aggList,
SubMtxManager *mtxmanager,
int msglvl,
FILE *msgFile
) {
SubMtx *BJhat, *BJhead ;
double *entBJ, *entBJhat ;
int inc1, inc1hat, inc2, inc2hat, ncol, ncolhat, nrow, nrowhat ;
if ( BJ == NULL || aggList == NULL ) {
fprintf(stderr,
"\n fatal error in assembleAggregates()"
"\n BJ = %p, aggList = %p", BJ, aggList) ;
exit(-1) ;
}
if ( SubMtxList_isListNonempty(aggList, BJ->rowid) ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n aggregate list is not-empty") ;
fflush(msgFile) ;
}
SubMtx_denseInfo(BJ, &nrow, &ncol, &inc1, &inc2, &entBJ) ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n\n BJ(%d,%d) : nrow %d, ncol %d, inc1 %d, inc2 %d, ent %p",
BJ->rowid, BJ->colid, nrow, ncol, inc1, inc2, entBJ) ;
fflush(msgFile) ;
}
BJhead = SubMtxList_getList(aggList, J) ;
for ( BJhat = BJhead ; BJhat != NULL ; BJhat = BJhat->next ) {
if ( BJhat == NULL ) {
fprintf(stderr,
"\n 3. fatal error in forwardVisit(%d)"
"\n BJhat = NULL", J) ;
exit(-1) ;
}
SubMtx_denseInfo(BJhat, &nrowhat, &ncolhat, &inc1hat, &inc2hat,
&entBJhat) ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n BJhat(%d,%d) : nrow %d, ncol %d, inc1 %d, inc2 %d, ent %p",
BJhat->rowid, BJhat->colid,
nrowhat, ncolhat, inc1hat, inc2hat, entBJhat) ;
fflush(msgFile) ;
}
if ( nrow != nrowhat || ncol != ncolhat
|| inc1 != inc1hat || inc2 != inc2hat || entBJhat == NULL ) {
fprintf(stderr, "\n fatal error") ;
exit(-1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n BJ") ;
SubMtx_writeForHumanEye(BJ, msgFile) ;
fprintf(msgFile, "\n\n BJhat") ;
SubMtx_writeForHumanEye(BJhat, msgFile) ;
fflush(msgFile) ;
}
if ( SUBMTX_IS_REAL(BJhat) ) {
DVadd(nrow*ncol, entBJ, entBJhat) ;
} else if ( SUBMTX_IS_COMPLEX(BJhat) ) {
DVadd(2*nrow*ncol, entBJ, entBJhat) ;
}
}
SubMtxManager_releaseListOfObjects(mtxmanager, BJhead) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n BJ after assembly") ;
SubMtx_writeForHumanEye(BJ, msgFile) ;
fflush(msgFile) ;
}
}
return ; }
/*
-------------------------------------------------------
purpose -- to find matrix entry (irow,jcol) if present.
return value --
if entry (irow,jcol) is not present then
*pValue is 0.0
return value is -1
else entry (irow,jcol) is present then
*pValue is the matrix entry
return value is offset into entries array
endif
created -- 98may01, cca
-------------------------------------------------------
*/
int
SubMtx_realEntry (
SubMtx *mtx,
int irow,
int jcol,
double *pValue
) {
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || irow < 0 || irow >= mtx->nrow || jcol < 0
|| jcol >= mtx->ncol || pValue == NULL ) {
fprintf(stderr,
"\n fatal error in SubMtx_realEntry(%p,%d,%d,%p)"
"\n bad input\n", mtx, irow, jcol, pValue) ;
exit(-1) ;
}
if ( ! SUBMTX_IS_REAL(mtx) ) {
fprintf(stderr,
"\n fatal error in SubMtx_realEntry(%p,%d,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL\n",
mtx, irow, jcol, pValue, mtx->type) ;
exit(-1) ;
}
*pValue = 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 ;
*pValue = entries[offset] ;
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 ) {
*pValue = entries[jj] ;
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 ) {
*pValue = entries[jj] ;
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] ) {
*pValue = entries[ii] ;
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 ;
*pValue = entries[offset] ;
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 ;
*pValue = entries[offset] ;
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) ;
}
*pValue = entries[irow] ;
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 ;
*pValue = entries[kk] ;
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 ;
*pValue = entries[kk] ;
return(kk) ;
}
} else {
kk += size-- ;
}
}
}
return(kk) ;
} break ;
default :
fprintf(stderr,
"\n fatal error in SubMtx_realEntry(%p,%d,%d,%p)"
"\n bad mode %d", mtx, irow, jcol, pValue, mtx->mode) ;
exit(-1) ;
break ;
}
return(-1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-----------------------------
test the SubMtx_solve() method.
created -- 98apr15, cca
-----------------------------
*/
{
SubMtx *mtxA, *mtxB, *mtxX ;
double idot, rdot, t1, t2 ;
double *entB, *entX ;
Drand *drand ;
FILE *msgFile ;
int inc1, inc2, mode, msglvl, ncolA, nentA, nrowA,
ncolB, nrowB, ncolX, nrowX, seed, type ;
if ( argc != 9 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type mode nrowA nentA ncolB seed"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of matrix A"
"\n 1 -- real"
"\n 2 -- complex"
"\n mode -- mode of matrix A"
"\n 2 -- sparse stored by rows"
"\n 3 -- sparse stored by columns"
"\n 5 -- sparse stored by subrows"
"\n 6 -- sparse stored by subcolumns"
"\n 7 -- diagonal"
"\n 8 -- block diagonal symmetric"
"\n 9 -- block diagonal hermitian"
"\n nrowA -- # of rows in matrix A"
"\n nentA -- # of entries in matrix A"
"\n ncolB -- # of columns in matrix B"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
fprintf(stderr, "\n message level must be positive\n") ;
spoolesFatal();
}
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
return(-1) ;
}
type = atoi(argv[3]) ;
mode = atoi(argv[4]) ;
nrowA = atoi(argv[5]) ;
nentA = atoi(argv[6]) ;
ncolB = atoi(argv[7]) ;
seed = atoi(argv[8]) ;
fprintf(msgFile, "\n %% %s:"
"\n %% msglvl = %d"
"\n %% msgFile = %s"
"\n %% type = %d"
"\n %% mode = %d"
"\n %% nrowA = %d"
"\n %% nentA = %d"
"\n %% ncolB = %d"
"\n %% seed = %d",
argv[0], msglvl, argv[2], type, mode,
nrowA, nentA, ncolB, seed) ;
ncolA = nrowA ;
nrowB = nrowA ;
nrowX = nrowA ;
ncolX = ncolB ;
/*
-----------------------------
check for errors in the input
-----------------------------
*/
if ( nrowA <= 0 || nentA <= 0 || ncolB <= 0 ) {
fprintf(stderr, "\n invalid input\n") ;
spoolesFatal();
}
switch ( type ) {
case SPOOLES_REAL :
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
break ;
default :
fprintf(stderr, "\n invalid mode %d\n", mode) ;
spoolesFatal();
}
break ;
case SPOOLES_COMPLEX :
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
break ;
default :
fprintf(stderr, "\n invalid mode %d\n", mode) ;
spoolesFatal();
}
break ;
default :
fprintf(stderr, "\n invalid type %d\n", type) ;
spoolesFatal();
break ;
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
------------------------------
initialize the X SubMtx object
------------------------------
*/
MARKTIME(t1) ;
mtxX = SubMtx_new() ;
SubMtx_initRandom(mtxX, type, SUBMTX_DENSE_COLUMNS, 0, 0,
nrowX, ncolX, nrowX*ncolX, ++seed) ;
SubMtx_denseInfo(mtxX, &nrowX, &ncolX, &inc1, &inc2, &entX) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize X SubMtx object",
t2 - t1) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n %% X SubMtx object") ;
fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, ncolX) ;
SubMtx_writeForMatlab(mtxX, "X", msgFile) ;
fflush(msgFile) ;
}
/*
------------------------------
initialize the B SubMtx object
------------------------------
*/
MARKTIME(t1) ;
mtxB = SubMtx_new() ;
SubMtx_init(mtxB, type,
SUBMTX_DENSE_COLUMNS, 0, 0, nrowB, ncolB, nrowB*ncolB) ;
SubMtx_denseInfo(mtxB, &nrowB, &ncolB, &inc1, &inc2, &entB) ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
if ( SUBMTX_IS_REAL(mtxX) ) {
DVcopy(nrowB*ncolB, entB, entX) ;
} else if ( SUBMTX_IS_COMPLEX(mtxX) ) {
ZVcopy(nrowB*ncolB, entB, entX) ;
}
break ;
default :
if ( SUBMTX_IS_REAL(mtxX) ) {
DVzero(nrowB*ncolB, entB) ;
} else if ( SUBMTX_IS_COMPLEX(mtxX) ) {
DVzero(2*nrowB*ncolB, entB) ;
}
break ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize B SubMtx object",
t2 - t1) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n %% B SubMtx object") ;
fprintf(msgFile, "\n B = zeros(%d,%d) ;", nrowB, ncolB) ;
SubMtx_writeForMatlab(mtxB, "B", msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------
initialize the A matrix SubMtx object
-------------------------------------
*/
seed++ ;
mtxA = SubMtx_new() ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
SubMtx_initRandomLowerTriangle(mtxA, type, mode, 0, 0,
nrowA, ncolA, nentA, seed, 1) ;
break ;
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
SubMtx_initRandomUpperTriangle(mtxA, type, mode, 0, 0,
nrowA, ncolA, nentA, seed, 1) ;
break ;
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
SubMtx_initRandom(mtxA, type, mode, 0, 0,
nrowA, ncolA, nentA, seed) ;
break ;
default :
fprintf(stderr, "\n fatal error in test_solve"
"\n invalid mode = %d", mode) ;
spoolesFatal();
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n %% A SubMtx object") ;
fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------------------------------------
compute B = A * X (for diagonal and block diagonal)
or B = (I + A) * X (for lower and upper triangular)
--------------------------------------------------------
*/
if ( SUBMTX_IS_REAL(mtxA) ) {
DV *colDV, *rowDV ;
double value, *colX, *rowA, *pBij, *pXij ;
int irowA, jcolX ;
colDV = DV_new() ;
DV_init(colDV, nrowA, NULL) ;
colX = DV_entries(colDV) ;
rowDV = DV_new() ;
DV_init(rowDV, nrowA, NULL) ;
rowA = DV_entries(rowDV) ;
for ( jcolX = 0 ; jcolX < ncolB ; jcolX++ ) {
SubMtx_fillColumnDV(mtxX, jcolX, colDV) ;
for ( irowA = 0 ; irowA < nrowA ; irowA++ ) {
SubMtx_fillRowDV(mtxA, irowA, rowDV) ;
SubMtx_locationOfRealEntry(mtxX, irowA, jcolX, &pXij) ;
SubMtx_locationOfRealEntry(mtxB, irowA, jcolX, &pBij) ;
value = DVdot(nrowA, rowA, colX) ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
*pBij = *pXij + value ;
break ;
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
*pBij = value ;
break ;
}
}
}
DV_free(colDV) ;
DV_free(rowDV) ;
} else if ( SUBMTX_IS_COMPLEX(mtxA) ) {
ZV *colZV, *rowZV ;
double *colX, *rowA, *pBIij, *pBRij, *pXIij, *pXRij ;
int irowA, jcolX ;
colZV = ZV_new() ;
ZV_init(colZV, nrowA, NULL) ;
colX = ZV_entries(colZV) ;
rowZV = ZV_new() ;
ZV_init(rowZV, nrowA, NULL) ;
rowA = ZV_entries(rowZV) ;
for ( jcolX = 0 ; jcolX < ncolB ; jcolX++ ) {
SubMtx_fillColumnZV(mtxX, jcolX, colZV) ;
for ( irowA = 0 ; irowA < nrowA ; irowA++ ) {
SubMtx_fillRowZV(mtxA, irowA, rowZV) ;
SubMtx_locationOfComplexEntry(mtxX,
irowA, jcolX, &pXRij, &pXIij) ;
SubMtx_locationOfComplexEntry(mtxB,
irowA, jcolX, &pBRij, &pBIij) ;
ZVdotU(nrowA, rowA, colX, &rdot, &idot) ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
*pBRij = *pXRij + rdot ;
*pBIij = *pXIij + idot ;
break ;
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
*pBRij = rdot ;
*pBIij = idot ;
break ;
}
}
}
ZV_free(colZV) ;
ZV_free(rowZV) ;
}
/*
----------------------
print out the matrices
----------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n %% X SubMtx object") ;
fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, ncolX) ;
SubMtx_writeForMatlab(mtxX, "X", msgFile) ;
fprintf(msgFile, "\n\n %% A SubMtx object") ;
fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
fprintf(msgFile, "\n\n %% B SubMtx object") ;
fprintf(msgFile, "\n B = zeros(%d,%d) ;", nrowB, ncolB) ;
SubMtx_writeForMatlab(mtxB, "B", msgFile) ;
fflush(msgFile) ;
}
/*
-----------------
check with matlab
-----------------
*/
if ( msglvl > 1 ) {
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
fprintf(msgFile,
"\n\n emtx = abs(B - X - A*X) ;"
"\n\n condA = cond(eye(%d,%d) + A)"
"\n\n maxabsZ = max(max(abs(emtx))) ", nrowA, nrowA) ;
fflush(msgFile) ;
break ;
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
fprintf(msgFile,
"\n\n emtx = abs(B - A*X) ;"
"\n\n condA = cond(A)"
"\n\n maxabsZ = max(max(abs(emtx))) ") ;
fflush(msgFile) ;
break ;
}
}
/*
----------------------------------------
compute the solve DY = B or (I + A)Y = B
----------------------------------------
*/
SubMtx_solve(mtxA, mtxB) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n %% Y SubMtx object") ;
fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowB, ncolB) ;
SubMtx_writeForMatlab(mtxB, "Y", msgFile) ;
fprintf(msgFile,
"\n\n %% solerror = abs(Y - X) ;"
"\n\n solerror = abs(Y - X) ;"
"\n\n maxabserror = max(max(solerror)) ") ;
fflush(msgFile) ;
}
/*
------------------------
free the working storage
------------------------
*/
SubMtx_free(mtxA) ;
SubMtx_free(mtxX) ;
SubMtx_free(mtxB) ;
Drand_free(drand) ;
fprintf(msgFile, "\n") ;
return(1) ; }
