/*
-------------------------------------------------
purpose -- to write an Perm object for a human eye
return value -- 1 if success, 0 otherwise
created -- 96jan05, cca
-------------------------------------------------
*/
int
Perm_writeForHumanEye (
Perm *perm,
FILE *fp
) {
int ierr, rc ;
if ( perm == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in Perm_writeForHumanEye(%p,%p)"
"\n bad input\n", perm, fp) ;
exit(-1) ;
}
if ( (rc = Perm_writeStats(perm, fp)) == 0 ) {
fprintf(stderr, "\n fatal error in Perm_writeForHumanEye(%p,%p)"
"\n rc = %d, return from Perm_writeStats(%p,%p)\n",
perm, fp, rc, perm, fp) ;
return(0) ;
}
if ( perm->isPresent == 2 || perm->isPresent == 3 ) {
fprintf(fp, "\n\n old-to-new permutation") ;
IVfp80(fp, perm->size, perm->oldToNew, 80, &ierr) ;
}
if ( perm->isPresent == 1 || perm->isPresent == 3 ) {
fprintf(fp, "\n\n new-to-old permutation") ;
IVfp80(fp, perm->size, perm->newToOld, 80, &ierr) ;
}
return(1) ; }
/*
-----------------------------------------------------
purpose -- to write an Perm object to a formatted file
return value -- 1 if success, 0 otherwise
created -- 96jan05, cca
-----------------------------------------------------
*/
int
Perm_writeToFormattedFile (
Perm *perm,
FILE *fp
) {
int ierr, rc ;
/*
---------------
check the input
---------------
*/
if ( perm == NULL || fp == NULL || perm->size <= 0 ) {
fprintf(stderr, "\n fatal error in Perm_writeToFormattedFile(%p,%p)"
"\n bad input\n", perm, fp) ;
exit(-1) ;
}
/*
-----------------------------------
write out the two scalar parameters
-----------------------------------
*/
rc = fprintf(fp, "\n %d %d", perm->isPresent, perm->size) ;
if ( rc < 0 ) {
fprintf(stderr, "\n fatal error in Perm_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from first fprintf\n", perm, fp, rc) ;
return(0) ;
}
if ( perm->isPresent == 2 || perm->isPresent == 3 ) {
/*
-------------------------------------------
write out the old-to-new permutation vector
-------------------------------------------
*/
IVfp80(fp, perm->size, perm->oldToNew, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in Perm_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from oldToNew[] IVfp80\n",
perm, fp, ierr) ;
return(0) ;
}
}
if ( perm->isPresent == 1 || perm->isPresent == 3 ) {
/*
-------------------------------------------
write out the new-to-old permutation vector
-------------------------------------------
*/
IVfp80(fp, perm->size, perm->newToOld, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in Perm_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from newToOld[] IVfp80\n",
perm, fp, ierr) ;
return(0) ;
}
}
return(1) ; }
/*
--------------------------------------------------------------------
sort the entries in ivec1[] and ivec2[] into lexicographic order,
using dvec[] as a companion vector. then compress out the duplicates
and sum the same values of dvec[]
return value -- # of compressed entries
created -- 97dec18, cca
--------------------------------------------------------------------
*/
int
IV2DVsortUpAndCompress (
int n,
int ivec1[],
int ivec2[],
double dvec[]
) {
int first, ierr, ii, key, length, start ;
/*
---------------
check the input
---------------
*/
if ( n < 0 || ivec1 == NULL || ivec2 == NULL || dvec == NULL ) {
fprintf(stderr,
"\n fatal error in IV2DVsortAndCompress(%d,%p,%p,%p)"
"\n bad input, n = %d, ivec1 = %p, ivec2 = %p, dvec = %p",
n, ivec1, ivec2, dvec, n, ivec1, ivec2, dvec) ;
spoolesFatal();
}
if ( n == 0 ) {
return(0) ;
}
/*
---------------------------------------
sort ivec1[] in ascending order with
ivec2[] and dvec[] as companion vectors
---------------------------------------
*/
IV2DVqsortUp(n, ivec1, ivec2, dvec) ;
#if MYDEBUG > 0
fprintf(stdout, "\n ivec1[] after sort up") ;
IVfp80(stdout, n, ivec1, 80, &ierr) ;
fprintf(stdout, "\n ivec2[] after sort up") ;
IVfp80(stdout, n, ivec2, 80, &ierr) ;
fprintf(stdout, "\n dvec[] after sort up") ;
DVfprintf(stdout, n, dvec) ;
#endif
first = start = 0 ;
key = ivec1[0] ;
for ( ii = 1 ; ii < n ; ii++ ) {
if ( key != ivec1[ii] ) {
length = IVDVsortUpAndCompress(ii - start,
ivec2 + start, dvec + start) ;
IVfill(length, ivec1 + first, key) ;
IVcopy(length, ivec2 + first, ivec2 + start) ;
DVcopy(length, dvec + first, dvec + start) ;
start = ii ;
first += length ;
key = ivec1[ii] ;
}
}
length = IVDVsortUpAndCompress(n - start, ivec2 + start, dvec + start) ;
IVfill(length, ivec1 + first, key) ;
IVcopy(length, ivec2 + first, ivec2 + start) ;
DVcopy(length, dvec + first, dvec + start) ;
first += length ;
return(first) ; }
/*
-------------------------------------------------
purpose -- to write an IVL object for a human eye
return value -- 1 if success, 0 otherwise
created -- 95sep29, cca
-------------------------------------------------
*/
int
IVL_writeForHumanEye (
IVL *ivl,
FILE *fp
) {
int ierr, j, size, rc ;
int *ind ;
if ( ivl == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in IVL_writeForHumanEye(%p,%p)"
"\n bad input\n", ivl, fp) ;
spoolesFatal();
}
if ( (rc = IVL_writeStats(ivl, fp)) == 0 ) {
fprintf(stderr, "\n fatal error in IVL_writeForHumanEye(%p,%p)"
"\n rc = %d, return from IVL_writeStats(%p,%p)\n",
ivl, fp, rc, ivl, fp) ;
return(0) ;
}
for ( j = 0 ; j < ivl->nlist ; j++ ) {
IVL_listAndSize(ivl, j, &size, &ind) ;
if ( size > 0 ) {
fprintf(fp, "\n %5d :", j) ;
IVfp80(fp, size, ind, 8, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr, "\n fatal error in IVL_writeForHumanEye(%p,%p)"
"\n ierr = %d, return from IVfp80, list %d\n",
ivl, fp, ierr, j) ;
return(0) ;
}
}
}
return(1) ; }
/*
------------------------------------------------
sort the entries in ivec[] into ascending order,
using dvec[] as a companion vector.
then compress out the duplicates integer keys,
summing the double values
return value -- # of compressed entries
created -- 97dec18, cca
------------------------------------------------
*/
int
IVDVsortUpAndCompress (
int n,
int ivec[],
double dvec[]
) {
int first, ierr, ii, key ;
/*
---------------
check the input
---------------
*/
if ( n < 0 || ivec == NULL || dvec == NULL) {
fprintf(stderr,
"\n fatal error in IVDVsortAndCompress(%d,%p,%p)"
"\n bad input, n = %d, ivec = %p, dvec = %p",
n, ivec, dvec, n, ivec, dvec) ;
spoolesFatal();
}
if ( n == 0 ) {
return(0) ;
}
/*
---------------------------------
sort ivec[] in ascending order
with dvec[] as a companion vector
---------------------------------
*/
IVDVqsortUp(n, ivec, dvec) ;
#if MYDEBUG > 0
fprintf(stdout, "\n ivec[] after sort up") ;
IVfp80(stdout, n, ivec, 80, &ierr) ;
fprintf(stdout, "\n dvec[] after sort up") ;
DVfprintf(stdout, n, dvec) ;
#endif
first = 1 ;
key = ivec[0] ;
#if MYDEBUG > 0
fprintf(stdout, "\n first = %d, key = %d, ivec[%d] = %d",
first, key, 0, ivec[0]) ;
#endif
for ( ii = 1 ; ii < n ; ii++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n first = %d, key = %d, ivec[%d] = %d",
first, key, 0, ivec[0]) ;
#endif
if ( key == ivec[ii] ) {
dvec[first-1] += dvec[ii] ;
} else if ( key != ivec[ii] ) {
#if MYDEBUG > 0
fprintf(stdout, "\n setting ivec[%d] = %d",
first, ivec[ii]) ;
#endif
ivec[first] = key = ivec[ii] ;
dvec[first] = dvec[ii] ;
first++ ;
}
}
return(first) ; }
/*
------------------------------------------------
sort the entries in ivec[] into ascending order,
then compress out the duplicates
return value -- # of compressed entries
created -- 97dec18, cca
------------------------------------------------
*/
int
IVsortUpAndCompress (
int n,
int ivec[]
) {
int first, ierr, ii, key ;
/*
---------------
check the input
---------------
*/
if ( n < 0 || ivec == NULL ) {
fprintf(stderr,
"\n fatal error in IVsortAndCompress(%d,%p)"
"\n bad input, n = %d, ivec = %p",
n, ivec, n, ivec) ;
spoolesFatal();
}
if ( n == 0 ) {
return(0) ;
}
/*
----------------------------------
sort the vector in ascending order
----------------------------------
*/
IVqsortUp(n, ivec) ;
#if MYDEBUG > 0
fprintf(stdout, "\n ivec[] after sort up") ;
IVfp80(stdout, n, ivec, 80, &ierr) ;
#endif
/*
--------------------
purge the duplicates
--------------------
*/
first = 1 ;
key = ivec[0] ;
#if MYDEBUG > 0
fprintf(stdout, "\n first = %d, key = %d, ivec[%d] = %d",
first, key, 0, ivec[0]) ;
#endif
for ( ii = 1 ; ii < n ; ii++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n first = %d, key = %d, ivec[%d] = %d",
first, key, 0, ivec[0]) ;
#endif
if ( key != ivec[ii] ) {
#if MYDEBUG > 0
fprintf(stdout, "\n setting ivec[%d] = %d",
first, ivec[ii]) ;
#endif
ivec[first++] = key = ivec[ii] ;
}
}
return(first) ; }
/*
----------------------------------------
purpose -- to write the object to a file
in human readable form
return value --
1 -- normal return
-1 -- mtx is NULL
-2 -- fp is NULL
created -- 98may02, cca
----------------------------------------
*/
int
DenseMtx_writeForHumanEye (
DenseMtx *mtx,
FILE *fp
) {
A2 a2 ;
int ierr, ncol, nrow ;
int *colind, *rowind ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in DenseMtx_writeForHumanEye()"
"\n mtx is NULL\n") ;
return(-1) ;
}
if ( fp == NULL ) {
fprintf(stderr, "\n fatal error in DenseMtx_writeForHumanEye()"
"\n mtx is NULL\n") ;
return(-2) ;
}
DenseMtx_writeStats(mtx, fp) ;
DenseMtx_rowIndices(mtx, &nrow, &rowind) ;
if ( nrow > 0 && rowind != NULL ) {
fprintf(fp, "\n mtx's row indices at %p", rowind) ;
IVfp80(fp, nrow, rowind, 80, &ierr) ;
}
DenseMtx_columnIndices(mtx, &ncol, &colind) ;
if ( ncol > 0 && colind != NULL ) {
fprintf(fp, "\n mtx's column indices at %p", colind) ;
IVfp80(fp, ncol, colind, 80, &ierr) ;
}
if ( nrow > 0 && ncol > 0 ) {
A2_setDefaultFields(&a2) ;
DenseMtx_setA2(mtx, &a2) ;
A2_writeForHumanEye(&a2, fp) ;
}
return(1) ; }
/*
-------------------------------------------------
purpose -- to write an IV object for a human eye
return value -- 1 if success, 0 otherwise
created -- 95oct06, cca
-------------------------------------------------
*/
int
IV_writeForHumanEye (
IV *iv,
FILE *fp
) {
int ierr, rc ;
if ( iv == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in IV_writeForHumanEye(%p,%p)"
"\n bad input\n", iv, fp) ;
exit(-1) ;
}
if ( (rc = IV_writeStats(iv, fp)) == 0 ) {
fprintf(stderr, "\n fatal error in IV_writeForHumanEye(%p,%p)"
"\n rc = %d, return from IV_writeStats(%p,%p)\n",
iv, fp, rc, iv, fp) ;
return(0) ;
}
IVfp80(fp, iv->size, iv->vec, 80, &ierr) ;
return(1) ; }
/*
-----------------------------------------------------
purpose -- to write an IV object to a formatted file
return value -- 1 if success, 0 otherwise
created -- 95oct06, cca
-----------------------------------------------------
*/
int
IV_writeToFormattedFile (
IV *iv,
FILE *fp
) {
int ierr, rc ;
/*
---------------
check the input
---------------
*/
if ( iv == NULL || fp == NULL || iv->size <= 0 ) {
fprintf(stderr, "\n fatal error in IV_writeToFormattedFile(%p,%p)"
"\n bad input\n", iv, fp) ;
fprintf(stderr, "\n iv->size = %d", iv->size) ;
exit(-1) ;
}
/*
-------------------------------------
write out the size of the vector
-------------------------------------
*/
rc = fprintf(fp, "\n %d", iv->size) ;
if ( rc < 0 ) {
fprintf(stderr, "\n fatal error in IV_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from first fprintf\n", iv, fp, rc) ;
return(0) ;
}
if ( iv->size > 0 ) {
IVfp80(fp, iv->size, iv->vec, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in IV_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from sizes[] IVfp80\n",
iv, fp, ierr) ;
return(0) ;
}
}
return(1) ; }
/*
-------------------------------------------------------------------
purpose -- to write out an integer vector with eighty column lines
input --
fp -- file pointer, must be formatted and write access
column -- present column
pierr -- pointer to int to hold return value,
should be 1 if any print was successful,
if fprintf() failed, then ierr = -1
return value -- present column
created -- 96jun22, cca
-------------------------------------------------------------------
*/
int
IV_fp80 (
IV *iv,
FILE *fp,
int column,
int *pierr
) {
/*
---------------
check the input
---------------
*/
if ( iv == NULL || fp == NULL || pierr == NULL ) {
fprintf(stderr, "\n fatal error in IV_fp80(%p,%p,%p)"
"\n bad input\n", iv, fp, pierr) ;
exit(-1) ;
}
if ( iv->size > 0 && iv->vec != NULL ) {
column = IVfp80(fp, iv->size, iv->vec, column, pierr) ;
}
return(column) ; }
/*
------------------------------------------------------
purpose -- to write an SolveMap object for a human eye
return value -- 1 if success, 0 otherwise
created -- 98apr09, cca
------------------------------------------------------
*/
int
SolveMap_writeForHumanEye (
SolveMap *solvemap,
FILE *fp
) {
int ierr, kk, rc ;
if ( solvemap == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in SolveMap_writeForHumanEye(%p,%p)"
"\n bad input\n", solvemap, fp) ;
spoolesFatal();
}
if ( (rc = SolveMap_writeStats(solvemap, fp)) == 0 ) {
fprintf(stderr, "\n fatal error in SolveMap_writeForHumanEye(%p,%p)"
"\n rc = %d, return from SolveMap_writeStats(%p,%p)\n",
solvemap, fp, rc, solvemap, fp) ;
return(0) ;
}
fprintf(fp, "\n\n front owners map") ;
IVfp80(fp, solvemap->nfront, solvemap->owners, 80, &ierr) ;
if ( solvemap->nblockUpper > 0 ) {
fprintf(fp, "\n\n upper block map") ;
for ( kk = 0 ; kk < solvemap->nblockUpper ; kk++ ) {
fprintf(fp, "\n block(%d,%d) owned by process %d",
solvemap->rowidsUpper[kk], solvemap->colidsUpper[kk],
solvemap->mapUpper[kk]) ;
}
}
if ( solvemap->symmetryflag == 2 && solvemap->nblockLower > 0 ) {
fprintf(fp, "\n\n lower block map") ;
for ( kk = 0 ; kk < solvemap->nblockLower ; kk++ ) {
fprintf(fp, "\n block(%d,%d) owned by process %d",
solvemap->rowidsLower[kk], solvemap->colidsLower[kk],
solvemap->mapLower[kk]) ;
}
}
return(1) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*
------------------------------------------------------------
compute an old-to-new ordering for
local nested dissection in three dimensions
n1 -- number of grid points in first direction
n2 -- number of grid points in second direction
n3 -- number of grid points in third direction
p1 -- number of domains in first direction
p2 -- number of domains in second direction
p3 -- number of domains in third direction
dsizes1 -- domain sizes in first direction, size p1
if NULL, then we construct our own
dsizes2 -- domain sizes in second direction, size p2
if NULL, then we construct our own
dsizes3 -- domain sizes in third direction, size p3
if NULL, then we construct our own
oldToNew -- old-to-new permutation vector
note : the following must hold
n1 > 0, n2 >0, n3 > 0,
n1 >= 2*p1 - 1, n2 >= 2*p2 - 1, n3 >= 2*p3 - 1, p3 > 1
sum(dsizes1) = n1 - p1 + 1, sum(dsizes2) = n2 - p2 + 1
sum(dsizes3) = n3 - p3 + 1
created -- 95nov16, cca
------------------------------------------------------------
*/
void
localND3D (
int n1,
int n2,
int n3,
int p1,
int p2,
int p3,
int dsizes1[],
int dsizes2[],
int dsizes3[],
int oldToNew[]
) {
int i, idom, ijk, isw, j, jdom, jsw, k, kdom, ksw,
length1, length2, length3, m, m1, m2, m3, msize, now, nvtx ;
int *length1s, *length2s, *length3s, *isws, *jsws, *ksws, *temp ;
/*
---------------
check the input
---------------
*/
if ( n1 <= 0 || n2 <= 0 || n3 <= 0
|| 2*p1 - 1 > n1 || 2*p2 - 1 > n2 || 2*p3 - 1 > n3 ) {
fprintf(stderr, "\n error in input data") ;
return ;
}
if ( p3 <= 1 ) {
fprintf(stderr, "\n p3 must be > 1") ;
return ;
}
if ( oldToNew == NULL ) {
fprintf(stderr, "\n oldToNew = NULL") ;
return ;
}
if ( dsizes1 != NULL && IVsum(p1, dsizes1) != n1 - p1 + 1 ) {
fprintf(stderr, "\n IVsum(p1, dsizes1) != n1 - p1 + 1 ") ;
return ;
}
if ( dsizes2 != NULL && IVsum(p2, dsizes2) != n2 - p2 + 1 ) {
fprintf(stderr, "\n IVsum(p2, dsizes2) != n2 - p2 + 1 ") ;
return ;
}
if ( dsizes3 != NULL && IVsum(p3, dsizes3) != n3 - p3 + 1 ) {
fprintf(stderr, "\n IVsum(p3, dsizes3) != n3 - p3 + 1 ") ;
return ;
}
if ( dsizes1 != NULL && IVmin(p1, dsizes1, &i) <= 0 ) {
fprintf(stderr, "\n IVmin(p1, dsizes1) must be > 0") ;
return ;
}
if ( dsizes2 != NULL && IVmin(p2, dsizes2, &i) <= 0 ) {
fprintf(stderr, "\n IVmin(p2, dsizes2) must be > 0") ;
return ;
}
if ( dsizes3 != NULL && IVmin(p3, dsizes3, &i) <= 0 ) {
fprintf(stderr, "\n IVmin(p3, dsizes3) must be > 0") ;
return ;
}
nvtx = n1*n2*n3 ;
/*
----------------------------------
construct the domain sizes vectors
----------------------------------
*/
if ( dsizes1 == NULL ) {
length1s = IVinit(p1, 0) ;
length1 = (n1 - p1 + 1) / p1 ;
m1 = (n1 - p1 + 1) % p1 ;
for ( i = 0 ; i < m1 ; i++ ) {
length1s[i] = length1 + 1 ;
}
for ( ; i < p1 ; i++ ) {
length1s[i] = length1 ;
}
} else {
length1s = dsizes1 ;
}
if ( dsizes2 == NULL ) {
length2s = IVinit(p2, 0) ;
length2 = (n2 - p2 + 1) / p2 ;
m2 = (n2 - p2 + 1) % p2 ;
for ( i = 0 ; i < m2 ; i++ ) {
length2s[i] = length2 + 1 ;
}
for ( ; i < p2 ; i++ ) {
length2s[i] = length2 ;
}
} else {
length2s = dsizes2 ;
}
if ( dsizes3 == NULL ) {
length3s = IVinit(p3, 0) ;
length3 = (n3 - p3 + 1) / p3 ;
m3 = (n3 - p3 + 1) % p3 ;
for ( i = 0 ; i < m3 ; i++ ) {
length3s[i] = length3 + 1 ;
}
for ( ; i < p3 ; i++ ) {
length3s[i] = length3 ;
}
} else {
length3s = dsizes3 ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n inside localND3D") ;
fprintf(stdout,
"\n n1 = %d, n2 = %d, n3 = %d, p1 = %d, p2 = %dm p3 = %d",
n1, n2, n3, p1, p2, p3) ;
fprintf(stdout, "\n length1s[%d] = ", p1) ;
IVfp80(stdout, p1, length1s, 12) ;
fprintf(stdout, "\n length2s[%d] = ", p2) ;
IVfp80(stdout, p2, length2s, 12) ;
fprintf(stdout, "\n length3s[%d] = ", p3) ;
IVfp80(stdout, p3, length3s, 13) ;
#endif
/*
---------------------------------------
determine the first and last domain ids
and the array of southwest points
---------------------------------------
*/
isws = IVinit(p1, -1) ;
for ( idom = 0, isw = 0 ; idom < p1 ; idom++ ) {
isws[idom] = isw ;
isw += length1s[idom] + 1 ;
}
jsws = IVinit(p2, -1) ;
for ( jdom = 0, jsw = 0 ; jdom < p2 ; jdom++ ) {
jsws[jdom] = jsw ;
jsw += length2s[jdom] + 1 ;
}
ksws = IVinit(p3, -1) ;
for ( kdom = 0, ksw = 0 ; kdom < p3 ; kdom++ ) {
ksws[kdom] = ksw ;
ksw += length3s[kdom] + 1 ;
}
#if MYDEBUG > 1
fprintf(stdout, "\n isws[%d] = ", p1) ;
IVfp80(stdout, p1, isws, 12) ;
fprintf(stdout, "\n jsws[%d] = ", p2) ;
IVfp80(stdout, p2, jsws, 12) ;
fprintf(stdout, "\n ksws[%d] = ", p3) ;
IVfp80(stdout, p3, ksws, 12) ;
#endif
/*
----------------------------------------------------------------
create a temporary permutation vector for the domains' orderings
----------------------------------------------------------------
*/
msize = IVmax(p1, length1s, &i) * IVmax(p2, length2s, &i)
* IVmax(p3, length3s, &k) ;
temp = IVinit(msize, -1) ;
/*
------------------------
fill in the domain nodes
------------------------
*/
now = 0 ;
for ( kdom = 0 ; kdom < p3 ; kdom++ ) {
ksw = ksws[kdom] ;
length3 = length3s[kdom] ;
for ( jdom = 0 ; jdom < p2 ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
/*
fprintf(stdout, "\n domain (%d,%d,%d), size %d x %d x %d",
idom, jdom, kdom, length1, length2, length3) ;
fprintf(stdout, "\n (isw, jsw, ksw) = (%d, %d, %d)",
isw, jsw, ksw) ;
*/
mkNDperm(length1, length2, length3, temp,
0, length1-1, 0, length2-1, 0, length3-1) ;
for ( m = 0 ; m < length1*length2*length3 ; m++ ) {
ijk = temp[m] ;
/*
fprintf(stdout, "\n m = %d, ijk = %d", m, ijk) ;
*/
k = ksw + ijk / (length1*length2) ;
ijk = ijk % (length1*length2) ;
j = jsw + ijk / length1 ;
i = isw + ijk % length1 ;
/*
fprintf(stdout, ", (i, j, k) = (%d, %d, %d)", i, j, k) ;
*/
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n old-to-new after domains are numbered") ;
fp3DGrid(n1, n2, n3, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the lower separator nodes
---------------------------------
*/
for ( kdom = 0 ; kdom < (p3/2) ; kdom++ ) {
ksw = ksws[kdom] ;
length3 = length3s[kdom] ;
for ( jdom = 0 ; jdom < p2 ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
/*
-------
3 faces
-------
*/
if ( isw > 0 ) {
i = isw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( jsw > 0 ) {
j = jsw - 1 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( ksw > 0 ) {
k = ksw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
/*
-----------
three edges
-----------
*/
if ( isw > 0 && jsw > 0 ) {
i = isw - 1 ;
j = jsw - 1 ;
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( isw > 0 && ksw > 0 ) {
i = isw - 1 ;
k = ksw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( jsw > 0 && ksw > 0 ) {
j = jsw - 1 ;
k = ksw - 1 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
/*
----------------
one corner point
----------------
*/
if ( isw > 0 && jsw > 0 && ksw > 0 ) {
i = isw - 1 ;
j = jsw - 1 ;
k = ksw - 1 ;
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the lower separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the upper separator nodes
---------------------------------
*/
for ( kdom = p3 - 1 ; kdom >= (p3/2) ; kdom-- ) {
ksw = ksws[kdom] ;
length3 = length3s[kdom] ;
for ( jdom = p2 - 1 ; jdom >= 0 ; jdom-- ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = p1 - 1 ; idom >= 0 ; idom-- ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
/*
-------
3 faces
-------
*/
if ( isw + length1 < n1 ) {
i = isw + length1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( jsw + length2 < n2 ) {
j = jsw + length2 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
if ( ksw + length3 < n3 ) {
k = ksw + length3 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
/*
-----------
three edges
-----------
*/
if ( isw + length1 < n1 && jsw + length2 < n2 ) {
i = isw + length1 ;
j = jsw + length2 ;
for ( k = ksw ; k <= ksw + length3 - 1 ; k++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( isw + length1 < n1 && ksw + length3 < n3 ) {
i = isw + length1 ;
k = ksw + length3 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
if ( jsw + length2 < n2 && ksw + length3 < n3 ) {
j = jsw + length2 ;
k = ksw + length3 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
/*
----------------
one corner point
----------------
*/
if ( isw + length1 < n1 && jsw + length2 < n2
&& ksw + length3 < n3 ) {
i = isw + length1 ;
j = jsw + length2 ;
k = ksw + length3 ;
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the upper separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
-------------------------------
fill in the top level separator
-------------------------------
*/
m1 = p3 / 2 ;
for ( kdom = 0, k = 0 ; kdom < m1 ; kdom++ ) {
k += length3s[kdom] + 1 ;
}
k-- ;
for ( j = 0 ; j < n2 ; j++ ) {
for ( i = 0 ; i < n1 ; i++ ) {
ijk = i + j*n1 + k*n1*n2 ;
oldToNew[ijk] = now++ ;
}
}
/*
------------------------
free the working storage
------------------------
*/
if ( dsizes1 == NULL ) {
IVfree(length1s) ;
}
if ( dsizes2 == NULL ) {
IVfree(length2s) ;
}
if ( dsizes3 == NULL ) {
IVfree(length3s) ;
}
IVfree(isws) ;
IVfree(jsws) ;
IVfree(ksws) ;
IVfree(temp) ;
return ; }
/*
--------------------------------------------
split the graph partition object into pieces
created -- 95nov29, cca
--------------------------------------------
*/
void
GPart_split (
GPart *gpart
) {
FILE *msgFile ;
GPart *gpartchild ;
Graph *g, *gchild ;
int domwght, icomp, ierr, msglvl, ncomp, nvtot, nvtx, sepwght ;
int *compids, *cweights, *map ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || (g = gpart->g) == NULL ) {
fprintf(stderr, "\n fatal error in GPart_split(%p)"
"\n bad input\n", gpart) ;
exit(-1) ;
}
if ( gpart->fch != NULL ) {
fprintf(stderr, "\n fatal error in GPart_split(%p)"
"\n child(ren) exist, already split\n", gpart) ;
exit(-1) ;
}
msgFile = gpart->msgFile ;
msglvl = gpart->msglvl ;
/*
------------------------------
count the number of subgraphs
and fill the cweights[] vector
------------------------------
*/
nvtx = g->nvtx ;
GPart_setCweights(gpart) ;
ncomp = gpart->ncomp ;
cweights = IV_entries(&gpart->cweightsIV) ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n\n inside GPart_split, %d components, cweights : ",
ncomp) ;
IV_fp80(&gpart->cweightsIV, msgFile, 25, &ierr) ;
}
if ( ncomp == 1 ) {
return ;
}
/*
-----------------------------------------
compute the weight of the components and
count the number of nontrivial components
-----------------------------------------
*/
sepwght = cweights[0] ;
domwght = 0 ;
for ( icomp = 1 ; icomp <= ncomp ; icomp++ ) {
domwght += cweights[icomp] ;
}
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n separator weight = %d, weight of components = %d",
sepwght, domwght) ;
}
/*
------------------------------------------------------
for each component
create its subgraph with boundary
create a GPart object to contain the subgraph
and set as the child of the present GPart object
end for
------------------------------------------------------
*/
compids = IV_entries(&gpart->compidsIV) ;
for ( icomp = 1 ; icomp <= ncomp ; icomp++ ) {
gpartchild = GPart_new() ;
gchild = Graph_subGraph(g, icomp, compids, &map) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n component %d", icomp) ;
fprintf(msgFile, "\n map to parent") ;
IVfp80(msgFile, gchild->nvtx + gchild->nvbnd, map, 80, &ierr) ;
Graph_writeForHumanEye(gchild, msgFile) ;
fflush(msgFile) ;
}
GPart_init(gpartchild, gchild) ;
nvtot = gpartchild->nvtx + gpartchild->nvbnd ;
IV_init2(&gpartchild->vtxMapIV, nvtot, nvtot, 1, map) ;
gpartchild->par = gpart ;
gpartchild->sib = gpart->fch ;
gpart->fch = gpartchild ;
gpartchild->msglvl = gpart->msglvl ;
gpartchild->msgFile = gpart->msgFile ;
}
return ; }
/*--------------------------------------------------------------------*/
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 -- to write a Graph object to a formatted file
return value -- 1 if success, 0 otherwise
created -- 95sep29, cca
------------------------------------------------------
*/
int
Graph_writeToFormattedFile (
Graph *graph,
FILE *fp
) {
int ierr, rc ;
/*
---------------
check the input
---------------
*/
if ( graph == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n bad input\n", graph, fp) ;
return(0) ;
}
if ( graph->type < 0 || 3 < graph->type ) {
fprintf(stderr, "\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n bad type = %d", graph, fp, graph->type) ;
return(0) ;
}
/*
-----------------------------------
write out the six scalar parameters
-----------------------------------
*/
rc = fprintf(fp, "\n %d %d %d %d %d %d",
graph->type, graph->nvtx, graph->nvbnd,
graph->nedges, graph->totvwght, graph->totewght) ;
if ( rc < 0 ) {
fprintf(stderr, "\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from first fprintf\n", graph, fp, rc) ;
return(0) ;
}
/*
---------------------------------
write out the adjacency structure
---------------------------------
*/
rc = IVL_writeToFormattedFile(graph->adjIVL, fp) ;
if ( rc < 0 ) {
fprintf(stderr, "\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from IVL_writeToFormattedFile(%p,%p)"
"\n while attempting to write out adjIVL\n",
graph, fp, rc, graph->adjIVL, fp) ;
return(0) ;
}
/*
-----------------------------------------
write out the vwghts[] vector, if present
-----------------------------------------
*/
if ( graph->type % 2 == 1 ) {
if ( graph->vwghts == NULL ) {
fprintf(stderr,
"\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n graph->type = %d, graph->vwghts == NULL\n",
graph, fp, graph->type) ;
return(0) ;
}
IVfp80(fp, graph->nvtx+graph->nvbnd, graph->vwghts, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from vwghts[] IVfp80\n",
graph, fp, ierr) ;
return(0) ;
}
}
/*
-------------------------------------
write out the edge weights IVL object
-------------------------------------
*/
if ( graph->type >= 2 ) {
if ( graph->ewghtIVL == NULL ) {
fprintf(stderr,
"\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n graph->type = %d, graph->ewghtIVL == NULL\n",
graph, fp, graph->type) ;
return(0) ;
}
rc = IVL_writeToFormattedFile(graph->ewghtIVL, fp) ;
if ( rc < 0 ) {
fprintf(stderr,
"\n fatal error in Graph_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from IVL_writeToFormattedFile(%p,%p)"
"\n while attempting to write out ewghtIVL\n",
graph, fp, rc, graph->ewghtIVL, fp) ;
return(0) ;
}
}
return(1) ; }
/*
-----------------------------------------------------
purpose -- to write an SolveMap object to a formatted file
return value -- 1 if success, 0 otherwise
created -- 98apr09, cca
-----------------------------------------------------
*/
int
SolveMap_writeToFormattedFile (
SolveMap *solvemap,
FILE *fp
) {
int ierr, rc ;
/*
---------------
check the input
---------------
*/
if ( solvemap == NULL || fp == NULL ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n bad input\n", solvemap, fp) ;
spoolesFatal();
}
/*
------------------------------------
write out the five scalar parameters
------------------------------------
*/
rc = fprintf(fp, "\n %d %d %d %d %d",
solvemap->symmetryflag,
solvemap->nfront,
solvemap->nproc,
solvemap->nblockUpper,
solvemap->nblockLower) ;
if ( rc < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from first fprintf\n",
solvemap, fp, rc) ;
return(0) ;
}
if ( solvemap->nfront > 0 ) {
IVfp80(fp, solvemap->nfront, solvemap->owners, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from owners[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
}
if ( solvemap->nblockUpper > 0 ) {
IVfp80(fp, solvemap->nblockUpper, solvemap->rowidsUpper, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from rowidsUpper[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
IVfp80(fp, solvemap->nblockUpper, solvemap->colidsUpper, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from colidsUpper[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
IVfp80(fp, solvemap->nblockUpper, solvemap->mapUpper, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from mapUpper[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
}
if ( solvemap->symmetryflag == 2 && solvemap->nblockLower > 0 ) {
IVfp80(fp, solvemap->nblockLower, solvemap->rowidsLower, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from rowidsLower[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
IVfp80(fp, solvemap->nblockLower, solvemap->colidsLower, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from colidsLower[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
IVfp80(fp, solvemap->nblockLower, solvemap->mapLower, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in SolveMap_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from mapLower[] IVfp80\n",
solvemap, fp, ierr) ;
return(0) ;
}
}
return(1) ; }
/*
-----------------------------------------
purpose -- eliminate vertex v
1) create v's boundary list
2) merge boundary list onto reach list
3) for each vertex in the boundary
3.1) add v to the subtree list
created -- 96feb25, cca
-----------------------------------------
*/
void
MSMD_eliminateVtx (
MSMD *msmd,
MSMDvtx *v,
MSMDinfo *info
) {
int i, ierr, j, nadj, nbnd, nedge, uid, wid, wght ;
int *adj, *bnd, *edges ;
IP *ip, *ip2, *prev ;
IV *reachIV ;
MSMDvtx *u, *w ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || v == NULL || info == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_eliminateVtx(%p,%p,%p)"
"\n bad input\n", msmd, v, info) ;
exit(-1) ;
}
adj = IV_entries(&msmd->ivtmpIV) ;
reachIV = &msmd->reachIV ;
/*
-----------------------------
create the boundary set for v
-----------------------------
*/
v->mark = 'X' ;
if ( v->subtrees == NULL ) {
/*
--------------------------------------------------------
v is a leaf, look at its uncovered edge list, move v and
any indistinguishable vertices to the end of the list
--------------------------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n vertex %d is a leaf", v->id) ;
fflush(info->msgFile) ;
}
v->status = 'L' ;
nedge = v->nadj ;
edges = v->adj ;
i = 0 ; j = nedge - 1 ;
while ( i <= j ) {
wid = edges[i] ;
w = msmd->vertices + wid ;
if ( w == v || w->status == 'I' ) {
edges[i] = edges[j] ;
edges[j] = wid ;
j-- ;
} else {
w->mark = 'X' ;
i++ ;
}
}
v->nadj = j + 1 ;
} else {
/*
----------------------------------------------------
v is not a leaf, merge its subtrees' boundaries
with its uncovered edge list to get the new boundary
----------------------------------------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n vertex %d is not a leaf", v->id) ;
fprintf(info->msgFile, "\n vertex %d, subtrees :", v->id) ;
IP_fp80(info->msgFile, v->subtrees, 20) ;
fflush(info->msgFile) ;
}
v->status = 'E' ;
nadj = 0 ;
while ( (ip = v->subtrees) != NULL ) {
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n subtree %d, ip(%p)<%d,%p>",
ip->val, ip, ip->val, ip->next) ;
fflush(info->msgFile) ;
}
uid = ip->val ;
u = msmd->vertices + uid ;
u->par = v ;
nbnd = u->nadj ;
bnd = u->adj ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n bnd of adj subtree %d :", u->id) ;
IVfp80(info->msgFile, nbnd, bnd, 25, &ierr) ;
fflush(info->msgFile) ;
}
for ( i = 0 ; i < nbnd ; i++ ) {
wid = bnd[i] ;
w = msmd->vertices + wid ;
if ( w->mark == 'O' && w->status != 'I' ) {
w->mark = 'X' ;
adj[nadj++] = wid ;
}
}
if ( u->status == 'E' ) {
/*
------------------------------------------
u is not a leaf, free its boundary storage
------------------------------------------
*/
IVfree(u->adj) ;
info->nbytes -= u->nadj * sizeof(int) ;
}
u->adj = NULL ;
u->nadj = 0 ;
/*
--------------------------------------
put this IP structure on the free list
--------------------------------------
*/
v->subtrees = ip->next ;
ip->val = -1 ;
ip->next = msmd->freeIP ;
msmd->freeIP = ip ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile,
"\n v->subtrees = %p, msmd->freeIP = %p",
v->subtrees, msmd->freeIP) ;
fflush(info->msgFile) ;
}
}
/*
------------------------------------------------
merge all uncovered edges into the boundary list
------------------------------------------------
*/
nedge = v->nadj ;
edges = v->adj ;
for ( i = 0 ; i < nedge ; i++ ) {
wid = edges[i] ;
w = msmd->vertices + wid ;
if ( w->mark == 'O' && w->status != 'I' ) {
w->mark = 'X' ;
adj[nadj++] = wid ;
}
}
/*
----------------------------------------------------------
if boundary is not empty, allocate new storage for entries
----------------------------------------------------------
*/
v->nadj = nadj ;
if ( nadj > 0 ) {
v->adj = IVinit(nadj, -1) ;
IVcopy(nadj, v->adj, adj) ;
info->nbytes += nadj*sizeof(int) ;
if ( info->maxnbytes < info->nbytes ) {
info->maxnbytes = info->nbytes ;
}
} else {
v->adj = NULL ;
}
}
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n bnd(%d) :", v->id) ;
if ( v->nadj > 0 ) {
IVfp80(info->msgFile, v->nadj, v->adj, 17, &ierr) ;
}
fflush(info->msgFile) ;
}
/*
----------------------------------------------
for each boundary vertex
1. add v to subtree list
2. put v on reach set if not already there
3. unmark and add weight to boundary weight
----------------------------------------------
*/
nbnd = v->nadj ;
bnd = v->adj ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n %d's bnd :", v->id) ;
IVfp80(info->msgFile, nbnd, bnd, 12, &ierr) ;
fflush(info->msgFile) ;
}
wght = 0 ;
for ( i = 0 ; i < nbnd ; i++ ) {
wid = bnd[i] ;
w = msmd->vertices + wid ;
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n adjacent vertex %d", w->id) ;
fflush(info->msgFile) ;
}
/*
-------------------------------
add v to the subtree list for w
-------------------------------
*/
if ( (ip = msmd->freeIP) == NULL ) {
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n need to get more IP objects") ;
fflush(info->msgFile) ;
}
/*
-------------------------------------------------
no more free IP structures, allocate more storage
-------------------------------------------------
*/
if ( (ip = IP_init(msmd->incrIP, IP_FORWARD)) == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_eliminateVtx%p,%p,%p)"
"\n unable to allocate more IP objects",
msmd, v, info) ;
exit(-1) ;
}
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n old baseIP = %p", msmd->baseIP) ;
fprintf(info->msgFile, "\n new baseIP = %p", ip) ;
fflush(info->msgFile) ;
}
ip->next = msmd->baseIP ;
msmd->baseIP = ip ;
info->nbytes += msmd->incrIP*sizeof(struct _IP) ;
if ( info->maxnbytes < info->nbytes ) {
info->maxnbytes = info->nbytes ;
}
ip = msmd->freeIP = msmd->baseIP + 1 ;
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n all set") ;
fflush(info->msgFile) ;
}
}
msmd->freeIP = ip->next ;
ip->val = v->id ;
ip->next = NULL ;
for ( ip2 = w->subtrees, prev = NULL ;
ip2 != NULL && ip2->val > ip->val ;
ip2 = ip2->next ) {
prev = ip2 ;
}
if ( prev == NULL ) {
w->subtrees = ip ;
} else {
prev->next = ip ;
}
ip->next = ip2 ;
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n %d's subtrees :", w->id) ;
IP_fp80(info->msgFile, w->subtrees, 15) ;
fflush(info->msgFile) ;
}
/*
--------------------------------
add w to reach list if necessary
--------------------------------
*/
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, "\n status[%d] = %c", wid, w->status) ;
fflush(info->msgFile) ;
}
switch ( w->status ) {
case 'D' :
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, ", remove from heap") ;
fflush(info->msgFile) ;
}
IIheap_remove(msmd->heap, wid) ;
case 'O' :
case 'B' :
if ( info->msglvl > 4 ) {
fprintf(info->msgFile, ", add to reach set, nreach = %d",
IV_size(reachIV) + 1) ;
fflush(info->msgFile) ;
}
IV_push(reachIV, wid) ;
w->status = 'R' ;
case 'R' :
break ;
case 'I' :
break ;
default :
fprintf(stderr, "\n error in MSMD_eliminateVtx(%p,%p,%p)"
"\n status[%d] = '%c'\n",
msmd, v, info, wid, w->status) ;
fprintf(stderr, "\n msmd->nvtx = %d", msmd->nvtx) ;
exit(-1) ;
}
/*
--------------------------------
unmark the boundary vertices and
store the weight of the boundary
--------------------------------
*/
w->mark = 'O' ;
wght += w->wght ;
}
/*
------------------------------------
unmark v and set its boundary weight
------------------------------------
*/
v->mark = 'O' ;
v->bndwght = wght ;
return ; }
/*
--------------------------------------------------------------
identify the wide separator
return -- IV object that holds the nodes in the wide separator
created -- 96oct21, cca
--------------------------------------------------------------
*/
IV *
GPart_identifyWideSep (
GPart *gpart,
int nlevel1,
int nlevel2
) {
FILE *msgFile ;
Graph *g ;
int count, first, ierr, ii, ilevel, last, msglvl,
nfirst, now, nsecond, nsep, nvtx, v, vsize, w ;
int *compids, *list, *mark, *vadj ;
IV *sepIV ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || (g = gpart->g) == NULL
|| nlevel1 < 0 || nlevel2 < 0 ) {
fprintf(stderr, "\n fatal error in GPart_identifyWideSep(%p,%d,%d)"
"\n bad input\n", gpart, nlevel1, nlevel2) ;
exit(-1) ;
}
g = gpart->g ;
compids = IV_entries(&gpart->compidsIV) ;
nvtx = g->nvtx ;
mark = IVinit(nvtx, -1) ;
list = IVinit(nvtx, -1) ;
msglvl = gpart->msglvl ;
msgFile = gpart->msgFile ;
/*
--------------------------------------
load the separator nodes into the list
--------------------------------------
*/
nsep = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
if ( compids[v] == 0 ) {
list[nsep++] = v ;
mark[v] = 0 ;
}
}
count = nsep ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n GPart_identifyWideSep : %d separator nodes loaded",
count) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
IVfp80(msgFile, nsep, list, 80, &ierr) ;
fflush(msgFile) ;
}
/*
----------------------------------------------
loop over the number of levels out that form
the wide separator towards the first component
----------------------------------------------
*/
if ( nlevel1 >= 1 ) {
first = count ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", 1, first) ;
fflush(msgFile) ;
}
for ( now = 0 ; now < nsep ; now++ ) {
v = list[now] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 1 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
list[count++] = w ;
mark[w] = 1 ;
}
}
}
now = first ;
for ( ilevel = 2 ; ilevel <= nlevel1 ; ilevel++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", ilevel, first);
fflush(msgFile) ;
}
last = count - 1 ;
while ( now <= last ) {
v = list[now++] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 1 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
mark[w] = 1 ;
list[count++] = w ;
}
}
}
}
}
nfirst = count - nsep ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n %d nodes added from the first component", nfirst) ;
fflush(msgFile) ;
}
if ( msglvl > 3 ) {
IVfp80(msgFile, nfirst, &list[nsep], 80, &ierr) ;
fflush(msgFile) ;
}
/*
----------------------------------------------
loop over the number of levels out that form
the wide separator towards the second component
----------------------------------------------
*/
if ( nlevel2 >= 1 ) {
first = count ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", 1, first) ;
fflush(msgFile) ;
}
for ( now = 0 ; now < nsep ; now++ ) {
v = list[now] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 2 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
list[count++] = w ;
mark[w] = 2 ;
}
}
}
now = first ;
for ( ilevel = 2 ; ilevel <= nlevel2 ; ilevel++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n level = %d, first = %d", ilevel, first);
fflush(msgFile) ;
}
last = count - 1 ;
while ( now <= last ) {
v = list[now++] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d : ", v) ;
IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
fflush(msgFile) ;
}
for ( ii = 0 ; ii < vsize ; ii++ ) {
w = vadj[ii] ;
if ( w < nvtx && mark[w] == -1 && compids[w] == 2 ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n adding %d to list", w) ;
fflush(msgFile) ;
}
mark[w] = 2 ;
list[count++] = w ;
}
}
}
}
}
nsecond = count - nsep - nfirst ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %d nodes added from the second component",
nsecond) ;
fflush(msgFile) ;
}
if ( msglvl > 3 ) {
IVfp80(msgFile, nsecond, &list[nsep + nfirst], 80, &ierr) ;
fflush(msgFile) ;
}
IVqsortUp(count, list) ;
/*
--------------------
create the IV object
--------------------
*/
sepIV = IV_new() ;
IV_init(sepIV, count, NULL) ;
IVcopy(count, IV_entries(sepIV), list) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n separator has %d nodes", IV_size(sepIV)) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n sepIV") ;
IV_writeForHumanEye(sepIV, msgFile) ;
fflush(msgFile) ;
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(mark) ;
IVfree(list) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n return from GPart_identifyWideSep") ;
fflush(msgFile) ;
}
return(sepIV) ; }
/*
-----------------------------------------------------------------
given a domain decomposition, find a bisector
1. construct the domain/segment graph
2. use block kernihan-lin to get an initial bisector
alpha -- cost function parameter for BKL
seed -- random number seed
cpus -- array to store CPU times
cpus[0] -- time to find domain/segment map
cpus[1] -- time to find domain/segment bipartite graph
cpus[2] -- time to find two-set partition
return value -- cost of the partition
created -- 96mar09, cca
-----------------------------------------------------------------
*/
double
GPart_TwoSetViaBKL (
GPart *gpart,
double alpha,
int seed,
double cpus[]
) {
BKL *bkl ;
BPG *bpg ;
double t1, t2 ;
FILE *msgFile ;
float bestcost ;
Graph *g, *gc ;
int c, flag, ierr, msglvl, ndom, nseg, nvtx, v ;
int *compids, *cweights, *dscolors, *dsmap, *vwghts ;
IV *dsmapIV ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL || cpus == NULL ) {
fprintf(stderr, "\n fatal error in GPart_DDsep(%p,%f,%d,%p)"
"\n bad input\n", gpart, alpha, seed, cpus) ;
exit(-1) ;
}
g = gpart->g ;
nvtx = gpart->nvtx ;
compids = IV_entries(&gpart->compidsIV) ;
cweights = IV_entries(&gpart->cweightsIV) ;
vwghts = g->vwghts ;
msglvl = gpart->msglvl ;
msgFile = gpart->msgFile ;
/*
HARDCODE THE ALPHA PARAMETER.
*/
alpha = 1.0 ;
/*
------------------------------
(1) get the domain/segment map
(2) get the compressed graph
(3) create the bipartite graph
------------------------------
*/
MARKTIME(t1) ;
dsmapIV = GPart_domSegMap(gpart, &ndom, &nseg) ;
dsmap = IV_entries(dsmapIV) ;
MARKTIME(t2) ;
cpus[0] = t2 - t1 ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n CPU %9.5f : generate domain-segment map",
t2 - t1) ;
fprintf(msgFile, "\n ndom = %d, nseg = %d", ndom, nseg) ;
fflush(msgFile) ;
}
/*
-----------------------------------------
create the domain/segment bipartite graph
-----------------------------------------
*/
MARKTIME(t1) ;
gc = Graph_compress(gpart->g, dsmap, 1) ;
bpg = BPG_new() ;
BPG_init(bpg, ndom, nseg, gc) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n CPU %9.5f : create domain-segment graph",
t2 - t1) ;
fflush(msgFile) ;
}
cpus[1] = t2 - t1 ;
if ( msglvl > 2 ) {
if ( bpg->graph->vwghts != NULL ) {
fprintf(msgFile, "\n domain weights :") ;
IVfp80(msgFile, bpg->nX, bpg->graph->vwghts, 17, &ierr) ;
fprintf(msgFile, "\n segment weights :") ;
IVfp80(msgFile, bpg->nY, bpg->graph->vwghts+bpg->nX, 18, &ierr) ;
fflush(msgFile) ;
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n dsmapIV ") ;
IV_writeForHumanEye(dsmapIV, msgFile) ;
fprintf(msgFile, "\n\n domain/segment bipartite graph ") ;
BPG_writeForHumanEye(bpg, msgFile) ;
fflush(msgFile) ;
}
/*
------------------------------------
create and initialize the BKL object
------------------------------------
*/
MARKTIME(t1) ;
flag = 5 ;
bkl = BKL_new() ;
BKL_init(bkl, bpg, alpha) ;
BKL_setInitPart(bkl, flag, seed, NULL) ;
bestcost = BKL_evalfcn(bkl) ;
gpart->ncomp = 2 ;
MARKTIME(t2) ;
cpus[2] = t2 - t1 ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n CPU %9.5f : initialize BKL object", t2 - t1) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n BKL : flag = %d, seed = %d", flag, seed) ;
fprintf(msgFile, ", initial cost = %.2f", bestcost) ;
fflush(msgFile) ;
fprintf(msgFile, ", cweights = < %d %d %d >",
bkl->cweights[0], bkl->cweights[1], bkl->cweights[2]) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n colors") ;
IVfp80(msgFile, bkl->nreg, bkl->colors, 80, &ierr) ;
fflush(msgFile) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n BKL initial weights : ") ;
IVfp80(msgFile, 3, bkl->cweights, 25, &ierr) ;
fflush(msgFile) ;
}
/*
--------------------------------
improve the partition via fidmat
--------------------------------
*/
MARKTIME(t1) ;
bestcost = BKL_fidmat(bkl) ;
MARKTIME(t2) ;
cpus[2] += t2 - t1 ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n CPU %9.5f : improve the partition via fidmat",
t2 - t1) ;
fflush(msgFile) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n BKL : %d passes", bkl->npass) ;
fprintf(msgFile, ", %d flips", bkl->nflips) ;
fprintf(msgFile, ", %d gainevals", bkl->ngaineval) ;
fprintf(msgFile, ", %d improve steps", bkl->nimprove) ;
fprintf(msgFile, ", cost = %9.2f", bestcost) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n BKL STATS < %9d %9d %9d > %9.2f < %4d %4d %4d %4d %4d >",
bkl->cweights[0], bkl->cweights[1], bkl->cweights[2],
bestcost, bkl->npass, bkl->npatch, bkl->nflips, bkl->nimprove,
bkl->ngaineval) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n colors") ;
IVfp80(msgFile, bkl->nreg, bkl->colors, 80, &ierr) ;
fflush(msgFile) ;
}
/*
----------------------------
set compids[] and cweights[]
----------------------------
*/
MARKTIME(t1) ;
dscolors = bkl->colors ;
gpart->ncomp = 2 ;
IV_setSize(&gpart->cweightsIV, 3) ;
cweights = IV_entries(&gpart->cweightsIV) ;
cweights[0] = cweights[1] = cweights[2] = 0 ;
if ( vwghts == NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
compids[v] = c = dscolors[dsmap[v]] ;
cweights[c]++ ;
}
} else {
for ( v = 0 ; v < nvtx ; v++ ) {
compids[v] = c = dscolors[dsmap[v]] ;
cweights[c] += vwghts[v] ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n BKL partition : < %d %d %d >",
cweights[0], cweights[1], cweights[2]) ;
fflush(msgFile) ;
}
/*
------------------------------------
free the BKL object, the BPG object
and the domain/segment map IV object
------------------------------------
*/
BKL_free(bkl) ;
IV_free(dsmapIV) ;
BPG_free(bpg) ;
MARKTIME(t2) ;
cpus[2] += t2 - t1 ;
return((double) bestcost) ;
}
/*
--------------------------------------------------------------------
fill *pndom with ndom, the number of domains.
fill *pnseg with nseg, the number of segments.
domains are numbered in [0, ndom), segments in [ndom,ndom+nseg).
return -- an IV object that contains the map
from vertices to segments
created -- 99feb29, cca
--------------------------------------------------------------------
*/
IV *
GPart_domSegMap (
GPart *gpart,
int *pndom,
int *pnseg
) {
FILE *msgFile ;
Graph *g ;
int adjdom, count, d, first, ierr, ii, jj1, jj2, last, ndom,
msglvl, nextphi, nPhi, nPsi, nV, phi, phi0, phi1, phi2, phi3,
psi, sigma, size, size0, size1, size2, v, vsize, w ;
int *adj, *adj0, *adj1, *adj2, *compids, *dmark, *dsmap, *head,
*link, *list, *offsets, *PhiToPsi, *PhiToV, *PsiToSigma,
*vadj, *VtoPhi ;
IV *dsmapIV ;
IVL *PhiByPhi, *PhiByPowD, *PsiByPowD ;
/*
--------------------
set the initial time
--------------------
*/
icputimes = 0 ;
MARKTIME(cputimes[icputimes]) ;
/*
---------------
check the input
---------------
*/
if ( gpart == NULL
|| (g = gpart->g) == NULL
|| pndom == NULL
|| pnseg == NULL ) {
fprintf(stderr, "\n fatal error in GPart_domSegMap(%p,%p,%p)"
"\n bad input\n", gpart, pndom, pnseg) ;
exit(-1) ;
}
compids = IV_entries(&gpart->compidsIV) ;
msglvl = gpart->msglvl ;
msgFile = gpart->msgFile ;
/*
------------------------
create the map IV object
------------------------
*/
nV = g->nvtx ;
dsmapIV = IV_new() ;
IV_init(dsmapIV, nV, NULL) ;
dsmap = IV_entries(dsmapIV) ;
/*
----------------------------------
check compids[] and get the number
of domains and interface vertices
----------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
ndom = nPhi = 0 ;
for ( v = 0 ; v < nV ; v++ ) {
if ( (d = compids[v]) < 0 ) {
fprintf(stderr,
"\n fatal error in GPart_domSegMap(%p,%p,%p)"
"\n compids[%d] = %d\n", gpart, pndom, pnseg,
v, compids[v]) ;
exit(-1) ;
} else if ( d == 0 ) {
nPhi++ ;
} else if ( ndom < d ) {
ndom = d ;
}
}
*pndom = ndom ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n Inside GPart_domSegMap") ;
fprintf(msgFile, "\n %d domains, %d Phi vertices", ndom, nPhi) ;
}
if ( ndom == 1 ) {
IVfill(nV, dsmap, 0) ;
*pndom = 1 ;
*pnseg = 0 ;
return(dsmapIV) ;
}
/*
--------------------------------
get the maps
PhiToV : [0,nPhi) |---> [0,nV)
VtoPhi : [0,nV) |---> [0,nPhi)
--------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PhiToV = IVinit(nPhi, -1) ;
VtoPhi = IVinit(nV, -1) ;
for ( v = 0, phi = 0 ; v < nV ; v++ ) {
if ( (d = compids[v]) == 0 ) {
PhiToV[phi] = v ;
VtoPhi[v] = phi++ ;
}
}
if ( phi != nPhi ) {
fprintf(stderr,
"\n fatal error in GPart_domSegMap(%p,%p,%p)"
"\n phi = %d != %d = nPhi\n",
gpart, pndom, pnseg, phi, nPhi) ;
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiToV(%d) :", nPhi) ;
IVfp80(msgFile, nPhi, PhiToV, 15, &ierr) ;
fflush(msgFile) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n VtoPhi(%d) :", nV) ;
IVfp80(msgFile, nV, VtoPhi, 15, &ierr) ;
fflush(msgFile) ;
}
/*
---------------------------------------------------
create an IVL object, PhiByPowD, to hold lists from
the interface vertices to their adjacent domains
---------------------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
dmark = IVinit(ndom+1, -1) ;
if ( nPhi >= ndom ) {
list = IVinit(nPhi, -1) ;
} else {
list = IVinit(ndom, -1) ;
}
PhiByPowD = IVL_new() ;
IVL_init1(PhiByPowD, IVL_CHUNKED, nPhi) ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
v = PhiToV[phi] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
/*
if ( phi == 0 ) {
int ierr ;
fprintf(msgFile, "\n adj(%d,%d) = ", v, phi) ;
IVfp80(msgFile, vsize, vadj, 15, &ierr) ;
fflush(msgFile) ;
}
*/
count = 0 ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
if ( (w = vadj[ii]) < nV
&& (d = compids[w]) > 0
&& dmark[d] != phi ) {
dmark[d] = phi ;
list[count++] = d ;
}
}
if ( count > 0 ) {
IVqsortUp(count, list) ;
IVL_setList(PhiByPowD, phi, count, list) ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiByPowD : interface x adjacent domains") ;
IVL_writeForHumanEye(PhiByPowD, msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------------
create an IVL object, PhiByPhi to hold lists
from the interface vertices to interface vertices.
(s,t) are in the list if (s,t) is an edge in the graph
and s and t do not share an adjacent domain
-------------------------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PhiByPhi = IVL_new() ;
IVL_init1(PhiByPhi, IVL_CHUNKED, nPhi) ;
offsets = IVinit(nPhi, 0) ;
head = IVinit(nPhi, -1) ;
link = IVinit(nPhi, -1) ;
for ( phi1 = 0 ; phi1 < nPhi ; phi1++ ) {
count = 0 ;
if ( msglvl > 2 ) {
v = PhiToV[phi1] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
fprintf(msgFile, "\n checking out phi = %d, v = %d", phi1, v) ;
fprintf(msgFile, "\n adj(%d) : ", v) ;
IVfp80(msgFile, vsize, vadj, 10, &ierr) ;
}
/*
-------------------------------------------------------------
get (phi1, phi0) edges that were previously put into the list
-------------------------------------------------------------
*/
if ( msglvl > 3 ) {
if ( head[phi1] == -1 ) {
fprintf(msgFile, "\n no previous edges") ;
} else {
fprintf(msgFile, "\n previous edges :") ;
}
}
for ( phi0 = head[phi1] ; phi0 != -1 ; phi0 = nextphi ) {
if ( msglvl > 3 ) {
fprintf(msgFile, " %d", phi0) ;
}
nextphi = link[phi0] ;
list[count++] = phi0 ;
IVL_listAndSize(PhiByPhi, phi0, &size0, &adj0) ;
if ( (ii = ++offsets[phi0]) < size0 ) {
/*
----------------------------
link phi0 into the next list
----------------------------
*/
phi2 = adj0[ii] ;
link[phi0] = head[phi2] ;
head[phi2] = phi0 ;
}
}
/*
--------------------------
get new edges (phi1, phi2)
--------------------------
*/
IVL_listAndSize(PhiByPowD, phi1, &size1, &adj1) ;
v = PhiToV[phi1] ;
Graph_adjAndSize(g, v, &vsize, &vadj) ;
for ( ii = 0 ; ii < vsize ; ii++ ) {
if ( (w = vadj[ii]) < nV
&& compids[w] == 0
&& (phi2 = VtoPhi[w]) > phi1 ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n checking out phi2 = %d", phi2) ;
}
/*
--------------------------------------------------
see if phi1 and phi2 have a common adjacent domain
--------------------------------------------------
*/
IVL_listAndSize(PhiByPowD, phi2, &size2, &adj2) ;
adjdom = 0 ;
jj1 = jj2 = 0 ;
while ( jj1 < size1 && jj2 < size2 ) {
if ( adj1[jj1] < adj2[jj2] ) {
jj1++ ;
} else if ( adj1[jj1] > adj2[jj2] ) {
jj2++ ;
} else {
if ( msglvl > 3 ) {
fprintf(msgFile, ", common adj domain %d", adj1[jj1]) ;
}
adjdom = 1 ;
break ;
}
}
if ( adjdom == 0 ) {
if ( msglvl > 3 ) {
fprintf(msgFile, ", no adjacent domain") ;
}
list[count++] = phi2 ;
}
}
}
if ( count > 0 ) {
/*
---------------------
set the list for phi1
---------------------
*/
IVqsortUp(count, list) ;
IVL_setList(PhiByPhi, phi1, count, list) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n edge list for %d :", phi1) ;
IVfp80(msgFile, count, list, 15, &ierr) ;
}
for ( ii = 0, phi2 = -1 ; ii < count ; ii++ ) {
if ( list[ii] > phi1 ) {
offsets[phi1] = ii ;
phi2 = list[ii] ;
break ;
}
}
if ( phi2 != -1 ) {
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n linking %d into list for %d", phi1, phi2) ;
}
link[phi1] = head[phi2] ;
head[phi2] = phi1 ;
}
/*
phi2 = list[0] ;
link[phi1] = head[phi2] ;
head[phi2] = phi1 ;
*/
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiByPhi : interface x interface") ;
IVL_writeForHumanEye(PhiByPhi, msgFile) ;
fflush(msgFile) ;
}
/*
--------------------
get the PhiToPsi map
--------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PhiToPsi = IVinit(nPhi, -1) ;
nPsi = 0 ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
if ( PhiToPsi[phi] == -1 ) {
/*
---------------------------
phi not yet mapped to a psi
---------------------------
*/
first = last = 0 ;
list[0] = phi ;
PhiToPsi[phi] = nPsi ;
while ( first <= last ) {
phi2 = list[first++] ;
IVL_listAndSize(PhiByPhi, phi2, &size, &adj) ;
for ( ii = 0 ; ii < size ; ii++ ) {
phi3 = adj[ii] ;
if ( PhiToPsi[phi3] == -1 ) {
PhiToPsi[phi3] = nPsi ;
list[++last] = phi3 ;
}
}
}
nPsi++ ;
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n nPsi = %d", nPsi) ;
fflush(msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PhiToPsi(%d) :", nPhi) ;
IVfp80(msgFile, nPhi, PhiToPsi, 15, &ierr) ;
fflush(msgFile) ;
}
/*
---------------------------------
create an IVL object, Psi --> 2^D
---------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
IVfill(nPsi, head, -1) ;
IVfill(nPhi, link, -1) ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
psi = PhiToPsi[phi] ;
link[phi] = head[psi] ;
head[psi] = phi ;
}
PsiByPowD = IVL_new() ;
IVL_init1(PsiByPowD, IVL_CHUNKED, nPsi) ;
IVfill(ndom+1, dmark, -1) ;
for ( psi = 0 ; psi < nPsi ; psi++ ) {
count = 0 ;
for ( phi = head[psi] ; phi != -1 ; phi = link[phi] ) {
v = PhiToV[phi] ;
Graph_adjAndSize(g, v, &size, &adj) ;
for ( ii = 0 ; ii < size ; ii++ ) {
if ( (w = adj[ii]) < nV
&& (d = compids[w]) > 0
&& dmark[d] != psi ) {
dmark[d] = psi ;
list[count++] = d ;
}
}
}
if ( count > 0 ) {
IVqsortUp(count, list) ;
IVL_setList(PsiByPowD, psi, count, list) ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n PsiByPowD(%d) :", nPhi) ;
IVL_writeForHumanEye(PsiByPowD, msgFile) ;
fflush(msgFile) ;
}
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
/*
-------------------------------------
now get the map Psi |---> Sigma that
is the equivalence map over PhiByPowD
-------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
PsiToSigma = IVL_equivMap1(PsiByPowD) ;
*pnseg = 1 + IVmax(nPsi, PsiToSigma, &ii) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n nSigma = %d", *pnseg) ;
fprintf(msgFile, "\n PsiToSigma(%d) :", nPhi) ;
IVfp80(msgFile, nPsi, PsiToSigma, 15, &ierr) ;
fflush(msgFile) ;
}
/*
--------------------------------------------------------------
now fill the map from the vertices to the domains and segments
--------------------------------------------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
for ( v = 0 ; v < nV ; v++ ) {
if ( (d = compids[v]) > 0 ) {
dsmap[v] = d - 1 ;
} else {
phi = VtoPhi[v] ;
psi = PhiToPsi[phi] ;
sigma = PsiToSigma[psi] ;
dsmap[v] = ndom + sigma ;
}
}
/*
------------------------
free the working storage
------------------------
*/
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
IVL_free(PhiByPhi) ;
IVL_free(PhiByPowD) ;
IVL_free(PsiByPowD) ;
IVfree(PhiToV) ;
IVfree(VtoPhi) ;
IVfree(dmark) ;
IVfree(list) ;
IVfree(PhiToPsi) ;
IVfree(head) ;
IVfree(link) ;
IVfree(offsets) ;
IVfree(PsiToSigma) ;
icputimes++ ;
MARKTIME(cputimes[icputimes]) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n domain/segment map timings split") ;
fprintf(msgFile,
"\n %9.5f : create the DSmap object"
"\n %9.5f : get numbers of domain and interface vertices"
"\n %9.5f : generate PhiToV and VtoPhi"
"\n %9.5f : generate PhiByPowD"
"\n %9.5f : generate PhiByPhi"
"\n %9.5f : generate PhiToPsi"
"\n %9.5f : generate PsiByPowD"
"\n %9.5f : generate PsiToSigma"
"\n %9.5f : generate dsmap"
"\n %9.5f : free working storage"
"\n %9.5f : total time",
cputimes[1] - cputimes[0],
cputimes[2] - cputimes[1],
cputimes[3] - cputimes[2],
cputimes[4] - cputimes[3],
cputimes[5] - cputimes[4],
cputimes[6] - cputimes[5],
cputimes[7] - cputimes[6],
cputimes[8] - cputimes[7],
cputimes[9] - cputimes[8],
cputimes[10] - cputimes[9],
cputimes[11] - cputimes[0]) ;
}
return(dsmapIV) ; }
/*
---------------------------------------------------------------------
purpose -- to order the graph using multi-stage minimum degree
g -- Graph object
stages -- stage vector for vertices,
if NULL then
all vertices on stage zero.
otherwise
vertices with stage istage are eliminated
before any vertices with stage > istage
working storage is free'd,
statistics can be accessed through their variables or printed
via the void MSMD_printStats(MSMD*,FILE*) method.
created -- 96feb25, cca
---------------------------------------------------------------------
*/
void
MSMD_order (
MSMD *msmd,
Graph *g,
int stages[],
MSMDinfo *info
) {
double t0, t1, t2, t3 ;
int istage, iv, nstage, nvtx ;
IP *ip ;
MSMDstageInfo *now, *total ;
MSMDvtx *v ;
/*
---------------
check the input
---------------
*/
MARKTIME(t0) ;
if ( msmd == NULL || g == NULL || info == NULL ) {
fprintf(stderr, "\n fatal error in MSMD_order(%p,%p,%p,%p)"
"\n bad input\n", msmd, g, stages, info) ;
exit(-1) ;
}
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n\n inside MSMD_order()") ;
if ( stages != NULL ) {
int ierr ;
fprintf(info->msgFile, "\n stages[%d]", g->nvtx) ;
IVfp80(info->msgFile, g->nvtx, stages, 80, &ierr) ;
}
fflush(info->msgFile) ;
}
/*
-------------------------------
check the information structure
-------------------------------
*/
if ( MSMDinfo_isValid(info) != 1 ) {
fprintf(stderr, "\n fatal error in MSMD_order(%p,%p,%p,%p)"
"\n bad MSMDinfo object\n", msmd, g, stages, info) ;
exit(-1) ;
}
/*
---------------------
initialize the object
---------------------
*/
if ( info->msglvl > 3 ) {
fprintf(info->msgFile, "\n\n trying to initialize MSMD object ") ;
Graph_writeForHumanEye(g, info->msgFile) ;
fflush(info->msgFile) ;
}
MSMD_init(msmd, g, stages, info) ;
nvtx = g->nvtx ;
nstage = info->nstage ;
if ( info->msglvl > 2 ) {
fprintf(info->msgFile,
"\n\n MSMD object initialized, %d stages", nstage) ;
fflush(info->msgFile) ;
}
/*
------------------------------------
load the reach set with all vertices
------------------------------------
*/
if ( info->compressFlag / 4 >= 1 ) {
/*
------------------
compress the graph
------------------
*/
if ( info->msglvl > 2 ) {
fprintf(info->msgFile, "\n\n initial compression") ;
fflush(info->msgFile) ;
}
IV_setSize(&msmd->reachIV, nvtx) ;
IV_ramp(&msmd->reachIV, 0, 1) ;
MSMD_findInodes(msmd, info) ;
if ( info->msglvl > 2 ) {
fprintf(info->msgFile,
"\n\n %d checked, %d found indistinguishable",
info->stageInfo->ncheck, info->stageInfo->nindst) ;
fflush(info->msgFile) ;
}
MSMD_cleanReachSet(msmd, info) ;
/*
for ( iv = 0, v = msmd->vertices ; iv < nvtx ; iv++, v++ ) {
MSMD_cleanEdgeList(msmd, v, info) ;
}
*/
}
IV_setSize(&msmd->reachIV, 0) ;
/*
--------------------
loop over the stages
--------------------
*/
for ( info->istage = 0 ; info->istage <= nstage ; info->istage++ ) {
if ( info->msglvl > 2 ) {
fprintf(info->msgFile,
"\n\n ##### elimination stage %d", info->istage) ;
fflush(info->msgFile) ;
}
/*
if ( info->istage == nstage ) {
info->msglvl = 5 ;
}
*/
MARKTIME(t1) ;
MSMD_eliminateStage(msmd, info) ;
MARKTIME(t2) ;
info->stageInfo->cpu = t2 - t1 ;
info->stageInfo++ ;
}
/*
-------------
final cleanup
-------------
*/
{
MSMDvtx *first, *last, *v ;
IV_setSize(&msmd->reachIV, 0) ;
first = msmd->vertices ;
last = first + nvtx - 1 ;
for ( v = first ; v <= last ; v++ ) {
switch ( v->status ) {
case 'E' :
case 'L' :
case 'I' :
break ;
default :
IV_push(&msmd->reachIV, v->id) ;
break ;
}
}
/*
fprintf(stdout, "\n reach set, %d entries", IV_size(&msmd->reachIV)) ;
IV_writeForHumanEye(&msmd->reachIV, stdout) ;
*/
MSMD_findInodes(msmd, info) ;
}
/*
---------------------------------------------------------
make info->stagInfo point back to beginning of the stages
---------------------------------------------------------
*/
info->stageInfo -= nstage + 1 ;
/*
------------------------
get the total statistics
------------------------
*/
for ( istage = 0, now = info->stageInfo,
total = info->stageInfo + nstage + 1 ;
istage <= nstage ;
istage++, now++ ) {
total->nstep += now->nstep ;
total->nfront += now->nfront ;
total->welim += now->welim ;
total->nfind += now->nfind ;
total->nzf += now->nzf ;
total->ops += now->ops ;
total->nexact2 += now->nexact2 ;
total->nexact3 += now->nexact3 ;
total->napprox += now->napprox ;
total->ncheck += now->ncheck ;
total->nindst += now->nindst ;
total->noutmtch += now->noutmtch ;
}
/*
-----------------------------------------------------
free some working storage (leave the MSMDvtx objects
so the user can extract the permutations and/or ETree
-----------------------------------------------------
*/
IIheap_free(msmd->heap) ;
msmd->heap = NULL ;
IV_clearData(&msmd->ivtmpIV) ;
IV_clearData(&msmd->reachIV) ;
/*
while ( (ip = msmd->baseIP) != NULL ) {
msmd->baseIP = ip->next ;
IP_free(ip) ;
}
*/
MARKTIME(t3) ;
info->totalCPU = t3 - t0 ;
return ; }
/*
----------------------------------------------------------------
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 ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------
test the Chv_addChevron() method.
created -- 98apr18, cca
---------------------------------------
*/
{
Chv *chv ;
double alpha[2] ;
double imag, real, t1, t2 ;
double *chvent, *entries ;
Drand *drand ;
FILE *msgFile ;
int chvsize, count, ichv, ierr, ii, iloc, irow, jcol,
lastcol, msglvl, ncol, nD, nent, nL, nrow, nU,
off, seed, symflag, type, upper ;
int *chvind, *colind, *keys, *rowind, *temp ;
if ( argc != 10 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nD nU type symflag seed "
"\n alphareal alphaimag"
"\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 --> hermitian"
"\n 2 --> nonsymmetric"
"\n seed -- random number seed"
"\n alpha -- scaling parameter"
"\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]) ;
seed = atoi(argv[7]) ;
alpha[0] = atof(argv[8]) ;
alpha[1] = atof(argv[9]) ;
if ( nD <= 0 || nU < 0 || symflag < 0 || symflag > 2 ) {
fprintf(stderr, "\n invalid input"
"\n nD = %d, nU = %d, symflag = %d\n", nD, nU, symflag) ;
exit(-1) ;
}
fprintf(msgFile, "\n alpha = %12.4e + %12.4e*i ;", alpha[0], alpha[1]) ;
nL = nU ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
----------------------------
initialize the Chv object
----------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
temp = IVinit(2*(nD+nU), -1) ;
IVramp(2*(nD+nU), temp, 0, 1) ;
IVshuffle(2*(nD+nU), temp, ++seed) ;
IVcopy(ncol, colind, temp) ;
IVqsortUp(ncol, colind) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
Chv_rowIndices(chv, &nrow, &rowind) ;
IVcopy(nrow, rowind, colind) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %% column indices") ;
IVfprintf(msgFile, ncol, colind) ;
}
lastcol = colind[ncol-1] ;
nent = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
/*
---------------------------------------------------------
hermitian example, set imaginary part of diagonal to zero
---------------------------------------------------------
*/
for ( irow = 0 ; irow < nD ; irow++ ) {
Chv_complexEntry(chv, irow, irow, &real, &imag) ;
Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chv, "a", msgFile) ;
}
/*
--------------------------------------------------
fill a chevron with random numbers and indices
that are a subset of a front's, as in the assembly
of original matrix entries.
--------------------------------------------------
*/
Drand_setUniform(drand, 0, nD) ;
iloc = (int) Drand_value(drand) ;
ichv = colind[iloc] ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
upper = nD - iloc + nU ;
} else {
upper = 2*(nD - iloc) - 1 + nL + nU ;
}
Drand_setUniform(drand, 1, upper) ;
chvsize = (int) Drand_value(drand) ;
fprintf(msgFile, "\n %% iloc = %d, ichv = %d, chvsize = %d",
iloc, ichv, chvsize) ;
chvind = IVinit(chvsize, -1) ;
chvent = DVinit(2*chvsize, 0.0) ;
Drand_setNormal(drand, 0.0, 1.0) ;
if ( CHV_IS_REAL(chv) ) {
Drand_fillDvector(drand, chvsize, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
Drand_fillDvector(drand, 2*chvsize, chvent) ;
}
keys = IVinit(upper+1, -1) ;
keys[0] = 0 ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
keys[count++] = colind[ii] - ichv ;
}
} else {
for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
keys[count++] = colind[ii] - ichv ;
keys[count++] = - colind[ii] + ichv ;
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% iloc = %d, ichv = %d", iloc, ichv) ;
fprintf(msgFile, "\n %% upper = %d", upper) ;
fprintf(msgFile, "\n %% chvsize = %d", chvsize) ;
fprintf(msgFile, "\n %% initial keys") ;
IVfprintf(msgFile, count, keys) ;
}
IVshuffle(count, keys, ++seed) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% shuffled keys") ;
IVfp80(msgFile, count, keys, 80, &ierr) ;
}
IVcopy(chvsize, chvind, keys) ;
if ( CHV_IS_REAL(chv) ) {
IVDVqsortUp(chvsize, chvind, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
IVZVqsortUp(chvsize, chvind, chvent) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chvind") ;
IVfprintf(msgFile, chvsize, chvind) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
if ( chvind[ii] == 0 ) {
chvent[2*ii+1] = 0.0 ;
}
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) ) {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]+off+1, colind[iloc]+1, chvent[ii]) ;
}
} else {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
if ( off > 0 ) {
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
} else {
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]-off+1, colind[iloc]+1, chvent[ii]) ;
}
}
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+1, colind[iloc]+off+1,
chvent[2*ii], chvent[2*ii+1]) ;
if ( CHV_IS_HERMITIAN(chv) ) {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+off+1, colind[iloc]+1,
chvent[2*ii], -chvent[2*ii+1]) ;
} else {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+off+1, colind[iloc]+1,
chvent[2*ii], chvent[2*ii+1]) ;
}
}
} else {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
if ( off > 0 ) {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+1, colind[iloc]+off+1,
chvent[2*ii], chvent[2*ii+1]) ;
} else {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]-off+1, colind[iloc]+1,
chvent[2*ii], chvent[2*ii+1]) ;
}
}
}
}
}
/*
------------------------------------
add the chevron into the Chv object
------------------------------------
*/
Chv_addChevron(chv, alpha, ichv, chvsize, chvind, chvent) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n %% after adding the chevron") ;
fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chv, "c", msgFile) ;
}
/*
-----------------
compute the error
-----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (a + alpha*b))))") ;
/*
------------------------
free the working storage
------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
IVfree(temp) ;
IVfree(chvind) ;
DVfree(chvent) ;
IVfree(keys) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*
-----------------------------------------------------
purpose -- to write an IVL object to a formatted file
return value -- 1 if success, 0 otherwise
created -- 95sep29, cca
-----------------------------------------------------
*/
int
IVL_writeToFormattedFile (
IVL *ivl,
FILE *fp
) {
int count, ierr, j, jsize, nlist, rc ;
int *jind ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || fp == NULL || (nlist = ivl->nlist) <= 0 ) {
fprintf(stderr, "\n fatal error in IVL_writeToFormattedFile(%p,%p)"
"\n bad input\n", ivl, fp) ;
spoolesFatal();
}
/*
-------------------------------------
write out the three scalar parameters
-------------------------------------
*/
rc = fprintf(fp, "\n %d %d %d", ivl->type, ivl->nlist, ivl->tsize) ;
if ( rc < 0 ) {
fprintf(stderr, "\n fatal error in IVL_writeToFormattedFile(%p,%p)"
"\n rc = %d, return from first fprintf\n", ivl, fp, rc) ;
return(0) ;
}
if ( ivl->nlist > 0 ) {
IVfp80(fp, ivl->nlist, ivl->sizes, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in IVL_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from sizes[] IVfp80\n",
ivl, fp, ierr) ;
return(0) ;
}
}
switch ( ivl->type ) {
case IVL_NOTYPE :
break ;
case IVL_UNKNOWN :
case IVL_CHUNKED :
case IVL_SOLO :
for ( j = 0, count = 80 ; j < ivl->nlist ; j++ ) {
IVL_listAndSize(ivl, j, &jsize, &jind) ;
if ( jsize > 0 ) {
count = IVfp80(fp, jsize, jind, count, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in IVL_writeToFormattedFile(%p,%p)"
"\n ierr = %d, return from IVfp80, list %d\n",
ivl, fp, ierr, j) ;
return(0) ;
}
}
}
break ;
}
return(1) ; }
/*
------------------------------------------------------------
compute an old-to-new ordering for
local nested dissection in two dimensions
n1 -- number of grid points in first direction
n2 -- number of grid points in second direction
p1 -- number of domains in first direction
p2 -- number of domains in second direction
dsizes1 -- domain sizes in first direction, size p1
if NULL, then we construct our own
dsizes2 -- domain sizes in second direction, size p2
if NULL, then we construct our own
oldToNew -- old-to-new permutation vector
note : the following must hold
n1 > 0, n2 >0, n1 >= 2*p1 - 1, n2 >= 2*p2 - 1, p2 > 1
sum(dsizes1) = n1 - p1 + 1 and sum(dsizes2) = n2 - p2 + 1
created -- 95nov16, cca
------------------------------------------------------------
*/
void
localND2D (
int n1,
int n2,
int p1,
int p2,
int dsizes1[],
int dsizes2[],
int oldToNew[]
) {
int i, idom, ij, isw, j, jdom, jsw, length1, length2,
m, m1, m2, msize, now, nvtx ;
int *length1s, *length2s, *isws, *jsws, *temp ;
/*
---------------
check the input
---------------
*/
if ( n1 <= 0 || n2 <= 0 || 2*p1 - 1 > n1 || 2*p2 - 1 > n2
|| oldToNew == NULL ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n bad input\n",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew) ;
exit(-1) ;
}
if ( p2 <= 1 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n p2 = %d, must be > 1",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew, p2) ;
exit(-1) ;
}
if ( dsizes1 != NULL && IVsum(p1, dsizes1) != n1 - p1 + 1 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVsum(p1, dsizes1) = %d != %d = n1 - p1 + 1 ",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVsum(p1, dsizes1), n1 - p1 + 1) ;
return ;
}
if ( dsizes1 != NULL && IVmin(p1, dsizes1, &i) <= 0 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVmin(p1, dsizes1) = %d must be > 0",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVmin(p1, dsizes1, &i)) ;
return ;
}
if ( dsizes2 != NULL && IVsum(p2, dsizes2) != n2 - p2 + 1 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVsum(p2, dsizes2) = %d != %d = n2 - p2 + 1 ",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVsum(p2, dsizes2), n2 - p2 + 1) ;
return ;
}
if ( dsizes2 != NULL && IVmin(p2, dsizes2, &i) <= 0 ) {
fprintf(stderr, "\n fatal error in localND2D(%d,%d,%d,%d,%p,%p,%p)"
"\n IVmin(p2, dsizes2) = %d must be > 0",
n1, n2, p1, p2, dsizes1, dsizes2, oldToNew,
IVmin(p2, dsizes2, &i)) ;
return ;
}
nvtx = n1*n2 ;
/*
----------------------------------
construct the domain sizes vectors
----------------------------------
*/
if ( dsizes1 == NULL ) {
length1s = IVinit(p1, 0) ;
length1 = (n1 - p1 + 1) / p1 ;
m1 = (n1 - p1 + 1) % p1 ;
for ( i = 0 ; i < m1 ; i++ ) {
length1s[i] = length1 + 1 ;
}
for ( ; i < p1 ; i++ ) {
length1s[i] = length1 ;
}
} else {
length1s = dsizes1 ;
}
if ( dsizes2 == NULL ) {
length2s = IVinit(p2, 0) ;
length2 = (n2 - p2 + 1) / p2 ;
m2 = (n2 - p2 + 1) % p2 ;
for ( i = 0 ; i < m2 ; i++ ) {
length2s[i] = length2 + 1 ;
}
for ( ; i < p2 ; i++ ) {
length2s[i] = length2 ;
}
} else {
length2s = dsizes2 ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n inside localND2D") ;
fprintf(stdout, "\n n1 = %d, n2 = %d, p1 = %d, p2 = %d",
n1, n2, p1, p2) ;
fprintf(stdout, "\n length1s[%d] = ", p1) ;
IVfp80(stdout, p1, length1s, 12) ;
fprintf(stdout, "\n length2s[%d] = ", p2) ;
IVfp80(stdout, p2, length2s, 12) ;
#endif
/*
---------------------------------------
determine the first and last domain ids
and the array of southwest points
---------------------------------------
*/
isws = IVinit(p1, -1) ;
for ( idom = 0, isw = 0 ; idom < p1 ; idom++ ) {
isws[idom] = isw ;
isw += length1s[idom] + 1 ;
}
jsws = IVinit(p2, -1) ;
for ( jdom = 0, jsw = 0 ; jdom < p2 ; jdom++ ) {
jsws[jdom] = jsw ;
jsw += length2s[jdom] + 1 ;
}
#if MYDEBUG > 1
fprintf(stdout, "\n isws[%d] = ", p1) ;
IVfp80(stdout, p1, isws, 12) ;
fprintf(stdout, "\n jsws[%d] = ", p2) ;
IVfp80(stdout, p2, jsws, 12) ;
#endif
/*
----------------------------------------------------------------
create a temporary permutation vector for the domains' orderings
----------------------------------------------------------------
*/
msize = IVmax(p1, length1s, &i) * IVmax(p2, length2s, &i) ;
temp = IVinit(msize, -1) ;
/*
------------------------
fill in the domain nodes
------------------------
*/
now = 0 ;
for ( jdom = 0; jdom < p2 ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
length1 = length1s[idom] ;
isw = isws[idom] ;
mkNDperm(length1, length2, 1, temp, 0, length1-1,
0, length2-1, 0, 0) ;
for ( m = 0 ; m < length1*length2 ; m++ ) {
ij = temp[m] ;
i = isw + (ij % length1) ;
j = jsw + (ij / length1) ;
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n old-to-new after domains are numbered") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the lower separator nodes
---------------------------------
*/
for ( jdom = 0 ; jdom < (p2/2) ; jdom++ ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = 0 ; idom < p1 ; idom++ ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
if ( isw > 0 ) {
i = isw - 1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
if ( isw > 0 && jsw > 0 ) {
i = isw - 1 ;
j = jsw - 1 ;
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
if ( jsw > 0 ) {
j = jsw - 1 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the lower separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
---------------------------------
fill in the upper separator nodes
---------------------------------
*/
for ( jdom = p2 - 1 ; jdom >= (p2/2) ; jdom-- ) {
jsw = jsws[jdom] ;
length2 = length2s[jdom] ;
for ( idom = p1 - 1 ; idom >= 0 ; idom-- ) {
isw = isws[idom] ;
length1 = length1s[idom] ;
if ( isw + length1 < n1 ) {
i = isw + length1 ;
for ( j = jsw ; j <= jsw + length2 - 1 ; j++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
if ( isw + length1 < n1 && jsw + length2 < n2 ) {
i = isw + length1 ;
j = jsw + length2 ;
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
if ( jsw + length2 < n2 ) {
j = jsw + length2 ;
for ( i = isw ; i <= isw + length1 - 1 ; i++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
}
}
}
#if MYDEBUG > 2
fprintf(stdout, "\n after the upper separators filled in") ;
fp2DGrid(n1, n2, oldToNew, stdout) ;
#endif
/*
-------------------------------
fill in the top level separator
-------------------------------
*/
m1 = p2 / 2 ;
for ( jdom = 0, j = 0 ; jdom < m1 ; jdom++ ) {
j += length2s[jdom] + 1 ;
}
j-- ;
for ( i = 0 ; i < n1 ; i++ ) {
ij = i + j*n1 ;
oldToNew[ij] = now++ ;
}
/*
------------------------
free the working storage
------------------------
*/
if ( dsizes1 == NULL ) {
IVfree(length1s) ;
}
if ( dsizes2 == NULL ) {
IVfree(length2s) ;
}
IVfree(isws) ;
IVfree(jsws) ;
IVfree(temp) ;
return ; }
/*
------------------------------------------------------------
load entries from sigma*A
chv -- pointer to the Chv object that holds the front
pencil -- pointer to a Pencil that holds the matrix entries
msglvl -- message level
msgFile -- message file
created -- 97jul18, cca
------------------------------------------------------------
*/
void
FrontMtx_loadEntries (
Chv *chv,
Pencil *pencil,
int msglvl,
FILE *msgFile
) {
InpMtx *inpmtxA, *inpmtxB ;
double one[2] = {1.0,0.0} ;
double *sigma ;
double *chvent ;
int chvsize, ichv, ncol, nD, nL, nU ;
int *chvind, *colind ;
/*
---------------
check the input
---------------
*/
if ( chv == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr,
"\n fatal error in FrontMtx_loadEntries(%p,%p,%d,%p)"
"\n bad input\n", chv, pencil, msglvl, msgFile) ;
exit(-1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile,
"\n\n # inside loadEntries for chv %d"
", sigma = %12.4e + i*%12.4e",
chv->id, pencil->sigma[0], pencil->sigma[1]) ;
fflush(msgFile) ;
}
Chv_dimensions(chv, &nD, &nL, &nU) ;
Chv_columnIndices(chv, &ncol, &colind) ;
/*
----------------------------------------
load the original entries, A + sigma * B
----------------------------------------
*/
inpmtxA = pencil->inpmtxA ;
sigma = pencil->sigma ;
inpmtxB = pencil->inpmtxB ;
if ( inpmtxA != NULL ) {
int ii ;
/*
-------------------
load entries from A
-------------------
*/
for ( ii = 0 ; ii < nD ; ii++ ) {
ichv = colind[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxA) ) {
InpMtx_realVector(inpmtxA, ichv, &chvsize, &chvind, &chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
InpMtx_complexVector(inpmtxA,
ichv, &chvsize, &chvind, &chvent) ;
}
if ( chvsize > 0 ) {
if ( msglvl > 3 ) {
int ierr ;
fprintf(msgFile, "\n inpmtxA chevron %d : chvsize = %d",
ichv, chvsize) ;
fprintf(msgFile, "\n chvind") ;
IVfp80(msgFile, chvsize, chvind, 80, &ierr) ;
fprintf(msgFile, "\n chvent") ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, chvsize, chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, 2*chvsize, chvent) ;
}
fflush(msgFile) ;
}
Chv_addChevron(chv, one, ichv, chvsize, chvind, chvent) ;
}
}
} else {
double *entries ;
int ii, off, stride ;
/*
-----------------
load the identity
-----------------
*/
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += 1.0 ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += 1.0 ;
off += stride ;
stride -= 2 ;
}
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += 1.0 ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += 1.0 ;
off += stride ;
stride -= 2 ;
}
}
}
}
if ( inpmtxB != NULL ) {
int ii ;
/*
-------------------------
load entries from sigma*B
-------------------------
*/
for ( ii = 0 ; ii < nD ; ii++ ) {
ichv = colind[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxB) ) {
InpMtx_realVector(inpmtxB, ichv, &chvsize, &chvind, &chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
InpMtx_complexVector(inpmtxB,
ichv, &chvsize, &chvind, &chvent) ;
}
if ( chvsize > 0 ) {
if ( msglvl > 3 ) {
int ierr ;
fprintf(msgFile, "\n inpmtxB chevron %d : chvsize = %d",
ichv, chvsize) ;
fprintf(msgFile, "\n chvind") ;
IVfp80(msgFile, chvsize, chvind, 80, &ierr) ;
fprintf(msgFile, "\n chvent") ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, chvsize, chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, 2*chvsize, chvent) ;
}
}
Chv_addChevron(chv, sigma, ichv, chvsize, chvind, chvent) ;
}
}
} else {
double *entries ;
int ii, off, stride ;
/*
--------------------------------------
load a scalar multiple of the identity
--------------------------------------
*/
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) ) {
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += sigma[0] ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += sigma[0] ;
off += stride ;
stride -= 2 ;
}
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
if ( CHV_IS_HERMITIAN(chv) && sigma[1] != 0.0 ) {
fprintf(stderr,
"\n fatal error in FrontMtx_loadEntries()"
"\n chevron is hermitian"
"\n sigma = %12.4e + %12.4e*i\n",
sigma[0], sigma[1]) ;
exit(-1) ;
}
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += sigma[0] ;
entries[2*off+1] += sigma[1] ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += sigma[0] ;
entries[2*off+1] += sigma[1] ;
off += stride ;
stride -= 2 ;
}
}
}
}
return ; }
/*
--------------------------------------------------------------------
perform an exhaustive search over a subspace of domains
mdom -- number of domains in the subspace
domids -- vector of domain ids, size mdom
tcolors -- temporary vector to hold active domain colors, size mdom
note : region colors and component weights of the best
partition are left in bkl->colors[] and bkl->cweights[].
return value -- cost of best partition
created -- 95oct07, cca
--------------------------------------------------------------------
*/
float
BKL_exhSearch (
BKL *bkl,
int mdom,
int domids[],
int tcolors[]
) {
float bestcost, newcost ;
int idom, ierr, iflip, iloc, jloc, nflip ;
int *colors ;
/*
---------------
check the input
---------------
*/
if ( bkl == NULL || mdom < 1 || domids == NULL || tcolors == NULL ) {
fprintf(stderr, "\n fatal error in BKL_exhaustiveSearch(%p,%d,%p,%p)"
"\n bad input\n", bkl, mdom, domids, tcolors) ;
exit(-1) ;
}
colors = bkl->colors ;
bkl->nflips = 0 ;
#if MYDEBUG > 0
fprintf(stdout, "\n inside BKL_exhSearch(%p,%d,%p,%p)",
bkl, mdom, domids, tcolors) ;
fprintf(stdout, "\n bkl->nflips = %d", bkl->nflips) ;
fflush(stdout) ;
#endif
/*
---------------------------------------------
copy the present colors and component weights
---------------------------------------------
*/
for ( iloc = 0 ; iloc < mdom ; iloc++ ) {
idom = domids[iloc] ;
tcolors[iloc] = colors[idom] ;
}
/*
---------------------
compute the best cost
---------------------
*/
bestcost = BKL_evalfcn(bkl) ;
#if MYDEBUG > 0
fprintf(stdout, "\n inside BKL_exhSearch(%p,%d,%p,%p)",
bkl, mdom, domids, tcolors) ;
fprintf(stdout, "\n %d domain ids : ", mdom) ;
IVfp80(stdout, mdom, domids, 20, &ierr) ;
fprintf(stdout, "\n color weights < %6d %6d %6d >, cost %9.2f",
bkl->cweights[0], bkl->cweights[1], bkl->cweights[2],
bestcost) ;
fflush(stdout) ;
#endif
#if MYDEBUG > 2
fprintf(stdout, "\n colors ") ;
IVfp80(stdout, bkl->nreg, colors, 80, &ierr) ;
fflush(stdout) ;
#endif
/*
---------------------------------
count the number of flips to make
---------------------------------
*/
for ( idom = 0, nflip = 1 ; idom < mdom ; idom++ ) {
nflip *= 2 ;
}
/*
--------------------------
loop over the 2^mdom flips
--------------------------
*/
for ( iflip = 1 ; iflip < nflip ; iflip++ ) {
iloc = BKL_greyCodeDomain(bkl, iflip) ;
idom = domids[iloc] ;
#if MYDEBUG > 1
fprintf(stdout, "\n FLIP %4d domain %4d", bkl->nflips, idom) ;
fflush(stdout) ;
#endif
#if MYDEBUG > 2
fprintf(stdout, "\n colors before flip") ;
IVfp80(stdout, bkl->nreg, colors, 80, &ierr) ;
fflush(stdout) ;
#endif
BKL_flipDomain(bkl, idom) ;
#if MYDEBUG > 2
fprintf(stdout, "\n colors after flip") ;
IVfp80(stdout, bkl->nreg, colors, 80, &ierr) ;
fprintf(stdout, "\n cweights : < %9d %9d %9d > ",
bkl->cweights[0], bkl->cweights[1], bkl->cweights[2]) ;
fflush(stdout) ;
#endif
newcost = BKL_evalfcn(bkl) ;
#if MYDEBUG > 1
fprintf(stdout, ", < %6d %6d %6d >, cost %9.2f",
bkl->cweights[0], bkl->cweights[1], bkl->cweights[2],
newcost) ;
fflush(stdout) ;
#endif
if ( newcost < bestcost ) {
#if MYDEBUG > 1
fprintf(stdout, ", better") ;
fflush(stdout) ;
#endif
bkl->nimprove++ ;
for ( jloc = 0 ; jloc < mdom ; jloc++ ) {
tcolors[jloc] = colors[domids[jloc]] ;
}
bestcost = newcost ;
}
}
/*
-----------------------------------------------------
restore the best colors and update the segment colors
-----------------------------------------------------
*/
for ( iloc = 0 ; iloc < mdom ; iloc++ ) {
idom = domids[iloc] ;
if ( colors[idom] != tcolors[iloc] ) {
BKL_flipDomain(bkl, idom) ;
}
}
return(bestcost) ; }
/*
-------------------------------------------------
purpose -- to write a Graph object for a human eye
return value -- 1 if success, 0 otherwise
created -- 95sep29, cca
-------------------------------------------------
*/
int
Graph_writeForHumanEye (
Graph *graph,
FILE *fp
) {
int ierr, rc ;
if ( graph == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n bad input\n", graph, fp) ;
spoolesFatal();
}
/*
------------------------
write out the statistics
------------------------
*/
if ( (rc = Graph_writeStats(graph, fp)) == 0 ) {
fprintf(stderr, "\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n rc = %d, return from Graph_writeStats(%p,%p)\n",
graph, fp, rc, graph, fp) ;
return(0) ;
}
if ( graph->adjIVL != NULL ) {
/*
----------------------------------
write out the adjacency IVL object
----------------------------------
*/
fprintf(fp, "\n\n adjacency IVL object") ;
rc = IVL_writeForHumanEye(graph->adjIVL, fp) ;
if ( rc < 0 ) {
fprintf(stderr, "\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n rc = %d, return from IVL_writeForHumanEye(%p,%p)"
"\n while attempting to write out adjIVL\n",
graph, fp, rc, graph->adjIVL, fp) ;
return(0) ;
}
}
/*
----------------------------------------------
write out the vertex weights vector if present
----------------------------------------------
*/
if ( graph->type % 2 == 1 ) {
if ( graph->vwghts == NULL ) {
fprintf(stderr,
"\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n graph->type = %d, graph->vwghts == NULL\n",
graph, fp, graph->type) ;
return(0) ;
}
fprintf(fp, "\n\n vertex weights ") ;
IVfp80(fp, graph->nvtx + graph->nvbnd, graph->vwghts, 80, &ierr) ;
if ( ierr < 0 ) {
fprintf(stderr,
"\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n ierr = %d, return from vwghts[] IVfp80\n",
graph, fp, ierr) ;
return(0) ;
}
}
/*
------------------------------------------------
write out the edge weight IVL object, if present
------------------------------------------------
*/
if ( graph->type >= 2 ) {
if ( graph->ewghtIVL == NULL ) {
fprintf(stderr,
"\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n graph->type = %d, graph->ewghtIVL == NULL\n",
graph, fp, graph->type) ;
return(0) ;
}
fprintf(fp, "\n\n edge weights IVL object") ;
rc = IVL_writeForHumanEye(graph->ewghtIVL, fp) ;
if ( rc < 0 ) {
fprintf(stderr,
"\n fatal error in Graph_writeForHumanEye(%p,%p)"
"\n rc = %d, return from IVL_writeForHumanEye(%p,%p)"
"\n while attempting to write out ewghtIVL\n",
graph, fp, rc, graph->ewghtIVL, fp) ;
return(0) ;
}
}
return(1) ; }
/*
----------------------------------------------
for each uncovered (v,w)
if v->subtrees \cap w->subtrees != emptyset
remove (v,w) from uncovered edges
end if
end for
created -- 95nov08, cca
----------------------------------------------
*/
void
MSMD_cleanEdgeList (
MSMD *msmd,
MSMDvtx *v,
MSMDinfo *info
) {
int i, ierr, j, nedge, wid ;
int *edges ;
IP *ip1, *ip2 ;
MSMDvtx *w ;
/*
---------------
check the input
---------------
*/
if ( msmd == NULL || v == NULL || info == NULL ) {
fprintf(stderr, "\n inside MSMD_cleanEdgeList(%p,%p,%p)"
"\n bad input\n", msmd, v, info) ;
exit(-1) ;
}
/*
--------------------------------------------
remove covered edges from the uncovered list
--------------------------------------------
*/
nedge = v->nadj ;
edges = v->adj ;
if ( info->msglvl > 5 ) {
fprintf(info->msgFile, "\n inside MSMD_cleanEdgeList(%p,%p)"
"\n %d's edges :", msmd, v, v->id) ;
IVfp80(info->msgFile, nedge, edges, 12, &ierr) ;
fflush(info->msgFile) ;
}
i = 0 ; j = nedge - 1 ;
while ( i <= j ) {
wid = edges[i] ;
w = msmd->vertices + wid ;
if ( info->msglvl > 5 ) {
fprintf(info->msgFile, "\n <%d,%c>", wid, w->status) ;
fflush(info->msgFile) ;
}
if ( w == v ) {
/*
--------------------------------
purge v from uncovered edge list
--------------------------------
*/
edges[i] = edges[j] ;
edges[j] = wid ;
j-- ;
} else {
switch ( w->status ) {
case 'I' :
case 'L' :
case 'E' :
/*
--------------------------------
purge w from uncovered edge list
--------------------------------
*/
edges[i] = edges[j] ;
edges[j] = wid ;
j-- ;
break ;
default :
ip1 = v->subtrees ;
ip2 = w->subtrees ;
if ( info->msglvl > 5 ) {
fprintf(info->msgFile, "\n subtree list for %d :", v->id) ;
IP_fp80(info->msgFile, ip1, 30) ;
fprintf(info->msgFile, "\n subtree list for %d :", w->id) ;
IP_fp80(info->msgFile, ip2, 30) ;
}
while ( ip1 != NULL && ip2 != NULL ) {
if ( ip1->val > ip2->val ) {
ip1 = ip1->next ;
} else if ( ip1->val < ip2->val ) {
ip2 = ip2->next ;
} else {
/*
---------------------------------
this edge has been covered, break
---------------------------------
*/
edges[i] = edges[j] ;
edges[j] = wid ;
j-- ;
break ;
}
}
if ( ip1 == NULL || ip2 == NULL ) {
/*
-------------------------------
this edge was not covered, keep
-------------------------------
*/
i++ ;
}
}
}
}
v->nadj = j + 1 ;
if ( info->msglvl > 5 ) {
fprintf(info->msgFile, "\n leaving MSMD_cleanEdgeList(%p,%p)"
"\n %d's edges :", msmd, v, v->id) ;
IVfp80(info->msgFile, v->nadj, edges, 12, &ierr) ;
fflush(info->msgFile) ;
}
return ; }
