📄 ordmmd.c
字号:
}
/* ---------------------- */
/* 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_ */
/* *********************************************************************** */
/* *********************************************************************** */
/* 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 = MMDUPD */
/* (C) UNIVERSITY OF WATERLOO JANUARY 1984 */
/* *********************************************************************** */
/* *********************************************************************** */
/* ***** MMDUPD ..... MULTIPLE MINIMUM DEGREE UPDATE ************* */
/* *********************************************************************** */
/* *********************************************************************** */
/* 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_(ehead, neqns, xadj, adjncy, delta, mdeg, dhead,
dforw, dbakw, qsize, llist, marker, maxint, tag)
integer *ehead, *neqns, *xadj, *adjncy, *delta, *mdeg, *dhead, *dforw, *dbakw,
*qsize, *llist, *marker, *maxint, *tag;
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
static integer 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_ */
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -