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: }