1 #include <petsc/private/fortranimpl.h> 2 #include <petscksp.h> 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define pcgasmdestroysubdomains_ PCGASMDESTROYSUBDOMAINS 6 #define pcgasmgetsubksp1_ PCGASMGETSUBKSP1 7 #define pcgasmgetsubksp2_ PCGASMGETSUBKSP2 8 #define pcgasmgetsubksp3_ PCGASMGETSUBKSP3 9 #define pcgasmgetsubksp4_ PCGASMGETSUBKSP4 10 #define pcgasmgetsubksp5_ PCGASMGETSUBKSP5 11 #define pcgasmgetsubksp6_ PCGASMGETSUBKSP6 12 #define pcgasmgetsubksp7_ PCGASMGETSUBKSP7 13 #define pcgasmgetsubksp8_ PCGASMGETSUBKSP8 14 #define pcgasmcreatesubdomains2d_ PCGASMCREATESUBDOMAINS2D 15 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 16 #define pcgasmdestroysubdomains_ pcgasmdestroysubdomains 17 #define pcgasmgetsubksp2_ pcgasmgetsubksp2 18 #define pcgasmgetsubksp3_ pcgasmgetsubksp3 19 #define pcgasmgetsubksp4_ pcgasmgetsubksp4 20 #define pcgasmgetsubksp5_ pcgasmgetsubksp5 21 #define pcgasmgetsubksp6_ pcgasmgetsubksp6 22 #define pcgasmgetsubksp7_ pcgasmgetsubksp7 23 #define pcgasmgetsubksp8_ pcgasmgetsubksp8 24 #define pcgasmcreatesubdomains2d_ pcgasmcreatesubdomains2d 25 #endif 26 27 PETSC_EXTERN void pcgasmdestroysubdomains_(PetscInt *n, IS *is, IS *isl, int *ierr) 28 { 29 IS *iis, *iisl; 30 *ierr = PetscMalloc1(*n, &iis); 31 if (*ierr) return; 32 *ierr = PetscArraycpy(iis, is, *n); 33 if (*ierr) return; 34 *ierr = PetscMalloc1(*n, &iisl); 35 if (*ierr) return; 36 *ierr = PetscArraycpy(iisl, isl, *n); 37 *ierr = PCGASMDestroySubdomains(*n, &iis, &iisl); 38 } 39 40 PETSC_EXTERN void pcgasmcreatesubdomains2d_(PC *pc, PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, IS *is, IS *isl, int *ierr) 41 { 42 IS *iis, *iisl; 43 *ierr = PCGASMCreateSubdomains2D(*pc, *m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl); 44 if (*ierr) return; 45 *ierr = PetscArraycpy(is, iis, *Nsub); 46 if (*ierr) return; 47 *ierr = PetscArraycpy(isl, iisl, *Nsub); 48 if (*ierr) return; 49 *ierr = PetscFree(iis); 50 if (*ierr) return; 51 *ierr = PetscFree(iisl); 52 } 53 54 PETSC_EXTERN void pcgasmgetsubksp1_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 55 { 56 KSP *tksp; 57 PetscInt i, nloc; 58 CHKFORTRANNULLINTEGER(n_local); 59 CHKFORTRANNULLINTEGER(first_local); 60 CHKFORTRANNULLOBJECT(ksp); 61 *ierr = PCGASMGetSubKSP(*pc, &nloc, first_local, &tksp); 62 if (n_local) *n_local = nloc; 63 if (ksp) { 64 for (i = 0; i < nloc; i++) ksp[i] = tksp[i]; 65 } 66 } 67 68 PETSC_EXTERN void pcgasmgetsubksp2_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 69 { 70 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 71 } 72 73 PETSC_EXTERN void pcgasmgetsubksp3_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 74 { 75 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 76 } 77 78 PETSC_EXTERN void pcgasmgetsubksp4_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 79 { 80 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 81 } 82 83 PETSC_EXTERN void pcgasmgetsubksp5_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 84 { 85 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 86 } 87 88 PETSC_EXTERN void pcgasmgetsubksp6_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 89 { 90 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 91 } 92 93 PETSC_EXTERN void pcgasmgetsubksp7_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 94 { 95 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 96 } 97 98 PETSC_EXTERN void pcgasmgetsubksp8_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr) 99 { 100 pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr); 101 } 102