/*
Monitor - User-provided routine to monitor the solution computed at
each timestep. This example plots the solution and computes the
error in two different norms.
Input Parameters:
ts - the timestep context
step - the count of the current step (with 0 meaning the
initial condition)
time - the current time
u - the solution at this timestep
ctx - the user-provided context for this monitoring routine.
In this case we use the application context which contains
information about the problem size, workspace and the exact
solution.
*/
PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal time,Vec u,void *ctx)
{
AppCtx *appctx = (AppCtx*) ctx; /* user-defined application context */
PetscErrorCode ierr;
PetscReal en2,en2s,enmax;
PetscDraw draw;
/*
We use the default X windows viewer
PETSC_VIEWER_DRAW_(appctx->comm)
that is associated with the current communicator. This saves
the effort of calling PetscViewerDrawOpen() to create the window.
Note that if we wished to plot several items in separate windows we
would create each viewer with PetscViewerDrawOpen() and store them in
the application context, appctx.
PetscReal buffering makes graphics look better.
*/
ierr = PetscViewerDrawGetDraw(PETSC_VIEWER_DRAW_(appctx->comm),0,&draw);CHKERRQ(ierr);
ierr = PetscDrawSetDoubleBuffer(draw);CHKERRQ(ierr);
ierr = VecView(u,PETSC_VIEWER_DRAW_(appctx->comm));CHKERRQ(ierr);
/*
Compute the exact solution at this timestep
*/
ierr = ExactSolution(time,appctx->solution,appctx);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = PetscPrintf(appctx->comm,"Computed solution vector\n");CHKERRQ(ierr);
ierr = VecView(u,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(appctx->comm,"Exact solution vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/*
Compute the 2-norm and max-norm of the error
*/
ierr = VecAXPY(appctx->solution,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(appctx->solution,NORM_2,&en2);CHKERRQ(ierr);
en2s = PetscSqrtReal(appctx->h)*en2; /* scale the 2-norm by the grid spacing */
ierr = VecNorm(appctx->solution,NORM_MAX,&enmax);CHKERRQ(ierr);
/*
PetscPrintf() causes only the first processor in this
communicator to print the timestep information.
*/
ierr = PetscPrintf(appctx->comm,"Timestep %D: time = %g,2-norm error = %g, max norm error = %g\n",step,(double)time,(double)en2s,(double)enmax);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
/* if (appctx->debug) {
ierr = PetscPrintf(appctx->comm,"Error vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
} */
return 0;
}
PetscErrorCode FormInitialGuess(Vec X,AppCtx *user)
{
PetscInt i,j,row,mx,my;
PetscErrorCode ierr;
PetscReal one = 1.0,lambda;
PetscReal temp1,temp,hx,hy;
PetscScalar *x;
mx = user->mx;
my = user->my;
lambda = user->param;
hx = one / (PetscReal)(mx-1);
hy = one / (PetscReal)(my-1);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
temp1 = lambda/(lambda + one);
for (j=0; j<my; j++) {
temp = (PetscReal)(PetscMin(j,my-j-1))*hy;
for (i=0; i<mx; i++) {
row = i + j*mx;
if (i == 0 || j == 0 || i == mx-1 || j == my-1) {
x[row] = 0.0;
continue;
}
x[row] = temp1*PetscSqrtReal(PetscMin((PetscReal)(PetscMin(i,mx-i-1))*hx,temp));
}
}
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
return 0;
}
PetscErrorCode StokesCalcError(Stokes *s)
{
PetscScalar scale = PetscSqrtReal((double)s->nx*s->ny);
PetscReal val;
Vec y0, y1;
PetscErrorCode ierr;
PetscFunctionBeginUser;
/* error y-x */
ierr = VecAXPY(s->y, -1.0, s->x);CHKERRQ(ierr);
/* ierr = VecView(s->y, (PetscViewer)PETSC_VIEWER_DEFAULT);CHKERRQ(ierr); */
/* error in velocity */
ierr = VecGetSubVector(s->y, s->isg[0], &y0);CHKERRQ(ierr);
ierr = VecNorm(y0, NORM_2, &val);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," discretization error u = %g\n",(double)(PetscRealPart(val/scale)));CHKERRQ(ierr);
ierr = VecRestoreSubVector(s->y, s->isg[0], &y0);CHKERRQ(ierr);
/* error in pressure */
ierr = VecGetSubVector(s->y, s->isg[1], &y1);CHKERRQ(ierr);
ierr = VecNorm(y1, NORM_2, &val);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," discretization error p = %g\n",(double)(PetscRealPart(val/scale)));CHKERRQ(ierr);
ierr = VecRestoreSubVector(s->y, s->isg[1], &y1);CHKERRQ(ierr);
/* total error */
ierr = VecNorm(s->y, NORM_2, &val);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," discretization error [u,p] = %g\n", (double)PetscRealPart((val/scale)));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESVIComputeInactiveSetFnorm(SNES snes,Vec F,Vec X, PetscReal *fnorm)
{
PetscErrorCode ierr;
const PetscScalar *x,*xl,*xu,*f;
PetscInt i,n;
PetscReal rnorm;
PetscFunctionBegin;
ierr = VecGetLocalSize(X,&n);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->xl,&xl);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->xu,&xu);CHKERRQ(ierr);
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecGetArrayRead(F,&f);CHKERRQ(ierr);
rnorm = 0.0;
for (i=0; i<n; i++) {
if (((PetscRealPart(x[i]) > PetscRealPart(xl[i]) + 1.e-8 || (PetscRealPart(f[i]) < 0.0)) && ((PetscRealPart(x[i]) < PetscRealPart(xu[i]) - 1.e-8) || PetscRealPart(f[i]) > 0.0))) rnorm += PetscRealPart(PetscConj(f[i])*f[i]);
}
ierr = VecRestoreArrayRead(F,&f);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->xl,&xl);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->xu,&xu);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
ierr = MPI_Allreduce(&rnorm,fnorm,1,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
*fnorm = PetscSqrtReal(*fnorm);
PetscFunctionReturn(0);
}
/*@
PetscDTGaussQuadrature - create Gauss quadrature
Not Collective
Input Arguments:
+ npoints - number of points
. a - left end of interval (often-1)
- b - right end of interval (often +1)
Output Arguments:
+ x - quadrature points
- w - quadrature weights
Level: intermediate
References:
Golub and Welsch, Calculation of Quadrature Rules, Math. Comp. 23(106), 221--230, 1969.
.seealso: PetscDTLegendreEval()
@*/
PetscErrorCode PetscDTGaussQuadrature(PetscInt npoints,PetscReal a,PetscReal b,PetscReal *x,PetscReal *w)
{
PetscErrorCode ierr;
PetscInt i;
PetscReal *work;
PetscScalar *Z;
PetscBLASInt N,LDZ,info;
PetscFunctionBegin;
ierr = PetscCitationsRegister(GaussCitation, &GaussCite);CHKERRQ(ierr);
/* Set up the Golub-Welsch system */
for (i=0; i<npoints; i++) {
x[i] = 0; /* diagonal is 0 */
if (i) w[i-1] = 0.5 / PetscSqrtReal(1 - 1./PetscSqr(2*i));
}
ierr = PetscMalloc2(npoints*npoints,&Z,PetscMax(1,2*npoints-2),&work);CHKERRQ(ierr);
ierr = PetscBLASIntCast(npoints,&N);CHKERRQ(ierr);
LDZ = N;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKsteqr",LAPACKsteqr_("I",&N,x,w,Z,&LDZ,work,&info));
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"xSTEQR error");
for (i=0; i<(npoints+1)/2; i++) {
PetscReal y = 0.5 * (-x[i] + x[npoints-i-1]); /* enforces symmetry */
x[i] = (a+b)/2 - y*(b-a)/2;
x[npoints-i-1] = (a+b)/2 + y*(b-a)/2;
w[i] = w[npoints-1-i] = 0.5*(b-a)*(PetscSqr(PetscAbsScalar(Z[i*npoints])) + PetscSqr(PetscAbsScalar(Z[(npoints-i-1)*npoints])));
}
ierr = PetscFree2(Z,work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormInitialGuess - Forms initial approximation.
Input Parameters:
user - user-defined application context
X - vector
Output Parameter:
X - vector
*/
PetscErrorCode FormInitialGuess(AppCtx *user,Vec X)
{
PetscInt i,j,row,mx,my,xs,ys,xm,ym,gxm,gym,gxs,gys;
PetscErrorCode ierr;
PetscReal one = 1.0,lambda,temp1,temp,hx,hy,hxdhy,hydhx,sc;
PetscScalar *x;
Vec localX = user->localX;
mx = user->mx; my = user->my; lambda = user->param;
hx = one/(PetscReal)(mx-1); hy = one/(PetscReal)(my-1);
sc = hx*hy*lambda; hxdhy = hx/hy; hydhx = hy/hx;
temp1 = lambda/(lambda + one);
/*
Get a pointer to vector data.
- For default PETSc vectors,VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = VecGetArray(localX,&x);CHKERRQ(ierr);
/*
Get local grid boundaries (for 2-dimensional DMDA):
xs, ys - starting grid indices (no ghost points)
xm, ym - widths of local grid (no ghost points)
gxs, gys - starting grid indices (including ghost points)
gxm, gym - widths of local grid (including ghost points)
*/
ierr = DMDAGetCorners(user->da,&xs,&ys,PETSC_NULL,&xm,&ym,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDAGetGhostCorners(user->da,&gxs,&gys,PETSC_NULL,&gxm,&gym,PETSC_NULL);CHKERRQ(ierr);
/*
Compute initial guess over the locally owned part of the grid
*/
for (j=ys; j<ys+ym; j++) {
temp = (PetscReal)(PetscMin(j,my-j-1))*hy;
for (i=xs; i<xs+xm; i++) {
row = i - gxs + (j - gys)*gxm;
if (i == 0 || j == 0 || i == mx-1 || j == my-1) {
x[row] = 0.0;
continue;
}
x[row] = temp1*PetscSqrtReal(PetscMin((PetscReal)(PetscMin(i,mx-i-1))*hx,temp));
}
}
/*
Restore vector
*/
ierr = VecRestoreArray(localX,&x);CHKERRQ(ierr);
/*
Insert values into global vector
*/
ierr = DMLocalToGlobalBegin(user->da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(user->da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
return 0;
}
/*
Monitor - User-provided routine to monitor the solution computed at
each timestep. This example plots the solution and computes the
error in two different norms.
Input Parameters:
ts - the timestep context
step - the count of the current step (with 0 meaning the
initial condition)
time - the current time
u - the solution at this timestep
ctx - the user-provided context for this monitoring routine.
In this case we use the application context which contains
information about the problem size, workspace and the exact
solution.
*/
PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal time,Vec u,void *ctx)
{
AppCtx *appctx = (AppCtx*) ctx; /* user-defined application context */
PetscErrorCode ierr;
PetscReal norm_2,norm_max;
/*
View a graph of the current iterate
*/
ierr = VecView(u,appctx->viewer2);CHKERRQ(ierr);
/*
Compute the exact solution
*/
ierr = ExactSolution(time,appctx->solution,appctx);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = PetscPrintf(appctx->comm,"Computed solution vector\n");CHKERRQ(ierr);
ierr = VecView(u,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(appctx->comm,"Exact solution vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/*
Compute the 2-norm and max-norm of the error
*/
ierr = VecAXPY(appctx->solution,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(appctx->solution,NORM_2,&norm_2);CHKERRQ(ierr);
norm_2 = PetscSqrtReal(appctx->h)*norm_2;
ierr = VecNorm(appctx->solution,NORM_MAX,&norm_max);CHKERRQ(ierr);
if (norm_2 < 1e-14) norm_2 = 0;
if (norm_max < 1e-14) norm_max = 0;
/*
PetscPrintf() causes only the first processor in this
communicator to print the timestep information.
*/
ierr = PetscPrintf(appctx->comm,"Timestep %D: time = %g 2-norm error = %g max norm error = %g\n",step,(double)time,(double)norm_2,(double)norm_max);CHKERRQ(ierr);
appctx->norm_2 += norm_2;
appctx->norm_max += norm_max;
/*
View a graph of the error
*/
ierr = VecView(appctx->solution,appctx->viewer1);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = PetscPrintf(appctx->comm,"Error vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
return 0;
}
/*@C
PetscDrawViewPortsCreate - Splits a window into smaller view ports. Each processor shares all the viewports.
Collective on PetscDraw
Input Parameters:
+ draw - the drawing context
- nports - the number of ports
Output Parameter:
. ports - a PetscDrawViewPorts context (C structure)
Options Database:
. -draw_ports - display multiple fields in the same window with PetscDrawPorts instead of in seperate windows
Level: advanced
Concepts: drawing^in subset of window
.seealso: PetscDrawSplitViewPort(), PetscDrawSetViewPort(), PetscDrawViewPortsSet(), PetscDrawViewPortsDestroy()
@*/
PetscErrorCode PetscDrawViewPortsCreate(PetscDraw draw,PetscInt nports,PetscDrawViewPorts **newports)
{
PetscDrawViewPorts *ports;
PetscInt i,n;
PetscBool isnull;
PetscMPIInt rank;
PetscReal *xl,*xr,*yl,*yr,h;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(draw,PETSC_DRAW_CLASSID,1);
if (nports < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Number of divisions must be positive: %d", nports);
PetscValidPointer(newports,3);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
if (isnull) {*newports = NULL; PetscFunctionReturn(0);}
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)draw),&rank);CHKERRQ(ierr);
ierr = PetscNew(&ports);CHKERRQ(ierr); *newports = ports;
ports->draw = draw;
ports->nports = nports;
ierr = PetscObjectReference((PetscObject)draw);CHKERRQ(ierr);
/* save previous drawport of window */
ierr = PetscDrawGetViewPort(draw,&ports->port_xl,&ports->port_yl,&ports->port_xr,&ports->port_yr);CHKERRQ(ierr);
n = (PetscInt)(.1 + PetscSqrtReal((PetscReal)nports));
while (n*n < nports) n++;
h = 1.0/n;
ierr = PetscMalloc4(n*n,&xl,n*n,&xr,n*n,&yl,n*n,&yr);CHKERRQ(ierr);
ports->xl = xl;
ports->xr = xr;
ports->yl = yl;
ports->yr = yr;
ierr = PetscDrawSetCoordinates(draw,0.0,0.0,1.0,1.0);CHKERRQ(ierr);
ierr = PetscDrawCollectiveBegin(draw);CHKERRQ(ierr);
for (i=0; i<n*n; i++) {
xl[i] = (i % n)*h;
xr[i] = xl[i] + h;
yl[i] = (i / n)*h;
yr[i] = yl[i] + h;
if (!rank) {
ierr = PetscDrawLine(draw,xl[i],yl[i],xl[i],yr[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xl[i],yr[i],xr[i],yr[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xr[i],yr[i],xr[i],yl[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xr[i],yl[i],xl[i],yl[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
xl[i] += .05*h;
xr[i] -= .05*h;
yl[i] += .05*h;
yr[i] -= .05*h;
}
ierr = PetscDrawCollectiveEnd(draw);CHKERRQ(ierr);
ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormInitialGuess - Forms initial approximation.
Input Parameters:
user - user-defined application context
X - vector
Output Parameter:
X - vector
*/
PetscErrorCode FormInitialGuess(AppCtx *user,Vec X)
{
PetscInt i,j,k,Mx,My,Mz,xs,ys,zs,xm,ym,zm;
PetscErrorCode ierr;
PetscReal lambda,temp1,hx,hy,hz,tempk,tempj;
PetscScalar ***x;
PetscFunctionBeginUser;
ierr = DMDAGetInfo(user->da,PETSC_IGNORE,&Mx,&My,&Mz,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
lambda = user->param;
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
hz = 1.0/(PetscReal)(Mz-1);
temp1 = lambda/(lambda + 1.0);
/*
Get a pointer to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = DMDAVecGetArray(user->da,X,&x);CHKERRQ(ierr);
/*
Get local grid boundaries (for 3-dimensional DMDA):
xs, ys, zs - starting grid indices (no ghost points)
xm, ym, zm - widths of local grid (no ghost points)
*/
ierr = DMDAGetCorners(user->da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
/*
Compute initial guess over the locally owned part of the grid
*/
for (k=zs; k<zs+zm; k++) {
tempk = (PetscReal)(PetscMin(k,Mz-k-1))*hz;
for (j=ys; j<ys+ym; j++) {
tempj = PetscMin((PetscReal)(PetscMin(j,My-j-1))*hy,tempk);
for (i=xs; i<xs+xm; i++) {
if (i == 0 || j == 0 || k == 0 || i == Mx-1 || j == My-1 || k == Mz-1) {
/* boundary conditions are all zero Dirichlet */
x[k][j][i] = 0.0;
} else {
x[k][j][i] = temp1*PetscSqrtReal(PetscMin((PetscReal)(PetscMin(i,Mx-i-1))*hx,tempj));
}
}
}
}
/*
Restore vector
*/
ierr = DMDAVecRestoreArray(user->da,X,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode VecNorm_Seq(Vec xin,NormType type,PetscReal *z)
{
const PetscScalar *xx;
PetscErrorCode ierr;
PetscInt n = xin->map->n;
PetscBLASInt one = 1, bn;
PetscFunctionBegin;
ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr);
if (type == NORM_2 || type == NORM_FROBENIUS) {
ierr = VecGetArrayRead(xin,&xx);CHKERRQ(ierr);
#if defined(PETSC_USE_REAL___FP16)
*z = BLASnrm2_(&bn,xx,&one);
#else
*z = PetscRealPart(BLASdot_(&bn,xx,&one,xx,&one));
*z = PetscSqrtReal(*z);
#endif
ierr = VecRestoreArrayRead(xin,&xx);CHKERRQ(ierr);
ierr = PetscLogFlops(PetscMax(2.0*n-1,0.0));CHKERRQ(ierr);
} else if (type == NORM_INFINITY) {
PetscInt i;
PetscReal max = 0.0,tmp;
ierr = VecGetArrayRead(xin,&xx);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if ((tmp = PetscAbsScalar(*xx)) > max) max = tmp;
/* check special case of tmp == NaN */
if (tmp != tmp) {max = tmp; break;}
xx++;
}
ierr = VecRestoreArrayRead(xin,&xx);CHKERRQ(ierr);
*z = max;
} else if (type == NORM_1) {
#if defined(PETSC_USE_COMPLEX)
PetscReal tmp = 0.0;
PetscInt i;
#endif
ierr = VecGetArrayRead(xin,&xx);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
/* BLASasum() returns the nonstandard 1 norm of the 1 norm of the complex entries so we provide a custom loop instead */
for (i=0; i<n; i++) {
tmp += PetscAbsScalar(xx[i]);
}
*z = tmp;
#else
PetscStackCallBLAS("BLASasum",*z = BLASasum_(&bn,xx,&one));
#endif
ierr = VecRestoreArrayRead(xin,&xx);CHKERRQ(ierr);
ierr = PetscLogFlops(PetscMax(n-1.0,0.0));CHKERRQ(ierr);
} else if (type == NORM_1_AND_2) {
ierr = VecNorm_Seq(xin,NORM_1,z);CHKERRQ(ierr);
ierr = VecNorm_Seq(xin,NORM_2,z+1);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);
}
/*
Monitor - User-provided routine to monitor the solution computed at
each timestep. This example plots the solution and computes the
error in two different norms.
Input Parameters:
ts - the timestep context
step - the count of the current step (with 0 meaning the
initial condition)
time - the current time
u - the solution at this timestep
ctx - the user-provided context for this monitoring routine.
In this case we use the application context which contains
information about the problem size, workspace and the exact
solution.
*/
PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal time,Vec u,void *ctx)
{
AppCtx *appctx = (AppCtx*) ctx; /* user-defined application context */
PetscErrorCode ierr;
PetscReal norm_2,norm_max;
/*
View a graph of the current iterate
*/
ierr = VecView(u,appctx->viewer2);CHKERRQ(ierr);
/*
Compute the exact solution
*/
ierr = ExactSolution(time,appctx->solution,appctx);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
printf("Computed solution vector\n");
ierr = VecView(u,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
printf("Exact solution vector\n");
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
/*
Compute the 2-norm and max-norm of the error
*/
ierr = VecAXPY(appctx->solution,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(appctx->solution,NORM_2,&norm_2);CHKERRQ(ierr);
norm_2 = PetscSqrtReal(appctx->h)*norm_2;
ierr = VecNorm(appctx->solution,NORM_MAX,&norm_max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Timestep %D: time = %G, 2-norm error = %G, max norm error = %G\n",
step,time,norm_2,norm_max);CHKERRQ(ierr);
appctx->norm_2 += norm_2;
appctx->norm_max += norm_max;
/*
View a graph of the error
*/
ierr = VecView(appctx->solution,appctx->viewer1);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
printf("Error vector\n");
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
return 0;
}
PetscErrorCode KSPAGMRESLejaOrdering(PetscScalar *re, PetscScalar *im, PetscScalar *rre, PetscScalar *rim, PetscInt m)
{
PetscInt *spos;
PetscScalar *n_cmpl,temp;
PetscErrorCode ierr;
PetscInt i, pos, j;
ierr = PetscMalloc(m*sizeof(PetscScalar), &n_cmpl);CHKERRQ(ierr);
ierr = PetscMalloc(m*sizeof(PetscInt), &spos);CHKERRQ(ierr);
PetscFunctionBegin;
/* Check the proper order of complex conjugate pairs */
j = 0;
while (j < m ) {
if (im[j] != 0.0) {/* complex eigenvalue */
if (im[j] < 0.0) { /* change the order */
temp = im[j+1];
im[j+1] = im[j];
im[j] = temp;
}
j += 2;
} else j++;
}
for (i = 0;i < m;i++)
n_cmpl[i] = PetscSqrtReal(re[i]*re[i]+im[i]*im[i]);
KSPAGMRESLejafmaxarray(n_cmpl, 0, m, &pos);
j = 0;
if (im[pos] >= 0.0) {
rre[0] = re[pos];
rim[0] = im[pos];
j++;
spos[0] = pos;
}
while (j < (m)) {
if (im[pos] > 0) {
rre[j] = re[pos+1];
rim[j] = im[pos+1];
spos[j] = pos + 1;
j++;
}
KSPAGMRESLejaCfpdMax(re, im, spos, j, m, &pos);
if (im[pos] < 0) pos--;
if ((im[pos] >= 0) && (j < m)) {
rre[j] = re[pos];
rim[j] = im[pos];
spos[j] = pos;
j++;
}
}
ierr = PetscFree(spos);CHKERRQ(ierr);
ierr = PetscFree(n_cmpl);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscDrawViewPortsCreate - Splits a window into smaller
view ports. Each processor shares all the viewports.
Collective on PetscDraw
Input Parameters:
+ draw - the drawing context
- nports - the number of ports
Output Parameter:
. ports - a PetscDrawViewPorts context (C structure)
Level: advanced
Concepts: drawing^in subset of window
.seealso: PetscDrawSplitViewPort(), PetscDrawSetViewPort(), PetscDrawViewPortsSet(), PetscDrawViewPortsDestroy()
@*/
PetscErrorCode PetscDrawViewPortsCreate(PetscDraw draw,PetscInt nports,PetscDrawViewPorts **ports)
{
PetscInt i,n;
PetscErrorCode ierr;
PetscBool isnull;
PetscReal *xl,*xr,*yl,*yr,h;
PetscFunctionBegin;
PetscValidHeaderSpecific(draw,PETSC_DRAW_CLASSID,1);
PetscValidPointer(ports,3);
ierr = PetscObjectTypeCompare((PetscObject)draw,PETSC_DRAW_NULL,&isnull);CHKERRQ(ierr);
if (isnull) {
*ports = NULL;
PetscFunctionReturn(0);
}
ierr = PetscNew(ports);CHKERRQ(ierr);
(*ports)->draw = draw;
(*ports)->nports = nports;
ierr = PetscObjectReference((PetscObject)draw);CHKERRQ(ierr);
n = (PetscInt)(.1 + PetscSqrtReal((PetscReal)nports));
while (n*n < nports) n++;
ierr = PetscMalloc1(n*n,&xl);CHKERRQ(ierr);(*ports)->xl = xl;
ierr = PetscMalloc1(n*n,&xr);CHKERRQ(ierr);(*ports)->xr = xr;
ierr = PetscMalloc1(n*n,&yl);CHKERRQ(ierr);(*ports)->yl = yl;
ierr = PetscMalloc1(n*n,&yr);CHKERRQ(ierr);(*ports)->yr = yr;
h = 1.0/n;
for (i=0; i<n*n; i++) {
xl[i] = (i % n)*h;
xr[i] = xl[i] + h;
yl[i] = (i/n)*h;
yr[i] = yl[i] + h;
ierr = PetscDrawLine(draw,xl[i],yl[i],xl[i],yr[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xl[i],yr[i],xr[i],yr[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xr[i],yr[i],xr[i],yl[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xr[i],yl[i],xl[i],yl[i],PETSC_DRAW_BLACK);CHKERRQ(ierr);
xl[i] += .1*h;
xr[i] -= .1*h;
yl[i] += .1*h;
yr[i] -= .1*h;
}
/* save previous drawport of window */
ierr = PetscDrawGetViewPort(draw,&(*ports)->port_xl,&(*ports)->port_yl,&(*ports)->port_xr,&(*ports)->port_yr);CHKERRQ(ierr);
/* ierr = PetscDrawSynchronizedFlush(draw);CHKERRQ(ierr);*/ /* this causes flicker */
PetscFunctionReturn(0);
}
/*
Custom CGS orthogonalization, preprocess after first orthogonalization
*/
static PetscErrorCode SVDOrthogonalizeCGS(BV V,PetscInt i,PetscScalar* h,PetscReal a,BVOrthogRefineType refine,PetscReal eta,PetscReal *norm)
{
PetscErrorCode ierr;
PetscReal sum,onorm;
PetscScalar dot;
PetscInt j;
PetscFunctionBegin;
switch (refine) {
case BV_ORTHOG_REFINE_NEVER:
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
break;
case BV_ORTHOG_REFINE_ALWAYS:
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
ierr = BVDotColumn(V,i,h);CHKERRQ(ierr);
ierr = BVMultColumn(V,-1.0,1.0,i,h);CHKERRQ(ierr);
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
break;
case BV_ORTHOG_REFINE_IFNEEDED:
dot = h[i];
onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
sum = 0.0;
for (j=0;j<i;j++) {
sum += PetscRealPart(h[j] * PetscConj(h[j]));
}
*norm = PetscRealPart(dot)/(a*a) - sum;
if (*norm>0.0) *norm = PetscSqrtReal(*norm);
else {
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
}
if (*norm < eta*onorm) {
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
ierr = BVDotColumn(V,i,h);CHKERRQ(ierr);
ierr = BVMultColumn(V,-1.0,1.0,i,h);CHKERRQ(ierr);
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
}
break;
}
PetscFunctionReturn(0);
}
/*@C
DMDAGetLogicalCoordinate - Returns a the i,j,k logical coordinate for the closest mesh point to a x,y,z point in the coordinates of the DMDA
Collective on DMDA
Input Parameters:
+ da - the distributed array
- x,y,z - the physical coordinates
Output Parameters:
+ II, JJ, KK - the logical coordinate (-1 on processes that do not contain that point)
- X, Y, Z, - (optional) the coordinates of the located grid point
Level: advanced
Notes:
All processors that share the DMDA must call this with the same coordinate value
.keywords: distributed array, get, processor subset
@*/
PetscErrorCode DMDAGetLogicalCoordinate(DM da,PetscScalar x,PetscScalar y,PetscScalar z,PetscInt *II,PetscInt *JJ,PetscInt *KK,PetscScalar *X,PetscScalar *Y,PetscScalar *Z)
{
DM_DA *dd = (DM_DA*)da->data;
PetscErrorCode ierr;
Vec coors;
DM dacoors;
DMDACoor2d **c;
PetscInt i,j,xs,xm,ys,ym;
PetscReal d,D = PETSC_MAX_REAL,Dv;
PetscMPIInt rank,root;
PetscFunctionBegin;
if (dd->dim == 1) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Cannot get point from 1d DMDA");
if (dd->dim == 3) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Cannot get point from 3d DMDA");
*II = -1;
*JJ = -1;
ierr = DMGetCoordinateDM(da,&dacoors);CHKERRQ(ierr);
ierr = DMDAGetCorners(dacoors,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
ierr = DMGetCoordinates(da,&coors);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dacoors,coors,&c);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
d = PetscSqrtReal(PetscRealPart( (c[j][i].x - x)*(c[j][i].x - x) + (c[j][i].y - y)*(c[j][i].y - y) ));
if (d < D) {
D = d;
*II = i;
*JJ = j;
}
}
}
ierr = MPI_Allreduce(&D,&Dv,1,MPIU_REAL,MPI_MIN,PetscObjectComm((PetscObject)da));CHKERRQ(ierr);
if (D != Dv) {
*II = -1;
*JJ = -1;
rank = 0;
} else {
*X = c[*JJ][*II].x;
*Y = c[*JJ][*II].y;
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)da),&rank);CHKERRQ(ierr);
rank++;
}
ierr = MPI_Allreduce(&rank,&root,1,MPI_INT,MPI_SUM,PetscObjectComm((PetscObject)da));CHKERRQ(ierr);
root--;
ierr = MPI_Bcast(X,1,MPIU_SCALAR,root,PetscObjectComm((PetscObject)da));CHKERRQ(ierr);
ierr = MPI_Bcast(Y,1,MPIU_SCALAR,root,PetscObjectComm((PetscObject)da));CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dacoors,coors,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESNGMRESSelectRestart_Private(SNES snes,PetscInt l,PetscReal fAnorm,PetscReal dnorm,PetscReal fminnorm,PetscReal dminnorm,PetscBool *selectRestart)
{
SNES_NGMRES *ngmres = (SNES_NGMRES*)snes->data;
PetscErrorCode ierr;
PetscFunctionBegin;
*selectRestart = PETSC_FALSE;
/* difference stagnation restart */
if ((ngmres->epsilonB*dnorm > dminnorm) && (PetscSqrtReal(fAnorm) > ngmres->deltaB*PetscSqrtReal(fminnorm)) && l > 0) {
if (ngmres->monitor) {
ierr = PetscViewerASCIIPrintf(ngmres->monitor,"difference restart: %e > %e\n",ngmres->epsilonB*dnorm,dminnorm);CHKERRQ(ierr);
}
*selectRestart = PETSC_TRUE;
}
/* residual stagnation restart */
if (PetscSqrtReal(fAnorm) > ngmres->gammaC*PetscSqrtReal(fminnorm)) {
if (ngmres->monitor) {
ierr = PetscViewerASCIIPrintf(ngmres->monitor,"residual restart: %e > %e\n",PetscSqrtReal(fAnorm),ngmres->gammaC*PetscSqrtReal(fminnorm));CHKERRQ(ierr);
}
*selectRestart = PETSC_TRUE;
}
PetscFunctionReturn(0);
}
/*MC
TSSSPRKS3 - Optimal third order SSP Runge-Kutta, low-storage, c_eff=(PetscSqrtReal(s)-1)/PetscSqrtReal(s), where PetscSqrtReal(s) is an integer
Pseudocode 2 of Ketcheson 2008
Level: beginner
.seealso: TSSSP, TSSSPSetType(), TSSSPSetNumStages()
M*/
static PetscErrorCode TSSSPStep_RK_3(TS ts,PetscReal t0,PetscReal dt,Vec sol)
{
TS_SSP *ssp = (TS_SSP*)ts->data;
Vec *work,F;
PetscInt i,s,n,r;
PetscReal c,stage_time;
PetscErrorCode ierr;
PetscFunctionBegin;
s = ssp->nstages;
n = (PetscInt)(PetscSqrtReal((PetscReal)s)+0.001);
r = s-n;
if (n*n != s) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for optimal third order schemes with %d stages, must be a square number at least 4",s);
ierr = TSSSPGetWorkVectors(ts,3,&work);CHKERRQ(ierr);
F = work[2];
ierr = VecCopy(sol,work[0]);CHKERRQ(ierr);
for (i=0; i<(n-1)*(n-2)/2; i++) {
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/r,F);CHKERRQ(ierr);
}
ierr = VecCopy(work[0],work[1]);CHKERRQ(ierr);
for (; i<n*(n+1)/2-1; i++) {
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/r,F);CHKERRQ(ierr);
}
{
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPBYPCZ(work[0],1.*n/(2*n-1.),(n-1.)*dt/(r*(2*n-1)),(n-1.)/(2*n-1.),work[1],F);CHKERRQ(ierr);
i++;
}
for (; i<s; i++) {
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/r,F);CHKERRQ(ierr);
}
ierr = VecCopy(work[0],sol);CHKERRQ(ierr);
ierr = TSSSPRestoreWorkVectors(ts,3,&work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode VecNorm_MPI(Vec xin,NormType type,PetscReal *z)
{
PetscReal sum,work = 0.0;
const PetscScalar *xx;
PetscErrorCode ierr;
PetscInt n = xin->map->n;
PetscBLASInt one = 1,bn;
PetscFunctionBegin;
ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr);
if (type == NORM_2 || type == NORM_FROBENIUS) {
ierr = VecGetArrayRead(xin,&xx);CHKERRQ(ierr);
work = PetscRealPart(BLASdot_(&bn,xx,&one,xx,&one));
ierr = VecRestoreArrayRead(xin,&xx);CHKERRQ(ierr);
ierr = MPIU_Allreduce(&work,&sum,1,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)xin));CHKERRQ(ierr);
*z = PetscSqrtReal(sum);
ierr = PetscLogFlops(2.0*xin->map->n);CHKERRQ(ierr);
} else if (type == NORM_1) {
/* Find the local part */
ierr = VecNorm_Seq(xin,NORM_1,&work);CHKERRQ(ierr);
/* Find the global max */
ierr = MPIU_Allreduce(&work,z,1,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)xin));CHKERRQ(ierr);
} else if (type == NORM_INFINITY) {
/* Find the local max */
ierr = VecNorm_Seq(xin,NORM_INFINITY,&work);CHKERRQ(ierr);
/* Find the global max */
ierr = MPIU_Allreduce(&work,z,1,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)xin));CHKERRQ(ierr);
} else if (type == NORM_1_AND_2) {
PetscReal temp[2];
ierr = VecNorm_Seq(xin,NORM_1,temp);CHKERRQ(ierr);
ierr = VecNorm_Seq(xin,NORM_2,temp+1);CHKERRQ(ierr);
temp[1] = temp[1]*temp[1];
ierr = MPIU_Allreduce(temp,z,2,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)xin));CHKERRQ(ierr);
z[1] = PetscSqrtReal(z[1]);
}
PetscFunctionReturn(0);
}
/*@
SVDComputeRelativeError - Computes the relative error bound associated
with the i-th singular triplet.
Collective on SVD
Input Parameter:
+ svd - the singular value solver context
- i - the solution index
Output Parameter:
. error - the relative error bound, computed as sqrt(n1^2+n2^2)/sigma
where n1 = ||A*v-sigma*u||_2 , n2 = ||A^T*u-sigma*v||_2 , sigma is the singular value,
u and v are the left and right singular vectors.
If sigma is too small the relative error is computed as sqrt(n1^2+n2^2).
Level: beginner
.seealso: SVDSolve(), SVDComputeResidualNorms()
@*/
PetscErrorCode SVDComputeRelativeError(SVD svd,PetscInt i,PetscReal *error)
{
PetscErrorCode ierr;
PetscReal sigma,norm1,norm2;
PetscFunctionBegin;
PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
PetscValidLogicalCollectiveInt(svd,i,2);
PetscValidPointer(error,3);
ierr = SVDGetSingularTriplet(svd,i,&sigma,NULL,NULL);CHKERRQ(ierr);
ierr = SVDComputeResidualNorms(svd,i,&norm1,&norm2);CHKERRQ(ierr);
*error = PetscSqrtReal(norm1*norm1+norm2*norm2);
if (sigma>*error) *error /= sigma;
PetscFunctionReturn(0);
}
PetscErrorCode SNESMonitorVI(SNES snes,PetscInt its,PetscReal fgnorm,void *dummy)
{
PetscErrorCode ierr;
PetscViewer viewer = dummy ? (PetscViewer) dummy : PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)snes));
const PetscScalar *x,*xl,*xu,*f;
PetscInt i,n,act[2] = {0,0},fact[2],N;
/* Number of components that actually hit the bounds (c.f. active variables) */
PetscInt act_bound[2] = {0,0},fact_bound[2];
PetscReal rnorm,fnorm;
double tmp;
PetscFunctionBegin;
ierr = VecGetLocalSize(snes->vec_sol,&n);CHKERRQ(ierr);
ierr = VecGetSize(snes->vec_sol,&N);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->xl,&xl);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->xu,&xu);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->vec_sol,&x);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->vec_func,&f);CHKERRQ(ierr);
rnorm = 0.0;
for (i=0; i<n; i++) {
if (((PetscRealPart(x[i]) > PetscRealPart(xl[i]) + 1.e-8 || (PetscRealPart(f[i]) < 0.0)) && ((PetscRealPart(x[i]) < PetscRealPart(xu[i]) - 1.e-8) || PetscRealPart(f[i]) > 0.0))) rnorm += PetscRealPart(PetscConj(f[i])*f[i]);
else if (PetscRealPart(x[i]) <= PetscRealPart(xl[i]) + 1.e-8 && PetscRealPart(f[i]) >= 0.0) act[0]++;
else if (PetscRealPart(x[i]) >= PetscRealPart(xu[i]) - 1.e-8 && PetscRealPart(f[i]) <= 0.0) act[1]++;
else SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Can never get here");
}
for (i=0; i<n; i++) {
if (PetscRealPart(x[i]) <= PetscRealPart(xl[i]) + 1.e-8) act_bound[0]++;
else if (PetscRealPart(x[i]) >= PetscRealPart(xu[i]) - 1.e-8) act_bound[1]++;
}
ierr = VecRestoreArrayRead(snes->vec_func,&f);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->xl,&xl);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->xu,&xu);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->vec_sol,&x);CHKERRQ(ierr);
ierr = MPI_Allreduce(&rnorm,&fnorm,1,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
ierr = MPI_Allreduce(act,fact,2,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
ierr = MPI_Allreduce(act_bound,fact_bound,2,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
fnorm = PetscSqrtReal(fnorm);
ierr = PetscViewerASCIIAddTab(viewer,((PetscObject)snes)->tablevel);CHKERRQ(ierr);
if (snes->ntruebounds) tmp = ((double)(fact[0]+fact[1]))/((double)snes->ntruebounds);
else tmp = 0.0;
ierr = PetscViewerASCIIPrintf(viewer,"%3D SNES VI Function norm %14.12e Active lower constraints %D/%D upper constraints %D/%D Percent of total %g Percent of bounded %g\n",its,(double)fnorm,fact[0],fact_bound[0],fact[1],fact_bound[1],((double)(fact[0]+fact[1]))/((double)N),tmp);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(viewer,((PetscObject)snes)->tablevel);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormInitialSolution(DM da,Vec U)
{
PetscErrorCode ierr;
PetscInt i,j,xs,ys,xm,ym,Mx,My;
PetscScalar ***u;
PetscReal hx,hy,x,y,r;
PetscFunctionBeginUser;
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArrayDOF(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;
r = PetscSqrtReal((x-.5)*(x-.5) + (y-.5)*(y-.5));
if (r < .125) {
u[j][i][0] = PetscExpReal(-30.0*r*r*r);
u[j][i][1] = 0.0;
} else {
u[j][i][0] = 0.0;
u[j][i][1] = 0.0;
}
}
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArrayDOF(da,U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMDASplitComm2d(MPI_Comm comm,PetscInt M,PetscInt N,PetscInt sw,MPI_Comm *outcomm)
{
PetscErrorCode ierr;
PetscInt m,n = 0,x = 0,y = 0;
PetscMPIInt size,csize,rank;
PetscFunctionBegin;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
csize = 4*size;
do {
if (csize % 4) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cannot split communicator of size %d tried %d %D %D",size,csize,x,y);
csize = csize/4;
m = (PetscInt)(0.5 + PetscSqrtReal(((PetscReal)M)*((PetscReal)csize)/((PetscReal)N)));
if (!m) m = 1;
while (m > 0) {
n = csize/m;
if (m*n == csize) break;
m--;
}
if (M > N && m < n) {PetscInt _m = m; m = n; n = _m;}
x = M/m + ((M % m) > ((csize-1) % m));
y = (N + (csize-1)/m)/n;
} while ((x < 4 || y < 4) && csize > 1);
if (size != csize) {
MPI_Group entire_group,sub_group;
PetscMPIInt i,*groupies;
ierr = MPI_Comm_group(comm,&entire_group);CHKERRQ(ierr);
ierr = PetscMalloc1(csize,&groupies);CHKERRQ(ierr);
for (i=0; i<csize; i++) {
groupies[i] = (rank/csize)*csize + i;
}
ierr = MPI_Group_incl(entire_group,csize,groupies,&sub_group);CHKERRQ(ierr);
ierr = PetscFree(groupies);CHKERRQ(ierr);
ierr = MPI_Comm_create(comm,sub_group,outcomm);CHKERRQ(ierr);
ierr = MPI_Group_free(&entire_group);CHKERRQ(ierr);
ierr = MPI_Group_free(&sub_group);CHKERRQ(ierr);
ierr = PetscInfo1(0,"DMDASplitComm2d:Creating redundant coarse problems of size %d\n",csize);CHKERRQ(ierr);
} else {
*outcomm = comm;
}
PetscFunctionReturn(0);
}
/*
EPSDelayedArnoldi1 - This function is similar to EPSDelayedArnoldi,
but without reorthogonalization (only delayed normalization).
*/
PetscErrorCode EPSDelayedArnoldi1(EPS eps,PetscScalar *H,PetscInt ldh,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscReal *beta,PetscBool *breakdown)
{
PetscErrorCode ierr;
PetscInt i,j,m=*M;
PetscScalar dot;
PetscReal norm=0.0;
PetscFunctionBegin;
for (j=k;j<m;j++) {
ierr = STApply(eps->st,V[j],f);CHKERRQ(ierr);
ierr = IPOrthogonalize(eps->ip,0,NULL,eps->nds,NULL,eps->defl,f,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = IPMInnerProductBegin(eps->ip,f,j+1,V,H+ldh*j);CHKERRQ(ierr);
if (j>k) {
ierr = IPInnerProductBegin(eps->ip,V[j],V[j],&dot);CHKERRQ(ierr);
}
ierr = IPMInnerProductEnd(eps->ip,f,j+1,V,H+ldh*j);CHKERRQ(ierr);
if (j>k) {
ierr = IPInnerProductEnd(eps->ip,V[j],V[j],&dot);CHKERRQ(ierr);
}
if (j>k) {
norm = PetscSqrtReal(PetscRealPart(dot));
ierr = VecScale(V[j],1.0/norm);CHKERRQ(ierr);
H[ldh*(j-1)+j] = norm;
for (i=0;i<j;i++)
H[ldh*j+i] = H[ldh*j+i]/norm;
H[ldh*j+j] = H[ldh*j+j]/dot;
ierr = VecScale(f,1.0/norm);CHKERRQ(ierr);
}
ierr = SlepcVecMAXPBY(f,1.0,-1.0,j+1,H+ldh*j,V);CHKERRQ(ierr);
if (j<m-1) {
ierr = VecCopy(f,V[j+1]);CHKERRQ(ierr);
}
}
ierr = IPNorm(eps->ip,f,beta);CHKERRQ(ierr);
ierr = VecScale(f,1.0 / *beta);CHKERRQ(ierr);
*breakdown = PETSC_FALSE;
PetscFunctionReturn(0);
}
void g3_uu_3d_alpha(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, PetscReal u_tShift, const PetscReal x[], PetscScalar g3[])
{
PetscReal mu=s_mu, lambda=s_lambda,rad;
PetscInt i;
for (i=0,rad=0.;i<dim;i++) {
PetscReal t=x[i];
rad += t*t;
}
rad = PetscSqrtReal(rad);
if (rad>0.25) {
mu *= s_soft_alpha;
lambda *= s_soft_alpha; /* we could keep the bulk the same like rubberish */
}
g3_uu_3d_private(g3,mu,lambda);
}
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 TSGLLEAdaptChoose_Both(TSGLLEAdapt adapt,PetscInt n,const PetscInt orders[],const PetscReal errors[],const PetscReal cost[],PetscInt cur,PetscReal h,PetscReal tleft,PetscInt *next_sc,PetscReal *next_h,PetscBool *finish)
{
TSGLLEAdapt_Both *both = (TSGLLEAdapt_Both*)adapt->data;
PetscErrorCode ierr;
PetscReal dec = 0.2,inc = 5.0,safe = 0.9;
struct {PetscInt id; PetscReal h,eff;} best={-1,0,0},trial={-1,0,0},current={-1,0,0};
PetscInt i;
PetscFunctionBegin;
for (i=0; i<n; i++) {
PetscReal optimal;
trial.id = i;
optimal = PetscPowReal((PetscReal)errors[i],(PetscReal)-1./(safe*orders[i]));
trial.h = h*optimal;
trial.eff = trial.h/cost[i];
if (trial.eff > best.eff) {ierr = PetscMemcpy(&best,&trial,sizeof(trial));CHKERRQ(ierr);}
if (i == cur) {ierr = PetscMemcpy(¤t,&trial,sizeof(trial));CHKERRQ(ierr);}
}
/* Only switch orders if the scheme offers significant benefits over the current one.
When the scheme is not changing, only change step size if it offers significant benefits. */
if (best.eff < 1.2*current.eff || both->count_at_order < orders[cur]+2) {
PetscReal last_desired_h;
*next_sc = current.id;
last_desired_h = both->desired_h;
both->desired_h = PetscMax(h*dec,PetscMin(h*inc,current.h));
*next_h = (both->count_at_order > 0)
? PetscSqrtReal(last_desired_h * both->desired_h)
: both->desired_h;
both->count_at_order++;
} else {
PetscReal rat = cost[best.id]/cost[cur];
*next_sc = best.id;
*next_h = PetscMax(h*rat*dec,PetscMin(h*rat*inc,best.h));
both->count_at_order = 0;
both->desired_h = best.h;
}
if (*next_h > tleft) {
*finish = PETSC_TRUE;
*next_h = tleft;
} else *finish = PETSC_FALSE;
PetscFunctionReturn(0);
}
PetscErrorCode FormInitialSolution(DM da,Vec X,PetscReal kappa)
{
PetscErrorCode ierr;
PetscInt i,xs,xm,Mx;
Field *x;
PetscReal hx,xx,r,sx;
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);
hx = 1.0/(PetscReal)Mx;
sx = 1.0/(hx*hx);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArray(da,X,&x);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++) {
xx = i*hx;
r = PetscSqrtReal((xx-.5)*(xx-.5));
if (r < .125) x[i].u = 1.0;
else x[i].u = -.50;
/* u[i] = PetscPowScalar(x - .5,4.0); */
}
for (i=xs; i<xs+xm; i++) x[i].w = -kappa*(x[i-1].u + x[i+1].u - 2.0*x[i].u)*sx;
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,X,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PetscDrawSplitViewPort - Splits a window shared by several processes into smaller
view ports. One for each process.
Collective on PetscDraw
Input Parameter:
. draw - the drawing context
Level: advanced
Concepts: drawing^in subset of window
.seealso: PetscDrawDivideViewPort(), PetscDrawSetViewPort()
@*/
PetscErrorCode PetscDrawSplitViewPort(PetscDraw draw)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
PetscInt n;
PetscBool isnull;
PetscReal xl,xr,yl,yr,h;
PetscFunctionBegin;
PetscValidHeaderSpecific(draw,PETSC_DRAW_CLASSID,1);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
if (isnull) PetscFunctionReturn(0);
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)draw),&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)draw),&size);CHKERRQ(ierr);
n = (PetscInt)(.1 + PetscSqrtReal((PetscReal)size));
while (n*n < size) n++;
h = 1.0/n;
xl = (rank % n)*h;
xr = xl + h;
yl = (rank / n)*h;
yr = yl + h;
ierr = PetscDrawCollectiveBegin(draw);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xl,yl,xl,yr,PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xl,yr,xr,yr,PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xr,yr,xr,yl,PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xr,yl,xl,yl,PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawCollectiveEnd(draw);CHKERRQ(ierr);
ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
draw->port_xl = xl + .05*h;
draw->port_xr = xr - .05*h;
draw->port_yl = yl + .05*h;
draw->port_yr = yr - .05*h;
if (draw->ops->setviewport) {
ierr = (*draw->ops->setviewport)(draw,xl,yl,xr,yr);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Monitor - User-provided routine to monitor the solution computed at
each timestep. This example plots the solution and computes the
error in two different norms.
Input Parameters:
ts - the timestep context
step - the count of the current step (with 0 meaning the
initial condition)
time - the current time
u - the solution at this timestep
ctx - the user-provided context for this monitoring routine.
In this case we use the application context which contains
information about the problem size, workspace and the exact
solution.
*/
PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal time,Vec u,void *ctx)
{
AppCtx *appctx = (AppCtx*)ctx;
PetscErrorCode ierr;
PetscInt i,m=appctx->m;
PetscReal norm_2,norm_max,h=1.0/(m+1);
PetscScalar *u_exact;
/* Compute the exact solution */
ierr = VecGetArray(appctx->solution,&u_exact);CHKERRQ(ierr);
for (i=0; i<m; i++){
u_exact[i] = exact(appctx->z[i+1],time);
}
ierr = VecRestoreArray(appctx->solution,&u_exact);CHKERRQ(ierr);
/* Print debugging information if desired */
if (appctx->debug) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Computed solution vector at time %g\n",time);CHKERRQ(ierr);
ierr = VecView(u,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Exact solution vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
/* Compute the 2-norm and max-norm of the error */
ierr = VecAXPY(appctx->solution,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(appctx->solution,NORM_2,&norm_2);CHKERRQ(ierr);
norm_2 = PetscSqrtReal(h)*norm_2;
ierr = VecNorm(appctx->solution,NORM_MAX,&norm_max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Timestep %D: time = %G, 2-norm error = %6.4f, max norm error = %6.4f\n",
step,time,norm_2,norm_max);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
return 0;
}
