Actual source code: qmdqt.c


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

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

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

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

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

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

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

 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 ../../.. 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:   return 0;
 89: }