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);
}
/*
Input:
d, number of nodes to compute
a,b, interval extrems
Output:
*x, array containing the d Chebyshev nodes of the interval [a,b]
*dct2, coefficients to compute a discrete cosine transformation (DCT-II)
*/
static PetscErrorCode ChebyshevNodes(PetscInt d,PetscReal a,PetscReal b,PetscScalar *x,PetscReal *dct2)
{
PetscInt j,i;
PetscReal t;
PetscFunctionBegin;
for (j=0;j<d+1;j++) {
t = ((2*j+1)*PETSC_PI)/(2*(d+1));
x[j] = (a+b)/2.0+((b-a)/2.0)*PetscCosReal(t);
for (i=0;i<d+1;i++) dct2[j*(d+1)+i] = PetscCosReal(i*t);
}
PetscFunctionReturn(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);
}
//FORMPSI
PetscErrorCode FormPsiAndInitialGuess(DM da,Vec U0,PetscBool feasible, ObsCtx *user)
{
PetscErrorCode ierr;
PetscInt i,j;
PetscReal **psi, **u0, **uexact,
x, y, r,
pi = PETSC_PI, afree = 0.69797, A = 0.68026, B = 0.47152;
DMDALocalInfo info;
PetscFunctionBeginUser;
ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, user->psi, &psi);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, U0, &u0);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, user->g, &uexact);CHKERRQ(ierr);
for (j=info.ys; j<info.ys+info.ym; j++) {
y = -2.0 + j * user->dy;
for (i=info.xs; i<info.xs+info.xm; i++) {
x = -2.0 + i * user->dx;
r = PetscSqrtReal(x * x + y * y);
if (r <= 1.0)
psi[j][i] = PetscSqrtReal(1.0 - r * r);
else
psi[j][i] = -1.0;
if (r <= afree)
uexact[j][i] = psi[j][i]; /* on the obstacle */
else
uexact[j][i] = - A * PetscLogReal(r) + B; /* solves the laplace eqn */
if (feasible) {
if (i == 0 || j == 0 || i == info.mx-1 || j == info.my-1)
u0[j][i] = uexact[j][i];
else
u0[j][i] = uexact[j][i] + PetscCosReal(pi*x/4.0)*PetscCosReal(pi*y/4.0);
} else
u0[j][i] = 0.;
}
}
ierr = DMDAVecRestoreArray(da, user->psi, &psi);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da, U0, &u0);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da, user->g, &uexact);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
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);
}
PetscErrorCode RHSFunction_Hull1972A3(TS ts, PetscReal t, Vec Y, Vec F, void *s)
{
PetscErrorCode ierr;
PetscScalar *y,*f;
PetscFunctionBegin;
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = y[0]*PetscCosReal(t);
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);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];
}
}
PetscErrorCode IFunction_Hull1972A3(TS ts, PetscReal t, Vec Y, Vec Ydot, Vec F, void *s)
{
PetscErrorCode ierr;
PetscScalar *y,*f;
PetscFunctionBegin;
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = y[0]*PetscCosReal(t);
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
/* Left hand side = ydot - f(y) */
ierr = VecAYPX(F,-1.0,Ydot);
PetscFunctionReturn(0);
}
PetscErrorCode IJacobian_Hull1972A3(TS ts, PetscReal t, Vec Y, Vec Ydot, PetscReal a, Mat A, Mat B, void *s)
{
PetscErrorCode ierr;
PetscScalar *y;
PetscInt row = 0,col = 0;
PetscScalar value = a - PetscCosReal(t);
PetscFunctionBegin;
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&row,1,&col,&value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static void leggaulob(PetscReal x1, PetscReal x2, PetscReal x[], PetscReal w[], int n)
/*******************************************************************************
Given the lower and upper limits of integration x1 and x2, and given n, this
routine returns arrays x[0..n-1] and w[0..n-1] of length n, containing the abscissas
and weights of the Gauss-Lobatto-Legendre n-point quadrature formula.
*******************************************************************************/
{
PetscInt j,m;
PetscReal z1,z,xm,xl,q,qp,Ln,scale;
if (n==1) {
x[0] = x1; /* Scale the root to the desired interval, */
x[1] = x2; /* and put in its symmetric counterpart. */
w[0] = 1.; /* Compute the weight */
w[1] = 1.; /* and its symmetric counterpart. */
} else {
x[0] = x1; /* Scale the root to the desired interval, */
x[n] = x2; /* and put in its symmetric counterpart. */
w[0] = 2./(n*(n+1));; /* Compute the weight */
w[n] = 2./(n*(n+1)); /* and its symmetric counterpart. */
m = (n+1)/2; /* The roots are symmetric, so we only find half of them. */
xm = 0.5*(x2+x1);
xl = 0.5*(x2-x1);
for (j=1; j<=(m-1); j++) { /* Loop over the desired roots. */
z=-1.0*PetscCosReal((PETSC_PI*(j+0.25)/(n))-(3.0/(8.0*n*PETSC_PI))*(1.0/(j+0.25)));
/* Starting with the above approximation to the ith root, we enter */
/* the main loop of refinement by Newton's method. */
do {
qAndLEvaluation(n,z,&q,&qp,&Ln);
z1 = z;
z = z1-q/qp; /* Newton's method. */
} while (fabs(z-z1) > 3.0e-11);
qAndLEvaluation(n,z,&q,&qp,&Ln);
x[j] = xm+xl*z; /* Scale the root to the desired interval, */
x[n-j] = xm-xl*z; /* and put in its symmetric counterpart. */
w[j] = 2.0/(n*(n+1)*Ln*Ln); /* Compute the weight */
w[n-j] = w[j]; /* and its symmetric counterpart. */
}
}
if (n%2==0) {
qAndLEvaluation(n,0.0,&q,&qp,&Ln);
x[n/2]=(x2-x1)/2.0;
w[n/2]=2.0/(n*(n+1)*Ln*Ln);
}
/* scale the weights according to mapping from [-1,1] to [0,1] */
scale = (x2-x1)/2.0;
for (j=0; j<=n; ++j) w[j] = w[j]*scale;
}
static PetscErrorCode PetscDTGaussJacobiQuadrature1D_Internal(PetscInt npoints, PetscReal a, PetscReal b, PetscReal *x, PetscReal *w)
{
PetscInt maxIter = 100;
PetscReal eps = 1.0e-8;
PetscReal a1, a2, a3, a4, a5, a6;
PetscInt k;
PetscErrorCode ierr;
PetscFunctionBegin;
a1 = PetscPowReal(2.0, a+b+1);
#if defined(PETSC_HAVE_TGAMMA)
a2 = PetscTGamma(a + npoints + 1);
a3 = PetscTGamma(b + npoints + 1);
a4 = PetscTGamma(a + b + npoints + 1);
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"tgamma() - math routine is unavailable.");
#endif
ierr = PetscDTFactorial_Internal(npoints, &a5);CHKERRQ(ierr);
a6 = a1 * a2 * a3 / a4 / a5;
/* Computes the m roots of P_{m}^{a,b} on [-1,1] by Newton's method with Chebyshev points as initial guesses.
Algorithm implemented from the pseudocode given by Karniadakis and Sherwin and Python in FIAT */
for (k = 0; k < npoints; ++k) {
PetscReal r = -PetscCosReal((2.0*k + 1.0) * PETSC_PI / (2.0 * npoints)), dP;
PetscInt j;
if (k > 0) r = 0.5 * (r + x[k-1]);
for (j = 0; j < maxIter; ++j) {
PetscReal s = 0.0, delta, f, fp;
PetscInt i;
for (i = 0; i < k; ++i) s = s + 1.0 / (r - x[i]);
ierr = PetscDTComputeJacobi(a, b, npoints, r, &f);CHKERRQ(ierr);
ierr = PetscDTComputeJacobiDerivative(a, b, npoints, r, &fp);CHKERRQ(ierr);
delta = f / (fp - f * s);
r = r - delta;
if (PetscAbsReal(delta) < eps) break;
}
x[k] = r;
ierr = PetscDTComputeJacobiDerivative(a, b, npoints, x[k], &dP);CHKERRQ(ierr);
w[k] = a6 / (1.0 - PetscSqr(x[k])) / PetscSqr(dP);
}
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);
}
static PetscErrorCode CEFunction(TS ts,PetscReal t,Vec X,Vec Xdot,Vec F,void *ctx)
{
PetscErrorCode ierr;
PetscReal l = ((CECtx*)ctx)->lambda;
PetscScalar *x,*xdot,*f;
PetscFunctionBeginUser;
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
ierr = VecGetArray(Xdot,&xdot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = xdot[0] + l*(x[0] - PetscCosReal(t));
#if 0
ierr = PetscPrintf(PETSC_COMM_WORLD," f(t=%G,x=%G,xdot=%G) = %G\n",t,x[0],xdot[0],f[0]);CHKERRQ(ierr);
#endif
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(Xdot,&xdot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Defines the Jacobian of the ODE passed to the ODE solver. See TSSetIJacobian() for the meaning of a and the Jacobian.
*/
static PetscErrorCode IJacobianImplicit(TS ts,PetscReal t,Vec Y,Vec Ydot,PetscReal a,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
PetscInt rowcol[] = {0,1,2,3,4,5};
const PetscScalar *y,*ydot;
PetscScalar J[6][6];
PetscFunctionBegin;
ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecGetArrayRead(Ydot,&ydot);CHKERRQ(ierr);
PetscMemzero(J,sizeof(J));
J[0][0]=-0.001 - a/1.e6;
J[0][1]=a/1.e6;
J[0][5]=(2*PETSC_PI* PetscCosReal(200*PETSC_PI*y[5]))/25.;
J[1][0]=a/1.e6;
J[1][1]=-0.00022222222222222223 - a/1.e6 - PetscExpReal((500*(y[1] - y[2]))/13.)/2.6e6;
J[1][2]= PetscExpReal((500*(y[1] - y[2]))/13.)/2.6e6;
J[2][1]= PetscExpReal((500*(y[1] - y[2]))/13.)/26000.;
J[2][2]=-0.00011111111111111112 - a/500000. - PetscExpReal((500*(y[1] - y[2]))/13.)/26000.;
J[3][1]=(-99* PetscExpReal((500*(y[1] - y[2]))/13.))/2.6e6;
J[3][2]=(99* PetscExpReal((500*(y[1] - y[2]))/13.))/2.6e6;
J[3][3]=-0.00011111111111111112 - (3*a)/1.e6;
J[3][4]=(3*a)/1.e6;
J[4][3]=(3*a)/1.e6;
J[4][4]=-0.00011111111111111112 - (3*a)/1.e6;
J[5][5]=a;
ierr = MatSetValues(B,6,rowcol,6,rowcol,&J[0][0],INSERT_VALUES);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (A != B) {
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode ComputeSolution(DM da,PetscGLL *gll,Vec u)
{
PetscErrorCode ierr;
PetscInt j,xs,xn;
PetscScalar *uu,*xx;
PetscReal xd;
Vec x;
PetscFunctionBegin;
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xn,NULL,NULL);CHKERRQ(ierr);
ierr = DMGetCoordinates(da,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,x,&xx);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,u,&uu);CHKERRQ(ierr);
/* loop over local nodes */
for (j=xs; j<xs+xn; j++) {
xd = xx[j];
uu[j] = (xd*xd - 1.0)*PetscCosReal(5.*PETSC_PI*xd);
}
ierr = DMDAVecRestoreArray(da,x,&xx);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,u,&uu);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode InitialConditions(DM da,Vec U)
{
PetscErrorCode ierr;
PetscInt i,xs,xm,Mx;
Field *u;
PetscReal hx,x;
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-1);
/*
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);
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
x = i*hx;
if (x < 1.0) u[i].rho = 0.0;
else u[i].rho = 1.0;
u[i].c = PetscCosReal(.5*PETSC_PI*x);
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static void func3(PetscReal x, PetscReal *val)
{
*val = PetscExpReal(x)*PetscCosReal(x);
}
static PetscReal p(PetscReal xi, PetscReal ecc)
{
PetscReal t=1.0+ecc*PetscCosReal(xi);
return(t*t*t);
}
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;
}
/*
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 void func14(PetscReal x, PetscReal *val)
{
if (x == 0.0) *val = 0.0;
else if (x == 1.0) *val = 1.0;
else *val = PetscExpReal(1-1/x)*PetscCosReal(1/x-1)/(x*x);
}
static void func9(PetscReal x, PetscReal *val)
{
*val = PetscLogReal(PetscCosReal(x));
}
static void func14(PetscReal x, PetscReal *val)
{
*val = PetscExpReal(1-1/x)*PetscCosReal(1/x-1)/(x*x);
}
