Actual source code: zgasmf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscksp.h>
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
29: PETSC_EXTERN void pcgasmsetsubdomains_(PC *pc, PetscInt *n, IS *is, IS *isl, int *ierr)
30: {
31: *ierr = PCGASMSetSubdomains(*pc, *n, is, isl);
32: }
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: }
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: }
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: }
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: }
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: }
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: }
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: }
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: }
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: }
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: }