Actual source code: zplexfemf90.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscdmplex.h>
3: #include <petscds.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define dmplexgetcellfields_ DMPLEXGETCELLFIELDS
7: #define dmplexrestorecellfields_ DMPLEXRESTORECELLFIELDS
8: #define dmplexgetfacefields_ DMPLEXGETFACEFIELDS
9: #define dmplexrestorefacefields_ DMPLEXRESTOREFACEFIELDS
10: #define dmplexgetfacegeometry_ DMPLEXGETFACEGEOMETRY
11: #define dmplexrestorefacegeometry_ DMPLEXRESTOREFACEGEOMETRY
12: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
13: #define dmplexgetcellfields_ dmplexgetcellfields
14: #define dmplexrestorecellfields_ dmplexrestorecellfields
15: #define dmplexgetfacefields_ dmplexgetfacefields
16: #define dmplexrestorefacefields_ dmplexrestorefacefields
17: #define dmplexgetfacegeometry_ dmplexgetfacegeometry
18: #define dmplexrestorefacegeometry_ dmplexrestorefacegeometry
19: #endif
21: PETSC_EXTERN void dmplexgetcellfields_(DM *dm, IS *cellIS, Vec *locX, Vec *locX_t, Vec *locA, F90Array1d *uPtr, F90Array1d *utPtr, F90Array1d *aPtr, int *ierr PETSC_F90_2PTR_PROTO(uPtrd) PETSC_F90_2PTR_PROTO(utPtrd) PETSC_F90_2PTR_PROTO(aPtrd))
22: {
23: PetscDS prob;
24: PetscScalar *u, *u_t, *a;
25: PetscInt numCells, totDim, totDimAux = 0;
27: *ierr = ISGetLocalSize(*cellIS, &numCells);
28: if (*ierr) return;
29: *ierr = DMPlexGetCellFields(*dm, *cellIS, *locX, *locX_t, *locA, &u, &u_t, &a);
30: if (*ierr) return;
31: *ierr = DMGetDS(*dm, &prob);
32: if (*ierr) return;
33: *ierr = PetscDSGetTotalDimension(prob, &totDim);
34: if (*ierr) return;
35: if (locA) {
36: DM dmAux;
37: PetscDS probAux;
39: *ierr = VecGetDM(*locA, &dmAux);
40: if (*ierr) return;
41: *ierr = DMGetDS(dmAux, &probAux);
42: if (*ierr) return;
43: *ierr = PetscDSGetTotalDimension(probAux, &totDimAux);
44: if (*ierr) return;
45: }
46: *ierr = F90Array1dCreate((void *)u, MPIU_SCALAR, 1, numCells * totDim, uPtr PETSC_F90_2PTR_PARAM(uPtrd));
47: if (*ierr) return;
48: *ierr = F90Array1dCreate((void *)u_t, MPIU_SCALAR, 1, locX_t ? numCells * totDim : 0, utPtr PETSC_F90_2PTR_PARAM(utPtrd));
49: if (*ierr) return;
50: *ierr = F90Array1dCreate((void *)a, MPIU_SCALAR, 1, locA ? numCells * totDimAux : 0, aPtr PETSC_F90_2PTR_PARAM(aPtrd));
51: }
53: PETSC_EXTERN void dmplexrestorecellfields_(DM *dm, IS *cellIS, Vec *locX, Vec *locX_t, Vec *locA, F90Array1d *uPtr, F90Array1d *utPtr, F90Array1d *aPtr, int *ierr PETSC_F90_2PTR_PROTO(uPtrd) PETSC_F90_2PTR_PROTO(utPtrd) PETSC_F90_2PTR_PROTO(aPtrd))
54: {
55: PetscScalar *u, *u_t, *a;
57: *ierr = F90Array1dAccess(uPtr, MPIU_SCALAR, (void **)&u PETSC_F90_2PTR_PARAM(uPtrd));
58: if (*ierr) return;
59: *ierr = F90Array1dAccess(utPtr, MPIU_SCALAR, (void **)&u_t PETSC_F90_2PTR_PARAM(utPtrd));
60: if (*ierr) return;
61: *ierr = F90Array1dAccess(aPtr, MPIU_SCALAR, (void **)&a PETSC_F90_2PTR_PARAM(aPtrd));
62: if (*ierr) return;
63: *ierr = DMPlexRestoreCellFields(*dm, *cellIS, *locX, NULL, NULL, &u, u_t ? &u_t : NULL, a ? &a : NULL);
64: if (*ierr) return;
65: *ierr = F90Array1dDestroy(uPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(uPtrd));
66: if (*ierr) return;
67: *ierr = F90Array1dDestroy(utPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(utPtrd));
68: if (*ierr) return;
69: *ierr = F90Array1dDestroy(aPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(aPtrd));
70: if (*ierr) return;
71: }
73: PETSC_EXTERN void dmplexgetfacefields_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *locX, Vec *locX_t, Vec *faceGeometry, Vec *cellGeometry, Vec *locGrad, PetscInt *Nface, F90Array1d *uLPtr, F90Array1d *uRPtr, int *ierr PETSC_F90_2PTR_PROTO(uLPtrd) PETSC_F90_2PTR_PROTO(uRPtrd))
74: {
75: PetscDS prob;
76: PetscScalar *uL, *uR;
77: PetscInt numFaces = *fEnd - *fStart, totDim;
79: *ierr = DMPlexGetFaceFields(*dm, *fStart, *fEnd, *locX, *locX_t, *faceGeometry, *cellGeometry, *locGrad, Nface, &uL, &uR);
80: if (*ierr) return;
81: *ierr = DMGetDS(*dm, &prob);
82: if (*ierr) return;
83: *ierr = PetscDSGetTotalDimension(prob, &totDim);
84: if (*ierr) return;
85: *ierr = F90Array1dCreate((void *)uL, MPIU_SCALAR, 1, numFaces * totDim, uLPtr PETSC_F90_2PTR_PARAM(uLPtrd));
86: if (*ierr) return;
87: *ierr = F90Array1dCreate((void *)uR, MPIU_SCALAR, 1, numFaces * totDim, uRPtr PETSC_F90_2PTR_PARAM(uRPtrd));
88: if (*ierr) return;
89: }
91: PETSC_EXTERN void dmplexrestorefacefields_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *locX, Vec *locX_t, Vec *faceGeometry, Vec *cellGeometry, Vec *locGrad, PetscInt *Nface, F90Array1d *uLPtr, F90Array1d *uRPtr, int *ierr PETSC_F90_2PTR_PROTO(uLPtrd) PETSC_F90_2PTR_PROTO(uRPtrd))
92: {
93: PetscScalar *uL, *uR;
95: *ierr = F90Array1dAccess(uLPtr, MPIU_SCALAR, (void **)&uL PETSC_F90_2PTR_PARAM(uLPtrd));
96: if (*ierr) return;
97: *ierr = F90Array1dAccess(uRPtr, MPIU_SCALAR, (void **)&uR PETSC_F90_2PTR_PARAM(uRPtrd));
98: if (*ierr) return;
99: *ierr = DMPlexRestoreFaceFields(*dm, *fStart, *fEnd, *locX, NULL, *faceGeometry, *cellGeometry, NULL, Nface, &uL, &uR);
100: if (*ierr) return;
101: *ierr = F90Array1dDestroy(uLPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(uLPtrd));
102: if (*ierr) return;
103: *ierr = F90Array1dDestroy(uRPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(uRPtrd));
104: if (*ierr) return;
105: }
107: PETSC_EXTERN void dmplexgetfacegeometry_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *faceGeometry, Vec *cellGeometry, PetscInt *Nface, F90Array1d *gPtr, F90Array1d *vPtr, int *ierr PETSC_F90_2PTR_PROTO(gPtrd) PETSC_F90_2PTR_PROTO(vPtrd))
108: {
109: PetscFVFaceGeom *g;
110: PetscReal *v;
111: PetscInt numFaces = *fEnd - *fStart, structSize = sizeof(PetscFVFaceGeom) / sizeof(PetscScalar);
113: *ierr = DMPlexGetFaceGeometry(*dm, *fStart, *fEnd, *faceGeometry, *cellGeometry, Nface, &g, &v);
114: if (*ierr) return;
115: *ierr = F90Array1dCreate((void *)g, MPIU_SCALAR, 1, numFaces * structSize, gPtr PETSC_F90_2PTR_PARAM(gPtrd));
116: if (*ierr) return;
117: *ierr = F90Array1dCreate((void *)v, MPIU_REAL, 1, numFaces * 2, vPtr PETSC_F90_2PTR_PARAM(vPtrd));
118: if (*ierr) return;
119: }
121: PETSC_EXTERN void dmplexrestorefacegeometry_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *faceGeometry, Vec *cellGeometry, PetscInt *Nface, F90Array1d *gPtr, F90Array1d *vPtr, int *ierr PETSC_F90_2PTR_PROTO(gPtrd) PETSC_F90_2PTR_PROTO(vPtrd))
122: {
123: PetscFVFaceGeom *g;
124: PetscReal *v;
126: *ierr = F90Array1dAccess(gPtr, MPIU_SCALAR, (void **)&g PETSC_F90_2PTR_PARAM(gPtrd));
127: if (*ierr) return;
128: *ierr = F90Array1dAccess(vPtr, MPIU_REAL, (void **)&v PETSC_F90_2PTR_PARAM(vPtrd));
129: if (*ierr) return;
130: *ierr = DMPlexRestoreFaceGeometry(*dm, *fStart, *fEnd, *faceGeometry, *cellGeometry, Nface, &g, &v);
131: if (*ierr) return;
132: *ierr = F90Array1dDestroy(gPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(vPtrd));
133: if (*ierr) return;
134: *ierr = F90Array1dDestroy(vPtr, MPIU_REAL PETSC_F90_2PTR_PARAM(gPtrd));
135: if (*ierr) return;
136: }