Actual source code: zplexf90.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscdmplex.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define dmplexgetcone_ DMPLEXGETCONE
6: #define dmplexrestorecone_ DMPLEXRESTORECONE
7: #define dmplexgetconeorientation_ DMPLEXGETCONEORIENTATION
8: #define dmplexrestoreconeorientation_ DMPLEXRESTORECONEORIENTATION
9: #define dmplexgetsupport_ DMPLEXGETSUPPORT
10: #define dmplexrestoresupport_ DMPLEXRESTORESUPPORT
11: #define dmplexgettransitiveclosure_ DMPLEXGETTRANSITIVECLOSURE
12: #define dmplexrestoretransitiveclosure_ DMPLEXRESTORETRANSITIVECLOSURE
13: #define dmplexvecgetclosure_ DMPLEXVECGETCLOSURE
14: #define dmplexvecrestoreclosure_ DMPLEXVECRESTORECLOSURE
15: #define dmplexvecsetclosure_ DMPLEXVECSETCLOSURE
16: #define dmplexmatsetclosure_ DMPLEXMATSETCLOSURE
17: #define dmplexgetjoin_ DMPLEXGETJOIN
18: #define dmplexgetfulljoin_ DMPLEXGETFULLJOIN
19: #define dmplexrestorejoin_ DMPLEXRESTOREJOIN
20: #define dmplexgetmeet_ DMPLEXGETMEET
21: #define dmplexgetfullmeet_ DMPLEXGETFULLMEET
22: #define dmplexrestoremeet_ DMPLEXRESTOREMEET
23: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
24: #define dmplexgetcone_ dmplexgetcone
25: #define dmplexrestorecone_ dmplexrestorecone
26: #define dmplexgetconeorientation_ dmplexgetconeorientation
27: #define dmplexrestoreconeorientation_ dmplexrestoreconeorientation
28: #define dmplexgetsupport_ dmplexgetsupport
29: #define dmplexrestoresupport_ dmplexrestoresupport
30: #define dmplexgettransitiveclosure_ dmplexgettransitiveclosure
31: #define dmplexrestoretransitiveclosure_ dmplexrestoretransitiveclosure
32: #define dmplexvecgetclosure_ dmplexvecgetclosure
33: #define dmplexvecrestoreclosure_ dmplexvecrestoreclosure
34: #define dmplexvecsetclosure_ dmplexvecsetclosure
35: #define dmplexmatsetclosure_ dmplexmatsetclosure
36: #define dmplexgetjoin_ dmplexgetjoin
37: #define dmplexgetfulljoin_ dmplexgetfulljoin
38: #define dmplexrestorejoin_ dmplexrestorejoin
39: #define dmplexgetmeet_ dmplexgetmeet
40: #define dmplexgetfullmeet_ dmplexgetfullmeet
41: #define dmplexrestoremeet_ dmplexrestoremeet
42: #endif
44: PETSC_EXTERN void dmplexgetcone_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
45: {
46: const PetscInt *v;
47: PetscInt n;
49: *ierr = DMPlexGetConeSize(*dm, *p, &n);
50: if (*ierr) return;
51: *ierr = DMPlexGetCone(*dm, *p, &v);
52: if (*ierr) return;
53: *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
54: }
56: PETSC_EXTERN void dmplexrestorecone_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
57: {
58: *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
59: if (*ierr) return;
60: }
62: PETSC_EXTERN void dmplexgetconeorientation_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
63: {
64: const PetscInt *v;
65: PetscInt n;
67: *ierr = DMPlexGetConeSize(*dm, *p, &n);
68: if (*ierr) return;
69: *ierr = DMPlexGetConeOrientation(*dm, *p, &v);
70: if (*ierr) return;
71: *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
72: }
74: PETSC_EXTERN void dmplexrestoreconeorientation_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
75: {
76: *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
77: if (*ierr) return;
78: }
80: PETSC_EXTERN void dmplexgetsupport_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
81: {
82: const PetscInt *v;
83: PetscInt n;
85: *ierr = DMPlexGetSupportSize(*dm, *p, &n);
86: if (*ierr) return;
87: *ierr = DMPlexGetSupport(*dm, *p, &v);
88: if (*ierr) return;
89: *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
90: }
92: PETSC_EXTERN void dmplexrestoresupport_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
93: {
94: *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
95: if (*ierr) return;
96: }
98: PETSC_EXTERN void dmplexgettransitiveclosure_(DM *dm, PetscInt *p, PetscBool *useCone, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
99: {
100: PetscInt *v = NULL;
101: PetscInt n;
103: CHKFORTRANNULL(N);
104: *ierr = DMPlexGetTransitiveClosure(*dm, *p, *useCone, &n, &v);
105: if (*ierr) return;
106: *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n * 2, ptr PETSC_F90_2PTR_PARAM(ptrd));
107: if (N) *N = n;
108: }
110: PETSC_EXTERN void dmplexrestoretransitiveclosure_(DM *dm, PetscInt *p, PetscBool *useCone, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
111: {
112: PetscInt *array;
114: *ierr = F90Array1dAccess(ptr, MPIU_INT, (void **)&array PETSC_F90_2PTR_PARAM(ptrd));
115: if (*ierr) return;
116: *ierr = DMPlexRestoreTransitiveClosure(*dm, *p, *useCone, NULL, &array);
117: if (*ierr) return;
118: *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
119: if (*ierr) return;
120: }
122: PETSC_EXTERN void dmplexvecgetclosure_(DM *dm, PetscSection *section, Vec *x, PetscInt *point, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
123: {
124: PetscScalar *v = NULL;
125: PetscInt n;
127: CHKFORTRANNULL(N);
128: *ierr = DMPlexVecGetClosure(*dm, *section, *x, *point, &n, &v);
129: if (*ierr) return;
130: *ierr = F90Array1dCreate((void *)v, MPIU_SCALAR, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
131: if (N) *N = n;
132: }
134: PETSC_EXTERN void dmplexvecrestoreclosure_(DM *dm, PetscSection *section, Vec *v, PetscInt *point, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
135: {
136: PetscScalar *array;
138: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&array PETSC_F90_2PTR_PARAM(ptrd));
139: if (*ierr) return;
140: *ierr = DMPlexVecRestoreClosure(*dm, *section, *v, *point, NULL, &array);
141: if (*ierr) return;
142: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
143: if (*ierr) return;
144: }
146: PETSC_EXTERN void dmplexgetjoin_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
147: {
148: const PetscInt *coveredPoints;
149: PetscInt n;
151: CHKFORTRANNULL(N);
152: *ierr = DMPlexGetJoin(*dm, *numPoints, points, &n, &coveredPoints);
153: if (*ierr) return;
154: *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
155: if (N) *N = n;
156: }
158: PETSC_EXTERN void dmplexgetfulljoin_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
159: {
160: const PetscInt *coveredPoints;
161: PetscInt n;
163: CHKFORTRANNULL(N);
164: *ierr = DMPlexGetFullJoin(*dm, *numPoints, points, &n, &coveredPoints);
165: if (*ierr) return;
166: *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
167: if (N) *N = n;
168: }
170: PETSC_EXTERN void dmplexrestorejoin_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
171: {
172: PetscInt *coveredPoints;
174: *ierr = F90Array1dAccess(cptr, MPIU_INT, (void **)&coveredPoints PETSC_F90_2PTR_PARAM(cptrd));
175: if (*ierr) return;
176: *ierr = DMPlexRestoreJoin(*dm, 0, NULL, NULL, (const PetscInt **)&coveredPoints);
177: if (*ierr) return;
178: *ierr = F90Array1dDestroy(cptr, MPIU_INT PETSC_F90_2PTR_PARAM(cptrd));
179: if (*ierr) return;
180: }
182: PETSC_EXTERN void dmplexgetmeet_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
183: {
184: const PetscInt *coveredPoints;
185: PetscInt n;
187: CHKFORTRANNULL(N);
188: *ierr = DMPlexGetMeet(*dm, *numPoints, points, &n, &coveredPoints);
189: if (*ierr) return;
190: *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
191: if (N) *N = n;
192: }
194: PETSC_EXTERN void dmplexgetfullmeet_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
195: {
196: const PetscInt *coveredPoints;
197: PetscInt n;
199: CHKFORTRANNULL(N);
200: if (*ierr) return;
201: *ierr = DMPlexGetFullMeet(*dm, *numPoints, points, &n, &coveredPoints);
202: if (*ierr) return;
203: *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
204: if (N) *N = n;
205: }
207: PETSC_EXTERN void dmplexrestoremeet_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
208: {
209: PetscInt *coveredPoints;
211: *ierr = F90Array1dAccess(cptr, MPIU_INT, (void **)&coveredPoints PETSC_F90_2PTR_PARAM(cptrd));
212: if (*ierr) return;
213: *ierr = DMPlexRestoreMeet(*dm, 0, NULL, NULL, (const PetscInt **)&coveredPoints);
214: if (*ierr) return;
215: *ierr = F90Array1dDestroy(cptr, MPIU_INT PETSC_F90_2PTR_PARAM(cptrd));
216: if (*ierr) return;
217: }