xref: /petsc/src/ts/utils/dmplexts.c (revision 8cd7fcbbde4ae99b6c1fac7f008f82577400d6fc)
16dbbd306SMatthew G. Knepley #include <petscdmplex.h>          /*I "petscdmplex.h" I*/
2254c1ad2SMatthew G. Knepley #include <petsc-private/tsimpl.h>   /*I "petscts.h" I*/
36dbbd306SMatthew G. Knepley #include <petscfv.h>
46dbbd306SMatthew G. Knepley 
5254c1ad2SMatthew G. Knepley /* TODO Move LS stuff to dtfv.c */
6254c1ad2SMatthew G. Knepley #include <petscblaslapack.h>
7254c1ad2SMatthew G. Knepley 
8254c1ad2SMatthew G. Knepley PETSC_STATIC_INLINE void WaxpyD(PetscInt dim, PetscScalar a, const PetscScalar *x, const PetscScalar *y, PetscScalar *w) {PetscInt d; for (d = 0; d < dim; ++d) w[d] = a*x[d] + y[d];}
9254c1ad2SMatthew G. Knepley PETSC_STATIC_INLINE PetscScalar DotD(PetscInt dim, const PetscScalar *x, const PetscScalar *y) {PetscScalar sum = 0.0; PetscInt d; for (d = 0; d < dim; ++d) sum += x[d]*y[d]; return sum;}
10254c1ad2SMatthew G. Knepley PETSC_STATIC_INLINE PetscReal NormD(PetscInt dim, const PetscScalar *x) {return PetscSqrtReal(PetscAbsScalar(DotD(dim,x,x)));}
11254c1ad2SMatthew G. Knepley 
12254c1ad2SMatthew G. Knepley typedef struct {
13254c1ad2SMatthew G. Knepley   PetscBool setupGeom; /* Flag for geometry setup */
14254c1ad2SMatthew G. Knepley   PetscBool setupGrad; /* Flag for gradient calculation setup */
15254c1ad2SMatthew G. Knepley   Vec       facegeom;  /* FaceGeom struct for each face */
16254c1ad2SMatthew G. Knepley   Vec       cellgeom;  /* CellGeom struct for each cell */
17254c1ad2SMatthew G. Knepley   DM        dmGrad;    /* Layout for the gradient data */
18254c1ad2SMatthew G. Knepley   PetscReal minradius; /* Minimum distance from centroid to face */
19254c1ad2SMatthew G. Knepley   void    (*riemann)(const PetscReal[], const PetscReal[], const PetscScalar[], const PetscScalar[], PetscScalar[], void *);
20254c1ad2SMatthew G. Knepley   void     *rhsfunctionlocalctx;
21254c1ad2SMatthew G. Knepley } DMTS_Plex;
226dbbd306SMatthew G. Knepley 
236dbbd306SMatthew G. Knepley #undef __FUNCT__
24254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMTSDestroy_Plex"
25254c1ad2SMatthew G. Knepley static PetscErrorCode DMTSDestroy_Plex(DMTS dmts)
266dbbd306SMatthew G. Knepley {
27254c1ad2SMatthew G. Knepley   DMTS_Plex     *dmplexts = (DMTS_Plex *) dmts->data;
286dbbd306SMatthew G. Knepley   PetscErrorCode ierr;
296dbbd306SMatthew G. Knepley 
30254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
31254c1ad2SMatthew G. Knepley   ierr = DMDestroy(&dmplexts->dmGrad);CHKERRQ(ierr);
32254c1ad2SMatthew G. Knepley   ierr = VecDestroy(&dmplexts->facegeom);CHKERRQ(ierr);
33254c1ad2SMatthew G. Knepley   ierr = VecDestroy(&dmplexts->cellgeom);CHKERRQ(ierr);
34254c1ad2SMatthew G. Knepley   ierr = PetscFree(dmts->data);CHKERRQ(ierr);
35254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
36254c1ad2SMatthew G. Knepley }
37254c1ad2SMatthew G. Knepley 
38254c1ad2SMatthew G. Knepley #undef __FUNCT__
39254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMTSDuplicate_Plex"
40254c1ad2SMatthew G. Knepley static PetscErrorCode DMTSDuplicate_Plex(DMTS olddmts, DMTS dmts)
41254c1ad2SMatthew G. Knepley {
42254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
43254c1ad2SMatthew G. Knepley 
44254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
45254c1ad2SMatthew G. Knepley   ierr = PetscNewLog(dmts, (DMTS_Plex **) &dmts->data);CHKERRQ(ierr);
46254c1ad2SMatthew G. Knepley   if (olddmts->data) {ierr = PetscMemcpy(dmts->data, olddmts->data, sizeof(DMTS_Plex));CHKERRQ(ierr);}
47254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
48254c1ad2SMatthew G. Knepley }
49254c1ad2SMatthew G. Knepley 
50254c1ad2SMatthew G. Knepley #undef __FUNCT__
51254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMPlexTSGetContext"
52254c1ad2SMatthew G. Knepley static PetscErrorCode DMPlexTSGetContext(DM dm, DMTS dmts, DMTS_Plex **dmplexts)
53254c1ad2SMatthew G. Knepley {
54254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
55254c1ad2SMatthew G. Knepley 
56254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
57254c1ad2SMatthew G. Knepley   *dmplexts = NULL;
58254c1ad2SMatthew G. Knepley   if (!dmts->data) {
59254c1ad2SMatthew G. Knepley     ierr = PetscNewLog(dm, (DMTS_Plex **) &dmts->data);CHKERRQ(ierr);
60254c1ad2SMatthew G. Knepley     dmts->ops->destroy   = DMTSDestroy_Plex;
61254c1ad2SMatthew G. Knepley     dmts->ops->duplicate = DMTSDuplicate_Plex;
62254c1ad2SMatthew G. Knepley   }
63254c1ad2SMatthew G. Knepley   *dmplexts = (DMTS_Plex *) dmts->data;
64254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
65254c1ad2SMatthew G. Knepley }
66254c1ad2SMatthew G. Knepley 
67254c1ad2SMatthew G. Knepley #undef __FUNCT__
68a0ac79e7SMatthew G. Knepley #define __FUNCT__ "DMPlexTSGetGeometry"
69a0ac79e7SMatthew G. Knepley PetscErrorCode DMPlexTSGetGeometry(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius)
70a0ac79e7SMatthew G. Knepley {
71a0ac79e7SMatthew G. Knepley   DMTS           dmts;
72a0ac79e7SMatthew G. Knepley   DMTS_Plex     *dmplexts;
73a0ac79e7SMatthew G. Knepley   PetscErrorCode ierr;
74a0ac79e7SMatthew G. Knepley 
75a0ac79e7SMatthew G. Knepley   PetscFunctionBegin;
76a0ac79e7SMatthew G. Knepley   ierr = DMGetDMTS(dm, &dmts);CHKERRQ(ierr);
77a0ac79e7SMatthew G. Knepley   ierr = DMPlexTSGetContext(dm, dmts, &dmplexts);CHKERRQ(ierr);
78a0ac79e7SMatthew G. Knepley   if (facegeom)  *facegeom  = dmplexts->facegeom;
79a0ac79e7SMatthew G. Knepley   if (cellgeom)  *cellgeom  = dmplexts->cellgeom;
80a0ac79e7SMatthew G. Knepley   if (minRadius) *minRadius = dmplexts->minradius;
81a0ac79e7SMatthew G. Knepley   PetscFunctionReturn(0);
82a0ac79e7SMatthew G. Knepley }
83a0ac79e7SMatthew G. Knepley 
84a0ac79e7SMatthew G. Knepley #undef __FUNCT__
85254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMPlexTSSetupGeometry"
86254c1ad2SMatthew G. Knepley static PetscErrorCode DMPlexTSSetupGeometry(DM dm, PetscFV fvm, DMTS_Plex *dmplexts)
87254c1ad2SMatthew G. Knepley {
88254c1ad2SMatthew G. Knepley   DM             dmFace, dmCell;
89254c1ad2SMatthew G. Knepley   DMLabel        ghostLabel;
90254c1ad2SMatthew G. Knepley   PetscSection   sectionFace, sectionCell;
91254c1ad2SMatthew G. Knepley   PetscSection   coordSection;
92254c1ad2SMatthew G. Knepley   Vec            coordinates;
93254c1ad2SMatthew G. Knepley   PetscReal      minradius;
94254c1ad2SMatthew G. Knepley   PetscScalar   *fgeom, *cgeom;
95254c1ad2SMatthew G. Knepley   PetscInt       dim, cStart, cEnd, cEndInterior, c, fStart, fEnd, f;
96254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
97254c1ad2SMatthew G. Knepley 
98254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
99254c1ad2SMatthew G. Knepley   if (dmplexts->setupGeom) PetscFunctionReturn(0);
100254c1ad2SMatthew G. Knepley   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
101254c1ad2SMatthew G. Knepley   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
102254c1ad2SMatthew G. Knepley   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
103254c1ad2SMatthew G. Knepley   /* Make cell centroids and volumes */
104254c1ad2SMatthew G. Knepley   ierr = DMClone(dm, &dmCell);CHKERRQ(ierr);
105254c1ad2SMatthew G. Knepley   ierr = DMSetCoordinateSection(dmCell, coordSection);CHKERRQ(ierr);
106254c1ad2SMatthew G. Knepley   ierr = DMSetCoordinatesLocal(dmCell, coordinates);CHKERRQ(ierr);
107254c1ad2SMatthew G. Knepley   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionCell);CHKERRQ(ierr);
108254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
109254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
110254c1ad2SMatthew G. Knepley   ierr = PetscSectionSetChart(sectionCell, cStart, cEnd);CHKERRQ(ierr);
111254c1ad2SMatthew G. Knepley   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionCell, c, sizeof(CellGeom)/sizeof(PetscScalar));CHKERRQ(ierr);}
112254c1ad2SMatthew G. Knepley   ierr = PetscSectionSetUp(sectionCell);CHKERRQ(ierr);
113254c1ad2SMatthew G. Knepley   ierr = DMSetDefaultSection(dmCell, sectionCell);CHKERRQ(ierr);
114254c1ad2SMatthew G. Knepley   ierr = PetscSectionDestroy(&sectionCell);CHKERRQ(ierr);
115254c1ad2SMatthew G. Knepley   ierr = DMCreateLocalVector(dmCell, &dmplexts->cellgeom);CHKERRQ(ierr);
116254c1ad2SMatthew G. Knepley   ierr = VecGetArray(dmplexts->cellgeom, &cgeom);CHKERRQ(ierr);
117254c1ad2SMatthew G. Knepley   for (c = cStart; c < cEndInterior; ++c) {
118254c1ad2SMatthew G. Knepley     CellGeom *cg;
119254c1ad2SMatthew G. Knepley 
120254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRef(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
121254c1ad2SMatthew G. Knepley     ierr = PetscMemzero(cg, sizeof(*cg));CHKERRQ(ierr);
122254c1ad2SMatthew G. Knepley     ierr = DMPlexComputeCellGeometryFVM(dmCell, c, &cg->volume, cg->centroid, NULL);CHKERRQ(ierr);
123254c1ad2SMatthew G. Knepley   }
124254c1ad2SMatthew G. Knepley   /* Compute face normals and minimum cell radius */
125254c1ad2SMatthew G. Knepley   ierr = DMClone(dm, &dmFace);CHKERRQ(ierr);
126254c1ad2SMatthew G. Knepley   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionFace);CHKERRQ(ierr);
127254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
128254c1ad2SMatthew G. Knepley   ierr = PetscSectionSetChart(sectionFace, fStart, fEnd);CHKERRQ(ierr);
129254c1ad2SMatthew G. Knepley   for (f = fStart; f < fEnd; ++f) {ierr = PetscSectionSetDof(sectionFace, f, sizeof(FaceGeom)/sizeof(PetscScalar));CHKERRQ(ierr);}
130254c1ad2SMatthew G. Knepley   ierr = PetscSectionSetUp(sectionFace);CHKERRQ(ierr);
131254c1ad2SMatthew G. Knepley   ierr = DMSetDefaultSection(dmFace, sectionFace);CHKERRQ(ierr);
132254c1ad2SMatthew G. Knepley   ierr = PetscSectionDestroy(&sectionFace);CHKERRQ(ierr);
133254c1ad2SMatthew G. Knepley   ierr = DMCreateLocalVector(dmFace, &dmplexts->facegeom);CHKERRQ(ierr);
134254c1ad2SMatthew G. Knepley   ierr = VecGetArray(dmplexts->facegeom, &fgeom);CHKERRQ(ierr);
135254c1ad2SMatthew G. Knepley   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
136254c1ad2SMatthew G. Knepley   minradius = PETSC_MAX_REAL;
137254c1ad2SMatthew G. Knepley   for (f = fStart; f < fEnd; ++f) {
138254c1ad2SMatthew G. Knepley     FaceGeom *fg;
139254c1ad2SMatthew G. Knepley     PetscReal area;
140254c1ad2SMatthew G. Knepley     PetscInt  ghost, d;
141254c1ad2SMatthew G. Knepley 
142254c1ad2SMatthew G. Knepley     ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);
143254c1ad2SMatthew G. Knepley     if (ghost >= 0) continue;
144254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRef(dmFace, f, fgeom, &fg);CHKERRQ(ierr);
145254c1ad2SMatthew G. Knepley     ierr = DMPlexComputeCellGeometryFVM(dm, f, &area, fg->centroid, fg->normal);CHKERRQ(ierr);
146254c1ad2SMatthew G. Knepley     for (d = 0; d < dim; ++d) fg->normal[d] *= area;
147254c1ad2SMatthew G. Knepley     /* Flip face orientation if necessary to match ordering in support, and Update minimum radius */
148254c1ad2SMatthew G. Knepley     {
149254c1ad2SMatthew G. Knepley       CellGeom       *cL, *cR;
150254c1ad2SMatthew G. Knepley       const PetscInt *cells;
151254c1ad2SMatthew G. Knepley       PetscReal      *lcentroid, *rcentroid;
152254c1ad2SMatthew G. Knepley       PetscScalar     v[3];
153254c1ad2SMatthew G. Knepley 
154254c1ad2SMatthew G. Knepley       ierr = DMPlexGetSupport(dm, f, &cells);CHKERRQ(ierr);
155254c1ad2SMatthew G. Knepley       ierr = DMPlexPointLocalRead(dmCell, cells[0], cgeom, &cL);CHKERRQ(ierr);
156254c1ad2SMatthew G. Knepley       ierr = DMPlexPointLocalRead(dmCell, cells[1], cgeom, &cR);CHKERRQ(ierr);
157254c1ad2SMatthew G. Knepley       lcentroid = cells[0] >= cEndInterior ? fg->centroid : cL->centroid;
158254c1ad2SMatthew G. Knepley       rcentroid = cells[1] >= cEndInterior ? fg->centroid : cR->centroid;
159254c1ad2SMatthew G. Knepley       WaxpyD(dim, -1, lcentroid, rcentroid, v);
160254c1ad2SMatthew G. Knepley       if (DotD(dim, fg->normal, v) < 0) {
161254c1ad2SMatthew G. Knepley         for (d = 0; d < dim; ++d) fg->normal[d] = -fg->normal[d];
162254c1ad2SMatthew G. Knepley       }
163254c1ad2SMatthew G. Knepley       if (DotD(dim, fg->normal, v) <= 0) {
164254c1ad2SMatthew G. Knepley         if (dim == 2) SETERRQ5(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed, normal (%g,%g) v (%g,%g)", f, fg->normal[0], fg->normal[1], v[0], v[1]);
165254c1ad2SMatthew G. Knepley         if (dim == 3) SETERRQ7(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed, normal (%g,%g,%g) v (%g,%g,%g)", f, fg->normal[0], fg->normal[1], fg->normal[2], v[0], v[1], v[2]);
166254c1ad2SMatthew G. Knepley         SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed", f);
167254c1ad2SMatthew G. Knepley       }
168254c1ad2SMatthew G. Knepley       if (cells[0] < cEndInterior) {
169254c1ad2SMatthew G. Knepley         WaxpyD(dim, -1, fg->centroid, cL->centroid, v);
170254c1ad2SMatthew G. Knepley         minradius = PetscMin(minradius, NormD(dim, v));
171254c1ad2SMatthew G. Knepley       }
172254c1ad2SMatthew G. Knepley       if (cells[1] < cEndInterior) {
173254c1ad2SMatthew G. Knepley         WaxpyD(dim, -1, fg->centroid, cR->centroid, v);
174254c1ad2SMatthew G. Knepley         minradius = PetscMin(minradius, NormD(dim, v));
175254c1ad2SMatthew G. Knepley       }
176254c1ad2SMatthew G. Knepley     }
177254c1ad2SMatthew G. Knepley   }
178254c1ad2SMatthew G. Knepley   ierr = MPI_Allreduce(&minradius, &dmplexts->minradius, 1, MPIU_SCALAR, MPI_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
179254c1ad2SMatthew G. Knepley   /* Compute centroids of ghost cells */
180254c1ad2SMatthew G. Knepley   for (c = cEndInterior; c < cEnd; ++c) {
181254c1ad2SMatthew G. Knepley     FaceGeom       *fg;
182254c1ad2SMatthew G. Knepley     const PetscInt *cone,    *support;
183254c1ad2SMatthew G. Knepley     PetscInt        coneSize, supportSize, s;
184254c1ad2SMatthew G. Knepley 
185254c1ad2SMatthew G. Knepley     ierr = DMPlexGetConeSize(dmCell, c, &coneSize);CHKERRQ(ierr);
186254c1ad2SMatthew G. Knepley     if (coneSize != 1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Ghost cell %d has cone size %d != 1", c, coneSize);
187254c1ad2SMatthew G. Knepley     ierr = DMPlexGetCone(dmCell, c, &cone);CHKERRQ(ierr);
188254c1ad2SMatthew G. Knepley     ierr = DMPlexGetSupportSize(dmCell, cone[0], &supportSize);CHKERRQ(ierr);
189254c1ad2SMatthew G. Knepley     if (supportSize != 2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d has support size %d != 1", cone[0], supportSize);
190254c1ad2SMatthew G. Knepley     ierr = DMPlexGetSupport(dmCell, cone[0], &support);CHKERRQ(ierr);
191254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRef(dmFace, cone[0], fgeom, &fg);CHKERRQ(ierr);
192254c1ad2SMatthew G. Knepley     for (s = 0; s < 2; ++s) {
193254c1ad2SMatthew G. Knepley       /* Reflect ghost centroid across plane of face */
194254c1ad2SMatthew G. Knepley       if (support[s] == c) {
195254c1ad2SMatthew G. Knepley         const CellGeom *ci;
196254c1ad2SMatthew G. Knepley         CellGeom       *cg;
197254c1ad2SMatthew G. Knepley         PetscScalar     c2f[3], a;
198254c1ad2SMatthew G. Knepley 
199254c1ad2SMatthew G. Knepley         ierr = DMPlexPointLocalRead(dmCell, support[(s+1)%2], cgeom, &ci);CHKERRQ(ierr);
200254c1ad2SMatthew G. Knepley         WaxpyD(dim, -1, ci->centroid, fg->centroid, c2f); /* cell to face centroid */
201254c1ad2SMatthew G. Knepley         a    = DotD(dim, c2f, fg->normal)/DotD(dim, fg->normal, fg->normal);
202254c1ad2SMatthew G. Knepley         ierr = DMPlexPointLocalRef(dmCell, support[s], cgeom, &cg);CHKERRQ(ierr);
203254c1ad2SMatthew G. Knepley         WaxpyD(dim, 2*a, fg->normal, ci->centroid, cg->centroid);
204254c1ad2SMatthew G. Knepley         cg->volume = ci->volume;
205254c1ad2SMatthew G. Knepley       }
206254c1ad2SMatthew G. Knepley     }
207254c1ad2SMatthew G. Knepley   }
208254c1ad2SMatthew G. Knepley   ierr = VecRestoreArray(dmplexts->facegeom, &fgeom);CHKERRQ(ierr);
209254c1ad2SMatthew G. Knepley   ierr = VecRestoreArray(dmplexts->cellgeom, &cgeom);CHKERRQ(ierr);
210254c1ad2SMatthew G. Knepley   ierr = DMDestroy(&dmCell);CHKERRQ(ierr);
211254c1ad2SMatthew G. Knepley   ierr = DMDestroy(&dmFace);CHKERRQ(ierr);
212254c1ad2SMatthew G. Knepley   dmplexts->setupGeom = PETSC_TRUE;
213254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
214254c1ad2SMatthew G. Knepley }
215254c1ad2SMatthew G. Knepley 
216254c1ad2SMatthew G. Knepley #undef __FUNCT__
217254c1ad2SMatthew G. Knepley #define __FUNCT__ "PseudoInverse"
218254c1ad2SMatthew G. Knepley /* Overwrites A. Can only handle full-rank problems with m>=n */
219254c1ad2SMatthew G. Knepley static PetscErrorCode PseudoInverse(PetscInt m,PetscInt mstride,PetscInt n,PetscScalar *A,PetscScalar *Ainv,PetscScalar *tau,PetscInt worksize,PetscScalar *work)
220254c1ad2SMatthew G. Knepley {
221254c1ad2SMatthew G. Knepley   PetscBool      debug = PETSC_FALSE;
222254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
223254c1ad2SMatthew G. Knepley   PetscBLASInt   M,N,K,lda,ldb,ldwork,info;
224254c1ad2SMatthew G. Knepley   PetscScalar    *R,*Q,*Aback,Alpha;
225254c1ad2SMatthew G. Knepley 
226254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
227254c1ad2SMatthew G. Knepley   if (debug) {
228254c1ad2SMatthew G. Knepley     ierr = PetscMalloc1(m*n,&Aback);CHKERRQ(ierr);
229254c1ad2SMatthew G. Knepley     ierr = PetscMemcpy(Aback,A,m*n*sizeof(PetscScalar));CHKERRQ(ierr);
230254c1ad2SMatthew G. Knepley   }
231254c1ad2SMatthew G. Knepley 
232254c1ad2SMatthew G. Knepley   ierr = PetscBLASIntCast(m,&M);CHKERRQ(ierr);
233254c1ad2SMatthew G. Knepley   ierr = PetscBLASIntCast(n,&N);CHKERRQ(ierr);
234254c1ad2SMatthew G. Knepley   ierr = PetscBLASIntCast(mstride,&lda);CHKERRQ(ierr);
235254c1ad2SMatthew G. Knepley   ierr = PetscBLASIntCast(worksize,&ldwork);CHKERRQ(ierr);
236254c1ad2SMatthew G. Knepley   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
237254c1ad2SMatthew G. Knepley   LAPACKgeqrf_(&M,&N,A,&lda,tau,work,&ldwork,&info);
238254c1ad2SMatthew G. Knepley   ierr = PetscFPTrapPop();CHKERRQ(ierr);
239254c1ad2SMatthew G. Knepley   if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xGEQRF error");
240254c1ad2SMatthew G. Knepley   R = A; /* Upper triangular part of A now contains R, the rest contains the elementary reflectors */
241254c1ad2SMatthew G. Knepley 
242254c1ad2SMatthew G. Knepley   /* Extract an explicit representation of Q */
243254c1ad2SMatthew G. Knepley   Q    = Ainv;
244254c1ad2SMatthew G. Knepley   ierr = PetscMemcpy(Q,A,mstride*n*sizeof(PetscScalar));CHKERRQ(ierr);
245254c1ad2SMatthew G. Knepley   K    = N;                     /* full rank */
246254c1ad2SMatthew G. Knepley   LAPACKungqr_(&M,&N,&K,Q,&lda,tau,work,&ldwork,&info);
247254c1ad2SMatthew G. Knepley   if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xORGQR/xUNGQR error");
248254c1ad2SMatthew G. Knepley 
249254c1ad2SMatthew G. Knepley   /* Compute A^{-T} = (R^{-1} Q^T)^T = Q R^{-T} */
250254c1ad2SMatthew G. Knepley   Alpha = 1.0;
251254c1ad2SMatthew G. Knepley   ldb   = lda;
252254c1ad2SMatthew G. Knepley   BLAStrsm_("Right","Upper","ConjugateTranspose","NotUnitTriangular",&M,&N,&Alpha,R,&lda,Q,&ldb);
253254c1ad2SMatthew G. Knepley   /* Ainv is Q, overwritten with inverse */
254254c1ad2SMatthew G. Knepley 
255254c1ad2SMatthew G. Knepley   if (debug) {                      /* Check that pseudo-inverse worked */
256254c1ad2SMatthew G. Knepley     PetscScalar Beta = 0.0;
257254c1ad2SMatthew G. Knepley     PetscInt    ldc;
258254c1ad2SMatthew G. Knepley     K   = N;
259254c1ad2SMatthew G. Knepley     ldc = N;
260254c1ad2SMatthew G. Knepley     BLASgemm_("ConjugateTranspose","Normal",&N,&K,&M,&Alpha,Ainv,&lda,Aback,&ldb,&Beta,work,&ldc);
261254c1ad2SMatthew G. Knepley     ierr = PetscScalarView(n*n,work,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
262254c1ad2SMatthew G. Knepley     ierr = PetscFree(Aback);CHKERRQ(ierr);
263254c1ad2SMatthew G. Knepley   }
264254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
265254c1ad2SMatthew G. Knepley }
266254c1ad2SMatthew G. Knepley 
267254c1ad2SMatthew G. Knepley #undef __FUNCT__
268254c1ad2SMatthew G. Knepley #define __FUNCT__ "PseudoInverseGetWorkRequired"
269254c1ad2SMatthew G. Knepley static PetscErrorCode PseudoInverseGetWorkRequired(PetscInt maxFaces, PetscInt *work)
270254c1ad2SMatthew G. Knepley {
271254c1ad2SMatthew G. Knepley   PetscInt m,n,nrhs,minwork;
272254c1ad2SMatthew G. Knepley 
273254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
274254c1ad2SMatthew G. Knepley   m       = maxFaces;
275254c1ad2SMatthew G. Knepley   n       = 3; /* spatial dimension */
276254c1ad2SMatthew G. Knepley   nrhs    = maxFaces;
277254c1ad2SMatthew G. Knepley   minwork = 3*PetscMin(m,n) + PetscMax(2*PetscMin(m,n), PetscMax(PetscMax(m,n), nrhs)); /* required by LAPACK */
278254c1ad2SMatthew G. Knepley   *work   = 5*minwork;          /* We can afford to be extra generous */
279254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
280254c1ad2SMatthew G. Knepley }
281254c1ad2SMatthew G. Knepley 
282254c1ad2SMatthew G. Knepley #undef __FUNCT__
283254c1ad2SMatthew G. Knepley #define __FUNCT__ "PseudoInverseSVD"
284254c1ad2SMatthew G. Knepley /* Overwrites A. Can handle degenerate problems and m<n. */
285254c1ad2SMatthew G. Knepley static PetscErrorCode PseudoInverseSVD(PetscInt m,PetscInt mstride,PetscInt n,PetscScalar *A,PetscScalar *Ainv,PetscScalar *tau,PetscInt worksize,PetscScalar *work)
286254c1ad2SMatthew G. Knepley {
287254c1ad2SMatthew G. Knepley   PetscBool      debug = PETSC_FALSE;
288254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
289254c1ad2SMatthew G. Knepley   PetscInt       i,j,maxmn;
290254c1ad2SMatthew G. Knepley   PetscBLASInt   M,N,nrhs,lda,ldb,irank,ldwork,info;
291254c1ad2SMatthew G. Knepley   PetscScalar    rcond,*tmpwork,*Brhs,*Aback;
292254c1ad2SMatthew G. Knepley 
293254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
294254c1ad2SMatthew G. Knepley   if (debug) {
295254c1ad2SMatthew G. Knepley     ierr = PetscMalloc1(m*n,&Aback);CHKERRQ(ierr);
296254c1ad2SMatthew G. Knepley     ierr = PetscMemcpy(Aback,A,m*n*sizeof(PetscScalar));CHKERRQ(ierr);
297254c1ad2SMatthew G. Knepley   }
298254c1ad2SMatthew G. Knepley 
299254c1ad2SMatthew G. Knepley   /* initialize to identity */
300254c1ad2SMatthew G. Knepley   tmpwork = Ainv;
301254c1ad2SMatthew G. Knepley   Brhs = work;
302254c1ad2SMatthew G. Knepley   maxmn = PetscMax(m,n);
303254c1ad2SMatthew G. Knepley   for (j=0; j<maxmn; j++) {
304254c1ad2SMatthew G. Knepley     for (i=0; i<maxmn; i++) Brhs[i + j*maxmn] = 1.0*(i == j);
305254c1ad2SMatthew G. Knepley   }
306254c1ad2SMatthew G. Knepley 
307254c1ad2SMatthew G. Knepley   ierr  = PetscBLASIntCast(m,&M);CHKERRQ(ierr);
308254c1ad2SMatthew G. Knepley   ierr  = PetscBLASIntCast(n,&N);CHKERRQ(ierr);
309254c1ad2SMatthew G. Knepley   nrhs  = M;
310254c1ad2SMatthew G. Knepley   ierr  = PetscBLASIntCast(mstride,&lda);CHKERRQ(ierr);
311254c1ad2SMatthew G. Knepley   ierr  = PetscBLASIntCast(maxmn,&ldb);CHKERRQ(ierr);
312254c1ad2SMatthew G. Knepley   ierr  = PetscBLASIntCast(worksize,&ldwork);CHKERRQ(ierr);
313254c1ad2SMatthew G. Knepley   rcond = -1;
314254c1ad2SMatthew G. Knepley   ierr  = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
315254c1ad2SMatthew G. Knepley   LAPACKgelss_(&M,&N,&nrhs,A,&lda,Brhs,&ldb,tau,&rcond,&irank,tmpwork,&ldwork,&info);
316254c1ad2SMatthew G. Knepley   ierr = PetscFPTrapPop();CHKERRQ(ierr);
317254c1ad2SMatthew G. Knepley   if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"xGELSS error");
318254c1ad2SMatthew G. Knepley   /* The following check should be turned into a diagnostic as soon as someone wants to do this intentionally */
319254c1ad2SMatthew G. Knepley   if (irank < PetscMin(M,N)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Rank deficient least squares fit, indicates an isolated cell with two colinear points");
320254c1ad2SMatthew G. Knepley 
321254c1ad2SMatthew G. Knepley   /* Brhs shaped (M,nrhs) column-major coldim=mstride was overwritten by Ainv shaped (N,nrhs) column-major coldim=maxmn.
322254c1ad2SMatthew G. Knepley    * Here we transpose to (N,nrhs) row-major rowdim=mstride. */
323254c1ad2SMatthew G. Knepley   for (i=0; i<n; i++) {
324254c1ad2SMatthew G. Knepley     for (j=0; j<nrhs; j++) Ainv[i*mstride+j] = Brhs[i + j*maxmn];
325254c1ad2SMatthew G. Knepley   }
326254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
327254c1ad2SMatthew G. Knepley }
328254c1ad2SMatthew G. Knepley 
329254c1ad2SMatthew G. Knepley #undef __FUNCT__
330254c1ad2SMatthew G. Knepley #define __FUNCT__ "BuildLeastSquares"
331254c1ad2SMatthew G. Knepley /* Build least squares gradient reconstruction operators */
332254c1ad2SMatthew G. Knepley static PetscErrorCode BuildLeastSquares(DM dm,PetscInt cEndInterior,DM dmFace,PetscScalar *fgeom,DM dmCell,PetscScalar *cgeom)
333254c1ad2SMatthew G. Knepley {
334*8cd7fcbbSMatthew G. Knepley   DMLabel        ghostLabel;
335254c1ad2SMatthew G. Knepley   PetscScalar   *B,*Binv,*work,*tau,**gref;
336254c1ad2SMatthew G. Knepley   PetscInt       dim, c,cStart,cEnd,maxNumFaces,worksize;
337254c1ad2SMatthew G. Knepley   PetscBool      useSVD = PETSC_TRUE;
338254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
339254c1ad2SMatthew G. Knepley 
340254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
341254c1ad2SMatthew G. Knepley   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
342254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm,0,&cStart,&cEnd);CHKERRQ(ierr);
343254c1ad2SMatthew G. Knepley   ierr = DMPlexGetMaxSizes(dm,&maxNumFaces,NULL);CHKERRQ(ierr);
344254c1ad2SMatthew G. Knepley   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
345254c1ad2SMatthew G. Knepley   ierr = PseudoInverseGetWorkRequired(maxNumFaces,&worksize);CHKERRQ(ierr);
346254c1ad2SMatthew G. Knepley   ierr = PetscMalloc5(maxNumFaces*dim,&B,worksize,&Binv,worksize,&work,maxNumFaces,&tau,maxNumFaces,&gref);CHKERRQ(ierr);
347254c1ad2SMatthew G. Knepley   for (c = cStart; c < cEndInterior; c++) {
348254c1ad2SMatthew G. Knepley     const PetscInt *faces;
349254c1ad2SMatthew G. Knepley     PetscInt       numFaces,usedFaces,f,i,j;
350254c1ad2SMatthew G. Knepley     const CellGeom *cg;
351*8cd7fcbbSMatthew G. Knepley     PetscBool       boundary;
352*8cd7fcbbSMatthew G. Knepley     PetscInt        ghost;
353*8cd7fcbbSMatthew G. Knepley 
354254c1ad2SMatthew G. Knepley     ierr = DMPlexGetConeSize(dm,c,&numFaces);CHKERRQ(ierr);
355254c1ad2SMatthew G. Knepley     if (numFaces < dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cell %D has only %D faces, not enough for gradient reconstruction",c,numFaces);
356254c1ad2SMatthew G. Knepley     ierr = DMPlexGetCone(dm,c,&faces);CHKERRQ(ierr);
357254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dmCell,c,cgeom,&cg);CHKERRQ(ierr);
358254c1ad2SMatthew G. Knepley     for (f=0,usedFaces=0; f<numFaces; f++) {
359254c1ad2SMatthew G. Knepley       const PetscInt *fcells;
360254c1ad2SMatthew G. Knepley       PetscInt       ncell,side;
361254c1ad2SMatthew G. Knepley       FaceGeom       *fg;
362254c1ad2SMatthew G. Knepley       const CellGeom *cg1;
363254c1ad2SMatthew G. Knepley 
364254c1ad2SMatthew G. Knepley       ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
365*8cd7fcbbSMatthew G. Knepley       ierr = DMPlexIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
366*8cd7fcbbSMatthew G. Knepley       if ((ghost >= 0) || boundary) continue;
367254c1ad2SMatthew G. Knepley       ierr  = DMPlexGetSupport(dm,faces[f],&fcells);CHKERRQ(ierr);
368254c1ad2SMatthew G. Knepley       side  = (c != fcells[0]); /* c is on left=0 or right=1 of face */
369254c1ad2SMatthew G. Knepley       ncell = fcells[!side];   /* the neighbor */
370254c1ad2SMatthew G. Knepley       ierr  = DMPlexPointLocalRef(dmFace,faces[f],fgeom,&fg);CHKERRQ(ierr);
371254c1ad2SMatthew G. Knepley       ierr  = DMPlexPointLocalRead(dmCell,ncell,cgeom,&cg1);CHKERRQ(ierr);
372254c1ad2SMatthew G. Knepley       for (j=0; j<dim; j++) B[j*numFaces+usedFaces] = cg1->centroid[j] - cg->centroid[j];
373254c1ad2SMatthew G. Knepley       gref[usedFaces++] = fg->grad[side];  /* Gradient reconstruction term will go here */
374254c1ad2SMatthew G. Knepley     }
375254c1ad2SMatthew G. Knepley     if (!usedFaces) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Mesh contains isolated cell (no neighbors). Is it intentional?");
376254c1ad2SMatthew G. Knepley     /* Overwrites B with garbage, returns Binv in row-major format */
377254c1ad2SMatthew G. Knepley     if (useSVD) {
378254c1ad2SMatthew G. Knepley       ierr = PseudoInverseSVD(usedFaces,numFaces,dim,B,Binv,tau,worksize,work);CHKERRQ(ierr);
379254c1ad2SMatthew G. Knepley     } else {
380254c1ad2SMatthew G. Knepley       ierr = PseudoInverse(usedFaces,numFaces,dim,B,Binv,tau,worksize,work);CHKERRQ(ierr);
381254c1ad2SMatthew G. Knepley     }
382254c1ad2SMatthew G. Knepley     for (f=0,i=0; f<numFaces; f++) {
383254c1ad2SMatthew G. Knepley       ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
384*8cd7fcbbSMatthew G. Knepley       ierr = DMPlexIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
385*8cd7fcbbSMatthew G. Knepley       if ((ghost >= 0) || boundary) continue;
386254c1ad2SMatthew G. Knepley       for (j=0; j<dim; j++) gref[i][j] = Binv[j*numFaces+i];
387254c1ad2SMatthew G. Knepley       i++;
388254c1ad2SMatthew G. Knepley     }
389254c1ad2SMatthew G. Knepley 
390254c1ad2SMatthew G. Knepley     if (0) {
391254c1ad2SMatthew G. Knepley       PetscReal grad[2] = {0,0};
392254c1ad2SMatthew G. Knepley       for (f=0; f<numFaces; f++) {
393254c1ad2SMatthew G. Knepley         const PetscInt *fcells;
394254c1ad2SMatthew G. Knepley         const CellGeom *cg1;
395254c1ad2SMatthew G. Knepley         const FaceGeom *fg;
396254c1ad2SMatthew G. Knepley         ierr = DMPlexGetSupport(dm,faces[f],&fcells);CHKERRQ(ierr);
397254c1ad2SMatthew G. Knepley         ierr = DMPlexPointLocalRead(dmFace,faces[f],fgeom,&fg);CHKERRQ(ierr);
398254c1ad2SMatthew G. Knepley         for (i=0; i<2; i++) {
399254c1ad2SMatthew G. Knepley           if (fcells[i] == c) continue;
400254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRead(dmCell,fcells[i],cgeom,&cg1);CHKERRQ(ierr);
401254c1ad2SMatthew G. Knepley           PetscScalar du = cg1->centroid[0] + 3*cg1->centroid[1] - (cg->centroid[0] + 3*cg->centroid[1]);
402254c1ad2SMatthew G. Knepley           grad[0] += fg->grad[!i][0] * du;
403254c1ad2SMatthew G. Knepley           grad[1] += fg->grad[!i][1] * du;
404254c1ad2SMatthew G. Knepley         }
405254c1ad2SMatthew G. Knepley       }
406254c1ad2SMatthew G. Knepley       printf("cell[%d] grad (%g,%g)\n",c,grad[0],grad[1]);
407254c1ad2SMatthew G. Knepley     }
408254c1ad2SMatthew G. Knepley   }
409254c1ad2SMatthew G. Knepley   ierr = PetscFree5(B,Binv,work,tau,gref);CHKERRQ(ierr);
410254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
411254c1ad2SMatthew G. Knepley }
412254c1ad2SMatthew G. Knepley 
413254c1ad2SMatthew G. Knepley #undef __FUNCT__
414254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMPlexTSSetupGradient"
415254c1ad2SMatthew G. Knepley static PetscErrorCode DMPlexTSSetupGradient(DM dm, PetscFV fvm, DMTS_Plex *dmplexts)
416254c1ad2SMatthew G. Knepley {
417254c1ad2SMatthew G. Knepley   DM             dmFace, dmCell;
418254c1ad2SMatthew G. Knepley   PetscScalar   *fgeom, *cgeom;
419254c1ad2SMatthew G. Knepley   PetscSection   sectionGrad;
420254c1ad2SMatthew G. Knepley   PetscInt       dim, pdim, cStart, cEnd, cEndInterior, c;
421254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
422254c1ad2SMatthew G. Knepley 
423254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
424254c1ad2SMatthew G. Knepley   if (dmplexts->setupGrad) PetscFunctionReturn(0);
425254c1ad2SMatthew G. Knepley   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
426254c1ad2SMatthew G. Knepley   ierr = PetscFVGetNumComponents(fvm, &pdim);CHKERRQ(ierr);
427254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
428254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
429254c1ad2SMatthew G. Knepley   /* Construct the interpolant corresponding to each face from the leat-square solution over the cell neighborhood */
430254c1ad2SMatthew G. Knepley   ierr = VecGetDM(dmplexts->facegeom, &dmFace);CHKERRQ(ierr);
431254c1ad2SMatthew G. Knepley   ierr = VecGetDM(dmplexts->cellgeom, &dmCell);CHKERRQ(ierr);
432254c1ad2SMatthew G. Knepley   ierr = VecGetArray(dmplexts->facegeom, &fgeom);CHKERRQ(ierr);
433254c1ad2SMatthew G. Knepley   ierr = VecGetArray(dmplexts->cellgeom, &cgeom);CHKERRQ(ierr);
434254c1ad2SMatthew G. Knepley   ierr = BuildLeastSquares(dm, cEndInterior, dmFace, fgeom, dmCell, cgeom);CHKERRQ(ierr);
435254c1ad2SMatthew G. Knepley   ierr = VecRestoreArray(dmplexts->facegeom, &fgeom);CHKERRQ(ierr);
436254c1ad2SMatthew G. Knepley   ierr = VecRestoreArray(dmplexts->cellgeom, &cgeom);CHKERRQ(ierr);
437254c1ad2SMatthew G. Knepley   /* Create storage for gradients */
438254c1ad2SMatthew G. Knepley   ierr = DMClone(dm, &dmplexts->dmGrad);CHKERRQ(ierr);
439254c1ad2SMatthew G. Knepley   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionGrad);CHKERRQ(ierr);
440254c1ad2SMatthew G. Knepley   ierr = PetscSectionSetChart(sectionGrad, cStart, cEnd);CHKERRQ(ierr);
441254c1ad2SMatthew G. Knepley   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionGrad, c, pdim*dim);CHKERRQ(ierr);}
442254c1ad2SMatthew G. Knepley   ierr = PetscSectionSetUp(sectionGrad);CHKERRQ(ierr);
443254c1ad2SMatthew G. Knepley   ierr = DMSetDefaultSection(dmplexts->dmGrad, sectionGrad);CHKERRQ(ierr);
444254c1ad2SMatthew G. Knepley   ierr = PetscSectionDestroy(&sectionGrad);CHKERRQ(ierr);
445254c1ad2SMatthew G. Knepley   dmplexts->setupGrad = PETSC_TRUE;
446254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
447254c1ad2SMatthew G. Knepley }
448254c1ad2SMatthew G. Knepley 
449254c1ad2SMatthew G. Knepley #undef __FUNCT__
450254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMPlexInsertBoundaryValuesFVM_Static"
451254c1ad2SMatthew G. Knepley static PetscErrorCode DMPlexInsertBoundaryValuesFVM_Static(DM dm, PetscFV fvm, PetscReal time, Vec locX, Vec Grad, DMTS_Plex *dmplexts)
452254c1ad2SMatthew G. Knepley {
453254c1ad2SMatthew G. Knepley   Vec                faceGeometry = dmplexts->facegeom;
454254c1ad2SMatthew G. Knepley   Vec                cellGeometry = dmplexts->cellgeom;
455254c1ad2SMatthew G. Knepley   DM                 dmFace, dmCell;
456254c1ad2SMatthew G. Knepley   const PetscScalar *facegeom, *cellgeom, *grad;
457254c1ad2SMatthew G. Knepley   PetscScalar       *x, *fx;
458254c1ad2SMatthew G. Knepley   PetscInt           numBd, b, dim, pdim, fStart, fEnd;
459254c1ad2SMatthew G. Knepley   PetscErrorCode     ierr;
460254c1ad2SMatthew G. Knepley 
461254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
462254c1ad2SMatthew G. Knepley   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
463254c1ad2SMatthew G. Knepley   ierr = PetscFVGetNumComponents(fvm, &pdim);CHKERRQ(ierr);
464254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
465254c1ad2SMatthew G. Knepley   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
466254c1ad2SMatthew G. Knepley   if (Grad) {
467254c1ad2SMatthew G. Knepley     ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
468254c1ad2SMatthew G. Knepley     ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
469254c1ad2SMatthew G. Knepley     ierr = DMGetWorkArray(dm, pdim, PETSC_SCALAR, &fx);CHKERRQ(ierr);
470254c1ad2SMatthew G. Knepley     ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr);
471254c1ad2SMatthew G. Knepley   }
472254c1ad2SMatthew G. Knepley   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
473254c1ad2SMatthew G. Knepley   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
474254c1ad2SMatthew G. Knepley   ierr = VecGetArray(locX, &x);CHKERRQ(ierr);
475254c1ad2SMatthew G. Knepley   for (b = 0; b < numBd; ++b) {
476254c1ad2SMatthew G. Knepley     PetscErrorCode (*func)(PetscReal,const PetscScalar*,const PetscScalar*,const PetscScalar*,PetscScalar*,void*);
477*8cd7fcbbSMatthew G. Knepley     DMLabel          label;
478*8cd7fcbbSMatthew G. Knepley     const char      *labelname;
479254c1ad2SMatthew G. Knepley     const PetscInt  *ids;
480254c1ad2SMatthew G. Knepley     PetscInt         numids, i;
481254c1ad2SMatthew G. Knepley     void            *ctx;
482254c1ad2SMatthew G. Knepley 
483*8cd7fcbbSMatthew G. Knepley     ierr = DMPlexGetBoundary(dm, b, NULL, NULL, &labelname, NULL, (void (**)()) &func, &numids, &ids, &ctx);CHKERRQ(ierr);
484*8cd7fcbbSMatthew G. Knepley     ierr = DMPlexGetLabel(dm, labelname, &label);CHKERRQ(ierr);
485254c1ad2SMatthew G. Knepley     for (i = 0; i < numids; ++i) {
486254c1ad2SMatthew G. Knepley       IS              faceIS;
487254c1ad2SMatthew G. Knepley       const PetscInt *faces;
488254c1ad2SMatthew G. Knepley       PetscInt        numFaces, f;
489254c1ad2SMatthew G. Knepley 
490254c1ad2SMatthew G. Knepley       ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr);
491254c1ad2SMatthew G. Knepley       if (!faceIS) continue; /* No points with that id on this process */
492254c1ad2SMatthew G. Knepley       ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
493254c1ad2SMatthew G. Knepley       ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
494254c1ad2SMatthew G. Knepley       for (f = 0; f < numFaces; ++f) {
495254c1ad2SMatthew G. Knepley         const PetscInt     face = faces[f], *cells;
496254c1ad2SMatthew G. Knepley         const FaceGeom    *fg;
497254c1ad2SMatthew G. Knepley 
498254c1ad2SMatthew G. Knepley         if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */
499254c1ad2SMatthew G. Knepley         ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
500254c1ad2SMatthew G. Knepley         ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
501254c1ad2SMatthew G. Knepley         if (Grad) {
502254c1ad2SMatthew G. Knepley           const CellGeom    *cg;
503254c1ad2SMatthew G. Knepley           const PetscScalar *cx, *cgrad;
504254c1ad2SMatthew G. Knepley           PetscScalar       *xG, dx[3];
505254c1ad2SMatthew G. Knepley           PetscInt           d;
506254c1ad2SMatthew G. Knepley 
507254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr);
508254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr);
509254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRead(dmplexts->dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr);
510254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRef(dm, cells[1], x, &xG);CHKERRQ(ierr);
511254c1ad2SMatthew G. Knepley           WaxpyD(dim, -1, cg->centroid, fg->centroid, dx);
512254c1ad2SMatthew G. Knepley           for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DotD(dim, &cgrad[d*dim], dx);
513254c1ad2SMatthew G. Knepley           ierr = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx);CHKERRQ(ierr);
514254c1ad2SMatthew G. Knepley         } else {
515254c1ad2SMatthew G. Knepley           const PetscScalar *xI;
516254c1ad2SMatthew G. Knepley           PetscScalar       *xG;
517254c1ad2SMatthew G. Knepley 
518254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr);
519254c1ad2SMatthew G. Knepley           ierr = DMPlexPointLocalRef(dm, cells[1], x, &xG);CHKERRQ(ierr);
520254c1ad2SMatthew G. Knepley           ierr = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx);CHKERRQ(ierr);
521254c1ad2SMatthew G. Knepley         }
522254c1ad2SMatthew G. Knepley       }
523254c1ad2SMatthew G. Knepley       ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
524254c1ad2SMatthew G. Knepley       ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
525254c1ad2SMatthew G. Knepley     }
526254c1ad2SMatthew G. Knepley   }
527254c1ad2SMatthew G. Knepley   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
528254c1ad2SMatthew G. Knepley   ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr);
529254c1ad2SMatthew G. Knepley   if (Grad) {
530254c1ad2SMatthew G. Knepley     ierr = DMRestoreWorkArray(dm, pdim, PETSC_SCALAR, &fx);CHKERRQ(ierr);
531254c1ad2SMatthew G. Knepley     ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr);
532254c1ad2SMatthew G. Knepley   }
533254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
534254c1ad2SMatthew G. Knepley }
535254c1ad2SMatthew G. Knepley 
536254c1ad2SMatthew G. Knepley #undef __FUNCT__
537254c1ad2SMatthew G. Knepley #define __FUNCT__ "TSComputeRHSFunction_DMPlex"
538254c1ad2SMatthew G. Knepley static PetscErrorCode TSComputeRHSFunction_DMPlex(TS ts, PetscReal time, Vec X, Vec F, void *ctx)
539254c1ad2SMatthew G. Knepley {
540254c1ad2SMatthew G. Knepley   DM                 dm;
541254c1ad2SMatthew G. Knepley   DMTS_Plex         *dmplexts = (DMTS_Plex *) ctx;
542254c1ad2SMatthew G. Knepley   void             (*riemann)(const PetscReal[], const PetscReal[], const PetscScalar[], const PetscScalar[], PetscScalar[], void *) = dmplexts->riemann;
543254c1ad2SMatthew G. Knepley   PetscFV            fvm;
544254c1ad2SMatthew G. Knepley   PetscLimiter       lim;
545254c1ad2SMatthew G. Knepley   Vec                faceGeometry = dmplexts->facegeom;
546254c1ad2SMatthew G. Knepley   Vec                cellGeometry = dmplexts->cellgeom;
547254c1ad2SMatthew G. Knepley   Vec                Grad = NULL, locGrad, locX;
548254c1ad2SMatthew G. Knepley   DM                 dmFace, dmCell;
549*8cd7fcbbSMatthew G. Knepley   DMLabel            ghostLabel;
550254c1ad2SMatthew G. Knepley   PetscCellGeometry  fgeom, cgeom;
551254c1ad2SMatthew G. Knepley   const PetscScalar *facegeom, *cellgeom, *x, *lgrad;
552254c1ad2SMatthew G. Knepley   PetscScalar       *grad, *f, *uL, *uR, *fluxL, *fluxR;
553254c1ad2SMatthew G. Knepley   PetscReal         *centroid, *normal, *vol, *cellPhi;
554254c1ad2SMatthew G. Knepley   PetscBool          computeGradients;
555254c1ad2SMatthew G. Knepley   PetscInt           Nf, dim, pdim, fStart, fEnd, numFaces = 0, face, iface, cell, cStart, cEnd, cEndInterior;
556254c1ad2SMatthew G. Knepley   PetscErrorCode     ierr;
557254c1ad2SMatthew G. Knepley 
558254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
559254c1ad2SMatthew G. Knepley   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
560254c1ad2SMatthew G. Knepley   PetscValidHeaderSpecific(X,VEC_CLASSID,3);
561254c1ad2SMatthew G. Knepley   PetscValidHeaderSpecific(F,VEC_CLASSID,5);
562254c1ad2SMatthew G. Knepley   ierr = TSGetDM(ts, &dm);CHKERRQ(ierr);
563254c1ad2SMatthew G. Knepley   ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
564254c1ad2SMatthew G. Knepley   ierr = VecZeroEntries(locX);CHKERRQ(ierr);
565254c1ad2SMatthew G. Knepley   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
566254c1ad2SMatthew G. Knepley   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
567254c1ad2SMatthew G. Knepley   ierr = VecZeroEntries(F);CHKERRQ(ierr);
5686dbbd306SMatthew G. Knepley   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5696dbbd306SMatthew G. Knepley   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
5706dbbd306SMatthew G. Knepley   ierr = DMGetField(dm, 0, (PetscObject *) &fvm);CHKERRQ(ierr);
571254c1ad2SMatthew G. Knepley   ierr = PetscFVGetLimiter(fvm, &lim);CHKERRQ(ierr);
5726dbbd306SMatthew G. Knepley   ierr = PetscFVGetNumComponents(fvm, &pdim);CHKERRQ(ierr);
573254c1ad2SMatthew G. Knepley   ierr = PetscFVGetComputeGradients(fvm, &computeGradients);CHKERRQ(ierr);
574254c1ad2SMatthew G. Knepley   if (computeGradients) {
575254c1ad2SMatthew G. Knepley     ierr = DMGetGlobalVector(dmplexts->dmGrad, &Grad);CHKERRQ(ierr);
576254c1ad2SMatthew G. Knepley     ierr = VecZeroEntries(Grad);CHKERRQ(ierr);
577254c1ad2SMatthew G. Knepley     ierr = VecGetArray(Grad, &grad);CHKERRQ(ierr);
578254c1ad2SMatthew G. Knepley   }
5796dbbd306SMatthew G. Knepley   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
5806dbbd306SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5816dbbd306SMatthew G. Knepley   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
5826dbbd306SMatthew G. Knepley   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
5836dbbd306SMatthew G. Knepley   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
5846dbbd306SMatthew G. Knepley   ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
5856dbbd306SMatthew G. Knepley   ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr);
586254c1ad2SMatthew G. Knepley   /* Count faces and reconstruct gradients */
5876dbbd306SMatthew G. Knepley   for (face = fStart; face < fEnd; ++face) {
588254c1ad2SMatthew G. Knepley     const PetscInt    *cells;
589254c1ad2SMatthew G. Knepley     const FaceGeom    *fg;
590254c1ad2SMatthew G. Knepley     const PetscScalar *cx[2];
591254c1ad2SMatthew G. Knepley     PetscScalar       *cgrad[2];
592*8cd7fcbbSMatthew G. Knepley     PetscBool          boundary;
593*8cd7fcbbSMatthew G. Knepley     PetscInt           ghost, c, pd, d;
5946dbbd306SMatthew G. Knepley 
5956dbbd306SMatthew G. Knepley     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
5966dbbd306SMatthew G. Knepley     if (ghost >= 0) continue;
5976dbbd306SMatthew G. Knepley     ++numFaces;
598254c1ad2SMatthew G. Knepley     if (!computeGradients) continue;
599*8cd7fcbbSMatthew G. Knepley     ierr = DMPlexIsBoundaryPoint(dm, face, &boundary);CHKERRQ(ierr);
600*8cd7fcbbSMatthew G. Knepley     if (boundary) continue;
601254c1ad2SMatthew G. Knepley     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
602254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
603254c1ad2SMatthew G. Knepley     for (c = 0; c < 2; ++c) {
604254c1ad2SMatthew G. Knepley       ierr = DMPlexPointLocalRead(dm, cells[c], x, &cx[c]);CHKERRQ(ierr);
605254c1ad2SMatthew G. Knepley       ierr = DMPlexPointGlobalRef(dmplexts->dmGrad, cells[c], grad, &cgrad[c]);CHKERRQ(ierr);
606254c1ad2SMatthew G. Knepley     }
607254c1ad2SMatthew G. Knepley     for (pd = 0; pd < pdim; ++pd) {
608254c1ad2SMatthew G. Knepley       PetscScalar delta = cx[1][pd] - cx[0][pd];
609254c1ad2SMatthew G. Knepley 
610254c1ad2SMatthew G. Knepley       for (d = 0; d < dim; ++d) {
611254c1ad2SMatthew G. Knepley         if (cgrad[0]) cgrad[0][pd*dim+d] += fg->grad[0][d] * delta;
612254c1ad2SMatthew G. Knepley         if (cgrad[1]) cgrad[1][pd*dim+d] -= fg->grad[1][d] * delta;
613254c1ad2SMatthew G. Knepley       }
614254c1ad2SMatthew G. Knepley     }
615254c1ad2SMatthew G. Knepley   }
616254c1ad2SMatthew G. Knepley   /* Limit interior gradients (using cell-based loop because it generalizes better to vector limiters) */
617254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
618254c1ad2SMatthew G. Knepley   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
619254c1ad2SMatthew G. Knepley   ierr = DMGetWorkArray(dm, pdim, PETSC_REAL, &cellPhi);CHKERRQ(ierr);
620254c1ad2SMatthew G. Knepley   for (cell = computeGradients && lim ? cStart : cEnd; cell < cEndInterior; ++cell) {
621254c1ad2SMatthew G. Knepley     const PetscInt    *faces;
622254c1ad2SMatthew G. Knepley     const PetscScalar *cx;
623254c1ad2SMatthew G. Knepley     const CellGeom    *cg;
624254c1ad2SMatthew G. Knepley     PetscScalar       *cgrad;
625254c1ad2SMatthew G. Knepley     PetscInt           coneSize, f, pd, d;
626254c1ad2SMatthew G. Knepley 
627254c1ad2SMatthew G. Knepley     ierr = DMPlexGetConeSize(dm, cell, &coneSize);CHKERRQ(ierr);
628254c1ad2SMatthew G. Knepley     ierr = DMPlexGetCone(dm, cell, &faces);CHKERRQ(ierr);
629254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dm, cell, x, &cx);CHKERRQ(ierr);
630254c1ad2SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dmCell, cell, cellgeom, &cg);CHKERRQ(ierr);
631254c1ad2SMatthew G. Knepley     ierr = DMPlexPointGlobalRef(dmplexts->dmGrad, cell, grad, &cgrad);CHKERRQ(ierr);
632254c1ad2SMatthew G. Knepley     if (!cgrad) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Supposedly ghost cell %d, but this should be impossible", cell);
633254c1ad2SMatthew G. Knepley     /* Limiter will be minimum value over all neighbors */
634254c1ad2SMatthew G. Knepley     for (d = 0; d < pdim; ++d) cellPhi[d] = PETSC_MAX_REAL;
635254c1ad2SMatthew G. Knepley     for (f = 0; f < coneSize; ++f) {
636254c1ad2SMatthew G. Knepley       const PetscScalar *ncx;
637254c1ad2SMatthew G. Knepley       const CellGeom    *ncg;
638254c1ad2SMatthew G. Knepley       const PetscInt    *fcells;
639*8cd7fcbbSMatthew G. Knepley       PetscInt           face = faces[f], ncell, ghost;
640254c1ad2SMatthew G. Knepley       PetscScalar        v[3];
641*8cd7fcbbSMatthew G. Knepley       PetscBool          boundary;
642254c1ad2SMatthew G. Knepley 
643254c1ad2SMatthew G. Knepley       ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
644*8cd7fcbbSMatthew G. Knepley       ierr = DMPlexIsBoundaryPoint(dm, face, &boundary);CHKERRQ(ierr);
645*8cd7fcbbSMatthew G. Knepley       if ((ghost >= 0) || boundary) continue;
646254c1ad2SMatthew G. Knepley       ierr  = DMPlexGetSupport(dm, face, &fcells);CHKERRQ(ierr);
647254c1ad2SMatthew G. Knepley       ncell = cell == fcells[0] ? fcells[1] : fcells[0];
648254c1ad2SMatthew G. Knepley       ierr  = DMPlexPointLocalRead(dm, ncell, x, &ncx);CHKERRQ(ierr);
649254c1ad2SMatthew G. Knepley       ierr  = DMPlexPointLocalRead(dmCell, ncell, cellgeom, &ncg);CHKERRQ(ierr);
650254c1ad2SMatthew G. Knepley       WaxpyD(dim, -1, cg->centroid, ncg->centroid, v);
651254c1ad2SMatthew G. Knepley       for (d = 0; d < pdim; ++d) {
652254c1ad2SMatthew G. Knepley         /* We use the symmetric slope limited form of Berger, Aftosmis, and Murman 2005 */
653254c1ad2SMatthew G. Knepley         PetscScalar phi, flim = 0.5 * (ncx[d] - cx[d]) / DotD(dim, &cgrad[d*dim], v);
654254c1ad2SMatthew G. Knepley 
655254c1ad2SMatthew G. Knepley         ierr = PetscLimiterLimit(lim, flim, &phi);CHKERRQ(ierr);
656254c1ad2SMatthew G. Knepley         cellPhi[d] = PetscMin(cellPhi[d], phi);
657254c1ad2SMatthew G. Knepley       }
658254c1ad2SMatthew G. Knepley     }
659254c1ad2SMatthew G. Knepley     /* Apply limiter to gradient */
660254c1ad2SMatthew G. Knepley     for (pd = 0; pd < pdim; ++pd)
661254c1ad2SMatthew G. Knepley       /* Scalar limiter applied to each component separately */
662254c1ad2SMatthew G. Knepley       for (d = 0; d < dim; ++d) cgrad[pd*dim+d] *= cellPhi[pd];
663254c1ad2SMatthew G. Knepley   }
664254c1ad2SMatthew G. Knepley   ierr = DMRestoreWorkArray(dm, pdim, PETSC_REAL, &cellPhi);CHKERRQ(ierr);
665254c1ad2SMatthew G. Knepley   ierr = DMPlexInsertBoundaryValuesFVM_Static(dm, fvm, time, locX, Grad, dmplexts);CHKERRQ(ierr);
666254c1ad2SMatthew G. Knepley   if (computeGradients) {
667254c1ad2SMatthew G. Knepley     ierr = VecRestoreArray(Grad, &grad);CHKERRQ(ierr);
668254c1ad2SMatthew G. Knepley     ierr = DMGetLocalVector(dmplexts->dmGrad, &locGrad);CHKERRQ(ierr);
669254c1ad2SMatthew G. Knepley     ierr = DMGlobalToLocalBegin(dmplexts->dmGrad, Grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
670254c1ad2SMatthew G. Knepley     ierr = DMGlobalToLocalEnd(dmplexts->dmGrad, Grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
671254c1ad2SMatthew G. Knepley     ierr = DMRestoreGlobalVector(dmplexts->dmGrad, &Grad);CHKERRQ(ierr);
672254c1ad2SMatthew G. Knepley     ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
6736dbbd306SMatthew G. Knepley   }
6746dbbd306SMatthew G. Knepley   ierr = PetscMalloc7(numFaces*dim,&centroid,numFaces*dim,&normal,numFaces*2,&vol,numFaces*pdim,&uL,numFaces*pdim,&uR,numFaces*pdim,&fluxL,numFaces*pdim,&fluxR);CHKERRQ(ierr);
675254c1ad2SMatthew G. Knepley   /* Read out values */
6766dbbd306SMatthew G. Knepley   for (face = fStart, iface = 0; face < fEnd; ++face) {
6776dbbd306SMatthew G. Knepley     const PetscInt    *cells;
6786dbbd306SMatthew G. Knepley     const FaceGeom    *fg;
6796dbbd306SMatthew G. Knepley     const CellGeom    *cgL, *cgR;
680254c1ad2SMatthew G. Knepley     const PetscScalar *xL, *xR, *gL, *gR;
6816dbbd306SMatthew G. Knepley     PetscInt           ghost, d;
6826dbbd306SMatthew G. Knepley 
6836dbbd306SMatthew G. Knepley     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
6846dbbd306SMatthew G. Knepley     if (ghost >= 0) continue;
6856dbbd306SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
6866dbbd306SMatthew G. Knepley     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
6876dbbd306SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
6886dbbd306SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
6896dbbd306SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dm, cells[0], x, &xL);CHKERRQ(ierr);
6906dbbd306SMatthew G. Knepley     ierr = DMPlexPointLocalRead(dm, cells[1], x, &xR);CHKERRQ(ierr);
691254c1ad2SMatthew G. Knepley     if (computeGradients) {
692254c1ad2SMatthew G. Knepley       PetscScalar dxL[3], dxR[3];
693254c1ad2SMatthew G. Knepley 
694254c1ad2SMatthew G. Knepley       ierr = DMPlexPointLocalRead(dmplexts->dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr);
695254c1ad2SMatthew G. Knepley       ierr = DMPlexPointLocalRead(dmplexts->dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr);
696254c1ad2SMatthew G. Knepley       WaxpyD(dim, -1, cgL->centroid, fg->centroid, dxL);
697254c1ad2SMatthew G. Knepley       WaxpyD(dim, -1, cgR->centroid, fg->centroid, dxR);
698254c1ad2SMatthew G. Knepley       for (d = 0; d < pdim; ++d) {
699254c1ad2SMatthew G. Knepley         uL[iface*pdim+d] = xL[d] + DotD(dim, &gL[d*dim], dxL);
700254c1ad2SMatthew G. Knepley         uR[iface*pdim+d] = xR[d] + DotD(dim, &gR[d*dim], dxR);
701254c1ad2SMatthew G. Knepley       }
702254c1ad2SMatthew G. Knepley     } else {
7036dbbd306SMatthew G. Knepley       for (d = 0; d < pdim; ++d) {
7046dbbd306SMatthew G. Knepley         uL[iface*pdim+d] = xL[d];
7056dbbd306SMatthew G. Knepley         uR[iface*pdim+d] = xR[d];
7066dbbd306SMatthew G. Knepley       }
707254c1ad2SMatthew G. Knepley     }
7086dbbd306SMatthew G. Knepley     for (d = 0; d < dim; ++d) {
7096dbbd306SMatthew G. Knepley       centroid[iface*dim+d] = fg->centroid[d];
7106dbbd306SMatthew G. Knepley       normal[iface*dim+d]   = fg->normal[d];
7116dbbd306SMatthew G. Knepley     }
7126dbbd306SMatthew G. Knepley     vol[iface*2+0] = cgL->volume;
7136dbbd306SMatthew G. Knepley     vol[iface*2+1] = cgR->volume;
7146dbbd306SMatthew G. Knepley     ++iface;
7156dbbd306SMatthew G. Knepley   }
716254c1ad2SMatthew G. Knepley   if (computeGradients) {
717254c1ad2SMatthew G. Knepley     ierr = VecRestoreArrayRead(locGrad,&lgrad);CHKERRQ(ierr);
718254c1ad2SMatthew G. Knepley     ierr = DMRestoreLocalVector(dmplexts->dmGrad, &locGrad);CHKERRQ(ierr);
719254c1ad2SMatthew G. Knepley   }
7206dbbd306SMatthew G. Knepley   ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr);
7216dbbd306SMatthew G. Knepley   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
7226dbbd306SMatthew G. Knepley   ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
7236dbbd306SMatthew G. Knepley   fgeom.v0  = centroid;
7246dbbd306SMatthew G. Knepley   fgeom.n   = normal;
7256dbbd306SMatthew G. Knepley   cgeom.vol = vol;
726254c1ad2SMatthew G. Knepley   /* Riemann solve */
727254c1ad2SMatthew G. Knepley   ierr = PetscFVIntegrateRHSFunction(fvm, numFaces, Nf, &fvm, 0, fgeom, cgeom, uL, uR, riemann, fluxL, fluxR, dmplexts->rhsfunctionlocalctx);CHKERRQ(ierr);
728254c1ad2SMatthew G. Knepley   /* Insert fluxes */
7296dbbd306SMatthew G. Knepley   ierr = VecGetArray(F, &f);CHKERRQ(ierr);
7306dbbd306SMatthew G. Knepley   for (face = fStart, iface = 0; face < fEnd; ++face) {
7316dbbd306SMatthew G. Knepley     const PetscInt *cells;
7326dbbd306SMatthew G. Knepley     PetscScalar    *fL, *fR;
7336dbbd306SMatthew G. Knepley     PetscInt        ghost, d;
7346dbbd306SMatthew G. Knepley 
7356dbbd306SMatthew G. Knepley     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
7366dbbd306SMatthew G. Knepley     if (ghost >= 0) continue;
7376dbbd306SMatthew G. Knepley     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
7386dbbd306SMatthew G. Knepley     ierr = DMPlexPointGlobalRef(dm, cells[0], f, &fL);CHKERRQ(ierr);
7396dbbd306SMatthew G. Knepley     ierr = DMPlexPointGlobalRef(dm, cells[1], f, &fR);CHKERRQ(ierr);
7406dbbd306SMatthew G. Knepley     for (d = 0; d < pdim; ++d) {
7416dbbd306SMatthew G. Knepley       if (fL) fL[d] -= fluxL[iface*pdim+d];
7426dbbd306SMatthew G. Knepley       if (fR) fR[d] += fluxR[iface*pdim+d];
7436dbbd306SMatthew G. Knepley     }
7446dbbd306SMatthew G. Knepley     ++iface;
7456dbbd306SMatthew G. Knepley   }
7466dbbd306SMatthew G. Knepley   ierr = VecRestoreArray(F, &f);CHKERRQ(ierr);
7476dbbd306SMatthew G. Knepley   ierr = PetscFree7(centroid,normal,vol,uL,uR,fluxL,fluxR);CHKERRQ(ierr);
748254c1ad2SMatthew G. Knepley   ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
749254c1ad2SMatthew G. Knepley   PetscFunctionReturn(0);
750254c1ad2SMatthew G. Knepley }
751254c1ad2SMatthew G. Knepley 
752254c1ad2SMatthew G. Knepley #undef __FUNCT__
753254c1ad2SMatthew G. Knepley #define __FUNCT__ "DMPlexTSSetRHSFunctionLocal"
754254c1ad2SMatthew G. Knepley /*@C
755254c1ad2SMatthew G. Knepley   DMPlexTSSetRHSFunctionLocal - set a local residual evaluation function
756254c1ad2SMatthew G. Knepley 
757254c1ad2SMatthew G. Knepley   Logically Collective
758254c1ad2SMatthew G. Knepley 
759254c1ad2SMatthew G. Knepley   Input Arguments:
760254c1ad2SMatthew G. Knepley + dm      - DM to associate callback with
761254c1ad2SMatthew G. Knepley . riemann - Riemann solver
762254c1ad2SMatthew G. Knepley - ctx     - optional context for Riemann solve
763254c1ad2SMatthew G. Knepley 
764254c1ad2SMatthew G. Knepley   Calling sequence for riemann:
765254c1ad2SMatthew G. Knepley 
766254c1ad2SMatthew G. Knepley $ riemann(const PetscReal x[], const PetscReal n[], const PetscScalar uL[], const PetscScalar uR[], PetscScalar flux[], void *ctx)
767254c1ad2SMatthew G. Knepley 
768254c1ad2SMatthew G. Knepley + x    - The coordinates at a point on the interface
769254c1ad2SMatthew G. Knepley . n    - The normal vector to the interface
770254c1ad2SMatthew G. Knepley . uL   - The state vector to the left of the interface
771254c1ad2SMatthew G. Knepley . uR   - The state vector to the right of the interface
772254c1ad2SMatthew G. Knepley . flux - output array of flux through the interface
773254c1ad2SMatthew G. Knepley - ctx  - optional user context
774254c1ad2SMatthew G. Knepley 
775254c1ad2SMatthew G. Knepley   Level: beginner
776254c1ad2SMatthew G. Knepley 
777254c1ad2SMatthew G. Knepley .seealso: DMTSSetRHSFunctionLocal()
778254c1ad2SMatthew G. Knepley @*/
779254c1ad2SMatthew G. Knepley PetscErrorCode DMPlexTSSetRHSFunctionLocal(DM dm, void (*riemann)(const PetscReal x[], const PetscReal n[], const PetscScalar uL[], const PetscScalar uR[], PetscScalar flux[], void *ctx), void *ctx)
780254c1ad2SMatthew G. Knepley {
781254c1ad2SMatthew G. Knepley   DMTS           dmts;
782254c1ad2SMatthew G. Knepley   DMTS_Plex     *dmplexts;
783254c1ad2SMatthew G. Knepley   PetscFV        fvm;
784254c1ad2SMatthew G. Knepley   PetscInt       Nf;
785254c1ad2SMatthew G. Knepley   PetscBool      computeGradients;
786254c1ad2SMatthew G. Knepley   PetscErrorCode ierr;
787254c1ad2SMatthew G. Knepley 
788254c1ad2SMatthew G. Knepley   PetscFunctionBegin;
789254c1ad2SMatthew G. Knepley   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
790254c1ad2SMatthew G. Knepley   ierr = DMGetDMTSWrite(dm, &dmts);CHKERRQ(ierr);
791254c1ad2SMatthew G. Knepley   ierr = DMPlexTSGetContext(dm, dmts, &dmplexts);CHKERRQ(ierr);
792254c1ad2SMatthew G. Knepley   dmplexts->riemann             = riemann;
793254c1ad2SMatthew G. Knepley   dmplexts->rhsfunctionlocalctx = ctx;
794254c1ad2SMatthew G. Knepley   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
795254c1ad2SMatthew G. Knepley   ierr = DMGetField(dm, 0, (PetscObject *) &fvm);CHKERRQ(ierr);
796254c1ad2SMatthew G. Knepley   ierr = DMPlexTSSetupGeometry(dm, fvm, dmplexts);CHKERRQ(ierr);
797254c1ad2SMatthew G. Knepley   ierr = PetscFVGetComputeGradients(fvm, &computeGradients);CHKERRQ(ierr);
798254c1ad2SMatthew G. Knepley   if (computeGradients) {ierr = DMPlexTSSetupGradient(dm, fvm, dmplexts);CHKERRQ(ierr);}
799254c1ad2SMatthew G. Knepley   ierr = DMTSSetRHSFunction(dm, TSComputeRHSFunction_DMPlex, dmplexts);CHKERRQ(ierr);
8006dbbd306SMatthew G. Knepley   PetscFunctionReturn(0);
8016dbbd306SMatthew G. Knepley }
802