Actual source code: fndsep.c

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

 5:  #include petsc.h
 6:  #include src/mat/order/order.h

  8: /*****************************************************************/
  9: /*************     FNDSEP ..... FIND SEPARATOR       *************/
 10: /*****************************************************************/
 11: /*    PURPOSE - THIS ROUTINE IS USED TO FIND A SMALL             */
 12: /*              SEPARATOR FOR A CONNECTED COMPONENT SPECIFIED    */
 13: /*              BY MASK IN THE GIVEN GRAPH.                      */
 14: /*                                                               */
 15: /*    INPUT PARAMETERS -                                         */
 16: /*       ../../.. - IS THE NODE THAT DETERMINES THE MASKED           */
 17: /*              COMPONENT.                                       */
 18: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR.          */
 19: /*                                                               */
 20: /*    OUTPUT PARAMETERS -                                        */
 21: /*       NSEP - NUMBER OF VARIABLES IN THE SEPARATOR.            */
 22: /*       SEP - VECTOR CONTAINING THE SEPARATOR NODES.            */
 23: /*                                                               */
 24: /*    UPDATED PARAMETER -                                        */
 25: /*       MASK - NODES IN THE SEPARATOR HAVE THEIR MASK           */
 26: /*              VALUES SET TO ZERO.                              */
 27: /*                                                               */
 28: /*    WORKING PARAMETERS -                                       */
 29: /*       (XLS, LS) - LEVEL STRUCTURE PAIR FOR LEVEL STRUCTURE    */
 30: /*              FOUND BY FN../../...                                 */
 31: /*                                                               */
 32: /*    PROGRAM SUBROUTINES -                                      */
 33: /*       FN../../...                                                 */
 34: /*                                                               */
 35: /*****************************************************************/
 38: int SPARSEPACKfndsep(int *root, int *xadj, int *adjncy, 
 39:         int *mask, int *nsep, int *sep, int *xls, int *ls)
 40: {
 41:     /* System generated locals */
 42:     int i__1, i__2;

 44:     /* Local variables */
 45:     int node, nlvl, i, j, jstop, jstrt, mp1beg, mp1end, midbeg,
 46:             midend, midlvl;
 47:     EXTERN int SPARSEPACKfnroot(int *, int *, int *,
 48:             int *, int *, int *, int *);
 49:     int nbr;

 52:     /* Parameter adjustments */
 53:     --ls;
 54:     --xls;
 55:     --sep;
 56:     --mask;
 57:     --adjncy;
 58:     --xadj;

 60:     SPARSEPACKfnroot(root, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &ls[1]);
 61: /*       IF THE NUMBER OF LEVELS IS LESS THAN 3, RETURN */
 62: /*       THE WHOLE COMPONENT AS THE SEPARATOR.*/
 63:     if (nlvl >= 3) {
 64:         goto L200;
 65:     }
 66:     *nsep = xls[nlvl + 1] - 1;
 67:     i__1 = *nsep;
 68:     for (i = 1; i <= i__1; ++i) {
 69:         node = ls[i];
 70:         sep[i] = node;
 71:         mask[node] = 0;
 72:     }
 73:     return(0);
 74: /*       FIND THE MIDDLE LEVEL OF THE ../../..ED LEVEL STRUCTURE.*/
 75: L200:
 76:     midlvl = (nlvl + 2) / 2;
 77:     midbeg = xls[midlvl];
 78:     mp1beg = xls[midlvl + 1];
 79:     midend = mp1beg - 1;
 80:     mp1end = xls[midlvl + 2] - 1;
 81: /*       THE SEPARATOR IS OBTAINED BY INCLUDING ONLY THOSE*/
 82: /*       MIDDLE-LEVEL NODES WITH NEIGHBORS IN THE MIDDLE+1*/
 83: /*       LEVEL. XADJ IS USED TEMPORARILY TO MARK THOSE*/
 84: /*       NODES IN THE MIDDLE+1 LEVEL.*/
 85:     i__1 = mp1end;
 86:     for (i = mp1beg; i <= i__1; ++i) {
 87:         node = ls[i];
 88:         xadj[node] = -xadj[node];
 89:     }
 90:     *nsep = 0;
 91:     i__1 = midend;
 92:     for (i = midbeg; i <= i__1; ++i) {
 93:         node = ls[i];
 94:         jstrt = xadj[node];
 95:         jstop = (i__2 = xadj[node + 1], (int)PetscAbsInt(i__2)) - 1;
 96:         i__2 = jstop;
 97:         for (j = jstrt; j <= i__2; ++j) {
 98:             nbr = adjncy[j];
 99:             if (xadj[nbr] > 0) {
100:                 goto L400;
101:             }
102:             ++(*nsep);
103:             sep[*nsep] = node;
104:             mask[node] = 0;
105:             goto L500;
106: L400:
107:             ;
108:         }
109: L500:
110:         ;
111:     }
112: /*       RESET XADJ TO ITS CORRECT SIGN.*/
113:     i__1 = mp1end;
114:     for (i = mp1beg; i <= i__1; ++i) {
115:         node = ls[i];
116:         xadj[node] = -xadj[node];
117:     }
118:     return(0);
119: }