Actual source code: zasmf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscksp.h>
4: #if PetscDefined(HAVE_FORTRAN_CAPS)
5: #define pcasmgetsubksp_ PCASMGETSUBKSP
6: #define pcasmrestoresubksp_ PCASMRESTORESUBKSP
7: #define pcasmgetlocalsubmatrices_ PCASMGETLOCALSUBMATRICES
8: #define pcasmgetlocalsubdomains_ PCASMGETLOCALSUBDOMAINS
9: #define pcasmweightedgetscaling_ PCASMWEIGHTEDGETSCALING
10: #define pcasmweightedsetcomputescaling_ PCASMWEIGHTEDSETCOMPUTESCALING
11: #define pcasmcreatesubdomains_ PCASMCREATESUBDOMAINS
12: #define pcasmdestroysubdomains_ PCASMDESTROYSUBDOMAINS
13: #define pcasmcreatesubdomains2d_ PCASMCREATESUBDOMAINS2D
14: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
15: #define pcasmgetsubksp_ pcasmgetsubksp
16: #define pcasmrestoresubksp_ pcasmrestoresubksp
17: #define pcasmgetlocalsubmatrices_ pcasmgetlocalsubmatrices
18: #define pcasmgetlocalsubdomains_ pcasmgetlocalsubdomains
19: #define pcasmweightedgetscaling_ pcasmweightedgetscaling
20: #define pcasmweightedsetcomputescaling_ pcasmweightedsetcomputescaling
21: #define pcasmcreatesubdomains_ pcasmcreatesubdomains
22: #define pcasmdestroysubdomains_ pcasmdestroysubdomains
23: #define pcasmcreatesubdomains2d_ pcasmcreatesubdomains2d
24: #endif
26: PETSC_EXTERN void pcasmcreatesubdomains_(Mat *A, PetscInt *n, F90Array1d *outis, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd1))
27: {
28: IS *insubs;
30: if (FORTRANNULLISPOINTER(outis)) {
31: *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_NULL, PETSC_ERROR_INITIAL, "PCASMCreateSubdomains() requires an output array; do not use PETSC_NULL_IS_POINTER");
32: return;
33: }
34: *ierr = PCASMCreateSubdomains(*A, *n, &insubs);
35: if (*ierr) return;
36: *ierr = F90Array1dCreate(insubs, MPIU_FORTRANADDR, 1, *n, outis PETSC_F90_2PTR_PARAM(ptrd1));
37: }
39: PETSC_EXTERN void pcasmgetlocalsubmatrices_(PC *pc, PetscInt *n, F90Array1d *mat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
40: {
41: PetscInt nloc;
42: Mat *tmat;
44: CHKFORTRANNULLINTEGER(n);
45: *ierr = PCASMGetLocalSubmatrices(*pc, &nloc, &tmat);
46: if (*ierr) return;
47: if (n) *n = nloc;
48: if (FORTRANNULLMATPOINTER(mat)) return;
49: if (tmat) *ierr = F90Array1dCreate(tmat, MPIU_FORTRANADDR, 1, nloc, mat PETSC_F90_2PTR_PARAM(ptrd));
50: else f90array1ddestroyfortranaddr_(mat PETSC_F90_2PTR_PARAM(ptrd));
51: }
53: PETSC_EXTERN void pcasmweightedgetscaling_(PC *pc, PetscInt *n, F90Array1d *scaling, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
54: {
55: PetscInt nloc;
56: Vec *tscaling;
58: CHKFORTRANNULLINTEGER(n);
59: *ierr = PCASMWeightedGetScaling(*pc, &nloc, &tscaling);
60: if (*ierr) return;
61: if (n) *n = nloc;
62: if (tscaling) *ierr = F90Array1dCreate(tscaling, MPIU_FORTRANADDR, 1, nloc, scaling PETSC_F90_2PTR_PARAM(ptrd));
63: else f90array1ddestroyfortranaddr_(scaling PETSC_F90_2PTR_PARAM(ptrd));
64: }
66: static struct {
67: PetscFortranCallbackId computescaling;
68: } _cb;
70: static PetscErrorCode ourcomputescaling(PC pc, PetscInt local, Vec scaling, PETSC_UNUSED PetscCtx ctx)
71: {
72: PetscObjectUseFortranCallbackSubType(pc, _cb.computescaling, (PC *, PetscInt *, Vec *, void *, PetscErrorCode *), (&pc, &local, &scaling, _ctx, &ierr));
73: }
75: PETSC_EXTERN void pcasmweightedsetcomputescaling_(PC *pc, void (*fn)(PC *, PetscInt *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
76: {
77: CHKFORTRANNULLFUNCTION(fn);
78: if (!fn) {
79: *ierr = PCASMWeightedSetComputeScaling(*pc, NULL, NULL);
80: return;
81: }
82: *ierr = PetscObjectSetFortranCallback((PetscObject)*pc, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.computescaling, (PetscFortranCallbackFn *)fn, ctx);
83: if (*ierr) return;
84: *ierr = PCASMWeightedSetComputeScaling(*pc, ourcomputescaling, NULL);
85: }
87: 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))
88: {
89: PetscInt nloc;
90: IS *tis, *tis_local;
92: CHKFORTRANNULLINTEGER(n);
93: *ierr = PCASMGetLocalSubdomains(*pc, &nloc, &tis, &tis_local);
94: if (*ierr) return;
95: if (n) *n = nloc;
96: if (!FORTRANNULLISPOINTER(is)) {
97: if (tis) *ierr = F90Array1dCreate(tis, MPIU_FORTRANADDR, 1, nloc, is PETSC_F90_2PTR_PARAM(ptrd1));
98: else f90array1ddestroyfortranaddr_(is PETSC_F90_2PTR_PARAM(ptrd1));
99: }
100: if (*ierr) return;
101: if (!FORTRANNULLISPOINTER(is_local)) {
102: if (tis_local) *ierr = F90Array1dCreate(tis_local, MPIU_FORTRANADDR, 1, nloc, is_local PETSC_F90_2PTR_PARAM(ptrd2));
103: else f90array1ddestroyfortranaddr_(is_local PETSC_F90_2PTR_PARAM(ptrd2));
104: }
105: }
107: PETSC_EXTERN void pcasmdestroysubdomains_(PetscInt *n, F90Array1d *is, F90Array1d *is_local, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
108: {
109: IS *isa, *isb = NULL;
110: PetscBool has_local = PetscNot(FORTRANNULLISPOINTER(is_local));
112: if (FORTRANNULLISPOINTER(is)) {
113: *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_NULL, PETSC_ERROR_INITIAL, "PCASMDestroySubdomains() requires the subdomain array; do not use PETSC_NULL_IS_POINTER");
114: return;
115: }
116: *ierr = F90Array1dAccess(is, MPIU_FORTRANADDR, (void **)&isa PETSC_F90_2PTR_PARAM(ptrd1));
117: if (*ierr) return;
118: if (has_local) {
119: *ierr = F90Array1dAccess(is_local, MPIU_FORTRANADDR, (void **)&isb PETSC_F90_2PTR_PARAM(ptrd2));
120: if (*ierr) return;
121: }
122: *ierr = PCASMDestroySubdomains(*n, &isa, has_local ? &isb : NULL);
123: if (*ierr) return;
124: *ierr = F90Array1dDestroy(is, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd1));
125: if (*ierr) return;
126: if (has_local) *ierr = F90Array1dDestroy(is_local, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd2));
127: }
129: PETSC_EXTERN void pcasmcreatesubdomains2d_(PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, F90Array1d *is, F90Array1d *is_local, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
130: {
131: IS *iis, *iisl;
133: if (FORTRANNULLISPOINTER(is) || FORTRANNULLISPOINTER(is_local)) {
134: *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_NULL, PETSC_ERROR_INITIAL, "PCASMCreateSubdomains2D() requires both output arrays; do not use PETSC_NULL_IS_POINTER");
135: return;
136: }
137: *ierr = PCASMCreateSubdomains2D(*m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
138: if (*ierr) return;
139: *ierr = F90Array1dCreate(iis, MPIU_FORTRANADDR, 1, *Nsub, is PETSC_F90_2PTR_PARAM(ptrd1));
140: if (*ierr) return;
141: *ierr = F90Array1dCreate(iisl, MPIU_FORTRANADDR, 1, *Nsub, is_local PETSC_F90_2PTR_PARAM(ptrd2));
142: if (*ierr) return;
143: }
145: PETSC_EXTERN void pcasmgetsubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
146: {
147: KSP *tksp;
148: PetscInt nloc, flocal;
150: CHKFORTRANNULLINTEGER(n_local);
151: CHKFORTRANNULLINTEGER(first_local);
152: *ierr = PCASMGetSubKSP(*pc, &nloc, first_local ? &flocal : NULL, &tksp);
153: if (*ierr) return;
154: if (n_local) *n_local = nloc;
155: if (first_local) *first_local = flocal;
156: if (FORTRANNULLKSPPOINTER(ksp)) return;
157: *ierr = F90Array1dCreate(tksp, MPIU_FORTRANADDR, 1, nloc, ksp PETSC_F90_2PTR_PARAM(ptrd));
158: }
160: PETSC_EXTERN void pcasmrestoresubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
161: {
162: *ierr = PETSC_SUCCESS;
163: if (FORTRANNULLKSPPOINTER(ksp)) return;
164: *ierr = F90Array1dDestroy(ksp, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
165: }