/*
Solution - Computes the exact solution at a given time
Input Parameters:
t - current time
solution - vector in which exact solution will be computed
appctx - user-defined application context
Output Parameter:
solution - vector with the newly computed exact solution
u(x,t) = sin(6*PI*(x - a*t)) + 3 * sin(2*PI*(x - a*t))
*/
PetscErrorCode Solution(TS ts,PetscReal t,Vec U,AppCtx *appctx)
{
PetscScalar *u;
PetscReal a=appctx->a,h,PI6,PI2;
PetscErrorCode ierr;
PetscInt i,mstart,mend,um,M;
DM da;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&mstart,0,0,&um,0,0);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
h = 1.0/M;
mend = mstart + um;
/* Get a pointer to vector data. */
ierr = DMDAVecGetArray(da,U,&u);CHKERRQ(ierr);
/* u[i] = sin(6*PI*(x[i] - a*t)) + 3 * sin(2*PI*(x[i] - a*t)) */
PI6 = PETSC_PI*6.;
PI2 = PETSC_PI*2.;
for (i=mstart; i<mend; i++) {
u[i] = PetscSinReal(PI6*(i*h - a*t)) + 3.*PetscSinReal(PI2*(i*h - a*t));
}
/* Restore vector */
ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
return 0;
}
/*
InitialConditions - Computes the solution at the initial time.
Input Parameter:
u - uninitialized solution vector (global)
appctx - user-defined application context
Output Parameter:
u - vector with solution at initial time (global)
*/
PetscErrorCode InitialConditions(TS ts,Vec U,AppCtx *appctx)
{
PetscScalar *u;
PetscErrorCode ierr;
PetscInt i,mstart,mend,um,M;
DM da;
PetscReal h;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&mstart,0,0,&um,0,0);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
h = 1.0/M;
mend = mstart + um;
/*
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.
- Note that the Fortran interface to VecGetArray() differs from the
C version. See the users manual for details.
*/
ierr = DMDAVecGetArray(da,U,&u);CHKERRQ(ierr);
/*
We initialize the solution array by simply writing the solution
directly into the array locations. Alternatively, we could use
VecSetValues() or VecSetValuesLocal().
*/
for (i=mstart; i<mend; i++) u[i] = PetscSinReal(PETSC_PI*i*6.*h) + 3.*PetscSinReal(PETSC_PI*i*2.*h);
/* Restore vector */
ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
return 0;
}
/*
FormExactSolution2 - Forms initial approximation.
Input Parameters:
da - The DM
user - user-defined application context
Output Parameter:
X - vector
*/
PetscErrorCode FormExactSolution2(DM da, AppCtx *user, Vec U)
{
DM coordDA;
Vec coordinates;
DMDACoor2d **coords;
PetscScalar **u;
PetscReal x, y;
PetscInt xs, ys, xm, ym, i, j;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = DMDAGetCorners(da, &xs, &ys, NULL, &xm, &ym, NULL);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(da, &coordDA);CHKERRQ(ierr);
ierr = DMGetCoordinates(da, &coordinates);CHKERRQ(ierr);
ierr = DMDAVecGetArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, U, &u);CHKERRQ(ierr);
for (j = ys; j < ys+ym; ++j) {
for (i = xs; i < xs+xm; ++i) {
x = PetscRealPart(coords[j][i].x);
y = PetscRealPart(coords[j][i].y);
u[j][i] = PetscSinReal(PETSC_PI*x)*PetscSinReal(PETSC_PI*y);
}
}
ierr = DMDAVecRestoreArray(da, U, &u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode GetExactEigenvalues(PetscInt M,PetscInt N,PetscInt P,PetscInt nconv,PetscReal *exact)
{
PetscInt n,i,j,k,l;
PetscReal *evals,ax,ay,az,sx,sy,sz;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ax = PETSC_PI/2/(M+1);
ay = PETSC_PI/2/(N+1);
az = PETSC_PI/2/(P+1);
n = PetscCeilReal(PetscPowReal(nconv,0.33333)+1);
ierr = PetscMalloc1(n*n*n,&evals);CHKERRQ(ierr);
l = 0;
for (i=1;i<=n;i++) {
sx = PetscSinReal(ax*i);
for (j=1;j<=n;j++) {
sy = PetscSinReal(ay*j);
for (k=1;k<=n;k++) {
sz = PetscSinReal(az*k);
evals[l++] = 4.0*(sx*sx+sy*sy+sz*sz);
}
}
}
ierr = PetscSortReal(n*n*n,evals);CHKERRQ(ierr);
for (i=0;i<nconv;i++) exact[i] = evals[i];
ierr = PetscFree(evals);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode trig_3d_u(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
{
u[0] = PetscSinReal(2.0*PETSC_PI*x[0]);
u[1] = PetscSinReal(2.0*PETSC_PI*x[1]) - 2.0*x[0]*x[1];
u[2] = PetscSinReal(2.0*PETSC_PI*x[2]) - 2.0*x[1]*x[2];
return 0;
}
PetscErrorCode CreateMesh(MPI_Comm comm, AppCtx *user, DM *dm)
{
PetscInt dim = user->dim;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = DMPlexCreateBoxMesh(comm, dim, user->simplex, user->cells, NULL, NULL, NULL, PETSC_TRUE, dm);CHKERRQ(ierr);
{
Parameter *param;
Vec coordinates;
PetscScalar *coords;
PetscReal alpha;
PetscInt cdim, N, bs, i;
ierr = DMGetCoordinateDim(*dm, &cdim);CHKERRQ(ierr);
ierr = DMGetCoordinates(*dm, &coordinates);CHKERRQ(ierr);
ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
ierr = VecGetBlockSize(coordinates, &bs);CHKERRQ(ierr);
if (bs != cdim) SETERRQ2(comm, PETSC_ERR_ARG_WRONG, "Invalid coordinate blocksize %D != embedding dimension %D", bs, cdim);
ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
ierr = PetscBagGetData(user->bag, (void **) ¶m);CHKERRQ(ierr);
alpha = param->alpha;
for (i = 0; i < N; i += cdim) {
PetscScalar x = coords[i+0];
PetscScalar y = coords[i+1];
coords[i+0] = PetscCosReal(alpha)*x - PetscSinReal(alpha)*y;
coords[i+1] = PetscSinReal(alpha)*x + PetscCosReal(alpha)*y;
}
ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
ierr = DMSetCoordinates(*dm, coordinates);CHKERRQ(ierr);
}
{
DM pdm = NULL;
PetscPartitioner part;
ierr = DMPlexGetPartitioner(*dm, &part);CHKERRQ(ierr);
ierr = PetscPartitionerSetFromOptions(part);CHKERRQ(ierr);
ierr = DMPlexDistribute(*dm, 0, NULL, &pdm);CHKERRQ(ierr);
if (pdm) {
ierr = DMDestroy(dm);CHKERRQ(ierr);
*dm = pdm;
}
}
ierr = DMSetFromOptions(*dm);CHKERRQ(ierr);
ierr = DMViewFromOptions(*dm, NULL, "-dm_view");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode ComputeB(AppCtx *user)
{
PetscErrorCode ierr;
PetscInt i,j;
PetscInt nx,ny,xs,xm,ys,ym;
PetscReal two=2.0, pi=4.0*atan(1.0);
PetscReal hx,hy,ehxhy;
PetscReal temp;
PetscReal ecc=user->ecc;
PetscReal **b;
PetscFunctionBeginUser;
nx = user->nx;
ny = user->ny;
hx = two*pi/(nx+1.0);
hy = two*user->b/(ny+1.0);
ehxhy = ecc*hx*hy;
/* Get pointer to local vector data */
ierr = DMDAVecGetArray(user->da,user->B, &b);CHKERRQ(ierr);
ierr = DMDAGetCorners(user->da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/* Compute the linear term in the objective function */
for (i=xs; i<xs+xm; i++) {
temp=PetscSinReal((i+1)*hx);
for (j=ys; j<ys+ym; j++) b[j][i] = -ehxhy*temp;
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(user->da,user->B,&b);CHKERRQ(ierr);
ierr = PetscLogFlops(5*xm*ym+3*xm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
ExactSolution - Computes the exact solution at a given time.
Input Parameters:
t - current time
solution - vector in which exact solution will be computed
appctx - user-defined application context
Output Parameter:
solution - vector with the newly computed exact solution
*/
PetscErrorCode ExactSolution(PetscReal t,Vec solution,AppCtx *appctx)
{
PetscScalar *s_localptr, h = appctx->h, ex1, ex2, sc1, sc2;
PetscInt i;
PetscErrorCode ierr;
/*
Get a pointer to vector data.
*/
ierr = VecGetArray(solution,&s_localptr);CHKERRQ(ierr);
/*
Simply write the solution directly into the array locations.
Alternatively, we culd use VecSetValues() or VecSetValuesLocal().
*/
ex1 = PetscExpReal(-36.*PETSC_PI*PETSC_PI*t); ex2 = PetscExpReal(-4.*PETSC_PI*PETSC_PI*t);
sc1 = PETSC_PI*6.*h; sc2 = PETSC_PI*2.*h;
for (i=0; i<appctx->m; i++) s_localptr[i] = PetscSinReal(PetscRealPart(sc1)*(PetscReal)i)*ex1 + 3.*PetscSinReal(PetscRealPart(sc2)*(PetscReal)i)*ex2;
/*
Restore vector
*/
ierr = VecRestoreArray(solution,&s_localptr);CHKERRQ(ierr);
return 0;
}
PetscScalar k1(AppCtx *ctx,PetscReal t)
{
PetscReal th = t/3600.0;
PetscReal barth = th - 24.0*floor(th/24.0);
if (((((PetscInt)th) % 24) < 4) || ((((PetscInt)th) % 24) >= 20)) return(1.0e-40);
else return(ctx->k1*PetscExpReal(7.0*PetscPowReal(PetscSinReal(.0625*PETSC_PI*(barth - 4.0)),.2)));
}
PetscErrorCode FormCoordinates(DM da,AppCtx *user)
{
PetscErrorCode ierr;
Vec coords;
DM cda;
PetscInt mx,my,mz;
PetscInt i,j,k,xs,ys,zs,xm,ym,zm;
CoordField ***x;
PetscFunctionBegin;
ierr = DMGetCoordinateDM(da,&cda);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(cda,&coords);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);
ierr = DMDAVecGetArray(da,coords,&x);CHKERRQ(ierr);
for (k=zs; k<zs+zm; k++) {
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
PetscReal cx = ((PetscReal)i) / (((PetscReal)(mx-1)));
PetscReal cy = ((PetscReal)j) / (((PetscReal)(my-1)));
PetscReal cz = ((PetscReal)k) / (((PetscReal)(mz-1)));
PetscReal rad = user->rad + cy*user->height;
PetscReal ang = (cx - 0.5)*user->arc;
x[k][j][i][0] = rad*PetscSinReal(ang);
x[k][j][i][1] = rad*PetscCosReal(ang) - (user->rad + 0.5*user->height)*PetscCosReal(-0.5*user->arc);
x[k][j][i][2] = user->width*(cz - 0.5);
}
}
}
ierr = DMDAVecRestoreArray(da,coords,&x);CHKERRQ(ierr);
ierr = DMSetCoordinates(da,coords);CHKERRQ(ierr);
ierr = VecDestroy(&coords);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormInitialSolution(TS ts,Vec X,void *ctx)
{
User user = (User)ctx;
DM da;
PetscInt i;
DMDALocalInfo info;
Field *x;
PetscReal hx;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = TSGetDM(ts,&da);
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
hx = 1.0/(PetscReal)(info.mx-1);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,X,&x);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (i=info.xs; i<info.xs+info.xm; i++) {
PetscReal xi = i*hx;
x[i].u = user->uleft*(1.-xi) + user->uright*xi + PetscSinReal(2.*PETSC_PI*xi);
x[i].v = user->vleft*(1.-xi) + user->vright*xi;
}
ierr = DMDAVecRestoreArray(da,X,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Calculates the exact solution to problems that have one */
PetscErrorCode ExactSolution(Vec Y, void* s, PetscReal t, PetscBool *flag)
{
PetscErrorCode ierr;
char *p = (char*) s;
PetscScalar *y;
PetscFunctionBegin;
if (!strcmp(p,"hull1972a1")) {
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
y[0] = PetscExpReal(-t);
*flag = PETSC_TRUE;
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
} else if (!strcmp(p,"hull1972a2")) {
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
y[0] = 1.0/PetscSqrtReal(t+1);
*flag = PETSC_TRUE;
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
} else if (!strcmp(p,"hull1972a3")) {
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
y[0] = PetscExpReal(PetscSinReal(t));
*flag = PETSC_TRUE;
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
} else if (!strcmp(p,"hull1972a4")) {
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
y[0] = 20.0/(1+19.0*PetscExpReal(-t/4.0));
*flag = PETSC_TRUE;
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
} else {
ierr = VecSet(Y,0);CHKERRQ(ierr);
*flag = PETSC_FALSE;
}
PetscFunctionReturn(0);
}
/*
Evaluates \integral_{-1}^{1} f*v_i where v_i is the ith basis polynomial via the GLL nodes and weights, since the v_i
basis function is zero at all nodes except the ith one the integral is simply the weight_i * f(node_i)
*/
PetscErrorCode ComputeRhs(DM da,PetscGLL *gll,Vec b)
{
PetscErrorCode ierr;
PetscInt i,j,xs,xn,n = gll->n;
PetscScalar *bb,*xx;
PetscReal xd;
Vec blocal,xlocal;
PetscFunctionBegin;
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xn,NULL,NULL);CHKERRQ(ierr);
xs = xs/(n-1);
xn = xn/(n-1);
ierr = DMGetLocalVector(da,&blocal);CHKERRQ(ierr);
ierr = VecZeroEntries(blocal);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,blocal,&bb);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(da,&xlocal);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,xlocal,&xx);CHKERRQ(ierr);
/* loop over local spectral elements */
for (j=xs; j<xs+xn; j++) {
/* loop over GLL points in each element */
for (i=0; i<n; i++) {
xd = xx[j*(n-1) + i];
bb[j*(n-1) + i] += -gll->weights[i]*(-20.*PETSC_PI*xd*PetscSinReal(5.*PETSC_PI*xd) + (2. - (5.*PETSC_PI)*(5.*PETSC_PI)*(xd*xd - 1.))*PetscCosReal(5.*PETSC_PI*xd));
}
}
ierr = DMDAVecRestoreArray(da,xlocal,&xx);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,blocal,&bb);CHKERRQ(ierr);
ierr = VecZeroEntries(b);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,blocal,ADD_VALUES,b);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,blocal,ADD_VALUES,b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&blocal);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode trig_u(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
{
PetscInt d;
*u = 0.0;
for (d = 0; d < dim; ++d) *u += PetscSinReal(2.0*PETSC_PI*x[d]);
return 0;
}
static void f0_trig_u(PetscInt dim, PetscInt Nf, PetscInt NfAux,
const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
{
PetscInt d;
for (d = 0; d < dim; ++d) f0[0] += -4.0*PetscSqr(PETSC_PI)*PetscSinReal(2.0*PETSC_PI*x[d]);
}
static PetscErrorCode CESolution(PetscReal t,Vec X,void *ctx)
{
PetscReal l = ((CECtx*)ctx)->lambda;
PetscErrorCode ierr;
PetscScalar *x;
PetscFunctionBeginUser;
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
x[0] = l/(l*l+1)*(l*PetscCosReal(t)+PetscSinReal(t)) - l*l/(l*l+1)*PetscExpReal(-l*t);
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
u = sin(2 pi x)
v = sin(2 pi y) - 2xy
\varepsilon = / 2 pi cos(2 pi x) -y \
\ -y 2 pi cos(2 pi y) - 2x /
Tr(\varepsilon) = div u = 2 pi (cos(2 pi x) + cos(2 pi y)) - 2 x
div \sigma = \partial_i \lambda \delta_{ij} \varepsilon_{kk} + \partial_i 2\mu\varepsilon_{ij}
= \lambda \partial_j 2 pi (cos(2 pi x) + cos(2 pi y)) + 2\mu < -4 pi^2 sin(2 pi x) - 1, -4 pi^2 sin(2 pi y) >
= \lambda < -4 pi^2 sin(2 pi x) - 2, -4 pi^2 sin(2 pi y) > + \mu < -8 pi^2 sin(2 pi x) - 2, -8 pi^2 sin(2 pi y) >
u = sin(2 pi x)
v = sin(2 pi y) - 2xy
w = sin(2 pi z) - 2yz
\varepsilon = / 2 pi cos(2 pi x) -y 0 \
| -y 2 pi cos(2 pi y) - 2x -z |
\ 0 -z 2 pi cos(2 pi z) - 2y /
Tr(\varepsilon) = div u = 2 pi (cos(2 pi x) + cos(2 pi y) + cos(2 pi z)) - 2 x - 2 y
div \sigma = \partial_i \lambda \delta_{ij} \varepsilon_{kk} + \partial_i 2\mu\varepsilon_{ij}
= \lambda \partial_j (2 pi (cos(2 pi x) + cos(2 pi y) + cos(2 pi z)) - 2 x - 2 y) + 2\mu < -4 pi^2 sin(2 pi x) - 1, -4 pi^2 sin(2 pi y) - 1, -4 pi^2 sin(2 pi z) >
= \lambda < -4 pi^2 sin(2 pi x) - 2, -4 pi^2 sin(2 pi y) - 2, -4 pi^2 sin(2 pi z) > + 2\mu < -4 pi^2 sin(2 pi x) - 1, -4 pi^2 sin(2 pi y) - 1, -4 pi^2 sin(2 pi z) >
*/
static void f0_elas_trig_u(PetscInt dim, PetscInt Nf, PetscInt NfAux,
const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
{
const PetscReal mu = 1.0;
const PetscReal lambda = 1.0;
const PetscReal fact = 4.0*PetscSqr(PETSC_PI);
PetscInt d;
for (d = 0; d < dim; ++d) f0[d] += -(2.0*mu + lambda) * fact*PetscSinReal(2.0*PETSC_PI*x[d]) - (d < dim-1 ? 2.0*(mu + lambda) : 0.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)
{
DM da = (DM) ctx;
PetscScalar *xx,*ff;
PetscReal h;
PetscErrorCode ierr;
PetscInt i,M,xs,xm;
Vec xlocal;
PetscFunctionBeginUser;
/* Get local work vector */
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);
/*
Get local grid boundaries (for 1-dimensional DMDA):
xs, xm - starting grid index, width of local grid (no ghost points)
*/
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,NULL,&M,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/*
Compute function over locally owned part of the grid
Note the [i-1] and [i+1] will automatically access the ghost points from other processes or the periodic points.
*/
h = 1.0/M;
for (i=xs; i<xs+xm; i++) ff[i] = (xx[i-1] - 2.0*xx[i] + xx[i+1])/(h*h) - PetscSinReal(2.0*PETSC_PI*i*h);
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,xlocal,&xx);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,f,&ff);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&xlocal);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode FormRHSFunction(TS ts,PetscReal t,Vec X,Vec F,void *ptr)
{
User user = (User)ptr;
DM da;
Vec Xloc;
DMDALocalInfo info;
PetscInt i,j;
PetscReal hx;
Field *f;
const Field *x;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
hx = 1.0/(PetscReal)info.mx;
/*
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 = DMGetLocalVector(da,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da,Xloc,(void*)&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (i=info.xs; i<info.xs+info.xm; i++) {
const PetscReal *a = user->a;
PetscReal u0t[2];
u0t[0] = 1.0 - PetscPowRealInt(PetscSinReal(12*t),4);
u0t[1] = 0.0;
for (j=0; j<2; j++) {
if (i == 0) f[i][j] = a[j]/hx*(1./3*u0t[j] + 0.5*x[i][j] - x[i+1][j] + 1./6*x[i+2][j]);
else if (i == 1) f[i][j] = a[j]/hx*(-1./12*u0t[j] + 2./3*x[i-1][j] - 2./3*x[i+1][j] + 1./12*x[i+2][j]);
else if (i == info.mx-2) f[i][j] = a[j]/hx*(-1./6*x[i-2][j] + x[i-1][j] - 0.5*x[i][j] - 1./3*x[i+1][j]);
else if (i == info.mx-1) f[i][j] = a[j]/hx*(-x[i][j] + x[i-1][j]);
else f[i][j] = a[j]/hx*(-1./12*x[i-2][j] + 2./3*x[i-1][j] - 2./3*x[i+1][j] + 1./12*x[i+2][j]);
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da,Xloc,(void*)&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Xloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Residual functions are in reference coordinates */
static void f0_bd_u(PetscInt dim, PetscInt Nf, PetscInt NfAux,
const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
PetscReal t, const PetscReal x[], const PetscReal n[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
{
const PetscReal Delta = PetscRealPart(constants[0]);
PetscReal alpha = PetscRealPart(constants[3]);
PetscReal X = PetscCosReal(alpha)*x[0] + PetscSinReal(alpha)*x[1];
PetscInt d;
for (d = 0; d < dim; ++d) {
f0[d] = -Delta * X * n[d];
}
}
/* FormFunctionLocalMMS2 - Evaluates nonlinear function, F(x) on local process patch */
PetscErrorCode FormFunctionLocalMMS2(DMDALocalInfo *info,PetscScalar **vx,PetscScalar **f,AppCtx *user)
{
PetscErrorCode ierr;
PetscInt i,j;
PetscReal lambda,hx,hy,hxdhy,hydhx;
PetscScalar u,ue,uw,un,us,uxx,uyy;
PetscReal x,y;
DM coordDA;
Vec coordinates;
DMDACoor2d **coords;
PetscFunctionBeginUser;
lambda = user->param;
hx = 1.0/(PetscReal)(info->mx-1);
hy = 1.0/(PetscReal)(info->my-1);
hxdhy = hx/hy;
hydhx = hy/hx;
/* Extract coordinates */
ierr = DMGetCoordinateDM(info->da, &coordDA);CHKERRQ(ierr);
ierr = DMGetCoordinates(info->da, &coordinates);CHKERRQ(ierr);
ierr = DMDAVecGetArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
if (i == 0 || j == 0 || i == info->mx-1 || j == info->my-1) {
f[j][i] = 2.0*(hydhx+hxdhy)*vx[j][i];
} else {
x = PetscRealPart(coords[j][i].x);
y = PetscRealPart(coords[j][i].y);
u = vx[j][i];
uw = vx[j][i-1];
ue = vx[j][i+1];
un = vx[j-1][i];
us = vx[j+1][i];
if (i-1 == 0) uw = 0.;
if (i+1 == info->mx-1) ue = 0.;
if (j-1 == 0) un = 0.;
if (j+1 == info->my-1) us = 0.;
uxx = (2.0*u - uw - ue)*hydhx;
uyy = (2.0*u - un - us)*hxdhy;
f[j][i] = uxx + uyy - hx*hy*(lambda*PetscExpScalar(u) + 2*PetscSqr(PETSC_PI)*PetscSinReal(PETSC_PI*x)*PetscSinReal(PETSC_PI*y) - lambda*exp(PetscSinReal(PETSC_PI*x)*PetscSinReal(PETSC_PI*y)));
}
}
}
ierr = DMDAVecRestoreArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
ierr = PetscLogFlops(11.0*info->ym*info->xm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode stdNormalArray(PetscReal *eps, PetscInt numdim, PetscRandom ran)
{
PetscInt i;
PetscScalar u1,u2;
PetscReal t;
PetscErrorCode ierr;
PetscFunctionBegin;
for (i=0; i<numdim; i+=2) {
ierr = PetscRandomGetValue(ran,&u1);CHKERRQ(ierr);
ierr = PetscRandomGetValue(ran,&u2);CHKERRQ(ierr);
t = PetscSqrtReal(-2*PetscLogReal(PetscRealPart(u1)));
eps[i] = t * PetscCosReal(2*PETSC_PI*PetscRealPart(u2));
eps[i+1] = t * PetscSinReal(2*PETSC_PI*PetscRealPart(u2));
}
PetscFunctionReturn(0);
}
/*
InitialConditions - Computes the solution at the initial time.
Input Parameter:
u - uninitialized solution vector (global)
appctx - user-defined application context
Output Parameter:
u - vector with solution at initial time (global)
*/
PetscErrorCode InitialConditions(Vec u,AppCtx *appctx)
{
PetscScalar *u_localptr;
PetscInt i;
PetscErrorCode 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.
- Note that the Fortran interface to VecGetArray() differs from the
C version. See the users manual for details.
*/
ierr = VecGetArray(u,&u_localptr);CHKERRQ(ierr);
/*
We initialize the solution array by simply writing the solution
directly into the array locations. Alternatively, we could use
VecSetValues() or VecSetValuesLocal().
*/
for (i=0; i<appctx->m; i++) u_localptr[i] = PetscSinReal(PETSC_PI*i*6.*appctx->h) + 3.*PetscSinReal(PETSC_PI*i*2.*appctx->h);
/*
Restore vector
*/
ierr = VecRestoreArray(u,&u_localptr);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = VecView(u,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
return 0;
}
/*
Defines the DAE passed to the time solver
*/
static PetscErrorCode IFunctionSemiExplicit(TS ts,PetscReal t,Vec Y,Vec Ydot,Vec F,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *y,*ydot;
PetscScalar *f;
PetscFunctionBegin;
/* The next three lines allow us to access the entries of the vectors directly */
ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecGetArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0]=-400* PetscSinReal(200*PETSC_PI*t) + 1000*y[3] + ydot[0];
f[1]=0.5 - 1/(2.* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + (500*y[1])/9. + ydot[1];
f[2]=-222.5522222222222 + 33/(100.* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + (1000*y[4])/27. + ydot[2];
f[3]=0.0006666766666666667 - 1/(1.e8* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + PetscSinReal(200*PETSC_PI*t)/2500. + y[0]/4500. - (11*y[3])/9000.;
f[4]=0.0006676566666666666 - 99/(1.e8* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + y[2]/9000. - y[4]/4500.;
ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Defines the DAE passed to the time solver
*/
static PetscErrorCode IFunctionImplicit(TS ts,PetscReal t,Vec Y,Vec Ydot,Vec F,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *y,*ydot;
PetscScalar *f;
PetscFunctionBegin;
/* The next three lines allow us to access the entries of the vectors directly */
ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecGetArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0]= PetscSinReal(200*PETSC_PI*t)/2500. - y[0]/1000. - ydot[0]/1.e6 + ydot[1]/1.e6;
f[1]=0.0006666766666666667 - PetscExpReal((500*(y[1] - y[2]))/13.)/1.e8 - y[1]/4500. + ydot[0]/1.e6 - ydot[1]/1.e6;
f[2]=-1.e-6 + PetscExpReal((500*(y[1] - y[2]))/13.)/1.e6 - y[2]/9000. - ydot[2]/500000.;
f[3]=0.0006676566666666666 - (99* PetscExpReal((500*(y[1] - y[2]))/13.))/1.e8 - y[3]/9000. - (3*ydot[3])/1.e6 + (3*ydot[4])/1.e6;
f[4]=-y[4]/9000. + (3*ydot[3])/1.e6 - (3*ydot[4])/1.e6;
ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank,size;
PetscErrorCode ierr;
PetscInt M = 60,time_steps = 100, localsize,j,i,mybase,myend,width,xbase,*localnodes = NULL;
DM da;
PetscViewer viewer,viewer_private;
PetscDraw draw;
Vec local,global;
PetscScalar *localptr,*globalptr;
PetscReal a,h,k;
PetscBool flg = PETSC_FALSE;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-M",&M,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/*
Test putting two nodes on each processor, exact last processor gets the rest
*/
ierr = PetscOptionsGetBool(NULL,"-distribute",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscMalloc1(size,&localnodes);CHKERRQ(ierr);
for (i=0; i<size-1; i++) localnodes[i] = 2;
localnodes[size-1] = M - 2*(size-1);
}
/* Set up the array */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,M,1,1,localnodes,&da);CHKERRQ(ierr);
ierr = PetscFree(localnodes);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = DMCreateLocalVector(da,&local);CHKERRQ(ierr);
/* Set up display to show combined wave graph */
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,"Entire Solution",20,480,800,200,&viewer);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawSetDoubleBuffer(draw);CHKERRQ(ierr);
/* determine starting point of each processor */
ierr = VecGetOwnershipRange(global,&mybase,&myend);CHKERRQ(ierr);
/* set up display to show my portion of the wave */
xbase = (int)((mybase)*((800.0 - 4.0*size)/M) + 4.0*rank);
width = (int)((myend-mybase)*800./M);
ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Local Portion of Solution",xbase,200,width,200,&viewer_private);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDraw(viewer_private,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawSetDoubleBuffer(draw);CHKERRQ(ierr);
/* Initialize the array */
ierr = VecGetLocalSize(local,&localsize);CHKERRQ(ierr);
ierr = VecGetArray(global,&globalptr);CHKERRQ(ierr);
for (i=1; i<localsize-1; i++) {
j = (i-1)+mybase;
globalptr[i-1] = PetscSinReal((PETSC_PI*j*6)/((PetscReal)M) + 1.2 * PetscSinReal((PETSC_PI*j*2)/((PetscReal)M))) * 2;
}
ierr = VecRestoreArray(global,&globalptr);CHKERRQ(ierr);
/* Assign Parameters */
a= 1.0;
h= 1.0/M;
k= h;
for (j=0; j<time_steps; j++) {
/* Global to Local */
ierr = DMGlobalToLocalBegin(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
/*Extract local array */
ierr = VecGetArray(local,&localptr);CHKERRQ(ierr);
ierr = VecGetArray(global,&globalptr);CHKERRQ(ierr);
/* Update Locally - Make array of new values */
/* Note: I don't do anything for the first and last entry */
for (i=1; i< localsize-1; i++) {
globalptr[i-1] = .5*(localptr[i+1]+localptr[i-1]) - (k / (2.0*a*h)) * (localptr[i+1] - localptr[i-1]);
}
ierr = VecRestoreArray(global,&globalptr);CHKERRQ(ierr);
ierr = VecRestoreArray(local,&localptr);CHKERRQ(ierr);
/* View my part of Wave */
ierr = VecView(global,viewer_private);CHKERRQ(ierr);
/* View global Wave */
ierr = VecView(global,viewer);CHKERRQ(ierr);
}
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_private);CHKERRQ(ierr);
ierr = VecDestroy(&local);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
PetscMPIInt rank,size;
PetscInt M = 14,time_steps = 20,w=1,s=1,localsize,j,i,mybase,myend,globalsize;
PetscErrorCode ierr;
DM da;
Vec global,local;
PetscScalar *globalptr,*localptr;
PetscReal h,k;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-M",&M,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/* Set up the array */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,M,w,s,NULL,&da);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* Make copy of local array for doing updates */
ierr = DMCreateLocalVector(da,&local);CHKERRQ(ierr);
/* determine starting point of each processor */
ierr = VecGetOwnershipRange(global,&mybase,&myend);CHKERRQ(ierr);
/* Initialize the Array */
ierr = VecGetLocalSize (global,&globalsize);CHKERRQ(ierr);
ierr = VecGetArray (global,&globalptr);CHKERRQ(ierr);
for (i=0; i<globalsize; i++) {
j = i + mybase;
globalptr[i] = PetscSinReal((PETSC_PI*j*6)/((PetscReal)M) + 1.2 * PetscSinReal((PETSC_PI*j*2)/((PetscReal)M))) * 4+4;
}
ierr = VecRestoreArray(global,&localptr);CHKERRQ(ierr);
/* Assign Parameters */
h= 1.0/M;
k= h*h/2.2;
ierr = VecGetLocalSize(local,&localsize);CHKERRQ(ierr);
for (j=0; j<time_steps; j++) {
/* Global to Local */
ierr = DMGlobalToLocalBegin(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
/*Extract local array */
ierr = VecGetArray(local,&localptr);CHKERRQ(ierr);
ierr = VecGetArray (global,&globalptr);CHKERRQ(ierr);
/* Update Locally - Make array of new values */
/* Note: I don't do anything for the first and last entry */
for (i=1; i< localsize-1; i++) {
globalptr[i-1] = localptr[i] + (k/(h*h)) * (localptr[i+1]-2.0*localptr[i]+localptr[i-1]);
}
ierr = VecRestoreArray (global,&globalptr);CHKERRQ(ierr);
ierr = VecRestoreArray(local,&localptr);CHKERRQ(ierr);
/* View Wave */
/* Set Up Display to Show Heat Graph */
#if defined(PETSC_USE_SOCKET_VIEWER)
ierr = VecView(global,PETSC_VIEWER_SOCKET_WORLD);CHKERRQ(ierr);
#endif
}
ierr = VecDestroy(&local);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
Mat A[NMAT]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt m=15,n,II,Istart,Iend,i,j,k;
PetscReal h,xi,xj,c[7] = { 2, .3, -2, .2, -2, -.3, -PETSC_PI/2 };
PetscScalar alpha,beta,gamma;
PetscBool flg;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP, "This example requires complex scalars");
#endif
ierr = PetscOptionsGetInt(NULL,"-m",&m,NULL);CHKERRQ(ierr);
n = m*m;
h = PETSC_PI/(m+1);
gamma = PetscExpScalar(PETSC_i*c[6]);
gamma = gamma/PetscAbsScalar(gamma);
k = 7;
ierr = PetscOptionsGetRealArray(NULL,"-c",c,&k,&flg);CHKERRQ(ierr);
if (flg && k!=7) SETERRQ1(PETSC_COMM_WORLD,1,"The number of parameters -c should be 7, you provided %D",k);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nPDDE stability, n=%D (m=%D)\n\n",n,m);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the polynomial matrices
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* initialize matrices */
for (i=0;i<NMAT;i++) {
ierr = MatCreate(PETSC_COMM_WORLD,&A[i]);CHKERRQ(ierr);
ierr = MatSetSizes(A[i],PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A[i]);CHKERRQ(ierr);
ierr = MatSetUp(A[i]);CHKERRQ(ierr);
}
ierr = MatGetOwnershipRange(A[0],&Istart,&Iend);CHKERRQ(ierr);
/* A[1] has a pattern similar to the 2D Laplacian */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
xi = (i+1)*h; xj = (j+1)*h;
alpha = c[0]+c[1]*PetscSinReal(xi)+gamma*(c[2]+c[3]*xi*(1.0-PetscExpReal(xi-PETSC_PI)));
beta = c[0]+c[1]*PetscSinReal(xj)-gamma*(c[2]+c[3]*xj*(1.0-PetscExpReal(xj-PETSC_PI)));
ierr = MatSetValue(A[1],II,II,alpha+beta-4.0/(h*h),INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[1],II,II-1,1.0/(h*h),INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[1],II,II+1,1.0/(h*h),INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[1],II,II-m,1.0/(h*h),INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[1],II,II+m,1.0/(h*h),INSERT_VALUES);CHKERRQ(ierr); }
}
/* A[0] and A[2] are diagonal */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
xi = (i+1)*h; xj = (j+1)*h;
alpha = c[4]+c[5]*xi*(PETSC_PI-xi);
beta = c[4]+c[5]*xj*(PETSC_PI-xj);
ierr = MatSetValue(A[0],II,II,alpha,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(A[2],II,II,beta,INSERT_VALUES);CHKERRQ(ierr);
}
/* assemble matrices */
for (i=0;i<NMAT;i++) {
ierr = MatAssemblyBegin(A[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
for (i=0;i<NMAT;i++) {
ierr = MatAssemblyEnd(A[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
ierr = PEPSetOperators(pep,NMAT,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPPrintSolution(pep,NULL);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
for (i=0;i<NMAT;i++) {
ierr = MatDestroy(&A[i]);CHKERRQ(ierr);
}
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
/* ------------------------------------------------------------------- */
PetscErrorCode InitialConditions(DM da,Vec U)
{
PetscErrorCode ierr;
PetscInt i,j,xs,ys,xm,ym,Mx,My;
Field **u;
PetscReal hx,hy,x,y;
PetscFunctionBegin;
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.5/(PetscReal)(Mx);
hy = 2.5/(PetscReal)(My);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArray(da,U,&u);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++) {
y = j*hy;
for (i=xs; i<xs+xm; i++) {
x = i*hx;
if ((1.0 <= x) && (x <= 1.5) && (1.0 <= y) && (y <= 1.5)) u[j][i].v = .25*PetscPowReal(PetscSinReal(4.0*PETSC_PI*x),2.0)*PetscPowReal(PetscSinReal(4.0*PETSC_PI*y),2.0);
else u[j][i].v = 0.0;
u[j][i].u = 1.0 - 2.0*u[j][i].v;
}
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int Argc,char **Args)
{
PetscBool flg;
PetscInt n = -6;
PetscScalar rho = 1.0;
PetscReal h;
PetscReal beta = 1.0;
DM da;
PetscRandom rctx;
PetscMPIInt comm_size;
Mat H,HtH;
PetscInt x, y, xs, ys, xm, ym;
PetscReal r1, r2;
PetscScalar uxy1, uxy2;
MatStencil sxy, sxy_m;
PetscScalar val, valconj;
Vec b, Htb,xvec;
KSP kspmg;
PC pcmg;
PetscErrorCode ierr;
PetscInt ix[1] = {0};
PetscScalar vals[1] = {1.0};
PetscInitialize(&Argc,&Args,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-size",&n,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-beta",&beta,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(NULL,"-rho",&rho,&flg);CHKERRQ(ierr);
/* Set the fudge parameters, we scale the whole thing by 1/(2*h) later */
h = 1.;
rho *= 1./(2.*h);
/* Geometry info */
ierr = DMDACreate2d(PETSC_COMM_WORLD, DMDA_BOUNDARY_PERIODIC,DMDA_BOUNDARY_PERIODIC, DMDA_STENCIL_STAR, n, n,
PETSC_DECIDE, PETSC_DECIDE, 2 /* this is the # of dof's */,
1, NULL, NULL, &da);CHKERRQ(ierr);
/* Random numbers */
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
/* Single or multi processor ? */
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&comm_size);CHKERRQ(ierr);
/* construct matrix */
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da, &H);CHKERRQ(ierr);
/* get local corners for this processor */
ierr = DMDAGetCorners(da,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
/* Assemble the matrix */
for (x=xs; x<xs+xm; x++) {
for (y=ys; y<ys+ym; y++) {
/* each lattice point sets only the *forward* pointing parameters (right, down),
i.e. Nabla_1^+ and Nabla_2^+.
In this way we can use only local random number creation. That means
we also have to set the corresponding backward pointing entries. */
/* Compute some normally distributed random numbers via Box-Muller */
ierr = PetscRandomGetValueReal(rctx, &r1);CHKERRQ(ierr);
r1 = 1.-r1; /* to change from [0,1) to (0,1], which we need for the log */
ierr = PetscRandomGetValueReal(rctx, &r2);CHKERRQ(ierr);
PetscReal R = PetscSqrtReal(-2.*PetscLogReal(r1));
PetscReal c = PetscCosReal(2.*PETSC_PI*r2);
PetscReal s = PetscSinReal(2.*PETSC_PI*r2);
/* use those to set the field */
uxy1 = PetscExpScalar(((PetscScalar) (R*c/beta))*PETSC_i);
uxy2 = PetscExpScalar(((PetscScalar) (R*s/beta))*PETSC_i);
sxy.i = x; sxy.j = y; /* the point where we are */
/* center action */
sxy.c = 0; /* spin 0, 0 */
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy, &rho, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 1; /* spin 1, 1 */
val = -rho;
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
sxy_m.i = x+1; sxy_m.j = y; /* right action */
sxy.c = 0; sxy_m.c = 0; /* spin 0, 0 */
val = -uxy1; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 0; sxy_m.c = 1; /* spin 0, 1 */
val = -uxy1; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 1; sxy_m.c = 0; /* spin 1, 0 */
val = uxy1; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 1; sxy_m.c = 1; /* spin 1, 1 */
val = uxy1; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy_m.i = x; sxy_m.j = y+1; /* down action */
sxy.c = 0; sxy_m.c = 0; /* spin 0, 0 */
val = -uxy2; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 0; sxy_m.c = 1; /* spin 0, 1 */
val = -PETSC_i*uxy2; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 1; sxy_m.c = 0; /* spin 1, 0 */
val = -PETSC_i*uxy2; valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
sxy.c = 1; sxy_m.c = 1; /* spin 1, 1 */
val = PetscConj(uxy2); valconj = PetscConj(val);
ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(H, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* scale H */
ierr = MatScale(H, 1./(2.*h));CHKERRQ(ierr);
/* it looks like H is Hermetian */
/* construct normal equations */
ierr = MatMatMult(H, H, MAT_INITIAL_MATRIX, 1., &HtH);CHKERRQ(ierr);
/* permutation matrix to check whether H and HtH are identical to the ones in the paper */
/* Mat perm; */
/* ierr = DMCreateMatrix(da, &perm);CHKERRQ(ierr); */
/* PetscInt row, col; */
/* PetscScalar one = 1.0; */
/* for (PetscInt i=0; i<n; i++) { */
/* for (PetscInt j=0; j<n; j++) { */
/* row = (i*n+j)*2; col = i*n+j; */
/* ierr = MatSetValues(perm, 1, &row, 1, &col, &one, INSERT_VALUES);CHKERRQ(ierr); */
/* row = (i*n+j)*2+1; col = i*n+j + n*n; */
/* ierr = MatSetValues(perm, 1, &row, 1, &col, &one, INSERT_VALUES);CHKERRQ(ierr); */
/* } */
/* } */
/* ierr = MatAssemblyBegin(perm, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); */
/* ierr = MatAssemblyEnd(perm, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); */
/* Mat Hperm; */
/* ierr = MatPtAP(H, perm, MAT_INITIAL_MATRIX, 1.0, &Hperm);CHKERRQ(ierr); */
/* ierr = PetscPrintf(PETSC_COMM_WORLD, "Matrix H after construction\n");CHKERRQ(ierr); */
/* ierr = MatView(Hperm, PETSC_VIEWER_STDOUT_(PETSC_COMM_WORLD));CHKERRQ(ierr); */
/* Mat HtHperm; */
/* ierr = MatPtAP(HtH, perm, MAT_INITIAL_MATRIX, 1.0, &HtHperm);CHKERRQ(ierr); */
/* ierr = PetscPrintf(PETSC_COMM_WORLD, "Matrix HtH:\n");CHKERRQ(ierr); */
/* ierr = MatView(HtHperm, PETSC_VIEWER_STDOUT_(PETSC_COMM_WORLD));CHKERRQ(ierr); */
/* right hand side */
ierr = DMCreateGlobalVector(da, &b);CHKERRQ(ierr);
ierr = VecSet(b,0.0);CHKERRQ(ierr);
ierr = VecSetValues(b, 1, ix, vals, INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(b);CHKERRQ(ierr);
ierr = VecAssemblyEnd(b);CHKERRQ(ierr);
/* ierr = VecSetRandom(b, rctx);CHKERRQ(ierr); */
ierr = VecDuplicate(b, &Htb);CHKERRQ(ierr);
ierr = MatMultTranspose(H, b, Htb);CHKERRQ(ierr);
/* construct solver */
ierr = KSPCreate(PETSC_COMM_WORLD,&kspmg);CHKERRQ(ierr);
ierr = KSPSetType(kspmg, KSPCG);CHKERRQ(ierr);
ierr = KSPGetPC(kspmg,&pcmg);CHKERRQ(ierr);
ierr = PCSetType(pcmg,PCASA);CHKERRQ(ierr);
/* maybe user wants to override some of the choices */
ierr = KSPSetFromOptions(kspmg);CHKERRQ(ierr);
ierr = KSPSetOperators(kspmg, HtH, HtH, DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = DMDASetRefinementFactor(da, 3, 3, 3);CHKERRQ(ierr);
ierr = PCSetDM(pcmg,da);CHKERRQ(ierr);
ierr = PCASASetTolerances(pcmg, 1.e-6, 1.e-10,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
ierr = VecDuplicate(b, &xvec);CHKERRQ(ierr);
ierr = VecSet(xvec, 0.0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(kspmg, Htb, xvec);CHKERRQ(ierr);
/* ierr = VecView(xvec, PETSC_VIEWER_STDOUT_(PETSC_COMM_WORLD));CHKERRQ(ierr); */
ierr = KSPDestroy(&kspmg);CHKERRQ(ierr);
ierr = VecDestroy(&xvec);CHKERRQ(ierr);
/* seems to be destroyed by KSPDestroy */
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&Htb);CHKERRQ(ierr);
ierr = MatDestroy(&HtH);CHKERRQ(ierr);
ierr = MatDestroy(&H);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
