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