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