/*
---------------------------------------------------------------
purpose -- fill dvec[J] with the stack storage to solve for J
in a forward solve
created -- 97nov30, cca
---------------------------------------------------------------
*/
void
ETree_forwSolveProfile (
ETree *etree,
double dvec[]
) {
int I, J, maxstack, nDJ, nfront, nUJ, stack ;
int *bndwghts, *fch, *nodwghts, *sib ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL || dvec == NULL ) {
fprintf(stderr,
"\n fatal error in ETree_forwSolveProfile(%p,%p)"
"\n bad input\n", etree, dvec) ;
exit(-1) ;
}
tree = ETree_tree(etree) ;
nodwghts = ETree_nodwghts(etree) ;
bndwghts = ETree_bndwghts(etree) ;
nfront = ETree_nfront(etree) ;
fch = ETree_fch(etree) ;
sib = ETree_sib(etree) ;
/*
---------------------------------------------
loop over the nodes in a post-order traversal
---------------------------------------------
*/
maxstack = stack = 0 ;
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
nDJ = nodwghts[J] ;
nUJ = bndwghts[J] ;
stack += nDJ + nUJ ;
dvec[J] = stack ;
if ( maxstack < stack ) {
maxstack = stack ;
}
#if MYDEBUG > 0
fprintf(stdout,
"\n working on front %d, nD = %d, nU = %d, stack = %d",
J, nDJ, nUJ, stack) ;
#endif
for ( I = fch[J] ; I != -1 ; I = sib[I] ) {
stack -= bndwghts[I] ;
}
stack -= nDJ ;
}
#if MYDEBUG >= 0
fprintf(stdout,
"\n forward solve : final stack = %d, max stack = %d",
stack, maxstack) ;
#endif
return ; }
/*
---------------------------------------------
purpose -- to broadcast a front tree object
from one process to all the others
created -- 98may21, cca
---------------------------------------------
*/
ETree *
ETree_MPI_Bcast (
ETree *etree,
int root,
int msglvl,
FILE *msgFile,
MPI_Comm comm
) {
int myid, nvtx, nfront, nint ;
int *buffer ;
/*
-------------
find identity
-------------
*/
MPI_Comm_rank(comm, &myid) ;
if ( myid == root ) {
/*
--------------------------------------------
this process owns the front tree, allocate a
continuous buffer and load the data into it.
--------------------------------------------
*/
nfront = ETree_nfront(etree) ;
nvtx = ETree_nvtx(etree) ;
nint = 3 + 5*nfront + nvtx ;
buffer = IVinit(nint, -1) ;
buffer[0] = nfront ;
buffer[1] = nvtx ;
buffer[2] = ETree_root(etree) ;
IVcopy(nfront, buffer + 3, ETree_par(etree)) ;
IVcopy(nfront, buffer + 3 + nfront, ETree_fch(etree)) ;
IVcopy(nfront, buffer + 3 + 2*nfront, ETree_sib(etree)) ;
IVcopy(nfront, buffer + 3 + 3*nfront, ETree_nodwghts(etree)) ;
IVcopy(nfront, buffer + 3 + 4*nfront, ETree_bndwghts(etree)) ;
IVcopy(nvtx, buffer + 3 + 5*nfront, ETree_vtxToFront(etree)) ;
/*
------------------------------------
send the size of the buffer and then
the buffer to the other processors
------------------------------------
*/
MPI_Bcast(&nint, 1, MPI_INT, root, comm) ;
MPI_Bcast(buffer, nint, MPI_INT, root, comm) ;
} else {
/*
--------------------------------------------
this process will receive the front tree.
clear its data, receive the number of int's,
then receive the buffer
--------------------------------------------
*/
if ( etree != NULL ) {
ETree_free(etree) ;
}
MPI_Bcast(&nint, 1, MPI_INT, root, comm) ;
buffer = IVinit(nint, -1) ;
MPI_Bcast(buffer, nint, MPI_INT, root, comm) ;
/*
----------------------------------------
create an ETree object and fill its data
----------------------------------------
*/
etree = ETree_new() ;
nfront = buffer[0] ;
nvtx = buffer[1] ;
ETree_init1(etree, nfront, nvtx) ;
etree->tree->n = nfront ;
etree->tree->root = buffer[2] ;
IVcopy(nfront, ETree_par(etree), buffer + 3) ;
IVcopy(nfront, ETree_fch(etree), buffer + 3 + nfront) ;
IVcopy(nfront, ETree_sib(etree), buffer + 3 + 2*nfront) ;
IVcopy(nfront, ETree_nodwghts(etree), buffer + 3 + 3*nfront) ;
IVcopy(nfront, ETree_bndwghts(etree), buffer + 3 + 4*nfront) ;
IVcopy(nvtx, ETree_vtxToFront(etree), buffer + 3 + 5*nfront) ;
}
/*
---------------
free the buffer
---------------
*/
IVfree(buffer) ;
return(etree) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------------------------
read in a ETree object, create an IV object with the same size,
mark the vertices in the top level separator(s), write the IV
object to a file
created -- 96may02, cca
---------------------------------------------------------------
*/
{
char *inETreeFileName, *outIVfileName ;
double t1, t2 ;
int msglvl, rc, J, K, ncomp, nfront, nvtx, v ;
int *bndwghts, *compids, *fch, *map, *nodwghts,
*par, *sib, *vtxToFront ;
IV *compidsIV, *mapIV ;
ETree *etree ;
FILE *msgFile ;
Tree *tree ;
if ( argc != 5 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile inETreeFile outIVfile"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inETreeFile -- input file, must be *.etreef or *.etreeb"
"\n outIVfile -- output file, must be *.ivf or *.ivb"
"\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) ;
}
inETreeFileName = argv[3] ;
outIVfileName = argv[4] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inETreeFile -- %s"
"\n outIVfile -- %s"
"\n",
argv[0], msglvl, argv[2], inETreeFileName, outIVfileName) ;
fflush(msgFile) ;
/*
------------------------
read in the ETree object
------------------------
*/
if ( strcmp(inETreeFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
etree = ETree_new() ;
MARKTIME(t1) ;
rc = ETree_readFromFile(etree, inETreeFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in etree from file %s",
t2 - t1, inETreeFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)",
rc, etree, inETreeFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading ETree object from file %s",
inETreeFileName) ;
if ( msglvl > 2 ) {
ETree_writeForHumanEye(etree, msgFile) ;
} else {
ETree_writeStats(etree, msgFile) ;
}
fflush(msgFile) ;
nfront = ETree_nfront(etree) ;
nvtx = ETree_nvtx(etree) ;
bndwghts = ETree_bndwghts(etree) ;
vtxToFront = ETree_vtxToFront(etree) ;
nodwghts = ETree_nodwghts(etree) ;
par = ETree_par(etree) ;
fch = ETree_fch(etree) ;
sib = ETree_sib(etree) ;
tree = ETree_tree(etree) ;
/*
-----------------------------------------
create the map from fronts to components,
top level separator(s) are component zero
-----------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map = IV_entries(mapIV) ;
ncomp = 0 ;
for ( J = Tree_preOTfirst(tree) ;
J != -1 ;
J = Tree_preOTnext(tree, J) ) {
if ( (K = par[J]) == -1 ) {
map[J] = 0 ;
} else if ( map[K] != 0 ) {
map[J] = map[K] ;
} else if ( J == fch[K] && sib[J] == -1
&& bndwghts[J] == nodwghts[K] + bndwghts[K] ) {
map[J] = 0 ;
} else {
map[J] = ++ncomp ;
}
}
fprintf(msgFile, "\n\n mapIV object") ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(mapIV, msgFile) ;
} else {
IV_writeStats(mapIV, msgFile) ;
}
/*
----------------------------------------
fill the map from vertices to components
----------------------------------------
*/
compidsIV = IV_new() ;
IV_init(compidsIV, nvtx, NULL) ;
compids = IV_entries(compidsIV) ;
for ( v = 0 ; v < nvtx ; v++ ) {
compids[v] = map[vtxToFront[v]] ;
}
fprintf(msgFile, "\n\n compidsIV object") ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(compidsIV, msgFile) ;
} else {
IV_writeStats(compidsIV, msgFile) ;
}
fflush(msgFile) ;
/*
-----------------------
write out the IV object
-----------------------
*/
if ( strcmp(outIVfileName, "none") != 0 ) {
MARKTIME(t1) ;
rc = IV_writeToFile(compidsIV, outIVfileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : write etree to file %s",
t2 - t1, outIVfileName) ;
}
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from IV_writeToFile(%p,%s)",
rc, compidsIV, outIVfileName) ;
}
/*
----------------
free the objects
----------------
*/
ETree_free(etree) ;
IV_free(mapIV) ;
IV_free(compidsIV) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*
---------------------------------------------------------------
purpose -- fill dvec[J] with the active storage to eliminate J
using the multifrontal method
symflag -- symmetry flag, one of SPOOLES_SYMMETRIC,
SPOOLES_HERMITIAN or SPOOLES_NONSYMMETRIC
created -- 97may21, cca
---------------------------------------------------------------
*/
void
ETree_MFstackProfile (
ETree *etree,
int symflag,
double dvec[]
) {
int I, J, nDJ, nUI, nUJ, stack ;
int *bndwghts, *fch, *nodwghts, *sib ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL || dvec == NULL ) {
fprintf(stderr, "\n fatal error in ETree_MFstackProfile(%p,%p)"
"\n bad input\n", etree, dvec) ;
exit(-1) ;
}
tree = ETree_tree(etree) ;
nodwghts = ETree_nodwghts(etree) ;
bndwghts = ETree_bndwghts(etree) ;
fch = ETree_fch(etree) ;
sib = ETree_sib(etree) ;
/*
---------------------------------------------
loop over the nodes in a post-order traversal
---------------------------------------------
*/
stack = 0 ;
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
nDJ = nodwghts[J] ;
nUJ = bndwghts[J] ;
#if MYDEBUG > 0
fprintf(stdout,
"\n working on front %d, nD = %d, nU = %d, stack = %d",
J, nDJ, nUJ, stack) ;
#endif
if ( (I = fch[J]) != -1 ) {
/*
--------------------------------
remove last child from the stack
--------------------------------
*/
while ( sib[I] != -1 ) {
I = sib[I] ;
}
nUI = bndwghts[I] ;
if ( symflag == SPOOLES_SYMMETRIC
|| symflag == SPOOLES_HERMITIAN ) {
stack -= (nUI*(nUI+1))/2 ;
} else if ( symflag == SPOOLES_NONSYMMETRIC ) {
stack -= nUI*nUI ;
}
#if MYDEBUG > 0
fprintf(stdout,
"\n removing last child %d, stack = %d", I, stack) ;
#endif
}
/*
---------------------------------
add frontal matrix for J to stack
and store as the storage for J
---------------------------------
*/
dvec[J] = stack + (nDJ + nUJ)*(nDJ + nUJ) ;
if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) {
dvec[J] = stack + ((nDJ + nUJ)*(nDJ + nUJ+1))/2 ;
} else if ( symflag == SPOOLES_NONSYMMETRIC ) {
dvec[J] = stack + (nDJ + nUJ)*(nDJ + nUJ) ;
}
#if MYDEBUG > 0
fprintf(stdout,
"\n working storage = %.0f", dvec[J]) ;
#endif
if ( (I = fch[J]) != -1 ) {
/*
------------------------------------
remove other children from the stack
------------------------------------
*/
while ( sib[I] != -1 ) {
nUI = bndwghts[I] ;
if ( symflag == SPOOLES_SYMMETRIC
|| symflag == SPOOLES_HERMITIAN ) {
stack -= (nUI*(nUI+1))/2 ;
} else if ( symflag == SPOOLES_NONSYMMETRIC ) {
stack -= nUI*nUI ;
}
#if MYDEBUG > 0
fprintf(stdout,
"\n removing child %d, stack = %d", I, stack) ;
#endif
I = sib[I] ;
}
}
/*
--------------------------------
add update matrix for J to stack
--------------------------------
*/
if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) {
stack += (nUJ*(nUJ+1))/2 ;
} else if ( symflag == SPOOLES_NONSYMMETRIC ) {
stack += nUJ*nUJ ;
}
#if MYDEBUG > 0
fprintf(stdout,
"\n adding update matrix, stack = %d", stack) ;
#endif
}
#if MYDEBUG >= 0
fprintf(stdout, "\n MF: final stack = %d", stack) ;
#endif
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) ; }
