1 /* gennd.f -- translated by f2c (version 19931217).*/ 2 3 #include <petscsys.h> 4 #include <petsc/private/matorderimpl.h> 5 6 PetscErrorCode SPARSEPACKrevrse(const PetscInt *n, PetscInt *perm) 7 { 8 /* System generated locals */ 9 PetscInt i__1; 10 11 /* Local variables */ 12 PetscInt swap, i, m, in; 13 14 PetscFunctionBegin; 15 /* Parameter adjustments */ 16 --perm; 17 18 in = *n; 19 m = *n / 2; 20 i__1 = m; 21 for (i = 1; i <= i__1; ++i) { 22 swap = perm[i]; 23 perm[i] = perm[in]; 24 perm[in] = swap; 25 --in; 26 } 27 PetscFunctionReturn(PETSC_SUCCESS); 28 } 29 30 /*****************************************************************/ 31 /********* GENND ..... GENERAL NESTED DISSECTION *********/ 32 /*****************************************************************/ 33 34 /* PURPOSE - SUBROUTINE GENND FINDS A NESTED DISSECTION*/ 35 /* ORDERING FOR A GENERAL GRAPH.*/ 36 37 /* INPUT PARAMETERS -*/ 38 /* NEQNS - NUMBER OF EQUATIONS.*/ 39 /* (XADJ, ADJNCY) - ADJACENCY STRUCTURE PAIR.*/ 40 41 /* OUTPUT PARAMETERS -*/ 42 /* PERM - THE NESTED DISSECTION ORDERING.*/ 43 44 /* WORKING PARAMETERS -*/ 45 /* MASK - IS USED TO MASK OFF VARIABLES THAT HAVE*/ 46 /* BEEN NUMBERED DURING THE ORDERNG PROCESS.*/ 47 /* (XLS, LS) - THIS LEVEL STRUCTURE PAIR IS USED AS*/ 48 /* TEMPORARY STORAGE BY FNROOT.*/ 49 50 /* PROGRAM SUBROUTINES -*/ 51 /* FNDSEP, REVRSE.*/ 52 /*****************************************************************/ 53 54 PetscErrorCode SPARSEPACKgennd(const PetscInt *neqns, const PetscInt *xadj, const PetscInt *adjncy, PetscInt *mask, PetscInt *perm, PetscInt *xls, PetscInt *ls) 55 { 56 /* System generated locals */ 57 PetscInt i__1; 58 59 /* Local variables */ 60 PetscInt nsep, root, i; 61 PetscInt num; 62 63 PetscFunctionBegin; 64 /* Parameter adjustments */ 65 --ls; 66 --xls; 67 --perm; 68 --mask; 69 --adjncy; 70 --xadj; 71 72 i__1 = *neqns; 73 for (i = 1; i <= i__1; ++i) mask[i] = 1; 74 num = 0; 75 i__1 = *neqns; 76 for (i = 1; i <= i__1; ++i) { 77 /* FOR EACH MASKED COMPONENT ...*/ 78 L200: 79 if (!mask[i]) goto L300; 80 root = i; 81 /* FIND A SEPARATOR AND NUMBER THE NODES NEXT.*/ 82 PetscCall(SPARSEPACKfndsep(&root, &xadj[1], &adjncy[1], &mask[1], &nsep, &perm[num + 1], &xls[1], &ls[1])); 83 num += nsep; 84 if (num >= *neqns) goto L400; 85 goto L200; 86 L300:; 87 } 88 /* SINCE SEPARATORS FOUND FIRST SHOULD BE ORDERED*/ 89 /* LAST, ROUTINE REVRSE IS CALLED TO ADJUST THE*/ 90 /* ORDERING VECTOR.*/ 91 L400: 92 PetscCall(SPARSEPACKrevrse(neqns, &perm[1])); 93 PetscFunctionReturn(PETSC_SUCCESS); 94 } 95