/*
-----------------------------------------------------------
purpose -- compute the checksums of the indices and entries
sums[0] = sum_{ii=0}^{nent} abs(ivec1[ii])
sums[1] = sum_{ii=0}^{nent} abs(ivec2[ii])
if real or complex entries then
sums[2] = sum_{ii=0}^{nent} magnitudes of entries
endif
created -- 98may16, cca
-----------------------------------------------------------
*/
void
InpMtx_checksums (
InpMtx *inpmtx,
double sums[]
) {
int ient, nent ;
int *ivec1, *ivec2 ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)"
"\n bad input\n", inpmtx, sums) ;
exit(-1) ;
}
switch ( inpmtx->inputMode ) {
case INPMTX_INDICES_ONLY :
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
break ;
default :
fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)"
"\n bad inputMode\n", inpmtx, sums) ;
exit(-1) ;
}
sums[0] = sums[1] = sums[2] = 0.0 ;
if ( (nent = InpMtx_nent(inpmtx)) <= 0 ) {
return ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
sums[0] += abs(ivec1[ient]) ;
sums[1] += abs(ivec2[ient]) ;
}
switch ( inpmtx->inputMode ) {
case INPMTX_INDICES_ONLY :
break ;
case SPOOLES_REAL : {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
sums[2] += fabs(dvec[ient]) ;
}
} break ;
case SPOOLES_COMPLEX : {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
sums[2] += Zabs(dvec[2*ient], dvec[2*ient+1]) ;
}
} break ;
}
return ; }
/*
-----------------------------------
map entries into the upper triangle
created -- 98jan28, cca
-----------------------------------
*/
void
InpMtx_mapToUpperTriangle (
InpMtx *inpmtx
) {
int col, ii, nent, row ;
int *ivec1, *ivec2 ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)"
"\n bad input\n", inpmtx) ;
exit(-1) ;
}
if ( !( INPMTX_IS_BY_ROWS(inpmtx)
|| INPMTX_IS_BY_COLUMNS(inpmtx)
|| INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)"
"\n bad coordType = %d, must be 1, 2, or 3\n",
inpmtx, inpmtx->coordType) ;
exit(-1) ;
}
nent = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( (row = ivec1[ii]) > (col = ivec2[ii]) ) {
ivec1[ii] = col ;
ivec2[ii] = row ;
}
}
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( (row = ivec2[ii]) > (col = ivec1[ii]) ) {
ivec1[ii] = row ;
ivec2[ii] = col ;
}
}
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( ivec2[ii] < 0 ) {
ivec2[ii] = -ivec2[ii] ;
}
}
}
inpmtx->storageMode = INPMTX_RAW_DATA ;
return ; }
/*
-----------------------------------
map entries into the lower triangle
created -- 98jan28, cca
-----------------------------------
*/
void
InpMtx_mapToLowerTriangle (
InpMtx *inpmtx
) {
int col, ii, nent, row ;
int *ivec1, *ivec2 ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_mapToLowerTriangle(%p)"
"\n bad input\n", inpmtx) ;
exit(-1) ;
}
if ( !( INPMTX_IS_BY_ROWS(inpmtx)
|| INPMTX_IS_BY_COLUMNS(inpmtx)
|| INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
fprintf(stderr, "\n fatal error in InpMtx_mapToLowerTriangle(%p)"
"\n bad coordType\n", inpmtx) ;
exit(-1) ;
}
nent = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( (row = ivec1[ii]) < (col = ivec2[ii]) ) {
ivec1[ii] = col ;
ivec2[ii] = row ;
}
}
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( (row = ivec2[ii]) < (col = ivec1[ii]) ) {
ivec1[ii] = row ;
ivec2[ii] = col ;
}
}
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( ivec2[ii] > 0 ) {
ivec2[ii] = -ivec2[ii] ;
}
}
}
return ; }
/*
---------------------------------------
given the data is in raw triples,
sort and compress the data
created -- 98jan28, cca
modified -- 98sep04, cca
test to see if the sort is necessary
---------------------------------------
*/
void
InpMtx_sortAndCompress (
InpMtx *inpmtx
) {
int ient, nent, sortMustBeDone ;
int *ivec1, *ivec2 ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_sortAndCompress(%p)"
"\n bad input\n", inpmtx) ;
exit(-1) ;
}
if ( INPMTX_IS_SORTED(inpmtx)
|| INPMTX_IS_BY_VECTORS(inpmtx)
|| (nent = inpmtx->nent) == 0 ) {
inpmtx->storageMode = INPMTX_SORTED ;
return ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
sortMustBeDone = 0 ;
for ( ient = 1 ; ient < nent ; ient++ ) {
if ( ivec1[ient-1] > ivec1[ient]
|| ( ivec1[ient-1] == ivec1[ient]
&& ivec2[ient-1] > ivec2[ient] ) ) {
sortMustBeDone = 1 ;
break ;
}
}
if ( sortMustBeDone == 1 ) {
if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) {
inpmtx->nent = IV2sortUpAndCompress(nent, ivec1, ivec2) ;
} else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
double *dvec = InpMtx_dvec(inpmtx) ;
inpmtx->nent = IV2DVsortUpAndCompress(nent, ivec1, ivec2, dvec) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
double *dvec = InpMtx_dvec(inpmtx) ;
inpmtx->nent = IV2ZVsortUpAndCompress(nent, ivec1, ivec2, dvec) ;
}
}
inpmtx->storageMode = INPMTX_SORTED ;
return ; }
/*
--------------------------------------------------------------------
purpose --
this method is used to determine the support of this matrix
for a matrix-vector multiply y[] = A * x[] when A is a
symmetric matrix.
supIV -- filled with row indices of y[] which will be updated
and row indices of x[] which will be used.
created -- 98aug01, cca
--------------------------------------------------------------------
*/
void
InpMtx_supportSym (
InpMtx *A,
IV *supIV
) {
char *mark ;
int chev, col, count, ii, loc, maxcol, maxrow, maxv, nent, off, row ;
int *ivec1, *ivec2, *sup ;
/*
---------------
check the input
---------------
*/
if ( A == NULL || supIV == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)"
"\n bad input\n", A, supIV) ;
exit(-1) ;
}
if ( !INPMTX_IS_BY_ROWS(A)
&& !INPMTX_IS_BY_COLUMNS(A)
&& !INPMTX_IS_BY_CHEVRONS(A) ) {
fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)"
"\n coordinate type\n", A, supIV) ;
exit(-1) ;
}
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
nent = A->nent ;
/*
-----------------------------------------------------------------
(1) determine the maximum row and column numbers in these entries
(2) allocate marking vectors for rows and columns
(3) fill marking vectors for rows and columns
(4) fill support vectors
-----------------------------------------------------------------
*/
if ( INPMTX_IS_BY_ROWS(A) ) {
maxrow = IVmax(nent, ivec1, &loc) ;
maxcol = IVmax(nent, ivec2, &loc) ;
maxv = (maxrow >= maxcol) ? maxrow : maxcol ;
mark = CVinit(1+maxv, 'O') ;
count = 0 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
row = ivec1[ii] ; col = ivec2[ii] ;
if ( mark[row] == 'O' ) {
count++ ;
}
mark[row] = 'X' ;
if ( mark[col] == 'O' ) {
count++ ;
}
mark[col] = 'X' ;
}
} else if ( INPMTX_IS_BY_COLUMNS(A) ) {
maxrow = IVmax(nent, ivec2, &loc) ;
maxcol = IVmax(nent, ivec1, &loc) ;
maxv = (maxrow >= maxcol) ? maxrow : maxcol ;
mark = CVinit(1+maxv, 'O') ;
count = 0 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
row = ivec2[ii] ; col = ivec1[ii] ;
if ( mark[row] == 'O' ) {
count++ ;
}
mark[row] = 'X' ;
if ( mark[col] == 'O' ) {
count++ ;
}
mark[col] = 'X' ;
}
} else if ( INPMTX_IS_BY_CHEVRONS(A) ) {
maxv = -1 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
chev = ivec1[ii] ; off = ivec2[ii] ;
if ( off >= 0 ) {
row = chev ; col = chev + off ;
if ( maxv < col ) {
maxv = col ;
}
} else {
col = chev ; row = chev - off ;
if ( maxv < row ) {
maxv = row ;
}
}
}
mark = CVinit(1+maxv, 'O') ;
count = 0 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
chev = ivec1[ii] ; off = ivec2[ii] ;
if ( off >= 0 ) {
row = chev ; col = chev + off ;
} else {
col = chev ; row = chev - off ;
}
if ( mark[row] == 'O' ) {
count++ ;
}
mark[row] = 'X' ;
if ( mark[col] == 'O' ) {
count++ ;
}
mark[col] = 'X' ;
}
}
IV_setSize(supIV, count) ;
sup = IV_entries(supIV) ;
for ( row = count = 0 ; row <= maxv ; row++ ) {
if ( mark[row] == 'X' ) {
sup[count++] = row ;
}
}
CVfree(mark) ;
return ; }
/*
--------------------------------------------------------------------
purpose -- to map the coordinates of the entries of the matrix
into new coordinates. this method is used during the distributed
matrix-vector multiply where a matrix local to a processor is
mapped into a local coordinate system.
(row,col) --> (rowmap[row],colmap[col])
we check that row is in [0,nrow) and col is in [0,ncol),
where nrow is the size of rowmapIV and ncol is the size of colmapIV.
note, the storage mode is not changed. i.e., if the data is
stored by vectors, it may be invalid after the indices have
been mapped. on the other hand, it may not, so it is the user's
responsibility to reset the storage mode if necessary.
created -- 98aug02, cca
--------------------------------------------------------------------
*/
void
InpMtx_mapEntries (
InpMtx *inpmtx,
IV *rowmapIV,
IV *colmapIV
) {
int chv, col, ii, ncol, nent, nrow, off, row ;
int *colmap, *ivec1, *ivec2, *rowmap ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL || rowmapIV == NULL || colmapIV == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n bad input\n") ;
exit(-1) ;
}
if ( !(INPMTX_IS_BY_ROWS(inpmtx)
|| INPMTX_IS_BY_COLUMNS(inpmtx)
|| INPMTX_IS_BY_CHEVRONS(inpmtx)) ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n bad coordinate type\n") ;
exit(-1) ;
}
IV_sizeAndEntries(rowmapIV, &nrow, &rowmap) ;
if ( rowmap == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n rowmap is NULL\n") ;
exit(-1) ;
}
IV_sizeAndEntries(colmapIV, &ncol, &colmap) ;
if ( colmap == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n colmap is NULL\n") ;
exit(-1) ;
}
nent = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
row = ivec1[ii] ; col = ivec2[ii] ;
if ( row < 0 || row >= nrow ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
exit(-1) ;
}
ivec1[ii] = rowmap[row] ;
if ( col < 0 || col >= ncol ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
exit(-1) ;
}
ivec2[ii] = colmap[col] ;
}
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
row = ivec2[ii] ; col = ivec1[ii] ;
if ( row < 0 || row >= nrow ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
exit(-1) ;
}
ivec2[ii] = rowmap[row] ;
if ( col < 0 || col >= ncol ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
exit(-1) ;
}
ivec1[ii] = colmap[col] ;
}
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
chv = ivec1[ii] ; off = ivec2[ii] ;
if ( off >= 0 ) {
row = chv ; col = chv + off ;
} else {
row = chv - off ; col = chv ;
}
if ( row < 0 || row >= nrow ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
exit(-1) ;
}
row = rowmap[row] ;
if ( col < 0 || col >= ncol ) {
fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
"\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
exit(-1) ;
}
col = colmap[col] ;
ivec1[ii] = (row >= col) ? col : row ;
ivec2[ii] = col - row ;
}
}
return ; }
/*
--------------------------------------------------------------------
purpose --
this method is used to determine the support of this matrix
for a matrix-vector multiply y[] = A * x[] when A is a
nonsymmetric matrix.
rowsupIV -- filled with row indices of y[] which will be updated.
colsupIV -- filled with row indices of x[] which will be used.
created -- 98aug01, cca
--------------------------------------------------------------------
*/
void
InpMtx_supportNonsymT (
InpMtx *A,
IV *rowsupIV,
IV *colsupIV
) {
char *colmark, *rowmark ;
int chev, col, colcount, ii, loc, maxcol, maxrow, nent, off, row,
rowcount ;
int *colsup, *ivec1, *ivec2, *rowsup ;
/*
---------------
check the input
---------------
*/
if ( A == NULL || rowsupIV == NULL || colsupIV == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)"
"\n bad input\n", A, rowsupIV, colsupIV) ;
spoolesFatal();
}
if ( !INPMTX_IS_BY_ROWS(A)
&& !INPMTX_IS_BY_COLUMNS(A)
&& !INPMTX_IS_BY_CHEVRONS(A) ) {
fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)"
"\n coordinate type\n", A, rowsupIV, colsupIV) ;
spoolesFatal();
}
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
nent = A->nent ;
/*
-----------------------------------------------------------------
(1) determine the maximum row and column numbers in these entries
(2) allocate marking vectors for rows and columns
(3) fill marking vectors for rows and columns
(4) fill support vectors
-----------------------------------------------------------------
*/
if ( INPMTX_IS_BY_ROWS(A) ) {
maxrow = IVmax(nent, ivec1, &loc) ;
maxcol = IVmax(nent, ivec2, &loc) ;
rowmark = CVinit(1+maxcol, 'O') ;
colmark = CVinit(1+maxrow, 'O') ;
rowcount = colcount = 0 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
row = ivec1[ii] ; col = ivec2[ii] ;
if ( colmark[row] == 'O' ) {
colcount++ ;
}
colmark[row] = 'X' ;
if ( rowmark[col] == 'O' ) {
rowcount++ ;
}
rowmark[col] = 'X' ;
}
} else if ( INPMTX_IS_BY_COLUMNS(A) ) {
maxrow = IVmax(nent, ivec2, &loc) ;
maxcol = IVmax(nent, ivec1, &loc) ;
rowmark = CVinit(1+maxcol, 'O') ;
colmark = CVinit(1+maxrow, 'O') ;
rowcount = colcount = 0 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
row = ivec2[ii] ; col = ivec1[ii] ;
if ( colmark[row] == 'O' ) {
colcount++ ;
}
colmark[row] = 'X' ;
if ( rowmark[col] == 'O' ) {
rowcount++ ;
}
rowmark[col] = 'X' ;
}
} else if ( INPMTX_IS_BY_CHEVRONS(A) ) {
maxrow = maxcol = -1 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
chev = ivec1[ii] ; off = ivec2[ii] ;
if ( off >= 0 ) {
row = chev ; col = chev + off ;
} else {
col = chev ; row = chev - off ;
}
if ( maxrow < row ) {
maxrow = row ;
}
if ( maxcol < col ) {
maxcol = col ;
}
}
rowmark = CVinit(1+maxcol, 'O') ;
colmark = CVinit(1+maxrow, 'O') ;
rowcount = colcount = 0 ;
for ( ii = 0 ; ii < nent ; ii++ ) {
chev = ivec1[ii] ; off = ivec2[ii] ;
if ( off >= 0 ) {
row = chev ; col = chev + off ;
} else {
col = chev ; row = chev - off ;
}
if ( colmark[row] == 'O' ) {
colcount++ ;
}
colmark[row] = 'X' ;
if ( rowmark[col] == 'O' ) {
rowcount++ ;
}
rowmark[col] = 'X' ;
}
}
IV_setSize(rowsupIV, rowcount) ;
rowsup = IV_entries(rowsupIV) ;
for ( col = rowcount = 0 ; col <= maxcol ; col++ ) {
if ( rowmark[col] == 'X' ) {
rowsup[rowcount++] = col ;
}
}
IV_setSize(colsupIV, colcount) ;
colsup = IV_entries(colsupIV) ;
for ( row = colcount = 0 ; row <= maxrow ; row++ ) {
if ( colmark[row] == 'X' ) {
colsup[colcount++] = row ;
}
}
CVfree(colmark) ;
CVfree(rowmark) ;
return ; }
/*
----------------------------------
return an IVL object that contains
the adjacency structure of A^TA.
created -- 98jan28, cca
----------------------------------
*/
IVL *
InpMtx_adjForATA (
InpMtx *inpmtxA
) {
InpMtx *inpmtxATA ;
int firstcol, firstrow, irow, jvtx, lastcol, lastrow,
loc, ncol, nent, nrow, size ;
int *ind, *ivec1, *ivec2 ;
IVL *adjIVL ;
/*
---------------
check the input
---------------
*/
if ( inpmtxA == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_adjForATA(%p)"
"\n NULL input\n", inpmtxA) ;
exit(-1) ;
}
/*
----------------------------------------------------------
change the coordinate type and storage mode to row vectors
----------------------------------------------------------
*/
InpMtx_changeCoordType(inpmtxA, INPMTX_BY_ROWS) ;
InpMtx_changeStorageMode(inpmtxA, INPMTX_BY_VECTORS) ;
nent = InpMtx_nent(inpmtxA) ;
ivec1 = InpMtx_ivec1(inpmtxA) ;
ivec2 = InpMtx_ivec2(inpmtxA) ;
firstrow = IVmin(nent, ivec1, &loc) ;
lastrow = IVmax(nent, ivec1, &loc) ;
firstcol = IVmin(nent, ivec2, &loc) ;
lastcol = IVmax(nent, ivec2, &loc) ;
if ( firstrow < 0 || firstcol < 0 ) {
fprintf(stderr, "\n fatal error"
"\n firstrow = %d, firstcol = %d"
"\n lastrow = %d, lastcol = %d",
firstrow, firstcol, lastrow, lastcol) ;
exit(-1) ;
}
nrow = 1 + lastrow ;
ncol = 1 + lastcol ;
/*
-----------------------------------------------------------
create the new InpMtx object to hold the structure of A^TA
-----------------------------------------------------------
*/
inpmtxATA = InpMtx_new() ;
InpMtx_init(inpmtxATA, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, 0, 0) ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
InpMtx_vector(inpmtxA, irow, &size, &ind) ;
InpMtx_inputMatrix(inpmtxATA, size, size, 1, size, ind, ind) ;
}
for ( jvtx = 0 ; jvtx < nrow ; jvtx++ ) {
InpMtx_inputEntry(inpmtxATA, jvtx, jvtx) ;
}
InpMtx_changeStorageMode(inpmtxATA, INPMTX_BY_VECTORS) ;
/*
-------------------
fill the IVL object
-------------------
*/
adjIVL = IVL_new() ;
IVL_init1(adjIVL, IVL_CHUNKED, nrow) ;
for ( jvtx = 0 ; jvtx < ncol ; jvtx++ ) {
InpMtx_vector(inpmtxATA, jvtx, &size, &ind) ;
IVL_setList(adjIVL, jvtx, size, ind) ;
}
/*
------------------------------
free the working InpMtx object
------------------------------
*/
InpMtx_free(inpmtxATA) ;
return(adjIVL) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*
-------------------------------------------
set up the nthread MTmvmObj data structures
-------------------------------------------
*/
static MTmvmObj *
setup (
InpMtx *A,
DenseMtx *Y,
double alpha[],
DenseMtx *X,
int nthread
) {
double *dvec ;
int ithread, nentA, nextra, nlocal, offset ;
int *ivec1, *ivec2 ;
MTmvmObj *MTmvmObjs, *obj ;
/*
---------------------------------
allocate nthread MTmvmObj objects
---------------------------------
*/
ALLOCATE(MTmvmObjs, struct _MTmvmObj, nthread) ;
for ( ithread = 0, obj = MTmvmObjs ;
ithread < nthread ;
ithread++, obj++ ) {
obj->A = InpMtx_new() ;
if ( ithread == 0 ) {
obj->Y = Y ;
} else {
obj->Y = DenseMtx_new() ;
}
obj->alpha[0] = alpha[0] ;
obj->alpha[1] = alpha[1] ;
obj->X = X ;
}
/*
----------------------------------------
set up and zero the replicated Y objects
----------------------------------------
*/
for ( ithread = 0, obj = MTmvmObjs ;
ithread < nthread ;
ithread++, obj++ ) {
if ( ithread > 0 ) {
DenseMtx_init(obj->Y, Y->type, Y->rowid, Y->colid,
Y->nrow, Y->ncol, Y->inc1, Y->inc2) ;
DenseMtx_zero(obj->Y) ;
}
}
/*
-------------------------------------
set up the partitioned InpMtx objects
-------------------------------------
*/
nentA = InpMtx_nent(A) ;
nlocal = nentA / nthread ;
nextra = nentA % nthread ;
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
if ( INPMTX_IS_REAL_ENTRIES(A) || INPMTX_IS_COMPLEX_ENTRIES(A) ) {
dvec = InpMtx_dvec(A) ;
} else {
dvec = NULL ;
}
offset = 0 ;
for ( ithread = 0, obj = MTmvmObjs ;
ithread < nthread ;
ithread++, obj++ ) {
InpMtx_init(obj->A, A->coordType, A->inputMode, 0, 0) ;
obj->A->storageMode = A->storageMode ;
if ( ithread < nextra ) {
obj->A->nent = nlocal + 1 ;
} else {
obj->A->nent = nlocal ;
}
IV_init(&(obj->A->ivec1IV), obj->A->nent, ivec1 + offset) ;
IV_init(&(obj->A->ivec2IV), obj->A->nent, ivec2 + offset) ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
DV_init(&(obj->A->dvecDV), obj->A->nent, dvec + offset) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
DV_init(&(obj->A->dvecDV), obj->A->nent, dvec + 2*offset) ;
}
offset += obj->A->nent ;
}
return(MTmvmObjs) ; }
/*
----------------------------------
drop entries in the upper triangle
created -- 98jan28, cca
----------------------------------
*/
void
InpMtx_dropUpperTriangle (
InpMtx *inpmtx
) {
double *dvec ;
int count, ii, nent ;
int *ivec1, *ivec2 ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)"
"\n bad input\n", inpmtx) ;
exit(-1) ;
}
if ( !( INPMTX_IS_BY_ROWS(inpmtx)
|| INPMTX_IS_BY_COLUMNS(inpmtx)
|| INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)"
"\n bad coordType \n", inpmtx) ;
exit(-1) ;
}
nent = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
count = 0 ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx)
|| INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
dvec = InpMtx_dvec(inpmtx) ;
}
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( ivec1[ii] >= ivec2[ii] ) {
ivec1[count] = ivec1[ii] ;
ivec2[count] = ivec2[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
dvec[count] = dvec[ii] ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
dvec[2*count] = dvec[2*ii] ;
dvec[2*count+1] = dvec[2*ii+1] ;
}
count++ ;
}
}
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( ivec1[ii] <= ivec2[ii] ) {
ivec1[count] = ivec1[ii] ;
ivec2[count] = ivec2[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
dvec[count] = dvec[ii] ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
dvec[2*count] = dvec[2*ii] ;
dvec[2*count+1] = dvec[2*ii+1] ;
}
count++ ;
}
}
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
if ( ivec2[ii] <= 0 ) {
ivec1[count] = ivec1[ii] ;
ivec2[count] = ivec2[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
dvec[count] = dvec[ii] ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
dvec[2*count] = dvec[2*ii] ;
dvec[2*count+1] = dvec[2*ii+1] ;
}
count++ ;
}
}
}
inpmtx->nent = count ;
IV_setSize(&inpmtx->ivec1IV, count) ;
IV_setSize(&inpmtx->ivec2IV, count) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx)
|| INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
DV_setSize(&inpmtx->dvecDV, count) ;
}
return ; }
/*
--------------------------------------------------------------------
purpose -- to setup two data structures for a QR serial
or multithreaded factorization
rowsIVL[J] -- list of rows of A to be assembled into front J
firstnz[irow] -- column with location of leading nonzero of row in A
created -- 98may29, cca
--------------------------------------------------------------------
*/
void
FrontMtx_QR_setup (
FrontMtx *frontmtx,
InpMtx *mtxA,
IVL **prowsIVL,
int **pfirstnz,
int msglvl,
FILE *msgFile
) {
int count, irow, jcol, J, loc, neqns, nfront, nrowA, rowsize ;
int *firstnz, *head, *link, *list, *rowind, *vtxToFront ;
IVL *rowsIVL ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || mtxA == NULL || prowsIVL == NULL
|| pfirstnz == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr, "\n fatal error in FrontMtx_QR_setup()"
"\n bad input\n") ;
exit(-1) ;
}
neqns = FrontMtx_neqns(frontmtx) ;
nfront = FrontMtx_nfront(frontmtx) ;
vtxToFront = ETree_vtxToFront(frontmtx->frontETree) ;
/*
----------------------------------------------------------------
create the rowsIVL object,
list(J) = list of rows that are assembled in front J
firstnz[irowA] = first column with nonzero element in A(irowA,*)
----------------------------------------------------------------
*/
InpMtx_changeCoordType(mtxA, INPMTX_BY_ROWS) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
nrowA = 1 + IVmax(InpMtx_nent(mtxA), InpMtx_ivec1(mtxA), &loc) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n nrowA = %d ", nrowA) ;
fflush(msgFile) ;
}
firstnz = IVinit(nrowA, -1) ;
head = IVinit(nfront, -1) ;
link = IVinit(nrowA, -1) ;
for ( irow = nrowA - 1 ; irow >= 0 ; irow-- ) {
InpMtx_vector(mtxA, irow, &rowsize, &rowind) ;
if ( rowsize > 0 ) {
firstnz[irow] = jcol = rowind[0] ;
J = vtxToFront[jcol] ;
link[irow] = head[J] ;
head[J] = irow ;
}
}
rowsIVL = IVL_new() ;
IVL_init2(rowsIVL, IVL_CHUNKED, nfront, nrowA) ;
list = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
count = 0 ;
for ( irow = head[J] ; irow != -1 ; irow = link[irow] ) {
list[count++] = irow ;
}
if ( count > 0 ) {
IVL_setList(rowsIVL, J, count, list) ;
}
}
IVfree(head) ;
IVfree(link) ;
IVfree(list) ;
/*
---------------------------
set the pointers for return
---------------------------
*/
*prowsIVL = rowsIVL ;
*pfirstnz = firstnz ;
return ; }
/*
----------------------------------------------------
determine the range of the matrix,
i.e., the minimum and maximum rows and columns
if pmincol != NULL then *pmincol = minimum column id
if pmaxcol != NULL then *pmaxcol = maximum column id
if pminrow != NULL then *pminrow = minimum row id
if pmaxrow != NULL then *pmaxrow = maximum row id
return value ---
1 -- normal return
-1 -- mtx is NULL
-2 -- no entries in the matrix
-3 -- invalid coordinate type
created -- 98oct15, cca
----------------------------------------------------
*/
int
InpMtx_range (
InpMtx *mtx,
int *pmincol,
int *pmaxcol,
int *pminrow,
int *pmaxrow
) {
int maxcol, maxrow, mincol, minrow, nent ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_range()"
"\n mtx is NULL\n") ;
return(-1) ;
}
if ( (nent = mtx->nent) <= 0 ) {
fprintf(stderr, "\n fatal error in InpMtx_range()"
"\n %d entries\n", nent) ;
return(-2) ;
}
if ( INPMTX_IS_BY_ROWS(mtx) ) {
int *rowind = InpMtx_ivec1(mtx) ;
int *colind = InpMtx_ivec2(mtx) ;
int col, ii, row ;
minrow = maxrow = rowind[0] ;
mincol = maxcol = colind[0] ;
for ( ii = 1 ; ii < nent ; ii++ ) {
row = rowind[ii] ;
col = colind[ii] ;
if ( minrow > row ) {
minrow = row ;
} else if ( maxrow < row ) {
maxrow = row ;
}
if ( mincol > col ) {
mincol = col ;
} else if ( maxcol < col ) {
maxcol = col ;
}
}
} else if ( INPMTX_IS_BY_COLUMNS(mtx) ) {
int *rowind = InpMtx_ivec2(mtx) ;
int *colind = InpMtx_ivec1(mtx) ;
int col, ii, row ;
minrow = maxrow = rowind[0] ;
mincol = maxcol = colind[0] ;
for ( ii = 1 ; ii < nent ; ii++ ) {
row = rowind[ii] ;
col = colind[ii] ;
if ( minrow > row ) {
minrow = row ;
} else if ( maxrow < row ) {
maxrow = row ;
}
if ( mincol > col ) {
mincol = col ;
} else if ( maxcol < col ) {
maxcol = col ;
}
}
} else if ( INPMTX_IS_BY_CHEVRONS(mtx) ) {
int *chvind = InpMtx_ivec1(mtx) ;
int *offsets = InpMtx_ivec2(mtx) ;
int col, ii, off, row ;
if ( (off = offsets[0]) >= 0 ) {
row = chvind[0], col = row + off ;
} else {
col = chvind[0], row = col - off ;
}
minrow = maxrow = row ;
mincol = maxcol = col ;
for ( ii = 1 ; ii < nent ; ii++ ) {
if ( (off = offsets[ii]) >= 0 ) {
row = chvind[ii], col = row + off ;
} else {
col = chvind[ii], row = col - off ;
}
if ( minrow > row ) {
minrow = row ;
} else if ( maxrow < row ) {
maxrow = row ;
}
if ( mincol > col ) {
mincol = col ;
} else if ( maxcol < col ) {
maxcol = col ;
}
}
} else {
fprintf(stderr, "\n fatal error in InpMtx_range()"
"\n invalid coordType %d\n", mtx->coordType) ;
return(-3) ;
}
if ( pmincol != NULL ) { *pmincol = mincol ; }
if ( pmaxcol != NULL ) { *pmaxcol = maxcol ; }
if ( pminrow != NULL ) { *pminrow = minrow ; }
if ( pmaxrow != NULL ) { *pmaxrow = maxrow ; }
return(1) ; }
/*
----------------------------------------------------
convert from sorted and compressed triples to vector
created -- 98jan28, cca
----------------------------------------------------
*/
void
InpMtx_convertToVectors (
InpMtx *inpmtx
) {
int *ivec1, *ivec2, *offsets, *sizes, *vecids ;
int first, id, ient, jj, nent, nvector, value ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_convertToVectors(%p)"
"\n bad input\n", inpmtx) ;
exit(-1) ;
}
if ( INPMTX_IS_BY_VECTORS(inpmtx) || (nent = inpmtx->nent) == 0 ) {
inpmtx->storageMode = INPMTX_BY_VECTORS ;
return ;
}
if ( INPMTX_IS_RAW_DATA(inpmtx) ) {
InpMtx_sortAndCompress(inpmtx) ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
/*
-----------------------------------
find the number of distinct vectors
-----------------------------------
*/
value = -1 ;
nvector = 0 ;
for ( ient = 0 ; ient < nent ; ient++ ) {
if ( ivec1[ient] >= 0 && value != ivec1[ient] ) {
value = ivec1[ient] ;
nvector++ ;
#if MYDEBUG > 0
fprintf(stdout, "\n ient %d, value %d, nvector %d",
ient, value, nvector) ;
fflush(stdout) ;
#endif
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n %d vectors", nvector) ;
fflush(stdout) ;
#endif
/*
-----------------------------------------------------------------
adjust the sizes of the sizes[] and offsets[] arrays if necessary
-----------------------------------------------------------------
*/
InpMtx_setNvector(inpmtx, nvector) ;
if ( nvector <= 0 ) {
/*
-----------------------------
matrix has no entries, return
-----------------------------
*/
inpmtx->storageMode = INPMTX_RAW_DATA ;
InpMtx_setNent(inpmtx, 0) ;
return ;
}
vecids = InpMtx_vecids(inpmtx) ;
sizes = InpMtx_sizes(inpmtx) ;
offsets = InpMtx_offsets(inpmtx) ;
/*
------------------------------------------------------------
set the vector sizes and offsets
note: we skip all entries whose first coordinate is negative
------------------------------------------------------------
*/
for ( first = 0 ; first < nent ; first++ ) {
if ( ivec1[first] >= 0 ) {
break ;
}
}
id = 0 ;
if ( first < nent ) {
value = ivec1[first] ;
for ( jj = first + 1 ; jj < nent ; jj++ ) {
if ( ivec1[jj] != value ) {
vecids[id] = value ;
sizes[id] = jj - first ;
offsets[id] = first ;
#if MYDEBUG > 0
fprintf(stdout,
"\n vecids[%d] = %d, sizes[%d] = %d, offsets[%d] = %d",
id, vecids[id], id, sizes[id], id, offsets[id]) ;
fflush(stdout) ;
#endif
first = jj ;
value = ivec1[jj] ;
id++ ;
}
}
vecids[id] = value ;
sizes[id] = jj - first ;
offsets[id] = first ;
#if MYDEBUG > 0
fprintf(stdout,
"\n vecids[%d] = %d, sizes[%d] = %d, offsets[%d] = %d",
id, vecids[id], id, sizes[id], id, offsets[id]) ;
fflush(stdout) ;
#endif
}
inpmtx->storageMode = INPMTX_BY_VECTORS ;
#if MYDEBUG > 0
fprintf(stdout, "\n vecidsIV") ;
IV_writeForHumanEye(&inpmtx->vecidsIV, stdout) ;
fprintf(stdout, "\n sizesIV") ;
IV_writeForHumanEye(&inpmtx->sizesIV, stdout) ;
fprintf(stdout, "\n offsetsIV") ;
IV_writeForHumanEye(&inpmtx->offsetsIV, stdout) ;
fflush(stdout) ;
#endif
return ; }
PetscErrorCode MatFactorNumeric_SeqSpooles(Mat F,Mat A,const MatFactorInfo *info)
{
Mat_Spooles *lu = (Mat_Spooles*)(F)->spptr;
ChvManager *chvmanager ;
Chv *rootchv ;
IVL *adjIVL;
PetscErrorCode ierr;
PetscInt nz,nrow=A->rmap->n,irow,nedges,neqns=A->cmap->n,*ai,*aj,i,*diag=0,fierr;
PetscScalar *av;
double cputotal,facops;
#if defined(PETSC_USE_COMPLEX)
PetscInt nz_row,*aj_tmp;
PetscScalar *av_tmp;
#else
PetscInt *ivec1,*ivec2,j;
double *dvec;
#endif
PetscBool isSeqAIJ,isMPIAIJ;
PetscFunctionBegin;
if (lu->flg == DIFFERENT_NONZERO_PATTERN) { /* first numeric factorization */
(F)->ops->solve = MatSolve_SeqSpooles;
(F)->assembled = PETSC_TRUE;
/* set Spooles options */
ierr = SetSpoolesOptions(A, &lu->options);CHKERRQ(ierr);
lu->mtxA = InpMtx_new();
}
/* copy A to Spooles' InpMtx object */
ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isSeqAIJ);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isMPIAIJ);CHKERRQ(ierr);
if (isSeqAIJ){
Mat_SeqAIJ *mat = (Mat_SeqAIJ*)A->data;
ai=mat->i; aj=mat->j; av=mat->a;
if (lu->options.symflag == SPOOLES_NONSYMMETRIC) {
nz=mat->nz;
} else { /* SPOOLES_SYMMETRIC || SPOOLES_HERMITIAN */
nz=(mat->nz + A->rmap->n)/2;
diag=mat->diag;
}
} else { /* A is SBAIJ */
Mat_SeqSBAIJ *mat = (Mat_SeqSBAIJ*)A->data;
ai=mat->i; aj=mat->j; av=mat->a;
nz=mat->nz;
}
InpMtx_init(lu->mtxA, INPMTX_BY_ROWS, lu->options.typeflag, nz, 0);
#if defined(PETSC_USE_COMPLEX)
for (irow=0; irow<nrow; irow++) {
if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !(isSeqAIJ || isMPIAIJ)){
nz_row = ai[irow+1] - ai[irow];
aj_tmp = aj + ai[irow];
av_tmp = av + ai[irow];
} else {
nz_row = ai[irow+1] - diag[irow];
aj_tmp = aj + diag[irow];
av_tmp = av + diag[irow];
}
for (i=0; i<nz_row; i++){
InpMtx_inputComplexEntry(lu->mtxA, irow, *aj_tmp++,PetscRealPart(*av_tmp),PetscImaginaryPart(*av_tmp));
av_tmp++;
}
}
#else
ivec1 = InpMtx_ivec1(lu->mtxA);
ivec2 = InpMtx_ivec2(lu->mtxA);
dvec = InpMtx_dvec(lu->mtxA);
if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !isSeqAIJ){
for (irow = 0; irow < nrow; irow++){
for (i = ai[irow]; i<ai[irow+1]; i++) ivec1[i] = irow;
}
IVcopy(nz, ivec2, aj);
DVcopy(nz, dvec, av);
} else {
nz = 0;
for (irow = 0; irow < nrow; irow++){
for (j = diag[irow]; j<ai[irow+1]; j++) {
ivec1[nz] = irow;
ivec2[nz] = aj[j];
dvec[nz] = av[j];
nz++;
}
}
}
InpMtx_inputRealTriples(lu->mtxA, nz, ivec1, ivec2, dvec);
#endif
InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);
if ( lu->options.msglvl > 0 ) {
int err;
printf("\n\n input matrix");
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix");CHKERRQ(ierr);
InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
err = fflush(lu->options.msgFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
if ( lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */
/*---------------------------------------------------
find a low-fill ordering
(1) create the Graph object
(2) order the graph
-------------------------------------------------------*/
if (lu->options.useQR){
adjIVL = InpMtx_adjForATA(lu->mtxA);
} else {
adjIVL = InpMtx_fullAdjacency(lu->mtxA);
}
nedges = IVL_tsize(adjIVL);
lu->graph = Graph_new();
Graph_init2(lu->graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL);
if ( lu->options.msglvl > 2 ) {
int err;
if (lu->options.useQR){
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of A^T A");CHKERRQ(ierr);
} else {
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of the input matrix");CHKERRQ(ierr);
}
Graph_writeForHumanEye(lu->graph, lu->options.msgFile);
err = fflush(lu->options.msgFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
switch (lu->options.ordering) {
case 0:
lu->frontETree = orderViaBestOfNDandMS(lu->graph,
lu->options.maxdomainsize, lu->options.maxzeros, lu->options.maxsize,
lu->options.seed, lu->options.msglvl, lu->options.msgFile); break;
case 1:
lu->frontETree = orderViaMMD(lu->graph,lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
case 2:
lu->frontETree = orderViaMS(lu->graph, lu->options.maxdomainsize,
lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
case 3:
lu->frontETree = orderViaND(lu->graph, lu->options.maxdomainsize,
lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
default:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unknown Spooles's ordering");
}
if ( lu->options.msglvl > 0 ) {
int err;
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree from ordering");CHKERRQ(ierr);
ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile);
err = fflush(lu->options.msgFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
/* get the permutation, permute the front tree */
lu->oldToNewIV = ETree_oldToNewVtxPerm(lu->frontETree);
lu->oldToNew = IV_entries(lu->oldToNewIV);
lu->newToOldIV = ETree_newToOldVtxPerm(lu->frontETree);
if (!lu->options.useQR) ETree_permuteVertices(lu->frontETree, lu->oldToNewIV);
/* permute the matrix */
if (lu->options.useQR){
InpMtx_permute(lu->mtxA, NULL, lu->oldToNew);
} else {
InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew);
if ( lu->options.symflag == SPOOLES_SYMMETRIC) {
InpMtx_mapToUpperTriangle(lu->mtxA);
}
#if defined(PETSC_USE_COMPLEX)
if ( lu->options.symflag == SPOOLES_HERMITIAN ) {
InpMtx_mapToUpperTriangleH(lu->mtxA);
}
#endif
InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS);
}
InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);
/* get symbolic factorization */
if (lu->options.useQR){
lu->symbfacIVL = SymbFac_initFromGraph(lu->frontETree, lu->graph);
IVL_overwrite(lu->symbfacIVL, lu->oldToNewIV);
IVL_sortUp(lu->symbfacIVL);
ETree_permuteVertices(lu->frontETree, lu->oldToNewIV);
} else {
lu->symbfacIVL = SymbFac_initFromInpMtx(lu->frontETree, lu->mtxA);
}
if ( lu->options.msglvl > 2 ) {
int err;
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n old-to-new permutation vector");CHKERRQ(ierr);
IV_writeForHumanEye(lu->oldToNewIV, lu->options.msgFile);
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n new-to-old permutation vector");CHKERRQ(ierr);
IV_writeForHumanEye(lu->newToOldIV, lu->options.msgFile);
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree after permutation");CHKERRQ(ierr);
ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile);
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr);
InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n symbolic factorization");CHKERRQ(ierr);
IVL_writeForHumanEye(lu->symbfacIVL, lu->options.msgFile);
err = fflush(lu->options.msgFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
lu->frontmtx = FrontMtx_new();
lu->mtxmanager = SubMtxManager_new();
SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0);
} else { /* new num factorization using previously computed symbolic factor */
if (lu->options.pivotingflag) { /* different FrontMtx is required */
FrontMtx_free(lu->frontmtx);
lu->frontmtx = FrontMtx_new();
} else {
FrontMtx_clearData (lu->frontmtx);
}
SubMtxManager_free(lu->mtxmanager);
lu->mtxmanager = SubMtxManager_new();
SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0);
/* permute mtxA */
if (lu->options.useQR){
InpMtx_permute(lu->mtxA, NULL, lu->oldToNew);
} else {
InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew);
if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {
InpMtx_mapToUpperTriangle(lu->mtxA);
}
InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS);
}
InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);
if ( lu->options.msglvl > 2 ) {
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr);
InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
}
} /* end of if( lu->flg == DIFFERENT_NONZERO_PATTERN) */
if (lu->options.useQR){
FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag,
SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS,
SPOOLES_NO_PIVOTING, NO_LOCK, 0, NULL,
lu->mtxmanager, lu->options.msglvl, lu->options.msgFile);
} else {
FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, lu->options.symflag,
FRONTMTX_DENSE_FRONTS, lu->options.pivotingflag, NO_LOCK, 0, NULL,
lu->mtxmanager, lu->options.msglvl, lu->options.msgFile);
}
if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { /* || SPOOLES_HERMITIAN ? */
if ( lu->options.patchAndGoFlag == 1 ) {
lu->frontmtx->patchinfo = PatchAndGoInfo_new();
PatchAndGoInfo_init(lu->frontmtx->patchinfo, 1, lu->options.toosmall, lu->options.fudge,
lu->options.storeids, lu->options.storevalues);
} else if ( lu->options.patchAndGoFlag == 2 ) {
lu->frontmtx->patchinfo = PatchAndGoInfo_new();
PatchAndGoInfo_init(lu->frontmtx->patchinfo, 2, lu->options.toosmall, lu->options.fudge,
lu->options.storeids, lu->options.storevalues);
}
}
/* numerical factorization */
chvmanager = ChvManager_new();
ChvManager_init(chvmanager, NO_LOCK, 1);
DVfill(10, lu->cpus, 0.0);
if (lu->options.useQR){
facops = 0.0 ;
FrontMtx_QR_factor(lu->frontmtx, lu->mtxA, chvmanager,
lu->cpus, &facops, lu->options.msglvl, lu->options.msgFile);
if ( lu->options.msglvl > 1 ) {
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n facops = %9.2f", facops);CHKERRQ(ierr);
}
} else {
IVfill(20, lu->stats, 0);
rootchv = FrontMtx_factorInpMtx(lu->frontmtx, lu->mtxA, lu->options.tau, 0.0,
chvmanager, &fierr, lu->cpus,lu->stats,lu->options.msglvl,lu->options.msgFile);
if (rootchv) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"\n matrix found to be singular");
if (fierr >= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"\n error encountered at front %D", fierr);
if(lu->options.FrontMtxInfo){
ierr = PetscPrintf(PETSC_COMM_SELF,"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns\n",lu->stats[0], lu->stats[1], lu->stats[2]);CHKERRQ(ierr);
cputotal = lu->cpus[8] ;
if ( cputotal > 0.0 ) {
ierr = PetscPrintf(PETSC_COMM_SELF,
"\n cpus cpus/totaltime"
"\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 \n",
lu->cpus[0], 100.*lu->cpus[0]/cputotal,
lu->cpus[1], 100.*lu->cpus[1]/cputotal,
lu->cpus[2], 100.*lu->cpus[2]/cputotal,
lu->cpus[3], 100.*lu->cpus[3]/cputotal,
lu->cpus[4], 100.*lu->cpus[4]/cputotal,
lu->cpus[5], 100.*lu->cpus[5]/cputotal,
lu->cpus[6], 100.*lu->cpus[6]/cputotal,
lu->cpus[7], 100.*lu->cpus[7]/cputotal, cputotal);CHKERRQ(ierr);
}
}
}
ChvManager_free(chvmanager);
if ( lu->options.msglvl > 0 ) {
int err;
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr);
FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile);
err = fflush(lu->options.msgFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { /* || SPOOLES_HERMITIAN ? */
if ( lu->options.patchAndGoFlag == 1 ) {
if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
if (lu->options.msglvl > 0 ){
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr);
IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile);
}
}
PatchAndGoInfo_free(lu->frontmtx->patchinfo);
} else if ( lu->options.patchAndGoFlag == 2 ) {
if (lu->options.msglvl > 0 ){
if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr);
IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile);
}
if ( lu->frontmtx->patchinfo->fudgeDV != NULL ) {
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n perturbations");CHKERRQ(ierr);
DV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeDV, lu->options.msgFile);
}
}
PatchAndGoInfo_free(lu->frontmtx->patchinfo);
}
}
/* post-process the factorization */
FrontMtx_postProcess(lu->frontmtx, lu->options.msglvl, lu->options.msgFile);
if ( lu->options.msglvl > 2 ) {
int err;
ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix after post-processing");CHKERRQ(ierr);
FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile);
err = fflush(lu->options.msgFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
lu->flg = SAME_NONZERO_PATTERN;
lu->CleanUpSpooles = PETSC_TRUE;
PetscFunctionReturn(0);
}
/*--------------------------------------------------------------------*/
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[] )
/*
---------------------------------------------------
read in (i, j, a(i,j)) triples,
construct a InpMtx object and
write it out to a file
created -- 97oct17, cca
---------------------------------------------------
*/
{
char *inFileName, *outFileName ;
InpMtx *inpmtx ;
FILE *inputFile, *msgFile ;
int dataType, flag, ient, msglvl,
ncol, nent, nrow, rc ;
int *ivec1, *ivec2 ;
if ( argc != 7 ) {
fprintf(stdout,
"\n\n usage : readAIJ msglvl msgFile dataType inputFile outFile flag"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n dataType -- 0 for indices only, 1 for double, 2 for complex"
"\n inputFile -- input file for a(i,j) entries"
"\n the first line must be \"nrow ncol nentries\""
"\n if dataType == 0 then"
"\n next lines are \"irow jcol\""
"\n else if dataType == 1 then"
"\n next lines are \"irow jcol entry\""
"\n else if dataType == 2 then"
"\n next lines are \"irow jcol realEntry imagEntry\""
"\n endif"
"\n outFile -- output file, must be *.inpmtxf or *.inpmtxb"
"\n flag -- flag for 0-based or 1-based addressing"
"\n") ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
dataType = atoi(argv[3]) ;
inFileName = argv[4] ;
outFileName = argv[5] ;
flag = atoi(argv[6]) ;
fprintf(msgFile,
"\n readAIJ "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n dataType -- %d"
"\n inputFile -- %s"
"\n outFile -- %s"
"\n flag -- %d"
"\n",
msglvl, argv[2], dataType, inFileName, outFileName, flag) ;
fflush(msgFile) ;
/*
----------------------------
open the input file and read
#rows #columns #entries
----------------------------
*/
if ( (inputFile = fopen(inFileName, "r")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], inFileName) ;
return(-1) ;
}
rc = fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ;
if ( rc != 3 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 3 fields read on first line of file %s",
argv[0], rc, inFileName) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n read in nrow = %d, ncol = %d, nent = %d",
nrow, ncol, nent) ;
fflush(msgFile) ;
}
/*
--------------------------------------------------
initialize the object
set coordType = INPMTX_BY_ROWS --> row coordinates
set inputMode = dataType
--------------------------------------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, dataType, nent, 0) ;
/*
-------------------------------------------------
read in the entries and load them into the object
-------------------------------------------------
*/
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) {
for ( ient = 0 ; ient < nent ; ient++ ) {
rc = fscanf(inputFile, "%d %d", ivec1 + ient, ivec2 + ient) ;
if ( rc != 2 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 2 fields read on entry %d of file %s",
argv[0], rc, ient, inFileName) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n entry %d, row %d, column %d",
ient, ivec1[ient], ivec2[ient]) ;
fflush(msgFile) ;
}
}
} else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
rc = fscanf(inputFile, "%d %d %le",
ivec1 + ient, ivec2 + ient, dvec + ient) ;
if ( rc != 3 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 3 fields read on entry %d of file %s",
argv[0], rc, ient, argv[3]) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n entry %d, row %d, column %d, value %e",
ient, ivec1[ient], ivec2[ient], dvec[ient]) ;
fflush(msgFile) ;
}
}
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
rc = fscanf(inputFile, "%d %d %le %le",
ivec1 + ient, ivec2 + ient,
dvec + 2*ient, dvec + 2*ient+1) ;
if ( rc != 4 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 4 fields read on entry %d of file %s",
argv[0], rc, ient, argv[3]) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n entry %d, row %d, column %d, value %12.4e + %12.4e*i",
ient, ivec1[ient], ivec2[ient],
dvec[2*ient], dvec[2*ient+1]) ;
fflush(msgFile) ;
}
}
}
inpmtx->nent = nent ;
if ( flag == 1 ) {
/*
--------------------------------------------------
indices were in FORTRAN mode, decrement for C mode
--------------------------------------------------
*/
for ( ient = 0 ; ient < nent ; ient++ ) {
ivec1[ient]-- ; ivec2[ient]-- ;
}
}
/*
-----------------------------
sort and compress the entries
-----------------------------
*/
InpMtx_changeStorageMode(inpmtx, 3) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n sorted, compressed and vector form") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------
write out the InpMtx object
---------------------------
*/
if ( strcmp(outFileName, "none") != 0 ) {
rc = InpMtx_writeToFile(inpmtx, outFileName) ;
fprintf(msgFile,
"\n return value %d from InpMtx_writeToFile(%p,%s)",
rc, inpmtx, outFileName) ;
}
/*
---------------------
free the working data
---------------------
*/
InpMtx_free(inpmtx) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
