/*
----------------------------------------------
purpose -- map the off diagonal blocks to
processes in a domain decomposition fashion
created -- 98mar28, cca
----------------------------------------------
*/
void
SolveMap_ddMap (
SolveMap *solvemap,
int symmetryflag,
IVL *upperBlockIVL,
IVL *lowerBlockIVL,
int nproc,
IV *ownersIV,
Tree *tree,
int seed,
int msglvl,
FILE *msgFile
) {
char *mark ;
Drand drand ;
int ii, I, J, K, loc, nadj, nblockLower, nblockUpper,
nfront, proc ;
int *adj, *colids, *fch, *map, *owners, *rowids, *sib ;
/*
---------------
check the input
---------------
*/
if ( solvemap == NULL || symmetryflag < 0
|| upperBlockIVL == NULL || ownersIV == NULL ) {
fprintf(stderr,
"\n fatal error in SolveMap_ddMap(%p,%d,%p,%p,%p,%d)"
"\n bad input\n",
solvemap, symmetryflag, upperBlockIVL,
lowerBlockIVL, ownersIV, seed) ;
spoolesFatal();
}
nfront = IV_size(ownersIV) ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n\n SolveMap_ddMap(): nfront = %d, nproc = %d",
nfront, nproc) ;
fflush(msgFile) ;
}
/*
-----------------------------------------------------------
count the number of upper blocks that do not include U(J,J)
-----------------------------------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n upperBlockIVL = %p", upperBlockIVL) ;
fflush(msgFile) ;
}
nblockUpper = 0 ;
for ( J = 0 ; J < nfront ; J++ ) {
IVL_listAndSize(upperBlockIVL, J, &nadj, &adj) ;
for ( ii = 0 ; ii < nadj ; ii++ ) {
if ( adj[ii] > J ) {
nblockUpper++ ;
}
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n nblockUpper = %d", nblockUpper) ;
fflush(msgFile) ;
}
/*
-----------------------------------------------------------
count the number of lower blocks that do not include L(J,J)
-----------------------------------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n lowerBlockIVL = %p", lowerBlockIVL) ;
fflush(msgFile) ;
}
nblockLower = 0 ;
if ( lowerBlockIVL != NULL ) {
for ( J = 0 ; J < nfront ; J++ ) {
IVL_listAndSize(lowerBlockIVL, J, &nadj, &adj) ;
for ( ii = 0 ; ii < nadj ; ii++ ) {
if ( adj[ii] > J ) {
nblockLower++ ;
}
}
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n nblockLower = %d", nblockLower) ;
fflush(msgFile) ;
}
/*
---------------------
initialize the object
---------------------
*/
SolveMap_init(solvemap, symmetryflag, nfront,
nproc, nblockUpper, nblockLower) ;
owners = SolveMap_owners(solvemap) ;
/*
----------------------
fill the owners vector
----------------------
*/
IVcopy(nfront, owners, IV_entries(ownersIV)) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n owners") ;
IVfprintf(msgFile, nfront, owners) ;
fflush(msgFile) ;
}
/*
-----------------------------------------------------
mark a node J in the tree as 'D' if it is in a domain
(owners[J] = owners[I] for all I a descendent of J)
and 'S' (for the schur complement) otherwise
-----------------------------------------------------
*/
mark = CVinit(nfront, 'D') ;
fch = tree->fch ;
sib = tree->sib ;
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
for ( I = fch[J] ; I != -1 ; I = sib[I] ) {
if ( mark[I] != 'D' || owners[I] != owners[J] ) {
mark[J] = 'S' ; break ;
}
}
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_setUniform(&drand, 0, nproc) ;
/*
-------------------------------
if J is in a domain
map(J,K) to owners[J]
else
map(J,K) to a random process
-------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n mapping upper blocks") ;
fflush(msgFile) ;
}
rowids = SolveMap_rowidsUpper(solvemap) ;
colids = SolveMap_colidsUpper(solvemap) ;
map = SolveMap_mapUpper(solvemap) ;
for ( J = loc = 0 ; J < nfront ; J++ ) {
IVL_listAndSize(upperBlockIVL, J, &nadj, &adj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n J = %d", J) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < nadj ; ii++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n K = %d", adj[ii]) ;
fflush(msgFile) ;
}
if ( (K = adj[ii]) > J ) {
if ( mark[J] == 'D' ) {
proc = owners[J] ;
} else {
proc = (int) Drand_value(&drand) ;
}
rowids[loc] = J ;
colids[loc] = K ;
map[loc] = proc ;
if ( msglvl > 2 ) {
fprintf(msgFile, ", map[%d] = %d", loc, map[loc]) ;
fflush(msgFile) ;
}
loc++ ;
}
}
}
if ( symmetryflag == SPOOLES_NONSYMMETRIC ) {
/*
-------------------------------
if J is in a domain
map(K,J) to owners[J]
else
map(K,J) to a random process
-------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n mapping lower blocks") ;
fflush(msgFile) ;
}
rowids = SolveMap_rowidsLower(solvemap) ;
colids = SolveMap_colidsLower(solvemap) ;
map = SolveMap_mapLower(solvemap) ;
for ( J = loc = 0 ; J < nfront ; J++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n J = %d", J) ;
fflush(msgFile) ;
}
IVL_listAndSize(lowerBlockIVL, J, &nadj, &adj) ;
for ( ii = 0 ; ii < nadj ; ii++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n K = %d", adj[ii]) ;
fflush(msgFile) ;
}
if ( (K = adj[ii]) > J ) {
if ( mark[J] == 'D' ) {
proc = owners[J] ;
} else {
proc = (int) Drand_value(&drand) ;
}
rowids[loc] = K ;
colids[loc] = J ;
map[loc] = proc ;
if ( msglvl > 2 ) {
fprintf(msgFile, ", map[%d] = %d", loc, map[loc]) ;
fflush(msgFile) ;
}
loc++ ;
}
}
}
}
/*
------------------------
free the working storage
------------------------
*/
CVfree(mark) ;
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 ; }
/*--------------------------------------------------------------------*/
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) ; }
/*
---------------------------------------------------------------
purpose -- fill dvec[J] with the active storage to eliminate J
using the right-looking general sparse method
symflag -- symmetry flag, one of SPOOLES_SYMMETRIC,
SPOOLES_HERMITIAN or SPOOLES_NONSYMMETRIC
created -- 98dec19, cca
---------------------------------------------------------------
*/
void
ETree_FSstorageProfile (
ETree *etree,
int symflag,
IVL *symbfacIVL,
double dvec[]
) {
char *incore ;
int ii, J, K, nDJ, nfront, nUJ, sizeJ, storage ;
int *bndwghts, *indJ, *mark, *nodwghts, *stor, *vtxToFront ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL || symbfacIVL == NULL || dvec == NULL ) {
fprintf(stderr,
"\n fatal error in ETree_FSstorageProfile(%p,%p,%p)"
"\n bad input\n", etree, symbfacIVL, dvec) ;
exit(-1) ;
}
tree = ETree_tree(etree) ;
nodwghts = ETree_nodwghts(etree) ;
bndwghts = ETree_bndwghts(etree) ;
vtxToFront = ETree_vtxToFront(etree) ;
nfront = ETree_nfront(etree) ;
incore = CVinit(nfront, 'F') ;
stor = IVinit(nfront, 0) ;
mark = IVinit(nfront, -1) ;
/*
--------------------------------------------
compute the storage for each front's chevron
--------------------------------------------
*/
if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) {
for ( J = 0 ; J < nfront ; J++ ) {
nDJ = nodwghts[J] ;
nUJ = bndwghts[J] ;
stor[J] = (nDJ*(nDJ+1))/2 + nDJ*nUJ ;
}
} else {
for ( J = 0 ; J < nfront ; J++ ) {
nDJ = nodwghts[J] ;
nUJ = bndwghts[J] ;
stor[J] = nDJ*nDJ + 2*nDJ*nUJ ;
}
}
/*
---------------------------------------------
loop over the nodes in a post-order traversal
---------------------------------------------
*/
storage = 0 ;
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
if ( incore[J] == 'F' ) {
storage += stor[J] ;
incore[J] = 'T' ;
}
IVL_listAndSize(symbfacIVL, J, &sizeJ, &indJ) ;
mark[J] = J ;
for ( ii = 0 ; ii < sizeJ ; ii++ ) {
K = vtxToFront[indJ[ii]] ;
if ( mark[K] != J ) {
mark[K] = J ;
if ( incore[K] == 'F' ) {
storage += stor[K] ;
incore[K] = 'T' ;
}
}
}
dvec[J] = storage ;
storage -= stor[J] ;
}
IVfree(mark) ;
IVfree(stor) ;
CVfree(incore) ;
return ; }
/*
------------------------------------------------------------------
purpose -- basic initializer
nlist -- number of lists to be held by this object
counts -- vector that contains number of items expected
for each list.
counts == NULL --> unknown number of items expected
counts != NULL --> known number of items expected
lockflag -- flag to specify lock status
lockflag = 0 --> mutex lock is not allocated or initialized
lockflag = 1 --> mutex lock is allocated and it can synchronize
only threads in this process.
lockflag = 2 --> mutex lock is allocated and it can synchronize
only threads in this and other processes.
flags -- vector to specify whether to lock individual lists
flags == NULL --> none or all lists must be locked,
use lockflag to determine
flags[ilist] = 'N' --> no need to lock list ilist
flags[ilist] = 'Y' --> must lock list ilist
created -- 98may02, cca
------------------------------------------------------------------
*/
void
SubMtxList_init (
SubMtxList *list,
int nlist,
int counts[],
int lockflag,
char flags[]
) {
int ilist ;
/*
---------------
check the input
---------------
*/
if ( list == NULL || nlist <= 0 || lockflag < 0 || lockflag > 2 ) {
fprintf(stderr,
"\n fatal error in SubMtxList_init(%p,%d,%p,%d,%p)"
"\n bad input\n", list, nlist, counts, lockflag, flags) ;
exit(-1) ;
}
/*
--------------
clear all data
--------------
*/
SubMtxList_clearData(list) ;
/*
-------------------------------------------------------
set the number of lists and allocate the heads[] vector
-------------------------------------------------------
*/
list->nlist = nlist ;
ALLOCATE(list->heads, struct _SubMtx *, nlist) ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
list->heads[ilist] = NULL ;
}
if ( counts != NULL ) {
/*
-------------------------------------
allocate and fill the counts[] vector
-------------------------------------
*/
list->counts = IVinit(nlist, 0) ;
IVcopy(nlist, list->counts, counts) ;
}
if ( lockflag > 0 ) {
/*
-----------------
allocate the lock
-----------------
*/
list->lock = Lock_new() ;
Lock_init(list->lock, lockflag) ;
}
if ( flags != NULL ) {
/*
------------------------------------
allocate and fill the flags[] vector
------------------------------------
*/
list->flags = CVinit(nlist, 'N') ;
CVcopy(nlist, list->flags, flags) ;
}
return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------------------
this program tests the IVL_MPI_allgather() method
(1) each process generates the same owners[n] map
(2) each process creates an IVL object
and fills its owned lists with random numbers
(3) the processes gather-all's the lists of ivl
created -- 98apr03, cca
-------------------------------------------------
*/
{
char *buffer ;
double chksum, globalsum, t1, t2 ;
Drand drand ;
int ilist, length, myid, msglvl, nlist,
nproc, rc, seed, size, tag ;
int *list, *owners, *vec ;
int stats[4], tstats[4] ;
IV *ownersIV ;
IVL *ivl ;
FILE *msgFile ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 5 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile n seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nlist -- number of lists in the IVL object"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
nlist = atoi(argv[3]) ;
seed = atoi(argv[4]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n nlist -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], nlist, seed) ;
fflush(msgFile) ;
/*
----------------------------
generate the ownersIV object
----------------------------
*/
MARKTIME(t1) ;
ownersIV = IV_new() ;
IV_init(ownersIV, nlist, NULL) ;
owners = IV_entries(ownersIV) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nproc) ;
Drand_fillIvector(&drand, nlist, owners) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize the ownersIV object",
t2 - t1) ;
fflush(msgFile) ;
fprintf(msgFile, "\n\n ownersIV generated") ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(ownersIV, msgFile) ;
} else {
IV_writeStats(ownersIV, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
set up the IVL object and fill owned entries
--------------------------------------------
*/
MARKTIME(t1) ;
ivl = IVL_new() ;
IVL_init1(ivl, IVL_CHUNKED, nlist) ;
vec = IVinit(nlist, -1) ;
Drand_setSeed(&drand, seed + myid) ;
Drand_setUniform(&drand, 0, nlist) ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
size = (int) Drand_value(&drand) ;
Drand_fillIvector(&drand, size, vec) ;
IVL_setList(ivl, ilist, size, vec) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize the IVL object",
t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
IVL_writeForHumanEye(ivl, msgFile) ;
} else {
IVL_writeStats(ivl, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
compute the local checksum of the ivl object
--------------------------------------------
*/
for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
IVL_listAndSize(ivl, ilist, &size, &list) ;
chksum += 1 + ilist + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local partial chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
-----------------------
get the global checksum
-----------------------
*/
rc = MPI_Allreduce((void *) &chksum, (void *) &globalsum,
1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD) ;
/*
--------------------------------
execute the all-gather operation
--------------------------------
*/
tag = 47 ;
IVzero(4, stats) ;
IVL_MPI_allgather(ivl, ownersIV,
stats, msglvl, msgFile, tag, MPI_COMM_WORLD) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n return from IVL_MPI_allgather()") ;
fprintf(msgFile,
"\n local send stats : %10d messages with %10d bytes"
"\n local recv stats : %10d messages with %10d bytes",
stats[0], stats[2], stats[1], stats[3]) ;
fflush(msgFile) ;
}
MPI_Reduce((void *) stats, (void *) tstats, 4, MPI_INT,
MPI_SUM, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile,
"\n total send stats : %10d messages with %10d bytes"
"\n total recv stats : %10d messages with %10d bytes",
tstats[0], tstats[2], tstats[1], tstats[3]) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ivl") ;
IVL_writeForHumanEye(ivl, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------------------------
compute the checksum of the entire object
-----------------------------------------
*/
for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &list) ;
chksum += 1 + ilist + size + IVsum(size, list) ;
}
fprintf(msgFile,
"\n globalsum = %12.4e, chksum = %12.4e, error = %12.4e",
globalsum, chksum, fabs(globalsum - chksum)) ;
fflush(msgFile) ;
/*
----------------
free the objects
----------------
*/
IV_free(ownersIV) ;
IVL_free(ivl) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*
--------------------------------------------------------------------
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 ; }
/*
----------------------------------------------------
purpose -- worker method to factor the matrix
created -- 98may29, cca
----------------------------------------------------
*/
static void *
FrontMtx_QR_workerFactor (
void *arg
) {
char *status ;
ChvList *updlist ;
ChvManager *chvmanager ;
double facops, t0, t1 ;
double *cpus ;
DV workDV ;
FILE *msgFile ;
FrontMtx *frontmtx ;
Ideq *dequeue ;
InpMtx *mtxA ;
int J, K, myid, neqns, nfront, msglvl ;
int *colmap, *firstnz, *nactiveChild, *owners, *par ;
IVL *rowsIVL ;
QR_factorData *data ;
MARKTIME(t0) ;
data = (QR_factorData *) arg ;
mtxA = data->mtxA ;
rowsIVL = data->rowsIVL ;
firstnz = data->firstnz ;
IV_sizeAndEntries(data->ownersIV, &nfront, &owners) ;
frontmtx = data->frontmtx ;
chvmanager = data->chvmanager ;
updlist = data->updlist ;
myid = data->myid ;
cpus = data->cpus ;
msglvl = data->msglvl ;
msgFile = data->msgFile ;
par = frontmtx->tree->par ;
neqns = FrontMtx_neqns(frontmtx) ;
/*
--------------------------------------------------------
status[J] = 'F' --> J finished
= 'W' --> J waiting to be finished
create the Ideq object to handle the bottom-up traversal
nactiveChild[K] = # of unfinished children of K,
when zero, K can be placed on the dequeue
--------------------------------------------------------
*/
status = CVinit(nfront, 'F') ;
dequeue = FrontMtx_setUpDequeue(frontmtx, owners, myid, status,
NULL, 'W', 'F', msglvl, msgFile) ;
FrontMtx_loadActiveLeaves(frontmtx, status, 'W', dequeue) ;
nactiveChild = FrontMtx_nactiveChild(frontmtx, status, myid) ;
colmap = IVinit(neqns, -1) ;
DV_setDefaultFields(&workDV) ;
facops = 0.0 ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n owners") ;
IVfprintf(msgFile, nfront, owners) ;
fprintf(msgFile, "\n Ideq") ;
Ideq_writeForHumanEye(dequeue, msgFile) ;
fflush(msgFile) ;
}
MARKTIME(t1) ;
cpus[0] += t1 - t0 ;
/*
---------------------------
loop while a path is active
---------------------------
*/
while ( (J = Ideq_removeFromHead(dequeue)) != -1 ) {
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n ### checking out front %d, owner %d",
J, owners[J]) ;
}
if ( owners[J] == myid ) {
/*
--------------------------------
front J is ready to be processed
--------------------------------
*/
FrontMtx_QR_factorVisit(frontmtx, J, mtxA, rowsIVL, firstnz,
updlist, chvmanager, status, colmap,
&workDV, cpus, &facops, msglvl, msgFile) ;
if ( status[J] == 'F' ) {
/*
------------------------------------------
front J is finished, put parent on dequeue
if it exists or all children are finished
------------------------------------------
*/
if ( (K = par[J]) != -1 && --nactiveChild[K] == 0 ) {
Ideq_insertAtHead(dequeue, K) ;
}
} else {
/*
-----------------------------------------------
front J is not complete, put on tail of dequeue
-----------------------------------------------
*/
Ideq_insertAtTail(dequeue, J) ;
}
} else {
/*
-------------------------------------------
front J is not owned, put parent on dequeue
if it exists and all children are finished
-------------------------------------------
*/
if ( (K = par[J]) != -1 && --nactiveChild[K] == 0 ) {
Ideq_insertAtHead(dequeue, K) ;
}
}
}
data->facops = facops ;
/*
------------------------
free the working storage
------------------------
*/
CVfree(status) ;
Ideq_free(dequeue) ;
IVfree(nactiveChild) ;
IVfree(colmap) ;
DV_clearData(&workDV) ;
MARKTIME(t1) ;
cpus[6] = t1 - t0 ;
cpus[5] = t1 - t0 - cpus[0] - cpus[1]
- cpus[2] - cpus[3] - cpus[4] ;
return(NULL) ;
}
