Actual source code: fnroot.c


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

  4: #include <petscsys.h>
  5: #include <petsc/private/matorderimpl.h>

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

 38:   /* Local variables */
 39:   PetscInt ndeg, node, j, k, nabor, kstop, jstrt, kstrt, mindeg, ccsize, nunlvl;
 40:   /*       DETERMINE THE LEVEL STRUCTURE ../../..ED AT ../../... */

 42:   /* Parameter adjustments */
 43:   --ls;
 44:   --xls;
 45:   --mask;
 46:   --adjncy;
 47:   --xadj;

 49:   SPARSEPACKrootls(root, &xadj[1], &adjncy[1], &mask[1], nlvl, &xls[1], &ls[1]);
 50:   ccsize = xls[*nlvl + 1] - 1;
 51:   if (*nlvl == 1 || *nlvl == ccsize) return 0;

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