Actual source code: qmdrch.c

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

 4:  #include petsc.h

  6: /*****************************************************************/
  7: /**********     QMDRCH ..... QUOT MIN DEG REACH SET    ***********/
  8: /*****************************************************************/

 10: /*    PURPOSE - THIS SUBROUTINE DETERMINES THE REACHABLE SET OF*/
 11: /*       A NODE THROUGH A GIVEN SUBSET.  THE ADJACENCY STRUCTURE*/
 12: /*       IS ASSUMED TO BE STORED IN A QUOTIENT GRAPH FORMAT.*/

 14: /*    INPUT PARAMETERS -*/
 15: /*       ../../.. - THE GIVEN NODE NOT IN THE SUBSET.*/
 16: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR.*/
 17: /*       DEG - THE DEGREE VECTOR.  DEG(I) LT 0 MEANS THE NODE*/
 18: /*              BELONGS TO THE GIVEN SUBSET.*/

 20: /*    OUTPUT PARAMETERS -*/
 21: /*       (RCHSZE, RCHSET) - THE REACHABLE SET.*/
 22: /*       (NHDSZE, NBRHD) - THE NEIGHBORHOOD SET.*/

 24: /*    UPDATED PARAMETERS -*/
 25: /*       MARKER - THE MARKER VECTOR FOR REACH AND NBRHD SETS.*/
 26: /*              GT 0 MEANS THE NODE IS IN REACH SET.*/
 27: /*              LT 0 MEANS THE NODE HAS BEEN MERGED WITH*/
 28: /*              OTHERS IN THE QUOTIENT OR IT IS IN NBRHD SET.*/
 29: /*****************************************************************/
 30: int SPARSEPACKqmdrch(int *root, int *xadj, int *adjncy, 
 31:         int *deg, int *marker, int *rchsze, int *rchset, 
 32:         int *nhdsze, int *nbrhd)
 33: {
 34:     /* System generated locals */
 35:     int i__1, i__2;

 37:     /* Local variables */
 38:     int node, i, j, nabor, istop, jstop, istrt, jstrt;

 40: /*       LOOP THROUGH THE NEIGHBORS OF ../../.. IN THE*/
 41: /*       QUOTIENT GRAPH.*/


 45:     /* Parameter adjustments */
 46:     --nbrhd;
 47:     --rchset;
 48:     --marker;
 49:     --deg;
 50:     --adjncy;
 51:     --xadj;

 53:     *nhdsze = 0;
 54:     *rchsze = 0;
 55:     istrt = xadj[*root];
 56:     istop = xadj[*root + 1] - 1;
 57:     if (istop < istrt) {
 58:         return(0);
 59:     }
 60:     i__1 = istop;
 61:     for (i = istrt; i <= i__1; ++i) {
 62:         nabor = adjncy[i];
 63:         if (nabor == 0) {
 64:             return(0);
 65:         }
 66:         if (marker[nabor] != 0) {
 67:             goto L600;
 68:         }
 69:         if (deg[nabor] < 0) {
 70:             goto L200;
 71:         }
 72: /*                   INCLUDE NABOR INTO THE REACHABLE SET.*/
 73:         ++(*rchsze);
 74:         rchset[*rchsze] = nabor;
 75:         marker[nabor] = 1;
 76:         goto L600;
 77: /*                NABOR HAS BEEN ELIMINATED. FIND NODES*/
 78: /*                REACHABLE FROM IT.*/
 79: L200:
 80:         marker[nabor] = -1;
 81:         ++(*nhdsze);
 82:         nbrhd[*nhdsze] = nabor;
 83: L300:
 84:         jstrt = xadj[nabor];
 85:         jstop = xadj[nabor + 1] - 1;
 86:         i__2 = jstop;
 87:         for (j = jstrt; j <= i__2; ++j) {
 88:             node = adjncy[j];
 89:             nabor = -node;
 90:             if (node < 0) {
 91:                 goto L300;
 92:             } else if (node == 0) {
 93:                 goto L600;
 94:             } else {
 95:                 goto L400;
 96:             }
 97: L400:
 98:             if (marker[node] != 0) {
 99:                 goto L500;
100:             }
101:             ++(*rchsze);
102:             rchset[*rchsze] = node;
103:             marker[node] = 1;
104: L500:
105:             ;
106:         }
107: L600:
108:         ;
109:     }
110:     return(0);
111: }