xref: /petsc/src/dm/dt/space/impls/point/spacepoint.c (revision 2f613bf53f46f9356e00a2ca2bd69453be72fc31)
1 #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/
2 #include <petsc/private/dtimpl.h> /*I "petscdt.h" I*/
3 
4 static PetscErrorCode PetscSpacePointView_Ascii(PetscSpace sp, PetscViewer viewer)
5 {
6   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
7   PetscViewerFormat format;
8   PetscErrorCode    ierr;
9 
10   PetscFunctionBegin;
11   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
12   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
13     ierr = PetscViewerASCIIPrintf(viewer, "Point space in dimension %d:\n", sp->Nv);CHKERRQ(ierr);
14     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
15     ierr = PetscQuadratureView(pt->quad, viewer);CHKERRQ(ierr);
16     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
17   } else {
18     ierr = PetscViewerASCIIPrintf(viewer, "Point space in dimension %d on %d points\n", sp->Nv, pt->quad->numPoints);CHKERRQ(ierr);
19   }
20   PetscFunctionReturn(0);
21 }
22 
23 static PetscErrorCode PetscSpaceView_Point(PetscSpace sp, PetscViewer viewer)
24 {
25   PetscBool      iascii;
26   PetscErrorCode ierr;
27 
28   PetscFunctionBegin;
29   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
30   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
31   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
32   if (iascii) {ierr = PetscSpacePointView_Ascii(sp, viewer);CHKERRQ(ierr);}
33   PetscFunctionReturn(0);
34 }
35 
36 static PetscErrorCode PetscSpaceSetUp_Point(PetscSpace sp)
37 {
38   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
39   PetscErrorCode    ierr;
40 
41   PetscFunctionBegin;
42   if (!pt->quad->points && sp->degree >= 0) {
43     ierr = PetscQuadratureDestroy(&pt->quad);CHKERRQ(ierr);
44     ierr = PetscDTStroudConicalQuadrature(sp->Nv, sp->Nc, PetscMax(sp->degree + 1, 1), -1.0, 1.0, &pt->quad);CHKERRQ(ierr);
45   }
46   PetscFunctionReturn(0);
47 }
48 
49 static PetscErrorCode PetscSpaceDestroy_Point(PetscSpace sp)
50 {
51   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
52   PetscErrorCode    ierr;
53 
54   PetscFunctionBegin;
55   ierr = PetscQuadratureDestroy(&pt->quad);CHKERRQ(ierr);
56   ierr = PetscFree(pt);CHKERRQ(ierr);
57   PetscFunctionReturn(0);
58 }
59 
60 static PetscErrorCode PetscSpaceGetDimension_Point(PetscSpace sp, PetscInt *dim)
61 {
62   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
63 
64   PetscFunctionBegin;
65   *dim = pt->quad->numPoints;
66   PetscFunctionReturn(0);
67 }
68 
69 static PetscErrorCode PetscSpaceEvaluate_Point(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
70 {
71   PetscSpace_Point *pt  = (PetscSpace_Point *) sp->data;
72   PetscInt          dim = sp->Nv, pdim = pt->quad->numPoints, d, p, i, c;
73   PetscErrorCode    ierr;
74 
75   PetscFunctionBegin;
76   if (npoints != pt->quad->numPoints) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot evaluate Point space on %d points != %d size", npoints, pt->quad->numPoints);
77   ierr = PetscArrayzero(B, npoints*pdim);CHKERRQ(ierr);
78   for (p = 0; p < npoints; ++p) {
79     for (i = 0; i < pdim; ++i) {
80       for (d = 0; d < dim; ++d) {
81         if (PetscAbsReal(points[p*dim+d] - pt->quad->points[p*dim+d]) > 1.0e-10) break;
82       }
83       if (d >= dim) {B[p*pdim+i] = 1.0; break;}
84     }
85   }
86   /* Replicate for other components */
87   for (c = 1; c < sp->Nc; ++c) {
88     for (p = 0; p < npoints; ++p) {
89       for (i = 0; i < pdim; ++i) {
90         B[(c*npoints + p)*pdim + i] = B[p*pdim + i];
91       }
92     }
93   }
94   if (D) {ierr = PetscArrayzero(D, npoints*pdim*dim);CHKERRQ(ierr);}
95   if (H) {ierr = PetscArrayzero(H, npoints*pdim*dim*dim);CHKERRQ(ierr);}
96   PetscFunctionReturn(0);
97 }
98 
99 static PetscErrorCode PetscSpaceInitialize_Point(PetscSpace sp)
100 {
101   PetscFunctionBegin;
102   sp->ops->setfromoptions = NULL;
103   sp->ops->setup          = PetscSpaceSetUp_Point;
104   sp->ops->view           = PetscSpaceView_Point;
105   sp->ops->destroy        = PetscSpaceDestroy_Point;
106   sp->ops->getdimension   = PetscSpaceGetDimension_Point;
107   sp->ops->evaluate       = PetscSpaceEvaluate_Point;
108   PetscFunctionReturn(0);
109 }
110 
111 /*MC
112   PETSCSPACEPOINT = "point" - A PetscSpace object that encapsulates functions defined on a set of quadrature points.
113 
114   Level: intermediate
115 
116 .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
117 M*/
118 
119 PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Point(PetscSpace sp)
120 {
121   PetscSpace_Point *pt;
122   PetscErrorCode    ierr;
123 
124   PetscFunctionBegin;
125   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
126   ierr     = PetscNewLog(sp,&pt);CHKERRQ(ierr);
127   sp->data = pt;
128 
129   sp->Nv = 0;
130   sp->maxDegree = PETSC_MAX_INT;
131   ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &pt->quad);CHKERRQ(ierr);
132   ierr = PetscQuadratureSetData(pt->quad, 0, 1, 0, NULL, NULL);CHKERRQ(ierr);
133 
134   ierr = PetscSpaceInitialize_Point(sp);CHKERRQ(ierr);
135   PetscFunctionReturn(0);
136 }
137 
138 /*@
139   PetscSpacePointSetPoints - Sets the evaluation points for the space to coincide with the points of a quadrature rule
140 
141   Logically collective
142 
143   Input Parameters:
144 + sp - The PetscSpace
145 - q  - The PetscQuadrature defining the points
146 
147   Level: intermediate
148 
149 .seealso: PetscSpaceCreate(), PetscSpaceSetType()
150 @*/
151 PetscErrorCode PetscSpacePointSetPoints(PetscSpace sp, PetscQuadrature q)
152 {
153   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
154   PetscErrorCode    ierr;
155 
156   PetscFunctionBegin;
157   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
158   PetscValidHeaderSpecific(q, PETSCQUADRATURE_CLASSID, 2);
159   ierr = PetscQuadratureDestroy(&pt->quad);CHKERRQ(ierr);
160   ierr = PetscQuadratureDuplicate(q, &pt->quad);CHKERRQ(ierr);
161   PetscFunctionReturn(0);
162 }
163 
164 /*@
165   PetscSpacePointGetPoints - Gets the evaluation points for the space as the points of a quadrature rule
166 
167   Logically collective
168 
169   Input Parameter:
170 . sp - The PetscSpace
171 
172   Output Parameter:
173 . q  - The PetscQuadrature defining the points
174 
175   Level: intermediate
176 
177 .seealso: PetscSpaceCreate(), PetscSpaceSetType()
178 @*/
179 PetscErrorCode PetscSpacePointGetPoints(PetscSpace sp, PetscQuadrature *q)
180 {
181   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
182 
183   PetscFunctionBegin;
184   PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 1);
185   PetscValidPointer(q, 2);
186   *q = pt->quad;
187   PetscFunctionReturn(0);
188 }
189