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 pcasmgetlocalsubmatrices_ PCASMGETLOCALSUBMATRICES
14: #define pcasmgetlocalsubdomains_ PCASMGETLOCALSUBDOMAINS
15: #define pcasmcreatesubdomains_ PCASMCREATESUBDOMAINS
16: #define pcasmdestroysubdomains_ PCASMDESTROYSUBDOMAINS
17: #define pcasmcreatesubdomains2d_ PCASMCREATESUBDOMAINS2D
18: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
19: #define pcasmgetsubksp1_ pcasmgetsubksp1
20: #define pcasmgetsubksp2_ pcasmgetsubksp2
21: #define pcasmgetsubksp3_ pcasmgetsubksp3
22: #define pcasmgetsubksp4_ pcasmgetsubksp4
23: #define pcasmgetsubksp5_ pcasmgetsubksp5
24: #define pcasmgetsubksp6_ pcasmgetsubksp6
25: #define pcasmgetsubksp7_ pcasmgetsubksp7
26: #define pcasmgetsubksp8_ pcasmgetsubksp8
27: #define pcasmgetlocalsubmatrices_ pcasmgetlocalsubmatrices
28: #define pcasmgetlocalsubdomains_ pcasmgetlocalsubdomains
29: #define pcasmcreatesubdomains_ pcasmcreatesubdomains
30: #define pcasmdestroysubdomains_ pcasmdestroysubdomains
31: #define pcasmcreatesubdomains2d_ pcasmcreatesubdomains2d
32: #endif
34: PETSC_EXTERN void pcasmcreatesubdomains2d_(PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, IS *is, IS *isl, int *ierr)
35: {
36: IS *iis, *iisl;
37: *ierr = PCASMCreateSubdomains2D(*m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
38: if (*ierr) return;
39: *ierr = PetscMemcpy(is, iis, *Nsub * sizeof(IS));
40: if (*ierr) return;
41: *ierr = PetscMemcpy(isl, iisl, *Nsub * sizeof(IS));
42: if (*ierr) return;
43: *ierr = PetscFree(iis);
44: if (*ierr) return;
45: *ierr = PetscFree(iisl);
46: }
48: PETSC_EXTERN void pcasmcreatesubdomains_(Mat *mat, PetscInt *n, IS *subs, PetscErrorCode *ierr)
49: {
50: PetscInt i;
51: IS *insubs;
53: *ierr = PCASMCreateSubdomains(*mat, *n, &insubs);
54: if (*ierr) return;
55: for (i = 0; i < *n; i++) subs[i] = insubs[i];
56: *ierr = PetscFree(insubs);
57: }
59: PETSC_EXTERN void pcasmdestroysubdomains_(PetscInt *n, IS *subs, IS *isubs, PetscErrorCode *ierr)
60: {
61: PetscInt i;
63: for (i = 0; i < *n; i++) {
64: *ierr = ISDestroy(&subs[i]);
65: if (*ierr) return;
66: *ierr = ISDestroy(&isubs[i]);
67: if (*ierr) return;
68: }
69: }
71: PETSC_EXTERN void pcasmgetsubksp1_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
72: {
73: KSP *tksp;
74: PetscInt i, nloc;
75: CHKFORTRANNULLINTEGER(n_local);
76: CHKFORTRANNULLINTEGER(first_local);
77: CHKFORTRANNULLOBJECT(ksp);
78: *ierr = PCASMGetSubKSP(*pc, &nloc, first_local, &tksp);
79: if (n_local) *n_local = nloc;
80: if (ksp) {
81: for (i = 0; i < nloc; i++) ksp[i] = tksp[i];
82: }
83: }
85: PETSC_EXTERN void pcasmgetsubksp2_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
86: {
87: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
88: }
90: PETSC_EXTERN void pcasmgetsubksp3_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
91: {
92: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
93: }
95: PETSC_EXTERN void pcasmgetsubksp4_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
96: {
97: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
98: }
100: PETSC_EXTERN void pcasmgetsubksp5_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
101: {
102: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
103: }
105: PETSC_EXTERN void pcasmgetsubksp6_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
106: {
107: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
108: }
110: PETSC_EXTERN void pcasmgetsubksp7_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
111: {
112: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
113: }
115: PETSC_EXTERN void pcasmgetsubksp8_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
116: {
117: pcasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
118: }
120: PETSC_EXTERN void pcasmgetlocalsubmatrices_(PC *pc, PetscInt *n, Mat *mat, PetscErrorCode *ierr)
121: {
122: PetscInt nloc, i;
123: Mat *tmat;
124: CHKFORTRANNULLOBJECT(mat);
125: CHKFORTRANNULLINTEGER(n);
126: *ierr = PCASMGetLocalSubmatrices(*pc, &nloc, &tmat);
127: if (n) *n = nloc;
128: if (mat) {
129: for (i = 0; i < nloc; i++) mat[i] = tmat[i];
130: }
131: }
132: PETSC_EXTERN void pcasmgetlocalsubdomains_(PC *pc, PetscInt *n, IS *is, IS *is_local, PetscErrorCode *ierr)
133: {
134: PetscInt nloc, i;
135: IS *tis, *tis_local;
136: CHKFORTRANNULLOBJECT(is);
137: CHKFORTRANNULLOBJECT(is_local);
138: CHKFORTRANNULLINTEGER(n);
139: *ierr = PCASMGetLocalSubdomains(*pc, &nloc, &tis, &tis_local);
140: if (n) *n = nloc;
141: if (is) {
142: for (i = 0; i < nloc; i++) is[i] = tis[i];
143: }
144: if (is_local && tis_local) {
145: for (i = 0; i < nloc; i++) is_local[i] = tis_local[i];
146: }
147: }