xref: /petsc/src/dm/dt/interface/dtaltv.c (revision 1a989b97589941243e8cab5a24b3e78e429ff245)
1*1a989b97SToby Isaac #include <petsc/private/petscimpl.h>
2*1a989b97SToby Isaac #include <petsc/private/dtimpl.h>
3*1a989b97SToby Isaac 
4*1a989b97SToby Isaac PetscErrorCode PetscDTAltVApply(PetscInt N, PetscInt k, const PetscReal *w, const PetscReal *v, PetscReal *wv)
5*1a989b97SToby Isaac {
6*1a989b97SToby Isaac   PetscErrorCode ierr;
7*1a989b97SToby Isaac 
8*1a989b97SToby Isaac   PetscFunctionBegin;
9*1a989b97SToby Isaac   if (N < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimension");
10*1a989b97SToby Isaac   if (k < 0 || k > N) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
11*1a989b97SToby Isaac   if (N <= 3) {
12*1a989b97SToby Isaac     if (!k) {
13*1a989b97SToby Isaac       *wv = w[0];
14*1a989b97SToby Isaac     } else {
15*1a989b97SToby Isaac       if (N == 1)        {*wv = w[0] * v[0];}
16*1a989b97SToby Isaac       else if (N == 2) {
17*1a989b97SToby Isaac         if (k == 1)      {*wv = w[0] * v[0] + w[1] * v[1];}
18*1a989b97SToby Isaac         else             {*wv = w[0] * (v[0] * v[3] - v[1] * v[2]);}
19*1a989b97SToby Isaac       } else {
20*1a989b97SToby Isaac         if (k == 1)      {*wv = w[0] * v[0] + w[1] * v[1] + w[2] * v[2];}
21*1a989b97SToby Isaac         else if (k == 2) {
22*1a989b97SToby Isaac           *wv = w[0] * (v[0] * v[4] - v[1] * v[3]) +
23*1a989b97SToby Isaac                 w[1] * (v[0] * v[5] - v[2] * v[3]) +
24*1a989b97SToby Isaac                 w[2] * (v[1] * v[5] - v[2] * v[4]);
25*1a989b97SToby Isaac         } else {
26*1a989b97SToby Isaac           *wv = w[0] * (v[0] * (v[4] * v[8] - v[5] * v[7]) +
27*1a989b97SToby Isaac                         v[1] * (v[5] * v[6] - v[3] * v[8]) +
28*1a989b97SToby Isaac                         v[2] * (v[3] * v[7] - v[4] * v[6]));
29*1a989b97SToby Isaac         }
30*1a989b97SToby Isaac       }
31*1a989b97SToby Isaac     }
32*1a989b97SToby Isaac   } else {
33*1a989b97SToby Isaac     PetscInt Nk, Nf;
34*1a989b97SToby Isaac     PetscInt *subset, *work, *perm;
35*1a989b97SToby Isaac     PetscInt i, j, l;
36*1a989b97SToby Isaac     PetscReal sum = 0.;
37*1a989b97SToby Isaac 
38*1a989b97SToby Isaac     ierr = PetscDTFactorialInt_Internal(k, &Nf);CHKERRQ(ierr);
39*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, k, &Nk);CHKERRQ(ierr);
40*1a989b97SToby Isaac     ierr = PetscMalloc3(k, &subset, k, &work, k, &perm);CHKERRQ(ierr);
41*1a989b97SToby Isaac     for (i = 0; i < Nk; i++) {
42*1a989b97SToby Isaac       PetscReal subsum = 0.;
43*1a989b97SToby Isaac 
44*1a989b97SToby Isaac       ierr = PetscDTEnumSubset(N, k, i, subset);CHKERRQ(ierr);
45*1a989b97SToby Isaac       for (j = 0; j < Nf; j++) {
46*1a989b97SToby Isaac         PetscBool permOdd;
47*1a989b97SToby Isaac         PetscReal prod;
48*1a989b97SToby Isaac 
49*1a989b97SToby Isaac         ierr = PetscDTEnumPerm(k, j, work, perm, &permOdd);CHKERRQ(ierr);
50*1a989b97SToby Isaac         prod = permOdd ? -1. : 1.;
51*1a989b97SToby Isaac         for (l = 0; l < k; l++) {
52*1a989b97SToby Isaac           prod *= v[perm[l] * N + subset[l]];
53*1a989b97SToby Isaac         }
54*1a989b97SToby Isaac         subsum += prod;
55*1a989b97SToby Isaac       }
56*1a989b97SToby Isaac       sum += w[i] * subsum;
57*1a989b97SToby Isaac     }
58*1a989b97SToby Isaac     ierr = PetscFree3(subset, work, perm);CHKERRQ(ierr);
59*1a989b97SToby Isaac     *wv = sum;
60*1a989b97SToby Isaac   }
61*1a989b97SToby Isaac   PetscFunctionReturn(0);
62*1a989b97SToby Isaac }
63*1a989b97SToby Isaac 
64*1a989b97SToby Isaac PetscErrorCode PetscDTAltVWedge(PetscInt N, PetscInt j, PetscInt k, const PetscReal *a, const PetscReal *b, PetscReal *awedgeb)
65*1a989b97SToby Isaac {
66*1a989b97SToby Isaac   PetscInt       i;
67*1a989b97SToby Isaac   PetscErrorCode ierr;
68*1a989b97SToby Isaac 
69*1a989b97SToby Isaac   PetscFunctionBegin;
70*1a989b97SToby Isaac   if (N < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimension");
71*1a989b97SToby Isaac   if (j < 0 || k < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "negative form degree");
72*1a989b97SToby Isaac   if (j + k > N) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Wedge greater than dimension");
73*1a989b97SToby Isaac   if (N <= 3) {
74*1a989b97SToby Isaac     PetscInt Njk;
75*1a989b97SToby Isaac 
76*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, j+k, &Njk);CHKERRQ(ierr);
77*1a989b97SToby Isaac     if (!j)      {for (i = 0; i < Njk; i++) {awedgeb[i] = a[0] * b[i];}}
78*1a989b97SToby Isaac     else if (!k) {for (i = 0; i < Njk; i++) {awedgeb[i] = a[i] * b[0];}}
79*1a989b97SToby Isaac     else {
80*1a989b97SToby Isaac       if (N == 2) {awedgeb[0] = a[0] * b[1] - a[1] * b[0];}
81*1a989b97SToby Isaac       else {
82*1a989b97SToby Isaac         if (j+k == 2) {
83*1a989b97SToby Isaac           awedgeb[0] = a[0] * b[1] - a[1] * b[0];
84*1a989b97SToby Isaac           awedgeb[1] = a[0] * b[2] - a[2] * b[0];
85*1a989b97SToby Isaac           awedgeb[2] = a[1] * b[2] - a[2] * b[1];
86*1a989b97SToby Isaac         } else {
87*1a989b97SToby Isaac           awedgeb[0] = a[0] * b[2] - a[1] * b[1] + a[2] * b[0];
88*1a989b97SToby Isaac         }
89*1a989b97SToby Isaac       }
90*1a989b97SToby Isaac     }
91*1a989b97SToby Isaac   } else {
92*1a989b97SToby Isaac     PetscInt  Njk;
93*1a989b97SToby Isaac     PetscInt  JKj;
94*1a989b97SToby Isaac     PetscInt *subset, *subsetjk, *subsetj, *subsetk;
95*1a989b97SToby Isaac     PetscInt  i;
96*1a989b97SToby Isaac 
97*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, j+k, &Njk);CHKERRQ(ierr);
98*1a989b97SToby Isaac     ierr = PetscDTBinomial(j+k, j, &JKj);CHKERRQ(ierr);
99*1a989b97SToby Isaac     ierr = PetscMalloc4(j+k, &subset, j+k, &subsetjk, j, &subsetj, k, &subsetk);CHKERRQ(ierr);
100*1a989b97SToby Isaac     for (i = 0; i < Njk; i++) {
101*1a989b97SToby Isaac       PetscReal sum = 0.;
102*1a989b97SToby Isaac       PetscInt  l;
103*1a989b97SToby Isaac 
104*1a989b97SToby Isaac       ierr = PetscDTEnumSubset(N, j+k, i, subset);CHKERRQ(ierr);
105*1a989b97SToby Isaac       for (l = 0; l < JKj; l++) {
106*1a989b97SToby Isaac         PetscBool jkOdd;
107*1a989b97SToby Isaac         PetscInt  m, jInd, kInd;
108*1a989b97SToby Isaac 
109*1a989b97SToby Isaac         ierr = PetscDTEnumSplit(j+k, j, l, subsetjk, &jkOdd);CHKERRQ(ierr);
110*1a989b97SToby Isaac         for (m = 0; m < j; m++) {
111*1a989b97SToby Isaac           subsetj[m] = subset[subsetjk[m]];
112*1a989b97SToby Isaac         }
113*1a989b97SToby Isaac         for (m = 0; m < k; m++) {
114*1a989b97SToby Isaac           subsetk[m] = subset[subsetjk[j+m]];
115*1a989b97SToby Isaac         }
116*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, j, subsetj, &jInd);CHKERRQ(ierr);
117*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, k, subsetk, &kInd);CHKERRQ(ierr);
118*1a989b97SToby Isaac         sum += jkOdd ? -(a[jInd] * b[kInd]) : (a[jInd] * b[kInd]);
119*1a989b97SToby Isaac       }
120*1a989b97SToby Isaac       awedgeb[i] = sum;
121*1a989b97SToby Isaac     }
122*1a989b97SToby Isaac     ierr = PetscFree4(subset, subsetjk, subsetj, subsetk);CHKERRQ(ierr);
123*1a989b97SToby Isaac   }
124*1a989b97SToby Isaac   PetscFunctionReturn(0);
125*1a989b97SToby Isaac }
126*1a989b97SToby Isaac 
127*1a989b97SToby Isaac PetscErrorCode PetscDTAltVWedgeMatrix(PetscInt N, PetscInt j, PetscInt k, const PetscReal *a, PetscReal *awedgeMat)
128*1a989b97SToby Isaac {
129*1a989b97SToby Isaac   PetscInt       i;
130*1a989b97SToby Isaac   PetscErrorCode ierr;
131*1a989b97SToby Isaac 
132*1a989b97SToby Isaac   PetscFunctionBegin;
133*1a989b97SToby Isaac   if (N < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimension");
134*1a989b97SToby Isaac   if (j < 0 || k < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "negative form degree");
135*1a989b97SToby Isaac   if (j + k > N) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Wedge greater than dimension");
136*1a989b97SToby Isaac   if (N <= 3) {
137*1a989b97SToby Isaac     PetscInt Njk;
138*1a989b97SToby Isaac 
139*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, j+k, &Njk);CHKERRQ(ierr);
140*1a989b97SToby Isaac     if (!j) {
141*1a989b97SToby Isaac       for (i = 0; i < Njk * Njk; i++) {awedgeMat[i] = 0.;}
142*1a989b97SToby Isaac       for (i = 0; i < Njk; i++) {awedgeMat[i * (Njk + 1)] = a[0];}
143*1a989b97SToby Isaac     } else if (!k) {
144*1a989b97SToby Isaac       for (i = 0; i < Njk; i++) {awedgeMat[i] = a[i];}
145*1a989b97SToby Isaac     } else {
146*1a989b97SToby Isaac       if (N == 2) {
147*1a989b97SToby Isaac         awedgeMat[0] = -a[1]; awedgeMat[1] =  a[0];
148*1a989b97SToby Isaac       } else {
149*1a989b97SToby Isaac         if (j+k == 2) {
150*1a989b97SToby Isaac           awedgeMat[0] = -a[1]; awedgeMat[1] =  a[0]; awedgeMat[2] =    0.;
151*1a989b97SToby Isaac           awedgeMat[3] = -a[2]; awedgeMat[4] =    0.; awedgeMat[5] =  a[0];
152*1a989b97SToby Isaac           awedgeMat[6] =    0.; awedgeMat[7] = -a[2]; awedgeMat[8] =  a[1];
153*1a989b97SToby Isaac         } else {
154*1a989b97SToby Isaac           awedgeMat[0] =  a[2]; awedgeMat[1] = -a[1]; awedgeMat[2] =  a[0];
155*1a989b97SToby Isaac         }
156*1a989b97SToby Isaac       }
157*1a989b97SToby Isaac     }
158*1a989b97SToby Isaac   } else {
159*1a989b97SToby Isaac     PetscInt  Njk;
160*1a989b97SToby Isaac     PetscInt  Nk;
161*1a989b97SToby Isaac     PetscInt  JKj, i;
162*1a989b97SToby Isaac     PetscInt *subset, *subsetjk, *subsetj, *subsetk;
163*1a989b97SToby Isaac 
164*1a989b97SToby Isaac     ierr = PetscDTBinomial(N,   k,   &Nk);CHKERRQ(ierr);
165*1a989b97SToby Isaac     ierr = PetscDTBinomial(N,   j+k, &Njk);CHKERRQ(ierr);
166*1a989b97SToby Isaac     ierr = PetscDTBinomial(j+k, j,   &JKj);CHKERRQ(ierr);
167*1a989b97SToby Isaac     ierr = PetscMalloc4(j+k, &subset, j+k, &subsetjk, j, &subsetj, k, &subsetk);CHKERRQ(ierr);
168*1a989b97SToby Isaac     for (i = 0; i < Njk * Nk; i++) awedgeMat[i] = 0.;
169*1a989b97SToby Isaac     for (i = 0; i < Njk; i++) {
170*1a989b97SToby Isaac       PetscInt  l;
171*1a989b97SToby Isaac 
172*1a989b97SToby Isaac       ierr = PetscDTEnumSubset(N, j+k, i, subset);CHKERRQ(ierr);
173*1a989b97SToby Isaac       for (l = 0; l < JKj; l++) {
174*1a989b97SToby Isaac         PetscBool jkOdd;
175*1a989b97SToby Isaac         PetscInt  m, jInd, kInd;
176*1a989b97SToby Isaac 
177*1a989b97SToby Isaac         ierr = PetscDTEnumSplit(j+k, j, l, subsetjk, &jkOdd);CHKERRQ(ierr);
178*1a989b97SToby Isaac         for (m = 0; m < j; m++) {
179*1a989b97SToby Isaac           subsetj[m] = subset[subsetjk[m]];
180*1a989b97SToby Isaac         }
181*1a989b97SToby Isaac         for (m = 0; m < k; m++) {
182*1a989b97SToby Isaac           subsetk[m] = subset[subsetjk[j+m]];
183*1a989b97SToby Isaac         }
184*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, j, subsetj, &jInd);CHKERRQ(ierr);
185*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, k, subsetk, &kInd);CHKERRQ(ierr);
186*1a989b97SToby Isaac         awedgeMat[i * Nk + kInd] += jkOdd ? - a[jInd] : a[jInd];
187*1a989b97SToby Isaac       }
188*1a989b97SToby Isaac     }
189*1a989b97SToby Isaac     ierr = PetscFree4(subset, subsetjk, subsetj, subsetk);CHKERRQ(ierr);
190*1a989b97SToby Isaac   }
191*1a989b97SToby Isaac   PetscFunctionReturn(0);
192*1a989b97SToby Isaac }
193*1a989b97SToby Isaac 
194*1a989b97SToby Isaac /* L: V -> W [|W| by |V| array], L*: altW -> altV */
195*1a989b97SToby Isaac PetscErrorCode PetscDTAltVPullback(PetscInt N, PetscInt M, const PetscReal *L, PetscInt k, const PetscReal *w, PetscReal *Lstarw)
196*1a989b97SToby Isaac {
197*1a989b97SToby Isaac   PetscInt         i, j, Nk, Mk;
198*1a989b97SToby Isaac   PetscErrorCode   ierr;
199*1a989b97SToby Isaac 
200*1a989b97SToby Isaac   PetscFunctionBegin;
201*1a989b97SToby Isaac   if (N < 0 || M < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimensions");
202*1a989b97SToby Isaac   if (PetscAbsInt(k) > N || PetscAbsInt(k) > M) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
203*1a989b97SToby Isaac   if (N <= 3 && M <= 3) {
204*1a989b97SToby Isaac 
205*1a989b97SToby Isaac     ierr = PetscDTBinomial(M, PetscAbsInt(k), &Mk);CHKERRQ(ierr);
206*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
207*1a989b97SToby Isaac     if (!k) {
208*1a989b97SToby Isaac       Lstarw[0] = w[0];
209*1a989b97SToby Isaac     } else if (k == 1) {
210*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
211*1a989b97SToby Isaac         PetscReal sum = 0.;
212*1a989b97SToby Isaac 
213*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {sum += L[j * Nk + i] * w[j];}
214*1a989b97SToby Isaac         Lstarw[i] = sum;
215*1a989b97SToby Isaac       }
216*1a989b97SToby Isaac     } else if (k == -1) {
217*1a989b97SToby Isaac       PetscReal mult[3] = {1., -1., 1.};
218*1a989b97SToby Isaac 
219*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
220*1a989b97SToby Isaac         PetscReal sum = 0.;
221*1a989b97SToby Isaac 
222*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {
223*1a989b97SToby Isaac           sum += L[(Mk - 1 - j) * Nk + (Nk - 1 - i)] * w[j] * mult[j];
224*1a989b97SToby Isaac         }
225*1a989b97SToby Isaac         Lstarw[i] = mult[i] * sum;
226*1a989b97SToby Isaac       }
227*1a989b97SToby Isaac     } else if (k == 2) {
228*1a989b97SToby Isaac       PetscInt pairs[3][2] = {{0,1},{0,2},{1,2}};
229*1a989b97SToby Isaac 
230*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
231*1a989b97SToby Isaac         PetscReal sum = 0.;
232*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {
233*1a989b97SToby Isaac           sum += (L[pairs[j][0] * N + pairs[i][0]] * L[pairs[j][1] * N + pairs[i][1]] -
234*1a989b97SToby Isaac                   L[pairs[j][1] * N + pairs[i][0]] * L[pairs[j][0] * N + pairs[i][1]]) * w[j];
235*1a989b97SToby Isaac         }
236*1a989b97SToby Isaac         Lstarw[i] = sum;
237*1a989b97SToby Isaac       }
238*1a989b97SToby Isaac     } else if (k == -2) {
239*1a989b97SToby Isaac       PetscInt  pairs[3][2] = {{1,2},{2,0},{0,1}};
240*1a989b97SToby Isaac       PetscInt  offi = (N == 2) ? 2 : 0;
241*1a989b97SToby Isaac       PetscInt  offj = (M == 2) ? 2 : 0;
242*1a989b97SToby Isaac 
243*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
244*1a989b97SToby Isaac         PetscReal sum   = 0.;
245*1a989b97SToby Isaac 
246*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {
247*1a989b97SToby Isaac           sum += (L[pairs[offj + j][0] * N + pairs[offi + i][0]] *
248*1a989b97SToby Isaac                   L[pairs[offj + j][1] * N + pairs[offi + i][1]] -
249*1a989b97SToby Isaac                   L[pairs[offj + j][1] * N + pairs[offi + i][0]] *
250*1a989b97SToby Isaac                   L[pairs[offj + j][0] * N + pairs[offi + i][1]]) * w[j];
251*1a989b97SToby Isaac 
252*1a989b97SToby Isaac         }
253*1a989b97SToby Isaac         Lstarw[i] = sum;
254*1a989b97SToby Isaac       }
255*1a989b97SToby Isaac     } else {
256*1a989b97SToby Isaac       PetscReal detL = L[0] * (L[4] * L[8] - L[5] * L[7]) +
257*1a989b97SToby Isaac                        L[1] * (L[5] * L[6] - L[3] * L[8]) +
258*1a989b97SToby Isaac                        L[2] * (L[3] * L[7] - L[4] * L[6]);
259*1a989b97SToby Isaac 
260*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {Lstarw[i] = detL * w[i];}
261*1a989b97SToby Isaac     }
262*1a989b97SToby Isaac   } else {
263*1a989b97SToby Isaac     PetscInt         Nf, l, p;
264*1a989b97SToby Isaac     PetscReal       *Lw, *Lwv;
265*1a989b97SToby Isaac     PetscInt        *subsetw, *subsetv;
266*1a989b97SToby Isaac     PetscInt        *work, *perm;
267*1a989b97SToby Isaac     PetscReal       *walloc = NULL;
268*1a989b97SToby Isaac     const PetscReal *ww = NULL;
269*1a989b97SToby Isaac     PetscBool        negative = PETSC_FALSE;
270*1a989b97SToby Isaac 
271*1a989b97SToby Isaac     ierr = PetscDTBinomial(M, PetscAbsInt(k), &Mk);CHKERRQ(ierr);
272*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
273*1a989b97SToby Isaac     ierr = PetscDTFactorialInt_Internal(PetscAbsInt(k), &Nf);CHKERRQ(ierr);
274*1a989b97SToby Isaac     if (k < 0) {
275*1a989b97SToby Isaac       negative = PETSC_TRUE;
276*1a989b97SToby Isaac       k = -k;
277*1a989b97SToby Isaac       ierr = PetscMalloc1(Mk, &walloc);CHKERRQ(ierr);
278*1a989b97SToby Isaac       ierr = PetscDTAltVStar(M, M - k, 1, w, walloc);CHKERRQ(ierr);
279*1a989b97SToby Isaac       ww = walloc;
280*1a989b97SToby Isaac     } else {
281*1a989b97SToby Isaac       ww = w;
282*1a989b97SToby Isaac     }
283*1a989b97SToby Isaac     ierr = PetscMalloc6(k, &subsetw, k, &subsetv, k, &work, k, &perm, N * k, &Lw, k * k, &Lwv);CHKERRQ(ierr);
284*1a989b97SToby Isaac     for (i = 0; i < Nk; i++) Lstarw[i] = 0.;
285*1a989b97SToby Isaac     for (i = 0; i < Mk; i++) {
286*1a989b97SToby Isaac       ierr = PetscDTEnumSubset(M, k, i, subsetw);CHKERRQ(ierr);
287*1a989b97SToby Isaac       for (j = 0; j < Nk; j++) {
288*1a989b97SToby Isaac         ierr = PetscDTEnumSubset(N, k, j, subsetv);CHKERRQ(ierr);
289*1a989b97SToby Isaac         for (p = 0; p < Nf; p++) {
290*1a989b97SToby Isaac           PetscReal prod;
291*1a989b97SToby Isaac           PetscBool isOdd;
292*1a989b97SToby Isaac 
293*1a989b97SToby Isaac           ierr = PetscDTEnumPerm(k, p, work, perm, &isOdd);CHKERRQ(ierr);
294*1a989b97SToby Isaac           prod = isOdd ? -ww[i] : ww[i];
295*1a989b97SToby Isaac           for (l = 0; l < k; l++) {
296*1a989b97SToby Isaac             prod *= L[subsetw[perm[l]] * N + subsetv[l]];
297*1a989b97SToby Isaac           }
298*1a989b97SToby Isaac           Lstarw[j] += prod;
299*1a989b97SToby Isaac         }
300*1a989b97SToby Isaac       }
301*1a989b97SToby Isaac     }
302*1a989b97SToby Isaac     if (negative) {
303*1a989b97SToby Isaac       PetscReal *sLsw;
304*1a989b97SToby Isaac 
305*1a989b97SToby Isaac       ierr = PetscMalloc1(Nk, &sLsw);CHKERRQ(ierr);
306*1a989b97SToby Isaac       ierr = PetscDTAltVStar(N, N - k, -1,  Lstarw, sLsw);CHKERRQ(ierr);
307*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) Lstarw[i] = sLsw[i];
308*1a989b97SToby Isaac       ierr = PetscFree(sLsw);CHKERRQ(ierr);
309*1a989b97SToby Isaac     }
310*1a989b97SToby Isaac     ierr = PetscFree6(subsetw, subsetv, work, perm, Lw, Lwv);CHKERRQ(ierr);
311*1a989b97SToby Isaac     ierr = PetscFree(walloc);CHKERRQ(ierr);
312*1a989b97SToby Isaac   }
313*1a989b97SToby Isaac   PetscFunctionReturn(0);
314*1a989b97SToby Isaac }
315*1a989b97SToby Isaac 
316*1a989b97SToby Isaac PetscErrorCode PetscDTAltVPullbackMatrix(PetscInt N, PetscInt M, const PetscReal *L, PetscInt k, PetscReal *Lstar)
317*1a989b97SToby Isaac {
318*1a989b97SToby Isaac   PetscInt        Nk, Mk, Nf, i, j, l, p;
319*1a989b97SToby Isaac   PetscReal      *Lw, *Lwv;
320*1a989b97SToby Isaac   PetscInt       *subsetw, *subsetv;
321*1a989b97SToby Isaac   PetscInt       *work, *perm;
322*1a989b97SToby Isaac   PetscBool       negative = PETSC_FALSE;
323*1a989b97SToby Isaac   PetscErrorCode  ierr;
324*1a989b97SToby Isaac 
325*1a989b97SToby Isaac   PetscFunctionBegin;
326*1a989b97SToby Isaac   if (N < 0 || M < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid dimensions");
327*1a989b97SToby Isaac   if (PetscAbsInt(k) > N || PetscAbsInt(k) > M) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
328*1a989b97SToby Isaac   if (N <= 3 && M <= 3) {
329*1a989b97SToby Isaac     PetscReal mult[3] = {1., -1., 1.};
330*1a989b97SToby Isaac 
331*1a989b97SToby Isaac     ierr = PetscDTBinomial(M, PetscAbsInt(k), &Mk);CHKERRQ(ierr);
332*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
333*1a989b97SToby Isaac     if (!k) {
334*1a989b97SToby Isaac       Lstar[0] = 1.;
335*1a989b97SToby Isaac     } else if (k == 1) {
336*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {for (j = 0; j < Mk; j++) {Lstar[i * Mk + j] = L[j * Nk + i];}}
337*1a989b97SToby Isaac     } else if (k == -1) {
338*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
339*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {
340*1a989b97SToby Isaac           Lstar[i * Mk + j] = L[(Mk - 1 - j) * Nk + (Nk - 1 - i)] * mult[i] * mult[j];
341*1a989b97SToby Isaac         }
342*1a989b97SToby Isaac       }
343*1a989b97SToby Isaac     } else if (k == 2) {
344*1a989b97SToby Isaac       PetscInt pairs[3][2] = {{0,1},{0,2},{1,2}};
345*1a989b97SToby Isaac 
346*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
347*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {
348*1a989b97SToby Isaac           Lstar[i * Mk + j] = L[pairs[j][0] * N + pairs[i][0]] *
349*1a989b97SToby Isaac                               L[pairs[j][1] * N + pairs[i][1]] -
350*1a989b97SToby Isaac                               L[pairs[j][1] * N + pairs[i][0]] *
351*1a989b97SToby Isaac                               L[pairs[j][0] * N + pairs[i][1]];
352*1a989b97SToby Isaac         }
353*1a989b97SToby Isaac       }
354*1a989b97SToby Isaac     } else if (k == -2) {
355*1a989b97SToby Isaac       PetscInt  pairs[3][2] = {{1,2},{2,0},{0,1}};
356*1a989b97SToby Isaac       PetscInt  offi = (N == 2) ? 2 : 0;
357*1a989b97SToby Isaac       PetscInt  offj = (M == 2) ? 2 : 0;
358*1a989b97SToby Isaac 
359*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
360*1a989b97SToby Isaac         for (j = 0; j < Mk; j++) {
361*1a989b97SToby Isaac           Lstar[i * Mk + j] = L[pairs[offj + j][0] * N + pairs[offi + i][0]] *
362*1a989b97SToby Isaac                               L[pairs[offj + j][1] * N + pairs[offi + i][1]] -
363*1a989b97SToby Isaac                               L[pairs[offj + j][1] * N + pairs[offi + i][0]] *
364*1a989b97SToby Isaac                               L[pairs[offj + j][0] * N + pairs[offi + i][1]];
365*1a989b97SToby Isaac         }
366*1a989b97SToby Isaac       }
367*1a989b97SToby Isaac     } else {
368*1a989b97SToby Isaac       PetscReal detL = L[0] * (L[4] * L[8] - L[5] * L[7]) +
369*1a989b97SToby Isaac                        L[1] * (L[5] * L[6] - L[3] * L[8]) +
370*1a989b97SToby Isaac                        L[2] * (L[3] * L[7] - L[4] * L[6]);
371*1a989b97SToby Isaac 
372*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {Lstar[i] = detL;}
373*1a989b97SToby Isaac     }
374*1a989b97SToby Isaac   } else {
375*1a989b97SToby Isaac     if (k < 0) {
376*1a989b97SToby Isaac       negative = PETSC_TRUE;
377*1a989b97SToby Isaac       k = -k;
378*1a989b97SToby Isaac     }
379*1a989b97SToby Isaac     ierr = PetscDTBinomial(M, PetscAbsInt(k), &Mk);CHKERRQ(ierr);
380*1a989b97SToby Isaac     ierr = PetscDTBinomial(N, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
381*1a989b97SToby Isaac     ierr = PetscDTFactorialInt_Internal(PetscAbsInt(k), &Nf);CHKERRQ(ierr);
382*1a989b97SToby Isaac     ierr = PetscMalloc6(M, &subsetw, N, &subsetv, k, &work, k, &perm, N * k, &Lw, k * k, &Lwv);CHKERRQ(ierr);
383*1a989b97SToby Isaac     for (i = 0; i < Nk * Mk; i++) Lstar[i] = 0.;
384*1a989b97SToby Isaac     for (i = 0; i < Mk; i++) {
385*1a989b97SToby Isaac       PetscBool iOdd;
386*1a989b97SToby Isaac       PetscInt  iidx, jidx;
387*1a989b97SToby Isaac 
388*1a989b97SToby Isaac       ierr = PetscDTEnumSplit(M, k, i, subsetw, &iOdd);CHKERRQ(ierr);
389*1a989b97SToby Isaac       iidx = negative ? Mk - 1 - i : i;
390*1a989b97SToby Isaac       iOdd = negative ? iOdd ^ ((k * (M-k)) & 1) : PETSC_FALSE;
391*1a989b97SToby Isaac       for (j = 0; j < Nk; j++) {
392*1a989b97SToby Isaac         PetscBool jOdd;
393*1a989b97SToby Isaac 
394*1a989b97SToby Isaac         ierr = PetscDTEnumSplit(N, k, j, subsetv, &jOdd);CHKERRQ(ierr);
395*1a989b97SToby Isaac         jidx = negative ? Nk - 1 - j : j;
396*1a989b97SToby Isaac         jOdd = negative ? iOdd ^ jOdd ^ ((k * (N-k)) & 1) : PETSC_FALSE;
397*1a989b97SToby Isaac         for (p = 0; p < Nf; p++) {
398*1a989b97SToby Isaac           PetscReal prod;
399*1a989b97SToby Isaac           PetscBool isOdd;
400*1a989b97SToby Isaac 
401*1a989b97SToby Isaac           ierr = PetscDTEnumPerm(k, p, work, perm, &isOdd);CHKERRQ(ierr);
402*1a989b97SToby Isaac           isOdd ^= jOdd;
403*1a989b97SToby Isaac           prod = isOdd ? -1. : 1.;
404*1a989b97SToby Isaac           for (l = 0; l < k; l++) {
405*1a989b97SToby Isaac             prod *= L[subsetw[perm[l]] * N + subsetv[l]];
406*1a989b97SToby Isaac           }
407*1a989b97SToby Isaac           Lstar[jidx * Mk + iidx] += prod;
408*1a989b97SToby Isaac         }
409*1a989b97SToby Isaac       }
410*1a989b97SToby Isaac     }
411*1a989b97SToby Isaac     ierr = PetscFree6(subsetw, subsetv, work, perm, Lw, Lwv);CHKERRQ(ierr);
412*1a989b97SToby Isaac   }
413*1a989b97SToby Isaac   PetscFunctionReturn(0);
414*1a989b97SToby Isaac }
415*1a989b97SToby Isaac 
416*1a989b97SToby Isaac PetscErrorCode PetscDTAltVInterior(PetscInt N, PetscInt k, const PetscReal *w, const PetscReal *v, PetscReal *wIntv)
417*1a989b97SToby Isaac {
418*1a989b97SToby Isaac   PetscInt        i, Nk, Nkm;
419*1a989b97SToby Isaac   PetscErrorCode  ierr;
420*1a989b97SToby Isaac 
421*1a989b97SToby Isaac   PetscFunctionBegin;
422*1a989b97SToby Isaac   if (k <= 0 || k > N) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
423*1a989b97SToby Isaac   ierr = PetscDTBinomial(N, k,   &Nk);CHKERRQ(ierr);
424*1a989b97SToby Isaac   ierr = PetscDTBinomial(N, k-1, &Nkm);CHKERRQ(ierr);
425*1a989b97SToby Isaac   if (N <= 3) {
426*1a989b97SToby Isaac     if (k == 1) {
427*1a989b97SToby Isaac       PetscReal sum = 0.;
428*1a989b97SToby Isaac 
429*1a989b97SToby Isaac       for (i = 0; i < N; i++) {
430*1a989b97SToby Isaac         sum += w[i] * v[i];
431*1a989b97SToby Isaac       }
432*1a989b97SToby Isaac       wIntv[0] = sum;
433*1a989b97SToby Isaac     } else if (k == N) {
434*1a989b97SToby Isaac       PetscReal mult[3] = {1., -1., 1.};
435*1a989b97SToby Isaac 
436*1a989b97SToby Isaac       for (i = 0; i < N; i++) {
437*1a989b97SToby Isaac         wIntv[N - 1 - i] = w[0] * v[i] * mult[i];
438*1a989b97SToby Isaac       }
439*1a989b97SToby Isaac     } else {
440*1a989b97SToby Isaac       wIntv[0] = - w[0]*v[1] - w[1]*v[2];
441*1a989b97SToby Isaac       wIntv[1] =   w[0]*v[0] - w[2]*v[2];
442*1a989b97SToby Isaac       wIntv[2] =   w[1]*v[0] + w[2]*v[1];
443*1a989b97SToby Isaac     }
444*1a989b97SToby Isaac   } else {
445*1a989b97SToby Isaac     PetscInt       *subset, *work;
446*1a989b97SToby Isaac 
447*1a989b97SToby Isaac     ierr = PetscMalloc2(k, &subset, k, &work);CHKERRQ(ierr);
448*1a989b97SToby Isaac     for (i = 0; i < Nkm; i++) wIntv[i] = 0.;
449*1a989b97SToby Isaac     for (i = 0; i < Nk; i++) {
450*1a989b97SToby Isaac       PetscInt  j, l, m;
451*1a989b97SToby Isaac 
452*1a989b97SToby Isaac       ierr = PetscDTEnumSubset(N, k, i, subset);CHKERRQ(ierr);
453*1a989b97SToby Isaac       for (j = 0; j < k; j++) {
454*1a989b97SToby Isaac         PetscInt  idx;
455*1a989b97SToby Isaac         PetscBool flip = (j & 1);
456*1a989b97SToby Isaac 
457*1a989b97SToby Isaac         for (l = 0, m = 0; l < k; l++) {
458*1a989b97SToby Isaac           if (l != j) work[m++] = subset[l];
459*1a989b97SToby Isaac         }
460*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, k - 1, work, &idx);CHKERRQ(ierr);
461*1a989b97SToby Isaac         wIntv[idx] += flip ? -(w[i] * v[subset[j]]) :  (w[i] * v[subset[j]]);
462*1a989b97SToby Isaac       }
463*1a989b97SToby Isaac     }
464*1a989b97SToby Isaac     ierr = PetscFree2(subset, work);CHKERRQ(ierr);
465*1a989b97SToby Isaac   }
466*1a989b97SToby Isaac   PetscFunctionReturn(0);
467*1a989b97SToby Isaac }
468*1a989b97SToby Isaac 
469*1a989b97SToby Isaac PetscErrorCode PetscDTAltVInteriorMatrix(PetscInt N, PetscInt k, const PetscReal *v, PetscReal *intvMat)
470*1a989b97SToby Isaac {
471*1a989b97SToby Isaac   PetscInt        i, Nk, Nkm;
472*1a989b97SToby Isaac   PetscErrorCode  ierr;
473*1a989b97SToby Isaac 
474*1a989b97SToby Isaac   PetscFunctionBegin;
475*1a989b97SToby Isaac   if (k <= 0 || k > N) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
476*1a989b97SToby Isaac   ierr = PetscDTBinomial(N, k,   &Nk);CHKERRQ(ierr);
477*1a989b97SToby Isaac   ierr = PetscDTBinomial(N, k-1, &Nkm);CHKERRQ(ierr);
478*1a989b97SToby Isaac   if (N <= 3) {
479*1a989b97SToby Isaac     if (k == 1) {
480*1a989b97SToby Isaac       for (i = 0; i < N; i++) intvMat[i] = v[i];
481*1a989b97SToby Isaac     } else if (k == N) {
482*1a989b97SToby Isaac       PetscReal mult[3] = {1., -1., 1.};
483*1a989b97SToby Isaac 
484*1a989b97SToby Isaac       for (i = 0; i < N; i++) intvMat[N - 1 - i] = v[i] * mult[i];
485*1a989b97SToby Isaac     } else {
486*1a989b97SToby Isaac       intvMat[0] = -v[1]; intvMat[1] = -v[2]; intvMat[2] =    0.;
487*1a989b97SToby Isaac       intvMat[3] =  v[0]; intvMat[4] =    0.; intvMat[5] = -v[2];
488*1a989b97SToby Isaac       intvMat[6] =    0.; intvMat[7] =  v[0]; intvMat[8] =  v[1];
489*1a989b97SToby Isaac     }
490*1a989b97SToby Isaac   } else {
491*1a989b97SToby Isaac     PetscInt       *subset, *work;
492*1a989b97SToby Isaac 
493*1a989b97SToby Isaac     ierr = PetscMalloc2(k, &subset, k, &work);CHKERRQ(ierr);
494*1a989b97SToby Isaac     for (i = 0; i < Nk * Nkm; i++) intvMat[i] = 0.;
495*1a989b97SToby Isaac     for (i = 0; i < Nk; i++) {
496*1a989b97SToby Isaac       PetscInt  j, l, m;
497*1a989b97SToby Isaac 
498*1a989b97SToby Isaac       ierr = PetscDTEnumSubset(N, k, i, subset);CHKERRQ(ierr);
499*1a989b97SToby Isaac       for (j = 0; j < k; j++) {
500*1a989b97SToby Isaac         PetscInt  idx;
501*1a989b97SToby Isaac         PetscBool flip = (j & 1);
502*1a989b97SToby Isaac 
503*1a989b97SToby Isaac         for (l = 0, m = 0; l < k; l++) {
504*1a989b97SToby Isaac           if (l != j) work[m++] = subset[l];
505*1a989b97SToby Isaac         }
506*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, k - 1, work, &idx);CHKERRQ(ierr);
507*1a989b97SToby Isaac         intvMat[idx * Nk + i] += flip ? -v[subset[j]] :  v[subset[j]];
508*1a989b97SToby Isaac       }
509*1a989b97SToby Isaac     }
510*1a989b97SToby Isaac     ierr = PetscFree2(subset, work);CHKERRQ(ierr);
511*1a989b97SToby Isaac   }
512*1a989b97SToby Isaac   PetscFunctionReturn(0);
513*1a989b97SToby Isaac }
514*1a989b97SToby Isaac 
515*1a989b97SToby Isaac PetscErrorCode PetscDTAltVStar(PetscInt N, PetscInt k, PetscInt pow, const PetscReal *w, PetscReal *starw)
516*1a989b97SToby Isaac {
517*1a989b97SToby Isaac   PetscInt        Nk, i;
518*1a989b97SToby Isaac   PetscErrorCode  ierr;
519*1a989b97SToby Isaac 
520*1a989b97SToby Isaac   PetscFunctionBegin;
521*1a989b97SToby Isaac   if (k < 0 || k > N) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "invalid form degree");
522*1a989b97SToby Isaac   ierr = PetscDTBinomial(N, k, &Nk);CHKERRQ(ierr);
523*1a989b97SToby Isaac   pow = pow % 4;
524*1a989b97SToby Isaac   pow = (pow + 4) % 4; /* make non-negative */
525*1a989b97SToby Isaac   /* pow is now 0, 1, 2, 3 */
526*1a989b97SToby Isaac   if (N <= 3) {
527*1a989b97SToby Isaac     if (pow & 1) {
528*1a989b97SToby Isaac       PetscReal mult[3] = {1., -1., 1.};
529*1a989b97SToby Isaac 
530*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) starw[Nk - 1 - i] = w[i] * mult[i];
531*1a989b97SToby Isaac     } else {
532*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) starw[i] = w[i];
533*1a989b97SToby Isaac     }
534*1a989b97SToby Isaac     if (pow > 1 && ((k * (N - k)) & 1)) {
535*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) starw[i] = -starw[i];
536*1a989b97SToby Isaac     }
537*1a989b97SToby Isaac   } else {
538*1a989b97SToby Isaac     PetscInt       *subset;
539*1a989b97SToby Isaac 
540*1a989b97SToby Isaac     ierr = PetscMalloc1(N, &subset);CHKERRQ(ierr);
541*1a989b97SToby Isaac     if (pow % 2) {
542*1a989b97SToby Isaac       PetscInt l = (pow == 1) ? k : N - k;
543*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) {
544*1a989b97SToby Isaac         PetscBool sOdd;
545*1a989b97SToby Isaac         PetscInt  j, idx;
546*1a989b97SToby Isaac 
547*1a989b97SToby Isaac         ierr = PetscDTEnumSplit(N, l, i, subset, &sOdd);CHKERRQ(ierr);
548*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, l, subset, &idx);CHKERRQ(ierr);
549*1a989b97SToby Isaac         ierr = PetscDTSubsetIndex(N, N-l, &subset[l], &j);CHKERRQ(ierr);
550*1a989b97SToby Isaac         starw[j] = sOdd ? -w[idx] : w[idx];
551*1a989b97SToby Isaac       }
552*1a989b97SToby Isaac     } else {
553*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) starw[i] = w[i];
554*1a989b97SToby Isaac     }
555*1a989b97SToby Isaac     /* star^2 = -1^(k * (N - k)) */
556*1a989b97SToby Isaac     if (pow > 1 && (k * (N - k)) % 2) {
557*1a989b97SToby Isaac       for (i = 0; i < Nk; i++) starw[i] = -starw[i];
558*1a989b97SToby Isaac     }
559*1a989b97SToby Isaac     ierr = PetscFree(subset);CHKERRQ(ierr);
560*1a989b97SToby Isaac   }
561*1a989b97SToby Isaac   PetscFunctionReturn(0);
562*1a989b97SToby Isaac }
563