Actual source code: qmdupd.c
1: /* qmdupd.f -- translated by f2c (version 19931217).*/
3: #include petsc.h
5: /******************************************************************/
6: /*********** QMDUPD ..... QUOT MIN DEG UPDATE ************/
7: /******************************************************************/
8: /******************************************************************/
10: /* PURPOSE - THIS ROUTINE PERFORMS DEGREE UPDATE FOR A SET*/
11: /* OF NODES IN THE MINIMUM DEGREE ALGORITHM.*/
13: /* INPUT PARAMETERS -*/
14: /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE.*/
15: /* (NLIST, LIST) - THE LIST OF NODES WHOSE DEGREE HAS TO*/
16: /* BE UPDATED.*/
18: /* UPDATED PARAMETERS -*/
19: /* DEG - THE DEGREE VECTOR.*/
20: /* QSIZE - SIZE OF INDISTINGUISHABLE SUPERNODES.*/
21: /* QLINK - LINKED LIST FOR INDISTINGUISHABLE NODES.*/
22: /* MARKER - USED TO MARK THOSE NODES IN REACH/NBRHD SETS.*/
24: /* WORKING PARAMETERS -*/
25: /* RCHSET - THE REACHABLE SET.*/
26: /* NBRHD - THE NEIGHBORHOOD SET.*/
28: /* PROGRAM SUBROUTINES -*/
29: /* QMDMRG.*/
30: /******************************************************************/
33: PetscErrorCode SPARSEPACKqmdupd(PetscInt *xadj, PetscInt *adjncy, PetscInt *nlist,
34: PetscInt *list, PetscInt *deg, PetscInt *qsize, PetscInt *qlink, PetscInt *
35: marker, PetscInt *rchset, PetscInt *nbrhd)
36: {
37: /* System generated locals */
38: PetscInt i__1, i__2;
40: /* Local variables */
41: PetscInt inhd, irch, node, mark, j, inode, nabor, jstop, jstrt, il;
42: EXTERN PetscErrorCode SPARSEPACKqmdrch(PetscInt*, PetscInt *, PetscInt *,
43: PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *),
44: SPARSEPACKqmdmrg(PetscInt*, PetscInt *, PetscInt *, PetscInt *, PetscInt *,
45: PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *);
46: PetscInt nhdsze, rchsze, deg0, deg1;
48: /* FIND ALL ELIMINATED SUPERNODES THAT ARE ADJACENT*/
49: /* TO SOME NODES IN THE GIVEN LIST. PUT THEM INTO.*/
50: /* (NHDSZE, NBRHD). DEG0 CONTAINS THE NUMBER OF*/
51: /* NODES IN THE LIST.*/
55: /* Parameter adjustments */
56: --nbrhd;
57: --rchset;
58: --marker;
59: --qlink;
60: --qsize;
61: --deg;
62: --list;
63: --adjncy;
64: --xadj;
66: if (*nlist <= 0) {
67: return(0);
68: }
69: deg0 = 0;
70: nhdsze = 0;
71: i__1 = *nlist;
72: for (il = 1; il <= i__1; ++il) {
73: node = list[il];
74: deg0 += qsize[node];
75: jstrt = xadj[node];
76: jstop = xadj[node + 1] - 1;
77: i__2 = jstop;
78: for (j = jstrt; j <= i__2; ++j) {
79: nabor = adjncy[j];
80: if (marker[nabor] != 0 || deg[nabor] >= 0) {
81: goto L100;
82: }
83: marker[nabor] = -1;
84: ++nhdsze;
85: nbrhd[nhdsze] = nabor;
86: L100:
87: ;
88: }
89: }
90: /* MERGE INDISTINGUISHABLE NODES IN THE LIST BY*/
91: /* CALLING THE SUBROUTINE QMDMRG.*/
92: if (nhdsze > 0) {
93: SPARSEPACKqmdmrg(&xadj[1], &adjncy[1], °[1], &qsize[1], &qlink[1], &marker[
94: 1], °0, &nhdsze, &nbrhd[1], &rchset[1], &nbrhd[nhdsze + 1]);
95: }
96: /* FIND THE NEW DEGREES OF THE NODES THAT HAVE NOT BEEN*/
97: /* MERGED.*/
98: i__1 = *nlist;
99: for (il = 1; il <= i__1; ++il) {
100: node = list[il];
101: mark = marker[node];
102: if (mark > 1 || mark < 0) {
103: goto L600;
104: }
105: marker[node] = 2;
106: SPARSEPACKqmdrch(&node, &xadj[1], &adjncy[1], °[1], &marker[1], &rchsze, &
107: rchset[1], &nhdsze, &nbrhd[1]);
108: deg1 = deg0;
109: if (rchsze <= 0) {
110: goto L400;
111: }
112: i__2 = rchsze;
113: for (irch = 1; irch <= i__2; ++irch) {
114: inode = rchset[irch];
115: deg1 += qsize[inode];
116: marker[inode] = 0;
117: }
118: L400:
119: deg[node] = deg1 - 1;
120: if (nhdsze <= 0) {
121: goto L600;
122: }
123: i__2 = nhdsze;
124: for (inhd = 1; inhd <= i__2; ++inhd) {
125: inode = nbrhd[inhd];
126: marker[inode] = 0;
127: }
128: L600:
129: ;
130: }
131: return(0);
132: }