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