예제 #1
0
파일: instance.c 프로젝트: bialk/SPOOLES
/*
   ---------------------------------
   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 ; }
예제 #2
0
/*
   -------------------------------------------------------------
   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 ; }
예제 #3
0
파일: split.c 프로젝트: fransklaver/SPOOLES
/*
   ----------------------------------------------------------------
   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 ; }