1 #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/ 2 #include <petscblaslapack.h> 3 4 static PetscErrorCode PetscFEDestroy_Basic(PetscFE fem) 5 { 6 PetscFE_Basic *b = (PetscFE_Basic *)fem->data; 7 8 PetscFunctionBegin; 9 PetscCall(PetscFree(b)); 10 PetscFunctionReturn(PETSC_SUCCESS); 11 } 12 13 static PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer v) 14 { 15 PetscInt dim, Nc; 16 PetscSpace basis = NULL; 17 PetscDualSpace dual = NULL; 18 PetscQuadrature quad = NULL; 19 20 PetscFunctionBegin; 21 PetscCall(PetscFEGetSpatialDimension(fe, &dim)); 22 PetscCall(PetscFEGetNumComponents(fe, &Nc)); 23 PetscCall(PetscFEGetBasisSpace(fe, &basis)); 24 PetscCall(PetscFEGetDualSpace(fe, &dual)); 25 PetscCall(PetscFEGetQuadrature(fe, &quad)); 26 PetscCall(PetscViewerASCIIPushTab(v)); 27 PetscCall(PetscViewerASCIIPrintf(v, "Basic Finite Element in %" PetscInt_FMT " dimensions with %" PetscInt_FMT " components\n", dim, Nc)); 28 if (basis) PetscCall(PetscSpaceView(basis, v)); 29 if (dual) PetscCall(PetscDualSpaceView(dual, v)); 30 if (quad) PetscCall(PetscQuadratureView(quad, v)); 31 PetscCall(PetscViewerASCIIPopTab(v)); 32 PetscFunctionReturn(PETSC_SUCCESS); 33 } 34 35 static PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer v) 36 { 37 PetscBool iascii; 38 39 PetscFunctionBegin; 40 PetscCall(PetscObjectTypeCompare((PetscObject)v, PETSCVIEWERASCII, &iascii)); 41 if (iascii) PetscCall(PetscFEView_Basic_Ascii(fe, v)); 42 PetscFunctionReturn(PETSC_SUCCESS); 43 } 44 45 /* Construct the change of basis from prime basis to nodal basis */ 46 PETSC_INTERN PetscErrorCode PetscFESetUp_Basic(PetscFE fem) 47 { 48 PetscReal *work; 49 PetscBLASInt *pivots; 50 PetscBLASInt n, info; 51 PetscInt pdim, j; 52 53 PetscFunctionBegin; 54 PetscCall(PetscDualSpaceGetDimension(fem->dualSpace, &pdim)); 55 PetscCall(PetscMalloc1(pdim * pdim, &fem->invV)); 56 for (j = 0; j < pdim; ++j) { 57 PetscReal *Bf; 58 PetscQuadrature f; 59 const PetscReal *points, *weights; 60 PetscInt Nc, Nq, q, k, c; 61 62 PetscCall(PetscDualSpaceGetFunctional(fem->dualSpace, j, &f)); 63 PetscCall(PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights)); 64 PetscCall(PetscMalloc1(Nc * Nq * pdim, &Bf)); 65 PetscCall(PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL)); 66 for (k = 0; k < pdim; ++k) { 67 /* V_{jk} = n_j(\phi_k) = \int \phi_k(x) n_j(x) dx */ 68 fem->invV[j * pdim + k] = 0.0; 69 70 for (q = 0; q < Nq; ++q) { 71 for (c = 0; c < Nc; ++c) fem->invV[j * pdim + k] += Bf[(q * pdim + k) * Nc + c] * weights[q * Nc + c]; 72 } 73 } 74 PetscCall(PetscFree(Bf)); 75 } 76 77 PetscCall(PetscMalloc2(pdim, &pivots, pdim, &work)); 78 n = pdim; 79 PetscCallBLAS("LAPACKgetrf", LAPACKREALgetrf_(&n, &n, fem->invV, &n, pivots, &info)); 80 PetscCheck(!info, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error returned from LAPACKgetrf %" PetscInt_FMT, (PetscInt)info); 81 PetscCallBLAS("LAPACKgetri", LAPACKREALgetri_(&n, fem->invV, &n, pivots, work, &n, &info)); 82 PetscCheck(!info, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error returned from LAPACKgetri %" PetscInt_FMT, (PetscInt)info); 83 PetscCall(PetscFree2(pivots, work)); 84 PetscFunctionReturn(PETSC_SUCCESS); 85 } 86 87 PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim) 88 { 89 PetscFunctionBegin; 90 PetscCall(PetscDualSpaceGetDimension(fem->dualSpace, dim)); 91 PetscFunctionReturn(PETSC_SUCCESS); 92 } 93 94 /* Tensor contraction on the middle index, 95 * C[m,n,p] = A[m,k,p] * B[k,n] 96 * where all matrices use C-style ordering. 97 */ 98 static PetscErrorCode TensorContract_Private(PetscInt m, PetscInt n, PetscInt p, PetscInt k, const PetscReal *A, const PetscReal *B, PetscReal *C) 99 { 100 PetscInt i; 101 102 PetscFunctionBegin; 103 PetscCheck(n && p, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Empty tensor is not allowed %" PetscInt_FMT " %" PetscInt_FMT, n, p); 104 for (i = 0; i < m; i++) { 105 PetscBLASInt n_, p_, k_, lda, ldb, ldc; 106 PetscReal one = 1, zero = 0; 107 /* Taking contiguous submatrices, we wish to comput c[n,p] = a[k,p] * B[k,n] 108 * or, in Fortran ordering, c(p,n) = a(p,k) * B(n,k) 109 */ 110 PetscCall(PetscBLASIntCast(n, &n_)); 111 PetscCall(PetscBLASIntCast(p, &p_)); 112 PetscCall(PetscBLASIntCast(k, &k_)); 113 lda = p_; 114 ldb = n_; 115 ldc = p_; 116 PetscCallBLAS("BLASgemm", BLASREALgemm_("N", "T", &p_, &n_, &k_, &one, A + i * k * p, &lda, B, &ldb, &zero, C + i * n * p, &ldc)); 117 } 118 PetscCall(PetscLogFlops(2. * m * n * p * k)); 119 PetscFunctionReturn(PETSC_SUCCESS); 120 } 121 122 PETSC_INTERN PetscErrorCode PetscFECreateTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscInt K, PetscTabulation T) 123 { 124 DM dm; 125 PetscInt pdim; /* Dimension of FE space P */ 126 PetscInt dim; /* Spatial dimension */ 127 PetscInt Nc; /* Field components */ 128 PetscReal *B = K >= 0 ? T->T[0] : NULL; 129 PetscReal *D = K >= 1 ? T->T[1] : NULL; 130 PetscReal *H = K >= 2 ? T->T[2] : NULL; 131 PetscReal *tmpB = NULL, *tmpD = NULL, *tmpH = NULL; 132 133 PetscFunctionBegin; 134 PetscCall(PetscDualSpaceGetDM(fem->dualSpace, &dm)); 135 PetscCall(DMGetDimension(dm, &dim)); 136 PetscCall(PetscDualSpaceGetDimension(fem->dualSpace, &pdim)); 137 PetscCall(PetscFEGetNumComponents(fem, &Nc)); 138 /* Evaluate the prime basis functions at all points */ 139 if (K >= 0) PetscCall(DMGetWorkArray(dm, npoints * pdim * Nc, MPIU_REAL, &tmpB)); 140 if (K >= 1) PetscCall(DMGetWorkArray(dm, npoints * pdim * Nc * dim, MPIU_REAL, &tmpD)); 141 if (K >= 2) PetscCall(DMGetWorkArray(dm, npoints * pdim * Nc * dim * dim, MPIU_REAL, &tmpH)); 142 PetscCall(PetscSpaceEvaluate(fem->basisSpace, npoints, points, tmpB, tmpD, tmpH)); 143 /* Translate from prime to nodal basis */ 144 if (B) { 145 /* B[npoints, nodes, Nc] = tmpB[npoints, prime, Nc] * invV[prime, nodes] */ 146 PetscCall(TensorContract_Private(npoints, pdim, Nc, pdim, tmpB, fem->invV, B)); 147 } 148 if (D && dim) { 149 /* D[npoints, nodes, Nc, dim] = tmpD[npoints, prime, Nc, dim] * invV[prime, nodes] */ 150 PetscCall(TensorContract_Private(npoints, pdim, Nc * dim, pdim, tmpD, fem->invV, D)); 151 } 152 if (H && dim) { 153 /* H[npoints, nodes, Nc, dim, dim] = tmpH[npoints, prime, Nc, dim, dim] * invV[prime, nodes] */ 154 PetscCall(TensorContract_Private(npoints, pdim, Nc * dim * dim, pdim, tmpH, fem->invV, H)); 155 } 156 if (K >= 0) PetscCall(DMRestoreWorkArray(dm, npoints * pdim * Nc, MPIU_REAL, &tmpB)); 157 if (K >= 1) PetscCall(DMRestoreWorkArray(dm, npoints * pdim * Nc * dim, MPIU_REAL, &tmpD)); 158 if (K >= 2) PetscCall(DMRestoreWorkArray(dm, npoints * pdim * Nc * dim * dim, MPIU_REAL, &tmpH)); 159 PetscFunctionReturn(PETSC_SUCCESS); 160 } 161 162 PETSC_INTERN PetscErrorCode PetscFEIntegrate_Basic(PetscDS ds, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom, const PetscScalar coefficients[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscScalar integral[]) 163 { 164 const PetscInt debug = 0; 165 PetscFE fe; 166 PetscPointFunc obj_func; 167 PetscQuadrature quad; 168 PetscTabulation *T, *TAux = NULL; 169 PetscScalar *u, *u_x, *a, *a_x; 170 const PetscScalar *constants; 171 PetscReal *x; 172 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 173 PetscInt dim, dE, Np, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e; 174 PetscBool isAffine; 175 const PetscReal *quadPoints, *quadWeights; 176 PetscInt qNc, Nq, q; 177 178 PetscFunctionBegin; 179 PetscCall(PetscDSGetObjective(ds, field, &obj_func)); 180 if (!obj_func) PetscFunctionReturn(PETSC_SUCCESS); 181 PetscCall(PetscDSGetDiscretization(ds, field, (PetscObject *)&fe)); 182 PetscCall(PetscFEGetSpatialDimension(fe, &dim)); 183 PetscCall(PetscFEGetQuadrature(fe, &quad)); 184 PetscCall(PetscDSGetNumFields(ds, &Nf)); 185 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 186 PetscCall(PetscDSGetComponentOffsets(ds, &uOff)); 187 PetscCall(PetscDSGetComponentDerivativeOffsets(ds, &uOff_x)); 188 PetscCall(PetscDSGetTabulation(ds, &T)); 189 PetscCall(PetscDSGetEvaluationArrays(ds, &u, NULL, &u_x)); 190 PetscCall(PetscDSGetWorkspace(ds, &x, NULL, NULL, NULL, NULL)); 191 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 192 if (dsAux) { 193 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 194 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 195 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 196 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 197 PetscCall(PetscDSGetTabulation(dsAux, &TAux)); 198 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 199 PetscCheck(T[0]->Np == TAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", T[0]->Np, TAux[0]->Np); 200 } 201 PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights)); 202 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 203 Np = cgeom->numPoints; 204 dE = cgeom->dimEmbed; 205 isAffine = cgeom->isAffine; 206 for (e = 0; e < Ne; ++e) { 207 PetscFEGeom fegeom; 208 209 fegeom.dim = cgeom->dim; 210 fegeom.dimEmbed = cgeom->dimEmbed; 211 if (isAffine) { 212 fegeom.v = x; 213 fegeom.xi = cgeom->xi; 214 fegeom.J = &cgeom->J[e * Np * dE * dE]; 215 fegeom.invJ = &cgeom->invJ[e * Np * dE * dE]; 216 fegeom.detJ = &cgeom->detJ[e * Np]; 217 } 218 for (q = 0; q < Nq; ++q) { 219 PetscScalar integrand; 220 PetscReal w; 221 222 if (isAffine) { 223 CoordinatesRefToReal(dE, dim, fegeom.xi, &cgeom->v[e * Np * dE], fegeom.J, &quadPoints[q * dim], x); 224 } else { 225 fegeom.v = &cgeom->v[(e * Np + q) * dE]; 226 fegeom.J = &cgeom->J[(e * Np + q) * dE * dE]; 227 fegeom.invJ = &cgeom->invJ[(e * Np + q) * dE * dE]; 228 fegeom.detJ = &cgeom->detJ[e * Np + q]; 229 } 230 w = fegeom.detJ[0] * quadWeights[q]; 231 if (debug > 1 && q < Np) { 232 PetscCall(PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", (double)fegeom.detJ[0])); 233 #if !defined(PETSC_USE_COMPLEX) 234 PetscCall(DMPrintCellMatrix(e, "invJ", dim, dim, fegeom.invJ)); 235 #endif 236 } 237 if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT "\n", q)); 238 PetscCall(PetscFEEvaluateFieldJets_Internal(ds, Nf, 0, q, T, &fegeom, &coefficients[cOffset], NULL, u, u_x, NULL)); 239 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, 0, q, TAux, &fegeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 240 obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, fegeom.v, numConstants, constants, &integrand); 241 integrand *= w; 242 integral[e * Nf + field] += integrand; 243 if (debug > 1) PetscCall(PetscPrintf(PETSC_COMM_SELF, " int: %g %g\n", (double)PetscRealPart(integrand), (double)PetscRealPart(integral[field]))); 244 } 245 cOffset += totDim; 246 cOffsetAux += totDimAux; 247 } 248 PetscFunctionReturn(PETSC_SUCCESS); 249 } 250 251 PETSC_INTERN PetscErrorCode PetscFEIntegrateBd_Basic(PetscDS ds, PetscInt field, PetscBdPointFunc obj_func, PetscInt Ne, PetscFEGeom *fgeom, const PetscScalar coefficients[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscScalar integral[]) 252 { 253 const PetscInt debug = 0; 254 PetscFE fe; 255 PetscQuadrature quad; 256 PetscTabulation *Tf, *TfAux = NULL; 257 PetscScalar *u, *u_x, *a, *a_x, *basisReal, *basisDerReal; 258 const PetscScalar *constants; 259 PetscReal *x; 260 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 261 PetscBool isAffine, auxOnBd; 262 const PetscReal *quadPoints, *quadWeights; 263 PetscInt qNc, Nq, q, Np, dE; 264 PetscInt dim, dimAux, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e; 265 266 PetscFunctionBegin; 267 if (!obj_func) PetscFunctionReturn(PETSC_SUCCESS); 268 PetscCall(PetscDSGetDiscretization(ds, field, (PetscObject *)&fe)); 269 PetscCall(PetscFEGetSpatialDimension(fe, &dim)); 270 PetscCall(PetscFEGetFaceQuadrature(fe, &quad)); 271 PetscCall(PetscDSGetNumFields(ds, &Nf)); 272 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 273 PetscCall(PetscDSGetComponentOffsets(ds, &uOff)); 274 PetscCall(PetscDSGetComponentDerivativeOffsets(ds, &uOff_x)); 275 PetscCall(PetscDSGetEvaluationArrays(ds, &u, NULL, &u_x)); 276 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, NULL, NULL)); 277 PetscCall(PetscDSGetFaceTabulation(ds, &Tf)); 278 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 279 if (dsAux) { 280 PetscCall(PetscDSGetSpatialDimension(dsAux, &dimAux)); 281 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 282 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 283 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 284 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 285 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 286 auxOnBd = dimAux < dim ? PETSC_TRUE : PETSC_FALSE; 287 if (auxOnBd) PetscCall(PetscDSGetTabulation(dsAux, &TfAux)); 288 else PetscCall(PetscDSGetFaceTabulation(dsAux, &TfAux)); 289 PetscCheck(Tf[0]->Np == TfAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", Tf[0]->Np, TfAux[0]->Np); 290 } 291 PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights)); 292 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 293 Np = fgeom->numPoints; 294 dE = fgeom->dimEmbed; 295 isAffine = fgeom->isAffine; 296 for (e = 0; e < Ne; ++e) { 297 PetscFEGeom fegeom, cgeom; 298 const PetscInt face = fgeom->face[e][0]; /* Local face number in cell */ 299 fegeom.n = NULL; 300 fegeom.v = NULL; 301 fegeom.J = NULL; 302 fegeom.detJ = NULL; 303 fegeom.dim = fgeom->dim; 304 fegeom.dimEmbed = fgeom->dimEmbed; 305 cgeom.dim = fgeom->dim; 306 cgeom.dimEmbed = fgeom->dimEmbed; 307 if (isAffine) { 308 fegeom.v = x; 309 fegeom.xi = fgeom->xi; 310 fegeom.J = &fgeom->J[e * Np * dE * dE]; 311 fegeom.invJ = &fgeom->invJ[e * Np * dE * dE]; 312 fegeom.detJ = &fgeom->detJ[e * Np]; 313 fegeom.n = &fgeom->n[e * Np * dE]; 314 315 cgeom.J = &fgeom->suppJ[0][e * Np * dE * dE]; 316 cgeom.invJ = &fgeom->suppInvJ[0][e * Np * dE * dE]; 317 cgeom.detJ = &fgeom->suppDetJ[0][e * Np]; 318 } 319 for (q = 0; q < Nq; ++q) { 320 PetscScalar integrand; 321 PetscReal w; 322 323 if (isAffine) { 324 CoordinatesRefToReal(dE, dim - 1, fegeom.xi, &fgeom->v[e * Np * dE], fegeom.J, &quadPoints[q * (dim - 1)], x); 325 } else { 326 fegeom.v = &fgeom->v[(e * Np + q) * dE]; 327 fegeom.J = &fgeom->J[(e * Np + q) * dE * dE]; 328 fegeom.invJ = &fgeom->invJ[(e * Np + q) * dE * dE]; 329 fegeom.detJ = &fgeom->detJ[e * Np + q]; 330 fegeom.n = &fgeom->n[(e * Np + q) * dE]; 331 332 cgeom.J = &fgeom->suppJ[0][(e * Np + q) * dE * dE]; 333 cgeom.invJ = &fgeom->suppInvJ[0][(e * Np + q) * dE * dE]; 334 cgeom.detJ = &fgeom->suppDetJ[0][e * Np + q]; 335 } 336 w = fegeom.detJ[0] * quadWeights[q]; 337 if (debug > 1 && q < Np) { 338 PetscCall(PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", (double)fegeom.detJ[0])); 339 #ifndef PETSC_USE_COMPLEX 340 PetscCall(DMPrintCellMatrix(e, "invJ", dim, dim, fegeom.invJ)); 341 #endif 342 } 343 if (debug > 1) PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT "\n", q)); 344 PetscCall(PetscFEEvaluateFieldJets_Internal(ds, Nf, face, q, Tf, &cgeom, &coefficients[cOffset], NULL, u, u_x, NULL)); 345 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, face, q, TfAux, &cgeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 346 obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, fegeom.v, fegeom.n, numConstants, constants, &integrand); 347 integrand *= w; 348 integral[e * Nf + field] += integrand; 349 if (debug > 1) PetscCall(PetscPrintf(PETSC_COMM_SELF, " int: %g %g\n", (double)PetscRealPart(integrand), (double)PetscRealPart(integral[e * Nf + field]))); 350 } 351 cOffset += totDim; 352 cOffsetAux += totDimAux; 353 } 354 PetscFunctionReturn(PETSC_SUCCESS); 355 } 356 357 PetscErrorCode PetscFEIntegrateResidual_Basic(PetscDS ds, PetscFormKey key, PetscInt Ne, PetscFEGeom *cgeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 358 { 359 const PetscInt debug = 0; 360 const PetscInt field = key.field; 361 PetscFE fe; 362 PetscWeakForm wf; 363 PetscInt n0, n1, i; 364 PetscPointFunc *f0_func, *f1_func; 365 PetscQuadrature quad; 366 PetscTabulation *T, *TAux = NULL; 367 PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *basisReal, *basisDerReal; 368 const PetscScalar *constants; 369 PetscReal *x; 370 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 371 PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e; 372 const PetscReal *quadPoints, *quadWeights; 373 PetscInt qdim, qNc, Nq, q, dE; 374 375 PetscFunctionBegin; 376 PetscCall(PetscDSGetDiscretization(ds, field, (PetscObject *)&fe)); 377 PetscCall(PetscFEGetSpatialDimension(fe, &dim)); 378 PetscCall(PetscFEGetQuadrature(fe, &quad)); 379 PetscCall(PetscDSGetNumFields(ds, &Nf)); 380 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 381 PetscCall(PetscDSGetComponentOffsets(ds, &uOff)); 382 PetscCall(PetscDSGetComponentDerivativeOffsets(ds, &uOff_x)); 383 PetscCall(PetscDSGetFieldOffset(ds, field, &fOffset)); 384 PetscCall(PetscDSGetWeakForm(ds, &wf)); 385 PetscCall(PetscWeakFormGetResidual(wf, key.label, key.value, key.field, key.part, &n0, &f0_func, &n1, &f1_func)); 386 if (!n0 && !n1) PetscFunctionReturn(PETSC_SUCCESS); 387 PetscCall(PetscDSGetEvaluationArrays(ds, &u, coefficients_t ? &u_t : NULL, &u_x)); 388 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, NULL, NULL)); 389 PetscCall(PetscDSGetWeakFormArrays(ds, &f0, &f1, NULL, NULL, NULL, NULL)); 390 PetscCall(PetscDSGetTabulation(ds, &T)); 391 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 392 if (dsAux) { 393 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 394 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 395 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 396 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 397 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 398 PetscCall(PetscDSGetTabulation(dsAux, &TAux)); 399 PetscCheck(T[0]->Np == TAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", T[0]->Np, TAux[0]->Np); 400 } 401 PetscCall(PetscQuadratureGetData(quad, &qdim, &qNc, &Nq, &quadPoints, &quadWeights)); 402 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 403 dE = cgeom->dimEmbed; 404 PetscCheck(cgeom->dim == qdim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "FEGeom dim %" PetscInt_FMT " != %" PetscInt_FMT " quadrature dim", cgeom->dim, qdim); 405 for (e = 0; e < Ne; ++e) { 406 PetscFEGeom fegeom; 407 408 fegeom.v = x; /* workspace */ 409 PetscCall(PetscArrayzero(f0, Nq * T[field]->Nc)); 410 PetscCall(PetscArrayzero(f1, Nq * T[field]->Nc * dE)); 411 for (q = 0; q < Nq; ++q) { 412 PetscReal w; 413 PetscInt c, d; 414 415 PetscCall(PetscFEGeomGetPoint(cgeom, e, q, &quadPoints[q * cgeom->dim], &fegeom)); 416 w = fegeom.detJ[0] * quadWeights[q]; 417 if (debug > 1 && q < cgeom->numPoints) { 418 PetscCall(PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", (double)fegeom.detJ[0])); 419 #if !defined(PETSC_USE_COMPLEX) 420 PetscCall(DMPrintCellMatrix(e, "invJ", dim, dim, fegeom.invJ)); 421 #endif 422 } 423 PetscCall(PetscFEEvaluateFieldJets_Internal(ds, Nf, 0, q, T, &fegeom, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t)); 424 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, 0, q, TAux, &fegeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 425 for (i = 0; i < n0; ++i) f0_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, fegeom.v, numConstants, constants, &f0[q * T[field]->Nc]); 426 for (c = 0; c < T[field]->Nc; ++c) f0[q * T[field]->Nc + c] *= w; 427 for (i = 0; i < n1; ++i) f1_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, fegeom.v, numConstants, constants, &f1[q * T[field]->Nc * dim]); 428 for (c = 0; c < T[field]->Nc; ++c) 429 for (d = 0; d < dim; ++d) f1[(q * T[field]->Nc + c) * dim + d] *= w; 430 if (debug) { 431 // LCOV_EXCL_START 432 PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT " wt %g x:", q, (double)quadWeights[q])); 433 for (c = 0; c < dE; ++c) PetscCall(PetscPrintf(PETSC_COMM_SELF, " %g", (double)fegeom.v[c])); 434 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 435 if (debug > 2) { 436 PetscCall(PetscPrintf(PETSC_COMM_SELF, " field %" PetscInt_FMT ":", field)); 437 for (c = 0; c < T[field]->Nc; ++c) PetscCall(PetscPrintf(PETSC_COMM_SELF, " %g", (double)PetscRealPart(u[uOff[field] + c]))); 438 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 439 PetscCall(PetscPrintf(PETSC_COMM_SELF, " field der %" PetscInt_FMT ":", field)); 440 for (c = 0; c < T[field]->Nc * dE; ++c) PetscCall(PetscPrintf(PETSC_COMM_SELF, " %g", (double)PetscRealPart(u_x[uOff[field] + c]))); 441 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 442 PetscCall(PetscPrintf(PETSC_COMM_SELF, " resid %" PetscInt_FMT ":", field)); 443 for (c = 0; c < T[field]->Nc; ++c) PetscCall(PetscPrintf(PETSC_COMM_SELF, " %g", (double)PetscRealPart(f0[q * T[field]->Nc + c]))); 444 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 445 PetscCall(PetscPrintf(PETSC_COMM_SELF, " res der %" PetscInt_FMT ":", field)); 446 for (c = 0; c < T[field]->Nc; ++c) { 447 for (d = 0; d < dim; ++d) PetscCall(PetscPrintf(PETSC_COMM_SELF, " %g", (double)PetscRealPart(f1[(q * T[field]->Nc + c) * dim + d]))); 448 } 449 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 450 } 451 // LCOV_EXCL_STOP 452 } 453 } 454 PetscCall(PetscFEUpdateElementVec_Internal(fe, T[field], 0, basisReal, basisDerReal, e, cgeom, f0, f1, &elemVec[cOffset + fOffset])); 455 cOffset += totDim; 456 cOffsetAux += totDimAux; 457 } 458 PetscFunctionReturn(PETSC_SUCCESS); 459 } 460 461 PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscDS ds, PetscWeakForm wf, PetscFormKey key, PetscInt Ne, PetscFEGeom *fgeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 462 { 463 const PetscInt debug = 0; 464 const PetscInt field = key.field; 465 PetscFE fe; 466 PetscInt n0, n1, i; 467 PetscBdPointFunc *f0_func, *f1_func; 468 PetscQuadrature quad; 469 PetscTabulation *Tf, *TfAux = NULL; 470 PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *basisReal, *basisDerReal; 471 const PetscScalar *constants; 472 PetscReal *x; 473 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 474 PetscInt dim, dimAux, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NcI; 475 PetscBool auxOnBd = PETSC_FALSE; 476 const PetscReal *quadPoints, *quadWeights; 477 PetscInt qdim, qNc, Nq, q, dE; 478 479 PetscFunctionBegin; 480 PetscCall(PetscDSGetDiscretization(ds, field, (PetscObject *)&fe)); 481 PetscCall(PetscFEGetSpatialDimension(fe, &dim)); 482 PetscCall(PetscFEGetFaceQuadrature(fe, &quad)); 483 PetscCall(PetscDSGetNumFields(ds, &Nf)); 484 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 485 PetscCall(PetscDSGetComponentOffsets(ds, &uOff)); 486 PetscCall(PetscDSGetComponentDerivativeOffsets(ds, &uOff_x)); 487 PetscCall(PetscDSGetFieldOffset(ds, field, &fOffset)); 488 PetscCall(PetscWeakFormGetBdResidual(wf, key.label, key.value, key.field, key.part, &n0, &f0_func, &n1, &f1_func)); 489 if (!n0 && !n1) PetscFunctionReturn(PETSC_SUCCESS); 490 PetscCall(PetscDSGetEvaluationArrays(ds, &u, coefficients_t ? &u_t : NULL, &u_x)); 491 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, NULL, NULL)); 492 PetscCall(PetscDSGetWeakFormArrays(ds, &f0, &f1, NULL, NULL, NULL, NULL)); 493 PetscCall(PetscDSGetFaceTabulation(ds, &Tf)); 494 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 495 if (dsAux) { 496 PetscCall(PetscDSGetSpatialDimension(dsAux, &dimAux)); 497 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 498 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 499 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 500 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 501 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 502 auxOnBd = dimAux < dim ? PETSC_TRUE : PETSC_FALSE; 503 if (auxOnBd) PetscCall(PetscDSGetTabulation(dsAux, &TfAux)); 504 else PetscCall(PetscDSGetFaceTabulation(dsAux, &TfAux)); 505 PetscCheck(Tf[0]->Np == TfAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", Tf[0]->Np, TfAux[0]->Np); 506 } 507 NcI = Tf[field]->Nc; 508 PetscCall(PetscQuadratureGetData(quad, &qdim, &qNc, &Nq, &quadPoints, &quadWeights)); 509 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 510 dE = fgeom->dimEmbed; 511 /* TODO FIX THIS */ 512 fgeom->dim = dim - 1; 513 PetscCheck(fgeom->dim == qdim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "FEGeom dim %" PetscInt_FMT " != %" PetscInt_FMT " quadrature dim", fgeom->dim, qdim); 514 for (e = 0; e < Ne; ++e) { 515 PetscFEGeom fegeom, cgeom; 516 const PetscInt face = fgeom->face[e][0]; 517 518 fegeom.v = x; /* Workspace */ 519 PetscCall(PetscArrayzero(f0, Nq * NcI)); 520 PetscCall(PetscArrayzero(f1, Nq * NcI * dE)); 521 for (q = 0; q < Nq; ++q) { 522 PetscReal w; 523 PetscInt c, d; 524 525 PetscCall(PetscFEGeomGetPoint(fgeom, e, q, &quadPoints[q * fgeom->dim], &fegeom)); 526 PetscCall(PetscFEGeomGetCellPoint(fgeom, e, q, &cgeom)); 527 w = fegeom.detJ[0] * quadWeights[q]; 528 if (debug > 1) { 529 if ((fgeom->isAffine && q == 0) || (!fgeom->isAffine)) { 530 PetscCall(PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", (double)fegeom.detJ[0])); 531 #if !defined(PETSC_USE_COMPLEX) 532 PetscCall(DMPrintCellMatrix(e, "invJ", dim, dim, fegeom.invJ)); 533 PetscCall(DMPrintCellVector(e, "n", dim, fegeom.n)); 534 #endif 535 } 536 } 537 PetscCall(PetscFEEvaluateFieldJets_Internal(ds, Nf, face, q, Tf, &cgeom, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t)); 538 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, auxOnBd ? 0 : face, q, TfAux, &cgeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 539 for (i = 0; i < n0; ++i) f0_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, fegeom.v, fegeom.n, numConstants, constants, &f0[q * NcI]); 540 for (c = 0; c < NcI; ++c) f0[q * NcI + c] *= w; 541 for (i = 0; i < n1; ++i) f1_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, fegeom.v, fegeom.n, numConstants, constants, &f1[q * NcI * dim]); 542 for (c = 0; c < NcI; ++c) 543 for (d = 0; d < dim; ++d) f1[(q * NcI + c) * dim + d] *= w; 544 if (debug) { 545 PetscCall(PetscPrintf(PETSC_COMM_SELF, " elem %" PetscInt_FMT " quad point %" PetscInt_FMT "\n", e, q)); 546 for (c = 0; c < NcI; ++c) { 547 if (n0) PetscCall(PetscPrintf(PETSC_COMM_SELF, " f0[%" PetscInt_FMT "] %g\n", c, (double)PetscRealPart(f0[q * NcI + c]))); 548 if (n1) { 549 for (d = 0; d < dim; ++d) PetscCall(PetscPrintf(PETSC_COMM_SELF, " f1[%" PetscInt_FMT ",%" PetscInt_FMT "] %g", c, d, (double)PetscRealPart(f1[(q * NcI + c) * dim + d]))); 550 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 551 } 552 } 553 } 554 } 555 PetscCall(PetscFEUpdateElementVec_Internal(fe, Tf[field], face, basisReal, basisDerReal, e, fgeom, f0, f1, &elemVec[cOffset + fOffset])); 556 cOffset += totDim; 557 cOffsetAux += totDimAux; 558 } 559 PetscFunctionReturn(PETSC_SUCCESS); 560 } 561 562 /* 563 BdIntegral: Operates completely in the embedding dimension. The trick is to have special "face quadrature" so we only integrate over the face, but 564 all transforms operate in the full space and are square. 565 566 HybridIntegral: The discretization is lower dimensional. That means the transforms are non-square. 567 1) DMPlexGetCellFields() retrieves from the hybrid cell, so it gets fields from both faces 568 2) We need to assume that the orientation is 0 for both 569 3) TODO We need to use a non-square Jacobian for the derivative maps, meaning the embedding dimension has to go to EvaluateFieldJets() and UpdateElementVec() 570 */ 571 PETSC_INTERN PetscErrorCode PetscFEIntegrateHybridResidual_Basic(PetscDS ds, PetscDS dsIn, PetscFormKey key, PetscInt s, PetscInt Ne, PetscFEGeom *fgeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 572 { 573 const PetscInt debug = 0; 574 const PetscInt field = key.field; 575 PetscFE fe; 576 PetscWeakForm wf; 577 PetscInt n0, n1, i; 578 PetscBdPointFunc *f0_func, *f1_func; 579 PetscQuadrature quad; 580 DMPolytopeType ct; 581 PetscTabulation *Tf, *TfIn, *TfAux = NULL; 582 PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *basisReal, *basisDerReal; 583 const PetscScalar *constants; 584 PetscReal *x; 585 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 586 PetscInt dim, dimAux, numConstants, Nf, NfAux = 0, totDim, totDimIn, totDimAux = 0, cOffset = 0, cOffsetIn = 0, cOffsetAux = 0, fOffset, e, NcI, NcS; 587 PetscBool isCohesiveField, auxOnBd = PETSC_FALSE; 588 const PetscReal *quadPoints, *quadWeights; 589 PetscInt qdim, qNc, Nq, q, dE; 590 591 PetscFunctionBegin; 592 /* Hybrid discretization is posed directly on faces */ 593 PetscCall(PetscDSGetDiscretization(ds, field, (PetscObject *)&fe)); 594 PetscCall(PetscFEGetSpatialDimension(fe, &dim)); 595 PetscCall(PetscFEGetQuadrature(fe, &quad)); 596 PetscCall(PetscDSGetNumFields(ds, &Nf)); 597 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 598 PetscCall(PetscDSGetTotalDimension(dsIn, &totDimIn)); 599 PetscCall(PetscDSGetComponentOffsetsCohesive(dsIn, 0, &uOff)); // Change 0 to s for one-sided offsets 600 PetscCall(PetscDSGetComponentDerivativeOffsetsCohesive(dsIn, s, &uOff_x)); 601 PetscCall(PetscDSGetFieldOffsetCohesive(ds, field, &fOffset)); 602 PetscCall(PetscDSGetWeakForm(ds, &wf)); 603 PetscCall(PetscWeakFormGetBdResidual(wf, key.label, key.value, key.field, key.part, &n0, &f0_func, &n1, &f1_func)); 604 if (!n0 && !n1) PetscFunctionReturn(PETSC_SUCCESS); 605 PetscCall(PetscDSGetEvaluationArrays(ds, &u, coefficients_t ? &u_t : NULL, &u_x)); 606 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, NULL, NULL)); 607 PetscCall(PetscDSGetWeakFormArrays(ds, &f0, &f1, NULL, NULL, NULL, NULL)); 608 /* NOTE This is a bulk tabulation because the DS is a face discretization */ 609 PetscCall(PetscDSGetTabulation(ds, &Tf)); 610 PetscCall(PetscDSGetFaceTabulation(dsIn, &TfIn)); 611 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 612 if (dsAux) { 613 PetscCall(PetscDSGetSpatialDimension(dsAux, &dimAux)); 614 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 615 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 616 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 617 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 618 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 619 auxOnBd = dimAux == dim ? PETSC_TRUE : PETSC_FALSE; 620 if (auxOnBd) PetscCall(PetscDSGetTabulation(dsAux, &TfAux)); 621 else PetscCall(PetscDSGetFaceTabulation(dsAux, &TfAux)); 622 PetscCheck(Tf[0]->Np == TfAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", Tf[0]->Np, TfAux[0]->Np); 623 } 624 PetscCall(PetscDSGetCohesive(ds, field, &isCohesiveField)); 625 NcI = Tf[field]->Nc; 626 NcS = NcI; 627 if (!isCohesiveField && s == 2) { 628 // If we are integrating over a cohesive cell (s = 2) for a non-cohesive fields, we use both sides 629 NcS *= 2; 630 } 631 PetscCall(PetscQuadratureGetData(quad, &qdim, &qNc, &Nq, &quadPoints, &quadWeights)); 632 PetscCall(PetscQuadratureGetCellType(quad, &ct)); 633 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 634 dE = fgeom->dimEmbed; 635 PetscCheck(fgeom->dim == qdim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "FEGeom dim %" PetscInt_FMT " != %" PetscInt_FMT " quadrature dim", fgeom->dim, qdim); 636 for (e = 0; e < Ne; ++e) { 637 PetscFEGeom fegeom; 638 const PetscInt face[2] = {fgeom->face[e * 2 + 0][0], fgeom->face[e * 2 + 1][2]}; 639 const PetscInt ornt[2] = {fgeom->face[e * 2 + 0][1], fgeom->face[e * 2 + 1][3]}; 640 const PetscInt cornt[2] = {fgeom->face[e * 2 + 0][3], fgeom->face[e * 2 + 1][1]}; 641 642 fegeom.v = x; /* Workspace */ 643 PetscCall(PetscArrayzero(f0, Nq * NcS)); 644 PetscCall(PetscArrayzero(f1, Nq * NcS * dE)); 645 for (q = 0; q < Nq; ++q) { 646 PetscInt qpt[2]; 647 PetscReal w; 648 PetscInt c, d; 649 650 PetscCall(PetscDSPermuteQuadPoint(ds, DMPolytopeTypeComposeOrientationInv(ct, cornt[0], ornt[0]), field, q, &qpt[0])); 651 PetscCall(PetscDSPermuteQuadPoint(ds, DMPolytopeTypeComposeOrientationInv(ct, ornt[1], cornt[1]), field, q, &qpt[1])); 652 PetscCall(PetscFEGeomGetPoint(fgeom, e * 2, q, &quadPoints[q * fgeom->dim], &fegeom)); 653 w = fegeom.detJ[0] * quadWeights[q]; 654 if (debug > 1 && q < fgeom->numPoints) { 655 PetscCall(PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", (double)fegeom.detJ[0])); 656 #if !defined(PETSC_USE_COMPLEX) 657 PetscCall(DMPrintCellMatrix(e, "invJ", dim, dE, fegeom.invJ)); 658 #endif 659 } 660 if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT " weight %g detJ %g\n", q, (double)quadWeights[q], (double)fegeom.detJ[0])); 661 /* TODO Is this cell or face quadrature, meaning should we use 'q' or 'face*Nq+q' */ 662 PetscCall(PetscFEEvaluateFieldJets_Hybrid_Internal(ds, Nf, 0, q, Tf, face, qpt, TfIn, &fegeom, &coefficients[cOffsetIn], &coefficients_t[cOffsetIn], u, u_x, u_t)); 663 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, auxOnBd ? 0 : face[s], auxOnBd ? q : qpt[s], TfAux, &fegeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 664 for (i = 0; i < n0; ++i) f0_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, fegeom.v, fegeom.n, numConstants, constants, &f0[q * NcS]); 665 for (c = 0; c < NcS; ++c) f0[q * NcS + c] *= w; 666 for (i = 0; i < n1; ++i) f1_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, fegeom.v, fegeom.n, numConstants, constants, &f1[q * NcS * dE]); 667 for (c = 0; c < NcS; ++c) 668 for (d = 0; d < dE; ++d) f1[(q * NcS + c) * dE + d] *= w; 669 } 670 if (isCohesiveField) { 671 PetscCall(PetscFEUpdateElementVec_Internal(fe, Tf[field], 0, basisReal, basisDerReal, e, fgeom, f0, f1, &elemVec[cOffset + fOffset])); 672 } else { 673 PetscCall(PetscFEUpdateElementVec_Hybrid_Internal(fe, Tf[field], 0, s, basisReal, basisDerReal, fgeom, f0, f1, &elemVec[cOffset + fOffset])); 674 } 675 cOffset += totDim; 676 cOffsetIn += totDimIn; 677 cOffsetAux += totDimAux; 678 } 679 PetscFunctionReturn(PETSC_SUCCESS); 680 } 681 682 PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscDS ds, PetscFEJacobianType jtype, PetscFormKey key, PetscInt Ne, PetscFEGeom *cgeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 683 { 684 const PetscInt debug = 0; 685 PetscFE feI, feJ; 686 PetscWeakForm wf; 687 PetscPointJac *g0_func, *g1_func, *g2_func, *g3_func; 688 PetscInt n0, n1, n2, n3, i; 689 PetscInt cOffset = 0; /* Offset into coefficients[] for element e */ 690 PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */ 691 PetscInt eOffset = 0; /* Offset into elemMat[] for element e */ 692 PetscInt offsetI = 0; /* Offset into an element vector for fieldI */ 693 PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */ 694 PetscQuadrature quad; 695 PetscTabulation *T, *TAux = NULL; 696 PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *basisReal, *basisDerReal, *testReal, *testDerReal; 697 const PetscScalar *constants; 698 PetscReal *x; 699 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 700 PetscInt NcI = 0, NcJ = 0; 701 PetscInt dim, numConstants, Nf, fieldI, fieldJ, NfAux = 0, totDim, totDimAux = 0, e; 702 PetscInt dE, Np; 703 PetscBool isAffine; 704 const PetscReal *quadPoints, *quadWeights; 705 PetscInt qNc, Nq, q; 706 707 PetscFunctionBegin; 708 PetscCall(PetscDSGetNumFields(ds, &Nf)); 709 fieldI = key.field / Nf; 710 fieldJ = key.field % Nf; 711 PetscCall(PetscDSGetDiscretization(ds, fieldI, (PetscObject *)&feI)); 712 PetscCall(PetscDSGetDiscretization(ds, fieldJ, (PetscObject *)&feJ)); 713 PetscCall(PetscFEGetSpatialDimension(feI, &dim)); 714 PetscCall(PetscFEGetQuadrature(feI, &quad)); 715 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 716 PetscCall(PetscDSGetComponentOffsets(ds, &uOff)); 717 PetscCall(PetscDSGetComponentDerivativeOffsets(ds, &uOff_x)); 718 PetscCall(PetscDSGetWeakForm(ds, &wf)); 719 switch (jtype) { 720 case PETSCFE_JACOBIAN_DYN: 721 PetscCall(PetscWeakFormGetDynamicJacobian(wf, key.label, key.value, fieldI, fieldJ, key.part, &n0, &g0_func, &n1, &g1_func, &n2, &g2_func, &n3, &g3_func)); 722 break; 723 case PETSCFE_JACOBIAN_PRE: 724 PetscCall(PetscWeakFormGetJacobianPreconditioner(wf, key.label, key.value, fieldI, fieldJ, key.part, &n0, &g0_func, &n1, &g1_func, &n2, &g2_func, &n3, &g3_func)); 725 break; 726 case PETSCFE_JACOBIAN: 727 PetscCall(PetscWeakFormGetJacobian(wf, key.label, key.value, fieldI, fieldJ, key.part, &n0, &g0_func, &n1, &g1_func, &n2, &g2_func, &n3, &g3_func)); 728 break; 729 } 730 if (!n0 && !n1 && !n2 && !n3) PetscFunctionReturn(PETSC_SUCCESS); 731 PetscCall(PetscDSGetEvaluationArrays(ds, &u, coefficients_t ? &u_t : NULL, &u_x)); 732 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, &testReal, &testDerReal)); 733 PetscCall(PetscDSGetWeakFormArrays(ds, NULL, NULL, &g0, &g1, &g2, &g3)); 734 PetscCall(PetscDSGetTabulation(ds, &T)); 735 PetscCall(PetscDSGetFieldOffset(ds, fieldI, &offsetI)); 736 PetscCall(PetscDSGetFieldOffset(ds, fieldJ, &offsetJ)); 737 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 738 if (dsAux) { 739 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 740 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 741 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 742 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 743 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 744 PetscCall(PetscDSGetTabulation(dsAux, &TAux)); 745 PetscCheck(T[0]->Np == TAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", T[0]->Np, TAux[0]->Np); 746 } 747 NcI = T[fieldI]->Nc; 748 NcJ = T[fieldJ]->Nc; 749 Np = cgeom->numPoints; 750 dE = cgeom->dimEmbed; 751 isAffine = cgeom->isAffine; 752 /* Initialize here in case the function is not defined */ 753 PetscCall(PetscArrayzero(g0, NcI * NcJ)); 754 PetscCall(PetscArrayzero(g1, NcI * NcJ * dE)); 755 PetscCall(PetscArrayzero(g2, NcI * NcJ * dE)); 756 PetscCall(PetscArrayzero(g3, NcI * NcJ * dE * dE)); 757 PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights)); 758 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 759 for (e = 0; e < Ne; ++e) { 760 PetscFEGeom fegeom; 761 762 fegeom.dim = cgeom->dim; 763 fegeom.dimEmbed = cgeom->dimEmbed; 764 if (isAffine) { 765 fegeom.v = x; 766 fegeom.xi = cgeom->xi; 767 fegeom.J = &cgeom->J[e * Np * dE * dE]; 768 fegeom.invJ = &cgeom->invJ[e * Np * dE * dE]; 769 fegeom.detJ = &cgeom->detJ[e * Np]; 770 } 771 for (q = 0; q < Nq; ++q) { 772 PetscReal w; 773 PetscInt c; 774 775 if (isAffine) { 776 CoordinatesRefToReal(dE, dim, fegeom.xi, &cgeom->v[e * Np * dE], fegeom.J, &quadPoints[q * dim], x); 777 } else { 778 fegeom.v = &cgeom->v[(e * Np + q) * dE]; 779 fegeom.J = &cgeom->J[(e * Np + q) * dE * dE]; 780 fegeom.invJ = &cgeom->invJ[(e * Np + q) * dE * dE]; 781 fegeom.detJ = &cgeom->detJ[e * Np + q]; 782 } 783 if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT " weight %g detJ %g\n", q, (double)quadWeights[q], (double)fegeom.detJ[0])); 784 w = fegeom.detJ[0] * quadWeights[q]; 785 if (coefficients) PetscCall(PetscFEEvaluateFieldJets_Internal(ds, Nf, 0, q, T, &fegeom, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t)); 786 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, 0, q, TAux, &fegeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 787 if (n0) { 788 PetscCall(PetscArrayzero(g0, NcI * NcJ)); 789 for (i = 0; i < n0; ++i) g0_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, numConstants, constants, g0); 790 for (c = 0; c < NcI * NcJ; ++c) g0[c] *= w; 791 } 792 if (n1) { 793 PetscCall(PetscArrayzero(g1, NcI * NcJ * dE)); 794 for (i = 0; i < n1; ++i) g1_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, numConstants, constants, g1); 795 for (c = 0; c < NcI * NcJ * dim; ++c) g1[c] *= w; 796 } 797 if (n2) { 798 PetscCall(PetscArrayzero(g2, NcI * NcJ * dE)); 799 for (i = 0; i < n2; ++i) g2_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, numConstants, constants, g2); 800 for (c = 0; c < NcI * NcJ * dim; ++c) g2[c] *= w; 801 } 802 if (n3) { 803 PetscCall(PetscArrayzero(g3, NcI * NcJ * dE * dE)); 804 for (i = 0; i < n3; ++i) g3_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, numConstants, constants, g3); 805 for (c = 0; c < NcI * NcJ * dim * dim; ++c) g3[c] *= w; 806 } 807 808 PetscCall(PetscFEUpdateElementMat_Internal(feI, feJ, 0, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 809 } 810 if (debug > 1) { 811 PetscInt fc, f, gc, g; 812 813 PetscCall(PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %" PetscInt_FMT " and %" PetscInt_FMT "\n", fieldI, fieldJ)); 814 for (fc = 0; fc < T[fieldI]->Nc; ++fc) { 815 for (f = 0; f < T[fieldI]->Nb; ++f) { 816 const PetscInt i = offsetI + f * T[fieldI]->Nc + fc; 817 for (gc = 0; gc < T[fieldJ]->Nc; ++gc) { 818 for (g = 0; g < T[fieldJ]->Nb; ++g) { 819 const PetscInt j = offsetJ + g * T[fieldJ]->Nc + gc; 820 PetscCall(PetscPrintf(PETSC_COMM_SELF, " elemMat[%" PetscInt_FMT ",%" PetscInt_FMT ",%" PetscInt_FMT ",%" PetscInt_FMT "]: %g\n", f, fc, g, gc, (double)PetscRealPart(elemMat[eOffset + i * totDim + j]))); 821 } 822 } 823 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 824 } 825 } 826 } 827 cOffset += totDim; 828 cOffsetAux += totDimAux; 829 eOffset += PetscSqr(totDim); 830 } 831 PetscFunctionReturn(PETSC_SUCCESS); 832 } 833 834 PETSC_INTERN PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscDS ds, PetscWeakForm wf, PetscFormKey key, PetscInt Ne, PetscFEGeom *fgeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 835 { 836 const PetscInt debug = 0; 837 PetscFE feI, feJ; 838 PetscBdPointJac *g0_func, *g1_func, *g2_func, *g3_func; 839 PetscInt n0, n1, n2, n3, i; 840 PetscInt cOffset = 0; /* Offset into coefficients[] for element e */ 841 PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */ 842 PetscInt eOffset = 0; /* Offset into elemMat[] for element e */ 843 PetscInt offsetI = 0; /* Offset into an element vector for fieldI */ 844 PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */ 845 PetscQuadrature quad; 846 PetscTabulation *T, *TAux = NULL; 847 PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *basisReal, *basisDerReal, *testReal, *testDerReal; 848 const PetscScalar *constants; 849 PetscReal *x; 850 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 851 PetscInt NcI = 0, NcJ = 0; 852 PetscInt dim, numConstants, Nf, fieldI, fieldJ, NfAux = 0, totDim, totDimAux = 0, e; 853 PetscBool isAffine; 854 const PetscReal *quadPoints, *quadWeights; 855 PetscInt qNc, Nq, q, Np, dE; 856 857 PetscFunctionBegin; 858 PetscCall(PetscDSGetNumFields(ds, &Nf)); 859 fieldI = key.field / Nf; 860 fieldJ = key.field % Nf; 861 PetscCall(PetscDSGetDiscretization(ds, fieldI, (PetscObject *)&feI)); 862 PetscCall(PetscDSGetDiscretization(ds, fieldJ, (PetscObject *)&feJ)); 863 PetscCall(PetscFEGetSpatialDimension(feI, &dim)); 864 PetscCall(PetscFEGetFaceQuadrature(feI, &quad)); 865 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 866 PetscCall(PetscDSGetComponentOffsets(ds, &uOff)); 867 PetscCall(PetscDSGetComponentDerivativeOffsets(ds, &uOff_x)); 868 PetscCall(PetscDSGetFieldOffset(ds, fieldI, &offsetI)); 869 PetscCall(PetscDSGetFieldOffset(ds, fieldJ, &offsetJ)); 870 PetscCall(PetscWeakFormGetBdJacobian(wf, key.label, key.value, fieldI, fieldJ, key.part, &n0, &g0_func, &n1, &g1_func, &n2, &g2_func, &n3, &g3_func)); 871 if (!n0 && !n1 && !n2 && !n3) PetscFunctionReturn(PETSC_SUCCESS); 872 PetscCall(PetscDSGetEvaluationArrays(ds, &u, coefficients_t ? &u_t : NULL, &u_x)); 873 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, &testReal, &testDerReal)); 874 PetscCall(PetscDSGetWeakFormArrays(ds, NULL, NULL, &g0, &g1, &g2, &g3)); 875 PetscCall(PetscDSGetFaceTabulation(ds, &T)); 876 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 877 if (dsAux) { 878 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 879 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 880 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 881 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 882 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 883 PetscCall(PetscDSGetFaceTabulation(dsAux, &TAux)); 884 } 885 NcI = T[fieldI]->Nc, NcJ = T[fieldJ]->Nc; 886 Np = fgeom->numPoints; 887 dE = fgeom->dimEmbed; 888 isAffine = fgeom->isAffine; 889 /* Initialize here in case the function is not defined */ 890 PetscCall(PetscArrayzero(g0, NcI * NcJ)); 891 PetscCall(PetscArrayzero(g1, NcI * NcJ * dE)); 892 PetscCall(PetscArrayzero(g2, NcI * NcJ * dE)); 893 PetscCall(PetscArrayzero(g3, NcI * NcJ * dE * dE)); 894 PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights)); 895 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 896 for (e = 0; e < Ne; ++e) { 897 PetscFEGeom fegeom, cgeom; 898 const PetscInt face = fgeom->face[e][0]; 899 fegeom.n = NULL; 900 fegeom.v = NULL; 901 fegeom.J = NULL; 902 fegeom.detJ = NULL; 903 fegeom.dim = fgeom->dim; 904 fegeom.dimEmbed = fgeom->dimEmbed; 905 cgeom.dim = fgeom->dim; 906 cgeom.dimEmbed = fgeom->dimEmbed; 907 if (isAffine) { 908 fegeom.v = x; 909 fegeom.xi = fgeom->xi; 910 fegeom.J = &fgeom->J[e * Np * dE * dE]; 911 fegeom.invJ = &fgeom->invJ[e * Np * dE * dE]; 912 fegeom.detJ = &fgeom->detJ[e * Np]; 913 fegeom.n = &fgeom->n[e * Np * dE]; 914 915 cgeom.J = &fgeom->suppJ[0][e * Np * dE * dE]; 916 cgeom.invJ = &fgeom->suppInvJ[0][e * Np * dE * dE]; 917 cgeom.detJ = &fgeom->suppDetJ[0][e * Np]; 918 } 919 for (q = 0; q < Nq; ++q) { 920 PetscReal w; 921 PetscInt c; 922 923 if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT "\n", q)); 924 if (isAffine) { 925 CoordinatesRefToReal(dE, dim - 1, fegeom.xi, &fgeom->v[e * Np * dE], fegeom.J, &quadPoints[q * (dim - 1)], x); 926 } else { 927 fegeom.v = &fgeom->v[(e * Np + q) * dE]; 928 fegeom.J = &fgeom->J[(e * Np + q) * dE * dE]; 929 fegeom.invJ = &fgeom->invJ[(e * Np + q) * dE * dE]; 930 fegeom.detJ = &fgeom->detJ[e * Np + q]; 931 fegeom.n = &fgeom->n[(e * Np + q) * dE]; 932 933 cgeom.J = &fgeom->suppJ[0][(e * Np + q) * dE * dE]; 934 cgeom.invJ = &fgeom->suppInvJ[0][(e * Np + q) * dE * dE]; 935 cgeom.detJ = &fgeom->suppDetJ[0][e * Np + q]; 936 } 937 w = fegeom.detJ[0] * quadWeights[q]; 938 if (coefficients) PetscCall(PetscFEEvaluateFieldJets_Internal(ds, Nf, face, q, T, &cgeom, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t)); 939 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, face, q, TAux, &cgeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 940 if (n0) { 941 PetscCall(PetscArrayzero(g0, NcI * NcJ)); 942 for (i = 0; i < n0; ++i) g0_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g0); 943 for (c = 0; c < NcI * NcJ; ++c) g0[c] *= w; 944 } 945 if (n1) { 946 PetscCall(PetscArrayzero(g1, NcI * NcJ * dE)); 947 for (i = 0; i < n1; ++i) g1_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g1); 948 for (c = 0; c < NcI * NcJ * dim; ++c) g1[c] *= w; 949 } 950 if (n2) { 951 PetscCall(PetscArrayzero(g2, NcI * NcJ * dE)); 952 for (i = 0; i < n2; ++i) g2_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g2); 953 for (c = 0; c < NcI * NcJ * dim; ++c) g2[c] *= w; 954 } 955 if (n3) { 956 PetscCall(PetscArrayzero(g3, NcI * NcJ * dE * dE)); 957 for (i = 0; i < n3; ++i) g3_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g3); 958 for (c = 0; c < NcI * NcJ * dim * dim; ++c) g3[c] *= w; 959 } 960 961 PetscCall(PetscFEUpdateElementMat_Internal(feI, feJ, face, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &cgeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 962 } 963 if (debug > 1) { 964 PetscInt fc, f, gc, g; 965 966 PetscCall(PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %" PetscInt_FMT " and %" PetscInt_FMT "\n", fieldI, fieldJ)); 967 for (fc = 0; fc < T[fieldI]->Nc; ++fc) { 968 for (f = 0; f < T[fieldI]->Nb; ++f) { 969 const PetscInt i = offsetI + f * T[fieldI]->Nc + fc; 970 for (gc = 0; gc < T[fieldJ]->Nc; ++gc) { 971 for (g = 0; g < T[fieldJ]->Nb; ++g) { 972 const PetscInt j = offsetJ + g * T[fieldJ]->Nc + gc; 973 PetscCall(PetscPrintf(PETSC_COMM_SELF, " elemMat[%" PetscInt_FMT ",%" PetscInt_FMT ",%" PetscInt_FMT ",%" PetscInt_FMT "]: %g\n", f, fc, g, gc, (double)PetscRealPart(elemMat[eOffset + i * totDim + j]))); 974 } 975 } 976 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 977 } 978 } 979 } 980 cOffset += totDim; 981 cOffsetAux += totDimAux; 982 eOffset += PetscSqr(totDim); 983 } 984 PetscFunctionReturn(PETSC_SUCCESS); 985 } 986 987 PETSC_INTERN PetscErrorCode PetscFEIntegrateHybridJacobian_Basic(PetscDS ds, PetscDS dsIn, PetscFEJacobianType jtype, PetscFormKey key, PetscInt s, PetscInt Ne, PetscFEGeom *fgeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS dsAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 988 { 989 const PetscInt debug = 0; 990 PetscFE feI, feJ; 991 PetscWeakForm wf; 992 PetscBdPointJac *g0_func, *g1_func, *g2_func, *g3_func; 993 PetscInt n0, n1, n2, n3, i; 994 PetscInt cOffset = 0; /* Offset into coefficients[] for element e */ 995 PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */ 996 PetscInt eOffset = 0; /* Offset into elemMat[] for element e */ 997 PetscInt offsetI = 0; /* Offset into an element vector for fieldI */ 998 PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */ 999 PetscQuadrature quad; 1000 DMPolytopeType ct; 1001 PetscTabulation *T, *TfIn, *TAux = NULL; 1002 PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *basisReal, *basisDerReal, *testReal, *testDerReal; 1003 const PetscScalar *constants; 1004 PetscReal *x; 1005 PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL; 1006 PetscInt NcI = 0, NcJ = 0, NcS, NcT; 1007 PetscInt dim, dimAux, numConstants, Nf, fieldI, fieldJ, NfAux = 0, totDim, totDimAux = 0, e; 1008 PetscBool isCohesiveFieldI, isCohesiveFieldJ, auxOnBd = PETSC_FALSE; 1009 const PetscReal *quadPoints, *quadWeights; 1010 PetscInt qNc, Nq, q; 1011 1012 PetscFunctionBegin; 1013 PetscCall(PetscDSGetNumFields(ds, &Nf)); 1014 fieldI = key.field / Nf; 1015 fieldJ = key.field % Nf; 1016 /* Hybrid discretization is posed directly on faces */ 1017 PetscCall(PetscDSGetDiscretization(ds, fieldI, (PetscObject *)&feI)); 1018 PetscCall(PetscDSGetDiscretization(ds, fieldJ, (PetscObject *)&feJ)); 1019 PetscCall(PetscFEGetSpatialDimension(feI, &dim)); 1020 PetscCall(PetscFEGetQuadrature(feI, &quad)); 1021 PetscCall(PetscDSGetTotalDimension(ds, &totDim)); 1022 PetscCall(PetscDSGetComponentOffsetsCohesive(ds, 0, &uOff)); // Change 0 to s for one-sided offsets 1023 PetscCall(PetscDSGetComponentDerivativeOffsetsCohesive(ds, s, &uOff_x)); 1024 PetscCall(PetscDSGetWeakForm(ds, &wf)); 1025 switch (jtype) { 1026 case PETSCFE_JACOBIAN_PRE: 1027 PetscCall(PetscWeakFormGetBdJacobianPreconditioner(wf, key.label, key.value, fieldI, fieldJ, key.part, &n0, &g0_func, &n1, &g1_func, &n2, &g2_func, &n3, &g3_func)); 1028 break; 1029 case PETSCFE_JACOBIAN: 1030 PetscCall(PetscWeakFormGetBdJacobian(wf, key.label, key.value, fieldI, fieldJ, key.part, &n0, &g0_func, &n1, &g1_func, &n2, &g2_func, &n3, &g3_func)); 1031 break; 1032 case PETSCFE_JACOBIAN_DYN: 1033 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "No boundary hybrid Jacobians :)"); 1034 } 1035 if (!n0 && !n1 && !n2 && !n3) PetscFunctionReturn(PETSC_SUCCESS); 1036 PetscCall(PetscDSGetEvaluationArrays(ds, &u, coefficients_t ? &u_t : NULL, &u_x)); 1037 PetscCall(PetscDSGetWorkspace(ds, &x, &basisReal, &basisDerReal, &testReal, &testDerReal)); 1038 PetscCall(PetscDSGetWeakFormArrays(ds, NULL, NULL, &g0, &g1, &g2, &g3)); 1039 PetscCall(PetscDSGetTabulation(ds, &T)); 1040 PetscCall(PetscDSGetFaceTabulation(dsIn, &TfIn)); 1041 PetscCall(PetscDSGetFieldOffsetCohesive(ds, fieldI, &offsetI)); 1042 PetscCall(PetscDSGetFieldOffsetCohesive(ds, fieldJ, &offsetJ)); 1043 PetscCall(PetscDSGetConstants(ds, &numConstants, &constants)); 1044 if (dsAux) { 1045 PetscCall(PetscDSGetSpatialDimension(dsAux, &dimAux)); 1046 PetscCall(PetscDSGetNumFields(dsAux, &NfAux)); 1047 PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux)); 1048 PetscCall(PetscDSGetComponentOffsets(dsAux, &aOff)); 1049 PetscCall(PetscDSGetComponentDerivativeOffsets(dsAux, &aOff_x)); 1050 PetscCall(PetscDSGetEvaluationArrays(dsAux, &a, NULL, &a_x)); 1051 auxOnBd = dimAux == dim ? PETSC_TRUE : PETSC_FALSE; 1052 if (auxOnBd) PetscCall(PetscDSGetTabulation(dsAux, &TAux)); 1053 else PetscCall(PetscDSGetFaceTabulation(dsAux, &TAux)); 1054 PetscCheck(T[0]->Np == TAux[0]->Np, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of tabulation points %" PetscInt_FMT " != %" PetscInt_FMT " number of auxiliary tabulation points", T[0]->Np, TAux[0]->Np); 1055 } 1056 PetscCall(PetscDSGetCohesive(ds, fieldI, &isCohesiveFieldI)); 1057 PetscCall(PetscDSGetCohesive(ds, fieldJ, &isCohesiveFieldJ)); 1058 NcI = T[fieldI]->Nc; 1059 NcJ = T[fieldJ]->Nc; 1060 NcS = isCohesiveFieldI ? NcI : 2 * NcI; 1061 NcT = isCohesiveFieldJ ? NcJ : 2 * NcJ; 1062 if (!isCohesiveFieldI && s == 2) { 1063 // If we are integrating over a cohesive cell (s = 2) for a non-cohesive fields, we use both sides 1064 NcS *= 2; 1065 } 1066 if (!isCohesiveFieldJ && s == 2) { 1067 // If we are integrating over a cohesive cell (s = 2) for a non-cohesive fields, we use both sides 1068 NcT *= 2; 1069 } 1070 // The derivatives are constrained to be along the cell, so there are dim, not dE, components, even though 1071 // the coordinates are in dE dimensions 1072 PetscCall(PetscArrayzero(g0, NcS * NcT)); 1073 PetscCall(PetscArrayzero(g1, NcS * NcT * dim)); 1074 PetscCall(PetscArrayzero(g2, NcS * NcT * dim)); 1075 PetscCall(PetscArrayzero(g3, NcS * NcT * dim * dim)); 1076 PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights)); 1077 PetscCall(PetscQuadratureGetCellType(quad, &ct)); 1078 PetscCheck(qNc == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %" PetscInt_FMT " components", qNc); 1079 for (e = 0; e < Ne; ++e) { 1080 PetscFEGeom fegeom; 1081 const PetscInt face[2] = {fgeom->face[e * 2 + 0][0], fgeom->face[e * 2 + 1][2]}; 1082 const PetscInt ornt[2] = {fgeom->face[e * 2 + 0][1], fgeom->face[e * 2 + 1][3]}; 1083 const PetscInt cornt[2] = {fgeom->face[e * 2 + 0][3], fgeom->face[e * 2 + 1][1]}; 1084 1085 fegeom.v = x; /* Workspace */ 1086 for (q = 0; q < Nq; ++q) { 1087 PetscInt qpt[2]; 1088 PetscReal w; 1089 PetscInt c; 1090 1091 PetscCall(PetscDSPermuteQuadPoint(ds, DMPolytopeTypeComposeOrientationInv(ct, cornt[0], ornt[0]), fieldI, q, &qpt[0])); 1092 PetscCall(PetscDSPermuteQuadPoint(ds, DMPolytopeTypeComposeOrientationInv(ct, ornt[1], cornt[1]), fieldI, q, &qpt[1])); 1093 PetscCall(PetscFEGeomGetPoint(fgeom, e * 2, q, &quadPoints[q * fgeom->dim], &fegeom)); 1094 w = fegeom.detJ[0] * quadWeights[q]; 1095 if (debug > 1 && q < fgeom->numPoints) { 1096 PetscCall(PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", (double)fegeom.detJ[0])); 1097 #if !defined(PETSC_USE_COMPLEX) 1098 PetscCall(DMPrintCellMatrix(e, "invJ", dim, dim, fegeom.invJ)); 1099 #endif 1100 } 1101 if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, " quad point %" PetscInt_FMT "\n", q)); 1102 if (coefficients) PetscCall(PetscFEEvaluateFieldJets_Hybrid_Internal(ds, Nf, 0, q, T, face, qpt, TfIn, &fegeom, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t)); 1103 if (dsAux) PetscCall(PetscFEEvaluateFieldJets_Internal(dsAux, NfAux, auxOnBd ? 0 : face[s], auxOnBd ? q : qpt[s], TAux, &fegeom, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL)); 1104 if (n0) { 1105 PetscCall(PetscArrayzero(g0, NcS * NcT)); 1106 for (i = 0; i < n0; ++i) g0_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g0); 1107 for (c = 0; c < NcS * NcT; ++c) g0[c] *= w; 1108 } 1109 if (n1) { 1110 PetscCall(PetscArrayzero(g1, NcS * NcT * dim)); 1111 for (i = 0; i < n1; ++i) g1_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g1); 1112 for (c = 0; c < NcS * NcT * dim; ++c) g1[c] *= w; 1113 } 1114 if (n2) { 1115 PetscCall(PetscArrayzero(g2, NcS * NcT * dim)); 1116 for (i = 0; i < n2; ++i) g2_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g2); 1117 for (c = 0; c < NcS * NcT * dim; ++c) g2[c] *= w; 1118 } 1119 if (n3) { 1120 PetscCall(PetscArrayzero(g3, NcS * NcT * dim * dim)); 1121 for (i = 0; i < n3; ++i) g3_func[i](dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, fegeom.v, fegeom.n, numConstants, constants, g3); 1122 for (c = 0; c < NcS * NcT * dim * dim; ++c) g3[c] *= w; 1123 } 1124 1125 if (isCohesiveFieldI) { 1126 if (isCohesiveFieldJ) { 1127 PetscCall(PetscFEUpdateElementMat_Internal(feI, feJ, 0, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 1128 } else { 1129 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 0, 0, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 1130 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 1, 1, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, &g0[NcI * NcJ], &g1[NcI * NcJ * dim], &g2[NcI * NcJ * dim], &g3[NcI * NcJ * dim * dim], eOffset, totDim, offsetI, offsetJ, elemMat)); 1131 } 1132 } else { 1133 if (s == 2) { 1134 if (isCohesiveFieldJ) { 1135 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 0, 0, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 1136 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 1, 1, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, &g0[NcI * NcJ], &g1[NcI * NcJ * dim], &g2[NcI * NcJ * dim], &g3[NcI * NcJ * dim * dim], eOffset, totDim, offsetI, offsetJ, elemMat)); 1137 } else { 1138 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 0, 0, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 1139 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 0, 1, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, &g0[NcI * NcJ], &g1[NcI * NcJ * dim], &g2[NcI * NcJ * dim], &g3[NcI * NcJ * dim * dim], eOffset, totDim, offsetI, offsetJ, elemMat)); 1140 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 1, 0, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, &g0[NcI * NcJ * 2], &g1[NcI * NcJ * dim * 2], &g2[NcI * NcJ * dim * 2], &g3[NcI * NcJ * dim * dim * 2], eOffset, totDim, offsetI, offsetJ, elemMat)); 1141 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, 1, 1, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, &g0[NcI * NcJ * 3], &g1[NcI * NcJ * dim * 3], &g2[NcI * NcJ * dim * 3], &g3[NcI * NcJ * dim * dim * 3], eOffset, totDim, offsetI, offsetJ, elemMat)); 1142 } 1143 } else 1144 PetscCall(PetscFEUpdateElementMat_Hybrid_Internal(feI, isCohesiveFieldI, feJ, isCohesiveFieldJ, 0, s, s, q, T[fieldI], basisReal, basisDerReal, T[fieldJ], testReal, testDerReal, &fegeom, g0, g1, g2, g3, eOffset, totDim, offsetI, offsetJ, elemMat)); 1145 } 1146 } 1147 if (debug > 1) { 1148 const PetscInt fS = 0 + (isCohesiveFieldI ? 0 : (s == 2 ? 0 : s * T[fieldI]->Nb)); 1149 const PetscInt fE = T[fieldI]->Nb + (isCohesiveFieldI ? 0 : (s == 2 ? T[fieldI]->Nb : s * T[fieldI]->Nb)); 1150 const PetscInt gS = 0 + (isCohesiveFieldJ ? 0 : (s == 2 ? 0 : s * T[fieldJ]->Nb)); 1151 const PetscInt gE = T[fieldJ]->Nb + (isCohesiveFieldJ ? 0 : (s == 2 ? T[fieldJ]->Nb : s * T[fieldJ]->Nb)); 1152 PetscInt f, g; 1153 1154 PetscCall(PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %" PetscInt_FMT " and %" PetscInt_FMT " s %s totDim %" PetscInt_FMT " offsets (%" PetscInt_FMT ", %" PetscInt_FMT ", %" PetscInt_FMT ")\n", fieldI, fieldJ, s ? (s > 1 ? "Coh" : "Pos") : "Neg", totDim, eOffset, offsetI, offsetJ)); 1155 for (f = fS; f < fE; ++f) { 1156 const PetscInt i = offsetI + f; 1157 for (g = gS; g < gE; ++g) { 1158 const PetscInt j = offsetJ + g; 1159 PetscCheck(i < totDim && j < totDim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Fuck up %" PetscInt_FMT " %" PetscInt_FMT " %" PetscInt_FMT " %" PetscInt_FMT "\n", f, i, g, j); 1160 PetscCall(PetscPrintf(PETSC_COMM_SELF, " elemMat[%" PetscInt_FMT ",%" PetscInt_FMT ",%" PetscInt_FMT ",%" PetscInt_FMT "]: %g\n", f / NcI, f % NcI, g / NcJ, g % NcJ, (double)PetscRealPart(elemMat[eOffset + i * totDim + j]))); 1161 } 1162 PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n")); 1163 } 1164 } 1165 cOffset += totDim; 1166 cOffsetAux += totDimAux; 1167 eOffset += PetscSqr(totDim); 1168 } 1169 PetscFunctionReturn(PETSC_SUCCESS); 1170 } 1171 1172 static PetscErrorCode PetscFEInitialize_Basic(PetscFE fem) 1173 { 1174 PetscFunctionBegin; 1175 fem->ops->setfromoptions = NULL; 1176 fem->ops->setup = PetscFESetUp_Basic; 1177 fem->ops->view = PetscFEView_Basic; 1178 fem->ops->destroy = PetscFEDestroy_Basic; 1179 fem->ops->getdimension = PetscFEGetDimension_Basic; 1180 fem->ops->createtabulation = PetscFECreateTabulation_Basic; 1181 fem->ops->integrate = PetscFEIntegrate_Basic; 1182 fem->ops->integratebd = PetscFEIntegrateBd_Basic; 1183 fem->ops->integrateresidual = PetscFEIntegrateResidual_Basic; 1184 fem->ops->integratebdresidual = PetscFEIntegrateBdResidual_Basic; 1185 fem->ops->integratehybridresidual = PetscFEIntegrateHybridResidual_Basic; 1186 fem->ops->integratejacobianaction = NULL /* PetscFEIntegrateJacobianAction_Basic */; 1187 fem->ops->integratejacobian = PetscFEIntegrateJacobian_Basic; 1188 fem->ops->integratebdjacobian = PetscFEIntegrateBdJacobian_Basic; 1189 fem->ops->integratehybridjacobian = PetscFEIntegrateHybridJacobian_Basic; 1190 PetscFunctionReturn(PETSC_SUCCESS); 1191 } 1192 1193 /*MC 1194 PETSCFEBASIC = "basic" - A `PetscFE` object that integrates with basic tiling and no vectorization 1195 1196 Level: intermediate 1197 1198 .seealso: `PetscFE`, `PetscFEType`, `PetscFECreate()`, `PetscFESetType()` 1199 M*/ 1200 1201 PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem) 1202 { 1203 PetscFE_Basic *b; 1204 1205 PetscFunctionBegin; 1206 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 1207 PetscCall(PetscNew(&b)); 1208 fem->data = b; 1209 1210 PetscCall(PetscFEInitialize_Basic(fem)); 1211 PetscFunctionReturn(PETSC_SUCCESS); 1212 } 1213