Actual source code: qmdqt.c

      1: /* qmdqt.f -- translated by f2c (version 19931217).*/

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

      6: /***************************************************************/
      7: /********     QMDQT  ..... QUOT MIN DEG QUOT TRANSFORM  ********/
      8: /***************************************************************/

     10: /*    PURPOSE - THIS SUBROUTINE PERFORMS THE QUOTIENT GRAPH  */
     11: /*       TRANSFORMATION AFTER A NODE HAS BEEN ELIMINATED.*/

     13: /*    INPUT PARAMETERS -*/
     14: /*       ROOT - THE NODE JUST ELIMINATED. IT BECOMES THE*/
     15: /*              REPRESENTATIVE OF THE NEW SUPERNODE.*/
     16: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE.*/
     17: /*       (RCHSZE, RCHSET) - THE REACHABLE SET OF ROOT IN THE*/
     18: /*              OLD QUOTIENT GRAPH.*/
     19: /*       NBRHD - THE NEIGHBORHOOD SET WHICH WILL BE MERGED*/
     20: /*              WITH ROOT TO FORM THE NEW SUPERNODE.*/
     21: /*       MARKER - THE MARKER VECTOR.*/

     23: /*    UPDATED PARAMETER -*/
     24: /*       ADJNCY - BECOMES THE ADJNCY OF THE QUOTIENT GRAPH.*/
     25: /***************************************************************/
     26: PetscErrorCode SPARSEPACKqmdqt(const PetscInt *root, const PetscInt *xadj, const PetscInt *inadjncy, PetscInt *marker, PetscInt *rchsze, PetscInt *rchset, PetscInt *nbrhd)
     27: {
     28:   PetscInt *adjncy = (PetscInt *)inadjncy; /* Used as temporary and reset within this function */
     29:   /* System generated locals */
     30:   PetscInt i__1, i__2;

     32:   /* Local variables */
     33:   PetscInt inhd, irch, node, ilink, j, nabor, jstop, jstrt;

     35:   PetscFunctionBegin;
     36:   /* Parameter adjustments */
     37:   --nbrhd;
     38:   --rchset;
     39:   --marker;
     40:   --adjncy;
     41:   --xadj;

     43:   irch = 0;
     44:   inhd = 0;
     45:   node = *root;
     46: L100:
     47:   jstrt = xadj[node];
     48:   jstop = xadj[node + 1] - 2;
     49:   if (jstop < jstrt) goto L300;

     51:   /*          PLACE REACH NODES INTO THE ADJACENT LIST OF NODE*/
     52:   i__1 = jstop;
     53:   for (j = jstrt; j <= i__1; ++j) {
     54:     ++irch;
     55:     adjncy[j] = rchset[irch];
     56:     if (irch >= *rchsze) goto L400;
     57:   }
     58: /*       LINK TO OTHER SPACE PROVIDED BY THE NBRHD SET.*/
     59: L300:
     60:   ilink = adjncy[jstop + 1];
     61:   node  = -ilink;
     62:   if (ilink < 0) goto L100;
     63:   ++inhd;
     64:   node              = nbrhd[inhd];
     65:   adjncy[jstop + 1] = -node;
     66:   goto L100;
     67: /*       ALL REACHABLE NODES HAVE BEEN SAVED.  END THE ADJ LIST.*/
     68: /*       ADD ROOT TO THE NBR LIST OF EACH NODE IN THE REACH SET.*/
     69: L400:
     70:   adjncy[j + 1] = 0;
     71:   i__1          = *rchsze;
     72:   for (irch = 1; irch <= i__1; ++irch) {
     73:     node = rchset[irch];
     74:     if (marker[node] < 0) goto L600;

     76:     jstrt = xadj[node];
     77:     jstop = xadj[node + 1] - 1;
     78:     i__2  = jstop;
     79:     for (j = jstrt; j <= i__2; ++j) {
     80:       nabor = adjncy[j];
     81:       if (marker[nabor] >= 0) goto L500;
     82:       adjncy[j] = *root;
     83:       goto L600;
     84:     L500:;
     85:     }
     86:   L600:;
     87:   }
     88:   PetscFunctionReturn(PETSC_SUCCESS);
     89: }