Ejemplo n.º 1
0
/*--------------------------------------------------------------------*/
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) ; }
Ejemplo n.º 2
0
/*--------------------------------------------------------------------*/
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) ; }
Ejemplo n.º 3
0
/*--------------------------------------------------------------------*/
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) ; }