1 /* genrcm.f -- translated by f2c (version 19931217).*/ 2 3 #include <petscsys.h> 4 #include <petsc/private/matorderimpl.h> 5 6 /*****************************************************************/ 7 /*****************************************************************/ 8 /********* GENRCM ..... GENERAL REVERSE CUTHILL MCKEE ********/ 9 /*****************************************************************/ 10 11 /* PURPOSE - GENRCM FINDS THE REVERSE CUTHILL-MCKEE*/ 12 /* ORDERING FOR A GENERAL GRAPH. FOR EACH CONNECTED*/ 13 /* COMPONENT IN THE GRAPH, GENRCM OBTAINS THE ORDERING*/ 14 /* BY CALLING THE SUBROUTINE RCM.*/ 15 16 /* INPUT PARAMETERS -*/ 17 /* NEQNS - NUMBER OF EQUATIONS*/ 18 /* (XADJ, ADJNCY) - ARRAY PAIR CONTAINING THE ADJACENCY*/ 19 /* STRUCTURE OF THE GRAPH OF THE MATRIX.*/ 20 21 /* OUTPUT PARAMETER -*/ 22 /* PERM - VECTOR THAT CONTAINS THE RCM ORDERING.*/ 23 24 /* WORKING PARAMETERS -*/ 25 /* MASK - IS USED TO MARK VARIABLES THAT HAVE BEEN*/ 26 /* NUMBERED DURING THE ORDERING PROCESS. IT IS*/ 27 /* INITIALIZED TO 1, AND SET TO ZERO AS EACH NODE*/ 28 /* IS NUMBERED.*/ 29 /* XLS - THE INDEX VECTOR FOR A LEVEL STRUCTURE. THE*/ 30 /* LEVEL STRUCTURE IS STORED IN THE CURRENTLY*/ 31 /* UNUSED SPACES IN THE PERMUTATION VECTOR PERM.*/ 32 33 /* PROGRAM SUBROUTINES -*/ 34 /* FNROOT, RCM.*/ 35 /*****************************************************************/ 36 PetscErrorCode SPARSEPACKgenrcm(const PetscInt *neqns, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *perm, PetscInt *mask, PetscInt *xls) 37 { 38 /* System generated locals */ 39 PetscInt i__1; 40 41 /* Local variables */ 42 PetscInt nlvl, root, i, ccsize; 43 PetscInt num; 44 45 PetscFunctionBegin; 46 if (!*neqns) PetscFunctionReturn(PETSC_SUCCESS); 47 if (*neqns == 1) { 48 perm[0] = 1; 49 mask[0] = 1; 50 xls[0] = 1; 51 PetscFunctionReturn(PETSC_SUCCESS); 52 } 53 54 /* Parameter adjustments */ 55 --xls; 56 --mask; 57 --perm; 58 --adjncy; 59 --xadj; 60 61 i__1 = *neqns; 62 for (i = 1; i <= i__1; ++i) mask[i] = 1; 63 num = 1; 64 i__1 = *neqns; 65 for (i = 1; i <= i__1; ++i) { 66 /* FOR EACH MASKED CONNECTED COMPONENT ...*/ 67 if (!mask[i]) goto L200; 68 root = i; 69 /* FIRST FIND A PSEUDO-PERIPHERAL NODE ROOT.*/ 70 /* NOTE THAT THE LEVEL STRUCTURE FOUND BY*/ 71 /* FNROOT IS STORED STARTING AT PERM(NUM).*/ 72 /* THEN RCM IS CALLED TO ORDER THE COMPONENT*/ 73 /* USING ROOT AS THE STARTING NODE.*/ 74 PetscCall(SPARSEPACKfnroot(&root, &xadj[1], &adjncy[1], &mask[1], &nlvl, &xls[1], &perm[num])); 75 PetscCall(SPARSEPACKrcm(&root, &xadj[1], &adjncy[1], &mask[1], &perm[num], &ccsize, &xls[1])); 76 num += ccsize; 77 if (num > *neqns) PetscFunctionReturn(PETSC_SUCCESS); 78 L200:; 79 } 80 PetscFunctionReturn(PETSC_SUCCESS); 81 } 82