1 #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/ 2 #include <petscblaslapack.h> 3 4 PetscErrorCode PetscFEDestroy_Basic(PetscFE fem) 5 { 6 PetscFE_Basic *b = (PetscFE_Basic *) fem->data; 7 PetscErrorCode ierr; 8 9 PetscFunctionBegin; 10 ierr = PetscFree(b);CHKERRQ(ierr); 11 PetscFunctionReturn(0); 12 } 13 14 PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer v) 15 { 16 PetscInt dim, Nc; 17 PetscSpace basis = NULL; 18 PetscDualSpace dual = NULL; 19 PetscQuadrature quad = NULL; 20 PetscErrorCode ierr; 21 22 PetscFunctionBegin; 23 ierr = PetscFEGetSpatialDimension(fe, &dim);CHKERRQ(ierr); 24 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 25 ierr = PetscFEGetBasisSpace(fe, &basis);CHKERRQ(ierr); 26 ierr = PetscFEGetDualSpace(fe, &dual);CHKERRQ(ierr); 27 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 28 ierr = PetscViewerASCIIPushTab(v);CHKERRQ(ierr); 29 ierr = PetscViewerASCIIPrintf(v, "Basic Finite Element in %D dimensions with %D components\n",dim,Nc);CHKERRQ(ierr); 30 if (basis) {ierr = PetscSpaceView(basis, v);CHKERRQ(ierr);} 31 if (dual) {ierr = PetscDualSpaceView(dual, v);CHKERRQ(ierr);} 32 if (quad) {ierr = PetscQuadratureView(quad, v);CHKERRQ(ierr);} 33 ierr = PetscViewerASCIIPopTab(v);CHKERRQ(ierr); 34 PetscFunctionReturn(0); 35 } 36 37 PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer v) 38 { 39 PetscBool iascii; 40 PetscErrorCode ierr; 41 42 PetscFunctionBegin; 43 ierr = PetscObjectTypeCompare((PetscObject) v, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr); 44 if (iascii) {ierr = PetscFEView_Basic_Ascii(fe, v);CHKERRQ(ierr);} 45 PetscFunctionReturn(0); 46 } 47 48 /* Construct the change of basis from prime basis to nodal basis */ 49 PetscErrorCode PetscFESetUp_Basic(PetscFE fem) 50 { 51 PetscScalar *work, *invVscalar; 52 PetscBLASInt *pivots; 53 PetscBLASInt n, info; 54 PetscInt pdim, j; 55 PetscErrorCode ierr; 56 57 PetscFunctionBegin; 58 ierr = PetscDualSpaceGetDimension(fem->dualSpace, &pdim);CHKERRQ(ierr); 59 ierr = PetscMalloc1(pdim*pdim,&fem->invV);CHKERRQ(ierr); 60 #if defined(PETSC_USE_COMPLEX) 61 ierr = PetscMalloc1(pdim*pdim,&invVscalar);CHKERRQ(ierr); 62 #else 63 invVscalar = fem->invV; 64 #endif 65 for (j = 0; j < pdim; ++j) { 66 PetscReal *Bf; 67 PetscQuadrature f; 68 const PetscReal *points, *weights; 69 PetscInt Nc, Nq, q, k, c; 70 71 ierr = PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);CHKERRQ(ierr); 72 ierr = PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);CHKERRQ(ierr); 73 ierr = PetscMalloc1(Nc*Nq*pdim,&Bf);CHKERRQ(ierr); 74 ierr = PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);CHKERRQ(ierr); 75 for (k = 0; k < pdim; ++k) { 76 /* V_{jk} = n_j(\phi_k) = \int \phi_k(x) n_j(x) dx */ 77 invVscalar[j*pdim+k] = 0.0; 78 79 for (q = 0; q < Nq; ++q) { 80 for (c = 0; c < Nc; ++c) invVscalar[j*pdim+k] += Bf[(q*pdim + k)*Nc + c]*weights[q*Nc + c]; 81 } 82 } 83 ierr = PetscFree(Bf);CHKERRQ(ierr); 84 } 85 ierr = PetscMalloc2(pdim,&pivots,pdim,&work);CHKERRQ(ierr); 86 n = pdim; 87 PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, invVscalar, &n, pivots, &info)); 88 PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, invVscalar, &n, pivots, work, &n, &info)); 89 #if defined(PETSC_USE_COMPLEX) 90 for (j = 0; j < pdim*pdim; j++) fem->invV[j] = PetscRealPart(invVscalar[j]); 91 ierr = PetscFree(invVscalar);CHKERRQ(ierr); 92 #endif 93 ierr = PetscFree2(pivots,work);CHKERRQ(ierr); 94 PetscFunctionReturn(0); 95 } 96 97 PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim) 98 { 99 PetscErrorCode ierr; 100 101 PetscFunctionBegin; 102 ierr = PetscDualSpaceGetDimension(fem->dualSpace, dim);CHKERRQ(ierr); 103 PetscFunctionReturn(0); 104 } 105 106 PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H) 107 { 108 DM dm; 109 PetscInt pdim; /* Dimension of FE space P */ 110 PetscInt dim; /* Spatial dimension */ 111 PetscInt Nc; /* Field components */ 112 PetscReal *tmpB, *tmpD, *tmpH; 113 PetscInt p, d, j, k, c; 114 PetscErrorCode ierr; 115 116 PetscFunctionBegin; 117 ierr = PetscDualSpaceGetDM(fem->dualSpace, &dm);CHKERRQ(ierr); 118 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 119 ierr = PetscDualSpaceGetDimension(fem->dualSpace, &pdim);CHKERRQ(ierr); 120 ierr = PetscFEGetNumComponents(fem, &Nc);CHKERRQ(ierr); 121 /* Evaluate the prime basis functions at all points */ 122 if (B) {ierr = DMGetWorkArray(dm, npoints*pdim*Nc, MPIU_REAL, &tmpB);CHKERRQ(ierr);} 123 if (D) {ierr = DMGetWorkArray(dm, npoints*pdim*Nc*dim, MPIU_REAL, &tmpD);CHKERRQ(ierr);} 124 if (H) {ierr = DMGetWorkArray(dm, npoints*pdim*Nc*dim*dim, MPIU_REAL, &tmpH);CHKERRQ(ierr);} 125 ierr = PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);CHKERRQ(ierr); 126 /* Translate to the nodal basis */ 127 for (p = 0; p < npoints; ++p) { 128 if (B) { 129 /* Multiply by V^{-1} (pdim x pdim) */ 130 for (j = 0; j < pdim; ++j) { 131 const PetscInt i = (p*pdim + j)*Nc; 132 133 for (c = 0; c < Nc; ++c) { 134 B[i+c] = 0.0; 135 for (k = 0; k < pdim; ++k) { 136 B[i+c] += fem->invV[k*pdim+j] * tmpB[(p*pdim + k)*Nc+c]; 137 } 138 } 139 } 140 } 141 if (D) { 142 /* Multiply by V^{-1} (pdim x pdim) */ 143 for (j = 0; j < pdim; ++j) { 144 for (c = 0; c < Nc; ++c) { 145 for (d = 0; d < dim; ++d) { 146 const PetscInt i = ((p*pdim + j)*Nc + c)*dim + d; 147 148 D[i] = 0.0; 149 for (k = 0; k < pdim; ++k) { 150 D[i] += fem->invV[k*pdim+j] * tmpD[((p*pdim + k)*Nc + c)*dim + d]; 151 } 152 } 153 } 154 } 155 } 156 if (H) { 157 /* Multiply by V^{-1} (pdim x pdim) */ 158 for (j = 0; j < pdim; ++j) { 159 for (c = 0; c < Nc; ++c) { 160 for (d = 0; d < dim*dim; ++d) { 161 const PetscInt i = ((p*pdim + j)*Nc + c)*dim*dim + d; 162 163 H[i] = 0.0; 164 for (k = 0; k < pdim; ++k) { 165 H[i] += fem->invV[k*pdim+j] * tmpH[((p*pdim + k)*Nc + c)*dim*dim + d]; 166 } 167 } 168 } 169 } 170 } 171 } 172 if (B) {ierr = DMRestoreWorkArray(dm, npoints*pdim*Nc, MPIU_REAL, &tmpB);CHKERRQ(ierr);} 173 if (D) {ierr = DMRestoreWorkArray(dm, npoints*pdim*Nc*dim, MPIU_REAL, &tmpD);CHKERRQ(ierr);} 174 if (H) {ierr = DMRestoreWorkArray(dm, npoints*pdim*Nc*dim*dim, MPIU_REAL, &tmpH);CHKERRQ(ierr);} 175 PetscFunctionReturn(0); 176 } 177 178 PetscErrorCode PetscFEIntegrate_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom, 179 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[]) 180 { 181 const PetscInt debug = 0; 182 PetscPointFunc obj_func; 183 PetscQuadrature quad; 184 PetscScalar *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux; 185 const PetscScalar *constants; 186 PetscReal *x; 187 PetscReal **B, **D, **BAux = NULL, **DAux = NULL; 188 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL; 189 PetscInt dim, dE, Np, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e; 190 PetscBool isAffine; 191 const PetscReal *quadPoints, *quadWeights; 192 PetscInt qNc, Nq, q; 193 PetscErrorCode ierr; 194 195 PetscFunctionBegin; 196 ierr = PetscDSGetObjective(prob, field, &obj_func);CHKERRQ(ierr); 197 if (!obj_func) PetscFunctionReturn(0); 198 ierr = PetscFEGetSpatialDimension(fem, &dim);CHKERRQ(ierr); 199 ierr = PetscFEGetQuadrature(fem, &quad);CHKERRQ(ierr); 200 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 201 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 202 ierr = PetscDSGetDimensions(prob, &Nb);CHKERRQ(ierr); 203 ierr = PetscDSGetComponents(prob, &Nc);CHKERRQ(ierr); 204 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 205 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 206 ierr = PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);CHKERRQ(ierr); 207 ierr = PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);CHKERRQ(ierr); 208 ierr = PetscDSGetTabulation(prob, &B, &D);CHKERRQ(ierr); 209 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 210 if (probAux) { 211 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 212 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 213 ierr = PetscDSGetDimensions(probAux, &NbAux);CHKERRQ(ierr); 214 ierr = PetscDSGetComponents(probAux, &NcAux);CHKERRQ(ierr); 215 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 216 ierr = PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);CHKERRQ(ierr); 217 ierr = PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);CHKERRQ(ierr); 218 ierr = PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);CHKERRQ(ierr); 219 ierr = PetscDSGetTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr); 220 } 221 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 222 Np = cgeom->numPoints; 223 dE = cgeom->dimEmbed; 224 isAffine = cgeom->isAffine; 225 for (e = 0; e < Ne; ++e) { 226 const PetscReal *v0 = &cgeom->v[e*Np*dE]; 227 const PetscReal *J = &cgeom->J[e*Np*dE*dE]; 228 229 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 230 for (q = 0; q < Nq; ++q) { 231 PetscScalar integrand; 232 const PetscReal *v; 233 const PetscReal *invJ; 234 PetscReal detJ; 235 236 if (isAffine) { 237 CoordinatesRefToReal(dE, dim, cgeom->xi, v0, J, &quadPoints[q*dim], x); 238 v = x; 239 invJ = &cgeom->invJ[e*dE*dE]; 240 detJ = cgeom->detJ[e]; 241 } else { 242 v = &v0[q*dE]; 243 invJ = &cgeom->invJ[(e*Np+q)*dE*dE]; 244 detJ = cgeom->detJ[e*Np + q]; 245 } 246 if (debug > 1 && q < Np) { 247 ierr = PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);CHKERRQ(ierr); 248 #if !defined(PETSC_USE_COMPLEX) 249 ierr = DMPrintCellMatrix(e, "invJ", dim, dim, invJ);CHKERRQ(ierr); 250 #endif 251 } 252 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);CHKERRQ(ierr);} 253 EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL); 254 if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL); 255 obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, v, numConstants, constants, &integrand); 256 integrand *= detJ*quadWeights[q]; 257 integral[e*Nf+field] += integrand; 258 if (debug > 1) {ierr = PetscPrintf(PETSC_COMM_SELF, " int: %g %g\n", (double) PetscRealPart(integrand), (double) PetscRealPart(integral[field]));CHKERRQ(ierr);} 259 } 260 cOffset += totDim; 261 cOffsetAux += totDimAux; 262 } 263 PetscFunctionReturn(0); 264 } 265 266 PetscErrorCode PetscFEIntegrateBd_Basic(PetscFE fem, PetscDS prob, PetscInt field, 267 PetscBdPointFunc obj_func, 268 PetscInt Ne, PetscFEGeom *fgeom, const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[]) 269 { 270 const PetscInt debug = 0; 271 PetscQuadrature quad; 272 PetscScalar *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux; 273 const PetscScalar *constants; 274 PetscReal *x; 275 PetscReal **B, **D, **BAux = NULL, **DAux = NULL; 276 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL; 277 PetscBool isAffine, auxOnBd; 278 const PetscReal *quadPoints, *quadWeights; 279 PetscInt qNc, Nq, q, Np, dE; 280 PetscInt dim, dimAux, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e; 281 PetscErrorCode ierr; 282 283 PetscFunctionBegin; 284 if (!obj_func) PetscFunctionReturn(0); 285 ierr = PetscFEGetSpatialDimension(fem, &dim);CHKERRQ(ierr); 286 ierr = PetscFEGetFaceQuadrature(fem, &quad);CHKERRQ(ierr); 287 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 288 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 289 ierr = PetscDSGetDimensions(prob, &Nb);CHKERRQ(ierr); 290 ierr = PetscDSGetComponents(prob, &Nc);CHKERRQ(ierr); 291 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 292 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 293 ierr = PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);CHKERRQ(ierr); 294 ierr = PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);CHKERRQ(ierr); 295 ierr = PetscDSGetFaceTabulation(prob, &B, &D);CHKERRQ(ierr); 296 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 297 if (probAux) { 298 ierr = PetscDSGetSpatialDimension(probAux, &dimAux);CHKERRQ(ierr); 299 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 300 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 301 ierr = PetscDSGetDimensions(probAux, &NbAux);CHKERRQ(ierr); 302 ierr = PetscDSGetComponents(probAux, &NcAux);CHKERRQ(ierr); 303 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 304 ierr = PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);CHKERRQ(ierr); 305 ierr = PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);CHKERRQ(ierr); 306 ierr = PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);CHKERRQ(ierr); 307 auxOnBd = dimAux < dim ? PETSC_TRUE : PETSC_FALSE; 308 if (auxOnBd) {ierr = PetscDSGetTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr);} 309 else {ierr = PetscDSGetFaceTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr);} 310 } 311 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 312 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 313 Np = fgeom->numPoints; 314 dE = fgeom->dimEmbed; 315 isAffine = fgeom->isAffine; 316 for (e = 0; e < Ne; ++e) { 317 const PetscReal *v0 = &fgeom->v[e*Np*dE]; 318 const PetscReal *J = &fgeom->J[e*Np*dE*dE]; 319 const PetscInt face = fgeom->face[e][0]; /* Local face number in cell */ 320 321 for (q = 0; q < Nq; ++q) { 322 const PetscReal *v; 323 const PetscReal *invJ; 324 const PetscReal *n; 325 PetscReal detJ; 326 PetscScalar integrand; 327 328 if (isAffine) { 329 CoordinatesRefToReal(dE, dim-1, fgeom->xi, v0, J, &quadPoints[q*(dim-1)], x); 330 v = x; 331 invJ = &fgeom->suppInvJ[0][e*dE*dE]; 332 detJ = fgeom->detJ[e]; 333 n = &fgeom->n[e*dE]; 334 } else { 335 v = &v0[q*dE]; 336 invJ = &fgeom->suppInvJ[0][(e*Np+q)*dE*dE]; 337 detJ = fgeom->detJ[e*Np + q]; 338 n = &fgeom->n[(e*Np+q)*dE]; 339 } 340 if (debug > 1 && q < Np) { 341 ierr = PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);CHKERRQ(ierr); 342 #ifndef PETSC_USE_COMPLEX 343 ierr = DMPrintCellMatrix(e, "invJ", dim, dim, invJ);CHKERRQ(ierr); 344 #endif 345 } 346 if (debug > 1) {ierr = PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);CHKERRQ(ierr);} 347 EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL); 348 if (probAux) EvaluateFieldJets(dimAux, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL); 349 obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, v, n, numConstants, constants, &integrand); 350 integrand *= detJ*quadWeights[q]; 351 integral[e*Nf+field] += integrand; 352 if (debug > 1) {ierr = PetscPrintf(PETSC_COMM_SELF, " int: %g %g\n", (double) PetscRealPart(integrand), (double) PetscRealPart(integral[e*Nf+field]));CHKERRQ(ierr);} 353 } 354 cOffset += totDim; 355 cOffsetAux += totDimAux; 356 } 357 PetscFunctionReturn(0); 358 } 359 360 PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom, 361 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 362 { 363 const PetscInt debug = 0; 364 PetscPointFunc f0_func; 365 PetscPointFunc f1_func; 366 PetscQuadrature quad; 367 PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux; 368 const PetscScalar *constants; 369 PetscReal *x; 370 PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI; 371 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL; 372 PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI; 373 PetscInt dE, Np; 374 PetscBool isAffine; 375 const PetscReal *quadPoints, *quadWeights; 376 PetscInt qNc, Nq, q; 377 PetscErrorCode ierr; 378 379 PetscFunctionBegin; 380 ierr = PetscFEGetSpatialDimension(fem, &dim);CHKERRQ(ierr); 381 ierr = PetscFEGetQuadrature(fem, &quad);CHKERRQ(ierr); 382 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 383 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 384 ierr = PetscDSGetDimensions(prob, &Nb);CHKERRQ(ierr); 385 ierr = PetscDSGetComponents(prob, &Nc);CHKERRQ(ierr); 386 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 387 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 388 ierr = PetscDSGetFieldOffset(prob, field, &fOffset);CHKERRQ(ierr); 389 ierr = PetscDSGetResidual(prob, field, &f0_func, &f1_func);CHKERRQ(ierr); 390 ierr = PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);CHKERRQ(ierr); 391 ierr = PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);CHKERRQ(ierr); 392 ierr = PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);CHKERRQ(ierr); 393 ierr = PetscDSGetTabulation(prob, &B, &D);CHKERRQ(ierr); 394 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 395 if (probAux) { 396 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 397 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 398 ierr = PetscDSGetDimensions(probAux, &NbAux);CHKERRQ(ierr); 399 ierr = PetscDSGetComponents(probAux, &NcAux);CHKERRQ(ierr); 400 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 401 ierr = PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);CHKERRQ(ierr); 402 ierr = PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);CHKERRQ(ierr); 403 ierr = PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);CHKERRQ(ierr); 404 ierr = PetscDSGetTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr); 405 } 406 NbI = Nb[field]; 407 NcI = Nc[field]; 408 BI = B[field]; 409 DI = D[field]; 410 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 411 Np = cgeom->numPoints; 412 dE = cgeom->dimEmbed; 413 isAffine = cgeom->isAffine; 414 for (e = 0; e < Ne; ++e) { 415 const PetscReal *v0 = &cgeom->v[e*Np*dE]; 416 const PetscReal *J = &cgeom->J[e*Np*dE*dE]; 417 418 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 419 ierr = PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));CHKERRQ(ierr); 420 ierr = PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));CHKERRQ(ierr); 421 for (q = 0; q < Nq; ++q) { 422 const PetscReal *v; 423 const PetscReal *invJ; 424 PetscReal detJ; 425 426 if (isAffine) { 427 CoordinatesRefToReal(dE, dim, cgeom->xi, v0, J, &quadPoints[q*dim], x); 428 v = x; 429 invJ = &cgeom->invJ[e*dE*dE]; 430 detJ = cgeom->detJ[e]; 431 } else { 432 v = &v0[q*dE]; 433 invJ = &cgeom->invJ[(e*Np+q)*dE*dE]; 434 detJ = cgeom->detJ[e*Np + q]; 435 } 436 if (debug > 1 && q < Np) { 437 ierr = PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);CHKERRQ(ierr); 438 #if !defined(PETSC_USE_COMPLEX) 439 ierr = DMPrintCellMatrix(e, "invJ", dim, dim, invJ);CHKERRQ(ierr); 440 #endif 441 } 442 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);CHKERRQ(ierr);} 443 EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t); 444 if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL); 445 if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, numConstants, constants, &f0[q*NcI]); 446 if (f1_func) { 447 ierr = PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));CHKERRQ(ierr); 448 f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, numConstants, constants, refSpaceDer); 449 } 450 TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL); 451 } 452 UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]); 453 cOffset += totDim; 454 cOffsetAux += totDimAux; 455 } 456 PetscFunctionReturn(0); 457 } 458 459 PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *fgeom, 460 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 461 { 462 const PetscInt debug = 0; 463 PetscBdPointFunc f0_func; 464 PetscBdPointFunc f1_func; 465 PetscQuadrature quad; 466 PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux; 467 const PetscScalar *constants; 468 PetscReal *x; 469 PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI; 470 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL; 471 PetscInt dim, dimAux, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI; 472 PetscBool isAffine, auxOnBd = PETSC_FALSE; 473 const PetscReal *quadPoints, *quadWeights; 474 PetscInt qNc, Nq, q, Np, dE; 475 PetscErrorCode ierr; 476 477 PetscFunctionBegin; 478 ierr = PetscFEGetSpatialDimension(fem, &dim);CHKERRQ(ierr); 479 ierr = PetscFEGetFaceQuadrature(fem, &quad);CHKERRQ(ierr); 480 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 481 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 482 ierr = PetscDSGetDimensions(prob, &Nb);CHKERRQ(ierr); 483 ierr = PetscDSGetComponents(prob, &Nc);CHKERRQ(ierr); 484 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 485 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 486 ierr = PetscDSGetFieldOffset(prob, field, &fOffset);CHKERRQ(ierr); 487 ierr = PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);CHKERRQ(ierr); 488 if (!f0_func && !f1_func) PetscFunctionReturn(0); 489 ierr = PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);CHKERRQ(ierr); 490 ierr = PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);CHKERRQ(ierr); 491 ierr = PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);CHKERRQ(ierr); 492 ierr = PetscDSGetFaceTabulation(prob, &B, &D);CHKERRQ(ierr); 493 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 494 if (probAux) { 495 ierr = PetscDSGetSpatialDimension(probAux, &dimAux);CHKERRQ(ierr); 496 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 497 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 498 ierr = PetscDSGetDimensions(probAux, &NbAux);CHKERRQ(ierr); 499 ierr = PetscDSGetComponents(probAux, &NcAux);CHKERRQ(ierr); 500 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 501 ierr = PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);CHKERRQ(ierr); 502 ierr = PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);CHKERRQ(ierr); 503 ierr = PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);CHKERRQ(ierr); 504 auxOnBd = dimAux < dim ? PETSC_TRUE : PETSC_FALSE; 505 if (auxOnBd) {ierr = PetscDSGetTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr);} 506 else {ierr = PetscDSGetFaceTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr);} 507 } 508 NbI = Nb[field]; 509 NcI = Nc[field]; 510 BI = B[field]; 511 DI = D[field]; 512 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 513 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 514 Np = fgeom->numPoints; 515 dE = fgeom->dimEmbed; 516 isAffine = fgeom->isAffine; 517 for (e = 0; e < Ne; ++e) { 518 const PetscReal *v0 = &fgeom->v[e*Np*dE]; 519 const PetscReal *J = &fgeom->J[e*Np*dE*dE]; 520 const PetscInt face = fgeom->face[e][0]; 521 522 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 523 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 524 ierr = PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));CHKERRQ(ierr); 525 ierr = PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));CHKERRQ(ierr); 526 for (q = 0; q < Nq; ++q) { 527 const PetscReal *v; 528 const PetscReal *invJ; 529 const PetscReal *n; 530 PetscReal detJ; 531 if (isAffine) { 532 CoordinatesRefToReal(dE, dim-1, fgeom->xi, v0, J, &quadPoints[q*(dim-1)], x); 533 v = x; 534 invJ = &fgeom->suppInvJ[0][e*dE*dE]; 535 detJ = fgeom->detJ[e]; 536 n = &fgeom->n[e*dE]; 537 } else { 538 v = &v0[q*dE]; 539 invJ = &fgeom->suppInvJ[0][(e*Np+q)*dE*dE]; 540 detJ = fgeom->detJ[e*Np + q]; 541 n = &fgeom->n[(e*Np+q)*dE]; 542 } 543 if (debug > 1 && q < Np) { 544 ierr = PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);CHKERRQ(ierr); 545 #if !defined(PETSC_USE_COMPLEX) 546 ierr = DMPrintCellMatrix(e, "invJ", dim, dim, invJ);CHKERRQ(ierr); 547 #endif 548 } 549 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);CHKERRQ(ierr);} 550 EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t); 551 if (probAux) EvaluateFieldJets(dimAux, NfAux, NbAux, NcAux, auxOnBd ? q : face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL); 552 if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, n, numConstants, constants, &f0[q*NcI]); 553 if (f1_func) { 554 ierr = PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));CHKERRQ(ierr); 555 f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, n, numConstants, constants, refSpaceDer); 556 } 557 TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL); 558 } 559 UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]); 560 cOffset += totDim; 561 cOffsetAux += totDimAux; 562 } 563 PetscFunctionReturn(0); 564 } 565 566 PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *geom, 567 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 568 { 569 const PetscInt debug = 0; 570 PetscPointJac g0_func; 571 PetscPointJac g1_func; 572 PetscPointJac g2_func; 573 PetscPointJac g3_func; 574 PetscInt cOffset = 0; /* Offset into coefficients[] for element e */ 575 PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */ 576 PetscInt eOffset = 0; /* Offset into elemMat[] for element e */ 577 PetscInt offsetI = 0; /* Offset into an element vector for fieldI */ 578 PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */ 579 PetscQuadrature quad; 580 PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux; 581 const PetscScalar *constants; 582 PetscReal *x; 583 PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ; 584 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL; 585 PetscInt NbI = 0, NcI = 0, NbJ = 0, NcJ = 0; 586 PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e; 587 PetscInt dE, Np; 588 PetscBool isAffine; 589 const PetscReal *quadPoints, *quadWeights; 590 PetscInt qNc, Nq, q; 591 PetscErrorCode ierr; 592 593 PetscFunctionBegin; 594 ierr = PetscFEGetSpatialDimension(fem, &dim);CHKERRQ(ierr); 595 ierr = PetscFEGetQuadrature(fem, &quad);CHKERRQ(ierr); 596 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 597 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 598 ierr = PetscDSGetDimensions(prob, &Nb);CHKERRQ(ierr); 599 ierr = PetscDSGetComponents(prob, &Nc);CHKERRQ(ierr); 600 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 601 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 602 switch(jtype) { 603 case PETSCFE_JACOBIAN_DYN: ierr = PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);CHKERRQ(ierr);break; 604 case PETSCFE_JACOBIAN_PRE: ierr = PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);CHKERRQ(ierr);break; 605 case PETSCFE_JACOBIAN: ierr = PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);CHKERRQ(ierr);break; 606 } 607 if (!g0_func && !g1_func && !g2_func && !g3_func) PetscFunctionReturn(0); 608 ierr = PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);CHKERRQ(ierr); 609 ierr = PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);CHKERRQ(ierr); 610 ierr = PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);CHKERRQ(ierr); 611 ierr = PetscDSGetTabulation(prob, &B, &D);CHKERRQ(ierr); 612 ierr = PetscDSGetFieldOffset(prob, fieldI, &offsetI);CHKERRQ(ierr); 613 ierr = PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);CHKERRQ(ierr); 614 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 615 if (probAux) { 616 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 617 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 618 ierr = PetscDSGetDimensions(probAux, &NbAux);CHKERRQ(ierr); 619 ierr = PetscDSGetComponents(probAux, &NcAux);CHKERRQ(ierr); 620 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 621 ierr = PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);CHKERRQ(ierr); 622 ierr = PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);CHKERRQ(ierr); 623 ierr = PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);CHKERRQ(ierr); 624 ierr = PetscDSGetTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr); 625 } 626 NbI = Nb[fieldI], NbJ = Nb[fieldJ]; 627 NcI = Nc[fieldI], NcJ = Nc[fieldJ]; 628 BI = B[fieldI], BJ = B[fieldJ]; 629 DI = D[fieldI], DJ = D[fieldJ]; 630 /* Initialize here in case the function is not defined */ 631 ierr = PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));CHKERRQ(ierr); 632 ierr = PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 633 ierr = PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 634 ierr = PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));CHKERRQ(ierr); 635 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 636 Np = geom->numPoints; 637 dE = geom->dimEmbed; 638 isAffine = geom->isAffine; 639 for (e = 0; e < Ne; ++e) { 640 const PetscReal *v0 = &geom->v[e*Np*dE]; 641 const PetscReal *J = &geom->J[e*Np*dE*dE]; 642 643 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 644 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 645 for (q = 0; q < Nq; ++q) { 646 const PetscReal *v; 647 const PetscReal *invJ; 648 PetscReal detJ; 649 const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ]; 650 const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim]; 651 PetscReal w; 652 PetscInt f, g, fc, gc, c; 653 654 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);CHKERRQ(ierr);} 655 if (isAffine) { 656 CoordinatesRefToReal(dE, dim, geom->xi, v0, J, &quadPoints[q*dim], x); 657 v = x; 658 invJ = &geom->invJ[e*dE*dE]; 659 detJ = geom->detJ[e]; 660 } else { 661 v = &v0[q*dE]; 662 invJ = &geom->invJ[(e*Np+q)*dE*dE]; 663 detJ = geom->detJ[e*Np + q]; 664 } 665 w = detJ*quadWeights[q]; 666 if (coefficients) EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t); 667 if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL); 668 if (g0_func) { 669 ierr = PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));CHKERRQ(ierr); 670 g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, g0); 671 for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w; 672 } 673 if (g1_func) { 674 PetscInt d, d2; 675 ierr = PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 676 g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, refSpaceDer); 677 for (fc = 0; fc < NcI; ++fc) { 678 for (gc = 0; gc < NcJ; ++gc) { 679 for (d = 0; d < dim; ++d) { 680 g1[(fc*NcJ+gc)*dim+d] = 0.0; 681 for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2]; 682 g1[(fc*NcJ+gc)*dim+d] *= w; 683 } 684 } 685 } 686 } 687 if (g2_func) { 688 PetscInt d, d2; 689 ierr = PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 690 g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, refSpaceDer); 691 for (fc = 0; fc < NcI; ++fc) { 692 for (gc = 0; gc < NcJ; ++gc) { 693 for (d = 0; d < dim; ++d) { 694 g2[(fc*NcJ+gc)*dim+d] = 0.0; 695 for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2]; 696 g2[(fc*NcJ+gc)*dim+d] *= w; 697 } 698 } 699 } 700 } 701 if (g3_func) { 702 PetscInt d, d2, dp, d3; 703 ierr = PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));CHKERRQ(ierr); 704 g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, refSpaceDer); 705 for (fc = 0; fc < NcI; ++fc) { 706 for (gc = 0; gc < NcJ; ++gc) { 707 for (d = 0; d < dim; ++d) { 708 for (dp = 0; dp < dim; ++dp) { 709 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0; 710 for (d2 = 0; d2 < dim; ++d2) { 711 for (d3 = 0; d3 < dim; ++d3) { 712 g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3]; 713 } 714 } 715 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w; 716 } 717 } 718 } 719 } 720 } 721 722 for (f = 0; f < NbI; ++f) { 723 for (fc = 0; fc < NcI; ++fc) { 724 const PetscInt fidx = f*NcI+fc; /* Test function basis index */ 725 const PetscInt i = offsetI+f; /* Element matrix row */ 726 for (g = 0; g < NbJ; ++g) { 727 for (gc = 0; gc < NcJ; ++gc) { 728 const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */ 729 const PetscInt j = offsetJ+g; /* Element matrix column */ 730 const PetscInt fOff = eOffset+i*totDim+j; 731 PetscInt d, d2; 732 733 elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx]; 734 for (d = 0; d < dim; ++d) { 735 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d]; 736 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx]; 737 for (d2 = 0; d2 < dim; ++d2) { 738 elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2]; 739 } 740 } 741 } 742 } 743 } 744 } 745 } 746 if (debug > 1) { 747 PetscInt fc, f, gc, g; 748 749 ierr = PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);CHKERRQ(ierr); 750 for (fc = 0; fc < NcI; ++fc) { 751 for (f = 0; f < NbI; ++f) { 752 const PetscInt i = offsetI + f*NcI+fc; 753 for (gc = 0; gc < NcJ; ++gc) { 754 for (g = 0; g < NbJ; ++g) { 755 const PetscInt j = offsetJ + g*NcJ+gc; 756 ierr = PetscPrintf(PETSC_COMM_SELF, " elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));CHKERRQ(ierr); 757 } 758 } 759 ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr); 760 } 761 } 762 } 763 cOffset += totDim; 764 cOffsetAux += totDimAux; 765 eOffset += PetscSqr(totDim); 766 } 767 PetscFunctionReturn(0); 768 } 769 770 PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *fgeom, 771 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 772 { 773 const PetscInt debug = 0; 774 PetscBdPointJac g0_func; 775 PetscBdPointJac g1_func; 776 PetscBdPointJac g2_func; 777 PetscBdPointJac g3_func; 778 PetscInt cOffset = 0; /* Offset into coefficients[] for element e */ 779 PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */ 780 PetscInt eOffset = 0; /* Offset into elemMat[] for element e */ 781 PetscInt offsetI = 0; /* Offset into an element vector for fieldI */ 782 PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */ 783 PetscQuadrature quad; 784 PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux; 785 const PetscScalar *constants; 786 PetscReal *x; 787 PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ; 788 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL; 789 PetscInt NbI = 0, NcI = 0, NbJ = 0, NcJ = 0; 790 PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e; 791 PetscBool isAffine; 792 const PetscReal *quadPoints, *quadWeights; 793 PetscInt qNc, Nq, q, Np, dE; 794 PetscErrorCode ierr; 795 796 PetscFunctionBegin; 797 ierr = PetscFEGetSpatialDimension(fem, &dim);CHKERRQ(ierr); 798 ierr = PetscFEGetFaceQuadrature(fem, &quad);CHKERRQ(ierr); 799 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 800 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 801 ierr = PetscDSGetDimensions(prob, &Nb);CHKERRQ(ierr); 802 ierr = PetscDSGetComponents(prob, &Nc);CHKERRQ(ierr); 803 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 804 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 805 ierr = PetscDSGetFieldOffset(prob, fieldI, &offsetI);CHKERRQ(ierr); 806 ierr = PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);CHKERRQ(ierr); 807 ierr = PetscDSGetBdJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);CHKERRQ(ierr); 808 ierr = PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);CHKERRQ(ierr); 809 ierr = PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);CHKERRQ(ierr); 810 ierr = PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);CHKERRQ(ierr); 811 ierr = PetscDSGetFaceTabulation(prob, &B, &D);CHKERRQ(ierr); 812 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 813 if (probAux) { 814 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 815 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 816 ierr = PetscDSGetDimensions(probAux, &NbAux);CHKERRQ(ierr); 817 ierr = PetscDSGetComponents(probAux, &NcAux);CHKERRQ(ierr); 818 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 819 ierr = PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);CHKERRQ(ierr); 820 ierr = PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);CHKERRQ(ierr); 821 ierr = PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);CHKERRQ(ierr); 822 ierr = PetscDSGetFaceTabulation(probAux, &BAux, &DAux);CHKERRQ(ierr); 823 } 824 NbI = Nb[fieldI], NbJ = Nb[fieldJ]; 825 NcI = Nc[fieldI], NcJ = Nc[fieldJ]; 826 BI = B[fieldI], BJ = B[fieldJ]; 827 DI = D[fieldI], DJ = D[fieldJ]; 828 /* Initialize here in case the function is not defined */ 829 ierr = PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));CHKERRQ(ierr); 830 ierr = PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 831 ierr = PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 832 ierr = PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));CHKERRQ(ierr); 833 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 834 Np = fgeom->numPoints; 835 dE = fgeom->dimEmbed; 836 isAffine = fgeom->isAffine; 837 for (e = 0; e < Ne; ++e) { 838 const PetscReal *v0 = &fgeom->v[e*Np*dE]; 839 const PetscReal *J = &fgeom->J[e*Np*dE*dE]; 840 const PetscInt face = fgeom->face[e][0]; 841 842 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 843 if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc); 844 for (q = 0; q < Nq; ++q) { 845 const PetscReal *BIq = &BI[(face*Nq+q)*NbI*NcI], *BJq = &BJ[(face*Nq+q)*NbJ*NcJ]; 846 const PetscReal *DIq = &DI[(face*Nq+q)*NbI*NcI*dim], *DJq = &DJ[(face*Nq+q)*NbJ*NcJ*dim]; 847 PetscReal w; 848 PetscInt f, g, fc, gc, c; 849 const PetscReal *v; 850 const PetscReal *invJ; 851 const PetscReal *n; 852 PetscReal detJ; 853 854 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);CHKERRQ(ierr);} 855 if (isAffine) { 856 CoordinatesRefToReal(dE, dim-1, fgeom->xi, v0, J, &quadPoints[q*(dim-1)], x); 857 v = x; 858 invJ = &fgeom->suppInvJ[0][e*dE*dE]; 859 detJ = fgeom->detJ[e]; 860 n = &fgeom->n[e*dE]; 861 } else { 862 v = &v0[q*dE]; 863 invJ = &fgeom->suppInvJ[0][(e*Np+q)*dE*dE]; 864 detJ = fgeom->detJ[e*Np + q]; 865 n = &fgeom->n[(e*Np+q)*dE]; 866 } 867 w = detJ*quadWeights[q]; 868 869 if (coefficients) EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t); 870 if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL); 871 if (g0_func) { 872 ierr = PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));CHKERRQ(ierr); 873 g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, g0); 874 for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w; 875 } 876 if (g1_func) { 877 PetscInt d, d2; 878 ierr = PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 879 g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, refSpaceDer); 880 for (fc = 0; fc < NcI; ++fc) { 881 for (gc = 0; gc < NcJ; ++gc) { 882 for (d = 0; d < dim; ++d) { 883 g1[(fc*NcJ+gc)*dim+d] = 0.0; 884 for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2]; 885 g1[(fc*NcJ+gc)*dim+d] *= w; 886 } 887 } 888 } 889 } 890 if (g2_func) { 891 PetscInt d, d2; 892 ierr = PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));CHKERRQ(ierr); 893 g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, refSpaceDer); 894 for (fc = 0; fc < NcI; ++fc) { 895 for (gc = 0; gc < NcJ; ++gc) { 896 for (d = 0; d < dim; ++d) { 897 g2[(fc*NcJ+gc)*dim+d] = 0.0; 898 for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2]; 899 g2[(fc*NcJ+gc)*dim+d] *= w; 900 } 901 } 902 } 903 } 904 if (g3_func) { 905 PetscInt d, d2, dp, d3; 906 ierr = PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));CHKERRQ(ierr); 907 g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, refSpaceDer); 908 for (fc = 0; fc < NcI; ++fc) { 909 for (gc = 0; gc < NcJ; ++gc) { 910 for (d = 0; d < dim; ++d) { 911 for (dp = 0; dp < dim; ++dp) { 912 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0; 913 for (d2 = 0; d2 < dim; ++d2) { 914 for (d3 = 0; d3 < dim; ++d3) { 915 g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3]; 916 } 917 } 918 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w; 919 } 920 } 921 } 922 } 923 } 924 925 for (f = 0; f < NbI; ++f) { 926 for (fc = 0; fc < NcI; ++fc) { 927 const PetscInt fidx = f*NcI+fc; /* Test function basis index */ 928 const PetscInt i = offsetI+f; /* Element matrix row */ 929 for (g = 0; g < NbJ; ++g) { 930 for (gc = 0; gc < NcJ; ++gc) { 931 const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */ 932 const PetscInt j = offsetJ+g; /* Element matrix column */ 933 const PetscInt fOff = eOffset+i*totDim+j; 934 PetscInt d, d2; 935 936 elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx]; 937 for (d = 0; d < dim; ++d) { 938 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d]; 939 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx]; 940 for (d2 = 0; d2 < dim; ++d2) { 941 elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2]; 942 } 943 } 944 } 945 } 946 } 947 } 948 } 949 if (debug > 1) { 950 PetscInt fc, f, gc, g; 951 952 ierr = PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);CHKERRQ(ierr); 953 for (fc = 0; fc < NcI; ++fc) { 954 for (f = 0; f < NbI; ++f) { 955 const PetscInt i = offsetI + f*NcI+fc; 956 for (gc = 0; gc < NcJ; ++gc) { 957 for (g = 0; g < NbJ; ++g) { 958 const PetscInt j = offsetJ + g*NcJ+gc; 959 ierr = PetscPrintf(PETSC_COMM_SELF, " elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));CHKERRQ(ierr); 960 } 961 } 962 ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr); 963 } 964 } 965 } 966 cOffset += totDim; 967 cOffsetAux += totDimAux; 968 eOffset += PetscSqr(totDim); 969 } 970 PetscFunctionReturn(0); 971 } 972 973 PetscErrorCode PetscFEInitialize_Basic(PetscFE fem) 974 { 975 PetscFunctionBegin; 976 fem->ops->setfromoptions = NULL; 977 fem->ops->setup = PetscFESetUp_Basic; 978 fem->ops->view = PetscFEView_Basic; 979 fem->ops->destroy = PetscFEDestroy_Basic; 980 fem->ops->getdimension = PetscFEGetDimension_Basic; 981 fem->ops->gettabulation = PetscFEGetTabulation_Basic; 982 fem->ops->integrate = PetscFEIntegrate_Basic; 983 fem->ops->integratebd = PetscFEIntegrateBd_Basic; 984 fem->ops->integrateresidual = PetscFEIntegrateResidual_Basic; 985 fem->ops->integratebdresidual = PetscFEIntegrateBdResidual_Basic; 986 fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */; 987 fem->ops->integratejacobian = PetscFEIntegrateJacobian_Basic; 988 fem->ops->integratebdjacobian = PetscFEIntegrateBdJacobian_Basic; 989 PetscFunctionReturn(0); 990 } 991 992 /*MC 993 PETSCFEBASIC = "basic" - A PetscFE object that integrates with basic tiling and no vectorization 994 995 Level: intermediate 996 997 .seealso: PetscFEType, PetscFECreate(), PetscFESetType() 998 M*/ 999 1000 PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem) 1001 { 1002 PetscFE_Basic *b; 1003 PetscErrorCode ierr; 1004 1005 PetscFunctionBegin; 1006 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 1007 ierr = PetscNewLog(fem,&b);CHKERRQ(ierr); 1008 fem->data = b; 1009 1010 ierr = PetscFEInitialize_Basic(fem);CHKERRQ(ierr); 1011 PetscFunctionReturn(0); 1012 } 1013 1014 1015