static PetscErrorCode SNESComputeFunction_DMLocal(SNES snes,Vec X,Vec F,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx;
Vec Xloc,Floc;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(F,VEC_CLASSID,3);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
ierr = VecZeroEntries(Floc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmlocalsnes->residuallocal)(dm,Xloc,Floc,dmlocalsnes->residuallocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Evaluates \integral_{-1}^{1} f*v_i where v_i is the ith basis polynomial via the GLL nodes and weights, since the v_i
basis function is zero at all nodes except the ith one the integral is simply the weight_i * f(node_i)
*/
PetscErrorCode ComputeRhs(DM da,PetscGLL *gll,Vec b)
{
PetscErrorCode ierr;
PetscInt i,j,xs,xn,n = gll->n;
PetscScalar *bb,*xx;
PetscReal xd;
Vec blocal,xlocal;
PetscFunctionBegin;
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xn,NULL,NULL);CHKERRQ(ierr);
xs = xs/(n-1);
xn = xn/(n-1);
ierr = DMGetLocalVector(da,&blocal);CHKERRQ(ierr);
ierr = VecZeroEntries(blocal);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,blocal,&bb);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(da,&xlocal);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,xlocal,&xx);CHKERRQ(ierr);
/* loop over local spectral elements */
for (j=xs; j<xs+xn; j++) {
/* loop over GLL points in each element */
for (i=0; i<n; i++) {
xd = xx[j*(n-1) + i];
bb[j*(n-1) + i] += -gll->weights[i]*(-20.*PETSC_PI*xd*PetscSinReal(5.*PETSC_PI*xd) + (2. - (5.*PETSC_PI)*(5.*PETSC_PI)*(xd*xd - 1.))*PetscCosReal(5.*PETSC_PI*xd));
}
}
ierr = DMDAVecRestoreArray(da,xlocal,&xx);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,blocal,&bb);CHKERRQ(ierr);
ierr = VecZeroEntries(b);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,blocal,ADD_VALUES,b);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,blocal,ADD_VALUES,b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&blocal);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMCreateLocalVector_Shell(DM dm,Vec *gvec)
{
PetscErrorCode ierr;
DM_Shell *shell = (DM_Shell*)dm->data;
Vec X;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidPointer(gvec,2);
*gvec = 0;
X = shell->Xlocal;
if (!X) SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_USER,"Must call DMShellSetLocalVector() or DMShellSetCreateLocalVector()");
if (((PetscObject)X)->refct < 2) { /* We have an exclusive reference so we can give it out */
ierr = PetscObjectReference((PetscObject)X);
CHKERRQ(ierr);
ierr = VecZeroEntries(X);
CHKERRQ(ierr);
*gvec = X;
} else { /* Need to create a copy, could use MAT_SHARE_NONZERO_PATTERN in most cases */
ierr = VecDuplicate(X,gvec);
CHKERRQ(ierr);
ierr = VecZeroEntries(*gvec);
CHKERRQ(ierr);
}
ierr = VecSetDM(*gvec,dm);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode OpForcing(Op op,DM dm,Vec F) {
PetscErrorCode ierr;
Vec X,Floc;
DM dmx;
const PetscScalar *x;
PetscScalar *f;
const PetscReal *B,*D,*w3;
PetscReal L[3];
PetscInt nelem,ne = op->ne,P,Q,P3,Q3;
PetscFunctionBegin;
ierr = PetscLogEventBegin(OP_Forcing,dm,F,0,0);CHKERRQ(ierr);
ierr = DMFEGetTensorEval(dm,&P,&Q,&B,&D,NULL,NULL,&w3);CHKERRQ(ierr);
P3 = P*P*P;
Q3 = Q*Q*Q;
ierr = DMFEGetUniformCoordinates(dm,L);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm,&dmx);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm,&X);CHKERRQ(ierr);
ierr = DMFEGetNumElements(dm,&nelem);CHKERRQ(ierr);
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecZeroEntries(Floc);CHKERRQ(ierr);
ierr = VecGetArray(Floc,&f);CHKERRQ(ierr);
for (PetscInt e=0; e<nelem; e+=ne) {
PetscScalar fe[op->dof*P3*ne]_align,fq[op->dof][Q3][ne]_align,xe[3*P3*ne]_align,xq[3][Q3][ne]_align,dx[3][3][Q3][ne]_align,wdxdet[Q3][ne]_align;
ierr = DMFEExtractElements(dmx,x,e,ne,xe);CHKERRQ(ierr);
ierr = PetscMemzero(xq,sizeof xq);CHKERRQ(ierr);
ierr = TensorContract(op->Tensor3,B,B,B,TENSOR_EVAL,xe,xq[0][0]);CHKERRQ(ierr);
ierr = PetscMemzero(dx,sizeof dx);CHKERRQ(ierr);
ierr = TensorContract(op->Tensor3,D,B,B,TENSOR_EVAL,xe,dx[0][0][0]);CHKERRQ(ierr);
ierr = TensorContract(op->Tensor3,B,D,B,TENSOR_EVAL,xe,dx[1][0][0]);CHKERRQ(ierr);
ierr = TensorContract(op->Tensor3,B,B,D,TENSOR_EVAL,xe,dx[2][0][0]);CHKERRQ(ierr);
ierr = PointwiseJacobianInvert(ne,Q*Q*Q,w3,dx,wdxdet);CHKERRQ(ierr);
for (PetscInt i=0; i<Q3; i++) {
for (PetscInt l=0; l<ne; l++) {
PetscReal xx[] = {xq[0][i][l],xq[1][i][l],xq[2][i][l]};
PetscScalar fql[op->dof];
ierr = (op->PointwiseForcing)(op,xx,L,fql);CHKERRQ(ierr);
for (PetscInt d=0; d<op->dof; d++) fq[d][i][l] = wdxdet[i][l] * fql[d];
}
}
ierr = PetscMemzero(fe,sizeof fe);CHKERRQ(ierr);
ierr = TensorContract(op->TensorDOF,B,B,B,TENSOR_TRANSPOSE,fq[0][0],fe);CHKERRQ(ierr);
ierr = DMFESetElements(dm,f,e,ne,ADD_VALUES,DOMAIN_INTERIOR,fe);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(Floc,&f);CHKERRQ(ierr);
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = PetscLogEventEnd(OP_Forcing,dm,F,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeFunction_DMDA(SNES snes,Vec X,Vec F,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x,*f;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(F,VEC_CLASSID,3);
if (!dmdasnes->residuallocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
switch (dmdasnes->residuallocalimode) {
case INSERT_VALUES: {
ierr = DMDAVecGetArray(dm,F,&f);CHKERRQ(ierr);
ierr = PetscLogEventBegin(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->residuallocal)(&info,x,f,dmdasnes->residuallocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = PetscLogEventEnd(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dm,F,&f);CHKERRQ(ierr);
} break;
case ADD_VALUES: {
Vec Floc;
ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = VecZeroEntries(Floc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Floc,&f);CHKERRQ(ierr);
ierr = PetscLogEventBegin(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->residuallocal)(&info,x,f,dmdasnes->residuallocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = PetscLogEventEnd(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dm,Floc,&f);CHKERRQ(ierr);
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr);
} break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_INCOMP,"Cannot use imode=%d",(int)dmdasnes->residuallocalimode);
}
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
if (snes->domainerror) {
ierr = VecSetInf(F);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode FormResidual(TS ts,PetscReal t,Vec U,Vec Udot,Vec R,void *user)
{
PetscFunctionBegin;
PetscErrorCode ierr;
DMDALocalInfo info;
DM dm;
Vec localU,localUdot,localR; // local versions
Field **h,**hdot,**r;
/* get the da from the snes */
ierr = TSGetDM(ts, &dm);CHKERRQ(ierr);
/* handle the vec U */
ierr = DMGetLocalVector(dm,&localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/* handle the vec Udot */
ierr = DMGetLocalVector(dm,&localUdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,Udot,INSERT_VALUES,localUdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,Udot,INSERT_VALUES,localUdot);CHKERRQ(ierr);
/* handle the vec R */
ierr = DMGetLocalVector(dm,&localR);CHKERRQ(ierr);
ierr = VecZeroEntries(localR);CHKERRQ(ierr);
/* Get the arrays from the vectors */
ierr = DMIGAVecGetArray(dm,localU,&h);CHKERRQ(ierr);
ierr = DMIGAVecGetArray(dm,localUdot,&hdot);CHKERRQ(ierr);
ierr = DMIGAVecGetArray(dm,localR,&r);CHKERRQ(ierr);
/* Grab the local info and call the local residual routine */
ierr = DMIGAGetLocalInfo(dm,&info);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = FormResidualLocal(&info,t,h,hdot,r,(AppCtx *) user);CHKERRQ(ierr);
/* Restore the arrays */
ierr = DMIGAVecRestoreArray(dm,localR,&r);CHKERRQ(ierr);
ierr = DMIGAVecRestoreArray(dm,localUdot,&hdot);CHKERRQ(ierr);
ierr = DMIGAVecRestoreArray(dm,localU,&h);CHKERRQ(ierr);
/* Add contributions back to global R */
ierr = VecZeroEntries(R);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,localR,ADD_VALUES,R);CHKERRQ(ierr); // this one adds the values
ierr = DMLocalToGlobalEnd(dm,localR,ADD_VALUES,R);CHKERRQ(ierr);
/* Restore the local vectors */
ierr = DMRestoreLocalVector(dm,&localU);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&localUdot);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&localR);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
This function should eventually replace:
DMDAComputeFunction() and DMDAComputeFunction1()
*/
static PetscErrorCode TSComputeIFunction_DMDA(TS ts,PetscReal ptime,Vec X,Vec Xdot,Vec F,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMTS_DA *dmdats = (DMTS_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x,*f,*xdot;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(F,VEC_CLASSID,3);
if (!dmdats->ifunctionlocal) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Corrupt context");
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xdot,&xdot);CHKERRQ(ierr);
switch (dmdats->ifunctionlocalimode) {
case INSERT_VALUES: {
ierr = DMDAVecGetArray(dm,F,&f);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdats->ifunctionlocal)(&info,ptime,x,xdot,f,dmdats->ifunctionlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMDAVecRestoreArray(dm,F,&f);CHKERRQ(ierr);
} break;
case ADD_VALUES: {
Vec Floc;
ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = VecZeroEntries(Floc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Floc,&f);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdats->ifunctionlocal)(&info,ptime,x,xdot,f,dmdats->ifunctionlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMDAVecRestoreArray(dm,Floc,&f);CHKERRQ(ierr);
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr);
} break;
default: SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_INCOMP,"Cannot use imode=%d",(int)dmdats->ifunctionlocalimode);
}
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dm,Xdot,&xdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSInterpolate_EIMEX(TS ts,PetscReal itime,Vec X)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscReal t,a,b;
Vec Y0=ext->VecSolPrev,Y1=ext->Y,Ydot=ext->Ydot,YdotI=ext->YdotI;
const PetscReal h = ts->ptime - ts->ptime_prev;
PetscErrorCode ierr;
PetscFunctionBegin;
t = (itime -ts->ptime + h)/h;
/* YdotI = -f(x)-g(x) */
ierr = VecZeroEntries(Ydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime-h,Y0,Ydot,YdotI,PETSC_FALSE);CHKERRQ(ierr);
a = 2.0*t*t*t - 3.0*t*t + 1.0;
b = -(t*t*t - 2.0*t*t + t)*h;
ierr = VecAXPBYPCZ(X,a,b,0.0,Y0,YdotI);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime,Y1,Ydot,YdotI,PETSC_FALSE);CHKERRQ(ierr);
a = -2.0*t*t*t+3.0*t*t;
b = -(t*t*t - t*t)*h;
ierr = VecAXPBYPCZ(X,a,b,1.0,Y1,YdotI);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
double SFieldSolveFor(SField sfv, double *Y, unsigned int yCount) {
mySField sf = static_cast<mySField>(sfv);
assert(yCount <= sf->maxN);
assert(Y);
assert(sf->running);
sf->Y = Y;
sf->curN = yCount;
// -------------- SOLVE
PetscErrorCode ierr;
PetscLogDouble tic,toc;
PetscTime(&tic);
int pt[sf->d];
ierr = MatZeroEntries(sf->J); CHKERRQ(ierr);
JacobianOnD(sf->J, sf->F, 0, pt, sf);
ierr = MatAssemblyBegin(sf->J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(sf->J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
PetscTime(&toc);
sf->timeAssembly += toc-tic;
PetscTime(&tic);
ierr = VecZeroEntries(sf->U); CHKERRQ(ierr);
ierr = KSPSetOperators(sf->ksp, sf->J, sf->J); CHKERRQ(ierr);
ierr = KSPSetUp(sf->ksp); CHKERRQ(ierr);
ierr = KSPSolve(sf->ksp,sf->F,sf->U); CHKERRQ(ierr);
PetscTime(&toc);
sf->timeSolver += toc-tic;
return Integrate(sf->U,pt,0,sf);
}
/*
FormIFunction - Evaluates nonlinear function, F(X,Xdot) = Xdot + grad(objective(X))
Input Parameters:
+ ts - the TS context
. t - time
. X - input vector
. Xdot - time derivative
- ctx - optional user-defined context
Output Parameter:
. F - function vector
*/
static PetscErrorCode FormIFunction(TS ts,PetscReal t,Vec X,Vec Xdot,Vec F,void *ictx)
{
PetscErrorCode ierr;
const PetscScalar *x;
PetscScalar *f;
PetscInt i;
Ctx *ctx = (Ctx*)ictx;
PetscFunctionBeginUser;
/*
Get pointers 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 = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
/* Compute gradient of objective */
for (i=0; i<ctx->n-1; i++) {
PetscScalar a,a0,a1;
a = x[i+1] - PetscSqr(x[i]);
a0 = -2.*x[i];
a1 = 1.;
f[i] += -2.*(1. - x[i]) + 200.*a*a0;
f[i+1] += 200.*a*a1;
}
/* Restore vectors */
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
ierr = VecAXPY(F,1.0,Xdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
DM dm;
DMTS tsdm;
TSIFunction ifunction;
MPI_Comm comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2,yydot = cvode->ydot;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)ts,&comm);CHKERRQ(ierr);
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar*) N_VGetArrayPointer(y);
ydot_data = (PetscScalar*) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data);CHKERRABORT(comm,ierr);
/* Now compute the right hand side function, via IFunction unless only the more efficient RHSFunction is set */
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = DMGetDMTS(dm,&tsdm);CHKERRQ(ierr);
ierr = DMTSGetIFunction(dm,&ifunction,NULL);CHKERRQ(ierr);
if (!ifunction) {
ierr = TSComputeRHSFunction(ts,t,yy,yyd);CHKERRQ(ierr);
} else { /* If rhsfunction is also set, this computes both parts and shifts them to the right */
ierr = VecZeroEntries(yydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,t,yy,yydot,yyd,PETSC_FALSE);CHKERRABORT(comm,ierr);
ierr = VecScale(yyd,-1.);CHKERRQ(ierr);
}
ierr = VecResetArray(yy);CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd);CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode FormRHSFunction(TS ts,PetscReal t,Vec X,Vec F,void *ptr)
{
User user = (User)ptr;
PetscErrorCode ierr;
PetscScalar **f;
const PetscScalar **x;
DM dm;
PetscInt i,xs,xm;
PetscFunctionBeginUser;
if (user->reactions) {
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = DMDAVecGetArrayDOFRead(dm,X,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArrayDOF(dm,F,&f);CHKERRQ(ierr);
ierr = DMDAGetCorners(dm,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
for (i=xs; i<xs+xm; i++) {
ierr = PetscMemcpy(user->tchemwork,x[i],(user->Nspec+1)*sizeof(x[xs][0]));CHKERRQ(ierr);
user->tchemwork[0] *= user->Tini; /* Dimensionalize */
ierr = TC_getSrc(user->tchemwork,user->Nspec+1,f[i]);TCCHKERRQ(ierr);
f[i][0] /= user->Tini; /* Non-dimensionalize */
}
ierr = DMDAVecRestoreArrayDOFRead(dm,X,&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayDOF(dm,F,&f);CHKERRQ(ierr);
} else {
ierr = VecZeroEntries(F);CHKERRQ(ierr);
}
if (user->diffusion) {
ierr = FormDiffusionFunction(ts,t,X,F,ptr);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
SlicedCreateGlobalVector - Creates a vector of the correct size to be gathered into
by the slice.
Collective on Sliced
Input Parameter:
. slice - the slice object
Output Parameters:
. gvec - the global vector
Level: advanced
Notes: Once this has been created you cannot add additional arrays or vectors to be packed.
.seealso SlicedDestroy(), SlicedCreate(), SlicedGetGlobalIndices()
@*/
PetscErrorCode PETSCDM_DLLEXPORT SlicedCreateGlobalVector(Sliced slice,Vec *gvec)
{
PetscErrorCode ierr;
PetscInt bs,cnt,i;
PetscFunctionBegin;
PetscValidHeaderSpecific(slice,DM_COOKIE,1);
PetscValidPointer(gvec,2);
*gvec = 0;
if (slice->globalvector) {
ierr = PetscObjectGetReference((PetscObject)slice->globalvector,&cnt);CHKERRQ(ierr);
if (cnt == 1) { /* Nobody else has a reference so we can just reference it and give it away */
*gvec = slice->globalvector;
ierr = PetscObjectReference((PetscObject)*gvec);CHKERRQ(ierr);
ierr = VecZeroEntries(*gvec);CHKERRQ(ierr);
} else { /* Someone else has a reference so we duplicate the global vector */
ierr = VecDuplicate(slice->globalvector,gvec);CHKERRQ(ierr);
}
} else {
bs = slice->bs;
/* VecCreateGhostBlock requires ghosted blocks to be given in terms of first entry, not block. Here, we munge the
* ghost array for this call, then put it back. */
for (i=0; i<slice->Nghosts; i++) slice->ghosts[i] *= bs;
ierr = VecCreateGhostBlock(((PetscObject)slice)->comm,bs,slice->n*bs,PETSC_DETERMINE,slice->Nghosts,slice->ghosts,&slice->globalvector);CHKERRQ(ierr);
for (i=0; i<slice->Nghosts; i++) slice->ghosts[i] /= bs;
*gvec = slice->globalvector;
ierr = PetscObjectReference((PetscObject)*gvec);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
X - initial state, updated in-place.
F - residual, computed at the initial X on input
*/
static PetscErrorCode SNESMSStep_3Sstar(SNES snes,Vec X,Vec F)
{
PetscErrorCode ierr;
SNES_MS *ms = (SNES_MS*)snes->data;
SNESMSTableau t = ms->tableau;
const PetscReal *gamma = t->gamma,*delta = t->delta,*betasub = t->betasub;
Vec S1,S2,S3,Y;
PetscInt i,nstages = t->nstages;;
PetscFunctionBegin;
Y = snes->work[0];
S1 = X;
S2 = snes->work[1];
S3 = snes->work[2];
ierr = VecZeroEntries(S2);CHKERRQ(ierr);
ierr = VecCopy(X,S3);CHKERRQ(ierr);
for (i=0; i<nstages; i++) {
Vec Ss[4] = {S1,S2,S3,Y};
PetscScalar scoeff[4] = {gamma[0*nstages+i]-1.0,gamma[1*nstages+i],gamma[2*nstages+i],-betasub[i]*ms->damping};
ierr = VecAXPY(S2,delta[i],S1);CHKERRQ(ierr);
if (i>0) {
ierr = SNESComputeFunction(snes,S1,F);CHKERRQ(ierr);
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
}
ierr = SNES_KSPSolve(snes,snes->ksp,F,Y);CHKERRQ(ierr);
ierr = VecMAXPY(S1,4,scoeff,Ss);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode TSPrecond_Sundials(realtype tn,N_Vector y,N_Vector fy,booleantype jok,booleantype *jcurPtr,
realtype _gamma,void *P_data,N_Vector vtemp1,N_Vector vtemp2,N_Vector vtemp3)
{
TS ts = (TS) P_data;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PC pc;
PetscErrorCode ierr;
Mat J,P;
Vec yy = cvode->w1,yydot = cvode->ydot;
PetscReal gm = (PetscReal)_gamma;
MatStructure str = DIFFERENT_NONZERO_PATTERN;
PetscScalar *y_data;
PetscFunctionBegin;
ierr = TSGetIJacobian(ts,&J,&P,NULL,NULL);CHKERRQ(ierr);
y_data = (PetscScalar*) N_VGetArrayPointer(y);
ierr = VecPlaceArray(yy,y_data);CHKERRQ(ierr);
ierr = VecZeroEntries(yydot);CHKERRQ(ierr); /* The Jacobian is independent of Ydot for ODE which is all that CVode works for */
/* compute the shifted Jacobian (1/gm)*I + Jrest */
ierr = TSComputeIJacobian(ts,ts->ptime,yy,yydot,1/gm,&J,&P,&str,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecResetArray(yy);CHKERRQ(ierr);
ierr = MatScale(P,gm);CHKERRQ(ierr); /* turn into I-gm*Jrest, J is not used by Sundials */
*jcurPtr = TRUE;
ierr = TSSundialsGetPC(ts,&pc);CHKERRQ(ierr);
ierr = PCSetOperators(pc,J,P,str);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MatMultTransposeAdd_SubMatrix(Mat N,Vec v1,Vec v2,Vec v3)
{
Mat_SubMatrix *Na = (Mat_SubMatrix*)N->data;
Vec xx = 0;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PreScaleLeft(N,v1,&xx);CHKERRQ(ierr);
ierr = VecZeroEntries(Na->lwork);CHKERRQ(ierr);
ierr = VecScatterBegin(Na->lrestrict,xx,Na->lwork,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (Na->lrestrict,xx,Na->lwork,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(Na->A,Na->lwork,Na->rwork);CHKERRQ(ierr);
if (v2 == v3) {
if (Na->scale == (PetscScalar)1.0 && !Na->right) {
ierr = VecScatterBegin(Na->rprolong,Na->rwork,v3,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (Na->rprolong,Na->rwork,v3,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
} else {
if (!Na->orwork) {ierr = VecDuplicate(v3,&Na->orwork);CHKERRQ(ierr);}
ierr = VecScatterBegin(Na->rprolong,Na->rwork,Na->orwork,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (Na->rprolong,Na->rwork,Na->orwork,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = PostScaleRight(N,Na->orwork);CHKERRQ(ierr);
ierr = VecAXPY(v3,Na->scale,Na->orwork);CHKERRQ(ierr);
}
} else {
ierr = VecScatterBegin(Na->rprolong,Na->rwork,v3,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (Na->rprolong,Na->rwork,v3,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = PostScaleRight(N,v3);CHKERRQ(ierr);
ierr = VecAYPX(v3,Na->scale,v2);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
inline PetscErrorCode ScatIEMatMult(Mat mat,Vec xx,Vec yy)
{
PetscInt n,s,t;
PetscScalar tmp,v;
PetscInt xstart,xend;
PetscFunctionBegin;
VecGetOwnershipRange(xx,&xstart,&xend);
VecGetSize(yy,&n);
VecZeroEntries(yy);
for(s = 0; s <n ; s++)
{
tmp = 0;
for(t = xstart; t < xend; t++)
{
VecGetValues(xx,1,&t,&v);
tmp += ScatIE.CoefMatFast(s,t)*v;
}
VecSetValues(yy,1,&s,&tmp,ADD_VALUES);
}
VecAssemblyBegin(yy);
VecAssemblyEnd(yy);
PetscFunctionReturn(0);
}
Ensure(FFT, transforms_constant_into_delta_function)
{
Vec v;
DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,4,2,1,NULL,&da);
DMCreateGlobalVector(da, &v);
VecZeroEntries(v);
VecSetValue(v, 0, 0.7, INSERT_VALUES);
VecAssemblyBegin(v);
VecAssemblyEnd(v);
scFftCreate(da, &fft);
Vec x, y, z;
scFftCreateVecsFFTW(fft, &x, &y, &z);
scFftTransform(fft, v, 0, y);
const PetscScalar *arr;
VecGetArrayRead(y, &arr);
//assert_that_double(fabs(arr[0] - 0.7), is_less_than_double(1.0e-6));
assert_that(fabs(arr[1] - 0.0) < 1.0e-6, is_true);
assert_that(fabs(arr[1] - 0.7) < 1.0e-6, is_true);
assert_that(fabs(arr[2] - 0.0) < 1.0e-6, is_true);
assert_that(fabs(arr[3] - 0.7) < 1.0e-6, is_true);
assert_that(fabs(arr[4] - 0.0) < 1.0e-6, is_true);
VecRestoreArrayRead(y, &arr);
VecDestroy(&x);
VecDestroy(&y);
VecDestroy(&z);
VecDestroy(&v);
scFftDestroy(&fft);
DMDestroy(&da);
}
PetscErrorCode FormInitialSolution(TS ts,Vec X,void *ctx)
{
PetscScalar **x,*xc;
PetscErrorCode ierr;
struct {const char *name; PetscReal massfrac;} initial[] = {
{"CH4", 0.0948178320887},
{"O2", 0.189635664177},
{"N2", 0.706766236705},
{"AR", 0.00878026702874}
};
PetscInt i,j,xs,xm;
DM dm;
PetscFunctionBeginUser;
ierr = VecZeroEntries(X);CHKERRQ(ierr);
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = DMDAGetCorners(dm,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
ierr = DMDAGetCoordinateArray(dm,&xc);CHKERRQ(ierr);
ierr = DMDAVecGetArrayDOF(dm,X,&x);CHKERRQ(ierr);
for (i=xs; i<xs+xm; i++) {
x[i][0] = 1.0 + .05*PetscSinScalar(2.*PETSC_PI*xc[i]); /* Non-dimensionalized by user->Tini */
for (j=0; j<sizeof(initial)/sizeof(initial[0]); j++) {
int ispec = TC_getSpos(initial[j].name, strlen(initial[j].name));
if (ispec < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Could not find species %s",initial[j].name);
ierr = PetscPrintf(PETSC_COMM_SELF,"Species %d: %s %g\n",j,initial[j].name,initial[j].massfrac);CHKERRQ(ierr);
x[i][1+ispec] = initial[j].massfrac;
}
}
ierr = DMDAVecRestoreArrayDOF(dm,X,&x);CHKERRQ(ierr);
ierr = DMDARestoreCoordinateArray(dm,&xc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
MPI_Comm comm = ((PetscObject)ts)->comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2,yydot = cvode->ydot;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar *) N_VGetArrayPointer(y);
ydot_data = (PetscScalar *) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data); CHKERRABORT(comm,ierr);
/* now compute the right hand side function */
if (!ts->userops->ifunction) {
ierr = TSComputeRHSFunction(ts,t,yy,yyd);CHKERRQ(ierr);
} else { /* If rhsfunction is also set, this computes both parts and shifts them to the right */
ierr = VecZeroEntries(yydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,t,yy,yydot,yyd,PETSC_FALSE); CHKERRABORT(comm,ierr);
ierr = VecScale(yyd,-1.);CHKERRQ(ierr);
}
ierr = VecResetArray(yy); CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd); CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
void linearSystemPETSc<scalar>::zeroSolution()
{
if (_isAllocated) {
_try(VecAssemblyBegin(_x));
_try(VecAssemblyEnd(_x));
_try(VecZeroEntries(_x));
}
}
void linearSystemPETSc<scalar>::zeroRightHandSide()
{
if (_isAllocated) {
_try(VecAssemblyBegin(_b));
_try(VecAssemblyEnd(_b));
_try(VecZeroEntries(_b));
}
}
static PetscErrorCode SNESComputeJacobian_DMLocal(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx;
Vec Xloc;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (dmlocalsnes->jacobianlocal) {
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);}
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmlocalsnes->jacobianlocal)(dm,Xloc,A,B,dmlocalsnes->jacobianlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
} else {
MatFDColoring fdcoloring;
ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
if (!fdcoloring) {
ISColoring coloring;
ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,coloring,&fdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
switch (dm->coloringtype) {
case IS_COLORING_GLOBAL:
ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMLocal,dmlocalsnes);CHKERRQ(ierr);
break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
}
ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,coloring,fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);
/* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
* VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
* MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
* drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
* taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
*/
ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,fdcoloring,X,snes);CHKERRQ(ierr);
}
/* This will be redundant if the user called both, but it's too common to forget. */
if (A != B) {
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Compute the gradient of the variables at the center of the cell
by the least-square reconstruction method based on the function
BuildLeastSquares.
*/
PetscErrorCode ConstructCellCentriodGradient(DM dm,DM dmFace,DM dmCell,PetscReal time,Vec locX,Vec F,User user)
{
DM dmGrad = user->dmGrad;
Model mod = user->model;
Physics phys = mod->physics;
const PetscInt dof = phys->dof;
PetscErrorCode ierr;
const PetscScalar *facegeom, *cellgeom, *x;
PetscInt fStart, fEnd, face, cStart;
Vec Grad;
PetscFunctionBeginUser;
ierr = DMGetGlobalVector(dmGrad,&Grad);CHKERRQ(ierr);
ierr = VecZeroEntries(Grad);CHKERRQ(ierr);
ierr = VecGetArrayRead(user->facegeom,&facegeom);CHKERRQ(ierr);
ierr = VecGetArrayRead(user->cellgeom,&cellgeom);CHKERRQ(ierr);
ierr = VecGetArrayRead(locX,&x);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
{
PetscScalar *grad;
ierr = VecGetArray(Grad,&grad);CHKERRQ(ierr);
/* Reconstruct gradients */
for (face=fStart; face<fEnd; face++) {
const PetscInt *cells;
const PetscScalar *cx[2];
const FaceGeom *fg;
PetscScalar *cgrad[2];
PetscInt i,j;
PetscBool ghost;
ierr = IsExteriorGhostFace(dm,face,&ghost);CHKERRQ(ierr);
if (ghost) continue;
ierr = DMPlexGetSupport(dm,face,&cells);CHKERRQ(ierr);
ierr = DMPlexPointLocalRead(dmFace,face,facegeom,&fg);CHKERRQ(ierr);
for (i=0; i<2; i++) {
ierr = DMPlexPointLocalRead(dm,cells[i],x,&cx[i]);CHKERRQ(ierr);
ierr = DMPlexPointGlobalRef(dmGrad,cells[i],grad,&cgrad[i]);CHKERRQ(ierr);
}
for (i=0; i<dof; i++) {
PetscScalar delta = cx[1][i] - cx[0][i];
for (j=0; j<DIM; j++) {
if (cgrad[0]) cgrad[0][i*DIM+j] += fg->grad[0][j] * delta;
if (cgrad[1]) cgrad[1][i*DIM+j] -= fg->grad[1][j] * delta;
}
}
}
ierr = VecRestoreArray(Grad,&grad);CHKERRQ(ierr);
}
ierr = DMRestoreGlobalVector(dmGrad,&Grad);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(user->facegeom,&facegeom);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(user->cellgeom,&cellgeom);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(locX,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PetscVecTools::Zero(Vec vector)
{
#if (PETSC_VERSION_MAJOR == 2 && PETSC_VERSION_MINOR == 2) //PETSc 2.2
PetscScalar zero = 0.0;
VecSet(&zero, vector);
#else
VecZeroEntries(vector);
#endif
}
static PetscErrorCode DRDPFunction(TS ts,PetscReal t,Vec U,Vec *drdp,Userctx *user)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecZeroEntries(drdp[0]);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatMultTranspose_Scatter(Mat A,Vec x,Vec y)
{
Mat_Scatter *scatter = (Mat_Scatter*)A->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!scatter->scatter) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Need to first call MatScatterSetScatter()");
ierr = VecZeroEntries(y);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter->scatter,x,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter->scatter,x,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode DRDYFunction(TS ts,PetscReal t,Vec U,Vec *drdy,Userctx *user)
{
PetscErrorCode ierr;
/*
Vec Xgen,Xnet,Dgen,Dnet;
PetscScalar *xnet,*dgen,*proj_vec;
PetscInt obs_len,i,idx;
PetscReal step_num;
PetscScalar *mat;
*/
PetscFunctionBegin;
ierr = VecZeroEntries(drdy[0]);CHKERRQ(ierr);
/* ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Dgen,&Dnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,U,Xgen,Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,drdy[0],Dgen,Dnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = VecGetArray(Dgen,&dgen);CHKERRQ(ierr);
t = t - user->tdisturb;
step_num = round(t / user->data_dt);
if(fabs(step_num - t/user->data_dt)<= 1e-6*user->dt) {
ierr = VecGetArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecGetSize(user->proj, &obs_len);CHKERRQ(ierr);
idx = 2*obs_len*(PetscInt) step_num;
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,U,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = MatDenseGetArray(user->obs,&mat);CHKERRQ(ierr);
for(i=0;i<obs_len; i++) {
//printf("B^T (B x -d): t=%g index=%d proj_len=%d proj[i] = %d \n", t, idx, obs_len, (int)proj_vec[i]);
dgen[2*((int)proj_vec[i])] += xnet[2*((int)proj_vec[i])] - mat[idx+2*i]; // obs[2*i, num_obs]
dgen[2*((int)proj_vec[i])] += xnet[2*((int)proj_vec[i])+1] - mat[idx+2*i+1]; // obs[2*i+1, num_obs]
}
}
ierr = MatDenseRestoreArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecRestoreArray(Dgen,&dgen);CHKERRQ(ierr);
ierr = DMCompositeGather(user->dmpgrid,drdy[0],INSERT_VALUES,Dgen,Dnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Dgen,&Dnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
*/
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_EIMEX(SNES snes,Vec X,Vec G,TS ts)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscErrorCode ierr;
Vec Ydot,Z;
DM dm,dmsave;
PetscFunctionBegin;
ierr = VecZeroEntries(G);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = TSEIMEXGetVecs(ts,dm,&Z,&Ydot,NULL,NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(Ydot);CHKERRQ(ierr);
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIFunction(ts,ext->ctime,X,Ydot,G,PETSC_FALSE);CHKERRQ(ierr);
/* PETSC_FALSE indicates non-imex, adding explicit RHS to the implicit I function. */
ierr = VecCopy(G,Ydot);CHKERRQ(ierr);
ts->dm = dmsave;
ierr = TSEIMEXRestoreVecs(ts,dm,&Z,&Ydot,NULL,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
dErr VecDohpZeroEntries(Vec v)
{
dErr err;
dBool isdohp;
Vec c;
dFunctionBegin;
dValidHeader(v,VEC_CLASSID,1);
err = PetscTypeCompare((dObject)v,VECDOHP,&isdohp);dCHK(err);
if (!isdohp) dERROR(PETSC_COMM_SELF,PETSC_ERR_SUP,"Vector type %s",((dObject)v)->type_name);
err = VecDohpGetClosure(v,&c);dCHK(err);
err = VecZeroEntries(c);dCHK(err);
err = VecDohpRestoreClosure(v,&c);dCHK(err);
dFunctionReturn(0);
}
