PetscErrorCode FillExact(Vec uexact, unfemCtx *ctx) {
PetscErrorCode ierr;
const Node *aloc;
double *auexact;
int i;
ierr = UMGetNodeCoordArrayRead(ctx->mesh,&aloc); CHKERRQ(ierr);
ierr = VecGetArray(uexact,&auexact); CHKERRQ(ierr);
for (i = 0; i < ctx->mesh->N; i++) {
auexact[i] = ctx->uexact_fcn(aloc[i].x,aloc[i].y);
}
ierr = VecRestoreArray(uexact,&auexact); CHKERRQ(ierr);
ierr = UMRestoreNodeCoordArrayRead(ctx->mesh,&aloc); CHKERRQ(ierr);
return 0;
}
PetscErrorCode UMStats(UM *mesh, double *maxh, double *meanh, double *maxa, double *meana) {
PetscErrorCode ierr;
const int *ae;
const Node *aloc;
int k;
double x[3], y[3], ax, ay, bx, by, cx, cy, h, a,
Maxh = 0.0, Maxa = 0.0, Sumh = 0.0, Suma = 0.0;
if ((mesh->K == 0) || (mesh->e == NULL)) {
SETERRQ(PETSC_COMM_WORLD,1,
"number of elements unknown; call UMReadElements() first\n");
}
if (mesh->N == 0) {
SETERRQ(PETSC_COMM_WORLD,2,
"node size unknown so element check impossible; call UMReadNodes() first\n");
}
ierr = UMGetNodeCoordArrayRead(mesh,&aloc); CHKERRQ(ierr);
ierr = ISGetIndices(mesh->e,&ae); CHKERRQ(ierr);
for (k = 0; k < mesh->K; k++) {
x[0] = aloc[ae[3*k]].x;
y[0] = aloc[ae[3*k]].y;
x[1] = aloc[ae[3*k+1]].x;
y[1] = aloc[ae[3*k+1]].y;
x[2] = aloc[ae[3*k+2]].x;
y[2] = aloc[ae[3*k+2]].y;
ax = x[1] - x[0];
ay = y[1] - y[0];
bx = x[2] - x[0];
by = y[2] - y[0];
cx = x[1] - x[2];
cy = y[1] - y[2];
h = PetscMax(ax*ax+ay*ay, PetscMax(bx*bx+by*by, cx*cx+cy*cy));
h = sqrt(h);
a = 0.5 * PetscAbs(ax*by-ay*bx);
Maxh = PetscMax(Maxh,h);
Sumh += h;
Maxa = PetscMax(Maxa,a);
Suma += a;
}
ierr = ISRestoreIndices(mesh->e,&ae); CHKERRQ(ierr);
ierr = UMRestoreNodeCoordArrayRead(mesh,&aloc); CHKERRQ(ierr);
if (maxh) *maxh = Maxh;
if (maxa) *maxa = Maxa;
if (meanh) *meanh = Sumh / mesh->K;
if (meana) *meana = Suma / mesh->K;
return 0;
}
//STARTBDRYRESIDUALS
PetscErrorCode FormFunction(SNES snes, Vec u, Vec F, void *ctx) {
PetscErrorCode ierr;
unfemCtx *user = (unfemCtx*)ctx;
const int *abfn, *ae, *as, *abfs, *en, deg = user->quaddeg - 1;
const Node *aloc;
const double *au;
double *aF, unode[3], gradu[2], gradpsi[3][2], uquad[4], aquad[4],
fquad[4], dx, dy, dx1, dx2, dy1, dy2, detJ,
ls, xmid, ymid, sint, xx, yy, sum;
int n, p, na, nb, k, l, q;
PetscLogStagePush(user->resstage); //STRIP
ierr = VecGetArrayRead(u,&au); CHKERRQ(ierr);
ierr = VecSet(F,0.0); CHKERRQ(ierr);
ierr = VecGetArray(F,&aF); CHKERRQ(ierr);
ierr = UMGetNodeCoordArrayRead(user->mesh,&aloc); CHKERRQ(ierr);
// Dirichlet node residuals
ierr = ISGetIndices(user->mesh->bfn,&abfn); CHKERRQ(ierr);
for (n = 0; n < user->mesh->N; n++) {
if (abfn[n] == 2) // node is Dirichlet
aF[n] = au[n] - user->gD_fcn(aloc[n].x,aloc[n].y);
}
// Neumann segment contributions
ierr = ISGetIndices(user->mesh->s,&as); CHKERRQ(ierr);
ierr = ISGetIndices(user->mesh->bfs,&abfs); CHKERRQ(ierr);
for (p = 0; p < user->mesh->P; p++) {
if (abfs[p] == 1) { // segment is Neumann
na = as[2*p+0]; // nodes at end of segment
nb = as[2*p+1];
// length of segment
dx = aloc[na].x-aloc[nb].x;
dy = aloc[na].y-aloc[nb].y;
ls = sqrt(dx * dx + dy * dy);
// midpoint rule; psi_na=psi_nb=0.5 at midpoint of segment
xmid = 0.5*(aloc[na].x+aloc[nb].x);
ymid = 0.5*(aloc[na].y+aloc[nb].y);
sint = 0.5 * user->gN_fcn(xmid,ymid) * ls;
// nodes at end of segment could be Dirichlet
if (abfn[na] != 2)
aF[na] -= sint;
if (abfn[nb] != 2)
aF[nb] -= sint;
}
}
ierr = ISRestoreIndices(user->mesh->s,&as); CHKERRQ(ierr);
ierr = ISRestoreIndices(user->mesh->bfs,&abfs); CHKERRQ(ierr);
//ENDBDRYRESIDUALS
//STARTELEMENTRESIDUALS
// element contributions
ierr = ISGetIndices(user->mesh->e,&ae); CHKERRQ(ierr);
for (k = 0; k < user->mesh->K; k++) {
en = ae + 3*k; // en[0], en[1], en[2] are nodes of element k
// geometry of element
dx1 = aloc[en[1]].x - aloc[en[0]].x;
dx2 = aloc[en[2]].x - aloc[en[0]].x;
dy1 = aloc[en[1]].y - aloc[en[0]].y;
dy2 = aloc[en[2]].y - aloc[en[0]].y;
detJ = dx1 * dy2 - dx2 * dy1;
// gradients of hat functions
for (l = 0; l < 3; l++) {
gradpsi[l][0] = ( dy2 * dchi[l][0] - dy1 * dchi[l][1]) / detJ;
gradpsi[l][1] = (-dx2 * dchi[l][0] + dx1 * dchi[l][1]) / detJ;
}
// u and grad u on element
gradu[0] = 0.0;
gradu[1] = 0.0;
for (l = 0; l < 3; l++) {
if (abfn[en[l]] == 2)
unode[l] = user->gD_fcn(aloc[en[l]].x,aloc[en[l]].y);
else
unode[l] = au[en[l]];
gradu[0] += unode[l] * gradpsi[l][0];
gradu[1] += unode[l] * gradpsi[l][1];
}
// function values at quadrature points on element
for (q = 0; q < Q[deg]; q++) {
uquad[q] = eval(unode,xi[deg][q],eta[deg][q]);
xx = aloc[en[0]].x + dx1 * xi[deg][q] + dx2 * eta[deg][q];
yy = aloc[en[0]].y + dy1 * xi[deg][q] + dy2 * eta[deg][q];
aquad[q] = user->a_fcn(uquad[q],xx,yy);
fquad[q] = user->f_fcn(uquad[q],xx,yy);
}
// residual contribution for each node of element
for (l = 0; l < 3; l++) {
if (abfn[en[l]] < 2) { // if NOT a Dirichlet node
sum = 0.0;
for (q = 0; q < Q[deg]; q++)
sum += w[deg][q]
* ( aquad[q] * InnerProd(gradu,gradpsi[l])
- fquad[q] * chi(l,xi[deg][q],eta[deg][q]) );
aF[en[l]] += fabs(detJ) * sum;
}
}
}
ierr = ISRestoreIndices(user->mesh->e,&ae); CHKERRQ(ierr);
ierr = ISRestoreIndices(user->mesh->bfn,&abfn); CHKERRQ(ierr);
ierr = UMRestoreNodeCoordArrayRead(user->mesh,&aloc); CHKERRQ(ierr);
ierr = VecRestoreArrayRead(u,&au); CHKERRQ(ierr);
ierr = VecRestoreArray(F,&aF); CHKERRQ(ierr);
PetscLogStagePop(); //STRIP
return 0;
}
PetscErrorCode FormPicard(SNES snes, Vec u, Mat A, Mat P, void *ctx) {
PetscErrorCode ierr;
unfemCtx *user = (unfemCtx*)ctx;
const int *abfn, *ae, *en, deg = user->quaddeg - 1;
const Node *aloc;
const double *au;
double unode[3], gradpsi[3][2],
uquad[4], aquad[4], v[9],
dx1, dx2, dy1, dy2, detJ, xx, yy, sum;
int n, k, l, m, q, cr, cv, row[3];
PetscLogStagePush(user->jacstage); //STRIP
ierr = MatZeroEntries(P); CHKERRQ(ierr);
ierr = ISGetIndices(user->mesh->bfn,&abfn); CHKERRQ(ierr);
for (n = 0; n < user->mesh->N; n++) {
if (abfn[n] == 2) {
v[0] = 1.0;
ierr = MatSetValues(P,1,&n,1,&n,v,ADD_VALUES); CHKERRQ(ierr);
}
}
ierr = ISGetIndices(user->mesh->e,&ae); CHKERRQ(ierr);
ierr = VecGetArrayRead(u,&au); CHKERRQ(ierr);
ierr = UMGetNodeCoordArrayRead(user->mesh,&aloc); CHKERRQ(ierr);
for (k = 0; k < user->mesh->K; k++) {
en = ae + 3*k; // en[0], en[1], en[2] are nodes of element k
// geometry of element
dx1 = aloc[en[1]].x - aloc[en[0]].x;
dx2 = aloc[en[2]].x - aloc[en[0]].x;
dy1 = aloc[en[1]].y - aloc[en[0]].y;
dy2 = aloc[en[2]].y - aloc[en[0]].y;
detJ = dx1 * dy2 - dx2 * dy1;
// gradients of hat functions and u on element
for (l = 0; l < 3; l++) {
gradpsi[l][0] = ( dy2 * dchi[l][0] - dy1 * dchi[l][1]) / detJ;
gradpsi[l][1] = (-dx2 * dchi[l][0] + dx1 * dchi[l][1]) / detJ;
if (abfn[en[l]] == 2)
unode[l] = user->gD_fcn(aloc[en[l]].x,aloc[en[l]].y);
else
unode[l] = au[en[l]];
}
// function values at quadrature points on element
for (q = 0; q < Q[deg]; q++) {
uquad[q] = eval(unode,xi[deg][q],eta[deg][q]);
xx = aloc[en[0]].x + dx1 * xi[deg][q] + dx2 * eta[deg][q];
yy = aloc[en[0]].y + dy1 * xi[deg][q] + dy2 * eta[deg][q];
aquad[q] = user->a_fcn(uquad[q],xx,yy);
}
// generate 3x3 element stiffness matrix
cr = 0; // count rows
cv = 0; // count values
for (l = 0; l < 3; l++) {
if (abfn[en[l]] != 2) {
row[cr] = en[l];
cr++;
for (m = 0; m < 3; m++) {
if (abfn[en[m]] != 2) {
sum = 0.0;
for (q = 0; q < Q[deg]; q++) {
sum += w[deg][q] * aquad[q]
* InnerProd(gradpsi[l],gradpsi[m]);
}
v[cv] = fabs(detJ) * sum;
cv++;
}
}
}
}
// insert element stiffness matrix
ierr = MatSetValues(P,cr,row,cr,row,v,ADD_VALUES); CHKERRQ(ierr);
}
ierr = ISRestoreIndices(user->mesh->e,&ae); CHKERRQ(ierr);
ierr = ISRestoreIndices(user->mesh->bfn,&abfn); CHKERRQ(ierr);
ierr = VecRestoreArrayRead(u,&au); CHKERRQ(ierr);
ierr = UMRestoreNodeCoordArrayRead(user->mesh,&aloc); CHKERRQ(ierr);
ierr = MatAssemblyBegin(P,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(P,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
if (A != P) {
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
}
ierr = MatSetOption(P,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE); CHKERRQ(ierr);
PetscLogStagePop(); //STRIP
return 0;
}
