Actual source code: dmfieldda.c

petsc-3.14.6 2021-03-30
Report Typos and Errors
  1: #include <petsc/private/dmfieldimpl.h>
  2: #include <petsc/private/dmimpl.h>
  3: #include <petscdmda.h>

  5: typedef struct _n_DMField_DA
  6: {
  7:   PetscScalar     *cornerVals;
  8:   PetscScalar     *cornerCoeffs;
  9:   PetscScalar     *work;
 10:   PetscReal       coordRange[3][2];
 11: }
 12: DMField_DA;

 14: static PetscErrorCode DMFieldDestroy_DA(DMField field)
 15: {
 16:   DMField_DA     *dafield;

 20:   dafield = (DMField_DA *) field->data;
 21:   PetscFree3(dafield->cornerVals,dafield->cornerCoeffs,dafield->work);
 22:   PetscFree(dafield);
 23:   return(0);
 24: }

 26: static PetscErrorCode DMFieldView_DA(DMField field,PetscViewer viewer)
 27: {
 28:   DMField_DA     *dafield = (DMField_DA *) field->data;
 29:   PetscBool      iascii;

 33:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
 34:   if (iascii) {
 35:     PetscInt i, c, dim;
 36:     PetscInt nc;
 37:     DM       dm = field->dm;

 39:     PetscViewerASCIIPrintf(viewer, "Field corner values:\n");
 40:     PetscViewerASCIIPushTab(viewer);
 41:     DMGetDimension(dm,&dim);
 42:     nc = field->numComponents;
 43:     for (i = 0, c = 0; i < (1 << dim); i++) {
 44:       PetscInt j;

 46:       for (j = 0; j < nc; j++, c++) {
 47:         PetscScalar val = dafield->cornerVals[nc * i + j];

 49: #if !defined(PETSC_USE_COMPLEX)
 50:         PetscViewerASCIIPrintf(viewer,"%g ",(double) val);
 51: #else
 52:         PetscViewerASCIIPrintf(viewer,"%g+i%g ",(double) PetscRealPart(val),(double) PetscImaginaryPart(val));
 53: #endif
 54:       }
 55:       PetscViewerASCIIPrintf(viewer,"\n");
 56:     }
 57:     PetscViewerASCIIPopTab(viewer);
 58:   }
 59:   return(0);
 60: }

 62: #define MEdot(y,A,x,m,c,cast)                          \
 63:   do {                                                 \
 64:     PetscInt _k, _l;                                   \
 65:     for (_k = 0; _k < (c); _k++) (y)[_k] = 0.;         \
 66:     for (_l = 0; _l < (m); _l++) {                     \
 67:       for (_k = 0; _k < (c); _k++) {                   \
 68:         (y)[_k] += cast((A)[(c) * _l + _k]) * (x)[_l]; \
 69:       }                                                \
 70:     }                                                  \
 71:   } while (0)

 73: #define MEHess(out,cf,etaB,etaD,dim,nc,cast)                      \
 74:   do {                                                            \
 75:     PetscInt _m, _j, _k;                                          \
 76:     for (_m = 0; _m < (nc) * (dim) * (dim); _m++) (out)[_m] = 0.; \
 77:     for (_j = 0; _j < (dim); _j++) {                              \
 78:       for (_k = _j + 1; _k < (dim); _k++) {                       \
 79:         PetscInt _ind = (1 << _j) + (1 << _k);                    \
 80:         for (_m = 0; _m < (nc); _m++) {                           \
 81:           PetscScalar c = (cf)[_m] * (etaB)[_ind] * (etaD)[_ind];   \
 82:           (out)[(_m * (dim) + _k) * (dim) + _j] += cast(c);       \
 83:           (out)[(_m * (dim) + _j) * (dim) + _k] += cast(c);       \
 84:         }                                                         \
 85:       }                                                           \
 86:     }                                                             \
 87:   } while (0)

 89: static void MultilinearEvaluate(PetscInt dim, PetscReal (*coordRange)[2], PetscInt nc, PetscScalar *cf, PetscScalar *cfWork, PetscInt nPoints, const PetscScalar *points, PetscDataType datatype, void *B, void *D, void *H)
 90: {
 91:   PetscInt i, j, k, l, m;
 92:   PetscInt  whol = 1 << dim;
 93:   PetscInt  half = whol >> 1;

 96:   if (!B && !D && !H) PetscFunctionReturnVoid();
 97:   for (i = 0; i < nPoints; i++) {
 98:     const PetscScalar *point = &points[dim * i];
 99:     PetscReal deta[3] = {0.};
100:     PetscReal etaB[8] = {1.,1.,1.,1.,1.,1.,1.,1.};
101:     PetscReal etaD[8] = {1.,1.,1.,1.,1.,1.,1.,1.};
102:     PetscReal work[8];

104:     for (j = 0; j < dim; j++) {
105:       PetscReal e, d;

107:       e = (PetscRealPart(point[j]) - coordRange[j][0]) / coordRange[j][1];
108:       deta[j] = d = 1. / coordRange[j][1];
109:       for (k = 0; k < whol; k++) {work[k] = etaB[k];}
110:       for (k = 0; k < half; k++) {
111:         etaB[k]        = work[2 * k] * e;
112:         etaB[k + half] = work[2 * k + 1];
113:       }
114:       if (H) {
115:         for (k = 0; k < whol; k++) {work[k] = etaD[k];}
116:         for (k = 0; k < half; k++) {
117:           etaD[k + half] = work[2 * k];
118:           etaD[k       ] = work[2 * k + 1] * d;
119:         }
120:       }
121:     }
122:     if (B) {
123:       if (datatype == PETSC_SCALAR) {
124:         PetscScalar *out = &((PetscScalar *)B)[nc * i];

126:         MEdot(out,cf,etaB,(1 << dim),nc,(PetscScalar));
127:       } else {
128:         PetscReal *out = &((PetscReal *)B)[nc * i];

130:         MEdot(out,cf,etaB,(1 << dim),nc,PetscRealPart);
131:       }
132:     }
133:     if (D) {
134:       if (datatype == PETSC_SCALAR) {
135:         PetscScalar *out = &((PetscScalar *)D)[nc * dim * i];

137:         for (m = 0; m < nc * dim; m++) out[m] = 0.;
138:       } else {
139:         PetscReal *out = &((PetscReal *)D)[nc * dim * i];

141:         for (m = 0; m < nc * dim; m++) out[m] = 0.;
142:       }
143:       for (j = 0; j < dim; j++) {
144:         PetscReal d = deta[j];

146:         for (k = 0; k < whol * nc; k++) {cfWork[k] = cf[k];}
147:         for (k = 0; k < whol; k++) {work[k] = etaB[k];}
148:         for (k = 0; k < half; k++) {
149:           PetscReal e;

151:           etaB[k]        =     work[2 * k];
152:           etaB[k + half] = e = work[2 * k + 1];

154:           for (l = 0; l < nc; l++) {
155:             cf[ k         * nc + l] = cfWork[ 2 * k      * nc + l];
156:             cf[(k + half) * nc + l] = cfWork[(2 * k + 1) * nc + l];
157:           }
158:           if (datatype == PETSC_SCALAR) {
159:             PetscScalar *out = &((PetscScalar *)D)[nc * dim * i];

161:             for (l = 0; l < nc; l++) {
162:               out[l * dim + j] += d * e * cf[k * nc + l];
163:             }
164:           } else {
165:             PetscReal *out = &((PetscReal *)D)[nc * dim * i];

167:             for (l = 0; l < nc; l++) {
168:               out[l * dim + j] += d * e * PetscRealPart(cf[k * nc + l]);
169:             }
170:           }
171:         }
172:       }
173:     }
174:     if (H) {
175:       if (datatype == PETSC_SCALAR) {
176:         PetscScalar *out = &((PetscScalar *)H)[nc * dim * dim * i];

178:         MEHess(out,cf,etaB,etaD,dim,nc,(PetscScalar));
179:       } else {
180:         PetscReal *out = &((PetscReal *)H)[nc * dim * dim * i];

182:         MEHess(out,cf,etaB,etaD,dim,nc,PetscRealPart);
183:       }
184:     }
185:   }
186:   PetscFunctionReturnVoid();
187: }

189: static PetscErrorCode DMFieldEvaluate_DA(DMField field, Vec points, PetscDataType datatype, void *B, void *D, void *H)
190: {
191:   DM             dm;
192:   DMField_DA     *dafield;
193:   PetscInt       dim;
194:   PetscInt       N, n, nc;
195:   const PetscScalar *array;
196:   PetscReal (*coordRange)[2];

200:   dm      = field->dm;
201:   nc      = field->numComponents;
202:   dafield = (DMField_DA *) field->data;
203:   DMGetDimension(dm,&dim);
204:   VecGetLocalSize(points,&N);
205:   if (N % dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point vector size %D not divisible by coordinate dimension %D\n",N,dim);
206:   n = N / dim;
207:   coordRange = &(dafield->coordRange[0]);
208:   VecGetArrayRead(points,&array);
209:   MultilinearEvaluate(dim,coordRange,nc,dafield->cornerCoeffs,dafield->work,n,array,datatype,B,D,H);
210:   VecRestoreArrayRead(points,&array);
211:   return(0);
212: }

214: static PetscErrorCode DMFieldEvaluateFE_DA(DMField field, IS cellIS, PetscQuadrature points, PetscDataType datatype, void *B, void *D, void *H)
215: {
216:   PetscInt       c, i, j, k, dim, cellsPer[3] = {0}, first[3] = {0}, whol, half;
217:   PetscReal      stepPer[3] = {0.};
218:   PetscReal      cellCoordRange[3][2] = {{0.,1.},{0.,1.},{0.,1.}};
219:   PetscScalar    *cellCoeffs, *work;
220:   DM             dm;
221:   DMDALocalInfo  info;
222:   PetscInt       cStart, cEnd;
223:   PetscInt       nq, nc;
224:   const PetscReal *q;
225: #if defined(PETSC_USE_COMPLEX)
226:   PetscScalar    *qs;
227: #else
228:   const PetscScalar *qs;
229: #endif
230:   DMField_DA     *dafield;
231:   PetscBool      isStride;
232:   const PetscInt *cells = NULL;
233:   PetscInt       sfirst = -1, stride = -1, nCells;

237:   dafield = (DMField_DA *) field->data;
238:   dm = field->dm;
239:   nc = field->numComponents;
240:   DMDAGetLocalInfo(dm,&info);
241:   dim = info.dim;
242:   work = dafield->work;
243:   stepPer[0] = 1./ info.mx;
244:   stepPer[1] = 1./ info.my;
245:   stepPer[2] = 1./ info.mz;
246:   first[0] = info.gxs;
247:   first[1] = info.gys;
248:   first[2] = info.gzs;
249:   cellsPer[0] = info.gxm;
250:   cellsPer[1] = info.gym;
251:   cellsPer[2] = info.gzm;
252:   /* TODO: probably take components into account */
253:   PetscQuadratureGetData(points, NULL, NULL, &nq, &q, NULL);
254: #if defined(PETSC_USE_COMPLEX)
255:   DMGetWorkArray(dm,nq * dim,MPIU_SCALAR,&qs);
256:   for (i = 0; i < nq * dim; i++) qs[i] = q[i];
257: #else
258:   qs = q;
259: #endif
260:   DMDAGetHeightStratum(dm,0,&cStart,&cEnd);
261:   DMGetWorkArray(dm,(1 << dim) * nc,MPIU_SCALAR,&cellCoeffs);
262:   whol = (1 << dim);
263:   half = whol >> 1;
264:   ISGetLocalSize(cellIS,&nCells);
265:   PetscObjectTypeCompare((PetscObject)cellIS,ISSTRIDE,&isStride);
266:   if (isStride) {
267:     ISStrideGetInfo(cellIS,&sfirst,&stride);
268:   } else {
269:     ISGetIndices(cellIS,&cells);
270:   }
271:   for (c = 0; c < nCells; c++) {
272:     PetscInt  cell = isStride ? (sfirst + c * stride) : cells[c];
273:     PetscInt  rem  = cell;
274:     PetscInt  ijk[3] = {0};
275:     void *cB, *cD, *cH;

277:     if (datatype == PETSC_SCALAR) {
278:       cB = B ? &((PetscScalar *)B)[nc * nq * c] : NULL;
279:       cD = D ? &((PetscScalar *)D)[nc * nq * dim * c] : NULL;
280:       cH = H ? &((PetscScalar *)H)[nc * nq * dim * dim * c] : NULL;
281:     } else {
282:       cB = B ? &((PetscReal *)B)[nc * nq * c] : NULL;
283:       cD = D ? &((PetscReal *)D)[nc * nq * dim * c] : NULL;
284:       cH = H ? &((PetscReal *)H)[nc * nq * dim * dim * c] : NULL;
285:     }
286:     if (cell < cStart || cell >= cEnd) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Point %D not a cell [%D,%D), not implemented yet",cell,cStart,cEnd);
287:     for (i = 0; i < nc * whol; i++) {work[i] = dafield->cornerCoeffs[i];}
288:     for (j = 0; j < dim; j++) {
289:       PetscReal e, d;
290:       ijk[j] = (rem % cellsPer[j]);
291:       rem /= cellsPer[j];

293:       e = 2. * (ijk[j] + first[j] + 0.5) * stepPer[j] - 1.;
294:       d = stepPer[j];
295:       for (i = 0; i < half; i++) {
296:         for (k = 0; k < nc; k++) {
297:           cellCoeffs[ i         * nc + k] = work[ 2 * i * nc + k] * d;
298:           cellCoeffs[(i + half) * nc + k] = work[ 2 * i * nc + k] * e + work[(2 * i + 1) * nc + k];
299:         }
300:       }
301:       for (i = 0; i < whol * nc; i++) {work[i] = cellCoeffs[i];}
302:     }
303:     MultilinearEvaluate(dim,cellCoordRange,nc,cellCoeffs,dafield->work,nq,qs,datatype,cB,cD,cH);
304:   }
305:   if (!isStride) {
306:     ISRestoreIndices(cellIS,&cells);
307:   }
308:   DMRestoreWorkArray(dm,(1 << dim) * nc,MPIU_SCALAR,&cellCoeffs);
309: #if defined(PETSC_USE_COMPLEX)
310:   DMRestoreWorkArray(dm,nq * dim,MPIU_SCALAR,&qs);
311: #endif
312:   return(0);
313: }

315: static PetscErrorCode DMFieldEvaluateFV_DA(DMField field, IS cellIS, PetscDataType datatype, void *B, void *D, void *H)
316: {
317:   PetscInt       c, i, dim, cellsPer[3] = {0}, first[3] = {0};
318:   PetscReal      stepPer[3] = {0.};
319:   DM             dm;
320:   DMDALocalInfo  info;
321:   PetscInt       cStart, cEnd, numCells;
322:   PetscInt       nc;
323:   PetscScalar    *points;
324:   DMField_DA     *dafield;
325:   PetscBool      isStride;
326:   const PetscInt *cells = NULL;
327:   PetscInt       sfirst = -1, stride = -1;

331:   dafield = (DMField_DA *) field->data;
332:   dm = field->dm;
333:   nc = field->numComponents;
334:   DMDAGetLocalInfo(dm,&info);
335:   dim = info.dim;
336:   stepPer[0] = 1./ info.mx;
337:   stepPer[1] = 1./ info.my;
338:   stepPer[2] = 1./ info.mz;
339:   first[0] = info.gxs;
340:   first[1] = info.gys;
341:   first[2] = info.gzs;
342:   cellsPer[0] = info.gxm;
343:   cellsPer[1] = info.gym;
344:   cellsPer[2] = info.gzm;
345:   DMDAGetHeightStratum(dm,0,&cStart,&cEnd);
346:   ISGetLocalSize(cellIS,&numCells);
347:   DMGetWorkArray(dm,dim * numCells,MPIU_SCALAR,&points);
348:   PetscObjectTypeCompare((PetscObject)cellIS,ISSTRIDE,&isStride);
349:   if (isStride) {
350:     ISStrideGetInfo(cellIS,&sfirst,&stride);
351:   } else {
352:     ISGetIndices(cellIS,&cells);
353:   }
354:   for (c = 0; c < numCells; c++) {
355:     PetscInt  cell = isStride ? (sfirst + c * stride) : cells[c];
356:     PetscInt  rem  = cell;
357:     PetscInt  ijk[3] = {0};

359:     if (cell < cStart || cell >= cEnd) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Point %D not a cell [%D,%D), not implemented yet",cell,cStart,cEnd);
360:     for (i = 0; i < dim; i++) {
361:       ijk[i] = (rem % cellsPer[i]);
362:       rem /= cellsPer[i];
363:       points[dim * c + i] = (ijk[i] + first[i] + 0.5) * stepPer[i];
364:     }
365:   }
366:   if (!isStride) {
367:     ISRestoreIndices(cellIS,&cells);
368:   }
369:   MultilinearEvaluate(dim,dafield->coordRange,nc,dafield->cornerCoeffs,dafield->work,numCells,points,datatype,B,D,H);
370:   DMRestoreWorkArray(dm,dim * numCells,MPIU_SCALAR,&points);
371:   return(0);
372: }

374: static PetscErrorCode DMFieldGetDegree_DA(DMField field, IS pointIS, PetscInt *minDegree, PetscInt *maxDegree)
375: {
376:   DM             dm;
377:   PetscInt       dim, h, imin;

381:   dm = field->dm;
382:   ISGetMinMax(pointIS,&imin,NULL);
383:   DMGetDimension(dm,&dim);
384:   for (h = 0; h <= dim; h++) {
385:     PetscInt hEnd;

387:     DMDAGetHeightStratum(dm,h,NULL,&hEnd);
388:     if (imin < hEnd) break;
389:   }
390:   dim -= h;
391:   if (minDegree) *minDegree = 1;
392:   if (maxDegree) *maxDegree = dim;
393:   return(0);
394: }

396: static PetscErrorCode DMFieldCreateDefaultQuadrature_DA(DMField field, IS cellIS, PetscQuadrature *quad)
397: {
398:   PetscInt       h, dim, imax, imin;
399:   DM             dm;

403:   dm = field->dm;
404:   ISGetMinMax(cellIS,&imin,&imax);
405:   DMGetDimension(dm,&dim);
406:   *quad = NULL;
407:   for (h = 0; h <= dim; h++) {
408:     PetscInt hStart, hEnd;

410:     DMDAGetHeightStratum(dm,h,&hStart,&hEnd);
411:     if (imin >= hStart && imax < hEnd) break;
412:   }
413:   dim -= h;
414:   if (dim > 0) {
415:     PetscDTGaussTensorQuadrature(dim, 1, 1, -1.0, 1.0, quad);
416:   }

418:   return(0);
419: }

421: static PetscErrorCode DMFieldInitialize_DA(DMField field)
422: {
423:   DM             dm;
424:   Vec            coords = NULL;
425:   PetscInt       dim, i, j, k;
426:   DMField_DA     *dafield = (DMField_DA *) field->data;

430:   field->ops->destroy                 = DMFieldDestroy_DA;
431:   field->ops->evaluate                = DMFieldEvaluate_DA;
432:   field->ops->evaluateFE              = DMFieldEvaluateFE_DA;
433:   field->ops->evaluateFV              = DMFieldEvaluateFV_DA;
434:   field->ops->getDegree               = DMFieldGetDegree_DA;
435:   field->ops->createDefaultQuadrature = DMFieldCreateDefaultQuadrature_DA;
436:   field->ops->view                    = DMFieldView_DA;
437:   dm = field->dm;
438:   DMGetDimension(dm,&dim);
439:   if (dm->coordinates) coords = dm->coordinates;
440:   else if (dm->coordinatesLocal) coords = dm->coordinatesLocal;
441:   if (coords) {
442:     PetscInt          n;
443:     const PetscScalar *array;
444:     PetscReal         mins[3][2] = {{PETSC_MAX_REAL,PETSC_MAX_REAL},{PETSC_MAX_REAL,PETSC_MAX_REAL},{PETSC_MAX_REAL,PETSC_MAX_REAL}};

446:     VecGetLocalSize(coords,&n);
447:     n /= dim;
448:     VecGetArrayRead(coords,&array);
449:     for (i = 0, k = 0; i < n; i++) {
450:       for (j = 0; j < dim; j++, k++) {
451:         PetscReal val = PetscRealPart(array[k]);

453:         mins[j][0] = PetscMin(mins[j][0],val);
454:         mins[j][1] = PetscMin(mins[j][1],-val);
455:       }
456:     }
457:     VecRestoreArrayRead(coords,&array);
458:     MPIU_Allreduce((PetscReal *) mins,&(dafield->coordRange[0][0]),2*dim,MPIU_REAL,MPI_MIN,PetscObjectComm((PetscObject)dm));
459:     for (j = 0; j < dim; j++) {
460:       dafield->coordRange[j][1] = -dafield->coordRange[j][1];
461:     }
462:   } else {
463:     for (j = 0; j < dim; j++) {
464:       dafield->coordRange[j][0] = 0.;
465:       dafield->coordRange[j][1] = 1.;
466:     }
467:   }
468:   for (j = 0; j < dim; j++) {
469:     PetscReal avg = 0.5 * (dafield->coordRange[j][1] + dafield->coordRange[j][0]);
470:     PetscReal dif = 0.5 * (dafield->coordRange[j][1] - dafield->coordRange[j][0]);

472:     dafield->coordRange[j][0] = avg;
473:     dafield->coordRange[j][1] = dif;
474:   }
475:   return(0);
476: }

478: PETSC_INTERN PetscErrorCode DMFieldCreate_DA(DMField field)
479: {
480:   DMField_DA     *dafield;

484:   PetscNewLog(field,&dafield);
485:   field->data = dafield;
486:   DMFieldInitialize_DA(field);
487:   return(0);
488: }

490: PetscErrorCode DMFieldCreateDA(DM dm, PetscInt nc, const PetscScalar *cornerValues,DMField *field)
491: {
492:   DMField        b;
493:   DMField_DA     *dafield;
494:   PetscInt       dim, nv, i, j, k;
495:   PetscInt       half;
496:   PetscScalar    *cv, *cf, *work;

500:   DMFieldCreate(dm,nc,DMFIELD_VERTEX,&b);
501:   DMFieldSetType(b,DMFIELDDA);
502:   dafield = (DMField_DA *) b->data;
503:   DMGetDimension(dm,&dim);
504:   nv = (1 << dim) * nc;
505:   PetscMalloc3(nv,&cv,nv,&cf,nv,&work);
506:   for (i = 0; i < nv; i++) cv[i] = cornerValues[i];
507:   for (i = 0; i < nv; i++) cf[i] = cv[i];
508:   dafield->cornerVals = cv;
509:   dafield->cornerCoeffs = cf;
510:   dafield->work = work;
511:   half = (1 << (dim - 1));
512:   for (i = 0; i < dim; i++) {
513:     PetscScalar *w;

515:     w = work;
516:     for (j = 0; j < half; j++) {
517:       for (k = 0; k < nc; k++) {
518:         w[j * nc + k] = 0.5 * (cf[(2 * j + 1) * nc + k] - cf[(2 * j) * nc + k]);
519:       }
520:     }
521:     w = &work[j * nc];
522:     for (j = 0; j < half; j++) {
523:       for (k = 0; k < nc; k++) {
524:         w[j * nc + k] = 0.5 * (cf[(2 * j) * nc + k] + cf[(2 * j + 1) * nc + k]);
525:       }
526:     }
527:     for (j = 0; j < nv; j++) {cf[j] = work[j];}
528:   }
529:   *field = b;
530:   return(0);
531: }