void genrcm(int neqns, int **padj, int *perm, int *mask, int *xls, int *work)
{
int num, i, root, nlvl, ccsize;
zeroi(neqns, work);
zeroi(neqns, mask);
num = 0;
for (i=0;i<neqns ; i++)
{
/* ---------------------------------------------------
for each masked connected component
-------------------------------------------------*/
if (mask[i] < 0) continue ;
root = i ;
/* ------------------------------------------------------------
first find a pseudo-peripheral node root. note that the level
structure found by fnroot is stored starting at perm[num].
then rcm is called to order the component using root as the
starting node.
----------------------------------------------------------*/
root = fnroot(root, padj, mask, &nlvl, xls, perm + num) ;
ccsize = rcm(root, padj, mask, perm+num,xls, work) ;
num += ccsize ;
if (num > neqns) return ;
}
return;
}
void gennd(int neqns, int **padj, int *mask, int *perm,
int *xls, int *ls, int *work)
{
int num, i, root, nsep ;
zeroi(neqns, mask) ;
num = 0 ;
/* -------------------------------
for each masked component
-----------------------------*/
/* modified to operate on equations rather than nodes*/
for (i=0;i<neqns ; i++)
{
while (mask[i] >= 0)
{
root = i ;
/* -----------------------------------------------------------
find a separator and number the nodes next.
---------------------------------------------------------*/
nsep = fndsep(root, padj, mask,(perm + num), xls, ls, work, neqns);
num += nsep ;
}
if (num >= neqns) printf("breaking out at i %d nums %d neqns %d\n",i,num, neqns);
if (num >= neqns ) break ;
}
/* -----------------------------------------------------------------
since separators found first should be ordered last,
routine revrse is called to adjust the ordering vector.
---------------------------------------------------------------*/
revrse(neqns, perm) ;
return ;
}
DEF_TEST(Sk4x_Conversions, r) {
// Assuming IEEE floats.
Sk4f zerof(0,0,0,0);
Sk4i zeroi(0,0,0,0);
ASSERT_EQ(zeroi, zerof.cast<Sk4i>());
ASSERT_EQ(zeroi, zerof.reinterpret<Sk4i>());
ASSERT_EQ(zerof, zeroi.cast<Sk4f>());
ASSERT_EQ(zerof, zeroi.reinterpret<Sk4f>());
Sk4f twof(2,2,2,2);
Sk4i twoi(2,2,2,2);
ASSERT_EQ(twoi, twof.cast<Sk4i>());
ASSERT_NE(twoi, twof.reinterpret<Sk4i>());
ASSERT_EQ(twof, twoi.cast<Sk4f>());
ASSERT_NE(twof, twoi.reinterpret<Sk4f>());
}
/*************************************************************************
*****************subrcm . . . substructure reverse cuthill mckee ********
*************************************************************************
purpose - subrcm finds the reverse cuthill-mckee
ordering for a subgraph. for each connected
component in the graph subrcm obtains the ordering
by calling the subroutine rcm.
input parameters -
neqns - number of equations
padj - the adjacency structure
root - first trial root ( any node that lies
int the subgraph)
output parameter -
perm - vector that contains the rcm ordering
working parameters
mask - is used to mark variables that have been
numbered during the ordering process. it is
initialized to 0 and set to -1 as each node
is numbered.
xls - the index bector for a vevel structure. the level
structre is sotred in the currently unused spaces
in the permutation vectore perm.
work - a working vector
program routines -
fnroot, rcm
*************************************************************************/
void subrcm (int neqns, int root, int **padj, int *perm,
int *mask, int *xls, int *work)
{
int num, nlvl, ccsize ;
zeroi(neqns, work) ;
num = 0 ;
if (mask[root] <0) return ;
/* ------------------------------------------------------------
first find a pseudo-peripheral node root. note that the level
structure found by fnroot is stored starting at perm[num].
then rcm is called to order the component using root as the
starting node.
----------------------------------------------------------*/
root = fnroot(root, padj, mask, &nlvl, xls, perm + num) ;
ccsize = rcm(root, padj, mask, perm+num,xls, work) ;
num += ccsize ;
if (num > neqns) return ;
return ;
}
int nodfac(int *perm, int *invp, int **padj, int *ancstr , int *list, int neqns,
int nblks, int *xblk, int *envlen, OFFDBLK **segfirst,
OFFDBLK **first, int *rowblks )
{
int i, node, nbr, qm, m, nnext ;
int bcount, knz, cnz ;
int nbrblk ;
int *pt ;
int *len ;
int count ;
OFFDBLK **segprv ;
OFFDBLK *p, *po, *nbeg ;
OFFDBLK junk ;
cnz = 0 ;
p = NULL ;
*first = NULL ;
po = &junk ;
count = 0 ;
bcount = 0 ;
segprv = (OFFDBLK **) calloc((nblks+1), sizeof(OFFDBLK *)) ;
len = (int *) calloc(nblks, sizeof(int)) ;
assert (segprv && len != NULL) ;
for (i=0;i<=nblks;i++)
{
segfirst[i] = NULL ;
segprv[i] = NULL ;
}
zeroi(nblks, len) ;
/* initialize link */
for (i = 0; i< neqns ; i++)
list[i] = i ;
zeroi(neqns,envlen) ;
for (node = 1 ; node < neqns; node++)
{
knz = 0 ;
i = perm[node] ;
/* sort adjacency list */
for (pt = padj[i] ; pt < padj[i+1] ; pt++)
{
nbr = invp[*pt] ;
if ( nbr >= node) continue ;
qm = node ;
do
{ m = qm ;
qm = list[m] ;
} while (qm<=nbr);
list[m] = nbr ;
list[nbr] = qm ;
}
nbr = list[node] ;
list[node] = node ;
nbeg = NULL ;
while (ancstr[nbr] <= node)
{
p = (OFFDBLK *)malloc( sizeof(OFFDBLK));
assert (p != NULL) ;
p->row = node ;
p->beg = nbr ;
po->next = p ;
po = p ;
nbrblk = rowblks[nbr] ;
knz += (xblk[nbrblk+1] - nbr) ;
len[count - bcount] = xblk[nbrblk+1] - nbr ;
count++;
if (*first == NULL) *first = p ;
if (nbeg == NULL) nbeg = p ;
if (segprv[nbrblk] != NULL) segprv[nbrblk]->bnext = p ;
segprv[nbrblk] = p ;
if (segfirst[nbrblk] == NULL) segfirst[nbrblk] = p ;
qm = nbr ;
do
{ nnext = list[qm] ;
list[qm] = qm ;
qm = nnext ;
} while (nnext < xblk[nbrblk+1] ) ;
nbr = ancstr[nbr] ;
if (nbr >= nnext ) nbr = nnext ;
else list[nbr] = nnext ;
}
/* part of the diagonal envelop block */
envlen[node] = node - nbr ;
/* should now allocate space for row and set up pointers */
if (knz > 0)
{
nbeg->nz = (double *)calloc(knz, sizeof(double)) ;
assert(nbeg->nz != NULL) ;
if ( bcount < count) bcount++ ;
m = bcount ;
while (bcount < count)
{ (nbeg->next)->nz = nbeg->nz + len[bcount - m] ;
nbeg = nbeg->next ;
bcount++ ;
}
}
cnz += knz ;
} /* end for node */
/* -----------------------------------------------
add on ending pieces for loops in factorization
and backsolving to catch on
-----------------------------------------------*/
node = neqns ;
nbr = neqns ;
p = (OFFDBLK *)calloc(1, sizeof(OFFDBLK));
assert (p != NULL) ;
p->row = neqns ;
p->beg = neqns ;
po->next = p ;
p->next = p ;
p->bnext = p ;
for (i=0 ; i<=nblks ; i++)
{
if (segfirst[i] == NULL) segfirst[i] = p ;
else segprv[i]->bnext = p ;
}
if (*first == NULL) *first = p ;
free(len) ;
free(segprv) ;
return 0;
}
/**********************************************************
*****************fndsep . . . . find separator *********
***********************************************************
purpose - this routine is used to find a small
separator for a connected component
specified by mask in the given graph.
input parameters
root - is the node that determines the masked
component
padj - the adjacency structure
output parameters
nsep - number of variablesin the separator
sep - vector containing the separator nodes
updated parameter
mask - nodes in the separator have their mask
values set to zero.
working parameters
xls, ls - level structur pair for level structure
found by fnroot
routines called -
fnroot
******************************************************************/
int fndsep(int root, int **padj, int *mask, int *sep, int *xls,
int *ls, int *work, int neqns)
{
int nlvl, nsep, i, node, midlvl, midbeg, mp1beg, mp1end ;
int *ptr ;
int minone = -1 ;
zeroi(neqns, work) ;
root = fnroot(root, padj, mask, &nlvl, xls, ls) ;
/* ----------------------------------------------------------------
if the number of levels is less than 3 (or some other value I
choose for incomplete nested dissection), return the whole
component as the separator.
---------------------------------------------------------------*/
if (nlvl < INCLEVEL)
{
nsep = xls[nlvl+1] ;
node = ls[0] ;
/* renumber the segment by rcm */
subrcm(nsep, node, padj, sep, mask, xls, work) ;
/*return(nsep) */
for (i=0;i<nsep;i++)
{
node = ls[i] ;
sep[i] = node ;
mask[node] |= minone ;
}
return(nsep) ;
}
/* ---------------------------------------------------------------
find the middle level of the rooted level structure.
---------------------------------------------------------*/
midlvl = (nlvl + 2)/2 ;
{
int j, k, l ; ;
k = xls[nlvl] ;
j = k/ 2 ;
l = 0 ;
for (k = 0 ; k < nlvl && l < j ; k++)
{
if (l < j) {
l += (xls[k+1] - xls[k]) ;
}
}
k-- ;
midlvl = k ;
midbeg = xls[midlvl] ;
mp1beg = xls[midlvl + 1] ;
mp1end = xls[midlvl + 2] ;
}
/* ----------------------------------------------------------------
the separator is obtained by including only those middle-level
nodes with neighbors in the middle+1 level. work is used
temporarily to mark those nodes in the middle+1 level.
---------------------------------------------------------------*/
for (i = mp1beg;i<mp1end;i++)
{
node = ls[i] ;
work[node] |= minone ;
}
nsep = 0 ;
for (i=midbeg;i< mp1beg ; i++)
{
node = ls[i] ;
for (ptr = padj[node] ; ptr < padj[node+1] ; ptr++)
{
if (work[*ptr] < 0)
{
sep[nsep] = node ;
nsep++ ;
mask[node] |= minone ;
ptr = padj[node + 1] ; /* node has been added get out of ptr
loop and start a new node */
}
}
}
/* -------------------
reset work
------------------*/
for (i=mp1beg; i< mp1end; i++)
{
node = ls[i] ;
work[i] &= 0 ;
}
return( nsep) ;
}