/* FormSource: Fill in source term f(x,y) in PDE from state X.
Does finite-differencing on X, so care is required with
differencing when working in parallel. */
PetscErrorCode FormSource(DM da,PorousCtx *user,Vec X,Vec F)
{
PetscInt i,j,Mx,My,xs,ys,xm,ym;
PetscErrorCode ierr;
PetscReal hx,hy;
PetscReal L, sig, beta;
PetscScalar **x, **f;
Vec Xlocal;
PetscScalar W, Wpow, Weast, Wwest, Wnorth, Wsouth,
Qx, Qy;
PetscFunctionBegin;
/* Get global and then local grid boundaries (for 2-dimensional DMDA):
Mx, My - total number of grid points in each dimension
xs, ys - starting grid indices (no ghost points)
xm, ym - widths of local grid (no ghost points) */
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,PETSC_NULL,&xm,&ym,PETSC_NULL);CHKERRQ(ierr);
/* set local constants */
L = user->L;
sig = user->sigma;
beta = user->beta;
hx = (2.0 * L) / (PetscReal)(Mx-1);
hy = (2.0 * L) / (PetscReal)(My-1);
/* we are going to difference X, so get a local vec and
communicate X into it */
ierr = DMCreateLocalVector(da,&Xlocal);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xlocal);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xlocal);CHKERRQ(ierr);
/* Compute source term in PDE over the locally owned part of
the grid by finite-differencing initial guess */
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,Xlocal,&x);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (i == 0 || j == 0 || i == Mx-1 || j == My-1) {
/* no other value makes sense; can't difference */
f[j][i] = 0.0;
} else {
W = x[j][i];
Weast = 0.5 * (x[j][i+1] + W);
Wwest = 0.5 * (x[j][i-1] + W);
Wnorth = 0.5 * (x[j+1][i] + W);
Wsouth = 0.5 * (x[j-1][i] + W);
Wpow = pow(W,sig);
Qx = ( Weast * (pow(x[j][i+1],sig) - Wpow)
- Wwest * (Wpow - pow(x[j][i-1],sig)) );
Qy = ( Wnorth * (pow(x[j+1][i],sig) - Wpow)
- Wsouth * (Wpow - pow(x[j-1][i],sig)) );
f[j][i] = W + beta * (Qx / (hx*hx) + Qy / (hy*hy));
}
}
}
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,Xlocal,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* FormGradient - Evaluates gradient of f.
Input Parameters:
. snes - the SNES context
. X - input vector
. ptr - optional user-defined context, as set by SNESSetFunction()
Output Parameters:
. G - vector containing the newly evaluated gradient
*/
PetscErrorCode FormGradient(SNES snes, Vec X, Vec G, void *ptr)
{
AppCtx *user;
int ierr;
PetscInt i,j;
PetscInt mx, my;
PetscScalar hx,hy, hydhx, hxdhy;
PetscScalar f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscScalar df1dxc,df2dxc,df3dxc,df4dxc,df5dxc,df6dxc;
PetscScalar **g, **x;
PetscInt xs,xm,ys,ym;
Vec localX;
DM da;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = SNESGetApplicationContext(snes,(void**)&user);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&mx,&my,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(mx+1);hy=1.0/(my+1); hydhx=hy/hx; hxdhy=hx/hy;
ierr = VecSet(G,0.0);CHKERRQ(ierr);
/* Get local vector */
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
/* Get ghost points */
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/* Get pointer to local vector data */
ierr = DMDAVecGetArray(da,localX, &x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,G, &g);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/* Compute function over the locally owned part of the mesh */
for (j=ys; j < ys+ym; j++) {
for (i=xs; i< xs+xm; i++) {
xc = x[j][i];
xlt=xrb=xl=xr=xb=xt=xc;
if (i==0) { /* left side */
xl = user->left[j+1];
xlt = user->left[j+2];
} else xl = x[j][i-1];
if (j==0) { /* bottom side */
xb = user->bottom[i+1];
xrb = user->bottom[i+2];
} else xb = x[j-1][i];
if (i+1 == mx) { /* right side */
xr = user->right[j+1];
xrb = user->right[j];
} else xr = x[j][i+1];
if (j+1==0+my) { /* top side */
xt = user->top[i+1];
xlt = user->top[i];
} else xt = x[j+1][i];
if (i>0 && j+1<my) xlt = x[j+1][i-1]; /* left top side */
if (j>0 && i+1<mx) xrb = x[j-1][i+1]; /* right bottom */
d1 = (xc-xl);
d2 = (xc-xr);
d3 = (xc-xt);
d4 = (xc-xb);
d5 = (xr-xrb);
d6 = (xrb-xb);
d7 = (xlt-xl);
d8 = (xt-xlt);
df1dxc = d1*hydhx;
df2dxc = (d1*hydhx + d4*hxdhy);
df3dxc = d3*hxdhy;
df4dxc = (d2*hydhx + d3*hxdhy);
df5dxc = d2*hydhx;
df6dxc = d4*hxdhy;
d1 /= hx;
d2 /= hx;
d3 /= hy;
d4 /= hy;
d5 /= hy;
d6 /= hx;
d7 /= hy;
d8 /= hx;
f1 = PetscSqrtScalar(1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtScalar(1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtScalar(1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtScalar(1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtScalar(1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtScalar(1.0 + d4*d4 + d6*d6);
df1dxc /= f1;
df2dxc /= f2;
df3dxc /= f3;
df4dxc /= f4;
df5dxc /= f5;
df6dxc /= f6;
g[j][i] = (df1dxc+df2dxc+df3dxc+df4dxc+df5dxc+df6dxc)/2.0;
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(da,localX, &x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,G, &g);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
ierr = PetscLogFlops(67*mx*my);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Applies some sweeps on nonlinear Gauss-Seidel on each process
*/
PetscErrorCode NonlinearGS(SNES snes,Vec X, Vec B, void *ctx)
{
PetscInt i,j,k,Mx,My,xs,ys,xm,ym,its,tot_its,sweeps,l;
PetscErrorCode ierr;
PetscReal lambda,hx,hy,hxdhy,hydhx,sc;
PetscScalar **x,**b,bij,F,F0=0,J,u,un,us,ue,eu,uw,uxx,uyy,y;
PetscReal atol,rtol,stol;
DM da;
AppCtx *user;
Vec localX,localB;
PetscFunctionBeginUser;
tot_its = 0;
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetApplicationContext(da,(void**)&user);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
lambda = user->param;
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
sc = hx*hy*lambda;
hxdhy = hx/hy;
hydhx = hy/hx;
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
for (l=0; l<sweeps; l++) {
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
/*
Get a pointer to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) ierr = DMDAVecGetArray(da,localB,&b);CHKERRQ(ierr);
/*
Get local grid boundaries (for 2-dimensional DMDA):
xs, ys - starting grid indices (no ghost points)
xm, ym - widths of local grid (no ghost points)
*/
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (i == 0 || j == 0 || i == Mx-1 || j == My-1) {
/* boundary conditions are all zero Dirichlet */
x[j][i] = 0.0;
} else {
if (B) bij = b[j][i];
else bij = 0.;
u = x[j][i];
un = x[j-1][i];
us = x[j+1][i];
ue = x[j][i-1];
uw = x[j][i+1];
for (k=0; k<its; k++) {
eu = PetscExpScalar(u);
uxx = (2.0*u - ue - uw)*hydhx;
uyy = (2.0*u - un - us)*hxdhy;
F = uxx + uyy - sc*eu - bij;
if (k == 0) F0 = F;
J = 2.0*(hydhx + hxdhy) - sc*eu;
y = F/J;
u -= y;
tot_its++;
if (atol > PetscAbsReal(PetscRealPart(F)) ||
rtol*PetscAbsReal(PetscRealPart(F0)) > PetscAbsReal(PetscRealPart(F)) ||
stol*PetscAbsReal(PetscRealPart(u)) > PetscAbsReal(PetscRealPart(y))) {
break;
}
}
x[j][i] = u;
}
}
}
/*
Restore vector
*/
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
}
ierr = PetscLogFlops(tot_its*(21.0));CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArray(da,localB,&b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode NonlinearGS(SNES snes, Vec X, Vec B, void *ctx)
{
DMDALocalInfo info;
Field **x,**b;
PetscErrorCode ierr;
Vec localX, localB;
DM da;
PetscInt xints,xinte,yints,yinte,i,j,k,l;
PetscInt n_pointwise = 50;
PetscInt n_sweeps = 3;
PetscReal hx,hy,dhx,dhy,hxdhy,hydhx;
PetscReal grashof,prandtl,lid;
PetscScalar u,uxx,uyy,vx,vy,avx,avy,vxp,vxm,vyp,vym;
PetscScalar fu, fv, fomega, ftemp;
PetscScalar dfudu;
PetscScalar dfvdv;
PetscScalar dfodu, dfodv, dfodo;
PetscScalar dftdu, dftdv, dftdt;
PetscScalar yu, yv, yo, yt;
PetscScalar bjiu, bjiv, bjiomega, bjitemp;
PetscBool ptconverged;
PetscScalar pfnorm, pfnorm0;
AppCtx *user = (AppCtx*)ctx;
PetscFunctionBegin;
grashof = user->grashof;
prandtl = user->prandtl;
lid = user->lidvelocity;
ierr = SNESGetDM(snes,(DM*)&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
/*
Scatter ghost points to local vector, using the 2-step process
DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
*/
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecGetArray(da,localB,&b);CHKERRQ(ierr);
}
/* looks like a combination of the formfunction / formjacobian routines */
dhx = (PetscReal)(info.mx-1); dhy = (PetscReal)(info.my-1);
hx = 1.0/dhx; hy = 1.0/dhy;
hxdhy = hx*dhy; hydhx = hy*dhx;
xints = info.xs; xinte = info.xs+info.xm; yints = info.ys; yinte = info.ys+info.ym;
/* Set the boundary conditions on the momentum equations */
/* Test whether we are on the bottom edge of the global array */
if (yints == 0) {
j = 0;
yints = yints + 1;
/* bottom edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the top edge of the global array */
if (yinte == info.my) {
j = info.my - 1;
yinte = yinte - 1;
/* top edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = lid + bjiu;
x[j][i].v = bjiv;
}
}
/* Test whether we are on the left edge of the global array */
if (xints == 0) {
i = 0;
xints = xints + 1;
/* left edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the right edge of the global array */
if (xinte == info.mx) {
i = info.mx - 1;
xinte = xinte - 1;
/* right edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
for (k=0; k < n_sweeps; k++) {
for (j=info.ys; j<info.ys + info.ym; j++) {
for (i=info.xs; i<info.xs + info.xm; i++) {
ptconverged = PETSC_FALSE;
pfnorm0 = 0.0;
pfnorm = 0.0;
fu = 0.0;
fv = 0.0;
fomega = 0.0;
ftemp = 0.0;
for (l = 0; l < n_pointwise && !ptconverged; l++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
bjiomega = b[j][i].omega;
bjitemp = b[j][i].temp;
} else {
bjiu = 0.0;
bjiv = 0.0;
bjiomega = 0.0;
bjitemp = 0.0;
}
if (i != 0 && i != info.mx - 1 && j != 0 && j != info.my-1) {
/* U velocity */
u = x[j][i].u;
uxx = (2.0*u - x[j][i-1].u - x[j][i+1].u)*hydhx;
uyy = (2.0*u - x[j-1][i].u - x[j+1][i].u)*hxdhy;
fu = uxx + uyy - .5*(x[j+1][i].omega-x[j-1][i].omega)*hx - bjiu;
dfudu = 2.0*(hydhx + hxdhy);
/* V velocity */
u = x[j][i].v;
uxx = (2.0*u - x[j][i-1].v - x[j][i+1].v)*hydhx;
uyy = (2.0*u - x[j-1][i].v - x[j+1][i].v)*hxdhy;
fv = uxx + uyy + .5*(x[j][i+1].omega-x[j][i-1].omega)*hy - bjiv;
dfvdv = 2.0*(hydhx + hxdhy);
/*
convective coefficients for upwinding
*/
vx = x[j][i].u; avx = PetscAbsScalar(vx);
vxp = .5*(vx+avx); vxm = .5*(vx-avx);
vy = x[j][i].v; avy = PetscAbsScalar(vy);
vyp = .5*(vy+avy); vym = .5*(vy-avy);
/* Omega */
u = x[j][i].omega;
uxx = (2.0*u - x[j][i-1].omega - x[j][i+1].omega)*hydhx;
uyy = (2.0*u - x[j-1][i].omega - x[j+1][i].omega)*hxdhy;
fomega = uxx + uyy +
(vxp*(u - x[j][i-1].omega) +
vxm*(x[j][i+1].omega - u)) * hy +
(vyp*(u - x[j-1][i].omega) +
vym*(x[j+1][i].omega - u)) * hx -
.5 * grashof * (x[j][i+1].temp - x[j][i-1].temp) * hy - bjiomega;
/* convective coefficient derivatives */
dfodo = 2.0*(hydhx + hxdhy) + ((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) {
dfodu = (u - x[j][i-1].omega)*hy;
} else {
dfodu = (x[j][i+1].omega - u)*hy;
}
if (PetscRealPart(vy) > 0.0) {
dfodv = (u - x[j-1][i].omega)*hx;
} else {
dfodv = (x[j+1][i].omega - u)*hx;
}
/* Temperature */
u = x[j][i].temp;
uxx = (2.0*u - x[j][i-1].temp - x[j][i+1].temp)*hydhx;
uyy = (2.0*u - x[j-1][i].temp - x[j+1][i].temp)*hxdhy;
ftemp = uxx + uyy + prandtl * (
(vxp*(u - x[j][i-1].temp) +
vxm*(x[j][i+1].temp - u)) * hy +
(vyp*(u - x[j-1][i].temp) +
vym*(x[j+1][i].temp - u)) * hx) - bjitemp;
dftdt = 2.0*(hydhx + hxdhy) + prandtl*((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) {
dftdu = prandtl*(u - x[j][i-1].temp)*hy;
} else {
dftdu = prandtl*(x[j][i+1].temp - u)*hy;
}
if (PetscRealPart(vy) > 0.0) {
dftdv = prandtl*(u - x[j-1][i].temp)*hx;
} else {
dftdv = prandtl*(x[j+1][i].temp - u)*hx;
}
/* invert the system:
[ dfu / du 0 0 0 ][yu] = [fu]
[ 0 dfv / dv 0 0 ][yv] [fv]
[ dfo / du dfo / dv dfo / do 0 ][yo] [fo]
[ dft / du dft / dv 0 dft / dt ][yt] [ft]
by simple back-substitution
*/
yu = fu / dfudu;
yv = fv / dfvdv;
yo = fomega / dfodo;
yt = ftemp / dftdt;
yo = (fomega - (dfodu*yu + dfodv*yv)) / dfodo;
yt = (ftemp - (dftdu*yu + dftdv*yv)) / dftdt;
x[j][i].u = x[j][i].u - yu;
x[j][i].v = x[j][i].v - yv;
x[j][i].temp = x[j][i].temp - yt;
x[j][i].omega = x[j][i].omega - yo;
}
if (i == 0) {
fomega = x[j][i].omega - (x[j][i+1].v - x[j][i].v)*dhx - bjiomega;
ftemp = x[j][i].temp - bjitemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (i == info.mx - 1) {
fomega = x[j][i].omega - (x[j][i].v - x[j][i-1].v)*dhx - bjiomega;
ftemp = x[j][i].temp - (PetscReal)(grashof>0) - bjitemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == 0) {
fomega = x[j][i].omega + (x[j+1][i].u - x[j][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j+1][i].temp - bjitemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == info.my - 1) {
fomega = x[j][i].omega + (x[j][i].u - x[j-1][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j-1][i].temp - bjitemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
pfnorm = fu*fu + fv*fv + fomega*fomega + ftemp*ftemp;
pfnorm = PetscSqrtScalar(pfnorm);
if (l == 0) pfnorm0 = pfnorm;
if (1e-15*PetscRealPart(pfnorm0) > PetscRealPart(pfnorm)) ptconverged = PETSC_TRUE;
}
}
}
}
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArray(da,localB,&b);CHKERRQ(ierr);
}
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = PetscLogFlops(n_sweeps*n_pointwise*(84.0 + 41)*info.ym*info.xm);CHKERRQ(ierr);
if (B) {
ierr = DMLocalToGlobalBegin(da,localB,INSERT_VALUES,B);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localB,INSERT_VALUES,B);CHKERRQ(ierr);
}
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
FormIFunction = Udot - RHSFunction
*/
PetscErrorCode
FormIFunction(TS ts, PetscReal /*t*/, Vec U, Vec Udot, Vec F, void * /*ctx*/)
{
PetscErrorCode ierr;
DM da;
PetscInt i, j, Mx, My, xs, ys, xm, ym;
PetscReal hx, hy, sx, sy;
PetscScalar u, uxx, uyy, **uarray, **f, **udot;
Vec localU;
MPI_Comm comm;
PetscFunctionBeginUser;
ierr = PetscObjectGetComm((PetscObject)ts, &comm);
ierr = TSGetDM(ts, &da);
CHKERRQ(ierr);
ierr = DMGetLocalVector(da, &localU);
CHKERRQ(ierr);
ierr = DMDAGetInfo(da,
PETSC_IGNORE,
&Mx,
&My,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE,
PETSC_IGNORE);
CHKERRQ(ierr);
hx = 1.0 / (PetscReal)(Mx - 1);
sx = 1.0 / (hx * hx);
hy = 1.0 / (PetscReal)(My - 1);
sy = 1.0 / (hy * hy);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da, U, INSERT_VALUES, localU);
CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da, U, INSERT_VALUES, localU);
CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da, localU, &uarray);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, F, &f);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, Udot, &udot);
CHKERRQ(ierr);
/* Get local grid boundaries */
ierr = DMDAGetCorners(da, &xs, &ys, NULL, &xm, &ym, NULL);
CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (j = ys; j < ys + ym; j++)
{
for (i = xs; i < xs + xm; i++)
{
/* Boundary conditions */
if (i == 0 || j == 0 || i == Mx - 1 || j == My - 1)
{
if (PETSC_TRUE)
{ /* Drichlet BC */
f[j][i] = uarray[j][i]; /* F = U */
}
else
{ /* Neumann BC */
if (i == 0 && j == 0)
{ /* SW corner */
f[j][i] = uarray[j][i] - uarray[j + 1][i + 1];
}
else if (i == Mx - 1 && j == 0)
{ /* SE corner */
f[j][i] = uarray[j][i] - uarray[j + 1][i - 1];
}
else if (i == 0 && j == My - 1)
{ /* NW corner */
f[j][i] = uarray[j][i] - uarray[j - 1][i + 1];
}
else if (i == Mx - 1 && j == My - 1)
{ /* NE corner */
f[j][i] = uarray[j][i] - uarray[j - 1][i - 1];
}
else if (i == 0)
{ /* Left */
f[j][i] = uarray[j][i] - uarray[j][i + 1];
}
else if (i == Mx - 1)
{ /* Right */
f[j][i] = uarray[j][i] - uarray[j][i - 1];
}
else if (j == 0)
{ /* Bottom */
f[j][i] = uarray[j][i] - uarray[j + 1][i];
}
else if (j == My - 1)
{ /* Top */
f[j][i] = uarray[j][i] - uarray[j - 1][i];
}
}
}
else
{ /* Interior */
u = uarray[j][i];
/* 5-point stencil */
uxx = (-2.0 * u + uarray[j][i - 1] + uarray[j][i + 1]);
uyy = (-2.0 * u + uarray[j - 1][i] + uarray[j + 1][i]);
if (PETSC_FALSE)
{
/* 9-point stencil: assume hx=hy */
uxx = 2.0 * uxx / 3.0 + (0.5 * (uarray[j - 1][i - 1] + uarray[j - 1][i + 1] +
uarray[j + 1][i - 1] + uarray[j + 1][i + 1]) -
2.0 * u) /
6.0;
uyy = 2.0 * uyy / 3.0 + (0.5 * (uarray[j - 1][i - 1] + uarray[j - 1][i + 1] +
uarray[j + 1][i - 1] + uarray[j + 1][i + 1]) -
2.0 * u) /
6.0;
}
f[j][i] = udot[j][i] - (uxx * sx + uyy * sy);
}
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da, localU, &uarray);
CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da, F, &f);
CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da, Udot, &udot);
CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da, &localU);
CHKERRQ(ierr);
ierr = PetscLogFlops(11.0 * ym * xm);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormFunction - Evaluates nonlinear function, F(x).
Input Parameters:
. ts - the TS context
. X - input vector
. ptr - optional user-defined context, as set by SNESSetFunction()
Output Parameter:
. F - function vector
*/
PetscErrorCode FormFunction(TS ts,PetscReal ftime,Vec X,Vec Xdot,Vec F,void *ptr)
{
DM da;
PetscErrorCode ierr;
PetscInt i,Mx,xs,xm;
PetscReal hx,sx;
PetscScalar r,l;
Field *x,*xdot,*f;
Vec localX,localXdot;
UserCtx *ctx = (UserCtx*)ptr;
PetscFunctionBegin;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localXdot);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
hx = 1.0/(PetscReal)Mx; sx = 1.0/(hx*hx);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,Xdot,INSERT_VALUES,localXdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,Xdot,INSERT_VALUES,localXdot);CHKERRQ(ierr);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArrayRead(da,localX,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,localXdot,&xdot);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
f[i].w = x[i].w + ctx->kappa*(x[i-1].u + x[i+1].u - 2.0*x[i].u)*sx;
if (ctx->cahnhillard) {
switch (ctx->energy) {
case 1: /* double well */
f[i].w += -x[i].u*x[i].u*x[i].u + x[i].u;
break;
case 2: /* double obstacle */
f[i].w += x[i].u;
break;
case 3: /* logarithmic */
if (x[i].u < -1.0 + 2.0*ctx->tol) f[i].w += .5*ctx->theta*(-log(ctx->tol) + log((1.0-x[i].u)/2.0)) + ctx->theta_c*x[i].u;
else if (x[i].u > 1.0 - 2.0*ctx->tol) f[i].w += .5*ctx->theta*(-log((1.0+x[i].u)/2.0) + log(ctx->tol)) + ctx->theta_c*x[i].u;
else f[i].w += .5*ctx->theta*(-log((1.0+x[i].u)/2.0) + log((1.0-x[i].u)/2.0)) + ctx->theta_c*x[i].u;
break;
case 4:
break;
}
}
f[i].u = xdot[i].u - (x[i-1].w + x[i+1].w - 2.0*x[i].w)*sx;
if (ctx->energy==4) {
f[i].u = xdot[i].u;
/* approximation of \grad (M(u) \grad w), where M(u) = (1-u^2) */
r = (1.0 - x[i+1].u*x[i+1].u)*(x[i+2].w-x[i].w)*.5/hx;
l = (1.0 - x[i-1].u*x[i-1].u)*(x[i].w-x[i-2].w)*.5/hx;
f[i].u -= (r - l)*.5/hx;
f[i].u += 2.0*ctx->theta_c*x[i].u*(x[i+1].u-x[i-1].u)*(x[i+1].u-x[i-1].u)*.25*sx - (ctx->theta - ctx->theta_c*(1-x[i].u*x[i].u))*(x[i+1].u + x[i-1].u - 2.0*x[i].u)*sx;
}
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArrayRead(da,localXdot,&xdot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,localX,&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localXdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
IFunction - Evaluates nonlinear function, F(U).
Input Parameters:
. ts - the TS context
. U - input vector
. ptr - optional user-defined context, as set by SNESSetFunction()
Output Parameter:
. F - function vector
*/
PetscErrorCode IFunction(TS ts,PetscReal ftime,Vec U,Vec Udot,Vec F,void *ptr)
{
AppCtx *appctx = (AppCtx*)ptr;
DM da;
PetscErrorCode ierr;
PetscInt i,Mx,xs,xm;
PetscReal hx,sx;
PetscScalar rho,c,rhoxx,cxx,cx,rhox,kcxrhox;
Field *u,*f,*udot;
Vec localU;
PetscFunctionBegin;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localU);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArray(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
if (!xs) {
f[0].rho = udot[0].rho; /* u[0].rho - 0.0; */
f[0].c = udot[0].c; /* u[0].c - 1.0; */
xs++;
xm--;
}
if (xs+xm == Mx) {
f[Mx-1].rho = udot[Mx-1].rho; /* u[Mx-1].rho - 1.0; */
f[Mx-1].c = udot[Mx-1].c; /* u[Mx-1].c - 0.0; */
xm--;
}
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
rho = u[i].rho;
rhoxx = (-2.0*rho + u[i-1].rho + u[i+1].rho)*sx;
c = u[i].c;
cxx = (-2.0*c + u[i-1].c + u[i+1].c)*sx;
if (!appctx->upwind) {
rhox = .5*(u[i+1].rho - u[i-1].rho)/hx;
cx = .5*(u[i+1].c - u[i-1].c)/hx;
kcxrhox = appctx->kappa*(cxx*rho + cx*rhox);
} else {
kcxrhox = appctx->kappa*((u[i+1].c - u[i].c)*u[i+1].rho - (u[i].c - u[i-1].c)*u[i].rho)*sx;
}
f[i].rho = udot[i].rho - appctx->epsilon*rhoxx + kcxrhox - appctx->mu*PetscAbsScalar(rho)*(1.0 - rho)*PetscMax(0,PetscRealPart(c - appctx->cstar)) + appctx->beta*rho;
f[i].c = udot[i].c - appctx->delta*cxx + appctx->lambda*c + appctx->alpha*rho*c/(appctx->gamma + c);
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localU);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode computeRHS2D(KSP ksp, Vec b, void* ctx){
FlowField & flowField = ((PetscUserCtx*)ctx)->getFlowField();
Parameters & parameters = ((PetscUserCtx*)ctx)->getParameters();
PetscUserCtx * context = ((PetscUserCtx*)ctx);
int *limitsX, *limitsY, *limitsZ;
((PetscUserCtx*)ctx)->getLimits(&limitsX, &limitsY, &limitsZ);
IntScalarField & flags = context->getFlowField().getFlags();
ScalarField & RHS = flowField.getRHS();
PetscInt i, j;
PetscInt Nx = parameters.geometry.sizeX + 2,
Ny = parameters.geometry.sizeY + 2;
PetscScalar** array;
DM da;
KSPGetDM(ksp, &da);
DMDAVecGetArray(da, b, &array);
// Iteration domains are going to be set and the values on the global boundary set when
// necessary
// Check left wall
if (context->setAsBoundary & LEFT_WALL_BIT){
if (parameters.simulation.scenario == "pressure-channel"){
for (j = limitsY[0]; j < limitsY[1]; j++){
array[j][0] = RHS.getScalar(0,j);
}
} else {
for (j = limitsY[0]; j < limitsY[1]; j++){
array[j][0] = 0;
}
}
}
// Check right wall
if (context->setAsBoundary & RIGHT_WALL_BIT){
for (j = limitsY[0]; j < limitsY[1]; j++){
array[j][Nx-1] = 0;
}
}
// Check bottom wall
if (context->setAsBoundary & BOTTOM_WALL_BIT){
for (i = limitsX[0]; i < limitsX[1]; i++){
array[0][i] = 0;
}
}
// Check top wall
if (context->setAsBoundary & TOP_WALL_BIT){
for (i = limitsX[0]; i < limitsX[1]; i++){
array[Ny-1][i] = 0;
}
}
// Fill the internal nodes. We already have the values
for (j = limitsY[0]; j < limitsY[1]; j++){
for (i = limitsX[0]; i < limitsX[1]; i++){
const int obstacle = flags.getValue(i-limitsX[0]+2, j-limitsY[0]+2);
if ((obstacle & OBSTACLE_SELF) == 0) { // If this is a fluid cell
array[j][i] = RHS.getScalar(i-limitsX[0]+2, j-limitsY[0]+2);
} else {
array[j][i] = 0.0;
}
}
}
DMDAVecRestoreArray(da, b, &array);
VecAssemblyBegin(b);
VecAssemblyEnd(b);
return 0;
}
PetscErrorCode computeRHS3D(KSP ksp, Vec b, void* ctx){
FlowField & flowField = ((PetscUserCtx*)ctx)->getFlowField();
Parameters & parameters = ((PetscUserCtx*)ctx)->getParameters();
ScalarField & RHS = flowField.getRHS();
PetscUserCtx * context = ((PetscUserCtx*)ctx);
IntScalarField & flags = flowField.getFlags();
int *limitsX, *limitsY, *limitsZ;
((PetscUserCtx*)ctx)->getLimits(&limitsX, &limitsY, &limitsZ);
PetscInt i, j, k;
PetscInt Nx = parameters.geometry.sizeX + 2,
Ny = parameters.geometry.sizeY + 2,
Nz = parameters.geometry.sizeZ + 2;
PetscScalar*** array;
DM da;
KSPGetDM(ksp, &da);
DMDAVecGetArray(da, b, &array);
// Notice that we're covering the whole surface, including corners and edges
// Also, the actual value is taking from the parameters.
// Left wall
if (context->setAsBoundary & LEFT_WALL_BIT){
if (parameters.simulation.scenario == "pressure-channel"){
for (k = limitsZ[0]; k < limitsZ[1]; k++){
for (j = limitsY[0]; j < limitsY[1]; j++){
array[k][j][0] = RHS.getScalar(0,j,k);
}
}
} else {
for (k = limitsZ[0]; k < limitsZ[1]; k++){
for (j = limitsY[0]; j < limitsY[1]; j++){
array[k][j][0] = 0;
}
}
}
}
// Right wall
if (context->setAsBoundary & RIGHT_WALL_BIT){
for (k = limitsZ[0]; k < limitsZ[1]; k++){
for (j = limitsY[0]; j < limitsY[1]; j++){
array[k][j][Nx-1] = 0;
}
}
}
// Bottom wall
if (context->setAsBoundary & BOTTOM_WALL_BIT){
for (k = limitsZ[0]; k < limitsZ[1]; k++){
for (i = limitsX[0]; i < limitsX[1]; i++){
array[k][0][i] = 0;
}
}
}
// Top wall
if (context->setAsBoundary & TOP_WALL_BIT){
for (k = limitsZ[0]; k < limitsZ[1]; k++){
for (i = limitsX[0]; i < limitsX[1]; i++){
array[k][Ny-1][i] = 0;
}
}
}
// Front wall
if (context->setAsBoundary & FRONT_WALL_BIT){
for (j = limitsY[0]; j < limitsY[1]; j++){
for (i = limitsX[0]; i < limitsX[1]; i++){
array[0][j][i] = 0;
}
}
}
// Back wall
if (context->setAsBoundary & BACK_WALL_BIT){
for (j = limitsY[0]; j < limitsY[1]; j++){
for (i = limitsX[0]; i < limitsX[1]; i++){
array[Nz-1][j][i] = 0;
}
}
}
// Fill the internal nodes. We already have the values
for (k = limitsZ[0]; k < limitsZ[1]; k++){
for (j = limitsY[0]; j < limitsY[1]; j++){
for (i = limitsX[0]; i < limitsX[1]; i++){
const int obstacle = flags.getValue(i-limitsX[0]+2, j-limitsY[0]+2, k-limitsZ[0]+2);
if ((obstacle & OBSTACLE_SELF) == 0) { // If this is a fluid cell
array[k][j][i] = RHS.getScalar(i-limitsX[0]+2, j-limitsY[0]+2, k-limitsZ[0]+2);
} else {
array[k][j][i] = 0.0;
}
}
}
}
DMDAVecRestoreArray(da, b, &array);
VecAssemblyBegin(b);
VecAssemblyEnd(b);
return 0;
}
/*
RHSFunction - Evaluates nonlinear function, F(x).
Input Parameters:
. ts - the TS context
. X - input vector
. ptr - optional user-defined context, as set by TSSetRHSFunction()
Output Parameter:
. F - function vector
*/
PetscErrorCode RHSFunction(TS ts,PetscReal ftime,Vec U,Vec F,void *ptr)
{
AppCtx *appctx = (AppCtx*)ptr;
DM da;
PetscErrorCode ierr;
PetscInt i,j,Mx,My,xs,ys,xm,ym;
PetscReal hx,hy,sx,sy;
PetscScalar uc,uxx,uyy,vc,vxx,vyy;
Field **u,**f;
Vec localU;
PetscFunctionBegin;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localU);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 2.50/(PetscReal)(Mx); sx = 1.0/(hx*hx);
hy = 2.50/(PetscReal)(My); sy = 1.0/(hy*hy);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArrayRead(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/*
Compute function over the locally owned part of the grid
*/
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
uc = u[j][i].u;
uxx = (-2.0*uc + u[j][i-1].u + u[j][i+1].u)*sx;
uyy = (-2.0*uc + u[j-1][i].u + u[j+1][i].u)*sy;
vc = u[j][i].v;
vxx = (-2.0*vc + u[j][i-1].v + u[j][i+1].v)*sx;
vyy = (-2.0*vc + u[j-1][i].v + u[j+1][i].v)*sy;
f[j][i].u = appctx->D1*(uxx + uyy) - uc*vc*vc + appctx->gamma*(1.0 - uc);
f[j][i].v = appctx->D2*(vxx + vyy) + uc*vc*vc - (appctx->gamma + appctx->kappa)*vc;
}
}
ierr = PetscLogFlops(16*xm*ym);CHKERRQ(ierr);
/*
Restore vectors
*/
ierr = DMDAVecRestoreArrayRead(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localU);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DM da2D;
PetscInt i,j,ixs, ixm, iys, iym;;
PetscViewer H5viewer;
PetscScalar xm = -1.0, xp=1.0;
PetscScalar ym = -1.0, yp=1.0;
PetscScalar value = 1.0,dx,dy;
PetscInt Nx = 40, Ny=40;
Vec gauss,input;
PetscScalar **gauss_ptr;
PetscReal norm;
const char *vecname;
dx=(xp-xm)/(Nx-1);
dy=(yp-ym)/(Ny-1);
/* Initialize the Petsc context */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,Nx,Ny,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da2D);CHKERRQ(ierr);
ierr = DMSetFromOptions(da2D);CHKERRQ(ierr);
ierr = DMSetUp(da2D);CHKERRQ(ierr);
/* Set the coordinates */
DMDASetUniformCoordinates(da2D, 0.0, 1.0, 0.0, 1.0, 0.0, 0.0);
/* Declare gauss as a DMDA component */
ierr = DMCreateGlobalVector(da2D,&gauss);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) gauss, "pressure");CHKERRQ(ierr);
/* Initialize vector gauss with a constant value (=1) */
ierr = VecSet(gauss,value);CHKERRQ(ierr);
/* Get the coordinates of the corners for each process */
ierr = DMDAGetCorners(da2D, &ixs, &iys, 0, &ixm, &iym, 0);CHKERRQ(ierr);
/* Build the gaussian profile (exp(-x^2-y^2)) */
ierr = DMDAVecGetArray(da2D,gauss,&gauss_ptr);CHKERRQ(ierr);
for (j=iys; j<iys+iym; j++) {
for (i=ixs; i<ixs+ixm; i++) {
gauss_ptr[j][i]=PetscExpScalar(-(xm+i*dx)*(xm+i*dx)-(ym+j*dy)*(ym+j*dy));
}
}
ierr = DMDAVecRestoreArray(da2D,gauss,&gauss_ptr);CHKERRQ(ierr);
/* Create the HDF5 viewer */
ierr = PetscViewerHDF5Open(PETSC_COMM_WORLD,"gauss.h5",FILE_MODE_WRITE,&H5viewer);CHKERRQ(ierr);
ierr = PetscViewerSetFromOptions(H5viewer);CHKERRQ(ierr);
/* Write the H5 file */
ierr = VecView(gauss,H5viewer);CHKERRQ(ierr);
/* Close the viewer */
ierr = PetscViewerDestroy(&H5viewer);CHKERRQ(ierr);
ierr = VecDuplicate(gauss,&input);CHKERRQ(ierr);
ierr = PetscObjectGetName((PetscObject)gauss,&vecname);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)input,vecname);CHKERRQ(ierr);
/* Create the HDF5 viewer for reading */
ierr = PetscViewerHDF5Open(PETSC_COMM_WORLD,"gauss.h5",FILE_MODE_READ,&H5viewer);CHKERRQ(ierr);
ierr = PetscViewerSetFromOptions(H5viewer);CHKERRQ(ierr);
ierr = VecLoad(input,H5viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&H5viewer);CHKERRQ(ierr);
ierr = VecAXPY(input,-1.0,gauss);CHKERRQ(ierr);
ierr = VecNorm(input,NORM_2,&norm);CHKERRQ(ierr);
if (norm > 1.e-6) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"Vec read in does not match vector written out");
ierr = VecDestroy(&input);CHKERRQ(ierr);
ierr = VecDestroy(&gauss);CHKERRQ(ierr);
ierr = DMDestroy(&da2D);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*
FormJacobian - Evaluates Jacobian matrix.
Input Parameters:
. snes - the SNES context
. x - input vector
. dummy - optional user-defined context (not used here)
Output Parameters:
. jac - Jacobian matrix
. B - optionally different preconditioning matrix
. flag - flag indicating matrix structure
*/
PetscErrorCode FormJacobian(SNES snes,Vec x,Mat *jac,Mat *B,MatStructure*flag,void *ctx)
{
ApplicationCtx *user = (ApplicationCtx*) ctx;
PetscScalar *xx,d,A[3];
PetscErrorCode ierr;
PetscInt i,j[3],M,xs,xm;
DM da = user->da;
PetscFunctionBegin;
/*
Get pointer to vector data
*/
ierr = DMDAVecGetArray(da,x,&xx);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Get range of locally owned matrix
*/
ierr = DMDAGetInfo(da,PETSC_NULL,&M,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,
PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Determine starting and ending local indices for interior grid points.
Set Jacobian entries for boundary points.
*/
if (xs == 0) { /* left boundary */
i = 0; A[0] = 1.0;
ierr = MatSetValues(*jac,1,&i,1,&i,A,INSERT_VALUES);CHKERRQ(ierr);
xs++;xm--;
}
if (xs+xm == M) { /* right boundary */
i = M-1; A[0] = 1.0;
ierr = MatSetValues(*jac,1,&i,1,&i,A,INSERT_VALUES);CHKERRQ(ierr);
xm--;
}
/*
Interior grid points
- Note that in this case we set all elements for a particular
row at once.
*/
d = 1.0/(user->h*user->h);
for (i=xs; i<xs+xm; i++) {
j[0] = i - 1; j[1] = i; j[2] = i + 1;
A[0] = A[2] = d; A[1] = -2.0*d + 2.0*xx[i];
ierr = MatSetValues(*jac,1,&i,3,j,A,INSERT_VALUES);CHKERRQ(ierr);
}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
Also, restore vector.
*/
ierr = MatAssemblyBegin(*jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,x,&xx);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
*flag = SAME_NONZERO_PATTERN;
PetscFunctionReturn(0);
}
/*
FormFunction - Evaluates nonlinear function, F(x).
Input Parameters:
. snes - the SNES context
. x - input vector
. ctx - optional user-defined context, as set by SNESSetFunction()
Output Parameter:
. f - function vector
Note:
The user-defined context can contain any application-specific
data needed for the function evaluation.
*/
PetscErrorCode FormFunction(SNES snes,Vec x,Vec f,void *ctx)
{
ApplicationCtx *user = (ApplicationCtx*) ctx;
DM da = user->da;
PetscScalar *xx,*ff,*FF,d;
PetscErrorCode ierr;
PetscInt i,M,xs,xm;
Vec xlocal;
PetscFunctionBegin;
ierr = DMGetLocalVector(da,&xlocal);CHKERRQ(ierr);
/*
Scatter ghost points to local vector, using the 2-step process
DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
By placing code between these two statements, computations can
be done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,x,INSERT_VALUES,xlocal);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,x,INSERT_VALUES,xlocal);CHKERRQ(ierr);
/*
Get pointers to vector data.
- The vector xlocal includes ghost point; the vectors x and f do
NOT include ghost points.
- Using DMDAVecGetArray() allows accessing the values using global ordering
*/
ierr = DMDAVecGetArray(da,xlocal,&xx);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,f,&ff);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,user->F,&FF);CHKERRQ(ierr);
/*
Get local grid boundaries (for 1-dimensional DMDA):
xs, xm - starting grid index, width of local grid (no ghost points)
*/
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_NULL,&M,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,
PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Set function values for boundary points; define local interior grid point range:
xsi - starting interior grid index
xei - ending interior grid index
*/
if (xs == 0) { /* left boundary */
ff[0] = xx[0];
xs++;xm--;
}
if (xs+xm == M) { /* right boundary */
ff[xs+xm-1] = xx[xs+xm-1] - 1.0;
xm--;
}
/*
Compute function over locally owned part of the grid (interior points only)
*/
d = 1.0/(user->h*user->h);
for (i=xs; i<xs+xm; i++) {
ff[i] = d*(xx[i-1] - 2.0*xx[i] + xx[i+1]) + xx[i]*xx[i] - FF[i];
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,xlocal,&xx);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,f,&ff);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,user->F,&FF);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&xlocal);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeJacobian_DMDA(SNES snes,Vec X,Mat *A,Mat *B,MatStructure *mstr,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x;
PetscFunctionBegin;
if (!dmdasnes->residuallocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (dmdasnes->jacobianlocal) {
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->jacobianlocal)(&info,x,*A,*B,mstr,dmdasnes->jacobianlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
} else {
MatFDColoring fdcoloring;
ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
if (!fdcoloring) {
ISColoring coloring;
ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,coloring,&fdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
switch (dm->coloringtype) {
case IS_COLORING_GLOBAL:
ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMDA,dmdasnes);CHKERRQ(ierr);
break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
}
ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);
/* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
* VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
* MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
* drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
* taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
*/
ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
}
*mstr = SAME_NONZERO_PATTERN;
ierr = MatFDColoringApply(*B,fdcoloring,X,mstr,snes);CHKERRQ(ierr);
}
/* This will be redundant if the user called both, but it's too common to forget. */
if (*A != *B) {
ierr = MatAssemblyBegin(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,Field ***x,Field ***f,void *ptr)
{
/* values for each basis function at each quadrature point */
AppCtx *user = (AppCtx*)ptr;
PetscInt i,j,k,l;
PetscInt ii,jj,kk;
Field ef[NEB];
Field ex[NEB];
CoordField ec[NEB];
PetscErrorCode ierr;
PetscInt xs=info->xs,ys=info->ys,zs=info->zs;
PetscInt xm=info->xm,ym=info->ym,zm=info->zm;
PetscInt xes,yes,zes,xee,yee,zee;
PetscInt mx=info->mx,my=info->my,mz=info->mz;
DM cda;
CoordField ***c;
Vec C;
PetscFunctionBegin;
ierr = DMGetCoordinateDM(info->da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(info->da,&C);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,C,&c);CHKERRQ(ierr);
ierr = DMDAGetInfo(info->da,0,&mx,&my,&mz,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(info->da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
/* loop over elements */
for (k=zs; k<zs+zm; k++) {
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
for (l=0;l<3;l++) {
f[k][j][i][l] = 0.;
}
}
}
}
/* element starts and ends */
xes = xs;
yes = ys;
zes = zs;
xee = xs+xm;
yee = ys+ym;
zee = zs+zm;
if (xs > 0) xes = xs - 1;
if (ys > 0) yes = ys - 1;
if (zs > 0) zes = zs - 1;
if (xs+xm == mx) xee = xs+xm-1;
if (ys+ym == my) yee = ys+ym-1;
if (zs+zm == mz) zee = zs+zm-1;
for (k=zes; k<zee; k++) {
for (j=yes; j<yee; j++) {
for (i=xes; i<xee; i++) {
GatherElementData(mx,my,mz,x,c,i,j,k,ex,ec,user);
FormElementJacobian(ex,ec,ef,NULL,user);
/* put this element's additions into the residuals */
for (kk=0;kk<NB;kk++){
for (jj=0;jj<NB;jj++) {
for (ii=0;ii<NB;ii++) {
PetscInt idx = ii + jj*NB + kk*NB*NB;
if (k+kk >= zs && j+jj >= ys && i+ii >= xs && k+kk < zs+zm && j+jj < ys+ym && i+ii < xs+xm) {
if (OnBoundary(i+ii,j+jj,k+kk,mx,my,mz)) {
for (l=0;l<3;l++)
f[k+kk][j+jj][i+ii][l] = x[k+kk][j+jj][i+ii][l] - ex[idx][l];
} else {
for (l=0;l<3;l++)
f[k+kk][j+jj][i+ii][l] += ef[idx][l];
}
}
}
}
}
}
}
}
ierr = DMDAVecRestoreArray(cda,C,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode FormIFunction(TS ts,PetscReal ftime,Vec U,Vec Udot,Vec F,void *ptr)
{
AppCtx *user=(AppCtx*)ptr;
DM da;
PetscErrorCode ierr;
PetscInt i,Mx,xs,xm;
PetscReal hx,sx;
PetscScalar *u,*udot,*f;
Vec localU;
PetscFunctionBegin;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localU);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
hx = 1.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* Get local grid boundaries */
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (i=xs; i<xs+xm; i++) {
if (user->boundary == 0) { /* Dirichlet BC */
if (i == 0 || i == Mx-1) {
f[i] = u[i]; /* F = U */
} else {
f[i] = udot[i] + (2.*u[i] - u[i-1] - u[i+1])*sx;
}
} else { /* Neumann BC */
if (i == 0) {
f[i] = u[0] - u[1];
} else if (i == Mx-1) {
f[i] = u[i] - u[i-1];
} else {
f[i] = udot[i] + (2.*u[i] - u[i-1] - u[i+1])*sx;
}
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localU);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode NonlinearGS(SNES snes,Vec X,Vec B,void *ptr)
{
/* values for each basis function at each quadrature point */
AppCtx *user = (AppCtx*)ptr;
PetscInt i,j,k,l,m,n,s;
PetscInt pi,pj,pk;
Field ef[1];
Field ex[8];
PetscScalar ej[9];
CoordField ec[8];
PetscScalar pjac[9],pjinv[9];
PetscScalar pf[3],py[3];
PetscErrorCode ierr;
PetscInt xs,ys,zs;
PetscInt xm,ym,zm;
PetscInt mx,my,mz;
DM cda;
CoordField ***c;
Vec C;
DM da;
Vec Xl,Bl;
Field ***x,***b;
PetscInt sweeps,its;
PetscReal atol,rtol,stol;
PetscReal fnorm0 = 0.0,fnorm,ynorm,xnorm = 0.0;
PetscFunctionBegin;
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&Xl);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&Bl);CHKERRQ(ierr);
}
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xl);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xl);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,Bl);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,Bl);CHKERRQ(ierr);
}
ierr = DMDAVecGetArray(da,Xl,&x);CHKERRQ(ierr);
if (B) ierr = DMDAVecGetArray(da,Bl,&b);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(da,&C);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,C,&c);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&mx,&my,&mz,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
for (s=0;s<sweeps;s++) {
for (k=zs; k<zs+zm; k++) {
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (OnBoundary(i,j,k,mx,my,mz)) {
BoundaryValue(i,j,k,mx,my,mz,x[k][j][i],user);
} else {
for (n=0;n<its;n++) {
for (m=0;m<9;m++) pjac[m] = 0.;
for (m=0;m<3;m++) pf[m] = 0.;
/* gather the elements for this point */
for (pk=-1; pk<1; pk++) {
for (pj=-1; pj<1; pj++) {
for (pi=-1; pi<1; pi++) {
/* check that this element exists */
if (i+pi >= 0 && i+pi < mx-1 && j+pj >= 0 && j+pj < my-1 && k+pk >= 0 && k+pk < mz-1) {
/* create the element function and jacobian */
GatherElementData(mx,my,mz,x,c,i+pi,j+pj,k+pk,ex,ec,user);
FormPBJacobian(-pi,-pj,-pk,ex,ec,ef,ej,user);
/* extract the point named by i,j,k from the whole element jacobian and function */
for (l=0;l<3;l++) {
pf[l] += ef[0][l];
for (m=0;m<3;m++) {
pjac[3*m+l] += ej[3*m+l];
}
}
}
}
}
}
/* invert */
InvertTensor(pjac,pjinv,NULL);
/* apply */
if (B) for (m=0;m<3;m++) {
pf[m] -= b[k][j][i][m];
}
TensorVector(pjinv,pf,py);
xnorm=0.;
for (m=0;m<3;m++) {
x[k][j][i][m] -= py[m];
xnorm += PetscRealPart(x[k][j][i][m]*x[k][j][i][m]);
}
fnorm = PetscRealPart(pf[0]*pf[0]+pf[1]*pf[1]+pf[2]*pf[2]);
if (n==0) fnorm0 = fnorm;
ynorm = PetscRealPart(py[0]*py[0]+py[1]*py[1]+py[2]*py[2]);
if (fnorm < atol*atol || fnorm < rtol*rtol*fnorm0 || ynorm < stol*stol*xnorm) break;
}
}
}
}
}
}
ierr = DMDAVecRestoreArray(da,Xl,&x);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,Xl,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,Xl,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Xl);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArray(da,Bl,&b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Bl);CHKERRQ(ierr);
}
ierr = DMDAVecRestoreArray(cda,C,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* FormTrueJacobianMatrixLocal - Evaluates analytical Jacobian matrix. */
PetscErrorCode FormTrueJacobianMatrixLocal(DMDALocalInfo *info,PetscScalar *u,Mat jacpre,Mat jac,AppCtx *user)
{
PetscErrorCode ierr;
PetscInt i, Mx;
PetscInt col[3],row[1];
PetscScalar v[3];
PetscReal hx, p, duL, duR, omHL, omHR;
PetscScalar *H;
Vec localH;
PetscFunctionBegin;
ierr = DMGetLocalVector(info->da,&localH);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(info->da,user->H,INSERT_VALUES,localH); CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(info->da,user->H,INSERT_VALUES,localH); CHKERRQ(ierr);
p = 1.0 + 1.0 / user->n;
Mx = info->mx;
hx = user->L / ((PetscReal)Mx - 1.0);
ierr = DMDAVecGetArray(info->da,localH,&H);CHKERRQ(ierr);
for (i=info->xs; i<info->xs+info->xm; i++) {
row[0] = i;
if (i == 0) {
col[0] = 0;
v[0] = 1.0;
ierr = MatSetValues(jac,1,row,1,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else {
if (i == 1) {
duL = u[i] - user->ug;
} else {
duL = u[i] - u[i-1];
}
omHL = GetOmega(duL, hx, p, user->epsilon) * H[i-1];
if (i == Mx-1) { /* Neumann: calving front stress boundary condition */
duR = u[Mx-2] + 2.0 * hx * user->gamma - u[Mx-1];
} else {
duR = u[i+1] - u[i];
}
omHR = GetOmega(duR, hx, p, user->epsilon) * H[i];
if (i == 1) {
col[0] = 1; col[1] = 2;
v[0] = - omHL - omHR; v[1] = omHR;
ierr = MatSetValues(jac,1,row,2,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else if (i == Mx-1) {
col[0] = i-1; col[1] = i;
v[0] = omHL + omHR; v[1] = - omHL - omHR;
ierr = MatSetValues(jac,1,row,2,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else {
col[0] = i-1; col[1] = i; col[2] = i+1;
v[0] = omHL; v[1] = - omHL - omHR; v[2] = omHR;
ierr = MatSetValues(jac,1,row,3,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
ierr = DMDAVecRestoreArray(info->da,localH,&H);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(info->da,&localH);CHKERRQ(ierr);
/* Assemble matrix, using the 2-step process */
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Tell the matrix we will never add a new nonzero location to the
matrix. If we do, it will generate an error. */
ierr = MatSetOption(jac,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
if (user->J != PETSC_NULL) {
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) user->J,"Jacobian_matrix"); CHKERRQ(ierr);
ierr = MatView(user->J, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Applies some sweeps on nonlinear Gauss-Seidel on each process
*/
PetscErrorCode NonlinearGS(SNES snes,Vec X)
{
PetscInt i,j,Mx,My,xs,ys,xm,ym,its,l;
PetscErrorCode ierr;
PetscReal hx,hy,hxdhy,hydhx;
PetscScalar **x,F,J,u,uxx,uyy;
DM da;
Vec localX;
PetscFunctionBeginUser;
ierr = SNESGetTolerances(snes,PETSC_NULL,PETSC_NULL,PETSC_NULL,&its,PETSC_NULL);CHKERRQ(ierr);
ierr = SNESShellGetContext(snes,(void**)&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
hxdhy = hx/hy;
hydhx = hy/hx;
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
for (l=0; l<its; l++) {
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/*
Get a pointer to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
/*
Get local grid boundaries (for 2-dimensional DMDA):
xs, ys - starting grid indices (no ghost points)
xm, ym - widths of local grid (no ghost points)
*/
ierr = DMDAGetCorners(da,&xs,&ys,PETSC_NULL,&xm,&ym,PETSC_NULL);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (i == 0 || j == 0 || i == Mx-1 || j == My-1) {
/* boundary conditions are all zero Dirichlet */
x[j][i] = 0.0;
} else {
u = x[j][i];
uxx = (2.0*u - x[j][i-1] - x[j][i+1])*hydhx;
uyy = (2.0*u - x[j-1][i] - x[j+1][i])*hxdhy;
F = uxx + uyy;
J = 2.0*(hydhx + hxdhy);
u = u - F/J;
x[j][i] = u;
}
}
}
/*
Restore vector
*/
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
}
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode InitialConditions(DM da,Vec C)
{
PetscErrorCode ierr;
PetscInt i,I,He,V,xs,xm,Mx,cnt = 0;
Concentrations *c;
PetscReal hx,x;
char string[16];
PetscFunctionBeginUser;
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(PetscReal)(Mx-1);
/* Name each of the concentrations */
for (He=1; He<N+1; He++) {
ierr = PetscSNPrintf(string,16,"%d-He",He);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,cnt++,string);CHKERRQ(ierr);
}
for (V=1; V<N+1; V++) {
ierr = PetscSNPrintf(string,16,"%d-V",V);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,cnt++,string);CHKERRQ(ierr);
}
for (I=1; I<N+1; I++) {
ierr = PetscSNPrintf(string,16,"%d-I",I);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,cnt++,string);CHKERRQ(ierr);
}
for (He=1; He<N+1; He++) {
for (V=1; V<N+1; V++) {
ierr = PetscSNPrintf(string,16,"%d-He-%d-V",He,V);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,cnt++,string);CHKERRQ(ierr);
}
}
/*
Get pointer to vector data
*/
ierr = DMDAVecGetArray(da,C,&c);CHKERRQ(ierr);
/* Shift the c pointer to allow accessing with index of 1, instead of 0 */
c = (Concentrations*)(((PetscScalar*)c)-1);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
x = i*hx;
for (He=1; He<N+1; He++) {
c[i].He[He] = 0.0;
}
for (V=1; V<N+1; V++) {
c[i].V[V] = 1.0;
}
for (I=1; I<N+1; I++) {
c[i].I[I] = 1.0;
}
for (He=1; He<N+1; He++) {
for (V=1; V<N+1; V++) {
c[i].HeV[He][V] = 0.0;
}
}
}
/*
Restore vectors
*/
c = (Concentrations*)(((PetscScalar*)c)+1);
ierr = DMDAVecRestoreArray(da,C,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode IFunction(TS ts,PetscReal t,Vec X,Vec Xdot,Vec F,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
DM cda;
DMDACoor2d **coors;
PetscScalar **p,**f,**pdot;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
Vec localX,gc,localXdot;
PetscScalar p_adv1,p_adv2,p_diff;
PetscFunctionBeginUser;
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
ierr = DMGetCoordinateDM(user->da,&cda);
CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);
CHKERRQ(ierr);
ierr = DMGetLocalVector(user->da,&localX);
CHKERRQ(ierr);
ierr = DMGetLocalVector(user->da,&localXdot);
CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);
CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);
CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(user->da,Xdot,INSERT_VALUES,localXdot);
CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->da,Xdot,INSERT_VALUES,localXdot);
CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(user->da,&gc);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,localX,&p);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,localXdot,&pdot);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,F,&f);
CHKERRQ(ierr);
user->disper_coe = PetscPowScalar((user->lambda*user->ws)/(2*user->H),2)*user->q*(1.0-PetscExpScalar(-t/user->lambda));
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
if (i == 0 || j == 0 || i == M-1 || j == N-1) {
ierr = BoundaryConditions(p,coors,i,j,M,N,f,user);
CHKERRQ(ierr);
} else {
ierr = adv1(p,coors[j][i].y,i,j,M,&p_adv1,user);
CHKERRQ(ierr);
ierr = adv2(p,coors[j][i].x,i,j,N,&p_adv2,user);
CHKERRQ(ierr);
ierr = diffuse(p,i,j,t,&p_diff,user);
CHKERRQ(ierr);
f[j][i] = -p_adv1 - p_adv2 + p_diff - pdot[j][i];
}
}
}
ierr = DMDAVecRestoreArray(user->da,localX,&p);
CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,localX,&pdot);
CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->da,&localX);
CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->da,&localXdot);
CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,F,&f);
CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(cda,gc,&coors);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
IFunction - Evaluates nonlinear function that defines the ODE
Input Parameters:
. ts - the TS context
. U - input vector
. ptr - optional user-defined context
Output Parameter:
. F - function values
*/
PetscErrorCode IFunction(TS ts,PetscReal ftime,Vec C,Vec Cdot,Vec F,void *ptr)
{
AppCtx *ctx = (AppCtx*) ptr;
DM da;
PetscErrorCode ierr;
PetscInt xi,Mx,xs,xm,He,he,V,v,I,i;
PetscReal hx,sx,x;
Concentrations *c,*f;
Vec localC;
PetscFunctionBeginUser;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localC);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
/*
F = Cdot + all the diffusion and reaction terms added below
*/
ierr = VecCopy(Cdot,F);CHKERRQ(ierr);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);CHKERRQ(ierr);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArray(da,localC,&c);CHKERRQ(ierr);
/* Shift the c pointer to allow accessing with index of 1, instead of 0 */
c = (Concentrations*)(((PetscScalar*)c)-1);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
f = (Concentrations*)(((PetscScalar*)f)-1);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Loop over grid points computing ODE terms for each grid point
*/
for (xi=xs; xi<xs+xm; xi++) {
x = xi*hx;
/* -------------------------------------------------------------
---- Compute diffusion over the locally owned part of the grid
*/
/* He clusters larger than 5 do not diffuse -- are immobile */
for (He=1; He<PetscMin(N+1,6); He++) {
f[xi].He[He] -= ctx->HeDiffusion[He]*(-2.0*c[xi].He[He] + c[xi-1].He[He] + c[xi+1].He[He])*sx;
}
/* V and I clusters ONLY of size 1 diffuse */
f[xi].V[1] -= ctx->VDiffusion[1]*(-2.0*c[xi].V[1] + c[xi-1].V[1] + c[xi+1].V[1])*sx;
f[xi].I[1] -= ctx->IDiffusion[1]*(-2.0*c[xi].I[1] + c[xi-1].I[1] + c[xi+1].I[1])*sx;
/* Mixed He - V clusters are immobile */
/* ----------------------------------------------------------------
---- Compute forcing that produces He of cluster size 1
Crude cubic approximation of graph from Tibo's notes
*/
f[xi].He[1] -= ctx->forcingScale*PetscMax(0.0,0.0006*x*x*x - 0.0087*x*x + 0.0300*x);
/* Are V or I produced? */
if (ctx->noreactions) continue;
/* ----------------------------------------------------------------
---- Compute reaction terms that can create a cluster of given size
*/
/* He[He] + He[he] -> He[He+he] */
for (He=2; He<N+1; He++) {
/* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
remove the upper half since they are symmetric to the lower half of the pairs. For example
when He = 5 (cluster size 5) the pairs are
1 4
2 2
3 2 these last two are not needed in the sum since they repeat from above
4 1 this is why he < (He/2) + 1 */
for (he=1; he<(He/2)+1; he++) {
f[xi].He[He] -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
/* remove the two clusters that merged to form the larger cluster */
f[xi].He[he] += ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
f[xi].He[He-he] += ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
}
}
/* V[V] + V[v] -> V[V+v] */
for (V=2; V<N+1; V++) {
for (v=1; v<(V/2)+1; v++) {
f[xi].V[V] -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
/* remove the clusters that merged to form the larger cluster */
f[xi].V[v] += ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
f[xi].V[V-v] += ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
}
}
/* I[I] + I[i] -> I[I+i] */
for (I=2; I<N+1; I++) {
for (i=1; i<(I/2)+1; i++) {
f[xi].I[I] -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
/* remove the clusters that merged to form the larger cluster */
f[xi].I[i] += ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
f[xi].I[I-i] += ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
}
}
/* He[1] + V[1] -> He[1]-V[1] */
f[xi].HeV[1][1] -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
/* remove the He and V that merged to form the He-V cluster */
f[xi].He[1] += 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
f[xi].V[1] += 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
/* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
for (He=1; He<N; He++) {
for (V=1; V<N+1; V++) {
for (he=1; he<N-He+1; he++) {
f[xi].HeV[He+he][V] -= ctx->reactionScale*c[xi].HeV[He][V]*c[xi].He[he];
/* remove the two clusters that merged to form the larger cluster */
f[xi].He[he] += ctx->reactionScale*c[xi].HeV[He][V]*c[xi].He[he];
f[xi].HeV[He][V] += ctx->reactionScale*c[xi].HeV[He][V]*c[xi].He[he];
}
}
}
/* He[He]-V[V] + V[v] -> He[He][V+v] */
for (He=1; He<N+1; He++) {
for (V=1; V<N; V++) {
for (v=1; v<N-V+1; v++) {
f[xi].HeV[He][V+v] -= ctx->reactionScale*c[xi].HeV[He][V]*c[xi].V[v];
/* remove the two clusters that merged to form the larger cluster */
f[xi].V[v] += ctx->reactionScale*c[xi].HeV[He][V]*c[xi].V[v];
f[xi].HeV[He][V] += ctx->reactionScale*c[xi].HeV[He][V]*c[xi].V[v];
}
}
}
/* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
/* Currently the reaction rates for this are zero */
for (He=1; He<N; He++) {
for (V=1; V<N; V++) {
for (he=1; he<N-He+1; he++) {
for (v=1; v<N-V+1; v++) {
f[xi].HeV[He+he][V+v] -= 0.0*c[xi].HeV[He][V]*c[xi].HeV[he][v];
/* remove the two clusters that merged to form the larger cluster */
f[xi].HeV[he][V] += 0.0*c[xi].HeV[He][V]*c[xi].HeV[he][v];
f[xi].HeV[He][V] += 0.0*c[xi].HeV[He][V]*c[xi].HeV[he][v];
}
}
}
}
/* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
if (ctx->nodissociations) continue;
/* -------------------------------------------------------------------------
---- Compute dissociation terms that removes an item from a cluster
I assume dissociation means losing only a single item from a cluster
I cannot tell from the notes if clusters can break up into any sub-size.
*/
/* He[He] -> He[He-1] + He[1] */
for (He=2; He<N+1; He++) {
f[xi].He[He-1] -= ctx->dissociationScale*c[xi].He[He];
f[xi].He[1] -= ctx->dissociationScale*c[xi].He[He];
f[xi].He[He] += ctx->dissociationScale*c[xi].He[He];
}
/* V[V] -> V[V-1] + V[1] */
for (V=2; V<N+1; V++) {
f[xi].V[V-1] -= ctx->dissociationScale*c[xi].V[V];
f[xi].V[1] -= ctx->dissociationScale*c[xi].V[V];
f[xi].V[V] += ctx->dissociationScale*c[xi].V[V];
}
/* I[I] -> I[I-1] + I[1] */
for (I=2; I<N+1; I++) {
f[xi].I[I-1] -= ctx->dissociationScale*c[xi].I[I];
f[xi].I[1] -= ctx->dissociationScale*c[xi].I[I];
f[xi].I[I] += ctx->dissociationScale*c[xi].I[I];
}
/* He[1]-V[1] -> He[1] + V[1] */
f[xi].He[1] -= 1000*ctx->reactionScale*c[xi].HeV[1][1];
f[xi].V[1] -= 1000*ctx->reactionScale*c[xi].HeV[1][1];
f[xi].HeV[1][1] += 1000*ctx->reactionScale*c[xi].HeV[1][1];
/* He[He]-V[1] -> He[He] + V[1] */
for (He=2; He<N+1; He++) {
f[xi].He[He] -= 1000*ctx->reactionScale*c[xi].HeV[He][1];
f[xi].V[1] -= 1000*ctx->reactionScale*c[xi].HeV[He][1];
f[xi].HeV[He][1] += 1000*ctx->reactionScale*c[xi].HeV[He][1];
}
/* He[1]-V[V] -> He[1] + V[V] */
for (V=2; V<N+1; V++) {
f[xi].He[1] -= 1000*ctx->reactionScale*c[xi].HeV[1][V];
f[xi].V[V] -= 1000*ctx->reactionScale*c[xi].HeV[1][V];
f[xi].HeV[1][V ] += 1000*ctx->reactionScale*c[xi].HeV[1][V];
}
/* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
for (He=2; He<N+1; He++) {
for (V=2; V<N+1; V++) {
f[xi].He[1] -= 1000*ctx->reactionScale*c[xi].HeV[He][V];
f[xi].HeV[He-1][V] -= 1000*ctx->reactionScale*c[xi].HeV[He][V];
f[xi].HeV[He][V] += 1000*ctx->reactionScale*c[xi].HeV[He][V];
}
}
/* He[He]-V[V] -> He[He]-V[V-1] + V[1] */
for (He=2; He<N+1; He++) {
for (V=2; V<N+1; V++) {
f[xi].V[1] -= 1000*ctx->reactionScale*c[xi].HeV[He][V];
f[xi].HeV[He][V-1] -= 1000*ctx->reactionScale*c[xi].HeV[He][V];
f[xi].HeV[He][V] += 1000*ctx->reactionScale*c[xi].HeV[He][V];
}
}
/* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
}
/*
Restore vectors
*/
c = (Concentrations*)(((PetscScalar*)c)+1);
ierr = DMDAVecRestoreArray(da,localC,&c);CHKERRQ(ierr);
f = (Concentrations*)(((PetscScalar*)f)+1);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localC);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode IJacobian(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal a,Mat *J,Mat *Jpre,MatStructure *flg,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
DM cda;
DMDACoor2d **coors;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
Vec gc;
PetscScalar val[5],xi,yi;
MatStencil row,col[5];
PetscScalar c1,c3,c5;
PetscFunctionBeginUser;
*flg = SAME_NONZERO_PATTERN;
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
PetscInt nc = 0;
row.i = i; row.j = j;
if (i == 0 || j == 0 || i == M-1 || j == N-1) {
if (user->bc == 0) {
col[nc].i = i; col[nc].j = j; val[nc++] = 1.0;
} else {
PetscScalar fthetac,fwc;
fthetac = user->ws/(2*user->H)*(user->PM_min - user->Pmax*sin(xi));
fwc = (yi*yi/2.0 - user->ws*yi);
if (i==0 && j==0) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = -fwc/user->dx + fthetac + user->disper_coe/user->dy;
} else if (i==0 && j == N-1) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/user->dx;
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = -fwc/user->dx + fthetac - user->disper_coe/user->dy;
} else if (i== M-1 && j == 0) {
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = fwc/user->dx + fthetac + user->disper_coe/user->dy;
} else if (i == M-1 && j == N-1) {
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/user->dx;
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = fwc/user->dx + fthetac - user->disper_coe/user->dy;
} else if (i==0) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j; val[nc++] = -fwc/user->dx + fthetac;
} else if (i == M-1) {
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j; val[nc++] = fwc/user->dx + fthetac;
} else if (j==0) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/(2*user->dx);
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/(2*user->dx);
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = user->disper_coe/user->dy + fthetac;
} else if (j == N-1) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/(2*user->dx);
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/(2*user->dx);
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = -user->disper_coe/user->dy + fthetac;
}
}
} else {
c1 = (yi-user->ws)/(2*user->dx);
c3 = (user->ws/(2.0*user->H))*(user->PM_min - user->Pmax*sin(xi))/(2*user->dy);
c5 = (PetscPowScalar((user->lambda*user->ws)/(2*user->H),2)*user->q*(1.0-PetscExpScalar(-t/user->lambda)))/(user->dy*user->dy);
col[nc].i = i-1; col[nc].j = j; val[nc++] = c1;
col[nc].i = i+1; col[nc].j = j; val[nc++] = -c1;
col[nc].i = i; col[nc].j = j-1; val[nc++] = c3 + c5;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -c3 + c5;
col[nc].i = i; col[nc].j = j; val[nc++] = -2*c5 -a;
}
ierr = MatSetValuesStencil(*Jpre,1,&row,nc,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (*J != *Jpre) {
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode FormGradient(SNES snes, Vec X, Vec G,void *ctx)
{
AppCtx *user=(AppCtx*)ctx;
PetscErrorCode info;
PetscInt i,j,k,kk;
PetscInt row[5],col[5];
PetscInt nx,ny,xs,xm,ys,ym;
PetscReal one=1.0, two=2.0, six=6.0,pi=4.0*atan(1.0);
PetscReal hx,hy,hxhy,hxhx,hyhy;
PetscReal xi,v[5];
PetscReal ecc=user->ecc, trule1,trule2,trule3,trule4,trule5,trule6;
PetscReal vmiddle, vup, vdown, vleft, vright;
PetscReal tt;
PetscReal **x,**g;
PetscReal zero=0.0;
Vec localX;
PetscFunctionBeginUser;
nx = user->nx;
ny = user->ny;
hx = two*pi/(nx+1.0);
hy = two*user->b/(ny+1.0);
hxhy = hx*hy;
hxhx = one/(hx*hx);
hyhy = one/(hy*hy);
info = VecSet(G, zero);CHKERRQ(info);
/* Get local vector */
info = DMGetLocalVector(user->da,&localX);CHKERRQ(info);
/* Get ghoist points */
info = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);CHKERRQ(info);
info = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);CHKERRQ(info);
/* Get pointer to vector data */
info = DMDAVecGetArray(user->da,localX,&x);CHKERRQ(info);
info = DMDAVecGetArray(user->da,G,&g);CHKERRQ(info);
info = DMDAGetCorners(user->da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(info);
for (i=xs; i< xs+xm; i++) {
xi = (i+1)*hx;
trule1 = hxhy*(p(xi,ecc) + p(xi+hx,ecc) + p(xi,ecc)) / six; /* L(i,j) */
trule2 = hxhy*(p(xi,ecc) + p(xi-hx,ecc) + p(xi,ecc)) / six; /* U(i,j) */
trule3 = hxhy*(p(xi,ecc) + p(xi+hx,ecc) + p(xi+hx,ecc)) / six; /* U(i+1,j) */
trule4 = hxhy*(p(xi,ecc) + p(xi-hx,ecc) + p(xi-hx,ecc)) / six; /* L(i-1,j) */
trule5 = trule1; /* L(i,j-1) */
trule6 = trule2; /* U(i,j+1) */
vdown = -(trule5+trule2)*hyhy;
vleft = -hxhx*(trule2+trule4);
vright = -hxhx*(trule1+trule3);
vup = -hyhy*(trule1+trule6);
vmiddle = (hxhx)*(trule1+trule2+trule3+trule4)+hyhy*(trule1+trule2+trule5+trule6);
for (j=ys; j<ys+ym; j++) {
v[0]=0; v[1]=0; v[2]=0; v[3]=0; v[4]=0;
k=0;
if (j > 0) {
v[k]=vdown; row[k] = i; col[k] = j-1; k++;
}
if (i > 0) {
v[k]= vleft; row[k] = i-1; col[k] = j; k++;
}
v[k]= vmiddle; row[k] = i; col[k] = j; k++;
if (i+1 < nx) {
v[k]= vright; row[k] = i+1; col[k] = j; k++;
}
if (j+1 < ny) {
v[k]= vup; row[k] = i; col[k] = j+1; k++;
}
tt=0;
for (kk=0; kk<k; kk++) tt+=v[kk]*x[col[kk]][row[kk]];
g[j][i] = tt;
}
}
/* Restore vectors */
info = DMDAVecRestoreArray(user->da,localX, &x);CHKERRQ(info);
info = DMDAVecRestoreArray(user->da,G, &g);CHKERRQ(info);
info = DMRestoreLocalVector(user->da,&localX);CHKERRQ(info);
info = VecAXPY(G, one, user->B);CHKERRQ(info);
info = PetscLogFlops((91 + 10*ym) * xm);CHKERRQ(info);
PetscFunctionReturn(0);
}
/* ------------------------------------------------------------------- */
PetscErrorCode FormInitialSolution(DM da,Vec U)
{
PetscErrorCode ierr;
PetscInt i,xs,xm,Mx,scale=1,N;
PetscScalar *u;
const PetscScalar *f;
PetscReal hx,x,r;
Vec finesolution;
PetscViewer viewer;
PetscBool flg;
PetscFunctionBegin;
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(PetscReal)Mx;
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArray(da,U,&u);CHKERRQ(ierr);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
/* InitialSolution is obtained with
./heat -ts_monitor -snes_monitor -pc_type lu -snes_converged_reason -ts_type cn -da_refine 9 -ts_max_time 1.e-4 -ts_dt .125e-6 -snes_atol 1.e-25 -snes_rtol 1.e-25 -ts_max_steps 15
*/
ierr = PetscOptionsHasName(NULL,NULL,"-square_initial",&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"InitialSolution.heat",FILE_MODE_READ,&viewer);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&finesolution);CHKERRQ(ierr);
ierr = VecLoad(finesolution,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = VecGetSize(finesolution,&N);CHKERRQ(ierr);
scale = N/Mx;
ierr = VecGetArrayRead(finesolution,&f);CHKERRQ(ierr);
}
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
x = i*hx;
r = PetscSqrtScalar((x-.5)*(x-.5));
if (r < .125) u[i] = 1.0;
else u[i] = -.5;
/* With the initial condition above the method is first order in space */
/* this is a smooth initial condition so the method becomes second order in space */
/*u[i] = PetscSinScalar(2*PETSC_PI*x); */
/* u[i] = f[scale*i];*/
if (!flg) u[i] = f[scale*i];
}
if (!flg) {
ierr = VecRestoreArrayRead(finesolution,&f);CHKERRQ(ierr);
ierr = VecDestroy(&finesolution);CHKERRQ(ierr);
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormHessian computes the quadratic term in the quadratic objective function
Notice that the objective function in this problem is quadratic (therefore a constant
hessian). If using a nonquadratic solver, then you might want to reconsider this function
*/
PetscErrorCode FormHessian(SNES snes,Vec X,Mat *H, Mat *Hpre, MatStructure *flg, void *ptr)
{
AppCtx *user=(AppCtx*)ptr;
PetscErrorCode info;
PetscInt i,j,k;
MatStencil row,col[5];
PetscInt nx,ny,xs,xm,ys,ym;
PetscReal one=1.0, two=2.0, six=6.0,pi=4.0*atan(1.0);
PetscReal hx,hy,hxhy,hxhx,hyhy;
PetscReal xi,v[5];
PetscReal ecc=user->ecc, trule1,trule2,trule3,trule4,trule5,trule6;
PetscReal vmiddle, vup, vdown, vleft, vright;
Mat hes=*H;
PetscBool assembled;
PetscReal **x;
Vec localX;
PetscFunctionBeginUser;
nx = user->nx;
ny = user->ny;
hx = two*pi/(nx+1.0);
hy = two*user->b/(ny+1.0);
hxhy = hx*hy;
hxhx = one/(hx*hx);
hyhy = one/(hy*hy);
info = MatAssembled(hes,&assembled);CHKERRQ(info);
if (assembled) {info = MatZeroEntries(hes);CHKERRQ(info);}
*flg=SAME_NONZERO_PATTERN;
/* Get local vector */
info = DMGetLocalVector(user->da,&localX);CHKERRQ(info);
/* Get ghost points */
info = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);CHKERRQ(info);
info = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);CHKERRQ(info);
/* Get pointers to vector data */
info = DMDAVecGetArray(user->da,localX, &x);CHKERRQ(info);
info = DMDAGetCorners(user->da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(info);
for (i=xs; i< xs+xm; i++) {
xi = (i+1)*hx;
trule1 = hxhy*(p(xi,ecc) + p(xi+hx,ecc) + p(xi,ecc)) / six; /* L(i,j) */
trule2 = hxhy*(p(xi,ecc) + p(xi-hx,ecc) + p(xi,ecc)) / six; /* U(i,j) */
trule3 = hxhy*(p(xi,ecc) + p(xi+hx,ecc) + p(xi+hx,ecc)) / six; /* U(i+1,j) */
trule4 = hxhy*(p(xi,ecc) + p(xi-hx,ecc) + p(xi-hx,ecc)) / six; /* L(i-1,j) */
trule5 = trule1; /* L(i,j-1) */
trule6 = trule2; /* U(i,j+1) */
vdown = -(trule5+trule2)*hyhy;
vleft = -hxhx*(trule2+trule4);
vright = -hxhx*(trule1+trule3);
vup = -hyhy*(trule1+trule6);
vmiddle = (hxhx)*(trule1+trule2+trule3+trule4)+hyhy*(trule1+trule2+trule5+trule6);
v[0]=0; v[1]=0; v[2]=0; v[3]=0; v[4]=0;
for (j=ys; j<ys+ym; j++) {
k =0;
row.i = i; row.j = j;
if (j > 0) {
v[k]=vdown; col[k].i=i;col[k].j = j-1; k++;
}
if (i > 0) {
v[k]= vleft; col[k].i= i-1; col[k].j = j;k++;
}
v[k]= vmiddle; col[k].i=i; col[k].j = j;k++;
if (i+1 < nx) {
v[k]= vright; col[k].i = i+1; col[k].j = j; k++;
}
if (j+1 < ny) {
v[k]= vup; col[k].i = i; col[k].j = j+1; k++;
}
info = MatSetValuesStencil(hes,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(info);
}
}
info = MatAssemblyBegin(hes,MAT_FINAL_ASSEMBLY);CHKERRQ(info);
info = DMDAVecRestoreArray(user->da,localX,&x);CHKERRQ(info);
info = MatAssemblyEnd(hes,MAT_FINAL_ASSEMBLY);CHKERRQ(info);
info = DMRestoreLocalVector(user->da,&localX);CHKERRQ(info);
/*
Tell the matrix we will never add a new nonzero location to the
matrix. If we do it will generate an error.
*/
info = MatSetOption(hes,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(info);
info = MatSetOption(hes,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(info);
info = PetscLogFlops(9*xm*ym+49*xm);CHKERRQ(info);
PetscFunctionReturn(0);
}
/*
FormJacobian - Evaluates Jacobian matrix.
Input Parameters:
. snes - SNES context
. X - input vector
. ptr - optional user-defined context, as set by SNESSetJacobian()
Output Parameters:
. tH - Jacobian matrix
*/
PetscErrorCode FormJacobian(SNES snes, Vec X, Mat H, Mat tHPre, void *ptr)
{
AppCtx *user;
PetscErrorCode ierr;
PetscInt i,j,k;
PetscInt mx, my;
MatStencil row,col[7];
PetscScalar hx, hy, hydhx, hxdhy;
PetscScalar f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscScalar hl,hr,ht,hb,hc,htl,hbr;
PetscScalar **x, v[7];
PetscBool assembled;
PetscInt xs,xm,ys,ym;
Vec localX;
DM da;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = SNESGetApplicationContext(snes,(void**)&user);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&mx,&my,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(mx+1); hy=1.0/(my+1); hydhx=hy/hx; hxdhy=hx/hy;
/* Set various matrix options */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled) {ierr = MatZeroEntries(H);CHKERRQ(ierr);}
/* Get local vector */
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
/* Get ghost points */
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,localX, &x);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/* Compute Jacobian over the locally owned part of the mesh */
for (j=ys; j< ys+ym; j++) {
for (i=xs; i< xs+xm; i++) {
xc = x[j][i];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left */
if (i==0) {
xl = user->left[j+1];
xlt = user->left[j+2];
} else xl = x[j][i-1];
/* Bottom */
if (j==0) {
xb =user->bottom[i+1];
xrb = user->bottom[i+2];
} else xb = x[j-1][i];
/* Right */
if (i+1 == mx) {
xr =user->right[j+1];
xrb = user->right[j];
} else xr = x[j][i+1];
/* Top */
if (j+1==my) {
xt =user->top[i+1];
xlt = user->top[i];
} else xt = x[j+1][i];
/* Top left */
if (i>0 && j+1<my) xlt = x[j+1][i-1];
/* Bottom right */
if (j>0 && i+1<mx) xrb = x[j-1][i+1];
d1 = (xc-xl)/hx;
d2 = (xc-xr)/hx;
d3 = (xc-xt)/hy;
d4 = (xc-xb)/hy;
d5 = (xrb-xr)/hy;
d6 = (xrb-xb)/hx;
d7 = (xlt-xl)/hy;
d8 = (xlt-xt)/hx;
f1 = PetscSqrtScalar(1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtScalar(1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtScalar(1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtScalar(1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtScalar(1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtScalar(1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+
(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+
(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+
(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+
(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) +
hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2.0*d1*d4)/(f2*f2*f2) +
(hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2.0*d2*d3)/(f4*f4*f4);
hl/=2.0; hr/=2.0; ht/=2.0; hb/=2.0; hbr/=2.0; htl/=2.0; hc/=2.0;
k =0;
row.i = i;row.j= j;
/* Bottom */
if (j>0) {
v[k] =hb;
col[k].i = i; col[k].j=j-1; k++;
}
/* Bottom right */
if (j>0 && i < mx -1) {
v[k] =hbr;
col[k].i = i+1; col[k].j = j-1; k++;
}
/* left */
if (i>0) {
v[k] = hl;
col[k].i = i-1; col[k].j = j; k++;
}
/* Centre */
v[k]= hc; col[k].i= row.i; col[k].j = row.j; k++;
/* Right */
if (i < mx-1) {
v[k] = hr;
col[k].i= i+1; col[k].j = j;k++;
}
/* Top left */
if (i>0 && j < my-1) {
v[k] = htl;
col[k].i = i-1;col[k].j = j+1; k++;
}
/* Top */
if (j < my-1) {
v[k] = ht;
col[k].i = i; col[k].j = j+1; k++;
}
ierr = MatSetValuesStencil(H,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Assemble the matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
ierr = PetscLogFlops(199*mx*my);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormJacobianLocal(DMDALocalInfo *info,Field ***x,Mat jacpre,Mat jac,void *ptr)
{
/* values for each basis function at each quadrature point */
AppCtx *user = (AppCtx*)ptr;
PetscInt i,j,k,m,l;
PetscInt ii,jj,kk;
PetscScalar ej[NPB*NPB];
PetscScalar vals[NPB*NPB];
Field ex[NEB];
CoordField ec[NEB];
PetscErrorCode ierr;
PetscInt xs=info->xs,ys=info->ys,zs=info->zs;
PetscInt xm=info->xm,ym=info->ym,zm=info->zm;
PetscInt xes,yes,zes,xee,yee,zee;
PetscInt mx=info->mx,my=info->my,mz=info->mz;
DM cda;
CoordField ***c;
Vec C;
PetscInt nrows;
MatStencil col[NPB],row[NPB];
PetscScalar v[9];
PetscFunctionBegin;
ierr = DMGetCoordinateDM(info->da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(info->da,&C);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,C,&c);CHKERRQ(ierr);
ierr = MatScale(jac,0.0);CHKERRQ(ierr);
xes = xs;
yes = ys;
zes = zs;
xee = xs+xm;
yee = ys+ym;
zee = zs+zm;
if (xs > 0) xes = xs-1;
if (ys > 0) yes = ys-1;
if (zs > 0) zes = zs-1;
if (xs+xm == mx) xee = xs+xm-1;
if (ys+ym == my) yee = ys+ym-1;
if (zs+zm == mz) zee = zs+zm-1;
for (k=zes; k<zee; k++) {
for (j=yes; j<yee; j++) {
for (i=xes; i<xee; i++) {
GatherElementData(mx,my,mz,x,c,i,j,k,ex,ec,user);
FormElementJacobian(ex,ec,NULL,ej,user);
ApplyBCsElement(mx,my,mz,i,j,k,ej);
nrows = 0.;
for (kk=0;kk<NB;kk++){
for (jj=0;jj<NB;jj++) {
for (ii=0;ii<NB;ii++) {
PetscInt idx = ii + jj*2 + kk*4;
for (m=0;m<3;m++) {
col[3*idx+m].i = i+ii;
col[3*idx+m].j = j+jj;
col[3*idx+m].k = k+kk;
col[3*idx+m].c = m;
if (i+ii >= xs && i+ii < xm+xs && j+jj >= ys && j+jj < ys+ym && k+kk >= zs && k+kk < zs+zm) {
row[nrows].i = i+ii;
row[nrows].j = j+jj;
row[nrows].k = k+kk;
row[nrows].c = m;
for (l=0;l<NPB;l++) vals[NPB*nrows + l] = ej[NPB*(3*idx+m) + l];
nrows++;
}
}
}
}
}
ierr = MatSetValuesStencil(jac,nrows,row,NPB,col,vals,ADD_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin(jac,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
/* set the diagonal */
v[0] = 1.;v[1] = 0.;v[2] = 0.;v[3] = 0.;v[4] = 1.;v[5] = 0.;v[6] = 0.;v[7] = 0.;v[8] = 1.;
for (k=zs; k<zs+zm; k++) {
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (OnBoundary(i,j,k,mx,my,mz)) {
for (m=0; m<3;m++) {
col[m].i = i;
col[m].j = j;
col[m].k = k;
col[m].c = m;
}
ierr = MatSetValuesStencil(jac,3,col,3,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
}
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(cda,C,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
RhsFunc - Evaluates nonlinear function F(u).
Input Parameters:
. ts - the TS context
. t - current time
. Xglobal - input vector
. F - output vector
. ptr - optional user-defined context, as set by SNESSetFunction()
Output Parameter:
. F - rhs function vector
*/
PetscErrorCode RhsFunc(TS ts,PetscReal t,Vec Xglobal,Vec F,void *ctx)
{
AppCtx *user = (AppCtx*)ctx; /* user-defined application context */
DM da = user->da;
PetscErrorCode ierr;
PetscInt i,j,Mx,My,xs,ys,xm,ym;
PetscReal dhx,dhy;
Vec localT;
Field **X,**Frhs; /* structures that contain variables of interest and left hand side of governing equations respectively */
PetscScalar csoil = user->csoil; /* heat constant for layer */
PetscScalar dzlay = user->dzlay; /* thickness of top soil layer */
PetscScalar emma = user->emma; /* emission parameter */
PetscScalar wind = user->wind; /* wind speed */
PetscScalar dewtemp = user->dewtemp; /* dew point temperature (moisture in air) */
PetscScalar pressure1 = user->pressure1; /* sea level pressure */
PetscScalar airtemp = user->airtemp; /* temperature of air near boundary layer inversion */
PetscScalar fract = user->fract; /* fraction of the sky covered by clouds */
PetscScalar Tc = user->Tc; /* temperature at base of lowest cloud layer */
PetscScalar lat = user->lat; /* latitude */
PetscScalar Cp = 1005.7; /* specific heat of air at constant pressure */
PetscScalar Rd = 287.058; /* gas constant for dry air */
PetscScalar diffconst = 1000; /* diffusion coefficient */
PetscScalar f = 2*0.0000727*PetscSinScalar(lat); /* coriolis force */
PetscScalar deep_grnd_temp = user->deep_grnd_temp; /* temp in lowest ground layer */
PetscScalar Ts,u,v,p;
PetscScalar u_abs,u_plus,u_minus,v_abs,v_plus,v_minus;
PetscScalar sfctemp1,fsfc1,Ra;
PetscScalar sheat; /* sensible heat flux */
PetscScalar latentheat; /* latent heat flux */
PetscScalar groundflux; /* flux from conduction of deep ground layer in contact with top soil */
PetscInt xend,yend;
PetscFunctionBeginUser;
ierr = DMGetLocalVector(da,&localT);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
dhx = (PetscReal)(Mx-1)/(5000*(Mx-1)); /* dhx = 1/dx; assume 2D space domain: [0.0, 1.e5] x [0.0, 1.e5] */
dhy = (PetscReal)(My-1)/(5000*(Mx-1)); /* dhy = 1/dy; */
/*
Scatter ghost points to local vector,using the 2-step process
DAGlobalToLocalBegin(),DAGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,Xglobal,INSERT_VALUES,localT);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,Xglobal,INSERT_VALUES,localT);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,localT,&X);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&Frhs);CHKERRQ(ierr);
/* Get local grid boundaries */
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
/* the interior points */
xend=xs+xm; yend=ys+ym;
for (j=ys; j<yend; j++) {
for (i=xs; i<xend; i++) {
Ts = X[j][i].Ts; u = X[j][i].u; v = X[j][i].v; p = X[j][i].p; /*P = X[j][i].P; */
sfctemp1 = (double)Ts;
sfctemp1 = (double)X[j][i].Ts;
ierr = calcfluxs(sfctemp1,airtemp,emma,fract,Tc,&fsfc1);CHKERRQ(ierr); /* calculates surface net radiative flux */
ierr = sensibleflux(sfctemp1,airtemp,wind,&sheat);CHKERRQ(ierr); /* calculate sensible heat flux */
ierr = latentflux(sfctemp1,dewtemp,wind,pressure1,&latentheat);CHKERRQ(ierr); /* calculates latent heat flux */
ierr = calc_gflux(sfctemp1,deep_grnd_temp,&groundflux);CHKERRQ(ierr); /* calculates flux from earth below surface soil layer by conduction */
ierr = calcfluxa(sfctemp1,airtemp,emma,&Ra); /* Calculates the change in downward radiative flux */
fsfc1 = fsfc1 + latentheat + sheat + groundflux; /* adds radiative, sensible heat, latent heat, and ground heat flux yielding net flux */
/* convective coefficients for upwinding */
u_abs = PetscAbsScalar(u);
u_plus = .5*(u + u_abs); /* u if u>0; 0 if u<0 */
u_minus = .5*(u - u_abs); /* u if u <0; 0 if u>0 */
v_abs = PetscAbsScalar(v);
v_plus = .5*(v + v_abs); /* v if v>0; 0 if v<0 */
v_minus = .5*(v - v_abs); /* v if v <0; 0 if v>0 */
/* Solve governing equations */
/* P = p*Rd*Ts; */
/* du/dt -> time change of east-west component of the wind */
Frhs[j][i].u = - u_plus*(u - X[j][i-1].u)*dhx - u_minus*(X[j][i+1].u - u)*dhx /* - u(du/dx) */
- v_plus*(u - X[j-1][i].u)*dhy - v_minus*(X[j+1][i].u - u)*dhy /* - v(du/dy) */
-(Rd/p)*(Ts*(X[j][i+1].p - X[j][i-1].p)*0.5*dhx + p*0*(X[j][i+1].Ts - X[j][i-1].Ts)*0.5*dhx) /* -(R/p)[Ts(dp/dx)+ p(dTs/dx)] */
/* -(1/p)*(X[j][i+1].P - X[j][i-1].P)*dhx */
+ f*v;
/* dv/dt -> time change of north-south component of the wind */
Frhs[j][i].v = - u_plus*(v - X[j][i-1].v)*dhx - u_minus*(X[j][i+1].v - v)*dhx /* - u(dv/dx) */
- v_plus*(v - X[j-1][i].v)*dhy - v_minus*(X[j+1][i].v - v)*dhy /* - v(dv/dy) */
-(Rd/p)*(Ts*(X[j+1][i].p - X[j-1][i].p)*0.5*dhy + p*0*(X[j+1][i].Ts - X[j-1][i].Ts)*0.5*dhy) /* -(R/p)[Ts(dp/dy)+ p(dTs/dy)] */
/* -(1/p)*(X[j+1][i].P - X[j-1][i].P)*dhy */
-f*u;
/* dT/dt -> time change of temperature */
Frhs[j][i].Ts = (fsfc1/(csoil*dzlay)) /* Fnet/(Cp*dz) diabatic change in T */
-u_plus*(Ts - X[j][i-1].Ts)*dhx - u_minus*(X[j][i+1].Ts - Ts)*dhx /* - u*(dTs/dx) advection x */
-v_plus*(Ts - X[j-1][i].Ts)*dhy - v_minus*(X[j+1][i].Ts - Ts)*dhy /* - v*(dTs/dy) advection y */
+ diffconst*((X[j][i+1].Ts - 2*Ts + X[j][i-1].Ts)*dhx*dhx /* + D(Ts_xx + Ts_yy) diffusion */
+ (X[j+1][i].Ts - 2*Ts + X[j-1][i].Ts)*dhy*dhy);
/* dp/dt -> time change of */
Frhs[j][i].p = -u_plus*(p - X[j][i-1].p)*dhx - u_minus*(X[j][i+1].p - p)*dhx /* - u*(dp/dx) */
-v_plus*(p - X[j-1][i].p)*dhy - v_minus*(X[j+1][i].p - p)*dhy; /* - v*(dp/dy) */
Frhs[j][i].Ta = Ra/Cp; /* dTa/dt time change of air temperature */
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(da,localT,&X);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&Frhs);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localT);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Solve Poisson Equation in Fourier space and pass the FFT
electrostatic potential to its caller, one could get the real-space
representation by simply call inverse FFT operation once
Vec uc_fft is intent(out).
Vec rho is intent(in).
real q is the overall factor.
To get the potential in kcal/mol as used in the rest of the code you
need to supply q = -4π/ε₀ that is -4 * M_PI * EPSILON0INV.
As a matter of fact, it appears that one could provide the same
factual parameter for rho and uc to effectively solve the Poisson
equation "in place".
Except of temporary allocation of a complex Vec does not have any
side effect.
*/
void bgy3d_poisson (const State *BHD, Vec uc_fft, Vec rho, real q)
{
const int *N = BHD->PD->N; /* [3] */
const real *h = BHD->PD->h;
real dk[3]; /* k-mesh spacing */
FOR_DIM
dk[dim] = 2 * M_PI / BHD->PD->L[dim];
const real h3 = h[0] * h[1] * h[2];
/* Get FFT of rho: rho(i, j, k) -> fft_rho(kx, ky, kz) placed into
complex uc_fft: */
MatMult (BHD->fft_mat, rho, uc_fft);
/*
Solving Poisson Equation (note the absence of -4π factor) with FFT
and IFFT:
Δu(x, y, z) = ρ(x, y, z)
because of x = ih, y = jh, and z = kh, with grid spacing h = L/n:
n² / L² Δu(i, j, k) = ρ(i, j, k)
In Fourier space the relation between FFT images of ρ and u is
(see FFTW manual "What FFTW Really Computes"):
u(kx, ky, kz) = ρ(kx, ky, kz) / (4 π² k² / L²)
with
k² = kx² + ky² + kz²
being the sum of squared integers. Finally do the inverse FFT
(see FFTW manual "What FFTW Really Computes"). Because of the
normalization IFFT(FFT(f)) = n³ * f we have:
u(i, j, k) = 1 / n³ * IFFT(u(kx, ky, kz))
*/
/* With q = -4π/ε₀ you would get the potential: */
/* scale by h3 in forward FFT */
const real scale = - q * h3;
/* Loop over local portion of the k-grid */
{
int x[3], n[3], i[3];
DMDAGetCorners (BHD->dc, &x[0], &x[1], &x[2], &n[0], &n[1], &n[2]);
complex ***uc_fft_;
DMDAVecGetArray (BHD->dc, uc_fft, &uc_fft_);
for (i[2] = x[2]; i[2] < x[2] + n[2]; i[2]++)
for (i[1] = x[1]; i[1] < x[1] + n[1]; i[1]++)
for (i[0] = x[0]; i[0] < x[0] + n[0]; i[0]++)
{
real k[3];
/* Take negative frequencies for i > N/2: */
FOR_DIM
k[dim] = KFREQ (i[dim], N[dim]) * dk[dim];
/*
For i, j, and k less than or equal to N/2 and uniform
box of size L this expression evaluates to (2π/L)² (i² +
j² + k²)
*/
const real k2 = SQR (k[2]) + SQR (k[1]) + SQR (k[0]);
real fac;
if (likely (k2 != 0.0))
fac = scale / k2;
else
fac = 0.0; /* gamma-point */
/* Here we compute in place: uc(kx, ky, kz) := scale
* rho(kx, ky, kz) / k² */
uc_fft_[i[2]][i[1]][i[0]] *= fac; /* complex */
}
DMDAVecRestoreArray (BHD->dc, uc_fft, &uc_fft_);
}
/*
* Leave IFFT to the caller when necessary, here we only pass out
* FFT coulomb potential
*/
}
