Actual source code: zasmf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscksp.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define pcasmgetsubksp_ PCASMGETSUBKSP
6: #define pcasmrestoresubksp_ PCASMRESTORESUBKSP
7: #define pcasmgetlocalsubmatrices_ PCASMGETLOCALSUBMATRICES
8: #define pcasmgetlocalsubdomains_ PCASMGETLOCALSUBDOMAINS
9: #define pcasmcreatesubdomains_ PCASMCREATESUBDOMAINS
10: #define pcasmdestroysubdomains_ PCASMDESTROYSUBDOMAINS
11: #define pcasmcreatesubdomains2d_ PCASMCREATESUBDOMAINS2D
12: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
13: #define pcasmgetsubksp_ pcasmgetsubksp
14: #define pcasmrestoresubksp_ pcasmrestoresubksp
15: #define pcasmgetlocalsubmatrices_ pcasmgetlocalsubmatrices
16: #define pcasmgetlocalsubdomains_ pcasmgetlocalsubdomains
17: #define pcasmcreatesubdomains_ pcasmcreatesubdomains
18: #define pcasmdestroysubdomains_ pcasmdestroysubdomains
19: #define pcasmcreatesubdomains2d_ pcasmcreatesubdomains2d
20: #endif
22: PETSC_EXTERN void pcasmcreatesubdomains_(Mat *mat, PetscInt n, F90Array1d *is, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd1))
23: {
24: IS *insubs;
26: CHKFORTRANNULLOBJECT(is);
27: *ierr = PCASMCreateSubdomains(*mat, n, &insubs);
28: if (*ierr) return;
29: if (insubs) *ierr = F90Array1dCreate(insubs, MPIU_FORTRANADDR, 1, n, is PETSC_F90_2PTR_PARAM(ptrd1));
30: }
32: PETSC_EXTERN void pcasmgetlocalsubmatrices_(PC *pc, PetscInt *n, F90Array1d *mat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
33: {
34: PetscInt nloc;
35: Mat *tmat;
37: CHKFORTRANNULLOBJECT(mat);
38: CHKFORTRANNULLINTEGER(n);
39: *ierr = PCASMGetLocalSubmatrices(*pc, &nloc, &tmat);
40: if (n) *n = nloc;
41: if (mat) *ierr = F90Array1dCreate(tmat, MPIU_FORTRANADDR, 1, nloc, mat PETSC_F90_2PTR_PARAM(ptrd));
42: }
44: PETSC_EXTERN void pcasmgetlocalsubdomains_(PC *pc, PetscInt *n, F90Array1d *is, F90Array1d *is_local, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
45: {
46: PetscInt nloc;
47: IS *tis, *tis_local;
49: CHKFORTRANNULLOBJECT(is);
50: CHKFORTRANNULLOBJECT(is_local);
51: CHKFORTRANNULLINTEGER(n);
52: *ierr = PCASMGetLocalSubdomains(*pc, &nloc, &tis, &tis_local);
53: if (*ierr) return;
54: if (n) *n = nloc;
55: if (is) *ierr = F90Array1dCreate(tis, MPIU_FORTRANADDR, 1, nloc, is PETSC_F90_2PTR_PARAM(ptrd1));
56: if (*ierr) return;
57: if (is_local) *ierr = F90Array1dCreate(tis_local, MPIU_FORTRANADDR, 1, nloc, is_local PETSC_F90_2PTR_PARAM(ptrd2));
58: if (*ierr) return;
59: }
61: PETSC_EXTERN void pcasmdestroysubdomains_(PetscInt *n, F90Array1d *is1, F90Array1d *is2, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
62: {
63: IS *isa, *isb;
65: *ierr = F90Array1dAccess(is1, MPIU_FORTRANADDR, (void **)&isa PETSC_F90_2PTR_PARAM(ptrd1));
66: if (*ierr) return;
67: *ierr = F90Array1dAccess(is2, MPIU_FORTRANADDR, (void **)&isb PETSC_F90_2PTR_PARAM(ptrd2));
68: if (*ierr) return;
69: *ierr = PCASMDestroySubdomains(*n, &isa, &isb);
70: if (*ierr) return;
71: *ierr = F90Array1dDestroy(is1, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd1));
72: if (*ierr) return;
73: *ierr = F90Array1dDestroy(is2, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd2));
74: if (*ierr) return;
75: }
77: PETSC_EXTERN void pcasmcreatesubdomains2d_(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))
78: {
79: IS *iis, *iisl;
81: *ierr = PCASMCreateSubdomains2D(*m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
82: if (*ierr) return;
83: *ierr = F90Array1dCreate(iis, MPIU_FORTRANADDR, 1, *Nsub, is1 PETSC_F90_2PTR_PARAM(ptrd1));
84: if (*ierr) return;
85: *ierr = F90Array1dCreate(iisl, MPIU_FORTRANADDR, 1, *Nsub, is2 PETSC_F90_2PTR_PARAM(ptrd2));
86: if (*ierr) return;
87: }
89: PETSC_EXTERN void pcasmgetsubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
90: {
91: KSP *tksp;
92: PetscInt nloc, flocal;
94: CHKFORTRANNULLINTEGER(n_local);
95: CHKFORTRANNULLINTEGER(first_local);
96: *ierr = PCASMGetSubKSP(*pc, &nloc, &flocal, &tksp);
97: if (n_local) *n_local = nloc;
98: if (first_local) *first_local = flocal;
99: *ierr = F90Array1dCreate(tksp, MPIU_FORTRANADDR, 1, nloc, ksp PETSC_F90_2PTR_PARAM(ptrd));
100: }
102: PETSC_EXTERN void pcasmrestoresubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
103: {
104: *ierr = F90Array1dDestroy(ksp, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
105: }