/*
-------------------------------------------------
purpose -- to permute an integer vector,
procedure uses the Drand object
input --
size -- size of the vector
y -- vector to be permuted
seed -- seed for the random number generator
if seed <= 0, simple return
created -- 95sep22, cca
-------------------------------------------------
*/
void
FVshuffle (
int size,
float y[],
int seed
) {
if ( size > 0 || seed <= 0 ) {
if ( y == NULL ) {
fprintf(stderr, "\n fatal error in FVshuffle, invalid data"
"\n size = %d, y = %p, seed = %d\n", size, y, seed) ;
exit(-1) ;
} else {
float temp ;
int i, j ;
Drand drand ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
for ( i = 0 ; i < size ; i++ ) {
j = (int) (size * Drand_value(&drand)) ;
temp = y[i] ;
y[i] = y[j] ;
y[j] = temp ;
}
}
}
return ; }
/*
-------------------------------------------------
purpose -- to permute an integer vector,
procedure uses the Drand object
input --
size -- size of the vector
y -- vector to be permuted
seed -- seed for the random number generator
if seed <= 0, simple return
created -- 95sep22, cca
-------------------------------------------------
*/
void
IVshuffle (
int size,
int y[],
int seed
) {
if ( size > 0 && seed > 0 ) {
if ( y == NULL ) {
fprintf(stderr, "\n fatal error in IVshuffle, invalid data"
"\n size = %d, y = %p, seed = %d\n", size, y, seed) ;
exit(-1) ;
} else {
int i, j, temp ;
double value ;
Drand drand ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0.0, 1.0) ;
for ( i = 0 ; i < size ; i++ ) {
value = Drand_value(&drand) ;
j = (int) (size * value) ;
temp = y[i] ;
y[i] = y[j] ;
y[j] = temp ;
}
}
}
return ; }
/*
-----------------------------------------------
fill the matrix with normal(0,1) random numbers
created -- 98may01, cca
-----------------------------------------------
*/
void
A2_fillRandomNormal (
A2 *a,
double mean,
double variance,
int seed
) {
double *entries ;
int i, inc1, inc2, j, loc, n1, n2 ;
Drand drand ;
/*
---------------
check the input
---------------
*/
if ( a == NULL
|| (n1 = a->n1) <= 0
|| (n2 = a->n2) <= 0
|| (inc1 = a->inc1) <= 0
|| (inc2 = a->inc2) <= 0
|| (entries = a->entries) == NULL ) {
fprintf(stderr, "\n fatal error in A2_fillRandomNormal(%p,%d)"
"\n bad input\n",
a, seed) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(a) || A2_IS_COMPLEX(a)) ) {
fprintf(stderr, "\n fatal error in A2_fillRandomNormal(%p,%f,%f,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
a, mean, variance, seed, a->type) ;
exit(-1) ;
}
/*
----------------
fill the entries
----------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, mean, variance) ;
for ( j = 0 ; j < n2 ; j++ ) {
for ( i = 0 ; i < n1 ; i++ ) {
loc = i*inc1 + j*inc2 ;
if ( A2_IS_REAL(a) ) {
entries[loc] = Drand_value(&drand) ;
} else if ( A2_IS_COMPLEX(a) ) {
entries[2*loc] = Drand_value(&drand) ;
entries[2*loc+1] = Drand_value(&drand) ;
}
}
}
return ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
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) ; }
int
main ( int argc, char *argv[] )
/*
-----------------------------------------------------
test the factor method for a grid matrix
(1) construct a linear system for a nested dissection
ordering on a regular grid
(2) create a solution matrix object
(3) multiply the solution with the matrix
to get a right hand side matrix object
(4) factor the matrix
(5) solve the system
created -- 98may16, cca
-----------------------------------------------------
*/
{
Chv *chv, *rootchv ;
ChvManager *chvmanager ;
DenseMtx *mtxB, *mtxX, *mtxZ ;
FrontMtx *frontmtx ;
InpMtx *mtxA ;
SubMtxManager *mtxmanager ;
double cputotal, droptol, factorops ;
double cpus[9] ;
Drand drand ;
double nops, tau, t1, t2 ;
ETree *frontETree ;
FILE *msgFile ;
int error, lockflag, maxsize, maxzeros, msglvl, neqns,
n1, n2, n3, nrhs, nzf, pivotingflag,
seed, sparsityflag, symmetryflag, type ;
int stats[6] ;
IVL *symbfacIVL ;
if ( argc != 17 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile n1 n2 n3 maxzeros maxsize"
"\n seed type symmetryflag sparsityflag "
"\n pivotingflag tau droptol lockflag nrhs"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n n1 -- number of grid points in the first direction"
"\n n2 -- number of grid points in the second direction"
"\n n3 -- number of grid points in the third direction"
"\n maxzeros -- max number of zeroes in a front"
"\n maxsize -- max number of internal nodes in a front"
"\n seed -- random number seed"
"\n type -- type of entries"
"\n 1 --> real"
"\n 2 --> complex"
"\n symmetryflag -- symmetry flag"
"\n 0 --> symmetric "
"\n 1 --> hermitian"
"\n 2 --> nonsymmetric"
"\n sparsityflag -- sparsity flag"
"\n 0 --> store dense fronts"
"\n 1 --> store sparse fronts, use droptol to drop entries"
"\n pivotingflag -- pivoting flag"
"\n 0 --> do not pivot"
"\n 1 --> enable pivoting"
"\n tau -- upper bound on factor entries"
"\n used only with pivoting"
"\n droptol -- lower bound on factor entries"
"\n used only with sparse fronts"
"\n lockflag -- flag to specify lock status"
"\n 0 --> mutex lock is not allocated or initialized"
"\n 1 --> mutex lock is allocated and it can synchronize"
"\n only threads in this process."
"\n 2 --> mutex lock is allocated and it can synchronize"
"\n only threads in this and other processes."
"\n nrhs -- # of right hand sides"
"\n", argv[0]) ;
return(-1) ;
}
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) ;
}
n1 = atoi(argv[3]) ;
n2 = atoi(argv[4]) ;
n3 = atoi(argv[5]) ;
maxzeros = atoi(argv[6]) ;
maxsize = atoi(argv[7]) ;
seed = atoi(argv[8]) ;
type = atoi(argv[9]) ;
symmetryflag = atoi(argv[10]) ;
sparsityflag = atoi(argv[11]) ;
pivotingflag = atoi(argv[12]) ;
tau = atof(argv[13]) ;
droptol = atof(argv[14]) ;
lockflag = atoi(argv[15]) ;
nrhs = atoi(argv[16]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n n1 -- %d"
"\n n2 -- %d"
"\n n3 -- %d"
"\n maxzeros -- %d"
"\n maxsize -- %d"
"\n seed -- %d"
"\n type -- %d"
"\n symmetryflag -- %d"
"\n sparsityflag -- %d"
"\n pivotingflag -- %d"
"\n tau -- %e"
"\n droptol -- %e"
"\n lockflag -- %d"
"\n nrhs -- %d"
"\n",
argv[0], msglvl, argv[2], n1, n2, n3, maxzeros, maxsize,
seed, type, symmetryflag, sparsityflag, pivotingflag,
tau, droptol, lockflag, nrhs) ;
fflush(msgFile) ;
neqns = n1 * n2 * n3 ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
/*
Drand_setUniform(&drand, 0.0, 1.0) ;
*/
Drand_setNormal(&drand, 0.0, 1.0) ;
/*
--------------------------
generate the linear system
--------------------------
*/
mkNDlinsys(n1, n2, n3, maxzeros, maxsize, type,
symmetryflag, nrhs, seed, msglvl, msgFile,
&frontETree, &symbfacIVL, &mtxA, &mtxX, &mtxB) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n mtxA") ;
InpMtx_writeForHumanEye(mtxA, msgFile) ;
fprintf(msgFile, "\n mtxX") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fprintf(msgFile, "\n mtxB") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
/*
fprintf(msgFile, "\n neqns = %d ;", n1*n2*n3) ;
fprintf(msgFile, "\n nrhs = %d ;", nrhs) ;
fprintf(msgFile, "\n A = zeros(neqns, neqns) ;") ;
fprintf(msgFile, "\n X = zeros(neqns, nrhs) ;") ;
fprintf(msgFile, "\n B = zeros(neqns, nrhs) ;") ;
InpMtx_writeForMatlab(mtxA, "A", msgFile) ;
DenseMtx_writeForMatlab(mtxX, "X", msgFile) ;
DenseMtx_writeForMatlab(mtxB, "B", msgFile) ;
{
int *ivec1 = InpMtx_ivec1(mtxA) ;
int *ivec2 = InpMtx_ivec2(mtxA) ;
double *dvec = InpMtx_dvec(mtxA) ;
int ichv, ii, col, offset, row, nent = InpMtx_nent(mtxA) ;
fprintf(msgFile, "\n coordType = %d", mtxA->coordType) ;
fprintf(msgFile, "\n start of matrix output file") ;
fprintf(msgFile, "\n %d %d %d", n1*n2*n3, n1*n2*n3, nent) ;
for ( ii = 0 ; ii < nent ; ii++ ) {
ichv = ivec1[ii] ;
if ( (offset = ivec2[ii]) >= 0 ) {
row = ichv, col = row + offset ;
} else {
col = ichv, row = col - offset ;
}
fprintf(msgFile, "\n %d %d %24.16e %24.16e",
row, col, dvec[2*ii], dvec[2*ii+1]) ;
}
}
{
int ii, jj ;
double imag, real ;
fprintf(msgFile, "\n start of rhs output file") ;
fprintf(msgFile, "\n %d %d", n1*n2*n3, nrhs) ;
for ( ii = 0 ; ii < n1*n2*n3 ; ii++ ) {
fprintf(msgFile, "\n %d ", ii) ;
for ( jj = 0 ; jj < nrhs ; jj++ ) {
DenseMtx_complexEntry(mtxB, ii, jj, &real, &imag) ;
fprintf(msgFile, " %24.16e %24.16e", real, imag) ;
}
}
}
*/
/*
------------------------------
initialize the FrontMtx object
------------------------------
*/
MARKTIME(t1) ;
frontmtx = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, lockflag, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL,
type, symmetryflag, sparsityflag, pivotingflag,
lockflag, 0, NULL, mtxmanager, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : initialize the front matrix",
t2 - t1) ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n nendD = %d, nentL = %d, nentU = %d",
frontmtx->nentD, frontmtx->nentL, frontmtx->nentU) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front matrix initialized") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
/*
-----------------
factor the matrix
-----------------
*/
nzf = ETree_nFactorEntries(frontETree, symmetryflag) ;
factorops = ETree_nFactorOps(frontETree, type, symmetryflag) ;
fprintf(msgFile,
"\n %d factor entries, %.0f factor ops, %8.3f ratio",
nzf, factorops, factorops/nzf) ;
IVzero(6, stats) ;
DVzero(9, cpus) ;
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, lockflag, 1) ;
MARKTIME(t1) ;
rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol,
chvmanager, &error, cpus,
stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops",
t2 - t1, 1.e-6*factorops/(t2-t1)) ;
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n factorization did not complete") ;
for ( chv = rootchv ; chv != NULL ; chv = chv->next ) {
fprintf(stdout, "\n chv %d, nD = %d, nL = %d, nU = %d",
chv->id, chv->nD, chv->nL, chv->nU) ;
}
}
if ( error >= 0 ) {
fprintf(msgFile, "\n\n error encountered at front %d\n", error) ;
exit(-1) ;
}
fprintf(msgFile,
"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns",
stats[0], stats[1], stats[2]) ;
if ( frontmtx->rowadjIVL != NULL ) {
fprintf(msgFile,
"\n %d entries in rowadjIVL", frontmtx->rowadjIVL->tsize) ;
}
if ( frontmtx->coladjIVL != NULL ) {
fprintf(msgFile,
", %d entries in coladjIVL", frontmtx->coladjIVL->tsize) ;
}
if ( frontmtx->upperblockIVL != NULL ) {
fprintf(msgFile,
"\n %d fronts, %d entries in upperblockIVL",
frontmtx->nfront, frontmtx->upperblockIVL->tsize) ;
}
if ( frontmtx->lowerblockIVL != NULL ) {
fprintf(msgFile,
", %d entries in lowerblockIVL",
frontmtx->lowerblockIVL->tsize) ;
}
fprintf(msgFile,
"\n %d entries in D, %d entries in L, %d entries in U",
stats[3], stats[4], stats[5]) ;
fprintf(msgFile, "\n %d locks", frontmtx->nlocks) ;
cputotal = cpus[8] ;
if ( cputotal > 0.0 ) {
fprintf(msgFile,
"\n initialize fronts %8.3f %6.2f"
"\n load original entries %8.3f %6.2f"
"\n update fronts %8.3f %6.2f"
"\n assemble postponed data %8.3f %6.2f"
"\n factor fronts %8.3f %6.2f"
"\n extract postponed data %8.3f %6.2f"
"\n store factor entries %8.3f %6.2f"
"\n miscellaneous %8.3f %6.2f"
"\n total time %8.3f",
cpus[0], 100.*cpus[0]/cputotal,
cpus[1], 100.*cpus[1]/cputotal,
cpus[2], 100.*cpus[2]/cputotal,
cpus[3], 100.*cpus[3]/cputotal,
cpus[4], 100.*cpus[4]/cputotal,
cpus[5], 100.*cpus[5]/cputotal,
cpus[6], 100.*cpus[6]/cputotal,
cpus[7], 100.*cpus[7]/cputotal, cputotal) ;
}
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
ChvManager_writeForHumanEye(chvmanager, msgFile) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n %% MATLAB file: front factor matrix") ;
FrontMtx_writeForMatlab(frontmtx, "L", "D", "U", msgFile) ;
}
/*
------------------------------
post-process the factor matrix
------------------------------
*/
MARKTIME(t1) ;
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix after post-processing") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
fprintf(msgFile, "\n\n after post-processing") ;
SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
code to test out the IO methods.
write the matrix to a file, free it,
then read it back in.
note: formatted files do not have much accuracy.
*/
/*
FrontMtx_writeToFile(frontmtx, "temp.frontmtxb") ;
FrontMtx_free(frontmtx) ;
frontmtx = FrontMtx_new() ;
FrontMtx_readFromFile(frontmtx, "temp.frontmtxb") ;
frontmtx->manager = mtxmanager ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
*/
/*
----------------
solve the system
----------------
*/
neqns = mtxB->nrow ;
nrhs = mtxB->ncol ;
mtxZ = DenseMtx_new() ;
DenseMtx_init(mtxZ, type, 0, 0, neqns, nrhs, 1, neqns) ;
DenseMtx_zero(mtxZ) ;
if ( type == SPOOLES_REAL ) {
nops = frontmtx->nentD + 2*frontmtx->nentU ;
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
nops += 2*frontmtx->nentL ;
} else {
nops += 2*frontmtx->nentU ;
}
} else if ( type == SPOOLES_COMPLEX ) {
nops = 8*frontmtx->nentD + 8*frontmtx->nentU ;
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
nops += 8*frontmtx->nentL ;
} else {
nops += 8*frontmtx->nentU ;
}
}
nops *= nrhs ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n rhs") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(stdout) ;
}
DVzero(6, cpus) ;
MARKTIME(t1) ;
FrontMtx_solve(frontmtx, mtxZ, mtxB, mtxmanager,
cpus, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : solve the system, %.3f mflops",
t2 - t1, 1.e-6*nops/(t2 - t1)) ;
cputotal = t2 - t1 ;
if ( cputotal > 0.0 ) {
fprintf(msgFile,
"\n set up solves %8.3f %6.2f"
"\n load rhs and store solution %8.3f %6.2f"
"\n forward solve %8.3f %6.2f"
"\n diagonal solve %8.3f %6.2f"
"\n backward solve %8.3f %6.2f"
"\n total time %8.3f",
cpus[0], 100.*cpus[0]/cputotal,
cpus[1], 100.*cpus[1]/cputotal,
cpus[2], 100.*cpus[2]/cputotal,
cpus[3], 100.*cpus[3]/cputotal,
cpus[4], 100.*cpus[4]/cputotal, cputotal) ;
}
/*
fprintf(msgFile, "\n Z = zeros(neqns, nrhs) ;") ;
DenseMtx_writeForMatlab(mtxZ, "Z", msgFile) ;
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n computed solution") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
DenseMtx_sub(mtxZ, mtxX) ;
fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxZ)) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n error") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
fprintf(msgFile, "\n\n after solve") ;
SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
------------------------
free the working storage
------------------------
*/
InpMtx_free(mtxA) ;
DenseMtx_free(mtxX) ;
DenseMtx_free(mtxB) ;
DenseMtx_free(mtxZ) ;
FrontMtx_free(frontmtx) ;
ETree_free(frontETree) ;
IVL_free(symbfacIVL) ;
ChvManager_free(chvmanager) ;
SubMtxManager_free(mtxmanager) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
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) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------------------
this program tests the IVL_MPI_allgather() method
(1) each process generates the same owners[n] map
(2) each process creates an IVL object
and fills its owned lists with random numbers
(3) the processes gather-all's the lists of ivl
created -- 98apr03, cca
-------------------------------------------------
*/
{
char *buffer ;
double chksum, globalsum, t1, t2 ;
Drand drand ;
int ilist, length, myid, msglvl, nlist,
nproc, rc, seed, size, tag ;
int *list, *owners, *vec ;
int stats[4], tstats[4] ;
IV *ownersIV ;
IVL *ivl ;
FILE *msgFile ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 5 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile n seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nlist -- number of lists in the IVL object"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
nlist = atoi(argv[3]) ;
seed = atoi(argv[4]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n nlist -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], nlist, seed) ;
fflush(msgFile) ;
/*
----------------------------
generate the ownersIV object
----------------------------
*/
MARKTIME(t1) ;
ownersIV = IV_new() ;
IV_init(ownersIV, nlist, NULL) ;
owners = IV_entries(ownersIV) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nproc) ;
Drand_fillIvector(&drand, nlist, owners) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize the ownersIV object",
t2 - t1) ;
fflush(msgFile) ;
fprintf(msgFile, "\n\n ownersIV generated") ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(ownersIV, msgFile) ;
} else {
IV_writeStats(ownersIV, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
set up the IVL object and fill owned entries
--------------------------------------------
*/
MARKTIME(t1) ;
ivl = IVL_new() ;
IVL_init1(ivl, IVL_CHUNKED, nlist) ;
vec = IVinit(nlist, -1) ;
Drand_setSeed(&drand, seed + myid) ;
Drand_setUniform(&drand, 0, nlist) ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
size = (int) Drand_value(&drand) ;
Drand_fillIvector(&drand, size, vec) ;
IVL_setList(ivl, ilist, size, vec) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize the IVL object",
t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
IVL_writeForHumanEye(ivl, msgFile) ;
} else {
IVL_writeStats(ivl, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
compute the local checksum of the ivl object
--------------------------------------------
*/
for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
IVL_listAndSize(ivl, ilist, &size, &list) ;
chksum += 1 + ilist + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local partial chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
-----------------------
get the global checksum
-----------------------
*/
rc = MPI_Allreduce((void *) &chksum, (void *) &globalsum,
1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD) ;
/*
--------------------------------
execute the all-gather operation
--------------------------------
*/
tag = 47 ;
IVzero(4, stats) ;
IVL_MPI_allgather(ivl, ownersIV,
stats, msglvl, msgFile, tag, MPI_COMM_WORLD) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n return from IVL_MPI_allgather()") ;
fprintf(msgFile,
"\n local send stats : %10d messages with %10d bytes"
"\n local recv stats : %10d messages with %10d bytes",
stats[0], stats[2], stats[1], stats[3]) ;
fflush(msgFile) ;
}
MPI_Reduce((void *) stats, (void *) tstats, 4, MPI_INT,
MPI_SUM, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile,
"\n total send stats : %10d messages with %10d bytes"
"\n total recv stats : %10d messages with %10d bytes",
tstats[0], tstats[2], tstats[1], tstats[3]) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ivl") ;
IVL_writeForHumanEye(ivl, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------------------------
compute the checksum of the entire object
-----------------------------------------
*/
for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &list) ;
chksum += 1 + ilist + size + IVsum(size, list) ;
}
fprintf(msgFile,
"\n globalsum = %12.4e, chksum = %12.4e, error = %12.4e",
globalsum, chksum, fabs(globalsum - chksum)) ;
fflush(msgFile) ;
/*
----------------
free the objects
----------------
*/
IV_free(ownersIV) ;
IVL_free(ivl) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(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) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------------
generate random (key1, key2, value) entries
and place them into a hash table.
created -- 98jan28, cca
-------------------------------------------
*/
{
Drand *drand ;
FILE *msgFile ;
I2Ohash *hashtbl ;
int grow, ii, key1, key2, maxkey, msglvl, nent, seed, size ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n %% usage : %s msglvl msgFile size grow maxkey nent seed"
"\n %% msglvl -- message level"
"\n %% msgFile -- message file"
"\n %% size -- number of lists in the hash table"
"\n %% grow -- growth for list items"
"\n %% maxkey -- maximum key value"
"\n %% nent -- number of entries to insert"
"\n %% seed -- random number seed"
"\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) ;
}
size = atoi(argv[3]) ;
grow = atoi(argv[4]) ;
maxkey = atoi(argv[5]) ;
nent = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
/*
fprintf(msgFile,
"\n %% %s "
"\n %% msglvl -- %d"
"\n %% msgFile -- %s"
"\n %% size -- %d"
"\n %% grow -- %d"
"\n %% maxkey -- %d"
"\n %% nent -- %d"
"\n",
argv[0], msglvl, argv[2], size, grow, maxkey, nent) ;
fflush(msgFile) ;
*/
/*
--------------------------------
initialize the hash table object
--------------------------------
*/
hashtbl = I2Ohash_new() ;
I2Ohash_init(hashtbl, size, nent/2, grow) ;
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, 0, maxkey) ;
/*
------------------------------------------------------------
generate (key1, key2, value) pairs and insert into the table
------------------------------------------------------------
*/
for ( ii = 0 ; ii < nent ; ii++ ) {
key1 = Drand_value(drand) ;
key2 = Drand_value(drand) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n inserting <%d,%d,NULL> into hash table",
key1, key2) ;
}
I2Ohash_insert(hashtbl, key1, key2, NULL) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n %d entries, measure = %.3f",
ii+1, I2Ohash_measure(hashtbl)) ;
}
if ( msglvl > 3 ) {
I2Ohash_writeForHumanEye(hashtbl, msgFile) ;
}
}
if ( msglvl > 0 ) {
fprintf(msgFile, "\n %12d %12d %12.3f",
size, nent, I2Ohash_measure(hashtbl)) ;
}
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-----------------------------------------------------
test the factor method for a grid matrix
(0) read in matrix from source file
(1) conver data matrix to InpMtx object if necessary
(2) create Graph and ETree object if necessary
(3) read in/create an ETree object
(4) create a solution matrix object
(5) multiply the solution with the matrix
to get a right hand side matrix object
(6) factor the matrix
(7) solve the system
created -- 98dec30, jwu
-----------------------------------------------------
*/
{
char etreeFileName[80], mtxFileName[80], *cpt, rhsFileName[80],
srcFileName[80], ctemp[81], msgFileName[80], slnFileName[80] ;
Chv *chv, *rootchv ;
ChvManager *chvmanager ;
DenseMtx *mtxB, *mtxQ, *mtxX, *mtxZ ;
double one[2] = { 1.0, 0.0 } ;
FrontMtx *frontmtx ;
InpMtx *mtxA ;
SubMtxManager *mtxmanager ;
double cputotal, droptol, conv_tol, factorops ;
double cpus[9] ;
Drand drand ;
double nops, tau, t1, t2 ;
ETree *frontETree ;
Graph *graph ;
FILE *msgFile, *inFile ;
int error, loc, msglvl, neqns, nzf, iformat,
pivotingflag, rc, seed, sparsityflag, symmetryflag,
method[METHODS], type, nrhs, etreeflag ;
int stats[6] ;
int nnzA, Ik, itermax, zversion, iterout ;
IV *newToOldIV, *oldToNewIV ;
IVL *symbfacIVL ;
int i, j, k, m, n, imethod, maxdomainsize, maxzeros, maxsize;
int nouter,ninner ;
if ( argc != 2 ) {
fprintf(stdout,
"\n\n usage : %s inFile"
"\n inFile -- input filename"
"\n", argv[0]) ;
return(-1) ;
}
/* read input file */
inFile = fopen(argv[1], "r");
if (inFile == (FILE *)NULL) {
fprintf(stderr, "\n fatal error in %s: unable to open file %s\n",
argv[0], argv[1]) ;
return(-1) ;
}
for (i=0; i<METHODS; i++) method[i]=-1;
imethod=0;
k=0;
while (1) {
fgets(ctemp, 80, inFile);
if (ctemp[0] != '*') {
/*printf("l=%2d:%s\n", strlen(ctemp),ctemp);*/
if (strlen(ctemp)==80) {
fprintf(stderr, "\n fatal error in %s: input line contains more than "
"80 characters.\n",argv[0]);
exit(-1);
}
if (k==0) {
sscanf(ctemp, "%d", &iformat);
if (iformat < 0 || iformat > 2) {
fprintf(stderr, "\n fatal error in %s: "
"invalid source matrix format\n",argv[0]) ;
return(-1) ;
}
}
else if (k==1)
sscanf(ctemp, "%s", srcFileName);
else if (k==2)
sscanf(ctemp, "%s", mtxFileName);
else if (k==3) {
sscanf(ctemp, "%d", &etreeflag);
if (etreeflag < 0 || etreeflag > 4) {
fprintf(stderr, "\n fatal error in %s: "
"invalid etree file status\n",argv[0]) ;
return(-1) ;
}
}
else if (k==4)
sscanf(ctemp, "%s", etreeFileName);
else if (k==5)
sscanf(ctemp, "%s", rhsFileName);
else if (k==6)
sscanf(ctemp, "%s", slnFileName);
else if (k==7){
sscanf(ctemp, "%s", msgFileName);
if ( strcmp(msgFileName, "stdout") == 0 ) {
msgFile = stdout ;
}
else if ( (msgFile = fopen(msgFileName, "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n", argv[0], ctemp) ;
return(-1) ;
}
}
else if (k==8)
sscanf(ctemp, "%d %d %d %d %d %d",
&msglvl, &seed, &nrhs, &Ik, &itermax, &iterout);
else if (k==9)
sscanf(ctemp, "%d %d %d", &symmetryflag, &sparsityflag, &pivotingflag);
else if (k==10)
sscanf(ctemp, "%lf %lf %lf", &tau, &droptol, &conv_tol);
else if (k==11) {
/*
for (j=0; j<strlen(ctemp); j++) {
printf("j=%2d:%s",j,ctemp+j);
if (ctemp[j] == ' ' && ctemp[j+1] != ' ') {
sscanf(ctemp+j, "%d", method+imethod);
printf("method[%d]=%d\n",imethod,method[imethod]);
if (method[imethod] < 0) break;
imethod++;
}
}
*/
imethod = sscanf(ctemp,"%d %d %d %d %d %d %d %d %d %d",
method, method+1, method+2, method+3, method+4,
method+5, method+6, method+7, method+8, method+9);
/*printf("imethod=%d\n",imethod);*/
for (j=0; j<imethod; j++) {
/*printf("method[%d]=%d\n",j,method[j]);*/
if (method[j]<0) {
imethod=j;
break;
}
}
if (imethod == 0) {
fprintf(msgFile,"No method assigned in input file\n");
return(-1);
}
}
k++;
}
if (k==12) break;
}
fclose(inFile);
/* reset nrhs to 1 */
if (nrhs > 1) {
fprintf(msgFile,"*** Multiple right-hand-side vectors is not allowed yet.\n");
fprintf(msgFile,"*** nrhs is reset to 1.\n");
nrhs =1;
}
fprintf(msgFile,
"\n %s "
"\n srcFileName -- %s"
"\n mtxFileName -- %s"
"\n etreeFileName -- %s"
"\n rhsFileName -- %s"
"\n msglvl -- %d"
"\n seed -- %d"
"\n symmetryflag -- %d"
"\n sparsityflag -- %d"
"\n pivotingflag -- %d"
"\n tau -- %e"
"\n droptol -- %e"
"\n conv_tol -- %e"
"\n method -- ",
argv[0], srcFileName, mtxFileName, etreeFileName, rhsFileName,
msglvl, seed, symmetryflag, sparsityflag, pivotingflag,
tau, droptol, conv_tol) ;
for (k=0; k<imethod; k++)
fprintf(msgFile, "%d ", method[k]);
fprintf(msgFile, "\n ", method[k]);
fflush(msgFile) ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
/*Drand_setUniform(&drand, 0.0, 1.0) ;*/
Drand_setNormal(&drand, 0.0, 1.0) ;
/*
----------------------------------------------
read in or convert source to the InpMtx object
----------------------------------------------
*/
rc = 1;
if ( strcmp(srcFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(-1) ;
}
mtxA = InpMtx_new() ;
MARKTIME(t1) ;
if (iformat == 0) { /* InpMtx source format */
rc = InpMtx_readFromFile(mtxA, srcFileName) ;
strcpy(mtxFileName, srcFileName);
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_readFromFile(%p,%s)",
rc, mtxA, srcFileName) ;
}
else if (iformat == 1) { /* HBF source format */
rc = InpMtx_readFromHBfile(mtxA, srcFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_readFromHBfile(%p,%s)",
rc, mtxA, srcFileName) ;
}
else { /* AIJ2 source format */
rc = InpMtx_readFromAIJ2file(mtxA, srcFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_readFromAIJ2file(%p,%s)",
rc, mtxA, srcFileName) ;
}
MARKTIME(t2) ;
if (iformat>0 && strcmp(mtxFileName, "none") != 0 ) {
rc = InpMtx_writeToFile(mtxA, mtxFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_writeToFile(%p,%s)",
rc, mtxA, mtxFileName) ;
}
fprintf(msgFile, "\n CPU %8.3f : read in (+ convert to) mtxA from file %s",
t2 - t1, mtxFileName) ;
if (rc != 1) {
goto end_read;
}
type = mtxA->inputMode ;
neqns = 1 + IVmax(mtxA->nent, InpMtx_ivec1(mtxA), &loc) ;
if ( INPMTX_IS_BY_ROWS(mtxA) ) {
fprintf(msgFile, "\n matrix coordinate type is rows") ;
} else if ( INPMTX_IS_BY_COLUMNS(mtxA) ) {
fprintf(msgFile, "\n matrix coordinate type is columns") ;
} else if ( INPMTX_IS_BY_CHEVRONS(mtxA) ) {
fprintf(msgFile, "\n matrix coordinate type is chevrons") ;
} else {
fprintf(msgFile, "\n\n, error, bad coordinate type") ;
rc=-1;
goto end_read;
}
if ( INPMTX_IS_RAW_DATA(mtxA) ) {
fprintf(msgFile, "\n matrix storage mode is raw data\n") ;
} else if ( INPMTX_IS_SORTED(mtxA) ) {
fprintf(msgFile, "\n matrix storage mode is sorted\n") ;
} else if ( INPMTX_IS_BY_VECTORS(mtxA) ) {
fprintf(msgFile, "\n matrix storage mode is by vectors\n") ;
} else {
fprintf(msgFile, "\n\n, error, bad storage mode") ;
rc=-1;
goto end_read;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n after reading InpMtx object from file %s",
mtxFileName) ;
if ( msglvl == 2 ) {
InpMtx_writeStats(mtxA, msgFile) ;
} else {
InpMtx_writeForHumanEye(mtxA, msgFile) ;
}
fflush(msgFile) ;
}
/*
Get the nonzeros in matrix A and print it
*/
nnzA = InpMtx_nent( mtxA );
fprintf(msgFile, "\n\n Input matrix size %d NNZ %d",
neqns, nnzA) ;
/*
--------------------------------------------------------
generate the linear system
1. generate solution matrix and fill with random numbers
2. generate rhs matrix and fill with zeros
3. compute matrix-matrix multiply
--------------------------------------------------------
*/
MARKTIME(t1) ;
mtxX = DenseMtx_new() ;
DenseMtx_init(mtxX, type, 0, -1, neqns, nrhs, 1, neqns) ;
mtxB = DenseMtx_new() ;
if (strcmp(rhsFileName, "none")) {
rc = DenseMtx_readFromFile(mtxB, rhsFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from DenseMtx_readFromFile(%p,%s)",
rc, mtxB, rhsFileName) ;
DenseMtx_zero(mtxX) ;
}
else {
DenseMtx_init(mtxB, type, 1, -1, neqns, nrhs, 1, neqns) ;
DenseMtx_fillRandomEntries(mtxX, &drand) ;
DenseMtx_zero(mtxB) ;
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_mmm(mtxA, mtxB, one, mtxX) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_mmm(mtxA, mtxB, one, mtxX) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_mmm(mtxA, mtxB, one, mtxX) ;
break ;
default :
break ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set up the solution and rhs ",
t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n original mtxX") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fprintf(msgFile, "\n\n original mtxB") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
if (rc != 1) {
InpMtx_free(mtxA);
DenseMtx_free(mtxX);
DenseMtx_free(mtxB);
goto end_init;
}
/*
------------------------
read in/create the ETree object
------------------------
*/
MARKTIME(t1) ;
if (etreeflag == 0) { /* read in ETree from file */
if ( strcmp(etreeFileName, "none") == 0 )
fprintf(msgFile, "\n no file to read from") ;
frontETree = ETree_new() ;
rc = ETree_readFromFile(frontETree, etreeFileName) ;
if (rc!=1)
fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)",
rc, frontETree, etreeFileName) ;
}
else {
graph = Graph_new() ;
rc = InpMtx_createGraph(mtxA, graph);
if (rc!=1) {
fprintf(msgFile, "\n return value %d from InpMtx_createGraph(%p,%p)",
rc, mtxA, graph) ;
Graph_free(graph);
goto end_tree;
}
if (etreeflag == 1) { /* Via BestOfNDandMS */
maxdomainsize = 500; maxzeros = 1000; maxsize = 64 ;
frontETree = orderViaBestOfNDandMS(graph, maxdomainsize, maxzeros,
maxsize, seed, msglvl, msgFile) ;
}
else if (etreeflag == 2) { /* Via MMD */
frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ;
}
else if (etreeflag == 3) { /* Via MS */
maxdomainsize = 500;
frontETree = orderViaMS(graph, maxdomainsize, seed, msglvl, msgFile) ;
}
else if (etreeflag == 4) { /* Via ND */
maxdomainsize = 500;
frontETree = orderViaND(graph, maxdomainsize, seed, msglvl, msgFile) ;
}
Graph_free(graph);
/* optionally write out the ETree object */
if ( strcmp(etreeFileName, "none") != 0 ) {
fprintf(msgFile, "\n\n writing out ETree to file %s",
etreeFileName) ;
ETree_writeToFile(frontETree, etreeFileName) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in/create frontETree from file %s",
t2 - t1, etreeFileName) ;
if ( rc != 1 ) {
ETree_free(frontETree);
goto end_tree;
}
ETree_leftJustify(frontETree) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n after reading ETree object from file %s",
etreeFileName) ;
if ( msglvl == 2 ) {
ETree_writeStats(frontETree, msgFile) ;
} else {
ETree_writeForHumanEye(frontETree, msgFile) ;
}
}
fflush(msgFile) ;
/*
--------------------------------------------------
get the permutations, permute the matrix and the
front tree, and compute the symbolic factorization
--------------------------------------------------
*/
MARKTIME(t1) ;
oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get permutations", t2 - t1) ;
MARKTIME(t1) ;
ETree_permuteVertices(frontETree, oldToNewIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute front tree", t2 - t1) ;
MARKTIME(t1) ;
InpMtx_permute(mtxA, IV_entries(oldToNewIV), IV_entries(oldToNewIV)) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute mtxA", t2 - t1) ;
if ( symmetryflag == SPOOLES_SYMMETRIC
|| symmetryflag == SPOOLES_HERMITIAN ) {
MARKTIME(t1) ;
InpMtx_mapToUpperTriangle(mtxA) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : map to upper triangle", t2 - t1) ;
}
if ( ! INPMTX_IS_BY_CHEVRONS(mtxA) ) {
MARKTIME(t1) ;
InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : change coordinate type", t2 - t1) ;
}
if ( INPMTX_IS_RAW_DATA(mtxA) ) {
MARKTIME(t1) ;
InpMtx_changeStorageMode(mtxA, INPMTX_SORTED) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : sort entries ", t2 - t1) ;
}
if ( INPMTX_IS_SORTED(mtxA) ) {
MARKTIME(t1) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : convert to vectors ", t2 - t1) ;
}
MARKTIME(t1) ;
symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : symbolic factorization", t2 - t1) ;
MARKTIME(t1) ;
DenseMtx_permuteRows(mtxB, oldToNewIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute rhs", t2 - t1) ;
/*
------------------------------
initialize the FrontMtx object
------------------------------
*/
MARKTIME(t1) ;
frontmtx = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, NO_LOCK, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL,
type, symmetryflag, sparsityflag, pivotingflag,
NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : initialize the front matrix",
t2 - t1) ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n nendD = %d, nentL = %d, nentU = %d",
frontmtx->nentD, frontmtx->nentL, frontmtx->nentU) ;
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front matrix initialized") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------
factor the matrix
-----------------
*/
nzf = ETree_nFactorEntries(frontETree, symmetryflag) ;
factorops = ETree_nFactorOps(frontETree, type, symmetryflag) ;
fprintf(msgFile,
"\n %d factor entries, %.0f factor ops, %8.3f ratio",
nzf, factorops, factorops/nzf) ;
IVzero(6, stats) ;
DVzero(9, cpus) ;
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, NO_LOCK, 1) ;
MARKTIME(t1) ;
rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol,
chvmanager, &error, cpus,
stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops",
t2 - t1, 1.e-6*factorops/(t2-t1)) ;
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n factorization did not complete") ;
for ( chv = rootchv ; chv != NULL ; chv = chv->next ) {
fprintf(stdout, "\n chv %d, nD = %d, nL = %d, nU = %d",
chv->id, chv->nD, chv->nL, chv->nU) ;
}
}
if ( error >= 0 ) {
fprintf(msgFile, "\n\n error encountered at front %d\n", error) ;
rc=error ;
goto end_front;
}
fprintf(msgFile,
"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns",
stats[0], stats[1], stats[2]) ;
if ( frontmtx->rowadjIVL != NULL ) {
fprintf(msgFile,
"\n %d entries in rowadjIVL", frontmtx->rowadjIVL->tsize) ;
}
if ( frontmtx->coladjIVL != NULL ) {
fprintf(msgFile,
", %d entries in coladjIVL", frontmtx->coladjIVL->tsize) ;
}
if ( frontmtx->upperblockIVL != NULL ) {
fprintf(msgFile,
"\n %d fronts, %d entries in upperblockIVL",
frontmtx->nfront, frontmtx->upperblockIVL->tsize) ;
}
if ( frontmtx->lowerblockIVL != NULL ) {
fprintf(msgFile,
", %d entries in lowerblockIVL",
frontmtx->lowerblockIVL->tsize) ;
}
fprintf(msgFile,
"\n %d entries in D, %d entries in L, %d entries in U",
stats[3], stats[4], stats[5]) ;
fprintf(msgFile, "\n %d locks", frontmtx->nlocks) ;
if ( FRONTMTX_IS_SYMMETRIC(frontmtx)
|| FRONTMTX_IS_HERMITIAN(frontmtx) ) {
int nneg, npos, nzero ;
FrontMtx_inertia(frontmtx, &nneg, &nzero, &npos) ;
fprintf(msgFile,
"\n %d negative, %d zero and %d positive eigenvalues",
nneg, nzero, npos) ;
fflush(msgFile) ;
}
cputotal = cpus[8] ;
if ( cputotal > 0.0 ) {
fprintf(msgFile,
"\n initialize fronts %8.3f %6.2f"
"\n load original entries %8.3f %6.2f"
"\n update fronts %8.3f %6.2f"
"\n assemble postponed data %8.3f %6.2f"
"\n factor fronts %8.3f %6.2f"
"\n extract postponed data %8.3f %6.2f"
"\n store factor entries %8.3f %6.2f"
"\n miscellaneous %8.3f %6.2f"
"\n total time %8.3f",
cpus[0], 100.*cpus[0]/cputotal,
cpus[1], 100.*cpus[1]/cputotal,
cpus[2], 100.*cpus[2]/cputotal,
cpus[3], 100.*cpus[3]/cputotal,
cpus[4], 100.*cpus[4]/cputotal,
cpus[5], 100.*cpus[5]/cputotal,
cpus[6], 100.*cpus[6]/cputotal,
cpus[7], 100.*cpus[7]/cputotal, cputotal) ;
}
if ( msglvl > 1 ) {
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
ChvManager_writeForHumanEye(chvmanager, msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
/*
------------------------------
post-process the factor matrix
------------------------------
*/
MARKTIME(t1) ;
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix after post-processing") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
fprintf(msgFile, "\n\n after post-processing") ;
if ( msglvl > 1 ) SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
----------------
solve the system
----------------
*/
neqns = mtxB->nrow ;
mtxZ = DenseMtx_new() ;
DenseMtx_init(mtxZ, type, 0, 0, neqns, nrhs, 1, neqns) ;
zversion=INPMTX_IS_COMPLEX_ENTRIES(mtxA);
for (k=0; k<imethod; k++) {
DenseMtx_zero(mtxZ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n rhs") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(stdout) ;
}
fprintf(msgFile, "\n\n itemax %d", itermax) ;
DVzero(6, cpus) ;
MARKTIME(t1) ;
switch ( method[k] ) {
case BiCGStabR :
if (zversion)
rc=zbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=bicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case BiCGStabL :
if (zversion)
rc=zbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=bicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case TFQMRR :
if (zversion)
rc=ztfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=tfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case TFQMRL :
if (zversion)
rc=ztfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=tfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case PCGR :
if (zversion)
rc=zpcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=pcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case PCGL :
if (zversion)
rc=zpcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=pcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case MLBiCGStabR :
mtxQ = DenseMtx_new() ;
DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ;
Drand_setUniform(&drand, 0.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxQ, &drand) ;
if (zversion)
rc=zmlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
else
rc=mlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
DenseMtx_free(mtxQ) ;
break;
case MLBiCGStabL :
mtxQ = DenseMtx_new() ;
DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ;
Drand_setUniform(&drand, 0.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxQ, &drand) ;
if (zversion)
rc=zmlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
else
rc=mlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
DenseMtx_free(mtxQ) ;
break;
case BGMRESR:
if (zversion)
fprintf(msgFile, "\n\n *** BGMRESR complex version is not available "
"at this moment. ") ;
else
rc=bgmresr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ,
mtxB, iterout, itermax, &nouter, &ninner, conv_tol,
msglvl, msgFile);
break;
case BGMRESL:
if (zversion)
fprintf(msgFile, "\n\n *** BGMRESR complex version is not available "
"at this moment. ") ;
else
rc=bgmresl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ,
mtxB, iterout, itermax, &nouter, &ninner, conv_tol,
msglvl, msgFile);
break;
default:
fprintf(msgFile, "\n\n *** Invalid method number ") ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : solve the system", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n computed solution") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
/*
-------------------------------------------------------------
permute the computed solution back into the original ordering
-------------------------------------------------------------
*/
MARKTIME(t1) ;
DenseMtx_permuteRows(mtxZ, newToOldIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute solution", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n permuted solution") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
/*
-------------
save solution
-------------
*/
if ( strcmp(slnFileName, "none") != 0 ) {
DenseMtx_writeToFile(mtxZ, slnFileName) ;
}
/*
-----------------
compute the error
-----------------
*/
if (!strcmp(rhsFileName, "none")) {
DenseMtx_sub(mtxZ, mtxX) ;
if (method[k] <8) {
mtxQ = DenseMtx_new() ;
DenseMtx_init(mtxQ, type, 0, -1, neqns, 1, 1, neqns) ;
rc=DenseMtx_initAsSubmatrix (mtxQ, mtxZ, 0, neqns-1, 0, 0);
fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxQ)) ;
DenseMtx_free(mtxQ) ;
}
else
fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxZ)) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n error") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
if ( msglvl > 1 )
SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
}
fprintf(msgFile, "\n--------- End of Method %d -------\n",method[k]) ;
}
/*
------------------------
free the working storage
------------------------
*/
DenseMtx_free(mtxZ) ;
end_front:
ChvManager_free(chvmanager) ;
SubMtxManager_free(mtxmanager) ;
FrontMtx_free(frontmtx) ;
IVL_free(symbfacIVL) ;
IV_free(oldToNewIV) ;
IV_free(newToOldIV) ;
end_tree:
ETree_free(frontETree) ;
end_init:
DenseMtx_free(mtxB) ;
DenseMtx_free(mtxX) ;
end_read:
InpMtx_free(mtxA) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(rc) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
--------------------------------------------------------------------
this program tests the Graph_MPI_Bcast() method
(1) process root generates a random Graph object
and computes its checksum
(2) process root broadcasts the Graph object to the other processors
(3) each process computes the checksum of its Graph object
(4) the checksums are compared on root
created -- 98sep10, cca
--------------------------------------------------------------------
*/
{
char *buffer ;
double chksum, t1, t2 ;
double *sums ;
Drand drand ;
int iproc, length, loc, msglvl, myid, nitem, nproc,
nvtx, root, seed, size, type, v ;
int *list ;
FILE *msgFile ;
Graph *graph ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type nvtx nitem root seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of graph"
"\n nvtx -- # of vertices"
"\n nitem -- # of items used to generate graph"
"\n root -- root processor for broadcast"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
type = atoi(argv[3]) ;
nvtx = atoi(argv[4]) ;
nitem = atoi(argv[5]) ;
root = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n type -- %d"
"\n nvtx -- %d"
"\n nitem -- %d"
"\n root -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ;
fflush(msgFile) ;
/*
-----------------------
set up the Graph object
-----------------------
*/
MARKTIME(t1) ;
graph = Graph_new() ;
if ( myid == root ) {
InpMtx *inpmtx ;
int nedges, totewght, totvwght, v ;
int *adj, *vwghts ;
IVL *adjIVL, *ewghtIVL ;
/*
-----------------------
generate a random graph
-----------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nvtx) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ;
InpMtx_setNent(inpmtx, nitem) ;
InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
adjIVL = InpMtx_fullAdjacency(inpmtx) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n full adjacency structure") ;
IVL_writeForHumanEye(adjIVL, msgFile) ;
fflush(msgFile) ;
}
nedges = adjIVL->tsize ;
if ( type == 1 || type == 3 ) {
Drand_setUniform(&drand, 1, 10) ;
vwghts = IVinit(nvtx, 0) ;
Drand_fillIvector(&drand, nvtx, vwghts) ;
totvwght = IVsum(nvtx, vwghts) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex weights") ;
IVfprintf(msgFile, nvtx, vwghts) ;
fflush(msgFile) ;
}
} else {
vwghts = NULL ;
totvwght = nvtx ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totvwght %d", totvwght) ;
fflush(msgFile) ;
}
if ( type == 2 || type == 3 ) {
ewghtIVL = IVL_new() ;
IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ;
Drand_setUniform(&drand, 1, 100) ;
totewght = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(adjIVL, v, &size, &adj) ;
IVL_setList(ewghtIVL, v, size, NULL) ;
IVL_listAndSize(ewghtIVL, v, &size, &adj) ;
Drand_fillIvector(&drand, size, adj) ;
totewght += IVsum(size, adj) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ewghtIVL") ;
IVL_writeForHumanEye(ewghtIVL, msgFile) ;
fflush(msgFile) ;
}
} else {
ewghtIVL = NULL ;
totewght = nedges ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totewght %d", totewght) ;
fflush(msgFile) ;
}
Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght,
adjIVL, vwghts, ewghtIVL) ;
InpMtx_free(inpmtx) ;
}
MARKTIME(t2) ;
fprintf(msgFile,
"\n CPU %8.3f : initialize the Graph object", t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
if ( myid == root ) {
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
}
/*
--------------------------
broadcast the Graph object
--------------------------
*/
MARKTIME(t1) ;
graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
---------------------------------------
gather the checksums from the processes
---------------------------------------
*/
sums = DVinit(nproc, 0.0) ;
MPI_Gather((void *) &chksum, 1, MPI_DOUBLE,
(void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile, "\n\n sums") ;
DVfprintf(msgFile, nproc, sums) ;
for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
sums[iproc] -= chksum ;
}
fprintf(msgFile, "\n\n errors") ;
DVfprintf(msgFile, nproc, sums) ;
fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc));
}
/*
----------------
free the objects
----------------
*/
DVfree(sums) ;
Graph_free(graph) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*
----------------------------------------------------------------
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) ; }
/*--------------------------------------------------------------------*/
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) ; }
