Actual source code: quadratic1d.c

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

  5: /*
  6:    Defines piecewise quadratic 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: /* For precomputed integrals, the table is structured as follows:

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

 17:    The Jacobian in this case may not be constant over the element in question.
 18:    The numbering of the nodes in the standard element is

 20:                  3
 21:                  |
 22:                  | 
 23:                  5  4
 24:                  |   
 25:                  |    
 26:                  1--6--2
 27: */

 29: #undef  __FUNCT__
 31: static int DiscDestroy_Triangular_1D_Quadratic(Discretization disc) {
 33:   return(0);
 34: }

 36: #undef  __FUNCT__
 38: static int DiscView_Triangular_1D_Quadratic_File(Discretization disc, PetscViewer viewer) {
 40:   PetscViewerASCIIPrintf(viewer, "Quadratic discretizationn");
 41:   PetscViewerASCIIPrintf(viewer, "    %d shape functions per componentn", disc->funcs);
 42:   PetscViewerASCIIPrintf(viewer, "    %d registered operatorsn", disc->numOps);
 43:   return(0);
 44: }

 46: #undef  __FUNCT__
 48: static int DiscView_Triangular_1D_Quadratic(Discretization disc, PetscViewer viewer) {
 49:   PetscTruth isascii;
 50:   int        ierr;

 53:   PetscTypeCompare((PetscObject) viewer, PETSC_VIEWER_ASCII, &isascii);
 54:   if (isascii == PETSC_TRUE) {
 55:     DiscView_Triangular_1D_Quadratic_File(disc, viewer);
 56:   }
 57:   return(0);
 58: }

 60: #undef  __FUNCT__
 62: int DiscEvaluateShapeFunctions_Triangular_1D_Quadratic_Private(double xi, double eta, double *coords, double *x,
 63:                                                                double *y, double *dxxi, double *dxet, double *dyxi, double *dyet)
 64: {
 65:   /* ASSUMPTION: The coordinates passed in are corrected for periodicity */
 67:   *x    = 0.0; *y    = 0.0;
 68:   *dxxi = 0.0; *dxet = 0.0;
 69:   *dyxi = 0.0; *dyet = 0.0;
 70:   /* phi^0: 1 - 3 (xi + eta) + 2 (xi + eta)^2 */
 71:   *x    += coords[0*2+0]*(1.0 - (xi + eta))*(1.0 - 2.0*(xi + eta));
 72:   *dxxi += coords[0*2+0]*(-3.0 + 4.0*(xi + eta));
 73:   *dxet += coords[0*2+0]*(-3.0 + 4.0*(xi + eta));
 74:   *y    += coords[0*2+1]*(1.0 - (xi + eta))*(1.0 - 2.0*(xi + eta));
 75:   *dyxi += coords[0*2+1]*(-3.0 + 4.0*(xi + eta));
 76:   *dyet += coords[0*2+1]*(-3.0 + 4.0*(xi + eta));
 77:   /* phi^1: xi (2xi - 1) */
 78:   *x    += coords[1*2+0]*(xi*(2.0*xi - 1.0));
 79:   *dxxi += coords[1*2+0]*(4.0*xi  - 1.0);
 80:   *dxet += 0.0;
 81:   *y    += coords[1*2+1]*(xi*(2.0*xi - 1.0));
 82:   *dyxi += coords[1*2+1]*(4.0*xi  - 1.0);
 83:   *dyet += 0.0;
 84:   /* phi^2: eta (2eta - 1) */
 85:   *x    += coords[2*2+0]*(eta*(2.0*eta - 1.0));
 86:   *dxxi += 0.0;
 87:   *dxet += coords[2*2+0]*(4.0*eta - 1.0);
 88:   *y    += coords[2*2+1]*(eta*(2.0*eta - 1.0));
 89:   *dyxi += 0.0;
 90:   *dyet += coords[2*2+1]*(4.0*eta - 1.0);
 91:   /* phi^3: 4 xi eta */
 92:   *x    += coords[3*2+0]*(4.0*xi*eta);
 93:   *dxxi += coords[3*2+0]*(4.0*eta);
 94:   *dxet += coords[3*2+0]*(4.0*xi);
 95:   *y    += coords[3*2+1]*(4.0*xi*eta);
 96:   *dyxi += coords[3*2+1]*(4.0*eta);
 97:   *dyet += coords[3*2+1]*(4.0*xi);
 98:   /* phi^4: 4 eta (1 - xi - eta) */
 99:   *x    += coords[4*2+0]*(4.0*eta*(1.0 - (xi + eta)));
100:   *dxxi += coords[4*2+0]*(-4.0*eta);
101:   *dxet += coords[4*2+0]*(-8.0*eta + 4.0*(1.0 - xi));
102:   *y    += coords[4*2+1]*(4.0*eta*(1.0 - (xi + eta)));
103:   *dyxi += coords[4*2+1]*(-4.0*eta);
104:   *dyet += coords[4*2+1]*(-8.0*eta + 4.0*(1.0 - xi));
105:   /* phi^5: 4 xi (1 - xi - eta) */
106:   *x    += coords[5*2+0]*(4.0*xi*(1.0 - (xi + eta)));
107:   *dxxi += coords[5*2+0]*(-8.0*xi  + 4.0*(1.0 - eta));
108:   *dxet += coords[5*2+0]*(-4.0*xi);
109:   *y    += coords[5*2+1]*(4.0*xi*(1.0 - (xi + eta)));
110:   *dyxi += coords[5*2+1]*(-8.0*xi  + 4.0*(1.0 - eta));
111:   *dyet += coords[5*2+1]*(-4.0*xi);
112:   PetscLogFlops(36+20+20+20+30+20);
113:   return(0);
114: }

116: #undef  __FUNCT__
118: int DiscTransformCoords_Triangular_1D_Quadratic(double x, double y, double *coords, double *newXi, double *newEta)
119: {
120:   /* ASSUMPTION: The coordinates passed in are corrected for periodicity */
121:   double xi, eta;     /* Canonical coordinates of the point */
122:   double dxix;        /* PartDer{xi}{x}  */
123:   double detx;        /* PartDer{eta}{x} */
124:   double dxiy;        /* PartDer{xi}{y}  */
125:   double dety;        /* PartDer{eta}{y} */
126:   double dxxi;        /* PartDer{x}{xi}  */
127:   double dxet;        /* PartDer{x}{eta} */
128:   double dyxi;        /* PartDer{y}{xi}  */
129:   double dyet;        /* PartDer{y}{eta} */
130:   double new_x;       /* x(xi,eta) */
131:   double new_y;       /* x(xi,eta) */
132:   double residual_x;  /* x(xi,eta) - x */
133:   double residual_y;  /* x(xi,eta) - y */
134:   double jac, invjac; /* The Jacobian determinant and its inverse */
135:   int    maxIters = 100;
136:   int    iter;
137:   int    ierr;

140:   /* We have to solve

142:        sum_f x(f) phi^f(xi,eta) = x
143:        sum_f y(f) phi^f(xi,eta) = y

145:      where f runs over nodes (each one has coordinates and a shape function). We
146:      will use Newton's method

148:      / sum_f x(f) PartDer{phi^f}{xi} sum_f x(f) PartDer{phi^f}{eta}  / dxi   = / sum_f x(f) phi^f(xi,eta) - x
149:       sum_f y(f) PartDer{phi^f}{xi} sum_f y(f) PartDer{phi^f}{eta} /  deta /    sum_f y(f) phi^f(xi,eta) - y/

151:      which can be rewritten more compactly as

153:      / PartDer{x}{xi} PartDer{x}{eta}   / dxi   = / x(xi,eta) - x 
154:       PartDer{y}{xi} PartDer{y}{eta} /   deta /    y(xi,eta) - y /

156:      The initial guess will be the linear solution.

158:      ASSUMPTION: The coordinates passed in are all on the same sheet as x,y
159:   */
160:   /* Form linear solution */
161:   dxxi = coords[1*2+0] - coords[0*2+0];
162:   dxet = coords[2*2+0] - coords[0*2+0];
163:   dyxi = coords[1*2+1] - coords[0*2+1];
164:   dyet = coords[2*2+1] - coords[0*2+1];
165:   jac  = PetscAbsReal(dxxi*dyet - dxet*dyxi);
166:   if (jac < 1.0e-14) SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
167:   invjac = 1/jac;
168:   dxix   =  dyet*invjac;
169:   dxiy   = -dxet*invjac;
170:   detx   = -dyxi*invjac;
171:   dety   =  dxxi*invjac;
172:   xi     = dxix*(x - coords[0*2+0]) + dxiy*(y - coords[0*2+1]);
173:   eta    = detx*(x - coords[0*2+0]) + dety*(y - coords[0*2+1]);
174:   for(iter = 0; iter < maxIters; iter++) {
175:     /* This is clumsy, but I can't think of anything better right now */
176:     DiscEvaluateShapeFunctions_Triangular_1D_Quadratic_Private(xi, eta, coords, &new_x, &new_y, &dxxi, &dxet, &dyxi, &dyet);
177: 

179:     /* Check for convergence -- I should maybe make the tolerance variable */
180:     residual_x = new_x - x;
181:     residual_y = new_y - y;
182:     if (PetscAbsReal(residual_x) + PetscAbsReal(residual_y) < 1.0e-6) break;

184:     /* Solve the system */
185:     jac = PetscAbsReal(dxxi*dyet - dxet*dyxi);
186:     if (jac < 1.0e-14) {
187:       iter = maxIters;
188:       break;
189:     }

191:     /* These are the elements of the inverse matrix */
192:     invjac = 1/jac;
193:     dxix   =  dyet*invjac;
194:     dxiy   = -dxet*invjac;
195:     detx   = -dyxi*invjac;
196:     dety   =  dxxi*invjac;
197:     xi    -= dxix*residual_x + dxiy*residual_y;
198:     eta   -= detx*residual_x + dety*residual_y;
199:   }
200:   if (iter == maxIters) {
201:     PetscLogInfo(PETSC_NULL, "DiscTransformCoords_Triangular_1D_Quadratic: Newton iteration did not convergen");
202:     PetscLogInfo(PETSC_NULL, "x: %g y: %g maxIters: %dn", x, y, maxIters);
203:     for(iter = 0; iter < 6; iter++) {
204:       PetscLogInfo(PETSC_NULL, "  x%d: %g y%d: %gn", iter, coords[iter*2+0], iter, coords[iter*2+1]);
205:     }
206:     /* Use linear interpolation */
207:     xi  = dxix*(x - coords[0*2+0]) + dxiy*(y - coords[0*2+1]);
208:     eta = detx*(x - coords[0*2+0]) + dety*(y - coords[0*2+1]);
209:   }

211:   *newXi  = xi;
212:   *newEta = eta;
213:   PetscLogFlops(7+15+19*iter);
214:   return(0);
215: }

217: #undef  __FUNCT__
219: static int DiscEvaluateFunctionGalerkin_Triangular_1D_Quadratic(Discretization disc, Mesh mesh, PointFunction f,
220:                                                                 PetscScalar alpha, int elem, PetscScalar *array, void *ctx)
221: {
222:   Mesh_Triangular *tri               = (Mesh_Triangular *) mesh->data;
223:   double          *nodes             = tri->nodes;
224:   int             *elements          = tri->faces;
225:   int              numCorners        = mesh->numCorners;
226:   int              comp              = disc->comp;              /* The number of components in this field */
227:   int              funcs             = disc->funcs;             /* The number of shape functions per component */
228:   PetscScalar     *funcVal           = disc->funcVal;           /* Function value at a quadrature point */
229:   int              numQuadPoints     = disc->numQuadPoints;     /* Number of points used for Gaussian quadrature */
230:   double          *quadWeights       = disc->quadWeights;       /* Weights in the standard element for Gaussian quadrature */
231:   double          *quadShapeFuncs    = disc->quadShapeFuncs;    /* Shape functions evaluated at quadrature points */
232:   double          *quadShapeFuncDers = disc->quadShapeFuncDers; /* Shape function derivatives at quadrature points */
233:   double           jac;                                         /* |J| for map to standard element */
234:   double           x, y;                                        /* The integration point */
235:   double           dxxi;                                        /* PartDer{x}{xi}  */
236:   double           dxet;                                        /* PartDer{x}{xi}  */
237:   double           dyxi;                                        /* PartDer{y}{eta} */
238:   double           dyet;                                        /* PartDer{y}{eta} */
239:   double           coords[MAX_CORNERS*2];
240:   int              rank = -1;
241:   int              i, j, k, func, p;
242: #ifdef PETSC_USE_BOPT_g
243:   PetscTruth       opt;
244: #endif
245:   int              ierr;

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

250:   /* For dummy collective calls */
251:   if (array == PETSC_NULL) {
252:     for(p = 0; p < numQuadPoints; p++) {
253:       (*f)(0, 0, PETSC_NULL, PETSC_NULL, PETSC_NULL, PETSC_NULL, ctx);
254:     }
255:     return(0);
256:   }

258: #ifdef PETSC_USE_BOPT_g
259:   if ((elem < 0) || (elem >= mesh->part->numOverlapElements)) {
260:     SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE, "Invalid element %d should be in [0,%d)", elem, mesh->part->numOverlapElements);
261:   }
262: #endif
263:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element */
264:   for(i = 0; i < numCorners; i++) {
265:     coords[i*2]   = nodes[elements[elem*numCorners+i]*2];
266:     coords[i*2+1] = nodes[elements[elem*numCorners+i]*2+1];
267:   }

269:   /* Check for constant jacobian here */
270:   if (PETSC_FALSE) {
271:     jac = PetscAbsReal((coords[2] - coords[0])*(coords[5] - coords[1]) - (coords[4] - coords[0])*(coords[3] - coords[1]));
272:     if (jac < 1.0e-14) {
273:       PetscPrintf(PETSC_COMM_SELF, "[%d], elem: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
274:                   rank, elem, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
275:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
276:     }
277:   }
278: #ifdef PETSC_USE_BOPT_g
279:   PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
280:   if (opt == PETSC_TRUE) {
281:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
282:                 rank, elem, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
283:     PetscPrintf(PETSC_COMM_SELF, "  x4: %g y4: %g x5: %g y5: %g x6: %g y6: %gn",
284:                 coords[6], coords[7], coords[8], coords[9], coords[10], coords[11]);
285:   }
286: #endif

288:   /* Calculate element vector entries by Gaussian quadrature */
289:   for(p = 0; p < numQuadPoints; p++)
290:   {
291:     /* x                    = sum^{funcs}_{f=1} x_f phi^f(p)
292:        PartDer{x}{xi}(p)  = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{xi}
293:        PartDer{x}{eta}(p) = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{eta}
294:        y                    = sum^{funcs}_{f=1} y_f phi^f(p)
295:        PartDer{y}{xi}(p)  = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{xi}
296:        PartDer{y}{eta}(p) = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{eta} */
297:     x    = 0.0; y    = 0.0;
298:     dxxi = 0.0; dxet = 0.0;
299:     dyxi = 0.0; dyet = 0.0;
300:     if (mesh->isPeriodic == PETSC_TRUE) {
301:       for(func = 0; func < funcs; func++)
302:       {
303:         x    += MeshPeriodicRelativeX(mesh, coords[func*2],   coords[0])*quadShapeFuncs[p*funcs+func];
304:         dxxi += MeshPeriodicRelativeX(mesh, coords[func*2],   coords[0])*quadShapeFuncDers[p*funcs*2+func*2];
305:         dxet += MeshPeriodicRelativeX(mesh, coords[func*2],   coords[0])*quadShapeFuncDers[p*funcs*2+func*2+1];
306:         y    += MeshPeriodicRelativeY(mesh, coords[func*2+1], coords[1])*quadShapeFuncs[p*funcs+func];
307:         dyxi += MeshPeriodicRelativeY(mesh, coords[func*2+1], coords[1])*quadShapeFuncDers[p*funcs*2+func*2];
308:         dyet += MeshPeriodicRelativeY(mesh, coords[func*2+1], coords[1])*quadShapeFuncDers[p*funcs*2+func*2+1];
309:       }
310:       x = MeshPeriodicX(mesh, x);
311:       y = MeshPeriodicY(mesh, y);
312:     } else {
313:       for(func = 0; func < funcs; func++)
314:       {
315:         x    += coords[func*2]  *quadShapeFuncs[p*funcs+func];
316:         dxxi += coords[func*2]  *quadShapeFuncDers[p*funcs*2+func*2];
317:         dxet += coords[func*2]  *quadShapeFuncDers[p*funcs*2+func*2+1];
318:         y    += coords[func*2+1]*quadShapeFuncs[p*funcs+func];
319:         dyxi += coords[func*2+1]*quadShapeFuncDers[p*funcs*2+func*2];
320:         dyet += coords[func*2+1]*quadShapeFuncDers[p*funcs*2+func*2+1];
321:       }
322:     }
323:     jac = PetscAbsReal(dxxi*dyet - dxet*dyxi);
324:     if (jac < 1.0e-14) {
325:       PetscPrintf(PETSC_COMM_SELF, "[%d]p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
326:                   rank, p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
327:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
328:     }
329:     (*f)(1, comp, &x, &y, PETSC_NULL, funcVal, ctx);
330: #ifdef PETSC_USE_BOPT_g
331:     PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
332:     if (opt == PETSC_TRUE) {
333:       PetscPrintf(PETSC_COMM_SELF, "[%d]p: %d jac: %g", rank, p, jac);
334:      for(j = 0; j < comp; j++)
335:         PetscPrintf(PETSC_COMM_SELF, " func[%d]: %g", j, PetscRealPart(funcVal[j]));
336:       PetscPrintf(PETSC_COMM_SELF, "n");
337:     }
338: #endif

340:     for(i = 0, k = 0; i < funcs; i++) {
341:       for(j = 0; j < comp; j++, k++) {
342:         array[k] += alpha*funcVal[j]*quadShapeFuncs[p*funcs+i]*jac*quadWeights[p];
343: #ifdef PETSC_USE_BOPT_g
344:         PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
345:         if (opt == PETSC_TRUE) {
346:           PetscPrintf(PETSC_COMM_SELF, "[%d]  array[%d]: %gn", rank, k, PetscRealPart(array[k]));
347:         }
348: #endif
349:       }
350:     }
351:   }
352:   PetscLogFlops((3 + 12*funcs + 5*funcs*comp) * numQuadPoints);
353:   return(0);
354: }

356: #undef  __FUNCT__
358: static int DiscEvaluateOperatorGalerkin_Triangular_1D_Quadratic(Discretization disc, Mesh mesh, int elemSize,
359:                                                                 int rowStart, int colStart, int op, PetscScalar alpha,
360:                                                                 int elem, PetscScalar *field, PetscScalar *array, void *ctx)
361: {
362:   Mesh_Triangular *tri        = (Mesh_Triangular *) mesh->data;
363:   double          *nodes      = tri->nodes;          /* The node coordinates */
364:   int             *elements   = tri->faces;          /* The element corners */
365:   int              numCorners = mesh->numCorners;    /* The number of corners per element */
366:   Operator         oper       = disc->operators[op]; /* The operator to discretize */
367:   Discretization   test       = oper->test;          /* The space of test functions */
368:   OperatorFunction opFunc     = oper->opFunc;        /* Integrals of operators which depend on J */
369:   PetscScalar     *precompInt = oper->precompInt;    /* Precomputed integrals of the operator on shape functions */
370:   int              rowSize    = test->size;          /* The number of shape functions per element */
371:   int              colSize    = disc->size;          /* The number of test  functions per element */
372:   double           x21, x31, y21, y31;               /* Coordinates of the element, with point 1 at the origin */
373:   double           jac;                              /* |J| for map to standard element */
374:   double           coords[MAX_CORNERS*2];            /* Coordinates of the element */
375:   int              rank;
376:   int              i, j, f;
377:   int              ierr;

380:   MPI_Comm_rank(disc->comm, &rank);
381: #ifdef PETSC_USE_BOPT_g
382:   /* Check for valid operator */
383:   if ((op < 0) || (op >= disc->numOps) || (!disc->operators[op])) SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
384: #endif

386:   if (precompInt != PETSC_NULL)
387:   {
388:     /* Calculate the determinant of the inverse Jacobian of the map to the standard element
389:        which has been specified as constant here - 1/|x_{21} y_{31} - x_{31} y_{21}| */
390:     if (mesh->isPeriodic == PETSC_TRUE) {
391:       x21 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+1]*2]   - nodes[elements[elem*numCorners]*2]);
392:       x31 = MeshPeriodicDiffX(mesh, nodes[elements[elem*numCorners+2]*2]   - nodes[elements[elem*numCorners]*2]);
393:       y21 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+1]*2+1] - nodes[elements[elem*numCorners]*2+1]);
394:       y31 = MeshPeriodicDiffY(mesh, nodes[elements[elem*numCorners+2]*2+1] - nodes[elements[elem*numCorners]*2+1]);
395:     } else {
396:       x21 = nodes[elements[elem*numCorners+1]*2]   - nodes[elements[elem*numCorners]*2];
397:       x31 = nodes[elements[elem*numCorners+2]*2]   - nodes[elements[elem*numCorners]*2];
398:       y21 = nodes[elements[elem*numCorners+1]*2+1] - nodes[elements[elem*numCorners]*2+1];
399:       y31 = nodes[elements[elem*numCorners+2]*2+1] - nodes[elements[elem*numCorners]*2+1];
400:     }
401:     jac = PetscAbsReal(x21*y31 - x31*y21);
402:     if (jac < 1.0e-14) {
403:       PetscPrintf(PETSC_COMM_SELF, "[%d]x21: %g y21: %g x31: %g y31: %g jac: %gn", rank, x21, y21, x31, y31, jac);
404:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
405:     }
406:     /* PetscPrintf(PETSC_COMM_SELF, "x21: %g y21: %g x31: %g y31: %gn", x21, y21, x31, y31, jac); */

408:     /* Calculate element matrix entries which are all precomputed */
409:     for(i = 0; i < rowSize; i++)
410:       for(j = 0; j < colSize; j++)
411:         array[(i+rowStart)*elemSize + j+colStart] += alpha*precompInt[i*colSize + j]*jac;
412:     PetscLogFlops(7 + 2*rowSize*colSize);
413:   }
414:   else
415:   {
416:     if (opFunc == PETSC_NULL) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid function");
417:     if (mesh->isPeriodic == PETSC_TRUE) {
418:       coords[0*2+0] = nodes[elements[elem*numCorners+0]*2+0];
419:       coords[0*2+1] = nodes[elements[elem*numCorners+0]*2+1];
420:       for(f = 1; f < PetscMax(disc->funcs, test->funcs); f++) {
421:         coords[f*2+0] = MeshPeriodicRelativeX(mesh, nodes[elements[elem*numCorners+f]*2+0], coords[0*2+0]);
422:         coords[f*2+1] = MeshPeriodicRelativeY(mesh, nodes[elements[elem*numCorners+f]*2+1], coords[0*2+1]);
423:       }
424:     } else {
425:       for(f = 0; f < PetscMax(disc->funcs, test->funcs); f++) {
426:         coords[f*2+0] = nodes[elements[elem*numCorners+f]*2+0];
427:         coords[f*2+1] = nodes[elements[elem*numCorners+f]*2+1];
428:       }
429:     }

431:     (*opFunc)(disc, test, rowSize, colSize, rowStart, colStart, elemSize, coords, alpha, field, array, ctx);
432: 
433:   }
434:   return(0);
435: }

437: #undef  __FUNCT__
439: static int DiscEvaluateNonlinearOperatorGalerkin_Triangular_1D_Quadratic(Discretization disc, Mesh mesh, NonlinearOperator f,
440:                                                                          PetscScalar alpha, int elem, int numArgs, PetscScalar **field,
441:                                                                          PetscScalar *vec, void *ctx)
442: {
443:   Mesh_Triangular *tri        = (Mesh_Triangular *) mesh->data;
444:   double          *nodes      = tri->nodes;
445:   int             *elements   = tri->faces;
446:   int              numCorners = mesh->numCorners;
447:   int              comp       = disc->comp;     /* The number of components in this field */
448:   int              funcs      = disc->funcs;    /* The number of shape functions per component */
449:   PetscScalar     *funcVal    = disc->funcVal;  /* Function value at a quadrature point */
450:   PetscScalar    **fieldVal   = disc->fieldVal; /* Field value and derivatives at a quadrature point */
451:   double           jac;                         /* |J| for map to standard element */
452:   double           invjac;                      /* |J^{-1}| for map from standard element */
453:   int              numQuadPoints;               /* Number of points used for Gaussian quadrature */
454:   double          *quadWeights;                 /* Weights in the standard element for Gaussian quadrature */
455:   double          *quadShapeFuncs;              /* Shape functions evaluated at quadrature points */
456:   double          *quadShapeFuncDers;           /* Shape function derivatives evaluated at quadrature points */
457:   double           x, y;                        /* The integration point */
458:   double           dxxi;                        /* PartDer{x}{xi}  */
459:   double           dxet;                        /* PartDer{x}{eta}  */
460:   double           dyxi;                        /* PartDer{y}{xi} */
461:   double           dyet;                        /* PartDer{y}{eta} */
462:   double           dxix;                        /* PartDer{xi}{x}  */
463:   double           detx;                        /* PartDer{eta}{x} */
464:   double           dxiy;                        /* PartDer{xi}{y}  */
465:   double           dety;                        /* PartDer{eta}{y} */
466:   PetscScalar      dfxi;                        /* PartDer{field}{xi}  */
467:   PetscScalar      dfet;                        /* PartDer{field}{eta} */
468:   double           coords[12];                  /* Coordinates of the element */
469:   int              rank = -1;
470:   int              i, j, k, func, p, arg;
471: #ifdef PETSC_USE_BOPT_g
472:   PetscTruth       opt;
473: #endif
474:   int              ierr;

477:   MPI_Comm_rank(disc->comm, &rank);
478:   numQuadPoints     = disc->numQuadPoints;
479:   quadWeights       = disc->quadWeights;
480:   quadShapeFuncs    = disc->quadShapeFuncs;
481:   quadShapeFuncDers = disc->quadShapeFuncDers;

483:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element */
484:   if (mesh->isPeriodic == PETSC_TRUE) {
485:     coords[0*2+0] = nodes[elements[elem*numCorners+0]*2+0];
486:     coords[0*2+1] = nodes[elements[elem*numCorners+0]*2+1];
487:     for(func = 1; func < funcs; func++) {
488:       coords[func*2+0] = MeshPeriodicRelativeX(mesh, nodes[elements[elem*numCorners+func]*2+0], coords[0*2+0]);
489:       coords[func*2+1] = MeshPeriodicRelativeY(mesh, nodes[elements[elem*numCorners+func]*2+1], coords[0*2+1]);
490:     }
491:   } else {
492:     for(func = 0; func < funcs; func++) {
493:       coords[func*2+0] = nodes[elements[elem*numCorners+func]*2+0];
494:       coords[func*2+1] = nodes[elements[elem*numCorners+func]*2+1];
495:     }
496:   }
497:   /* Check for constant jacobian here */
498:   if (PETSC_FALSE) {
499:     jac = PetscAbsReal((coords[2] - coords[0])*(coords[5] - coords[1]) - (coords[4] - coords[0])*(coords[3] - coords[1]));
500:     if (jac < 1.0e-14) {
501:       PetscPrintf(PETSC_COMM_SELF, "[%d], elem: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
502:                   rank, elem, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
503:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
504:     }
505:   }
506: #ifdef PETSC_USE_BOPT_g
507:   PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
508:   if (opt == PETSC_TRUE) {
509:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
510:                 rank, elem, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
511:     PetscPrintf(PETSC_COMM_SELF, "  x4: %g y4: %g x5: %g y5: %g x6: %g y6: %gn",
512:                 coords[6], coords[7], coords[8], coords[9], coords[10], coords[11]);
513:   }
514: #endif

516:   /* Calculate element vector entries by Gaussian quadrature */
517:   for(p = 0; p < numQuadPoints; p++) {
518:     /* x                      = sum^{funcs}_{f=1} x_f   phi^f(p)
519:        PartDer{x}{xi}(p)    = sum^{funcs}_{f=1} x_f   PartDer{phi^f(p)}{xi}
520:        PartDer{x}{eta}(p)   = sum^{funcs}_{f=1} x_f   PartDer{phi^f(p)}{eta}
521:        y                      = sum^{funcs}_{f=1} y_f   phi^f(p)
522:        PartDer{y}{xi}(p)    = sum^{funcs}_{f=1} y_f   PartDer{phi^f(p)}{xi}
523:        PartDer{y}{eta}(p)   = sum^{funcs}_{f=1} y_f   PartDer{phi^f(p)}{eta}
524:        u^i                    = sum^{funcs}_{f=1} u^i_f phi^f(p)
525:        PartDer{u^i}{xi}(p)  = sum^{funcs}_{f=1} u^i_f PartDer{phi^f(p)}{xi}
526:        PartDer{u^i}{eta}(p) = sum^{funcs}_{f=1} u^i_f PartDer{phi^f(p)}{eta} */
527:     x    = 0.0; y    = 0.0;
528:     dxxi = 0.0; dyxi = 0.0;
529:     dxet = 0.0; dyet = 0.0;
530:     for(arg = 0; arg < numArgs; arg++)
531:       for(j = 0; j < comp*3; j++)
532:         fieldVal[arg][j] = 0.0;
533:     for(func = 0; func < funcs; func++) {
534:       x    += coords[func*2]  *quadShapeFuncs[p*funcs+func];
535:       dxxi += coords[func*2]  *quadShapeFuncDers[p*funcs*2+func*2];
536:       dxet += coords[func*2]  *quadShapeFuncDers[p*funcs*2+func*2+1];
537:       y    += coords[func*2+1]*quadShapeFuncs[p*funcs+func];
538:       dyxi += coords[func*2+1]*quadShapeFuncDers[p*funcs*2+func*2];
539:       dyet += coords[func*2+1]*quadShapeFuncDers[p*funcs*2+func*2+1];
540:       for(arg = 0; arg < numArgs; arg++) {
541:         for(j = 0; j < comp; j++) {
542:           fieldVal[arg][j*3]   += field[arg][func*comp+j]*quadShapeFuncs[p*funcs+func];
543:           fieldVal[arg][j*3+1] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*2+func*2];
544:           fieldVal[arg][j*3+2] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*2+func*2+1];
545:         }
546:       }
547:     }
548:     if (mesh->isPeriodic == PETSC_TRUE) {
549:       x = MeshPeriodicX(mesh, x);
550:       y = MeshPeriodicY(mesh, y);
551:     }
552:     jac = PetscAbsReal(dxxi*dyet - dxet*dyxi);
553:     if (jac < 1.0e-14) {
554:       PetscPrintf(PETSC_COMM_SELF, "[%d]p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
555:                   rank, p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
556:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
557:     }
558:     /* These are the elements of the inverse matrix */
559:     invjac = 1/jac;
560:     dxix   =  dyet*invjac;
561:     dxiy   = -dxet*invjac;
562:     detx   = -dyxi*invjac;
563:     dety   =  dxxi*invjac;

565:     /* Convert the field derivatives to old coordinates */
566:     for(arg = 0; arg < numArgs; arg++)
567:       for(j = 0; j < comp; j++) {
568:         dfxi                 = fieldVal[arg][j*3+1];
569:         dfet                 = fieldVal[arg][j*3+2];
570:         fieldVal[arg][j*3+1] = dfxi*dxix + dfet*detx;
571:         fieldVal[arg][j*3+2] = dfxi*dxiy + dfet*dety;
572:       }

574:     (*f)(1, comp, &x, &y, PETSC_NULL, numArgs, fieldVal, funcVal, ctx);
575: #ifdef PETSC_USE_BOPT_g
576:     PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
577:     if (opt == PETSC_TRUE) {
578:       PetscPrintf(PETSC_COMM_SELF, "[%d]p: %d jac: %g", rank, p, jac);
579:       for(j = 0; j < comp; j++)
580:         PetscPrintf(PETSC_COMM_SELF, " func[%d]: %g", j, PetscRealPart(funcVal[j]));
581:       PetscPrintf(PETSC_COMM_SELF, "n");
582:     }
583: #endif

585:     for(i = 0, k = 0; i < funcs; i++) {
586:       for(j = 0; j < comp; j++, k++) {
587:         vec[k] += alpha*funcVal[j]*quadShapeFuncs[p*funcs+i]*jac*quadWeights[p];
588: #ifdef PETSC_USE_BOPT_g
589:         PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
590:         if (opt == PETSC_TRUE) {
591:           PetscPrintf(PETSC_COMM_SELF, "[%d]  vec[%d]: %gn", rank, k, PetscRealPart(vec[k]));
592:         }
593: #endif
594:       }
595:     }
596:   }
597:   PetscLogFlops(((12 + (6*numArgs + 5)*comp)*funcs + 8 + 6*numArgs*comp) * numQuadPoints);
598:   return(0);
599: }

601: #undef  __FUNCT__
603: static int DiscEvaluateALEOperatorGalerkin_Triangular_1D_Quadratic(Discretization disc, Mesh mesh, int elemSize,
604:                                                                    int rowStart, int colStart, int op, PetscScalar alpha,
605:                                                                    int elem, PetscScalar *field, PetscScalar *ALEfield, PetscScalar *array,
606:                                                                    void *ctx)
607: {
608:   Mesh_Triangular    *tri        = (Mesh_Triangular *) mesh->data;
609:   double             *nodes      = tri->nodes;
610:   int                *elements   = tri->faces;
611:   int                 numCorners = mesh->numCorners;
612:   Discretization      test;                  /* The space of test functions */
613:   Operator            oper;                  /* The operator to discretize */
614:   int                 rowSize;               /* The number of shape functions per element */
615:   int                 colSize;               /* The number of test  functions per element */
616:   ALEOperatorFunction opFunc;                /* Integrals of operators which depend on J */
617:   double              coords[MAX_CORNERS*2]; /* Coordinates of the element */
618:   int                 f;
619:   int                 ierr;

622: #ifdef PETSC_USE_BOPT_g
623:   /* Check for valid operator */
624:   if ((op < 0) || (op >= disc->numOps) || (!disc->operators[op])) SETERRQ(PETSC_ERR_ARG_WRONG, "Invalid operator");
625: #endif
626:   /* Get discretization info */
627:   oper    = disc->operators[op];
628:   opFunc  = oper->ALEOpFunc;
629:   test    = oper->test;
630:   rowSize = test->size;
631:   colSize = disc->size;

633:   if (opFunc == PETSC_NULL) SETERRQ(PETSC_ERR_ARG_CORRUPT, "Invalid function");
634:   if (mesh->isPeriodic == PETSC_TRUE) {
635:     coords[0*2+0] = nodes[elements[elem*numCorners+0]*2+0];
636:     coords[0*2+1] = nodes[elements[elem*numCorners+0]*2+1];
637:     for(f = 1; f < PetscMax(disc->funcs, test->funcs); f++) {
638:       coords[f*2+0] = MeshPeriodicRelativeX(mesh, nodes[elements[elem*numCorners+f]*2+0], coords[0*2+0]);
639:       coords[f*2+1] = MeshPeriodicRelativeY(mesh, nodes[elements[elem*numCorners+f]*2+1], coords[0*2+1]);
640:     }
641:   } else {
642:     for(f = 0; f < PetscMax(disc->funcs, test->funcs); f++) {
643:       coords[f*2+0] = nodes[elements[elem*numCorners+f]*2+0];
644:       coords[f*2+1] = nodes[elements[elem*numCorners+f]*2+1];
645:     }
646:   }

648:   (*opFunc)(disc, test, rowSize, colSize, rowStart, colStart, elemSize, coords, alpha, field, ALEfield, array, ctx);
649: 
650:   return(0);
651: }

653: #undef  __FUNCT__
655: static int DiscEvaluateNonlinearALEOperatorGalerkin_Triangular_1D_Quadratic(Discretization disc, Mesh mesh, NonlinearOperator f,
656:                                                                             PetscScalar alpha, int elem, int numArgs, PetscScalar **field,
657:                                                                             PetscScalar *ALEfield, PetscScalar *vec, void *ctx)
658: {
659:   Mesh_Triangular *tri        = (Mesh_Triangular *) mesh->data;
660:   double          *nodes      = tri->nodes;
661:   int             *elements   = tri->faces;
662:   int              numCorners = mesh->numCorners;
663:   int              comp       = disc->comp;     /* The number of components in this field */
664:   int              funcs      = disc->funcs;    /* The number of shape functions per component */
665:   PetscScalar     *funcVal    = disc->funcVal;  /* Function value at a quadrature point */
666:   PetscScalar    **fieldVal   = disc->fieldVal; /* Field value and derivatives at a quadrature point */
667:   double           jac;                         /* |J| for map to standard element */
668:   double           invjac;                      /* |J^{-1}| for map from standard element */
669:   int              numQuadPoints;               /* Number of points used for Gaussian quadrature */
670:   double          *quadWeights;                 /* Weights in the standard element for Gaussian quadrature */
671:   double          *quadShapeFuncs;              /* Shape functions evaluated at quadrature points */
672:   double          *quadShapeFuncDers;           /* Shape function derivatives evaluated at quadrature points */
673:   double           x, y;                        /* The integration point */
674:   double           dxxi;                        /* PartDer{x}{xi}  */
675:   double           dxet;                        /* PartDer{x}{eta}  */
676:   double           dyxi;                        /* PartDer{y}{xi} */
677:   double           dyet;                        /* PartDer{y}{eta} */
678:   double           dxix;                        /* PartDer{xi}{x}  */
679:   double           detx;                        /* PartDer{eta}{x} */
680:   double           dxiy;                        /* PartDer{xi}{y}  */
681:   double           dety;                        /* PartDer{eta}{y} */
682:   PetscScalar      dfxi;                        /* PartDer{field}{xi}  */
683:   PetscScalar      dfet;                        /* PartDer{field}{eta} */
684:   double           coords[12];                  /* Coordinates of the element */
685:   int              rank;
686:   int              i, j, k, func, p, arg;
687: #ifdef PETSC_USE_BOPT_g
688:   PetscTruth       opt;
689: #endif
690:   int              ierr;

693:   MPI_Comm_rank(disc->comm, &rank);
694:   numQuadPoints     = disc->numQuadPoints;
695:   quadWeights       = disc->quadWeights;
696:   quadShapeFuncs    = disc->quadShapeFuncs;
697:   quadShapeFuncDers = disc->quadShapeFuncDers;

699:   /* Calculate the determinant of the inverse Jacobian of the map to the standard element */
700:   if (mesh->isPeriodic == PETSC_TRUE) {
701:     coords[0*2+0] = nodes[elements[elem*numCorners+0]*2+0];
702:     coords[0*2+1] = nodes[elements[elem*numCorners+0]*2+1];
703:     for(func = 1; func < funcs; func++) {
704:       coords[func*2+0] = MeshPeriodicRelativeX(mesh, nodes[elements[elem*numCorners+func]*2+0], coords[0*2+0]);
705:       coords[func*2+1] = MeshPeriodicRelativeY(mesh, nodes[elements[elem*numCorners+func]*2+1], coords[0*2+1]);
706:     }
707:   } else {
708:     for(func = 0; func < funcs; func++) {
709:       coords[func*2+0] = nodes[elements[elem*numCorners+func]*2+0];
710:       coords[func*2+1] = nodes[elements[elem*numCorners+func]*2+1];
711:     }
712:   }
713:   /* Check for constant jacobian here */
714:   if (PETSC_FALSE) {
715:     jac = PetscAbsReal((coords[2] - coords[0])*(coords[5] - coords[1]) - (coords[4] - coords[0])*(coords[3] - coords[1]));
716:     if (jac < 1.0e-14) {
717:       PetscPrintf(PETSC_COMM_SELF, "[%d], elem: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
718:                   rank, elem, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
719:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
720:     }
721:   }
722: #ifdef PETSC_USE_BOPT_g
723:   PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
724:   if (opt == PETSC_TRUE) {
725:     PetscPrintf(PETSC_COMM_SELF, "[%d]elem: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
726:                 rank, elem, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
727:     PetscPrintf(PETSC_COMM_SELF, "  x4: %g y4: %g x5: %g y5: %g x6: %g y6: %gn",
728:                 coords[6], coords[7], coords[8], coords[9], coords[10], coords[11]);
729:   }
730: #endif

732:   /* Calculate element vector entries by Gaussian quadrature */
733:   for(p = 0; p < numQuadPoints; p++) {
734:     /* x                      = sum^{funcs}_{f=1} x_f   phi^f(p)
735:        PartDer{x}{xi}(p)    = sum^{funcs}_{f=1} x_f   PartDer{phi^f(p)}{xi}
736:        PartDer{x}{eta}(p)   = sum^{funcs}_{f=1} x_f   PartDer{phi^f(p)}{eta}
737:        y                      = sum^{funcs}_{f=1} y_f   phi^f(p)
738:        PartDer{y}{xi}(p)    = sum^{funcs}_{f=1} y_f   PartDer{phi^f(p)}{xi}
739:        PartDer{y}{eta}(p)   = sum^{funcs}_{f=1} y_f   PartDer{phi^f(p)}{eta}
740:        u^i                    = sum^{funcs}_{f=1} u^i_f phi^f(p)
741:        PartDer{u^i}{xi}(p)  = sum^{funcs}_{f=1} u^i_f PartDer{phi^f(p)}{xi}
742:        PartDer{u^i}{eta}(p) = sum^{funcs}_{f=1} u^i_f PartDer{phi^f(p)}{eta} */
743:     x    = 0.0; y    = 0.0;
744:     dxxi = 0.0; dyxi = 0.0;
745:     dxet = 0.0; dyet = 0.0;
746:     for(arg = 0; arg < numArgs; arg++)
747:       for(j = 0; j < comp*3; j++)
748:         fieldVal[arg][j] = 0.0;
749:     for(func = 0; func < funcs; func++)
750:     {
751:       x    += coords[func*2]  *quadShapeFuncs[p*funcs+func];
752:       dxxi += coords[func*2]  *quadShapeFuncDers[p*funcs*2+func*2];
753:       dxet += coords[func*2]  *quadShapeFuncDers[p*funcs*2+func*2+1];
754:       y    += coords[func*2+1]*quadShapeFuncs[p*funcs+func];
755:       dyxi += coords[func*2+1]*quadShapeFuncDers[p*funcs*2+func*2];
756:       dyet += coords[func*2+1]*quadShapeFuncDers[p*funcs*2+func*2+1];
757:       for(arg = 0; arg < numArgs; arg++) {
758:         for(j = 0; j < comp; j++) {
759:           fieldVal[arg][j*3]   += (field[arg][func*comp+j] - ALEfield[func*comp+j])*quadShapeFuncs[p*funcs+func];
760:           fieldVal[arg][j*3+1] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*2+func*2];
761:           fieldVal[arg][j*3+2] += field[arg][func*comp+j]*quadShapeFuncDers[p*funcs*2+func*2+1];
762:         }
763:       }
764:     }
765:     if (mesh->isPeriodic == PETSC_TRUE) {
766:       x = MeshPeriodicX(mesh, x);
767:       y = MeshPeriodicY(mesh, y);
768:     }
769:     jac = PetscAbsReal(dxxi*dyet - dxet*dyxi);
770:     if (jac < 1.0e-14) {
771:       PetscPrintf(PETSC_COMM_SELF, "[%d]p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
772:                   rank, p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
773:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
774:     }
775:     /* These are the elements of the inverse matrix */
776:     invjac = 1/jac;
777:     dxix   =  dyet*invjac;
778:     dxiy   = -dxet*invjac;
779:     detx   = -dyxi*invjac;
780:     dety   =  dxxi*invjac;

782:     /* Convert the field derivatives to old coordinates */
783:     for(arg = 0; arg < numArgs; arg++) {
784:       for(j = 0; j < comp; j++) {
785:         dfxi                 = fieldVal[arg][j*3+1];
786:         dfet                 = fieldVal[arg][j*3+2];
787:         fieldVal[arg][j*3+1] = dfxi*dxix + dfet*detx;
788:         fieldVal[arg][j*3+2] = dfxi*dxiy + dfet*dety;
789:       }
790:     }

792:     (*f)(1, comp, &x, &y, PETSC_NULL, numArgs, fieldVal, funcVal, ctx);
793: #ifdef PETSC_USE_BOPT_g
794:     PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
795:     if (opt == PETSC_TRUE) {
796:       PetscPrintf(PETSC_COMM_SELF, "[%d]p: %d jac: %g", rank, p, jac);
797:       for(j = 0; j < comp; j++)
798:         PetscPrintf(PETSC_COMM_SELF, " func[%d]: %g", j, PetscRealPart(funcVal[j]));
799:       PetscPrintf(PETSC_COMM_SELF, "n");
800:     }
801: #endif

803:     for(i = 0, k = 0; i < funcs; i++) {
804:       for(j = 0; j < comp; j++, k++) {
805:         vec[k] += alpha*funcVal[j]*quadShapeFuncs[p*funcs+i]*jac*quadWeights[p];
806: #ifdef PETSC_USE_BOPT_g
807:         PetscOptionsHasName(PETSC_NULL, "-trace_assembly", &opt);
808:         if (opt == PETSC_TRUE) {
809:           PetscPrintf(PETSC_COMM_SELF, "[%d]  vec[%d]: %gn", rank, k, PetscRealPart(vec[k]));
810:         }
811: #endif
812:       }
813:     }
814:   }
815:   PetscLogFlops(((12 + (7*numArgs + 5)*comp)*funcs + 8 + 6*numArgs*comp) * numQuadPoints);
816:   return(0);
817: }

819: #undef  __FUNCT__
821: int Identity_Triangular_1D_Quadratic(Discretization disc, Discretization test, int rowSize, int colSize,
822:                                      int globalRowStart, int globalColStart, int globalSize, double *coords,
823:                                      PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
824: {
825:   int     numQuadPoints;     /* Number of points used for Gaussian quadrature */
826:   double *quadWeights;       /* Weights in the standard element for Gaussian quadrature */
827:   double *quadShapeFuncs;    /* Shape functions evaluated at quadrature points */
828:   double *quadTestFuncs;     /* Test  functions evaluated at quadrature points */
829:   double *quadShapeFuncDers; /* Shape function derivatives evaluated at quadrature points */
830:   double  dxxi;              /* PartDer{x}{xi}  */
831:   double  dxet;              /* PartDer{x}{eta} */
832:   double  dyxi;              /* PartDer{y}{xi}  */
833:   double  dyet;              /* PartDer{y}{eta} */
834:   double  jac;               /* |J| for map to standard element */
835:   int     comp;              /* The number of field components */
836:   int     funcs;             /* The number of shape functions */
837:   int     i, j, c, f, p;

840:   /* Calculate element matrix entries by Gaussian quadrature */
841:   comp              = disc->comp;
842:   funcs             = disc->funcs;
843:   numQuadPoints     = disc->numQuadPoints;
844:   quadWeights       = disc->quadWeights;
845:   quadShapeFuncs    = disc->quadShapeFuncs;
846:   quadTestFuncs     = test->quadShapeFuncs;
847:   quadShapeFuncDers = disc->quadShapeFuncDers;
848:   for(p = 0; p < numQuadPoints; p++)
849:   {
850:     /* PartDer{x}{xi}(p)  = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{xi}
851:        PartDer{x}{eta}(p) = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{eta}
852:        PartDer{y}{xi}(p)  = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{xi}
853:        PartDer{y}{eta}(p) = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{eta} */
854:     dxxi = 0.0; dxet = 0.0;
855:     dyxi = 0.0; dyet = 0.0;
856:     for(f = 0; f < funcs; f++)
857:     {
858:       dxxi += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2];
859:       dxet += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2+1];
860:       dyxi += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2];
861:       dyet += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2+1];
862:     }
863:     jac = PetscAbsReal(dxxi*dyet - dxet*dyxi);
864: #ifdef PETSC_USE_BOPT_g
865:     if (jac < 1.0e-14) {
866:       PetscPrintf(PETSC_COMM_SELF, "p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
867:                   p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
868:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
869:     }
870: #endif

872:     for(i = 0; i < funcs; i++)
873:     {
874:       for(j = 0; j < funcs; j++)
875:       {
876:                                 for(c = 0; c < comp; c++)
877:                                 {
878:                                         array[(i*comp+c+globalRowStart)*globalSize + j*comp+c+globalColStart] +=
879:                                                 alpha*quadTestFuncs[p*funcs+i]*quadShapeFuncs[p*funcs+j]*jac*quadWeights[p];
880:                                         /* PetscPrintf(PETSC_COMM_SELF, "  array[%d,%d]: %gn", i*comp+c+globalRowStart, j*comp+c+globalColStart,
881:                                                                                         array[(i*comp+c+globalRowStart)*globalSize + j*comp+c+globalColStart]); */
882:                                 }
883:       }
884:     }
885:   }
886:   PetscLogFlops((8*funcs + 3 + 5*funcs*funcs*comp) * numQuadPoints);

888:   return(0);
889: }

891: #undef  __FUNCT__
893: int Laplacian_Triangular_1D_Quadratic(Discretization disc, Discretization test, int rowSize, int colSize,
894:                                       int globalRowStart, int globalColStart, int globalSize, double *coords,
895:                                       PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
896: {
897:   int     numQuadPoints;     /* Number of points used for Gaussian quadrature */
898:   double *quadWeights;       /* Weights in the standard element for Gaussian quadrature */
899:   double *quadShapeFuncDers; /* Shape function derivatives evaluated at quadrature points */
900:   double *quadTestFuncDers;  /* Test  function derivatives evaluated at quadrature points */
901:   double  dxxi;              /* PartDer{x}{xi}  */
902:   double  dxet;              /* PartDer{x}{eta} */
903:   double  dyxi;              /* PartDer{y}{xi}  */
904:   double  dyet;              /* PartDer{y}{eta} */
905:   double  dxix;              /* PartDer{xi}{x}  */
906:   double  detx;              /* PartDer{eta}{x} */
907:   double  dxiy;              /* PartDer{xi}{y}  */
908:   double  dety;              /* PartDer{eta}{y} */
909:   double  dphix;             /* PartDer{phi_i}{x} times PartDer{phi_j}{x} */
910:   double  dphiy;             /* PartDer{phi_i}{y} times PartDer{phi_j}{y} */
911:   double  jac;               /* |J| for map to standard element */
912:   double  invjac;            /* |J^{-1}| for map from standard element */
913:         int     comp;              /* The number of field components */
914:         int     funcs;             /* The number of shape functions */
915:   int     i, j, c, f, p;

918:   /* Calculate element matrix entries by Gaussian quadrature */
919:   comp              = disc->comp;
920:   funcs             = disc->funcs;
921:   numQuadPoints     = disc->numQuadPoints;
922:   quadWeights       = disc->quadWeights;
923:   quadShapeFuncDers = disc->quadShapeFuncDers;
924:   quadTestFuncDers  = test->quadShapeFuncDers;
925:   for(p = 0; p < numQuadPoints; p++)
926:   {
927:     /* PartDer{x}{xi}(p)  = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{xi}
928:        PartDer{x}{eta}(p) = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{eta}
929:        PartDer{y}{xi}(p)  = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{xi}
930:        PartDer{y}{eta}(p) = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{eta} */
931:     dxxi = 0.0; dxet = 0.0;
932:     dyxi = 0.0; dyet = 0.0;
933:     for(f = 0; f < funcs; f++)
934:     {
935:       dxxi += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2];
936:       dxet += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2+1];
937:       dyxi += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2];
938:       dyet += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2+1];
939:     }
940:     jac  = PetscAbsReal(dxxi*dyet - dxet*dyxi);
941: #ifdef PETSC_USE_BOPT_g
942:     if (jac < 1.0e-14) {
943:       PetscPrintf(PETSC_COMM_SELF, "p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
944:                   p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
945:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
946:     }
947: #endif
948:                 /* These are the elements of the inverse matrix */
949:     invjac =  1.0/jac;
950:                 dxix   =  dyet*invjac;
951:                 dxiy   = -dxet*invjac;
952:                 detx   = -dyxi*invjac;
953:                 dety   =  dxxi*invjac;

955:     for(i = 0; i < funcs; i++)
956:     {
957:       for(j = 0; j < funcs; j++)
958:       {
959:         dphix = (quadTestFuncDers[p*funcs*2+i*2]*dxix + quadTestFuncDers[p*funcs*2+i*2+1]*detx)*
960:           (quadShapeFuncDers[p*funcs*2+j*2]*dxix + quadShapeFuncDers[p*funcs*2+j*2+1]*detx);
961:         dphiy = (quadTestFuncDers[p*funcs*2+i*2]*dxiy + quadTestFuncDers[p*funcs*2+i*2+1]*dety)*
962:           (quadShapeFuncDers[p*funcs*2+j*2]*dxiy + quadShapeFuncDers[p*funcs*2+j*2+1]*dety);
963:                                 for(c = 0; c < comp; c++)
964:                                 {
965:                                         array[(i*comp+c+globalRowStart)*globalSize + j*comp+c+globalColStart] +=
966:                                                 -alpha*(dphix + dphiy)*jac*quadWeights[p];
967:                                         /* PetscPrintf(PETSC_COMM_SELF, "  array[%d,%d]: %gn", i*comp+c+globalRowStart, j*comp+c+globalColStart,
968:                                                                                         array[(i*comp+c+globalRowStart)*globalSize + j*comp+c+globalColStart]); */
969:                                 }
970:       }
971:     }
972:   }
973:   PetscLogFlops((8*funcs + 8 + 19*funcs*funcs*comp) * numQuadPoints);

975:   return(0);
976: }

978: #undef  __FUNCT__
980: int Weighted_Laplacian_Triangular_1D_Quadratic(Discretization disc, Discretization test, int rowSize, int colSize,
981:                                                int globalRowStart, int globalColStart, int globalSize, double *coords,
982:                                                PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
983: {
984:   int     numQuadPoints;     /* Number of points used for Gaussian quadrature */
985:   double *quadWeights;       /* Weights in the standard element for Gaussian quadrature */
986:   double *quadShapeFuncDers; /* Shape function derivatives evaluated at quadrature points */
987:   double *quadTestFuncDers;  /* Test  function derivatives evaluated at quadrature points */
988:   double  dxxi;              /* PartDer{x}{xi}  */
989:   double  dxet;              /* PartDer{x}{eta} */
990:   double  dyxi;              /* PartDer{y}{xi}  */
991:   double  dyet;              /* PartDer{y}{eta} */
992:   double  dxix;              /* PartDer{xi}{x}  */
993:   double  detx;              /* PartDer{eta}{x} */
994:   double  dxiy;              /* PartDer{xi}{y}  */
995:   double  dety;              /* PartDer{eta}{y} */
996:   double  dphix;             /* PartDer{phi_i}{x} times PartDer{phi_j}{x} */
997:   double  dphiy;             /* PartDer{phi_i}{y} times PartDer{phi_j}{y} */
998:   double  jac;               /* |J| for map to standard element */
999:   double  invjac;            /* |J^{-1}| for map from standard element */
1000:         int     comp;              /* The number of field components */
1001:         int     funcs;             /* The number of shape functions */
1002:   int     i, j, c, f, p;

1004:   /* Each element is weighted by its Jacobian. This is supposed to make smaller elements "stiffer". */
1006:   /* Calculate element matrix entries by Gaussian quadrature */
1007:         comp              = disc->comp;
1008:         funcs             = disc->funcs;
1009:   numQuadPoints     = disc->numQuadPoints;
1010:   quadWeights       = disc->quadWeights;
1011:   quadShapeFuncDers = disc->quadShapeFuncDers;
1012:   quadTestFuncDers  = test->quadShapeFuncDers;
1013:   for(p = 0; p < numQuadPoints; p++)
1014:   {
1015:     /* PartDer{x}{xi}(p)  = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{xi}
1016:        PartDer{x}{eta}(p) = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{eta}
1017:        PartDer{y}{xi}(p)  = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{xi}
1018:        PartDer{y}{eta}(p) = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{eta} */
1019:     dxxi = 0.0; dxet = 0.0;
1020:     dyxi = 0.0; dyet = 0.0;
1021:     for(f = 0; f < funcs; f++)
1022:     {
1023:       dxxi += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2];
1024:       dxet += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2+1];
1025:       dyxi += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2];
1026:       dyet += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2+1];
1027:     }
1028:     jac  = PetscAbsReal(dxxi*dyet - dxet*dyxi);
1029: #ifdef PETSC_USE_BOPT_g
1030:     if (jac < 1.0e-14) {
1031:       PetscPrintf(PETSC_COMM_SELF, "p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
1032:                   p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
1033:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
1034:     }
1035: #endif
1036:                 /* These are the elements of the inverse matrix */
1037:     invjac =  1.0/jac;
1038:                 dxix   =  dyet*invjac;
1039:                 dxiy   = -dxet*invjac;
1040:                 detx   = -dyxi*invjac;
1041:                 dety   =  dxxi*invjac;

1043:     for(i = 0; i < funcs; i++)
1044:     {
1045:       for(j = 0; j < funcs; j++)
1046:       {
1047:         dphix = (quadTestFuncDers[p*funcs*2+i*2]*dxix + quadTestFuncDers[p*funcs*2+i*2+1]*detx)*
1048:           (quadShapeFuncDers[p*funcs*2+j*2]*dxix + quadShapeFuncDers[p*funcs*2+j*2+1]*detx);
1049:         dphiy = (quadTestFuncDers[p*funcs*2+i*2]*dxiy + quadTestFuncDers[p*funcs*2+i*2+1]*dety)*
1050:           (quadShapeFuncDers[p*funcs*2+j*2]*dxiy + quadShapeFuncDers[p*funcs*2+j*2+1]*dety);
1051:                                 for(c = 0; c < comp; c++)
1052:                                 {
1053:                                         array[(i*comp+c+globalRowStart)*globalSize + j*comp+c+globalColStart] +=
1054:                                                 -alpha*(dphix + dphiy)*quadWeights[p];
1055:                                 }
1056:       }
1057:     }
1058:   }
1059:   PetscLogFlops((8*funcs + 8 + 18*funcs*funcs*comp) * numQuadPoints);

1061:   return(0);
1062: }

1064: #undef  __FUNCT__
1066: int Divergence_Triangular_1D_Quadratic(Discretization disc, Discretization test, int rowSize, int colSize,
1067:                                        int globalRowStart, int globalColStart, int globalSize, double *coords,
1068:                                        PetscScalar alpha, PetscScalar *field, PetscScalar *array, void *ctx)
1069: {
1070:         /* We are using the convention that

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

1075:                  and

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

1080:                  where $d$ is the number of space dimensions. This agrees with the convention which allows
1081:                  $Delta matrix{u_1 cr u_2} = 0$ to denote a set of scalar equations        This also requires that
1082:      the dimension of a vector must be divisible by the space dimension in order to be acted upon by
1083:      the divergence operator */
1084:   int     numQuadPoints;     /* Number of points used for Gaussian quadrature */
1085:   double *quadWeights;       /* Weights in the standard element for Gaussian quadrature */
1086:   double *quadTestFuncs;     /* Test  functions evaluated at quadrature points */
1087:   double *quadShapeFuncDers; /* Shape function derivatives evaluated at quadrature points */
1088:   double  dxxi;              /* PartDer{x}{xi}  */
1089:   double  dxet;              /* PartDer{x}{eta} */
1090:   double  dyxi;              /* PartDer{y}{xi}  */
1091:   double  dyet;              /* PartDer{y}{eta} */
1092:   double  dxix;              /* PartDer{xi}{x}  */
1093:   double  detx;              /* PartDer{eta}{x} */
1094:   double  dxiy;              /* PartDer{xi}{y}  */
1095:   double  dety;              /* PartDer{eta}{y} */
1096:   double  dphix;             /* PartDer{phi_i}{x} times PartDer{phi_j}{x} */
1097:   double  dphiy;             /* PartDer{phi_i}{y} times PartDer{phi_j}{y} */
1098:   double  jac;               /* |J| for map to standard element */
1099:   double  invjac;            /* |J^{-1}| for map from standard element */
1100:   int     comp;              /* The number of field components */
1101:   int     tcomp;             /* The number of field components for the test field */
1102:   int     funcs;             /* The number of shape functions */
1103:   int     tfuncs;            /* The number of test functions */
1104:   int     i, j, c, tc, f, p;

1107:   /* Calculate element matrix entries by Gaussian quadrature */
1108:   comp              = disc->comp;
1109:   tcomp             = test->comp;
1110:   funcs             = disc->funcs;
1111:   tfuncs            = test->funcs;
1112:   numQuadPoints     = disc->numQuadPoints;
1113:   quadWeights       = disc->quadWeights;
1114:   quadTestFuncs     = test->quadShapeFuncs;
1115:   quadShapeFuncDers = disc->quadShapeFuncDers;
1116:   for(p = 0; p < numQuadPoints; p++) {
1117:     /* PartDer{x}{xi}(p)  = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{xi}
1118:        PartDer{x}{eta}(p) = sum^{funcs}_{f=1} x_f PartDer{phi^f(p)}{eta}
1119:        PartDer{y}{xi}(p)  = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{xi}
1120:        PartDer{y}{eta}(p) = sum^{funcs}_{f=1} y_f PartDer{phi^f(p)}{eta} */
1121:     dxxi = 0.0; dxet = 0.0;
1122:     dyxi = 0.0; dyet = 0.0;
1123:     for(f = 0; f < funcs; f++)
1124:     {
1125:       dxxi += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2];
1126:       dxet += coords[f*2]  *quadShapeFuncDers[p*funcs*2+f*2+1];
1127:       dyxi += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2];
1128:       dyet += coords[f*2+1]*quadShapeFuncDers[p*funcs*2+f*2+1];
1129:     }
1130:     jac  = PetscAbsReal(dxxi*dyet - dxet*dyxi);
1131: #ifdef PETSC_USE_BOPT_g
1132:     if (jac < 1.0e-14) {
1133:       PetscPrintf(PETSC_COMM_SELF, "p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
1134:                                                                         p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]);
1135:       SETERRQ(PETSC_ERR_DISC_SING_JAC, "Singular Jacobian");
1136:     }
1137: #endif
1138:                 /* PetscPrintf(PETSC_COMM_SELF, "p: %d x1: %g y1: %g x2: %g y2: %g x3: %g y3: %gn",
1139:                                                                 p, coords[0], coords[1], coords[2], coords[3], coords[4], coords[5]); */
1140:                 /* These are the elements of the inverse matrix */
1141:     invjac =  1.0/jac;
1142:     dxix   =  dyet*invjac;
1143:     dxiy   = -dxet*invjac;
1144:     detx   = -dyxi*invjac;
1145:     dety   =  dxxi*invjac;

1147:                 /* The rows are test functions */
1148:     for(i = 0; i < tfuncs; i++)
1149:     {
1150:       for(tc = 0; tc < tcomp; tc++)
1151:       {
1152:         /* The columns are shape functions */
1153:         for(j = 0; j < funcs; j++)
1154:         {
1155:           dphix = quadShapeFuncDers[p*funcs*2+j*2]*dxix + quadShapeFuncDers[p*funcs*2+j*2+1]*detx;
1156:           dphiy = quadShapeFuncDers[p*funcs*2+j*2]*dxiy + quadShapeFuncDers[p*funcs*2+j*2+1]*dety;
1157:           /* We divide by the number of space dimensions */
1158:           for(c = 0; c < comp/2; c++)
1159:           {
1160:             array[(i*tcomp+tc+globalRowStart)*globalSize + j*comp+c*2+globalColStart] +=
1161:               alpha*dphix*quadTestFuncs[p*tfuncs+i]*jac*quadWeights[p];
1162:                                                         /* PetscPrintf(PETSC_COMM_SELF, "  array[%d,%d]: %gn", i*tcomp+tc+globalRowStart, j*comp+c*2+globalColStart,
1163:                                                                                                         array[(i*tcomp+tc+globalRowStart)*globalSize + j*comp+c*2+globalColStart]); */
1164:             array[(i*tcomp+tc+globalRowStart)*globalSize + j*comp+c*2+1+globalColStart] +=
1165:               alpha*dphiy*quadTestFuncs[p*tfuncs+i]*jac*quadWeights[p];
1166:                                                         /* PetscPrintf(PETSC_COMM_SELF, "  array[%d,%d]: %gn", i*tcomp+tc+globalRowStart, j*comp+c*2+1+globalColStart,
1167:                                                                                                         array[(i*tcomp+tc+globalRowStart)*globalSize + j*comp+c*2+1+globalColStart]); */
1168:                                         }
1169:                                 }
1170:                         }
1171:     }
1172:   }
1173:   PetscLogFlops((8*funcs + 8 + 8*tfuncs*tcomp*funcs*comp) * numQuadPoints);

1175:   return(0);
1176: }

1178: #undef  __FUNCT__
1180: int DiscInterpolateField_Triangular_1D_Quadratic(Discretization disc, Mesh oldMesh, int elem, double x, double y, double z,
1181:                                                  PetscScalar *oldFieldVal, PetscScalar *newFieldVal, InterpolationType type)
1182: {
1183:   Mesh_Triangular *tri        = (Mesh_Triangular *) oldMesh->data;
1184:   int              numCorners = oldMesh->numCorners;
1185:   int             *elements   = tri->faces;
1186:   int             *neighbors  = tri->neighbors;
1187:   double          *nodes      = tri->nodes;
1188:   double           coords[24];  /* Coordinates of our "big element" */
1189:   double           xi, eta;     /* Canonical coordinates of the point */
1190:   double           x21, x31, y21, y31, jac, invjac, dx, dy, dxix, dxiy, detx, dety, xiOld, etaOld;
1191:   int              comp = disc->comp;
1192:   int              neighbor, corner, nelem, node, c;
1193:   int              ierr;

1196:   /* No scheme in place for boundary elements */
1197:   for(neighbor = 0; neighbor < 3; neighbor++)
1198:     if (neighbors[elem*3+neighbor] < 0)
1199:       type = INTERPOLATION_LOCAL;

1201:   switch (type)
1202:   {
1203:   case INTERPOLATION_LOCAL:
1204:     if (oldMesh->isPeriodic == PETSC_TRUE) {
1205:       coords[0*2+0] = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+0]*2+0], x);
1206:       coords[0*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+0]*2+1], y);
1207:       coords[1*2+0] = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+1]*2+0], x);
1208:       coords[1*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+1]*2+1], y);
1209:       coords[2*2+0] = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+2]*2+0], x);
1210:       coords[2*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+2]*2+1], y);
1211:       coords[3*2+0] = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+3]*2+0], x);
1212:       coords[3*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+3]*2+1], y);
1213:       coords[4*2+0] = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+4]*2+0], x);
1214:       coords[4*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+4]*2+1], y);
1215:       coords[5*2+0] = MeshPeriodicRelativeX(oldMesh, nodes[elements[elem*numCorners+5]*2+0], x);
1216:       coords[5*2+1] = MeshPeriodicRelativeY(oldMesh, nodes[elements[elem*numCorners+5]*2+1], y);
1217:     } else {
1218:       coords[0*2+0] = nodes[elements[elem*numCorners+0]*2+0];
1219:       coords[0*2+1] = nodes[elements[elem*numCorners+0]*2+1];
1220:       coords[1*2+0] = nodes[elements[elem*numCorners+1]*2+0];
1221:       coords[1*2+1] = nodes[elements[elem*numCorners+1]*2+1];
1222:       coords[2*2+0] = nodes[elements[elem*numCorners+2]*2+0];
1223:       coords[2*2+1] = nodes[elements[elem*numCorners+2]*2+1];
1224:       coords[3*2+0] = nodes[elements[elem*numCorners+3]*2+0];
1225:       coords[3*2+1] = nodes[elements[elem*numCorners+3]*2+1];
1226:       coords[4*2+0] = nodes[elements[elem*numCorners+4]*2+0];
1227:       coords[4*2+1] = nodes[elements[elem*numCorners+4]*2+1];
1228:       coords[5*2+0] = nodes[elements[elem*numCorners+5]*2+0];
1229:       coords[5*2+1] = nodes[elements[elem*numCorners+5]*2+1];
1230:     }
1231:     /* Get the (xi,eta) coordinates of the point */
1232:     DiscTransformCoords_Triangular_1D_Quadratic(x, y, coords, &xi, &eta);
1233:     if ((xi < -1.0e-02) || (eta < -1.0e-02) || (xi > 1.01) || (eta > 1.01)) {
1234:       xiOld  = xi;
1235:       etaOld = eta;
1236:       /* Use linear approximation */
1237:       x21    = coords[1*2+0] - coords[0*2+0];
1238:       x31    = coords[2*2+0] - coords[0*2+0];
1239:       y21    = coords[1*2+1] - coords[0*2+1];
1240:       y31    = coords[2*2+1] - coords[0*2+1];
1241:       dx     = x - coords[0*2+0];
1242:       dy     = y - coords[0*2+1];
1243:       jac    = PetscAbsReal(x21*y31 - x31*y21);
1244:       invjac = 1/jac;
1245:       dxix   =  y31*invjac;
1246:       dxiy   = -x31*invjac;
1247:       detx   = -y21*invjac;
1248:       dety   =  x21*invjac;

1250:       xi     = dxix*dx + dxiy*dy;
1251:       eta    = detx*dx + dety*dy;
1252:       PetscPrintf(PETSC_COMM_SELF, "elem: %d x: %g y: %g xiOld: %g etaOld: %g xi: %g eta: %gn", elem, x, y, xiOld, etaOld, xi, eta);
1253:     }
1254:     for(c = 0; c < comp; c++) {
1255:       newFieldVal[c] = oldFieldVal[0*comp+c]*(1.0 - xi - eta)*(1.0 - 2.0*xi - 2.0*eta) +
1256:         oldFieldVal[1*comp+c]*xi *(2.0*xi  - 1.0)      +
1257:         oldFieldVal[2*comp+c]*eta*(2.0*eta - 1.0)      +
1258:         oldFieldVal[3*comp+c]*4.0*xi*eta               +
1259:         oldFieldVal[4*comp+c]*4.0*eta*(1.0 - xi - eta) +
1260:         oldFieldVal[5*comp+c]*4.0*xi *(1.0 - xi - eta);
1261:     }
1262:     PetscLogFlops(34*comp);
1263:     break;
1264:   case INTERPOLATION_HALO:
1265:     /* Here is our "big element" where numbers in parantheses represent
1266:        the numbering on the old little element:

1268:            2
1269:            |
1270:            | 
1271:            |  
1272:            6   5
1273:            |    
1274:            |     
1275:            |      
1276:        (1) 7---*---4 (0)
1277:            |      |
1278:            |      | 
1279:            |      |  
1280:            8   *   *   3
1281:            |      |    
1282:            |      |     
1283:            |      |      
1284:            0---9--10--11---1
1285:                   (2)

1287:        We search for the neighbor node by looking for the vertex not a member of the original element.
1288:     */
1289:     for(neighbor = 0; neighbor < 3; neighbor++)
1290:     {
1291:       nelem = neighbors[elem*3+neighbor];
1292:       for(corner = 0; corner < 3; corner++)
1293:       {
1294:         node = elements[nelem*numCorners+corner];
1295:         if ((node != elements[elem*numCorners+((neighbor+1)%3)]) && (node != elements[elem*numCorners+((neighbor+2)%3)]))
1296:         {
1297:           /* The neighboring elements give the vertices */
1298:           coords[neighbor*2]   = nodes[node*2];
1299:           coords[neighbor*2+1] = nodes[node*2+1];
1300:           break;
1301:         }
1302:       }
1303:     }
1304:     /* Element vertices form midnodes */
1305:     coords[3*2]   = nodes[elements[elem*numCorners]*2];
1306:     coords[3*2+1] = nodes[elements[elem*numCorners]*2+1];
1307:     coords[4*2]   = nodes[elements[elem*numCorners+1]*2];
1308:     coords[4*2+1] = nodes[elements[elem*numCorners+1]*2+1];
1309:     coords[5*2]   = nodes[elements[elem*numCorners+2]*2];
1310:     coords[5*2+1] = nodes[elements[elem*numCorners+2]*2+1];
1311:     /* Treat 4 triangles as one big element with quadratic shape functions */
1312:     SETERRQ(PETSC_ERR_SUP, "Unsupported interpolation type");
1313:   default:
1314:     SETERRQ(PETSC_ERR_ARG_WRONG, "Unknown interpolation type");
1315:   }
1316: 
1317:   return(0);
1318: }

1320: #undef  __FUNCT__
1322: int DiscInterpolateElementVec_Triangular_1D_Quadratic(Discretization disc, ElementVec vec, Discretization newDisc, ElementVec newVec)
1323: {
1324:   int          comp  = disc->comp;
1325:   int          size  = disc->size;
1326:   PetscScalar *array, *newArray;
1327:   PetscTruth   islin, isquad;
1328:   int          f, c;
1329:   int          ierr;

1332:   ElementVecGetArray(vec,    &array);
1333:   ElementVecGetArray(newVec, &newArray);
1334:   PetscTypeCompare((PetscObject) newDisc, DISCRETIZATION_TRIANGULAR_1D_LINEAR,    &islin);
1335:   PetscTypeCompare((PetscObject) newDisc, DISCRETIZATION_TRIANGULAR_1D_QUADRATIC, &isquad);
1336:   if (isquad == PETSC_TRUE) {
1337:     PetscMemcpy(newArray, array, size * sizeof(PetscScalar));
1338:   } else if (islin == PETSC_TRUE) {
1339:     for(f = 0; f < newDisc->funcs; f++) {
1340:       for(c = 0; c < comp; c++) {
1341:         newArray[f*comp+c] = array[f*comp+c];
1342:       }
1343:     }
1344:   } else {
1345:     SETERRQ(PETSC_ERR_SUP, "Discretization not supported");
1346:   }
1347:   ElementVecRestoreArray(vec,    &array);
1348:   ElementVecRestoreArray(newVec, &newArray);
1349:   return(0);
1350: }

1352: #undef  __FUNCT__
1354: /*
1355:   DiscSetupQuadrature_Triangular_1D_Quadratic - Setup Gaussian quadrature with a 7 point integration rule

1357:   Input Parameter:
1358: . disc - The Discretization
1359: */
1360: int DiscSetupQuadrature_Triangular_1D_Quadratic(Discretization disc) {
1361:   int    dim   = disc->dim;
1362:   int    funcs = disc->funcs;
1363:   double xi, eta;
1364:   int    p;
1365:   int    ierr;

1368:   disc->numQuadPoints = 7;
1369:   PetscMalloc(disc->numQuadPoints*dim       * sizeof(double), &disc->quadPoints);
1370:   PetscMalloc(disc->numQuadPoints           * sizeof(double), &disc->quadWeights);
1371:   PetscMalloc(disc->numQuadPoints*funcs     * sizeof(double), &disc->quadShapeFuncs);
1372:   PetscMalloc(disc->numQuadPoints*funcs*dim * sizeof(double), &disc->quadShapeFuncDers);
1373:   PetscLogObjectMemory(disc, (disc->numQuadPoints*(funcs*(dim+1) + dim+1)) * sizeof(double));
1374:   disc->quadPoints[0]  = 1.0/3.0;
1375:   disc->quadPoints[1]  = disc->quadPoints[0];
1376:   disc->quadWeights[0] = 0.11250000000000;
1377:   disc->quadPoints[2]  = 0.797426985353087;
1378:   disc->quadPoints[3]  = 0.101286507323456;
1379:   disc->quadWeights[1] = 0.0629695902724135;
1380:   disc->quadPoints[4]  = disc->quadPoints[3];
1381:   disc->quadPoints[5]  = disc->quadPoints[2];
1382:   disc->quadWeights[2] = disc->quadWeights[1];
1383:   disc->quadPoints[6]  = disc->quadPoints[4];
1384:   disc->quadPoints[7]  = disc->quadPoints[3];
1385:   disc->quadWeights[3] = disc->quadWeights[1];
1386:   disc->quadPoints[8]  = 0.470142064105115;
1387:   disc->quadPoints[9]  = 0.059715871789770;
1388:   disc->quadWeights[4] = 0.066197076394253;
1389:   disc->quadPoints[10] = disc->quadPoints[8];
1390:   disc->quadPoints[11] = disc->quadPoints[8];
1391:   disc->quadWeights[5] = disc->quadWeights[4];
1392:   disc->quadPoints[12] = disc->quadPoints[9];
1393:   disc->quadPoints[13] = disc->quadPoints[8];
1394:   disc->quadWeights[6] = disc->quadWeights[4];
1395:   for(p = 0; p < disc->numQuadPoints; p++) {
1396:     xi  = disc->quadPoints[p*2];
1397:     eta = disc->quadPoints[p*2+1];
1398:     /* phi^0: 1 - 3 (xi + eta) + 2 (xi + eta)^2 */
1399:     disc->quadShapeFuncs[p*funcs]            =  1.0 - 3.0*(xi + eta) + 2.0*(xi + eta)*(xi + eta);
1400:     disc->quadShapeFuncDers[p*funcs*2+0*2]   = -3.0 + 4.0*(xi + eta);
1401:     disc->quadShapeFuncDers[p*funcs*2+0*2+1] = -3.0 + 4.0*(xi + eta);
1402:     /* phi^1: xi (2xi - 1) */
1403:     disc->quadShapeFuncs[p*funcs+1]          =  xi*(2.0*xi - 1.0);
1404:     disc->quadShapeFuncDers[p*funcs*2+1*2]   =  4.0*xi - 1.0;
1405:     disc->quadShapeFuncDers[p*funcs*2+1*2+1] =  0.0;
1406:     /* phi^2: eta (2eta - 1) */
1407:     disc->quadShapeFuncs[p*funcs+2]          =  eta*(2.0*eta - 1.0);
1408:     disc->quadShapeFuncDers[p*funcs*2+2*2]   =  0.0;
1409:     disc->quadShapeFuncDers[p*funcs*2+2*2+1] =  4.0*eta - 1.0;
1410:     /* phi^3: 4 xi eta */
1411:     disc->quadShapeFuncs[p*funcs+3]          =  4.0*xi*eta;
1412:     disc->quadShapeFuncDers[p*funcs*2+3*2]   =  4.0*eta;
1413:     disc->quadShapeFuncDers[p*funcs*2+3*2+1] =  4.0*xi;
1414:     /* phi^4: 4 eta (1 - xi - eta) */
1415:     disc->quadShapeFuncs[p*funcs+4]          =  4.0*eta*(1.0 - xi - eta);
1416:     disc->quadShapeFuncDers[p*funcs*2+4*2]   = -4.0*eta;
1417:     disc->quadShapeFuncDers[p*funcs*2+4*2+1] = -8.0*eta + 4.0*(1.0 - xi);
1418:     /* phi^5: 4 xi (1 - xi - eta) */
1419:     disc->quadShapeFuncs[p*funcs+5]          =  4.0*xi*(1.0 - xi - eta);
1420:     disc->quadShapeFuncDers[p*funcs*2+5*2]   = -8.0*xi + 4.0*(1.0 - eta);
1421:     disc->quadShapeFuncDers[p*funcs*2+5*2+1] = -4.0*xi;
1422:   }
1423:   return(0);
1424: }

1426: #undef  __FUNCT__
1428: /*
1429:   DiscSetupOperators_Triangular_1D_Quadratic - Setup the default operators

1431:   Input Parameter:
1432: . disc - The Discretization
1433: */
1434: int DiscSetupOperators_Triangular_1D_Quadratic(Discretization disc) {
1435:   int newOp;

1439:   /* The Identity operator I -- the matrix is symmetric */
1440:   DiscretizationRegisterOperator(disc, Identity_Triangular_1D_Quadratic, &newOp);
1441:   if (newOp != IDENTITY) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", IDENTITY);
1442:   /* The Laplacian operator Delta -- the matrix is symmetric */
1443:   DiscretizationRegisterOperator(disc, Laplacian_Triangular_1D_Quadratic, &newOp);
1444:   if (newOp != LAPLACIAN) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", LAPLACIAN);
1445:   /* The Gradient operator nabla -- the matrix is rectangular */
1446:   DiscretizationRegisterOperator(disc, PETSC_NULL, &newOp);
1447:   if (newOp != GRADIENT) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", GRADIENT);
1448:   /* The Divergence operator nablacdot -- the matrix is rectangular */
1449:   DiscretizationRegisterOperator(disc, Divergence_Triangular_1D_Quadratic, &newOp);
1450:   if (newOp != DIVERGENCE) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", DIVERGENCE);
1451:   /* The weighted Laplacian operator -- the matrix is symmetric */
1452:   DiscretizationRegisterOperator(disc, Weighted_Laplacian_Triangular_1D_Quadratic, &newOp);
1453:   if (newOp != WEIGHTED_LAP) SETERRQ1(PETSC_ERR_ARG_WRONGSTATE, "Default operator %d not setup correctly", WEIGHTED_LAP);
1454:   return(0);
1455: }

1457: static struct _DiscretizationOps DOps = {PETSC_NULL/* DiscretizationSetup */,
1458:                                          DiscSetupOperators_Triangular_1D_Quadratic,
1459:                                          PETSC_NULL/* DiscretizationSetFromOptions */,
1460:                                          DiscView_Triangular_1D_Quadratic,
1461:                                          DiscDestroy_Triangular_1D_Quadratic,
1462:                                          DiscEvaluateFunctionGalerkin_Triangular_1D_Quadratic,
1463:                                          DiscEvaluateOperatorGalerkin_Triangular_1D_Quadratic,
1464:                                          DiscEvaluateALEOperatorGalerkin_Triangular_1D_Quadratic,
1465:                                          DiscEvaluateNonlinearOperatorGalerkin_Triangular_1D_Quadratic,
1466:                                          DiscEvaluateNonlinearALEOperatorGalerkin_Triangular_1D_Quadratic,
1467:                                          DiscInterpolateField_Triangular_1D_Quadratic,
1468:                                          DiscInterpolateElementVec_Triangular_1D_Quadratic};

1470: EXTERN_C_BEGIN
1471: #undef  __FUNCT__
1473: int DiscCreate_Triangular_1D_Quadratic(Discretization disc) {
1474:   int    arg;
1475:   int    ierr;

1478:   if (disc->comp <= 0) {
1479:     SETERRQ(PETSC_ERR_ARG_WRONG, "Discretization must have at least 1 component. Call DiscretizationSetNumComponents() to set this.");
1480:   }
1481:   PetscMemcpy(disc->ops, &DOps, sizeof(struct _DiscretizationOps));
1482:   disc->dim   = 2;
1483:   disc->funcs = 6;
1484:   disc->size  = disc->funcs*disc->comp;

1486:   DiscretizationSetupDefaultOperators(disc);
1487:   DiscSetupQuadrature_Triangular_1D_Quadratic(disc);

1489:   /* Storage */
1490:   PetscMalloc(disc->comp * sizeof(PetscScalar),   &disc->funcVal);
1491:   PetscMalloc(2          * sizeof(PetscScalar *), &disc->fieldVal);
1492:   for(arg = 0; arg < 2; arg++) {
1493:     PetscMalloc(disc->comp*(disc->dim+1) * sizeof(PetscScalar), &disc->fieldVal[arg]);
1494:   }
1495:   return(0);
1496: }
1497: EXTERN_C_END