Actual source code: fnroot.c

      1: #define PETSCMAT_DLL

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

     5:  #include petsc.h

      7: EXTERN PetscErrorCode SPARSEPACKrootls(PetscInt*, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *);

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

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

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

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