1*8be712e4SBarry Smith /* qmdmrg.f -- translated by f2c (version 19931217).*/ 2*8be712e4SBarry Smith 3*8be712e4SBarry Smith #include <petscsys.h> 4*8be712e4SBarry Smith #include <petsc/private/matorderimpl.h> 5*8be712e4SBarry Smith 6*8be712e4SBarry Smith /******************************************************************/ 7*8be712e4SBarry Smith /*********** QMDMRG ..... QUOT MIN DEG MERGE ************/ 8*8be712e4SBarry Smith /******************************************************************/ 9*8be712e4SBarry Smith /* PURPOSE - THIS ROUTINE MERGES INDISTINGUISHABLE NODES IN */ 10*8be712e4SBarry Smith /* THE MINIMUM DEGREE ORDERING ALGORITHM. */ 11*8be712e4SBarry Smith /* IT ALSO COMPUTES THE NEW DEGREES OF THESE */ 12*8be712e4SBarry Smith /* NEW SUPERNODES. */ 13*8be712e4SBarry Smith /* */ 14*8be712e4SBarry Smith /* INPUT PARAMETERS - */ 15*8be712e4SBarry Smith /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE. */ 16*8be712e4SBarry Smith /* DEG0 - THE NUMBER OF NODES IN THE GIVEN SET. */ 17*8be712e4SBarry Smith /* (NHDSZE, NBRHD) - THE SET OF ELIMINATED SUPERNODES */ 18*8be712e4SBarry Smith /* ADJACENT TO SOME NODES IN THE SET. */ 19*8be712e4SBarry Smith /* */ 20*8be712e4SBarry Smith /* UPDATED PARAMETERS - */ 21*8be712e4SBarry Smith /* DEG - THE DEGREE VECTOR. */ 22*8be712e4SBarry Smith /* QSIZE - SIZE OF INDISTINGUISHABLE NODES. */ 23*8be712e4SBarry Smith /* QLINK - LINKED LIST FOR INDISTINGUISHABLE NODES. */ 24*8be712e4SBarry Smith /* MARKER - THE GIVEN SET IS GIVEN BY THOSE NODES WITH */ 25*8be712e4SBarry Smith /* MARKER VALUE SET TO 1. THOSE NODES WITH DEGREE */ 26*8be712e4SBarry Smith /* UPDATED WILL HAVE MARKER VALUE SET TO 2. */ 27*8be712e4SBarry Smith /* */ 28*8be712e4SBarry Smith /* WORKING PARAMETERS - */ 29*8be712e4SBarry Smith /* RCHSET - THE REACHABLE SET. */ 30*8be712e4SBarry Smith /* OVRLP - TEMP VECTOR TO STORE THE INTERSECTION OF TWO */ 31*8be712e4SBarry Smith /* REACHABLE SETS. */ 32*8be712e4SBarry Smith /* */ 33*8be712e4SBarry Smith /*****************************************************************/ 34*8be712e4SBarry Smith PetscErrorCode SPARSEPACKqmdmrg(const PetscInt *xadj, const PetscInt *adjncy, PetscInt *deg, PetscInt *qsize, PetscInt *qlink, PetscInt *marker, PetscInt *deg0, PetscInt *nhdsze, PetscInt *nbrhd, PetscInt *rchset, PetscInt *ovrlp) 35*8be712e4SBarry Smith { 36*8be712e4SBarry Smith /* System generated locals */ 37*8be712e4SBarry Smith PetscInt i__1, i__2, i__3; 38*8be712e4SBarry Smith 39*8be712e4SBarry Smith /* Local variables */ 40*8be712e4SBarry Smith PetscInt head, inhd, irch, node, mark, ilink, root, j, lnode, nabor, jstop, jstrt, rchsze, mrgsze, novrlp, iov, deg1; 41*8be712e4SBarry Smith 42*8be712e4SBarry Smith PetscFunctionBegin; 43*8be712e4SBarry Smith /* Parameter adjustments */ 44*8be712e4SBarry Smith --ovrlp; 45*8be712e4SBarry Smith --rchset; 46*8be712e4SBarry Smith --nbrhd; 47*8be712e4SBarry Smith --marker; 48*8be712e4SBarry Smith --qlink; 49*8be712e4SBarry Smith --qsize; 50*8be712e4SBarry Smith --deg; 51*8be712e4SBarry Smith --adjncy; 52*8be712e4SBarry Smith --xadj; 53*8be712e4SBarry Smith 54*8be712e4SBarry Smith if (*nhdsze <= 0) PetscFunctionReturn(PETSC_SUCCESS); 55*8be712e4SBarry Smith i__1 = *nhdsze; 56*8be712e4SBarry Smith for (inhd = 1; inhd <= i__1; ++inhd) { 57*8be712e4SBarry Smith root = nbrhd[inhd]; 58*8be712e4SBarry Smith marker[root] = 0; 59*8be712e4SBarry Smith } 60*8be712e4SBarry Smith /* LOOP THROUGH EACH ELIMINATED SUPERNODE IN THE SET */ 61*8be712e4SBarry Smith /* (NHDSZE, NBRHD). */ 62*8be712e4SBarry Smith i__1 = *nhdsze; 63*8be712e4SBarry Smith for (inhd = 1; inhd <= i__1; ++inhd) { 64*8be712e4SBarry Smith root = nbrhd[inhd]; 65*8be712e4SBarry Smith marker[root] = -1; 66*8be712e4SBarry Smith rchsze = 0; 67*8be712e4SBarry Smith novrlp = 0; 68*8be712e4SBarry Smith deg1 = 0; 69*8be712e4SBarry Smith L200: 70*8be712e4SBarry Smith jstrt = xadj[root]; 71*8be712e4SBarry Smith jstop = xadj[root + 1] - 1; 72*8be712e4SBarry Smith /* DETERMINE THE REACHABLE SET AND ITS PETSCINTERSECT- */ 73*8be712e4SBarry Smith /* ION WITH THE INPUT REACHABLE SET. */ 74*8be712e4SBarry Smith i__2 = jstop; 75*8be712e4SBarry Smith for (j = jstrt; j <= i__2; ++j) { 76*8be712e4SBarry Smith nabor = adjncy[j]; 77*8be712e4SBarry Smith root = -nabor; 78*8be712e4SBarry Smith if (nabor < 0) goto L200; 79*8be712e4SBarry Smith else if (!nabor) goto L700; 80*8be712e4SBarry Smith else goto L300; 81*8be712e4SBarry Smith L300: 82*8be712e4SBarry Smith mark = marker[nabor]; 83*8be712e4SBarry Smith if (mark < 0) goto L600; 84*8be712e4SBarry Smith else if (!mark) goto L400; 85*8be712e4SBarry Smith else goto L500; 86*8be712e4SBarry Smith L400: 87*8be712e4SBarry Smith ++rchsze; 88*8be712e4SBarry Smith rchset[rchsze] = nabor; 89*8be712e4SBarry Smith deg1 += qsize[nabor]; 90*8be712e4SBarry Smith marker[nabor] = 1; 91*8be712e4SBarry Smith goto L600; 92*8be712e4SBarry Smith L500: 93*8be712e4SBarry Smith if (mark > 1) goto L600; 94*8be712e4SBarry Smith ++novrlp; 95*8be712e4SBarry Smith ovrlp[novrlp] = nabor; 96*8be712e4SBarry Smith marker[nabor] = 2; 97*8be712e4SBarry Smith L600:; 98*8be712e4SBarry Smith } 99*8be712e4SBarry Smith /* FROM THE OVERLAPPED SET, DETERMINE THE NODES */ 100*8be712e4SBarry Smith /* THAT CAN BE MERGED TOGETHER. */ 101*8be712e4SBarry Smith L700: 102*8be712e4SBarry Smith head = 0; 103*8be712e4SBarry Smith mrgsze = 0; 104*8be712e4SBarry Smith i__2 = novrlp; 105*8be712e4SBarry Smith for (iov = 1; iov <= i__2; ++iov) { 106*8be712e4SBarry Smith node = ovrlp[iov]; 107*8be712e4SBarry Smith jstrt = xadj[node]; 108*8be712e4SBarry Smith jstop = xadj[node + 1] - 1; 109*8be712e4SBarry Smith i__3 = jstop; 110*8be712e4SBarry Smith for (j = jstrt; j <= i__3; ++j) { 111*8be712e4SBarry Smith nabor = adjncy[j]; 112*8be712e4SBarry Smith if (marker[nabor] != 0) goto L800; 113*8be712e4SBarry Smith marker[node] = 1; 114*8be712e4SBarry Smith goto L1100; 115*8be712e4SBarry Smith L800:; 116*8be712e4SBarry Smith } 117*8be712e4SBarry Smith /* NODE BELONGS TO THE NEW MERGED SUPERNODE. */ 118*8be712e4SBarry Smith /* UPDATE THE VECTORS QLINK AND QSIZE. */ 119*8be712e4SBarry Smith mrgsze += qsize[node]; 120*8be712e4SBarry Smith marker[node] = -1; 121*8be712e4SBarry Smith lnode = node; 122*8be712e4SBarry Smith L900: 123*8be712e4SBarry Smith ilink = qlink[lnode]; 124*8be712e4SBarry Smith if (ilink <= 0) goto L1000; 125*8be712e4SBarry Smith lnode = ilink; 126*8be712e4SBarry Smith goto L900; 127*8be712e4SBarry Smith L1000: 128*8be712e4SBarry Smith qlink[lnode] = head; 129*8be712e4SBarry Smith head = node; 130*8be712e4SBarry Smith L1100:; 131*8be712e4SBarry Smith } 132*8be712e4SBarry Smith if (head <= 0) goto L1200; 133*8be712e4SBarry Smith qsize[head] = mrgsze; 134*8be712e4SBarry Smith deg[head] = *deg0 + deg1 - 1; 135*8be712e4SBarry Smith marker[head] = 2; 136*8be712e4SBarry Smith /* RESET MARKER VALUES. */ 137*8be712e4SBarry Smith L1200: 138*8be712e4SBarry Smith root = nbrhd[inhd]; 139*8be712e4SBarry Smith marker[root] = 0; 140*8be712e4SBarry Smith if (rchsze <= 0) goto L1400; 141*8be712e4SBarry Smith i__2 = rchsze; 142*8be712e4SBarry Smith for (irch = 1; irch <= i__2; ++irch) { 143*8be712e4SBarry Smith node = rchset[irch]; 144*8be712e4SBarry Smith marker[node] = 0; 145*8be712e4SBarry Smith } 146*8be712e4SBarry Smith L1400:; 147*8be712e4SBarry Smith } 148*8be712e4SBarry Smith PetscFunctionReturn(PETSC_SUCCESS); 149*8be712e4SBarry Smith } 150