/* ------------------------------------------------------- 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) ; }
/* --------------------------------------- purpose -- solve (I + A^T) X = B, where (1) A is strictly lower triangular (2) X overwrites B (B) B has mode SUBMTX_DENSE_COLUMNS created -- 98may01, cca --------------------------------------- */ static void solveDenseSubrows ( SubMtx *mtxA, SubMtx *mtxB ) { double ai, ar, bi0, bi1, bi2, br0, br1, br2 ; double *colB0, *colB1, *colB2, *entriesA, *entriesB ; int colstart, first, iloc, inc1, inc2, irowA, jcolB, jj, kk, last, ncolB, nentA, nrowA, nrowB, rloc ; int *firstlocsA, *sizesA ; /* ---------------------------------------------------- extract the pointer and dimensions from two matrices ---------------------------------------------------- */ SubMtx_denseSubrowsInfo(mtxA, &nrowA, &nentA, &firstlocsA, &sizesA, &entriesA) ; SubMtx_denseInfo(mtxB, &nrowB, &ncolB, &inc1, &inc2, &entriesB) ; #if MYDEBUG > 0 fprintf(stdout, "\n nrowA = %d, ncolA = %d", nrowA, nentA) ; fflush(stdout) ; #endif colB0 = entriesB ; for ( jcolB = 0 ; jcolB < ncolB - 2 ; jcolB += 3 ) { colB1 = colB0 + 2*nrowB ; colB2 = colB1 + 2*nrowB ; #if MYDEBUG > 0 fprintf(stdout, "\n jcolB = %d", jcolB) ; fflush(stdout) ; #endif for ( irowA = nrowA - 1, colstart = nentA ; irowA >= 0 ; irowA-- ) { if ( sizesA[irowA] > 0 ) { first = firstlocsA[irowA] ; last = first + sizesA[irowA] - 1 ; colstart -= last - first + 1 ; rloc = 2*irowA ; iloc = rloc + 1 ; br0 = colB0[rloc] ; bi0 = colB0[iloc] ; br1 = colB1[rloc] ; bi1 = colB1[iloc] ; br2 = colB2[rloc] ; bi2 = colB2[iloc] ; for ( jj = first, kk = colstart ; jj <= last ; jj++, kk++ ) { ar = entriesA[2*kk] ; ai = entriesA[2*kk+1] ; rloc = 2*jj ; iloc = rloc + 1 ; colB0[rloc] -= ar*br0 + ai*bi0 ; colB0[iloc] -= ar*bi0 - ai*br0 ; colB1[rloc] -= ar*br1 + ai*bi1 ; colB1[iloc] -= ar*bi1 - ai*br1 ; colB2[rloc] -= ar*br2 + ai*bi2 ; colB2[iloc] -= ar*bi2 - ai*br2 ; } } } colB0 = colB2 + 2*nrowB ; } if ( jcolB == ncolB - 2 ) { colB1 = colB0 + 2*nrowB ; #if MYDEBUG > 0 fprintf(stdout, "\n jcolB = %d", jcolB) ; fflush(stdout) ; #endif for ( irowA = nrowA - 1, colstart = nentA ; irowA >= 0 ; irowA-- ) { if ( sizesA[irowA] > 0 ) { first = firstlocsA[irowA] ; last = first + sizesA[irowA] - 1 ; colstart -= last - first + 1 ; rloc = 2*irowA ; iloc = rloc + 1 ; br0 = colB0[rloc] ; bi0 = colB0[iloc] ; br1 = colB1[rloc] ; bi1 = colB1[iloc] ; for ( jj = first, kk = colstart ; jj <= last ; jj++, kk++ ) { ar = entriesA[2*kk] ; ai = entriesA[2*kk+1] ; rloc = 2*jj ; iloc = rloc + 1 ; colB0[rloc] -= ar*br0 + ai*bi0 ; colB0[iloc] -= ar*bi0 - ai*br0 ; colB1[rloc] -= ar*br1 + ai*bi1 ; colB1[iloc] -= ar*bi1 - ai*br1 ; } } } } else if ( jcolB == ncolB - 1 ) { #if MYDEBUG > 0 fprintf(stdout, "\n jcolB = %d", jcolB) ; fflush(stdout) ; #endif for ( irowA = nrowA - 1, colstart = nentA ; irowA >= 0 ; irowA-- ) { if ( sizesA[irowA] > 0 ) { first = firstlocsA[irowA] ; last = first + sizesA[irowA] - 1 ; colstart -= last - first + 1 ; rloc = 2*irowA ; iloc = rloc + 1 ; br0 = colB0[rloc] ; bi0 = colB0[iloc] ; for ( jj = first, kk = colstart ; jj <= last ; jj++, kk++ ) { ar = entriesA[2*kk] ; ai = entriesA[2*kk+1] ; rloc = 2*jj ; iloc = rloc + 1 ; colB0[rloc] -= ar*br0 + ai*bi0 ; colB0[iloc] -= ar*bi0 - ai*br0 ; } } } } 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 ; }