コード例 #1
0
ファイル: test_scalevec.c プロジェクト: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------------
   test the SubMtx_scale{1,2,3}vec() methods.

   created -- 98may02, cca
   ------------------------------------------
*/
{
SubMtx   *mtxA ;
double   t1, t2 ;
double   *x0, *x1, *x2, *y0, *y1, *y2 ;
Drand    *drand ;
DV       *xdv0, *xdv1, *xdv2, *ydv0, *ydv1, *ydv2 ;
ZV       *xzv0, *xzv1, *xzv2, *yzv0, *yzv1, *yzv2 ;
FILE     *msgFile ;
int      mode, msglvl, nrowA, seed, type ;

if ( argc != 7 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile type nrowA seed"
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    type -- type of matrix A"
           "\n       1 -- real"
           "\n       2 -- complex"
           "\n    mode -- mode of matrix A"
           "\n       7 -- diagonal"
           "\n       8 -- block diagonal symmetric"
           "\n       9 -- block diagonal hermitian (complex only)"
           "\n    nrowA -- # of rows in matrix A"
           "\n    seed  -- random number seed"
           "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type  = atoi(argv[3]) ;
mode  = atoi(argv[4]) ;
nrowA = atoi(argv[5]) ;
seed  = atoi(argv[6]) ;
fprintf(msgFile, "\n %% %s:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% type    = %d"
        "\n %% mode    = %d"
        "\n %% nrowA   = %d"
        "\n %% seed    = %d",
        argv[0], msglvl, argv[2], type, mode, nrowA, seed) ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if ( nrowA <= 0 ) {
   fprintf(stderr, "\n invalid input\n") ;
   exit(-1) ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   ----------------------------
   initialize the X ZV objects
   ----------------------------
*/
MARKTIME(t1) ;
if ( type == SPOOLES_REAL ) {
   xdv0 = DV_new() ;
   DV_init(xdv0, nrowA, NULL) ;
   x0 = DV_entries(xdv0) ;
   Drand_fillDvector(drand, nrowA, x0) ;
   xdv1 = DV_new() ;
   DV_init(xdv1, nrowA, NULL) ;
   x1 = DV_entries(xdv1) ;
   Drand_fillDvector(drand, nrowA, x1) ;
   xdv2 = DV_new() ;
   DV_init(xdv2, nrowA, NULL) ;
   x2 = DV_entries(xdv2) ;
   Drand_fillDvector(drand, nrowA, x2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize X ZV objects",
           t2 - t1) ;
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n %% X DV objects") ;
      fprintf(msgFile, "\n X0 = zeros(%d,1) ;", nrowA) ;
      DV_writeForMatlab(xdv0, "X0", msgFile) ;
      fprintf(msgFile, "\n X1 = zeros(%d,1) ;", nrowA) ;
      DV_writeForMatlab(xdv1, "X1", msgFile) ;
      fprintf(msgFile, "\n X2 = zeros(%d,1) ;", nrowA) ;
      DV_writeForMatlab(xdv2, "X2", msgFile) ;
      fflush(msgFile) ;
   }
} else if ( type == SPOOLES_COMPLEX ) {
   xzv0 = ZV_new() ;
   ZV_init(xzv0, nrowA, NULL) ;
   x0 = ZV_entries(xzv0) ;
   Drand_fillDvector(drand, 2*nrowA, x0) ;
   xzv1 = ZV_new() ;
   ZV_init(xzv1, nrowA, NULL) ;
   x1 = ZV_entries(xzv1) ;
   Drand_fillDvector(drand, 2*nrowA, x1) ;
   xzv2 = ZV_new() ;
   ZV_init(xzv2, nrowA, NULL) ;
   x2 = ZV_entries(xzv2) ;
   Drand_fillDvector(drand, 2*nrowA, x2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize X ZV objects",
           t2 - t1) ;
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n %% X ZV objects") ;
      fprintf(msgFile, "\n X0 = zeros(%d,1) ;", nrowA) ;
      ZV_writeForMatlab(xzv0, "X0", msgFile) ;
      fprintf(msgFile, "\n X1 = zeros(%d,1) ;", nrowA) ;
      ZV_writeForMatlab(xzv1, "X1", msgFile) ;
      fprintf(msgFile, "\n X2 = zeros(%d,1) ;", nrowA) ;
      ZV_writeForMatlab(xzv2, "X2", msgFile) ;
      fflush(msgFile) ;
   }
}
/*
   ---------------------------------
   initialize the Y DV or ZV objects
   ---------------------------------
*/
MARKTIME(t1) ;
if ( type == SPOOLES_REAL ) {
   ydv0 = DV_new() ;
   DV_init(ydv0, nrowA, NULL) ;
   y0 = DV_entries(ydv0) ;
   ydv1 = DV_new() ;
   DV_init(ydv1, nrowA, NULL) ;
   y1 = DV_entries(ydv1) ;
   ydv2 = DV_new() ;
   DV_init(ydv2, nrowA, NULL) ;
   y2 = DV_entries(ydv2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize Y DV objects",
           t2 - t1) ;
} else if ( type == SPOOLES_COMPLEX ) {
   yzv0 = ZV_new() ;
   ZV_init(yzv0, nrowA, NULL) ;
   y0 = ZV_entries(yzv0) ;
   yzv1 = ZV_new() ;
   ZV_init(yzv1, nrowA, NULL) ;
   y1 = ZV_entries(yzv1) ;
   yzv2 = ZV_new() ;
   ZV_init(yzv2, nrowA, NULL) ;
   y2 = ZV_entries(yzv2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize Y ZV objects",
           t2 - t1) ;
}
/*
   -----------------------------------
   initialize the A matrix SubMtx object
   -----------------------------------
*/
seed++ ;
mtxA = SubMtx_new() ;
switch ( mode ) {
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
   SubMtx_initRandom(mtxA, type, mode, 0, 0, nrowA, nrowA, 0, seed) ;
   break ;
default :
   fprintf(stderr, "\n fatal error in test_solve"
           "\n invalid mode = %d", mode) ;
   exit(-1) ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% A SubMtx object") ;
   fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, nrowA) ;
   SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------
   compute Y0 = A * X0
   -------------------
*/
if ( type == SPOOLES_REAL ) {
   DVzero(nrowA, y0) ;
} else if ( type == SPOOLES_COMPLEX ) {
   DVzero(2*nrowA, y0) ;
}
SubMtx_scale1vec(mtxA, y0, x0) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n Z0 = zeros(%d,1) ;", nrowA) ;
   if ( type == SPOOLES_REAL ) {
      DV_writeForMatlab(ydv0, "Z0", msgFile) ;
   } else if ( type == SPOOLES_COMPLEX ) {
      ZV_writeForMatlab(yzv0, "Z0", msgFile) ;
   }
   fprintf(msgFile, "\n err0 = Z0 - A*X0 ;") ;
   fprintf(msgFile, "\n error0 = max(abs(err0))") ;
   fflush(msgFile) ;
}
if ( type == SPOOLES_REAL ) {
   DVzero(nrowA, y0) ;
   DVzero(nrowA, y1) ;
} else if ( type == SPOOLES_COMPLEX ) {
   DVzero(2*nrowA, y0) ;
   DVzero(2*nrowA, y1) ;
}
SubMtx_scale2vec(mtxA, y0, y1, x0, x1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n Z0 = zeros(%d,1) ;", nrowA) ;
   fprintf(msgFile, "\n\n Z1 = zeros(%d,1) ;", nrowA) ;
   if ( type == SPOOLES_REAL ) {
      DV_writeForMatlab(ydv0, "Z0", msgFile) ;
      DV_writeForMatlab(ydv1, "Z1", msgFile) ;
   } else if ( type == SPOOLES_COMPLEX ) {
      ZV_writeForMatlab(yzv0, "Z0", msgFile) ;
      ZV_writeForMatlab(yzv1, "Z1", msgFile) ;
   }
   fprintf(msgFile, "\n err1 = [Z0 Z1] - A*[X0 X1] ;") ;
   fprintf(msgFile, "\n error1 = max(abs(err1))") ;
   fflush(msgFile) ;
}
if ( type == SPOOLES_REAL ) {
   DVzero(nrowA, y0) ;
   DVzero(nrowA, y1) ;
   DVzero(nrowA, y2) ;
} else if ( type == SPOOLES_COMPLEX ) {
   DVzero(2*nrowA, y0) ;
   DVzero(2*nrowA, y1) ;
   DVzero(2*nrowA, y2) ;
}
SubMtx_scale3vec(mtxA, y0, y1, y2, x0, x1, x2) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n Z0 = zeros(%d,1) ;", nrowA) ;
   fprintf(msgFile, "\n\n Z1 = zeros(%d,1) ;", nrowA) ;
   fprintf(msgFile, "\n\n Z2 = zeros(%d,1) ;", nrowA) ;
   if ( type == SPOOLES_REAL ) {
      DV_writeForMatlab(ydv0, "Z0", msgFile) ;
      DV_writeForMatlab(ydv1, "Z1", msgFile) ;
      DV_writeForMatlab(ydv2, "Z2", msgFile) ;
   } else if ( type == SPOOLES_COMPLEX ) {
      ZV_writeForMatlab(yzv0, "Z0", msgFile) ;
      ZV_writeForMatlab(yzv1, "Z1", msgFile) ;
      ZV_writeForMatlab(yzv2, "Z2", msgFile) ;
   }
   fprintf(msgFile, "\n err2 = [Z0 Z1 Z2] - A*[X0 X1 X2] ;") ;
   fprintf(msgFile, "\n error3 = max(abs(err2))") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
SubMtx_free(mtxA) ;
if ( type == SPOOLES_REAL ) {
   DV_free(xdv0) ;
   DV_free(xdv1) ;
   DV_free(xdv2) ;
   DV_free(ydv0) ;
   DV_free(ydv1) ;
   DV_free(ydv2) ;
} else if ( type == SPOOLES_COMPLEX ) {
   ZV_free(xzv0) ;
   ZV_free(xzv1) ;
   ZV_free(xzv2) ;
   ZV_free(yzv0) ;
   ZV_free(yzv1) ;
   ZV_free(yzv2) ;
}
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #2
0
ファイル: test_r1upd.c プロジェクト: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -------------------------------------
   test the Chv_r1upd() method.
   the program's output is a matlab file
   to check correctness of the code.

   created -- 98apr30, cca
   -------------------------------------
*/
{
Chv     *chv ;
double   imag, real, t1, t2 ;
double   *entries ;
Drand    *drand ;
FILE     *msgFile ;
int      ii, irow, jcol, msglvl, ncol, nD, nent, nL, nrow, nU, 
         rc, seed, symflag, tag, type ;
int      *colind, *rowind ;

if ( argc != 8 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile nD nU type symflag seed "
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    nD      -- # of rows and columns in the (1,1) block"
           "\n    nU      -- # of columns in the (1,2) block"
           "\n    type    -- entries type"
           "\n       1 --> real"
           "\n       2 --> complex"
           "\n    symflag -- symmetry flag"
           "\n       0 --> hermitian"
           "\n       1 --> symmetric"
           "\n       2 --> nonsymmetric "
           "\n    seed    -- random number seed"
           "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
nD      = atoi(argv[3]) ;
nU      = atoi(argv[4]) ;
type    = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
seed    = atoi(argv[7]) ;
fprintf(msgFile, "\n %% testChv:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% nD      = %d"
        "\n %% nU      = %d"
        "\n %% type    = %d"
        "\n %% symflag = %d"
        "\n %% seed    = %d",
        msglvl, argv[2], nD, nU, type, symflag, seed) ;
nL = nU ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if (  nD <= 0 || nL < 0 || nU < 0 
   || symflag < 0 || symflag > 3 ) {
   fprintf(stderr, "\n invalid input"
      "\n nD = %d, nL = %d, nU = %d, symflag = %d\n",
           nD, nL, nU, symflag) ;
   exit(-1) ;
}
if ( symflag <= 2 && nL != nU ) {
   fprintf(stderr, "\n invalid input"
      "\n symflag = %d, nL = %d, nU = %d", symflag, nL, nU) ;
   exit(-1) ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   ----------------------------
   initialize the Chv object
   ----------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
/*
   ------------------------------------
   load the entries with random entries
   ------------------------------------
*/
nent    = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
   for ( irow = 0 ; irow < nD ; irow++ ) {
      Chv_complexEntry(chv, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
   }
}
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "a", msgFile) ;
/*
   ---------------------------------------
   write out matlab code for rank-1 update
   ---------------------------------------
*/
fprintf(msgFile,
        "\n nD = %d ;"
        "\n nL = %d ;"
        "\n nU = %d ;"
        "\n nrow = nD + nL ;"
        "\n ncol = nD + nU ;"
        "\n b = a ; "
        "\n d = a(1,1) ;"
        "\n l = a(2:nrow,1) / d ; "
        "\n u = a(1,2:ncol) ; "
        "\n b(2:nrow,2:ncol) = a(2:nrow,2:ncol) - l * u ; "
        "\n u = u / d ; "
        "\n b(1,1) = d ; "
        "\n b(1,2:ncol) = u ; "
        "\n b(2:nrow,1) = l ; ",
        nD, nL, nU) ;
if ( nL > 0 && nU > 0 ) {
   fprintf(msgFile, "\n b(nD+1:nrow,nD+1:ncol) = 0.0 ;") ;
}
/*
   -------------------------
   perform the rank-1 update
   -------------------------
*/
rc = Chv_r1upd(chv) ;
/*
fprintf(msgFile, "\n raw entries vector") ;
DVfprintf(msgFile, 2*nent, entries) ;
*/
fprintf(msgFile, "\n %% matrix entries after update") ;
Chv_writeForMatlab(chv, "c", msgFile) ;
fprintf(msgFile, "\n maxerr = max(max(abs(c-b)))") ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
           
fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #3
0
ファイル: testMMM.c プロジェクト: fransklaver/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------------------------------------
   generate a random matrix and test a matrix-matrix multiply method.
   the output is a matlab file to test correctness.

   created -- 98jan29, cca
 --------------------------------------------------------------------
*/
{
DenseMtx   *X, *Y, *Y2 ;
double     alpha[2] ;
double     alphaImag, alphaReal, t1, t2 ;
double     *zvec ;
Drand      *drand ;
int        col, dataType, ii, msglvl, ncolA, nitem, nops, nrhs, 
           nrowA, nrowX, nrowY, nthread, row, seed, 
           storageMode, symflag, transposeflag ;
int        *colids, *rowids ;
InpMtx     *A ;
FILE       *msgFile ;

if ( argc != 15 ) {
   fprintf(stdout, 
      "\n\n %% usage : %s msglvl msgFile symflag storageMode "
      "\n %%    nrow ncol nent nrhs seed alphaReal alphaImag nthread"
      "\n %%    msglvl   -- message level"
      "\n %%    msgFile  -- message file"
      "\n %%    dataType -- type of matrix entries"
      "\n %%       1 -- real"
      "\n %%       2 -- complex"
      "\n %%    symflag  -- symmetry flag"
      "\n %%       0 -- symmetric"
      "\n %%       1 -- hermitian"
      "\n %%       2 -- nonsymmetric"
      "\n %%    storageMode -- storage mode"
      "\n %%       1 -- by rows"
      "\n %%       2 -- by columns"
      "\n %%       3 -- by chevrons, (requires nrow = ncol)"
      "\n %%    transpose -- transpose flag"
      "\n %%       0 -- Y := Y + alpha * A * X"
      "\n %%       1 -- Y := Y + alpha * A^H * X, nonsymmetric only"
      "\n %%       2 -- Y := Y + alpha * A^T * X, nonsymmetric only"
      "\n %%    nrowA    -- number of rows in A"
      "\n %%    ncolA    -- number of columns in A"
      "\n %%    nitem    -- number of items"
      "\n %%    nrhs     -- number of right hand sides"
      "\n %%    seed     -- random number seed"
      "\n %%    alphaReal -- y := y + alpha*A*x"
      "\n %%    alphaImag -- y := y + alpha*A*x"
      "\n %%    nthread   -- # of threads"
      "\n", argv[0]) ;
   return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n fatal error in %s"
           "\n unable to open file %s\n",
           argv[0], argv[2]) ;
   return(-1) ;
}
dataType      = atoi(argv[3]) ;
symflag       = atoi(argv[4]) ;
storageMode   = atoi(argv[5]) ;
transposeflag = atoi(argv[6]) ;
nrowA         = atoi(argv[7]) ;
ncolA         = atoi(argv[8]) ;
nitem         = atoi(argv[9]) ;
nrhs          = atoi(argv[10]) ;
seed          = atoi(argv[11]) ;
alphaReal     = atof(argv[12]) ;
alphaImag     = atof(argv[13]) ;
nthread       = atoi(argv[14]) ;
fprintf(msgFile, 
        "\n %% %s "
        "\n %% msglvl        -- %d" 
        "\n %% msgFile       -- %s" 
        "\n %% dataType      -- %d" 
        "\n %% symflag       -- %d" 
        "\n %% storageMode   -- %d" 
        "\n %% transposeflag -- %d" 
        "\n %% nrowA         -- %d" 
        "\n %% ncolA         -- %d" 
        "\n %% nitem         -- %d" 
        "\n %% nrhs          -- %d" 
        "\n %% seed          -- %d"
        "\n %% alphaReal     -- %e"
        "\n %% alphaImag     -- %e"
        "\n %% nthread       -- %d"
        "\n",
        argv[0], msglvl, argv[2], dataType, symflag, storageMode,
        transposeflag, nrowA, ncolA, nitem, nrhs, seed, 
        alphaReal, alphaImag, nthread) ;
fflush(msgFile) ;
if ( dataType != 1 && dataType != 2 ) {
   fprintf(stderr, "\n invalid value %d for dataType\n", dataType) ;
   spoolesFatal();
}
if ( symflag != 0 && symflag != 1 && symflag != 2 ) {
   fprintf(stderr, "\n invalid value %d for symflag\n", symflag) ;
   spoolesFatal();
}
if ( storageMode != 1 && storageMode != 2 && storageMode != 3 ) {
   fprintf(stderr, 
           "\n invalid value %d for storageMode\n", storageMode) ;
   spoolesFatal();
}
if ( transposeflag < 0
   || transposeflag > 2 ) {
   fprintf(stderr, "\n error, transposeflag = %d, must be 0, 1 or 2",
           transposeflag) ;
   spoolesFatal();
}
if ( (transposeflag == 1 && symflag != 2)
   || (transposeflag == 2 && symflag != 2) ) {
   fprintf(stderr, "\n error, transposeflag = %d, symflag = %d",
           transposeflag, symflag) ;
   spoolesFatal();
}
if ( transposeflag == 1 && dataType != 2 ) {
   fprintf(stderr, "\n error, transposeflag = %d, dataType = %d",
           transposeflag, dataType) ;
   spoolesFatal();
}
if ( symflag == 1 && dataType != 2 ) {
   fprintf(stderr, 
           "\n symflag = 1 (hermitian), dataType != 2 (complex)") ;
   spoolesFatal();
}
if ( nrowA <= 0 || ncolA <= 0 || nitem <= 0 ) {
   fprintf(stderr, 
           "\n invalid value: nrow = %d, ncol = %d, nitem = %d",
           nrowA, ncolA, nitem) ;
   spoolesFatal();
}
if ( symflag < 2 && nrowA != ncolA ) {
   fprintf(stderr,
           "\n invalid data: symflag = %d, nrow = %d, ncol = %d",
           symflag, nrowA, ncolA) ;
   spoolesFatal();
}
alpha[0] = alphaReal ;
alpha[1] = alphaImag ;
/*
   ----------------------------
   initialize the matrix object
   ----------------------------
*/
A = InpMtx_new() ;
InpMtx_init(A, storageMode, dataType, 0, 0) ;
drand = Drand_new() ;
/*
   ----------------------------------
   generate a vector of nitem triples
   ----------------------------------
*/
rowids = IVinit(nitem,   -1) ;
Drand_setUniform(drand, 0, nrowA) ;
Drand_fillIvector(drand, nitem, rowids) ;
colids = IVinit(nitem,   -1) ;
Drand_setUniform(drand, 0, ncolA) ;
Drand_fillIvector(drand, nitem, colids) ;
Drand_setUniform(drand, 0.0, 1.0) ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
   zvec = DVinit(nitem, 0.0) ;
   Drand_fillDvector(drand, nitem, zvec) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
   zvec = ZVinit(nitem, 0.0, 0.0) ;
   Drand_fillDvector(drand, 2*nitem, zvec) ;
}
/*
   -----------------------------------
   assemble the entries entry by entry
   -----------------------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
}
if ( symflag == 1 ) {
/*
   ----------------
   hermitian matrix
   ----------------
*/
   for ( ii = 0 ; ii < nitem ; ii++ ) {
      if ( rowids[ii] == colids[ii] ) {
         zvec[2*ii+1] = 0.0 ;
      }
      if ( rowids[ii] <= colids[ii] ) {
         row = rowids[ii] ; col = colids[ii] ;
      } else {
         row = colids[ii] ; col = rowids[ii] ;
      }
      InpMtx_inputComplexEntry(A, row, col, zvec[2*ii], zvec[2*ii+1]) ;
   }
} else if ( symflag == 0 ) {
/*
   ----------------
   symmetric matrix
   ----------------
*/
   if ( INPMTX_IS_REAL_ENTRIES(A) ) {
      for ( ii = 0 ; ii < nitem ; ii++ ) {
         if ( rowids[ii] <= colids[ii] ) {
            row = rowids[ii] ; col = colids[ii] ;
         } else {
            row = colids[ii] ; col = rowids[ii] ;
         }
         InpMtx_inputRealEntry(A, row, col, zvec[ii]) ;
      }
   } else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
      for ( ii = 0 ; ii < nitem ; ii++ ) {
         if ( rowids[ii] <= colids[ii] ) {
            row = rowids[ii] ; col = colids[ii] ;
         } else {
            row = colids[ii] ; col = rowids[ii] ;
         }
         InpMtx_inputComplexEntry(A, row, col,
                                  zvec[2*ii], zvec[2*ii+1]) ;
      }
   }
} else {
/*
   -------------------
   nonsymmetric matrix
   -------------------
*/
   if ( INPMTX_IS_REAL_ENTRIES(A) ) {
      for ( ii = 0 ; ii < nitem ; ii++ ) {
         InpMtx_inputRealEntry(A, rowids[ii], colids[ii], zvec[ii]) ;
      }
   } else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
      for ( ii = 0 ; ii < nitem ; ii++ ) {
         InpMtx_inputComplexEntry(A, rowids[ii], colids[ii], 
                                  zvec[2*ii], zvec[2*ii+1]) ;
      }
   }
}
InpMtx_changeStorageMode(A, INPMTX_BY_VECTORS) ;
DVfree(zvec) ;
if ( symflag == 0 || symflag == 1 ) {
   if ( INPMTX_IS_REAL_ENTRIES(A) ) {
      nops = 4*A->nent*nrhs ;
   } else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
      nops = 16*A->nent*nrhs ;
   }
} else {
   if ( INPMTX_IS_REAL_ENTRIES(A) ) {
      nops = 2*A->nent*nrhs ;
   } else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
      nops = 8*A->nent*nrhs ;
   }
}
if ( msglvl > 1 ) {
/*
   -------------------------------------------
   write the assembled matrix to a matlab file
   -------------------------------------------
*/
   InpMtx_writeForMatlab(A, "A", msgFile) ;
   if ( symflag == 0 ) {
      fprintf(msgFile,
              "\n   for k = 1:%d"
              "\n      for j = k+1:%d"
              "\n         A(j,k) = A(k,j) ;"
              "\n      end"
              "\n   end", nrowA, ncolA) ;
   } else if ( symflag == 1 ) {
      fprintf(msgFile,
              "\n   for k = 1:%d"
              "\n      for j = k+1:%d"
              "\n         A(j,k) = ctranspose(A(k,j)) ;"
              "\n      end"
              "\n   end", nrowA, ncolA) ;
   }
}
/*
   -------------------------------
   generate dense matrices X and Y
   -------------------------------
*/
if ( transposeflag == 0 ) {
   nrowX = ncolA ;
   nrowY = nrowA ;
} else {
   nrowX = nrowA ;
   nrowY = ncolA ;
}
X  = DenseMtx_new() ;
Y  = DenseMtx_new() ;
Y2 = DenseMtx_new() ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
   DenseMtx_init(X, SPOOLES_REAL, 0, 0, nrowX, nrhs, 1, nrowX) ;
   Drand_fillDvector(drand, nrowX*nrhs, DenseMtx_entries(X)) ;
   DenseMtx_init(Y, SPOOLES_REAL, 0, 0, nrowY, nrhs, 1, nrowY) ;
   Drand_fillDvector(drand, nrowY*nrhs, DenseMtx_entries(Y)) ;
   DenseMtx_init(Y2, SPOOLES_REAL, 0, 0, nrowY, nrhs, 1, nrowY) ;
   DVcopy(nrowY*nrhs, DenseMtx_entries(Y2), DenseMtx_entries(Y)) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
   DenseMtx_init(X, SPOOLES_COMPLEX, 0, 0, nrowX, nrhs, 1, nrowX) ;
   Drand_fillDvector(drand, 2*nrowX*nrhs, DenseMtx_entries(X)) ;
   DenseMtx_init(Y, SPOOLES_COMPLEX, 0, 0, nrowY, nrhs, 1, nrowY) ;
   Drand_fillDvector(drand, 2*nrowY*nrhs, DenseMtx_entries(Y)) ;
   DenseMtx_init(Y2, SPOOLES_COMPLEX, 0, 0, nrowY, nrhs, 1, nrowY) ;
   DVcopy(2*nrowY*nrhs, DenseMtx_entries(Y2), DenseMtx_entries(Y)) ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, nrhs) ;
   DenseMtx_writeForMatlab(X, "X", msgFile) ;
   fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowY, nrhs) ;
   DenseMtx_writeForMatlab(Y, "Y", msgFile) ;
}
/*
   --------------------------------------------
   perform the matrix-matrix multiply in serial
   --------------------------------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n alpha = %20.12e + %20.2e*i;", 
           alpha[0], alpha[1]);
   fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
}
if ( transposeflag == 0 ) {
   MARKTIME(t1) ;
   if ( symflag == 0 ) {
      InpMtx_sym_mmm(A, Y, alpha, X) ;
   } else if ( symflag == 1 ) {
      InpMtx_herm_mmm(A, Y, alpha, X) ;
   } else if ( symflag == 2 ) {
      InpMtx_nonsym_mmm(A, Y, alpha, X) ;
   }
   MARKTIME(t2) ;
   if ( msglvl > 1 ) {
      DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
      fprintf(msgFile, "\n maxerr = max(Z - Y - alpha*A*X) ") ;
      fprintf(msgFile, "\n") ;
   }
} else if ( transposeflag == 1 ) {
   MARKTIME(t1) ;
   InpMtx_nonsym_mmm_H(A, Y, alpha, X) ;
   MARKTIME(t2) ;
   if ( msglvl > 1 ) {
      DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
      fprintf(msgFile, 
              "\n maxerr = max(Z - Y - alpha*ctranspose(A)*X) ") ;
      fprintf(msgFile, "\n") ;
   }
} else if ( transposeflag == 2 ) {
   MARKTIME(t1) ;
   InpMtx_nonsym_mmm_T(A, Y, alpha, X) ;
   MARKTIME(t2) ;
   if ( msglvl > 1 ) {
      DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
      fprintf(msgFile, 
              "\n maxerr = max(Z - Y - alpha*transpose(A)*X) ") ;
      fprintf(msgFile, "\n") ;
   }
}
fprintf(msgFile, "\n %% %d ops, %.3f time, %.3f serial mflops", 
        nops, t2 - t1, 1.e-6*nops/(t2 - t1)) ;
/*
   --------------------------------------------------------
   perform the matrix-matrix multiply in multithreaded mode
   --------------------------------------------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, 
           "\n alpha = %20.12e + %20.2e*i;", alpha[0], alpha[1]);
   fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
}
if ( transposeflag == 0 ) {
   MARKTIME(t1) ;
   if ( symflag == 0 ) {
      InpMtx_MT_sym_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
   } else if ( symflag == 1 ) {
      InpMtx_MT_herm_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
   } else if ( symflag == 2 ) {
      InpMtx_MT_nonsym_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
   }
   MARKTIME(t2) ;
   if ( msglvl > 1 ) {
      DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
      fprintf(msgFile, "\n maxerr2 = max(Z2 - Y - alpha*A*X) ") ;
      fprintf(msgFile, "\n") ;
   }
} else if ( transposeflag == 1 ) {
   MARKTIME(t1) ;
   InpMtx_MT_nonsym_mmm_H(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
   MARKTIME(t2) ;
   if ( msglvl > 1 ) {
      DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
      fprintf(msgFile, 
              "\n maxerr2 = max(Z2 - Y - alpha*ctranspose(A)*X) ") ;
      fprintf(msgFile, "\n") ;
   }
} else if ( transposeflag == 2 ) {
   MARKTIME(t1) ;
   InpMtx_MT_nonsym_mmm_T(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
   MARKTIME(t2) ;
   if ( msglvl > 1 ) {
      DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
      fprintf(msgFile, 
              "\n maxerr2 = max(Z2 - Y - alpha*transpose(A)*X) ") ;
      fprintf(msgFile, "\n") ;
   }
}
fprintf(msgFile, "\n %% %d ops, %.3f time, %.3f MT mflops",
        nops, t2 - t1, 1.e-6*nops/(t2 - t1)) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
InpMtx_free(A) ;
DenseMtx_free(X) ;
DenseMtx_free(Y) ;
DenseMtx_free(Y2) ;
IVfree(rowids) ;
IVfree(colids) ;
Drand_free(drand) ;

fclose(msgFile) ;

return(1) ; }
コード例 #4
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------
   test the copyEntriesToVector routine

   created -- 98may01, cca,
   ------------------------------------
*/
{
Chv      *chvJ, *chvI ;
double   imag, real, t1, t2 ;
double   *dvec, *entries ;
Drand    *drand ;
FILE     *msgFile ;
int      count, first, ierr, ii, iilast, ipivot, irow, jcol, jj, 
         jjlast, maxnent, mm, msglvl, ncol, nD, nent, nentD, nentL, 
         nentL11, nentL21, nentU, nentU11, nentU12, nL, npivot, nrow,
         nU, pivotingflag, seed, storeflag, symflag, total, type ;
int      *colind, *pivotsizes, *rowind ;

if ( argc != 10 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile nD nU type symflag "
"\n         pivotingflag storeflag seed"
"\n    msglvl    -- message level"
"\n    msgFile   -- message file"
"\n    nD        -- # of rows and columns in the (1,1) block"
"\n    nU        -- # of columns in the (1,2) block"
"\n    type      -- entries type"
"\n        1 --> real"
"\n        2 --> complex"
"\n    symflag   -- symmetry flag"
"\n        0 --> symmetric"
"\n        1 --> nonsymmetric"
"\n    pivotingflag -- pivoting flag"
"\n        if symflag = 1 and pivotingflag = 1 then"
"\n           construct pivotsizes[] vector"
"\n        endif"
"\n    storeflag -- flag to denote how to store entries"
"\n        0 --> store by rows"
"\n        1 --> store by columns"
"\n    seed      -- random number seed"
"\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
nD           = atoi(argv[3]) ;
nU           = atoi(argv[4]) ;
type         = atoi(argv[5]) ;
symflag      = atoi(argv[6]) ;
pivotingflag = atoi(argv[7]) ;
storeflag    = atoi(argv[8]) ;
seed         = atoi(argv[9]) ;
if ( msglvl > 0 ) {
   switch ( storeflag ) {
   case 0  : fprintf(msgFile, "\n\n %% STORE BY ROWS") ; break ;
   case 1  : fprintf(msgFile, "\n\n %% STORE BY COLUMNS") ; break ;
   default : 
      fprintf(stderr, "\n bad value %d for storeflag", storeflag) ;
      break ;
   }
}
nL = nU ;
if ( symflag == SPOOLES_NONSYMMETRIC ) {
   pivotingflag = 0 ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setNormal(drand, 0.0, 1.0) ;
Drand_setSeed(drand, seed) ;
/*
   --------------------------
   initialize the chvJ object
   --------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
        t2 - t1) ;
nent = Chv_nent(chvJ) ;
entries = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
Chv_columnIndices(chvJ, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   Chv_rowIndices(chvJ, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chevron a") ;
   Chv_writeForMatlab(chvJ, "a", msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------
   initialize the chvI object
   --------------------------
*/
MARKTIME(t1) ;
chvI = Chv_new() ;
Chv_init(chvI, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
        t2 - t1) ;
Chv_zero(chvI) ;
Chv_columnIndices(chvI, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
   Chv_rowIndices(chvI, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
if ( symflag == 0 && pivotingflag == 1 ) {
/*
   ------------------------------
   create the pivotsizes[] vector
   ------------------------------
*/
   Drand_setUniform(drand, 1, 2.999) ;
   pivotsizes = IVinit(nD, 0) ;
   Drand_fillIvector(drand, nD, pivotsizes) ;
/*
   fprintf(msgFile, "\n initial pivotsizes[] : ") ;
   IVfp80(msgFile, nD, pivotsizes, 80, &ierr) ;
*/
   for ( npivot = count = 0 ; npivot < nD ; npivot++ ) {
      count += pivotsizes[npivot] ;
      if ( count > nD ) {
         pivotsizes[npivot]-- ;
         count-- ;
      } 
      if ( count == nD ) {
         break ;
      }
   }
   npivot++ ;
/*
   fprintf(msgFile, "\n final pivotsizes[] : ") ;
   IVfp80(msgFile, npivot, pivotsizes, 80, &ierr) ;
*/
} else {
   npivot = 0 ;
   pivotsizes = NULL ;
}
/*
   --------------------------------------------------
   first test: copy lower, diagonal and upper entries
   --------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   nentL = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_LOWER);
} else {
   nentL = 0 ;
}
nentD = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_UPPER) ;
maxnent = nentL ;
if ( maxnent < nentD ) { maxnent = nentD ; }
if ( maxnent < nentU ) { maxnent = nentU ; }
if ( CHV_IS_REAL(chvJ) ) {
   dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   dvec = DVinit(2*maxnent, 0.0) ;
}
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
   --------------------------------------
   copy the entries in the lower triangle,
   then move into the chvI object
   --------------------------------------
*/
   nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                                  dvec, CHV_STRICT_LOWER, storeflag) ;
   if ( nent != nentL ) {
      fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
      exit(-1) ;
   }
   if ( storeflag == 0 ) {
      for ( irow = 0, mm = 0 ; irow < nrow ; irow++ ) {
         jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
         for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jj, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ;
               imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
            }
         }
      }
   } else {
      for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
         for ( irow = jcol + 1 ; irow < nrow ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
/*
fprintf(msgFile, "\n %% mm = %d, a(%d,%d) = %20.12e + %20.12e*i",
        mm, irow, jcol, real, imag) ;
*/
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
}
/*
   ---------------------------------------
   copy the entries in the diagonal matrix
   then move into the chvI object
   ---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
   fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
   exit(-1) ;
}
if ( pivotsizes == NULL ) {
   for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
      if ( CHV_IS_REAL(chvJ) ) {
         real = dvec[mm] ; 
         Chv_setRealEntry(chvI, jcol, jcol, real) ;
      } else if ( CHV_IS_COMPLEX(chvJ) ) {
         real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
         Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
      }
   }
} else {
   for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
      if ( pivotsizes[ipivot] == 1 ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ; 
            Chv_setRealEntry(chvI, irow, irow, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
         }
         mm++ ; irow++ ;
      } else {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow+1, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
            mm++ ; 
            irow += 2 ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
            mm++ ; 
            irow += 2 ;
         }
      }
   }
}
/*
   --------------------------------------
   copy the entries in the upper triangle,
   then move into the chvI object
   --------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_STRICT_UPPER, storeflag) ;
if ( nent != nentU ) {
   fprintf(stderr, "\n error: nentU = %d, nent = %d", nentU, nent) ;
   exit(-1) ;
}
if ( storeflag == 1 ) {
   if ( pivotsizes == NULL ) {
      for ( jcol = mm = 0 ; jcol < ncol ; jcol++ ) {
         iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ; 
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         iilast = jcol - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
         jcol++ ;
         if ( pivotsizes[ipivot] == 2 ) {
            for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, ii, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
               }
            }
            jcol++ ;
         }
      }
      for ( jcol = nD ; jcol < ncol ; jcol++ ) {
         for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
} else {
   if ( pivotsizes == NULL ) {
      for ( irow = mm = 0 ; irow < nD ; irow++ ) {
         for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         if ( pivotsizes[ipivot] == 1 ) {
            for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            irow++ ;
         } else {
            for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow+1, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
               }
            }
            irow += 2 ;
         }
      }
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chevron b") ;
   Chv_writeForMatlab(chvI, "b", msgFile) ;
   fprintf(msgFile, 
           "\n\n emtx1 = abs(a - b) ; enorm1 = max(max(emtx1))") ;
   fflush(msgFile) ;
}
DVfree(dvec) ;
/*
   -----------------------------------------------------
   second test: copy lower (1,1), lower (2,1), diagonal,
                upper(1,1) and upper(1,2) blocks
   -----------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   nentL11 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                              CHV_STRICT_LOWER_11) ;
   nentL21 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                              CHV_LOWER_21) ;
} else {
   nentL11 = 0 ;
   nentL21 = 0 ;
}
nentD   = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU11 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                           CHV_STRICT_UPPER_11) ;
nentU12 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                           CHV_UPPER_12) ;
maxnent = nentL11 ;
if ( maxnent < nentL21 ) { maxnent = nentL21 ; }
if ( maxnent < nentD   ) { maxnent = nentD   ; }
if ( maxnent < nentU11 ) { maxnent = nentU11 ; }
if ( maxnent < nentU12 ) { maxnent = nentU12 ; }
fprintf(msgFile, 
        "\n %% nentL11 = %d, nentL21 = %d"
        "\n %% nentD = %d, nentU11 = %d, nentU12 = %d",
        nentL11, nentL21, nentD, nentU11, nentU12) ;
if ( CHV_IS_REAL(chvJ) ) {
   dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   dvec = DVinit(2*maxnent, 0.0) ;
}
Chv_zero(chvI) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
   ------------------------------------------
   copy the entries in the lower (1,1) block,
   then move into the chvI object
   ------------------------------------------
*/
   nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                                 dvec, CHV_STRICT_LOWER_11, storeflag) ;
   if ( nent != nentL11 ) {
      fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
      exit(-1) ;
   }
   if ( storeflag == 0 ) {
      for ( irow = 0, mm = 0 ; irow < nD ; irow++ ) {
         jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
         for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jj, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
            }
         }
      }
   } else {
      for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
         for ( irow = jcol + 1 ; irow < nD ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
/*
   ------------------------------------------
   copy the entries in the lower (2,1) block,
   then move into the chvI object
   ------------------------------------------
*/
   nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                                  dvec, CHV_LOWER_21, storeflag);
   if ( nent != nentL21 ) {
      fprintf(stderr, "\n error: nentL21 = %d, nent = %d", 
              nentL21, nent) ;
      exit(-1) ;
   }
   if ( storeflag == 0 ) {
      for ( irow = nD, mm = 0 ; irow < nrow ; irow++ ) {
         for ( jcol = 0 ; jcol < nD ; jcol++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
         for ( irow = nD ; irow < nrow ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
}
/*
   ---------------------------------------
   copy the entries in the diagonal matrix
   then move into the chvI object
   ---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
   fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
   exit(-1) ;
}
if ( pivotsizes == NULL ) {
   for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
      if ( CHV_IS_REAL(chvJ) ) {
         real = dvec[mm] ;
         Chv_setRealEntry(chvI, jcol, jcol, real) ;
      } else if ( CHV_IS_COMPLEX(chvJ) ) {
         real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
         Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
      }
   }
} else {
   for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
      if ( pivotsizes[ipivot] == 1 ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
         }
         mm++ ; irow++ ;
      } else {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow+1, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
            mm++ ; 
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
            mm++ ; 
         }
         irow += 2 ;
      }
   }
}
/*
   -----------------------------------------
   copy the entries in the upper (1,1) block
   then move into the chvI object
   -----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_STRICT_UPPER_11, storeflag) ;
if ( nent != nentU11 ) {
   fprintf(stderr, "\n error: nentU11 = %d, nent = %d", nentU11, nent) ;
   exit(-1) ;
}
if ( storeflag == 1 ) {
   if ( pivotsizes == NULL ) {
      for ( jcol = mm = 0 ; jcol < nD ; jcol++ ) {
         iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         iilast = jcol - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
         jcol++ ;
         if ( pivotsizes[ipivot] == 2 ) {
            for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, ii, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
               }
            }
            jcol++ ;
         }
      }
   }
} else {
   if ( pivotsizes == NULL ) {
      for ( irow = mm = 0 ; irow < nD ; irow++ ) {
         for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         if ( pivotsizes[ipivot] == 1 ) {
            for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            irow++ ;
         } else {
            for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow+1, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
               }
            }
            irow += 2 ;
         }
      }
   }
}
/*
   -----------------------------------------
   copy the entries in the upper (1,2) block
   then move into the chvI object
   -----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_UPPER_12, storeflag) ;
if ( nent != nentU12 ) {
   fprintf(stderr, "\n error: nentU12 = %d, nent = %d", nentU12, nent) ;
   exit(-1) ;
}
if ( storeflag == 1 ) {
   for ( jcol = nD, mm = 0 ; jcol < ncol ; jcol++ ) {
      for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, jcol, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
         }
      }
   }
} else {
   for ( irow = mm = 0 ; irow < nD ; irow++ ) {
      for ( jcol = nD ; jcol < ncol ; jcol++, mm++ ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, jcol, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
         }
      }
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chevron b") ;
   Chv_writeForMatlab(chvI, "b", msgFile) ;
   fprintf(msgFile, 
           "\n\n emtx2 = abs(a - b) ; enorm2 = max(max(emtx2))") ;
   fprintf(msgFile, "\n\n [ enorm1 enorm2]") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
if ( pivotsizes != NULL ) {
   IVfree(pivotsizes) ;
}
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;
DVfree(dvec) ;

fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #5
0
ファイル: testGMMM.c プロジェクト: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------------------------
   generate a random matrix and test the InpMtx_*_gmmm*()  
   matrix-matrix multiply methods.
   the output is a matlab file to test correctness.

   created -- 98nov14, cca
   ------------------------------------------------------
*/
{
DenseMtx   *X, *Y ;
double     alpha[2], beta[2] ;
double     alphaImag, alphaReal, betaImag, betaReal ;
Drand      *drand ;
int        dataType, msglvl, ncolA, nitem, nrhs, nrowA, nrowX, 
           nrowY, seed, coordType, rc, symflag, transposeflag ;
InpMtx     *A ;
FILE       *msgFile ;

if ( argc != 16 ) {
   fprintf(stdout, 
   "\n\n %% usage : %s msglvl msgFile symflag coordType transpose"
   "\n %%         nrow ncol nent nrhs seed "
   "\n %%         alphaReal alphaImag betaReal betaImag"
   "\n %%    msglvl   -- message level"
   "\n %%    msgFile  -- message file"
   "\n %%    dataType -- type of matrix entries"
   "\n %%       1 -- real"
   "\n %%       2 -- complex"
   "\n %%    symflag  -- symmetry flag"
   "\n %%       0 -- symmetric"
   "\n %%       1 -- hermitian"
   "\n %%       2 -- nonsymmetric"
   "\n %%    coordType -- storage mode"
   "\n %%       1 -- by rows"
   "\n %%       2 -- by columns"
   "\n %%       3 -- by chevrons, (requires nrow = ncol)"
   "\n %%    transpose -- transpose flag"
   "\n %%       0 -- Y := beta * Y + alpha * A * X"
   "\n %%       1 -- Y := beta * Y + alpha * A^H * X, nonsymmetric only"
   "\n %%       2 -- Y := beta * Y + alpha * A^T * X, nonsymmetric only"
   "\n %%    nrowA     -- number of rows in A"
   "\n %%    ncolA     -- number of columns in A"
   "\n %%    nitem     -- number of items"
   "\n %%    nrhs      -- number of right hand sides"
   "\n %%    seed      -- random number seed"
   "\n %%    alphaReal -- y := beta*y + alpha*A*x"
   "\n %%    alphaImag -- y := beta*y + alpha*A*x"
   "\n %%    betaReal  -- y := beta*y + alpha*A*x"
   "\n %%    betaImag  -- y := beta*y + alpha*A*x"
   "\n", argv[0]) ;
   return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n fatal error in %s"
           "\n unable to open file %s\n",
           argv[0], argv[2]) ;
   return(-1) ;
}
dataType      = atoi(argv[3]) ;
symflag       = atoi(argv[4]) ;
coordType   = atoi(argv[5]) ;
transposeflag = atoi(argv[6]) ;
nrowA         = atoi(argv[7]) ;
ncolA         = atoi(argv[8]) ;
nitem         = atoi(argv[9]) ;
nrhs          = atoi(argv[10]) ;
seed          = atoi(argv[11]) ;
alphaReal     = atof(argv[12]) ;
alphaImag     = atof(argv[13]) ;
betaReal      = atof(argv[14]) ;
betaImag      = atof(argv[15]) ;
fprintf(msgFile, 
        "\n %% %s "
        "\n %% msglvl        -- %d" 
        "\n %% msgFile       -- %s" 
        "\n %% dataType      -- %d" 
        "\n %% symflag       -- %d" 
        "\n %% coordType     -- %d" 
        "\n %% transposeflag -- %d" 
        "\n %% nrowA         -- %d" 
        "\n %% ncolA         -- %d" 
        "\n %% nitem         -- %d" 
        "\n %% nrhs          -- %d" 
        "\n %% seed          -- %d"
        "\n %% alphaReal     -- %e"
        "\n %% alphaImag     -- %e"
        "\n %% betaReal      -- %e"
        "\n %% betaImag      -- %e"
        "\n",
        argv[0], msglvl, argv[2], dataType, symflag, coordType,
        transposeflag, nrowA, ncolA, nitem, nrhs, seed, 
        alphaReal, alphaImag, betaReal, betaImag) ;
fflush(msgFile) ;
if ( dataType != 1 && dataType != 2 ) {
   fprintf(stderr, "\n invalid value %d for dataType\n", dataType) ;
   exit(-1) ;
}
if ( symflag != 0 && symflag != 1 && symflag != 2 ) {
   fprintf(stderr, "\n invalid value %d for symflag\n", symflag) ;
   exit(-1) ;
}
if ( coordType != 1 && coordType != 2 && coordType != 3 ) {
   fprintf(stderr, 
           "\n invalid value %d for coordType\n", coordType) ;
   exit(-1) ;
}
if ( transposeflag < 0
   || transposeflag > 2 ) {
   fprintf(stderr, "\n error, transposeflag = %d, must be 0, 1 or 2",
           transposeflag) ;
   exit(-1) ;
}
if ( (transposeflag == 1 && symflag != 2)
   || (transposeflag == 2 && symflag != 2) ) {
   fprintf(stderr, "\n error, transposeflag = %d, symflag = %d",
           transposeflag, symflag) ;
   exit(-1) ;
}
if ( transposeflag == 1 && dataType != 2 ) {
   fprintf(stderr, "\n error, transposeflag = %d, dataType = %d",
           transposeflag, dataType) ;
   exit(-1) ;
}
if ( symflag == 1 && dataType != 2 ) {
   fprintf(stderr, 
           "\n symflag = 1 (hermitian), dataType != 2 (complex)") ;
   exit(-1) ;
}
if ( nrowA <= 0 || ncolA <= 0 || nitem <= 0 ) {
   fprintf(stderr, 
           "\n invalid value: nrow = %d, ncol = %d, nitem = %d",
           nrowA, ncolA, nitem) ;
   exit(-1) ;
}
if ( symflag < 2 && nrowA != ncolA ) {
   fprintf(stderr,
           "\n invalid data: symflag = %d, nrow = %d, ncol = %d",
           symflag, nrowA, ncolA) ;
   exit(-1) ;
}
alpha[0] = alphaReal ;
alpha[1] = alphaImag ;
beta[0]  = betaReal ;
beta[1]  = betaImag ;
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
   ----------------------------
   initialize the matrix object
   and fill with random entries
   ----------------------------
*/
A = InpMtx_new() ;
InpMtx_init(A, coordType, dataType, 0, 0) ;
rc = InpMtx_randomMatrix(A, dataType, coordType, INPMTX_BY_VECTORS,
                         nrowA, ncolA, symflag, 1, nitem, seed) ;
if ( rc != 1 ) {
   fprintf(stderr, "\n error return %d from InpMtx_randomMatrix()", rc);
   exit(-1) ;
}
/*
   -------------------------------------------
   write the assembled matrix to a matlab file
   -------------------------------------------
*/
InpMtx_writeForMatlab(A, "A", msgFile) ;
if ( symflag == 0 ) {
   fprintf(msgFile,
           "\n   for k = 1:%d"
           "\n      for j = k+1:%d"
           "\n         A(j,k) = A(k,j) ;"
           "\n      end"
           "\n   end", nrowA, ncolA) ;
} else if ( symflag == 1 ) {
   fprintf(msgFile,
           "\n   for k = 1:%d"
           "\n      for j = k+1:%d"
           "\n         A(j,k) = ctranspose(A(k,j)) ;"
           "\n      end"
           "\n   end", nrowA, ncolA) ;
}
/*
   -------------------------------
   generate dense matrices X and Y
   -------------------------------
*/
if ( transposeflag == 0 ) {
   nrowX = ncolA ;
   nrowY = nrowA ;
} else {
   nrowX = nrowA ;
   nrowY = ncolA ;
}
X = DenseMtx_new() ;
Y = DenseMtx_new() ;
DenseMtx_init(X, dataType, 0, 0, nrowX, nrhs, 1, nrowX) ;
DenseMtx_fillRandomEntries(X, drand) ;
DenseMtx_init(Y, dataType, 0, 0, nrowY, nrhs, 1, nrowY) ;
DenseMtx_fillRandomEntries(Y, drand) ;
fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, nrhs) ;
DenseMtx_writeForMatlab(X, "X", msgFile) ;
fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowY, nrhs) ;
DenseMtx_writeForMatlab(Y, "Y", msgFile) ;
/*
   ----------------------------------
   perform the matrix-matrix multiply
   ----------------------------------
*/
fprintf(msgFile, "\n beta = %20.12e + %20.2e*i;", beta[0], beta[1]);
fprintf(msgFile, "\n alpha = %20.12e + %20.2e*i;", alpha[0], alpha[1]);
fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
if ( transposeflag == 0 ) {
   if ( symflag == 0 ) {
      InpMtx_sym_gmmm(A, beta, Y, alpha, X) ;
   } else if ( symflag == 1 ) {
      InpMtx_herm_gmmm(A, beta, Y, alpha, X) ;
   } else if ( symflag == 2 ) {
      InpMtx_nonsym_gmmm(A, beta, Y, alpha, X) ;
   }
   DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
   fprintf(msgFile, "\n maxerr = max(Z - beta*Y - alpha*A*X) ") ;
   fprintf(msgFile, "\n") ;
} else if ( transposeflag == 1 ) {
   InpMtx_nonsym_gmmm_H(A, beta, Y, alpha, X) ;
   DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
   fprintf(msgFile, 
           "\n maxerr = max(Z - beta*Y - alpha*ctranspose(A)*X) ") ;
   fprintf(msgFile, "\n") ;
} else if ( transposeflag == 2 ) {
   InpMtx_nonsym_gmmm_T(A, beta, Y, alpha, X) ;
   DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
   fprintf(msgFile, 
           "\n maxerr = max(Z - beta*Y - alpha*transpose(A)*X) ") ;
   fprintf(msgFile, "\n") ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
InpMtx_free(A) ;
DenseMtx_free(X) ;
DenseMtx_free(Y) ;
Drand_free(drand) ;

fclose(msgFile) ;

return(1) ; }
コード例 #6
0
ファイル: test_solve.c プロジェクト: fransklaver/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -----------------------------
   test the SubMtx_solve() method.

   created -- 98apr15, cca
   -----------------------------
*/
{
SubMtx   *mtxA, *mtxB, *mtxX ;
double   idot, rdot, t1, t2 ;
double   *entB, *entX ;
Drand    *drand ;
FILE     *msgFile ;
int      inc1, inc2, mode, msglvl, ncolA, nentA, nrowA, 
         ncolB, nrowB, ncolX, nrowX, seed, type ;

if ( argc != 9 ) {
   fprintf(stdout, 
       "\n\n usage : %s msglvl msgFile type mode nrowA nentA ncolB seed"
       "\n    msglvl  -- message level"
       "\n    msgFile -- message file"
       "\n    type    -- type of matrix A"
       "\n       1 -- real"
       "\n       2 -- complex"
       "\n    mode    -- mode of matrix A"
       "\n       2 -- sparse stored by rows"
       "\n       3 -- sparse stored by columns"
       "\n       5 -- sparse stored by subrows"
       "\n       6 -- sparse stored by subcolumns"
       "\n       7 -- diagonal"
       "\n       8 -- block diagonal symmetric"
       "\n       9 -- block diagonal hermitian"
       "\n    nrowA   -- # of rows in matrix A"
       "\n    nentA   -- # of entries in matrix A"
       "\n    ncolB   -- # of columns in matrix B"
       "\n    seed    -- random number seed"
       "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   spoolesFatal();
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type  = atoi(argv[3]) ;
mode  = atoi(argv[4]) ;
nrowA = atoi(argv[5]) ;
nentA = atoi(argv[6]) ;
ncolB = atoi(argv[7]) ;
seed  = atoi(argv[8]) ;
fprintf(msgFile, "\n %% %s:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% type    = %d"
        "\n %% mode    = %d"
        "\n %% nrowA   = %d"
        "\n %% nentA   = %d"
        "\n %% ncolB   = %d"
        "\n %% seed    = %d",
        argv[0], msglvl, argv[2], type, mode, 
        nrowA, nentA, ncolB, seed) ;
ncolA = nrowA ;
nrowB = nrowA ;
nrowX = nrowA ;
ncolX = ncolB ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if ( nrowA <= 0 || nentA <= 0 || ncolB <= 0 ) {
   fprintf(stderr, "\n invalid input\n") ;
   spoolesFatal();
}
switch ( type ) {
case SPOOLES_REAL :
   switch ( mode ) {
   case SUBMTX_DENSE_SUBROWS :
   case SUBMTX_SPARSE_ROWS :
   case SUBMTX_DENSE_SUBCOLUMNS :
   case SUBMTX_SPARSE_COLUMNS :
   case SUBMTX_DIAGONAL :
   case SUBMTX_BLOCK_DIAGONAL_SYM :
      break ;
   default :
      fprintf(stderr, "\n invalid mode %d\n", mode) ;
      spoolesFatal();
   }
   break ;
case SPOOLES_COMPLEX :
   switch ( mode ) {
   case SUBMTX_DENSE_SUBROWS :
   case SUBMTX_SPARSE_ROWS :
   case SUBMTX_DENSE_SUBCOLUMNS :
   case SUBMTX_SPARSE_COLUMNS :
   case SUBMTX_DIAGONAL :
   case SUBMTX_BLOCK_DIAGONAL_SYM :
   case SUBMTX_BLOCK_DIAGONAL_HERM :
      break ;
   default :
      fprintf(stderr, "\n invalid mode %d\n", mode) ;
      spoolesFatal();
   }
   break ;
default :
   fprintf(stderr, "\n invalid type %d\n", type) ;
   spoolesFatal();
   break ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   ------------------------------
   initialize the X SubMtx object
   ------------------------------
*/
MARKTIME(t1) ;
mtxX = SubMtx_new() ;
SubMtx_initRandom(mtxX, type, SUBMTX_DENSE_COLUMNS, 0, 0, 
                  nrowX, ncolX, nrowX*ncolX, ++seed) ;
SubMtx_denseInfo(mtxX, &nrowX, &ncolX, &inc1, &inc2, &entX) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize X SubMtx object",
        t2 - t1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% X SubMtx object") ;
   fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, ncolX) ;
   SubMtx_writeForMatlab(mtxX, "X", msgFile) ;
   fflush(msgFile) ;
}
/*
   ------------------------------
   initialize the B SubMtx object
   ------------------------------
*/
MARKTIME(t1) ;
mtxB = SubMtx_new() ;
SubMtx_init(mtxB, type,
            SUBMTX_DENSE_COLUMNS, 0, 0, nrowB, ncolB, nrowB*ncolB) ;
SubMtx_denseInfo(mtxB, &nrowB, &ncolB, &inc1, &inc2, &entB) ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
   if ( SUBMTX_IS_REAL(mtxX) ) {
      DVcopy(nrowB*ncolB, entB, entX) ;
   } else if ( SUBMTX_IS_COMPLEX(mtxX) ) {
      ZVcopy(nrowB*ncolB, entB, entX) ;
   }
   break ;
default :
   if ( SUBMTX_IS_REAL(mtxX) ) {
      DVzero(nrowB*ncolB, entB) ;
   } else if ( SUBMTX_IS_COMPLEX(mtxX) ) {
      DVzero(2*nrowB*ncolB, entB) ;
   }
   break ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize B SubMtx object",
        t2 - t1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% B SubMtx object") ;
   fprintf(msgFile, "\n B = zeros(%d,%d) ;", nrowB, ncolB) ;
   SubMtx_writeForMatlab(mtxB, "B", msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------
   initialize the A matrix SubMtx object
   -------------------------------------
*/
seed++ ;
mtxA = SubMtx_new() ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
   SubMtx_initRandomLowerTriangle(mtxA, type, mode, 0, 0, 
                                  nrowA, ncolA, nentA, seed, 1) ;
   break ;
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
   SubMtx_initRandomUpperTriangle(mtxA, type, mode, 0, 0, 
                                  nrowA, ncolA, nentA, seed, 1) ;
   break ;
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
   SubMtx_initRandom(mtxA, type, mode, 0, 0,
                     nrowA, ncolA, nentA, seed) ;
   break ;
default :
   fprintf(stderr, "\n fatal error in test_solve"
           "\n invalid mode = %d", mode) ;
   spoolesFatal();
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% A SubMtx object") ;
   fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
   SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------------------------
   compute B = A * X (for diagonal and block diagonal)
     or    B = (I + A) * X (for lower and upper triangular)
   --------------------------------------------------------
*/
if ( SUBMTX_IS_REAL(mtxA) ) {
   DV       *colDV, *rowDV ;
   double   value, *colX, *rowA, *pBij, *pXij ;
   int      irowA, jcolX ;

   colDV = DV_new() ;
   DV_init(colDV, nrowA, NULL) ;
   colX = DV_entries(colDV) ;
   rowDV = DV_new() ;
   DV_init(rowDV, nrowA, NULL) ;
   rowA = DV_entries(rowDV) ;
   for ( jcolX = 0 ; jcolX < ncolB ; jcolX++ ) {
      SubMtx_fillColumnDV(mtxX, jcolX, colDV) ;
      for ( irowA = 0 ; irowA < nrowA ; irowA++ ) {
         SubMtx_fillRowDV(mtxA, irowA, rowDV) ;
         SubMtx_locationOfRealEntry(mtxX, irowA, jcolX, &pXij) ;
         SubMtx_locationOfRealEntry(mtxB, irowA, jcolX, &pBij) ;
         value = DVdot(nrowA, rowA, colX) ;
         switch ( mode ) {
         case SUBMTX_DENSE_SUBROWS :
         case SUBMTX_SPARSE_ROWS :
         case SUBMTX_DENSE_SUBCOLUMNS :
         case SUBMTX_SPARSE_COLUMNS :
            *pBij = *pXij + value ;
            break ;
         case SUBMTX_DIAGONAL :
         case SUBMTX_BLOCK_DIAGONAL_SYM :
            *pBij = value ;
            break ;
         }
      }
   }
   DV_free(colDV) ;
   DV_free(rowDV) ;
} else if ( SUBMTX_IS_COMPLEX(mtxA) ) {
   ZV       *colZV, *rowZV ;
   double   *colX, *rowA, *pBIij, *pBRij, *pXIij, *pXRij ;
   int      irowA, jcolX ;

   colZV = ZV_new() ;
   ZV_init(colZV, nrowA, NULL) ;
   colX = ZV_entries(colZV) ;
   rowZV = ZV_new() ;
   ZV_init(rowZV, nrowA, NULL) ;
   rowA = ZV_entries(rowZV) ;
   for ( jcolX = 0 ; jcolX < ncolB ; jcolX++ ) {
      SubMtx_fillColumnZV(mtxX, jcolX, colZV) ;
      for ( irowA = 0 ; irowA < nrowA ; irowA++ ) {
         SubMtx_fillRowZV(mtxA, irowA, rowZV) ;
         SubMtx_locationOfComplexEntry(mtxX, 
                                       irowA, jcolX, &pXRij, &pXIij) ;
         SubMtx_locationOfComplexEntry(mtxB, 
                                       irowA, jcolX, &pBRij, &pBIij) ;
         ZVdotU(nrowA, rowA, colX, &rdot, &idot) ;
         switch ( mode ) {
         case SUBMTX_DENSE_SUBROWS :
         case SUBMTX_SPARSE_ROWS :
         case SUBMTX_DENSE_SUBCOLUMNS :
         case SUBMTX_SPARSE_COLUMNS :
            *pBRij = *pXRij + rdot ;
            *pBIij = *pXIij + idot ;
            break ;
         case SUBMTX_DIAGONAL :
         case SUBMTX_BLOCK_DIAGONAL_SYM :
         case SUBMTX_BLOCK_DIAGONAL_HERM :
            *pBRij = rdot ;
            *pBIij = idot ;
            break ;
         }
      }
   }
   ZV_free(colZV) ;
   ZV_free(rowZV) ;
}
/*
   ----------------------
   print out the matrices
   ----------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% X SubMtx object") ;
   fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, ncolX) ;
   SubMtx_writeForMatlab(mtxX, "X", msgFile) ;
   fprintf(msgFile, "\n\n %% A SubMtx object") ;
   fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
   SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fprintf(msgFile, "\n\n %% B SubMtx object") ;
   fprintf(msgFile, "\n B = zeros(%d,%d) ;", nrowB, ncolB) ;
   SubMtx_writeForMatlab(mtxB, "B", msgFile) ;
   fflush(msgFile) ;
}
/*
   -----------------
   check with matlab
   -----------------
*/
if ( msglvl > 1 ) {
   switch ( mode ) {
   case SUBMTX_DENSE_SUBROWS :
   case SUBMTX_SPARSE_ROWS :
   case SUBMTX_DENSE_SUBCOLUMNS :
   case SUBMTX_SPARSE_COLUMNS :
      fprintf(msgFile,
              "\n\n emtx   = abs(B - X - A*X) ;"
              "\n\n condA = cond(eye(%d,%d) + A)"
              "\n\n maxabsZ = max(max(abs(emtx))) ", nrowA, nrowA) ;
      fflush(msgFile) ;
      break ;
   case SUBMTX_DIAGONAL :
   case SUBMTX_BLOCK_DIAGONAL_SYM :
   case SUBMTX_BLOCK_DIAGONAL_HERM :
      fprintf(msgFile,
              "\n\n emtx   = abs(B - A*X) ;"
              "\n\n condA = cond(A)"
              "\n\n maxabsZ = max(max(abs(emtx))) ") ;
      fflush(msgFile) ;
      break ;
   }
}
/*
   ----------------------------------------
   compute the solve DY = B or (I + A)Y = B
   ----------------------------------------
*/
SubMtx_solve(mtxA, mtxB) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% Y SubMtx object") ;
   fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowB, ncolB) ;
   SubMtx_writeForMatlab(mtxB, "Y", msgFile) ;
   fprintf(msgFile,
           "\n\n %% solerror   = abs(Y - X) ;"
           "\n\n solerror   = abs(Y - X) ;"
           "\n\n maxabserror = max(max(solerror)) ") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
SubMtx_free(mtxA) ;
SubMtx_free(mtxX) ;
SubMtx_free(mtxB) ;
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #7
0
ファイル: test_assmbChv.c プロジェクト: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------
   test the Chv_assembleChv() method.

   created -- 98apr18, cca
   ------------------------------------
*/
{
Chv     *chvI, *chvJ ;
double   imag, real, t1, t2 ;
double   *entriesI, *entriesJ ;
Drand    *drand ;
FILE     *msgFile ;
int      ierr, ii, irow, jcol,
         lastcol, msglvl, ncolI, ncolJ, nDI, nDJ, nentI, nentJ, 
         nrowI, nrowJ, nUI, nUJ, seed, symflag, type ;
int      *colindI, *colindJ, *rowindI, *rowindJ, *temp ;

if ( argc != 10 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile nDJ nUJ nDI nUI type symflag seed "
"\n    msglvl  -- message level"
"\n    msgFile -- message file"
"\n    nDJ     -- # of rows and columns in the (1,1) block"
"\n    nUJ     -- # of columns in the (1,2) block"
"\n    nDI     -- # of rows and columns in the (1,1) block"
"\n    nUI     -- # of columns in the (1,2) block"
"\n    type    -- entries type"
"\n       1 --> real"
"\n       2 --> complex"
"\n    symflag -- symmetry flag"
"\n       0 --> symmetric"
"\n       1 --> hermitian"
"\n       2 --> nonsymmetric"
"\n    seed    -- random number seed"
"\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
nDJ     = atoi(argv[3]) ;
nUJ     = atoi(argv[4]) ;
nDI     = atoi(argv[5]) ;
nUI     = atoi(argv[6]) ;
type    = atoi(argv[7]) ;
symflag = atoi(argv[8]) ;
seed    = atoi(argv[9]) ;
if (  nDJ <= 0 || nUJ < 0 
   || nDI <= 0 || nUI < 0 
   || nDI >= nDJ || (nDI + nUI) >= (nDJ + nUJ)
   || nUI >= (nDJ + nUJ - nDI)
   || (  symflag != SPOOLES_SYMMETRIC
      && symflag != SPOOLES_HERMITIAN
      && symflag != SPOOLES_NONSYMMETRIC) ) {
   fprintf(stderr, "\n invalid input"
      "\n nDJ = %d, nUJ = %d, nDI = %d, nUI = %d, symflag = %d\n",
           nDJ, nUJ, nDI, nUI, symflag) ;
   exit(-1) ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
   ----------------------------
   initialize the ChvJ object
   ----------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nDJ, nUJ, nUJ, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chvJ, &ncolJ, &colindJ) ;
temp = IVinit(2*(nDJ+nUJ), -1) ;
IVramp(2*(nDJ+nUJ), temp, 0, 1) ;
IVshuffle(2*(nDJ+nUJ), temp, ++seed) ;
IVcopy(ncolJ, colindJ, temp) ;
IVfree(temp) ;
IVqsortUp(ncolJ, colindJ) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   Chv_rowIndices(chvJ, &nrowJ, &rowindJ) ;
   IVcopy(nrowJ, rowindJ, colindJ) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n %% column indices") ;
   IVfprintf(msgFile, ncolJ, colindJ) ;
}
lastcol = colindJ[ncolJ-1] ;
nentJ = Chv_nent(chvJ) ;
entriesJ = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
   Drand_fillDvector(drand, nentJ, entriesJ) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   Drand_fillDvector(drand, 2*nentJ, entriesJ) ;
}
if ( CHV_IS_HERMITIAN(chvJ) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nDJ ; irow++ ) {
      Chv_complexEntry(chvJ, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chvJ, irow, irow, real, 0.0) ;
   }
}
/*
   ---------------------------
   initialize the ChvI object
   ---------------------------
*/
chvI = Chv_new() ;
Chv_init(chvI, 0, nDI, nUI, nUI, type, symflag) ;
Chv_columnIndices(chvI, &ncolI, &colindI) ;
temp = IVinit(ncolJ, -1) ;
IVramp(ncolJ, temp, 0, 1) ;
while ( 1 ) {
   IVshuffle(ncolJ, temp, ++seed) ;
   IVqsortUp(ncolI, temp) ;
   if ( temp[0] < nDJ ) {
      break ;
   }
}
for ( ii = 0 ; ii < ncolI ; ii++ ) {
   colindI[ii] = colindJ[temp[ii]] ;
}
IVfree(temp) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
   Chv_rowIndices(chvI, &nrowI, &rowindI) ;
   IVcopy(nrowI, rowindI, colindI) ;
}
nentI = Chv_nent(chvI) ;
entriesI = Chv_entries(chvI) ;
if ( CHV_IS_REAL(chvI) ) {
   Drand_fillDvector(drand, nentI, entriesI) ;
} else if ( CHV_IS_COMPLEX(chvI) ) {
   Drand_fillDvector(drand, 2*nentI, entriesI) ;
}
if ( CHV_IS_HERMITIAN(chvI) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nDI ; irow++ ) {
      Chv_complexEntry(chvI, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chvI, irow, irow, real, 0.0) ;
   }
}
/*
   --------------------------------------------------
   write out the two chevron objects to a matlab file
   --------------------------------------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chvJ, "a", msgFile) ;
   fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chvI, "b", msgFile) ;
}
/*
   ---------------------------------------------
   assemble the chvI object into the chvJ object
   ---------------------------------------------
*/
Chv_assembleChv(chvJ, chvI) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n %% after assembly") ;
   fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chvJ, "c", msgFile) ;
}
/*
   -----------------
   compute the error
   -----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (b + a))))") ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #8
0
ファイル: test_frobNorm.c プロジェクト: fransklaver/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -----------------------------------------------
   test the DenseMtx_frobNorm routine.

   when msglvl > 1, the output of this program
   can be fed into Matlab to check for errors

   created -- 98dec03, ycp
   -----------------------------------------------
*/
{
DenseMtx   *A ;
double     t1, t2, value ;
Drand      *drand ;
FILE       *msgFile ;
int        inc1, inc2, msglvl, nrow, ncol, seed, type ;

if ( argc != 9 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile type nrow ncol inc1 inc2 "
"\n         , seed "
"\n    msglvl  -- message level"
"\n    msgFile -- message file"
"\n    type    -- entries type"
"\n      1 -- real"
"\n      2 -- complex"
"\n    nrow    -- # of rows "
"\n    ncol    -- # of columns "
"\n    inc1    -- row increment "
"\n    inc2    -- column increment "
"\n    seed    -- random number seed"
"\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   spoolesFatal();
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type = atoi(argv[3]) ;
nrow = atoi(argv[4]) ;
ncol = atoi(argv[5]) ;
inc1 = atoi(argv[6]) ;
inc2 = atoi(argv[7]) ;
if (   type < 1 || type > 2 || nrow < 0 || ncol < 0 
    || inc1 < 1 || inc2 < 1 ) {
   fprintf(stderr, 
       "\n fatal error, type %d, nrow %d, ncol %d, inc1 %d, inc2 %d",
       type, nrow, ncol, inc1, inc2) ;
   spoolesFatal();
}
seed   = atoi(argv[8]) ;
fprintf(msgFile, "\n\n %% %s :"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% type    = %d"
        "\n %% nrow    = %d"
        "\n %% ncol    = %d"
        "\n %% inc1    = %d"
        "\n %% inc2    = %d"
        "\n %% seed    = %d"
        "\n",
        argv[0], msglvl, argv[2], type, nrow, ncol, inc1, inc2, seed) ;
/*
   ----------------------------
   initialize the matrix object
   ----------------------------
*/
MARKTIME(t1) ;
A = DenseMtx_new() ;
DenseMtx_init(A, type, 0, 0, nrow, ncol, inc1, inc2) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix object",
        t2 - t1) ;
MARKTIME(t1) ;
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
seed++ ;
Drand_setUniform(drand, -1.0, 1.0) ;
DenseMtx_fillRandomEntries(A, drand) ;
MARKTIME(t2) ;
fprintf(msgFile, 
      "\n %% CPU : %.3f to fill matrix with random numbers", t2 - t1) ;
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n matrix A") ;
   DenseMtx_writeForHumanEye(A, msgFile) ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n %% matrix A") ;
   fprintf(msgFile, "\n nrow = %d ;", nrow) ;
   fprintf(msgFile, "\n ncol = %d ;", ncol) ;
   fprintf(msgFile, "\n");
   DenseMtx_writeForMatlab(A, "A", msgFile) ;
}
/*
   --------------------------
   compute the frobenius norm 
   --------------------------
*/
  value = DenseMtx_frobNorm(A);

if ( msglvl > 1 ) {
   fprintf(msgFile, "\n %% Frobenius Norm = %e", value) ;
   fprintf(msgFile, "\n");
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
DenseMtx_free(A) ;
Drand_free(drand) ;

return(1) ; }
コード例 #9
0
ファイル: test_mmm.c プロジェクト: fransklaver/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -------------------------------------------------------
   test the DenseMtx_mmm routine.

   C = alpha*A*B + beta*C, where A, B and C  are DenseMtx. 
       alpha and beta are scalars.

   when msglvl > 1, the output of this program
   can be fed into Matlab to check for errors

   created -- 98dec14, ycp
   -------------------------------------------------------
*/
{
DenseMtx   *mtxA, *mtxB, *mtxC;
double     t1, t2, value[2] = {1.0, 1.0} ;
Drand      *drand ;
FILE       *msgFile ;
int        i, j, k, msglvl, nrow, nk, ncol, cnrow, cncol, seed, type ;
int        ainc1, ainc2, binc1, binc2, cinc1, cinc2;
double     alpha[2], beta[2], one[2] = {1.0, 0.0}, rvalue;
char       A_opt[1]=" ", B_opt[1]=" ";

if ( argc != 20 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile type nrow nk ncol ainc1 ainc2 binc1 "
"\n         binc2 cinc1 cinc2 A_opt B_opt ralpha ialpha rbeta ibeta seed "
"\n    msglvl  -- message level"
"\n    msgFile -- message file"
"\n    type    -- entries type"
"\n      1 -- real"
"\n      2 -- complex"
"\n    nrow    -- # of rows of mtxA "
"\n    nk      -- # of columns of mtxA "
"\n    ncol    -- # of columns of mtxB "
"\n    ainc1   -- A row increment "
"\n    ainc2   -- A column increment "
"\n    binc1   -- B row increment "
"\n    binc2   -- B column increment "
"\n    binc1   -- C row increment "
"\n    binc2   -- C column increment "
"\n    A_opt   -- A option "
"\n    B_opt   -- B option "
"\n    ralpha  -- real(alpha)"
"\n    ialpha  -- imag(alpha)"
"\n    rbeta   -- real(beta)"
"\n    ibeta   -- imag(beta)"
"\n    seed    -- random number seed"
"\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   spoolesFatal();
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type = atoi(argv[3]) ;
nrow = atoi(argv[4]) ;
nk   = atoi(argv[5]) ;
ncol = atoi(argv[6]) ;
ainc1= atoi(argv[7]) ;
ainc2= atoi(argv[8]) ;
binc1= atoi(argv[9]) ;
binc2= atoi(argv[10]) ;
cinc1= atoi(argv[11]) ;
cinc2= atoi(argv[12]) ;
if (  type < 1 ||  type > 2 ||  nrow < 0 ||  ncol < 0 ||
     ainc1 < 1 || ainc2 < 1 || binc1 < 1 || binc2 < 1  ) {
   fprintf(stderr, 
       "\n fatal error, type %d, nrow %d, ncol %d, ainc1 %d, ainc2 %d"
       ", binc1 %d, binc2 %d", type, nrow, ncol, ainc1, ainc2, binc1, binc2) ;
   spoolesFatal();
}
A_opt[0] = *argv[13] ;
B_opt[0] = *argv[14] ;
alpha[0]= atof (argv[15]);
alpha[1]= atof (argv[16]);
beta[0] = atof (argv[17]);
beta[1] = atof (argv[18]);
seed    = atoi (argv[19]) ;
fprintf(msgFile, "\n\n %% %s :"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% type    = %d"
        "\n %% nrow    = %d"
        "\n %% nk      = %d"
        "\n %% ncol    = %d"
        "\n %% ainc1   = %d"
        "\n %% ainc2   = %d"
        "\n %% binc1   = %d"
        "\n %% binc2   = %d"
        "\n %% cinc1   = %d"
        "\n %% cinc2   = %d"
        "\n %% a_opt   = %c"
        "\n %% b_opt   = %c"
        "\n %% ralpha  = %e"
        "\n %% ialpha  = %e"
        "\n %% rbeta   = %e"
        "\n %% ibeta   = %e"
        "\n %% seed    = %d"
        "\n",
        argv[0], msglvl, argv[2], type, nrow, nk, ncol, ainc1, ainc2, 
        binc1, binc2, cinc1, cinc2, A_opt[0], B_opt[0], alpha[0], 
        alpha[1], beta[0], beta[1], seed) ;
/*
   ----------------------------
   initialize the matrix object
   ----------------------------
*/
MARKTIME(t1) ;
mtxA = DenseMtx_new() ;
DenseMtx_init(mtxA, type, 0, 0, nrow, nk, ainc1, ainc2) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix object",
        t2 - t1) ;
MARKTIME(t1) ;
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
seed++ ;
Drand_setUniform(drand, -1.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxA, drand) ;
MARKTIME(t2) ;
fprintf(msgFile, 
      "\n %% CPU : %.3f to fill matrix A with random numbers", t2 - t1) ;
MARKTIME(t1) ;
mtxB = DenseMtx_new() ;
DenseMtx_init(mtxB, type, 0, 0, nk, ncol, binc1, binc2) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix object",
        t2 - t1) ;
MARKTIME(t1) ;
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
seed++ ;
Drand_setUniform(drand, -1.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxB, drand) ;
MARKTIME(t2) ;
fprintf(msgFile,
      "\n %% CPU : %.3f to fill matrix B with random numbers", t2 - t1) ;

cnrow = nrow;
cncol = ncol;
MARKTIME(t1) ;
mtxC = DenseMtx_new() ;
if ( A_opt[0] == 't' || A_opt[0] == 'T' || 
     A_opt[0] == 'c' || A_opt[0] == 'C') {
  cnrow = nk; 
}
if ( B_opt[0] == 't' || B_opt[0] == 'T' ||
     B_opt[0] == 'c' || B_opt[0] == 'C') {
  cncol = nk; 
}
if ( cinc1 == 1 && cinc2 == nrow ){ /* stored by column */
  cinc1 = 1;
  cinc2 = cnrow;
} else { /* stored by row */
  cinc1 = cncol;
  cinc2 = 1; 
}
DenseMtx_init(mtxC, type, 0, 0, cnrow, cncol, cinc1, cinc2) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix object",
        t2 - t1) ;
MARKTIME(t1) ;
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
seed++ ;
Drand_setUniform(drand, -1.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxC, drand) ;
MARKTIME(t2) ;
fprintf(msgFile,
      "\n %% CPU : %.3f to fill matrix C with random numbers", t2 - t1) ;

if ( msglvl > 3 ) {
   fprintf(msgFile, "\n matrix A") ;
   DenseMtx_writeForHumanEye(mtxA, msgFile) ;
   fprintf(msgFile, "\n matrix B") ;
   DenseMtx_writeForHumanEye(mtxB, msgFile) ;
   fprintf(msgFile, "\n matrix C") ;
   DenseMtx_writeForHumanEye(mtxC, msgFile) ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% beta  = (%f, %f)", beta[0], beta[1]) ;
   fprintf(msgFile, "\n %% alpha = (%f, %f)\n", alpha[0], alpha[1]) ;
   fprintf(msgFile, "\n %% matrix A") ;
   fprintf(msgFile, "\n nrow = %d ;", nrow) ;
   fprintf(msgFile, "\n ncol = %d ;", nk) ;
   DenseMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fprintf(msgFile, "\n");
   fprintf(msgFile, "\n %% matrix B") ;
   fprintf(msgFile, "\n nrow = %d ;", nk) ;
   fprintf(msgFile, "\n ncol = %d ;", ncol) ;
   DenseMtx_writeForMatlab(mtxB, "B", msgFile) ;
   fprintf(msgFile, "\n");
   fprintf(msgFile, "\n %% matrix C") ;
   fprintf(msgFile, "\n nrow = %d ;", cnrow) ;
   fprintf(msgFile, "\n ncol = %d ;", cncol) ;
   DenseMtx_writeForMatlab(mtxC, "C", msgFile) ;
}
/*
   --------------------------
   performs the matrix-matrix operations
   C = alpha*(A)*(B) + beta*C
   --------------------------
*/
   DenseMtx_mmm(A_opt, B_opt, &beta, mtxC, &alpha, mtxA, mtxB);

if ( msglvl > 1 ) {
   fprintf(msgFile, "\n");
   fprintf(msgFile, "\n %% *** Output matrix C ***") ;
   fprintf(msgFile, "\n nrow = %d ;", cnrow) ;
   fprintf(msgFile, "\n ncol = %d ;", cncol) ;
   DenseMtx_writeForMatlab(mtxC, "C", msgFile) ;
   fprintf(msgFile, "\n");
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
DenseMtx_free(mtxA) ;
DenseMtx_free(mtxB) ;
DenseMtx_free(mtxC) ;
Drand_free(drand)   ;

return(1) ; }
コード例 #10
0
ファイル: test_update.c プロジェクト: fransklaver/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -------------------------------------
   test the Chv_update{H,S,N}() methods.
   T := T - U^T * D * U
   T := T - U^H * D * U
   T := T - L   * D * U

   created -- 98apr23, cca
   -------------------------------------
*/
{
Chv     *chvT ;
SubMtx     *mtxD, *mtxL, *mtxU ;
double   imag, ops, real, t1, t2 ;
Drand    *drand ;
DV       *tempDV ;
FILE     *msgFile ;
int      irow, msglvl, ncolT, nDT, ncolU, nentT, nentU, nrowD, 
         nrowL, nrowT, offset, seed, size, sparsityflag, symflag, type ;
int      *colindT, *colindU, *ivec, *rowindL, *rowindT ;

if ( argc != 13 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile type symflag sparsityflag"
           "\n         ncolT ncolU nrowD nentU offset seed"
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    type    -- entries type"
           "\n       1 -- real"
           "\n       2 -- complex"
           "\n    symflag -- type of matrix U"
           "\n       0 -- symmetric"
           "\n       1 -- hermitian"
           "\n       2 -- nonsymmetric"
           "\n    sparsityflag -- dense or sparse"
           "\n       0 -- dense"
           "\n       1 -- sparse"
           "\n    ncolT   -- # of rows and columns in matrix T"
           "\n    nDT     -- # of internal rows and columns in matrix T"
           "\n    ncolU   -- # of rows and columns in matrix U"
           "\n    nrowD   -- # of rows and columns in matrix D"
           "\n    nentU   -- # of entries in matrix U"
           "\n    offset  -- distance between D_I and T"
           "\n    seed    -- random number seed"
           "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   spoolesFatal();
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type         = atoi(argv[3]) ;
symflag      = atoi(argv[4]) ;
sparsityflag = atoi(argv[5]) ;
ncolT        = atoi(argv[6]) ;
nDT          = atoi(argv[7]) ;
ncolU        = atoi(argv[8]) ;
nrowD        = atoi(argv[9]) ;
nentU        = atoi(argv[10]) ;
offset       = atoi(argv[11]) ;
seed         = atoi(argv[12]) ;
fprintf(msgFile, "\n %% %s:"
        "\n %% msglvl       = %d"
        "\n %% msgFile      = %s"
        "\n %% type         = %d"
        "\n %% symflag      = %d"
        "\n %% sparsityflag = %d"
        "\n %% ncolT        = %d"
        "\n %% nDT          = %d"
        "\n %% ncolU        = %d"
        "\n %% nrowD        = %d"
        "\n %% nentU        = %d"
        "\n %% offset       = %d"
        "\n %% seed         = %d",
        argv[0], msglvl, argv[2], type, symflag, sparsityflag, 
        ncolT, nDT, ncolU, nrowD, nentU, offset, seed) ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if (  (type != SPOOLES_REAL 
       && type != SPOOLES_COMPLEX) 
   || (symflag != SPOOLES_SYMMETRIC 
       && symflag != SPOOLES_HERMITIAN 
       && symflag != SPOOLES_NONSYMMETRIC) 
   || (sparsityflag < 0 || sparsityflag > 1)
   || ncolT <= 0 || ncolU > (ncolT + offset) || nrowD <= 0 ) {
   fprintf(stderr, "\n invalid input\n") ;
   spoolesFatal();
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, ++seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   -----------------------
   get a vector of indices
   -----------------------
*/
size = nrowD + offset + ncolT ;
ivec = IVinit(size, -1) ;
IVramp(size, ivec, 0, 1) ;
/*
   ----------------------------
   initialize the T Chv object
   ----------------------------
*/
fprintf(msgFile, "\n\n %% symflag = %d", symflag) ;
MARKTIME(t1) ;
chvT = Chv_new() ;
Chv_init(chvT, 0, nDT, ncolT - nDT, ncolT - nDT, type, symflag) ;
nentT = Chv_nent(chvT) ;
if ( CHV_IS_REAL(chvT) ) {
   Drand_fillDvector(drand, nentT, Chv_entries(chvT)) ;
} else if ( CHV_IS_COMPLEX(chvT) ) {
   Drand_fillDvector(drand, 2*nentT, Chv_entries(chvT)) ;
}
Chv_columnIndices(chvT, &ncolT, &colindT) ;
IVcopy(ncolT, colindT, ivec + nrowD + offset) ;
if ( CHV_IS_NONSYMMETRIC(chvT) ) {
   Chv_rowIndices(chvT, &nrowT, &rowindT) ;
   IVcopy(nrowT, rowindT, colindT) ;
}
IVfree(ivec) ;
if ( CHV_IS_HERMITIAN(chvT) ) {
   fprintf(msgFile, "\n\n %% hermitian\n") ;
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nDT ; irow++ ) {
      Chv_complexEntry(chvT, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chvT, irow, irow, real, 0.0) ;
   }
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chvT Chv object",
        t2 - t1) ;
fprintf(msgFile, "\n T = zeros(%d,%d); ", size, size) ;
Chv_writeForMatlab(chvT, "T", msgFile) ;
/*
   ---------------------------
   initialize the D Mtx object
   ---------------------------
*/
MARKTIME(t1) ;
mtxD = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
   if ( CHV_IS_SYMMETRIC(chvT) ) {
      SubMtx_initRandom(mtxD, SPOOLES_REAL, SUBMTX_BLOCK_DIAGONAL_SYM,
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   } else {
      SubMtx_initRandom(mtxD, SPOOLES_REAL, SUBMTX_DIAGONAL, 
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   }
} else if ( CHV_IS_COMPLEX(chvT) ) {
   if ( CHV_IS_HERMITIAN(chvT) ) {
      SubMtx_initRandom(mtxD,SPOOLES_COMPLEX,SUBMTX_BLOCK_DIAGONAL_HERM,
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   } else if ( CHV_IS_SYMMETRIC(chvT) ) {
      SubMtx_initRandom(mtxD,SPOOLES_COMPLEX, SUBMTX_BLOCK_DIAGONAL_SYM,
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   } else {
      SubMtx_initRandom(mtxD, SPOOLES_COMPLEX, SUBMTX_DIAGONAL, 
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   }
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize D SubMtx object",
        t2 - t1) ;
fprintf(msgFile, "\n D = zeros(%d,%d) ;", nrowD, nrowD) ;
SubMtx_writeForMatlab(mtxD, "D", msgFile) ;
/*
   ----------------------------
   initialize the U SubMtx object
   ----------------------------
*/
MARKTIME(t1) ;
mtxU = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
   if ( sparsityflag == 0 ) {
      SubMtx_initRandom(mtxU, SPOOLES_REAL, SUBMTX_DENSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   } else {
      SubMtx_initRandom(mtxU, SPOOLES_REAL, SUBMTX_SPARSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   }
} else if ( CHV_IS_COMPLEX(chvT) ) {
   if ( sparsityflag == 0 ) {
      SubMtx_initRandom(mtxU, SPOOLES_COMPLEX, SUBMTX_DENSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   } else {
      SubMtx_initRandom(mtxU, SPOOLES_COMPLEX, SUBMTX_SPARSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   }
}
ivec = IVinit(offset + ncolT, -1) ;
IVramp(offset + ncolT, ivec, nrowD, 1) ;
IVshuffle(offset + ncolT, ivec, ++seed) ;
SubMtx_columnIndices(mtxU, &ncolU, &colindU) ;
IVcopy(ncolU, colindU, ivec) ;
IVqsortUp(ncolU, colindU) ;
IVfree(ivec) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize U SubMtx object",
        t2 - t1) ;
fprintf(msgFile, "\n U = zeros(%d,%d) ;", nrowD, size) ;
SubMtx_writeForMatlab(mtxU, "U", msgFile) ;
if ( CHV_IS_NONSYMMETRIC(chvT) ) {
/*
   ----------------------------
   initialize the L SubMtx object
   ----------------------------
*/
   MARKTIME(t1) ;
   mtxL = SubMtx_new() ;
   if ( CHV_IS_REAL(chvT) ) {
      if ( sparsityflag == 0 ) {
         SubMtx_initRandom(mtxL, SPOOLES_REAL, SUBMTX_DENSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      } else {
         SubMtx_initRandom(mtxL, SPOOLES_REAL, SUBMTX_SPARSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      }
   } else if ( CHV_IS_COMPLEX(chvT) ) {
      if ( sparsityflag == 0 ) {
         SubMtx_initRandom(mtxL, SPOOLES_COMPLEX, SUBMTX_DENSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      } else {
         SubMtx_initRandom(mtxL, SPOOLES_COMPLEX, SUBMTX_SPARSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      }
   }
   SubMtx_rowIndices(mtxL, &nrowL, &rowindL) ;
   IVcopy(nrowL, rowindL, colindU) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize L SubMtx object",
           t2 - t1) ;
   fprintf(msgFile, "\n L = zeros(%d,%d) ;", size, nrowD) ;
   SubMtx_writeForMatlab(mtxL, "L", msgFile) ;
} else {
   mtxL = NULL ;
}
/*
   --------------------------------
   compute the matrix-matrix update
   --------------------------------
*/
tempDV = DV_new() ;
ops = 8*nrowD*nrowD*ncolU ;
if ( CHV_IS_SYMMETRIC(chvT) ) {
   Chv_updateS(chvT, mtxD, mtxU, tempDV) ;
} else if ( CHV_IS_HERMITIAN(chvT) ) {
   Chv_updateH(chvT, mtxD, mtxU, tempDV) ;
} else if ( CHV_IS_NONSYMMETRIC(chvT) ) {
   Chv_updateN(chvT, mtxL, mtxD, mtxU, tempDV) ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to compute m-m, %.3f mflops",
        t2 - t1, ops*1.e-6/(t2 - t1)) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% Z Chv object") ;
   fprintf(msgFile, "\n Z = zeros(%d,%d); ", size, size) ;
   Chv_writeForMatlab(chvT, "Z", msgFile) ;
   fflush(msgFile) ;
}
/*
   -----------------
   check with matlab
   -----------------
*/
if ( msglvl > 1 ) {
   if ( CHV_IS_HERMITIAN(chvT) ) {
      fprintf(msgFile, "\n\n B  =  ctranspose(U) * D * U ;") ;
   } else if ( CHV_IS_SYMMETRIC(chvT) ) {
      fprintf(msgFile, "\n\n B  =  transpose(U) * D * U ;") ;
   } else {
      fprintf(msgFile, "\n\n B  =  L * D * U ;") ;
   }
   fprintf(msgFile, 
           "\n\n for irow = 1:%d"
           "\n      for jcol = 1:%d"
           "\n         if T(irow,jcol) ~= 0.0"
           "\n            T(irow,jcol) = T(irow,jcol) - B(irow,jcol) ;"
           "\n         end"
           "\n      end"
           "\n   end"
           "\n emtx   = abs(Z - T) ;",
           size, size) ;
   fprintf(msgFile, "\n\n maxabs = max(max(emtx)) ") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
if ( mtxL != NULL ) {
   SubMtx_free(mtxL) ;
}
Chv_free(chvT) ;
SubMtx_free(mtxD) ;
SubMtx_free(mtxU) ;
DV_free(tempDV) ;
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #11
0
ファイル: test_addChevron.c プロジェクト: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ---------------------------------------
   test the Chv_addChevron() method.

   created -- 98apr18, cca
   ---------------------------------------
*/
{
Chv     *chv ;
double   alpha[2] ;
double   imag, real, t1, t2 ;
double   *chvent, *entries ;
Drand    *drand ;
FILE     *msgFile ;
int      chvsize, count, ichv, ierr, ii, iloc, irow, jcol,
         lastcol, msglvl, ncol, nD, nent, nL, nrow, nU, 
         off, seed, symflag, type, upper ;
int      *chvind, *colind, *keys, *rowind, *temp ;

if ( argc != 10 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile nD nU type symflag seed "
           "\n         alphareal alphaimag"
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    nD      -- # of rows and columns in the (1,1) block"
           "\n    nU      -- # of columns in the (1,2) block"
           "\n    type    -- entries type"
           "\n       1 --> real"
           "\n       2 --> complex"
           "\n    symflag -- symmetry flag"
           "\n       0 --> symmetric"
           "\n       1 --> hermitian"
           "\n       2 --> nonsymmetric"
           "\n    seed    -- random number seed"
           "\n    alpha   -- scaling parameter"
           "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
nD       = atoi(argv[3]) ;
nU       = atoi(argv[4]) ;
type     = atoi(argv[5]) ;
symflag  = atoi(argv[6]) ;
seed     = atoi(argv[7]) ;
alpha[0] = atof(argv[8]) ;
alpha[1] = atof(argv[9]) ;
if (  nD <= 0 || nU < 0 || symflag < 0 || symflag > 2 ) {
   fprintf(stderr, "\n invalid input"
           "\n nD = %d, nU = %d, symflag = %d\n", nD, nU, symflag) ;
   exit(-1) ;
}
fprintf(msgFile, "\n alpha = %12.4e + %12.4e*i ;", alpha[0], alpha[1]) ;
nL = nU ;
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
   ----------------------------
   initialize the Chv object
   ----------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
temp = IVinit(2*(nD+nU), -1) ;
IVramp(2*(nD+nU), temp, 0, 1) ;
IVshuffle(2*(nD+nU), temp, ++seed) ;
IVcopy(ncol, colind, temp) ;
IVqsortUp(ncol, colind) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVcopy(nrow, rowind, colind) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n %% column indices") ;
   IVfprintf(msgFile, ncol, colind) ;
}
lastcol = colind[ncol-1] ;
nent = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nD ; irow++ ) {
      Chv_complexEntry(chv, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
   }
}

if ( msglvl > 1 ) {
   fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chv, "a", msgFile) ;
}
/*
   --------------------------------------------------
   fill a chevron with random numbers and indices
   that are a subset of a front's, as in the assembly
   of original matrix entries.
   --------------------------------------------------
*/
Drand_setUniform(drand, 0, nD) ;
iloc = (int) Drand_value(drand) ;
ichv = colind[iloc] ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
   upper = nD - iloc + nU ;
} else {
   upper = 2*(nD - iloc) - 1 + nL + nU ;
}
Drand_setUniform(drand, 1, upper) ;
chvsize = (int) Drand_value(drand) ;
fprintf(msgFile, "\n %% iloc = %d, ichv = %d, chvsize = %d", 
        iloc, ichv, chvsize) ;
chvind  = IVinit(chvsize, -1) ;
chvent  = DVinit(2*chvsize, 0.0) ;
Drand_setNormal(drand, 0.0, 1.0) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, chvsize, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*chvsize, chvent) ;
}
keys    = IVinit(upper+1, -1) ;
keys[0] = 0 ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
   for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
      keys[count++] = colind[ii] - ichv ;
   }
} else {
   for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
      keys[count++] =   colind[ii] - ichv ;
      keys[count++] = - colind[ii] + ichv ;
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% iloc = %d, ichv = %d", iloc, ichv) ;
   fprintf(msgFile, "\n %% upper = %d", upper) ;
   fprintf(msgFile, "\n %% chvsize = %d", chvsize) ;
   fprintf(msgFile, "\n %% initial keys") ;
   IVfprintf(msgFile, count, keys) ;
}
   IVshuffle(count, keys, ++seed) ;
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% shuffled keys") ;
   IVfp80(msgFile, count, keys, 80, &ierr) ;
}
IVcopy(chvsize, chvind, keys) ;
if ( CHV_IS_REAL(chv) ) {
   IVDVqsortUp(chvsize, chvind, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   IVZVqsortUp(chvsize, chvind, chvent) ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chvind") ;
   IVfprintf(msgFile, chvsize, chvind) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
   for ( ii = 0 ; ii < chvsize ; ii++ ) {
      if ( chvind[ii] == 0 ) {
         chvent[2*ii+1] = 0.0 ;
      }
   }
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   if ( CHV_IS_REAL(chv) ) {
      if ( CHV_IS_SYMMETRIC(chv) ) {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                    colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
            fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                    colind[iloc]+off+1, colind[iloc]+1, chvent[ii]) ;
         }
      } else {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            if ( off > 0 ) {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                       colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
            } else {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                       colind[iloc]-off+1, colind[iloc]+1, chvent[ii]) ;
            }
         }
      }
   } else if ( CHV_IS_COMPLEX(chv) ) {
      if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                    colind[iloc]+1, colind[iloc]+off+1,
                    chvent[2*ii], chvent[2*ii+1]) ;
            if ( CHV_IS_HERMITIAN(chv) ) {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]+off+1, colind[iloc]+1, 
                       chvent[2*ii], -chvent[2*ii+1]) ;
            } else {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]+off+1, colind[iloc]+1, 
                       chvent[2*ii], chvent[2*ii+1]) ;
            }
         }
      } else {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            if ( off > 0 ) {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]+1, colind[iloc]+off+1,
                       chvent[2*ii], chvent[2*ii+1]) ;
            } else {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]-off+1, colind[iloc]+1, 
                       chvent[2*ii], chvent[2*ii+1]) ;
            }
         }
      }
   }
}
/*
   ------------------------------------
   add the chevron into the Chv object
   ------------------------------------
*/
Chv_addChevron(chv, alpha, ichv, chvsize, chvind, chvent) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n %% after adding the chevron") ;
   fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chv, "c", msgFile) ;
}
/*
   -----------------
   compute the error
   -----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (a + alpha*b))))") ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
IVfree(temp) ;
IVfree(chvind) ;
DVfree(chvent) ;
IVfree(keys) ;

fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #12
0
ファイル: test_findPivot.c プロジェクト: JuliaFEM/SPOOLES
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ---------------------------------------------------
   test the Chv_findPivot(), swap and update methods.
   the program's output is a matlab file
   to check correctness of the code.

   created -- 98jan24, cca
   ---------------------------------------------------
*/
{
Chv     *chv ;
double   imag, real, tau, t1, t2 ;
double   *entries ;
Drand    *drand ;
DV       *workDV ;
FILE     *msgFile ;
int      icol, ii, ipvt, irow, jcol, jpvt, jrow, msglvl, ncol, nD, 
         ndelay, nent, nL, nrow, ntest, nU, rc, pivotsize, seed, 
         symflag, tag, temp, type ;
int      *colind, *rowind ;

if ( argc != 9 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile nD nU type symflag seed tau "
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    nD      -- # of rows and columns in the (1,1) block"
           "\n    nU      -- # of columns in the (1,2) block"
           "\n    type    -- entries type"
           "\n       1 --> real"
           "\n       2 --> complex"
           "\n    symflag -- symmetry flag"
           "\n       0 --> symmetric"
           "\n       1 --> hermitian"
           "\n       2 --> nonsymmetric"
           "\n    seed    -- random number seed"
           "\n    tau     -- bound on magnitudes of factor entries"
           "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
nD      = atoi(argv[3]) ;
nU      = atoi(argv[4]) ;
type    = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
seed    = atoi(argv[7]) ;
tau     = atof(argv[8]) ;
fprintf(msgFile, "\n %% testChv:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% nD      = %d"
        "\n %% nU      = %d"
        "\n %% type    = %d"
        "\n %% symflag = %d"
        "\n %% seed    = %d"
        "\n %% tau     = %12.4e",
        msglvl, argv[2], nD, nU, type, symflag, seed, tau) ;
nL   = nU ;
nrow = nD + nL ;
ncol = nD + nU ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if (  nD <= 0 || nU < 0 
   || (symflag != SPOOLES_SYMMETRIC
   &&  symflag !=  SPOOLES_HERMITIAN
   &&  symflag !=  SPOOLES_NONSYMMETRIC) ) {
   fprintf(stderr, "\n invalid input"
      "\n nD = %d, nL = %d, nU = %d, symflag = %d\n",
           nD, nL, nU, symflag) ;
   exit(-1) ;
}
if (  (symflag ==  SPOOLES_SYMMETRIC || symflag ==  SPOOLES_HERMITIAN) 
   && nL != nU ) {
   fprintf(stderr, "\n invalid input"
      "\n symflag = %d, nL = %d, nU = %d", symflag, nL, nU) ;
   exit(-1) ;
}
fprintf(msgFile,
        "\n nD = %d ;"
        "\n nL = %d ;"
        "\n nU = %d ;"
        "\n nrow = nD + nL ;"
        "\n ncol = nD + nU ;",
        nD, nL, nU) ;
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   --------------------------
   initialize the Chv object
   --------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
/*
   ------------------------------------
   load the entries with random entries
   ------------------------------------
*/
nent    = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( msglvl > 4 ) {
   fprintf(msgFile, "\n raw entries vector") ;
   DVfprintf(msgFile, 2*nent, entries) ;
   fflush(msgFile) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nD ; irow++ ) {
      Chv_complexEntry(chv, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
   }
}
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "a", msgFile) ;
/*
   ------------
   find a pivot 
   ------------
*/
workDV = DV_new() ;
ndelay = 0 ;
ntest  = 0 ;
pivotsize = Chv_findPivot(chv, workDV, tau, ndelay, 
                           &irow, &jcol, &ntest) ;
fprintf(msgFile, "\n\n %% pivotsize = %d", pivotsize) ;
ipvt = irow ;
jpvt = jcol ;
if (  (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
   && irow > jcol ) {
   temp = irow ;
   irow = jcol ;
   jcol = temp ;
}
fprintf(msgFile, "\n\n irow = %d ; \n jcol = %d ;", irow+1, jcol+1) ;
/*
   -------------------------
   swap the rows and columns
   -------------------------
*/
if ( pivotsize == 0 ) {
   exit(0) ;
} else if ( pivotsize == 1 ) {
   fprintf(msgFile, 
           "\n b = a ;"
           "\n xtemp = b(irow,:) ;"
           "\n b(irow,:) = b(1,:) ;"
           "\n b(1,:) = xtemp ;"
           "\n xtemp = b(:,jcol) ;"
           "\n b(:,jcol) = b(:,1) ;"
           "\n b(:,1) = xtemp ;") ;
   if ( CHV_IS_SYMMETRIC(chv) || symflag == CHV_IS_HERMITIAN(chv) ) {
      Chv_swapRowsAndColumns(chv, 0, irow) ;
   } else {
      Chv_swapRows(chv, 0, irow) ;
      Chv_swapColumns(chv, 0, jcol) ;
   }
} else if ( pivotsize == 2 ) {
   if ( symflag < 2 ) {
      fprintf(msgFile, 
              "\n b = a ;"
              "\n xtemp = b(irow,:) ;"
              "\n b(irow,:) = b(1,:) ;"
              "\n b(1,:) = xtemp ;"
              "\n xtemp = b(:,irow) ;"
              "\n b(:,irow) = b(:,1) ;"
              "\n b(:,1) = xtemp ;"
              "\n xtemp = b(jcol,:) ;"
              "\n b(jcol,:) = b(2,:) ;"
              "\n b(2,:) = xtemp ;"
              "\n xtemp = b(:,jcol) ;"
              "\n b(:,jcol) = b(:,2) ;"
              "\n b(:,2) = xtemp ;") ;
      Chv_swapRowsAndColumns(chv, 0, irow) ;
      Chv_swapRowsAndColumns(chv, 1, jcol) ;
   } else {
      fprintf(stderr, "\n fatal error, symflag = %d, pvtsize = %d",
              symflag, pivotsize) ;
      exit(-1) ;
   }
}
/*
   -----------------------------------------
   check that the swap was executed properly
   -----------------------------------------
*/
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "c", msgFile) ;
fprintf(msgFile, "\n maxerrswap = norm(c - a)") ;
/*
   ---------------------------
   ramp the indices once again
   ---------------------------
*/
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
/*
   -----------------------------------
   perform the rank-1 or rank-2 update
   -----------------------------------
*/
fprintf(msgFile, "\n\n ckeep = b ;") ;
fprintf(msgFile, "\n\n c = b ;") ;
if ( pivotsize == 1 ) {
   rc = Chv_r1upd(chv) ;
   fprintf(msgFile, 
           "\n\n d = c(1,1) ;"
           "\n l = c(2:nrow,1)/d ;"
           "\n u = c(1,2:ncol) ;") ;
   if ( nD > 1 ) {
      fprintf(msgFile, 
           "\n c(2:nrow,2:ncol) = c(2:nrow,2:ncol) - l*u ;") ;
   }
   fprintf(msgFile, 
           "\n u = u / d ;"
           "\n c(1:1,1:1) = d ; "
           "\n c(1:1,2:ncol) = u ; "
           "\n c(2:ncol,1:1) = l ; ") ;
   fprintf(msgFile, "\n c(nD+1:nrow,nD+1:ncol) = 0 ;") ;
} else {
   rc = Chv_r2upd(chv) ;
   fprintf(msgFile, 
           "\n\n d = c(1:2,1:2) ;"
           "\n l = c(3:nrow,1:2) / d ;"
           "\n u = c(1:2,3:ncol) ;") ;
   if ( nD > 2 ) {
      fprintf(msgFile, 
              "\n c(3:nrow,3:ncol) = c(3:nrow,3:ncol) - l*u ;") ;
   }
   fprintf(msgFile, 
           "\n u = d \\ u ; "
           "\n c(1:2,1:2) = d ; "
           "\n c(1:2,3:ncol) = u ; "
           "\n c(3:ncol,1:2) = l ; ") ;
   if ( nU > 0 ) {
      fprintf(msgFile, 
           "\n c(nD+1:nrow,nD+1:ncol) = 0 ;") ;
   }
}
fprintf(msgFile, "\n %% matrix entries after update") ;
Chv_writeForMatlab(chv, "f", msgFile) ;
fprintf(msgFile, "\n maxerrupd = norm(f - c)") ;
/*
   ------------------------------------------------------
   check out the maximum magnitude of elements in l and u
   ------------------------------------------------------
*/
fprintf(msgFile, "\n ipvt = %d", ipvt + 1) ;
fprintf(msgFile, "\n jpvt = %d", jpvt + 1) ;
fprintf(msgFile, "\n pivotsize = %d", pivotsize) ;
fprintf(msgFile, "\n tau = %12.4e", tau) ;
if ( symflag < 2 ) {
   fprintf(msgFile, "\n ubound = max(max(abs(u))) ") ;
} else {
   fprintf(msgFile, 
           "\n lbound = max(max(abs(l))) "
           "\n ubound = max(max(abs(u))) ") ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
DV_free(workDV) ;
           
fprintf(msgFile, "\n") ;

return(1) ; }
コード例 #13
0
ファイル: util.c プロジェクト: bialk/SPOOLES
/*
   ----------------------------------------------------------------
   purpose -- to create an InpMtx object filled with random entries

   input --

      mtx         -- matrix object, if NULL, it is created
      inputMode   -- input mode for the object,
                     indices only, real or complex entries
      coordType   -- coordinate type for the object,
                     by rows, by columns or by chevrons
      storageMode -- storage mode for the object,
                     raw data, sorted or by vectors
      nrow        -- # of rows
      ncol        -- # of columns
      symflag     -- symmetry flag for the matrix,
                     symmetric, hermitian or nonsymmetric
      nonzerodiag -- if 1, entries are placed on the diagonal
      nitem       -- # of items to be placed into the matrix
      seed        --  random number seed

   return value ---
      1 -- normal return
     -1 -- mtx is NULL
     -2 -- bad input mode
     -3 -- bad coordinate type
     -4 -- bad storage mode
     -5 -- nrow or ncol <= 0
     -6 -- bad symmetry flag
     -7 -- hermitian matrix but not complex
     -8 -- symmetric or hermitian matrix but nrow != ncol
     -9 -- nitem < 0
   ----------------------------------------------------------------
*/
int
InpMtx_randomMatrix (
   InpMtx   *mtx,
   int      inputMode,
   int      coordType,
   int      storageMode,
   int      nrow,
   int      ncol,
   int      symflag,
   int      nonzerodiag,
   int      nitem,
   int      seed
) {
double   *dvec ;
Drand    *drand ;
int      col, ii, neqns, row ;
int      *colids, *rowids ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n mtx is NULL\n") ;
   return(-1) ;
}
switch ( inputMode ) {
case INPMTX_INDICES_ONLY :
case SPOOLES_REAL        :
case SPOOLES_COMPLEX     :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad input mode %d\n", inputMode) ;
   return(-2) ;
   break ;
}
switch ( coordType ) {
case INPMTX_BY_ROWS     :
case INPMTX_BY_COLUMNS  :
case INPMTX_BY_CHEVRONS :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad coordinate type %d\n", coordType) ;
   return(-3) ;
   break ;
}
switch ( storageMode ) {
case INPMTX_RAW_DATA   :
case INPMTX_SORTED     :
case INPMTX_BY_VECTORS :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad storage mode%d\n", storageMode) ;
   return(-4) ;
   break ;
}
if ( nrow <= 0 || ncol <= 0 ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n nrow = %d, ncol = %d\n", nrow, ncol) ;
   return(-5) ;
}
switch ( symflag ) {
case SPOOLES_SYMMETRIC    :
case SPOOLES_HERMITIAN    :
case SPOOLES_NONSYMMETRIC :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad symmetry flag%d\n", symflag) ;
   return(-6) ;
   break ;
}
if ( symflag == SPOOLES_HERMITIAN && inputMode != SPOOLES_COMPLEX ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n symmetryflag is Hermitian, requires complex type\n") ;
   return(-7) ;
}
if ( (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
  && nrow != ncol ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n symmetric or hermitian matrix, nrow %d, ncol%d\n",
           nrow, ncol) ;
   return(-8) ;
}
if ( nitem < 0 ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n nitem = %d\n", nitem) ;
   return(-9) ;
}
/*--------------------------------------------------------------------*/
neqns = (nrow <= ncol) ? nrow : ncol ;
if ( nonzerodiag == 1 ) {
   nitem += neqns ;
}
/*
   ---------------------
   initialize the object
   ---------------------
*/
InpMtx_init(mtx, INPMTX_BY_ROWS, inputMode, nitem, 0) ;
/*
   ----------------
   fill the triples
   ----------------
*/
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
rowids = IVinit(nitem, -1) ;
colids = IVinit(nitem, -1) ;
if ( nonzerodiag == 1 ) {
   IVramp(neqns, rowids, 0, 1) ;
   Drand_setUniform(drand, 0, nrow) ;
   Drand_fillIvector(drand, nitem - neqns, rowids + neqns) ;
   Drand_setUniform(drand, 0, ncol) ;
   IVramp(neqns, colids, 0, 1) ;
   Drand_fillIvector(drand, nitem - neqns, colids + neqns) ;
} else {
   Drand_setUniform(drand, 0, nrow) ;
   Drand_fillIvector(drand, nitem, rowids) ;
   Drand_setUniform(drand, 0, ncol) ;
   Drand_fillIvector(drand, nitem, colids) ;
}
if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) {
   for ( ii = 0 ; ii < nitem ; ii++ ) {
      if ( (row = rowids[ii]) > (col = colids[ii]) ) {
         rowids[ii] = col ;
         colids[ii] = row ;
      }
   }
}
if ( inputMode == SPOOLES_REAL ) {
   dvec = DVinit(nitem, 0.0) ;
   Drand_setUniform(drand, 0.0, 1.0) ;
   Drand_fillDvector(drand, nitem, dvec) ;
} else if ( inputMode == SPOOLES_COMPLEX ) {
   dvec = DVinit(2*nitem, 0.0) ;
   Drand_setUniform(drand, 0.0, 1.0) ;
   Drand_fillDvector(drand, 2*nitem, dvec) ;
   if ( symflag == SPOOLES_HERMITIAN ) {
      for ( ii = 0 ; ii < nitem ; ii++ ) {
         if ( rowids[ii] == colids[ii] ) {
            dvec[2*ii+1] = 0.0 ;
         }
      }
   }
} else {
   dvec = NULL ;
}
/*
   ----------------
   load the triples
   ----------------
*/
switch ( inputMode ) {
case INPMTX_INDICES_ONLY :
   InpMtx_inputTriples(mtx, nitem, rowids, colids) ;
   break ;
case SPOOLES_REAL :
   InpMtx_inputRealTriples(mtx, nitem, rowids, colids, dvec) ;
   break ;
case SPOOLES_COMPLEX :
   InpMtx_inputComplexTriples(mtx, nitem, rowids, colids, dvec) ;
   break ;
}
/*
   ----------------------------------------
   set the coordinate type and storage mode
   ----------------------------------------
*/
InpMtx_changeCoordType(mtx, coordType) ;
InpMtx_changeStorageMode(mtx, storageMode) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Drand_free(drand) ;
IVfree(rowids) ;
IVfree(colids) ;
if ( dvec != NULL ) {
   DVfree(dvec) ;
}
return(1) ; }