Actual source code: linear.c

  1: #ifdef PETSC_RCS_HEADER
  2: static char vcid[] = "$Id: linear.c,v 1.7 2000/01/10 03:54:15 knepley Exp $";
  3: #endif

  5: /*
  6:    Defines piecewise linear function space on a two dimensional 
  7:    grid. Suitable for finite element type discretization of a PDE.
  8: */

 10: #include "src/grid/discretization/discimpl.h"         /*I "discretization.h" I*/
 11: #include "src/mesh/impls/triangular/triimpl.h"

 13: extern int DiscTransformCoords_Triangular_2D_Quadratic(double, double, double *, double *, double *);

 15: /* For precomputed integrals, the table is structured as follows:

 17:      precompInt[op,i,j] = int_{SE} <op phi^i(xi,eta), phi^j(xi,eta)> |J^{-1}|

 19:    where we recall that |J| is a constant for linear affine maps,
 20:    and the map of any triangle to the standard element is linear.
 21:    The numbering of the nodes in the standard element is

 23:                  3
 24:                  |
 25:                  | 
 26:                  |  
 27:                  |   
 28:                  1----2
 29: */

 31: static int DiscDestroy_Triangular_2D_Linear(Discretization disc) {
 33:   return(0);
 34: }

 36: static int DiscView_Triangular_2D_Linear_File(Discretization disc, PetscViewer viewer) {
 38:   PetscViewerASCIIPrintf(viewer, "Linear discretizationn");
 39:   PetscViewerASCIIPrintf(viewer, "    %d shape functions per componentn", disc->funcs);
 40:   PetscViewerASCIIPrintf(viewer, "    %d registered operatorsn", disc->numOps);
 41:   return(0);
 42: }

 44: static int DiscView_Triangular_2D_Linear(Discretization disc, PetscViewer viewer) {
 45:   PetscTruth isascii;
 46:   int        ierr;

 49:   PetscTypeCompare((PetscObject) viewer, PETSC_VIEWER_ASCII, &isascii);
 50:   if (isascii == PETSC_TRUE) {
 51:     DiscView_Triangular_2D_Linear_File(disc, viewer);
 52:   }
 53:   return(0);
 54: }

 56: static int DiscEvaluateFunctionGalerkin_Triangular_2D_Linear(Discretization disc, Mesh mesh, PointFunction f, PetscScalar alpha,
 57:                                                              int elem, PetscScalar *array, void *ctx)
 58: {
 59:   Mesh_Triangular *tri            = (Mesh_Triangular *) mesh->data;
 60:   double          *nodes          = tri->nodes;
 61:   int             *elements       = tri->faces;
 62:   int              corners        = mesh->numCorners;
 63:   int              dim            = disc->dim;
 64:   int              comp           = disc->comp;           /* The number of components in this field */
 65:   int              funcs          = disc->funcs;          /* The number of shape functions per component */
 66:   PetscScalar     *funcVal        = disc->funcVal;        /* Function value at a quadrature point */
 67:   int              numQuadPoints  = disc->numQuadPoints;  /* Number of points used for Gaussian quadrature */
 68:   double          *quadPoints     = disc->quadPoints;     /* Points in the standard element for Gaussian quadrature */
 69:   double          *quadWeights    = disc->quadWeights;    /* Weights in the standard element for Gaussian quadrature */
 70:   double          *quadShapeFuncs = disc->quadShapeFuncs; /* Shape function evaluated at quadrature points */
 71:   double           jac;                                   /* |J| for map to standard element */
 72:   double           x, y;                                  /* The integration point */
 73:   double           x11, y11, x21, y21, x31, y31;
 74:   int              rank = -1;
 75:   int              i, j, k, p;
 76: #ifdef PETSC_USE_BOPT_g
 77:   PetscTruth       opt;
 78: #endif
 79:   int              ierr;

 82:   MPI_Comm_rank(disc->comm, &rank);

 84:   /* For dummy collective calls */
 85:   if (array == PETSC_NULL) {
 86:     for(p = 0; p < numQuadPoints; p++) {
 87:       (*f)(0, 0, PETSC_NULL, PETSC_NULL, PETSC_NULL, PETSC_NULL, ctx);
 88:     }
 89:     return(0);
 90:   }

 92: #ifdef PETSC_USE_BOPT_g
 93:   if ((elem < 0) || (elem >= mesh->part->numOverlapElements)) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Invalid element");
 94: #endif
 95:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element
 96:      which must be a constant for linear elements */
 97:   x11 = nodes[elements[elem*corners]*dim];
 98:   y11 = nodes[elements[elem*corners]*dim+1];
 99:   if (mesh->isPeriodic == PETSC_TRUE) {
100:     x21 = MeshPeriodicDiffX(mesh, nodes[elements[elem*corners+1]*dim]   - x11);
101:     x31 = MeshPeriodicDiffX(mesh, nodes[elements[elem*corners+2]*dim]   - x11);
102:     y21 = MeshPeriodicDiffY(mesh, nodes[elements[elem*corners+1]*dim+1] - y11);
103:     y31 = MeshPeriodicDiffY(mesh, nodes[elements[elem*corners+2]*dim+1] - y11);
104:   } else {
105:     x21 = nodes[elements[elem*corners+1]*dim]   - x11;
106:     x31 = nodes[elements[elem*corners+2]*dim]   - x11;
107:     y21 = nodes[elements[elem*corners+1]*dim+1] - y11;
108:     y31 = nodes[elements[elem*corners+2]*dim+1] - y11;
109:   }
110:   jac = PetscAbsReal(x21*y31 - x31*y21);
111:   if (jac < 1.0e-14) {
112:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %gn", rank, elem, x21, y21, x31, y31);
113:     SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
114:   }
115: #ifdef PETSC_USE_BOPT_g
116:   PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
117:   if (opt == PETSC_TRUE) {
118:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %g jac: %gn",
119:                 rank, elem, x21, y21, x31, y31, jac);
120:   }
121: #endif

123:   /* Calculate element vector entries by Gaussian quadrature */
124:   for(p = 0; p < numQuadPoints; p++) {
125:     x    = MeshPeriodicX(mesh, x21*quadPoints[p*dim] + x31*quadPoints[p*dim+1] + x11);
126:     y    = MeshPeriodicY(mesh, y21*quadPoints[p*dim] + y31*quadPoints[p*dim+1] + y11);
127:     (*f)(1, comp, &x, &y, PETSC_NULL, funcVal, ctx);
128: #ifdef PETSC_USE_BOPT_g
129:     PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
130:     if (opt == PETSC_TRUE) {
131:       PetscPrintf(PETSC_COMM_SELF, "[%d]p:%d jac: %g", rank, p, jac);
132:       for(j = 0; j < comp; j++) PetscPrintf(PETSC_COMM_SELF, " func[%d]: %g", j, PetscRealPart(funcVal[j]));
133:       PetscPrintf(PETSC_COMM_SELF, "n");
134:   }
135: #endif

137:     for(i = 0, k = 0; i < funcs; i++) {
138:       for(j = 0; j < comp; j++, k++) {
139:         array[k] += alpha*funcVal[j]*quadShapeFuncs[p*funcs+i]*jac*quadWeights[p];
140: #ifdef PETSC_USE_BOPT_g
141:         PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
142:         if (opt == PETSC_TRUE) {
143:           PetscPrintf(PETSC_COMM_SELF, "[%d]  array[%d]: %gn", rank, k, PetscRealPart(array[k]));
144:         }
145: #endif
146:       }
147:     }
148:   }
149:   PetscLogFlops(7 + (8 + 5*funcs*comp) * numQuadPoints);
150:   return(0);
151: }

153: static int DiscEvaluateOperatorGalerkin_Triangular_2D_Linear(Discretization disc, Mesh mesh, int elemSize,
154:                                                              int rowStart, int colStart, int op, PetscScalar alpha,
155:                                                              int elem, PetscScalar *field, PetscScalar *mat, void *ctx)
156: {
157:   Mesh_Triangular *tri        = (Mesh_Triangular *) mesh->data;
158:   double          *nodes      = tri->nodes;          /* The node coordinates */
159:   int             *elements   = tri->faces;          /* The element corners */
160:   int              numCorners = mesh->numCorners;    /* The number of corners per element */
161:   int              dim        = disc->dim;
162:   Operator         oper       = disc->operators[op]; /* The operator to discretize */
163:   Discretization   test       = oper->test;          /* The space of test functions */
164:   OperatorFunction opFunc     = oper->opFunc;        /* Integrals of operators which depend on J */
165:   PetscScalar     *precompInt = oper->precompInt;    /* Precomputed integrals of the operator on shape functions */
166:   int              rowSize    = test->size;          /* The number of shape functions per element */
167:   int              colSize    = disc->size;          /* The number of test  functions per element */
168:   double           x21, x31, y21, y31;               /* Coordinates of the element, with point 1 at the origin */
169:   double           jac;                              /* |J| for map to standard element */
170:   double           coords[MAX_CORNERS*2];            /* Coordinates of the element */
171:   int              rank;
172:   int              i, j, f;
173:   int              ierr;

176:   MPI_Comm_rank(disc->comm, &rank);
177: #ifdef PETSC_USE_BOPT_g
178:   /* Check for valid operator */
179:   if ((op < 0) || (op >= disc->numOps) || (!disc->operators[op])) SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
180: #endif

182:   if (precompInt != PETSC_NULL) {
183:     /* Calculate the determinant of the inverse Jacobian of the map to the standard element
184:        which must be a constant for linear elements - 1/|x_{21} y_{31} - x_{31} y_{21}| */
185:     if (mesh->isPeriodic == PETSC_TRUE) {
186:       x21 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+1]*dim]   - nodes[elements[elem*numCorners]*dim]);
187:       x31 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+2]*dim]   - nodes[elements[elem*numCorners]*dim]);
188:       y21 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+1]*dim+1] - nodes[elements[elem*numCorners]*dim+1]);
189:       y31 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+2]*dim+1] - nodes[elements[elem*numCorners]*dim+1]);
190:     } else {
191:       x21 = nodes[elements[elem*numCorners+1]*dim]   - nodes[elements[elem*numCorners]*dim];
192:       x31 = nodes[elements[elem*numCorners+2]*dim]   - nodes[elements[elem*numCorners]*dim];
193:       y21 = nodes[elements[elem*numCorners+1]*dim+1] - nodes[elements[elem*numCorners]*dim+1];
194:       y31 = nodes[elements[elem*numCorners+2]*dim+1] - nodes[elements[elem*numCorners]*dim+1];
195:     }
196:     jac = PetscAbsReal(x21*y31 - x31*y21);
197:     if (jac < 1.0e-14) {
198:       PetscPrintf(PETSC_COMM_SELF, "[%d]x21: %g y21: %g x31: %g y31: %g jac: %gn", rank, x21, y21, x31, y31, jac);
199:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
200:     }

202:     /* Calculate element matrix entries which are all precomputed */
203:     for(i = 0; i < rowSize; i++) {
204:       for(j = 0; j < colSize; j++) {
205:         mat[(i+rowStart)*elemSize + j+colStart] += alpha*precompInt[i*colSize + j]*jac;
206:       }
207:     }
208:     PetscLogFlops(7 + 2*rowSize*colSize);
209:   } else {
210:     if (opFunc == PETSC_NULL) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid function");
211:     if (mesh->isPeriodic == PETSC_TRUE) {
212:       coords[0*dim+0] = nodes[elements[elem*numCorners+0]*dim+0];
213:       coords[0*dim+1] = nodes[elements[elem*numCorners+0]*dim+1];
214:       for(f = 1; f < PetscMax(disc->funcs, test->funcs); f++) {
215:         coords[f*dim+0] = MeshPeriodicRelativeX(mesh, nodes[elements[elem*numCorners+f]*dim+0], coords[0*dim+0]);
216:         coords[f*dim+1] = MeshPeriodicRelativeY(mesh, nodes[elements[elem*numCorners+f]*dim+1], coords[0*dim+1]);
217:       }
218:     } else {
219:       for(f = 0; f < PetscMax(disc->funcs, test->funcs); f++) {
220:         coords[f*dim+0] = nodes[elements[elem*numCorners+f]*dim+0];
221:         coords[f*dim+1] = nodes[elements[elem*numCorners+f]*dim+1];
222:       }
223:     }

225:     (*opFunc)(disc, test, rowSize, colSize, rowStart, colStart, elemSize, coords, alpha, field, mat, ctx);
226: 
227:   }
228:   return(0);
229: }

231: static int DiscEvaluateNonlinearOperatorGalerkin_Triangular_2D_Linear(Discretization disc, Mesh mesh, NonlinearOperator f,
232:                                                                       PetscScalar alpha, int elem, int numArgs, PetscScalar **field,
233:                                                                       PetscScalar *vec, void *ctx)
234: {
235:   Mesh_Triangular *tri        = (Mesh_Triangular *) mesh->data;
236:   double          *nodes      = tri->nodes;      /* The node coordinates */
237:   int             *elements   = tri->faces;      /* The element corners */
238:   int              numCorners = mesh->numCorners; /* The number of corners per element */
239:   int              dim        = disc->dim;
240:   int              comp       = disc->comp;      /* The number of components in this field */
241:   int              funcs      = disc->funcs;     /* The number of shape functions per component */
242:   PetscScalar     *funcVal    = disc->funcVal;   /* Function value at a quadrature point */
243:   PetscScalar    **fieldVal   = disc->fieldVal;  /* Field value and derivatives at a quadrature point */
244:   double           jac;                          /* |J| for map to standard element */
245:   double           invjac;                       /* |J^{-1}| for map from standard element */
246:   int              numQuadPoints;                /* Number of points used for Gaussian quadrature */
247:   double          *quadPoints;                   /* Points in the standard element for Gaussian quadrature */
248:   double          *quadWeights;                  /* Weights in the standard element for Gaussian quadrature */
249:   double          *quadShapeFuncs;               /* Shape function evaluated at quadrature points */
250:   double          *quadShapeFuncDers;            /* Shape function derivatives evaluated at quadrature points */
251:   double           x, y;                         /* The integration point */
252:   double           dxix;                         /* PartDer{xi}{x}  */
253:   double           detx;                         /* PartDer{eta}{x} */
254:   double           dxiy;                         /* PartDer{xi}{y}  */
255:   double           dety;                         /* PartDer{eta}{y} */
256:   PetscScalar      dfxi;                         /* PartDer{field}{xi}  */
257:   PetscScalar      dfet;                         /* PartDer{field}{eta} */
258:   double           x11, y11, x21, y21, x31, y31;
259:   int              rank = -1;
260:   int              i, j, k, p, func, arg;
261: #ifdef PETSC_USE_BOPT_g
262:   PetscTruth       opt;
263: #endif
264:   int              ierr;

267:   if (numArgs > 2) SETERRQ(PETSC_ERR_SUP, "Only configured to handle two nonlinear arguments");
268:   MPI_Comm_rank(disc->comm, &rank);
269:   numQuadPoints     = disc->numQuadPoints;
270:   quadPoints        = disc->quadPoints;
271:   quadWeights       = disc->quadWeights;
272:   quadShapeFuncs    = disc->quadShapeFuncs;
273:   quadShapeFuncDers = disc->quadShapeFuncDers;
274: 
275:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element
276:      which must be a constant for linear elements */
277:   x11 = nodes[elements[elem*numCorners]*dim];
278:   y11 = nodes[elements[elem*numCorners]*dim+1];
279:   if (mesh->isPeriodic == PETSC_TRUE) {
280:     x21 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+1]*dim]   - x11);
281:     x31 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+2]*dim]   - x11);
282:     y21 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+1]*dim+1] - y11);
283:     y31 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+2]*dim+1] - y11);
284:   } else {
285:     x21 = nodes[elements[elem*numCorners+1]*dim]   - x11;
286:     x31 = nodes[elements[elem*numCorners+2]*dim]   - x11;
287:     y21 = nodes[elements[elem*numCorners+1]*dim+1] - y11;
288:     y31 = nodes[elements[elem*numCorners+2]*dim+1] - y11;
289:   }
290:   jac = PetscAbsReal(x21*y31 - x31*y21);
291:   if (jac < 1.0e-14) {
292:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %gn", rank, elem, x21, y21, x31, y31);
293:     SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
294:   }
295: #ifdef PETSC_USE_BOPT_g
296:   PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
297:   if (opt == PETSC_TRUE) {
298:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %g jac: %gn",
299:                 rank, elem, x21, y21, x31, y31, jac);
300:   }
301: #endif

303:   /* These are the elements of the inverse matrix */
304:   invjac = 1/jac;
305:   dxix =  y31*invjac;
306:   dxiy = -x31*invjac;
307:   detx = -y21*invjac;
308:   dety =  x21*invjac;

310:   /* Calculate element vector entries by Gaussian quadrature */
311:   for(p = 0; p < numQuadPoints; p++) {
312:     x = MeshPeriodicX(mesh, x21*quadPoints[p*dim] + x31*quadPoints[p*dim+1] + x11);
313:     y = MeshPeriodicY(mesh, y21*quadPoints[p*dim] + y31*quadPoints[p*dim+1] + y11);
314:     /* Can this be simplified? */
315:     for(arg = 0; arg < numArgs; arg++) {
316:       for(j = 0; j < comp*(dim+1); j++) fieldVal[arg][j] = 0.0;
317:       for(func = 0; func < funcs; func++) {
318:         for(j = 0; j < comp; j++) {
319:           fieldVal[arg][j*(dim+1)]   += field[arg][func*comp+j]*quadShapeFuncs[p*funcs+func];
320:           fieldVal[arg][j*(dim+1)+1] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*dim+func*dim];
321:           fieldVal[arg][j*(dim+1)+2] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*dim+func*dim+1];
322:         }
323:       }
324:     }

326:     /* Convert the field derivatives to old coordinates */
327:     for(arg = 0; arg < numArgs; arg++) {
328:       for(j = 0; j < comp; j++) {
329:         dfxi                       = fieldVal[arg][j*(dim+1)+1];
330:         dfet                       = fieldVal[arg][j*(dim+1)+2];
331:         fieldVal[arg][j*(dim+1)+1] = dfxi*dxix + dfet*detx;
332:         fieldVal[arg][j*(dim+1)+2] = dfxi*dxiy + dfet*dety;
333:       }
334:     }

336:     (*f)(1, comp, &x, &y, PETSC_NULL, numArgs, fieldVal, funcVal, ctx);
337: #ifdef PETSC_USE_BOPT_g
338:     PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
339:     if (opt == PETSC_TRUE) {
340:       PetscPrintf(PETSC_COMM_SELF, "[%d]p:%d jac: %g", rank, p, jac);
341:       for(j = 0; j < comp; j++)
342:         PetscPrintf(PETSC_COMM_SELF, " func[%d]: %g", j, PetscRealPart(funcVal[j]));
343:       PetscPrintf(PETSC_COMM_SELF, "n");
344:     }
345: #endif

347:     for(i = 0, k = 0; i < funcs; i++) {
348:       for(j = 0; j < comp; j++, k++) {
349:         vec[k] += alpha*funcVal[j]*quadShapeFuncs[p*funcs+i]*jac*quadWeights[p];
350: #ifdef PETSC_USE_BOPT_g
351:         PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
352:         if (opt == PETSC_TRUE) {
353:           PetscPrintf(PETSC_COMM_SELF, "[%d]  vec[%d]: %gn", rank, k, PetscRealPart(vec[k]));
354:         }
355: #endif
356:       }
357:     }
358:   }
359:   PetscLogFlops(12 + (8 + (6*numArgs + 5)*funcs*comp + 6*numArgs*comp) * numQuadPoints);
360:   return(0);
361: }

363: static int DiscEvaluateALEOperatorGalerkin_Triangular_2D_Linear(Discretization disc, Mesh mesh, int elemSize,
364:                                                                 int rowStart, int colStart, int op, PetscScalar alpha,
365:                                                                 int elem, PetscScalar *field, PetscScalar *ALEfield, PetscScalar *mat,
366:                                                                 void *ctx)
367: {
368:   Mesh_Triangular    *tri        = (Mesh_Triangular *) mesh->data;
369:   double             *nodes      = tri->nodes;          /* The node coordinates */
370:   int                *elements   = tri->faces;          /* The element corners */
371:   int                 numCorners = mesh->numCorners;    /* The number of corners per element */
372:   int                 dim        = disc->dim;
373:   Operator            oper       = disc->operators[op]; /* The operator to discretize */
374:   Discretization      test       = oper->test;          /* The space of test functions */
375:   ALEOperatorFunction opFunc     = oper->ALEOpFunc;     /* Integrals of operators which depend on J */
376:   int                 rowSize    = test->size;          /* The number of shape functions per element */
377:   int                 colSize    = disc->size;          /* The number of test  functions per element */
378:   double              coords[MAX_CORNERS*2];            /* Coordinates of the element */
379:   int                 f;
380:   int                 ierr;

383: #ifdef PETSC_USE_BOPT_g
384:   /* Check for valid operator */
385:   if ((op < 0) || (op >= disc->numOps) || (!disc->operators[op])) SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
386: #endif

388:   if (opFunc == PETSC_NULL) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid function");
389:   if (mesh->isPeriodic == PETSC_TRUE) {
390:     coords[0*dim+0] = nodes[elements[elem*numCorners+0]*dim+0];
391:     coords[0*dim+1] = nodes[elements[elem*numCorners+0]*dim+1];
392:     for(f = 1; f < PetscMax(disc->funcs, test->funcs); f++) {
393:       coords[f*dim+0] = MeshPeriodicRelativeX(mesh, nodes[elements[elem*numCorners+f]*dim+0], coords[0*dim+0]);
394:       coords[f*dim+1] = MeshPeriodicRelativeY(mesh, nodes[elements[elem*numCorners+f]*dim+1], coords[0*dim+1]);
395:     }
396:   } else {
397:     for(f = 0; f < PetscMax(disc->funcs, test->funcs); f++) {
398:       coords[f*dim+0] = nodes[elements[elem*numCorners+f]*dim+0];
399:       coords[f*dim+1] = nodes[elements[elem*numCorners+f]*dim+1];
400:     }
401:   }

403:   (*opFunc)(disc, test, rowSize, colSize, rowStart, colStart, elemSize, coords, alpha, field, ALEfield, mat, ctx);
404: 
405:   return(0);
406: }

408: static int DiscEvaluateNonlinearALEOperatorGalerkin_Triangular_2D_Linear(Discretization disc, Mesh mesh, NonlinearOperator f,
409:                                                                          PetscScalar alpha, int elem, int numArgs, PetscScalar **field,
410:                                                                          PetscScalar *ALEfield, PetscScalar *vec, void *ctx)
411: {
412:   Mesh_Triangular *tri        = (Mesh_Triangular *) mesh->data;
413:   double          *nodes      = tri->nodes;      /* The node coordinates */
414:   int             *elements   = tri->faces;      /* The element corners */
415:   int              numCorners = mesh->numCorners; /* The number of corners per element */
416:   int              dim        = disc->dim;
417:   int              comp       = disc->comp;      /* The number of components in this field */
418:   int              funcs      = disc->funcs;     /* The number of shape functions per component */
419:   PetscScalar     *funcVal    = disc->funcVal;   /* Function value at a quadrature point */
420:   PetscScalar    **fieldVal   = disc->fieldVal;  /* Field value and derivatives at a quadrature point */
421:   double           jac;                          /* |J| for map to standard element */
422:   double           invjac;                       /* |J^{-1}| for map from standard element */
423:   int              numQuadPoints;                /* Number of points used for Gaussian quadrature */
424:   double          *quadPoints;                   /* Points in the standard element for Gaussian quadrature */
425:   double          *quadWeights;                  /* Weights in the standard element for Gaussian quadrature */
426:   double          *quadShapeFuncs;               /* Shape function evaluated at quadrature points */
427:   double          *quadShapeFuncDers;            /* Shape function derivatives evaluated at quadrature points */
428:   double           x, y;                         /* The integration point */
429:   double           dxix;                         /* PartDer{xi}{x}  */
430:   double           detx;                         /* PartDer{eta}{x} */
431:   double           dxiy;                         /* PartDer{xi}{y}  */
432:   double           dety;                         /* PartDer{eta}{y} */
433:   PetscScalar      dfxi;                         /* PartDer{field}{xi}  */
434:   PetscScalar      dfet;                         /* PartDer{field}{eta} */
435:   double           x11, y11, x21, y21, x31, y31;
436:   int              rank;
437:   int              i, j, k, p, func, arg;
438: #ifdef PETSC_USE_BOPT_g
439:   PetscTruth       opt;
440: #endif
441:   int              ierr;

444:   if (numArgs > 2) SETERRQ(PETSC_ERR_SUP, "Only configured to handle two nonlinear arguments");
445:   MPI_Comm_rank(disc->comm, &rank);

447:   numQuadPoints     = disc->numQuadPoints;
448:   quadPoints        = disc->quadPoints;
449:   quadWeights       = disc->quadWeights;
450:   quadShapeFuncs    = disc->quadShapeFuncs;
451:   quadShapeFuncDers = disc->quadShapeFuncDers;
452: 
453:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element
454:      which must be a constant for linear elements */
455:   x11 = nodes[elements[elem*numCorners]*dim];
456:   y11 = nodes[elements[elem*numCorners]*dim+1];
457:   if (mesh->isPeriodic == PETSC_TRUE) {
458:     x21 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+1]*dim]   - x11);
459:     x31 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+2]*dim]   - x11);
460:     y21 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+1]*dim+1] - y11);
461:     y31 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+2]*dim+1] - y11);
462:   } else {
463:     x21 = nodes[elements[elem*numCorners+1]*dim]   - x11;
464:     x31 = nodes[elements[elem*numCorners+2]*dim]   - x11;
465:     y21 = nodes[elements[elem*numCorners+1]*dim+1] - y11;
466:     y31 = nodes[elements[elem*numCorners+2]*dim+1] - y11;
467:   }
468:   jac = PetscAbsReal(x21*y31 - x31*y21);
469:   if (jac < 1.0e-14) {
470:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %gn", rank, elem, x21, y21, x31, y31);
471:     SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
472:   }
473: #ifdef PETSC_USE_BOPT_g
474:   PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
475:   if (opt == PETSC_TRUE) {
476:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %g jac: %gn",
477:                 rank, elem, x21, y21, x31, y31, jac);
478:   }
479: #endif

481:   /* These are the elements of the inverse matrix */
482:   invjac = 1/jac;
483:   dxix =  y31*invjac;
484:   dxiy = -x31*invjac;
485:   detx = -y21*invjac;
486:   dety =  x21*invjac;

488:   /* Calculate element vector entries by Gaussian quadrature */
489:   for(p = 0; p < numQuadPoints; p++) {
490:     x = MeshPeriodicX(mesh, x21*quadPoints[p*dim] + x31*quadPoints[p*dim+1] + x11);
491:     y = MeshPeriodicY(mesh, y21*quadPoints[p*dim] + y31*quadPoints[p*dim+1] + y11);
492:     /* Can this be simplified? */
493:     for(arg = 0; arg < numArgs; arg++) {
494:       for(j = 0; j < comp*(dim+1); j++) fieldVal[arg][j] = 0.0;
495:       for(func = 0; func < funcs; func++)
496:         for(j = 0; j < comp; j++) {
497:           fieldVal[arg][j*(dim+1)]   += (field[arg][func*comp+j] - ALEfield[func*comp+j])*quadShapeFuncs[p*funcs+func];
498:           fieldVal[arg][j*(dim+1)+1] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*dim+func*dim];
499:           fieldVal[arg][j*(dim+1)+2] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*dim+func*dim+1];
500:         }
501:     }

503:     /* Convert the field derivatives to old coordinates */
504:     for(arg = 0; arg < numArgs; arg++) {
505:       for(j = 0; j < comp; j++) {
506:         dfxi                       = fieldVal[arg][j*(dim+1)+1];
507:         dfet                       = fieldVal[arg][j*(dim+1)+2];
508:         fieldVal[arg][j*(dim+1)+1] = dfxi*dxix + dfet*detx;
509:         fieldVal[arg][j*(dim+1)+2] = dfxi*dxiy + dfet*dety;
510:       }
511:     }

513:     (*f)(1, comp, &x, &y, PETSC_NULL, numArgs, fieldVal, funcVal, ctx);
514: #ifdef PETSC_USE_BOPT_g
515:     PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
516:     if (opt == PETSC_TRUE) {
517:       PetscPrintf(PETSC_COMM_SELF, "[%d]p:%d jac: %g", rank, p, jac);
518:       for(j = 0; j < comp; j++)
519:         PetscPrintf(PETSC_COMM_SELF, " func[%d]: %g", j, PetscRealPart(funcVal[j]));
520:       PetscPrintf(PETSC_COMM_SELF, "n");
521:     }
522: #endif

524:     for(i = 0, k = 0; i < funcs; i++) {
525:       for(j = 0; j < comp; j++, k++) {
526:         vec[k] += alpha*funcVal[j]*quadShapeFuncs[p*funcs+i]*jac*quadWeights[p];
527: #ifdef PETSC_USE_BOPT_g
528:         PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
529:         if (opt == PETSC_TRUE) {
530:           PetscPrintf(PETSC_COMM_SELF, "[%d]  vec[%d]: %gn", rank, k, PetscRealPart(vec[k]));
531:         }
532: #endif
533:       }
534:     }
535:   }
536:   PetscLogFlops(12 + (8 + (7*numArgs + 5)*funcs*comp + 6*numArgs*comp) * numQuadPoints);
537:   return(0);
538: }

540: int Laplacian_Triangular_2D_Linear(Discretization disc, Discretization test, int rowSize, int colSize,
541:                                    int globalRowStart, int globalColStart, int globalSize, double *coords,
542:                                    PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
543: {
544:   double      x21, x31, y21, y31; /* Coordinates of the element, with point 1 at the origin */
545:   double      jac;                /* |J| for map to standard element */
546:   PetscScalar w;                  /* 1/(2 jac) */
547:   int         comp;               /* Number of components */
548:   int         i;

551:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element
552:      which must be a constant for linear elements - 1/|x_{21} y_{31} - x_{31} y_{21}| */
553:   x21 = coords[2] - coords[0];
554:   x31 = coords[4] - coords[0];
555:   y21 = coords[3] - coords[1];
556:   y31 = coords[5] - coords[1];
557:   jac = PetscAbsReal(x21*y31 - x31*y21);
558: #ifdef PETSC_USE_BOPT_g
559:   if (jac < 1.0e-14) {
560:     PetscPrintf(PETSC_COMM_SELF, "x21: %g y21: %g x31: %g y31: %g jac: %gn", x21, y21, x31, y31, jac);
561:     SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
562:   }
563: #endif

565:   comp = rowSize/disc->funcs;
566:   w    = 1.0/(2.0*jac);
567:   w   *= alpha;
568:   for(i = 0; i < comp; i++) {
569:     /* phi^1 phi^1 */
570:     array[(0*comp+i+globalRowStart)*globalSize + 0*comp+i+globalColStart] =
571:                         (-x21*x21 + 2.0*x21*x31 - x31*x31 - (y21 - y31)*(y21 - y31))*w;
572:     /* phi^1 phi^2 */
573:     array[(0*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart] = (-x21*x31 + x31*x31 + y31*(y31 - y21))*w;
574:     /* phi^1 phi^3 */
575:     array[(0*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart] = (x21*x21 - x21*x31 + y21*(y21 - y31))*w;
576:     /* phi^2 phi^1 */
577:     array[(1*comp+i+globalRowStart)*globalSize + 0*comp+i+globalColStart] =
578:                         array[(0*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart];
579:     /* phi^2 phi^2 */
580:     array[(1*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart] = (-x31*x31 - y31*y31)*w;
581:     /* phi^2 phi^3 */
582:     array[(1*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart] = (x21*x31 + y21*y31)*w;
583:     /* phi^3 phi^1 */
584:     array[(2*comp+i+globalRowStart)*globalSize + 0*comp+i+globalColStart] =
585:                         array[(0*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart];
586:     /* phi^3 phi^2 */
587:     array[(2*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart] =
588:                         array[(1*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart];
589:     /* phi^3 phi^3 */
590:     array[(2*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart] = (-x21*x21 - y21*y21)*w;
591:   }
592:   PetscLogFlops(47);

594:   return(0);
595: }

597: int Weighted_Laplacian_Triangular_2D_Linear(Discretization disc, Discretization test, int rowSize, int colSize,
598:                                             int globalRowStart, int globalColStart, int globalSize, double *coords,
599:                                             PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
600: {
601:   double               x21, x31, y21, y31; /* Coordinates of the element, with point 1 at the origin */
602: #ifdef PETSC_USE_BOPT_g
603:   double               jac;                /* |J| for map to standard element */
604: #endif
605:   PetscScalar          w;                  /* 1/2 */
606:   int                  comp;               /* Number of components */
607:   int                  i;

609:   /* Each element is weighted by its Jacobian. This is supposed to make smaller elements "stiffer". */
611:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element
612:      which must be a constant for linear elements - 1/|x_{21} y_{31} - x_{31} y_{21}| */
613:   x21 = coords[2] - coords[0];
614:   x31 = coords[4] - coords[0];
615:   y21 = coords[3] - coords[1];
616:   y31 = coords[5] - coords[1];
617: #ifdef PETSC_USE_BOPT_g
618:   jac = PetscAbsReal(x21*y31 - x31*y21);
619:   if (jac < 1.0e-14) {
620:     PetscPrintf(PETSC_COMM_SELF, "x21: %g y21: %g x31: %g y31: %g jac: %gn", x21, y21, x31, y31, jac);
621:     SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
622:   }
623: #endif

625:   comp = rowSize/3;
626:   w  = 1.0/(2.0);
627:   w *= alpha;
628:   for(i = 0; i < comp; i++)
629:   {
630:     /* phi^1 phi^1 */
631:     array[(0*comp+i+globalRowStart)*globalSize + 0*comp+i+globalColStart] =
632:                         (-x21*x21 + 2.0*x21*x31 - x31*x31 - (y21 - y31)*(y21 - y31))*w;
633:     /* phi^1 phi^2 */
634:     array[(0*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart] = (-x21*x31 + x31*x31 + y31*(y31 - y21))*w;
635:     /* phi^1 phi^3 */
636:     array[(0*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart] = (x21*x21 - x21*x31 + y21*(y21 - y31))*w;
637:     /* phi^2 phi^1 */
638:     array[(1*comp+i+globalRowStart)*globalSize + 0*comp+i+globalColStart] =
639:                         array[(0*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart];
640:     /* phi^2 phi^2 */
641:     array[(1*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart] = (-x31*x31 - y31*y31)*w;
642:     /* phi^2 phi^3 */
643:     array[(1*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart] = (x21*x31 + y21*y31)*w;
644:     /* phi^3 phi^1 */
645:     array[(2*comp+i+globalRowStart)*globalSize + 0*comp+i+globalColStart] =
646:                         array[(0*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart];
647:     /* phi^3 phi^2 */
648:     array[(2*comp+i+globalRowStart)*globalSize + 1*comp+i+globalColStart] =
649:                         array[(1*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart];
650:     /* phi^3 phi^3 */
651:     array[(2*comp+i+globalRowStart)*globalSize + 2*comp+i+globalColStart] = (-x21*x21 - y21*y21)*w;
652:   }
653:   PetscLogFlops(47);

655:   return(0);
656: }

658: int Gradient_Triangular_2D_Linear(Discretization disc, Discretization test, int rowSize, int colSize,
659:                                   int globalRowStart, int globalColStart, int globalSize, double *coords,
660:                                   PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
661: {
662:   /* We are using the convention that

664:        nabla matrix{v_1 cr v_2 cr vdots cr v_n} =
665:          matrix{v^{(1)}_1 cr vdots cr v^{(d)}_1 cr v^{(1)}_2 cr vdots cr v^{(d)}_n}

667:      and

669:        nabla cdot matrix{v^{(1)}_1 cr vdots cr v^{(d)}_1 cr v^{(1)}_2 cr vdots cr v^{(d)}_n} =
670:          matrix{v_1 cr v_2 cr vdots cr v_n}

672:      where $d$ is the number of space dimensions. This agrees with the convention which allows
673:      $Delta matrix{u_1 cr u_2} = 0$ to denote a set of scalar equations. This also means that
674:      the dimension of the test function vector must be divisible by the number of space dimensions */
675:   int     numQuadPoints;     /* Number of points used for Gaussian quadrature */
676:   double *quadWeights;       /* Weights in the standard element for Gaussian quadrature */
677:   double *quadShapeFuncs;    /* Shape functions evaluated at quadrature points */
678:   double *quadTestFuncDers;  /* Test function derivatives evaluated at quadrature points */
679:   double  dxxi;              /* PartDer{x}{xi}  */
680:   double  dxet;              /* PartDer{x}{eta} */
681:   double  dyxi;              /* PartDer{y}{xi}  */
682:   double  dyet;              /* PartDer{y}{eta} */
683:   double  dxix;              /* PartDer{xi}{x}  */
684:   double  detx;              /* PartDer{eta}{x} */
685:   double  dxiy;              /* PartDer{xi}{y}  */
686:   double  dety;              /* PartDer{eta}{y} */
687:   double  dphix;             /* PartDer{phi_i}{x} times PartDer{phi_j}{x} */
688:   double  dphiy;             /* PartDer{phi_i}{y} times PartDer{phi_j}{y} */
689:   double  jac;               /* |J| for map to standard element */
690:   double  invjac;            /* |J^{-1}| for map from standard element */
691:   int     dim;               /* The problem dimension */
692:   int     comp;              /* The number of field components */
693:   int     tcomp;             /* The number of field components for the test field */
694:   int     funcs;             /* The number of shape functions */
695:   int     tfuncs;            /* The number of test functions */
696:   int     i, j, c, tc, f, p;

699:   /* Calculate element matrix entries by Gaussian quadrature --
700:      Since we integrate by parts here, the test and shape functions are switched */
701:   dim              = disc->dim;
702:   comp             = disc->comp;
703:   tcomp            = test->comp;
704:   funcs            = disc->funcs;
705:   tfuncs           = test->funcs;
706:   numQuadPoints    = disc->numQuadPoints;
707:   quadWeights      = disc->quadWeights;
708:   quadShapeFuncs   = disc->quadShapeFuncs;
709:   quadTestFuncDers = test->quadShapeFuncDers;
710:   for(p = 0; p < numQuadPoints; p++) {
711:     /* PartDer{x}{xi}(p)  = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{xi}
712:        PartDer{x}{eta}(p) = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{eta}
713:        PartDer{y}{xi}(p)  = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{xi}
714:        PartDer{y}{eta}(p) = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{eta} */
715:     dxxi = 0.0; dxet = 0.0;
716:     dyxi = 0.0; dyet = 0.0;
717:     for(f = 0; f < tfuncs; f++) {
718:       dxxi += coords[f*dim]  *quadTestFuncDers[p*tfuncs*dim+f*dim];
719:       dxet += coords[f*dim]  *quadTestFuncDers[p*tfuncs*dim+f*dim+1];
720:       dyxi += coords[f*dim+1]*quadTestFuncDers[p*tfuncs*dim+f*dim];
721:       dyet += coords[f*dim+1]*quadTestFuncDers[p*tfuncs*dim+f*dim+1];
722:     }
723:     jac  = PetscAbsReal(dxxi*dyet - dxet*dyxi);
724: #ifdef PETSC_USE_BOPT_g
725:     if (jac < 1.0e-14) {
726:       PetscPrintf(PETSC_COMM_SELF, "p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
727:                   p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
728:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
729:     }
730: #endif
731:     /* These are the elements of the inverse matrix */
732:     invjac =  1.0/jac;
733:     dxix   =  dyet*invjac;
734:     dxiy   = -dxet*invjac;
735:     detx   = -dyxi*invjac;
736:     dety   =  dxxi*invjac;

738:     /* The rows are test functions */
739:     for(i = 0; i < tfuncs; i++) {
740:       /* We divide by the space dimension */
741:       for(tc = 0; tc < tcomp/dim; tc++) {
742:         /* The columns are shape functions */
743:         for(j = 0; j < funcs; j++) {
744:           for(c = 0; c < comp; c++) {
745:             dphix = quadTestFuncDers[p*tfuncs*dim+i*dim]*dxix + quadTestFuncDers[p*tfuncs*dim+i*dim+1]*detx;
746:             dphiy = quadTestFuncDers[p*tfuncs*dim+i*dim]*dxiy + quadTestFuncDers[p*tfuncs*dim+i*dim+1]*dety;
747:             array[(i*tcomp+tc*dim+globalRowStart)*globalSize + j*comp+c+globalColStart] +=
748:               -alpha*dphix*quadShapeFuncs[p*funcs+j]*jac*quadWeights[p];
749:             array[(i*tcomp+tc*dim+1+globalRowStart)*globalSize + j*comp+c+globalColStart] +=
750:               -alpha*dphiy*quadShapeFuncs[p*funcs+j]*jac*quadWeights[p];
751:           }
752:         }
753:       }
754:     }
755:   }
756:   PetscLogFlops((8*tfuncs + 8 + 8*tfuncs*tcomp*funcs*comp) * numQuadPoints);

758:   return(0);
759: }

761: int DiscInterpolateField_Triangular_2D_Linear(Discretization disc, Mesh oldMesh, int elem, double x, double y, double z,
762:                                               PetscScalar *oldFieldVal, PetscScalar *newFieldVal, InterpolationType type)
763: {
764:   Mesh_Triangular *tri        = (Mesh_Triangular *) oldMesh->data;
765:   Partition        p          = oldMesh->part;
766:   int              dim        = disc->dim;
767:   int              numCorners = oldMesh->numCorners;
768:   int             *elements   = tri->faces;
769:   int             *neighbors  = tri->neighbors;
770:   double          *nodes      = tri->nodes;
771:   double           coords[12];  /* Coordinates of our "big element" */
772:   double           x11, y11;    /* Coordinates of vertex 0 */
773:   double           xi, eta;     /* Canonical coordinates of the interpolation point */
774:   double           dxix;        /* PartDer{xi}{x}  */
775:   double           detx;        /* PartDer{eta}{x} */
776:   double           dxiy;        /* PartDer{xi}{y}  */
777:   double           dety;        /* PartDer{eta}{y} */
778:   double           dxxi;        /* PartDer{x}{xi}  */
779:   double           dxet;        /* PartDer{x}{eta} */
780:   double           dyxi;        /* PartDer{y}{xi}  */
781:   double           dyet;        /* PartDer{y}{eta} */
782:   double           jac, invjac; /* The Jacobian determinant and its inverse */
783:   int              comp = disc->comp;
784:   int              neighbor, corner, nelem, node, c;
785: #ifdef PETSC_USE_BOPT_g
786:   PetscTruth       opt;
787: #endif
788:   int              ierr;

791:   /* No scheme in place for boundary elements */
792:   for(neighbor = 0; neighbor < 3; neighbor++)
793:     if (neighbors[elem*3+neighbor] < 0)
794:       type = INTERPOLATION_LOCAL;

796:   switch (type)
797:   {
798:   case INTERPOLATION_LOCAL:
799:     x11    = nodes[elements[elem*numCorners]*dim];
800:     y11    = nodes[elements[elem*numCorners]*dim+1];
801:     if (oldMesh->isPeriodic == PETSC_TRUE) {
802:       dxxi = MeshPeriodicDiffX(oldMesh, nodes[elements[elem*numCorners+1]*dim]   - x11);
803:       dxet = MeshPeriodicDiffX(oldMesh, nodes[elements[elem*numCorners+2]*dim]   - x11);
804:       dyxi = MeshPeriodicDiffY(oldMesh, nodes[elements[elem*numCorners+1]*dim+1] - y11);
805:       dyet = MeshPeriodicDiffY(oldMesh, nodes[elements[elem*numCorners+2]*dim+1] - y11);
806:     } else {
807:       dxxi = nodes[elements[elem*numCorners+1]*dim]   - x11;
808:       dxet = nodes[elements[elem*numCorners+2]*dim]   - x11;
809:       dyxi = nodes[elements[elem*numCorners+1]*dim+1] - y11;
810:       dyet = nodes[elements[elem*numCorners+2]*dim+1] - y11;
811:     }
812:     jac  = PetscAbsReal(dxxi*dyet - dxet*dyxi);
813:     if (jac < 1.0e-14) {
814:       PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %gn", p->rank, elem, dxxi, dyxi, dxet, dyet);
815:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
816:     }
817: #ifdef PETSC_USE_BOPT_g
818:     PetscOptionsHasName(PETSC_NULL, "-trace_interpolation", &opt);
819:     if (opt == PETSC_TRUE) {
820:       PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x21: %g y21: %g x31: %g y31: %g jac: %gn",
821:                   p->rank, elem, dxxi, dyxi, dxet, dyet, jac);
822:     }
823: #endif

825:     /* These are the elements of the inverse matrix */
826:     invjac = 1/jac;
827:     dxix   =  dyet*invjac;
828:     dxiy   = -dxet*invjac;
829:     detx   = -dyxi*invjac;
830:     dety   =  dxxi*invjac;
831:     if (oldMesh->isPeriodic == PETSC_TRUE) {
832:       xi     = dxix*MeshPeriodicDiffX(oldMesh, x - x11) + dxiy*MeshPeriodicDiffY(oldMesh, y - y11);
833:       eta    = detx*MeshPeriodicDiffX(oldMesh, x - x11) + dety*MeshPeriodicDiffY(oldMesh, y - y11);
834:     } else {
835:       xi     = dxix*(x - x11) + dxiy*(y - y11);
836:       eta    = detx*(x - x11) + dety*(y - y11);
837:     }
838:     for(c = 0 ; c < comp; c++) {
839:       newFieldVal[c] = oldFieldVal[0*comp+c]*(1.0 - xi - eta) + oldFieldVal[1*comp+c]*xi + oldFieldVal[2*comp+c]*eta;
840:     }
841:     PetscLogFlops(7+15+7*comp);
842:     break;
843:   case INTERPOLATION_HALO:
844:     /* Here is our "big element" where numbers in parantheses represent
845:        the numbering on the old little element:

847:            2
848:            |
849:            | 
850:            |  
851:        (1) 4---3 (0)
852:            |  |
853:            |  | 
854:            |  |  
855:            0---5---1
856:               (2)

858:        We search for the neighbor node by looking for the vertex not a member of the original element.
859:     */
860:     for(neighbor = 0; neighbor < 3; neighbor++)
861:     {
862:       nelem = neighbors[elem*3+neighbor];
863:       for(corner = 0; corner < 3; corner++)
864:       {
865:         node = elements[nelem*numCorners+corner];
866:         if ((node != elements[elem*numCorners+((neighbor+1)%3)]) && (node != elements[elem*numCorners+((neighbor+2)%3)]))
867:         {
868:           /* The neighboring elements give the vertices */
869:           coords[neighbor*2]   = MeshPeriodicRelativeX(oldMesh, nodes[node*2+0], x);
870:           coords[neighbor*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[node*2+1], y);
871:           break;
872:         }
873:       }
874:     }
875:     /* Element vertices form midnodes */
876:     coords[3*2]   = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+0]*2+0], x);
877:     coords[3*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+0]*2+1], y);
878:     coords[4*2]   = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+1]*2+0], x);
879:     coords[4*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+1]*2+1], y);
880:     coords[5*2]   = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+2]*2+0], x);
881:     coords[5*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+2]*2+1], y);
882:     /* Get the (xi,eta) coordinates of the point */
883:     DiscTransformCoords_Triangular_2D_Quadratic(x, y, coords, &xi, &eta);
884:     if ((xi < -1.0e-02) || (eta < -1.0e-02)) {
885:       PetscPrintf(PETSC_COMM_SELF, "Linear: elem: %d x: %g y: %g xi: %g eta: %gn", elem, x, y, xi, eta);
886:       SETERRQ(PETSC_ERR_PLIB, "Standard element coordinates were negative");
887:     }
888:     for(c = 0 ; c < comp; c++) {
889:       newFieldVal[c] = oldFieldVal[0*comp+c]*(1.0 - xi - eta)*(1.0 - 2.0*xi - 2.0*eta) +
890:         oldFieldVal[1*comp+c]*xi *(2.0*xi  - 1.0)      +
891:         oldFieldVal[2*comp+c]*eta*(2.0*eta - 1.0)      +
892:         oldFieldVal[3*comp+c]*4.0*xi*eta               +
893:         oldFieldVal[4*comp+c]*4.0*eta*(1.0 - xi - eta) +
894:         oldFieldVal[5*comp+c]*4.0*xi *(1.0 - xi - eta);
895:     }
896:     PetscLogFlops(34*comp);
897:     break;
898:   default:
899:     SETERRQ1(PETSC_ERR_ARG_WRONG, "Unknown interpolation type %d", type);
900:   }
901: 
902:   return(0);
903: }

905: int DiscInterpolateElementVec_Triangular_2D_Linear(Discretization disc, ElementVec vec, Discretization newDisc, ElementVec newVec)
906: {
907:   int          funcs = disc->funcs;
908:   int          comp  = disc->comp;
909:   int          size  = disc->size;
910:   PetscScalar *array, *newArray;
911:   PetscTruth   islin, isquad;
912:   int          f, c;
913:   int          ierr;

916:   ElementVecGetArray(vec,    &array);
917:   ElementVecGetArray(newVec, &newArray);
918:   PetscTypeCompare((PetscObject) newDisc, DISCRETIZATION_TRIANGULAR_2D_LINEAR,    &islin);
919:   PetscTypeCompare((PetscObject) newDisc, DISCRETIZATION_TRIANGULAR_2D_QUADRATIC, &isquad);
920:   if (islin == PETSC_TRUE) {
921:     PetscMemcpy(newArray, array, size * sizeof(PetscScalar));
922:   } else if (isquad == PETSC_TRUE) {
923:     for(f = 0; f < newDisc->funcs; f++) {
924:       for(c = 0; c < comp; c++) {
925:         if (f < funcs) {
926:           newArray[f*comp+c] = array[f*comp+c];
927:         } else {
928:           newArray[f*comp+c] = 0.5*(array[((f+1)%funcs)*comp+c] + array[((f+2)%funcs)*comp+c]);
929:         }
930:       }
931:     }
932:   } else {
933:     SETERRQ(PETSC_ERR_SUP, "Discretization not supported");
934:   }
935:   ElementVecRestoreArray(vec,    &array);
936:   ElementVecRestoreArray(newVec, &newArray);
937:   return(0);
938: }

940: /*
941:   DiscSetupQuadrature_Triangular_2D_Linear - Setup Gaussian quadrature with a 7 point integration rule

943:   Input Parameter:
944: . disc - The Discretization
945: */
946: int DiscSetupQuadrature_Triangular_2D_Linear(Discretization disc) {
947:   int dim   = disc->dim;
948:   int funcs = disc->funcs;
949:   int p;

953:   disc->numQuadPoints = 7;
954:   PetscMalloc(disc->numQuadPoints*dim       * sizeof(double), &disc->quadPoints);
955:   PetscMalloc(disc->numQuadPoints           * sizeof(double), &disc->quadWeights);
956:   PetscMalloc(disc->numQuadPoints*funcs     * sizeof(double), &disc->quadShapeFuncs);
957:   PetscMalloc(disc->numQuadPoints*funcs*dim * sizeof(double), &disc->quadShapeFuncDers);
958:   PetscLogObjectMemory(disc, (disc->numQuadPoints*(funcs*(dim+1) + dim+1)) * sizeof(double));
959:   disc->quadPoints[0]  = 1.0/3.0;
960:   disc->quadPoints[1]  = disc->quadPoints[0];
961:   disc->quadWeights[0] = 0.11250000000000;
962:   disc->quadPoints[2]  = 0.797426985353087;
963:   disc->quadPoints[3]  = 0.101286507323456;
964:   disc->quadWeights[1] = 0.0629695902724135;
965:   disc->quadPoints[4]  = disc->quadPoints[3];
966:   disc->quadPoints[5]  = disc->quadPoints[2];
967:   disc->quadWeights[2] = disc->quadWeights[1];
968:   disc->quadPoints[6]  = disc->quadPoints[4];
969:   disc->quadPoints[7]  = disc->quadPoints[3];
970:   disc->quadWeights[3] = disc->quadWeights[1];
971:   disc->quadPoints[8]  = 0.470142064105115;
972:   disc->quadPoints[9]  = 0.059715871789770;
973:   disc->quadWeights[4] = 0.066197076394253;
974:   disc->quadPoints[10] = disc->quadPoints[8];
975:   disc->quadPoints[11] = disc->quadPoints[8];
976:   disc->quadWeights[5] = disc->quadWeights[4];
977:   disc->quadPoints[12] = disc->quadPoints[9];
978:   disc->quadPoints[13] = disc->quadPoints[8];
979:   disc->quadWeights[6] = disc->quadWeights[4];
980:   for(p = 0; p < disc->numQuadPoints; p++) {
981:     /* phi^0: 1 - xi - eta */
982:     disc->quadShapeFuncs[p*funcs]                =  1.0 - disc->quadPoints[p*dim] - disc->quadPoints[p*dim+1];
983:     disc->quadShapeFuncDers[p*funcs*dim+0*dim]   = -1.0;
984:     disc->quadShapeFuncDers[p*funcs*dim+0*dim+1] = -1.0;
985:     /* phi^1: xi */
986:     disc->quadShapeFuncs[p*funcs+1]              =  disc->quadPoints[p*dim];
987:     disc->quadShapeFuncDers[p*funcs*dim+1*dim]   =  1.0;
988:     disc->quadShapeFuncDers[p*funcs*dim+1*dim+1] =  0.0;
989:     /* phi^2: eta */
990:     disc->quadShapeFuncs[p*funcs+2]              =  disc->quadPoints[p*dim+1];
991:     disc->quadShapeFuncDers[p*funcs*dim+2*dim]   =  0.0;
992:     disc->quadShapeFuncDers[p*funcs*dim+2*dim+1] =  1.0;
993:   }
994:   return(0);
995: }

997: /*
998:   DiscSetupOperators_Triangular_2D_Linear - Setup the default operators

1000:   Input Parameter:
1001: . disc - The Discretization
1002: */
1003: int DiscSetupOperators_Triangular_2D_Linear(Discretization disc) {
1004:   int          comp = disc->comp;
1005:   int          size = disc->size;
1006:   PetscScalar *precompInt;
1007:   int          newOp;
1008:   int          c, i, j;
1009:   int          ierr;

1012:   /* The Identity operator I -- the matrix is symmetric */
1013:   PetscMalloc(size*size * sizeof(PetscScalar), &precompInt);
1014:   PetscLogObjectMemory(disc, size*size * sizeof(PetscScalar));
1015:   PetscMemzero(precompInt, size*size * sizeof(PetscScalar));
1016:   for(c = 0; c < comp; c++) {
1017:     precompInt[(0*comp+c)*size + 0*comp+c] = 1.0/12.0;
1018:     precompInt[(0*comp+c)*size + 1*comp+c] = 1.0/24.0;
1019:     precompInt[(0*comp+c)*size + 2*comp+c] = 1.0/24.0;
1020:     precompInt[(1*comp+c)*size + 1*comp+c] = 1.0/12.0;
1021:     precompInt[(1*comp+c)*size + 2*comp+c] = 1.0/24.0;
1022:     precompInt[(2*comp+c)*size + 2*comp+c] = 1.0/12.0;
1023:   }
1024:   for(i = 0; i < size; i++) {
1025:     for(j = 0; j < i; j++) {
1026:       precompInt[i*size + j] = precompInt[j*size + i];
1027:     }
1028:   }
1029:   DiscretizationRegisterPrecomputedOperator(disc, precompInt, &newOp);
1030:   if (newOp != IDENTITY) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", IDENTITY);
1031:   /* The Laplacian operator Delta -- the matrix is symmetric */
1032:   DiscretizationRegisterOperator(disc, Laplacian_Triangular_2D_Linear, &newOp);
1033:   if (newOp != LAPLACIAN) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", LAPLACIAN);
1034:   /* The Gradient operator nabla -- the matrix is rectangular */
1035:   DiscretizationRegisterOperator(disc, Gradient_Triangular_2D_Linear, &newOp);
1036:   if (newOp != GRADIENT) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", GRADIENT);
1037:   /* The Divergence operator nablacdot -- the matrix is rectangular */
1038:   DiscretizationRegisterOperator(disc, PETSC_NULL, &newOp);
1039:   if (newOp != DIVERGENCE) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", DIVERGENCE);
1040:   /* The weighted Laplacian operator -- the matrix is symmetric */
1041:   DiscretizationRegisterOperator(disc, Weighted_Laplacian_Triangular_2D_Linear, &newOp);
1042:   if (newOp != WEIGHTED_LAP) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", WEIGHTED_LAP);
1043:   return(0);
1044: }

1046: static struct _DiscretizationOps DOps = {PETSC_NULL/* DiscretizationSetup */,
1047:                                          DiscSetupOperators_Triangular_2D_Linear,
1048:                                          PETSC_NULL/* DiscretizationSetFromOptions */,
1049:                                          DiscView_Triangular_2D_Linear,
1050:                                          DiscDestroy_Triangular_2D_Linear,
1051:                                          DiscEvaluateFunctionGalerkin_Triangular_2D_Linear,
1052:                                          DiscEvaluateOperatorGalerkin_Triangular_2D_Linear,
1053:                                          DiscEvaluateALEOperatorGalerkin_Triangular_2D_Linear,
1054:                                          DiscEvaluateNonlinearOperatorGalerkin_Triangular_2D_Linear,
1055:                                          DiscEvaluateNonlinearALEOperatorGalerkin_Triangular_2D_Linear,
1056:                                          DiscInterpolateField_Triangular_2D_Linear,
1057:                                          DiscInterpolateElementVec_Triangular_2D_Linear};

1059: EXTERN_C_BEGIN
1060: int DiscCreate_Triangular_2D_Linear(Discretization disc) {
1061:   int arg;

1065:   if (disc->comp <= 0) {
1066:     SETERRQ(PETSC_ERR_ARG_WRONG, "Discretization must have at least 1 component. Call DiscretizationSetNumComponents() to set this.");
1067:   }
1068:   PetscMemcpy(disc->ops, &DOps, sizeof(struct _DiscretizationOps));
1069:   disc->dim   = 2;
1070:   disc->funcs = 3;
1071:   disc->size  = disc->funcs*disc->comp;

1073:   DiscretizationSetupDefaultOperators(disc);
1074:   DiscSetupQuadrature_Triangular_2D_Linear(disc);

1076:   DiscretizationCreate(disc->comm, &disc->bdDisc);
1077:   DiscretizationSetNumComponents(disc->bdDisc, disc->comp);
1078:   DiscretizationSetType(disc->bdDisc, BD_DISCRETIZATION_TRIANGULAR_2D_LINEAR);

1080:   /* Storage */
1081:   PetscMalloc(disc->comp * sizeof(PetscScalar),   &disc->funcVal);
1082:   PetscMalloc(2          * sizeof(PetscScalar *), &disc->fieldVal);
1083:   for(arg = 0; arg < 2; arg++) {
1084:     PetscMalloc(disc->comp*(disc->dim+1) * sizeof(PetscScalar), &disc->fieldVal[arg]);
1085:   }
1086:   return(0);
1087: }
1088: EXTERN_C_END