Actual source code: zasmf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscksp.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define pcasmgetsubksp1_ PCASMGETSUBKSP1
6: #define pcasmgetsubksp2_ PCASMGETSUBKSP2
7: #define pcasmgetsubksp3_ PCASMGETSUBKSP3
8: #define pcasmgetsubksp4_ PCASMGETSUBKSP4
9: #define pcasmgetsubksp5_ PCASMGETSUBKSP5
10: #define pcasmgetsubksp6_ PCASMGETSUBKSP6
11: #define pcasmgetsubksp7_ PCASMGETSUBKSP7
12: #define pcasmgetsubksp8_ PCASMGETSUBKSP8
13: #define pcasmsetlocalsubdomains_ PCASMSETLOCALSUBDOMAINS
14: #define pcasmsetglobalsubdomains_ PCASMSETGLOBALSUBDOMAINS
15: #define pcasmgetlocalsubmatrices_ PCASMGETLOCALSUBMATRICES
16: #define pcasmgetlocalsubdomains_ PCASMGETLOCALSUBDOMAINS
17: #define pcasmcreatesubdomains_ PCASMCREATESUBDOMAINS
18: #define pcasmdestroysubdomains_ PCASMDESTROYSUBDOMAINS
19: #define pcasmcreatesubdomains2d_ PCASMCREATESUBDOMAINS2D
20: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
21: #define pcasmgetsubksp1_ pcasmgetsubksp1
22: #define pcasmgetsubksp2_ pcasmgetsubksp2
23: #define pcasmgetsubksp3_ pcasmgetsubksp3
24: #define pcasmgetsubksp4_ pcasmgetsubksp4
25: #define pcasmgetsubksp5_ pcasmgetsubksp5
26: #define pcasmgetsubksp6_ pcasmgetsubksp6
27: #define pcasmgetsubksp7_ pcasmgetsubksp7
28: #define pcasmgetsubksp8_ pcasmgetsubksp8
29: #define pcasmsetlocalsubdomains_ pcasmsetlocalsubdomains
30: #define pcasmsetglobalsubdomains_ pcasmsetglobalsubdomains
31: #define pcasmgetlocalsubmatrices_ pcasmgetlocalsubmatrices
32: #define pcasmgetlocalsubdomains_ pcasmgetlocalsubdomains
33: #define pcasmcreatesubdomains_ pcasmcreatesubdomains
34: #define pcasmdestroysubdomains_ pcasmdestroysubdomains
35: #define pcasmcreatesubdomains2d_ pcasmcreatesubdomains2d
36: #endif
38: PETSC_EXTERN void pcasmcreatesubdomains2d_(PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, IS *is, IS *isl, int *ierr)
39: {
40: IS *iis, *iisl;
41: *ierr = PCASMCreateSubdomains2D(*m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
42: if (*ierr) return;
43: *ierr = PetscMemcpy(is, iis, *Nsub * sizeof(IS));
44: if (*ierr) return;
45: *ierr = PetscMemcpy(isl, iisl, *Nsub * sizeof(IS));
46: if (*ierr) return;
47: *ierr = PetscFree(iis);
48: if (*ierr) return;
49: *ierr = PetscFree(iisl);
50: }
52: PETSC_EXTERN void pcasmcreatesubdomains_(Mat *mat, PetscInt *n, IS *subs, PetscErrorCode *ierr)
53: {
54: PetscInt i;
55: IS *insubs;
57: *ierr = PCASMCreateSubdomains(*mat, *n, &insubs);
58: if (*ierr) return;
59: for (i = 0; i < *n; i++) subs[i] = insubs[i];
60: *ierr = PetscFree(insubs);
61: }
63: PETSC_EXTERN void pcasmdestroysubdomains_(PetscInt *n, IS *subs, IS *isubs, PetscErrorCode *ierr)
64: {
65: PetscInt i;
67: for (i = 0; i < *n; i++) {
68: *ierr = ISDestroy(&subs[i]);
69: if (*ierr) return;
70: *ierr = ISDestroy(&isubs[i]);
71: if (*ierr) return;
72: }
73: }
75: PETSC_EXTERN void pcasmgetsubksp1_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
76: {
77: KSP *tksp;
78: PetscInt i, nloc;
79: CHKFORTRANNULLINTEGER(n_local);
80: CHKFORTRANNULLINTEGER(first_local);
81: CHKFORTRANNULLOBJECT(ksp);
82: *ierr = PCASMGetSubKSP(*pc, &nloc, first_local, &tksp);
83: if (n_local) *n_local = nloc;
84: if (ksp) {
85: for (i = 0; i < nloc; i++) ksp[i] = tksp[i];
86: }
87: }
89: PETSC_EXTERN void pcasmgetsubksp2_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
90: {
91: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
92: }
94: PETSC_EXTERN void pcasmgetsubksp3_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
95: {
96: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
97: }
99: PETSC_EXTERN void pcasmgetsubksp4_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
100: {
101: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
102: }
104: PETSC_EXTERN void pcasmgetsubksp5_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
105: {
106: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
107: }
109: PETSC_EXTERN void pcasmgetsubksp6_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
110: {
111: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
112: }
114: PETSC_EXTERN void pcasmgetsubksp7_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
115: {
116: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
117: }
119: PETSC_EXTERN void pcasmgetsubksp8_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
120: {
121: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
122: }
124: PETSC_EXTERN void pcasmsetlocalsubdomains_(PC *pc, PetscInt *n, IS *is, IS *is_local, PetscErrorCode *ierr)
125: {
126: CHKFORTRANNULLOBJECT(is);
127: CHKFORTRANNULLOBJECT(is_local);
128: *ierr = PCASMSetLocalSubdomains(*pc, *n, is, is_local);
129: }
131: PETSC_EXTERN void pcasmsettotalsubdomains_(PC *pc, PetscInt *N, IS *is, IS *is_local, PetscErrorCode *ierr)
132: {
133: CHKFORTRANNULLOBJECT(is);
134: CHKFORTRANNULLOBJECT(is_local);
135: *ierr = PCASMSetTotalSubdomains(*pc, *N, is, is_local);
136: }
138: PETSC_EXTERN void pcasmgetlocalsubmatrices_(PC *pc, PetscInt *n, Mat *mat, PetscErrorCode *ierr)
139: {
140: PetscInt nloc, i;
141: Mat *tmat;
142: CHKFORTRANNULLOBJECT(mat);
143: CHKFORTRANNULLINTEGER(n);
144: *ierr = PCASMGetLocalSubmatrices(*pc, &nloc, &tmat);
145: if (n) *n = nloc;
146: if (mat) {
147: for (i = 0; i < nloc; i++) mat[i] = tmat[i];
148: }
149: }
150: PETSC_EXTERN void pcasmgetlocalsubdomains_(PC *pc, PetscInt *n, IS *is, IS *is_local, PetscErrorCode *ierr)
151: {
152: PetscInt nloc, i;
153: IS *tis, *tis_local;
154: CHKFORTRANNULLOBJECT(is);
155: CHKFORTRANNULLOBJECT(is_local);
156: CHKFORTRANNULLINTEGER(n);
157: *ierr = PCASMGetLocalSubdomains(*pc, &nloc, &tis, &tis_local);
158: if (n) *n = nloc;
159: if (is) {
160: for (i = 0; i < nloc; i++) is[i] = tis[i];
161: }
162: if (is_local && tis_local) {
163: for (i = 0; i < nloc; i++) is_local[i] = tis_local[i];
164: }
165: }