Date: 2022-03-04T17:38:28+00:00

Actual source code: plexmetric.c

      1: #include <petsc/private/dmpleximpl.h>
      2: #include <petscblaslapack.h>

      4: PetscErrorCode DMPlexP1FieldCreate_Private(DM dm, PetscInt f, PetscInt size, Vec *metric)
      5: {
      6:   MPI_Comm       comm;
      8:   PetscFE        fe;
      9:   PetscInt       dim;

     13:   /* Extract metadata from dm */
     14:   PetscObjectGetComm((PetscObject) dm, &comm);
     15:   DMGetDimension(dm, &dim);

     17:   /* Create a P1 field of the requested size */
     18:   PetscFECreateLagrange(comm, dim, size, PETSC_TRUE, 1, PETSC_DETERMINE, &fe);
     19:   DMSetField(dm, f, NULL, (PetscObject)fe);
     20:   DMCreateDS(dm);
     21:   PetscFEDestroy(&fe);
     22:   DMCreateLocalVector(dm, metric);

     24:   return(0);
     25: }

     27: /*
     28:   DMPlexMetricCreate - Create a Riemannian metric field

     30:   Input parameters:
     31: + dm     - The DM
     32: - f      - The field number to use

     34:   Output parameter:
     35: . metric - The metric

     37:   Level: beginner

     39:   Note: It is assumed that the DM is comprised of simplices.

     41: .seealso: DMPlexMetricCreateUniform(), DMPlexMetricCreateIsotropic()
     42: */
     43: PetscErrorCode DMPlexMetricCreate(DM dm, PetscInt f, Vec *metric)
     44: {
     46:   PetscInt       coordDim, Nd;

     49:   DMGetCoordinateDim(dm, &coordDim);
     50:   Nd = coordDim*coordDim;
     51:   DMPlexP1FieldCreate_Private(dm, f, Nd, metric);
     52:   return(0);
     53: }

     55: typedef struct {
     56:   PetscReal scaling;  /* Scaling for uniform metric diagonal */
     57: } DMPlexMetricUniformCtx;

     59: static PetscErrorCode diagonal(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
     60: {
     61:   DMPlexMetricUniformCtx *user = (DMPlexMetricUniformCtx*)ctx;
     62:   PetscInt                i, j;

     64:   for (i = 0; i < dim; ++i) {
     65:     for (j = 0; j < dim; ++j) {
     66:       if (i == j) u[i+dim*j] = user->scaling;
     67:       else u[i+dim*j] = 0.0;
     68:     }
     69:   }
     70:   return 0;
     71: }

     73: /*
     74:   DMPlexMetricCreateUniform - Construct a uniform isotropic metric

     76:   Input parameters:
     77: + dm     - The DM
     78: . f      - The field number to use
     79: - alpha  - Scaling parameter for the diagonal

     81:   Output parameter:
     82: . metric - The uniform metric

     84:   Level: beginner

     86:   Note: It is assumed that the DM is comprised of simplices.

     88: .seealso: DMPlexMetricCreate(), DMPlexMetricCreateIsotropic()
     89: */
     90: PetscErrorCode DMPlexMetricCreateUniform(DM dm, PetscInt f, PetscReal alpha, Vec *metric)
     91: {
     92:   DMPlexMetricUniformCtx user;
     93:   PetscErrorCode       (*funcs[1])(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *);
     94:   PetscErrorCode         ierr;
     95:   void                  *ctxs[1];

     98:   DMPlexMetricCreate(dm, f, metric);
     99:   if (!alpha) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Uniform metric scaling is undefined");
    100:   if (alpha < 1.0e-30) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Uniform metric scaling %e should be positive", alpha);
    101:   else user.scaling = alpha;
    102:   funcs[0] = diagonal;
    103:   ctxs[0] = &user;
    104:   DMProjectFunctionLocal(dm, 0.0, funcs, ctxs, INSERT_ALL_VALUES, *metric);
    105:   return(0);
    106: }

    108: /*
    109:   DMPlexMetricCreateIsotropic - Construct an isotropic metric from an error indicator

    111:   Input parameters:
    112: + dm        - The DM
    113: . f         - The field number to use
    114: - indicator - The error indicator

    116:   Output parameter:
    117: . metric    - The isotropic metric

    119:   Level: beginner

    121:   Notes:

    123:   It is assumed that the DM is comprised of simplices.

    125:   The indicator needs to be a scalar field defined at *vertices*.

    127: .seealso: DMPlexMetricCreate(), DMPlexMetricCreateUniform()
    128: */
    129: PetscErrorCode DMPlexMetricCreateIsotropic(DM dm, PetscInt f, Vec indicator, Vec *metric)
    130: {
    131:   DM                 dmIndi;
    132:   PetscErrorCode     ierr;
    133:   PetscInt           dim, d, vStart, vEnd, v;
    134:   const PetscScalar *indi;
    135:   PetscScalar       *met;

    138:   DMGetDimension(dm, &dim);
    139:   DMPlexMetricCreate(dm, f, metric);
    140:   DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);
    141:   VecGetArrayRead(indicator, &indi);
    142:   VecGetArrayWrite(*metric, &met);
    143:   VecGetDM(indicator, &dmIndi);
    144:   for (v = vStart; v < vEnd; ++v) {
    145:     PetscScalar *vindi, *vmet;
    146:     DMPlexPointLocalRead(dmIndi, v, indi, &vindi);
    147:     DMPlexPointLocalRef(dm, v, met, &vmet);
    148:     for (d = 0; d < dim; ++d) vmet[d*(dim+1)] = vindi[0];
    149:   }
    150:   VecRestoreArrayWrite(*metric, &met);
    151:   VecRestoreArrayRead(indicator, &indi);
    152:   return(0);
    153: }

    155: static PetscErrorCode DMPlexMetricModify_Private(PetscInt dim, PetscReal h_min, PetscReal h_max, PetscReal a_max, PetscScalar Mp[])
    156: {
    158:   PetscInt       i, j, k;
    159:   PetscReal     *eigs, max_eig, l_min = 1.0/(h_max*h_max), l_max = 1.0/(h_min*h_min), la_min = 1.0/(a_max*a_max);
    160:   PetscScalar   *Mpos;

    163:   PetscMalloc2(dim*dim, &Mpos, dim, &eigs);

    165:   /* Symmetrize */
    166:   for (i = 0; i < dim; ++i) {
    167:     Mpos[i*dim+i] = Mp[i*dim+i];
    168:     for (j = i+1; j < dim; ++j) {
    169:       Mpos[i*dim+j] = 0.5*(Mp[i*dim+j] + Mp[j*dim+i]);
    170:       Mpos[j*dim+i] = Mpos[i*dim+j];
    171:     }
    172:   }

    174:   /* Compute eigendecomposition */
    175:   {
    176:     PetscScalar  *work;
    177:     PetscBLASInt lwork;

    179:     lwork = 5*dim;
    180:     PetscMalloc1(5*dim, &work);
    181:     {
    182:       PetscBLASInt lierr;
    183:       PetscBLASInt nb;

    185:       PetscBLASIntCast(dim, &nb);
    186:       PetscFPTrapPush(PETSC_FP_TRAP_OFF);
    187: #if defined(PETSC_USE_COMPLEX)
    188:       {
    189:         PetscReal *rwork;
    190:         PetscMalloc1(3*dim, &rwork);
    191:         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&nb,Mpos,&nb,eigs,work,&lwork,rwork,&lierr));
    192:         PetscFree(rwork);
    193:       }
    194: #else
    195:       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&nb,Mpos,&nb,eigs,work,&lwork,&lierr));
    196: #endif
    197:       if (lierr) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in LAPACK routine %d", (int) lierr);
    198:       PetscFPTrapPop();
    199:     }
    200:     PetscFree(work);
    201:   }

    203:   /* Reflect to positive orthant and enforce maximum and minimum size */
    204:   max_eig = 0.0;
    205:   for (i = 0; i < dim; ++i) {
    206:     eigs[i] = PetscMin(l_max, PetscMax(l_min, PetscAbsReal(eigs[i])));
    207:     max_eig = PetscMax(eigs[i], max_eig);
    208:   }

    210:   /* Enforce maximum anisotropy */
    211:   for (i = 0; i < dim; ++i) {
    212:     if (a_max > 1.0) eigs[i] = PetscMax(eigs[i], max_eig*la_min);
    213:   }

    215:   /* Reconstruct Hessian */
    216:   for (i = 0; i < dim; ++i) {
    217:     for (j = 0; j < dim; ++j) {
    218:       Mp[i*dim+j] = 0.0;
    219:       for (k = 0; k < dim; ++k) {
    220:         Mp[i*dim+j] += Mpos[k*dim+i] * eigs[k] * Mpos[k*dim+j];
    221:       }
    222:     }
    223:   }
    224:   PetscFree2(Mpos, eigs);

    226:   return(0);
    227: }

    229: /*
    230:   DMPlexMetricEnforceSPD - Enforce symmetric positive-definiteness of a metric

    232:   Input parameters:
    233: + dm            - The DM
    234: . restrictSizes - Should maximum/minimum metric magnitudes and anisotropy be enforced?
    235: - metric        - The metric

    237:   Output parameter:
    238: . metric        - The metric

    240:   Level: beginner

    242: .seealso: DMPlexMetricNormalize(), DMPlexMetricIntersection()
    243: */
    244: PetscErrorCode DMPlexMetricEnforceSPD(DM dm, PetscBool restrictSizes, Vec metric)
    245: {
    246:   DMPlexMetricCtx *user;
    247:   PetscErrorCode   ierr;
    248:   PetscInt         dim, vStart, vEnd, v;
    249:   PetscScalar     *met;
    250:   PetscReal        h_min = 1.0e-30, h_max = 1.0e+30, a_max = 0.0;

    254:   /* Extract metadata from dm */
    255:   DMGetDimension(dm, &dim);
    256:   DMGetApplicationContext(dm, (void**)&user);
    257:   if (restrictSizes) {
    258:     if (user->h_max > h_min) h_max = PetscMin(h_max, user->h_max);
    259:     if (user->h_min > 0.0) h_min = PetscMax(h_min, user->h_min);
    260:     if (user->a_max > 1.0) a_max = user->a_max;
    261:   }

    263:   /* Enforce SPD */
    264:   DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);
    265:   VecGetArray(metric, &met);
    266:   for (v = vStart; v < vEnd; ++v) {
    267:     PetscScalar *vmet;
    268:     DMPlexPointLocalRef(dm, v, met, &vmet);
    269:     DMPlexMetricModify_Private(dim, h_min, h_max, a_max, vmet);
    270:   }
    271:   VecRestoreArray(metric, &met);

    273:   return(0);
    274: }

    276: static void detMFunc(PetscInt dim, PetscInt Nf, PetscInt NfAux,
    277:                      const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
    278:                      const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
    279:                      PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
    280: {
    281:   const PetscScalar p = constants[0];
    282:   PetscReal         detH = 0.0;

    284:   if      (dim == 2) DMPlex_Det2D_Scalar_Internal(&detH, u);
    285:   else if (dim == 3) DMPlex_Det3D_Scalar_Internal(&detH, u);
    286:   f0[0] = PetscPowReal(detH, p/(2.0*p + dim));
    287: }

    289: /*
    290:   DMPlexMetricNormalize - Apply L-p normalization to a metric

    292:   Input parameters:
    293: + dm            - The DM
    294: . metricIn      - The unnormalized metric
    295: - restrictSizes - Should maximum/minimum metric magnitudes and anisotropy be enforced?

    297:   Output parameter:
    298: . metricOut     - The normalized metric

    300:   Level: beginner

    302: .seealso: DMPlexMetricEnforceSPD(), DMPlexMetricIntersection()
    303: */
    304: PetscErrorCode DMPlexMetricNormalize(DM dm, Vec metricIn, PetscBool restrictSizes, Vec *metricOut)
    305: {
    306:   DMPlexMetricCtx *user;
    307:   MPI_Comm         comm;
    308:   PetscDS          ds;
    309:   PetscErrorCode   ierr;
    310:   PetscInt         dim, Nd, vStart, vEnd, v, i;
    311:   PetscScalar     *met, integral, constants[1];
    312:   PetscReal        p, h_min = 1.0e-30, h_max = 1.0e+30, a_max = 0.0, factGlob, target;

    316:   /* Extract metadata from dm */
    317:   PetscObjectGetComm((PetscObject) dm, &comm);
    318:   DMGetDimension(dm, &dim);
    319:   Nd = dim*dim;
    320:   DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);
    321:   DMGetApplicationContext(dm, (void**)&user);
    322:   if (restrictSizes && user->restrictAnisotropyFirst && user->a_max > 1.0) a_max = user->a_max;
    323:   if (PetscAbsReal(user->p) >= 1.0) p = user->p;
    324:   else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Metric normalization order %f should be greater than one.", user->p);
    325:   constants[0] = p;
    326:   if (user->targetComplexity > 0.0) target = user->targetComplexity;
    327:   else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Target metric complexity %f should be positive.", user->targetComplexity);

    329:   /* Set up metric and ensure it is SPD */
    330:   DMPlexMetricCreate(dm, 0, metricOut);
    331:   VecCopy(metricIn, *metricOut);
    332:   DMPlexMetricEnforceSPD(dm, PETSC_FALSE, *metricOut);

    334:   /* Compute global normalization factor */
    335:   DMGetDS(dm, &ds);
    336:   PetscDSSetConstants(ds, 1, constants);
    337:   PetscDSSetObjective(ds, 0, detMFunc);
    338:   DMPlexComputeIntegralFEM(dm, *metricOut, &integral, NULL);
    339:   factGlob = PetscPowReal(target/PetscRealPart(integral), 2.0/dim);

    341:   /* Apply local scaling */
    342:   a_max = 0.0;
    343:   if (restrictSizes) {
    344:     if (user->h_max > h_min) h_max = PetscMin(h_max, user->h_max);
    345:     if (user->h_min > 0.0) h_min = PetscMax(h_min, user->h_min);
    346:     if (!user->restrictAnisotropyFirst && user->a_max > 1.0) a_max = user->a_max;
    347:   }
    348:   VecGetArray(*metricOut, &met);
    349:   for (v = vStart; v < vEnd; ++v) {
    350:     PetscScalar       *Mp;
    351:     PetscReal          detM, fact;

    353:     DMPlexPointLocalRef(dm, v, met, &Mp);
    354:     if      (dim == 2) DMPlex_Det2D_Scalar_Internal(&detM, Mp);
    355:     else if (dim == 3) DMPlex_Det3D_Scalar_Internal(&detM, Mp);
    356:     else SETERRQ1(comm, PETSC_ERR_SUP, "Dimension %d not supported", dim);
    357:     fact = factGlob * PetscPowReal(PetscAbsReal(detM), -1.0/(2*p+dim));
    358:     for (i = 0; i < Nd; ++i) Mp[i] *= fact;
    359:     if (restrictSizes) { DMPlexMetricModify_Private(dim, h_min, h_max, a_max, Mp); }
    360:   }
    361:   VecRestoreArray(*metricOut, &met);

    363:   return(0);
    364: }

    366: /*
    367:   DMPlexMetricAverage - Compute the average of a list of metrics

    369:   Input Parameter:
    370: + dm         - The DM
    371: . numMetrics - The number of metrics to be averaged
    372: . weights    - Weights for the average
    373: - metrics    - The metrics to be averaged

    375:   Output Parameter:
    376: . metricAvg  - The averaged metric

    378:   Level: beginner

    380:   Notes:
    381:   The weights should sum to unity.

    383:   If weights are not provided then an unweighted average is used.

    385: .seealso: DMPlexMetricAverage2(), DMPlexMetricAverage3(), DMPlexMetricIntersection()
    386: */
    387: PetscErrorCode DMPlexMetricAverage(DM dm, PetscInt numMetrics, PetscReal weights[], Vec metrics[], Vec *metricAvg)
    388: {
    389:   PetscBool      haveWeights = PETSC_TRUE;
    391:   PetscInt       i;
    392:   PetscReal      sum = 0.0, tol = 1.0e-10;

    395:   if (numMetrics < 1) { SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot average %d < 1 metrics", numMetrics); }
    396:   DMPlexMetricCreate(dm, 0, metricAvg);
    397:   VecSet(*metricAvg, 0.0);

    399:   /* Default to the unweighted case */
    400:   if (!weights) {
    401:     PetscMalloc1(numMetrics, &weights);
    402:     haveWeights = PETSC_FALSE;
    403:     for (i = 0; i < numMetrics; ++i) {weights[i] = 1.0/numMetrics; }
    404:   }

    406:   /* Check weights sum to unity */
    407:   for (i = 0; i < numMetrics; ++i) { sum += weights[i]; }
    408:   if (PetscAbsReal(sum - 1) > tol) { SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Weights do not sum to unity"); }

    410:   /* Compute metric average */
    411:   for (i = 0; i < numMetrics; ++i) { VecAXPY(*metricAvg, weights[i], metrics[i]); }
    412:   if (!haveWeights) {PetscFree(weights); }
    413:   return(0);
    414: }

    416: /*
    417:   DMPlexMetricAverage2 - Compute the unweighted average of two metrics

    419:   Input Parameter:
    420: + dm         - The DM
    421: . metric1    - The first metric to be averaged
    422: - metric2    - The second metric to be averaged

    424:   Output Parameter:
    425: . metricAvg  - The averaged metric

    427:   Level: beginner

    429: .seealso: DMPlexMetricAverage(), DMPlexMetricAverage3()
    430: */
    431: PetscErrorCode DMPlexMetricAverage2(DM dm, Vec metric1, Vec metric2, Vec *metricAvg)
    432: {
    434:   PetscReal      weights[2] = {0.5, 0.5};
    435:   Vec            metrics[2] = {metric1, metric2};

    438:   DMPlexMetricAverage(dm, 2, weights, metrics, metricAvg);
    439:   return(0);
    440: }

    442: /*
    443:   DMPlexMetricAverage3 - Compute the unweighted average of three metrics

    445:   Input Parameter:
    446: + dm         - The DM
    447: . metric1    - The first metric to be averaged
    448: . metric2    - The second metric to be averaged
    449: - metric3    - The third metric to be averaged

    451:   Output Parameter:
    452: . metricAvg  - The averaged metric

    454:   Level: beginner

    456: .seealso: DMPlexMetricAverage(), DMPlexMetricAverage2()
    457: */
    458: PetscErrorCode DMPlexMetricAverage3(DM dm, Vec metric1, Vec metric2, Vec metric3, Vec *metricAvg)
    459: {
    461:   PetscReal      weights[3] = {1.0/3.0, 1.0/3.0, 1.0/3.0};
    462:   Vec            metrics[3] = {metric1, metric2, metric3};

    465:   DMPlexMetricAverage(dm, 3, weights, metrics, metricAvg);
    466:   return(0);
    467: }

    469: static PetscErrorCode DMPlexMetricIntersection_Private(PetscInt dim, PetscScalar M1[], PetscScalar M2[])
    470: {
    472:   PetscInt       i, j, k, l, m;
    473:   PetscReal     *evals, *evals1;
    474:   PetscScalar   *evecs, *sqrtM1, *isqrtM1;

    477:   PetscMalloc5(dim*dim, &evecs, dim*dim, &sqrtM1, dim*dim, &isqrtM1, dim, &evals, dim, &evals1);
    478:   for (i = 0; i < dim; ++i) {
    479:     for (j = 0; j < dim; ++j) {
    480:       evecs[i*dim+j] = M1[i*dim+j];
    481:     }
    482:   }
    483:   {
    484:     PetscScalar *work;
    485:     PetscBLASInt lwork;

    487:     lwork = 5*dim;
    488:     PetscMalloc1(5*dim, &work);
    489:     {
    490:       PetscBLASInt lierr, nb;
    491:       PetscReal    sqrtk;

    493:       /* Compute eigendecomposition of M1 */
    494:       PetscBLASIntCast(dim, &nb);
    495:       PetscFPTrapPush(PETSC_FP_TRAP_OFF);
    496: #if defined(PETSC_USE_COMPLEX)
    497:       {
    498:         PetscReal *rwork;
    499:         PetscMalloc1(3*dim, &rwork);
    500:         PetscStackCallBLAS("LAPACKsyev", LAPACKsyev_("V", "U", &nb, evecs, &nb, evals1, work, &lwork, rwork, &lierr));
    501:         PetscFree(rwork);
    502:       }
    503: #else
    504:       PetscStackCallBLAS("LAPACKsyev", LAPACKsyev_("V", "U", &nb, evecs, &nb, evals1, work, &lwork, &lierr));
    505: #endif
    506:       if (lierr) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in LAPACK routine %d", (int) lierr);
    507:       PetscFPTrapPop();

    509:       /* Compute square root and reciprocal */
    510:       for (i = 0; i < dim; ++i) {
    511:         for (j = 0; j < dim; ++j) {
    512:           sqrtM1[i*dim+j] = 0.0;
    513:           isqrtM1[i*dim+j] = 0.0;
    514:           for (k = 0; k < dim; ++k) {
    515:             sqrtk = PetscSqrtReal(evals1[k]);
    516:             sqrtM1[i*dim+j] += evecs[k*dim+i] * sqrtk * evecs[k*dim+j];
    517:             isqrtM1[i*dim+j] += evecs[k*dim+i] * (1.0/sqrtk) * evecs[k*dim+j];
    518:           }
    519:         }
    520:       }

    522:       /* Map into the space spanned by the eigenvectors of M1 */
    523:       for (i = 0; i < dim; ++i) {
    524:         for (j = 0; j < dim; ++j) {
    525:           evecs[i*dim+j] = 0.0;
    526:           for (k = 0; k < dim; ++k) {
    527:             for (l = 0; l < dim; ++l) {
    528:               evecs[i*dim+j] += isqrtM1[i*dim+k] * M2[l*dim+k] * isqrtM1[j*dim+l];
    529:             }
    530:           }
    531:         }
    532:       }

    534:       /* Compute eigendecomposition */
    535:       PetscFPTrapPush(PETSC_FP_TRAP_OFF);
    536: #if defined(PETSC_USE_COMPLEX)
    537:       {
    538:         PetscReal *rwork;
    539:         PetscMalloc1(3*dim, &rwork);
    540:         PetscStackCallBLAS("LAPACKsyev", LAPACKsyev_("V", "U", &nb, evecs, &nb, evals, work, &lwork, rwork, &lierr));
    541:         PetscFree(rwork);
    542:       }
    543: #else
    544:       PetscStackCallBLAS("LAPACKsyev", LAPACKsyev_("V", "U", &nb, evecs, &nb, evals, work, &lwork, &lierr));
    545: #endif
    546:       if (lierr) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in LAPACK routine %d", (int) lierr);
    547:       PetscFPTrapPop();

    549:       /* Modify eigenvalues */
    550:       for (i = 0; i < dim; ++i) evals[i] = PetscMin(evals[i], evals1[i]);

    552:       /* Map back to get the intersection */
    553:       for (i = 0; i < dim; ++i) {
    554:         for (j = 0; j < dim; ++j) {
    555:           M2[i*dim+j] = 0.0;
    556:           for (k = 0; k < dim; ++k) {
    557:             for (l = 0; l < dim; ++l) {
    558:               for (m = 0; m < dim; ++m) {
    559:                 M2[i*dim+j] += sqrtM1[i*dim+k] * evecs[l*dim+k] * evals[l] * evecs[l*dim+m] * sqrtM1[j*dim+m];
    560:               }
    561:             }
    562:           }
    563:         }
    564:       }
    565:     }
    566:     PetscFree(work);
    567:   }
    568:   PetscFree5(evecs, sqrtM1, isqrtM1, evals, evals1);
    569:   return(0);
    570: }

    572: /*
    573:   DMPlexMetricIntersection - Compute the intersection of a list of metrics

    575:   Input Parameter:
    576: + dm         - The DM
    577: . numMetrics - The number of metrics to be intersected
    578: - metrics    - The metrics to be intersected

    580:   Output Parameter:
    581: . metricInt  - The intersected metric

    583:   Level: beginner

    585:   Notes:

    587:   The intersection of a list of metrics has the maximal ellipsoid which fits within the ellipsoids of the component metrics.

    589:   The implementation used here is only consistent with the maximal ellipsoid definition in the case numMetrics = 2.

    591: .seealso: DMPlexMetricIntersection2(), DMPlexMetricIntersection3(), DMPlexMetricAverage()
    592: */
    593: PetscErrorCode DMPlexMetricIntersection(DM dm, PetscInt numMetrics, Vec metrics[], Vec *metricInt)
    594: {
    596:   PetscInt       dim, vStart, vEnd, v, i;
    597:   PetscScalar   *met, *meti, *M, *Mi;

    600:   if (numMetrics < 1) { SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot intersect %d < 1 metrics", numMetrics); }

    602:   /* Extract metadata from dm */
    603:   DMGetDimension(dm, &dim);
    604:   DMPlexMetricCreate(dm, 0, metricInt);
    605:   DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);

    607:   /* Copy over the first metric */
    608:   VecCopy(metrics[0], *metricInt);

    610:   /* Intersect subsequent metrics in turn */
    611:   if (numMetrics > 1) {
    612:     VecGetArray(*metricInt, &met);
    613:     for (i = 1; i < numMetrics; ++i) {
    614:       VecGetArray(metrics[i], &meti);
    615:       for (v = vStart; v < vEnd; ++v) {
    616:         DMPlexPointLocalRef(dm, v, met, &M);
    617:         DMPlexPointLocalRef(dm, v, meti, &Mi);
    618:         DMPlexMetricIntersection_Private(dim, Mi, M);
    619:       }
    620:       VecRestoreArray(metrics[i], &meti);
    621:     }
    622:     VecRestoreArray(*metricInt, &met);
    623:   }

    625:   return(0);
    626: }

    628: /*
    629:   DMPlexMetricIntersection2 - Compute the intersection of two metrics

    631:   Input Parameter:
    632: + dm        - The DM
    633: . metric1   - The first metric to be intersected
    634: - metric2   - The second metric to be intersected

    636:   Output Parameter:
    637: . metricInt - The intersected metric

    639:   Level: beginner

    641: .seealso: DMPlexMetricIntersection(), DMPlexMetricIntersection3()
    642: */
    643: PetscErrorCode DMPlexMetricIntersection2(DM dm, Vec metric1, Vec metric2, Vec *metricInt)
    644: {
    646:   Vec            metrics[2] = {metric1, metric2};

    649:   DMPlexMetricIntersection(dm, 2, metrics, metricInt);
    650:   return(0);
    651: }

    653: /*
    654:   DMPlexMetricIntersection3 - Compute the intersection of three metrics

    656:   Input Parameter:
    657: + dm        - The DM
    658: . metric1   - The first metric to be intersected
    659: . metric2   - The second metric to be intersected
    660: - metric3   - The third metric to be intersected

    662:   Output Parameter:
    663: . metricInt - The intersected metric

    665:   Level: beginner

    667: .seealso: DMPlexMetricIntersection(), DMPlexMetricIntersection2()
    668: */
    669: PetscErrorCode DMPlexMetricIntersection3(DM dm, Vec metric1, Vec metric2, Vec metric3, Vec *metricInt)
    670: {
    672:   Vec            metrics[3] = {metric1, metric2, metric3};

    675:   DMPlexMetricIntersection(dm, 3, metrics, metricInt);
    676:   return(0);
    677: }