Actual source code: fn1wd.c

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

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

  7: /*****************************************************************/
  8: /********     FN1WD ..... FIND ONE-WAY DISSECTORS        *********/
  9: /*****************************************************************/
 10: /*    PURPOSE - THIS SUBROUTINE FINDS ONE-WAY DISSECTORS OF      */
 11: /*       A CONNECTED COMPONENT SPECIFIED BY MASK AND ../../...       */
 12: /*                                                               */
 13: /*    INPUT PARAMETERS -                                         */
 14: /*       ../../.. - A NODE THAT DEFINES (ALONG WITH MASK) THE        */
 15: /*              COMPONENT TO BE PROCESSED.                       */
 16: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE.               */
 17: /*                                                               */
 18: /*    OUTPUT PARAMETERS -                                        */
 19: /*       NSEP - NUMBER OF NODES IN THE ONE-WAY DISSECTORS.       */
 20: /*       SEP - VECTOR CONTAINING THE DISSECTOR NODES.            */
 21: /*                                                               */
 22: /*    UPDATED PARAMETER -                                        */
 23: /*       MASK - NODES IN THE DISSECTOR HAVE THEIR MASK VALUES    */
 24: /*              SET TO ZERO.                                     */
 25: /*                                                               */
 26: /*    WORKING PARAMETERS-                                        */
 27: /*       (XLS, LS) - LEVEL STRUCTURE USED BY THE ROUTINE FN../../... */
 28: /*                                                               */
 29: /*    PROGRAM SUBROUTINE -                                       */
 30: /*       FN../../...                                                 */
 31: /*****************************************************************/
 34: PetscErrorCode SPARSEPACKfn1wd(PetscInt *root, PetscInt *xadj, PetscInt *adjncy, 
 35:                                PetscInt *mask, PetscInt *nsep, PetscInt *sep, PetscInt *nlvl, PetscInt *
 36:                                xls, PetscInt *ls)
 37: {
 38:     /* System generated locals */
 39:     PetscInt  i__1, i__2;

 41:     /* Local variables */
 42:     PetscInt  node, i, j, k;
 43:     PetscReal width, fnlvl;
 44:     PetscInt  kstop, kstrt, lp1beg, lp1end;
 45:     PetscReal deltp1;
 46:     PetscInt  lvlbeg, lvlend;
 47:     PetscInt  nbr, lvl;

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

 58:     SPARSEPACKfnroot(root, &xadj[1], &adjncy[1], &mask[1], nlvl, &xls[1], &ls[1]);
 59:     fnlvl = (PetscReal) (*nlvl);
 60:     *nsep = xls[*nlvl + 1] - 1;
 61:     width = (PetscReal) (*nsep) / fnlvl;
 62:     deltp1 = sqrt((width * 3.f + 13.f) / 2.f) + 1.f;
 63:     if (*nsep >= 50 && deltp1 <= fnlvl * .5f) {
 64:         goto L300;
 65:     }
 66: /*       THE COMPONENT IS TOO SMALL, OR THE LEVEL STRUCTURE */
 67: /*       IS VERY LONG AND NARROW. RETURN THE WHOLE COMPONENT.*/
 68:     i__1 = *nsep;
 69:     for (i = 1; i <= i__1; ++i) {
 70:         node = ls[i];
 71:         sep[i] = node;
 72:         mask[node] = 0;
 73:     }
 74:     return(0);
 75: /*       FIND THE PARALLEL DISSECTORS.*/
 76: L300:
 77:     *nsep = 0;
 78:     i = 0;
 79: L400:
 80:     ++i;
 81:     lvl = (PetscInt)((PetscReal) i * deltp1 + .5f);
 82:     if (lvl >= *nlvl) {
 83:         return(0);
 84:     }
 85:     lvlbeg = xls[lvl];
 86:     lp1beg = xls[lvl + 1];
 87:     lvlend = lp1beg - 1;
 88:     lp1end = xls[lvl + 2] - 1;
 89:     i__1 = lp1end;
 90:     for (j = lp1beg; j <= i__1; ++j) {
 91:         node = ls[j];
 92:         xadj[node] = -xadj[node];
 93:     }
 94: /*          NODES IN LEVEL LVL ARE CHOSEN TO FORM DISSECTOR. */
 95: /*          INCLUDE ONLY THOSE WITH NEIGHBORS IN LVL+1 LEVEL. */
 96: /*          XADJ IS USED TEMPORARILY TO MARK NODES IN LVL+1.  */
 97:     i__1 = lvlend;
 98:     for (j = lvlbeg; j <= i__1; ++j) {
 99:         node = ls[j];
100:         kstrt = xadj[node];
101:         kstop = (i__2 = xadj[node + 1], (PetscInt)PetscAbsInt(i__2)) - 1;
102:         i__2 = kstop;
103:         for (k = kstrt; k <= i__2; ++k) {
104:             nbr = adjncy[k];
105:             if (xadj[nbr] > 0) {
106:                 goto L600;
107:             }
108:             ++(*nsep);
109:             sep[*nsep] = node;
110:             mask[node] = 0;
111:             goto L700;
112: L600:
113:             ;
114:         }
115: L700:
116:         ;
117:     }
118:     i__1 = lp1end;
119:     for (j = lp1beg; j <= i__1; ++j) {
120:         node = ls[j];
121:         xadj[node] = -xadj[node];
122:     }
123:     goto L400;
124: }