Actual source code: dtaltv.c

  1: #include <petsc/private/petscimpl.h>
  2: #include <petsc/private/dtimpl.h>

  4: /*MC
  5:    PetscDTAltV - An interface for common operations on k-forms, also known as alternating algebraic forms or alternating k-linear maps.
  6:    The name of the interface comes from the notation "Alt V" for the algebra of all k-forms acting vectors in the space V, also known as the exterior algebra of V*.

  8:    A recommended reference for this material is Section 2 "Exterior algebra and exterior calculus" in "Finite element
  9:    exterior calculus, homological techniques, and applications", by Arnold, Falk, & Winther (2006, doi:10.1017/S0962492906210018).

 11:    A k-form w (k is called the "form degree" of w) is an alternating k-linear map acting on tuples (v_1, ..., v_k) of
 12:    vectors from a vector space V and producing a real number:
 13:    - alternating: swapping any two vectors in a tuple reverses the sign of the result, e.g. w(v_1, v_2, ..., v_k) = -w(v_2, v_1, ..., v_k)
 14:    - k-linear: w acts linear in each vector separately, e.g. w(a*v + b*y, v_2, ..., v_k) = a*w(v,v_2,...,v_k) + b*w(y,v_2,...,v_k)
 15:    This action is implemented as `PetscDTAltVApply()`.

 17:    The k-forms on a vector space form a vector space themselves, Alt^k V.  The dimension of Alt^k V, if V is N dimensional, is N choose k.  (This
 18:    shows that for an N dimensional space, only 0 <= k <= N are valid form degrees.)
 19:    The standard basis for Alt^k V, used in PetscDTAltV, has one basis k-form for each ordered subset of k coordinates of the N dimensional space:
 20:    For example, if the coordinate directions of a four dimensional space are (t, x, y, z), then there are 4 choose 2 = 6 ordered subsets of two coordinates.
 21:    They are, in lexicographic order, (t, x), (t, y), (t, z), (x, y), (x, z) and (y, z).  PetscDTAltV also orders the basis of Alt^k V lexicographically
 22:    by the associated subsets.

 24:    The unit basis k-form associated with coordinates (c_1, ..., c_k) acts on a set of k vectors (v_1, ..., v_k) by creating a square matrix V where
 25:    V[i,j] = v_i[c_j] and taking the determinant of V.

 27:    If j + k <= N, then a j-form f and a k-form g can be multiplied to create a (j+k)-form using the wedge or exterior product, (f wedge g).
 28:    This is an anticommutative product, (f wedge g) = -(g wedge f).  It is sufficient to describe the wedge product of two basis forms.
 29:    Let f be the basis j-form associated with coordinates (f_1,...,f_j) and g be the basis k-form associated with coordinates (g_1,...,g_k):
 30:    - If there is any coordinate in both sets, then (f wedge g) = 0.
 31:    - Otherwise, (f wedge g) is a multiple of the basis (j+k)-form h associated with (f_1,...,f_j,g_1,...,g_k).
 32:    - In fact it is equal to either h or -h depending on how (f_1,...,f_j,g_1,...,g_k) compares to the same list of coordinates given in ascending order: if it is an even permutation of that list, then (f wedge g) = h, otherwise (f wedge g) = -h.
 33:    The wedge product is implemented for either two inputs (f and g) in `PetscDTAltVWedge()`, or for one (just f, giving a
 34:    matrix to multiply against multiple choices of g) in `PetscDTAltVWedgeMatrix()`.

 36:    If k > 0, a k-form w and a vector v can combine to make a (k-1)-formm through the interior product, (w int v),
 37:    defined by (w int v)(v_1,...,v_{k-1}) = w(v,v_1,...,v_{k-1}).

 39:    The interior product is implemented for either two inputs (w and v) in PetscDTAltVInterior, for one (just v, giving a
 40:    matrix to multiply against multiple choices of w) in `PetscDTAltVInteriorMatrix()`,
 41:    or for no inputs (giving the sparsity pattern of `PetscDTAltVInteriorMatrix()`) in `PetscDTAltVInteriorPattern()`.

 43:    When there is a linear map L: V -> W from an N dimensional vector space to an M dimensional vector space,
 44:    it induces the linear pullback map L^* : Alt^k W -> Alt^k V, defined by L^* w(v_1,...,v_k) = w(L v_1, ..., L v_k).
 45:    The pullback is implemented as `PetscDTAltVPullback()` (acting on a known w) and `PetscDTAltVPullbackMatrix()` (creating a matrix that computes the actin of L^*).

 47:    Alt^k V and Alt^(N-k) V have the same dimension, and the Hodge star operator maps between them.  We note that Alt^N V is a one dimensional space, and its
 48:    basis vector is sometime called vol.  The Hodge star operator has the property that (f wedge (star g)) = (f,g) vol, where (f,g) is the simple inner product
 49:    of the basis coefficients of f and g.
 50:    Powers of the Hodge star operator can be applied with PetscDTAltVStar

 52:    Level: intermediate

 54: .seealso: `PetscDTAltVApply()`, `PetscDTAltVWedge()`, `PetscDTAltVInterior()`, `PetscDTAltVPullback()`, `PetscDTAltVStar()`
 55: M*/

 57: /*@
 58:   PetscDTAltVApply - Apply an a k-form (an alternating k-linear map) to a set of k N-dimensional vectors

 60:   Input Parameters:
 61: + N - the dimension of the vector space, N >= 0
 62: . k - the degree k of the k-form w, 0 <= k <= N
 63: . w - a k-form, size [N choose k] (each degree of freedom of a k-form is associated with a subset of k coordinates of the N-dimensional vectors.
 64:        The degrees of freedom are ordered lexicographically by their associated subsets)
 65: - v - a set of k vectors of size N, size [k x N], each vector stored contiguously

 67:   Output Parameter:
 68: . wv - w(v_1,...,v_k) = \sum_i w_i * det(V_i): the degree of freedom w_i is associated with coordinates [s_{i,1},...,s_{i,k}], and the square matrix V_i has
 69:    entry (j,k) given by the s_{i,k}'th coordinate of v_j

 71:   Level: intermediate

 73: .seealso: `PetscDTAltV`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
 74: @*/
 75: PetscErrorCode PetscDTAltVApply(PetscInt N, PetscInt k, const PetscReal *w, const PetscReal *v, PetscReal *wv)
 76: {
 77:   PetscFunctionBegin;
 78:   PetscCheck(N >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimension");
 79:   PetscCheck(k >= 0 && k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
 80:   if (N <= 3) {
 81:     if (!k) {
 82:       *wv = w[0];
 83:     } else {
 84:       if (N == 1) {
 85:         *wv = w[0] * v[0];
 86:       } else if (N == 2) {
 87:         if (k == 1) {
 88:           *wv = w[0] * v[0] + w[1] * v[1];
 89:         } else {
 90:           *wv = w[0] * (v[0] * v[3] - v[1] * v[2]);
 91:         }
 92:       } else {
 93:         if (k == 1) {
 94:           *wv = w[0] * v[0] + w[1] * v[1] + w[2] * v[2];
 95:         } else if (k == 2) {
 96:           *wv = w[0] * (v[0] * v[4] - v[1] * v[3]) + w[1] * (v[0] * v[5] - v[2] * v[3]) + w[2] * (v[1] * v[5] - v[2] * v[4]);
 97:         } else {
 98:           *wv = w[0] * (v[0] * (v[4] * v[8] - v[5] * v[7]) + v[1] * (v[5] * v[6] - v[3] * v[8]) + v[2] * (v[3] * v[7] - v[4] * v[6]));
 99:         }
100:       }
101:     }
102:   } else {
103:     PetscInt  Nk, Nf;
104:     PetscInt *subset, *perm;
105:     PetscInt  i, j, l;
106:     PetscReal sum = 0.;

108:     PetscCall(PetscDTFactorialInt(k, &Nf));
109:     PetscCall(PetscDTBinomialInt(N, k, &Nk));
110:     PetscCall(PetscMalloc2(k, &subset, k, &perm));
111:     for (i = 0; i < Nk; i++) {
112:       PetscReal subsum = 0.;

114:       PetscCall(PetscDTEnumSubset(N, k, i, subset));
115:       for (j = 0; j < Nf; j++) {
116:         PetscBool permOdd;
117:         PetscReal prod;

119:         PetscCall(PetscDTEnumPerm(k, j, perm, &permOdd));
120:         prod = permOdd ? -1. : 1.;
121:         for (l = 0; l < k; l++) prod *= v[perm[l] * N + subset[l]];
122:         subsum += prod;
123:       }
124:       sum += w[i] * subsum;
125:     }
126:     PetscCall(PetscFree2(subset, perm));
127:     *wv = sum;
128:   }
129:   PetscFunctionReturn(PETSC_SUCCESS);
130: }

132: /*@
133:   PetscDTAltVWedge - Compute the wedge product of a j-form and a k-form, giving a (j+k) form

135:   Input Parameters:
136: + N - the dimension of the vector space, N >= 0
137: . j - the degree j of the j-form a, 0 <= j <= N
138: . k - the degree k of the k-form b, 0 <= k <= N and 0 <= j+k <= N
139: . a - a j-form, size [N choose j]
140: - b - a k-form, size [N choose k]

142:   Output Parameter:
143: . awedgeb - the (j+k)-form a wedge b, size [N choose (j+k)]: (a wedge b)(v_1,...,v_{j+k}) = \sum_{s} sign(s) a(v_{s_1},...,v_{s_j}) b(v_{s_{j+1}},...,v_{s_{j+k}}),
144:              where the sum is over permutations s such that s_1 < s_2 < ... < s_j and s_{j+1} < s_{j+2} < ... < s_{j+k}.

146:   Level: intermediate

148: .seealso: `PetscDTAltV`, `PetscDTAltVWedgeMatrix()`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
149: @*/
150: PetscErrorCode PetscDTAltVWedge(PetscInt N, PetscInt j, PetscInt k, const PetscReal *a, const PetscReal *b, PetscReal *awedgeb)
151: {
152:   PetscInt i;

154:   PetscFunctionBegin;
155:   PetscCheck(N >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimension");
156:   PetscCheck(j >= 0 && k >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "negative form degree");
157:   PetscCheck(j + k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Wedge greater than dimension");
158:   if (N <= 3) {
159:     PetscInt Njk;

161:     PetscCall(PetscDTBinomialInt(N, j + k, &Njk));
162:     if (!j) {
163:       for (i = 0; i < Njk; i++) awedgeb[i] = a[0] * b[i];
164:     } else if (!k) {
165:       for (i = 0; i < Njk; i++) awedgeb[i] = a[i] * b[0];
166:     } else {
167:       if (N == 2) {
168:         awedgeb[0] = a[0] * b[1] - a[1] * b[0];
169:       } else {
170:         if (j + k == 2) {
171:           awedgeb[0] = a[0] * b[1] - a[1] * b[0];
172:           awedgeb[1] = a[0] * b[2] - a[2] * b[0];
173:           awedgeb[2] = a[1] * b[2] - a[2] * b[1];
174:         } else {
175:           awedgeb[0] = a[0] * b[2] - a[1] * b[1] + a[2] * b[0];
176:         }
177:       }
178:     }
179:   } else {
180:     PetscInt  Njk;
181:     PetscInt  JKj;
182:     PetscInt *subset, *subsetjk, *subsetj, *subsetk;
183:     PetscInt  i;

185:     PetscCall(PetscDTBinomialInt(N, j + k, &Njk));
186:     PetscCall(PetscDTBinomialInt(j + k, j, &JKj));
187:     PetscCall(PetscMalloc4(j + k, &subset, j + k, &subsetjk, j, &subsetj, k, &subsetk));
188:     for (i = 0; i < Njk; i++) {
189:       PetscReal sum = 0.;
190:       PetscInt  l;

192:       PetscCall(PetscDTEnumSubset(N, j + k, i, subset));
193:       for (l = 0; l < JKj; l++) {
194:         PetscBool jkOdd;
195:         PetscInt  m, jInd, kInd;

197:         PetscCall(PetscDTEnumSplit(j + k, j, l, subsetjk, &jkOdd));
198:         for (m = 0; m < j; m++) subsetj[m] = subset[subsetjk[m]];
199:         for (m = 0; m < k; m++) subsetk[m] = subset[subsetjk[j + m]];
200:         PetscCall(PetscDTSubsetIndex(N, j, subsetj, &jInd));
201:         PetscCall(PetscDTSubsetIndex(N, k, subsetk, &kInd));
202:         sum += jkOdd ? -(a[jInd] * b[kInd]) : (a[jInd] * b[kInd]);
203:       }
204:       awedgeb[i] = sum;
205:     }
206:     PetscCall(PetscFree4(subset, subsetjk, subsetj, subsetk));
207:   }
208:   PetscFunctionReturn(PETSC_SUCCESS);
209: }

211: /*@
212:   PetscDTAltVWedgeMatrix - Compute the matrix defined by the wedge product with a given j-form that maps k-forms to (j+k)-forms

214:   Input Parameters:
215: + N - the dimension of the vector space, N >= 0
216: . j - the degree j of the j-form a, 0 <= j <= N
217: . k - the degree k of the k-forms that (a wedge) will be applied to, 0 <= k <= N and 0 <= j+k <= N
218: - a - a j-form, size [N choose j]

220:   Output Parameter:
221: . awedgeMat - (a wedge), an [(N choose j+k) x (N choose k)] matrix in row-major order, such that (a wedge) * b = a wedge b

223:   Level: intermediate

225: .seealso: `PetscDTAltV`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
226: @*/
227: PetscErrorCode PetscDTAltVWedgeMatrix(PetscInt N, PetscInt j, PetscInt k, const PetscReal *a, PetscReal *awedgeMat)
228: {
229:   PetscInt i;

231:   PetscFunctionBegin;
232:   PetscCheck(N >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimension");
233:   PetscCheck(j >= 0 && k >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "negative form degree");
234:   PetscCheck(j + k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Wedge greater than dimension");
235:   if (N <= 3) {
236:     PetscInt Njk;

238:     PetscCall(PetscDTBinomialInt(N, j + k, &Njk));
239:     if (!j) {
240:       for (i = 0; i < Njk * Njk; i++) awedgeMat[i] = 0.;
241:       for (i = 0; i < Njk; i++) awedgeMat[i * (Njk + 1)] = a[0];
242:     } else if (!k) {
243:       for (i = 0; i < Njk; i++) awedgeMat[i] = a[i];
244:     } else {
245:       if (N == 2) {
246:         awedgeMat[0] = -a[1];
247:         awedgeMat[1] = a[0];
248:       } else {
249:         if (j + k == 2) {
250:           awedgeMat[0] = -a[1];
251:           awedgeMat[1] = a[0];
252:           awedgeMat[2] = 0.;
253:           awedgeMat[3] = -a[2];
254:           awedgeMat[4] = 0.;
255:           awedgeMat[5] = a[0];
256:           awedgeMat[6] = 0.;
257:           awedgeMat[7] = -a[2];
258:           awedgeMat[8] = a[1];
259:         } else {
260:           awedgeMat[0] = a[2];
261:           awedgeMat[1] = -a[1];
262:           awedgeMat[2] = a[0];
263:         }
264:       }
265:     }
266:   } else {
267:     PetscInt  Njk;
268:     PetscInt  Nk;
269:     PetscInt  JKj, i;
270:     PetscInt *subset, *subsetjk, *subsetj, *subsetk;

272:     PetscCall(PetscDTBinomialInt(N, k, &Nk));
273:     PetscCall(PetscDTBinomialInt(N, j + k, &Njk));
274:     PetscCall(PetscDTBinomialInt(j + k, j, &JKj));
275:     PetscCall(PetscMalloc4(j + k, &subset, j + k, &subsetjk, j, &subsetj, k, &subsetk));
276:     for (i = 0; i < Njk * Nk; i++) awedgeMat[i] = 0.;
277:     for (i = 0; i < Njk; i++) {
278:       PetscInt l;

280:       PetscCall(PetscDTEnumSubset(N, j + k, i, subset));
281:       for (l = 0; l < JKj; l++) {
282:         PetscBool jkOdd;
283:         PetscInt  m, jInd, kInd;

285:         PetscCall(PetscDTEnumSplit(j + k, j, l, subsetjk, &jkOdd));
286:         for (m = 0; m < j; m++) subsetj[m] = subset[subsetjk[m]];
287:         for (m = 0; m < k; m++) subsetk[m] = subset[subsetjk[j + m]];
288:         PetscCall(PetscDTSubsetIndex(N, j, subsetj, &jInd));
289:         PetscCall(PetscDTSubsetIndex(N, k, subsetk, &kInd));
290:         awedgeMat[i * Nk + kInd] += jkOdd ? -a[jInd] : a[jInd];
291:       }
292:     }
293:     PetscCall(PetscFree4(subset, subsetjk, subsetj, subsetk));
294:   }
295:   PetscFunctionReturn(PETSC_SUCCESS);
296: }

298: /*@
299:   PetscDTAltVPullback - Compute the pullback of a k-form under a linear transformation of the coordinate space

301:   Input Parameters:
302: + N - the dimension of the origin vector space of the linear transformation, M >= 0
303: . M - the dimension of the image vector space of the linear transformation, N >= 0
304: . L - a linear transformation, an [M x N] matrix in row-major format
305: . k - the *signed* degree k of the |k|-form w, -(min(M,N)) <= k <= min(M,N).  A negative form degree indicates that the pullback should be conjugated by
306:        the Hodge star operator (see note).
307: - w - a |k|-form in the image space, size [M choose |k|]

309:   Output Parameter:
310: . Lstarw - the pullback of w to a |k|-form in the origin space, size [N choose |k|]: (Lstarw)(v_1,...v_k) = w(L*v_1,...,L*v_k).

312:   Level: intermediate

314:   Note:
315:   Negative form degrees accommodate, e.g., H-div conforming vector fields.  An H-div conforming
316:   vector field stores its degrees of freedom as (dx, dy, dz), like a 1-form, but its normal
317:   trace is integrated on faces, like a 2-form.  The correct pullback then is to apply the Hodge
318:   star transformation from (M-2)-form to 2-form, pullback as a 2-form, then invert the Hodge
319:   star transformation.

321: .seealso: `PetscDTAltV`, `PetscDTAltVPullbackMatrix()`, `PetscDTAltVStar()`
322: @*/
323: PetscErrorCode PetscDTAltVPullback(PetscInt N, PetscInt M, const PetscReal *L, PetscInt k, const PetscReal *w, PetscReal *Lstarw)
324: {
325:   PetscInt i, j, Nk, Mk;

327:   PetscFunctionBegin;
328:   PetscCheck(N >= 0 && M >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimensions");
329:   PetscCheck(PetscAbsInt(k) <= N && PetscAbsInt(k) <= M, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
330:   if (N <= 3 && M <= 3) {
331:     PetscCall(PetscDTBinomialInt(M, PetscAbsInt(k), &Mk));
332:     PetscCall(PetscDTBinomialInt(N, PetscAbsInt(k), &Nk));
333:     if (!k) {
334:       Lstarw[0] = w[0];
335:     } else if (k == 1) {
336:       for (i = 0; i < Nk; i++) {
337:         PetscReal sum = 0.;

339:         for (j = 0; j < Mk; j++) sum += L[j * Nk + i] * w[j];
340:         Lstarw[i] = sum;
341:       }
342:     } else if (k == -1) {
343:       PetscReal mult[3] = {1., -1., 1.};

345:       for (i = 0; i < Nk; i++) {
346:         PetscReal sum = 0.;

348:         for (j = 0; j < Mk; j++) sum += L[(Mk - 1 - j) * Nk + (Nk - 1 - i)] * w[j] * mult[j];
349:         Lstarw[i] = mult[i] * sum;
350:       }
351:     } else if (k == 2) {
352:       PetscInt pairs[3][2] = {
353:         {0, 1},
354:         {0, 2},
355:         {1, 2}
356:       };

358:       for (i = 0; i < Nk; i++) {
359:         PetscReal sum = 0.;
360:         for (j = 0; j < Mk; j++) sum += (L[pairs[j][0] * N + pairs[i][0]] * L[pairs[j][1] * N + pairs[i][1]] - L[pairs[j][1] * N + pairs[i][0]] * L[pairs[j][0] * N + pairs[i][1]]) * w[j];
361:         Lstarw[i] = sum;
362:       }
363:     } else if (k == -2) {
364:       PetscInt pairs[3][2] = {
365:         {1, 2},
366:         {2, 0},
367:         {0, 1}
368:       };
369:       PetscInt offi = (N == 2) ? 2 : 0;
370:       PetscInt offj = (M == 2) ? 2 : 0;

372:       for (i = 0; i < Nk; i++) {
373:         PetscReal sum = 0.;

375:         for (j = 0; j < Mk; j++) sum += (L[pairs[offj + j][0] * N + pairs[offi + i][0]] * L[pairs[offj + j][1] * N + pairs[offi + i][1]] - L[pairs[offj + j][1] * N + pairs[offi + i][0]] * L[pairs[offj + j][0] * N + pairs[offi + i][1]]) * w[j];
376:         Lstarw[i] = sum;
377:       }
378:     } else {
379:       PetscReal detL = L[0] * (L[4] * L[8] - L[5] * L[7]) + L[1] * (L[5] * L[6] - L[3] * L[8]) + L[2] * (L[3] * L[7] - L[4] * L[6]);

381:       for (i = 0; i < Nk; i++) Lstarw[i] = detL * w[i];
382:     }
383:   } else {
384:     PetscInt         Nf, l, p;
385:     PetscReal       *Lw, *Lwv;
386:     PetscInt        *subsetw, *subsetv;
387:     PetscInt        *perm;
388:     PetscReal       *walloc   = NULL;
389:     const PetscReal *ww       = NULL;
390:     PetscBool        negative = PETSC_FALSE;

392:     PetscCall(PetscDTBinomialInt(M, PetscAbsInt(k), &Mk));
393:     PetscCall(PetscDTBinomialInt(N, PetscAbsInt(k), &Nk));
394:     PetscCall(PetscDTFactorialInt(PetscAbsInt(k), &Nf));
395:     if (k < 0) {
396:       negative = PETSC_TRUE;
397:       k        = -k;
398:       PetscCall(PetscMalloc1(Mk, &walloc));
399:       PetscCall(PetscDTAltVStar(M, M - k, 1, w, walloc));
400:       ww = walloc;
401:     } else {
402:       ww = w;
403:     }
404:     PetscCall(PetscMalloc5(k, &subsetw, k, &subsetv, k, &perm, N * k, &Lw, k * k, &Lwv));
405:     for (i = 0; i < Nk; i++) Lstarw[i] = 0.;
406:     for (i = 0; i < Mk; i++) {
407:       PetscCall(PetscDTEnumSubset(M, k, i, subsetw));
408:       for (j = 0; j < Nk; j++) {
409:         PetscCall(PetscDTEnumSubset(N, k, j, subsetv));
410:         for (p = 0; p < Nf; p++) {
411:           PetscReal prod;
412:           PetscBool isOdd;

414:           PetscCall(PetscDTEnumPerm(k, p, perm, &isOdd));
415:           prod = isOdd ? -ww[i] : ww[i];
416:           for (l = 0; l < k; l++) prod *= L[subsetw[perm[l]] * N + subsetv[l]];
417:           Lstarw[j] += prod;
418:         }
419:       }
420:     }
421:     if (negative) {
422:       PetscReal *sLsw;

424:       PetscCall(PetscMalloc1(Nk, &sLsw));
425:       PetscCall(PetscDTAltVStar(N, N - k, -1, Lstarw, sLsw));
426:       for (i = 0; i < Nk; i++) Lstarw[i] = sLsw[i];
427:       PetscCall(PetscFree(sLsw));
428:     }
429:     PetscCall(PetscFree5(subsetw, subsetv, perm, Lw, Lwv));
430:     PetscCall(PetscFree(walloc));
431:   }
432:   PetscFunctionReturn(PETSC_SUCCESS);
433: }

435: /*@
436:   PetscDTAltVPullbackMatrix - Compute the pullback matrix for k-forms under a linear transformation

438:   Input Parameters:
439: + N - the dimension of the origin vector space of the linear transformation, N >= 0
440: . M - the dimension of the image vector space of the linear transformation, M >= 0
441: . L - a linear transformation, an [M x N] matrix in row-major format
442: - k - the *signed* degree k of the |k|-forms on which Lstar acts, -(min(M,N)) <= k <= min(M,N).
443:        A negative form degree indicates that the pullback should be conjugated by the Hodge star operator (see note in `PetscDTAltvPullback()`)

445:   Output Parameter:
446: . Lstar - the pullback matrix, an [(N choose |k|) x (M choose |k|)] matrix in row-major format such that Lstar * w = L^* w

448:   Level: intermediate

450: .seealso: `PetscDTAltV`, `PetscDTAltVPullback()`, `PetscDTAltVStar()`
451: @*/
452: PetscErrorCode PetscDTAltVPullbackMatrix(PetscInt N, PetscInt M, const PetscReal *L, PetscInt k, PetscReal *Lstar)
453: {
454:   PetscInt   Nk, Mk, Nf, i, j, l, p;
455:   PetscReal *Lw, *Lwv;
456:   PetscInt  *subsetw, *subsetv;
457:   PetscInt  *perm;
458:   PetscBool  negative = PETSC_FALSE;

460:   PetscFunctionBegin;
461:   PetscCheck(N >= 0 && M >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimensions");
462:   PetscCheck(PetscAbsInt(k) <= N && PetscAbsInt(k) <= M, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
463:   if (N <= 3 && M <= 3) {
464:     PetscReal mult[3] = {1., -1., 1.};

466:     PetscCall(PetscDTBinomialInt(M, PetscAbsInt(k), &Mk));
467:     PetscCall(PetscDTBinomialInt(N, PetscAbsInt(k), &Nk));
468:     if (!k) {
469:       Lstar[0] = 1.;
470:     } else if (k == 1) {
471:       for (i = 0; i < Nk; i++) {
472:         for (j = 0; j < Mk; j++) Lstar[i * Mk + j] = L[j * Nk + i];
473:       }
474:     } else if (k == -1) {
475:       for (i = 0; i < Nk; i++) {
476:         for (j = 0; j < Mk; j++) Lstar[i * Mk + j] = L[(Mk - 1 - j) * Nk + (Nk - 1 - i)] * mult[i] * mult[j];
477:       }
478:     } else if (k == 2) {
479:       PetscInt pairs[3][2] = {
480:         {0, 1},
481:         {0, 2},
482:         {1, 2}
483:       };

485:       for (i = 0; i < Nk; i++) {
486:         for (j = 0; j < Mk; j++) Lstar[i * Mk + j] = L[pairs[j][0] * N + pairs[i][0]] * L[pairs[j][1] * N + pairs[i][1]] - L[pairs[j][1] * N + pairs[i][0]] * L[pairs[j][0] * N + pairs[i][1]];
487:       }
488:     } else if (k == -2) {
489:       PetscInt pairs[3][2] = {
490:         {1, 2},
491:         {2, 0},
492:         {0, 1}
493:       };
494:       PetscInt offi = (N == 2) ? 2 : 0;
495:       PetscInt offj = (M == 2) ? 2 : 0;

497:       for (i = 0; i < Nk; i++) {
498:         for (j = 0; j < Mk; j++) {
499:           Lstar[i * Mk + j] = L[pairs[offj + j][0] * N + pairs[offi + i][0]] * L[pairs[offj + j][1] * N + pairs[offi + i][1]] - L[pairs[offj + j][1] * N + pairs[offi + i][0]] * L[pairs[offj + j][0] * N + pairs[offi + i][1]];
500:         }
501:       }
502:     } else {
503:       PetscReal detL = L[0] * (L[4] * L[8] - L[5] * L[7]) + L[1] * (L[5] * L[6] - L[3] * L[8]) + L[2] * (L[3] * L[7] - L[4] * L[6]);

505:       for (i = 0; i < Nk; i++) Lstar[i] = detL;
506:     }
507:   } else {
508:     if (k < 0) {
509:       negative = PETSC_TRUE;
510:       k        = -k;
511:     }
512:     PetscCall(PetscDTBinomialInt(M, PetscAbsInt(k), &Mk));
513:     PetscCall(PetscDTBinomialInt(N, PetscAbsInt(k), &Nk));
514:     PetscCall(PetscDTFactorialInt(PetscAbsInt(k), &Nf));
515:     PetscCall(PetscMalloc5(M, &subsetw, N, &subsetv, k, &perm, N * k, &Lw, k * k, &Lwv));
516:     for (i = 0; i < Nk * Mk; i++) Lstar[i] = 0.;
517:     for (i = 0; i < Mk; i++) {
518:       PetscBool iOdd;
519:       PetscInt  iidx, jidx;

521:       PetscCall(PetscDTEnumSplit(M, k, i, subsetw, &iOdd));
522:       iidx = negative ? Mk - 1 - i : i;
523:       iOdd = negative ? (PetscBool)(iOdd ^ ((k * (M - k)) & 1)) : PETSC_FALSE;
524:       for (j = 0; j < Nk; j++) {
525:         PetscBool jOdd;

527:         PetscCall(PetscDTEnumSplit(N, k, j, subsetv, &jOdd));
528:         jidx = negative ? Nk - 1 - j : j;
529:         jOdd = negative ? (PetscBool)(iOdd ^ jOdd ^ ((k * (N - k)) & 1)) : PETSC_FALSE;
530:         for (p = 0; p < Nf; p++) {
531:           PetscReal prod;
532:           PetscBool isOdd;

534:           PetscCall(PetscDTEnumPerm(k, p, perm, &isOdd));
535:           isOdd = (PetscBool)(isOdd ^ jOdd);
536:           prod  = isOdd ? -1. : 1.;
537:           for (l = 0; l < k; l++) prod *= L[subsetw[perm[l]] * N + subsetv[l]];
538:           Lstar[jidx * Mk + iidx] += prod;
539:         }
540:       }
541:     }
542:     PetscCall(PetscFree5(subsetw, subsetv, perm, Lw, Lwv));
543:   }
544:   PetscFunctionReturn(PETSC_SUCCESS);
545: }

547: /*@
548:   PetscDTAltVInterior - Compute the interior product of a k-form with a vector

550:   Input Parameters:
551: + N - the dimension of the vector space, N >= 0
552: . k - the degree k of the k-form w, 0 <= k <= N
553: . w - a k-form, size [N choose k]
554: - v - an N dimensional vector

556:   Output Parameter:
557: . wIntv - the (k-1)-form (w int v), size [N choose (k-1)]: (w int v) is defined by its action on (k-1) vectors {v_1, ..., v_{k-1}} as (w inv v)(v_1, ..., v_{k-1}) = w(v, v_1, ..., v_{k-1}).

559:   Level: intermediate

561: .seealso: `PetscDTAltV`, `PetscDTAltVInteriorMatrix()`, `PetscDTAltVInteriorPattern()`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
562: @*/
563: PetscErrorCode PetscDTAltVInterior(PetscInt N, PetscInt k, const PetscReal *w, const PetscReal *v, PetscReal *wIntv)
564: {
565:   PetscInt i, Nk, Nkm;

567:   PetscFunctionBegin;
568:   PetscCheck(k > 0 && k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
569:   PetscCall(PetscDTBinomialInt(N, k, &Nk));
570:   PetscCall(PetscDTBinomialInt(N, k - 1, &Nkm));
571:   if (N <= 3) {
572:     if (k == 1) {
573:       PetscReal sum = 0.;

575:       for (i = 0; i < N; i++) sum += w[i] * v[i];
576:       wIntv[0] = sum;
577:     } else if (k == N) {
578:       PetscReal mult[3] = {1., -1., 1.};

580:       for (i = 0; i < N; i++) wIntv[N - 1 - i] = w[0] * v[i] * mult[i];
581:     } else {
582:       wIntv[0] = -w[0] * v[1] - w[1] * v[2];
583:       wIntv[1] = w[0] * v[0] - w[2] * v[2];
584:       wIntv[2] = w[1] * v[0] + w[2] * v[1];
585:     }
586:   } else {
587:     PetscInt *subset, *work;

589:     PetscCall(PetscMalloc2(k, &subset, k, &work));
590:     for (i = 0; i < Nkm; i++) wIntv[i] = 0.;
591:     for (i = 0; i < Nk; i++) {
592:       PetscInt j, l, m;

594:       PetscCall(PetscDTEnumSubset(N, k, i, subset));
595:       for (j = 0; j < k; j++) {
596:         PetscInt  idx;
597:         PetscBool flip = (PetscBool)(j & 1);

599:         for (l = 0, m = 0; l < k; l++) {
600:           if (l != j) work[m++] = subset[l];
601:         }
602:         PetscCall(PetscDTSubsetIndex(N, k - 1, work, &idx));
603:         wIntv[idx] += flip ? -(w[i] * v[subset[j]]) : (w[i] * v[subset[j]]);
604:       }
605:     }
606:     PetscCall(PetscFree2(subset, work));
607:   }
608:   PetscFunctionReturn(PETSC_SUCCESS);
609: }

611: /*@
612:   PetscDTAltVInteriorMatrix - Compute the matrix of the linear transformation induced on a k-form by the interior product with a vector

614:   Input Parameters:
615: + N - the dimension of the vector space, N >= 0
616: . k - the degree k of the k-forms on which intvMat acts, 0 <= k <= N
617: - v - an N dimensional vector

619:   Output Parameter:
620: . intvMat - an [(N choose (k-1)) x (N choose k)] matrix, row-major: (intvMat) * w = (w int v)

622:   Level: intermediate

624: .seealso: `PetscDTAltV`, `PetscDTAltVInterior()`, `PetscDTAltVInteriorPattern()`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
625: @*/
626: PetscErrorCode PetscDTAltVInteriorMatrix(PetscInt N, PetscInt k, const PetscReal *v, PetscReal *intvMat)
627: {
628:   PetscInt i, Nk, Nkm;

630:   PetscFunctionBegin;
631:   PetscCheck(k > 0 && k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
632:   PetscCall(PetscDTBinomialInt(N, k, &Nk));
633:   PetscCall(PetscDTBinomialInt(N, k - 1, &Nkm));
634:   if (N <= 3) {
635:     if (k == 1) {
636:       for (i = 0; i < N; i++) intvMat[i] = v[i];
637:     } else if (k == N) {
638:       PetscReal mult[3] = {1., -1., 1.};

640:       for (i = 0; i < N; i++) intvMat[N - 1 - i] = v[i] * mult[i];
641:     } else {
642:       intvMat[0] = -v[1];
643:       intvMat[1] = -v[2];
644:       intvMat[2] = 0.;
645:       intvMat[3] = v[0];
646:       intvMat[4] = 0.;
647:       intvMat[5] = -v[2];
648:       intvMat[6] = 0.;
649:       intvMat[7] = v[0];
650:       intvMat[8] = v[1];
651:     }
652:   } else {
653:     PetscInt *subset, *work;

655:     PetscCall(PetscMalloc2(k, &subset, k, &work));
656:     for (i = 0; i < Nk * Nkm; i++) intvMat[i] = 0.;
657:     for (i = 0; i < Nk; i++) {
658:       PetscInt j, l, m;

660:       PetscCall(PetscDTEnumSubset(N, k, i, subset));
661:       for (j = 0; j < k; j++) {
662:         PetscInt  idx;
663:         PetscBool flip = (PetscBool)(j & 1);

665:         for (l = 0, m = 0; l < k; l++) {
666:           if (l != j) work[m++] = subset[l];
667:         }
668:         PetscCall(PetscDTSubsetIndex(N, k - 1, work, &idx));
669:         intvMat[idx * Nk + i] += flip ? -v[subset[j]] : v[subset[j]];
670:       }
671:     }
672:     PetscCall(PetscFree2(subset, work));
673:   }
674:   PetscFunctionReturn(PETSC_SUCCESS);
675: }

677: /*@
678:   PetscDTAltVInteriorPattern - compute the sparsity and sign pattern of the interior product matrix computed in `PetscDTAltVInteriorMatrix()`

680:   Input Parameters:
681: + N - the dimension of the vector space, N >= 0
682: - k - the degree of the k-forms on which intvMat from `PetscDTAltVInteriorMatrix()` acts, 0 <= k <= N.

684:   Output Parameter:
685: . indices - The interior product matrix intvMat has size [(N choose (k-1)) x (N choose k)] and has (N choose k) * k
686:              non-zeros.  indices[i][0] and indices[i][1] are the row and column of a non-zero, and its value is equal to the vector
687:              coordinate v[j] if indices[i][2] = j, or -v[j] if indices[i][2] = -(j+1)

689:   Level: intermediate

691:   Note:
692:   This function is useful when the interior product needs to be computed at multiple locations, as when computing the Koszul differential

694: .seealso: `PetscDTAltV`, `PetscDTAltVInterior()`, `PetscDTAltVInteriorMatrix()`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
695: @*/
696: PetscErrorCode PetscDTAltVInteriorPattern(PetscInt N, PetscInt k, PetscInt (*indices)[3])
697: {
698:   PetscInt i, Nk, Nkm;

700:   PetscFunctionBegin;
701:   PetscCheck(k > 0 && k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
702:   PetscCall(PetscDTBinomialInt(N, k, &Nk));
703:   PetscCall(PetscDTBinomialInt(N, k - 1, &Nkm));
704:   if (N <= 3) {
705:     if (k == 1) {
706:       for (i = 0; i < N; i++) {
707:         indices[i][0] = 0;
708:         indices[i][1] = i;
709:         indices[i][2] = i;
710:       }
711:     } else if (k == N) {
712:       PetscInt val[3] = {0, -2, 2};

714:       for (i = 0; i < N; i++) {
715:         indices[i][0] = N - 1 - i;
716:         indices[i][1] = 0;
717:         indices[i][2] = val[i];
718:       }
719:     } else {
720:       indices[0][0] = 0;
721:       indices[0][1] = 0;
722:       indices[0][2] = -(1 + 1);
723:       indices[1][0] = 0;
724:       indices[1][1] = 1;
725:       indices[1][2] = -(2 + 1);
726:       indices[2][0] = 1;
727:       indices[2][1] = 0;
728:       indices[2][2] = 0;
729:       indices[3][0] = 1;
730:       indices[3][1] = 2;
731:       indices[3][2] = -(2 + 1);
732:       indices[4][0] = 2;
733:       indices[4][1] = 1;
734:       indices[4][2] = 0;
735:       indices[5][0] = 2;
736:       indices[5][1] = 2;
737:       indices[5][2] = 1;
738:     }
739:   } else {
740:     PetscInt *subset, *work;

742:     PetscCall(PetscMalloc2(k, &subset, k, &work));
743:     for (i = 0; i < Nk; i++) {
744:       PetscInt j, l, m;

746:       PetscCall(PetscDTEnumSubset(N, k, i, subset));
747:       for (j = 0; j < k; j++) {
748:         PetscInt  idx;
749:         PetscBool flip = (PetscBool)(j & 1);

751:         for (l = 0, m = 0; l < k; l++) {
752:           if (l != j) work[m++] = subset[l];
753:         }
754:         PetscCall(PetscDTSubsetIndex(N, k - 1, work, &idx));
755:         indices[i * k + j][0] = idx;
756:         indices[i * k + j][1] = i;
757:         indices[i * k + j][2] = flip ? -(subset[j] + 1) : subset[j];
758:       }
759:     }
760:     PetscCall(PetscFree2(subset, work));
761:   }
762:   PetscFunctionReturn(PETSC_SUCCESS);
763: }

765: /*@
766:   PetscDTAltVStar - Apply a power of the Hodge star operator, which maps k-forms to (N-k) forms, to a k-form

768:   Input Parameters:
769: + N   - the dimension of the vector space, N >= 0
770: . k   - the degree k of the k-form w, 0 <= k <= N
771: . pow - the number of times to apply the Hodge star operator: pow < 0 indicates that the inverse of the Hodge star operator should be applied |pow| times.
772: - w   - a k-form, size [N choose k]

774:   Output Parameter:
775: . starw - (star)^pow w

777:   Level: intermediate

779:   Notes:
780:   Each degree of freedom of a k-form is associated with a subset S of k coordinates of the N
781:   dimensional vector space: the Hodge start operator (star) maps that degree of freedom to the
782:   degree of freedom associated with S', the complement of S, with a sign change if the
783:   permutation of coordinates {S[0], ... S[k-1], S'[0], starw- 1]} is an odd permutation.  This
784:   implies (star)^2 w = (-1)^{k(N-k)} w, and (star)^4 w = w.

786: .seealso: `PetscDTAltV`, `PetscDTAltVPullback()`, `PetscDTAltVPullbackMatrix()`
787: @*/
788: PetscErrorCode PetscDTAltVStar(PetscInt N, PetscInt k, PetscInt pow, const PetscReal *w, PetscReal *starw)
789: {
790:   PetscInt Nk, i;

792:   PetscFunctionBegin;
793:   PetscCheck(k >= 0 && k <= N, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
794:   PetscCall(PetscDTBinomialInt(N, k, &Nk));
795:   pow = pow % 4;
796:   pow = (pow + 4) % 4; /* make non-negative */
797:   /* pow is now 0, 1, 2, 3 */
798:   if (N <= 3) {
799:     if (pow & 1) {
800:       PetscReal mult[3] = {1., -1., 1.};

802:       for (i = 0; i < Nk; i++) starw[Nk - 1 - i] = w[i] * mult[i];
803:     } else {
804:       for (i = 0; i < Nk; i++) starw[i] = w[i];
805:     }
806:     if (pow > 1 && ((k * (N - k)) & 1)) {
807:       for (i = 0; i < Nk; i++) starw[i] = -starw[i];
808:     }
809:   } else {
810:     PetscInt *subset;

812:     PetscCall(PetscMalloc1(N, &subset));
813:     if (pow % 2) {
814:       PetscInt l = (pow == 1) ? k : N - k;
815:       for (i = 0; i < Nk; i++) {
816:         PetscBool sOdd;
817:         PetscInt  j, idx;

819:         PetscCall(PetscDTEnumSplit(N, l, i, subset, &sOdd));
820:         PetscCall(PetscDTSubsetIndex(N, l, subset, &idx));
821:         PetscCall(PetscDTSubsetIndex(N, N - l, &subset[l], &j));
822:         starw[j] = sOdd ? -w[idx] : w[idx];
823:       }
824:     } else {
825:       for (i = 0; i < Nk; i++) starw[i] = w[i];
826:     }
827:     /* star^2 = -1^(k * (N - k)) */
828:     if (pow > 1 && (k * (N - k)) % 2) {
829:       for (i = 0; i < Nk; i++) starw[i] = -starw[i];
830:     }
831:     PetscCall(PetscFree(subset));
832:   }
833:   PetscFunctionReturn(PETSC_SUCCESS);
834: }