/* ----------------------------------------------------------- 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 -- 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 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 *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) ; }
/*--------------------------------------------------------------------*/ 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) ; }