xref: /petsc/src/dm/dt/space/impls/poly/spacepoly.c (revision d39dd5f566189b2481225fb9d88e076a8392ff33)
120cf1dd8SToby Isaac #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/
220cf1dd8SToby Isaac 
320cf1dd8SToby Isaac PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
420cf1dd8SToby Isaac {
520cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
620cf1dd8SToby Isaac   PetscErrorCode   ierr;
720cf1dd8SToby Isaac 
820cf1dd8SToby Isaac   PetscFunctionBegin;
920cf1dd8SToby Isaac   ierr = PetscOptionsHead(PetscOptionsObject,"PetscSpace polynomial options");CHKERRQ(ierr);
1020cf1dd8SToby Isaac   ierr = PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);CHKERRQ(ierr);
1120cf1dd8SToby Isaac   ierr = PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);CHKERRQ(ierr);
1220cf1dd8SToby Isaac   ierr = PetscOptionsTail();CHKERRQ(ierr);
1320cf1dd8SToby Isaac   PetscFunctionReturn(0);
1420cf1dd8SToby Isaac }
1520cf1dd8SToby Isaac 
1620cf1dd8SToby Isaac static PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
1720cf1dd8SToby Isaac {
1820cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
1920cf1dd8SToby Isaac   PetscErrorCode   ierr;
2020cf1dd8SToby Isaac 
2120cf1dd8SToby Isaac   PetscFunctionBegin;
2220cf1dd8SToby Isaac   if (poly->tensor) {ierr = PetscViewerASCIIPrintf(viewer, "Tensor polynomial space of degree %D\n", sp->degree);CHKERRQ(ierr);}
2320cf1dd8SToby Isaac   else              {ierr = PetscViewerASCIIPrintf(viewer, "Polynomial space of degree %D\n", sp->degree);CHKERRQ(ierr);}
2420cf1dd8SToby Isaac   PetscFunctionReturn(0);
2520cf1dd8SToby Isaac }
2620cf1dd8SToby Isaac 
2720cf1dd8SToby Isaac PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
2820cf1dd8SToby Isaac {
2920cf1dd8SToby Isaac   PetscBool      iascii;
3020cf1dd8SToby Isaac   PetscErrorCode ierr;
3120cf1dd8SToby Isaac 
3220cf1dd8SToby Isaac   PetscFunctionBegin;
3320cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
3420cf1dd8SToby Isaac   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
3520cf1dd8SToby Isaac   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
3620cf1dd8SToby Isaac   if (iascii) {ierr = PetscSpacePolynomialView_Ascii(sp, viewer);CHKERRQ(ierr);}
3720cf1dd8SToby Isaac   PetscFunctionReturn(0);
3820cf1dd8SToby Isaac }
3920cf1dd8SToby Isaac 
4020cf1dd8SToby Isaac PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
4120cf1dd8SToby Isaac {
4220cf1dd8SToby Isaac   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
4320cf1dd8SToby Isaac   PetscInt         ndegree = sp->degree+1;
4420cf1dd8SToby Isaac   PetscInt         deg;
4520cf1dd8SToby Isaac   PetscErrorCode   ierr;
4620cf1dd8SToby Isaac 
4720cf1dd8SToby Isaac   PetscFunctionBegin;
4820cf1dd8SToby Isaac   ierr = PetscMalloc1(ndegree, &poly->degrees);CHKERRQ(ierr);
4920cf1dd8SToby Isaac   for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
5020cf1dd8SToby Isaac   if (poly->tensor) {
5120cf1dd8SToby Isaac     sp->maxDegree = sp->degree + PetscMax(sp->Nv - 1,0);
5220cf1dd8SToby Isaac   } else {
5320cf1dd8SToby Isaac     sp->maxDegree = sp->degree;
5420cf1dd8SToby Isaac   }
5520cf1dd8SToby Isaac   PetscFunctionReturn(0);
5620cf1dd8SToby Isaac }
5720cf1dd8SToby Isaac 
5820cf1dd8SToby Isaac PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
5920cf1dd8SToby Isaac {
6020cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
6120cf1dd8SToby Isaac   PetscErrorCode   ierr;
6220cf1dd8SToby Isaac 
6320cf1dd8SToby Isaac   PetscFunctionBegin;
6420cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);CHKERRQ(ierr);
6520cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", NULL);CHKERRQ(ierr);
6620cf1dd8SToby Isaac   ierr = PetscFree(poly->degrees);CHKERRQ(ierr);
6720cf1dd8SToby Isaac   if (poly->subspaces) {
6820cf1dd8SToby Isaac     PetscInt d;
6920cf1dd8SToby Isaac 
7020cf1dd8SToby Isaac     for (d = 0; d < sp->Nv; ++d) {
7120cf1dd8SToby Isaac       ierr = PetscSpaceDestroy(&poly->subspaces[d]);CHKERRQ(ierr);
7220cf1dd8SToby Isaac     }
7320cf1dd8SToby Isaac   }
7420cf1dd8SToby Isaac   ierr = PetscFree(poly->subspaces);CHKERRQ(ierr);
7520cf1dd8SToby Isaac   ierr = PetscFree(poly);CHKERRQ(ierr);
7620cf1dd8SToby Isaac   PetscFunctionReturn(0);
7720cf1dd8SToby Isaac }
7820cf1dd8SToby Isaac 
7920cf1dd8SToby Isaac /* We treat the space as a tensor product of scalar polynomial spaces, so the dimension is multiplied by Nc */
8020cf1dd8SToby Isaac PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
8120cf1dd8SToby Isaac {
8220cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
8320cf1dd8SToby Isaac   PetscInt         deg  = sp->degree;
8420cf1dd8SToby Isaac   PetscInt         n    = sp->Nv, i;
8520cf1dd8SToby Isaac   PetscReal        D    = 1.0;
8620cf1dd8SToby Isaac 
8720cf1dd8SToby Isaac   PetscFunctionBegin;
8820cf1dd8SToby Isaac   if (poly->tensor) {
8920cf1dd8SToby Isaac     *dim = 1;
9020cf1dd8SToby Isaac     for (i = 0; i < n; ++i) *dim *= (deg+1);
9120cf1dd8SToby Isaac   } else {
9220cf1dd8SToby Isaac     for (i = 1; i <= n; ++i) {
9320cf1dd8SToby Isaac       D *= ((PetscReal) (deg+i))/i;
9420cf1dd8SToby Isaac     }
9520cf1dd8SToby Isaac     *dim = (PetscInt) (D + 0.5);
9620cf1dd8SToby Isaac   }
9720cf1dd8SToby Isaac   *dim *= sp->Nc;
9820cf1dd8SToby Isaac   PetscFunctionReturn(0);
9920cf1dd8SToby Isaac }
10020cf1dd8SToby Isaac 
10120cf1dd8SToby Isaac /*
10220cf1dd8SToby Isaac   LatticePoint_Internal - Returns all tuples of size 'len' with nonnegative integers that sum up to 'sum'.
10320cf1dd8SToby Isaac 
10420cf1dd8SToby Isaac   Input Parameters:
10520cf1dd8SToby Isaac + len - The length of the tuple
10620cf1dd8SToby Isaac . sum - The sum of all entries in the tuple
10720cf1dd8SToby Isaac - ind - The current multi-index of the tuple, initialized to the 0 tuple
10820cf1dd8SToby Isaac 
10920cf1dd8SToby Isaac   Output Parameter:
11020cf1dd8SToby Isaac + ind - The multi-index of the tuple, -1 indicates the iteration has terminated
11120cf1dd8SToby Isaac . tup - A tuple of len integers addig to sum
11220cf1dd8SToby Isaac 
11320cf1dd8SToby Isaac   Level: developer
11420cf1dd8SToby Isaac 
11520cf1dd8SToby Isaac .seealso:
11620cf1dd8SToby Isaac */
11720cf1dd8SToby Isaac static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
11820cf1dd8SToby Isaac {
11920cf1dd8SToby Isaac   PetscInt       i;
12020cf1dd8SToby Isaac   PetscErrorCode ierr;
12120cf1dd8SToby Isaac 
12220cf1dd8SToby Isaac   PetscFunctionBegin;
12320cf1dd8SToby Isaac   if (len == 1) {
12420cf1dd8SToby Isaac     ind[0] = -1;
12520cf1dd8SToby Isaac     tup[0] = sum;
12620cf1dd8SToby Isaac   } else if (sum == 0) {
12720cf1dd8SToby Isaac     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
12820cf1dd8SToby Isaac   } else {
12920cf1dd8SToby Isaac     tup[0] = sum - ind[0];
13020cf1dd8SToby Isaac     ierr = LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);CHKERRQ(ierr);
13120cf1dd8SToby Isaac     if (ind[1] < 0) {
13220cf1dd8SToby Isaac       if (ind[0] == sum) {ind[0] = -1;}
13320cf1dd8SToby Isaac       else               {ind[1] = 0; ++ind[0];}
13420cf1dd8SToby Isaac     }
13520cf1dd8SToby Isaac   }
13620cf1dd8SToby Isaac   PetscFunctionReturn(0);
13720cf1dd8SToby Isaac }
13820cf1dd8SToby Isaac 
13920cf1dd8SToby Isaac /*
14020cf1dd8SToby Isaac   TensorPoint_Internal - Returns all tuples of size 'len' with nonnegative integers that are less than 'max'.
14120cf1dd8SToby Isaac 
14220cf1dd8SToby Isaac   Input Parameters:
14320cf1dd8SToby Isaac + len - The length of the tuple
14420cf1dd8SToby Isaac . max - The max for all entries in the tuple
14520cf1dd8SToby Isaac - ind - The current multi-index of the tuple, initialized to the 0 tuple
14620cf1dd8SToby Isaac 
14720cf1dd8SToby Isaac   Output Parameter:
14820cf1dd8SToby Isaac + ind - The multi-index of the tuple, -1 indicates the iteration has terminated
14920cf1dd8SToby Isaac . tup - A tuple of len integers less than max
15020cf1dd8SToby Isaac 
15120cf1dd8SToby Isaac   Level: developer
15220cf1dd8SToby Isaac 
15320cf1dd8SToby Isaac .seealso:
15420cf1dd8SToby Isaac */
15520cf1dd8SToby Isaac static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
15620cf1dd8SToby Isaac {
15720cf1dd8SToby Isaac   PetscInt       i;
15820cf1dd8SToby Isaac   PetscErrorCode ierr;
15920cf1dd8SToby Isaac 
16020cf1dd8SToby Isaac   PetscFunctionBegin;
16120cf1dd8SToby Isaac   if (len == 1) {
16220cf1dd8SToby Isaac     tup[0] = ind[0]++;
16320cf1dd8SToby Isaac     ind[0] = ind[0] >= max ? -1 : ind[0];
16420cf1dd8SToby Isaac   } else if (max == 0) {
16520cf1dd8SToby Isaac     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
16620cf1dd8SToby Isaac   } else {
16720cf1dd8SToby Isaac     tup[0] = ind[0];
16820cf1dd8SToby Isaac     ierr = TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);CHKERRQ(ierr);
16920cf1dd8SToby Isaac     if (ind[1] < 0) {
17020cf1dd8SToby Isaac       ind[1] = 0;
17120cf1dd8SToby Isaac       if (ind[0] == max-1) {ind[0] = -1;}
17220cf1dd8SToby Isaac       else                 {++ind[0];}
17320cf1dd8SToby Isaac     }
17420cf1dd8SToby Isaac   }
17520cf1dd8SToby Isaac   PetscFunctionReturn(0);
17620cf1dd8SToby Isaac }
17720cf1dd8SToby Isaac 
17820cf1dd8SToby Isaac /*
17920cf1dd8SToby Isaac   p in [0, npoints), i in [0, pdim), c in [0, Nc)
18020cf1dd8SToby Isaac 
18120cf1dd8SToby Isaac   B[p][i][c] = B[p][i_scalar][c][c]
18220cf1dd8SToby Isaac */
18320cf1dd8SToby Isaac PetscErrorCode PetscSpaceEvaluate_Polynomial(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
18420cf1dd8SToby Isaac {
18520cf1dd8SToby Isaac   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
18620cf1dd8SToby Isaac   DM               dm      = sp->dm;
18720cf1dd8SToby Isaac   PetscInt         Nc      = sp->Nc;
18820cf1dd8SToby Isaac   PetscInt         ndegree = sp->degree+1;
18920cf1dd8SToby Isaac   PetscInt        *degrees = poly->degrees;
19020cf1dd8SToby Isaac   PetscInt         dim     = sp->Nv;
19120cf1dd8SToby Isaac   PetscReal       *lpoints, *tmp, *LB, *LD, *LH;
19220cf1dd8SToby Isaac   PetscInt        *ind, *tup;
19320cf1dd8SToby Isaac   PetscInt         c, pdim, d, e, der, der2, i, p, deg, o;
19420cf1dd8SToby Isaac   PetscErrorCode   ierr;
19520cf1dd8SToby Isaac 
19620cf1dd8SToby Isaac   PetscFunctionBegin;
19720cf1dd8SToby Isaac   ierr = PetscSpaceGetDimension(sp, &pdim);CHKERRQ(ierr);
19820cf1dd8SToby Isaac   pdim /= Nc;
19920cf1dd8SToby Isaac   ierr = DMGetWorkArray(dm, npoints, MPIU_REAL, &lpoints);CHKERRQ(ierr);
20020cf1dd8SToby Isaac   ierr = DMGetWorkArray(dm, npoints*ndegree*3, MPIU_REAL, &tmp);CHKERRQ(ierr);
2018c7916f5SToby Isaac   if (B || D || H) {ierr = DMGetWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LB);CHKERRQ(ierr);}
2028c7916f5SToby Isaac   if (D || H)      {ierr = DMGetWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LD);CHKERRQ(ierr);}
20320cf1dd8SToby Isaac   if (H)           {ierr = DMGetWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LH);CHKERRQ(ierr);}
20420cf1dd8SToby Isaac   for (d = 0; d < dim; ++d) {
20520cf1dd8SToby Isaac     for (p = 0; p < npoints; ++p) {
20620cf1dd8SToby Isaac       lpoints[p] = points[p*dim+d];
20720cf1dd8SToby Isaac     }
20820cf1dd8SToby Isaac     ierr = PetscDTLegendreEval(npoints, lpoints, ndegree, degrees, tmp, &tmp[1*npoints*ndegree], &tmp[2*npoints*ndegree]);CHKERRQ(ierr);
20920cf1dd8SToby Isaac     /* LB, LD, LH (ndegree * dim x npoints) */
21020cf1dd8SToby Isaac     for (deg = 0; deg < ndegree; ++deg) {
21120cf1dd8SToby Isaac       for (p = 0; p < npoints; ++p) {
2128c7916f5SToby Isaac         if (B || D || H) LB[(deg*dim + d)*npoints + p] = tmp[(0*npoints + p)*ndegree+deg];
2138c7916f5SToby Isaac         if (D || H)      LD[(deg*dim + d)*npoints + p] = tmp[(1*npoints + p)*ndegree+deg];
21420cf1dd8SToby Isaac         if (H)           LH[(deg*dim + d)*npoints + p] = tmp[(2*npoints + p)*ndegree+deg];
21520cf1dd8SToby Isaac       }
21620cf1dd8SToby Isaac     }
21720cf1dd8SToby Isaac   }
21820cf1dd8SToby Isaac   /* Multiply by A (pdim x ndegree * dim) */
21920cf1dd8SToby Isaac   ierr = PetscMalloc2(dim,&ind,dim,&tup);CHKERRQ(ierr);
22020cf1dd8SToby Isaac   if (B) {
22120cf1dd8SToby Isaac     /* B (npoints x pdim x Nc) */
22220cf1dd8SToby Isaac     ierr = PetscMemzero(B, npoints*pdim*Nc*Nc * sizeof(PetscReal));CHKERRQ(ierr);
22320cf1dd8SToby Isaac     if (poly->tensor) {
22420cf1dd8SToby Isaac       i = 0;
22520cf1dd8SToby Isaac       ierr = PetscMemzero(ind, dim * sizeof(PetscInt));CHKERRQ(ierr);
22620cf1dd8SToby Isaac       while (ind[0] >= 0) {
22720cf1dd8SToby Isaac         ierr = TensorPoint_Internal(dim, sp->degree+1, ind, tup);CHKERRQ(ierr);
22820cf1dd8SToby Isaac         for (p = 0; p < npoints; ++p) {
22920cf1dd8SToby Isaac           B[(p*pdim + i)*Nc*Nc] = 1.0;
23020cf1dd8SToby Isaac           for (d = 0; d < dim; ++d) {
23120cf1dd8SToby Isaac             B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
23220cf1dd8SToby Isaac           }
23320cf1dd8SToby Isaac         }
23420cf1dd8SToby Isaac         ++i;
23520cf1dd8SToby Isaac       }
23620cf1dd8SToby Isaac     } else {
23720cf1dd8SToby Isaac       i = 0;
23820cf1dd8SToby Isaac       for (o = 0; o <= sp->degree; ++o) {
23920cf1dd8SToby Isaac         ierr = PetscMemzero(ind, dim * sizeof(PetscInt));CHKERRQ(ierr);
24020cf1dd8SToby Isaac         while (ind[0] >= 0) {
24120cf1dd8SToby Isaac           ierr = LatticePoint_Internal(dim, o, ind, tup);CHKERRQ(ierr);
24220cf1dd8SToby Isaac           for (p = 0; p < npoints; ++p) {
24320cf1dd8SToby Isaac             B[(p*pdim + i)*Nc*Nc] = 1.0;
24420cf1dd8SToby Isaac             for (d = 0; d < dim; ++d) {
24520cf1dd8SToby Isaac               B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
24620cf1dd8SToby Isaac             }
24720cf1dd8SToby Isaac           }
24820cf1dd8SToby Isaac           ++i;
24920cf1dd8SToby Isaac         }
25020cf1dd8SToby Isaac       }
25120cf1dd8SToby Isaac     }
25220cf1dd8SToby Isaac     /* Make direct sum basis for multicomponent space */
25320cf1dd8SToby Isaac     for (p = 0; p < npoints; ++p) {
25420cf1dd8SToby Isaac       for (i = 0; i < pdim; ++i) {
25520cf1dd8SToby Isaac         for (c = 1; c < Nc; ++c) {
25620cf1dd8SToby Isaac           B[(p*pdim*Nc + i*Nc + c)*Nc + c] = B[(p*pdim + i)*Nc*Nc];
25720cf1dd8SToby Isaac         }
25820cf1dd8SToby Isaac       }
25920cf1dd8SToby Isaac     }
26020cf1dd8SToby Isaac   }
26120cf1dd8SToby Isaac   if (D) {
26220cf1dd8SToby Isaac     /* D (npoints x pdim x Nc x dim) */
26320cf1dd8SToby Isaac     ierr = PetscMemzero(D, npoints*pdim*Nc*Nc*dim * sizeof(PetscReal));CHKERRQ(ierr);
26420cf1dd8SToby Isaac     if (poly->tensor) {
26520cf1dd8SToby Isaac       i = 0;
26620cf1dd8SToby Isaac       ierr = PetscMemzero(ind, dim * sizeof(PetscInt));CHKERRQ(ierr);
26720cf1dd8SToby Isaac       while (ind[0] >= 0) {
26820cf1dd8SToby Isaac         ierr = TensorPoint_Internal(dim, sp->degree+1, ind, tup);CHKERRQ(ierr);
26920cf1dd8SToby Isaac         for (p = 0; p < npoints; ++p) {
27020cf1dd8SToby Isaac           for (der = 0; der < dim; ++der) {
27120cf1dd8SToby Isaac             D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
27220cf1dd8SToby Isaac             for (d = 0; d < dim; ++d) {
27320cf1dd8SToby Isaac               if (d == der) {
27420cf1dd8SToby Isaac                 D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
27520cf1dd8SToby Isaac               } else {
27620cf1dd8SToby Isaac                 D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
27720cf1dd8SToby Isaac               }
27820cf1dd8SToby Isaac             }
27920cf1dd8SToby Isaac           }
28020cf1dd8SToby Isaac         }
28120cf1dd8SToby Isaac         ++i;
28220cf1dd8SToby Isaac       }
28320cf1dd8SToby Isaac     } else {
28420cf1dd8SToby Isaac       i = 0;
28520cf1dd8SToby Isaac       for (o = 0; o <= sp->degree; ++o) {
28620cf1dd8SToby Isaac         ierr = PetscMemzero(ind, dim * sizeof(PetscInt));CHKERRQ(ierr);
28720cf1dd8SToby Isaac         while (ind[0] >= 0) {
28820cf1dd8SToby Isaac           ierr = LatticePoint_Internal(dim, o, ind, tup);CHKERRQ(ierr);
28920cf1dd8SToby Isaac           for (p = 0; p < npoints; ++p) {
29020cf1dd8SToby Isaac             for (der = 0; der < dim; ++der) {
29120cf1dd8SToby Isaac               D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
29220cf1dd8SToby Isaac               for (d = 0; d < dim; ++d) {
29320cf1dd8SToby Isaac                 if (d == der) {
29420cf1dd8SToby Isaac                   D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
29520cf1dd8SToby Isaac                 } else {
29620cf1dd8SToby Isaac                   D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
29720cf1dd8SToby Isaac                 }
29820cf1dd8SToby Isaac               }
29920cf1dd8SToby Isaac             }
30020cf1dd8SToby Isaac           }
30120cf1dd8SToby Isaac           ++i;
30220cf1dd8SToby Isaac         }
30320cf1dd8SToby Isaac       }
30420cf1dd8SToby Isaac     }
30520cf1dd8SToby Isaac     /* Make direct sum basis for multicomponent space */
30620cf1dd8SToby Isaac     for (p = 0; p < npoints; ++p) {
30720cf1dd8SToby Isaac       for (i = 0; i < pdim; ++i) {
30820cf1dd8SToby Isaac         for (c = 1; c < Nc; ++c) {
30920cf1dd8SToby Isaac           for (d = 0; d < dim; ++d) {
31020cf1dd8SToby Isaac             D[((p*pdim*Nc + i*Nc + c)*Nc + c)*dim + d] = D[(p*pdim + i)*Nc*Nc*dim + d];
31120cf1dd8SToby Isaac           }
31220cf1dd8SToby Isaac         }
31320cf1dd8SToby Isaac       }
31420cf1dd8SToby Isaac     }
31520cf1dd8SToby Isaac   }
31620cf1dd8SToby Isaac   if (H) {
31720cf1dd8SToby Isaac     /* H (npoints x pdim x Nc x Nc x dim x dim) */
31820cf1dd8SToby Isaac     ierr = PetscMemzero(H, npoints*pdim*Nc*Nc*dim*dim * sizeof(PetscReal));CHKERRQ(ierr);
31920cf1dd8SToby Isaac     if (poly->tensor) {
32020cf1dd8SToby Isaac       i = 0;
32120cf1dd8SToby Isaac       ierr = PetscMemzero(ind, dim * sizeof(PetscInt));CHKERRQ(ierr);
32220cf1dd8SToby Isaac       while (ind[0] >= 0) {
32320cf1dd8SToby Isaac         ierr = TensorPoint_Internal(dim, sp->degree+1, ind, tup);CHKERRQ(ierr);
32420cf1dd8SToby Isaac         for (p = 0; p < npoints; ++p) {
32520cf1dd8SToby Isaac           for (der = 0; der < dim; ++der) {
32620cf1dd8SToby Isaac             H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der] = 1.0;
32720cf1dd8SToby Isaac             for (d = 0; d < dim; ++d) {
32820cf1dd8SToby Isaac               if (d == der) {
32920cf1dd8SToby Isaac                 H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der] *= LH[(tup[d]*dim + d)*npoints + p];
33020cf1dd8SToby Isaac               } else {
33120cf1dd8SToby Isaac                 H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
33220cf1dd8SToby Isaac               }
33320cf1dd8SToby Isaac             }
33420cf1dd8SToby Isaac             for (der2 = der + 1; der2 < dim; ++der2) {
33520cf1dd8SToby Isaac               H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] = 1.0;
33620cf1dd8SToby Isaac               for (d = 0; d < dim; ++d) {
33720cf1dd8SToby Isaac                 if (d == der || d == der2) {
33820cf1dd8SToby Isaac                   H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LD[(tup[d]*dim + d)*npoints + p];
33920cf1dd8SToby Isaac                 } else {
34020cf1dd8SToby Isaac                   H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LB[(tup[d]*dim + d)*npoints + p];
34120cf1dd8SToby Isaac                 }
34220cf1dd8SToby Isaac               }
34320cf1dd8SToby Isaac               H[((p*pdim + i)*Nc*Nc*dim + der2) * dim + der] = H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2];
34420cf1dd8SToby Isaac             }
34520cf1dd8SToby Isaac           }
34620cf1dd8SToby Isaac         }
34720cf1dd8SToby Isaac         ++i;
34820cf1dd8SToby Isaac       }
34920cf1dd8SToby Isaac     } else {
35020cf1dd8SToby Isaac       i = 0;
35120cf1dd8SToby Isaac       for (o = 0; o <= sp->degree; ++o) {
35220cf1dd8SToby Isaac         ierr = PetscMemzero(ind, dim * sizeof(PetscInt));CHKERRQ(ierr);
35320cf1dd8SToby Isaac         while (ind[0] >= 0) {
35420cf1dd8SToby Isaac           ierr = LatticePoint_Internal(dim, o, ind, tup);CHKERRQ(ierr);
35520cf1dd8SToby Isaac           for (p = 0; p < npoints; ++p) {
35620cf1dd8SToby Isaac             for (der = 0; der < dim; ++der) {
35720cf1dd8SToby Isaac               H[((p*pdim + i)*Nc*Nc*dim + der)*dim + der] = 1.0;
35820cf1dd8SToby Isaac               for (d = 0; d < dim; ++d) {
35920cf1dd8SToby Isaac                 if (d == der) {
36020cf1dd8SToby Isaac                   H[((p*pdim + i)*Nc*Nc*dim + der)*dim + der] *= LH[(tup[d]*dim + d)*npoints + p];
36120cf1dd8SToby Isaac                 } else {
36220cf1dd8SToby Isaac                   H[((p*pdim + i)*Nc*Nc*dim + der)*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
36320cf1dd8SToby Isaac                 }
36420cf1dd8SToby Isaac               }
36520cf1dd8SToby Isaac               for (der2 = der + 1; der2 < dim; ++der2) {
36620cf1dd8SToby Isaac                 H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] = 1.0;
36720cf1dd8SToby Isaac                 for (d = 0; d < dim; ++d) {
36820cf1dd8SToby Isaac                   if (d == der || d == der2) {
36920cf1dd8SToby Isaac                     H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LD[(tup[d]*dim + d)*npoints + p];
37020cf1dd8SToby Isaac                   } else {
37120cf1dd8SToby Isaac                     H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LB[(tup[d]*dim + d)*npoints + p];
37220cf1dd8SToby Isaac                   }
37320cf1dd8SToby Isaac                 }
37420cf1dd8SToby Isaac                 H[((p*pdim + i)*Nc*Nc*dim + der2) * dim + der] = H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2];
37520cf1dd8SToby Isaac               }
37620cf1dd8SToby Isaac             }
37720cf1dd8SToby Isaac           }
37820cf1dd8SToby Isaac           ++i;
37920cf1dd8SToby Isaac         }
38020cf1dd8SToby Isaac       }
38120cf1dd8SToby Isaac     }
38220cf1dd8SToby Isaac     /* Make direct sum basis for multicomponent space */
38320cf1dd8SToby Isaac     for (p = 0; p < npoints; ++p) {
38420cf1dd8SToby Isaac       for (i = 0; i < pdim; ++i) {
38520cf1dd8SToby Isaac         for (c = 1; c < Nc; ++c) {
38620cf1dd8SToby Isaac           for (d = 0; d < dim; ++d) {
38720cf1dd8SToby Isaac             for (e = 0; e < dim; ++e) {
38820cf1dd8SToby Isaac               H[(((p*pdim*Nc + i*Nc + c)*Nc + c)*dim + d)*dim + e] = H[((p*pdim + i)*Nc*Nc*dim + d)*dim + e];
38920cf1dd8SToby Isaac             }
39020cf1dd8SToby Isaac           }
39120cf1dd8SToby Isaac         }
39220cf1dd8SToby Isaac       }
39320cf1dd8SToby Isaac     }
39420cf1dd8SToby Isaac   }
39520cf1dd8SToby Isaac   ierr = PetscFree2(ind,tup);CHKERRQ(ierr);
39620cf1dd8SToby Isaac   if (H)           {ierr = DMRestoreWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LH);CHKERRQ(ierr);}
3978c7916f5SToby Isaac   if (D || H)      {ierr = DMRestoreWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LD);CHKERRQ(ierr);}
3988c7916f5SToby Isaac   if (B || D || H) {ierr = DMRestoreWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LB);CHKERRQ(ierr);}
39920cf1dd8SToby Isaac   ierr = DMRestoreWorkArray(dm, npoints*ndegree*3, MPIU_REAL, &tmp);CHKERRQ(ierr);
40020cf1dd8SToby Isaac   ierr = DMRestoreWorkArray(dm, npoints, MPIU_REAL, &lpoints);CHKERRQ(ierr);
40120cf1dd8SToby Isaac   PetscFunctionReturn(0);
40220cf1dd8SToby Isaac }
40320cf1dd8SToby Isaac 
40420cf1dd8SToby Isaac /*@
40520cf1dd8SToby Isaac   PetscSpacePolynomialSetTensor - Set whether a function space is a space of tensor polynomials (the space is spanned
40620cf1dd8SToby Isaac   by polynomials whose degree in each variabl is bounded by the given order), as opposed to polynomials (the space is
40720cf1dd8SToby Isaac   spanned by polynomials whose total degree---summing over all variables---is bounded by the given order).
40820cf1dd8SToby Isaac 
40920cf1dd8SToby Isaac   Input Parameters:
41020cf1dd8SToby Isaac + sp     - the function space object
41120cf1dd8SToby Isaac - tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space
41220cf1dd8SToby Isaac 
41320cf1dd8SToby Isaac   Level: beginner
41420cf1dd8SToby Isaac 
41520cf1dd8SToby Isaac .seealso: PetscSpacePolynomialGetTensor(), PetscSpaceSetDegree(), PetscSpaceSetNumVariables()
41620cf1dd8SToby Isaac @*/
41720cf1dd8SToby Isaac PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
41820cf1dd8SToby Isaac {
41920cf1dd8SToby Isaac   PetscErrorCode ierr;
42020cf1dd8SToby Isaac 
42120cf1dd8SToby Isaac   PetscFunctionBegin;
42220cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
42320cf1dd8SToby Isaac   ierr = PetscTryMethod(sp,"PetscSpacePolynomialSetTensor_C",(PetscSpace,PetscBool),(sp,tensor));CHKERRQ(ierr);
42420cf1dd8SToby Isaac   PetscFunctionReturn(0);
42520cf1dd8SToby Isaac }
42620cf1dd8SToby Isaac 
42720cf1dd8SToby Isaac /*@
42820cf1dd8SToby Isaac   PetscSpacePolynomialGetTensor - Get whether a function space is a space of tensor polynomials (the space is spanned
42920cf1dd8SToby Isaac   by polynomials whose degree in each variabl is bounded by the given order), as opposed to polynomials (the space is
43020cf1dd8SToby Isaac   spanned by polynomials whose total degree---summing over all variables---is bounded by the given order).
43120cf1dd8SToby Isaac 
43220cf1dd8SToby Isaac   Input Parameters:
43320cf1dd8SToby Isaac . sp     - the function space object
43420cf1dd8SToby Isaac 
43520cf1dd8SToby Isaac   Output Parameters:
43620cf1dd8SToby Isaac . tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space
43720cf1dd8SToby Isaac 
43820cf1dd8SToby Isaac   Level: beginner
43920cf1dd8SToby Isaac 
44020cf1dd8SToby Isaac .seealso: PetscSpacePolynomialSetTensor(), PetscSpaceSetDegree(), PetscSpaceSetNumVariables()
44120cf1dd8SToby Isaac @*/
44220cf1dd8SToby Isaac PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
44320cf1dd8SToby Isaac {
44420cf1dd8SToby Isaac   PetscErrorCode ierr;
44520cf1dd8SToby Isaac 
44620cf1dd8SToby Isaac   PetscFunctionBegin;
44720cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
44820cf1dd8SToby Isaac   PetscValidPointer(tensor, 2);
44920cf1dd8SToby Isaac   ierr = PetscTryMethod(sp,"PetscSpacePolynomialGetTensor_C",(PetscSpace,PetscBool*),(sp,tensor));CHKERRQ(ierr);
45020cf1dd8SToby Isaac   PetscFunctionReturn(0);
45120cf1dd8SToby Isaac }
45220cf1dd8SToby Isaac 
45320cf1dd8SToby Isaac static PetscErrorCode PetscSpacePolynomialSetTensor_Polynomial(PetscSpace sp, PetscBool tensor)
45420cf1dd8SToby Isaac {
45520cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
45620cf1dd8SToby Isaac 
45720cf1dd8SToby Isaac   PetscFunctionBegin;
45820cf1dd8SToby Isaac   poly->tensor = tensor;
45920cf1dd8SToby Isaac   PetscFunctionReturn(0);
46020cf1dd8SToby Isaac }
46120cf1dd8SToby Isaac 
46220cf1dd8SToby Isaac static PetscErrorCode PetscSpacePolynomialGetTensor_Polynomial(PetscSpace sp, PetscBool *tensor)
46320cf1dd8SToby Isaac {
46420cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
46520cf1dd8SToby Isaac 
46620cf1dd8SToby Isaac   PetscFunctionBegin;
46720cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
46820cf1dd8SToby Isaac   PetscValidPointer(tensor, 2);
46920cf1dd8SToby Isaac   *tensor = poly->tensor;
47020cf1dd8SToby Isaac   PetscFunctionReturn(0);
47120cf1dd8SToby Isaac }
47220cf1dd8SToby Isaac 
47320cf1dd8SToby Isaac static PetscErrorCode PetscSpaceGetHeightSubspace_Polynomial(PetscSpace sp, PetscInt height, PetscSpace *subsp)
47420cf1dd8SToby Isaac {
47520cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
47620cf1dd8SToby Isaac   PetscInt         Nc, dim, order;
47720cf1dd8SToby Isaac   PetscBool        tensor;
47820cf1dd8SToby Isaac   PetscErrorCode   ierr;
47920cf1dd8SToby Isaac 
48020cf1dd8SToby Isaac   PetscFunctionBegin;
48120cf1dd8SToby Isaac   ierr = PetscSpaceGetNumComponents(sp, &Nc);CHKERRQ(ierr);
48220cf1dd8SToby Isaac   ierr = PetscSpaceGetNumVariables(sp, &dim);CHKERRQ(ierr);
48320cf1dd8SToby Isaac   ierr = PetscSpaceGetDegree(sp, &order, NULL);CHKERRQ(ierr);
48420cf1dd8SToby Isaac   ierr = PetscSpacePolynomialGetTensor(sp, &tensor);CHKERRQ(ierr);
48520cf1dd8SToby Isaac   if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Asked for space at height %D for dimension %D space", height, dim);}
48620cf1dd8SToby Isaac   if (!poly->subspaces) {ierr = PetscCalloc1(dim, &poly->subspaces);CHKERRQ(ierr);}
48720cf1dd8SToby Isaac   if (height <= dim) {
48820cf1dd8SToby Isaac     if (!poly->subspaces[height-1]) {
48920cf1dd8SToby Isaac       PetscSpace sub;
49020cf1dd8SToby Isaac 
49120cf1dd8SToby Isaac       ierr = PetscSpaceCreate(PetscObjectComm((PetscObject) sp), &sub);CHKERRQ(ierr);
49220cf1dd8SToby Isaac       ierr = PetscSpaceSetType(sub, PETSCSPACEPOLYNOMIAL);CHKERRQ(ierr);
493*d39dd5f5SToby Isaac       ierr = PetscSpaceSetNumComponents(sub, Nc);CHKERRQ(ierr);
494*d39dd5f5SToby Isaac       ierr = PetscSpaceSetDegree(sub, order, PETSC_DETERMINE);CHKERRQ(ierr);
49520cf1dd8SToby Isaac       ierr = PetscSpaceSetNumVariables(sub, dim-height);CHKERRQ(ierr);
49620cf1dd8SToby Isaac       ierr = PetscSpacePolynomialSetTensor(sub, tensor);CHKERRQ(ierr);
49720cf1dd8SToby Isaac       ierr = PetscSpaceSetUp(sub);CHKERRQ(ierr);
49820cf1dd8SToby Isaac       poly->subspaces[height-1] = sub;
49920cf1dd8SToby Isaac     }
50020cf1dd8SToby Isaac     *subsp = poly->subspaces[height-1];
50120cf1dd8SToby Isaac   } else {
50220cf1dd8SToby Isaac     *subsp = NULL;
50320cf1dd8SToby Isaac   }
50420cf1dd8SToby Isaac   PetscFunctionReturn(0);
50520cf1dd8SToby Isaac }
50620cf1dd8SToby Isaac 
50720cf1dd8SToby Isaac PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
50820cf1dd8SToby Isaac {
50920cf1dd8SToby Isaac   PetscErrorCode ierr;
51020cf1dd8SToby Isaac 
51120cf1dd8SToby Isaac   PetscFunctionBegin;
51220cf1dd8SToby Isaac   sp->ops->setfromoptions    = PetscSpaceSetFromOptions_Polynomial;
51320cf1dd8SToby Isaac   sp->ops->setup             = PetscSpaceSetUp_Polynomial;
51420cf1dd8SToby Isaac   sp->ops->view              = PetscSpaceView_Polynomial;
51520cf1dd8SToby Isaac   sp->ops->destroy           = PetscSpaceDestroy_Polynomial;
51620cf1dd8SToby Isaac   sp->ops->getdimension      = PetscSpaceGetDimension_Polynomial;
51720cf1dd8SToby Isaac   sp->ops->evaluate          = PetscSpaceEvaluate_Polynomial;
51820cf1dd8SToby Isaac   sp->ops->getheightsubspace = PetscSpaceGetHeightSubspace_Polynomial;
51920cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Polynomial);CHKERRQ(ierr);
52020cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", PetscSpacePolynomialSetTensor_Polynomial);CHKERRQ(ierr);
52120cf1dd8SToby Isaac   PetscFunctionReturn(0);
52220cf1dd8SToby Isaac }
52320cf1dd8SToby Isaac 
52420cf1dd8SToby Isaac /*MC
52520cf1dd8SToby Isaac   PETSCSPACEPOLYNOMIAL = "poly" - A PetscSpace object that encapsulates a polynomial space, e.g. P1 is the space of
52620cf1dd8SToby Isaac   linear polynomials. The space is replicated for each component.
52720cf1dd8SToby Isaac 
52820cf1dd8SToby Isaac   Level: intermediate
52920cf1dd8SToby Isaac 
53020cf1dd8SToby Isaac .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
53120cf1dd8SToby Isaac M*/
53220cf1dd8SToby Isaac 
53320cf1dd8SToby Isaac PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
53420cf1dd8SToby Isaac {
53520cf1dd8SToby Isaac   PetscSpace_Poly *poly;
53620cf1dd8SToby Isaac   PetscErrorCode   ierr;
53720cf1dd8SToby Isaac 
53820cf1dd8SToby Isaac   PetscFunctionBegin;
53920cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
54020cf1dd8SToby Isaac   ierr     = PetscNewLog(sp,&poly);CHKERRQ(ierr);
54120cf1dd8SToby Isaac   sp->data = poly;
54220cf1dd8SToby Isaac 
54320cf1dd8SToby Isaac   poly->symmetric    = PETSC_FALSE;
54420cf1dd8SToby Isaac   poly->tensor       = PETSC_FALSE;
54520cf1dd8SToby Isaac   poly->degrees      = NULL;
54620cf1dd8SToby Isaac   poly->subspaces    = NULL;
54720cf1dd8SToby Isaac 
54820cf1dd8SToby Isaac   ierr = PetscSpaceInitialize_Polynomial(sp);CHKERRQ(ierr);
54920cf1dd8SToby Isaac   PetscFunctionReturn(0);
55020cf1dd8SToby Isaac }
55120cf1dd8SToby Isaac 
55220cf1dd8SToby Isaac PetscErrorCode PetscSpacePolynomialSetSymmetric(PetscSpace sp, PetscBool sym)
55320cf1dd8SToby Isaac {
55420cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
55520cf1dd8SToby Isaac 
55620cf1dd8SToby Isaac   PetscFunctionBegin;
55720cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
55820cf1dd8SToby Isaac   poly->symmetric = sym;
55920cf1dd8SToby Isaac   PetscFunctionReturn(0);
56020cf1dd8SToby Isaac }
56120cf1dd8SToby Isaac 
56220cf1dd8SToby Isaac PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
56320cf1dd8SToby Isaac {
56420cf1dd8SToby Isaac   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
56520cf1dd8SToby Isaac 
56620cf1dd8SToby Isaac   PetscFunctionBegin;
56720cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
56820cf1dd8SToby Isaac   PetscValidPointer(sym, 2);
56920cf1dd8SToby Isaac   *sym = poly->symmetric;
57020cf1dd8SToby Isaac   PetscFunctionReturn(0);
57120cf1dd8SToby Isaac }
57220cf1dd8SToby Isaac 
573