예제 #1
0
파일: util.c 프로젝트: bialk/SPOOLES
/*
   -----------------------------------
   map entries into the upper triangle

   created -- 98jan28, cca
   -----------------------------------
*/
void
InpMtx_mapToUpperTriangle (
   InpMtx   *inpmtx
) {
int      col, ii, nent, row ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)"
           "\n bad coordType = %d, must be 1, 2, or 3\n", 
           inpmtx, inpmtx->coordType) ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec1[ii]) > (col = ivec2[ii]) ) {
         ivec1[ii] = col ;
         ivec2[ii] = row ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec2[ii]) > (col = ivec1[ii]) ) {
         ivec1[ii] = row ;
         ivec2[ii] = col ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec2[ii] < 0 ) {
         ivec2[ii] = -ivec2[ii] ;
      }
   }
}
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
예제 #2
0
파일: util.c 프로젝트: bialk/SPOOLES
/*
   -----------------------------------
   map entries into the lower triangle

   created -- 98jan28, cca
   -----------------------------------
*/
void
InpMtx_mapToLowerTriangle (
   InpMtx   *inpmtx
) {
int      col, ii, nent, row ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToLowerTriangle(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToLowerTriangle(%p)"
           "\n bad coordType\n", inpmtx) ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec1[ii]) < (col = ivec2[ii]) ) {
         ivec1[ii] = col ;
         ivec2[ii] = row ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec2[ii]) < (col = ivec1[ii]) ) {
         ivec1[ii] = row ;
         ivec2[ii] = col ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec2[ii] > 0 ) {
         ivec2[ii] = -ivec2[ii] ;
      }
   }
}
return ; }
예제 #3
0
파일: support.c 프로젝트: damiannz/spooles
/*
   --------------------------------------------------------------------
   purpose -- 
      this method is used to determine the support of this matrix
      for a matrix-vector multiply y[] = A * x[] when A is a 
      Hermitian matrix.

      supIV -- filled with row indices of y[] which will be updated
               and row indices of x[] which will be used.

   created -- 98aug01, cca
   --------------------------------------------------------------------
*/
void
InpMtx_supportHerm (
   InpMtx   *A,
   IV       *supIV
) {
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL || supIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportHerm(%p,%p)"
           "\n bad input\n", A, supIV) ;
   exit(-1) ;
}
if (  !INPMTX_IS_BY_ROWS(A) 
   && !INPMTX_IS_BY_COLUMNS(A) 
   && !INPMTX_IS_BY_CHEVRONS(A) ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportHerm(%p,%p)"
           "\n coordinate type\n", A, supIV) ;
   exit(-1) ;
}
InpMtx_supportSym(A, supIV) ;

return ; }
예제 #4
0
파일: support.c 프로젝트: damiannz/spooles
/*
   --------------------------------------------------------------------
   purpose -- 
      this method is used to determine the support of this matrix
      for a matrix-vector multiply y[] = A * x[] when A is a
      nonsymmetric matrix.

      rowsupIV -- filled with row indices of y[] which will be updated.
      colsupIV -- filled with row indices of x[] which will be used.

   created -- 98aug01, cca
   --------------------------------------------------------------------
*/
void
InpMtx_supportNonsymH (
   InpMtx   *A,
   IV       *rowsupIV,
   IV       *colsupIV
) {
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL || rowsupIV == NULL || colsupIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportNonsymH(%p,%p,%p)"
           "\n bad input\n", A, rowsupIV, colsupIV) ;
   exit(-1) ;
}
if (  !INPMTX_IS_BY_ROWS(A) 
   && !INPMTX_IS_BY_COLUMNS(A) 
   && !INPMTX_IS_BY_CHEVRONS(A) ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportNonsymH(%p,%p,%p)"
           "\n coordinate type\n", A, rowsupIV, colsupIV) ;
   exit(-1) ;
}
InpMtx_supportNonsymT(A, rowsupIV, colsupIV) ;

return ; }
예제 #5
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   -----------------------------
   input a chevron in the matrix

   created -- 98jan28, cca
   -----------------------------
*/
static void
inputChevron (
   InpMtx   *inpmtx,
   int       chv,
   int       chvsize,
   int       chvind[],
   double    chvent[]
) {
int      col, ii, jj, nent, offset, row ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, chvsize) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0, jj = nent ; ii < chvsize ; ii++, jj++ ) {
      if ( (offset = chvind[ii]) >= 0 ) {
         row = chv ;
         col = chv + offset ;
      } else {
         col = chv ;
         row = chv - offset ;
      }
      ivec1[jj] = row ;
      ivec2[jj] = col ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0, jj = nent ; ii < chvsize ; ii++, jj++ ) {
      if ( (offset = chvind[ii]) >= 0 ) {
         row = chv ;
         col = chv + offset ;
      } else {
         col = chv ;
         row = chv - offset ;
      }
      ivec1[jj] = col ;
      ivec2[jj] = row ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   IVfill(chvsize, ivec1 + nent, chv) ;
   IVcopy(chvsize, ivec2 + nent, chvind) ;
}
IV_setSize(&inpmtx->ivec1IV, nent + chvsize) ;
IV_setSize(&inpmtx->ivec2IV, nent + chvsize) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) + nent ;
   DVcopy(chvsize, dvec, chvent) ;
   DV_setSize(&inpmtx->dvecDV,  nent + chvsize) ;
} else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) + 2*nent ;
   ZVcopy(chvsize, dvec, chvent) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + chvsize)) ;
}
inpmtx->nent += chvsize ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
예제 #6
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   ---------------------------------
   input a row in the matrix

   created -- 98jan28, cca
   ---------------------------------
*/
static void
inputRow (
   InpMtx   *inpmtx,
   int       row,
   int       rowsize,
   int       rowind[],
   double    rowent[]
) {
int      col, ii, jj, nent ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, rowsize) ;
nent  = inpmtx->nent ; 
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) { /* row coordinates */
   IVfill(rowsize, ivec1 + nent, row) ;
   IVcopy(rowsize, ivec2 + nent, rowind) ;
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) { /* column coordinates */
   IVfill(rowsize, ivec2 + nent, row) ;
   IVcopy(rowsize, ivec1 + nent, rowind) ;
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) { /* chevron coordinates */
   for ( ii = 0, jj = nent ; ii < rowsize ; ii++, jj++ ) {
      col = rowind[ii] ;
      ivec1[ii] = (row <= col) ? row : col ;
      ivec2[ii] = col - row ;
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + rowsize) ;
IV_setSize(&inpmtx->ivec2IV, nent + rowsize) ;
/*
   -----------------
   input the entries
   -----------------
*/
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double  *dvec = DV_entries(&inpmtx->dvecDV) ;
   DVcopy(rowsize, dvec + nent, rowent) ;
   DV_setSize(&inpmtx->dvecDV, nent + rowsize) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double  *dvec = DV_entries(&inpmtx->dvecDV) ;
   ZVcopy(rowsize, dvec + 2*nent, rowent) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + rowsize)) ;
}
inpmtx->storageMode = INPMTX_RAW_DATA ;
inpmtx->nent += rowsize ;

return ; }
예제 #7
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   ----------------------------------
   input a single entry in the matrix

   created -- 98jan28, cca
   ----------------------------------
*/
static void
inputEntry (
   InpMtx   *inpmtx,
   int       row,
   int       col,
   double    real,
   double    imag
) {
int   nent ;
int   *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, 1) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   ivec1[nent] = row ;
   ivec2[nent] = col ;
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   ivec1[nent] = col ;
   ivec2[nent] = row ;
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   if ( row <= col ) {
      ivec1[nent] = row ;
      ivec2[nent] = col - row ;
   } else {
      ivec1[nent] = col ;
      ivec2[nent] = col - row ;
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + 1) ;
IV_setSize(&inpmtx->ivec2IV, nent + 1) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   dvec[nent] = real ;
   DV_setSize(&inpmtx->dvecDV,  nent + 1) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   dvec[2*nent]   = real  ;
   dvec[2*nent+1] = imag  ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + 1)) ;
}
inpmtx->nent++ ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
예제 #8
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   ------------------------------------
   input a complex column in the matrix

   created -- 98jan28, cca
   ------------------------------------
*/
static void
inputColumn (
   InpMtx   *inpmtx,
   int       col,
   int       colsize,
   int       colind[],
   double    colent[]
) {
int      ii, jj, nent, row ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, colsize) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   IVcopy(colsize, ivec1 + nent, colind) ;
   IVfill(colsize, ivec2 + nent, col) ;
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   IVfill(colsize, ivec1 + nent, col) ;
   IVcopy(colsize, ivec2 + nent, colind) ;
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0, jj = nent ; ii < colsize ; ii++, jj++ ) {
      row = colind[jj] ;
      ivec1[jj] = (row <= col) ? row : col ;
      ivec2[jj] = col - row ;
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + colsize) ;
IV_setSize(&inpmtx->ivec2IV, nent + colsize) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double *dvec = DV_entries(&inpmtx->dvecDV) + nent ;
   DVcopy(colsize, dvec, colent) ;
   DV_setSize(&inpmtx->dvecDV,  nent + colsize) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double *dvec = DV_entries(&inpmtx->dvecDV) + 2*nent ;
   ZVcopy(colsize, dvec, colent) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + colsize)) ;
}
inpmtx->nent = nent + colsize ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
예제 #9
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   ------------------------------------------
   input a single complex entry in the matrix

   created -- 98jan28, cca
   ------------------------------------------
*/
void
InpMtx_inputComplexEntry (
   InpMtx   *inpmtx,
   int       row,
   int       col,
   double    real,
   double    imag
) {
/*
   --------------
   check the data
   --------------
*/
if ( inpmtx == NULL || row < 0 || col < 0 ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputComplexEntry(%p,%d,%d,%e,%e)"
           "\n bad inputComplex\n", inpmtx, row, col, real, imag) ;
   spoolesFatal();
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputComplexEntry(%p,%d,%d,%e,%e)"
           "\n bad coordType = %d\n", inpmtx, row, col, real, imag,
           inpmtx->coordType) ;
   spoolesFatal();
}
if ( ! INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputComplexEntry(%p,%d,%d,%e,%e)"
           "\n inputMode is not SPOOLES_COMPLEX\n",
           inpmtx, row, col, real, imag) ;
   spoolesFatal();
}
inputEntry(inpmtx, row, col, real, imag) ;

return ; }
예제 #10
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   ---------------------------------------
   input a single real entry in the matrix

   created -- 98jan28, cca
   ---------------------------------------
*/
void
InpMtx_inputRealEntry (
   InpMtx   *inpmtx,
   int       row,
   int       col,
   double    value
) {
/*
   --------------
   check the data
   --------------
*/
if ( inpmtx == NULL || row < 0 || col < 0 ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputRealEntry(%p,%d,%d,%e)"
           "\n bad inputReal\n", inpmtx, row, col, value) ;
   spoolesFatal();
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputRealEntry(%p,%d,%d,%e)"
           "\n bad coordType = %d\n", inpmtx, row, col, value, 
           inpmtx->coordType) ;
   spoolesFatal();
}
if ( ! INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputRealEntry(%p,%d,%d,%e)"
           "\n inputMode is not SPOOLES_REAL\n",
           inpmtx, row, col, value) ;
   spoolesFatal();
}
inputEntry(inpmtx, row, col, value, 0.0) ;

return ; }
예제 #11
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   ----------------------------------
   input a single entry in the matrix

   created -- 98jan28, cca
   ----------------------------------
*/
void
InpMtx_inputEntry (
   InpMtx   *inpmtx,
   int       row,
   int       col
) {
/*
   --------------
   check the data
   --------------
*/
if ( inpmtx == NULL || row < 0 || col < 0 ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputEntry(%p,%d,%d)"
           "\n bad input\n", inpmtx, row, col) ;
   spoolesFatal();
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputEntry(%p,%d,%d)"
           "\n bad coordType = %d\n", inpmtx, row, col, 
           inpmtx->coordType) ;
   spoolesFatal();
}
if ( ! INPMTX_IS_INDICES_ONLY(inpmtx) ) {
   fprintf(stderr, 
           "\n fatal error in InpMtx_inputEntry(%p,%d,%d)"
           "\n inputMode is not INPMTX_INDICES_ONLY\n",
           inpmtx, row, col) ;
   spoolesFatal();
}
inputEntry(inpmtx, row, col, 0.0, 0.0) ;

return ; }
예제 #12
0
파일: support.c 프로젝트: damiannz/spooles
/*
   --------------------------------------------------------------------
   purpose -- 
      this method is used to determine the support of this matrix
      for a matrix-vector multiply y[] = A * x[] when A is a 
      symmetric matrix.

      supIV -- filled with row indices of y[] which will be updated
               and row indices of x[] which will be used.

   created -- 98aug01, cca
   --------------------------------------------------------------------
*/
void
InpMtx_supportSym (
   InpMtx   *A,
   IV       *supIV
) {
char   *mark ;
int    chev, col, count, ii, loc, maxcol, maxrow, maxv, nent, off, row ;
int    *ivec1, *ivec2, *sup ;
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL || supIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)"
           "\n bad input\n", A, supIV) ;
   exit(-1) ;
}
if (  !INPMTX_IS_BY_ROWS(A) 
   && !INPMTX_IS_BY_COLUMNS(A) 
   && !INPMTX_IS_BY_CHEVRONS(A) ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)"
           "\n coordinate type\n", A, supIV) ;
   exit(-1) ;
}
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
nent  = A->nent ;
/*
   -----------------------------------------------------------------
   (1) determine the maximum row and column numbers in these entries
   (2) allocate marking vectors for rows and columns
   (3) fill marking vectors for rows and columns
   (4) fill support vectors 
   -----------------------------------------------------------------
*/
if ( INPMTX_IS_BY_ROWS(A) ) {
   maxrow = IVmax(nent, ivec1, &loc) ;
   maxcol = IVmax(nent, ivec2, &loc) ;
   maxv   = (maxrow >= maxcol) ? maxrow : maxcol ;
   mark   = CVinit(1+maxv, 'O') ;
   count  = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec1[ii] ; col = ivec2[ii] ;
      if ( mark[row] == 'O' ) {
         count++ ;
      }
      mark[row] = 'X' ;
      if ( mark[col] == 'O' ) {
         count++ ;
      }
      mark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(A) ) {
   maxrow = IVmax(nent, ivec2, &loc) ;
   maxcol = IVmax(nent, ivec1, &loc) ;
   maxv   = (maxrow >= maxcol) ? maxrow : maxcol ;
   mark   = CVinit(1+maxv, 'O') ;
   count  = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec2[ii] ; col = ivec1[ii] ;
      if ( mark[row] == 'O' ) {
         count++ ;
      }
      mark[row] = 'X' ;
      if ( mark[col] == 'O' ) {
         count++ ;
      }
      mark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(A) ) {
   maxv = -1 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
         if ( maxv < col ) {
            maxv = col ;
         }
      } else {
         col = chev ; row = chev - off ;
         if ( maxv < row ) {
            maxv = row ;
         }
      }
   }
   mark = CVinit(1+maxv, 'O') ;
   count = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
      } else {
         col = chev ; row = chev - off ;
      }
      if ( mark[row] == 'O' ) {
         count++ ;
      }
      mark[row] = 'X' ;
      if ( mark[col] == 'O' ) {
         count++ ;
      }
      mark[col] = 'X' ;
   }
}
IV_setSize(supIV, count) ;
sup = IV_entries(supIV) ;
for ( row = count = 0 ; row <= maxv ; row++ ) {
   if ( mark[row] == 'X' ) {
      sup[count++] = row ;
   }
}
CVfree(mark) ;

return ; }
예제 #13
0
파일: input.c 프로젝트: fransklaver/SPOOLES
/*
   -----------------------
   input a matrix

   created -- 98jan28, cca
   -----------------------
*/
static void
inputMatrix (
   InpMtx   *inpmtx,
   int       nrow,
   int       ncol,
   int       rowstride,
   int       colstride,
   int       rowind[],
   int       colind[],
   double    mtxent[]
) {
int      col, ii, jj, kk, nent, row ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, nrow*ncol) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      col = colind[jj] ;
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         row = rowind[ii] ;
         ivec1[kk] = row ;
         ivec2[kk] = col ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      col = colind[jj] ;
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         row = rowind[ii] ;
         ivec1[kk] = col ;
         ivec2[kk] = row ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      col = colind[jj] ;
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         row = rowind[ii] ;
         if ( row <= col ) {
            ivec1[kk] = row ;
         } else {
            ivec1[kk] = col ;
         }
         ivec2[kk] = col - row ;
      }
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + nrow*ncol) ;
IV_setSize(&inpmtx->ivec2IV, nent + nrow*ncol) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   int      ij ;
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         ij = ii*rowstride + jj*colstride ;
         dvec[kk] = mtxent[ij] ;
      }
   }
   DV_setSize(&inpmtx->dvecDV, nent + nrow*ncol) ;
} if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   int      ij ;
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         ij = ii*rowstride + jj*colstride ;
         dvec[2*kk]   = mtxent[2*ij]   ;
         dvec[2*kk+1] = mtxent[2*ij+1] ;
      }
   }
   DV_setSize(&inpmtx->dvecDV,  2*(nent + nrow*ncol)) ;
}
inpmtx->nent += nrow*ncol ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
예제 #14
0
파일: map.c 프로젝트: bialk/SPOOLES
/*
   --------------------------------------------------------------------
   purpose -- to map the coordinates of the entries of the matrix 
      into new coordinates. this method is used during the distributed
      matrix-vector multiply where a matrix local to a processor is
      mapped into a local coordinate system.

   (row,col) --> (rowmap[row],colmap[col])

   we check that row is in [0,nrow) and col is in [0,ncol),
   where nrow is the size of rowmapIV and ncol is the size of colmapIV.

   note, the storage mode is not changed. i.e., if the data is
   stored by vectors, it may be invalid after the indices have 
   been mapped. on the other hand, it may not, so it is the user's
   responsibility to reset the storage mode if necessary.

   created -- 98aug02, cca
   --------------------------------------------------------------------
*/
void
InpMtx_mapEntries (
   InpMtx   *inpmtx,
   IV       *rowmapIV,
   IV       *colmapIV
) {
int   chv, col, ii, ncol, nent, nrow, off, row ;
int   *colmap, *ivec1, *ivec2, *rowmap ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL || rowmapIV == NULL || colmapIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n bad input\n") ;
   exit(-1) ;
}
if ( !(INPMTX_IS_BY_ROWS(inpmtx)
   ||  INPMTX_IS_BY_COLUMNS(inpmtx)
   ||  INPMTX_IS_BY_CHEVRONS(inpmtx)) ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n bad coordinate type\n") ;
   exit(-1) ;
}
IV_sizeAndEntries(rowmapIV, &nrow, &rowmap) ;
if ( rowmap == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n rowmap is NULL\n") ;
   exit(-1) ;
}
IV_sizeAndEntries(colmapIV, &ncol, &colmap) ;
if ( colmap == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n colmap is NULL\n") ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec1[ii] ; col = ivec2[ii] ;
      if ( row < 0 || row >= nrow ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
         exit(-1) ;
      }
      ivec1[ii] = rowmap[row] ;
      if ( col < 0 || col >= ncol ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
         exit(-1) ;
      }
      ivec2[ii] = colmap[col] ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec2[ii] ; col = ivec1[ii] ;
      if ( row < 0 || row >= nrow ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
         exit(-1) ;
      }
      ivec2[ii] = rowmap[row] ;
      if ( col < 0 || col >= ncol ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
         exit(-1) ;
      }
      ivec1[ii] = colmap[col] ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chv = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chv ; col = chv + off ;
      } else {
         row = chv - off ; col = chv ;
      }
      if ( row < 0 || row >= nrow ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
         exit(-1) ;
      }
      row = rowmap[row] ;
      if ( col < 0 || col >= ncol ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
         exit(-1) ;
      }
      col = colmap[col] ;
      ivec1[ii] = (row >= col) ? col : row ;
      ivec2[ii] = col - row ;
   }
}
return ; }
예제 #15
0
/*
   --------------------------------------------------------------------
   purpose -- 
      this method is used to determine the support of this matrix
      for a matrix-vector multiply y[] = A * x[] when A is a
      nonsymmetric matrix.

      rowsupIV -- filled with row indices of y[] which will be updated.
      colsupIV -- filled with row indices of x[] which will be used.

   created -- 98aug01, cca
   --------------------------------------------------------------------
*/
void
InpMtx_supportNonsymT (
   InpMtx   *A,
   IV       *rowsupIV,
   IV       *colsupIV
) {
char   *colmark, *rowmark ;
int    chev, col, colcount, ii, loc, maxcol, maxrow, nent, off, row,
       rowcount ;
int    *colsup, *ivec1, *ivec2, *rowsup ;
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL || rowsupIV == NULL || colsupIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)"
           "\n bad input\n", A, rowsupIV, colsupIV) ;
   spoolesFatal();
}
if (  !INPMTX_IS_BY_ROWS(A) 
   && !INPMTX_IS_BY_COLUMNS(A) 
   && !INPMTX_IS_BY_CHEVRONS(A) ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)"
           "\n coordinate type\n", A, rowsupIV, colsupIV) ;
   spoolesFatal();
}
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
nent  = A->nent ;
/*
   -----------------------------------------------------------------
   (1) determine the maximum row and column numbers in these entries
   (2) allocate marking vectors for rows and columns
   (3) fill marking vectors for rows and columns
   (4) fill support vectors 
   -----------------------------------------------------------------
*/
if ( INPMTX_IS_BY_ROWS(A) ) {
   maxrow   = IVmax(nent, ivec1, &loc) ;
   maxcol   = IVmax(nent, ivec2, &loc) ;
   rowmark  = CVinit(1+maxcol, 'O') ;
   colmark  = CVinit(1+maxrow, 'O') ;
   rowcount = colcount = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec1[ii] ; col = ivec2[ii] ;
      if ( colmark[row] == 'O' ) {
         colcount++ ;
      }
      colmark[row] = 'X' ;
      if ( rowmark[col] == 'O' ) {
         rowcount++ ;
      }
      rowmark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(A) ) {
   maxrow   = IVmax(nent, ivec2, &loc) ;
   maxcol   = IVmax(nent, ivec1, &loc) ;
   rowmark  = CVinit(1+maxcol, 'O') ;
   colmark  = CVinit(1+maxrow, 'O') ;
   rowcount = colcount = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec2[ii] ; col = ivec1[ii] ;
      if ( colmark[row] == 'O' ) {
         colcount++ ;
      }
      colmark[row] = 'X' ;
      if ( rowmark[col] == 'O' ) {
         rowcount++ ;
      }
      rowmark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(A) ) {
   maxrow = maxcol = -1 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
      } else {
         col = chev ; row = chev - off ;
      }
      if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( maxcol < col ) {
         maxcol = col ;
      }
   }
   rowmark  = CVinit(1+maxcol, 'O') ;
   colmark  = CVinit(1+maxrow, 'O') ;
   rowcount = colcount = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
      } else {
         col = chev ; row = chev - off ;
      }
      if ( colmark[row] == 'O' ) {
         colcount++ ;
      }
      colmark[row] = 'X' ;
      if ( rowmark[col] == 'O' ) {
         rowcount++ ;
      }
      rowmark[col] = 'X' ;
   }
}
IV_setSize(rowsupIV, rowcount) ;
rowsup = IV_entries(rowsupIV) ;
for ( col = rowcount = 0 ; col <= maxcol ; col++ ) {
   if ( rowmark[col] == 'X' ) {
      rowsup[rowcount++] = col ;
   }
}
IV_setSize(colsupIV, colcount) ;
colsup = IV_entries(colsupIV) ;
for ( row = colcount = 0 ; row <= maxrow ; row++ ) {
   if ( colmark[row] == 'X' ) {
      colsup[colcount++] = row ;
   }
}
CVfree(colmark) ;
CVfree(rowmark) ;

return ; }
예제 #16
0
파일: iter.c 프로젝트: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -----------------------------------------------------
   test the factor method for a grid matrix
   (0) read in matrix from source file 
   (1) conver data matrix to InpMtx object if necessary
   (2) create Graph and ETree object if necessary
   (3) read in/create an ETree object
   (4) create a solution matrix object
   (5) multiply the solution with the matrix
       to get a right hand side matrix object
   (6) factor the matrix 
   (7) solve the system

   created   -- 98dec30, jwu
   -----------------------------------------------------
*/
{
char            etreeFileName[80], mtxFileName[80], *cpt, rhsFileName[80],
                srcFileName[80], ctemp[81], msgFileName[80], slnFileName[80] ;
Chv             *chv, *rootchv ;
ChvManager      *chvmanager ;
DenseMtx        *mtxB, *mtxQ, *mtxX, *mtxZ ;
double          one[2] = { 1.0, 0.0 } ;
FrontMtx        *frontmtx ;
InpMtx          *mtxA ;
SubMtxManager   *mtxmanager ;
double          cputotal, droptol, conv_tol, factorops ;
double          cpus[9] ;
Drand           drand ;
double          nops, tau, t1, t2   ;
ETree           *frontETree   ;
Graph           *graph ;
FILE            *msgFile, *inFile ;
int             error, loc, msglvl, neqns, nzf, iformat, 
                pivotingflag, rc, seed, sparsityflag, symmetryflag, 
                method[METHODS], type, nrhs, etreeflag ;
int             stats[6] ;
int             nnzA, Ik, itermax, zversion, iterout ;
IV              *newToOldIV, *oldToNewIV ;
IVL             *symbfacIVL ;
int             i, j, k, m, n, imethod, maxdomainsize, maxzeros, maxsize;
int             nouter,ninner ;

if ( argc != 2 ) {
   fprintf(stdout, 
"\n\n usage : %s inFile"
"\n    inFile       -- input filename"
"\n", argv[0]) ;
   return(-1) ;
}

/* read input file */
inFile = fopen(argv[1], "r");
if (inFile == (FILE *)NULL) {
  fprintf(stderr, "\n fatal error in %s: unable to open file %s\n",
           argv[0], argv[1]) ;
  return(-1) ;
}

for (i=0; i<METHODS; i++) method[i]=-1; 
imethod=0;
k=0;
while (1) {
  fgets(ctemp, 80, inFile);
  if (ctemp[0] != '*') {
    /*printf("l=%2d:%s\n", strlen(ctemp),ctemp);*/
    if (strlen(ctemp)==80) {
      fprintf(stderr, "\n fatal error in %s: input line contains more than "
	      "80 characters.\n",argv[0]);
      exit(-1);
    }
    if (k==0) {
      sscanf(ctemp, "%d",  &iformat);
      if (iformat < 0 || iformat > 2) {
	fprintf(stderr, "\n fatal error in %s: "
		"invalid source matrix format\n",argv[0]) ;
	return(-1) ;
      }
    }
    else if (k==1)
      sscanf(ctemp, "%s", srcFileName);
    else if (k==2)
      sscanf(ctemp, "%s", mtxFileName);
    else if (k==3) {
      sscanf(ctemp, "%d",  &etreeflag);
      if (etreeflag < 0 || etreeflag > 4) {
	fprintf(stderr, "\n fatal error in %s: "
                        "invalid etree file status\n",argv[0]) ;
	return(-1) ;
      }
    }
    else if (k==4)
      sscanf(ctemp, "%s", etreeFileName);
    else if (k==5)
      sscanf(ctemp, "%s", rhsFileName);
    else if (k==6)
      sscanf(ctemp, "%s", slnFileName);
    else if (k==7){
      sscanf(ctemp, "%s", msgFileName);
      if ( strcmp(msgFileName, "stdout") == 0 ) {
	msgFile = stdout ;
      }
      else if ( (msgFile = fopen(msgFileName, "a")) == NULL ) {
	fprintf(stderr, "\n fatal error in %s"
		"\n unable to open file %s\n", argv[0], ctemp) ;
	return(-1) ;
      }
    }
    else if (k==8)
      sscanf(ctemp, "%d %d %d %d %d %d", 
	     &msglvl, &seed, &nrhs, &Ik, &itermax, &iterout);
    else if (k==9)
      sscanf(ctemp, "%d %d %d", &symmetryflag, &sparsityflag, &pivotingflag);
    else if (k==10)
      sscanf(ctemp, "%lf %lf %lf", &tau, &droptol, &conv_tol);
    else if (k==11) {
      /*
      for (j=0; j<strlen(ctemp); j++) {
	printf("j=%2d:%s",j,ctemp+j);
	if (ctemp[j] == ' ' && ctemp[j+1] != ' ') {
	  sscanf(ctemp+j, "%d", method+imethod);
          printf("method[%d]=%d\n",imethod,method[imethod]);
	  if (method[imethod] < 0) break;
	  imethod++;
	}
      }
      */
      imethod = sscanf(ctemp,"%d %d %d %d %d %d %d %d %d %d",
		       method, method+1, method+2, method+3, method+4,
		       method+5, method+6, method+7, method+8, method+9);
      /*printf("imethod=%d\n",imethod);*/
      for (j=0; j<imethod; j++) {
	/*printf("method[%d]=%d\n",j,method[j]);*/
	if (method[j]<0) {
	  imethod=j;
          break;
	}
      }
      if (imethod == 0) {
	fprintf(msgFile,"No method assigned in input file\n");
	return(-1);
      }
    }
    k++;
  }
  if (k==12) break;
}

fclose(inFile);

/* reset nrhs to 1 */
if (nrhs > 1) {
  fprintf(msgFile,"*** Multiple right-hand-side vectors is not allowed yet.\n");
  fprintf(msgFile,"*** nrhs is reset to 1.\n");
  nrhs =1;
}

fprintf(msgFile, 
        "\n %s "
        "\n srcFileName   -- %s"
        "\n mtxFileName   -- %s"
        "\n etreeFileName -- %s"
        "\n rhsFileName   -- %s"
        "\n msglvl        -- %d" 
        "\n seed          -- %d" 
        "\n symmetryflag  -- %d" 
        "\n sparsityflag  -- %d" 
        "\n pivotingflag  -- %d" 
        "\n tau           -- %e" 
        "\n droptol       -- %e" 
        "\n conv_tol      -- %e"
        "\n method        -- ",
        argv[0], srcFileName, mtxFileName, etreeFileName, rhsFileName,
	msglvl, seed, symmetryflag, sparsityflag, pivotingflag, 
        tau, droptol, conv_tol) ;
 
for (k=0; k<imethod; k++) 
  fprintf(msgFile, "%d ", method[k]);
fprintf(msgFile, "\n ", method[k]);

fflush(msgFile) ;

/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
/*Drand_setUniform(&drand, 0.0, 1.0) ;*/
Drand_setNormal(&drand, 0.0, 1.0) ;
/*
   ----------------------------------------------
   read in or convert source to the InpMtx object
   ----------------------------------------------
*/
rc = 1;

if ( strcmp(srcFileName, "none") == 0 ) {
   fprintf(msgFile, "\n no file to read from") ;
   exit(-1) ;
}
mtxA = InpMtx_new() ;

MARKTIME(t1) ;
if (iformat == 0)  { /* InpMtx source format */
  rc = InpMtx_readFromFile(mtxA, srcFileName) ;
  strcpy(mtxFileName, srcFileName);
  if ( rc != 1 ) 
    fprintf(msgFile, "\n return value %d from InpMtx_readFromFile(%p,%s)",
	    rc, mtxA, srcFileName) ;
}
else if (iformat == 1) {  /* HBF source format */
  rc = InpMtx_readFromHBfile(mtxA, srcFileName) ;
  if ( rc != 1 ) 
    fprintf(msgFile, "\n return value %d from InpMtx_readFromHBfile(%p,%s)",
	    rc, mtxA, srcFileName) ;
}
else { /* AIJ2 source format */
  rc = InpMtx_readFromAIJ2file(mtxA, srcFileName) ;
  if ( rc != 1 ) 
    fprintf(msgFile, "\n return value %d from InpMtx_readFromAIJ2file(%p,%s)",
	    rc, mtxA, srcFileName) ;
}
MARKTIME(t2) ;
if (iformat>0 && strcmp(mtxFileName, "none") != 0 ) {
  rc = InpMtx_writeToFile(mtxA, mtxFileName) ;
  if ( rc != 1 )
    fprintf(msgFile, "\n return value %d from InpMtx_writeToFile(%p,%s)",
	    rc, mtxA, mtxFileName) ;
}

fprintf(msgFile, "\n CPU %8.3f : read in (+ convert to) mtxA from file %s",
	t2 - t1, mtxFileName) ;
if (rc != 1) {
  goto end_read;
}
type = mtxA->inputMode ;
neqns = 1 + IVmax(mtxA->nent, InpMtx_ivec1(mtxA), &loc) ;
if ( INPMTX_IS_BY_ROWS(mtxA) ) {
  fprintf(msgFile, "\n matrix coordinate type is rows") ;
} else if ( INPMTX_IS_BY_COLUMNS(mtxA) ) {
  fprintf(msgFile, "\n matrix coordinate type is columns") ;
} else if ( INPMTX_IS_BY_CHEVRONS(mtxA) ) {
  fprintf(msgFile, "\n matrix coordinate type is chevrons") ;
} else {
  fprintf(msgFile, "\n\n, error, bad coordinate type") ;
  rc=-1;
  goto end_read;
}
if ( INPMTX_IS_RAW_DATA(mtxA) ) {
  fprintf(msgFile, "\n matrix storage mode is raw data\n") ;
} else if ( INPMTX_IS_SORTED(mtxA) ) {
  fprintf(msgFile, "\n matrix storage mode is sorted\n") ;
} else if ( INPMTX_IS_BY_VECTORS(mtxA) ) {
  fprintf(msgFile, "\n matrix storage mode is by vectors\n") ;
} else {
  fprintf(msgFile, "\n\n, error, bad storage mode") ;
  rc=-1;
  goto end_read;
}

if ( msglvl > 1 ) {
  fprintf(msgFile, "\n\n after reading InpMtx object from file %s",
	  mtxFileName) ;
  if ( msglvl == 2 ) {
    InpMtx_writeStats(mtxA, msgFile) ;
  } else {
    InpMtx_writeForHumanEye(mtxA, msgFile) ;
  }
  fflush(msgFile) ;
}
/*
  Get the nonzeros in matrix A and print it
  */
nnzA  = InpMtx_nent( mtxA );
fprintf(msgFile, "\n\n Input matrix size  %d NNZ  %d",
	neqns, nnzA) ;

/*
   --------------------------------------------------------
   generate the linear system
   1. generate solution matrix and fill with random numbers
   2. generate rhs matrix and fill with zeros
   3. compute matrix-matrix multiply
   --------------------------------------------------------
*/
MARKTIME(t1) ;
mtxX = DenseMtx_new() ;
DenseMtx_init(mtxX, type, 0, -1, neqns, nrhs, 1, neqns) ;
mtxB = DenseMtx_new() ; 

if (strcmp(rhsFileName, "none")) {
  rc = DenseMtx_readFromFile(mtxB, rhsFileName) ;
  if ( rc != 1 )
    fprintf(msgFile, "\n return value %d from DenseMtx_readFromFile(%p,%s)",
	    rc, mtxB, rhsFileName) ;
  DenseMtx_zero(mtxX) ;
}
else {
  DenseMtx_init(mtxB, type, 1, -1, neqns, nrhs, 1, neqns) ;
  DenseMtx_fillRandomEntries(mtxX, &drand) ;
  DenseMtx_zero(mtxB) ;
  switch ( symmetryflag ) {
  case SPOOLES_SYMMETRIC : 
    InpMtx_sym_mmm(mtxA, mtxB, one, mtxX) ;
    break ;
  case SPOOLES_HERMITIAN :
    InpMtx_herm_mmm(mtxA, mtxB, one, mtxX) ;
    break ;
  case SPOOLES_NONSYMMETRIC :
    InpMtx_nonsym_mmm(mtxA, mtxB, one, mtxX) ;
    break ;
  default :
    break ;
  }
}
  
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set up the solution and rhs ",
        t2 - t1) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n original mtxX") ;
   DenseMtx_writeForHumanEye(mtxX, msgFile) ;
   fprintf(msgFile, "\n\n original mtxB") ;
   DenseMtx_writeForHumanEye(mtxB, msgFile) ;
   fflush(msgFile) ;
}
if (rc != 1) {
  InpMtx_free(mtxA);
  DenseMtx_free(mtxX);
  DenseMtx_free(mtxB);
  goto end_init;
}

/*
   ------------------------
   read in/create the ETree object
   ------------------------
*/

MARKTIME(t1) ;
if (etreeflag == 0) { /* read in ETree from file */
  if ( strcmp(etreeFileName, "none") == 0 ) 
    fprintf(msgFile, "\n no file to read from") ;
  frontETree = ETree_new() ;
  rc = ETree_readFromFile(frontETree, etreeFileName) ;
  if (rc!=1) 
    fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)",
	    rc, frontETree, etreeFileName) ;
}
else {
  graph = Graph_new() ;
  rc = InpMtx_createGraph(mtxA, graph);
  if (rc!=1) {
    fprintf(msgFile, "\n return value %d from InpMtx_createGraph(%p,%p)",
	    rc, mtxA, graph) ;
    Graph_free(graph);
    goto end_tree;
  }
  if (etreeflag == 1) { /* Via BestOfNDandMS */
    maxdomainsize = 500; maxzeros      = 1000; maxsize       = 64    ;
    frontETree = orderViaBestOfNDandMS(graph, maxdomainsize, maxzeros,
				       maxsize, seed, msglvl, msgFile) ;
  }
  else if (etreeflag == 2) { /* Via MMD */
    frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ;        
  }
  else if (etreeflag == 3) { /* Via MS */
    maxdomainsize = 500;
    frontETree = orderViaMS(graph, maxdomainsize, seed, msglvl, msgFile) ;
  }
  else if (etreeflag == 4) { /* Via ND */
    maxdomainsize = 500;
    frontETree = orderViaND(graph, maxdomainsize, seed, msglvl, msgFile) ;
  }
  Graph_free(graph);

  /*    optionally write out the ETree object    */
  if ( strcmp(etreeFileName, "none") != 0 ) {
    fprintf(msgFile, "\n\n writing out ETree to file %s", 
	    etreeFileName) ;
    ETree_writeToFile(frontETree, etreeFileName) ;
  }
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in/create frontETree from file %s",
	t2 - t1, etreeFileName) ;
if ( rc != 1 ) {
  ETree_free(frontETree);
  goto end_tree;
}

ETree_leftJustify(frontETree) ;
if ( msglvl > 1 ) {
  fprintf(msgFile, "\n\n after reading ETree object from file %s",
	  etreeFileName) ;
  if ( msglvl == 2 ) {
    ETree_writeStats(frontETree, msgFile) ;
  } else {
    ETree_writeForHumanEye(frontETree, msgFile) ;
  }
}
fflush(msgFile) ;
/*
   --------------------------------------------------
   get the permutations, permute the matrix and the 
   front tree, and compute the symbolic factorization
   --------------------------------------------------
*/
MARKTIME(t1) ;
oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get permutations", t2 - t1) ;
MARKTIME(t1) ;
ETree_permuteVertices(frontETree, oldToNewIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute front tree", t2 - t1) ;
MARKTIME(t1) ;
InpMtx_permute(mtxA, IV_entries(oldToNewIV), IV_entries(oldToNewIV)) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute mtxA", t2 - t1) ;
if (  symmetryflag == SPOOLES_SYMMETRIC
   || symmetryflag == SPOOLES_HERMITIAN ) {
   MARKTIME(t1) ;
   InpMtx_mapToUpperTriangle(mtxA) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n CPU %8.3f : map to upper triangle", t2 - t1) ;
}
if ( ! INPMTX_IS_BY_CHEVRONS(mtxA) ) {
   MARKTIME(t1) ;
   InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n CPU %8.3f : change coordinate type", t2 - t1) ;
}
if ( INPMTX_IS_RAW_DATA(mtxA) ) {
   MARKTIME(t1) ;
   InpMtx_changeStorageMode(mtxA, INPMTX_SORTED) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n CPU %8.3f : sort entries ", t2 - t1) ;
}
if ( INPMTX_IS_SORTED(mtxA) ) {
   MARKTIME(t1) ;
   InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n CPU %8.3f : convert to vectors ", t2 - t1) ;
}
MARKTIME(t1) ;
symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : symbolic factorization", t2 - t1) ;
MARKTIME(t1) ;
DenseMtx_permuteRows(mtxB, oldToNewIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute rhs", t2 - t1) ;

/*
   ------------------------------
   initialize the FrontMtx object
   ------------------------------
*/
MARKTIME(t1) ;
frontmtx   = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, NO_LOCK, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL,
              type, symmetryflag, sparsityflag, pivotingflag,
              NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : initialize the front matrix",
        t2 - t1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile,
           "\n nendD  = %d, nentL = %d, nentU = %d",
           frontmtx->nentD, frontmtx->nentL, frontmtx->nentU) ;
   SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n front matrix initialized") ;
   FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
   fflush(msgFile) ;
}
/*
   -----------------
   factor the matrix
   -----------------
*/
nzf       = ETree_nFactorEntries(frontETree, symmetryflag) ;
factorops = ETree_nFactorOps(frontETree, type, symmetryflag) ;
fprintf(msgFile, 
        "\n %d factor entries, %.0f factor ops, %8.3f ratio",
        nzf, factorops, factorops/nzf) ;
IVzero(6, stats) ;
DVzero(9, cpus) ;
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, NO_LOCK, 1) ;
MARKTIME(t1) ;
rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol, 
                                chvmanager, &error, cpus, 
                                stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops",
        t2 - t1, 1.e-6*factorops/(t2-t1)) ;
if ( rootchv != NULL ) {
   fprintf(msgFile, "\n\n factorization did not complete") ;
   for ( chv = rootchv ; chv != NULL ; chv = chv->next ) {
      fprintf(stdout, "\n chv %d, nD = %d, nL = %d, nU = %d",
              chv->id, chv->nD, chv->nL, chv->nU) ;
   }
}
if ( error >= 0 ) {
   fprintf(msgFile, "\n\n error encountered at front %d\n", error) ;
   rc=error ;
   goto end_front;
}
fprintf(msgFile,
        "\n %8d pivots, %8d pivot tests, %8d delayed rows and columns",
        stats[0], stats[1], stats[2]) ;
if ( frontmtx->rowadjIVL != NULL ) {
   fprintf(msgFile,
           "\n %d entries in rowadjIVL", frontmtx->rowadjIVL->tsize) ;
}
if ( frontmtx->coladjIVL != NULL ) {
   fprintf(msgFile,
           ", %d entries in coladjIVL", frontmtx->coladjIVL->tsize) ;
}
if ( frontmtx->upperblockIVL != NULL ) {
   fprintf(msgFile,
           "\n %d fronts, %d entries in upperblockIVL", 
           frontmtx->nfront, frontmtx->upperblockIVL->tsize) ;
}
if ( frontmtx->lowerblockIVL != NULL ) {
   fprintf(msgFile,
           ", %d entries in lowerblockIVL", 
           frontmtx->lowerblockIVL->tsize) ;
}
fprintf(msgFile,
        "\n %d entries in D, %d entries in L, %d entries in U",
        stats[3], stats[4], stats[5]) ;
fprintf(msgFile, "\n %d locks", frontmtx->nlocks) ;
if (  FRONTMTX_IS_SYMMETRIC(frontmtx)
   || FRONTMTX_IS_HERMITIAN(frontmtx) ) {
   int   nneg, npos, nzero ;

   FrontMtx_inertia(frontmtx, &nneg, &nzero, &npos) ;
   fprintf(msgFile, 
           "\n %d negative, %d zero and %d positive eigenvalues",
           nneg, nzero, npos) ;
   fflush(msgFile) ;
}
cputotal = cpus[8] ;
if ( cputotal > 0.0 ) {
   fprintf(msgFile,
   "\n    initialize fronts       %8.3f %6.2f"
   "\n    load original entries   %8.3f %6.2f"
   "\n    update fronts           %8.3f %6.2f"
   "\n    assemble postponed data %8.3f %6.2f"
   "\n    factor fronts           %8.3f %6.2f"
   "\n    extract postponed data  %8.3f %6.2f"
   "\n    store factor entries    %8.3f %6.2f"
   "\n    miscellaneous           %8.3f %6.2f"
   "\n    total time              %8.3f",
   cpus[0], 100.*cpus[0]/cputotal,
   cpus[1], 100.*cpus[1]/cputotal,
   cpus[2], 100.*cpus[2]/cputotal,
   cpus[3], 100.*cpus[3]/cputotal,
   cpus[4], 100.*cpus[4]/cputotal,
   cpus[5], 100.*cpus[5]/cputotal,
   cpus[6], 100.*cpus[6]/cputotal,
   cpus[7], 100.*cpus[7]/cputotal, cputotal) ;
}
if ( msglvl > 1 ) {
  SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
  ChvManager_writeForHumanEye(chvmanager, msgFile) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n front factor matrix") ;
   FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}

/*
   ------------------------------
   post-process the factor matrix
   ------------------------------
*/
MARKTIME(t1) ;
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n front factor matrix after post-processing") ;
   FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
fprintf(msgFile, "\n\n after post-processing") ;
if ( msglvl > 1 ) SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
   ----------------
   solve the system
   ----------------
*/
neqns = mtxB->nrow ;
mtxZ  = DenseMtx_new() ;
DenseMtx_init(mtxZ, type, 0, 0, neqns, nrhs, 1, neqns) ;
zversion=INPMTX_IS_COMPLEX_ENTRIES(mtxA);

for (k=0; k<imethod; k++) {
  DenseMtx_zero(mtxZ) ;
  if ( msglvl > 2 ) {
    fprintf(msgFile, "\n\n rhs") ;
    DenseMtx_writeForHumanEye(mtxB, msgFile) ;
    fflush(stdout) ;
  }
  fprintf(msgFile, "\n\n itemax  %d", itermax) ;
  DVzero(6, cpus) ;
  MARKTIME(t1) ;
  switch ( method[k] ) {
  case BiCGStabR :
    if (zversion)
      rc=zbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		    itermax, conv_tol, msglvl, msgFile);
    else
      rc=bicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		   itermax, conv_tol, msglvl, msgFile);

    break;
  case BiCGStabL :
    if (zversion)
    rc=zbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		  itermax, conv_tol, msglvl, msgFile);
    else
      rc=bicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		   itermax, conv_tol, msglvl, msgFile);
    break;
  case TFQMRR :
    if (zversion)
      rc=ztfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		 itermax, conv_tol, msglvl, msgFile);
    else
      rc=tfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		itermax, conv_tol, msglvl, msgFile);
    break;
  case TFQMRL :
    if (zversion)
      rc=ztfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		 itermax, conv_tol, msglvl, msgFile);
    else
      rc=tfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
		itermax, conv_tol, msglvl, msgFile);
    break;
  case PCGR :
    if (zversion)
      rc=zpcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
	       itermax, conv_tol, msglvl, msgFile);
    else
      rc=pcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
	      itermax, conv_tol, msglvl, msgFile);
    break;
  case PCGL :
    if (zversion)
      rc=zpcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
	       itermax, conv_tol, msglvl, msgFile);
    else
      rc=pcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
	      itermax, conv_tol, msglvl, msgFile);
    break;
  case MLBiCGStabR :
    mtxQ = DenseMtx_new() ;
    DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ;
    Drand_setUniform(&drand, 0.0, 1.0) ;
    DenseMtx_fillRandomEntries(mtxQ, &drand) ;
    if (zversion)
      rc=zmlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, 
		      mtxB, itermax, conv_tol, msglvl, msgFile);
    else
      rc=mlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, 
		     mtxB, itermax, conv_tol, msglvl, msgFile);
    DenseMtx_free(mtxQ) ;
    break;
  case MLBiCGStabL :
    mtxQ = DenseMtx_new() ;
    DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ;
    Drand_setUniform(&drand, 0.0, 1.0) ;
    DenseMtx_fillRandomEntries(mtxQ, &drand) ;
    if (zversion)
      rc=zmlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, 
		      mtxB, itermax, conv_tol, msglvl, msgFile);
    else
      rc=mlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, 
		     mtxB, itermax, conv_tol, msglvl, msgFile);
    DenseMtx_free(mtxQ) ;
    break;
  case BGMRESR:    
    if (zversion)
      fprintf(msgFile, "\n\n *** BGMRESR complex version is not available "
	      "at this moment.   ") ;
    else
      rc=bgmresr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ,
                 mtxB, iterout, itermax, &nouter, &ninner, conv_tol,
                 msglvl, msgFile);
    break;
  case BGMRESL:    
    if (zversion)
      fprintf(msgFile, "\n\n *** BGMRESR complex version is not available "
	      "at this moment.   ") ;
    else
      rc=bgmresl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ,
                 mtxB, iterout, itermax, &nouter, &ninner, conv_tol,
                 msglvl, msgFile);
    break;
  default:
    fprintf(msgFile, "\n\n *** Invalid method number   ") ;
  }
  
  MARKTIME(t2) ;
  fprintf(msgFile, "\n\n CPU %8.3f : solve the system", t2 - t1) ;
  if ( msglvl > 2 ) {
    fprintf(msgFile, "\n\n computed solution") ;
    DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
    fflush(stdout) ;
  }
  
/*
  -------------------------------------------------------------
  permute the computed solution back into the original ordering
  -------------------------------------------------------------
*/
  MARKTIME(t1) ;
  DenseMtx_permuteRows(mtxZ, newToOldIV) ;
  MARKTIME(t2) ;
  fprintf(msgFile, "\n CPU %8.3f : permute solution", t2 - t1) ;
  if ( msglvl > 2 ) {
    fprintf(msgFile, "\n\n permuted solution") ;
    DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
    fflush(stdout) ;
  }
/*
  -------------
  save solution
  -------------
*/
  if (  strcmp(slnFileName, "none") != 0 ) {
    DenseMtx_writeToFile(mtxZ, slnFileName) ;
  }
/*
  -----------------
  compute the error
  -----------------
*/
  if (!strcmp(rhsFileName, "none")) {    
    DenseMtx_sub(mtxZ, mtxX) ;
    if (method[k] <8) {
      mtxQ = DenseMtx_new() ;
      DenseMtx_init(mtxQ, type, 0, -1, neqns, 1, 1, neqns) ;
      rc=DenseMtx_initAsSubmatrix (mtxQ, mtxZ, 0, neqns-1, 0, 0);
      fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxQ)) ;
      DenseMtx_free(mtxQ) ;
    }
    else
      fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxZ)) ;

    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n error") ;
      DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
      fflush(stdout) ;
    }
    if ( msglvl > 1 ) 
      SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
  }
  fprintf(msgFile, "\n---------  End of Method %d -------\n",method[k]) ;
      
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
DenseMtx_free(mtxZ) ;

end_front:
ChvManager_free(chvmanager) ;
SubMtxManager_free(mtxmanager) ;
FrontMtx_free(frontmtx) ;
IVL_free(symbfacIVL) ;
IV_free(oldToNewIV) ;
IV_free(newToOldIV) ;

end_tree:
ETree_free(frontETree) ;

end_init:
DenseMtx_free(mtxB) ;
DenseMtx_free(mtxX) ;

end_read:
InpMtx_free(mtxA) ;

fprintf(msgFile, "\n") ;
fclose(msgFile) ;

return(rc) ; }
예제 #17
0
파일: Setup.c 프로젝트: damiannz/spooles
/*
   ----------------------------------------------------------------
   purpose --

   given InpMtx objects that contain A and B, initialize the bridge
   data structure for the serial factor's, solve's and mvm's.

   data -- pointer to a Bridge object
   pprbtype -- pointer to value containing problem type
     *prbtype = 1 --> A X = B X Lambda, vibration problem
     *prbtype = 2 --> A X = B X Lambda, buckling problem
     *prbtype = 3 --> A X = X Lambda, simple eigenvalue problem
   pneqns  -- pointer to value containing number of equations
   pmxbsz  -- pointer to value containing blocksize
   A       -- pointer to InpMtx object containing A
   B       -- pointer to InpMtx object containing B
   pseed   -- pointer to value containing a random number seed
   pmsglvl -- pointer to value containing a message level
   msgFile -- message file pointer

   return value --
      1 -- normal return
     -1 -- data is NULL
     -2 -- pprbtype is NULL
     -3 -- *pprbtype is invalid
     -4 -- pneqns is NULL
     -5 -- *pneqns is invalid
     -6 -- pmxbsz is NULL
     -7 -- *pmxbsz is invalid
     -8 -- A and B are NULL
     -9 -- pseed is NULL
    -10 -- pmsglvl is NULL
    -11 -- *pmsglvl > 0 and msgFile is NULL

   created -- 98aug10, cca
   ----------------------------------------------------------------
*/
int
Setup (
   void     *data,
   int      *pprbtype,
   int      *pneqns,
   int      *pmxbsz,
   InpMtx   *A,
   InpMtx   *B,
   int      *pseed,
   int      *pmsglvl,
   FILE     *msgFile
) {
Bridge   *bridge = (Bridge *) data ;
double   sigma[2] ;
Graph    *graph ;
int      maxdomainsize, maxsize, maxzeros, msglvl, mxbsz, 
         nedges, neqns, prbtype, seed ;
IVL      *adjIVL ;
#if MYDEBUG > 0
double   t1, t2 ;
MARKTIME(t1) ;
count_Setup++ ;
fprintf(stdout, "\n (%d) Setup()", count_Setup) ;
fflush(stdout) ;
#endif
/*
   --------------------
   check the input data
   --------------------
*/
if ( data == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n data is NULL\n") ;
   return(-1) ;
}
if ( pprbtype == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n prbtype is NULL\n") ;
   return(-2) ;
}
prbtype = *pprbtype ;
if ( prbtype < 1 || prbtype > 3 ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n prbtype = %d, is invalid\n", prbtype) ;
   return(-3) ;
}
if ( pneqns == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pneqns is NULL\n") ;
   return(-4) ;
}
neqns = *pneqns ;
if ( neqns <= 0 ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n neqns = %d, is invalid\n", neqns) ;
   return(-5) ;
}
if ( pmxbsz == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pmxbsz is NULL\n") ;
   return(-6) ;
}
mxbsz = *pmxbsz ;
if ( mxbsz <= 0 ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n *pmxbsz = %d, is invalid\n", mxbsz) ;
   return(-7) ;
}
if ( A == NULL && B == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n A and B are NULL\n") ;
   return(-8) ;
}
if ( pseed == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pseed is NULL\n") ;
   return(-9) ;
}
seed = *pseed ;
if ( pmsglvl == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pmsglvl is NULL\n") ;
   return(-10) ;
}
msglvl = *pmsglvl ;
if ( msglvl > 0 && msgFile == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n msglvl = %d, msgFile = NULL\n", msglvl) ;
   return(-11) ;
}
bridge->msglvl  = msglvl  ;
bridge->msgFile = msgFile ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n inside Setup()"
           "\n neqns = %d, prbtype = %d, mxbsz = %d, seed = %d",
           neqns, prbtype, mxbsz, seed) ;
   if ( A != NULL ) {
      fprintf(msgFile, "\n\n matrix A") ;
      InpMtx_writeForHumanEye(A, msgFile) ;
   }
   if ( B != NULL ) {
      fprintf(msgFile, "\n\n matrix B") ;
      InpMtx_writeForHumanEye(B, msgFile) ;
   }
   fflush(msgFile) ;
}
bridge->prbtype = prbtype ;
bridge->neqns   = neqns   ;
bridge->mxbsz   = mxbsz   ;
bridge->A       = A       ;
bridge->B       = B       ;
bridge->seed    = seed    ;
/*
   ----------------------------
   create and initialize pencil
   ----------------------------
*/
sigma[0] = 1.0; sigma[1] = 0.0;
bridge->pencil = Pencil_new() ;
Pencil_setDefaultFields(bridge->pencil) ;
Pencil_init(bridge->pencil, SPOOLES_REAL, SPOOLES_SYMMETRIC,
            A, sigma, B) ;
/*
   --------------------------------
   convert to row or column vectors
   --------------------------------
*/
if ( A != NULL ) {
   if ( ! INPMTX_IS_BY_ROWS(A) && ! INPMTX_IS_BY_COLUMNS(A) ) {
      InpMtx_changeCoordType(A, INPMTX_BY_ROWS) ;
   }
   if ( ! INPMTX_IS_BY_VECTORS(A) ) {
      InpMtx_changeStorageMode(A, INPMTX_BY_VECTORS) ;
   }
}
if ( B != NULL ) {
   if ( ! INPMTX_IS_BY_ROWS(B) && ! INPMTX_IS_BY_COLUMNS(B) ) {
      InpMtx_changeCoordType(B, INPMTX_BY_ROWS) ;
   }
   if ( ! INPMTX_IS_BY_VECTORS(B) ) {
      InpMtx_changeStorageMode(B, INPMTX_BY_VECTORS) ;
   }
}
/*
   -------------------------------
   create a Graph object for A + B
   -------------------------------
*/
graph  = Graph_new() ;
adjIVL = Pencil_fullAdjacency(bridge->pencil) ;
nedges = IVL_tsize(adjIVL),
Graph_init2(graph, 0, bridge->neqns, 0, nedges,
            bridge->neqns, nedges, adjIVL, NULL, NULL) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n graph of the input matrix") ;
   Graph_writeForHumanEye(graph, msgFile) ;
   fflush(msgFile) ;
}
/*
   ---------------
   order the graph
   ---------------
*/
maxdomainsize = neqns / 64 ;
if ( maxdomainsize == 0 ) {
   maxdomainsize = 1 ;
}
maxzeros  = (int) (0.01*neqns) ;
maxsize   = 64 ;
bridge->frontETree = orderViaBestOfNDandMS(graph, maxdomainsize, 
                     maxzeros, maxsize, bridge->seed, msglvl, msgFile) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n front tree from ordering") ;
   ETree_writeForHumanEye(bridge->frontETree, msgFile) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------------------
   get the old-to-new and new-to-old permutations
   ----------------------------------------------
*/
bridge->oldToNewIV = ETree_oldToNewVtxPerm(bridge->frontETree) ;
bridge->newToOldIV = ETree_newToOldVtxPerm(bridge->frontETree) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n old-to-new permutation") ;
   IV_writeForHumanEye(bridge->oldToNewIV, msgFile) ;
   fprintf(msgFile, "\n\n new-to-old permutation") ;
   IV_writeForHumanEye(bridge->newToOldIV, msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------
   permute the vertices in the front tree
   --------------------------------------
*/
ETree_permuteVertices(bridge->frontETree, bridge->oldToNewIV) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n permuted front etree") ;
   ETree_writeForHumanEye(bridge->frontETree, msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------------
   permute the entries in the pencil. 
   note, after the permutation the 
   entries are mapped into the upper triangle.
   -------------------------------------------
*/
Pencil_permute(bridge->pencil, bridge->oldToNewIV, bridge->oldToNewIV) ;
Pencil_mapToUpperTriangle(bridge->pencil) ;
Pencil_changeCoordType(bridge->pencil, INPMTX_BY_CHEVRONS) ;
Pencil_changeStorageMode(bridge->pencil, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n permuted pencil") ;
   Pencil_writeForHumanEye(bridge->pencil, msgFile) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------
   compute the symbolic factorization
   ----------------------------------
*/
bridge->symbfacIVL = SymbFac_initFromPencil(bridge->frontETree, 
                                            bridge->pencil) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n symbolic factorization") ;
   IVL_writeForHumanEye(bridge->symbfacIVL, msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------------------
   create a FrontMtx object to hold the factorization
   --------------------------------------------------
*/
bridge->frontmtx = FrontMtx_new() ;
/*
   ------------------------------------------------------------
   create a SubMtxManager object to hold the factor submatrices
   ------------------------------------------------------------
*/
bridge->mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(bridge->mtxmanager, NO_LOCK, 0) ;
/*
   ------------------------------------------------------------
   allocate the working objects X and Y for the matrix multiply
   ------------------------------------------------------------
*/
bridge->X = DenseMtx_new() ;
DenseMtx_init(bridge->X, SPOOLES_REAL, 0, 0, neqns, mxbsz, 1, neqns) ;
bridge->Y = DenseMtx_new() ;
DenseMtx_init(bridge->Y, SPOOLES_REAL, 0, 0, neqns, mxbsz, 1, neqns) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Graph_free(graph) ;

#if MYDEBUG > 0
MARKTIME(t2) ;
time_Setup += t2 - t1 ;
fprintf(stdout, ", %8.3f seconds, %8.3f total time", 
        t2 - t1, time_Setup) ;
fflush(stdout) ;
#endif

return(1) ; }
예제 #18
0
파일: util.c 프로젝트: bialk/SPOOLES
/*
   ----------------------------------------------------
   determine the range of the matrix, 
   i.e., the minimum and maximum rows and columns

   if pmincol != NULL then *pmincol = minimum column id
   if pmaxcol != NULL then *pmaxcol = maximum column id
   if pminrow != NULL then *pminrow = minimum row id
   if pmaxrow != NULL then *pmaxrow = maximum row id

   return value ---
      1 -- normal return
     -1 -- mtx is NULL
     -2 -- no entries in the matrix
     -3 -- invalid coordinate type
   
   created -- 98oct15, cca
   ----------------------------------------------------
*/
int
InpMtx_range (
   InpMtx   *mtx,
   int      *pmincol,
   int      *pmaxcol,
   int      *pminrow,
   int      *pmaxrow
) {
int   maxcol, maxrow, mincol, minrow, nent ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_range()"
           "\n mtx is NULL\n") ;
   return(-1) ;
}
if ( (nent = mtx->nent) <= 0 ) {
   fprintf(stderr, "\n fatal error in InpMtx_range()"
           "\n %d entries\n", nent) ;
   return(-2) ;
}
if ( INPMTX_IS_BY_ROWS(mtx) ) {
   int   *rowind = InpMtx_ivec1(mtx) ;
   int   *colind = InpMtx_ivec2(mtx) ;
   int   col, ii, row ;

   minrow = maxrow = rowind[0] ;
   mincol = maxcol = colind[0] ;
   for ( ii = 1 ; ii < nent ; ii++ ) {
      row = rowind[ii] ;
      col = colind[ii] ;
      if ( minrow > row ) {
         minrow = row ;
      } else if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( mincol > col ) {
         mincol = col ;
      } else if ( maxcol < col ) {
         maxcol = col ;
      }
   }
 } else if ( INPMTX_IS_BY_COLUMNS(mtx) ) {
   int   *rowind = InpMtx_ivec2(mtx) ;
   int   *colind = InpMtx_ivec1(mtx) ;
   int   col, ii, row ;

   minrow = maxrow = rowind[0] ;
   mincol = maxcol = colind[0] ;
   for ( ii = 1 ; ii < nent ; ii++ ) {
      row = rowind[ii] ;
      col = colind[ii] ;
      if ( minrow > row ) {
         minrow = row ;
      } else if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( mincol > col ) {
         mincol = col ;
      } else if ( maxcol < col ) {
         maxcol = col ;
      }
   }
 } else if ( INPMTX_IS_BY_CHEVRONS(mtx) ) {
   int   *chvind  = InpMtx_ivec1(mtx) ;
   int   *offsets = InpMtx_ivec2(mtx) ;
   int   col, ii, off, row ;

   if ( (off = offsets[0]) >= 0 ) {
      row = chvind[0], col = row + off ;
   } else {
      col = chvind[0], row = col - off ;
   }
   minrow = maxrow = row ;
   mincol = maxcol = col ;
   for ( ii = 1 ; ii < nent ; ii++ ) {
      if ( (off = offsets[ii]) >= 0 ) {
         row = chvind[ii], col = row + off ;
      } else {
         col = chvind[ii], row = col - off ;
      }
      if ( minrow > row ) {
         minrow = row ;
      } else if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( mincol > col ) {
         mincol = col ;
      } else if ( maxcol < col ) {
         maxcol = col ;
      }
   }
} else {
   fprintf(stderr, "\n fatal error in InpMtx_range()"
           "\n invalid coordType %d\n", mtx->coordType) ;
   return(-3) ;
}
if ( pmincol != NULL ) { *pmincol = mincol ; }
if ( pmaxcol != NULL ) { *pmaxcol = maxcol ; }
if ( pminrow != NULL ) { *pminrow = minrow ; }
if ( pmaxrow != NULL ) { *pmaxrow = maxrow ; }

return(1) ; }
예제 #19
0
/*
   -------------------------------------------------------------------
   purpose --

   given an InpMtx object that contains the structure of A, initialize
     the bridge data structure for the serial factor's and solve's.

   note: all parameters are pointers to be compatible with
         fortran's call by reference.

   return value --
      1 -- normal return
     -1 -- bridge is NULL
     -2 -- mtxA is NULL

   created -- 98sep17, cca
   -------------------------------------------------------------------
*/
int
BridgeMT_setup (
    BridgeMT   *bridge,
    InpMtx     *mtxA
) {
    double   t0, t1, t2 ;
    ETree    *frontETree ;
    FILE     *msgFile ;
    Graph    *graph ;
    int      compressed, msglvl, nedges, neqns, Neqns ;
    IV       *eqmapIV ;
    IVL      *adjIVL, *symbfacIVL ;

    MARKTIME(t0) ;
    /*
       --------------------
       check the input data
       --------------------
    */
    if ( bridge == NULL ) {
        fprintf(stderr, "\n fatal error in BridgeMT_setup()"
                "\n data is NULL\n") ;
        return(-1) ;
    }
    if ( mtxA == NULL ) {
        fprintf(stderr, "\n fatal error in BridgeMT_setup()"
                "\n A is NULL\n") ;
        return(-2) ;
    }
    msglvl  = bridge->msglvl  ;
    msgFile = bridge->msgFile ;
    neqns   = bridge->neqns   ;
    if ( ! (INPMTX_IS_BY_ROWS(mtxA) || INPMTX_IS_BY_COLUMNS(mtxA)) ) {
        /*
           ------------------------------
           change coordinate type to rows
           ------------------------------
        */
        InpMtx_changeCoordType(mtxA, INPMTX_BY_ROWS) ;
    }
    if ( ! INPMTX_IS_BY_VECTORS(mtxA) ) {
        /*
           ------------------------------
           change storage mode to vectors
           ------------------------------
        */
        InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
    }
    /*
       ---------------------------
       create a Graph object for A
       ---------------------------
    */
    MARKTIME(t1) ;
    graph  = Graph_new() ;
    adjIVL = InpMtx_fullAdjacency(mtxA);
    nedges = bridge->nedges = IVL_tsize(adjIVL),
    Graph_init2(graph, 0, neqns, 0, nedges,
                neqns, nedges, adjIVL, NULL, NULL) ;
    MARKTIME(t2) ;
    bridge->cpus[0] += t2 - t1 ;
    if ( msglvl > 1 ) {
        fprintf(msgFile, "\n CPU %8.3f : time to create Graph", t2 - t1) ;
        fflush(msgFile) ;
    }
    if ( msglvl > 3 ) {
        fprintf(msgFile, "\n\n graph of the input matrix") ;
        Graph_writeForHumanEye(graph, msgFile) ;
        fflush(msgFile) ;
    }
    /*
       ------------------
       compress the graph
       ------------------
    */
    MARKTIME(t1) ;
    eqmapIV = Graph_equivMap(graph) ;
    Neqns = bridge->Neqns = 1 + IV_max(eqmapIV) ;
    if ( msglvl > 2 ) {
        fprintf(msgFile, "\n\n graph's equivalence map") ;
        IV_writeForHumanEye(eqmapIV, msgFile) ;
        fflush(msgFile) ;
    }
    if ( Neqns < bridge->compressCutoff * neqns ) {
        Graph   *cgraph ;
        /*
           ------------------
           compress the graph
           ------------------
        */
        cgraph = Graph_compress2(graph, eqmapIV, 1) ;
        Graph_free(graph) ;
        graph = cgraph ;
        compressed = 1 ;
        bridge->Nedges = graph->nedges ;
    } else {
        compressed = 0 ;
    }
    MARKTIME(t2) ;
    bridge->cpus[1] += t2 - t1 ;
    if ( msglvl > 1 ) {
        fprintf(msgFile, "\n CPU %8.3f : time to create compressed graph",
                t2 - t1) ;
        fflush(msgFile) ;
    }
    if ( msglvl > 3 ) {
        fprintf(msgFile, "\n\n graph to order") ;
        Graph_writeForHumanEye(graph, msgFile) ;
        fflush(msgFile) ;
    }
    /*
       ---------------
       order the graph
       ---------------
    */
    MARKTIME(t1) ;
    if ( bridge->maxdomainsize <= 0 ) {
        bridge->maxdomainsize = neqns/32 ;
    }
    if ( bridge->maxdomainsize <= 0 ) {
        bridge->maxdomainsize = 1 ;
    }
    if ( bridge->maxnzeros < 0 ) {
        bridge->maxnzeros = 0.01*neqns ;
    }
    if ( bridge->maxsize < 0 ) {
        bridge->maxsize = neqns ;
    }
    frontETree = orderViaBestOfNDandMS(graph, bridge->maxdomainsize,
                                       bridge->maxnzeros, bridge->maxsize,
                                       bridge->seed, msglvl, msgFile) ;
    MARKTIME(t2) ;
    bridge->cpus[2] += t2 - t1 ;
    if ( msglvl > 1 ) {
        fprintf(msgFile, "\n CPU %8.3f : time to order graph", t2 - t1) ;
        fflush(msgFile) ;
    }
    if ( msglvl > 3 ) {
        fprintf(msgFile, "\n\n front tree from ordering") ;
        ETree_writeForHumanEye(frontETree, msgFile) ;
        fflush(msgFile) ;
    }
    MARKTIME(t1) ;
    if ( compressed == 1 ) {
        ETree   *etree ;
        IVL     *tempIVL ;
        /*
           ----------------------------------------------------------
           compute the symbolic factorization of the compressed graph
           ----------------------------------------------------------
        */
        tempIVL = SymbFac_initFromGraph(frontETree, graph) ;
        /*
           -------------------------------------------------------
           expand the symbolic factorization to the original graph
           -------------------------------------------------------
        */
        symbfacIVL = IVL_expand(tempIVL, eqmapIV) ;
        IVL_free(tempIVL) ;
        /*
           ---------------------
           expand the front tree
           ---------------------
        */
        etree = ETree_expand(frontETree, eqmapIV) ;
        ETree_free(frontETree) ;
        frontETree = etree ;
    } else {
        /*
           --------------------------------------------------------
           compute the symbolic factorization of the original graph
           --------------------------------------------------------
        */
        symbfacIVL = SymbFac_initFromGraph(frontETree, graph) ;
    }
    MARKTIME(t2) ;
    bridge->frontETree = frontETree ;
    bridge->symbfacIVL = symbfacIVL ;
    /*
       ----------------------------------------------
       get the old-to-new and new-to-old permutations
       ----------------------------------------------
    */
    bridge->oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
    bridge->newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
    if ( msglvl > 2 ) {
        fprintf(msgFile, "\n\n old-to-new permutation") ;
        IV_writeForHumanEye(bridge->oldToNewIV, msgFile) ;
        fprintf(msgFile, "\n\n new-to-old permutation") ;
        IV_writeForHumanEye(bridge->newToOldIV, msgFile) ;
        fflush(msgFile) ;
    }
    /*
       ------------------------------------------------------
       overwrite the symbolic factorization with the permuted
       indices and sort the lists into ascending order
       ------------------------------------------------------
    */
    IVL_overwrite(symbfacIVL, bridge->oldToNewIV) ;
    IVL_sortUp(symbfacIVL) ;
    if ( msglvl > 2 ) {
        fprintf(msgFile, "\n\n symbolic factorization") ;
        IVL_writeForHumanEye(symbfacIVL, msgFile) ;
        fflush(msgFile) ;
    }
    /*
       --------------------------------------
       permute the vertices in the front tree
       --------------------------------------
    */
    ETree_permuteVertices(frontETree, bridge->oldToNewIV) ;
    if ( msglvl > 2 ) {
        fprintf(msgFile, "\n\n permuted front etree") ;
        ETree_writeForHumanEye(frontETree, msgFile) ;
        fflush(msgFile) ;
    }
    MARKTIME(t2) ;
    bridge->cpus[3] += t2 - t1 ;
    if ( msglvl > 1 ) {
        fprintf(msgFile, "\n CPU %8.3f : time for symbolic factorization",
                t2 - t1) ;
        fflush(msgFile) ;
    }
    /*
       ------------------------
       free the working storage
       ------------------------
    */
    Graph_free(graph) ;
    IV_free(eqmapIV) ;

    MARKTIME(t2) ;
    bridge->cpus[4] += t2 - t0 ;

    return(1) ;
}
예제 #20
0
파일: util.c 프로젝트: bialk/SPOOLES
/*
   ----------------------------------
   drop entries in the upper triangle

   created -- 98jan28, cca
   ----------------------------------
*/
void
InpMtx_dropUpperTriangle (
   InpMtx   *inpmtx
) {
double   *dvec ;
int      count, ii, nent ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)"
           "\n bad coordType \n", inpmtx) ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
count = 0 ;
if (  INPMTX_IS_REAL_ENTRIES(inpmtx)
   || INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   dvec = InpMtx_dvec(inpmtx) ;
}
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec1[ii] >= ivec2[ii] ) {
         ivec1[count] = ivec1[ii] ;
         ivec2[count] = ivec2[ii] ;
         if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
            dvec[count] = dvec[ii]   ;
         } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
            dvec[2*count]   = dvec[2*ii]   ;
            dvec[2*count+1] = dvec[2*ii+1] ;
         }
         count++ ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec1[ii] <= ivec2[ii] ) {
         ivec1[count] = ivec1[ii] ;
         ivec2[count] = ivec2[ii] ;
         if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
            dvec[count] = dvec[ii]   ;
         } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
            dvec[2*count]   = dvec[2*ii]   ;
            dvec[2*count+1] = dvec[2*ii+1] ;
         }
         count++ ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec2[ii] <= 0 ) {
         ivec1[count] = ivec1[ii] ;
         ivec2[count] = ivec2[ii] ;
         if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
            dvec[count] = dvec[ii]   ;
         } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
            dvec[2*count]   = dvec[2*ii]   ;
            dvec[2*count+1] = dvec[2*ii+1] ;
         }
         count++ ;
      }
   }
}
inpmtx->nent = count ;
IV_setSize(&inpmtx->ivec1IV, count) ;
IV_setSize(&inpmtx->ivec2IV, count) ;
if (  INPMTX_IS_REAL_ENTRIES(inpmtx)
   || INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   DV_setSize(&inpmtx->dvecDV, count) ;
}

return ; }