Date: 2013-07-02T14:44:46+00:00

Actual source code: qmdrch.c
petsc-3.4.2 2013-07-02

      2: /* qmdrch.f -- translated by f2c (version 19931217).*/

      4: #include <petscsys.h>
      5: #include <../src/mat/order/order.h>

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

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

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

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

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

     40:   /* Local variables */
     41:   PetscInt node, i, j, nabor, istop, jstop, istrt, jstrt;

     43: /*       LOOP THROUGH THE NEIGHBORS OF ../../.. IN THE*/
     44: /*       QUOTIENT GRAPH.*/

     48:   /* Parameter adjustments */
     49:   --nbrhd;
     50:   --rchset;
     51:   --marker;
     52:   --deg;
     53:   --adjncy;
     54:   --xadj;

     56:   *nhdsze = 0;
     57:   *rchsze = 0;
     58:   istrt   = xadj[*root];
     59:   istop   = xadj[*root + 1] - 1;
     60:   if (istop < istrt) return(0);
     61:   i__1 = istop;
     62:   for (i = istrt; i <= i__1; ++i) {
     63:     nabor = adjncy[i];
     64:     if (!nabor) return(0);
     65:     if (marker[nabor] != 0) goto L600;
     66:     if (deg[nabor] < 0) goto L200;

     68: /*                   INCLUDE NABOR INTO THE REACHABLE SET.*/
     69:     ++(*rchsze);
     70:     rchset[*rchsze] = nabor;
     71:     marker[nabor]   = 1;
     72:     goto L600;
     73: /*                NABOR HAS BEEN ELIMINATED. FIND NODES*/
     74: /*                REACHABLE FROM IT.*/
     75: L200:
     76:     marker[nabor] = -1;
     77:     ++(*nhdsze);
     78:     nbrhd[*nhdsze] = nabor;
     79: L300:
     80:     jstrt = xadj[nabor];
     81:     jstop = xadj[nabor + 1] - 1;
     82:     i__2  = jstop;
     83:     for (j = jstrt; j <= i__2; ++j) {
     84:       node  = adjncy[j];
     85:       nabor = -node;
     86:       if (node < 0) goto L300;
     87:       else if (!node) goto L600;
     88:       else goto L400;
     89: L400:
     90:       if (marker[node] != 0) goto L500;
     91:       ++(*rchsze);
     92:       rchset[*rchsze] = node;
     93:       marker[node]    = 1;
     94: L500:
     95:       ;
     96:     }
     97: L600:
     98:     ;
     99:   }
    100:   return(0);
    101: }