1026 lines
29 KiB
C
1026 lines
29 KiB
C
|
|
typedef int shortint;
|
|
|
|
|
|
/* prototypes -------------------- */
|
|
int genmmd_(int *, int *, int *, int *, int *, int *, int *,
|
|
int *, int *, int *, int *, int *);
|
|
int mmdint_(int *, int *, shortint *, shortint *, shortint *, shortint *, shortint *,
|
|
shortint *, shortint *);
|
|
int mmdelm_(int *, int *, shortint *, shortint *, shortint *, shortint *, shortint *,
|
|
shortint *, shortint *, int *, int *);
|
|
int mmdupd_(int *, int *, int *, shortint *, int *, int *, shortint *,
|
|
shortint *, shortint *, shortint *, shortint *, shortint *, int *, int *);
|
|
int mmdnum_(int *, shortint *, shortint *, shortint *);
|
|
|
|
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
/* **** GENMMD ..... MULTIPLE MINIMUM EXTERNAL DEGREE **** */
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
|
|
/* AUTHOR - JOSEPH W.H. LIU */
|
|
/* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
|
|
|
|
/* PURPOSE - THIS ROUTINE IMPLEMENTS THE MINIMUM DEGREE */
|
|
/* ALGORITHM. IT MAKES USE OF THE IMPLICIT REPRESENTATION */
|
|
/* OF ELIMINATION GRAPHS BY QUOTIENT GRAPHS, AND THE */
|
|
/* NOTION OF INDISTINGUISHABLE NODES. IT ALSO IMPLEMENTS */
|
|
/* THE MODIFICATIONS BY MULTIPLE ELIMINATION AND MINIMUM */
|
|
/* EXTERNAL DEGREE. */
|
|
/* --------------------------------------------- */
|
|
/* CAUTION - THE ADJACENCY VECTOR ADJNCY WILL BE */
|
|
/* DESTROYED. */
|
|
/* --------------------------------------------- */
|
|
|
|
/* INPUT PARAMETERS - */
|
|
/* NEQNS - NUMBER OF EQUATIONS. */
|
|
/* (XADJ,ADJNCY) - THE ADJACENCY STRUCTURE. */
|
|
/* DELTA - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
|
|
/* MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) INTEGER */
|
|
/* (ANY SMALLER ESTIMATE WILL DO) FOR MARKING */
|
|
/* NODES. */
|
|
|
|
/* OUTPUT PARAMETERS - */
|
|
/* PERM - THE MINIMUM DEGREE ORDERING. */
|
|
/* INVP - THE INVERSE OF PERM. */
|
|
/* NOFSUB - AN UPPER BOUND ON THE NUMBER OF NONZERO */
|
|
/* SUBSCRIPTS FOR THE COMPRESSED STORAGE SCHEME. */
|
|
|
|
/* WORKING PARAMETERS - */
|
|
/* DHEAD - VECTOR FOR HEAD OF DEGREE LISTS. */
|
|
/* INVP - USED TEMPORARILY FOR DEGREE FORWARD LINK. */
|
|
/* PERM - USED TEMPORARILY FOR DEGREE BACKWARD LINK. */
|
|
/* QSIZE - VECTOR FOR SIZE OF SUPERNODES. */
|
|
/* LLIST - VECTOR FOR TEMPORARY LINKED LISTS. */
|
|
/* MARKER - A TEMPORARY MARKER VECTOR. */
|
|
|
|
/* PROGRAM SUBROUTINES - */
|
|
/* MMDELM, MMDINT, MMDNUM, MMDUPD. */
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Subroutine */ int genmmd_(int *neqns, int *xadj, shortint *adjncy,
|
|
shortint *invp, shortint *perm, int *delta, shortint *dhead,
|
|
shortint *qsize, shortint *llist, shortint *marker, int *maxint,
|
|
int *nofsub)
|
|
{
|
|
/* System generated locals */
|
|
int i__1;
|
|
|
|
/* Local variables */
|
|
static int mdeg, ehead, i, mdlmt, mdnode;
|
|
extern /* Subroutine */ int mmdelm_(int *, int *, shortint *,
|
|
shortint *, shortint *, shortint *, shortint *, shortint *,
|
|
shortint *, int *, int *), mmdupd_(int *, int *,
|
|
int *, shortint *, int *, int *, shortint *, shortint
|
|
*, shortint *, shortint *, shortint *, shortint *, int *,
|
|
int *), mmdint_(int *, int *, shortint *, shortint *,
|
|
shortint *, shortint *, shortint *, shortint *, shortint *),
|
|
mmdnum_(int *, shortint *, shortint *, shortint *);
|
|
static int nextmd, tag, num;
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Parameter adjustments */
|
|
--marker;
|
|
--llist;
|
|
--qsize;
|
|
--dhead;
|
|
--perm;
|
|
--invp;
|
|
--adjncy;
|
|
--xadj;
|
|
|
|
/* Function Body */
|
|
if (*neqns <= 0) {
|
|
return 0;
|
|
}
|
|
|
|
/* ------------------------------------------------ */
|
|
/* INITIALIZATION FOR THE MINIMUM DEGREE ALGORITHM. */
|
|
/* ------------------------------------------------ */
|
|
*nofsub = 0;
|
|
mmdint_(neqns, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1], &
|
|
qsize[1], &llist[1], &marker[1]);
|
|
|
|
/* ---------------------------------------------- */
|
|
/* NUM COUNTS THE NUMBER OF ORDERED NODES PLUS 1. */
|
|
/* ---------------------------------------------- */
|
|
num = 1;
|
|
|
|
/* ----------------------------- */
|
|
/* ELIMINATE ALL ISOLATED NODES. */
|
|
/* ----------------------------- */
|
|
nextmd = dhead[1];
|
|
L100:
|
|
if (nextmd <= 0) {
|
|
goto L200;
|
|
}
|
|
mdnode = nextmd;
|
|
nextmd = invp[mdnode];
|
|
marker[mdnode] = *maxint;
|
|
invp[mdnode] = -num;
|
|
++num;
|
|
goto L100;
|
|
|
|
L200:
|
|
/* ---------------------------------------- */
|
|
/* SEARCH FOR NODE OF THE MINIMUM DEGREE. */
|
|
/* MDEG IS THE CURRENT MINIMUM DEGREE; */
|
|
/* TAG IS USED TO FACILITATE MARKING NODES. */
|
|
/* ---------------------------------------- */
|
|
if (num > *neqns) {
|
|
goto L1000;
|
|
}
|
|
tag = 1;
|
|
dhead[1] = 0;
|
|
mdeg = 2;
|
|
L300:
|
|
if (dhead[mdeg] > 0) {
|
|
goto L400;
|
|
}
|
|
++mdeg;
|
|
goto L300;
|
|
L400:
|
|
/* ------------------------------------------------- */
|
|
/* USE VALUE OF DELTA TO SET UP MDLMT, WHICH GOVERNS */
|
|
/* WHEN A DEGREE UPDATE IS TO BE PERFORMED. */
|
|
/* ------------------------------------------------- */
|
|
mdlmt = mdeg + *delta;
|
|
ehead = 0;
|
|
|
|
L500:
|
|
mdnode = dhead[mdeg];
|
|
if (mdnode > 0) {
|
|
goto L600;
|
|
}
|
|
++mdeg;
|
|
if (mdeg > mdlmt) {
|
|
goto L900;
|
|
}
|
|
goto L500;
|
|
L600:
|
|
/* ---------------------------------------- */
|
|
/* REMOVE MDNODE FROM THE DEGREE STRUCTURE. */
|
|
/* ---------------------------------------- */
|
|
nextmd = invp[mdnode];
|
|
dhead[mdeg] = nextmd;
|
|
if (nextmd > 0) {
|
|
perm[nextmd] = -mdeg;
|
|
}
|
|
invp[mdnode] = -num;
|
|
*nofsub = *nofsub + mdeg + qsize[mdnode] - 2;
|
|
if (num + qsize[mdnode] > *neqns) {
|
|
goto L1000;
|
|
}
|
|
/* ---------------------------------------------- */
|
|
/* ELIMINATE MDNODE AND PERFORM QUOTIENT GRAPH */
|
|
/* TRANSFORMATION. RESET TAG VALUE IF NECESSARY. */
|
|
/* ---------------------------------------------- */
|
|
++tag;
|
|
if (tag < *maxint) {
|
|
goto L800;
|
|
}
|
|
tag = 1;
|
|
i__1 = *neqns;
|
|
for (i = 1; i <= i__1; ++i) {
|
|
if (marker[i] < *maxint) {
|
|
marker[i] = 0;
|
|
}
|
|
/* L700: */
|
|
}
|
|
L800:
|
|
mmdelm_(&mdnode, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1], &
|
|
qsize[1], &llist[1], &marker[1], maxint, &tag);
|
|
num += qsize[mdnode];
|
|
llist[mdnode] = ehead;
|
|
ehead = mdnode;
|
|
if (*delta >= 0) {
|
|
goto L500;
|
|
}
|
|
L900:
|
|
/* ------------------------------------------- */
|
|
/* UPDATE DEGREES OF THE NODES INVOLVED IN THE */
|
|
/* MINIMUM DEGREE NODES ELIMINATION. */
|
|
/* ------------------------------------------- */
|
|
if (num > *neqns) {
|
|
goto L1000;
|
|
}
|
|
mmdupd_(&ehead, neqns, &xadj[1], &adjncy[1], delta, &mdeg, &dhead[1], &
|
|
invp[1], &perm[1], &qsize[1], &llist[1], &marker[1], maxint, &tag)
|
|
;
|
|
goto L300;
|
|
|
|
L1000:
|
|
mmdnum_(neqns, &perm[1], &invp[1], &qsize[1]);
|
|
return 0;
|
|
|
|
} /* genmmd_ */
|
|
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
/* *** MMDINT ..... MULT MINIMUM DEGREE INITIALIZATION *** */
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
|
|
/* AUTHOR - JOSEPH W.H. LIU */
|
|
/* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
|
|
|
|
/* PURPOSE - THIS ROUTINE PERFORMS INITIALIZATION FOR THE */
|
|
/* MULTIPLE ELIMINATION VERSION OF THE MINIMUM DEGREE */
|
|
/* ALGORITHM. */
|
|
|
|
/* INPUT PARAMETERS - */
|
|
/* NEQNS - NUMBER OF EQUATIONS. */
|
|
/* (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
|
|
|
|
/* OUTPUT PARAMETERS - */
|
|
/* (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
|
|
/* QSIZE - SIZE OF SUPERNODE (INITIALIZED TO ONE). */
|
|
/* LLIST - LINKED LIST. */
|
|
/* MARKER - MARKER VECTOR. */
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Subroutine */ int mmdint_(int *neqns, int *xadj, shortint *adjncy,
|
|
shortint *dhead, shortint *dforw, shortint *dbakw, shortint *qsize,
|
|
shortint *llist, shortint *marker)
|
|
{
|
|
/* System generated locals */
|
|
int i__1;
|
|
|
|
/* Local variables */
|
|
static int ndeg, node, fnode;
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Parameter adjustments */
|
|
--marker;
|
|
--llist;
|
|
--qsize;
|
|
--dbakw;
|
|
--dforw;
|
|
--dhead;
|
|
--adjncy;
|
|
--xadj;
|
|
|
|
/* Function Body */
|
|
i__1 = *neqns;
|
|
for (node = 1; node <= i__1; ++node) {
|
|
dhead[node] = 0;
|
|
qsize[node] = 1;
|
|
marker[node] = 0;
|
|
llist[node] = 0;
|
|
/* L100: */
|
|
}
|
|
/* ------------------------------------------ */
|
|
/* INITIALIZE THE DEGREE DOUBLY LINKED LISTS. */
|
|
/* ------------------------------------------ */
|
|
i__1 = *neqns;
|
|
for (node = 1; node <= i__1; ++node) {
|
|
ndeg = xadj[node + 1] - xadj[node] + 1;
|
|
fnode = dhead[ndeg];
|
|
dforw[node] = fnode;
|
|
dhead[ndeg] = node;
|
|
if (fnode > 0) {
|
|
dbakw[fnode] = node;
|
|
}
|
|
dbakw[node] = -ndeg;
|
|
/* L200: */
|
|
}
|
|
return 0;
|
|
|
|
} /* mmdint_ */
|
|
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
/* ** MMDELM ..... MULTIPLE MINIMUM DEGREE ELIMINATION *** */
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
|
|
/* AUTHOR - JOSEPH W.H. LIU */
|
|
/* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
|
|
|
|
/* PURPOSE - THIS ROUTINE ELIMINATES THE NODE MDNODE OF */
|
|
/* MINIMUM DEGREE FROM THE ADJACENCY STRUCTURE, WHICH */
|
|
/* IS STORED IN THE QUOTIENT GRAPH FORMAT. IT ALSO */
|
|
/* TRANSFORMS THE QUOTIENT GRAPH REPRESENTATION OF THE */
|
|
/* ELIMINATION GRAPH. */
|
|
|
|
/* INPUT PARAMETERS - */
|
|
/* MDNODE - NODE OF MINIMUM DEGREE. */
|
|
/* MAXINT - ESTIMATE OF MAXIMUM REPRESENTABLE (SHORT) */
|
|
/* INT. */
|
|
/* TAG - TAG VALUE. */
|
|
|
|
/* UPDATED PARAMETERS - */
|
|
/* (XADJ,ADJNCY) - UPDATED ADJACENCY STRUCTURE. */
|
|
/* (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
|
|
/* QSIZE - SIZE OF SUPERNODE. */
|
|
/* MARKER - MARKER VECTOR. */
|
|
/* LLIST - TEMPORARY LINKED LIST OF ELIMINATED NABORS. */
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Subroutine */ int mmdelm_(int *mdnode, int *xadj, shortint *adjncy,
|
|
shortint *dhead, shortint *dforw, shortint *dbakw, shortint *qsize,
|
|
shortint *llist, shortint *marker, int *maxint, int *tag)
|
|
{
|
|
/* System generated locals */
|
|
int i__1, i__2;
|
|
|
|
/* Local variables */
|
|
static int node, link, rloc, rlmt, i, j, nabor, rnode, elmnt, xqnbr,
|
|
istop, jstop, istrt, jstrt, nxnode, pvnode, nqnbrs, npv;
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* ----------------------------------------------- */
|
|
/* FIND REACHABLE SET AND PLACE IN DATA STRUCTURE. */
|
|
/* ----------------------------------------------- */
|
|
/* Parameter adjustments */
|
|
--marker;
|
|
--llist;
|
|
--qsize;
|
|
--dbakw;
|
|
--dforw;
|
|
--dhead;
|
|
--adjncy;
|
|
--xadj;
|
|
|
|
/* Function Body */
|
|
marker[*mdnode] = *tag;
|
|
istrt = xadj[*mdnode];
|
|
istop = xadj[*mdnode + 1] - 1;
|
|
/* ------------------------------------------------------- */
|
|
/* ELMNT POINTS TO THE BEGINNING OF THE LIST OF ELIMINATED */
|
|
/* NABORS OF MDNODE, AND RLOC GIVES THE STORAGE LOCATION */
|
|
/* FOR THE NEXT REACHABLE NODE. */
|
|
/* ------------------------------------------------------- */
|
|
elmnt = 0;
|
|
rloc = istrt;
|
|
rlmt = istop;
|
|
i__1 = istop;
|
|
for (i = istrt; i <= i__1; ++i) {
|
|
nabor = adjncy[i];
|
|
if (nabor == 0) {
|
|
goto L300;
|
|
}
|
|
if (marker[nabor] >= *tag) {
|
|
goto L200;
|
|
}
|
|
marker[nabor] = *tag;
|
|
if (dforw[nabor] < 0) {
|
|
goto L100;
|
|
}
|
|
adjncy[rloc] = nabor;
|
|
++rloc;
|
|
goto L200;
|
|
L100:
|
|
llist[nabor] = elmnt;
|
|
elmnt = nabor;
|
|
L200:
|
|
;
|
|
}
|
|
L300:
|
|
/* ----------------------------------------------------- */
|
|
/* MERGE WITH REACHABLE NODES FROM GENERALIZED ELEMENTS. */
|
|
/* ----------------------------------------------------- */
|
|
if (elmnt <= 0) {
|
|
goto L1000;
|
|
}
|
|
adjncy[rlmt] = -elmnt;
|
|
link = elmnt;
|
|
L400:
|
|
jstrt = xadj[link];
|
|
jstop = xadj[link + 1] - 1;
|
|
i__1 = jstop;
|
|
for (j = jstrt; j <= i__1; ++j) {
|
|
node = adjncy[j];
|
|
link = -node;
|
|
if (node < 0) {
|
|
goto L400;
|
|
} else if (node == 0) {
|
|
goto L900;
|
|
} else {
|
|
goto L500;
|
|
}
|
|
L500:
|
|
if (marker[node] >= *tag || dforw[node] < 0) {
|
|
goto L800;
|
|
}
|
|
marker[node] = *tag;
|
|
/* --------------------------------- */
|
|
/* USE STORAGE FROM ELIMINATED NODES */
|
|
/* IF NECESSARY. */
|
|
/* --------------------------------- */
|
|
L600:
|
|
if (rloc < rlmt) {
|
|
goto L700;
|
|
}
|
|
link = -adjncy[rlmt];
|
|
rloc = xadj[link];
|
|
rlmt = xadj[link + 1] - 1;
|
|
goto L600;
|
|
L700:
|
|
adjncy[rloc] = node;
|
|
++rloc;
|
|
L800:
|
|
;
|
|
}
|
|
L900:
|
|
elmnt = llist[elmnt];
|
|
goto L300;
|
|
L1000:
|
|
if (rloc <= rlmt) {
|
|
adjncy[rloc] = 0;
|
|
}
|
|
/* -------------------------------------------------------- */
|
|
/* FOR EACH NODE IN THE REACHABLE SET, DO THE FOLLOWING ... */
|
|
/* -------------------------------------------------------- */
|
|
link = *mdnode;
|
|
L1100:
|
|
istrt = xadj[link];
|
|
istop = xadj[link + 1] - 1;
|
|
i__1 = istop;
|
|
for (i = istrt; i <= i__1; ++i) {
|
|
rnode = adjncy[i];
|
|
link = -rnode;
|
|
if (rnode < 0) {
|
|
goto L1100;
|
|
} else if (rnode == 0) {
|
|
goto L1800;
|
|
} else {
|
|
goto L1200;
|
|
}
|
|
L1200:
|
|
/* -------------------------------------------- */
|
|
/* IF RNODE IS IN THE DEGREE LIST STRUCTURE ... */
|
|
/* -------------------------------------------- */
|
|
pvnode = dbakw[rnode];
|
|
if (pvnode == 0 || pvnode == -(*maxint)) {
|
|
goto L1300;
|
|
}
|
|
/* ------------------------------------- */
|
|
/* THEN REMOVE RNODE FROM THE STRUCTURE. */
|
|
/* ------------------------------------- */
|
|
nxnode = dforw[rnode];
|
|
if (nxnode > 0) {
|
|
dbakw[nxnode] = pvnode;
|
|
}
|
|
if (pvnode > 0) {
|
|
dforw[pvnode] = nxnode;
|
|
}
|
|
npv = -pvnode;
|
|
if (pvnode < 0) {
|
|
dhead[npv] = nxnode;
|
|
}
|
|
L1300:
|
|
/* ---------------------------------------- */
|
|
/* PURGE INACTIVE QUOTIENT NABORS OF RNODE. */
|
|
/* ---------------------------------------- */
|
|
jstrt = xadj[rnode];
|
|
jstop = xadj[rnode + 1] - 1;
|
|
xqnbr = jstrt;
|
|
i__2 = jstop;
|
|
for (j = jstrt; j <= i__2; ++j) {
|
|
nabor = adjncy[j];
|
|
if (nabor == 0) {
|
|
goto L1500;
|
|
}
|
|
if (marker[nabor] >= *tag) {
|
|
goto L1400;
|
|
}
|
|
adjncy[xqnbr] = nabor;
|
|
++xqnbr;
|
|
L1400:
|
|
;
|
|
}
|
|
L1500:
|
|
/* ---------------------------------------- */
|
|
/* IF NO ACTIVE NABOR AFTER THE PURGING ... */
|
|
/* ---------------------------------------- */
|
|
nqnbrs = xqnbr - jstrt;
|
|
if (nqnbrs > 0) {
|
|
goto L1600;
|
|
}
|
|
/* ----------------------------- */
|
|
/* THEN MERGE RNODE WITH MDNODE. */
|
|
/* ----------------------------- */
|
|
qsize[*mdnode] += qsize[rnode];
|
|
qsize[rnode] = 0;
|
|
marker[rnode] = *maxint;
|
|
dforw[rnode] = -(*mdnode);
|
|
dbakw[rnode] = -(*maxint);
|
|
goto L1700;
|
|
L1600:
|
|
/* -------------------------------------- */
|
|
/* ELSE FLAG RNODE FOR DEGREE UPDATE, AND */
|
|
/* ADD MDNODE AS A NABOR OF RNODE. */
|
|
/* -------------------------------------- */
|
|
dforw[rnode] = nqnbrs + 1;
|
|
dbakw[rnode] = 0;
|
|
adjncy[xqnbr] = *mdnode;
|
|
++xqnbr;
|
|
if (xqnbr <= jstop) {
|
|
adjncy[xqnbr] = 0;
|
|
}
|
|
|
|
L1700:
|
|
;
|
|
}
|
|
L1800:
|
|
return 0;
|
|
|
|
} /* mmdelm_ */
|
|
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
/* ***** MMDUPD ..... MULTIPLE MINIMUM DEGREE UPDATE ***** */
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
|
|
/* AUTHOR - JOSEPH W.H. LIU */
|
|
/* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
|
|
|
|
/* PURPOSE - THIS ROUTINE UPDATES THE DEGREES OF NODES */
|
|
/* AFTER A MULTIPLE ELIMINATION STEP. */
|
|
|
|
/* INPUT PARAMETERS - */
|
|
/* EHEAD - THE BEGINNING OF THE LIST OF ELIMINATED */
|
|
/* NODES (I.E., NEWLY FORMED ELEMENTS). */
|
|
/* NEQNS - NUMBER OF EQUATIONS. */
|
|
/* (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
|
|
/* DELTA - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
|
|
/* MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) */
|
|
/* INTEGER. */
|
|
|
|
/* UPDATED PARAMETERS - */
|
|
/* MDEG - NEW MINIMUM DEGREE AFTER DEGREE UPDATE. */
|
|
/* (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
|
|
/* QSIZE - SIZE OF SUPERNODE. */
|
|
/* LLIST - WORKING LINKED LIST. */
|
|
/* MARKER - MARKER VECTOR FOR DEGREE UPDATE. */
|
|
/* TAG - TAG VALUE. */
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Subroutine */ int mmdupd_(int *ehead, int *neqns, int *xadj,
|
|
shortint *adjncy, int *delta, int *mdeg, shortint *dhead,
|
|
shortint *dforw, shortint *dbakw, shortint *qsize, shortint *llist,
|
|
shortint *marker, int *maxint, int *tag)
|
|
{
|
|
/* System generated locals */
|
|
int i__1, i__2;
|
|
|
|
/* Local variables */
|
|
static int node, mtag, link, mdeg0, i, j, enode, fnode, nabor, elmnt,
|
|
istop, jstop, q2head, istrt, jstrt, qxhead, iq2, deg, deg0;
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Parameter adjustments */
|
|
--marker;
|
|
--llist;
|
|
--qsize;
|
|
--dbakw;
|
|
--dforw;
|
|
--dhead;
|
|
--adjncy;
|
|
--xadj;
|
|
|
|
/* Function Body */
|
|
mdeg0 = *mdeg + *delta;
|
|
elmnt = *ehead;
|
|
L100:
|
|
/* ------------------------------------------------------- */
|
|
/* FOR EACH OF THE NEWLY FORMED ELEMENT, DO THE FOLLOWING. */
|
|
/* (RESET TAG VALUE IF NECESSARY.) */
|
|
/* ------------------------------------------------------- */
|
|
if (elmnt <= 0) {
|
|
return 0;
|
|
}
|
|
mtag = *tag + mdeg0;
|
|
if (mtag < *maxint) {
|
|
goto L300;
|
|
}
|
|
*tag = 1;
|
|
i__1 = *neqns;
|
|
for (i = 1; i <= i__1; ++i) {
|
|
if (marker[i] < *maxint) {
|
|
marker[i] = 0;
|
|
}
|
|
/* L200: */
|
|
}
|
|
mtag = *tag + mdeg0;
|
|
L300:
|
|
/* --------------------------------------------- */
|
|
/* CREATE TWO LINKED LISTS FROM NODES ASSOCIATED */
|
|
/* WITH ELMNT: ONE WITH TWO NABORS (Q2HEAD) IN */
|
|
/* ADJACENCY STRUCTURE, AND THE OTHER WITH MORE */
|
|
/* THAN TWO NABORS (QXHEAD). ALSO COMPUTE DEG0, */
|
|
/* NUMBER OF NODES IN THIS ELEMENT. */
|
|
/* --------------------------------------------- */
|
|
q2head = 0;
|
|
qxhead = 0;
|
|
deg0 = 0;
|
|
link = elmnt;
|
|
L400:
|
|
istrt = xadj[link];
|
|
istop = xadj[link + 1] - 1;
|
|
i__1 = istop;
|
|
for (i = istrt; i <= i__1; ++i) {
|
|
enode = adjncy[i];
|
|
link = -enode;
|
|
if (enode < 0) {
|
|
goto L400;
|
|
} else if (enode == 0) {
|
|
goto L800;
|
|
} else {
|
|
goto L500;
|
|
}
|
|
|
|
L500:
|
|
if (qsize[enode] == 0) {
|
|
goto L700;
|
|
}
|
|
deg0 += qsize[enode];
|
|
marker[enode] = mtag;
|
|
/* ---------------------------------- */
|
|
/* IF ENODE REQUIRES A DEGREE UPDATE, */
|
|
/* THEN DO THE FOLLOWING. */
|
|
/* ---------------------------------- */
|
|
if (dbakw[enode] != 0) {
|
|
goto L700;
|
|
}
|
|
/* ---------------------------------------
|
|
*/
|
|
/* PLACE EITHER IN QXHEAD OR Q2HEAD LISTS.
|
|
*/
|
|
/* ---------------------------------------
|
|
*/
|
|
if (dforw[enode] == 2) {
|
|
goto L600;
|
|
}
|
|
llist[enode] = qxhead;
|
|
qxhead = enode;
|
|
goto L700;
|
|
L600:
|
|
llist[enode] = q2head;
|
|
q2head = enode;
|
|
L700:
|
|
;
|
|
}
|
|
L800:
|
|
/* -------------------------------------------- */
|
|
/* FOR EACH ENODE IN Q2 LIST, DO THE FOLLOWING. */
|
|
/* -------------------------------------------- */
|
|
enode = q2head;
|
|
iq2 = 1;
|
|
L900:
|
|
if (enode <= 0) {
|
|
goto L1500;
|
|
}
|
|
if (dbakw[enode] != 0) {
|
|
goto L2200;
|
|
}
|
|
++(*tag);
|
|
deg = deg0;
|
|
/* ------------------------------------------ */
|
|
/* IDENTIFY THE OTHER ADJACENT ELEMENT NABOR. */
|
|
/* ------------------------------------------ */
|
|
istrt = xadj[enode];
|
|
nabor = adjncy[istrt];
|
|
if (nabor == elmnt) {
|
|
nabor = adjncy[istrt + 1];
|
|
}
|
|
/* ------------------------------------------------ */
|
|
/* IF NABOR IS UNELIMINATED, INCREASE DEGREE COUNT. */
|
|
/* ------------------------------------------------ */
|
|
link = nabor;
|
|
if (dforw[nabor] < 0) {
|
|
goto L1000;
|
|
}
|
|
deg += qsize[nabor];
|
|
goto L2100;
|
|
L1000:
|
|
/* -------------------------------------------- */
|
|
/* OTHERWISE, FOR EACH NODE IN THE 2ND ELEMENT, */
|
|
/* DO THE FOLLOWING. */
|
|
/* -------------------------------------------- */
|
|
istrt = xadj[link];
|
|
istop = xadj[link + 1] - 1;
|
|
i__1 = istop;
|
|
for (i = istrt; i <= i__1; ++i) {
|
|
node = adjncy[i];
|
|
link = -node;
|
|
if (node == enode) {
|
|
goto L1400;
|
|
}
|
|
if (node < 0) {
|
|
goto L1000;
|
|
} else if (node == 0) {
|
|
goto L2100;
|
|
} else {
|
|
goto L1100;
|
|
}
|
|
|
|
L1100:
|
|
if (qsize[node] == 0) {
|
|
goto L1400;
|
|
}
|
|
if (marker[node] >= *tag) {
|
|
goto L1200;
|
|
}
|
|
/* -----------------------------------
|
|
-- */
|
|
/* CASE WHEN NODE IS NOT YET CONSIDERED
|
|
. */
|
|
/* -----------------------------------
|
|
-- */
|
|
marker[node] = *tag;
|
|
deg += qsize[node];
|
|
goto L1400;
|
|
L1200:
|
|
/* ----------------------------------------
|
|
*/
|
|
/* CASE WHEN NODE IS INDISTINGUISHABLE FROM
|
|
*/
|
|
/* ENODE. MERGE THEM INTO A NEW SUPERNODE.
|
|
*/
|
|
/* ----------------------------------------
|
|
*/
|
|
if (dbakw[node] != 0) {
|
|
goto L1400;
|
|
}
|
|
if (dforw[node] != 2) {
|
|
goto L1300;
|
|
}
|
|
qsize[enode] += qsize[node];
|
|
qsize[node] = 0;
|
|
marker[node] = *maxint;
|
|
dforw[node] = -enode;
|
|
dbakw[node] = -(*maxint);
|
|
goto L1400;
|
|
L1300:
|
|
/* --------------------------------------
|
|
*/
|
|
/* CASE WHEN NODE IS OUTMATCHED BY ENODE.
|
|
*/
|
|
/* --------------------------------------
|
|
*/
|
|
if (dbakw[node] == 0) {
|
|
dbakw[node] = -(*maxint);
|
|
}
|
|
L1400:
|
|
;
|
|
}
|
|
goto L2100;
|
|
L1500:
|
|
/* ------------------------------------------------ */
|
|
/* FOR EACH ENODE IN THE QX LIST, DO THE FOLLOWING. */
|
|
/* ------------------------------------------------ */
|
|
enode = qxhead;
|
|
iq2 = 0;
|
|
L1600:
|
|
if (enode <= 0) {
|
|
goto L2300;
|
|
}
|
|
if (dbakw[enode] != 0) {
|
|
goto L2200;
|
|
}
|
|
++(*tag);
|
|
deg = deg0;
|
|
/* --------------------------------- */
|
|
/* FOR EACH UNMARKED NABOR OF ENODE, */
|
|
/* DO THE FOLLOWING. */
|
|
/* --------------------------------- */
|
|
istrt = xadj[enode];
|
|
istop = xadj[enode + 1] - 1;
|
|
i__1 = istop;
|
|
for (i = istrt; i <= i__1; ++i) {
|
|
nabor = adjncy[i];
|
|
if (nabor == 0) {
|
|
goto L2100;
|
|
}
|
|
if (marker[nabor] >= *tag) {
|
|
goto L2000;
|
|
}
|
|
marker[nabor] = *tag;
|
|
link = nabor;
|
|
/* ------------------------------ */
|
|
/* IF UNELIMINATED, INCLUDE IT IN */
|
|
/* DEG COUNT. */
|
|
/* ------------------------------ */
|
|
if (dforw[nabor] < 0) {
|
|
goto L1700;
|
|
}
|
|
deg += qsize[nabor];
|
|
goto L2000;
|
|
L1700:
|
|
/* -------------------------------
|
|
*/
|
|
/* IF ELIMINATED, INCLUDE UNMARKED
|
|
*/
|
|
/* NODES IN THIS ELEMENT INTO THE
|
|
*/
|
|
/* DEGREE COUNT. */
|
|
/* -------------------------------
|
|
*/
|
|
jstrt = xadj[link];
|
|
jstop = xadj[link + 1] - 1;
|
|
i__2 = jstop;
|
|
for (j = jstrt; j <= i__2; ++j) {
|
|
node = adjncy[j];
|
|
link = -node;
|
|
if (node < 0) {
|
|
goto L1700;
|
|
} else if (node == 0) {
|
|
goto L2000;
|
|
} else {
|
|
goto L1800;
|
|
}
|
|
|
|
L1800:
|
|
if (marker[node] >= *tag) {
|
|
goto L1900;
|
|
}
|
|
marker[node] = *tag;
|
|
deg += qsize[node];
|
|
L1900:
|
|
;
|
|
}
|
|
L2000:
|
|
;
|
|
}
|
|
L2100:
|
|
/* ------------------------------------------- */
|
|
/* UPDATE EXTERNAL DEGREE OF ENODE IN DEGREE */
|
|
/* STRUCTURE, AND MDEG (MIN DEG) IF NECESSARY. */
|
|
/* ------------------------------------------- */
|
|
deg = deg - qsize[enode] + 1;
|
|
fnode = dhead[deg];
|
|
dforw[enode] = fnode;
|
|
dbakw[enode] = -deg;
|
|
if (fnode > 0) {
|
|
dbakw[fnode] = enode;
|
|
}
|
|
dhead[deg] = enode;
|
|
if (deg < *mdeg) {
|
|
*mdeg = deg;
|
|
}
|
|
L2200:
|
|
/* ---------------------------------- */
|
|
/* GET NEXT ENODE IN CURRENT ELEMENT. */
|
|
/* ---------------------------------- */
|
|
enode = llist[enode];
|
|
if (iq2 == 1) {
|
|
goto L900;
|
|
}
|
|
goto L1600;
|
|
L2300:
|
|
/* ----------------------------- */
|
|
/* GET NEXT ELEMENT IN THE LIST. */
|
|
/* ----------------------------- */
|
|
*tag = mtag;
|
|
elmnt = llist[elmnt];
|
|
goto L100;
|
|
|
|
} /* mmdupd_ */
|
|
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
/* ***** MMDNUM ..... MULTI MINIMUM DEGREE NUMBERING ***** */
|
|
/* *************************************************************** */
|
|
/* *************************************************************** */
|
|
|
|
/* AUTHOR - JOSEPH W.H. LIU */
|
|
/* DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
|
|
|
|
/* PURPOSE - THIS ROUTINE PERFORMS THE FINAL STEP IN */
|
|
/* PRODUCING THE PERMUTATION AND INVERSE PERMUTATION */
|
|
/* VECTORS IN THE MULTIPLE ELIMINATION VERSION OF THE */
|
|
/* MINIMUM DEGREE ORDERING ALGORITHM. */
|
|
|
|
/* INPUT PARAMETERS - */
|
|
/* NEQNS - NUMBER OF EQUATIONS. */
|
|
/* QSIZE - SIZE OF SUPERNODES AT ELIMINATION. */
|
|
|
|
/* UPDATED PARAMETERS - */
|
|
/* INVP - INVERSE PERMUTATION VECTOR. ON INPUT, */
|
|
/* IF QSIZE(NODE)=0, THEN NODE HAS BEEN MERGED */
|
|
/* INTO THE NODE -INVP(NODE); OTHERWISE, */
|
|
/* -INVP(NODE) IS ITS INVERSE LABELLING. */
|
|
|
|
/* OUTPUT PARAMETERS - */
|
|
/* PERM - THE PERMUTATION VECTOR. */
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Subroutine */ int mmdnum_(int *neqns, shortint *perm, shortint *invp,
|
|
shortint *qsize)
|
|
{
|
|
/* System generated locals */
|
|
int i__1;
|
|
|
|
/* Local variables */
|
|
static int node, root, nextf, father, nqsize, num;
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
|
|
/* *************************************************************** */
|
|
|
|
/* Parameter adjustments */
|
|
--qsize;
|
|
--invp;
|
|
--perm;
|
|
|
|
/* Function Body */
|
|
i__1 = *neqns;
|
|
for (node = 1; node <= i__1; ++node) {
|
|
nqsize = qsize[node];
|
|
if (nqsize <= 0) {
|
|
perm[node] = invp[node];
|
|
}
|
|
if (nqsize > 0) {
|
|
perm[node] = -invp[node];
|
|
}
|
|
/* L100: */
|
|
}
|
|
/* ------------------------------------------------------ */
|
|
/* FOR EACH NODE WHICH HAS BEEN MERGED, DO THE FOLLOWING. */
|
|
/* ------------------------------------------------------ */
|
|
i__1 = *neqns;
|
|
for (node = 1; node <= i__1; ++node) {
|
|
if (perm[node] > 0) {
|
|
goto L500;
|
|
}
|
|
/* ----------------------------------------- */
|
|
/* TRACE THE MERGED TREE UNTIL ONE WHICH HAS */
|
|
/* NOT BEEN MERGED, CALL IT ROOT. */
|
|
/* ----------------------------------------- */
|
|
father = node;
|
|
L200:
|
|
if (perm[father] > 0) {
|
|
goto L300;
|
|
}
|
|
father = -perm[father];
|
|
goto L200;
|
|
L300:
|
|
/* ----------------------- */
|
|
/* NUMBER NODE AFTER ROOT. */
|
|
/* ----------------------- */
|
|
root = father;
|
|
num = perm[root] + 1;
|
|
invp[node] = -num;
|
|
perm[root] = num;
|
|
/* ------------------------ */
|
|
/* SHORTEN THE MERGED TREE. */
|
|
/* ------------------------ */
|
|
father = node;
|
|
L400:
|
|
nextf = -perm[father];
|
|
if (nextf <= 0) {
|
|
goto L500;
|
|
}
|
|
perm[father] = -root;
|
|
father = nextf;
|
|
goto L400;
|
|
L500:
|
|
;
|
|
}
|
|
/* ---------------------- */
|
|
/* READY TO COMPUTE PERM. */
|
|
/* ---------------------- */
|
|
i__1 = *neqns;
|
|
for (node = 1; node <= i__1; ++node) {
|
|
num = -invp[node];
|
|
invp[node] = num;
|
|
perm[num] = node;
|
|
/* L600: */
|
|
}
|
|
return 0;
|
|
|
|
} /* mmdnum_ */
|
|
|