Actual source code: qmdupd.c

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

 3:  #include petsc.h

  5: /******************************************************************/
  6: /***********     QMDUPD ..... QUOT MIN DEG UPDATE      ************/
  7: /******************************************************************/
  8: /******************************************************************/

 10: /*    PURPOSE - THIS ROUTINE PERFORMS DEGREE UPDATE FOR A SET*/
 11: /*       OF NODES IN THE MINIMUM DEGREE ALGORITHM.*/

 13: /*    INPUT PARAMETERS -*/
 14: /*       (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE.*/
 15: /*       (NLIST, LIST) - THE LIST OF NODES WHOSE DEGREE HAS TO*/
 16: /*              BE UPDATED.*/

 18: /*    UPDATED PARAMETERS -*/
 19: /*       DEG - THE DEGREE VECTOR.*/
 20: /*       QSIZE - SIZE OF INDISTINGUISHABLE SUPERNODES.*/
 21: /*       QLINK - LINKED LIST FOR INDISTINGUISHABLE NODES.*/
 22: /*       MARKER - USED TO MARK THOSE NODES IN REACH/NBRHD SETS.*/

 24: /*    WORKING PARAMETERS -*/
 25: /*       RCHSET - THE REACHABLE SET.*/
 26: /*       NBRHD -  THE NEIGHBORHOOD SET.*/

 28: /*    PROGRAM SUBROUTINES -*/
 29: /*       QMDMRG.*/
 30: /******************************************************************/
 33: PetscErrorCode SPARSEPACKqmdupd(PetscInt *xadj, PetscInt *adjncy, PetscInt *nlist, 
 34:         PetscInt *list, PetscInt *deg, PetscInt *qsize, PetscInt *qlink, PetscInt *
 35:         marker, PetscInt *rchset, PetscInt *nbrhd)
 36: {
 37:     /* System generated locals */
 38:     PetscInt i__1, i__2;

 40:     /* Local variables */
 41:     PetscInt inhd, irch, node, mark, j, inode, nabor, jstop, jstrt, il;
 42:     EXTERN PetscErrorCode SPARSEPACKqmdrch(PetscInt*, PetscInt *, PetscInt *,
 43:             PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *),
 44:              SPARSEPACKqmdmrg(PetscInt*, PetscInt *, PetscInt *, PetscInt *, PetscInt *,
 45:             PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *);
 46:     PetscInt nhdsze, rchsze, deg0, deg1;

 48: /*       FIND ALL ELIMINATED SUPERNODES THAT ARE ADJACENT*/
 49: /*       TO SOME NODES IN THE GIVEN LIST. PUT THEM INTO.*/
 50: /*       (NHDSZE, NBRHD). DEG0 CONTAINS THE NUMBER OF*/
 51: /*       NODES IN THE LIST.*/


 55:     /* Parameter adjustments */
 56:     --nbrhd;
 57:     --rchset;
 58:     --marker;
 59:     --qlink;
 60:     --qsize;
 61:     --deg;
 62:     --list;
 63:     --adjncy;
 64:     --xadj;

 66:     if (*nlist <= 0) {
 67:         return(0);
 68:     }
 69:     deg0 = 0;
 70:     nhdsze = 0;
 71:     i__1 = *nlist;
 72:     for (il = 1; il <= i__1; ++il) {
 73:         node = list[il];
 74:         deg0 += qsize[node];
 75:         jstrt = xadj[node];
 76:         jstop = xadj[node + 1] - 1;
 77:         i__2 = jstop;
 78:         for (j = jstrt; j <= i__2; ++j) {
 79:             nabor = adjncy[j];
 80:             if (marker[nabor] != 0 || deg[nabor] >= 0) {
 81:                 goto L100;
 82:             }
 83:             marker[nabor] = -1;
 84:             ++nhdsze;
 85:             nbrhd[nhdsze] = nabor;
 86: L100:
 87:             ;
 88:         }
 89:     }
 90: /*       MERGE INDISTINGUISHABLE NODES IN THE LIST BY*/
 91: /*       CALLING THE SUBROUTINE QMDMRG.*/
 92:     if (nhdsze > 0) {
 93:         SPARSEPACKqmdmrg(&xadj[1], &adjncy[1], &deg[1], &qsize[1], &qlink[1], &marker[
 94:                 1], &deg0, &nhdsze, &nbrhd[1], &rchset[1], &nbrhd[nhdsze + 1]);
 95:     }
 96: /*       FIND THE NEW DEGREES OF THE NODES THAT HAVE NOT BEEN*/
 97: /*       MERGED.*/
 98:     i__1 = *nlist;
 99:     for (il = 1; il <= i__1; ++il) {
100:         node = list[il];
101:         mark = marker[node];
102:         if (mark > 1 || mark < 0) {
103:             goto L600;
104:         }
105:         marker[node] = 2;
106:         SPARSEPACKqmdrch(&node, &xadj[1], &adjncy[1], &deg[1], &marker[1], &rchsze, &
107:                 rchset[1], &nhdsze, &nbrhd[1]);
108:         deg1 = deg0;
109:         if (rchsze <= 0) {
110:             goto L400;
111:         }
112:         i__2 = rchsze;
113:         for (irch = 1; irch <= i__2; ++irch) {
114:             inode = rchset[irch];
115:             deg1 += qsize[inode];
116:             marker[inode] = 0;
117:         }
118: L400:
119:         deg[node] = deg1 - 1;
120:         if (nhdsze <= 0) {
121:             goto L600;
122:         }
123:         i__2 = nhdsze;
124:         for (inhd = 1; inhd <= i__2; ++inhd) {
125:             inode = nbrhd[inhd];
126:             marker[inode] = 0;
127:         }
128: L600:
129:         ;
130:     }
131:     return(0);
132: }