Actual source code: qmdqt.c

      1: #define PETSCMAT_DLL

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

     5:  #include petsc.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: /***************************************************************/
     29: PetscErrorCode SPARSEPACKqmdqt(PetscInt *root, PetscInt *xadj, PetscInt *adjncy,
     30:         PetscInt *marker, PetscInt *rchsze, PetscInt *rchset, PetscInt *nbrhd)
     31: {
     32:     /* System generated locals */
     33:     PetscInt i__1, i__2;

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

     39:     /* Parameter adjustments */
     40:     --nbrhd;
     41:     --rchset;
     42:     --marker;
     43:     --adjncy;
     44:     --xadj;

     46:     irch = 0;
     47:     inhd = 0;
     48:     node = *root;
     49: L100:
     50:     jstrt = xadj[node];
     51:     jstop = xadj[node + 1] - 2;
     52:     if (jstop < jstrt) {
     53:         goto L300;
     54:     }
     55: /*          PLACE REACH NODES INTO THE ADJACENT LIST OF NODE*/
     56:     i__1 = jstop;
     57:     for (j = jstrt; j <= i__1; ++j) {
     58:         ++irch;
     59:         adjncy[j] = rchset[irch];
     60:         if (irch >= *rchsze) {
     61:             goto L400;
     62:         }
     63:     }
     64: /*       LINK TO OTHER SPACE PROVIDED BY THE NBRHD SET.*/
     65: L300:
     66:     ilink = adjncy[jstop + 1];
     67:     node = -ilink;
     68:     if (ilink < 0) {
     69:         goto L100;
     70:     }
     71:     ++inhd;
     72:     node = nbrhd[inhd];
     73:     adjncy[jstop + 1] = -node;
     74:     goto L100;
     75: /*       ALL REACHABLE NODES HAVE BEEN SAVED.  END THE ADJ LIST.*/
     76: /*       ADD ../../.. TO THE NBR LIST OF EACH NODE IN THE REACH SET.*/
     77: L400:
     78:     adjncy[j + 1] = 0;
     79:     i__1 = *rchsze;
     80:     for (irch = 1; irch <= i__1; ++irch) {
     81:         node = rchset[irch];
     82:         if (marker[node] < 0) {
     83:             goto L600;
     84:         }
     85:         jstrt = xadj[node];
     86:         jstop = xadj[node + 1] - 1;
     87:         i__2 = jstop;
     88:         for (j = jstrt; j <= i__2; ++j) {
     89:             nabor = adjncy[j];
     90:             if (marker[nabor] >= 0) {
     91:                 goto L500;
     92:             }
     93:             adjncy[j] = *root;
     94:             goto L600;
     95: L500:
     96:             ;
     97:         }
     98: L600:
     99:         ;
    100:     }
    101:     return(0);
    102: }