1*8be712e4SBarry Smith /* qmdrch.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 /********** QMDRCH ..... QUOT MIN DEG REACH SET ***********/ 8*8be712e4SBarry Smith /*****************************************************************/ 9*8be712e4SBarry Smith 10*8be712e4SBarry Smith /* PURPOSE - THIS SUBROUTINE DETERMINES THE REACHABLE SET OF*/ 11*8be712e4SBarry Smith /* A NODE THROUGH A GIVEN SUBSET. THE ADJACENCY STRUCTURE*/ 12*8be712e4SBarry Smith /* IS ASSUMED TO BE STORED IN A QUOTIENT GRAPH FORMAT.*/ 13*8be712e4SBarry Smith 14*8be712e4SBarry Smith /* INPUT PARAMETERS -*/ 15*8be712e4SBarry Smith /* ROOT - THE GIVEN NODE NOT IN THE SUBSET.*/ 16*8be712e4SBarry Smith /* (XADJ, ADJNCY) - THE ADJACENCY STRUCTURE PAIR.*/ 17*8be712e4SBarry Smith /* DEG - THE DEGREE VECTOR. DEG(I) LT 0 MEANS THE NODE*/ 18*8be712e4SBarry Smith /* BELONGS TO THE GIVEN SUBSET.*/ 19*8be712e4SBarry Smith 20*8be712e4SBarry Smith /* OUTPUT PARAMETERS -*/ 21*8be712e4SBarry Smith /* (RCHSZE, RCHSET) - THE REACHABLE SET.*/ 22*8be712e4SBarry Smith /* (NHDSZE, NBRHD) - THE NEIGHBORHOOD SET.*/ 23*8be712e4SBarry Smith 24*8be712e4SBarry Smith /* UPDATED PARAMETERS -*/ 25*8be712e4SBarry Smith /* MARKER - THE MARKER VECTOR FOR REACH AND NBRHD SETS.*/ 26*8be712e4SBarry Smith /* GT 0 MEANS THE NODE IS IN REACH SET.*/ 27*8be712e4SBarry Smith /* LT 0 MEANS THE NODE HAS BEEN MERGED WITH*/ 28*8be712e4SBarry Smith /* OTHERS IN THE QUOTIENT OR IT IS IN NBRHD SET.*/ 29*8be712e4SBarry Smith /*****************************************************************/ 30*8be712e4SBarry Smith PetscErrorCode SPARSEPACKqmdrch(const PetscInt *root, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *deg, PetscInt *marker, PetscInt *rchsze, PetscInt *rchset, PetscInt *nhdsze, PetscInt *nbrhd) 31*8be712e4SBarry Smith { 32*8be712e4SBarry Smith /* System generated locals */ 33*8be712e4SBarry Smith PetscInt i__1, i__2; 34*8be712e4SBarry Smith 35*8be712e4SBarry Smith /* Local variables */ 36*8be712e4SBarry Smith PetscInt node, i, j, nabor, istop, jstop, istrt, jstrt; 37*8be712e4SBarry Smith 38*8be712e4SBarry Smith /* LOOP THROUGH THE NEIGHBORS OF ROOT IN THE*/ 39*8be712e4SBarry Smith /* QUOTIENT GRAPH.*/ 40*8be712e4SBarry Smith 41*8be712e4SBarry Smith PetscFunctionBegin; 42*8be712e4SBarry Smith /* Parameter adjustments */ 43*8be712e4SBarry Smith --nbrhd; 44*8be712e4SBarry Smith --rchset; 45*8be712e4SBarry Smith --marker; 46*8be712e4SBarry Smith --deg; 47*8be712e4SBarry Smith --adjncy; 48*8be712e4SBarry Smith --xadj; 49*8be712e4SBarry Smith 50*8be712e4SBarry Smith *nhdsze = 0; 51*8be712e4SBarry Smith *rchsze = 0; 52*8be712e4SBarry Smith istrt = xadj[*root]; 53*8be712e4SBarry Smith istop = xadj[*root + 1] - 1; 54*8be712e4SBarry Smith if (istop < istrt) PetscFunctionReturn(PETSC_SUCCESS); 55*8be712e4SBarry Smith i__1 = istop; 56*8be712e4SBarry Smith for (i = istrt; i <= i__1; ++i) { 57*8be712e4SBarry Smith nabor = adjncy[i]; 58*8be712e4SBarry Smith if (!nabor) PetscFunctionReturn(PETSC_SUCCESS); 59*8be712e4SBarry Smith if (marker[nabor] != 0) goto L600; 60*8be712e4SBarry Smith if (deg[nabor] < 0) goto L200; 61*8be712e4SBarry Smith 62*8be712e4SBarry Smith /* INCLUDE NABOR INTO THE REACHABLE SET.*/ 63*8be712e4SBarry Smith ++(*rchsze); 64*8be712e4SBarry Smith rchset[*rchsze] = nabor; 65*8be712e4SBarry Smith marker[nabor] = 1; 66*8be712e4SBarry Smith goto L600; 67*8be712e4SBarry Smith /* NABOR HAS BEEN ELIMINATED. FIND NODES*/ 68*8be712e4SBarry Smith /* REACHABLE FROM IT.*/ 69*8be712e4SBarry Smith L200: 70*8be712e4SBarry Smith marker[nabor] = -1; 71*8be712e4SBarry Smith ++(*nhdsze); 72*8be712e4SBarry Smith nbrhd[*nhdsze] = nabor; 73*8be712e4SBarry Smith L300: 74*8be712e4SBarry Smith jstrt = xadj[nabor]; 75*8be712e4SBarry Smith jstop = xadj[nabor + 1] - 1; 76*8be712e4SBarry Smith i__2 = jstop; 77*8be712e4SBarry Smith for (j = jstrt; j <= i__2; ++j) { 78*8be712e4SBarry Smith node = adjncy[j]; 79*8be712e4SBarry Smith nabor = -node; 80*8be712e4SBarry Smith if (node < 0) goto L300; 81*8be712e4SBarry Smith else if (!node) goto L600; 82*8be712e4SBarry Smith else goto L400; 83*8be712e4SBarry Smith L400: 84*8be712e4SBarry Smith if (marker[node] != 0) goto L500; 85*8be712e4SBarry Smith ++(*rchsze); 86*8be712e4SBarry Smith rchset[*rchsze] = node; 87*8be712e4SBarry Smith marker[node] = 1; 88*8be712e4SBarry Smith L500:; 89*8be712e4SBarry Smith } 90*8be712e4SBarry Smith L600:; 91*8be712e4SBarry Smith } 92*8be712e4SBarry Smith PetscFunctionReturn(PETSC_SUCCESS); 93*8be712e4SBarry Smith } 94