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: /*                                                                */
 44: int SPARSEPACKgenqmd(int *neqns, int *xadj, int *adjncy, 
 45:         int *perm, int *invp, int *deg, int *marker, int *
 46:         rchset, int *nbrhd, int *qsize, int *qlink, int *nofsub)
 47: {
 48:     /* System generated locals */
 49:     int i__1;

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

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

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

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