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