/*
------------------------------------------------------------
create and return a depth metric IV object
input : vmetricIV -- a metric defined on the vertices
output : dmetricIV -- a depth metric defined on the vertices
dmetric[u] = vmetric[u] + dmetric[par[u]] if par[u] != -1
= vmetric[u] if par[u] == -1
created -- 96jun23, cca
------------------------------------------------------------
*/
IV *
Tree_setDepthImetric (
Tree *tree,
IV *vmetricIV
) {
int u, v ;
int *dmetric, *vmetric ;
IV *dmetricIV ;
/*
---------------
check the input
---------------
*/
if ( tree == NULL || tree->n < 1
|| vmetricIV == NULL
|| tree->n != IV_size(vmetricIV)
|| (vmetric = IV_entries(vmetricIV)) == NULL ) {
fprintf(stderr, "\n fatal error in Tree_setDepthImetric(%p,%p)"
"\n bad input\n", tree, vmetricIV) ;
exit(-1) ;
}
dmetricIV = IV_new() ;
IV_init(dmetricIV, tree->n, NULL) ;
dmetric = IV_entries(dmetricIV) ;
for ( u = Tree_preOTfirst(tree) ;
u != -1 ;
u = Tree_preOTnext(tree, u) ) {
dmetric[u] = vmetric[u] ;
if ( (v = tree->par[u]) != -1 ) {
dmetric[u] += dmetric[v] ;
}
}
return(dmetricIV) ; }
/*
------------------------------------------------------
create and return a subtree metric IV object
input : vmetricIV -- a metric defined on the vertices
return : tmetricIV -- a metric defined on the subtrees
created -- 96jun23, cca
------------------------------------------------------
*/
IV *
Tree_setSubtreeImetric (
Tree *tree,
IV *vmetricIV
) {
int u, v ;
int *tmetric, *vmetric ;
IV *tmetricIV ;
/*
---------------
check the input
---------------
*/
if ( tree == NULL || tree->n <= 0
|| vmetricIV == NULL
|| tree->n != IV_size(vmetricIV)
|| (vmetric = IV_entries(vmetricIV)) == NULL ) {
fprintf(stderr, "\n fatal error in Tree_setSubtreeImetric(%p,%p)"
"\n bad input\n", tree, vmetricIV) ;
exit(-1) ;
}
tmetricIV = IV_new() ;
IV_init(tmetricIV, tree->n, NULL) ;
tmetric = IV_entries(tmetricIV) ;
for ( v = Tree_postOTfirst(tree) ;
v != -1 ;
v = Tree_postOTnext(tree, v) ) {
tmetric[v] = vmetric[v] ;
for ( u = tree->fch[v] ; u != -1 ; u = tree->sib[u] ) {
tmetric[v] += tmetric[u] ;
}
}
return(tmetricIV) ; }
/*
----------------------------------------------
return the number of bytes taken by the object
created -- 95oct05, cca
----------------------------------------------
*/
int
GPart_sizeOf (
GPart *gpart
) {
int nbytes ;
if ( gpart == NULL ) {
fprintf(stderr, "\n fatal error in GPart_sizeOf(%p)"
"\n bad input\n", gpart) ;
exit(-1) ;
}
nbytes = sizeof(struct _GPart) ;
nbytes += IV_size(&gpart->compidsIV) ;
nbytes += IV_size(&gpart->cweightsIV) ;
nbytes += IV_size(&gpart->vtxMapIV) ;
return(nbytes) ; }
/*
---------------------------------------------------------------------
purpose -- take a Graph object and a map to expand it, create and
return a bigger unit weight Graph object. this is useful
for expanding a compressed graph into a unit weight graph.
created -- 96mar02, cca
---------------------------------------------------------------------
*/
Graph *
Graph_expand2 (
Graph *g,
IV *mapIV
) {
/*
---------------
check the input
---------------
*/
if ( g == NULL
|| g->nvtx <= 0
|| mapIV == NULL
|| IV_entries(mapIV) == NULL ) {
fprintf(stderr, "\n fatal error in Graph_expand2(%p,%p)"
"\n bad input\n", g, mapIV) ;
spoolesFatal();
}
return(Graph_expand(g, IV_size(mapIV), IV_entries(mapIV))) ; }
/*
------------------------------------------------------------------
create and return a height metric IV object
input : vmetricIV -- a metric defined on the vertices
output : dmetricIV -- a depth metric defined on the vertices
hmetric[v] = vmetric[v] + max{p(u) = v} hmetric[u] if fch[v] != -1
= vmetric[v] if fch[v] == -1
created -- 96jun23, cca
------------------------------------------------------------------
*/
IV *
Tree_setHeightImetric (
Tree *tree,
IV *vmetricIV
) {
int u, v, val ;
int *hmetric, *vmetric ;
IV *hmetricIV ;
/*
---------------
check the input
---------------
*/
if ( tree == NULL || tree->n < 1
|| vmetricIV == NULL
|| tree->n != IV_size(vmetricIV)
|| (vmetric = IV_entries(vmetricIV)) == NULL ) {
fprintf(stderr, "\n fatal error in Tree_setHeightImetric(%p,%p)"
"\n bad input\n", tree, vmetricIV) ;
if ( tree != NULL ) {
Tree_writeForHumanEye(tree, stderr) ;
}
if ( vmetricIV != NULL ) {
IV_writeForHumanEye(vmetricIV, stderr) ;
}
exit(-1) ;
}
hmetricIV = IV_new() ;
IV_init(hmetricIV, tree->n, NULL) ;
hmetric = IV_entries(hmetricIV) ;
for ( v = Tree_postOTfirst(tree) ;
v != -1 ;
v = Tree_postOTnext(tree, v) ) {
for ( u = tree->fch[v], val = 0 ; u != -1 ; u = tree->sib[u] ) {
if ( val < hmetric[u] ) {
val = hmetric[u] ;
}
}
hmetric[v] = val + vmetric[v] ;
}
return(hmetricIV) ; }
/*
-------------------------------------------------------------
initialize the object given a Tree object and a map IV object
created -- 96mar10, cca
-------------------------------------------------------------
*/
void
DSTree_init2 (
DSTree *dstree,
Tree *tree,
IV *mapIV
) {
/*
---------------
check the input
---------------
*/
if ( dstree == NULL || tree == NULL || tree->n < 1
|| mapIV == NULL || IV_size(mapIV) < 1 ) {
fprintf(stderr, "\n fatal error in DSTree_init2(%p,%p,%p)"
"\n bad input\n", dstree, tree, mapIV) ;
exit(-1) ;
}
DSTree_clearData(dstree) ;
dstree->tree = tree ;
dstree->mapIV = mapIV ;
return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
----------------------------------------
draw the tree
created -- 99jan23, cca
----------------------------------------
*/
{
char coordflag, heightflag ;
char *inTagsFileName, *inTreeFileName, *outEPSfileName ;
double fontsize, radius, t1, t2 ;
double bbox[4], frame[4] ;
DV *xDV, *yDV ;
int ierr, msglvl, rc, tagsflag ;
IV *tagsIV ;
Tree *tree ;
FILE *msgFile ;
if ( argc != 19 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile inTreeFile inTagsFile outEPSfile "
"\n heightflag coordflag radius bbox[4] frame[4] tagflag fontsize"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inTreeFile -- input file, must be *.treef or *.treeb"
"\n inTagsFile -- input file, must be *.ivf or *.ivb or none"
"\n outEPSfile -- output file"
"\n heightflag -- height flag"
"\n 'D' -- use depth metric"
"\n 'H' -- use height metric"
"\n coordflag -- coordinate flag"
"\n 'C' -- use (x,y) Cartesian coordinates"
"\n 'P' -- use (r,theta) polar coordinates"
"\n radius -- radius of node"
"\n bbox[4] -- bounding box"
"\n frame[4] -- frame for plot"
"\n fontsize -- size of fonts (in points)"
"\n tagflag -- if 1, draw labels, otherwise, do not"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
inTreeFileName = argv[3] ;
inTagsFileName = argv[4] ;
outEPSfileName = argv[5] ;
heightflag = argv[6][0] ;
coordflag = argv[7][0] ;
radius = atof(argv[8]) ;
bbox[0] = atof(argv[9]) ;
bbox[1] = atof(argv[10]) ;
bbox[2] = atof(argv[11]) ;
bbox[3] = atof(argv[12]) ;
frame[0] = atof(argv[13]) ;
frame[1] = atof(argv[14]) ;
frame[2] = atof(argv[15]) ;
frame[3] = atof(argv[16]) ;
fontsize = atof(argv[17]) ;
tagsflag = atoi(argv[18]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inTreeFile -- %s"
"\n inTagsFile -- %s"
"\n outEPSfile -- %s"
"\n heightflag -- %c"
"\n coordflag -- %d"
"\n radius -- %.3g"
"\n bbox -- %.3g %.3g %.3g %.3g"
"\n frame -- %.3g %.3g %.3g %.3g"
"\n fontsize -- %.3g"
"\n",
argv[0], msglvl, argv[2], inTreeFileName, inTagsFileName,
outEPSfileName, heightflag, coordflag, radius,
bbox[0], bbox[1], bbox[2], bbox[3],
frame[0], frame[1], frame[2], frame[3], fontsize, tagsflag) ;
fflush(msgFile) ;
/*
------------------------
read in the Tree object
------------------------
*/
if ( strcmp(inTreeFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
tree = Tree_new() ;
MARKTIME(t1) ;
rc = Tree_readFromFile(tree, inTreeFileName) ;
/*
Tree_setFchSibRoot(tree) ;
*/
Tree_leftJustify(tree) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in tree from file %s",
t2 - t1, inTreeFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from Tree_readFromFile(%p,%s)",
rc, tree, inTreeFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading Tree object from file %s",
inTreeFileName) ;
if ( msglvl > 2 ) {
Tree_writeForHumanEye(tree, msgFile) ;
} else {
Tree_writeStats(tree, msgFile) ;
}
fflush(msgFile) ;
if ( Tree_maxNchild(tree) > 2 ) {
fprintf(msgFile, "\n\n maximum number of children = %d",
Tree_maxNchild(tree)) ;
}
if ( strcmp(inTagsFileName, "none") != 0 ) {
/*
--------------------------
read in the tags IV object
--------------------------
*/
tagsIV = IV_new() ;
MARKTIME(t1) ;
rc = IV_readFromFile(tagsIV, inTagsFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in tagsIV from file %s",
t2 - t1, inTagsFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)",
rc, tagsIV, inTagsFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading IV object from file %s",
inTagsFileName) ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(tagsIV, msgFile) ;
} else {
IV_writeStats(tagsIV, msgFile) ;
}
fflush(msgFile) ;
if ( IV_size(tagsIV) != tree->n ) {
fprintf(stderr,
"\n fatal error, IV_size(tagsIV) = %d, tree->n = %d",
IV_size(tagsIV), tree->n) ;
exit(-1) ;
}
} else {
tagsIV = NULL ;
}
/*
-------------------------------
get the coordinates of the tree
-------------------------------
*/
xDV = DV_new() ;
yDV = DV_new() ;
rc = Tree_getSimpleCoords(tree, heightflag, coordflag, xDV, yDV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error return %d from Tree_getSimpleCoords()",rc);
exit(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n x-coordinates") ;
DV_writeForHumanEye(xDV, msgFile) ;
fprintf(msgFile, "\n\n y-coordinates") ;
DV_writeForHumanEye(yDV, msgFile) ;
fflush(msgFile) ;
}
/*
-------------
draw the Tree
-------------
*/
rc = Tree_drawToEPS(tree, outEPSfileName, xDV, yDV, radius, NULL,
tagsflag, fontsize, tagsIV, bbox, frame, NULL) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error return %d from Tree_drawToEPSfile()", rc) ;
exit(-1) ;
}
/*
---------------------
free the Tree object
---------------------
*/
Tree_free(tree) ;
if ( tagsIV != NULL ) {
IV_free(tagsIV) ;
}
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*
--------------------------------------
purpose -- map the off diagonal blocks
to processes in a random fashion
created -- 98mar19, cca
--------------------------------------
*/
void
SolveMap_randomMap (
SolveMap *solvemap,
int symmetryflag,
IVL *upperBlockIVL,
IVL *lowerBlockIVL,
int nproc,
IV *ownersIV,
int seed,
int msglvl,
FILE *msgFile
) {
Drand drand ;
int ii, J, K, loc, nadj, nblockLower, nblockUpper,
nfront, proc ;
int *adj, *colids, *map, *owners, *rowids ;
/*
---------------
check the input
---------------
*/
if ( solvemap == NULL || symmetryflag < 0
|| upperBlockIVL == NULL || ownersIV == NULL ) {
fprintf(stderr,
"\n fatal error in SolveMap_randomMap(%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_randomMap(): 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) ;
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_setUniform(&drand, 0, nproc) ;
/*
----------------------------------------
map the upper blocks in a random fashion
----------------------------------------
*/
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 ) {
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 ( lowerBlockIVL != NULL ) {
/*
----------------------------------------
map the lower blocks in a random fashion
----------------------------------------
*/
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 ) {
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++ ;
}
}
}
}
return ; }
/*
-------------------------------------------------------
make the map from wide separator vertices Y
to components {0, 1, 2, 3}.
YCmap[y] == 0 --> y is not adjacent to either component
YCmap[y] == 1 --> y is adjacent to only component 1
YCmap[y] == 2 --> y is adjacent to only component 2
YCmap[y] == 3 --> y is adjacent to components 1 and 2
created -- 96jun09, cca
-------------------------------------------------------
*/
IV *
GPart_makeYCmap (
GPart *gpart,
IV *YVmapIV
) {
Graph *g ;
int ii, nvtx, nY, v, vsize, w, y ;
int *compids, *vadj, *VYmap, *YCmap, *YVmap ;
IV *YCmapIV ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || (g = gpart->g) == NULL
|| (nvtx = gpart->nvtx) <= 0
|| YVmapIV == NULL || (nY = IV_size(YVmapIV)) <= 0
|| (YVmap = IV_entries(YVmapIV)) == NULL ) {
fprintf(stderr, "\n fatal error in GPart_makeYCmap(%p,%p)"
"\n bad input\n", gpart, YVmapIV) ;
if ( YVmapIV != NULL ) {
fprintf(stderr, "\n YVmapIV") ;
IV_writeForHumanEye(YVmapIV, stderr) ;
}
exit(-1) ;
}
compids = IV_entries(&gpart->compidsIV) ;
/*
--------------------------------
generate the inverse V --> Y map
--------------------------------
*/
VYmap = IVinit(nvtx, -1) ;
for ( y = 0 ; y < nY ; y++ ) {
v = YVmap[y] ;
VYmap[v] = y ;
}
/*
------------------------------------
initialize the Y --> C map IV object
------------------------------------
*/
YCmapIV = IV_new();
IV_init(YCmapIV, nY, NULL) ;
YCmap = IV_entries(YCmapIV) ;
/*
---------------
fill the fields
---------------
*/
for ( y = 0 ; y < nY ; y++ ) {
YCmap[y] = 0 ;
v = YVmap[y] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && VYmap[w] == -1 ) {
/*
--------------------------------
w is not in the wide separator Y
--------------------------------
*/
if ( compids[w] == 1 ) {
/*
---------------------------------------
v is adjacent to component 1 setminus Y
---------------------------------------
*/
if ( YCmap[y] == 2 ) {
/*
------------------------------------
v is already adjacent to component 2
so it is adjacent to both components
------------------------------------
*/
YCmap[y] = 3 ;
break ;
} else {
/*
----------------------------------
set map value but keep on checking
----------------------------------
*/
YCmap[y] = 1 ;
}
} else if ( compids[w] == 2 ) {
/*
---------------------------------------
v is adjacent to component 2 setminus Y
---------------------------------------
*/
if ( YCmap[y] == 1 ) {
/*
------------------------------------
v is already adjacent to component 1
so it is adjacent to both components
------------------------------------
*/
YCmap[y] = 3 ;
break ;
} else {
/*
----------------------------------
set map value but keep on checking
----------------------------------
*/
YCmap[y] = 2 ;
}
}
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(VYmap) ;
return(YCmapIV) ; }
/*
-------------------------------------------------
clean the vertices in the reach set
for each v in reach set
clean subtree list
clean edge list
end for
created -- 95nov08, cca
-------------------------------------------------
*/
void
MSMD_cleanReachSet (
MSMD *msmd,
MSMDinfo *info
) {
int k, nreach ;
int *reach ;
MSMDvtx *v ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || info == NULL ) {
fprintf(stderr, "\n inside MSMD_cleanReachSet(%p,%p)"
"\n bad input\n", msmd, info) ;
exit(-1) ;
}
nreach = IV_size(&msmd->reachIV) ;
reach = IV_entries(&msmd->reachIV) ;
/*
nreach = msmd->nreach ;
reach = msmd->reach ;
*/
if ( nreach < 0 || nreach > msmd->nvtx || reach == NULL ) {
fprintf(stderr, "\n inside MSMD_cleanReachSet(%p)"
"\n nreach = %d, reach = %p, nvtx = %d\n",
msmd, nreach, reach, msmd->nvtx) ;
exit(-1) ;
}
if ( info->msglvl >= 5 ) {
fprintf(info->msgFile, "\n inside MSMD_cleanReachSet(%p)", msmd) ;
fflush(info->msgFile) ;
}
/*
---------------------------------------------------------
clean the subtree lists of the vertices in the reach list
---------------------------------------------------------
*/
#if MYDEBUG > 0
fprintf(stdout, "\n nreach = %d", nreach) ;
for ( k = 0 ; k < nreach ; k++ ) {
v = msmd->vertices + reach[k] ;
fprintf(stdout, "\n <%d, %c, %c>", v->id, v->status, v->mark) ;
}
fflush(stdout) ;
#endif
for ( k = 0 ; k < nreach ; k++ ) {
v = msmd->vertices + reach[k] ;
#if MYDEBUG > 1
fprintf(stdout, "\n calling MSMD_cleanSubtreeList(%p,%d)",
msmd, v->id) ;
fflush(stdout) ;
#endif
MSMD_cleanSubtreeList(msmd, v, info) ;
}
/*
------------------------------------------------------
clean the edge lists of the vertices in the reach list
------------------------------------------------------
*/
for ( k = 0 ; k < nreach ; k++ ) {
v = msmd->vertices + reach[k] ;
#if MYDEBUG > 1
fprintf(stdout, "\n calling MSMD_cleanEdgeList(%p,%d)",
msmd, v->id) ;
fflush(stdout) ;
#endif
MSMD_cleanEdgeList(msmd, v, info) ;
}
if ( info->msglvl > 3 ) {
for ( k = 0 ; k < nreach ; k++ ) {
v = msmd->vertices + reach[k] ;
MSMDvtx_print(v, info->msgFile) ;
}
}
return ; }
/*
-------------------------------------------------------------
purpose --- to compute a matrix-vector multiply y[] = C * x[]
where C is the identity, A or B (depending on *pprbtype).
*pnrows -- # of rows in x[]
*pncols -- # of columns in x[]
*pprbtype -- problem type
*pprbtype = 1 --> vibration problem, matrix is A
*pprbtype = 2 --> buckling problem, matrix is B
*pprbtype = 3 --> matrix is identity, y[] = x[]
x[] -- vector to be multiplied
NOTE: the x[] vector is global, not a portion
y[] -- product vector
NOTE: the y[] vector is global, not a portion
created -- 98aug28, cca & jcp
-------------------------------------------------------------
*/
void
JimMatMulMPI (
int *pnrows,
int *pncols,
double x[],
double y[],
int *pprbtype,
void *data
) {
BridgeMPI *bridge = (BridgeMPI *) data ;
int ncols, nent, nrows ;
#if MYDEBUG > 0
double t1, t2 ;
count_JimMatMul++ ;
MARKTIME(t1) ;
if ( bridge->myid == 0 ) {
fprintf(stdout, "\n (%d) JimMatMulMPI() start", count_JimMatMul) ;
fflush(stdout) ;
}
#endif
#if MYDEBUG > 1
fprintf(bridge->msgFile,
"\n (%d) JimMatMulMPI() start", count_JimMatMul) ;
fflush(bridge->msgFile) ;
#endif
nrows = *pnrows ;
ncols = *pncols ;
nent = nrows*ncols ;
if ( *pprbtype == 3 ) {
/*
--------------------------
... matrix is the identity
--------------------------
*/
DVcopy(nent, y, x) ;
} else {
BridgeMPI *bridge = (BridgeMPI *) data ;
DenseMtx *mtx, *newmtx ;
int irow, jcol, jj, kk, myid, neqns, nowned, tag = 0 ;
int *vtxmap ;
int stats[4] ;
IV *mapIV ;
/*
---------------------------------------------
slide the owned rows of x[] down in the array
---------------------------------------------
*/
vtxmap = IV_entries(bridge->vtxmapIV) ;
neqns = bridge->neqns ;
myid = bridge->myid ;
nowned = IV_size(bridge->myownedIV) ;
for ( jcol = jj = kk = 0 ; jcol < ncols ; jcol++ ) {
for ( irow = 0 ; irow < neqns ; irow++, jj++ ) {
if ( vtxmap[irow] == myid ) {
y[kk++] = x[jj] ;
}
}
}
if ( kk != nowned * ncols ) {
fprintf(stderr, "\n proc %d : kk %d, nowned %d, ncols %d",
myid, kk, nowned, ncols) ;
exit(-1) ;
}
/*
----------------------------------------
call the method that assumes local input
----------------------------------------
*/
if ( bridge->msglvl > 2 ) {
fprintf(bridge->msgFile,
"\n inside JimMatMulMPI, calling MatMulMpi"
"\n prbtype %d, nrows %d, ncols %d, nowned %d",
*pprbtype, *pnrows, *pncols, nowned) ;
fflush(bridge->msgFile) ;
}
MatMulMPI(&nowned, pncols, y, y, pprbtype, data) ;
/*
-------------------------------------------------
gather all the entries of y[] onto processor zero
-------------------------------------------------
*/
mtx = DenseMtx_new() ;
DenseMtx_init(mtx, SPOOLES_REAL, 0, 0, nowned, ncols, 1, nowned) ;
DVcopy (nowned*ncols, DenseMtx_entries(mtx), y) ;
IVcopy(nowned, mtx->rowind, IV_entries(bridge->myownedIV)) ;
mapIV = IV_new() ;
IV_init(mapIV, neqns, NULL) ;
IV_fill(mapIV, 0) ;
IVfill(4, stats, 0) ;
if ( bridge->msglvl > 2 ) {
fprintf(bridge->msgFile, "\n mtx: %d rows x %d columns",
mtx->nrow, mtx->ncol) ;
fflush(bridge->msgFile) ;
}
newmtx = DenseMtx_MPI_splitByRows(mtx, mapIV, stats, bridge->msglvl,
bridge->msgFile, tag, bridge->comm) ;
if ( bridge->msglvl > 2 ) {
fprintf(bridge->msgFile, "\n newmtx: %d rows x %d columns",
newmtx->nrow, newmtx->ncol) ;
fflush(bridge->msgFile) ;
}
DenseMtx_free(mtx) ;
mtx = newmtx ;
IV_free(mapIV) ;
if ( myid == 0 ) {
if ( mtx->nrow != neqns || mtx->ncol != ncols ) {
fprintf(bridge->msgFile,
"\n\n WHOA: mtx->nrows %d, mtx->ncols %d"
", neqns %d, ncols %d", mtx->nrow, mtx->ncol,
neqns, ncols) ;
exit(-1) ;
}
DVcopy(neqns*ncols, y, DenseMtx_entries(mtx)) ;
}
DenseMtx_free(mtx) ;
/*
---------------------------------------------
broadcast the entries to the other processors
---------------------------------------------
*/
MPI_Bcast((void *) y, neqns*ncols, MPI_DOUBLE, 0, bridge->comm) ;
if ( bridge->msglvl > 2 ) {
fprintf(bridge->msgFile, "\n after the broadcast") ;
fflush(bridge->msgFile) ;
}
}
MPI_Barrier(bridge->comm) ;
#if MYDEBUG > 0
MARKTIME(t2) ;
time_JimMatMul += t2 - t1 ;
if ( bridge->myid == 0 ) {
fprintf(stdout, "\n (%d) JimMatMulMPI() end", count_JimMatMul) ;
fprintf(stdout, ", %8.3f seconds, %8.3f total time",
t2 - t1, time_JimMatMul) ;
fflush(stdout) ;
}
#endif
#if MYDEBUG > 1
fprintf(bridge->msgFile,
"\n (%d) JimMatMulMPI() end", count_JimMatMul) ;
fprintf(bridge->msgFile, ", %8.3f seconds, %8.3f total time",
t2 - t1, time_JimMatMul) ;
fflush(bridge->msgFile) ;
#endif
return ; }
/*
-----------------------------------------------------------------
compress a tree based on a map from old vertices to new vertices.
the restriction on the map is that the set {u | map[u] = U} must
be connected for all U.
created -- 95nov15, cca
modified -- 96jan04, cca
bug fixed, N computed incorrectly
modified -- 96jun23, cca
in calling sequence, int map[] converted to IV *mapIV
-----------------------------------------------------------------
*/
Tree *
Tree_compress (
Tree *tree,
IV *mapIV
) {
int n, N, u, U, v, V ;
int *head, *link, *map ;
Tree *tree2 ;
/*
---------------
check the input
---------------
*/
if ( tree == NULL
|| (n = tree->n) <= 0
|| mapIV == NULL
|| n != IV_size(mapIV)
|| (map = IV_entries(mapIV)) == NULL ) {
fprintf(stderr, "\n fatal error in Tree_compress(%p,%p)"
"\n bad input\n", tree, mapIV) ;
exit(-1) ;
}
/*
-----------------------
initialize the new tree
-----------------------
*/
N = 1 + IV_max(mapIV) ;
tree2 = Tree_new() ;
Tree_init1(tree2, N) ;
/*
-----------------------------------------------------------
get the head/link construct to map old nodes into new nodes
-----------------------------------------------------------
*/
head = IVinit(N, -1) ;
link = IVinit(n, -1) ;
for ( v = 0 ; v < n ; v++ ) {
if ( (V = map[v]) < 0 || V >= N ) {
fprintf(stderr, "\n fatal error in Tree_compress(%p,%p)"
"\n map[%d] = %d, N = %d\n", tree, map, v, V, N) ;
exit(-1) ;
}
link[v] = head[V] ;
head[V] = v ;
}
/*
---------------------
fill the tree vectors
---------------------
*/
for ( U = 0 ; U < N ; U++ ) {
for ( u = head[U] ; u != -1 ; u = link[u] ) {
if ( (v = tree->par[u]) == -1 ) {
tree2->par[U] = -1 ;
break ;
} else if ( (V = map[v]) != U ) {
tree2->par[U] = V ;
break ;
}
}
}
Tree_setFchSibRoot(tree2) ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(head) ;
IVfree(link) ;
return(tree2) ; }
/*
---------------------------------------------------------------------
eliminate all nodes in a stage
created -- 96feb25, cca
---------------------------------------------------------------------
*/
void
MSMD_eliminateStage (
MSMD *msmd,
MSMDinfo *info
) {
int ierr, ii, jj, iv, nelim, nreach, stage, step ;
int *reach ;
IV *reachIV ;
MSMDvtx *v ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || info == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_eliminateStage(%p,%p)"
"\n bad input\n", msmd, info) ;
exit(-1) ;
}
stage = info->istage ;
/*
-----------------------------------------------
load the reach set with all nodes in this stage
-----------------------------------------------
*/
reachIV = &msmd->reachIV ;
IV_setSize(reachIV, 0) ;
for ( iv = 0, v = msmd->vertices ; iv < msmd->nvtx ; iv++, v++ ) {
if ( v->status != 'I' ) {
if ( v->stage == stage ) {
IV_push(reachIV, v->id) ;
v->status = 'R' ;
} else if ( v->stage > stage || v->stage < 0 ) {
v->status = 'B' ;
}
}
}
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n after loading reach set") ;
IV_fp80(reachIV, info->msgFile, 80, &ierr) ;
fflush(info->msgFile) ;
}
if ( info->seed > 0 ) {
IV_shuffle(reachIV, info->seed) ;
}
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n reach set at stage %d", stage) ;
IV_fp80(reachIV, info->msgFile, 80, &ierr) ;
fflush(info->msgFile) ;
}
/*
------------------------------------
do an initial update of the vertices
------------------------------------
*/
MSMD_update(msmd, info) ;
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n\n after initial update") ;
fflush(info->msgFile) ;
}
IV_setSize(reachIV, 0) ;
/*
-----------
elimination
-----------
*/
step = 0 ;
while ( 1 ) {
if ( info->msglvl > 1 ) {
fprintf(info->msgFile, "\n\n ##### stage %d, elimination step %d",
stage, step) ;
fflush(info->msgFile) ;
}
nelim = MSMD_eliminateStep(msmd, info) ;
if ( nelim == 0 ) {
break ;
}
/*
-----------------------------------------
for each node in the reach set, clean its
subtree list and list of uncovered edges
-----------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n calling MSMD_cleanReachSet()") ;
fprintf(info->msgFile, "\n reach set") ;
IV_fp80(reachIV, info->msgFile, 80, &ierr) ;
fflush(info->msgFile) ;
}
MSMD_cleanReachSet(msmd, info) ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n return from MSMD_cleanReachSet()") ;
fflush(info->msgFile) ;
}
/*
------------------
compress the graph
------------------
*/
MSMD_findInodes(msmd, info) ;
/*
----------------------------------------------
clean the reach set of indistinguishable nodes
and any nodes not on the present stage
----------------------------------------------
*/
nreach = IV_size(reachIV) ;
reach = IV_entries(reachIV) ;
for ( ii = jj = 0 ; ii < nreach ; ii++ ) {
if ( reach[ii] < 0 || reach[ii] >= msmd->nvtx ) {
fprintf(stderr, "\n fatal error in MSMD_eliminateStage()"
"\n reach[%d] = %d", ii, reach[ii]) ;
exit(-1) ;
}
v = msmd->vertices + reach[ii] ;
if ( v->status == 'I' ) {
continue ;
} else if ( v->stage != stage ) {
v->status = 'B' ;
} else {
reach[jj++] = v->id ;
}
}
IV_setSize(reachIV, jj) ;
if ( info->msglvl > 2 ) {
fprintf(info->msgFile,
"\n\n after cleaning reach set, nreach = %d",
IV_size(reachIV)) ;
fprintf(info->msgFile, "\n reach :") ;
IV_fp80(reachIV, info->msgFile, 8, &ierr) ;
fflush(info->msgFile) ;
}
/*
----------------------------------
update the nodes on the reach set
----------------------------------
*/
MSMD_update(msmd, info) ;
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n\n return from update") ;
fflush(info->msgFile) ;
}
IV_setSize(reachIV, 0) ;
/*
------------------------------
increment the elimination step
------------------------------
*/
step++ ;
}
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n stage %d over, %d steps",
stage, step) ;
fflush(info->msgFile) ;
}
/*
--------------------------------------
set the number of steps for this stage
--------------------------------------
*/
info->stageInfo->nstep = step ;
return ; }
/*
-------------------------------------------------------
purpose -- merge the front tree allowing a parent
to absorb all children when that creates
at most maxzeros zero entries inside a front
return --
IV object that has the old front to new front map
created -- 98jan29, cca
-------------------------------------------------------
*/
ETree *
ETree_mergeFrontsAll (
ETree *etree,
int maxzeros,
IV *nzerosIV
) {
ETree *etree2 ;
int cost, J, Jall, K, KandBnd, nfront, nvtx, nnew ;
int *bndwghts, *fch, *map, *nodwghts, *nzeros, *rep, *sib, *temp ;
IV *mapIV ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL || nzerosIV == NULL
|| (nfront = etree->nfront) <= 0
|| (nvtx = etree->nvtx) <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)"
"\n bad input\n", etree, maxzeros, nzerosIV) ;
if ( etree != NULL ) {
fprintf(stderr, "\n nfront = %d, nvtx = %d",
etree->nfront, etree->nvtx) ;
}
spoolesFatal();
}
if ( IV_size(nzerosIV) != nfront ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)"
"\n size(nzerosIV) = %d, nfront = %d\n",
etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ;
spoolesFatal();
}
nzeros = IV_entries(nzerosIV) ;
/*
----------------------
set up working storage
----------------------
*/
tree = etree->tree ;
fch = ETree_fch(etree) ;
sib = ETree_sib(etree) ;
nodwghts = IVinit(nfront, 0) ;
IVcopy(nfront, nodwghts, ETree_nodwghts(etree)) ;
bndwghts = ETree_bndwghts(etree) ;
rep = IVinit(nfront, -1) ;
IVramp(nfront, rep, 0, 1) ;
/*
------------------------------------------
perform a post-order traversal of the tree
------------------------------------------
*/
for ( K = Tree_postOTfirst(tree) ;
K != -1 ;
K = Tree_postOTnext(tree, K) ) {
#if MYDEBUG > 0
fprintf(stdout, "\n\n ##### visiting front %d", K) ;
fflush(stdout) ;
#endif
if ( (J = fch[K]) != -1 ) {
KandBnd = nodwghts[K] + bndwghts[K] ;
Jall = 0 ;
cost = 2*nzeros[K] ;
for ( J = fch[K] ; J != -1 ; J = sib[J] ) {
Jall += nodwghts[J] ;
cost -= nodwghts[J]*nodwghts[J] ;
cost += 2*nodwghts[J]*(KandBnd - bndwghts[J]) ;
cost += 2*nzeros[J] ;
}
cost += Jall*Jall ;
cost = cost/2 ;
#if MYDEBUG > 0
fprintf(stdout, "\n cost = %d", cost) ;
fflush(stdout) ;
#endif
if ( cost <= maxzeros ) {
for ( J = fch[K] ; J != -1 ; J = sib[J] ) {
#if MYDEBUG > 0
fprintf(stdout, "\n merging %d into %d", J, K) ;
fflush(stdout) ;
#endif
rep[J] = K ;
nodwghts[K] += nodwghts[J] ;
}
nzeros[K] = cost ;
}
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n whoa, finished") ;
fflush(stdout) ;
#endif
/*
-------------------------------------------------
take the map from fronts to representative fronts
and make the map from old fronts to new fronts
-------------------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map = IV_entries(mapIV) ;
for ( J = 0, nnew = 0 ; J < nfront ; J++ ) {
if ( rep[J] == J ) {
map[J] = nnew++ ;
} else {
K = J ;
while ( rep[K] != K ) {
K = rep[K] ;
}
rep[J] = K ;
}
}
for ( J = 0 ; J < nfront ; J++ ) {
if ( (K = rep[J]) != J ) {
map[J] = map[K] ;
}
}
/*
-------------------------------
get the compressed ETree object
-------------------------------
*/
etree2 = ETree_compress(etree, mapIV) ;
/*
-------------------------
remap the nzeros[] vector
-------------------------
*/
temp = IVinit(nfront, 0) ;
IVcopy(nfront, temp, nzeros) ;
IV_setSize(nzerosIV, nnew) ;
nzeros = IV_entries(nzerosIV) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( rep[J] == J ) {
nzeros[map[J]] = temp[J] ;
}
}
IVfree(temp) ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(nodwghts) ;
IVfree(rep) ;
IV_free(mapIV) ;
return(etree2) ; }
/*
------------------------------------------------------------------
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 ; }
/*
--------------------------------------------------------------
identify the wide separator
return -- IV object that holds the nodes in the wide separator
created -- 96oct21, cca
--------------------------------------------------------------
*/
IV *
GPart_identifyWideSep (
GPart *gpart,
int nlevel1,
int nlevel2
) {
FILE *msgFile ;
Graph *g ;
int count, first, ierr, ii, ilevel, last, msglvl,
nfirst, now, nsecond, nsep, nvtx, v, vsize, w ;
int *compids, *list, *mark, *vadj ;
IV *sepIV ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || (g = gpart->g) == NULL
|| nlevel1 < 0 || nlevel2 < 0 ) {
fprintf(stderr, "\n fatal error in GPart_identifyWideSep(%p,%d,%d)"
"\n bad input\n", gpart, nlevel1, nlevel2) ;
exit(-1) ;
}
g = gpart->g ;
compids = IV_entries(&gpart->compidsIV) ;
nvtx = g->nvtx ;
mark = IVinit(nvtx, -1) ;
list = IVinit(nvtx, -1) ;
msglvl = gpart->msglvl ;
msgFile = gpart->msgFile ;
/*
--------------------------------------
load the separator nodes into the list
--------------------------------------
*/
nsep = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] == 0 ) {
list[nsep++] = v ;
mark[v] = 0 ;
}
}
count = nsep ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n GPart_identifyWideSep : %d separator nodes loaded",
count) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
IVfp80(msgFile, nsep, list, 80, &ierr) ;
fflush(msgFile) ;
}
/*
----------------------------------------------
loop over the number of levels out that form
the wide separator towards the first component
----------------------------------------------
*/
if ( nlevel1 >= 1 ) {
first = count ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", 1, first) ;
fflush(msgFile) ;
}
for ( now = 0 ; now < nsep ; now++ ) {
v = list[now] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 1 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
list[count++] = w ;
mark[w] = 1 ;
}
}
}
now = first ;
for ( ilevel = 2 ; ilevel <= nlevel1 ; ilevel++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", ilevel, first);
fflush(msgFile) ;
}
last = count - 1 ;
while ( now <= last ) {
v = list[now++] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 1 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
mark[w] = 1 ;
list[count++] = w ;
}
}
}
}
}
nfirst = count - nsep ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n %d nodes added from the first component", nfirst) ;
fflush(msgFile) ;
}
if ( msglvl > 3 ) {
IVfp80(msgFile, nfirst, &list[nsep], 80, &ierr) ;
fflush(msgFile) ;
}
/*
----------------------------------------------
loop over the number of levels out that form
the wide separator towards the second component
----------------------------------------------
*/
if ( nlevel2 >= 1 ) {
first = count ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", 1, first) ;
fflush(msgFile) ;
}
for ( now = 0 ; now < nsep ; now++ ) {
v = list[now] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 2 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
list[count++] = w ;
mark[w] = 2 ;
}
}
}
now = first ;
for ( ilevel = 2 ; ilevel <= nlevel2 ; ilevel++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", ilevel, first);
fflush(msgFile) ;
}
last = count - 1 ;
while ( now <= last ) {
v = list[now++] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 2 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
mark[w] = 2 ;
list[count++] = w ;
}
}
}
}
}
nsecond = count - nsep - nfirst ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d nodes added from the second component",
nsecond) ;
fflush(msgFile) ;
}
if ( msglvl > 3 ) {
IVfp80(msgFile, nsecond, &list[nsep + nfirst], 80, &ierr) ;
fflush(msgFile) ;
}
IVqsortUp(count, list) ;
/*
--------------------
create the IV object
--------------------
*/
sepIV = IV_new() ;
IV_init(sepIV, count, NULL) ;
IVcopy(count, IV_entries(sepIV), list) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n separator has %d nodes", IV_size(sepIV)) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n sepIV") ;
IV_writeForHumanEye(sepIV, msgFile) ;
fflush(msgFile) ;
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(mark) ;
IVfree(list) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n return from GPart_identifyWideSep") ;
fflush(msgFile) ;
}
return(sepIV) ; }
/*
--------------------------------------------------------------------
purpose -- to fill submtx with a submatrix of the front matrix.
the fronts that form the submatrix are found in frontidsIV.
all information in submtx is local, front #'s are from 0 to
one less than the number of fronts in the submatrix, equation
#'s are from 0 to one less than the number of rows and columns
in the submatrix. the global row and column ids for the submatrix
are stored in rowsIV and colsIV on return.
return values ---
1 -- normal return
-1 -- submtx is NULL
-2 -- frontmtx is NULL
-3 -- frontmtx is not in 2-D mode
-4 -- frontidsIV is NULL
-5 -- frontidsIV is invalid
-6 -- rowsIV is NULL
-7 -- colsIV is NULL
-8 -- unable to create front tree
-9 -- unable to create symbfacIVL
-10 -- unable to create coladjIVL
-11 -- unable to create rowadjIVL
-12 -- unable to create upperblockIVL
-13 -- unable to create lowerblockIVL
created -- 98oct17, cca
--------------------------------------------------------------------
*/
int
FrontMtx_initFromSubmatrix (
FrontMtx *submtx,
FrontMtx *frontmtx,
IV *frontidsIV,
IV *rowsIV,
IV *colsIV,
int msglvl,
FILE *msgFile
) {
ETree *etreeSub ;
int ii, J, Jsub, K, Ksub, ncol, nfront, nfrontSub, neqnSub, nJ,
nrow, offset, rc, size, vSub ;
int *bndwghts, *colind, *colmap, *cols, *frontSubIds,
*list, *nodwghts, *rowind, *rowmap, *rows ;
IV *frontsizesIVsub, *vtxIV ;
IVL *coladjIVLsub, *lowerblockIVLsub, *rowadjIVLsub,
*symbfacIVLsub, *upperblockIVLsub ;
SubMtx *mtx ;
/*
---------------
check the input
---------------
*/
if ( submtx == NULL ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n submtx is NULL\n") ;
return(-1) ;
}
if ( frontmtx == NULL ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n frontmtx is NULL\n") ;
return(-2) ;
}
if ( ! FRONTMTX_IS_2D_MODE(frontmtx) ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n frontmtx mode is not 2D\n") ;
return(-3) ;
}
if ( frontidsIV == NULL ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n frontidsIV is NULL\n") ;
return(-4) ;
}
nfront = FrontMtx_nfront(frontmtx) ;
IV_sizeAndEntries(frontidsIV, &nfrontSub, &frontSubIds) ;
if ( nfrontSub < 0 || nfrontSub > nfront ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n invalid frontidsIV"
"\n nfrontSub = %d, nfront %d\n", nfrontSub, nfront) ;
return(-5) ;
}
for ( ii = 0 ; ii < nfrontSub ; ii++ ) {
if ( (J = frontSubIds[ii]) < 0 || J >= nfront ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n invalid frontidsIV"
"\n frontSubIds[%d] = %d, nfront = %d\n",
ii, J, nfront) ;
return(-5) ;
}
}
if ( rowsIV == NULL ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n rowsIV is NULL\n") ;
return(-6) ;
}
if ( colsIV == NULL ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n colsIV is NULL\n") ;
return(-7) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------------
clear the data for the submatrix and set the
scalar values (some inherited from the global matrix)
-----------------------------------------------------
*/
FrontMtx_clearData(submtx) ;
submtx->nfront = nfrontSub ;
submtx->type = frontmtx->type ;
submtx->symmetryflag = frontmtx->symmetryflag ;
submtx->sparsityflag = frontmtx->sparsityflag ;
submtx->pivotingflag = frontmtx->pivotingflag ;
submtx->dataMode = FRONTMTX_2D_MODE ;
/*
---------------------------------------------------------------
initialize the front tree for the submatrix.
note: on return, vtxIV is filled with the vertices originally
in the submatrix, (pivoting may change this), needed to find
symbolic factorization IVL object
note: at return, the boundary weights are likely to be invalid,
since we have no way of knowing what boundary indices for a
front are really in the domain. this will be changed after we
have the symbolic factorization.
---------------------------------------------------------------
*/
etreeSub = submtx->frontETree = ETree_new() ;
vtxIV = IV_new() ;
rc = ETree_initFromSubtree(etreeSub, frontidsIV,
frontmtx->frontETree, vtxIV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n unable to create submatrix's front ETree, rc = %d\n", rc) ;
return(-8) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n submatrix ETree") ;
ETree_writeForHumanEye(etreeSub, msgFile) ;
fprintf(msgFile, "\n\n submatrix original equations") ;
IV_writeForHumanEye(vtxIV, msgFile) ;
fflush(msgFile) ;
}
/*
------------------------------------------------------
set the # of equations (perhap temporarily if pivoting
has delayed some rows and columns), and the tree.
------------------------------------------------------
*/
submtx->neqns = neqnSub = IV_size(vtxIV) ;
submtx->tree = etreeSub->tree ;
/*
-----------------------------------------------------
initialize the symbolic factorization for the subtree
-----------------------------------------------------
*/
symbfacIVLsub = submtx->symbfacIVL = IVL_new() ;
rc = IVL_initFromSubIVL(symbfacIVLsub, frontmtx->symbfacIVL,
frontidsIV, vtxIV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n unable to create submatrix's symbfac, rc = %d\n", rc) ;
return(-9) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n submatrix symbolic factorizatio") ;
IVL_writeForHumanEye(symbfacIVLsub, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------------------------
adjust the boundary weights of the front tree
---------------------------------------------
*/
nodwghts = ETree_nodwghts(etreeSub) ;
bndwghts = ETree_bndwghts(etreeSub) ;
for ( J = 0 ; J < nfrontSub ; J++ ) {
IVL_listAndSize(symbfacIVLsub, J, &size, &list) ;
bndwghts[J] = size - nodwghts[J] ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n submatrix ETree after bndweight adjustment") ;
ETree_writeForHumanEye(etreeSub, msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------
set the front sizes for the submatrix
-------------------------------------
*/
frontsizesIVsub = submtx->frontsizesIV = IV_new() ;
IV_init(frontsizesIVsub, nfrontSub, NULL) ;
IVgather(nfrontSub, IV_entries(frontsizesIVsub),
IV_entries(frontmtx->frontsizesIV),
IV_entries(frontidsIV)) ;
neqnSub = submtx->neqns = IV_sum(frontsizesIVsub) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n %d equations in submatrix", neqnSub) ;
fprintf(msgFile, "\n\n front sizes for submatrix") ;
IV_writeForHumanEye(frontsizesIVsub, msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------------------------
fill rowsIV and colsIV with the row and column ids of the submatrix
-------------------------------------------------------------------
*/
IV_setSize(rowsIV, neqnSub) ;
IV_setSize(colsIV, neqnSub) ;
rows = IV_entries(rowsIV) ;
cols = IV_entries(colsIV) ;
for ( Jsub = offset = 0 ; Jsub < nfrontSub ; Jsub++ ) {
if ( (nJ = FrontMtx_frontSize(submtx, Jsub)) > 0 ) {
J = frontSubIds[Jsub] ;
FrontMtx_columnIndices(frontmtx, J, &size, &list) ;
IVcopy(nJ, cols + offset, list) ;
FrontMtx_rowIndices(frontmtx, J, &size, &list) ;
IVcopy(nJ, rows + offset, list) ;
offset += nJ ;
}
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n row ids for submatrix") ;
IV_writeForHumanEye(rowsIV, msgFile) ;
fprintf(msgFile, "\n\n column ids for submatrix") ;
IV_writeForHumanEye(colsIV, msgFile) ;
fflush(msgFile) ;
}
/*
----------------------------------
get the row and column adjacencies
----------------------------------
*/
if ( FRONTMTX_IS_PIVOTING(frontmtx) ) {
submtx->neqns = neqnSub ;
coladjIVLsub = submtx->coladjIVL = IVL_new() ;
rc = IVL_initFromSubIVL(coladjIVLsub, frontmtx->coladjIVL,
frontidsIV, colsIV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n unable to create submatrix's coladjIVL, rc = %d\n", rc) ;
return(-10) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n submatrix col adjacency") ;
IVL_writeForHumanEye(coladjIVLsub, msgFile) ;
fflush(msgFile) ;
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
rowadjIVLsub = submtx->rowadjIVL = IVL_new() ;
rc = IVL_initFromSubIVL(rowadjIVLsub, frontmtx->rowadjIVL,
frontidsIV, rowsIV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n unable to create submatrix's rowadjIVL, rc = %d\n", rc) ;
return(-11) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n submatrix row adjacency") ;
IVL_writeForHumanEye(rowadjIVLsub, msgFile) ;
fflush(msgFile) ;
}
}
}
IV_free(vtxIV) ;
/*
----------------------------------------------
get the rowmap[] and colmap[] vectors,
needed to translate indices in the submatrices
----------------------------------------------
*/
colmap = IVinit(frontmtx->neqns, -1) ;
for ( ii = 0 ; ii < neqnSub ; ii++ ) {
colmap[cols[ii]] = ii ;
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
rowmap = IVinit(frontmtx->neqns, -1) ;
for ( ii = 0 ; ii < neqnSub ; ii++ ) {
rowmap[rows[ii]] = ii ;
}
} else {
rowmap = colmap ;
}
/*
-----------------------------------------------------------
get the upper and lower block IVL objects for the submatrix
-----------------------------------------------------------
*/
upperblockIVLsub = submtx->upperblockIVL = IVL_new() ;
rc = IVL_initFromSubIVL(upperblockIVLsub, frontmtx->upperblockIVL,
frontidsIV, frontidsIV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n unable to create upperblockIVL, rc = %d\n", rc) ;
return(-12) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n upper block adjacency IVL object") ;
IVL_writeForHumanEye(upperblockIVLsub, msgFile) ;
fflush(msgFile) ;
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
lowerblockIVLsub = submtx->lowerblockIVL = IVL_new() ;
rc = IVL_initFromSubIVL(lowerblockIVLsub, frontmtx->lowerblockIVL,
frontidsIV, frontidsIV) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()"
"\n unable to create lowerblockIVL, rc = %d\n", rc) ;
return(-13) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n lower block adjacency IVL object") ;
IVL_writeForHumanEye(lowerblockIVLsub, msgFile) ;
fflush(msgFile) ;
}
}
/*
----------------------------------------------------------------
allocate the vector and hash table(s) for the factor submatrices
----------------------------------------------------------------
*/
ALLOCATE(submtx->p_mtxDJJ, struct _SubMtx *, nfrontSub) ;
for ( J = 0 ; J < nfrontSub ; J++ ) {
submtx->p_mtxDJJ[J] = NULL ;
}
submtx->upperhash = I2Ohash_new() ;
I2Ohash_init(submtx->upperhash, nfrontSub, nfrontSub, nfrontSub) ;
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
submtx->lowerhash = I2Ohash_new() ;
I2Ohash_init(submtx->lowerhash, nfrontSub, nfrontSub, nfrontSub) ;
}
/*
-----------------------------------------------------------------
remove the diagonal submatrices from the factor matrix
and insert into the submatrix object. note: front row and column
ids must be changed to their local values, and the row and column
indices must be mapped to local indices.
-----------------------------------------------------------------
*/
for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) {
J = frontSubIds[Jsub] ;
if ( (mtx = frontmtx->p_mtxDJJ[J]) != NULL ) {
SubMtx_setIds(mtx, Jsub, Jsub) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVgather(ncol, colind, colmap, colind) ;
SubMtx_rowIndices(mtx, &nrow, &rowind) ;
IVgather(nrow, rowind, rowmap, rowind) ;
submtx->p_mtxDJJ[Jsub] = mtx ;
frontmtx->p_mtxDJJ[J] = NULL ;
submtx->nentD += mtx->nent ;
}
}
/*
----------------------------------------------------------------
remove the upper triangular submatrices from the factor matrix
and insert into the submatrix object. note: front row and column
ids must be changed to their local values. if the matrix is on
the diagonal, i.e., U(J,J), its row and column indices must be
mapped to local indices.
----------------------------------------------------------------
*/
for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) {
J = frontSubIds[Jsub] ;
FrontMtx_upperAdjFronts(submtx, Jsub, &size, &list) ;
for ( ii = 0 ; ii < size ; ii++ ) {
Ksub = list[ii] ;
K = frontSubIds[Ksub] ;
if ( 1 == I2Ohash_remove(frontmtx->upperhash,
J, K, (void *) &mtx) ) {
SubMtx_setIds(mtx, Jsub, Ksub) ;
if ( K == J ) {
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVgather(ncol, colind, colmap, colind) ;
SubMtx_rowIndices(mtx, &nrow, &rowind) ;
IVgather(nrow, rowind, rowmap, rowind) ;
}
I2Ohash_insert(submtx->upperhash, Jsub, Ksub, (void *) mtx) ;
submtx->nentU += mtx->nent ;
}
}
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
/*
----------------------------------------------------------------
remove the lower triangular submatrices from the factor matrix
and insert into the submatrix object. note: front row and column
ids must be changed to their local values. if the matrix is on
the diagonal, i.e., L(J,J), its row and column indices must be
mapped to local indices.
----------------------------------------------------------------
*/
for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) {
J = frontSubIds[Jsub] ;
FrontMtx_lowerAdjFronts(submtx, Jsub, &size, &list) ;
for ( ii = 0 ; ii < size ; ii++ ) {
Ksub = list[ii] ;
K = frontSubIds[Ksub] ;
if ( 1 == I2Ohash_remove(frontmtx->lowerhash,
K, J, (void *) &mtx) ) {
SubMtx_setIds(mtx, Ksub, Jsub) ;
if ( K == J ) {
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVgather(ncol, colind, colmap, colind) ;
SubMtx_rowIndices(mtx, &nrow, &rowind) ;
IVgather(nrow, rowind, rowmap, rowind) ;
}
I2Ohash_insert(submtx->lowerhash, Ksub, Jsub, (void *) mtx);
submtx->nentL += mtx->nent ;
}
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(colmap) ;
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
IVfree(rowmap) ;
}
return(1) ; }
/*
------------------------------------------------------------------
purpose -- to initialize the semi-implicit matrix using as input a
FrontMtx and a map from fronts to domains (map[J] != 0)
or the schur complement (map[J] = 0)
return value --
1 -- normal return
-1 -- semimtx is NULL
-2 -- frontmtx is NULL
-3 -- inpmtx is NULL
-4 -- frontmapIV is NULL
-5 -- frontmapIV is invalid
-6 -- unable to create domains' front matrix
-7 -- unable to create schur complement front matrix
created -- 98oct17, cca
------------------------------------------------------------------
*/
int
SemiImplMtx_initFromFrontMtx (
SemiImplMtx *semimtx,
FrontMtx *frontmtx,
InpMtx *inpmtx,
IV *frontmapIV,
int msglvl,
FILE *msgFile
) {
FrontMtx *domMtx, *schurMtx ;
InpMtx *A12, *A21 ;
int ii, J, ncol, nfront, nrow, rc, size ;
int *cols, *frontmap, *rows ;
IV *domColsIV, *domidsIV, *domRowsIV,
*schurColsIV, *schuridsIV, *schurRowsIV ;
/*
--------------
check the data
--------------
*/
if ( semimtx == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n semimtx is NULL\n") ;
return(-1) ;
}
if ( frontmtx == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n frontmtx is NULL\n") ;
return(-2) ;
}
if ( inpmtx == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n inpmtx is NULL\n") ;
return(-3) ;
}
if ( frontmapIV == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n frontmapIV is NULL\n") ;
return(-4) ;
}
nfront = FrontMtx_nfront(frontmtx) ;
IV_sizeAndEntries(frontmapIV, &size, &frontmap) ;
if ( nfront != size ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n nfront %d, size of front map %d\n", nfront, size) ;
return(-5) ;
}
domidsIV = IV_new() ;
schuridsIV = IV_new() ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( frontmap[J] == 0 ) {
IV_push(schuridsIV, J) ;
} else if ( frontmap[J] > 0 ) {
IV_push(domidsIV, J) ;
} else {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n frontmap[%d] = %d, invalid\n", J, frontmap[J]) ;
IV_free(domidsIV) ;
IV_free(schuridsIV) ;
return(-5) ;
}
}
/*
-----------------------------------------------------------
clear the data for the semi-implicit matrix and set scalars
-----------------------------------------------------------
*/
SemiImplMtx_clearData(semimtx) ;
semimtx->neqns = frontmtx->neqns ;
semimtx->type = frontmtx->type ;
semimtx->symmetryflag = frontmtx->symmetryflag ;
/*
----------------------------------------------
get the front matrix that contains the domains
----------------------------------------------
*/
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n working on domain front matrix") ;
fflush(msgFile) ;
}
domMtx = semimtx->domainMtx = FrontMtx_new() ;
domRowsIV = semimtx->domRowsIV = IV_new() ;
domColsIV = semimtx->domColsIV = IV_new() ;
rc = FrontMtx_initFromSubmatrix(domMtx, frontmtx, domidsIV,
domRowsIV, domColsIV, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to initialize the domains' front matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
semimtx->ndomeqns = IV_size(domRowsIV) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n---------------------------------------- ") ;
fprintf(msgFile, "\n\n submatrix for domains") ;
FrontMtx_writeForHumanEye(domMtx, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
FrontMtx_writeForMatlab(domMtx, "L11", "D11", "U11", msgFile) ;
IV_writeForMatlab(domRowsIV, "domrows", msgFile) ;
IV_writeForMatlab(domColsIV, "domcols", msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------------
get the front matrix that contains the schur complement
-------------------------------------------------------
*/
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n working on domain front matrix") ;
fflush(msgFile) ;
}
schurMtx = semimtx->schurMtx = FrontMtx_new() ;
schurRowsIV = semimtx->schurRowsIV = IV_new() ;
schurColsIV = semimtx->schurColsIV = IV_new() ;
rc = FrontMtx_initFromSubmatrix(schurMtx, frontmtx, schuridsIV,
schurRowsIV, schurColsIV, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to initialize the schur complement front matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
semimtx->nschureqns = IV_size(schurRowsIV) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n---------------------------------------- ") ;
fprintf(msgFile, "\n\n submatrix for schur complement") ;
FrontMtx_writeForHumanEye(schurMtx, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
FrontMtx_writeForMatlab(schurMtx, "L22", "D22", "U22", msgFile) ;
IV_writeForMatlab(schurRowsIV, "schurrows", msgFile) ;
IV_writeForMatlab(schurColsIV, "schurcols", msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------
get the A12 InpMtx object
-------------------------
*/
A12 = semimtx->A12 = InpMtx_new() ;
rc = InpMtx_initFromSubmatrix(A12, inpmtx, domRowsIV, schurColsIV,
semimtx->symmetryflag, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to create A21 matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
InpMtx_changeCoordType(A12, INPMTX_BY_ROWS) ;
InpMtx_changeStorageMode(A12, INPMTX_BY_VECTORS) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n---------------------------------------- ") ;
fprintf(msgFile, "\n\n domRowsIV ") ;
IV_writeForHumanEye(domRowsIV, msgFile) ;
fprintf(msgFile, "\n\n schurColsIV ") ;
IV_writeForHumanEye(schurColsIV, msgFile) ;
fprintf(msgFile, "\n\n A12 matrix") ;
InpMtx_writeForHumanEye(A12, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n A12 = zeros(%d,%d) ;",
IV_size(domRowsIV), IV_size(schurColsIV)) ;
InpMtx_writeForMatlab(A12, "A12", msgFile) ;
fflush(msgFile) ;
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
/*
-------------------------
get the A21 InpMtx object
-------------------------
*/
A21 = semimtx->A21 = InpMtx_new() ;
rc = InpMtx_initFromSubmatrix(A21, inpmtx, schurRowsIV, domColsIV,
semimtx->symmetryflag, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to create A21 matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
InpMtx_changeCoordType(A21, INPMTX_BY_COLUMNS) ;
InpMtx_changeStorageMode(A21, INPMTX_BY_VECTORS) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n--------------------------------------- ") ;
fprintf(msgFile, "\n\n schurRowsIV ") ;
IV_writeForHumanEye(schurRowsIV, msgFile) ;
fprintf(msgFile, "\n\n domColsIV ") ;
IV_writeForHumanEye(domColsIV, msgFile) ;
fprintf(msgFile, "\n\n A21 matrix") ;
InpMtx_writeForHumanEye(A21, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n A21 = zeros(%d,%d) ;",
IV_size(schurRowsIV), IV_size(domColsIV)) ;
InpMtx_writeForMatlab(A21, "A21", msgFile) ;
fflush(msgFile) ;
}
}
/*
------------------------
free the working storage
------------------------
*/
IV_free(domidsIV) ;
IV_free(schuridsIV) ;
return(1) ; }
/*
--------------------------------------------------------------------
purpose -- merge the front tree allowing at most
maxzeros zero entries inside a front
return --
IV object that has the old front to new front map
created -- 96jun23, cca
modified -- 97dec18, cca
bug fixed that incorrectly counted the number of zeros in a front
--------------------------------------------------------------------
*/
ETree *
ETree_mergeFrontsAny (
ETree *etree,
int maxzeros,
IV *nzerosIV
) {
ETree *etree2 ;
int J, K, nfront, nvtx, nnew ;
int *bndwghts, *cost, *fch, *map, *nodwghts,
*nzeros, *par, *place, *rep, *sib, *temp ;
IV *mapIV ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL
|| (nfront = etree->nfront) <= 0
|| (nvtx = etree->nvtx) <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d)"
"\n bad input\n", etree, maxzeros) ;
spoolesFatal();
}
if ( IV_size(nzerosIV) != nfront ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d,%p)"
"\n size(nzerosIV) = %d, nfront = %d\n",
etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ;
spoolesFatal();
}
nzeros = IV_entries(nzerosIV) ;
tree = etree->tree ;
nodwghts = IVinit(nfront, 0) ;
bndwghts = IVinit(nfront, 0) ;
par = IVinit(nfront, -1) ;
fch = IVinit(nfront, -1) ;
sib = IVinit(nfront, -1) ;
IVcopy(nfront, par, tree->par) ;
IVcopy(nfront, fch, tree->fch) ;
IVcopy(nfront, sib, tree->sib) ;
IVcopy(nfront, nodwghts, IV_entries(etree->nodwghtsIV)) ;
IVcopy(nfront, bndwghts, IV_entries(etree->bndwghtsIV)) ;
/*
----------------------
set up working storage
----------------------
*/
rep = IVinit(nfront, -1) ;
IVramp(nfront, rep, 0, 1) ;
cost = IVinit(nfront, 0) ;
/*
------------------------------------------
perform a post-order traversal of the tree
------------------------------------------
*/
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
#if MYDEBUG > 0
fprintf(stdout, "\n\n ##### visiting front %d", J) ;
fflush(stdout) ;
#endif
visitAny(J, par, fch, sib, nodwghts, bndwghts,
rep, cost, nzeros, maxzeros) ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n whoa, finished") ;
fflush(stdout) ;
#endif
/*
-------------------------------------------------
take the map from fronts to representative fronts
and make the map from old fronts to new fronts
-------------------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map = IV_entries(mapIV) ;
place = IVinit(nfront, -1) ;
for ( J = 0, nnew = 0 ; J < nfront ; J++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n rep[%d] = %d", J, rep[J]) ;
fflush(stdout) ;
#endif
if ( rep[J] != J ) {
K = J ;
while ( rep[K] != K ) {
#if MYDEBUG > 0
fprintf(stdout, "\n rep[%d] = %d", K, rep[K]) ;
fflush(stdout) ;
#endif
K = rep[K] ;
}
rep[J] = K ;
#if MYDEBUG > 0
fprintf(stdout, "\n setting rep[%d] = %d", J, rep[J]) ;
fflush(stdout) ;
#endif
} else {
place[J] = nnew++ ;
}
}
for ( J = 0 ; J < nfront ; J++ ) {
K = rep[J] ;
map[J] = place[K] ;
}
/*
-------------------------------
get the compressed ETree object
-------------------------------
*/
etree2 = ETree_compress(etree, mapIV) ;
/*
-------------------------
remap the nzeros[] vector
-------------------------
*/
temp = IVinit(nfront, 0) ;
IVcopy(nfront, temp, nzeros) ;
IV_setSize(nzerosIV, nnew) ;
nzeros = IV_entries(nzerosIV) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( rep[J] == J ) {
nzeros[map[J]] = temp[J] ;
}
}
IVfree(temp) ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(par) ;
IVfree(fch) ;
IVfree(sib) ;
IVfree(nodwghts) ;
IVfree(bndwghts) ;
IVfree(rep) ;
IVfree(cost) ;
IVfree(place) ;
IV_free(mapIV) ;
return(etree2) ; }
/*
----------------------------------------------
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 -- eliminate vertex v
1) create v's boundary list
2) merge boundary list onto reach list
3) for each vertex in the boundary
3.1) add v to the subtree list
created -- 96feb25, cca
-----------------------------------------
*/
void
MSMD_eliminateVtx (
MSMD *msmd,
MSMDvtx *v,
MSMDinfo *info
) {
int i, ierr, j, nadj, nbnd, nedge, uid, wid, wght ;
int *adj, *bnd, *edges ;
IP *ip, *ip2, *prev ;
IV *reachIV ;
MSMDvtx *u, *w ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || v == NULL || info == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_eliminateVtx(%p,%p,%p)"
"\n bad input\n", msmd, v, info) ;
exit(-1) ;
}
adj = IV_entries(&msmd->ivtmpIV) ;
reachIV = &msmd->reachIV ;
/*
-----------------------------
create the boundary set for v
-----------------------------
*/
v->mark = 'X' ;
if ( v->subtrees == NULL ) {
/*
--------------------------------------------------------
v is a leaf, look at its uncovered edge list, move v and
any indistinguishable vertices to the end of the list
--------------------------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n vertex %d is a leaf", v->id) ;
fflush(info->msgFile) ;
}
v->status = 'L' ;
nedge = v->nadj ;
edges = v->adj ;
i = 0 ; j = nedge - 1 ;
while ( i <= j ) {
wid = edges[i] ;
w = msmd->vertices + wid ;
if ( w == v || w->status == 'I' ) {
edges[i] = edges[j] ;
edges[j] = wid ;
j-- ;
} else {
w->mark = 'X' ;
i++ ;
}
}
v->nadj = j + 1 ;
} else {
/*
----------------------------------------------------
v is not a leaf, merge its subtrees' boundaries
with its uncovered edge list to get the new boundary
----------------------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n vertex %d is not a leaf", v->id) ;
fprintf(info->msgFile, "\n vertex %d, subtrees :", v->id) ;
IP_fp80(info->msgFile, v->subtrees, 20) ;
fflush(info->msgFile) ;
}
v->status = 'E' ;
nadj = 0 ;
while ( (ip = v->subtrees) != NULL ) {
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n subtree %d, ip(%p)<%d,%p>",
ip->val, ip, ip->val, ip->next) ;
fflush(info->msgFile) ;
}
uid = ip->val ;
u = msmd->vertices + uid ;
u->par = v ;
nbnd = u->nadj ;
bnd = u->adj ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n bnd of adj subtree %d :", u->id) ;
IVfp80(info->msgFile, nbnd, bnd, 25, &ierr) ;
fflush(info->msgFile) ;
}
for ( i = 0 ; i < nbnd ; i++ ) {
wid = bnd[i] ;
w = msmd->vertices + wid ;
if ( w->mark == 'O' && w->status != 'I' ) {
w->mark = 'X' ;
adj[nadj++] = wid ;
}
}
if ( u->status == 'E' ) {
/*
------------------------------------------
u is not a leaf, free its boundary storage
------------------------------------------
*/
IVfree(u->adj) ;
info->nbytes -= u->nadj * sizeof(int) ;
}
u->adj = NULL ;
u->nadj = 0 ;
/*
--------------------------------------
put this IP structure on the free list
--------------------------------------
*/
v->subtrees = ip->next ;
ip->val = -1 ;
ip->next = msmd->freeIP ;
msmd->freeIP = ip ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile,
"\n v->subtrees = %p, msmd->freeIP = %p",
v->subtrees, msmd->freeIP) ;
fflush(info->msgFile) ;
}
}
/*
------------------------------------------------
merge all uncovered edges into the boundary list
------------------------------------------------
*/
nedge = v->nadj ;
edges = v->adj ;
for ( i = 0 ; i < nedge ; i++ ) {
wid = edges[i] ;
w = msmd->vertices + wid ;
if ( w->mark == 'O' && w->status != 'I' ) {
w->mark = 'X' ;
adj[nadj++] = wid ;
}
}
/*
----------------------------------------------------------
if boundary is not empty, allocate new storage for entries
----------------------------------------------------------
*/
v->nadj = nadj ;
if ( nadj > 0 ) {
v->adj = IVinit(nadj, -1) ;
IVcopy(nadj, v->adj, adj) ;
info->nbytes += nadj*sizeof(int) ;
if ( info->maxnbytes < info->nbytes ) {
info->maxnbytes = info->nbytes ;
}
} else {
v->adj = NULL ;
}
}
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n bnd(%d) :", v->id) ;
if ( v->nadj > 0 ) {
IVfp80(info->msgFile, v->nadj, v->adj, 17, &ierr) ;
}
fflush(info->msgFile) ;
}
/*
----------------------------------------------
for each boundary vertex
1. add v to subtree list
2. put v on reach set if not already there
3. unmark and add weight to boundary weight
----------------------------------------------
*/
nbnd = v->nadj ;
bnd = v->adj ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n %d's bnd :", v->id) ;
IVfp80(info->msgFile, nbnd, bnd, 12, &ierr) ;
fflush(info->msgFile) ;
}
wght = 0 ;
for ( i = 0 ; i < nbnd ; i++ ) {
wid = bnd[i] ;
w = msmd->vertices + wid ;
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n adjacent vertex %d", w->id) ;
fflush(info->msgFile) ;
}
/*
-------------------------------
add v to the subtree list for w
-------------------------------
*/
if ( (ip = msmd->freeIP) == NULL ) {
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n need to get more IP objects") ;
fflush(info->msgFile) ;
}
/*
-------------------------------------------------
no more free IP structures, allocate more storage
-------------------------------------------------
*/
if ( (ip = IP_init(msmd->incrIP, IP_FORWARD)) == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_eliminateVtx%p,%p,%p)"
"\n unable to allocate more IP objects",
msmd, v, info) ;
exit(-1) ;
}
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n old baseIP = %p", msmd->baseIP) ;
fprintf(info->msgFile, "\n new baseIP = %p", ip) ;
fflush(info->msgFile) ;
}
ip->next = msmd->baseIP ;
msmd->baseIP = ip ;
info->nbytes += msmd->incrIP*sizeof(struct _IP) ;
if ( info->maxnbytes < info->nbytes ) {
info->maxnbytes = info->nbytes ;
}
ip = msmd->freeIP = msmd->baseIP + 1 ;
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n all set") ;
fflush(info->msgFile) ;
}
}
msmd->freeIP = ip->next ;
ip->val = v->id ;
ip->next = NULL ;
for ( ip2 = w->subtrees, prev = NULL ;
ip2 != NULL && ip2->val > ip->val ;
ip2 = ip2->next ) {
prev = ip2 ;
}
if ( prev == NULL ) {
w->subtrees = ip ;
} else {
prev->next = ip ;
}
ip->next = ip2 ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n %d's subtrees :", w->id) ;
IP_fp80(info->msgFile, w->subtrees, 15) ;
fflush(info->msgFile) ;
}
/*
--------------------------------
add w to reach list if necessary
--------------------------------
*/
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n status[%d] = %c", wid, w->status) ;
fflush(info->msgFile) ;
}
switch ( w->status ) {
case 'D' :
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, ", remove from heap") ;
fflush(info->msgFile) ;
}
IIheap_remove(msmd->heap, wid) ;
case 'O' :
case 'B' :
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, ", add to reach set, nreach = %d",
IV_size(reachIV) + 1) ;
fflush(info->msgFile) ;
}
IV_push(reachIV, wid) ;
w->status = 'R' ;
case 'R' :
break ;
case 'I' :
break ;
default :
fprintf(stderr, "\n error in MSMD_eliminateVtx(%p,%p,%p)"
"\n status[%d] = '%c'\n",
msmd, v, info, wid, w->status) ;
fprintf(stderr, "\n msmd->nvtx = %d", msmd->nvtx) ;
exit(-1) ;
}
/*
--------------------------------
unmark the boundary vertices and
store the weight of the boundary
--------------------------------
*/
w->mark = 'O' ;
wght += w->wght ;
}
/*
------------------------------------
unmark v and set its boundary weight
------------------------------------
*/
v->mark = 'O' ;
v->bndwght = wght ;
return ; }
/*
------------------------------------------------
given a permutation and a vector to map vertices
into compressed vertices, create and return a
permutation object for the compressed vertices.
created -- 96may02, cca
------------------------------------------------
*/
Perm *
Perm_compress (
Perm *perm,
IV *eqmapIV
) {
int n, N, v, vcomp, vnew ;
int *eqmap, *head, *link, *newToOld, *oldToNew, *vals ;
Perm *perm2 ;
/*
---------------
check the input
---------------
*/
if ( perm == NULL
|| (n = perm->size) <= 0
|| eqmapIV == NULL
|| n != IV_size(eqmapIV)
|| (eqmap = IV_entries(eqmapIV)) == NULL ) {
fprintf(stderr, "\n fatal error in Perm_compress(%p,%p)"
"\n bad input\n", perm, eqmapIV) ;
if ( perm != NULL ) {
Perm_writeStats(perm, stderr) ;
}
if ( eqmapIV != NULL ) {
IV_writeStats(eqmapIV, stderr) ;
}
spoolesFatal();
}
n = perm->size ;
if ( (oldToNew = perm->oldToNew) == NULL ) {
Perm_fillOldToNew(perm) ;
oldToNew = perm->oldToNew ;
}
if ( (newToOld = perm->newToOld) == NULL ) {
Perm_fillNewToOld(perm) ;
newToOld = perm->newToOld ;
}
/*
---------------------------------
create the new permutation object
---------------------------------
*/
N = 1 + IVmax(n, eqmap, &v) ;
perm2 = Perm_new() ;
Perm_initWithTypeAndSize(perm2, 3, N) ;
/*
--------------------------------------------
get the head/link structure for the vertices
--------------------------------------------
*/
head = IVinit(N, -1) ;
link = IVinit(n, -1) ;
for ( v = 0 ; v < n ; v++ ) {
vcomp = eqmap[v] ;
link[v] = head[vcomp] ;
head[vcomp] = v ;
}
/*
---------------------------
get the two vectors to sort
---------------------------
*/
IVramp(N, perm2->newToOld, 0, 1) ;
vals = IVinit(N, -1) ;
for ( vcomp = 0 ; vcomp < N ; vcomp++ ) {
v = head[vcomp] ;
vnew = perm->oldToNew[v] ;
for ( v = link[v] ; v != -1 ; v = link[v] ) {
if ( vnew > perm->oldToNew[v] ) {
vnew = perm->oldToNew[v] ;
}
}
vals[vcomp] = vnew ;
}
IV2qsortUp(N, vals, perm2->newToOld) ;
for ( vcomp = 0 ; vcomp < N ; vcomp++ ) {
perm2->oldToNew[perm2->newToOld[vcomp]] = vcomp ;
}
/*
---------------------
free the working data
---------------------
*/
IVfree(head) ;
IVfree(link) ;
IVfree(vals) ;
return(perm2) ; }
/*
--------------------------------------------------
purpose -- to solve a linear system
(A - sigma*B) sol[] = rhs[]
data -- pointer to bridge data object
*pnrows -- # of rows in x[] and y[]
*pncols -- # of columns in x[] and y[]
rhs[] -- vector that holds right hand sides
NOTE: the rhs[] vector is global, not a portion
sol[] -- vector to hold solutions
NOTE: the sol[] vector is global, not a portion
note: rhs[] and sol[] can be the same array.
on return, *perror holds an error code.
created -- 98aug28, cca & jcp
--------------------------------------------------
*/
void
JimSolveMPI (
int *pnrows,
int *pncols,
double rhs[],
double sol[],
void *data,
int *perror
) {
BridgeMPI *bridge = (BridgeMPI *) data ;
DenseMtx *mtx, *newmtx ;
int irow, jj, jcol, kk, myid, ncols = *pncols,
neqns, nowned, tag = 0 ;
int *vtxmap ;
int stats[4] ;
IV *mapIV ;
#if MYDEBUG > 0
double t1, t2 ;
count_JimSolve++ ;
MARKTIME(t1) ;
if ( bridge->myid == 0 ) {
fprintf(stdout, "\n (%d) JimSolve() start", count_JimSolve) ;
fflush(stdout) ;
}
#endif
#if MYDEBUG > 1
fprintf(bridge->msgFile, "\n (%d) JimSolve() start", count_JimSolve) ;
fflush(bridge->msgFile) ;
#endif
MPI_Barrier(bridge->comm) ;
/*
---------------------------------------------
slide the owned rows of rhs down in the array
---------------------------------------------
*/
vtxmap = IV_entries(bridge->vtxmapIV) ;
neqns = bridge->neqns ;
myid = bridge->myid ;
nowned = IV_size(bridge->myownedIV) ;
for ( jcol = jj = kk = 0 ; jcol < ncols ; jcol++ ) {
for ( irow = 0 ; irow < neqns ; irow++, jj++ ) {
if ( vtxmap[irow] == myid ) {
sol[kk++] = rhs[jj] ;
}
}
}
if ( kk != nowned * ncols ) {
fprintf(stderr, "\n proc %d : kk %d, nowned %d, ncols %d",
myid, kk, nowned, ncols) ;
exit(-1) ;
}
/*
----------------------------------------
call the method that assumes local input
----------------------------------------
*/
if ( bridge->msglvl > 1 ) {
fprintf(bridge->msgFile, "\n calling SolveMPI()") ;
fflush(bridge->msgFile) ;
}
SolveMPI(&nowned, pncols, sol, sol, data, perror) ;
if ( bridge->msglvl > 1 ) {
fprintf(bridge->msgFile, "\n return from SolveMPI()") ;
fflush(bridge->msgFile) ;
}
/*
------------------------------------------
gather all the entries onto processor zero
------------------------------------------
*/
mtx = DenseMtx_new() ;
DenseMtx_init(mtx, SPOOLES_REAL, 0, 0, nowned, ncols, 1, nowned) ;
DVcopy (nowned*ncols, DenseMtx_entries(mtx), sol) ;
IVcopy(nowned, mtx->rowind, IV_entries(bridge->myownedIV)) ;
mapIV = IV_new() ;
IV_init(mapIV, neqns, NULL) ;
IV_fill(mapIV, 0) ;
IVfill(4, stats, 0) ;
if ( bridge->msglvl > 1 ) {
fprintf(bridge->msgFile, "\n calling DenseMtx_split()()") ;
fflush(bridge->msgFile) ;
}
newmtx = DenseMtx_MPI_splitByRows(mtx, mapIV, stats, bridge->msglvl,
bridge->msgFile, tag, bridge->comm) ;
if ( bridge->msglvl > 1 ) {
fprintf(bridge->msgFile, "\n return from DenseMtx_split()()") ;
fflush(bridge->msgFile) ;
}
DenseMtx_free(mtx) ;
mtx = newmtx ;
IV_free(mapIV) ;
if ( myid == 0 ) {
DVcopy(neqns*ncols, sol, DenseMtx_entries(mtx)) ;
}
DenseMtx_free(mtx) ;
/*
---------------------------------------------
broadcast the entries to the other processors
---------------------------------------------
*/
if ( bridge->msglvl > 1 ) {
fprintf(bridge->msgFile, "\n calling MPI_Bcast()()") ;
fflush(bridge->msgFile) ;
}
MPI_Bcast((void *) sol, neqns*ncols, MPI_DOUBLE, 0, bridge->comm) ;
if ( bridge->msglvl > 1 ) {
fprintf(bridge->msgFile, "\n return from MPI_Bcast()()") ;
fflush(bridge->msgFile) ;
}
MPI_Barrier(bridge->comm) ;
/*
------------------------------------------------------------------
set the error. (this is simple since when the spooles codes detect
a fatal error, they print out a message to stderr and exit.)
------------------------------------------------------------------
*/
*perror = 0 ;
#if MYDEBUG > 0
MARKTIME(t2) ;
time_JimSolve += t2 - t1 ;
if ( bridge->myid == 0 ) {
fprintf(stdout, "\n (%d) JimSolve() end", count_JimSolve) ;
fprintf(stdout, ", %8.3f seconds, %8.3f total time",
t2 - t1, time_JimSolve) ;
fflush(stdout) ;
}
#endif
#if MYDEBUG > 1
fprintf(bridge->msgFile, "\n (%d) JimSolve() end", count_JimSolve) ;
fprintf(bridge->msgFile, ", %8.3f seconds, %8.3f total time",
t2 - t1, time_JimSolve) ;
fflush(bridge->msgFile) ;
#endif
return ; }
