Actual source code: fnroot.c

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

 4:  #include petsc.h

  6: /*****************************************************************/
  7: /********     FN../../.. ..... FIND PSEUDO-PERIPHERAL NODE    ********/
  8: /*****************************************************************/
  9: /*   PURPOSE - FN../../.. IMPLEMENTS A MODIFIED VERSION OF THE       */
 10: /*      SCHEME BY GIBBS, POOLE, AND STOCKMEYER TO FIND PSEUDO-   */
 11: /*      PERIPHERAL NODES.  IT DETERMINES SUCH A NODE FOR THE     */
 12: /*      SECTION SUBGRAPH SPECIFIED BY MASK AND ../../...             */
 13: /*   INPUT PARAMETERS -                                          */
 14: /*      (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR FOR THE GRAPH. */
 15: /*      MASK - SPECIFIES A SECTION SUBGRAPH. NODES FOR WHICH     */
 16: /*             MASK IS ZERO ARE IGNORED BY FN../../...              */
 17: /*   UPDATED PARAMETER -                                        */
 18: /*      ../../.. - ON INPUT, IT (ALONG WITH MASK) DEFINES THE       */
 19: /*             COMPONENT FOR WHICH A PSEUDO-PERIPHERAL NODE IS  */
 20: /*             TO BE FOUND. ON OUTPUT, IT IS THE NODE OBTAINED. */
 21: /*                                                              */
 22: /*   OUTPUT PARAMETERS -                                        */
 23: /*      NLVL - IS THE NUMBER OF LEVELS IN THE LEVEL STRUCTURE   */
 24: /*             ../../..ED AT THE NODE ../../...                         */
 25: /*      (XLS,LS) - THE LEVEL STRUCTURE ARRAY PAIR CONTAINING    */
 26: /*                 THE LEVEL STRUCTURE FOUND.                   */
 27: /*                                                              */
 28: /*   PROGRAM SUBROUTINES -                                      */
 29: /*      ../../..LS.                                                 */
 30: /*                                                              */
 31: /****************************************************************/
 32: int SPARSEPACKfnroot(int *root, int *xadj, int *adjncy, 
 33:         int *mask, int *nlvl, int *xls, int *ls)
 34: {
 35:     /* System generated locals */
 36:     int i__1, i__2;

 38:     /* Local variables */
 39:     int ndeg, node, j, k, nabor, kstop, jstrt, kstrt, mindeg,
 40:             ccsize, nunlvl;
 41:     EXTERN int SPARSEPACKrootls(int *, int *, int *,
 42:             int *, int *, int *, int *);
 43: /*       DETERMINE THE LEVEL STRUCTURE ../../..ED AT ../../... */

 46:     /* Parameter adjustments */
 47:     --ls;
 48:     --xls;
 49:     --mask;
 50:     --adjncy;
 51:     --xadj;

 53:     SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], nlvl, &xls[1], &ls[1]);
 54:     ccsize = xls[*nlvl + 1] - 1;
 55:     if (*nlvl == 1 || *nlvl == ccsize) {
 56:         return(0);
 57:     }
 58: /*       PICK A NODE WITH MINIMUM DEGREE FROM THE LAST LEVEL.*/
 59: L100:
 60:     jstrt = xls[*nlvl];
 61:     mindeg = ccsize;
 62:     *root = ls[jstrt];
 63:     if (ccsize == jstrt) {
 64:         goto L400;
 65:     }
 66:     i__1 = ccsize;
 67:     for (j = jstrt; j <= i__1; ++j) {
 68:         node = ls[j];
 69:         ndeg = 0;
 70:         kstrt = xadj[node];
 71:         kstop = xadj[node + 1] - 1;
 72:         i__2 = kstop;
 73:         for (k = kstrt; k <= i__2; ++k) {
 74:             nabor = adjncy[k];
 75:             if (mask[nabor] > 0) {
 76:                 ++ndeg;
 77:             }
 78:         }
 79:         if (ndeg >= mindeg) {
 80:             goto L300;
 81:         }
 82:         *root = node;
 83:         mindeg = ndeg;
 84: L300:
 85:         ;
 86:     }
 87: /*       AND GENERATE ITS ../../..ED LEVEL STRUCTURE.*/
 88: L400:
 89:     SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], &nunlvl, &xls[1], &ls[1]);
 90:     if (nunlvl <= *nlvl) {
 91:         return(0);
 92:     }
 93:     *nlvl = nunlvl;
 94:     if (*nlvl < ccsize) {
 95:         goto L100;
 96:     }
 97:     return(0);
 98: }