xref: /petsc/src/ksp/pc/impls/gasm/ftn-custom/zgasmf.c (revision 2ae2db358559b5b4e2d021d6074243931b3b092d)
1 #include <petsc/private/ftnimpl.h>
2 #include <petscksp.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5   #define pcgasmdestroysubdomains_  PCGASMDESTROYSUBDOMAINS
6   #define pcgasmgetsubksp_          PCGASMGETSUBKSP
7   #define pcgasmrestoresubksp_      PCGASMRESTORESUBKSP
8   #define pcgasmcreatesubdomains2d_ PCGASMCREATESUBDOMAINS2D
9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
10   #define pcgasmdestroysubdomains_  pcgasmdestroysubdomains
11   #define pcgasmgetsubksp_          pcgasmgetsubksp
12   #define pcgasmrestoresubksp_      pcgasmrestoresubksp
13   #define pcgasmcreatesubdomains2d_ pcgasmcreatesubdomains2d
14 #endif
15 
pcgasmdestroysubdomains_(PetscInt * n,F90Array1d * is1,F90Array1d * is2,int * ierr PETSC_F90_2PTR_PROTO (ptrd1)PETSC_F90_2PTR_PROTO (ptrd2))16 PETSC_EXTERN void pcgasmdestroysubdomains_(PetscInt *n, F90Array1d *is1, F90Array1d *is2, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
17 {
18   IS *isa, *isb;
19 
20   *ierr = F90Array1dAccess(is1, MPIU_FORTRANADDR, (void **)&isa PETSC_F90_2PTR_PARAM(ptrd1));
21   if (*ierr) return;
22   *ierr = F90Array1dAccess(is2, MPIU_FORTRANADDR, (void **)&isb PETSC_F90_2PTR_PARAM(ptrd2));
23   if (*ierr) return;
24   *ierr = F90Array1dDestroy(is1, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd1));
25   if (*ierr) return;
26   *ierr = F90Array1dDestroy(is2, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd2));
27   if (*ierr) return;
28   *ierr = PCGASMDestroySubdomains(*n, &isa, &isb);
29 }
30 
pcgasmcreatesubdomains2d_(PC * pc,PetscInt * m,PetscInt * n,PetscInt * M,PetscInt * N,PetscInt * dof,PetscInt * overlap,PetscInt * Nsub,F90Array1d * is1,F90Array1d * is2,int * ierr PETSC_F90_2PTR_PROTO (ptrd1)PETSC_F90_2PTR_PROTO (ptrd2))31 PETSC_EXTERN void pcgasmcreatesubdomains2d_(PC *pc, PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, F90Array1d *is1, F90Array1d *is2, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
32 {
33   IS *iis, *iisl;
34   *ierr = PCGASMCreateSubdomains2D(*pc, *m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
35   if (*ierr) return;
36   *ierr = F90Array1dCreate(iis, MPIU_FORTRANADDR, 1, *Nsub, is1 PETSC_F90_2PTR_PARAM(ptrd1));
37   if (*ierr) return;
38   *ierr = F90Array1dCreate(iisl, MPIU_FORTRANADDR, 1, *Nsub, is2 PETSC_F90_2PTR_PARAM(ptrd2));
39   if (*ierr) return;
40 }
41 
pcgasmgetsubksp_(PC * pc,PetscInt * n_local,PetscInt * first_local,F90Array1d * ksp,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrd))42 PETSC_EXTERN void pcgasmgetsubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
43 {
44   KSP     *tksp;
45   PetscInt nloc, flocal;
46 
47   CHKFORTRANNULLINTEGER(n_local);
48   CHKFORTRANNULLINTEGER(first_local);
49   *ierr = PCGASMGetSubKSP(*pc, &nloc, &flocal, &tksp);
50   if (n_local) *n_local = nloc;
51   if (first_local) *first_local = flocal;
52   *ierr = F90Array1dCreate(tksp, MPIU_FORTRANADDR, 1, nloc, ksp PETSC_F90_2PTR_PARAM(ptrd));
53 }
54 
pcgasmrestoresubksp_(PC * pc,PetscInt * n_local,PetscInt * first_local,F90Array1d * ksp,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrd))55 PETSC_EXTERN void pcgasmrestoresubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
56 {
57   *ierr = F90Array1dDestroy(ksp, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
58 }
59