/*
----------------------------------------
if the new-to-old vector is not present,
create it and fill its entries
created -- 96mar16, cca
----------------------------------------
*/
void
Perm_fillNewToOld (
Perm *perm
) {
int size ;
/*
---------------
check the input
---------------
*/
if ( perm == NULL
|| perm->isPresent < 1 || perm->isPresent > 3
|| (size = perm->size) <= 0 ) {
fprintf(stderr, "\n fatal error in Perm_fillNewToOld(%p)"
"\n bad input\n", perm) ;
spoolesFatal();
}
if ( perm->isPresent == 2 ) {
int iold ;
int *newToOld = perm->newToOld = IVinit(size, -1) ;
int *oldToNew = perm->oldToNew ;
for ( iold = 0 ; iold < size ; iold++ ) {
newToOld[oldToNew[iold]] = iold ;
}
perm->isPresent = 3 ;
}
return ; }
/*
----------------------------------------
if the old-to-new vector is not present,
create it and fill its entries
created -- 96mar16, cca
----------------------------------------
*/
void
Perm_fillOldToNew (
Perm *perm
) {
int size ;
/*
---------------
check the input
---------------
*/
if ( perm == NULL
|| perm->isPresent < 1 || perm->isPresent > 3
|| (size = perm->size) <= 0 ) {
fprintf(stderr, "\n fatal error in Perm_fillOldToNew(%p)"
"\n bad input\n", perm) ;
spoolesFatal();
}
if ( perm->isPresent == 1 ) {
int inew ;
int *newToOld = perm->newToOld ;
int *oldToNew = perm->oldToNew = IVinit(size, -1) ;
for ( inew = 0 ; inew < size ; inew++ ) {
oldToNew[newToOld[inew]] = inew ;
}
perm->isPresent = 3 ;
}
return ; }
/*
-------------------------------------------------------------
purpose -- allocate an int array and fill with the inverse of
y[]. note, y[] must be a permutation vector.
created : 95sep22, cca
-------------------------------------------------------------
*/
int *
IVinverse (
int size,
int y[]
) {
int *x = NULL ;
if ( size > 0 ) {
if ( y == NULL ) {
fprintf(stderr, "\n fatal error in IVinverse, invalid data"
"\n size = %d, y = %p\n", size, y) ;
exit(-1) ;
} else {
int i, j ;
x = IVinit(size, -1) ;
for ( i = 0 ; i < size ; i++ ) {
j = y[i] ;
if ( j < 0 || j >= size || x[j] != -1 ) {
fprintf(stderr,
"\n fatal error in IVinverse"
"\n y[%d] = %d, value out-of-range or repeated",
i, j) ;
exit(-1) ;
}
x[j] = i ;
}
}
}
return(x) ; }
/*
---------------------------------------------------------
set the compids[] vector using a global map from vertices
to domains and interface nodes.
DDmapIV -- IV object that contains the map from vertices
to domains and interface nodes
created -- 96mar17, cca
---------------------------------------------------------
*/
void
GPart_DDviaProjection (
GPart *gpart,
IV *DDmapIV
) {
int *compids, *domainMap, *map, *vtxMap ;
int dom, domloc, ndom, ndomloc, nvtx, vglob, vloc ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || DDmapIV == NULL ) {
fprintf(stderr, "\n fatal error in GPart_DDviaProjection(%p,%p)"
"\n bad input\n", gpart, DDmapIV) ;
exit(-1) ;
}
nvtx = gpart->nvtx ;
compids = IV_entries(&gpart->compidsIV) ;
/*
--------------------------
find the number of domains
--------------------------
*/
vtxMap = IV_entries(&gpart->vtxMapIV) ;
map = IV_entries(DDmapIV) ;
ndom = IV_max(DDmapIV) ;
/*
------------------------
check for a quick return
------------------------
*/
if ( gpart->par == NULL ) {
IVcopy(nvtx, compids, map) ;
gpart->ncomp = ndom ;
return ;
}
/*
----------------------------------------
fill compids[] with the local domain ids
----------------------------------------
*/
domainMap = IVinit(ndom+1, -1) ;
ndomloc = 0 ;
for ( vloc = 0 ; vloc < nvtx ; vloc++ ) {
vglob = vtxMap[vloc] ;
if ( (dom = map[vglob]) > 0 ) {
if ( (domloc = domainMap[dom]) == -1 ) {
domloc = domainMap[dom] = ++ndomloc ;
}
compids[vloc] = domloc ;
} else {
compids[vloc] = 0 ;
}
}
gpart->ncomp = ndomloc ;
IVfree(domainMap) ;
return ; }
/*
----------------------------------------------------------
check that the permutation object does house a permutation
return value --
1 if a true permutation
0 otherwise
----------------------------------------------------------
*/
int
Perm_checkPerm (
Perm *perm
) {
int inew, iold, rc, size ;
int *counts, *newToOld, *oldToNew ;
/*
---------------
check the input
---------------
*/
if ( perm == NULL
|| perm->isPresent < 1 || perm->isPresent > 3
|| (size = perm->size) <= 0 ) {
fprintf(stderr, "\n fatal error in Perm_checkPerm(%p)"
"\n bad input\n", perm) ;
spoolesFatal();
}
rc = 1 ;
counts = IVinit(size, 0) ;
if ( (newToOld = perm->newToOld) != NULL ) {
for ( inew = 0 ; inew < size ; inew++ ) {
if ( 0 <= (iold = newToOld[inew]) && iold < size ) {
counts[iold]++ ;
} else {
IVfree(counts) ;
return(0) ;
}
}
for ( iold = 0 ; iold < size ; iold++ ) {
if ( counts[iold] != 1 ) {
IVfree(counts) ;
return(0) ;
}
}
}
if ( (oldToNew = perm->oldToNew) != NULL ) {
IVzero(size, counts) ;
for ( iold = 0 ; iold < size ; iold++ ) {
if ( 0 <= (inew = oldToNew[iold]) && inew < size ) {
counts[inew]++ ;
} else {
IVfree(counts) ;
return(0) ;
}
}
for ( inew = 0 ; inew < size ; inew++ ) {
if ( counts[inew] != 1 ) {
IVfree(counts) ;
return(0) ;
}
}
}
IVfree(counts) ;
return(rc) ; }
/*
-----------------------
initialize the object
created -- 95oct07, cca
-----------------------
*/
void
BKL_init (
BKL *bkl,
BPG *bpg,
float alpha
) {
/*
---------------
check the input
---------------
*/
if ( bkl == NULL || bpg == NULL ) {
fprintf(stderr, "\n fatal error in BKL_init(%p,%p,%f)"
"\n bad input\n", bkl, bpg, alpha) ;
exit(-1) ;
}
/*
--------------
clear the data
--------------
*/
BKL_clearData(bkl) ;
/*
---------------------
initialize the fields
---------------------
*/
bkl->bpg = bpg ;
bkl->ndom = bpg->nX ;
bkl->nseg = bpg->nY ;
bkl->nreg = bpg->nX + bpg->nY ;
if ( bpg->graph->vwghts == NULL ) {
bkl->totweight = bkl->nreg ;
bkl->regwghts = IVinit(bkl->nreg, 1) ;
} else {
bkl->regwghts = bpg->graph->vwghts ;
bkl->totweight = IVsum(bkl->nreg, bkl->regwghts) ;
}
bkl->colors = IVinit(bkl->nreg, 0) ;
bkl->alpha = alpha ;
return ; }
/*
------------------------------------------------------------------
purpose -- set the scalars and allocate the vectors for the object
created -- 98mar19, cca
------------------------------------------------------------------
*/
void
SolveMap_init (
SolveMap *solvemap,
int symmetryflag,
int nfront,
int nproc,
int nblockUpper,
int nblockLower
) {
/*
---------------
check the input
---------------
*/
if ( solvemap == NULL || symmetryflag < 0 || nfront <= 0
|| nproc < 0 || nblockUpper < 0 || nblockLower < 0 ) {
fprintf(stderr, "\n fatal error in SolveMap_init(%p,%d,%d,%d,%d,%d)"
"\n bad input\n", solvemap, symmetryflag, nfront,
nproc, nblockUpper, nblockLower) ;
spoolesFatal();
}
/*
----------------
clear the object
----------------
*/
SolveMap_clearData(solvemap) ;
/*
---------------
set the scalars
---------------
*/
solvemap->symmetryflag = symmetryflag ;
solvemap->nfront = nfront ;
solvemap->nproc = nproc ;
solvemap->nblockUpper = nblockUpper ;
solvemap->nblockLower = nblockLower ;
/*
------------------------
allocate the data arrays
------------------------
*/
solvemap->owners = IVinit(nfront, -1) ;
solvemap->rowidsUpper = IVinit(nblockUpper, -1) ;
solvemap->colidsUpper = IVinit(nblockUpper, -1) ;
solvemap->mapUpper = IVinit(nblockUpper, -1) ;
if ( symmetryflag == SPOOLES_NONSYMMETRIC && nblockLower > 0 ) {
solvemap->rowidsLower = IVinit(nblockLower, -1) ;
solvemap->colidsLower = IVinit(nblockLower, -1) ;
solvemap->mapLower = IVinit(nblockLower, -1) ;
}
return ; }
/*
-------------------------------------
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) ; }
/*
---------------------------------------------
simplest initialization method
if entries != NULL
the object does not own the entries,
it just points to the entries base address
else if size > 0
the object will own the entries,
it allocates a vector of size int's.
else
nothing happens
endif
created -- 96aug28, cca
---------------------------------------------
*/
void
IV_init (
IV *iv,
int size,
int *entries
) {
if ( iv == NULL || size < 0 ) {
fprintf(stderr, "\n fatal error in IV_init(%p,%d,%p)"
"\n bad input\n", iv, size, entries) ;
exit(-1) ;
}
/*
--------------
clear any data
--------------
*/
IV_clearData(iv) ;
/*
-----------------------------
set the size and maximum size
-----------------------------
*/
iv->maxsize = iv->size = size ;
/*
-------------------------
set vector and owner flag
-------------------------
*/
if ( entries != NULL ) {
iv->owned = 0 ;
iv->vec = entries ;
} else if ( size > 0 ) {
iv->owned = 1 ;
iv->vec = IVinit(size, -1) ;
}
/*
fprintf(stdout,
"\n %% leaving IV_init, iv %p, size %d, maxsize %d, entries %p",
iv, iv->size, iv->maxsize, iv->vec) ;
fflush(stdout) ;
*/
return ; }
/*
---------------------------------------
purpose -- initialize the EGraph object
created -- 96oct24, cca
---------------------------------------
*/
void
EGraph_init (
EGraph *egraph,
int type,
int nelem,
int nvtx,
int IVL_type
) {
/*
---------------
check the input
---------------
*/
if ( egraph == NULL || type < 0 || type > 1
|| nelem <= 0 || nvtx <= 0 ) {
fprintf(stderr, "\n fatal error in EGraph_init(%p,%d,%d,%d,%d)"
"\n bad input\n", egraph, type, nelem, nvtx, IVL_type) ;
exit(-1) ;
}
/*
----------------------------
clear the data in the object
----------------------------
*/
EGraph_clearData(egraph) ;
/*
---------------------
initialize the object
---------------------
*/
egraph->type = type ;
egraph->nelem = nelem ;
egraph->nvtx = nvtx ;
egraph->adjIVL = IVL_new() ;
IVL_init1(egraph->adjIVL, IVL_type, nelem) ;
if ( type == 1 ) {
egraph->vwghts = IVinit(nvtx, 0) ;
}
return ; }
/*
-----------------------------------------
permute the columns of the matrix
A(*,*) = A(*,index(*))
this method calls A2_sortColumnsUp
but does not overwrite the index[] vector
created -- 98apr15, cca
-----------------------------------------
*/
void
A2_permuteColumns (
A2 *mtx,
int ncol,
int index[]
) {
int *colids ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || ncol < 0 || ncol > mtx->n2 || index == NULL ) {
fprintf(stderr, "\n fatal error in A2_permuteColumns(%p,%d,%p)"
"\n bad input\n", mtx, ncol, index) ;
exit(-1) ;
}
colids = IVinit(ncol, -1) ;
IVcopy(ncol, colids, index) ;
A2_sortColumnsUp(mtx, ncol, colids) ;
IVfree(colids) ;
return ; }
/*
-----------------------------------------
permute the rows of the matrix
A(*,*) = A(index(*),*)
this method calls A2_sortRowsUp
but does not overwrite the index[] vector
created -- 98apr15, cca
-----------------------------------------
*/
void
A2_permuteRows (
A2 *mtx,
int nrow,
int index[]
) {
int *rowids ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || nrow < 0 || nrow > mtx->n1 || index == NULL ) {
fprintf(stderr, "\n fatal error in A2_permuteRows(%p,%d,%p)"
"\n bad input\n", mtx, nrow, index) ;
exit(-1) ;
}
rowids = IVinit(nrow, -1) ;
IVcopy(nrow, rowids, index) ;
A2_sortRowsUp(mtx, nrow, rowids) ;
IVfree(rowids) ;
return ; }
/*
-------------------------------------------------------------
purpose --
the IVL object ivl and IV object ownersIV are both found on
each process. the ownersIV object is identical over all the
processes, and owners[ii] tells which processes owns list ii
of the ivl object. on return from this method, the ivl object
is replicated over all the processes. each process sends
the lists that it owns to all the other processes.
created -- 98apr03, cca
-------------------------------------------------------------
*/
void
IVL_MPI_allgather (
IVL *ivl,
IV *ownersIV,
int stats[],
int msglvl,
FILE *msgFile,
int firsttag,
MPI_Comm comm
) {
int count, destination, ii, ilist, incount, jlist,
jproc, left, maxcount, myid, nlist, nmylists,
notherlists, nowners, nproc, offset, outcount,
right, size, source, tag ;
int *counts, *inbuffer, *list, *outbuffer, *owners ;
MPI_Status status ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || ownersIV == NULL ) {
fprintf(stderr, "\n fatal error in IVL_MPI_allgather()"
"\n ivl = %p, ownersIV = %p\n",
ivl, ownersIV) ;
exit(-1) ;
}
/*
----------------------------------------------
get id of self, # of processes and # of fronts
----------------------------------------------
*/
MPI_Comm_rank(comm, &myid) ;
MPI_Comm_size(comm, &nproc) ;
nlist = ivl->nlist ;
IV_sizeAndEntries(ownersIV, &nowners, &owners) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n inside IVL_MPI_allgather()"
"\n nproc = %d, myid = %d, nlist = %d, nowners = %d",
nproc, myid, nlist, nowners) ;
fflush(msgFile) ;
}
if ( nlist != nowners || owners == NULL ) {
fprintf(stderr, "\n fatal error in IVL_MPI_allgather()"
"\n nlist = %d, nowners = %d, owners = %p\n",
nlist, nowners, owners) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ivl") ;
IVL_writeForHumanEye(ivl, msgFile) ;
fprintf(msgFile, "\n\n ownersIV") ;
IV_writeForHumanEye(ownersIV, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------------------------------
step 1 : determine the size of the message that
this process will send to the others
-----------------------------------------------
*/
for ( ilist = 0, outcount = 1 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] < 0 || owners[ilist] >= nproc ) {
fprintf(stderr, "\n owners[%d] = %d", ilist, owners[ilist]) ;
exit(-1) ;
}
if ( owners[ilist] == myid ) {
outcount += 2 ;
IVL_listAndSize(ivl, ilist, &size, &list) ;
outcount += size ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n outcount = %d", outcount) ;
fflush(msgFile) ;
}
/*
----------------------------------------------------
do an all-to-all gather/scatter
counts[jproc] = # of int's in the message from jproc
----------------------------------------------------
*/
counts = IVinit(nproc, 0) ;
counts[myid] = outcount ;
MPI_Allgather((void *) &counts[myid], 1, MPI_INT,
(void *) counts, 1, MPI_INT, comm) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n counts") ;
IVfprintf(msgFile, nproc, counts) ;
fflush(msgFile) ;
}
/*
-----------------------------
set up the in and out buffers
-----------------------------
*/
if ( outcount > 0 ) {
outbuffer = IVinit(outcount, -1) ;
for ( ilist = nmylists = 0, ii = 1 ; ilist < nlist ; ilist++ ) {
if ( owners[ilist] == myid ) {
nmylists++ ;
IVL_listAndSize(ivl, ilist, &size, &list) ;
outbuffer[ii++] = ilist ;
outbuffer[ii++] = size ;
if ( size > 0 ) {
IVcopy(size, &outbuffer[ii], list) ;
ii += size ;
}
}
}
outbuffer[0] = nmylists ;
if ( ii != outcount ) {
fprintf(stderr, "\n myid = %d, ii = %d, outcount = %d",
myid, ii, outcount) ;
fprintf(msgFile, "\n myid = %d, ii = %d, outcount = %d",
myid, ii, outcount) ;
exit(-1) ;
}
} else {
outbuffer = NULL ;
}
maxcount = IVmax(nproc, counts, &jproc) ;
if ( maxcount > 0 ) {
inbuffer = IVinit(maxcount, -1) ;
} else {
inbuffer = NULL ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n outbuffer %p, maxcount %d, inbuffer %p",
outbuffer, maxcount, inbuffer) ;
fflush(msgFile) ;
}
/*
-------------------------------------
step 2: loop over the other processes
send and receive information
-------------------------------------
*/
for ( offset = 1, tag = firsttag ; offset < nproc ; offset++, tag++ ) {
right = (myid + offset) % nproc ;
if ( offset <= myid ) {
left = myid - offset ;
} else {
left = nproc + myid - offset ;
}
if ( outcount > 0 ) {
destination = right ;
stats[0]++ ;
stats[2] += outcount*sizeof(int) ;
} else {
destination = MPI_PROC_NULL ;
}
incount = counts[left] ;
if ( incount > 0 ) {
source = left ;
stats[1]++ ;
stats[3] += incount*sizeof(int) ;
} else {
source = MPI_PROC_NULL ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n offset %d, source %d, destination %d",
offset, source, destination) ;
fflush(msgFile) ;
}
/*
-----------------
do a send/receive
-----------------
*/
MPI_Sendrecv(outbuffer, outcount, MPI_INT, destination, tag,
inbuffer, incount, MPI_INT, source, tag,
comm, &status) ;
if ( source != MPI_PROC_NULL ) {
MPI_Get_count(&status, MPI_INT, &count) ;
if ( count != incount ) {
fprintf(stderr,
"\n 1. fatal error in IVL_MPI_allgather()"
"\n proc %d : source = %d, count = %d, incount = %d\n",
myid, source, count, incount) ;
exit(-1) ;
}
}
/*
----------------------------
set the values in the vector
----------------------------
*/
notherlists = inbuffer[0] ;
for ( ilist = 0, ii = 1 ; ilist < notherlists ; ilist++ ) {
jlist = inbuffer[ii++] ;
size = inbuffer[ii++] ;
if ( size > 0 ) {
IVL_setList(ivl, jlist, size, &inbuffer[ii]) ;
ii += size ;
}
}
if ( ii != incount ) {
fprintf(msgFile, "\n ii = %d, incount = %d", ii, incount) ;
fprintf(stderr, "\n ii = %d, incount = %d", ii, incount) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n after setting values") ;
IVL_writeForHumanEye(ivl, msgFile) ;
fflush(msgFile) ;
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(counts) ;
if ( outbuffer != NULL ) {
IVfree(outbuffer) ;
}
if ( inbuffer != NULL ) {
IVfree(inbuffer) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n leaving IVL_MPI_gatherall()") ;
fflush(msgFile) ;
}
return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------------------------
read BPG from file and get the Dulmage-Mendelsohn decomposition
created -- 96mar08, cca
---------------------------------------------------------------
*/
{
char *inBPGFileName ;
double t1, t2 ;
int ierr, msglvl, rc ;
int *dmflags, *stats ;
BPG *bpg ;
FILE *msgFile ;
if ( argc != 4 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile inFile "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inFile -- input file, must be *.bpgf or *.bpgb"
"\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) ;
}
inBPGFileName = argv[3] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inFile -- %s"
"\n",
argv[0], msglvl, argv[2], inBPGFileName) ;
fflush(msgFile) ;
/*
----------------------
read in the BPG object
----------------------
*/
if ( strcmp(inBPGFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
bpg = BPG_new() ;
MARKTIME(t1) ;
rc = BPG_readFromFile(bpg, inBPGFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in graph from file %s",
t2 - t1, inBPGFileName) ;
if ( rc != 1 ) {
fprintf(msgFile, "\n return value %d from BPG_readFromFile(%p,%s)",
rc, bpg, inBPGFileName) ;
exit(-1) ;
}
fprintf(msgFile, "\n\n after reading BPG object from file %s",
inBPGFileName) ;
if ( msglvl > 2 ) {
BPG_writeForHumanEye(bpg, msgFile) ;
} else {
BPG_writeStats(bpg, msgFile) ;
}
fflush(msgFile) ;
/*
--------------------------------------------
test out the max flow DMdecomposition method
--------------------------------------------
*/
dmflags = IVinit(bpg->nX + bpg->nY, -1) ;
stats = IVinit(6, 0) ;
MARKTIME(t1) ;
BPG_DMviaMaxFlow(bpg, dmflags, stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %9.5f : find DM via maxflow", t2 - t1) ;
if ( msglvl > 0 ) {
fprintf(msgFile,
"\n\n BPG_DMviaMaxFlow"
"\n |X_I| = %6d, |X_E| = %6d, |X_R| = %6d"
"\n |Y_I| = %6d, |Y_E| = %6d, |Y_R| = %6d",
stats[0], stats[1], stats[2],
stats[3], stats[4], stats[5]) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n dmflags") ;
IVfp80(msgFile, bpg->nX + bpg->nY, dmflags, 80, &ierr) ;
fflush(msgFile) ;
}
/*
------------------------------------------
test out the matching DMcomposition method
------------------------------------------
*/
IVfill(bpg->nX + bpg->nY, dmflags, -1) ;
IVfill(6, stats, -1) ;
MARKTIME(t1) ;
BPG_DMdecomposition(bpg, dmflags, stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %9.5f : find DM via matching", t2 - t1) ;
if ( msglvl > 0 ) {
fprintf(msgFile,
"\n\n BPG_DMdecomposition"
"\n |X_I| = %6d, |X_E| = %6d, |X_R| = %6d"
"\n |Y_I| = %6d, |Y_E| = %6d, |Y_R| = %6d",
stats[0], stats[1], stats[2],
stats[3], stats[4], stats[5]) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n dmflags") ;
IVfp80(msgFile, bpg->nX + bpg->nY, dmflags, 80, &ierr) ;
fflush(msgFile) ;
}
/*
----------------
free the storage
----------------
*/
IVfree(dmflags) ;
IVfree(stats) ;
BPG_free(bpg) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
------------------------------------------------------------------
generate a random matrix and test a matrix-matrix multiply method.
the output is a matlab file to test correctness.
created -- 98jan29, cca
--------------------------------------------------------------------
*/
{
DenseMtx *X, *Y, *Y2 ;
double alpha[2] ;
double alphaImag, alphaReal, t1, t2 ;
double *zvec ;
Drand *drand ;
int col, dataType, ii, msglvl, ncolA, nitem, nops, nrhs,
nrowA, nrowX, nrowY, nthread, row, seed,
storageMode, symflag, transposeflag ;
int *colids, *rowids ;
InpMtx *A ;
FILE *msgFile ;
if ( argc != 15 ) {
fprintf(stdout,
"\n\n %% usage : %s msglvl msgFile symflag storageMode "
"\n %% nrow ncol nent nrhs seed alphaReal alphaImag nthread"
"\n %% msglvl -- message level"
"\n %% msgFile -- message file"
"\n %% dataType -- type of matrix entries"
"\n %% 1 -- real"
"\n %% 2 -- complex"
"\n %% symflag -- symmetry flag"
"\n %% 0 -- symmetric"
"\n %% 1 -- hermitian"
"\n %% 2 -- nonsymmetric"
"\n %% storageMode -- storage mode"
"\n %% 1 -- by rows"
"\n %% 2 -- by columns"
"\n %% 3 -- by chevrons, (requires nrow = ncol)"
"\n %% transpose -- transpose flag"
"\n %% 0 -- Y := Y + alpha * A * X"
"\n %% 1 -- Y := Y + alpha * A^H * X, nonsymmetric only"
"\n %% 2 -- Y := Y + alpha * A^T * X, nonsymmetric only"
"\n %% nrowA -- number of rows in A"
"\n %% ncolA -- number of columns in A"
"\n %% nitem -- number of items"
"\n %% nrhs -- number of right hand sides"
"\n %% seed -- random number seed"
"\n %% alphaReal -- y := y + alpha*A*x"
"\n %% alphaImag -- y := y + alpha*A*x"
"\n %% nthread -- # of threads"
"\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) ;
}
dataType = atoi(argv[3]) ;
symflag = atoi(argv[4]) ;
storageMode = atoi(argv[5]) ;
transposeflag = atoi(argv[6]) ;
nrowA = atoi(argv[7]) ;
ncolA = atoi(argv[8]) ;
nitem = atoi(argv[9]) ;
nrhs = atoi(argv[10]) ;
seed = atoi(argv[11]) ;
alphaReal = atof(argv[12]) ;
alphaImag = atof(argv[13]) ;
nthread = atoi(argv[14]) ;
fprintf(msgFile,
"\n %% %s "
"\n %% msglvl -- %d"
"\n %% msgFile -- %s"
"\n %% dataType -- %d"
"\n %% symflag -- %d"
"\n %% storageMode -- %d"
"\n %% transposeflag -- %d"
"\n %% nrowA -- %d"
"\n %% ncolA -- %d"
"\n %% nitem -- %d"
"\n %% nrhs -- %d"
"\n %% seed -- %d"
"\n %% alphaReal -- %e"
"\n %% alphaImag -- %e"
"\n %% nthread -- %d"
"\n",
argv[0], msglvl, argv[2], dataType, symflag, storageMode,
transposeflag, nrowA, ncolA, nitem, nrhs, seed,
alphaReal, alphaImag, nthread) ;
fflush(msgFile) ;
if ( dataType != 1 && dataType != 2 ) {
fprintf(stderr, "\n invalid value %d for dataType\n", dataType) ;
spoolesFatal();
}
if ( symflag != 0 && symflag != 1 && symflag != 2 ) {
fprintf(stderr, "\n invalid value %d for symflag\n", symflag) ;
spoolesFatal();
}
if ( storageMode != 1 && storageMode != 2 && storageMode != 3 ) {
fprintf(stderr,
"\n invalid value %d for storageMode\n", storageMode) ;
spoolesFatal();
}
if ( transposeflag < 0
|| transposeflag > 2 ) {
fprintf(stderr, "\n error, transposeflag = %d, must be 0, 1 or 2",
transposeflag) ;
spoolesFatal();
}
if ( (transposeflag == 1 && symflag != 2)
|| (transposeflag == 2 && symflag != 2) ) {
fprintf(stderr, "\n error, transposeflag = %d, symflag = %d",
transposeflag, symflag) ;
spoolesFatal();
}
if ( transposeflag == 1 && dataType != 2 ) {
fprintf(stderr, "\n error, transposeflag = %d, dataType = %d",
transposeflag, dataType) ;
spoolesFatal();
}
if ( symflag == 1 && dataType != 2 ) {
fprintf(stderr,
"\n symflag = 1 (hermitian), dataType != 2 (complex)") ;
spoolesFatal();
}
if ( nrowA <= 0 || ncolA <= 0 || nitem <= 0 ) {
fprintf(stderr,
"\n invalid value: nrow = %d, ncol = %d, nitem = %d",
nrowA, ncolA, nitem) ;
spoolesFatal();
}
if ( symflag < 2 && nrowA != ncolA ) {
fprintf(stderr,
"\n invalid data: symflag = %d, nrow = %d, ncol = %d",
symflag, nrowA, ncolA) ;
spoolesFatal();
}
alpha[0] = alphaReal ;
alpha[1] = alphaImag ;
/*
----------------------------
initialize the matrix object
----------------------------
*/
A = InpMtx_new() ;
InpMtx_init(A, storageMode, dataType, 0, 0) ;
drand = Drand_new() ;
/*
----------------------------------
generate a vector of nitem triples
----------------------------------
*/
rowids = IVinit(nitem, -1) ;
Drand_setUniform(drand, 0, nrowA) ;
Drand_fillIvector(drand, nitem, rowids) ;
colids = IVinit(nitem, -1) ;
Drand_setUniform(drand, 0, ncolA) ;
Drand_fillIvector(drand, nitem, colids) ;
Drand_setUniform(drand, 0.0, 1.0) ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
zvec = DVinit(nitem, 0.0) ;
Drand_fillDvector(drand, nitem, zvec) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
zvec = ZVinit(nitem, 0.0, 0.0) ;
Drand_fillDvector(drand, 2*nitem, zvec) ;
}
/*
-----------------------------------
assemble the entries entry by entry
-----------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
}
if ( symflag == 1 ) {
/*
----------------
hermitian matrix
----------------
*/
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] == colids[ii] ) {
zvec[2*ii+1] = 0.0 ;
}
if ( rowids[ii] <= colids[ii] ) {
row = rowids[ii] ; col = colids[ii] ;
} else {
row = colids[ii] ; col = rowids[ii] ;
}
InpMtx_inputComplexEntry(A, row, col, zvec[2*ii], zvec[2*ii+1]) ;
}
} else if ( symflag == 0 ) {
/*
----------------
symmetric matrix
----------------
*/
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] <= colids[ii] ) {
row = rowids[ii] ; col = colids[ii] ;
} else {
row = colids[ii] ; col = rowids[ii] ;
}
InpMtx_inputRealEntry(A, row, col, zvec[ii]) ;
}
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] <= colids[ii] ) {
row = rowids[ii] ; col = colids[ii] ;
} else {
row = colids[ii] ; col = rowids[ii] ;
}
InpMtx_inputComplexEntry(A, row, col,
zvec[2*ii], zvec[2*ii+1]) ;
}
}
} else {
/*
-------------------
nonsymmetric matrix
-------------------
*/
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
InpMtx_inputRealEntry(A, rowids[ii], colids[ii], zvec[ii]) ;
}
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
InpMtx_inputComplexEntry(A, rowids[ii], colids[ii],
zvec[2*ii], zvec[2*ii+1]) ;
}
}
}
InpMtx_changeStorageMode(A, INPMTX_BY_VECTORS) ;
DVfree(zvec) ;
if ( symflag == 0 || symflag == 1 ) {
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
nops = 4*A->nent*nrhs ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
nops = 16*A->nent*nrhs ;
}
} else {
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
nops = 2*A->nent*nrhs ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
nops = 8*A->nent*nrhs ;
}
}
if ( msglvl > 1 ) {
/*
-------------------------------------------
write the assembled matrix to a matlab file
-------------------------------------------
*/
InpMtx_writeForMatlab(A, "A", msgFile) ;
if ( symflag == 0 ) {
fprintf(msgFile,
"\n for k = 1:%d"
"\n for j = k+1:%d"
"\n A(j,k) = A(k,j) ;"
"\n end"
"\n end", nrowA, ncolA) ;
} else if ( symflag == 1 ) {
fprintf(msgFile,
"\n for k = 1:%d"
"\n for j = k+1:%d"
"\n A(j,k) = ctranspose(A(k,j)) ;"
"\n end"
"\n end", nrowA, ncolA) ;
}
}
/*
-------------------------------
generate dense matrices X and Y
-------------------------------
*/
if ( transposeflag == 0 ) {
nrowX = ncolA ;
nrowY = nrowA ;
} else {
nrowX = nrowA ;
nrowY = ncolA ;
}
X = DenseMtx_new() ;
Y = DenseMtx_new() ;
Y2 = DenseMtx_new() ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
DenseMtx_init(X, SPOOLES_REAL, 0, 0, nrowX, nrhs, 1, nrowX) ;
Drand_fillDvector(drand, nrowX*nrhs, DenseMtx_entries(X)) ;
DenseMtx_init(Y, SPOOLES_REAL, 0, 0, nrowY, nrhs, 1, nrowY) ;
Drand_fillDvector(drand, nrowY*nrhs, DenseMtx_entries(Y)) ;
DenseMtx_init(Y2, SPOOLES_REAL, 0, 0, nrowY, nrhs, 1, nrowY) ;
DVcopy(nrowY*nrhs, DenseMtx_entries(Y2), DenseMtx_entries(Y)) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
DenseMtx_init(X, SPOOLES_COMPLEX, 0, 0, nrowX, nrhs, 1, nrowX) ;
Drand_fillDvector(drand, 2*nrowX*nrhs, DenseMtx_entries(X)) ;
DenseMtx_init(Y, SPOOLES_COMPLEX, 0, 0, nrowY, nrhs, 1, nrowY) ;
Drand_fillDvector(drand, 2*nrowY*nrhs, DenseMtx_entries(Y)) ;
DenseMtx_init(Y2, SPOOLES_COMPLEX, 0, 0, nrowY, nrhs, 1, nrowY) ;
DVcopy(2*nrowY*nrhs, DenseMtx_entries(Y2), DenseMtx_entries(Y)) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, nrhs) ;
DenseMtx_writeForMatlab(X, "X", msgFile) ;
fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowY, nrhs) ;
DenseMtx_writeForMatlab(Y, "Y", msgFile) ;
}
/*
--------------------------------------------
perform the matrix-matrix multiply in serial
--------------------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n alpha = %20.12e + %20.2e*i;",
alpha[0], alpha[1]);
fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
}
if ( transposeflag == 0 ) {
MARKTIME(t1) ;
if ( symflag == 0 ) {
InpMtx_sym_mmm(A, Y, alpha, X) ;
} else if ( symflag == 1 ) {
InpMtx_herm_mmm(A, Y, alpha, X) ;
} else if ( symflag == 2 ) {
InpMtx_nonsym_mmm(A, Y, alpha, X) ;
}
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
fprintf(msgFile, "\n maxerr = max(Z - Y - alpha*A*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 1 ) {
MARKTIME(t1) ;
InpMtx_nonsym_mmm_H(A, Y, alpha, X) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
fprintf(msgFile,
"\n maxerr = max(Z - Y - alpha*ctranspose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 2 ) {
MARKTIME(t1) ;
InpMtx_nonsym_mmm_T(A, Y, alpha, X) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
fprintf(msgFile,
"\n maxerr = max(Z - Y - alpha*transpose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
}
fprintf(msgFile, "\n %% %d ops, %.3f time, %.3f serial mflops",
nops, t2 - t1, 1.e-6*nops/(t2 - t1)) ;
/*
--------------------------------------------------------
perform the matrix-matrix multiply in multithreaded mode
--------------------------------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n alpha = %20.12e + %20.2e*i;", alpha[0], alpha[1]);
fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
}
if ( transposeflag == 0 ) {
MARKTIME(t1) ;
if ( symflag == 0 ) {
InpMtx_MT_sym_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
} else if ( symflag == 1 ) {
InpMtx_MT_herm_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
} else if ( symflag == 2 ) {
InpMtx_MT_nonsym_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
}
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
fprintf(msgFile, "\n maxerr2 = max(Z2 - Y - alpha*A*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 1 ) {
MARKTIME(t1) ;
InpMtx_MT_nonsym_mmm_H(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
fprintf(msgFile,
"\n maxerr2 = max(Z2 - Y - alpha*ctranspose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 2 ) {
MARKTIME(t1) ;
InpMtx_MT_nonsym_mmm_T(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
fprintf(msgFile,
"\n maxerr2 = max(Z2 - Y - alpha*transpose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
}
fprintf(msgFile, "\n %% %d ops, %.3f time, %.3f MT mflops",
nops, t2 - t1, 1.e-6*nops/(t2 - t1)) ;
/*
------------------------
free the working storage
------------------------
*/
InpMtx_free(A) ;
DenseMtx_free(X) ;
DenseMtx_free(Y) ;
DenseMtx_free(Y2) ;
IVfree(rowids) ;
IVfree(colids) ;
Drand_free(drand) ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
------------------------------------
test the copyEntriesToVector routine
created -- 98may01, cca,
------------------------------------
*/
{
Chv *chvJ, *chvI ;
double imag, real, t1, t2 ;
double *dvec, *entries ;
Drand *drand ;
FILE *msgFile ;
int count, first, ierr, ii, iilast, ipivot, irow, jcol, jj,
jjlast, maxnent, mm, msglvl, ncol, nD, nent, nentD, nentL,
nentL11, nentL21, nentU, nentU11, nentU12, nL, npivot, nrow,
nU, pivotingflag, seed, storeflag, symflag, total, type ;
int *colind, *pivotsizes, *rowind ;
if ( argc != 10 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nD nU type symflag "
"\n pivotingflag storeflag seed"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nD -- # of rows and columns in the (1,1) block"
"\n nU -- # of columns in the (1,2) block"
"\n type -- entries type"
"\n 1 --> real"
"\n 2 --> complex"
"\n symflag -- symmetry flag"
"\n 0 --> symmetric"
"\n 1 --> nonsymmetric"
"\n pivotingflag -- pivoting flag"
"\n if symflag = 1 and pivotingflag = 1 then"
"\n construct pivotsizes[] vector"
"\n endif"
"\n storeflag -- flag to denote how to store entries"
"\n 0 --> store by rows"
"\n 1 --> store by columns"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
fprintf(stderr, "\n message level must be positive\n") ;
exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
return(-1) ;
}
nD = atoi(argv[3]) ;
nU = atoi(argv[4]) ;
type = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
pivotingflag = atoi(argv[7]) ;
storeflag = atoi(argv[8]) ;
seed = atoi(argv[9]) ;
if ( msglvl > 0 ) {
switch ( storeflag ) {
case 0 : fprintf(msgFile, "\n\n %% STORE BY ROWS") ; break ;
case 1 : fprintf(msgFile, "\n\n %% STORE BY COLUMNS") ; break ;
default :
fprintf(stderr, "\n bad value %d for storeflag", storeflag) ;
break ;
}
}
nL = nU ;
if ( symflag == SPOOLES_NONSYMMETRIC ) {
pivotingflag = 0 ;
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setNormal(drand, 0.0, 1.0) ;
Drand_setSeed(drand, seed) ;
/*
--------------------------
initialize the chvJ object
--------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
t2 - t1) ;
nent = Chv_nent(chvJ) ;
entries = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
Drand_fillDvector(drand, 2*nent, entries) ;
}
Chv_columnIndices(chvJ, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
Chv_rowIndices(chvJ, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chevron a") ;
Chv_writeForMatlab(chvJ, "a", msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------
initialize the chvI object
--------------------------
*/
MARKTIME(t1) ;
chvI = Chv_new() ;
Chv_init(chvI, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
t2 - t1) ;
Chv_zero(chvI) ;
Chv_columnIndices(chvI, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
Chv_rowIndices(chvI, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
if ( symflag == 0 && pivotingflag == 1 ) {
/*
------------------------------
create the pivotsizes[] vector
------------------------------
*/
Drand_setUniform(drand, 1, 2.999) ;
pivotsizes = IVinit(nD, 0) ;
Drand_fillIvector(drand, nD, pivotsizes) ;
/*
fprintf(msgFile, "\n initial pivotsizes[] : ") ;
IVfp80(msgFile, nD, pivotsizes, 80, &ierr) ;
*/
for ( npivot = count = 0 ; npivot < nD ; npivot++ ) {
count += pivotsizes[npivot] ;
if ( count > nD ) {
pivotsizes[npivot]-- ;
count-- ;
}
if ( count == nD ) {
break ;
}
}
npivot++ ;
/*
fprintf(msgFile, "\n final pivotsizes[] : ") ;
IVfp80(msgFile, npivot, pivotsizes, 80, &ierr) ;
*/
} else {
npivot = 0 ;
pivotsizes = NULL ;
}
/*
--------------------------------------------------
first test: copy lower, diagonal and upper entries
--------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
nentL = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_LOWER);
} else {
nentL = 0 ;
}
nentD = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_UPPER) ;
maxnent = nentL ;
if ( maxnent < nentD ) { maxnent = nentD ; }
if ( maxnent < nentU ) { maxnent = nentU ; }
if ( CHV_IS_REAL(chvJ) ) {
dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
dvec = DVinit(2*maxnent, 0.0) ;
}
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
--------------------------------------
copy the entries in the lower triangle,
then move into the chvI object
--------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_LOWER, storeflag) ;
if ( nent != nentL ) {
fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
exit(-1) ;
}
if ( storeflag == 0 ) {
for ( irow = 0, mm = 0 ; irow < nrow ; irow++ ) {
jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jj, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ;
imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
}
}
}
} else {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
for ( irow = jcol + 1 ; irow < nrow ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
/*
fprintf(msgFile, "\n %% mm = %d, a(%d,%d) = %20.12e + %20.12e*i",
mm, irow, jcol, real, imag) ;
*/
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
}
/*
---------------------------------------
copy the entries in the diagonal matrix
then move into the chvI object
---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
exit(-1) ;
}
if ( pivotsizes == NULL ) {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, jcol, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
}
mm++ ; irow++ ;
} else {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow+1, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
mm++ ;
irow += 2 ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
mm++ ;
irow += 2 ;
}
}
}
}
/*
--------------------------------------
copy the entries in the upper triangle,
then move into the chvI object
--------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_UPPER, storeflag) ;
if ( nent != nentU ) {
fprintf(stderr, "\n error: nentU = %d, nent = %d", nentU, nent) ;
exit(-1) ;
}
if ( storeflag == 1 ) {
if ( pivotsizes == NULL ) {
for ( jcol = mm = 0 ; jcol < ncol ; jcol++ ) {
iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
iilast = jcol - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
if ( pivotsizes[ipivot] == 2 ) {
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
}
}
for ( jcol = nD ; jcol < ncol ; jcol++ ) {
for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
} else {
if ( pivotsizes == NULL ) {
for ( irow = mm = 0 ; irow < nD ; irow++ ) {
for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
irow++ ;
} else {
for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
}
}
irow += 2 ;
}
}
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chevron b") ;
Chv_writeForMatlab(chvI, "b", msgFile) ;
fprintf(msgFile,
"\n\n emtx1 = abs(a - b) ; enorm1 = max(max(emtx1))") ;
fflush(msgFile) ;
}
DVfree(dvec) ;
/*
-----------------------------------------------------
second test: copy lower (1,1), lower (2,1), diagonal,
upper(1,1) and upper(1,2) blocks
-----------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
nentL11 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_STRICT_LOWER_11) ;
nentL21 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_LOWER_21) ;
} else {
nentL11 = 0 ;
nentL21 = 0 ;
}
nentD = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU11 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_STRICT_UPPER_11) ;
nentU12 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_UPPER_12) ;
maxnent = nentL11 ;
if ( maxnent < nentL21 ) { maxnent = nentL21 ; }
if ( maxnent < nentD ) { maxnent = nentD ; }
if ( maxnent < nentU11 ) { maxnent = nentU11 ; }
if ( maxnent < nentU12 ) { maxnent = nentU12 ; }
fprintf(msgFile,
"\n %% nentL11 = %d, nentL21 = %d"
"\n %% nentD = %d, nentU11 = %d, nentU12 = %d",
nentL11, nentL21, nentD, nentU11, nentU12) ;
if ( CHV_IS_REAL(chvJ) ) {
dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
dvec = DVinit(2*maxnent, 0.0) ;
}
Chv_zero(chvI) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
------------------------------------------
copy the entries in the lower (1,1) block,
then move into the chvI object
------------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_LOWER_11, storeflag) ;
if ( nent != nentL11 ) {
fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
exit(-1) ;
}
if ( storeflag == 0 ) {
for ( irow = 0, mm = 0 ; irow < nD ; irow++ ) {
jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jj, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
}
}
}
} else {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
for ( irow = jcol + 1 ; irow < nD ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
/*
------------------------------------------
copy the entries in the lower (2,1) block,
then move into the chvI object
------------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_LOWER_21, storeflag);
if ( nent != nentL21 ) {
fprintf(stderr, "\n error: nentL21 = %d, nent = %d",
nentL21, nent) ;
exit(-1) ;
}
if ( storeflag == 0 ) {
for ( irow = nD, mm = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
for ( irow = nD ; irow < nrow ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
}
/*
---------------------------------------
copy the entries in the diagonal matrix
then move into the chvI object
---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
exit(-1) ;
}
if ( pivotsizes == NULL ) {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, jcol, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
}
mm++ ; irow++ ;
} else {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow+1, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
mm++ ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
mm++ ;
}
irow += 2 ;
}
}
}
/*
-----------------------------------------
copy the entries in the upper (1,1) block
then move into the chvI object
-----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_UPPER_11, storeflag) ;
if ( nent != nentU11 ) {
fprintf(stderr, "\n error: nentU11 = %d, nent = %d", nentU11, nent) ;
exit(-1) ;
}
if ( storeflag == 1 ) {
if ( pivotsizes == NULL ) {
for ( jcol = mm = 0 ; jcol < nD ; jcol++ ) {
iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
iilast = jcol - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
if ( pivotsizes[ipivot] == 2 ) {
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
}
}
}
} else {
if ( pivotsizes == NULL ) {
for ( irow = mm = 0 ; irow < nD ; irow++ ) {
for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
irow++ ;
} else {
for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
}
}
irow += 2 ;
}
}
}
}
/*
-----------------------------------------
copy the entries in the upper (1,2) block
then move into the chvI object
-----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_UPPER_12, storeflag) ;
if ( nent != nentU12 ) {
fprintf(stderr, "\n error: nentU12 = %d, nent = %d", nentU12, nent) ;
exit(-1) ;
}
if ( storeflag == 1 ) {
for ( jcol = nD, mm = 0 ; jcol < ncol ; jcol++ ) {
for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( irow = mm = 0 ; irow < nD ; irow++ ) {
for ( jcol = nD ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chevron b") ;
Chv_writeForMatlab(chvI, "b", msgFile) ;
fprintf(msgFile,
"\n\n emtx2 = abs(a - b) ; enorm2 = max(max(emtx2))") ;
fprintf(msgFile, "\n\n [ enorm1 enorm2]") ;
fflush(msgFile) ;
}
/*
------------------------
free the working storage
------------------------
*/
if ( pivotsizes != NULL ) {
IVfree(pivotsizes) ;
}
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;
DVfree(dvec) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*
------------------------------------------------------------
create and return an ETree object that holds the front tree.
created -- 96jun23, cca
------------------------------------------------------------
*/
ETree *
MSMD_frontETree (
MSMD *msmd
) {
ETree *etree ;
int front, iv, nfront, nvtx, root ;
int *bndwghts, *fch, *nodwghts, *par, *sib, *vtxToFront ;
MSMDvtx *v, *w ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_frontETree(%p)"
"\n bad input\n", msmd) ;
exit(-1) ;
}
nvtx = msmd->nvtx ;
/*
--------------------------
count the number of fronts
--------------------------
*/
nfront = 0 ;
fch = IVinit(nvtx, -1) ;
sib = IVinit(nvtx, -1) ;
root = -1 ;
for ( iv = 0, v = msmd->vertices ; iv < nvtx ; iv++, v++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n vertex %d, status %c, wght %d",
v->id, v->status, v->wght) ;
/*
MSMDvtx_print(v, stdout) ;
*/
fflush(stdout) ;
#endif
switch ( v->status ) {
case 'L' :
case 'E' :
if ( (w = v->par) != NULL ) {
sib[v->id] = fch[w->id] ;
fch[w->id] = v->id ;
} else {
sib[v->id] = root ;
root = v->id ;
}
#if MYDEBUG > 0
fprintf(stdout, ", new front %d", nfront) ;
fflush(stdout) ;
#endif
nfront++ ;
break ;
default :
break ;
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n %d fronts", nfront) ;
fflush(stdout) ;
#endif
/*
---------------------------
initialize the ETree object
---------------------------
*/
etree = ETree_new() ;
ETree_init1(etree, nfront, nvtx) ;
nodwghts = IV_entries(etree->nodwghtsIV) ;
bndwghts = IV_entries(etree->bndwghtsIV) ;
vtxToFront = IV_entries(etree->vtxToFrontIV) ;
/*
----------------------------------------------
fill the vtxToFront[] vector so representative
vertices are mapped in a post-order traversal
----------------------------------------------
*/
nfront = 0 ;
iv = root ;
while ( iv != -1 ) {
while ( fch[iv] != -1 ) {
iv = fch[iv] ;
}
v = msmd->vertices + iv ;
vtxToFront[iv] = nfront++ ;
#if MYDEBUG > 0
fprintf(stdout, "\n v = %d, vwght = %d, vtxToFront[%d] = %d",
v->id, v->wght, iv, vtxToFront[iv]) ;
fflush(stdout) ;
#endif
while ( sib[iv] == -1 && v->par != NULL ) {
v = v->par ;
iv = v->id ;
vtxToFront[iv] = nfront++ ;
#if MYDEBUG > 0
fprintf(stdout, "\n v = %d, vwght = %d, vtxToFront[%d] = %d",
v->id, v->wght, iv, vtxToFront[iv]) ;
fflush(stdout) ;
#endif
}
iv = sib[iv] ;
}
IVfree(fch) ;
IVfree(sib) ;
/*
--------------------------------------------------------------
fill in the vertex-to-front map for indistinguishable vertices
--------------------------------------------------------------
*/
for ( iv = 0, v = msmd->vertices ; iv < nvtx ; iv++, v++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n v %d, wght = %d, status %c",
v->id, v->wght, v->status) ;
fflush(stdout) ;
#endif
switch ( v->status ) {
case 'I' :
#if MYDEBUG > 0
fprintf(stdout, "\n I : v %d", v->id) ;
fflush(stdout) ;
#endif
w = v ;
while ( w->par != NULL && w->status == 'I' ) {
w = w->par ;
#if MYDEBUG > 0
/*
fprintf(stdout, " --> %d", w->id) ;
*/
fprintf(stdout, " %d", w->id) ;
fflush(stdout) ;
#endif
}
#if MYDEBUG > 0
fprintf(stdout, ", w %d, status %c", w->id, w->status) ;
fflush(stdout) ;
#endif
switch ( w->status ) {
case 'L' :
case 'E' :
vtxToFront[v->id] = vtxToFront[w->id] ;
#if MYDEBUG > 0
fprintf(stdout, "\n I: vtxToFront[%d] = %d",
iv, vtxToFront[iv]) ;
fflush(stdout) ;
#endif
break ;
default :
#if MYDEBUG > 0
fprintf(stdout, "\n wow, v->rootpar = %d, status %c",
w->id, w->status) ;
fflush(stdout) ;
#endif
break ;
}
}
}
/*
------------------------------------------------------------
now fill in the parent Tree field, node and boundary weights
------------------------------------------------------------
*/
par = etree->tree->par ;
for ( iv = 0, v = msmd->vertices ; iv < nvtx ; iv++, v++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n v %d, status %c", v->id, v->status) ;
fflush(stdout) ;
#endif
switch ( v->status ) {
case 'L' :
case 'E' :
front = vtxToFront[iv] ;
#if MYDEBUG > 0
fprintf(stdout, ", front %d", front) ;
fflush(stdout) ;
#endif
if ( (w = v->par) != NULL ) {
par[vtxToFront[v->id]] = vtxToFront[w->id] ;
#if MYDEBUG > 0
fprintf(stdout, ", par[%d] = %d", front, par[front]) ;
fflush(stdout) ;
#endif
}
bndwghts[front] = v->bndwght ;
nodwghts[front] = v->wght ;
break ;
default :
break ;
}
}
/*
-------------------------
set the other tree fields
-------------------------
*/
Tree_setFchSibRoot(etree->tree) ;
return(etree) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
--------------------------------------------------------------------
this program tests the Graph_MPI_Bcast() method
(1) process root generates a random Graph object
and computes its checksum
(2) process root broadcasts the Graph object to the other processors
(3) each process computes the checksum of its Graph object
(4) the checksums are compared on root
created -- 98sep10, cca
--------------------------------------------------------------------
*/
{
char *buffer ;
double chksum, t1, t2 ;
double *sums ;
Drand drand ;
int iproc, length, loc, msglvl, myid, nitem, nproc,
nvtx, root, seed, size, type, v ;
int *list ;
FILE *msgFile ;
Graph *graph ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type nvtx nitem root seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of graph"
"\n nvtx -- # of vertices"
"\n nitem -- # of items used to generate graph"
"\n root -- root processor for broadcast"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
type = atoi(argv[3]) ;
nvtx = atoi(argv[4]) ;
nitem = atoi(argv[5]) ;
root = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n type -- %d"
"\n nvtx -- %d"
"\n nitem -- %d"
"\n root -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ;
fflush(msgFile) ;
/*
-----------------------
set up the Graph object
-----------------------
*/
MARKTIME(t1) ;
graph = Graph_new() ;
if ( myid == root ) {
InpMtx *inpmtx ;
int nedges, totewght, totvwght, v ;
int *adj, *vwghts ;
IVL *adjIVL, *ewghtIVL ;
/*
-----------------------
generate a random graph
-----------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nvtx) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ;
InpMtx_setNent(inpmtx, nitem) ;
InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
adjIVL = InpMtx_fullAdjacency(inpmtx) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n full adjacency structure") ;
IVL_writeForHumanEye(adjIVL, msgFile) ;
fflush(msgFile) ;
}
nedges = adjIVL->tsize ;
if ( type == 1 || type == 3 ) {
Drand_setUniform(&drand, 1, 10) ;
vwghts = IVinit(nvtx, 0) ;
Drand_fillIvector(&drand, nvtx, vwghts) ;
totvwght = IVsum(nvtx, vwghts) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex weights") ;
IVfprintf(msgFile, nvtx, vwghts) ;
fflush(msgFile) ;
}
} else {
vwghts = NULL ;
totvwght = nvtx ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totvwght %d", totvwght) ;
fflush(msgFile) ;
}
if ( type == 2 || type == 3 ) {
ewghtIVL = IVL_new() ;
IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ;
Drand_setUniform(&drand, 1, 100) ;
totewght = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(adjIVL, v, &size, &adj) ;
IVL_setList(ewghtIVL, v, size, NULL) ;
IVL_listAndSize(ewghtIVL, v, &size, &adj) ;
Drand_fillIvector(&drand, size, adj) ;
totewght += IVsum(size, adj) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ewghtIVL") ;
IVL_writeForHumanEye(ewghtIVL, msgFile) ;
fflush(msgFile) ;
}
} else {
ewghtIVL = NULL ;
totewght = nedges ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totewght %d", totewght) ;
fflush(msgFile) ;
}
Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght,
adjIVL, vwghts, ewghtIVL) ;
InpMtx_free(inpmtx) ;
}
MARKTIME(t2) ;
fprintf(msgFile,
"\n CPU %8.3f : initialize the Graph object", t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
if ( myid == root ) {
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
}
/*
--------------------------
broadcast the Graph object
--------------------------
*/
MARKTIME(t1) ;
graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
---------------------------------------
gather the checksums from the processes
---------------------------------------
*/
sums = DVinit(nproc, 0.0) ;
MPI_Gather((void *) &chksum, 1, MPI_DOUBLE,
(void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile, "\n\n sums") ;
DVfprintf(msgFile, nproc, sums) ;
for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
sums[iproc] -= chksum ;
}
fprintf(msgFile, "\n\n errors") ;
DVfprintf(msgFile, nproc, sums) ;
fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc));
}
/*
----------------
free the objects
----------------
*/
DVfree(sums) ;
Graph_free(graph) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*
-------------------------------------------------------
purpose -- to read in a Graph object from a CHACO file
input --
fn -- filename
return value -- 1 if success, 0 if failure
created -- 98sep20, jjs
--------------------------------------------------------
*/
int
Graph_readFromChacoFile (
Graph *graph,
char *fn
) {
char *rc ;
FILE *fp;
int nvtx, nedges, format;
char string[BUFLEN], *s1, *s2;
int k, v, vsize, w, vwghts, ewghts;
int *adjncy, *weights, *vwghtsINT;
IVL *adjIVL, *ewghtIVL;
/*
---------------
check the input
---------------
*/
if ((graph == NULL) || (fn == NULL)) {
fprintf(stderr, "\n error in Graph_readFromFile(%p,%s)"
"\n bad input\n", graph, fn);
return(0);
}
/*
---------------------
clear the data fields
---------------------
*/
Graph_clearData(graph);
/*
----------------------------------------------
open file and read in nvtx, nedges, and format
----------------------------------------------
*/
if ((fp = fopen(fn, "r")) == (FILE*)NULL) {
fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)"
"\n unable to open file %s", graph, fn, fn);
return(0);
}
/*
-------------
skip comments
-------------
*/
do {
rc = fgets(string, BUFLEN, fp) ;
if ( rc == NULL ) {
fprintf(stderr, "\n error in Graph_readFromChacoFile()"
"\n error skipping comments in file %s\n", fn) ;
return(0) ;
}
} while ( string[0] == '%');
/*
-------------------------------------------------
read in # vertices, # edges and (optional) format
-------------------------------------------------
*/
format = 0;
if (sscanf(string, "%d %d %d", &nvtx, &nedges, &format) < 2) {
fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)"
"\n unable to read header of file %s", graph, fn, fn);
return(0);
}
ewghts = ((format % 10) > 0);
vwghts = (((format / 10) % 10) > 0);
if (format >= 100) {
fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)"
"\n unknown format", graph, fn);
return(0);
}
/*
------------------------------------------------------------------
initialize vector(s) to hold adjacency and (optional) edge weights
------------------------------------------------------------------
*/
adjncy = IVinit(nvtx, -1) ;
if ( ewghts ) {
weights = IVinit(nvtx, -1) ;
} else {
weights = NULL ;
}
/*
---------------------------
initialize the Graph object
---------------------------
*/
nedges *= 2;
nedges += nvtx;
Graph_init1(graph, 2*ewghts+vwghts, nvtx, 0, nedges,
IVL_CHUNKED, IVL_CHUNKED);
adjIVL = graph->adjIVL;
if (ewghts) {
ewghtIVL = graph->ewghtIVL;
weights[0] = 0; /* self loops have no weight */
}
if (vwghts) vwghtsINT = graph->vwghts;
/*
---------------------------
read in all adjacency lists
---------------------------
*/
k = 0;
for (v = 0; v < nvtx; v++) {
/*
-------------
skip comments
-------------
*/
do {
rc = fgets(string, BUFLEN, fp);
if ( rc == NULL ) {
fprintf(stderr, "\n error in Graph_readFromChacoFile()"
"\n error reading adjacency for vertex %d in file %s\n",
v, fn) ;
IVfree(adjncy) ;
if ( weights != NULL ) {
IVfree(weights) ;
}
return(0) ;
}
} while ( string[0] == '%');
/*
-------------------------
check for buffer overflow
-------------------------
*/
if (strlen(string) == BUFLEN-1) {
fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)"
"\n unable to read adjacency lists of file %s (line "
"buffer too small)\n", graph, fn, fn);
IVfree(adjncy) ;
if ( weights != NULL ) {
IVfree(weights) ;
}
return(0);
}
/*
----------------------------------------------
read in (optional) vertex weight,
adjacent vertices, and (optional) edge weights
----------------------------------------------
*/
s1 = string;
if (vwghts) vwghtsINT[v] = (int)strtol(string, &s1, 10);
adjncy[0] = v; /* insert self loop needed by spooles */
if ( ewghts ) {
weights[0] = 0;
}
vsize = 1;
while ((w = (int)strtol(s1, &s2, 10)) > 0) {
adjncy[vsize] = --w; /* node numbering starts with 0 */
s1 = s2;
if (ewghts)
{ weights[vsize] = (int)strtol(s1, &s2, 10);
s1 = s2;
}
vsize++;
}
/*
---------------------------------
sort the lists in ascending order
---------------------------------
*/
if ( ewghts ) {
IV2qsortUp(vsize, adjncy, weights) ;
} else {
IVqsortUp(vsize, adjncy) ;
}
/*
--------------------------------
set the lists in the IVL objects
--------------------------------
*/
IVL_setList(adjIVL, v, vsize, adjncy);
if (ewghts) IVL_setList(ewghtIVL, v, vsize, weights);
k += vsize;
}
/*
-----------------------------------
close the file and do a final check
-----------------------------------
*/
fclose(fp);
/*
------------------------
free the working storage
------------------------
*/
IVfree(adjncy) ;
if ( weights != NULL ) {
IVfree(weights) ;
}
/*
----------------
check for errors
----------------
*/
if ((k != nedges) || (v != nvtx)) {
fprintf(stderr, "\n error in Graph_readFromChacoFile()"
"\n number of nodes/edges does not match with header of %s"
"\n k %d, nedges %d, v %d, nvtx %d\n",
fn, k, nedges, v, nvtx);
return(0);
}
return(1); }
/*
-------------------------------------------------
sort the columns of the matrix in ascending order
of the colids[] vector. on return, colids is
in asending order. return value is the number
of column swaps made.
created -- 98apr15, cca
-------------------------------------------------
*/
int
A2_sortColumnsUp (
A2 *mtx,
int ncol,
int colids[]
) {
int ii, mincol, mincolid, nswap, target ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || mtx->n2 < ncol || ncol < 0 || colids == NULL ) {
fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
"\n bad input\n", mtx, ncol, colids) ;
if ( mtx != NULL ) {
A2_writeStats(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, ncol, colids, mtx->type) ;
exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc2 == 1 ) {
double *dvtmp ;
int irow, nrow ;
int *ivtmp ;
/*
---------------------------------------------------
matrix is stored by rows, so permute each row
---------------------------------------------------
*/
ivtmp = IVinit(ncol, -1) ;
if ( A2_IS_REAL(mtx) ) {
dvtmp = DVinit(ncol, 0.0) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
dvtmp = DVinit(2*ncol, 0.0) ;
}
IVramp(ncol, ivtmp, 0, 1) ;
IV2qsortUp(ncol, colids, ivtmp) ;
nrow = mtx->n1 ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
if ( A2_IS_REAL(mtx) ) {
DVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
DVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
ZVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
ZVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
}
}
IVfree(ivtmp) ;
DVfree(dvtmp) ;
} else {
/*
----------------------------------------
use a simple insertion sort to swap cols
----------------------------------------
*/
for ( target = 0 ; target < ncol ; target++ ) {
mincol = target ;
mincolid = colids[target] ;
for ( ii = target + 1 ; ii < ncol ; ii++ ) {
if ( mincolid > colids[ii] ) {
mincol = ii ;
mincolid = colids[ii] ;
}
}
if ( mincol != target ) {
colids[mincol] = colids[target] ;
colids[target] = mincolid ;
A2_swapColumns(mtx, target, mincol) ;
nswap++ ;
}
}
}
return(nswap) ; }
/*
---------------------------------------------------
purpose -- move the solution from the individual
SubMtx objects into the global solution SubMtx object
created -- 98feb20
---------------------------------------------------
*/
void
FrontMtx_storeSolution (
FrontMtx *frontmtx,
int owners[],
int myid,
SubMtxManager *manager,
SubMtx *p_mtx[],
DenseMtx *solmtx,
int msglvl,
FILE *msgFile
) {
char localsol ;
SubMtx *xmtxJ ;
double *sol, *xJ ;
int inc1, inc2, irow, jrhs, J, kk,
ncolJ, neqns, nfront, nJ, nrhs, nrowInSol, nrowJ ;
int *colindJ, *colmap, *rowind ;
if ( (nrowInSol = solmtx->nrow) != (neqns = frontmtx->neqns) ) {
/*
--------------------------------------------------------------
the solution matrix is only part of the total solution matrix.
(this happens in an MPI environment where the rhs
is partitioned among the processors.)
create a map from the global row indices to the
indices local to this solution matrix.
--------------------------------------------------------------
*/
colmap = IVinit(neqns, -1) ;
rowind = solmtx->rowind ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n solmtx->rowind") ;
IVfprintf(msgFile, solmtx->nrow, rowind) ;
fflush(msgFile) ;
}
for ( irow = 0 ; irow < nrowInSol ; irow++ ) {
colmap[rowind[irow]] = irow ;
}
localsol = 'T' ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n colmap") ;
IVfprintf(msgFile, neqns, colmap) ;
fflush(msgFile) ;
}
} else {
localsol = 'F' ;
}
DenseMtx_dimensions(solmtx, &neqns, &nrhs) ;
nfront = FrontMtx_nfront(frontmtx) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (owners == NULL || owners[J] == myid)
&& (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
xmtxJ = p_mtx[J] ;
if ( xmtxJ == NULL ) {
fprintf(stderr,
"\n fatal error in storeSolution(%d)"
"\n thread %d, xmtxJ = NULL", J, myid) ;
exit(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n storing solution for front %d", J) ;
SubMtx_writeForHumanEye(xmtxJ, msgFile) ;
fflush(msgFile) ;
}
if ( localsol == 'T' ) {
/*
------------------------------------------------------
map the global row indices into the local row indices
------------------------------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n global row indices") ;
IVfprintf(msgFile, nJ, colindJ) ;
fflush(msgFile) ;
}
for ( irow = 0 ; irow < nJ ; irow++ ) {
colindJ[irow] = colmap[colindJ[irow]] ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n local row indices") ;
IVfprintf(msgFile, nJ, colindJ) ;
fflush(msgFile) ;
}
}
/*
----------------------------------
store x_{J,*} into solution matrix
----------------------------------
*/
sol = DenseMtx_entries(solmtx) ;
SubMtx_denseInfo(xmtxJ, &nrowJ, &ncolJ, &inc1, &inc2, &xJ) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
for ( irow = 0 ; irow < nJ ; irow++ ) {
kk = colindJ[irow] ;
sol[kk] = xJ[irow] ;
}
sol += neqns ;
xJ += nJ ;
}
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
for ( irow = 0 ; irow < nJ ; irow++ ) {
kk = colindJ[irow] ;
sol[2*kk] = xJ[2*irow] ;
sol[2*kk+1] = xJ[2*irow+1] ;
}
sol += 2*neqns ;
xJ += 2*nJ ;
}
}
/*
fprintf(msgFile, "\n solution for front %d stored", J) ;
*/
SubMtxManager_releaseObject(manager, xmtxJ) ;
if ( localsol == 'T' ) {
/*
-----------------------------------------------------------
map the local row indices back into the global row indices
-----------------------------------------------------------
*/
for ( irow = 0 ; irow < nJ ; irow++ ) {
colindJ[irow] = rowind[colindJ[irow]] ;
}
}
}
}
if ( localsol == 'T' ) {
IVfree(colmap) ;
}
/*
fprintf(msgFile, "\n\n SOLUTION") ;
DenseMtx_writeForHumanEye(solmtx, msgFile) ;
*/
return ; }
/*
---------------------------------------------------
purpose -- to read an IVL object from a binary file
return value -- 1 if success, 0 if failure
created -- 95sep29, cca
---------------------------------------------------
*/
int
IVL_readFromBinaryFile (
IVL *ivl,
FILE *fp
) {
int nlist, rc, type ;
int itemp[3] ;
int *sizes ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in IVL_readFromBinaryFile(%p,%p)"
"\n bad input\n", ivl, fp) ;
return(0) ;
}
switch ( ivl->type ) {
case IVL_CHUNKED :
case IVL_SOLO :
break ;
default :
fprintf(stderr, "\n error in IVL_readBinaryFile(%p,%p)"
"\n bad type = %d", ivl, fp, ivl->type) ;
return(0) ;
}
/*
-------------------------------------------
save the ivl type and clear the data fields
-------------------------------------------
*/
type = ivl->type ;
IVL_clearData(ivl) ;
/*
-----------------------------------
read in the three scalar parameters
type, # of lists, # of indices
-----------------------------------
*/
if ( (rc = fread((void *) itemp, sizeof(int), 3, fp)) != 3 ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n itemp(3) : %d items of %d read\n", ivl, fp, rc, 3) ;
return(0) ;
}
nlist = itemp[1] ;
/*
--------------------------
read in the sizes[] vector
--------------------------
*/
sizes = IVinit(nlist, 0) ;
if ( (rc = fread((void *) sizes, sizeof(int), nlist, fp)) != nlist ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n sizes(%d) : %d items of %d read\n",
ivl, fp, nlist, rc, nlist) ;
return(0) ;
}
/*
---------------------
initialize the object
---------------------
*/
IVL_init3(ivl, type, nlist, sizes) ;
IVfree(sizes) ;
/*
-------------------
read in the indices
-------------------
*/
switch ( type ) {
case IVL_SOLO : {
int ilist, size ;
int *ind ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &ind) ;
if ( (rc = fread((void *) ind, sizeof(int), size, fp)) != size ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n list %d, %d items of %d read\n",
ivl, fp, ilist, rc, size) ;
return(0) ;
}
}
} break ;
case IVL_CHUNKED : {
/*
--------------------------------------------------------
read in the indices into the contiguous block of storage
--------------------------------------------------------
*/
if ( (rc = fread((void *) ivl->chunk->base,
sizeof(int), ivl->tsize, fp)) != ivl->tsize ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n indices(%d) : %d items of %d read\n",
ivl, fp, ivl->tsize, rc, ivl->tsize) ;
return(0) ;
}
} break ;
}
return(1) ; }
/*
----------------------------------------------------
set the component weights from the compids[] vector
created -- 95oct05, cca
modified -- 95nov29, cca
----------------------------------------------------
*/
void
GPart_setCweights (
GPart *gpart
) {
Graph *g ;
int ierr, ii, last, ncomp, now, nvtx, u, usize, v, w ;
int *compids, *cweights, *list, *uadj, *vwghts ;
/*
--------------
check the data
--------------
*/
if ( gpart == NULL ) {
fprintf(stderr, "\n fatal error in GPart_setCweights(%p)"
"\n bad input\n", gpart) ;
exit(-1) ;
}
if ( (nvtx = gpart->nvtx) <= 0 || (g = gpart->g) == NULL ) {
fprintf(stderr, "\n fatal error in GPart_setCweights(%p)"
"\n bad Gpart object\n", gpart) ;
exit(-1) ;
}
/*
----------------------------------------------------------
set the component id of all non-multisector vertices to -1
----------------------------------------------------------
*/
compids = IV_entries(&gpart->compidsIV) ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] != 0 ) {
compids[v] = -1 ;
}
}
/*
----------------------------------------------------------
compute the number of components and set the component ids
----------------------------------------------------------
*/
list = IVinit(nvtx, -1) ;
ncomp = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] == -1 ) {
compids[v] = ++ncomp ;
now = last = 0 ;
list[now] = v ;
while ( now <= last ) {
u = list[now++] ;
Graph_adjAndSize(g, u, &usize, &uadj) ;
for ( ii = 0 ; ii < usize ; ii++ ) {
if ( (w = uadj[ii]) < nvtx && compids[w] == -1 ) {
compids[w] = ncomp ;
list[++last] = w ;
}
}
}
}
}
/*
----------------------------
set the number of components
----------------------------
*/
gpart->ncomp = ncomp ;
/*
-------------------------
set the component weights
-------------------------
*/
IV_setSize(&gpart->cweightsIV, 1 + ncomp) ;
cweights = IV_entries(&gpart->cweightsIV) ;
IVzero(1 + ncomp, cweights) ;
if ( (vwghts = gpart->g->vwghts) != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
cweights[compids[v]] += vwghts[v] ;
}
} else {
for ( v = 0 ; v < nvtx ; v++ ) {
cweights[compids[v]]++ ;
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(list) ;
return ; }
/*
------------------------------------------------------
purpose -- to read an IVL object from a formatted file
return value -- 1 if success, 0 if failure
created -- 95sep29, cca
------------------------------------------------------
*/
int
IVL_readFromFormattedFile (
IVL *ivl,
FILE *fp
) {
int nlist, rc, type ;
int itemp[3] ;
int *sizes ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || fp == NULL ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n bad input\n", ivl, fp) ;
return(0) ;
}
switch ( ivl->type ) {
case IVL_CHUNKED :
case IVL_SOLO :
break ;
default :
fprintf(stderr, "\n error in IVL_readFormattedFile(%p,%p)"
"\n bad type = %d", ivl, fp, ivl->type) ;
return(0) ;
}
/*
-------------------------------------------
save the ivl type and clear the data fields
-------------------------------------------
*/
type = ivl->type ;
IVL_clearData(ivl) ;
/*
-----------------------------------
read in the three scalar parameters
type, # of lists, # of indices
-----------------------------------
*/
if ( (rc = IVfscanf(fp, 3, itemp)) != 3 ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n %d items of %d read\n", ivl, fp, rc, 3) ;
return(0) ;
}
nlist = itemp[1] ;
/*
fprintf(stdout, "\n itemp = { %d %d %d } ",
itemp[0], itemp[1], itemp[2]) ;
*/
/*
--------------------------
read in the sizes[] vector
--------------------------
*/
sizes = IVinit(nlist, 0) ;
if ( (rc = IVfscanf(fp, nlist, sizes)) != nlist ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n %d items of %d read\n", ivl, fp, rc, nlist) ;
return(0) ;
}
/*
---------------------
initialize the object
---------------------
*/
IVL_init3(ivl, type, nlist, sizes) ;
IVfree(sizes) ;
/*
-----------------------
now read in the indices
-----------------------
*/
switch ( type ) {
case IVL_SOLO : {
int ilist, size ;
int *ind ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &ind) ;
if ( size > 0 ) {
if ( (rc = IVfscanf(fp, size, ind)) != size ) {
fprintf(stderr,
"\n error in IVL_readFromFormattedFile(%p,%p)"
"\n list %d, %d items of %d read\n",
ivl, fp, ilist, rc, size) ;
return(0) ;
}
}
}
} break ;
case IVL_CHUNKED : {
/*
--------------------------------------------------------
read in the indices into the contiguous block of storage
--------------------------------------------------------
*/
if ( (rc = IVfscanf(fp, ivl->tsize, ivl->chunk->base))
!= ivl->tsize ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n %d items of %d read\n", ivl, fp, rc, ivl->tsize) ;
return(0) ;
}
} break ;
}
return(1) ; }
/*
----------------------------------------------
sort the rows of the matrix in ascending order
of the rowids[] vector. on return, rowids is
in asending order. return value is the number
of row swaps made.
created -- 98apr15, cca
----------------------------------------------
*/
int
A2_sortRowsUp (
A2 *mtx,
int nrow,
int rowids[]
) {
int ii, minrow, minrowid, nswap, target ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || mtx->n1 < nrow || nrow < 0 || rowids == NULL ) {
fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
"\n bad input\n", mtx, nrow, rowids) ;
if ( mtx != NULL ) {
A2_writeStats(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, nrow, rowids, mtx->type) ;
exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc1 == 1 ) {
double *dvtmp ;
int jcol, ncol ;
int *ivtmp ;
/*
---------------------------------------------------
matrix is stored by columns, so permute each column
---------------------------------------------------
*/
ivtmp = IVinit(nrow, -1) ;
if ( A2_IS_REAL(mtx) ) {
dvtmp = DVinit(nrow, 0.0) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
dvtmp = DVinit(2*nrow, 0.0) ;
}
IVramp(nrow, ivtmp, 0, 1) ;
IV2qsortUp(nrow, rowids, ivtmp) ;
ncol = mtx->n2 ;
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
if ( A2_IS_REAL(mtx) ) {
DVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
DVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
ZVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
ZVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
}
}
IVfree(ivtmp) ;
DVfree(dvtmp) ;
} else {
/*
----------------------------------------
use a simple insertion sort to swap rows
----------------------------------------
*/
for ( target = 0 ; target < nrow ; target++ ) {
minrow = target ;
minrowid = rowids[target] ;
for ( ii = target + 1 ; ii < nrow ; ii++ ) {
if ( minrowid > rowids[ii] ) {
minrow = ii ;
minrowid = rowids[ii] ;
}
}
if ( minrow != target ) {
rowids[minrow] = rowids[target] ;
rowids[target] = minrowid ;
A2_swapRows(mtx, target, minrow) ;
nswap++ ;
}
}
}
return(nswap) ; }
/*
-------------------------------------------------------------------
make an element graph for a n1 x n2 x n3 grid with ncomp components
created -- 95nov03, cca
-------------------------------------------------------------------
*/
EGraph *
EGraph_make27P (
int n1,
int n2,
int n3,
int ncomp
) {
EGraph *egraph ;
int eid, icomp, ijk, ielem, jelem, kelem, m, nelem, nvtx ;
int *list ;
/*
---------------
check the input
---------------
*/
if ( n1 <= 0 || n2 <= 0 || n3 <= 0 || ncomp <= 0 ) {
fprintf(stderr, "\n fatal error in EGraph_make27P(%d,%d,%d,%d)"
"\n bad input\n", n1, n2, n3, ncomp) ;
exit(-1) ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n inside EGraph_make27P(%d,%d,%d,%d)",
n1, n2, n3, ncomp) ;
fflush(stdout) ;
#endif
/*
-----------------
create the object
-----------------
*/
nelem = (n1 - 1)*(n2 - 1)*(n3 - 1) ;
nvtx = n1*n2*n3*ncomp ;
egraph = EGraph_new() ;
if ( ncomp == 1 ) {
EGraph_init(egraph, 0, nelem, nvtx, IVL_CHUNKED) ;
} else {
EGraph_init(egraph, 1, nelem, nvtx, IVL_CHUNKED) ;
IVfill(nvtx, egraph->vwghts, ncomp) ;
}
/*
----------------------------
fill the adjacency structure
----------------------------
*/
list = IVinit(8*ncomp, -1) ;
for ( kelem = 0 ; kelem < n3 - 1 ; kelem++ ) {
for ( jelem = 0 ; jelem < n2 - 1 ; jelem++ ) {
for ( ielem = 0 ; ielem < n1 - 1 ; ielem++ ) {
eid = ielem + jelem*(n1-1) + kelem*(n1-1)*(n2-1);
m = 0 ;
ijk = ncomp*(ielem + jelem*n1 + kelem*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + 1 + jelem*n1 + kelem*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + (jelem+1)*n1 + kelem*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + 1 + (jelem+1)*n1 + kelem*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + jelem*n1 + (kelem+1)*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + 1 + jelem*n1 + (kelem+1)*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + (jelem+1)*n1 + (kelem+1)*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
ijk = ncomp*(ielem + 1 + (jelem+1)*n1 + (kelem+1)*n1*n2) ;
for ( icomp = 0 ; icomp < ncomp ; icomp++ ) {
list[m++] = ijk++ ;
}
IVqsortUp(m, list) ;
IVL_setList(egraph->adjIVL, eid, m, list) ;
}
}
}
IVfree(list) ;
return(egraph) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------
test the Drand random number generator object
---------------------------------------------
*/
{
double ddot, dmean, param1, param2 ;
double *dvec ;
Drand drand ;
FILE *msgFile ;
int distribution, ierr, imean, msglvl, n, seed1, seed2 ;
int *ivec ;
if ( argc != 9 ) {
fprintf(stderr,
"\n\n usage : testDrand msglvl msgFile "
"\n distribution param1 param2 seed1 seed2 n"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n distribution -- 1 for uniform(param1,param2)"
"\n -- 2 for normal(param1,param2)"
"\n param1 -- first parameter"
"\n param2 -- second parameter"
"\n seed1 -- first random number seed"
"\n seed2 -- second random number seed"
"\n n -- length of the vector"
"\n"
) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
distribution = atoi(argv[3]) ;
if ( distribution < 1 || distribution > 2 ) {
fprintf(stderr, "\n fatal error in testDrand"
"\n distribution must be 1 (uniform) or 2 (normal)") ;
exit(-1) ;
}
param1 = atof(argv[4]) ;
param2 = atof(argv[5]) ;
seed1 = atoi(argv[6]) ;
seed2 = atoi(argv[7]) ;
n = atoi(argv[8]) ;
Drand_init(&drand) ;
Drand_setSeeds(&drand, seed1, seed2) ;
switch ( distribution ) {
case 1 :
fprintf(msgFile, "\n uniform in [%f,%f]", param1, param2) ;
Drand_setUniform(&drand, param1, param2) ;
break ;
case 2 :
fprintf(msgFile, "\n normal(%f,%f)", param1, param2) ;
Drand_setNormal(&drand, param1, param2) ;
break ;
}
/*
---------------------------------------------
fill the integer and double precision vectors
---------------------------------------------
*/
dvec = DVinit(n, 0.0) ;
Drand_fillDvector(&drand, n, dvec) ;
dmean = DVsum(n, dvec)/n ;
ddot = DVdot(n, dvec, dvec) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n dvec mean = %.4f, variance = %.4f",
dmean, sqrt(fabs(ddot - n*dmean)/n)) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n dvec") ;
DVfprintf(msgFile, n, dvec) ;
}
DVqsortUp(n, dvec) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n sorted dvec") ;
DVfprintf(msgFile, n, dvec) ;
}
ivec = IVinit(n, 0) ;
Drand_fillIvector(&drand, n, ivec) ;
imean = IVsum(n, ivec)/n ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n ivec") ;
IVfp80(msgFile, n, ivec, 80, &ierr) ;
}
IVqsortUp(n, ivec) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n sorted ivec") ;
IVfp80(msgFile, n, ivec, 80, &ierr) ;
}
fprintf(msgFile, "\n") ;
return(1) ; }
/*
----------------------------------------------------------------
purpose --
if the elimination has halted before all the stages have been
eliminated, then create the schur complement graph and the map
from the original vertices those in the schur complement graph.
schurGraph -- Graph object to contain the schur complement graph
VtoPhi -- IV object to contain the map from vertices in V
to schur complement vertices in Phi
created -- 97feb01, cca
----------------------------------------------------------------
*/
void
MSMD_makeSchurComplement (
MSMD *msmd,
Graph *schurGraph,
IV *VtoPhiIV
) {
int nedge, nPhi, nvtx, totewght, totvwght ;
int *mark, *rep, *VtoPhi, *vwghts ;
int count, *list ;
int ierr, ii, size, *adj ;
int phi, psi, tag ;
IP *ip ;
IVL *adjIVL ;
MSMDvtx *u, *v, *vertices, *vfirst, *vlast, *w ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || schurGraph == NULL || VtoPhiIV == NULL ) {
fprintf(stderr,
"\n\n fatal error in MSMD_makeSchurComplement(%p,%p,%p)"
"\n bad input\n", msmd, schurGraph, VtoPhiIV) ;
exit(-1) ;
}
vertices = msmd->vertices ;
nvtx = msmd->nvtx ;
/*
-------------------------------------
initialize the V-to-Phi map IV object
-------------------------------------
*/
IV_clearData(VtoPhiIV) ;
IV_setSize(VtoPhiIV, nvtx) ;
IV_fill(VtoPhiIV, -2) ;
VtoPhi = IV_entries(VtoPhiIV) ;
/*
---------------------------------------------
count the number of Schur complement vertices
---------------------------------------------
*/
vfirst = vertices ;
vlast = vfirst + nvtx - 1 ;
nPhi = 0 ;
for ( v = vfirst ; v <= vlast ; v++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n v->id = %d, v->status = %c", v->id, v->status) ;
fflush(stdout) ;
#endif
switch ( v->status ) {
case 'L' :
case 'E' :
case 'I' :
break ;
case 'B' :
VtoPhi[v->id] = nPhi++ ;
#if MYDEBUG > 0
fprintf(stdout, ", VtoPhi[%d] = %d", v->id, VtoPhi[v->id]) ;
fflush(stdout) ;
#endif
break ;
default :
break ;
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n nPhi = %d", nPhi) ;
fflush(stdout) ;
#endif
/*
----------------------------------------------------
get the representative vertex id for each Phi vertex
----------------------------------------------------
*/
rep = IVinit(nPhi, -1) ;
for ( v = vfirst ; v <= vlast ; v++ ) {
if ( (phi = VtoPhi[v->id]) >= 0 ) {
#if MYDEBUG > 0
fprintf(stdout, "\n rep[%d] = %d", phi, v->id) ;
fflush(stdout) ;
#endif
rep[phi] = v->id ;
}
}
/*
------------------------------------------
set the map for indistinguishable vertices
------------------------------------------
*/
for ( v = vfirst ; v <= vlast ; v++ ) {
if ( v->status == 'I' ) {
w = v ;
while ( w->status == 'I' ) {
w = w->par ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n v = %d, status = %c, w = %d, status = %c",
v->id, v->status, w->id, w->status) ;
fflush(stdout) ;
#endif
VtoPhi[v->id] = VtoPhi[w->id] ;
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n VtoPhi") ;
IV_writeForHumanEye(VtoPhiIV, stdout) ;
fflush(stdout) ;
#endif
/*
---------------------------
initialize the Graph object
---------------------------
*/
Graph_clearData(schurGraph) ;
Graph_init1(schurGraph, 1, nPhi, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ;
adjIVL = schurGraph->adjIVL ;
vwghts = schurGraph->vwghts ;
#if MYDEBUG > 0
fprintf(stdout, "\n\n schurGraph initialized, nvtx = %d",
schurGraph->nvtx) ;
fflush(stdout) ;
#endif
/*
-------------------------------
fill the vertex adjacency lists
-------------------------------
*/
mark = IVinit(nPhi, -1) ;
list = IVinit(nPhi, -1) ;
nedge = totvwght = totewght = 0 ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
/*
-----------------------------
get the representative vertex
-----------------------------
*/
v = vfirst + rep[phi] ;
#if MYDEBUG > 0
fprintf(stdout, "\n phi = %d, v = %d", phi, v->id) ;
fflush(stdout) ;
MSMDvtx_print(v, stdout) ;
fflush(stdout) ;
#endif
count = 0 ;
tag = v->id ;
/*
---------------------------
load self in adjacency list
---------------------------
*/
mark[phi] = tag ;
totewght += v->wght * v->wght ;
#if MYDEBUG > 0
fprintf(stdout, "\n mark[%d] = %d", phi, mark[phi]) ;
fflush(stdout) ;
#endif
list[count++] = phi ;
/*
----------------------------------------
load boundary lists of adjacent subtrees
----------------------------------------
*/
for ( ip = v->subtrees ; ip != NULL ; ip = ip->next ) {
u = vertices + ip->val ;
size = u->nadj ;
adj = u->adj ;
#if MYDEBUG > 0
fprintf(stdout, "\n subtree %d :", u->id) ;
IVfp80(stdout, size, adj, 15, &ierr) ;
fflush(stdout) ;
#endif
for ( ii = 0 ; ii < size ; ii++ ) {
w = vertices + adj[ii] ;
#if MYDEBUG > 0
fprintf(stdout, "\n w %d, status %c, psi %d",
w->id, w->status, VtoPhi[w->id]) ;
fflush(stdout) ;
#endif
if ( (psi = VtoPhi[w->id]) != -2 && mark[psi] != tag ) {
mark[psi] = tag ;
#if MYDEBUG > 0
fprintf(stdout, ", mark[%d] = %d", psi, mark[psi]) ;
fflush(stdout) ;
#endif
list[count++] = psi ;
totewght += v->wght * w->wght ;
}
}
}
/*
----------------------
load adjacent vertices
----------------------
*/
size = v->nadj ;
adj = v->adj ;
for ( ii = 0 ; ii < size ; ii++ ) {
w = vertices + adj[ii] ;
if ( (psi = VtoPhi[w->id]) != -2 && mark[psi] != tag ) {
mark[psi] = tag ;
list[count++] = psi ;
totewght += v->wght * w->wght ;
}
}
/*
---------------------------------------------
sort the list and inform adjacency IVL object
---------------------------------------------
*/
IVqsortUp(count, list) ;
IVL_setList(adjIVL, phi, count, list) ;
/*
--------------------------------------
set the vertex weight and increment
the total vertex weight and edge count
--------------------------------------
*/
vwghts[phi] = v->wght ;
totvwght += v->wght ;
nedge += count ;
}
schurGraph->totvwght = totvwght ;
schurGraph->nedges = nedge ;
schurGraph->totewght = totewght ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(list) ;
IVfree(mark) ;
IVfree(rep) ;
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 broadcast a front tree object
from one process to all the others
created -- 98may21, cca
---------------------------------------------
*/
ETree *
ETree_MPI_Bcast (
ETree *etree,
int root,
int msglvl,
FILE *msgFile,
MPI_Comm comm
) {
int myid, nvtx, nfront, nint ;
int *buffer ;
/*
-------------
find identity
-------------
*/
MPI_Comm_rank(comm, &myid) ;
if ( myid == root ) {
/*
--------------------------------------------
this process owns the front tree, allocate a
continuous buffer and load the data into it.
--------------------------------------------
*/
nfront = ETree_nfront(etree) ;
nvtx = ETree_nvtx(etree) ;
nint = 3 + 5*nfront + nvtx ;
buffer = IVinit(nint, -1) ;
buffer[0] = nfront ;
buffer[1] = nvtx ;
buffer[2] = ETree_root(etree) ;
IVcopy(nfront, buffer + 3, ETree_par(etree)) ;
IVcopy(nfront, buffer + 3 + nfront, ETree_fch(etree)) ;
IVcopy(nfront, buffer + 3 + 2*nfront, ETree_sib(etree)) ;
IVcopy(nfront, buffer + 3 + 3*nfront, ETree_nodwghts(etree)) ;
IVcopy(nfront, buffer + 3 + 4*nfront, ETree_bndwghts(etree)) ;
IVcopy(nvtx, buffer + 3 + 5*nfront, ETree_vtxToFront(etree)) ;
/*
------------------------------------
send the size of the buffer and then
the buffer to the other processors
------------------------------------
*/
MPI_Bcast(&nint, 1, MPI_INT, root, comm) ;
MPI_Bcast(buffer, nint, MPI_INT, root, comm) ;
} else {
/*
--------------------------------------------
this process will receive the front tree.
clear its data, receive the number of int's,
then receive the buffer
--------------------------------------------
*/
if ( etree != NULL ) {
ETree_free(etree) ;
}
MPI_Bcast(&nint, 1, MPI_INT, root, comm) ;
buffer = IVinit(nint, -1) ;
MPI_Bcast(buffer, nint, MPI_INT, root, comm) ;
/*
----------------------------------------
create an ETree object and fill its data
----------------------------------------
*/
etree = ETree_new() ;
nfront = buffer[0] ;
nvtx = buffer[1] ;
ETree_init1(etree, nfront, nvtx) ;
etree->tree->n = nfront ;
etree->tree->root = buffer[2] ;
IVcopy(nfront, ETree_par(etree), buffer + 3) ;
IVcopy(nfront, ETree_fch(etree), buffer + 3 + nfront) ;
IVcopy(nfront, ETree_sib(etree), buffer + 3 + 2*nfront) ;
IVcopy(nfront, ETree_nodwghts(etree), buffer + 3 + 3*nfront) ;
IVcopy(nfront, ETree_bndwghts(etree), buffer + 3 + 4*nfront) ;
IVcopy(nvtx, ETree_vtxToFront(etree), buffer + 3 + 5*nfront) ;
}
/*
---------------
free the buffer
---------------
*/
IVfree(buffer) ;
return(etree) ; }