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); }