/*
-----------------------------------------
purpose -- produce a map from each column
to the front that contains it
created -- 98may04, cca
-----------------------------------------
*/
IV *
FrontMtx_colmapIV (
FrontMtx *frontmtx
) {
int ii, J, ncolJ, neqns, nfront, nJ ;
int *colindJ, *colmap ;
IV *colmapIV ;
/*
-----------------------------------------
get the map from columns to owning fronts
-----------------------------------------
*/
neqns = FrontMtx_neqns(frontmtx) ;
nfront = FrontMtx_nfront(frontmtx) ;
colmapIV = IV_new() ;
IV_init(colmapIV, neqns, NULL) ;
colmap = IV_entries(colmapIV) ;
IVfill(neqns, colmap, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
if ( ncolJ > 0 && colindJ != NULL ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
colmap[colindJ[ii]] = J ;
}
}
}
}
return(colmapIV) ;
}
/*
--------------------------------------------------------------------
purpose -- produce a map from each row to the front that contains it
created -- 98may04, cca
--------------------------------------------------------------------
*/
IV *
FrontMtx_rowmapIV (
FrontMtx *frontmtx
) {
int ii, J, nrowJ, neqns, nfront, nJ ;
int *rowindJ, *rowmap ;
IV *rowmapIV ;
/*
--------------------------------------
get the map from rows to owning fronts
--------------------------------------
*/
neqns = FrontMtx_neqns(frontmtx) ;
nfront = FrontMtx_nfront(frontmtx) ;
rowmapIV = IV_new() ;
IV_init(rowmapIV, neqns, NULL) ;
rowmap = IV_entries(rowmapIV) ;
IVfill(neqns, rowmap, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_rowIndices(frontmtx, J, &nrowJ, &rowindJ) ;
if ( nrowJ > 0 && rowindJ != NULL ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
rowmap[rowindJ[ii]] = J ;
}
}
}
}
return(rowmapIV) ;
}
/*
------------------------------------------------------------
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) ; }
/*
------------------------------------------------------
transform an ETree object by
(1) merging small fronts into larger fronts
using the ETree_mergeFrontsOne() method
(2) merging small fronts into larger fronts
using the ETree_mergeFrontsAll() method
(3) split a large front into a chain of smaller fronts
using the ETree_splitFronts() method
created -- 96jun27, cca
------------------------------------------------------
*/
ETree *
ETree_transform2 (
ETree *etree,
int vwghts[],
int maxzeros,
int maxfrontsize,
int seed
) {
ETree *etree2 ;
int nfront, nvtx ;
IV *nzerosIV ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL
|| (nfront = etree->nfront) <= 0
|| (nvtx = etree->nvtx) <= 0
|| maxfrontsize <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_transform2(%p,%p,%d,%d,%d)"
"\n bad input\n", etree, vwghts, maxzeros, maxfrontsize,
seed) ;
spoolesFatal();
}
nzerosIV = IV_new();
IV_init(nzerosIV, nfront, NULL) ;
IV_fill(nzerosIV, 0) ;
/*
--------------------------
first, merge only children
--------------------------
*/
etree2 = ETree_mergeFrontsOne(etree, maxzeros, nzerosIV) ;
ETree_free(etree) ;
etree = etree2 ;
/*
--------------------------
second, merge all children
--------------------------
*/
etree2 = ETree_mergeFrontsAll(etree, maxzeros, nzerosIV) ;
ETree_free(etree) ;
etree = etree2 ;
/*
-----------------------------------
fourth, split large interior fronts
-----------------------------------
*/
etree2 = ETree_splitFronts(etree, vwghts, maxfrontsize, seed) ;
ETree_free(etree) ;
etree = etree2 ;
/*
------------------------
free the working storage
------------------------
*/
IV_free(nzerosIV) ;
return(etree) ; }
/*
------------------------------------------------------
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) ; }
/*
-------------------------------------------------------
purpose -- create and return an IV object that contains
all the column ids owned by process myid.
created -- 98jun13, cca
-------------------------------------------------------
*/
IV *
FrontMtx_ownedColumnsIV (
FrontMtx *frontmtx,
int myid,
IV *ownersIV,
int msglvl,
FILE *msgFile
) {
int J, neqns, nfront, nJ, nowned, ncolJ, offset ;
int *ownedColumns, *owners, *colindJ ;
IV *ownedColumnsIV ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL ) {
fprintf(stderr, "\n fatal error in FrontMtx_ownedColumnsIV(%p,%d,%p)"
"\n bad input\n", frontmtx, myid, ownersIV) ;
exit(-1) ;
}
nfront = frontmtx->nfront ;
neqns = frontmtx->neqns ;
ownedColumnsIV = IV_new() ;
if ( ownersIV == NULL ) {
IV_init(ownedColumnsIV, neqns, NULL) ;
IV_ramp(ownedColumnsIV, 0, 1) ;
} else {
owners = IV_entries(ownersIV) ;
for ( J = 0, nowned = 0 ; J < nfront ; J++ ) {
if ( owners[J] == myid ) {
nJ = FrontMtx_frontSize(frontmtx, J) ;
nowned += nJ ;
}
}
if ( nowned > 0 ) {
IV_init(ownedColumnsIV, nowned, NULL) ;
ownedColumns = IV_entries(ownedColumnsIV) ;
for ( J = 0, offset = 0 ; J < nfront ; J++ ) {
if ( owners[J] == myid ) {
nJ = FrontMtx_frontSize(frontmtx, J) ;
if ( nJ > 0 ) {
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
IVcopy(nJ, ownedColumns + offset, colindJ) ;
offset += nJ ;
}
}
}
}
}
return(ownedColumnsIV) ;
}
/*
-------------------------------------
return an IV object filled with the
weights of the component's boundaries
created -- 96oct21, cca
-------------------------------------
*/
IV *
GPart_bndWeightsIV (
GPart *gpart
) {
Graph *graph ;
int icomp, ii, ncomp, nvtx, v, vsize, vwght, w ;
int *bnd, *compids, *cweights, *mark, *vadj, *vwghts ;
IV *bndIV ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || (graph = gpart->g) == NULL ) {
fprintf(stderr, "\n fatal error in GPart_bndWeightsIV(%p)"
"\n bad input\n", gpart) ;
exit(-1) ;
}
nvtx = gpart->nvtx ;
ncomp = gpart->ncomp ;
compids = IV_entries(&gpart->compidsIV) ;
cweights = IV_entries(&gpart->cweightsIV) ;
vwghts = graph->vwghts ;
bndIV = IV_new() ;
IV_init(bndIV, 1 + ncomp, NULL) ;
IV_fill(bndIV, 0) ;
bnd = IV_entries(bndIV) ;
mark = IVinit(ncomp+1, -1) ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] == 0 ) {
vwght = (vwghts == NULL) ? 1 : vwghts[v] ;
Graph_adjAndSize(graph, v, &vsize, &vadj) ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( (icomp = compids[w]) != 0 && mark[icomp] != v ) {
mark[icomp] = v ;
bnd[icomp] += vwght ;
}
}
}
}
IVfree(mark) ;
return(bndIV) ; }
/*
------------------------------------------------------------------
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) ; }
/*
------------------------------------
return an IV object with the weights
of the vertices in each front.
created -- 96jun23, cca
------------------------------------
*/
IV *
ETree_nvtxMetric (
ETree *etree
) {
IV *metricIV ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL || etree->nfront <= 0 || etree->nvtx <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_nvtxMetric(%p)"
"\n bad input\n", etree) ;
exit(-1) ;
}
metricIV = IV_new() ;
IV_init(metricIV, etree->nfront, NULL) ;
IVcopy(etree->nfront, IV_entries(metricIV),
IV_entries(etree->nodwghtsIV)) ;
return(metricIV) ; }
/*
--------------------------------------------
create and return an IV object that contains
the map from vertices to fundamental chains.
return value -- # of fundamental chains
created -- 96jun23, cca
-------------------------------------------
*/
IV *
Tree_fundChainMap (
Tree *tree
) {
int nfc, u, v ;
int *map ;
IV *mapIV ;
/*
---------------
check the input
---------------
*/
if ( tree == NULL || tree->n <= 0 ) {
fprintf(stderr, "\n fatal error in Tree_fundChainMap(%p)"
"\n bad input\n", tree) ;
exit(-1) ;
}
mapIV = IV_new() ;
IV_init(mapIV, tree->n, NULL) ;
map = IV_entries(mapIV) ;
for ( v = Tree_postOTfirst(tree), nfc = 0 ;
v != -1 ;
v = Tree_postOTnext(tree, v) ) {
if ( (u = tree->fch[v]) == -1 || tree->sib[u] != -1 ) {
/*
--------------------
v starts a new chain
--------------------
*/
map[v] = nfc++ ;
} else {
/*
-----------------------------------------------
v belongs in the same chain as its only child u
-----------------------------------------------
*/
map[v] = map[u] ;
}
}
return(mapIV) ; }
/*
---------------------------------------------------------------
return an IV object with the number
of factor entries in each front.
symflag -- symmetryflag
SPOOLES_SYMMETRIC, SPOOLES_HERMITIAN or SPOOLES_NONSYMMETRIC
created -- 96jun23, cca
---------------------------------------------------------------
*/
IV *
ETree_nentMetric (
ETree *etree,
int flag
) {
int front, nfront, nb, nv ;
int *bndwghts, *metric, *nodwghts ;
IV *metricIV ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL
|| (nfront = etree->nfront) <= 0 || etree->nvtx <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_nentMetric(%p)"
"\n bad input\n", etree) ;
exit(-1) ;
}
metricIV = IV_new() ;
IV_init(metricIV, nfront, NULL) ;
metric = IV_entries(metricIV) ;
nodwghts = IV_entries(etree->nodwghtsIV) ;
bndwghts = IV_entries(etree->bndwghtsIV) ;
if ( flag == 1 ) {
for ( front = 0 ; front < nfront ; front++ ) {
nv = nodwghts[front] ;
nb = bndwghts[front] ;
metric[front] = (nv*(nv+1))/2 + nv*nb ;
}
} else if ( flag == 2 ) {
for ( front = 0 ; front < nfront ; front++ ) {
nv = nodwghts[front] ;
nb = bndwghts[front] ;
metric[front] = nv*nv + 2*nv*nb ;
}
}
return(metricIV) ; }
/*
-----------------------------------------------
initialize the object given the number of nodes
created -- 96mar10, cca
-----------------------------------------------
*/
void
DSTree_init1 (
DSTree *dstree,
int ndomsep,
int nvtx
) {
/*
---------------
check the input
---------------
*/
if ( dstree == NULL || ndomsep <= 0 ) {
fprintf(stderr, "\n fatal error in DSTree_init1(%p,%d,%d)"
"\n bad input\n", dstree, ndomsep, nvtx) ;
exit(-1) ;
}
DSTree_clearData(dstree) ;
dstree->tree = Tree_new() ;
Tree_init1(dstree->tree, ndomsep) ;
dstree->mapIV = IV_new() ;
IV_init(dstree->mapIV, nvtx, NULL) ;
IV_fill(dstree->mapIV, -1) ;
return ; }
/*
-------------------------------------------------------------
purpose -- after pivoting for a nonsymmetric factorization,
some delayed columns may belong to a process other
than its original owner. this method returns an
IV object that maps columns to owning processes.
created -- 98may22, cca
-------------------------------------------------------------
*/
IV *
FrontMtx_MPI_colmapIV (
FrontMtx *frontmtx,
IV *frontOwnersIV,
int msglvl,
FILE *msgFile,
MPI_Comm comm
) {
int buffersize, ii, iproc, J, myid, nDJ, neqns, nfront, nproc,
ncolJ, nToSend, v ;
int *buffer, *counts, *frontOwners, *inbuffer, *outbuffer,
*colindJ, *colmap, *vtxToFront ;
IV *colmapIV ;
/*
-------------------------------------------
get the process id and number of processors
-------------------------------------------
*/
MPI_Comm_rank(comm, &myid) ;
MPI_Comm_size(comm, &nproc) ;
neqns = frontmtx->neqns ;
vtxToFront = ETree_vtxToFront(frontmtx->frontETree) ;
IV_sizeAndEntries(frontOwnersIV, &nfront, &frontOwners) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n inside FrontMtx_MPI_colmapIV()"
"\n myid = %d, nproc = %d, nfront = %d, neqns = %d",
myid, nproc, nfront, neqns) ;
fflush(msgFile) ;
}
/*
----------------------------------------------------------
loop through the owned fronts and store each column in an
owned front that was originally owned by another processor
----------------------------------------------------------
*/
outbuffer = IVinit(neqns, -1) ;
for ( J = nToSend = 0 ; J < nfront ; J++ ) {
if ( frontOwners[J] == myid
&& (nDJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front %d owned, nDJ = %d, ncolJ = %d",
J, nDJ, ncolJ) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < nDJ ; ii++ ) {
v = colindJ[ii] ;
if ( frontOwners[vtxToFront[v]] != myid ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n column %d originally owned by %d",
v, frontOwners[vtxToFront[v]]) ;
fflush(msgFile) ;
}
outbuffer[nToSend++] = v ;
}
}
}
}
IVqsortUp(nToSend, outbuffer) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n shifted vertices") ;
IVfprintf(msgFile, nToSend, outbuffer) ;
fflush(msgFile) ;
}
counts = IVinit(nproc, 0) ;
/*
--------------------------------------------
use an all-gather call to get the number of
moved columns that are owned by each process
--------------------------------------------
*/
MPI_Allgather((void *) &nToSend, 1, MPI_INT, counts, 1, MPI_INT, comm) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n after the all-gather operation, counts") ;
IVfprintf(msgFile, nproc, counts) ;
fflush(msgFile) ;
}
buffersize = IVmax(nproc, counts, &iproc) ;
inbuffer = IVinit(buffersize, -1) ;
/*
-----------------------------------
initialize the column map IV object
-----------------------------------
*/
colmapIV = IV_new() ;
IV_init(colmapIV, neqns, NULL) ;
colmap = IV_entries(colmapIV) ;
IVgather(neqns, colmap, frontOwners, vtxToFront) ;
/*
--------------------------------------------------------------
loop over the other processes, receive vector of moved columns
--------------------------------------------------------------
*/
for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
if ( counts[iproc] > 0 ) {
if ( iproc == myid ) {
/*
-------------------------------------
send buffer vector to other processes
-------------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n sending outbuffer to all processes") ;
IVfprintf(msgFile, nToSend, outbuffer) ;
fflush(msgFile) ;
}
MPI_Bcast(outbuffer, nToSend, MPI_INT, iproc, comm) ;
buffer = outbuffer ;
} else {
/*
-----------------------------------------
receive the vector from the other process
-----------------------------------------
*/
MPI_Bcast(inbuffer, counts[iproc], MPI_INT, iproc, comm) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n received inbuffer from process %d",
iproc) ;
IVfprintf(msgFile, counts[iproc], inbuffer) ;
fflush(msgFile) ;
}
buffer = inbuffer ;
}
/*
-------------------------
set the column map values
-------------------------
*/
for ( ii = 0 ; ii < counts[iproc] ; ii++ ) {
v = buffer[ii] ;
colmap[v] = iproc ;
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(inbuffer) ;
IVfree(outbuffer) ;
IVfree(counts) ;
return(colmapIV) ; }
/*
----------------------------------------------------------
purpose -- to construct the map from fronts to processors,
and compute operations for each processor.
maptype -- type of map for parallel factorization
maptype = 1 --> wrap map
maptype = 2 --> balanced map
maptype = 3 --> subtree-subset map
maptype = 4 --> domain decomposition map
cutoff -- used when maptype = 4 as upper bound on
relative domain size
return value --
1 -- success
-1 -- bridge is NULL
-2 -- front tree is NULL
created -- 98sep25, cca
----------------------------------------------------------
*/
int
BridgeMPI_factorSetup (
BridgeMPI *bridge,
int maptype,
double cutoff
) {
double t1, t2 ;
DV *cumopsDV ;
ETree *frontETree ;
FILE *msgFile ;
int msglvl, nproc ;
/*
---------------
check the input
---------------
*/
MARKTIME(t1) ;
if ( bridge == NULL ) {
fprintf(stderr, "\n error in BridgeMPI_factorSetup()"
"\n bridge is NULL") ;
return(-1) ;
}
if ( (frontETree = bridge->frontETree) == NULL ) {
fprintf(stderr, "\n error in BridgeMPI_factorSetup()"
"\n frontETree is NULL") ;
return(-2) ;
}
nproc = bridge->nproc ;
msglvl = bridge->msglvl ;
msgFile = bridge->msgFile ;
/*
-------------------------------------------
allocate and initialize the cumopsDV object
-------------------------------------------
*/
if ( (cumopsDV = bridge->cumopsDV) == NULL ) {
cumopsDV = bridge->cumopsDV = DV_new() ;
}
DV_setSize(cumopsDV, nproc) ;
DV_zero(cumopsDV) ;
/*
----------------------------
create the owners map object
----------------------------
*/
switch ( maptype ) {
case 1 :
bridge->ownersIV = ETree_wrapMap(frontETree, bridge->type,
bridge->symmetryflag, cumopsDV) ;
break ;
case 2 :
bridge->ownersIV = ETree_balancedMap(frontETree, bridge->type,
bridge->symmetryflag, cumopsDV) ;
break ;
case 3 :
bridge->ownersIV = ETree_subtreeSubsetMap(frontETree, bridge->type,
bridge->symmetryflag, cumopsDV) ;
break ;
case 4 :
bridge->ownersIV = ETree_ddMap(frontETree, bridge->type,
bridge->symmetryflag, cumopsDV, cutoff) ;
break ;
default :
bridge->ownersIV = ETree_ddMap(frontETree, bridge->type,
bridge->symmetryflag, cumopsDV, 1./(2*nproc)) ;
break ;
}
MARKTIME(t2) ;
bridge->cpus[7] = t2 - t1 ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n parallel factor setup") ;
fprintf(msgFile, "\n type = %d, symmetryflag = %d",
bridge->type, bridge->symmetryflag) ;
fprintf(msgFile, "\n total factor operations = %.0f",
DV_sum(cumopsDV)) ;
fprintf(msgFile,
"\n upper bound on speedup due to load balance = %.2f",
DV_max(cumopsDV)/DV_sum(cumopsDV)) ;
fprintf(msgFile, "\n operations distributions over threads") ;
DV_writeForHumanEye(cumopsDV, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n owners map IV object") ;
IV_writeForHumanEye(bridge->ownersIV, msgFile) ;
fflush(msgFile) ;
}
/*
----------------------------
create the vertex map object
----------------------------
*/
bridge->vtxmapIV = IV_new() ;
IV_init(bridge->vtxmapIV, bridge->neqns, NULL) ;
IVgather(bridge->neqns, IV_entries(bridge->vtxmapIV),
IV_entries(bridge->ownersIV),
ETree_vtxToFront(bridge->frontETree)) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex map IV object") ;
IV_writeForHumanEye(bridge->vtxmapIV, msgFile) ;
fflush(msgFile) ;
}
return(1) ;
}
/*
-------------------------------------------------------
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 -- 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) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------------------------
read in an ETree object and an equivalence map,
expand the ETree object and optionally write to a file.
created -- 98sep05, cca
-------------------------------------------------------
*/
{
char *inEqmapFileName, *inETreeFileName, *outETreeFileName ;
double t1, t2 ;
ETree *etree, *etree2 ;
FILE *msgFile ;
int msglvl, rc ;
IV *eqmapIV ;
if ( argc != 6 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile inETreeFile inEqmapFile outETreeFile"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inETreeFile -- input file, must be *.etreef or *.etreeb"
"\n inEqmapFile -- input file, must be *.ivf or *.ivb"
"\n outETreeFile -- output file, must be *.etreef or *.etreeb"
"\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] ;
inEqmapFileName = argv[4] ;
outETreeFileName = argv[5] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inETreeFile -- %s"
"\n inEqmapFile -- %s"
"\n outETreeFile -- %s"
"\n",
argv[0], msglvl, argv[2],
inETreeFileName, inEqmapFileName, outETreeFileName) ;
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) ;
/*
-------------------------------------
read in the equivalence map IV object
-------------------------------------
*/
if ( strcmp(inEqmapFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
eqmapIV = IV_new() ;
MARKTIME(t1) ;
rc = IV_readFromFile(eqmapIV, inEqmapFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in eqmapIV from file %s",
t2 - t1, inEqmapFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)",
rc, eqmapIV, inEqmapFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading IV object from file %s",
inEqmapFileName) ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(eqmapIV, msgFile) ;
} else {
IV_writeStats(eqmapIV, msgFile) ;
}
fflush(msgFile) ;
/*
-----------------------
expand the ETree object
-----------------------
*/
etree2 = ETree_expand(etree, eqmapIV) ;
fprintf(msgFile, "\n\n after expanding the ETree object") ;
if ( msglvl > 2 ) {
ETree_writeForHumanEye(etree2, msgFile) ;
} else {
ETree_writeStats(etree2, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------
write out the ETree object
--------------------------
*/
if ( strcmp(outETreeFileName, "none") != 0 ) {
MARKTIME(t1) ;
rc = ETree_writeToFile(etree2, outETreeFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : write etree to file %s",
t2 - t1, outETreeFileName) ;
}
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from ETree_writeToFile(%p,%s)",
rc, etree2, outETreeFileName) ;
}
/*
---------------------
free the ETree object
---------------------
*/
ETree_free(etree) ;
IV_free(eqmapIV) ;
ETree_free(etree2) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
------------------------------------------------------------
make ETree objects for nested dissection on a regular grid
1 -- vertex elimination tree
2 -- fundamental supernode front tree
3 -- merge only children if possible
4 -- merge all children if possible
5 -- split large non-leaf fronts
created -- 98feb05, cca
------------------------------------------------------------
*/
{
char *outETreeFileName ;
double ops[6] ;
double t1, t2 ;
EGraph *egraph ;
ETree *etree0, *etree1, *etree2, *etree3, *etree4, *etree5 ;
FILE *msgFile ;
Graph *graph ;
int nfronts[6], nfind[6], nzf[6] ;
int maxsize, maxzeros, msglvl, n1, n2, n3, nvtx, rc, v ;
int *newToOld, *oldToNew ;
IV *nzerosIV ;
if ( argc != 9 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile n1 n2 n3 maxzeros maxsize outFile"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n n1 -- number of points in the first direction"
"\n n2 -- number of points in the second direction"
"\n n3 -- number of points in the third direction"
"\n maxzeros -- number of points in the third direction"
"\n maxsize -- maximum number of vertices in a front"
"\n outFile -- output file, must be *.etreef or *.etreeb"
"\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) ;
}
n1 = atoi(argv[3]) ;
n2 = atoi(argv[4]) ;
n3 = atoi(argv[5]) ;
maxzeros = atoi(argv[6]) ;
maxsize = atoi(argv[7]) ;
outETreeFileName = argv[8] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n n1 -- %d"
"\n n2 -- %d"
"\n n3 -- %d"
"\n maxzeros -- %d"
"\n maxsize -- %d"
"\n outFile -- %s"
"\n",
argv[0], msglvl, argv[2], n1, n2, n3,
maxzeros, maxsize, outETreeFileName) ;
fflush(msgFile) ;
/*
----------------------------
create the grid graph object
----------------------------
*/
if ( n1 == 1 ) {
egraph = EGraph_make9P(n2, n3, 1) ;
} else if ( n2 == 1 ) {
egraph = EGraph_make9P(n1, n3, 1) ;
} else if ( n3 == 1 ) {
egraph = EGraph_make9P(n1, n2, 1) ;
} else {
egraph = EGraph_make27P(n1, n2, n3, 1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n %d x %d x %d grid EGraph", n1, n2, n3) ;
EGraph_writeForHumanEye(egraph, msgFile) ;
fflush(msgFile) ;
}
graph = EGraph_mkAdjGraph(egraph) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n %d x %d x %d grid Graph", n1, n2, n3) ;
Graph_writeForHumanEye(graph, msgFile) ;
fflush(msgFile) ;
}
/*
----------------------------------
get the nested dissection ordering
----------------------------------
*/
nvtx = n1*n2*n3 ;
newToOld = IVinit(nvtx, -1) ;
oldToNew = IVinit(nvtx, -1) ;
mkNDperm(n1, n2, n3, newToOld, 0, n1-1, 0, n2-1, 0, n3-1) ;
for ( v = 0 ; v < nvtx ; v++ ) {
oldToNew[newToOld[v]] = v ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n %d x %d x %d nd ordering", n1, n2, n3) ;
IVfprintf(msgFile, nvtx, oldToNew) ;
fflush(msgFile) ;
}
/*
------------------------------------------
create the vertex elimination ETree object
------------------------------------------
*/
etree0 = ETree_new() ;
ETree_initFromGraphWithPerms(etree0, graph, newToOld, oldToNew) ;
nfronts[0] = ETree_nfront(etree0) ;
nfind[0] = ETree_nFactorIndices(etree0) ;
nzf[0] = ETree_nFactorEntries(etree0, SPOOLES_SYMMETRIC) ;
ops[0] = ETree_nFactorOps(etree0, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
fprintf(msgFile,
"\n vtx tree : %8d fronts, %8d indices, %8d |L|, %12.0f ops",
nfronts[0], nfind[0], nzf[0], ops[0]) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex elimination tree") ;
ETree_writeForHumanEye(etree0, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------------------------
create the fundamental supernode ETree object
---------------------------------------------
*/
nzerosIV = IV_new() ;
IV_init(nzerosIV, nvtx, NULL) ;
IV_fill(nzerosIV, 0) ;
etree1 = ETree_mergeFrontsOne(etree0, 0, nzerosIV) ;
nfronts[1] = ETree_nfront(etree1) ;
nfind[1] = ETree_nFactorIndices(etree1) ;
nzf[1] = ETree_nFactorEntries(etree1, SPOOLES_SYMMETRIC) ;
ops[1] = ETree_nFactorOps(etree1, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
fprintf(msgFile,
"\n fs tree : %8d fronts, %8d indices, %8d |L|, %12.0f ops",
nfronts[1], nfind[1], nzf[1], ops[1]) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n fundamental supernode front tree") ;
ETree_writeForHumanEye(etree1, msgFile) ;
fprintf(msgFile, "\n\n nzerosIV") ;
IV_writeForHumanEye(nzerosIV, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------
try to absorb only children
---------------------------
*/
etree2 = ETree_mergeFrontsOne(etree1, maxzeros, nzerosIV) ;
nfronts[2] = ETree_nfront(etree2) ;
nfind[2] = ETree_nFactorIndices(etree2) ;
nzf[2] = ETree_nFactorEntries(etree2, SPOOLES_SYMMETRIC) ;
ops[2] = ETree_nFactorOps(etree2, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
fprintf(msgFile,
"\n merge one : %8d fronts, %8d indices, %8d |L|, %12.0f ops",
nfronts[2], nfind[2], nzf[2], ops[2]) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front tree after mergeOne") ;
ETree_writeForHumanEye(etree2, msgFile) ;
fprintf(msgFile, "\n\n nzerosIV") ;
IV_writeForHumanEye(nzerosIV, msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------
try to absorb all children
--------------------------
*/
etree3 = ETree_mergeFrontsAll(etree2, maxzeros, nzerosIV) ;
nfronts[3] = ETree_nfront(etree3) ;
nfind[3] = ETree_nFactorIndices(etree3) ;
nzf[3] = ETree_nFactorEntries(etree3, SPOOLES_SYMMETRIC) ;
ops[3] = ETree_nFactorOps(etree3, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
fprintf(msgFile,
"\n merge all : %8d fronts, %8d indices, %8d |L|, %12.0f ops",
nfronts[3], nfind[3], nzf[3], ops[3]) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front tree after mergeAll") ;
ETree_writeForHumanEye(etree3, msgFile) ;
fprintf(msgFile, "\n\n nzerosIV") ;
IV_writeForHumanEye(nzerosIV, msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------------
try to absorb any other children
--------------------------------
*/
etree4 = etree3 ;
/*
etree4 = ETree_mergeFrontsAny(etree3, maxzeros, nzerosIV) ;
nfronts[4] = ETree_nfront(etree4) ;
nfind[4] = ETree_nFactorIndices(etree4) ;
nzf[4] = ETree_nFactorEntries(etree4, SPOOLES_SYMMETRIC) ;
ops[4] = ETree_nFactorOps(etree4, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
fprintf(msgFile,
"\n merge any : %8d fronts, %8d indices, %8d |L|, %12.0f ops",
nfronts[4], nfind[4], nzf[4], ops[4]) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front tree after mergeAny") ;
ETree_writeForHumanEye(etree3, msgFile) ;
fprintf(msgFile, "\n\n nzerosIV") ;
IV_writeForHumanEye(nzerosIV, msgFile) ;
fflush(msgFile) ;
}
*/
/*
--------------------
split the front tree
--------------------
*/
etree5 = ETree_splitFronts(etree4, NULL, maxsize, 0) ;
nfronts[5] = ETree_nfront(etree5) ;
nfind[5] = ETree_nFactorIndices(etree5) ;
nzf[5] = ETree_nFactorEntries(etree5, SPOOLES_SYMMETRIC) ;
ops[5] = ETree_nFactorOps(etree5, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
fprintf(msgFile,
"\n split : %8d fronts, %8d indices, %8d |L|, %12.0f ops",
nfronts[5], nfind[5], nzf[5], ops[5]) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front tree after split") ;
ETree_writeForHumanEye(etree4, msgFile) ;
fflush(msgFile) ;
}
fprintf(msgFile, "\n\n complex symmetric ops %.0f",
ETree_nFactorOps(etree5, SPOOLES_COMPLEX, SPOOLES_SYMMETRIC)) ;
/*
--------------------------
write out the ETree object
--------------------------
*/
if ( strcmp(outETreeFileName, "none") != 0 ) {
MARKTIME(t1) ;
rc = ETree_writeToFile(etree5, outETreeFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : write etree to file %s",
t2 - t1, outETreeFileName) ;
if ( rc != 1 ) {
fprintf(msgFile,
"\n return value %d from ETree_writeToFile(%p,%s)",
rc, etree5, outETreeFileName) ;
}
}
/*
----------------
free the objects
----------------
*/
ETree_free(etree0) ;
ETree_free(etree1) ;
ETree_free(etree2) ;
ETree_free(etree3) ;
/*
ETree_free(etree4) ;
*/
ETree_free(etree5) ;
EGraph_free(egraph) ;
Graph_free(graph) ;
IVfree(newToOld) ;
IVfree(oldToNew) ;
IV_free(nzerosIV) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------------
read in a Graph and a stages id IV object,
replace the stages IV object with wirebasket stages
created -- 97jul30, cca
---------------------------------------------------
*/
{
char *inCompidsFileName, *inGraphFileName, *outStagesIVfileName ;
double t1, t2 ;
Graph *graph ;
int msglvl, nvtx, radius, rc, v ;
int *compids, *stages ;
IV *compidsIV, *stagesIV ;
FILE *msgFile ;
if ( argc != 7 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile inGraphFile inStagesFile "
"\n outStagesFile radius"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inGraphFile -- input file, must be *.graphf or *.graphb"
"\n inStagesFile -- output file, must be *.ivf or *.ivb"
"\n outStagesFile -- output file, must be *.ivf or *.ivb"
"\n radius -- radius to set the stage "
"\n of a separator vertex"
"\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) ;
}
inGraphFileName = argv[3] ;
inCompidsFileName = argv[4] ;
outStagesIVfileName = argv[5] ;
radius = atoi(argv[6]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inGraphFile -- %s"
"\n inStagesFile -- %s"
"\n outStagesFile -- %s"
"\n radius -- %d"
"\n",
argv[0], msglvl, argv[2], inGraphFileName, inCompidsFileName,
outStagesIVfileName, radius) ;
fflush(msgFile) ;
/*
------------------------
read in the Graph object
------------------------
*/
if ( strcmp(inGraphFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
graph = Graph_new() ;
MARKTIME(t1) ;
rc = Graph_readFromFile(graph, inGraphFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in graph from file %s",
t2 - t1, inGraphFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from Graph_readFromFile(%p,%s)",
rc, graph, inGraphFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading Graph object from file %s",
inGraphFileName) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
/*
---------------------
read in the IV object
---------------------
*/
if ( strcmp(inCompidsFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
compidsIV = IV_new() ;
MARKTIME(t1) ;
rc = IV_readFromFile(compidsIV, inCompidsFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in compidsIV from file %s",
t2 - t1, inCompidsFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)",
rc, compidsIV, inCompidsFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading IV object from file %s",
inCompidsFileName) ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(compidsIV, msgFile) ;
} else {
IV_writeStats(compidsIV, msgFile) ;
}
fflush(msgFile) ;
IV_sizeAndEntries(compidsIV, &nvtx, &compids) ;
/*
----------------------------
convert to the stages vector
----------------------------
*/
stagesIV = IV_new() ;
IV_init(stagesIV, nvtx, NULL) ;
stages = IV_entries(stagesIV) ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] == 0 ) {
stages[v] = 1 ;
} else {
stages[v] = 0 ;
}
}
/*
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] == 0 ) {
stages[v] = 0 ;
} else {
stages[v] = 1 ;
}
}
*/
/*
-------------------------
get the wirebasket stages
-------------------------
*/
Graph_wirebasketStages(graph, stagesIV, radius) ;
IV_sizeAndEntries(stagesIV, &nvtx, &stages) ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( stages[v] == 2 ) {
stages[v] = 1 ;
} else if ( stages[v] > 2 ) {
stages[v] = 2 ;
}
}
fprintf(msgFile, "\n\n new stages IV object") ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(stagesIV, msgFile) ;
} else {
IV_writeStats(stagesIV, msgFile) ;
}
fflush(msgFile) ;
/*
---------------------------
write out the stages object
---------------------------
*/
if ( strcmp(outStagesIVfileName, "none") != 0 ) {
MARKTIME(t1) ;
IV_writeToFile(stagesIV, outStagesIVfileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : write stagesIV to file %s",
t2 - t1, outStagesIVfileName) ;
if ( rc != 1 ) {
fprintf(msgFile,
"\n return value %d from IV_writeToFile(%p,%s)",
rc, stagesIV, outStagesIVfileName) ;
}
}
/*
------------------------
free the working storage
------------------------
*/
Graph_free(graph) ;
IV_free(stagesIV) ;
IV_free(compidsIV) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------------------
this program tests the IVL_MPI_allgather() method
(1) each process generates the same owners[n] map
(2) each process creates an IVL object
and fills its owned lists with random numbers
(3) the processes gather-all's the lists of ivl
created -- 98apr03, cca
-------------------------------------------------
*/
{
char *buffer ;
double chksum, globalsum, t1, t2 ;
Drand drand ;
int ilist, length, myid, msglvl, nlist,
nproc, rc, seed, size, tag ;
int *list, *owners, *vec ;
int stats[4], tstats[4] ;
IV *ownersIV ;
IVL *ivl ;
FILE *msgFile ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 5 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile n seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nlist -- number of lists in the IVL object"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
nlist = atoi(argv[3]) ;
seed = atoi(argv[4]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n nlist -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], nlist, seed) ;
fflush(msgFile) ;
/*
----------------------------
generate the ownersIV object
----------------------------
*/
MARKTIME(t1) ;
ownersIV = IV_new() ;
IV_init(ownersIV, nlist, NULL) ;
owners = IV_entries(ownersIV) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nproc) ;
Drand_fillIvector(&drand, nlist, owners) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize the ownersIV object",
t2 - t1) ;
fflush(msgFile) ;
fprintf(msgFile, "\n\n ownersIV generated") ;
if ( msglvl > 2 ) {
IV_writeForHumanEye(ownersIV, msgFile) ;
} else {
IV_writeStats(ownersIV, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
set up the IVL object and fill owned entries
--------------------------------------------
*/
MARKTIME(t1) ;
ivl = IVL_new() ;
IVL_init1(ivl, IVL_CHUNKED, nlist) ;
vec = IVinit(nlist, -1) ;
Drand_setSeed(&drand, seed + myid) ;
Drand_setUniform(&drand, 0, nlist) ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
size = (int) Drand_value(&drand) ;
Drand_fillIvector(&drand, size, vec) ;
IVL_setList(ivl, ilist, size, vec) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize the IVL object",
t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
IVL_writeForHumanEye(ivl, msgFile) ;
} else {
IVL_writeStats(ivl, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
compute the local checksum of the ivl object
--------------------------------------------
*/
for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
IVL_listAndSize(ivl, ilist, &size, &list) ;
chksum += 1 + ilist + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local partial chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
-----------------------
get the global checksum
-----------------------
*/
rc = MPI_Allreduce((void *) &chksum, (void *) &globalsum,
1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD) ;
/*
--------------------------------
execute the all-gather operation
--------------------------------
*/
tag = 47 ;
IVzero(4, stats) ;
IVL_MPI_allgather(ivl, ownersIV,
stats, msglvl, msgFile, tag, MPI_COMM_WORLD) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n return from IVL_MPI_allgather()") ;
fprintf(msgFile,
"\n local send stats : %10d messages with %10d bytes"
"\n local recv stats : %10d messages with %10d bytes",
stats[0], stats[2], stats[1], stats[3]) ;
fflush(msgFile) ;
}
MPI_Reduce((void *) stats, (void *) tstats, 4, MPI_INT,
MPI_SUM, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile,
"\n total send stats : %10d messages with %10d bytes"
"\n total recv stats : %10d messages with %10d bytes",
tstats[0], tstats[2], tstats[1], tstats[3]) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ivl") ;
IVL_writeForHumanEye(ivl, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------------------------
compute the checksum of the entire object
-----------------------------------------
*/
for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &list) ;
chksum += 1 + ilist + size + IVsum(size, list) ;
}
fprintf(msgFile,
"\n globalsum = %12.4e, chksum = %12.4e, error = %12.4e",
globalsum, chksum, fabs(globalsum - chksum)) ;
fflush(msgFile) ;
/*
----------------
free the objects
----------------
*/
IV_free(ownersIV) ;
IVL_free(ivl) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
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 -- 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) ; }
/*
--------------------------------------------------------------------
fill *pndom with ndom, the number of domains.
fill *pnseg with nseg, the number of segments.
domains are numbered in [0, ndom), segments in [ndom,ndom+nseg).
return -- an IV object that contains the map
from vertices to segments
created -- 99feb29, cca
--------------------------------------------------------------------
*/
IV *
GPart_domSegMap (
GPart *gpart,
int *pndom,
int *pnseg
) {
FILE *msgFile ;
Graph *g ;
int adjdom, count, d, first, ierr, ii, jj1, jj2, last, ndom,
msglvl, nextphi, nPhi, nPsi, nV, phi, phi0, phi1, phi2, phi3,
psi, sigma, size, size0, size1, size2, v, vsize, w ;
int *adj, *adj0, *adj1, *adj2, *compids, *dmark, *dsmap, *head,
*link, *list, *offsets, *PhiToPsi, *PhiToV, *PsiToSigma,
*vadj, *VtoPhi ;
IV *dsmapIV ;
IVL *PhiByPhi, *PhiByPowD, *PsiByPowD ;
/*
--------------------
set the initial time
--------------------
*/
icputimes = 0 ;
MARKTIME(cputimes[icputimes]) ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL
|| (g = gpart->g) == NULL
|| pndom == NULL
|| pnseg == NULL ) {
fprintf(stderr, "\n fatal error in GPart_domSegMap(%p,%p,%p)"
"\n bad input\n", gpart, pndom, pnseg) ;
exit(-1) ;
}
compids = IV_entries(&gpart->compidsIV) ;
msglvl = gpart->msglvl ;
msgFile = gpart->msgFile ;
/*
------------------------
create the map IV object
------------------------
*/
nV = g->nvtx ;
dsmapIV = IV_new() ;
IV_init(dsmapIV, nV, NULL) ;
dsmap = IV_entries(dsmapIV) ;
/*
----------------------------------
check compids[] and get the number
of domains and interface vertices
----------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
ndom = nPhi = 0 ;
for ( v = 0 ; v < nV ; v++ ) {
if ( (d = compids[v]) < 0 ) {
fprintf(stderr,
"\n fatal error in GPart_domSegMap(%p,%p,%p)"
"\n compids[%d] = %d\n", gpart, pndom, pnseg,
v, compids[v]) ;
exit(-1) ;
} else if ( d == 0 ) {
nPhi++ ;
} else if ( ndom < d ) {
ndom = d ;
}
}
*pndom = ndom ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n Inside GPart_domSegMap") ;
fprintf(msgFile, "\n %d domains, %d Phi vertices", ndom, nPhi) ;
}
if ( ndom == 1 ) {
IVfill(nV, dsmap, 0) ;
*pndom = 1 ;
*pnseg = 0 ;
return(dsmapIV) ;
}
/*
--------------------------------
get the maps
PhiToV : [0,nPhi) |---> [0,nV)
VtoPhi : [0,nV) |---> [0,nPhi)
--------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PhiToV = IVinit(nPhi, -1) ;
VtoPhi = IVinit(nV, -1) ;
for ( v = 0, phi = 0 ; v < nV ; v++ ) {
if ( (d = compids[v]) == 0 ) {
PhiToV[phi] = v ;
VtoPhi[v] = phi++ ;
}
}
if ( phi != nPhi ) {
fprintf(stderr,
"\n fatal error in GPart_domSegMap(%p,%p,%p)"
"\n phi = %d != %d = nPhi\n",
gpart, pndom, pnseg, phi, nPhi) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiToV(%d) :", nPhi) ;
IVfp80(msgFile, nPhi, PhiToV, 15, &ierr) ;
fflush(msgFile) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n VtoPhi(%d) :", nV) ;
IVfp80(msgFile, nV, VtoPhi, 15, &ierr) ;
fflush(msgFile) ;
}
/*
---------------------------------------------------
create an IVL object, PhiByPowD, to hold lists from
the interface vertices to their adjacent domains
---------------------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
dmark = IVinit(ndom+1, -1) ;
if ( nPhi >= ndom ) {
list = IVinit(nPhi, -1) ;
} else {
list = IVinit(ndom, -1) ;
}
PhiByPowD = IVL_new() ;
IVL_init1(PhiByPowD, IVL_CHUNKED, nPhi) ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
v = PhiToV[phi] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
/*
if ( phi == 0 ) {
int ierr ;
fprintf(msgFile, "\n adj(%d,%d) = ", v, phi) ;
IVfp80(msgFile, vsize, vadj, 15, &ierr) ;
fflush(msgFile) ;
}
*/
count = 0 ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
if ( (w = vadj[ii]) < nV
&& (d = compids[w]) > 0
&& dmark[d] != phi ) {
dmark[d] = phi ;
list[count++] = d ;
}
}
if ( count > 0 ) {
IVqsortUp(count, list) ;
IVL_setList(PhiByPowD, phi, count, list) ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiByPowD : interface x adjacent domains") ;
IVL_writeForHumanEye(PhiByPowD, msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------------
create an IVL object, PhiByPhi to hold lists
from the interface vertices to interface vertices.
(s,t) are in the list if (s,t) is an edge in the graph
and s and t do not share an adjacent domain
-------------------------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PhiByPhi = IVL_new() ;
IVL_init1(PhiByPhi, IVL_CHUNKED, nPhi) ;
offsets = IVinit(nPhi, 0) ;
head = IVinit(nPhi, -1) ;
link = IVinit(nPhi, -1) ;
for ( phi1 = 0 ; phi1 < nPhi ; phi1++ ) {
count = 0 ;
if ( msglvl > 2 ) {
v = PhiToV[phi1] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
fprintf(msgFile, "\n checking out phi = %d, v = %d", phi1, v) ;
fprintf(msgFile, "\n adj(%d) : ", v) ;
IVfp80(msgFile, vsize, vadj, 10, &ierr) ;
}
/*
-------------------------------------------------------------
get (phi1, phi0) edges that were previously put into the list
-------------------------------------------------------------
*/
if ( msglvl > 3 ) {
if ( head[phi1] == -1 ) {
fprintf(msgFile, "\n no previous edges") ;
} else {
fprintf(msgFile, "\n previous edges :") ;
}
}
for ( phi0 = head[phi1] ; phi0 != -1 ; phi0 = nextphi ) {
if ( msglvl > 3 ) {
fprintf(msgFile, " %d", phi0) ;
}
nextphi = link[phi0] ;
list[count++] = phi0 ;
IVL_listAndSize(PhiByPhi, phi0, &size0, &adj0) ;
if ( (ii = ++offsets[phi0]) < size0 ) {
/*
----------------------------
link phi0 into the next list
----------------------------
*/
phi2 = adj0[ii] ;
link[phi0] = head[phi2] ;
head[phi2] = phi0 ;
}
}
/*
--------------------------
get new edges (phi1, phi2)
--------------------------
*/
IVL_listAndSize(PhiByPowD, phi1, &size1, &adj1) ;
v = PhiToV[phi1] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
if ( (w = vadj[ii]) < nV
&& compids[w] == 0
&& (phi2 = VtoPhi[w]) > phi1 ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n checking out phi2 = %d", phi2) ;
}
/*
--------------------------------------------------
see if phi1 and phi2 have a common adjacent domain
--------------------------------------------------
*/
IVL_listAndSize(PhiByPowD, phi2, &size2, &adj2) ;
adjdom = 0 ;
jj1 = jj2 = 0 ;
while ( jj1 < size1 && jj2 < size2 ) {
if ( adj1[jj1] < adj2[jj2] ) {
jj1++ ;
} else if ( adj1[jj1] > adj2[jj2] ) {
jj2++ ;
} else {
if ( msglvl > 3 ) {
fprintf(msgFile, ", common adj domain %d", adj1[jj1]) ;
}
adjdom = 1 ;
break ;
}
}
if ( adjdom == 0 ) {
if ( msglvl > 3 ) {
fprintf(msgFile, ", no adjacent domain") ;
}
list[count++] = phi2 ;
}
}
}
if ( count > 0 ) {
/*
---------------------
set the list for phi1
---------------------
*/
IVqsortUp(count, list) ;
IVL_setList(PhiByPhi, phi1, count, list) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n edge list for %d :", phi1) ;
IVfp80(msgFile, count, list, 15, &ierr) ;
}
for ( ii = 0, phi2 = -1 ; ii < count ; ii++ ) {
if ( list[ii] > phi1 ) {
offsets[phi1] = ii ;
phi2 = list[ii] ;
break ;
}
}
if ( phi2 != -1 ) {
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n linking %d into list for %d", phi1, phi2) ;
}
link[phi1] = head[phi2] ;
head[phi2] = phi1 ;
}
/*
phi2 = list[0] ;
link[phi1] = head[phi2] ;
head[phi2] = phi1 ;
*/
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiByPhi : interface x interface") ;
IVL_writeForHumanEye(PhiByPhi, msgFile) ;
fflush(msgFile) ;
}
/*
--------------------
get the PhiToPsi map
--------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PhiToPsi = IVinit(nPhi, -1) ;
nPsi = 0 ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
if ( PhiToPsi[phi] == -1 ) {
/*
---------------------------
phi not yet mapped to a psi
---------------------------
*/
first = last = 0 ;
list[0] = phi ;
PhiToPsi[phi] = nPsi ;
while ( first <= last ) {
phi2 = list[first++] ;
IVL_listAndSize(PhiByPhi, phi2, &size, &adj) ;
for ( ii = 0 ; ii < size ; ii++ ) {
phi3 = adj[ii] ;
if ( PhiToPsi[phi3] == -1 ) {
PhiToPsi[phi3] = nPsi ;
list[++last] = phi3 ;
}
}
}
nPsi++ ;
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n nPsi = %d", nPsi) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiToPsi(%d) :", nPhi) ;
IVfp80(msgFile, nPhi, PhiToPsi, 15, &ierr) ;
fflush(msgFile) ;
}
/*
---------------------------------
create an IVL object, Psi --> 2^D
---------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
IVfill(nPsi, head, -1) ;
IVfill(nPhi, link, -1) ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
psi = PhiToPsi[phi] ;
link[phi] = head[psi] ;
head[psi] = phi ;
}
PsiByPowD = IVL_new() ;
IVL_init1(PsiByPowD, IVL_CHUNKED, nPsi) ;
IVfill(ndom+1, dmark, -1) ;
for ( psi = 0 ; psi < nPsi ; psi++ ) {
count = 0 ;
for ( phi = head[psi] ; phi != -1 ; phi = link[phi] ) {
v = PhiToV[phi] ;
Graph_adjAndSize(g, v, &size, &adj) ;
for ( ii = 0 ; ii < size ; ii++ ) {
if ( (w = adj[ii]) < nV
&& (d = compids[w]) > 0
&& dmark[d] != psi ) {
dmark[d] = psi ;
list[count++] = d ;
}
}
}
if ( count > 0 ) {
IVqsortUp(count, list) ;
IVL_setList(PsiByPowD, psi, count, list) ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PsiByPowD(%d) :", nPhi) ;
IVL_writeForHumanEye(PsiByPowD, msgFile) ;
fflush(msgFile) ;
}
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
/*
-------------------------------------
now get the map Psi |---> Sigma that
is the equivalence map over PhiByPowD
-------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PsiToSigma = IVL_equivMap1(PsiByPowD) ;
*pnseg = 1 + IVmax(nPsi, PsiToSigma, &ii) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n nSigma = %d", *pnseg) ;
fprintf(msgFile, "\n PsiToSigma(%d) :", nPhi) ;
IVfp80(msgFile, nPsi, PsiToSigma, 15, &ierr) ;
fflush(msgFile) ;
}
/*
--------------------------------------------------------------
now fill the map from the vertices to the domains and segments
--------------------------------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
for ( v = 0 ; v < nV ; v++ ) {
if ( (d = compids[v]) > 0 ) {
dsmap[v] = d - 1 ;
} else {
phi = VtoPhi[v] ;
psi = PhiToPsi[phi] ;
sigma = PsiToSigma[psi] ;
dsmap[v] = ndom + sigma ;
}
}
/*
------------------------
free the working storage
------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
IVL_free(PhiByPhi) ;
IVL_free(PhiByPowD) ;
IVL_free(PsiByPowD) ;
IVfree(PhiToV) ;
IVfree(VtoPhi) ;
IVfree(dmark) ;
IVfree(list) ;
IVfree(PhiToPsi) ;
IVfree(head) ;
IVfree(link) ;
IVfree(offsets) ;
IVfree(PsiToSigma) ;
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n domain/segment map timings split") ;
fprintf(msgFile,
"\n %9.5f : create the DSmap object"
"\n %9.5f : get numbers of domain and interface vertices"
"\n %9.5f : generate PhiToV and VtoPhi"
"\n %9.5f : generate PhiByPowD"
"\n %9.5f : generate PhiByPhi"
"\n %9.5f : generate PhiToPsi"
"\n %9.5f : generate PsiByPowD"
"\n %9.5f : generate PsiToSigma"
"\n %9.5f : generate dsmap"
"\n %9.5f : free working storage"
"\n %9.5f : total time",
cputimes[1] - cputimes[0],
cputimes[2] - cputimes[1],
cputimes[3] - cputimes[2],
cputimes[4] - cputimes[3],
cputimes[5] - cputimes[4],
cputimes[6] - cputimes[5],
cputimes[7] - cputimes[6],
cputimes[8] - cputimes[7],
cputimes[9] - cputimes[8],
cputimes[10] - cputimes[9],
cputimes[11] - cputimes[0]) ;
}
return(dsmapIV) ; }
/*
--------------------------------------------------
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 ; }
/*
--------------------------------------------------------------
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) ; }
/*
-------------------------------------------------------
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) ; }
/*
-------------------------------------------------------------
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 ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
----------------------------------------
get statistics for a semi-implicit solve
created -- 97dec11, cca
----------------------------------------
*/
{
char *inGraphFileName, *inETreeFileName, *inMapFileName ;
double nA21, nL, nL11, nL22, nPhi, nV, t1, t2 ;
ETree *etree ;
int ii, inside, J, K, msglvl, nfront, nJ,
nvtx, rc, sizeJ, v, vsize, w ;
int *adjJ, *frontmap, *map, *nodwghts,
*vadj, *vtxToFront, *vwghts ;
IV *mapIV ;
IVL *symbfacIVL ;
Graph *graph ;
FILE *msgFile ;
Tree *tree ;
if ( argc != 6 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile GraphFile ETreeFile mapFile "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n GraphFile -- input graph file, must be *.graphf or *.graphb"
"\n ETreeFile -- input ETree file, must be *.etreef or *.etreeb"
"\n mapFile -- input map IV 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) ;
}
inGraphFileName = argv[3] ;
inETreeFileName = argv[4] ;
inMapFileName = argv[5] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n GraphFile -- %s"
"\n ETreeFile -- %s"
"\n mapFile -- %s"
"\n",
argv[0], msglvl, argv[2],
inGraphFileName, inETreeFileName, inMapFileName) ;
fflush(msgFile) ;
/*
------------------------
read in the Graph object
------------------------
*/
graph = Graph_new() ;
if ( strcmp(inGraphFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
rc = Graph_readFromFile(graph, inGraphFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in graph from file %s",
t2 - t1, inGraphFileName) ;
nvtx = graph->nvtx ;
vwghts = graph->vwghts ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from Graph_readFromFile(%p,%s)",
rc, graph, inGraphFileName) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n after reading Graph object from file %s",
inGraphFileName) ;
Graph_writeForHumanEye(graph, msgFile) ;
fflush(msgFile) ;
}
/*
------------------------
read in the ETree object
------------------------
*/
etree = ETree_new() ;
if ( strcmp(inETreeFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
rc = ETree_readFromFile(etree, inETreeFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in etree from file %s",
t2 - t1, inETreeFileName) ;
nfront = ETree_nfront(etree) ;
tree = ETree_tree(etree) ;
vtxToFront = ETree_vtxToFront(etree) ;
nodwghts = ETree_nodwghts(etree) ;
nL = ETree_nFactorEntries(etree, 2) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)",
rc, etree, inETreeFileName) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n after reading ETree object from file %s",
inETreeFileName) ;
ETree_writeForHumanEye(etree, msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------
read in the map IV object
-------------------------
*/
mapIV = IV_new() ;
if ( strcmp(inMapFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
rc = IV_readFromFile(mapIV, inMapFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in mapIV from file %s",
t2 - t1, inMapFileName) ;
map = IV_entries(mapIV) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)",
rc, mapIV, inMapFileName) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n after reading IV object from file %s",
inMapFileName) ;
IV_writeForHumanEye(mapIV, msgFile) ;
fflush(msgFile) ;
}
nV = nPhi = 0 ;
if ( vwghts == NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
nV++ ;
if ( map[v] == 0 ) {
nPhi++ ;
}
}
} else {
for ( v = 0 ; v < nvtx ; v++ ) {
nV += vwghts[v] ;
if ( map[v] == 0 ) {
nPhi += vwghts[v] ;
}
}
}
fprintf(msgFile, "\n nPhi = %.0f, nV = %.0f", nPhi, nV) ;
/*
-------------------------
get the frontmap[] vector
-------------------------
*/
frontmap = IVinit(nfront, -1) ;
for ( v = 0 ; v < nvtx ; v++ ) {
J = vtxToFront[v] ;
if ( frontmap[J] == -1 ) {
frontmap[J] = map[v] ;
} else if ( frontmap[J] != map[v] ) {
fprintf(msgFile, "\n\n error, frontmap[%d] = %d, map[%d] = %d",
J, frontmap[J], v, map[v]) ;
}
}
/*
----------------------------------
compute the symbolic factorization
----------------------------------
*/
symbfacIVL = SymbFac_initFromGraph(etree, graph) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n symbolic factorization") ;
IVL_writeForHumanEye(symbfacIVL, msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------------------------
compute the number of entries in L11 and L22
--------------------------------------------
*/
nL11 = nL22 = 0 ;
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
nJ = nodwghts[J] ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n front %d, nJ = %d", J, nJ) ;
}
IVL_listAndSize(symbfacIVL, J, &sizeJ, &adjJ) ;
for ( ii = 0, inside = 0 ; ii < sizeJ ; ii++ ) {
w = adjJ[ii] ;
K = vtxToFront[w] ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n w = %d, K = %d", w, K) ;
}
if ( K > J && frontmap[K] == frontmap[J] ) {
inside += (vwghts == NULL) ? 1 : vwghts[w] ;
if ( msglvl > 3 ) {
fprintf(msgFile, ", inside") ;
}
}
}
if ( frontmap[J] != 0 ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n inside = %d, adding %d to L11",
inside, nJ*nJ + 2*nJ*inside) ;
}
nL11 += nJ*nJ + 2*nJ*inside ;
} else {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n inside = %d, adding %d to L22",
inside, nJ*nJ + 2*nJ*inside) ;
}
nL22 += nJ*nJ + 2*nJ*inside ;
}
}
if ( msglvl > 0 ) {
fprintf(msgFile, "\n |L| = %.0f, |L11| = %.0f, |L22| = %.0f",
nL, nL11, nL22) ;
}
/*
------------------------------------
compute the number of entries in A21
------------------------------------
*/
nA21 = 0 ;
if ( vwghts != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
if ( map[v] == 0 ) {
Graph_adjAndSize(graph, v, &vsize, &vadj) ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( map[v] != map[w] ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n A21 : v = %d, w = %d", v, w) ;
}
nA21 += vwghts[v] * vwghts[w] ;
}
}
}
}
} else {
for ( v = 0 ; v < nvtx ; v++ ) {
if ( map[v] == 0 ) {
Graph_adjAndSize(graph, v, &vsize, &vadj) ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( map[v] != map[w] ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n A21 : v = %d, w = %d", v, w) ;
}
nA21++ ;
}
}
}
}
}
if ( msglvl > 0 ) {
fprintf(msgFile,
"\n |L| = %.0f, |L11| = %.0f, |L22| = %.0f, |A21| = %.0f",
nL, nL11, nL22, nA21) ;
fprintf(msgFile,
"\n storage: explicit = %.0f, semi-implicit = %.0f, ratio = %.3f"
"\n opcount: explicit = %.0f, semi-implicit = %.0f, ratio = %.3f",
nL, nL11 + nA21 + nL22,
nL/(nL11 + nA21 + nL22),
2*nL, 4*nL11 + 2*nA21 + 2*nL22,
2*nL/(4*nL11 + 2*nA21 + 2*nL22)) ;
fprintf(msgFile, "\n ratios %8.3f %8.3f %8.3f",
nPhi/nV,
nL/(nL11 + nA21 + nL22),
2*nL/(4*nL11 + 2*nA21 + 2*nL22)) ;
}
/*
------------------------
free the working storage
------------------------
*/
Graph_free(graph) ;
ETree_free(etree) ;
IV_free(mapIV) ;
IVL_free(symbfacIVL) ;
IVfree(frontmap) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*
--------------------------------------------------------------------
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) ; }