/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------
test the Drand random number generator object
---------------------------------------------
*/
{
double ddot, dmean, param1, param2 ;
double *dvec ;
Drand drand ;
FILE *msgFile ;
int distribution, ierr, imean, msglvl, n, seed1, seed2 ;
int *ivec ;
if ( argc != 9 ) {
fprintf(stderr,
"\n\n usage : testDrand msglvl msgFile "
"\n distribution param1 param2 seed1 seed2 n"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n distribution -- 1 for uniform(param1,param2)"
"\n -- 2 for normal(param1,param2)"
"\n param1 -- first parameter"
"\n param2 -- second parameter"
"\n seed1 -- first random number seed"
"\n seed2 -- second random number seed"
"\n n -- length of the vector"
"\n"
) ;
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) ;
}
distribution = atoi(argv[3]) ;
if ( distribution < 1 || distribution > 2 ) {
fprintf(stderr, "\n fatal error in testDrand"
"\n distribution must be 1 (uniform) or 2 (normal)") ;
exit(-1) ;
}
param1 = atof(argv[4]) ;
param2 = atof(argv[5]) ;
seed1 = atoi(argv[6]) ;
seed2 = atoi(argv[7]) ;
n = atoi(argv[8]) ;
Drand_init(&drand) ;
Drand_setSeeds(&drand, seed1, seed2) ;
switch ( distribution ) {
case 1 :
fprintf(msgFile, "\n uniform in [%f,%f]", param1, param2) ;
Drand_setUniform(&drand, param1, param2) ;
break ;
case 2 :
fprintf(msgFile, "\n normal(%f,%f)", param1, param2) ;
Drand_setNormal(&drand, param1, param2) ;
break ;
}
/*
---------------------------------------------
fill the integer and double precision vectors
---------------------------------------------
*/
dvec = DVinit(n, 0.0) ;
Drand_fillDvector(&drand, n, dvec) ;
dmean = DVsum(n, dvec)/n ;
ddot = DVdot(n, dvec, dvec) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n dvec mean = %.4f, variance = %.4f",
dmean, sqrt(fabs(ddot - n*dmean)/n)) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n dvec") ;
DVfprintf(msgFile, n, dvec) ;
}
DVqsortUp(n, dvec) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n sorted dvec") ;
DVfprintf(msgFile, n, dvec) ;
}
ivec = IVinit(n, 0) ;
Drand_fillIvector(&drand, n, ivec) ;
imean = IVsum(n, ivec)/n ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n ivec") ;
IVfp80(msgFile, n, ivec, 80, &ierr) ;
}
IVqsortUp(n, ivec) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n sorted ivec") ;
IVfp80(msgFile, n, ivec, 80, &ierr) ;
}
fprintf(msgFile, "\n") ;
return(1) ; }
/*--------------------------------------------------------------------*/
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) ; }
