Actual source code: qmdmrg.c

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

 4:  #include petsc.h

  6: /******************************************************************/
  7: /***********     QMDMRG ..... QUOT MIN DEG MERGE       ************/
  8: /******************************************************************/
  9: /*    PURPOSE - THIS ROUTINE MERGES INDISTINGUISHABLE NODES IN   */
 10: /*              THE MINIMUM DEGREE ORDERING ALGORITHM.           */
 11: /*              IT ALSO COMPUTES THE NEW DEGREES OF THESE        */
 12: /*              NEW SUPERNODES.                                  */
 13: /*                                                               */
 14: /*    INPUT PARAMETERS -                                         */
 15: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE.               */
 16: /*       DEG0 - THE NUMBER OF NODES IN THE GIVEN SET.            */
 17: /*       (NHDSZE, NBRHD) - THE SET OF ELIMINATED SUPERNODES      */
 18: /*              ADJACENT TO SOME NODES IN THE SET.               */
 19: /*                                                               */
 20: /*    UPDATED PARAMETERS -                                       */
 21: /*       DEG - THE DEGREE VECTOR.                                */
 22: /*       QSIZE - SIZE OF INDISTINGUISHABLE NODES.                */
 23: /*       QLINK - LINKED LIST FOR INDISTINGUISHABLE NODES.        */
 24: /*       MARKER - THE GIVEN SET IS GIVEN BY THOSE NODES WITH     */
 25: /*              MARKER VALUE SET TO 1.  THOSE NODES WITH DEGREE  */
 26: /*              UPDATED WILL HAVE MARKER VALUE SET TO 2.         */
 27: /*                                                               */
 28: /*    WORKING PARAMETERS -                                       */
 29: /*       RCHSET - THE REACHABLE SET.                             */
 30: /*       OVRLP -  TEMP VECTOR TO STORE THE INTERSECTION OF TWO   */
 31: /*              REACHABLE SETS.                                  */
 32: /*                                                               */
 33: /*****************************************************************/
 34: int SPARSEPACKqmdmrg(int *xadj, int *adjncy, int *deg, 
 35:         int *qsize, int *qlink, int *marker, int *deg0, 
 36:         int *nhdsze, int *nbrhd, int *rchset, int *ovrlp)
 37: {
 38:     /* System generated locals */
 39:     int i__1, i__2, i__3;

 41:     /* Local variables */
 42:     int head, inhd, irch, node, mark, link, root, j, lnode, nabor,
 43:             jstop, jstrt, rchsze, mrgsze, novrlp, iov, deg1;

 46:     /* Parameter adjustments */
 47:     --ovrlp;
 48:     --rchset;
 49:     --nbrhd;
 50:     --marker;
 51:     --qlink;
 52:     --qsize;
 53:     --deg;
 54:     --adjncy;
 55:     --xadj;

 57:     if (*nhdsze <= 0) {
 58:         return(0);
 59:     }
 60:     i__1 = *nhdsze;
 61:     for (inhd = 1; inhd <= i__1; ++inhd) {
 62:         root = nbrhd[inhd];
 63:         marker[root] = 0;
 64:     }
 65: /*       LOOP THROUGH EACH ELIMINATED SUPERNODE IN THE SET     */
 66: /*       (NHDSZE, NBRHD).                                      */
 67:     i__1 = *nhdsze;
 68:     for (inhd = 1; inhd <= i__1; ++inhd) {
 69:         root = nbrhd[inhd];
 70:         marker[root] = -1;
 71:         rchsze = 0;
 72:         novrlp = 0;
 73:         deg1 = 0;
 74: L200:
 75:         jstrt = xadj[root];
 76:         jstop = xadj[root + 1] - 1;
 77: /*          DETERMINE THE REACHABLE SET AND ITS INTERSECT-     */
 78: /*          ION WITH THE INPUT REACHABLE SET.                  */
 79:         i__2 = jstop;
 80:         for (j = jstrt; j <= i__2; ++j) {
 81:             nabor = adjncy[j];
 82:             root = -nabor;
 83:             if (nabor < 0) {
 84:                 goto L200;
 85:             } else if (nabor == 0) {
 86:                 goto L700;
 87:             } else {
 88:                 goto L300;
 89:             }
 90: L300:
 91:             mark = marker[nabor];
 92:             if (mark < 0) {
 93:                 goto L600;
 94:             } else if (mark == 0) {
 95:                 goto L400;
 96:             } else {
 97:                 goto L500;
 98:             }
 99: L400:
100:             ++rchsze;
101:             rchset[rchsze] = nabor;
102:             deg1 += qsize[nabor];
103:             marker[nabor] = 1;
104:             goto L600;
105: L500:
106:             if (mark > 1) {
107:                 goto L600;
108:             }
109:             ++novrlp;
110:             ovrlp[novrlp] = nabor;
111:             marker[nabor] = 2;
112: L600:
113:             ;
114:         }
115: /*          FROM THE OVERLAPPED SET, DETERMINE THE NODES        */
116: /*          THAT CAN BE MERGED TOGETHER.                        */
117: L700:
118:         head = 0;
119:         mrgsze = 0;
120:         i__2 = novrlp;
121:         for (iov = 1; iov <= i__2; ++iov) {
122:             node = ovrlp[iov];
123:             jstrt = xadj[node];
124:             jstop = xadj[node + 1] - 1;
125:             i__3 = jstop;
126:             for (j = jstrt; j <= i__3; ++j) {
127:                 nabor = adjncy[j];
128:                 if (marker[nabor] != 0) {
129:                     goto L800;
130:                 }
131:                 marker[node] = 1;
132:                 goto L1100;
133: L800:
134:                 ;
135:             }
136: /*             NODE BELONGS TO THE NEW MERGED SUPERNODE.      */
137: /*             UPDATE THE VECTORS QLINK AND QSIZE.            */
138:             mrgsze += qsize[node];
139:             marker[node] = -1;
140:             lnode = node;
141: L900:
142:             link = qlink[lnode];
143:             if (link <= 0) {
144:                 goto L1000;
145:             }
146:             lnode = link;
147:             goto L900;
148: L1000:
149:             qlink[lnode] = head;
150:             head = node;
151: L1100:
152:             ;
153:         }
154:         if (head <= 0) {
155:             goto L1200;
156:         }
157:         qsize[head] = mrgsze;
158:         deg[head] = *deg0 + deg1 - 1;
159:         marker[head] = 2;
160: /*          RESET MARKER VALUES.          */
161: L1200:
162:         root = nbrhd[inhd];
163:         marker[root] = 0;
164:         if (rchsze <= 0) {
165:             goto L1400;
166:         }
167:         i__2 = rchsze;
168:         for (irch = 1; irch <= i__2; ++irch) {
169:             node = rchset[irch];
170:             marker[node] = 0;
171:         }
172: L1400:
173:         ;
174:     }
175:     return(0);
176: }