/*
-----------------------------------------------------------
purpose -- to write out the statistics for the Graph object
return value -- 1 if success, 0 otherwise
created -- 95sep29, cca
-----------------------------------------------------------
*/
int
Graph_writeStats (
Graph *graph,
FILE *fp
) {
int rc ;
/*
---------------
check the input
---------------
*/
if ( graph == NULL || fp == NULL ) {
fprintf(stderr, "\n error in Graph_writeStats(%p,%p)"
"\n bad input\n", graph, fp) ;
spoolesFatal();
}
switch ( graph->type ) {
case 0 :
rc = fprintf(fp, "\n Graph : unweighted graph object :") ;
break ;
case 1 :
rc = fprintf(fp, "\n Graph : vertices weighted graph object :") ;
break ;
case 2 :
rc = fprintf(fp, "\n Graph : edges weighted graph object :") ;
break ;
case 3 :
rc = fprintf(fp,
"\n Graph : vertices and edges weighted graph object :") ;
break ;
default :
fprintf(stderr, "\n fatal error in Graph_writeStats(%p,%p)"
"\n invalid graph->type = %d\n", graph, fp, graph->type) ;
return(0) ;
}
if ( rc < 0 ) { goto IO_error ; }
fflush(fp) ;
rc = fprintf(fp,
"\n %d internal vertices, %d boundary vertices, %d edges",
graph->nvtx, graph->nvbnd, graph->nedges) ;
if ( rc < 0 ) { goto IO_error ; }
fflush(fp) ;
rc = fprintf(fp,
"\n %d internal vertex weight, %d boundary vertex weight",
(graph->vwghts != NULL) ? IVsum(graph->nvtx, graph->vwghts) : graph->nvtx,
(graph->vwghts != NULL) ? IVsum(graph->nvbnd, graph->vwghts + graph->nvtx) : graph->nvbnd) ;
if ( rc < 0 ) { goto IO_error ; }
if ( graph->type >= 2 ) {
rc = fprintf(fp, "\n %d total edge weight",
graph->totewght) ;
}
if ( rc < 0 ) { goto IO_error ; }
return(1) ;
IO_error :
fprintf(stderr, "\n fatal error in Graph_writeStats(%p,%p)"
"\n rc = %d, return from fprintf\n", graph, fp, rc) ;
return(0) ;
}
/*
-----------------------
initialize the object
created -- 95oct07, cca
-----------------------
*/
void
BKL_init (
BKL *bkl,
BPG *bpg,
float alpha
) {
/*
---------------
check the input
---------------
*/
if ( bkl == NULL || bpg == NULL ) {
fprintf(stderr, "\n fatal error in BKL_init(%p,%p,%f)"
"\n bad input\n", bkl, bpg, alpha) ;
exit(-1) ;
}
/*
--------------
clear the data
--------------
*/
BKL_clearData(bkl) ;
/*
---------------------
initialize the fields
---------------------
*/
bkl->bpg = bpg ;
bkl->ndom = bpg->nX ;
bkl->nseg = bpg->nY ;
bkl->nreg = bpg->nX + bpg->nY ;
if ( bpg->graph->vwghts == NULL ) {
bkl->totweight = bkl->nreg ;
bkl->regwghts = IVinit(bkl->nreg, 1) ;
} else {
bkl->regwghts = bpg->graph->vwghts ;
bkl->totweight = IVsum(bkl->nreg, bkl->regwghts) ;
}
bkl->colors = IVinit(bkl->nreg, 0) ;
bkl->alpha = alpha ;
return ; }
/*
----------------------------------------------------
purpose -- to read a Graph object from a binary file
return value -- 1 if success, 0 if failure
created -- 95sep29, cca
----------------------------------------------------
*/
int
Graph_readFromBinaryFile (
Graph *graph,
FILE *fp
) {
int nedges, nvbnd, nvtx, rc, totewght, totvwght, type ;
int itemp[6] ;
int *vwghts ;
IVL *adjIVL, *ewghtIVL ;
/*
---------------
check the input
---------------
*/
if ( graph == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in Graph_readFromBinaryFile(%p,%p)"
"\n bad input\n", graph, fp) ;
return(0) ;
}
/*
---------------------
clear the data fields
---------------------
*/
Graph_clearData(graph) ;
/*
---------------------------------------------
read in the six scalar parameters
type, nvtx, nvbnd, nedges, totvwght, totewght
---------------------------------------------
*/
if ( (rc = fread((void *) itemp, sizeof(int), 6, fp)) != 6 ) {
fprintf(stderr, "\n error in Graph_readFromBinaryFile(%p,%p)"
"\n %d items of %d read\n", graph, fp, rc, 6) ;
return(0) ;
}
type = itemp[0] ;
nvtx = itemp[1] ;
nvbnd = itemp[2] ;
nedges = itemp[3] ;
totvwght = itemp[4] ;
totewght = itemp[5] ;
/*
--------------------------------------------------
create the adjIVL IVL object,
set its type to IVL_CHUNKED, then read in its data
--------------------------------------------------
*/
adjIVL = IVL_new() ;
IVL_setDefaultFields(adjIVL) ;
adjIVL->type = IVL_CHUNKED ;
rc = IVL_readFromBinaryFile(adjIVL, fp) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in Graph_readFromBinaryFile(%p,%p)"
"\n trying to read in adjIVL"
"\n return code %d from IVL_readBinaryFile(%p,%p)",
graph, fp, rc, adjIVL, fp) ;
return(0) ;
}
if ( type % 2 == 1 ) {
int nvtot, wght ;
/*
--------------------------
vertex weights are present
--------------------------
*/
nvtot = nvtx + nvbnd ;
vwghts = IVinit2(nvtot) ;
if ( (rc = fread((void *) vwghts, sizeof(int), nvtot, fp)) != nvtot){
fprintf(stderr, "\n error in Graph_readFromBinaryFile(%p,%p)"
"\n %d items of %d read\n", graph, fp, rc, nvtx+nvbnd) ;
return(0) ;
}
wght = IVsum(nvtot, vwghts) ;
if ( wght != totvwght ) {
fprintf(stderr, "\n error in Graph_readFromBinaryFile(%p,%p)"
"\n totvwght = %d, IVsum(vwghts) = %d\n",
graph, fp, totvwght, wght) ;
return(0) ;
}
} else {
vwghts = NULL ;
}
if ( type > 2 ) {
int wght ;
/*
-----------------------------------------------------
edge weights are present, create the ewghtIVL object,
set its type to IVL_CHUNKED, then read in its data
-----------------------------------------------------
*/
ewghtIVL = IVL_new() ;
IVL_setDefaultFields(ewghtIVL) ;
ewghtIVL->type = IVL_CHUNKED ;
rc = IVL_readFromBinaryFile(ewghtIVL, fp) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in Graph_readFromBinaryFile(%p,%p)"
"\n trying to read in ewghtIVL"
"\n return code %d from IVL_readBinaryFile(%p,%p)",
graph, fp, rc, ewghtIVL, fp) ;
return(0) ;
}
wght = IVL_sum(ewghtIVL) ;
if ( wght != totewght ) {
fprintf(stderr, "\n error in Graph_readFromBinaryFile(%p,%p)"
"\n totewght = %d, IVL_sum(ewghtIVL) = %d\n",
graph, fp, totewght, wght) ;
return(0) ;
}
} else {
ewghtIVL = NULL ;
}
/*
---------------------
initialize the object
---------------------
*/
Graph_init2(graph, type, nvtx, nvbnd, nedges, totvwght, totewght,
adjIVL, vwghts, ewghtIVL) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
--------------------------------------------------------------------
this program tests the Graph_MPI_Bcast() method
(1) process root generates a random Graph object
and computes its checksum
(2) process root broadcasts the Graph object to the other processors
(3) each process computes the checksum of its Graph object
(4) the checksums are compared on root
created -- 98sep10, cca
--------------------------------------------------------------------
*/
{
char *buffer ;
double chksum, t1, t2 ;
double *sums ;
Drand drand ;
int iproc, length, loc, msglvl, myid, nitem, nproc,
nvtx, root, seed, size, type, v ;
int *list ;
FILE *msgFile ;
Graph *graph ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type nvtx nitem root seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of graph"
"\n nvtx -- # of vertices"
"\n nitem -- # of items used to generate graph"
"\n root -- root processor for broadcast"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
type = atoi(argv[3]) ;
nvtx = atoi(argv[4]) ;
nitem = atoi(argv[5]) ;
root = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n type -- %d"
"\n nvtx -- %d"
"\n nitem -- %d"
"\n root -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ;
fflush(msgFile) ;
/*
-----------------------
set up the Graph object
-----------------------
*/
MARKTIME(t1) ;
graph = Graph_new() ;
if ( myid == root ) {
InpMtx *inpmtx ;
int nedges, totewght, totvwght, v ;
int *adj, *vwghts ;
IVL *adjIVL, *ewghtIVL ;
/*
-----------------------
generate a random graph
-----------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nvtx) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ;
InpMtx_setNent(inpmtx, nitem) ;
InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
adjIVL = InpMtx_fullAdjacency(inpmtx) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n full adjacency structure") ;
IVL_writeForHumanEye(adjIVL, msgFile) ;
fflush(msgFile) ;
}
nedges = adjIVL->tsize ;
if ( type == 1 || type == 3 ) {
Drand_setUniform(&drand, 1, 10) ;
vwghts = IVinit(nvtx, 0) ;
Drand_fillIvector(&drand, nvtx, vwghts) ;
totvwght = IVsum(nvtx, vwghts) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex weights") ;
IVfprintf(msgFile, nvtx, vwghts) ;
fflush(msgFile) ;
}
} else {
vwghts = NULL ;
totvwght = nvtx ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totvwght %d", totvwght) ;
fflush(msgFile) ;
}
if ( type == 2 || type == 3 ) {
ewghtIVL = IVL_new() ;
IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ;
Drand_setUniform(&drand, 1, 100) ;
totewght = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(adjIVL, v, &size, &adj) ;
IVL_setList(ewghtIVL, v, size, NULL) ;
IVL_listAndSize(ewghtIVL, v, &size, &adj) ;
Drand_fillIvector(&drand, size, adj) ;
totewght += IVsum(size, adj) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ewghtIVL") ;
IVL_writeForHumanEye(ewghtIVL, msgFile) ;
fflush(msgFile) ;
}
} else {
ewghtIVL = NULL ;
totewght = nedges ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totewght %d", totewght) ;
fflush(msgFile) ;
}
Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght,
adjIVL, vwghts, ewghtIVL) ;
InpMtx_free(inpmtx) ;
}
MARKTIME(t2) ;
fprintf(msgFile,
"\n CPU %8.3f : initialize the Graph object", t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
if ( myid == root ) {
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
}
/*
--------------------------
broadcast the Graph object
--------------------------
*/
MARKTIME(t1) ;
graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
---------------------------------------
gather the checksums from the processes
---------------------------------------
*/
sums = DVinit(nproc, 0.0) ;
MPI_Gather((void *) &chksum, 1, MPI_DOUBLE,
(void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile, "\n\n sums") ;
DVfprintf(msgFile, nproc, sums) ;
for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
sums[iproc] -= chksum ;
}
fprintf(msgFile, "\n\n errors") ;
DVfprintf(msgFile, nproc, sums) ;
fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc));
}
/*
----------------
free the objects
----------------
*/
DVfree(sums) ;
Graph_free(graph) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*
---------------------------------------------------------
purpose -- to write out the statistics for the IVL object
return value -- 1 if success, 0 otherwise
created -- 95sep29, cca
---------------------------------------------------------
*/
int
IVL_writeStats (
IVL *ivl,
FILE *fp
) {
int nactive, rc ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || fp == NULL ) {
fprintf(stderr, "\n error in IVL_writeStats(%p,%p)"
"\n bad input\n", ivl, fp) ;
spoolesFatal();
}
nactive = 0 ;
if ( ivl->nlist > 0 ) {
nactive = IVsum(ivl->nlist, ivl->sizes) ;
}
rc = fprintf(fp, "\n IVL : integer vector list object :") ;
if ( rc < 0 ) { goto IO_error ; }
rc = fprintf(fp, "\n type %d", ivl->type) ;
if ( rc < 0 ) { goto IO_error ; }
switch ( ivl->type ) {
case IVL_CHUNKED : rc = fprintf(fp, ", chunked storage") ; break ;
case IVL_SOLO : rc = fprintf(fp, ", solo storage") ; break ;
case IVL_UNKNOWN : rc = fprintf(fp, ", unknown storage") ; break ;
}
if ( rc < 0 ) { goto IO_error ; }
rc = fprintf(fp,
"\n %d lists, %d maximum lists, %d tsize, %d total bytes",
ivl->nlist, ivl->maxnlist, ivl->tsize, IVL_sizeOf(ivl)) ;
if ( rc < 0 ) { goto IO_error ; }
switch ( ivl->type ) {
case IVL_CHUNKED : {
Ichunk *chunk ;
int nalloc, nchunk ;
nalloc = nchunk = 0 ;
for ( chunk = ivl->chunk ; chunk != NULL ; chunk = chunk->next){
nchunk++ ;
nalloc += chunk->size ;
}
rc = fprintf(fp, "\n %d chunks, %d active entries, %d allocated",
nchunk, nactive, nalloc) ;
if ( rc < 0 ) { goto IO_error ; }
if ( nalloc > 0 ) {
rc = fprintf(fp, ", %.2f %% used", (100.*nactive)/nalloc) ;
if ( rc < 0 ) { goto IO_error ; }
}
} break ;
case IVL_SOLO :
rc = fprintf(fp,
"\n %d lists separately allocated, %d active entries",
ivl->nlist, nactive) ;
if ( rc < 0 ) { goto IO_error ; }
break ;
}
return(1) ;
IO_error :
fprintf(stderr, "\n fatal error in IVL_writeStats(%p,%p)"
"\n rc = %d, return from fprintf\n", ivl, fp, rc) ;
return(0) ;
}
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------
test the Drand random number generator object
---------------------------------------------
*/
{
double ddot, dmean, param1, param2 ;
double *dvec ;
Drand drand ;
FILE *msgFile ;
int distribution, ierr, imean, msglvl, n, seed1, seed2 ;
int *ivec ;
if ( argc != 9 ) {
fprintf(stderr,
"\n\n usage : testDrand msglvl msgFile "
"\n distribution param1 param2 seed1 seed2 n"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n distribution -- 1 for uniform(param1,param2)"
"\n -- 2 for normal(param1,param2)"
"\n param1 -- first parameter"
"\n param2 -- second parameter"
"\n seed1 -- first random number seed"
"\n seed2 -- second random number seed"
"\n n -- length of the vector"
"\n"
) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
distribution = atoi(argv[3]) ;
if ( distribution < 1 || distribution > 2 ) {
fprintf(stderr, "\n fatal error in testDrand"
"\n distribution must be 1 (uniform) or 2 (normal)") ;
exit(-1) ;
}
param1 = atof(argv[4]) ;
param2 = atof(argv[5]) ;
seed1 = atoi(argv[6]) ;
seed2 = atoi(argv[7]) ;
n = atoi(argv[8]) ;
Drand_init(&drand) ;
Drand_setSeeds(&drand, seed1, seed2) ;
switch ( distribution ) {
case 1 :
fprintf(msgFile, "\n uniform in [%f,%f]", param1, param2) ;
Drand_setUniform(&drand, param1, param2) ;
break ;
case 2 :
fprintf(msgFile, "\n normal(%f,%f)", param1, param2) ;
Drand_setNormal(&drand, param1, param2) ;
break ;
}
/*
---------------------------------------------
fill the integer and double precision vectors
---------------------------------------------
*/
dvec = DVinit(n, 0.0) ;
Drand_fillDvector(&drand, n, dvec) ;
dmean = DVsum(n, dvec)/n ;
ddot = DVdot(n, dvec, dvec) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n dvec mean = %.4f, variance = %.4f",
dmean, sqrt(fabs(ddot - n*dmean)/n)) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n dvec") ;
DVfprintf(msgFile, n, dvec) ;
}
DVqsortUp(n, dvec) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n sorted dvec") ;
DVfprintf(msgFile, n, dvec) ;
}
ivec = IVinit(n, 0) ;
Drand_fillIvector(&drand, n, ivec) ;
imean = IVsum(n, ivec)/n ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n ivec") ;
IVfp80(msgFile, n, ivec, 80, &ierr) ;
}
IVqsortUp(n, ivec) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n sorted ivec") ;
IVfp80(msgFile, n, ivec, 80, &ierr) ;
}
fprintf(msgFile, "\n") ;
return(1) ; }
/*
------------------------------------------------------------
compute an old-to-new ordering for
local nested dissection in three dimensions
n1 -- number of grid points in first direction
n2 -- number of grid points in second direction
n3 -- number of grid points in third direction
p1 -- number of domains in first direction
p2 -- number of domains in second direction
p3 -- number of domains in third direction
dsizes1 -- domain sizes in first direction, size p1
if NULL, then we construct our own
dsizes2 -- domain sizes in second direction, size p2
if NULL, then we construct our own
dsizes3 -- domain sizes in third direction, size p3
if NULL, then we construct our own
oldToNew -- old-to-new permutation vector
note : the following must hold
n1 > 0, n2 >0, n3 > 0,
n1 >= 2*p1 - 1, n2 >= 2*p2 - 1, n3 >= 2*p3 - 1, p3 > 1
sum(dsizes1) = n1 - p1 + 1, sum(dsizes2) = n2 - p2 + 1
sum(dsizes3) = n3 - p3 + 1
created -- 95nov16, cca
------------------------------------------------------------
*/
void
localND3D (
int n1,
int n2,
int n3,
int p1,
int p2,
int p3,
int dsizes1[],
int dsizes2[],
int dsizes3[],
int oldToNew[]
) {
int i, idom, ijk, isw, j, jdom, jsw, k, kdom, ksw,
length1, length2, length3, m, m1, m2, m3, msize, now, nvtx ;
int *length1s, *length2s, *length3s, *isws, *jsws, *ksws, *temp ;
/*
---------------
check the input
---------------
*/
if ( n1 <= 0 || n2 <= 0 || n3 <= 0
|| 2*p1 - 1 > n1 || 2*p2 - 1 > n2 || 2*p3 - 1 > n3 ) {
fprintf(stderr, "\n error in input data") ;
return ;
}
if ( p3 <= 1 ) {
fprintf(stderr, "\n p3 must be > 1") ;
return ;
}
if ( oldToNew == NULL ) {
fprintf(stderr, "\n oldToNew = NULL") ;
return ;
}
if ( dsizes1 != NULL && IVsum(p1, dsizes1) != n1 - p1 + 1 ) {
fprintf(stderr, "\n IVsum(p1, dsizes1) != n1 - p1 + 1 ") ;
return ;
}
if ( dsizes2 != NULL && IVsum(p2, dsizes2) != n2 - p2 + 1 ) {
fprintf(stderr, "\n IVsum(p2, dsizes2) != n2 - p2 + 1 ") ;
return ;
}
if ( dsizes3 != NULL && IVsum(p3, dsizes3) != n3 - p3 + 1 ) {
fprintf(stderr, "\n IVsum(p3, dsizes3) != n3 - p3 + 1 ") ;
return ;
}
if ( dsizes1 != NULL && IVmin(p1, dsizes1, &i) <= 0 ) {
fprintf(stderr, "\n IVmin(p1, dsizes1) must be > 0") ;
return ;
}
if ( dsizes2 != NULL && IVmin(p2, dsizes2, &i) <= 0 ) {
fprintf(stderr, "\n IVmin(p2, dsizes2) must be > 0") ;
return ;
}
if ( dsizes3 != NULL && IVmin(p3, dsizes3, &i) <= 0 ) {
fprintf(stderr, "\n IVmin(p3, dsizes3) must be > 0") ;
return ;
}
nvtx = n1*n2*n3 ;
/*
----------------------------------
construct the domain sizes vectors
----------------------------------
*/
if ( dsizes1 == NULL ) {
length1s = IVinit(p1, 0) ;
length1 = (n1 - p1 + 1) / p1 ;
m1 = (n1 - p1 + 1) % p1 ;
for ( i = 0 ; i < m1 ; i++ ) {
length1s[i] = length1 + 1 ;
}
for ( ; i < p1 ; i++ ) {
length1s[i] = length1 ;
}
} else {
length1s = dsizes1 ;
}
if ( dsizes2 == NULL ) {
length2s = IVinit(p2, 0) ;
length2 = (n2 - p2 + 1) / p2 ;
m2 = (n2 - p2 + 1) % p2 ;
for ( i = 0 ; i < m2 ; i++ ) {
length2s[i] = length2 + 1 ;
}
for ( ; i < p2 ; i++ ) {
length2s[i] = length2 ;
}
} else {
length2s = dsizes2 ;
}
if ( dsizes3 == NULL ) {
length3s = IVinit(p3, 0) ;
length3 = (n3 - p3 + 1) / p3 ;
m3 = (n3 - p3 + 1) % p3 ;
for ( i = 0 ; i < m3 ; i++ ) {
length3s[i] = length3 + 1 ;
}
for ( ; i < p3 ; i++ ) {
length3s[i] = length3 ;
}
} else {
length3s = dsizes3 ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n inside localND3D") ;
fprintf(stdout,
"\n n1 = %d, n2 = %d, n3 = %d, p1 = %d, p2 = %dm p3 = %d",
n1, n2, n3, p1, p2, p3) ;
fprintf(stdout, "\n length1s[%d] = ", p1) ;
IVfp80(stdout, p1, length1s, 12) ;
fprintf(stdout, "\n length2s[%d] = ", p2) ;
IVfp80(stdout, p2, length2s, 12) ;
fprintf(stdout, "\n length3s[%d] = ", p3) ;
IVfp80(stdout, p3, length3s, 13) ;
#endif
/*
---------------------------------------
determine the first and last domain ids
and the array of southwest points
---------------------------------------
*/
isws = IVinit(p1, -1) ;
for ( idom = 0, isw = 0 ; idom < p1 ; idom++ ) {
isws[idom] = isw ;
isw += length1s[idom] + 1 ;
}
jsws = IVinit(p2, -1) ;
for ( jdom = 0, jsw = 0 ; jdom < p2 ; jdom++ ) {
jsws[jdom] = jsw ;
jsw += length2s[jdom] + 1 ;
}
ksws = IVinit(p3, -1) ;
for ( kdom = 0, ksw = 0 ; kdom < p3 ; kdom++ ) {
ksws[kdom] = ksw ;
ksw += length3s[kdom] + 1 ;
}
#if MYDEBUG > 1
fprintf(stdout, "\n isws[%d] = ", p1) ;
IVfp80(stdout, p1, isws, 12) ;
fprintf(stdout, "\n jsws[%d] = ", p2) ;
IVfp80(stdout, p2, jsws, 12) ;
fprintf(stdout, "\n ksws[%d] = ", p3) ;
IVfp80(stdout, p3, ksws, 12) ;
#endif
/*
----------------------------------------------------------------
create a temporary permutation vector for the domains' orderings
----------------------------------------------------------------
*/
msize = IVmax(p1, length1s, &i) * IVmax(p2, length2s, &i)
* IVmax(p3, length3s, &k) ;
temp = IVinit(msize, -1) ;
/*
------------------------
fill in the domain nodes
------------------------
*/
now = 0 ;
for ( kdom = 0 ; kdom < p3 ; kdom++ ) {
ksw = ksws[kdom] ;
length3 = length3s[kdom] ;
for ( jdom = 0 ; jdom < p2 ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
/*
fprintf(stdout, "\n domain (%d,%d,%d), size %d x %d x %d",
idom, jdom, kdom, length1, length2, length3) ;
fprintf(stdout, "\n (isw, jsw, ksw) = (%d, %d, %d)",
isw, jsw, ksw) ;
*/
mkNDperm(length1, length2, length3, temp,
0, length1-1, 0, length2-1, 0, length3-1) ;
for ( m = 0 ; m < length1*length2*length3 ; m++ ) {
ijk = temp[m] ;
/*
fprintf(stdout, "\n m = %d, ijk = %d", m, ijk) ;
*/
k = ksw + ijk / (length1*length2) ;
ijk = ijk % (length1*length2) ;
j = jsw + ijk / length1 ;
i = isw + ijk % length1 ;
/*
fprintf(stdout, ", (i, j, k) = (%d, %d, %d)", i, j, k) ;
*/
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n old-to-new after domains are numbered") ;
fp3DGrid(n1, n2, n3, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the lower separator nodes
---------------------------------
*/
for ( kdom = 0 ; kdom < (p3/2) ; kdom++ ) {
ksw = ksws[kdom] ;
length3 = length3s[kdom] ;
for ( jdom = 0 ; jdom < p2 ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
/*
-------
3 faces
-------
*/
if ( isw > 0 ) {
i = isw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( jsw > 0 ) {
j = jsw - 1 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( ksw > 0 ) {
k = ksw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
/*
-----------
three edges
-----------
*/
if ( isw > 0 && jsw > 0 ) {
i = isw - 1 ;
j = jsw - 1 ;
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( isw > 0 && ksw > 0 ) {
i = isw - 1 ;
k = ksw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( jsw > 0 && ksw > 0 ) {
j = jsw - 1 ;
k = ksw - 1 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
/*
----------------
one corner point
----------------
*/
if ( isw > 0 && jsw > 0 && ksw > 0 ) {
i = isw - 1 ;
j = jsw - 1 ;
k = ksw - 1 ;
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the lower separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the upper separator nodes
---------------------------------
*/
for ( kdom = p3 - 1 ; kdom >= (p3/2) ; kdom-- ) {
ksw = ksws[kdom] ;
length3 = length3s[kdom] ;
for ( jdom = p2 - 1 ; jdom >= 0 ; jdom-- ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = p1 - 1 ; idom >= 0 ; idom-- ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
/*
-------
3 faces
-------
*/
if ( isw + length1 < n1 ) {
i = isw + length1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( jsw + length2 < n2 ) {
j = jsw + length2 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( ksw + length3 < n3 ) {
k = ksw + length3 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
/*
-----------
three edges
-----------
*/
if ( isw + length1 < n1 && jsw + length2 < n2 ) {
i = isw + length1 ;
j = jsw + length2 ;
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( isw + length1 < n1 && ksw + length3 < n3 ) {
i = isw + length1 ;
k = ksw + length3 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( jsw + length2 < n2 && ksw + length3 < n3 ) {
j = jsw + length2 ;
k = ksw + length3 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
/*
----------------
one corner point
----------------
*/
if ( isw + length1 < n1 && jsw + length2 < n2
&& ksw + length3 < n3 ) {
i = isw + length1 ;
j = jsw + length2 ;
k = ksw + length3 ;
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the upper separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
-------------------------------
fill in the top level separator
-------------------------------
*/
m1 = p3 / 2 ;
for ( kdom = 0, k = 0 ; kdom < m1 ; kdom++ ) {
k += length3s[kdom] + 1 ;
}
k-- ;
for ( j = 0 ; j < n2 ; j++ ) {
for ( i = 0 ; i < n1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
/*
------------------------
free the working storage
------------------------
*/
if ( dsizes1 == NULL ) {
IVfree(length1s) ;
}
if ( dsizes2 == NULL ) {
IVfree(length2s) ;
}
if ( dsizes3 == NULL ) {
IVfree(length3s) ;
}
IVfree(isws) ;
IVfree(jsws) ;
IVfree(ksws) ;
IVfree(temp) ;
return ; }
/*
------------------------------------------------------------
compute an old-to-new ordering for
local nested dissection in two dimensions
n1 -- number of grid points in first direction
n2 -- number of grid points in second direction
p1 -- number of domains in first direction
p2 -- number of domains in second direction
dsizes1 -- domain sizes in first direction, size p1
if NULL, then we construct our own
dsizes2 -- domain sizes in second direction, size p2
if NULL, then we construct our own
oldToNew -- old-to-new permutation vector
note : the following must hold
n1 > 0, n2 >0, n1 >= 2*p1 - 1, n2 >= 2*p2 - 1, p2 > 1
sum(dsizes1) = n1 - p1 + 1 and sum(dsizes2) = n2 - p2 + 1
created -- 95nov16, cca
------------------------------------------------------------
*/
void
localND2D (
int n1,
int n2,
int p1,
int p2,
int dsizes1[],
int dsizes2[],
int oldToNew[]
) {
int i, idom, ij, isw, j, jdom, jsw, length1, length2,
m, m1, m2, msize, now, nvtx ;
int *length1s, *length2s, *isws, *jsws, *temp ;
/*
---------------
check the input
---------------
*/
if ( n1 <= 0 || n2 <= 0 || 2*p1 - 1 > n1 || 2*p2 - 1 > n2
|| oldToNew == NULL ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n bad input\n",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew) ;
exit(-1) ;
}
if ( p2 <= 1 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n p2 = %d, must be > 1",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew, p2) ;
exit(-1) ;
}
if ( dsizes1 != NULL && IVsum(p1, dsizes1) != n1 - p1 + 1 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVsum(p1, dsizes1) = %d != %d = n1 - p1 + 1 ",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVsum(p1, dsizes1), n1 - p1 + 1) ;
return ;
}
if ( dsizes1 != NULL && IVmin(p1, dsizes1, &i) <= 0 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVmin(p1, dsizes1) = %d must be > 0",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVmin(p1, dsizes1, &i)) ;
return ;
}
if ( dsizes2 != NULL && IVsum(p2, dsizes2) != n2 - p2 + 1 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVsum(p2, dsizes2) = %d != %d = n2 - p2 + 1 ",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVsum(p2, dsizes2), n2 - p2 + 1) ;
return ;
}
if ( dsizes2 != NULL && IVmin(p2, dsizes2, &i) <= 0 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVmin(p2, dsizes2) = %d must be > 0",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVmin(p2, dsizes2, &i)) ;
return ;
}
nvtx = n1*n2 ;
/*
----------------------------------
construct the domain sizes vectors
----------------------------------
*/
if ( dsizes1 == NULL ) {
length1s = IVinit(p1, 0) ;
length1 = (n1 - p1 + 1) / p1 ;
m1 = (n1 - p1 + 1) % p1 ;
for ( i = 0 ; i < m1 ; i++ ) {
length1s[i] = length1 + 1 ;
}
for ( ; i < p1 ; i++ ) {
length1s[i] = length1 ;
}
} else {
length1s = dsizes1 ;
}
if ( dsizes2 == NULL ) {
length2s = IVinit(p2, 0) ;
length2 = (n2 - p2 + 1) / p2 ;
m2 = (n2 - p2 + 1) % p2 ;
for ( i = 0 ; i < m2 ; i++ ) {
length2s[i] = length2 + 1 ;
}
for ( ; i < p2 ; i++ ) {
length2s[i] = length2 ;
}
} else {
length2s = dsizes2 ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n inside localND2D") ;
fprintf(stdout, "\n n1 = %d, n2 = %d, p1 = %d, p2 = %d",
n1, n2, p1, p2) ;
fprintf(stdout, "\n length1s[%d] = ", p1) ;
IVfp80(stdout, p1, length1s, 12) ;
fprintf(stdout, "\n length2s[%d] = ", p2) ;
IVfp80(stdout, p2, length2s, 12) ;
#endif
/*
---------------------------------------
determine the first and last domain ids
and the array of southwest points
---------------------------------------
*/
isws = IVinit(p1, -1) ;
for ( idom = 0, isw = 0 ; idom < p1 ; idom++ ) {
isws[idom] = isw ;
isw += length1s[idom] + 1 ;
}
jsws = IVinit(p2, -1) ;
for ( jdom = 0, jsw = 0 ; jdom < p2 ; jdom++ ) {
jsws[jdom] = jsw ;
jsw += length2s[jdom] + 1 ;
}
#if MYDEBUG > 1
fprintf(stdout, "\n isws[%d] = ", p1) ;
IVfp80(stdout, p1, isws, 12) ;
fprintf(stdout, "\n jsws[%d] = ", p2) ;
IVfp80(stdout, p2, jsws, 12) ;
#endif
/*
----------------------------------------------------------------
create a temporary permutation vector for the domains' orderings
----------------------------------------------------------------
*/
msize = IVmax(p1, length1s, &i) * IVmax(p2, length2s, &i) ;
temp = IVinit(msize, -1) ;
/*
------------------------
fill in the domain nodes
------------------------
*/
now = 0 ;
for ( jdom = 0; jdom < p2 ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
length1 = length1s[idom] ;
isw = isws[idom] ;
mkNDperm(length1, length2, 1, temp, 0, length1-1,
0, length2-1, 0, 0) ;
for ( m = 0 ; m < length1*length2 ; m++ ) {
ij = temp[m] ;
i = isw + (ij % length1) ;
j = jsw + (ij / length1) ;
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n old-to-new after domains are numbered") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the lower separator nodes
---------------------------------
*/
for ( jdom = 0 ; jdom < (p2/2) ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
if ( isw > 0 ) {
i = isw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
if ( isw > 0 && jsw > 0 ) {
i = isw - 1 ;
j = jsw - 1 ;
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
if ( jsw > 0 ) {
j = jsw - 1 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the lower separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the upper separator nodes
---------------------------------
*/
for ( jdom = p2 - 1 ; jdom >= (p2/2) ; jdom-- ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = p1 - 1 ; idom >= 0 ; idom-- ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
if ( isw + length1 < n1 ) {
i = isw + length1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
if ( isw + length1 < n1 && jsw + length2 < n2 ) {
i = isw + length1 ;
j = jsw + length2 ;
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
if ( jsw + length2 < n2 ) {
j = jsw + length2 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the upper separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
-------------------------------
fill in the top level separator
-------------------------------
*/
m1 = p2 / 2 ;
for ( jdom = 0, j = 0 ; jdom < m1 ; jdom++ ) {
j += length2s[jdom] + 1 ;
}
j-- ;
for ( i = 0 ; i < n1 ; i++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
/*
------------------------
free the working storage
------------------------
*/
if ( dsizes1 == NULL ) {
IVfree(length1s) ;
}
if ( dsizes2 == NULL ) {
IVfree(length2s) ;
}
IVfree(isws) ;
IVfree(jsws) ;
IVfree(temp) ;
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) ; }
/*
----------------------------------------------------
create a Graph object that holds the adjacency graph
of the assembled elements.
created -- 95nov03, cca
----------------------------------------------------
*/
Graph *
EGraph_mkAdjGraph (
EGraph *egraph
) {
int elem, esize, i, nelem, nvtx, v, vsize, w ;
int *eind, *head, *link, *marker, *offsets, *vind ;
IVL *eadjIVL, *gadjIVL ;
Graph *graph ;
/*
---------------
check the input
---------------
*/
if ( egraph == NULL || (eadjIVL = egraph->adjIVL) == NULL ) {
fprintf(stderr, "\n fatal error in EGraph_mkAdjGraph(%p)"
"\n bad input\n", egraph) ;
spoolesFatal();
}
nelem = egraph->nelem ;
nvtx = egraph->nvtx ;
/*
--------------------------------
set up the linked list structure
--------------------------------
*/
head = IVinit(nvtx, -1) ;
link = IVinit(nelem, -1) ;
offsets = IVinit(nelem, 0) ;
/*
-----------------------------------------------------------
sort the vertices in each element list into ascending order
and link them into their first vertex
-----------------------------------------------------------
*/
for ( elem = 0 ; elem < nelem ; elem++ ) {
IVL_listAndSize(eadjIVL, elem, &esize, &eind) ;
if ( esize > 0 ) {
IVqsortUp(esize, eind) ;
v = eind[0] ;
link[elem] = head[v] ;
head[v] = elem ;
}
}
/*
---------------------------
create the new Graph object
---------------------------
*/
graph = Graph_new() ;
Graph_init1(graph, egraph->type, nvtx, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ;
gadjIVL = graph->adjIVL ;
/*
----------------------
loop over the vertices
----------------------
*/
vind = IVinit(nvtx, -1) ;
marker = IVinit(nvtx, -1) ;
for ( v = 0 ; v < nvtx ; v++ ) {
/*
---------------------------------
loop over the supporting elements
---------------------------------
*/
vsize = 0 ;
vind[vsize++] = v ;
marker[v] = v ;
while ( (elem = head[v]) != -1 ) {
/*
fprintf(stdout, "\n checking out element %d :", jelem) ;
*/
head[v] = link[elem] ;
IVL_listAndSize(eadjIVL, elem, &esize, &eind) ;
for ( i = 0 ; i < esize ; i++ ) {
w = eind[i] ;
if ( marker[w] != v ) {
marker[w] = v ;
vind[vsize++] = w ;
}
}
if ( (i = ++offsets[elem]) < esize ) {
w = eind[i] ;
link[elem] = head[w] ;
head[w] = elem ;
}
}
IVqsortUp(vsize, vind) ;
IVL_setList(gadjIVL, v, vsize, vind) ;
}
graph->nedges = gadjIVL->tsize ;
if ( egraph->type == 0 ) {
graph->totvwght = nvtx ;
} else if ( egraph->type == 1 ) {
/*
------------------------------
fill the vertex weights vector
------------------------------
*/
IVcopy(nvtx, graph->vwghts, egraph->vwghts) ;
graph->totvwght = IVsum(nvtx, graph->vwghts) ;
}
graph->totewght = graph->nedges ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(head) ;
IVfree(link) ;
IVfree(marker) ;
IVfree(vind) ;
IVfree(offsets) ;
return(graph) ; }
/*
------------------------------------------------------------------
purpose -- to find indistinguishable nodes in the reach set
flag = 0 --> return
flag = 1 --> check out nodes that are 2-adj
flag = 2 --> check out nodes that are both 2-adj and not
note: the reach set is not changed.
created -- 96feb15, cca
modified -- 97feb07, cca
very tricky "bug"
was : sum += ip->val for subtrees
sum += IVsum(nvedge, vedges) for uncovered edges
now : sum += ip->val + 1 for subtrees
sum += IVsum(nvedge, vedges) + nvedge for uncovered edges
checksums were "wrong" due to vertex 0 adding nothing
to the checksum. beware 0-indexing.
------------------------------------------------------------------
*/
void
MSMD_findInodes (
MSMD *msmd,
MSMDinfo *info
) {
int first, flag, i, ierr, iv, iw, j, k, keepon, nlist,
nreach, nvedge, sum, vid, vchk, vcount, wid ;
int *chk, *list, *reach, *vedges, *wedges ;
IP *ip, *ipv, *ipw, *vsubtrees ;
MSMDvtx *v, *w ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || info == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_findInodes(%p,%p)"
"\n bad input\n", msmd, info) ;
exit(-1) ;
}
if ( (flag = info->compressFlag % 4) == 0 ) {
/*
---------------------------------------
no compression requested, simple return
---------------------------------------
*/
return ;
}
/*
---------------------------------
if the reach set is empty, return
---------------------------------
*/
if ( (nreach = IV_size(&msmd->reachIV)) == 0 ) {
return ;
}
/*
reach = msmd->reach ;
*/
reach = IV_entries(&msmd->reachIV) ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n inside MSMD_findInodes(%p)"
"\n reach(%d) :", msmd, nreach) ;
IVfp80(info->msgFile, nreach, reach, 10, &ierr);
fflush(info->msgFile) ;
}
/*
-------------------------------------------------------
load the front of the reach set with nodes to be tested
-------------------------------------------------------
*/
chk = IV_entries(&msmd->ivtmpIV) ;
list = reach ;
if ( flag == 1 ) {
/*
-------------------------------------------
work only with nodes adjacent to 2 subtrees
-------------------------------------------
*/
i = 0 ; j = nreach - 1 ;
while ( i <= j ) {
vid = list[i] ;
v = msmd->vertices + vid ;
if ( v->nadj != 0 || (ip = v->subtrees) == NULL
|| (ip = ip->next) == NULL || ip->next != NULL ) {
/*
--------------------------------
vertex is not 2-adj, swap to end
--------------------------------
*/
list[i] = list[j] ;
list[j] = vid ;
j-- ;
} else {
/*
--------------------------
vertex is 2-adj, keep here
--------------------------
*/
i++ ;
}
}
nlist = j + 1 ;
} else {
/*
---------------------------------
put all reached nodes in the list
---------------------------------
*/
nlist = nreach ;
}
if ( nlist == 0 ) {
return ;
}
/*
-----------------------------------------------------
compute the the checksums and count adjacent subtrees
for all vertices in the list
-----------------------------------------------------
*/
for ( k = 0 ; k < nlist ; k++ ) {
vid = list[k] ;
v = msmd->vertices + vid ;
vcount = 0 ;
sum = 0 ;
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n vertex %d", vid) ;
fflush(info->msgFile) ;
}
for ( ipv = v->subtrees ; ipv != NULL ; ipv = ipv->next ) {
/*
------------------------------------
add adjacent subtree to the checksum
------------------------------------
*/
sum += ipv->val + 1 ;
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n adjacent subtree %d, sum = %d",
ipv->val, sum) ;
fflush(info->msgFile) ;
}
vcount++ ;
}
if ( (nvedge = v->nadj) > 0 && (vedges = v->adj) != NULL ) {
sum += IVsum(nvedge, vedges) + nvedge ;
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n %d adjacent edges :",
nvedge) ;
IVfp80(info->msgFile, nvedge, vedges, 20, &ierr) ;
fprintf(info->msgFile, " : sum = %d", sum) ;
fflush(info->msgFile) ;
}
IVqsortUp(nvedge, vedges) ;
}
/*
-----------------
save the checksum
-----------------
*/
chk[k] = sum ;
}
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n before sort, list array") ;
fflush(info->msgFile) ;
IVfp80(info->msgFile, nlist, list, 80, &ierr) ;
fflush(info->msgFile) ;
fprintf(info->msgFile, "\n chk array") ;
fflush(info->msgFile) ;
IVfp80(info->msgFile, nlist, chk, 80, &ierr) ;
fflush(info->msgFile) ;
}
/*
-----------------------------------------------------
sort the vertices in the reach set by their checksums
-----------------------------------------------------
*/
IV2qsortUp(nlist, chk, list) ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n after sort, reach array") ;
IVfp80(info->msgFile, nlist, list, 80, &ierr) ;
fprintf(info->msgFile, "\n chk array") ;
IVfp80(info->msgFile, nlist, chk, 80, &ierr) ;
fflush(info->msgFile) ;
}
/*
----------------------------------------
detect and purge indistinguishable nodes
----------------------------------------
*/
for ( iv = 0 ; iv < nlist ; iv++ ) {
vid = list[iv] ;
v = msmd->vertices + vid ;
if ( v->status == 'I' ) {
/*
-----------------------------------------------------
vertex has been found indistinguishable, skip to next
-----------------------------------------------------
*/
continue ;
}
/*
---------------------------
test against other vertices
---------------------------
*/
vchk = chk[iv] ;
nvedge = v->nadj ;
vedges = v->adj ;
vsubtrees = v->subtrees ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile,
"\n checking out v = %d, vchk = %d, status = %c",
v->id, vchk, v->status) ;
fflush(info->msgFile) ;
}
/*
---------------------------------------------------
check v against all vertices with the same checksum
---------------------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n checking out v = %d, status = %d",
v->id, v->stage) ;
fflush(info->msgFile) ;
}
first = 1 ;
for ( iw = iv + 1 ; iw < nlist && chk[iw] == vchk ; iw++ ) {
wid = reach[iw] ;
w = msmd->vertices + wid ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile,
"\n w = %d, status = %c, status = %d",
w->id, w->status, w->stage) ;
fflush(info->msgFile) ;
}
if ( w->status == 'I'
|| v->stage != w->stage
|| nvedge != w->nadj ) {
/*
------------------------------------
w has been found indistinguishable
or
v and w do not lie on the same stage
or
edge counts are not the same
------------------------------------
*/
continue ;
}
/*
----------------------------------------
w and v check out so far, check to see
if all vertices adjacent to w are marked
----------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile,
"\n checking %d against %d", wid, vid) ;
fflush(info->msgFile) ;
}
/*
---------------------------------------------------------------
check to see if the subtree lists and edge lists are indentical
---------------------------------------------------------------
*/
info->stageInfo->ncheck++ ;
keepon = 1 ;
ipv = vsubtrees ;
ipw = w->subtrees ;
while ( ipv != NULL && ipw != NULL ) {
if ( ipv->val != ipw->val ) {
keepon = 0 ;
break ;
}
ipv = ipv->next ;
ipw = ipw->next ;
}
if ( keepon == 1 ) {
wedges = w->adj ;
for ( k = 0 ; k < nvedge ; k++ ) {
if ( vedges[k] != wedges[k] ) {
keepon = 0 ;
break ;
}
}
}
if ( keepon == 1 ) {
/*
---------------------------------------------
w and v are indistinguishable, merge w into v
---------------------------------------------
*/
if ( info->msglvl > 1 ) {
fprintf(info->msgFile,
"\n %d absorbs %d, wght = %d, status[%d] = %c",
v->id, w->id, w->wght, w->id, w->status) ;
fflush(info->msgFile) ;
}
v->wght += w->wght ;
w->wght = 0 ;
w->status = 'I' ;
w->nadj = 0 ;
w->adj = NULL ;
w->par = v ;
if ( (ipw = w->subtrees) != NULL ) {
while ( ipw->next != NULL ) {
ipw = ipw->next ;
}
ipw->next = msmd->freeIP ;
msmd->freeIP = ipw ;
w->subtrees = NULL ;
}
info->stageInfo->nindst++ ;
}
}
}
if ( info->msglvl > 4 ) {
fprintf(info->msgFile,
"\n MSMD_findInodes(%p), all done checking the nodes", msmd) ;
fflush(info->msgFile) ;
}
return ; }
/*
-----------------------------------------------------------
purpose -- to write out the statistics for the BPG object
return value -- 1 if success, 0 otherwise
created -- 95oct06, cca
-----------------------------------------------------------
*/
int
BPG_writeStats (
BPG *bpg,
FILE *fp
) {
int rc ;
/*
---------------
check the input
---------------
*/
if ( bpg == NULL || fp == NULL ) {
fprintf(stderr, "\n error in BPG_writeStats(%p,%p)"
"\n bad input\n", bpg, fp) ;
spoolesFatal();
}
if ( bpg->graph == NULL ) {
fprintf(stderr, "\n warning in BPG_writeStats(%p,%p)"
"\n bpg->graph = NULL\n", bpg, fp) ;
return(1) ;
}
switch ( bpg->graph->type ) {
case 0 :
rc = fprintf(fp, "\n BPG : unweighted bpg object :") ;
break ;
case 1 :
rc = fprintf(fp, "\n BPG : vertices weighted bpg object :") ;
break ;
case 2 :
rc = fprintf(fp, "\n BPG : edges weighted bpg object :") ;
break ;
case 3 :
rc = fprintf(fp,
"\n BPG : vertices and edges weighted bpg object :") ;
break ;
default :
fprintf(stderr, "\n fatal error in BPG_writeStats(%p,%p)"
"\n invalid bpg->g->type = %d\n",
bpg, fp, bpg->graph->type) ;
return(0) ;
}
if ( rc < 0 ) { goto IO_error ; }
fflush(fp) ;
rc = fprintf(fp, " nX = %d, nY = %d", bpg->nX, bpg->nY) ;
if ( rc < 0 ) { goto IO_error ; }
fflush(fp) ;
if ( bpg->graph != NULL ) {
if ( bpg->graph->vwghts != NULL ) {
rc = fprintf(fp, ", |X| = %d, |Y| = %d",
IVsum(bpg->nX, bpg->graph->vwghts),
IVsum(bpg->nY, bpg->graph->vwghts + bpg->nX)) ;
} else {
rc = fprintf(fp, ", |X| = %d, |Y| = %d", bpg->nX, bpg->nY) ;
}
}
if ( rc < 0 ) { goto IO_error ; }
fflush(fp) ;
return(1) ;
IO_error :
fprintf(stderr, "\n fatal error in BPG_writeStats(%p,%p)"
"\n rc = %d, return from fprintf\n", bpg, fp, rc) ;
return(0) ;
}
