📄 ordmmd.c
字号:
fnode = dhead[ndeg];
dforw[node] = fnode;
dhead[ndeg] = node;
if (fnode > 0) {
dbakw[fnode] = node;
}
dbakw[node] = -ndeg;
/* L200: */
}
return 0;
} /* mmdint_ */
/* *********************************************************************** */
/* *********************************************************************** */
/* Version: 0.3 */
/* Last modified: December 27, 1994 */
/* Authors: Joseph W.H. Liu */
/* Mathematical Sciences Section, Oak Ridge National Laboratory */
/* *********************************************************************** */
/* *********************************************************************** */
/* --- SPARSPAK-A (ANSI FORTRAN) RELEASE III --- NAME = MMDELM */
/* (C) UNIVERSITY OF WATERLOO JANUARY 1984 */
/* *********************************************************************** */
/* *********************************************************************** */
/* ** MMDELM ..... MULTIPLE MINIMUM DEGREE ELIMINATION *********** */
/* *********************************************************************** */
/* *********************************************************************** */
/* 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) */
/* INTEGER. */
/* 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_(mdnode, xadj, adjncy, dhead, dforw, dbakw, qsize,
llist, marker, maxint, tag)
integer *mdnode, *xadj, *adjncy, *dhead, *dforw, *dbakw, *qsize, *llist, *
marker, *maxint, *tag;
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
static integer 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_ */
/* *********************************************************************** */
/* *********************************************************************** */
/* Version: 0.3 */
/* Last modified: December 27, 1994 */
/* Authors: Joseph W.H. Liu */
/* Mathematical Sciences Section, Oak Ridge National Laboratory */
/* *********************************************************************** */
/* *********************************************************************** */
/* --- SPARSPAK-A (ANSI FORTRAN) RELEASE III --- NAME = MMDNUM */
/* (C) UNIVERSITY OF WATERLOO JANUARY 1984 */
/* *********************************************************************** */
/* *********************************************************************** */
/* ***** MMDNUM ..... MULTI MINIMUM DEGREE NUMBERING ************* */
/* *********************************************************************** */
/* *********************************************************************** */
/* 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_(neqns, perm, invp, qsize)
integer *neqns, *perm, *invp, *qsize;
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer 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:
;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -