Actual source code: genqmd.c

  1: /*$Id: genqmd.c,v 1.17 2001/03/23 23:22:51 balay Exp $*/
  2: /* genqmd.f -- translated by f2c (version 19931217).*/

 4:  #include petsc.h

  6: /******************************************************************/
  7: /***********    GENQMD ..... QUOT MIN DEGREE ORDERING    **********/
  8: /******************************************************************/
  9: /*    PURPOSE - THIS ROUTINE IMPLEMENTS THE MINIMUM DEGREE        */
 10: /*       ALGORITHM.  IT MAKES USE OF THE IMPLICIT REPRESENT-      */
 11: /*       ATION OF THE ELIMINATION GRAPHS BY QUOTIENT GRAPHS,      */
 12: /*       AND THE NOTION OF INDISTINGUISHABLE NODES.               */
 13: /*       CAUTION - THE ADJACENCY VECTOR ADJNCY WILL BE            */
 14: /*       DESTROYED.                                               */
 15: /*                                                                */
 16: /*    INPUT PARAMETERS -                                          */
 17: /*       NEQNS - NUMBER OF EQUATIONS.                             */
 18: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE.                */
 19: /*                                                                */
 20: /*    OUTPUT PARAMETERS -                                         */
 21: /*       PERM - THE MINIMUM DEGREE ORDERING.                      */
 22: /*       INVP - THE INVERSE OF PERM.                              */
 23: /*                                                                */
 24: /*    WORKING PARAMETERS -                                        */
 25: /*       DEG - THE DEGREE VECTOR. DEG(I) IS NEGATIVE MEANS        */
 26: /*              NODE I HAS BEEN NUMBERED.                         */
 27: /*       MARKER - A MARKER VECTOR, WHERE MARKER(I) IS             */
 28: /*              NEGATIVE MEANS NODE I HAS BEEN MERGED WITH        */
 29: /*              ANOTHER NODE AND THUS CAN BE IGNORED.             */
 30: /*       RCHSET - VECTOR USED FOR THE REACHABLE SET.              */
 31: /*       NBRHD - VECTOR USED FOR THE NEIGHBORHOOD SET.            */
 32: /*       QSIZE - VECTOR USED TO STORE THE SIZE OF                 */
 33: /*              INDISTINGUISHABLE SUPERNODES.                     */
 34: /*       QLINK - VECTOR TO STORE INDISTINGUISHABLE NODES,         */
 35: /*              I, QLINK(I), QLINK(QLINK(I)) ... ARE THE          */
 36: /*              MEMBERS OF THE SUPERNODE REPRESENTED BY I.        */
 37: /*                                                                */
 38: /*    PROGRAM SUBROUTINES -                                       */
 39: /*       QMDRCH, QMDQT, QMDUPD.                                   */
 40: /*                                                                */
 41: /******************************************************************/
 42: /*                                                                */
 43: /*                                                                */
 46: int SPARSEPACKgenqmd(int *neqns, int *xadj, int *adjncy, 
 47:         int *perm, int *invp, int *deg, int *marker, int *
 48:         rchset, int *nbrhd, int *qsize, int *qlink, int *nofsub)
 49: {
 50:     /* System generated locals */
 51:     int i__1;

 53:     /* Local variables */
 54:     int ndeg, irch, node, nump1, j, inode;
 55:     EXTERN int SPARSEPACKqmdqt(int *, int *, int *, int *, int *, int *, int *);
 56:     int ip, np, mindeg, search;
 57:     EXTERN int SPARSEPACKqmdrch(int *, int *, int *,
 58:               int *, int *, int *, int *, int *, int *),
 59:            SPARSEPACKqmdupd(int *, int *, int *, int *, int *,
 60:               int *, int *, int *, int *, int *);
 61:     int nhdsze, nxnode, rchsze, thresh, num;

 63: /*       INITIALIZE DEGREE VECTOR AND OTHER WORKING VARIABLES.   */

 66:     /* Parameter adjustments */
 67:     --qlink;
 68:     --qsize;
 69:     --nbrhd;
 70:     --rchset;
 71:     --marker;
 72:     --deg;
 73:     --invp;
 74:     --perm;
 75:     --adjncy;
 76:     --xadj;

 78:     mindeg = *neqns;
 79:     *nofsub = 0;
 80:     i__1 = *neqns;
 81:     for (node = 1; node <= i__1; ++node) {
 82:         perm[node] = node;
 83:         invp[node] = node;
 84:         marker[node] = 0;
 85:         qsize[node] = 1;
 86:         qlink[node] = 0;
 87:         ndeg = xadj[node + 1] - xadj[node];
 88:         deg[node] = ndeg;
 89:         if (ndeg < mindeg) {
 90:             mindeg = ndeg;
 91:         }
 92:     }
 93:     num = 0;
 94: /*       PERFORM THRESHOLD SEARCH TO GET A NODE OF MIN DEGREE.   */
 95: /*       VARIABLE SEARCH POINTS TO WHERE SEARCH SHOULD START.    */
 96: L200:
 97:     search = 1;
 98:     thresh = mindeg;
 99:     mindeg = *neqns;
100: L300:
101:     nump1 = num + 1;
102:     if (nump1 > search) {
103:         search = nump1;
104:     }
105:     i__1 = *neqns;
106:     for (j = search; j <= i__1; ++j) {
107:         node = perm[j];
108:         if (marker[node] < 0) {
109:             goto L400;
110:         }
111:         ndeg = deg[node];
112:         if (ndeg <= thresh) {
113:             goto L500;
114:         }
115:         if (ndeg < mindeg) {
116:             mindeg = ndeg;
117:         }
118: L400:
119:         ;
120:     }
121:     goto L200;
122: /*          NODE HAS MINIMUM DEGREE. FIND ITS REACHABLE SETS BY    */
123: /*          CALLING QMDRCH.                                        */
124: L500:
125:     search = j;
126:     *nofsub += deg[node];
127:     marker[node] = 1;
128:     SPARSEPACKqmdrch(&node, &xadj[1], &adjncy[1], &deg[1], &marker[1], &rchsze, &
129:             rchset[1], &nhdsze, &nbrhd[1]);
130: /*          ELIMINATE ALL NODES INDISTINGUISHABLE FROM NODE.       */
131: /*          THEY ARE GIVEN BY NODE, QLINK(NODE), ....              */
132:     nxnode = node;
133: L600:
134:     ++num;
135:     np = invp[nxnode];
136:     ip = perm[num];
137:     perm[np] = ip;
138:     invp[ip] = np;
139:     perm[num] = nxnode;
140:     invp[nxnode] = num;
141:     deg[nxnode] = -1;
142:     nxnode = qlink[nxnode];
143:     if (nxnode > 0) {
144:         goto L600;
145:     }
146:     if (rchsze <= 0) {
147:         goto L800;
148:     }
149: /*             UPDATE THE DEGREES OF THE NODES IN THE REACHABLE     */
150: /*             SET AND IDENTIFY INDISTINGUISHABLE NODES.            */
151:     SPARSEPACKqmdupd(&xadj[1], &adjncy[1], &rchsze, &rchset[1], &deg[1], &qsize[1], &
152:             qlink[1], &marker[1], &rchset[rchsze + 1], &nbrhd[nhdsze + 1]);
153: /*             RESET MARKER VALUE OF NODES IN REACH SET.            */
154: /*             UPDATE THRESHOLD VALUE FOR CYCLIC SEARCH.            */
155: /*             ALSO CALL QMDQT TO FORM NEW QUOTIENT GRAPH.          */
156:     marker[node] = 0;
157:     i__1 = rchsze;
158:     for (irch = 1; irch <= i__1; ++irch) {
159:         inode = rchset[irch];
160:         if (marker[inode] < 0) {
161:             goto L700;
162:         }
163:         marker[inode] = 0;
164:         ndeg = deg[inode];
165:         if (ndeg < mindeg) {
166:             mindeg = ndeg;
167:         }
168:         if (ndeg > thresh) {
169:             goto L700;
170:         }
171:         mindeg = thresh;
172:         thresh = ndeg;
173:         search = invp[inode];
174: L700:
175:         ;
176:     }
177:     if (nhdsze > 0) {
178:         SPARSEPACKqmdqt(&node, &xadj[1], &adjncy[1], &marker[1], &rchsze, &rchset[1], &
179:                 nbrhd[1]);
180:     }
181: L800:
182:     if (num < *neqns) {
183:         goto L300;
184:     }
185:     return(0);
186: }