/*
-----------------------
clear the data fields
created -- 98aug26, cca
-----------------------
*/
void
PatchAndGoInfo_clearData (
PatchAndGoInfo *info
) {
if ( info == NULL ) {
fprintf(stderr, "\n fatal error in PatchAndGoInfo_clearData()"
"\n bad input\n") ;
spoolesFatal();
}
if ( info->fudgeIV != NULL ) {
IV_free(info->fudgeIV) ;
}
if ( info->fudgeDV != NULL ) {
DV_free(info->fudgeDV) ;
}
PatchAndGoInfo_setDefaultFields(info) ;
return ; }
/*
-----------------------
clear the data fields
return value ---
1 -- normal return
-1 -- bridge is NULL
created -- 98sep18, cca
-----------------------
*/
int
BridgeMT_clearData (
BridgeMT *bridge
) {
if ( bridge == NULL ) {
fprintf(stderr, "\n fatal error in BridgeMT_clearData(%p)"
"\n bad input\n", bridge) ;
return(-1) ;
}
if ( bridge->frontmtx != NULL ) {
FrontMtx_free(bridge->frontmtx) ;
}
if ( bridge->frontETree != NULL ) {
ETree_free(bridge->frontETree) ;
}
if ( bridge->symbfacIVL != NULL ) {
IVL_free(bridge->symbfacIVL) ;
}
if ( bridge->mtxmanager != NULL ) {
SubMtxManager_free(bridge->mtxmanager) ;
}
if ( bridge->oldToNewIV != NULL ) {
IV_free(bridge->oldToNewIV) ;
}
if ( bridge->newToOldIV != NULL ) {
IV_free(bridge->newToOldIV) ;
}
if ( bridge->ownersIV != NULL ) {
IV_free(bridge->ownersIV) ;
}
if ( bridge->solvemap != NULL ) {
SolveMap_free(bridge->solvemap) ;
}
if ( bridge->cumopsDV != NULL ) {
DV_free(bridge->cumopsDV) ;
}
BridgeMT_setDefaultFields(bridge) ;
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 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[] ) {
/*
--------------------------------------------------
all-in-one program to solve A X = B
using a multithreaded factorization and solve
We use a patch-and-go strategy
for the factorization without pivoting
(1) read in matrix entries and form DInpMtx object
(2) form Graph object
(3) order matrix and form front tree
(4) get the permutation, permute the matrix and
front tree and get the symbolic factorization
(5) compute the numeric factorization
(6) read in right hand side entries
(7) compute the solution
created -- 98jun04, cca
--------------------------------------------------
*/
/*--------------------------------------------------------------------*/
char *matrixFileName, *rhsFileName ;
DenseMtx *mtxB, *mtxX ;
Chv *rootchv ;
ChvManager *chvmanager ;
double fudge, imag, real, tau = 100., toosmall, value ;
double cpus[10] ;
DV *cumopsDV ;
ETree *frontETree ;
FrontMtx *frontmtx ;
FILE *inputFile, *msgFile ;
Graph *graph ;
InpMtx *mtxA ;
int error, ient, irow, jcol, jrhs, jrow, lookahead, msglvl,
ncol, nedges, nent, neqns, nfront, nrhs, nrow, nthread,
patchAndGoFlag, seed,
storeids, storevalues, symmetryflag, type ;
int *newToOld, *oldToNew ;
int stats[20] ;
IV *newToOldIV, *oldToNewIV, *ownersIV ;
IVL *adjIVL, *symbfacIVL ;
SolveMap *solvemap ;
SubMtxManager *mtxmanager ;
/*--------------------------------------------------------------------*/
/*
--------------------
get input parameters
--------------------
*/
if ( argc != 14 ) {
fprintf(stdout, "\n"
"\n usage: %s msglvl msgFile type symmetryflag patchAndGoFlag"
"\n fudge toosmall storeids storevalues"
"\n matrixFileName rhsFileName seed"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of entries"
"\n 1 (SPOOLES_REAL) -- real entries"
"\n 2 (SPOOLES_COMPLEX) -- complex entries"
"\n symmetryflag -- type of matrix"
"\n 0 (SPOOLES_SYMMETRIC) -- symmetric entries"
"\n 1 (SPOOLES_HERMITIAN) -- Hermitian entries"
"\n 2 (SPOOLES_NONSYMMETRIC) -- nonsymmetric entries"
"\n patchAndGoFlag -- flag for the patch-and-go strategy"
"\n 0 -- none, stop factorization"
"\n 1 -- optimization strategy"
"\n 2 -- structural analysis strategy"
"\n fudge -- perturbation parameter"
"\n toosmall -- upper bound on a small pivot"
"\n storeids -- flag to store ids of small pivots"
"\n storevalues -- flag to store perturbations"
"\n matrixFileName -- matrix file name, format"
"\n nrow ncol nent"
"\n irow jcol entry"
"\n ..."
"\n note: indices are zero based"
"\n rhsFileName -- right hand side file name, format"
"\n nrow nrhs "
"\n ..."
"\n jrow entry(jrow,0) ... entry(jrow,nrhs-1)"
"\n ..."
"\n seed -- random number seed, used for ordering"
"\n nthread -- number of threads"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
type = atoi(argv[3]) ;
symmetryflag = atoi(argv[4]) ;
patchAndGoFlag = atoi(argv[5]) ;
fudge = atof(argv[6]) ;
toosmall = atof(argv[7]) ;
storeids = atoi(argv[8]) ;
storevalues = atoi(argv[9]) ;
matrixFileName = argv[10] ;
rhsFileName = argv[11] ;
seed = atoi(argv[12]) ;
nthread = atoi(argv[13]) ;
/*--------------------------------------------------------------------*/
/*
--------------------------------------------
STEP 1: read the entries from the input file
and create the InpMtx object
--------------------------------------------
*/
if ( (inputFile = fopen(matrixFileName, "r")) == NULL ) {
fprintf(stderr, "\n unable to open file %s", matrixFileName) ;
spoolesFatal();
}
fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ;
neqns = nrow ;
mtxA = InpMtx_new() ;
InpMtx_init(mtxA, INPMTX_BY_ROWS, type, nent, 0) ;
if ( type == SPOOLES_REAL ) {
for ( ient = 0 ; ient < nent ; ient++ ) {
fscanf(inputFile, "%d %d %le", &irow, &jcol, &value) ;
InpMtx_inputRealEntry(mtxA, irow, jcol, value) ;
}
} else {
for ( ient = 0 ; ient < nent ; ient++ ) {
fscanf(inputFile, "%d %d %le %le", &irow, &jcol, &real, &imag) ;
InpMtx_inputComplexEntry(mtxA, irow, jcol, real, imag) ;
}
}
fclose(inputFile) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n input matrix") ;
InpMtx_writeForHumanEye(mtxA, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-------------------------------------------------
STEP 2 : find a low-fill ordering
(1) create the Graph object
(2) order the graph using multiple minimum degree
-------------------------------------------------
*/
graph = Graph_new() ;
adjIVL = InpMtx_fullAdjacency(mtxA) ;
nedges = IVL_tsize(adjIVL) ;
Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL,
NULL, NULL) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n graph of the input matrix") ;
Graph_writeForHumanEye(graph, msgFile) ;
fflush(msgFile) ;
}
frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n front tree from ordering") ;
ETree_writeForHumanEye(frontETree, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------------
STEP 3: get the permutation, permute the matrix and
front tree and get the symbolic factorization
-----------------------------------------------------
*/
oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
oldToNew = IV_entries(oldToNewIV) ;
newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
newToOld = IV_entries(newToOldIV) ;
ETree_permuteVertices(frontETree, oldToNewIV) ;
InpMtx_permute(mtxA, oldToNew, oldToNew) ;
InpMtx_mapToUpperTriangle(mtxA) ;
InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n old-to-new permutation vector") ;
IV_writeForHumanEye(oldToNewIV, msgFile) ;
fprintf(msgFile, "\n\n new-to-old permutation vector") ;
IV_writeForHumanEye(newToOldIV, msgFile) ;
fprintf(msgFile, "\n\n front tree after permutation") ;
ETree_writeForHumanEye(frontETree, msgFile) ;
fprintf(msgFile, "\n\n input matrix after permutation") ;
InpMtx_writeForHumanEye(mtxA, msgFile) ;
fprintf(msgFile, "\n\n symbolic factorization") ;
IVL_writeForHumanEye(symbfacIVL, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
------------------------------------------
STEP 4: initialize the front matrix object
and the PatchAndGoInfo object to handle
small pivots
------------------------------------------
*/
frontmtx = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, LOCK_IN_PROCESS, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, symmetryflag,
FRONTMTX_DENSE_FRONTS, SPOOLES_NO_PIVOTING, LOCK_IN_PROCESS,
0, NULL, mtxmanager, msglvl, msgFile) ;
if ( patchAndGoFlag == 1 ) {
frontmtx->patchinfo = PatchAndGoInfo_new() ;
PatchAndGoInfo_init(frontmtx->patchinfo, 1, toosmall, fudge,
storeids, storevalues) ;
} else if ( patchAndGoFlag == 2 ) {
frontmtx->patchinfo = PatchAndGoInfo_new() ;
PatchAndGoInfo_init(frontmtx->patchinfo, 2, toosmall, fudge,
storeids, storevalues) ;
}
/*--------------------------------------------------------------------*/
/*
------------------------------------------
STEP 5: setup the domain decomposition map
------------------------------------------
*/
if ( nthread > (nfront = FrontMtx_nfront(frontmtx)) ) {
nthread = nfront ;
}
cumopsDV = DV_new() ;
DV_init(cumopsDV, nthread, NULL) ;
ownersIV = ETree_ddMap(frontETree, type, symmetryflag,
cumopsDV, 1./(2.*nthread)) ;
DV_free(cumopsDV) ;
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------------
STEP 6: compute the numeric factorization in parallel
-----------------------------------------------------
*/
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, LOCK_IN_PROCESS, 1) ;
DVfill(10, cpus, 0.0) ;
IVfill(20, stats, 0) ;
lookahead = 0 ;
rootchv = FrontMtx_MT_factorInpMtx(frontmtx, mtxA, tau, 0.0,
chvmanager, ownersIV, lookahead,
&error, cpus, stats, msglvl, msgFile) ;
if ( patchAndGoFlag == 1 ) {
if ( frontmtx->patchinfo->fudgeIV != NULL ) {
fprintf(msgFile, "\n small pivots found at these locations") ;
IV_writeForHumanEye(frontmtx->patchinfo->fudgeIV, msgFile) ;
}
PatchAndGoInfo_free(frontmtx->patchinfo) ;
} else if ( patchAndGoFlag == 2 ) {
if ( frontmtx->patchinfo->fudgeIV != NULL ) {
fprintf(msgFile, "\n small pivots found at these locations") ;
IV_writeForHumanEye(frontmtx->patchinfo->fudgeIV, msgFile) ;
}
if ( frontmtx->patchinfo->fudgeDV != NULL ) {
fprintf(msgFile, "\n perturbations") ;
DV_writeForHumanEye(frontmtx->patchinfo->fudgeDV, msgFile) ;
}
PatchAndGoInfo_free(frontmtx->patchinfo) ;
}
ChvManager_free(chvmanager) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n factor matrix") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n matrix found to be singular\n") ;
spoolesFatal();
}
if ( error >= 0 ) {
fprintf(msgFile, "\n\n fatal error at front %d\n", error) ;
spoolesFatal();
}
/*
--------------------------------------
STEP 7: post-process the factorization
--------------------------------------
*/
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n factor matrix after post-processing") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------
STEP 8: read the right hand side matrix B
-----------------------------------------
*/
if ( (inputFile = fopen(rhsFileName, "r")) == NULL ) {
fprintf(stderr, "\n unable to open file %s", rhsFileName) ;
spoolesFatal();
}
fscanf(inputFile, "%d %d", &nrow, &nrhs) ;
mtxB = DenseMtx_new() ;
DenseMtx_init(mtxB, type, 0, 0, neqns, nrhs, 1, neqns) ;
DenseMtx_zero(mtxB) ;
if ( type == SPOOLES_REAL ) {
for ( irow = 0 ; irow < nrow ; irow++ ) {
fscanf(inputFile, "%d", &jrow) ;
for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
fscanf(inputFile, "%le", &value) ;
DenseMtx_setRealEntry(mtxB, jrow, jrhs, value) ;
}
}
} else {
for ( irow = 0 ; irow < nrow ; irow++ ) {
fscanf(inputFile, "%d", &jrow) ;
for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
fscanf(inputFile, "%le %le", &real, &imag) ;
DenseMtx_setComplexEntry(mtxB, jrow, jrhs, real, imag) ;
}
}
}
fclose(inputFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n rhs matrix in original ordering") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
--------------------------------------------------------------
STEP 9: permute the right hand side into the original ordering
--------------------------------------------------------------
*/
DenseMtx_permuteRows(mtxB, oldToNewIV) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n right hand side matrix in new ordering") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
--------------------------------------------------------
STEP 10: get the solve map object for the parallel solve
--------------------------------------------------------
*/
solvemap = SolveMap_new() ;
SolveMap_ddMap(solvemap, type, FrontMtx_upperBlockIVL(frontmtx),
FrontMtx_lowerBlockIVL(frontmtx), nthread, ownersIV,
FrontMtx_frontTree(frontmtx), seed, msglvl, msgFile) ;
/*--------------------------------------------------------------------*/
/*
--------------------------------------------
STEP 11: solve the linear system in parallel
--------------------------------------------
*/
mtxX = DenseMtx_new() ;
DenseMtx_init(mtxX, type, 0, 0, neqns, nrhs, 1, neqns) ;
DenseMtx_zero(mtxX) ;
FrontMtx_MT_solve(frontmtx, mtxX, mtxB, mtxmanager, solvemap,
cpus, msglvl, msgFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n solution matrix in new ordering") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
--------------------------------------------------------
STEP 12: permute the solution into the original ordering
--------------------------------------------------------
*/
DenseMtx_permuteRows(mtxX, newToOldIV) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n solution matrix in original ordering") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-----------
free memory
-----------
*/
FrontMtx_free(frontmtx) ;
DenseMtx_free(mtxX) ;
DenseMtx_free(mtxB) ;
IV_free(newToOldIV) ;
IV_free(oldToNewIV) ;
InpMtx_free(mtxA) ;
ETree_free(frontETree) ;
IVL_free(symbfacIVL) ;
SubMtxManager_free(mtxmanager) ;
Graph_free(graph) ;
SolveMap_free(solvemap) ;
IV_free(ownersIV) ;
/*--------------------------------------------------------------------*/
return(1) ; }
/*--------------------------------------------------------------------*/
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) ; }
//static void factor_MT(struct factorinfo *pfi, InpMtx *mtxA, int size, FILE *msgFile, int symmetryflag)
void factor_MT(struct factorinfo *pfi, InpMtx *mtxA, int size, FILE *msgFile, int symmetryflag)
{
Graph *graph;
IV *ownersIV;
IVL *symbfacIVL;
Chv *rootchv;
/* Initialize pfi: */
pfi->size = size;
pfi->msgFile = msgFile;
DVfill(10, pfi->cpus, 0.0);
/*
* STEP 1 : find a low-fill ordering
* (1) create the Graph object
*/
ssolve_creategraph(&graph, &pfi->frontETree, mtxA, size, msgFile);
/*
* STEP 2: get the permutation, permute the matrix and
* front tree and get the symbolic factorization
*/
ssolve_permuteA(&pfi->oldToNewIV, &pfi->newToOldIV, &symbfacIVL, pfi->frontETree,
mtxA, msgFile, symmetryflag);
/*
* STEP 3: Prepare distribution to multiple threads/cpus
*/
{
DV *cumopsDV;
int nfront;
nfront = ETree_nfront(pfi->frontETree);
pfi->nthread = num_cpus;
if (pfi->nthread > nfront)
pfi->nthread = nfront;
cumopsDV = DV_new();
DV_init(cumopsDV, pfi->nthread, NULL);
ownersIV = ETree_ddMap(pfi->frontETree, SPOOLES_REAL, symmetryflag,
cumopsDV, 1. / (2. * pfi->nthread));
if (DEBUG_LVL > 1) {
fprintf(msgFile,
"\n\n map from fronts to threads");
IV_writeForHumanEye(ownersIV, msgFile);
fprintf(msgFile,
"\n\n factor operations for each front");
DV_writeForHumanEye(cumopsDV, msgFile);
fflush(msgFile);
} else {
fprintf(msgFile, "\n\n Using %d threads\n",
pfi->nthread);
}
DV_free(cumopsDV);
}
/*
* STEP 4: initialize the front matrix object
*/
{
pfi->frontmtx = FrontMtx_new();
pfi->mtxmanager = SubMtxManager_new();
SubMtxManager_init(pfi->mtxmanager, LOCK_IN_PROCESS, 0);
FrontMtx_init(pfi->frontmtx, pfi->frontETree, symbfacIVL, SPOOLES_REAL,
symmetryflag, FRONTMTX_DENSE_FRONTS,
SPOOLES_PIVOTING, LOCK_IN_PROCESS, 0, NULL,
pfi->mtxmanager, DEBUG_LVL, pfi->msgFile);
}
/*
* STEP 5: compute the numeric factorization in parallel
*/
{
ChvManager *chvmanager;
int stats[20];
int error;
chvmanager = ChvManager_new();
ChvManager_init(chvmanager, LOCK_IN_PROCESS, 1);
IVfill(20, stats, 0);
rootchv = FrontMtx_MT_factorInpMtx(pfi->frontmtx, mtxA, MAGIC_TAU, MAGIC_DTOL,
chvmanager, ownersIV, 0,
&error, pfi->cpus, stats, DEBUG_LVL,
pfi->msgFile);
ChvManager_free(chvmanager);
if (DEBUG_LVL > 1) {
fprintf(msgFile, "\n\n factor matrix");
FrontMtx_writeForHumanEye(pfi->frontmtx, pfi->msgFile);
fflush(pfi->msgFile);
}
if (rootchv != NULL) {
fprintf(pfi->msgFile, "\n\n matrix found to be singular\n");
exit(-1);
}
if (error >= 0) {
fprintf(pfi->msgFile, "\n\n fatal error at front %d", error);
exit(-1);
}
}
/*
* STEP 6: post-process the factorization
*/
ssolve_postfactor(pfi->frontmtx, pfi->msgFile);
/*
* STEP 7: get the solve map object for the parallel solve
*/
{
pfi->solvemap = SolveMap_new();
SolveMap_ddMap(pfi->solvemap, symmetryflag,
FrontMtx_upperBlockIVL(pfi->frontmtx),
FrontMtx_lowerBlockIVL(pfi->frontmtx), pfi->nthread, ownersIV,
FrontMtx_frontTree(pfi->frontmtx), RNDSEED, DEBUG_LVL,
pfi->msgFile);
}
/* cleanup: */
InpMtx_free(mtxA);
IVL_free(symbfacIVL);
Graph_free(graph);
IV_free(ownersIV);
}
